├── .gitignore ├── Makefile ├── README.md ├── cameras.def ├── data ├── dense │ └── README ├── images │ ├── barcode │ │ └── barcode.jpg │ ├── calibration │ │ ├── cal1.jpg │ │ ├── cal2.jpg │ │ ├── cal3.jpg │ │ ├── cal4.jpg │ │ ├── cube1.png │ │ ├── cube2.png │ │ ├── cube3.png │ │ ├── cube4.png │ │ ├── disk1.jpg │ │ └── disk2.jpg │ ├── pano │ │ ├── pano000.jpg │ │ ├── pano001.jpg │ │ ├── pano002.jpg │ │ ├── pano003.jpg │ │ ├── pano004.jpg │ │ ├── pano005.jpg │ │ ├── pano006.jpg │ │ └── pano007.jpg │ └── transi │ │ ├── .gitignore │ │ ├── dscn2070.jpg │ │ ├── dscn2479.jpg │ │ ├── dscn2511.jpg │ │ └── regions.txt ├── ml │ └── mnist.txt ├── models3ds │ ├── STS.3ds │ └── lunarlandernofoil_carbajal.3ds ├── shapes │ ├── digits1.png │ ├── digits1.txt │ ├── digits2.png │ ├── digits2.txt │ ├── digits3.png │ ├── digits3.txt │ ├── digits4.png │ ├── digits4.txt │ ├── digits5.png │ ├── digits5.txt │ ├── eye.txt │ ├── letters.png │ ├── letters.txt │ ├── letters1.png │ ├── letters1.txt │ ├── letters2.png │ ├── letters2.txt │ ├── mpeg7.txt │ ├── mpeg7s.txt │ ├── pentominos.txt │ ├── squares.txt │ └── tags.txt ├── tracks │ ├── dinosaur │ │ ├── calib.txt │ │ ├── cams.txt │ │ ├── optcams.txt │ │ ├── optpts.txt │ │ └── pts.txt │ ├── maquette │ │ ├── calib.txt │ │ ├── cams.txt │ │ ├── optcams.txt │ │ ├── optpts.txt │ │ └── pts.txt │ └── trafalgar-21 │ │ ├── calib.txt │ │ ├── cams.txt │ │ ├── optcams.txt │ │ ├── optpts.txt │ │ └── pts.txt └── videos │ ├── chaos.avi │ ├── digits.avi │ ├── rcube.avi │ └── rot4.avi ├── lib ├── lib32 │ ├── libcontours.so │ ├── libcudart.so │ ├── libcudart.so.2 │ └── libsiftgpu.so └── lib64 │ ├── libcontours.so │ ├── libcudart.so │ ├── libcudart.so.4 │ ├── libcudart.so.4.0.17 │ └── libsiftgpu.so ├── packages ├── Makefile ├── base │ ├── LICENSE │ ├── Setup.lhs │ ├── hVision-base.cabal │ └── src │ │ ├── Image.hs │ │ ├── Image │ │ ├── Capture.hs │ │ ├── Capture │ │ │ ├── MPlayer.hs │ │ │ ├── Simple │ │ │ │ └── simple.c │ │ │ ├── UVC.hs │ │ │ └── UVC │ │ │ │ ├── COPYING │ │ │ │ ├── capture.c │ │ │ │ ├── dynctrl-logitech.h │ │ │ │ ├── uvc_compat.h │ │ │ │ ├── uvcvideo.h │ │ │ │ ├── v4l2uvc.c │ │ │ │ └── v4l2uvc.h │ │ ├── Convert.hs │ │ ├── Core.hs │ │ ├── Devel.hs │ │ ├── Devel │ │ │ └── wrappers.h │ │ ├── ROI.hs │ │ └── Types.hs │ │ └── Util │ │ ├── Audio.hs │ │ ├── Camera.hs │ │ ├── Convex.hs │ │ ├── Covariance.hs │ │ ├── Ellipses.hs │ │ ├── Estimation.hs │ │ ├── Experiment.hs │ │ ├── Gaussian.hs │ │ ├── Geometry.hs │ │ ├── Graph.hs │ │ ├── Homogeneous.hs │ │ ├── ICA.hs │ │ ├── Kalman.hs │ │ ├── L1.hs │ │ ├── LazyIO.hs │ │ ├── NLHash.hs │ │ ├── Optimize.hs │ │ ├── Polygon.hs │ │ ├── Probability.hs │ │ ├── Quaternion.hs │ │ ├── Rotation.hs │ │ ├── Small.hs │ │ ├── Sparse.hs │ │ └── Stat.hs ├── classifier │ ├── LICENSE │ ├── Setup.lhs │ ├── hVision-classifier.cabal │ └── src │ │ ├── Classifier.hs │ │ └── Classifier │ │ ├── Adaboost.hs │ │ ├── Base.hs │ │ ├── GP.hs │ │ ├── Kernel.hs │ │ ├── Neural.hs │ │ ├── Prepro.hs │ │ ├── Regression.hs │ │ ├── SVM.hs │ │ ├── Simple.hs │ │ ├── ToyProblems.hs │ │ └── Tree.hs ├── contours │ ├── CLK │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── hVision-CLK.cabal │ │ └── src │ │ │ └── Contours │ │ │ ├── CLK.hs │ │ │ ├── CLKP.hs │ │ │ └── Refine.hs │ ├── clipping │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── hclipping.cabal │ │ ├── src │ │ │ └── Contours │ │ │ │ ├── ClipRaw.hs │ │ │ │ ├── Clipping.hs │ │ │ │ └── Clipping │ │ │ │ ├── Doxyfile │ │ │ │ ├── clipping.c │ │ │ │ └── clipping.h │ │ └── test │ │ │ ├── .gitignore │ │ │ ├── Makefile │ │ │ ├── clipping.hs │ │ │ ├── delta.hs │ │ │ ├── test.hs │ │ │ ├── test2.hs │ │ │ ├── test4.hs │ │ │ └── xor.hs │ ├── contours │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── hVision-contours.cabal │ │ └── src │ │ │ ├── Contours.hs │ │ │ └── Contours │ │ │ ├── Base.hs │ │ │ ├── Fourier.hs │ │ │ ├── GNS.hs │ │ │ ├── Matching.hs │ │ │ ├── Normalization.hs │ │ │ ├── Orientation.hs │ │ │ ├── Reduction.hs │ │ │ └── Resample.hs │ └── hcontours │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── hcontours.cabal │ │ └── src │ │ └── ImagProc │ │ └── Contrib │ │ ├── Contours.hs │ │ └── Contours │ │ ├── Structs.hsc │ │ └── struct.h ├── contrib │ ├── examples │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── hVision-contrib.cabal │ │ └── src │ │ │ └── ImagProc │ │ │ └── Contrib │ │ │ ├── Examples.hs │ │ │ └── Examples │ │ │ └── examples.c │ ├── export │ │ ├── .gitignore │ │ ├── CLK │ │ │ ├── HTools.hs │ │ │ ├── test.c │ │ │ └── test.hs │ │ ├── example │ │ │ ├── HTools.hs │ │ │ ├── test.c │ │ │ └── test.hs │ │ ├── generate │ │ ├── imag │ │ │ ├── HTools.hs │ │ │ ├── data.txt │ │ │ ├── test.c │ │ │ └── test.hs │ │ └── poly │ │ │ ├── HTools.hs │ │ │ ├── README │ │ │ ├── test.c │ │ │ └── test.hs │ ├── gpu │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── dso_handle.c │ │ ├── imagproc-gpu.cabal │ │ └── src │ │ │ └── ImagProc │ │ │ └── GPU │ │ │ ├── SIFT.hs │ │ │ └── SIFT │ │ │ ├── SiftGPU.cpp │ │ │ └── SiftGPU.h │ ├── models3ds │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── models3ds.cabal │ │ └── src │ │ │ └── EasyVision │ │ │ └── GUI │ │ │ ├── C │ │ │ └── model3ds.c │ │ │ └── Model3DS.hs │ ├── tesseract │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── examples │ │ │ ├── .gitignore │ │ │ └── ocr.hs │ │ ├── htesseract.cabal │ │ └── src │ │ │ └── ImagProc │ │ │ └── Contrib │ │ │ └── Tesseract.hs │ └── zbar │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── contrib.cabal │ │ ├── examples │ │ ├── .gitignore │ │ ├── demo.sh │ │ ├── zbar.hs │ │ └── zbar2.hs │ │ └── src │ │ └── ImagProc │ │ └── Contrib │ │ ├── ZBar.hs │ │ ├── ZBar │ │ ├── Structs.hsc │ │ └── zbar.c │ │ └── wrappers.h ├── geometry │ ├── LICENSE │ ├── Setup.lhs │ ├── hVision-geometry.cabal │ └── src │ │ ├── Vision.hs │ │ └── Vision │ │ ├── Autofrontal.hs │ │ ├── Bootstrap.hs │ │ ├── Camera.hs │ │ ├── Epipolar.hs │ │ ├── Gea.hs │ │ ├── IO.hs │ │ ├── Ippe.hs │ │ ├── LASBA.hs │ │ ├── Multiview.hs │ │ ├── Stereo.hs │ │ ├── TensorRep.hs │ │ ├── Tensorial.hs │ │ └── Types.hs ├── gui │ ├── LICENSE │ ├── Setup.lhs │ ├── hVision-gui.cabal │ └── src │ │ └── Vision │ │ └── GUI │ │ ├── Arrow.hs │ │ ├── Draw.hs │ │ ├── Interface.hs │ │ ├── Objects.hs │ │ ├── Parameters.hs │ │ ├── ScatterPlot.hs │ │ ├── Simple.hs │ │ ├── Source.hs │ │ ├── Trackball.hs │ │ ├── Types.hs │ │ └── Util.hs ├── hvision │ ├── LICENSE │ ├── Setup.lhs │ ├── hVision.cabal │ └── src │ │ ├── Contours │ │ └── Polygons.hs │ │ ├── Image │ │ ├── Processing.hs │ │ └── Processing │ │ │ ├── Contour.hs │ │ │ ├── Generic.hs │ │ │ ├── Moments.hs │ │ │ └── Tools.hs │ │ └── Vision │ │ ├── Apps │ │ ├── ShCamera.hs │ │ └── Show.hs │ │ └── GUI.hs ├── ip │ ├── custom │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── hVision-custom.cabal │ │ └── src │ │ │ └── Image │ │ │ └── Processing │ │ │ ├── Custom.hs │ │ │ ├── Simple.hs │ │ │ ├── custom.c │ │ │ └── simple.c │ ├── ipp │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── hVision-ipp.cabal │ │ └── src │ │ │ └── Image │ │ │ └── Processing │ │ │ ├── IPP.hs │ │ │ └── IPP │ │ │ ├── AdHoc.hs │ │ │ ├── Adapt.hs │ │ │ ├── Auto.hs │ │ │ ├── AutoGen.hs │ │ │ ├── Core.hs │ │ │ ├── Parser.hs │ │ │ ├── Pure.hs │ │ │ ├── Structs.hsc │ │ │ ├── Wrappers.hs │ │ │ ├── adapter.hs │ │ │ ├── auxIpp.c │ │ │ ├── functions.txt │ │ │ ├── ptr_adapt.c │ │ │ └── ptr_adapt.h │ ├── ippicv │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── hVision-ippicv.cabal │ │ └── src │ │ │ └── Image │ │ │ └── Processing │ │ │ ├── IPP │ │ │ ├── AdHoc.hs │ │ │ ├── Adapt.hs │ │ │ ├── Auto.hs │ │ │ ├── AutoGen.hs │ │ │ ├── Core.hs │ │ │ ├── Parser.hs │ │ │ ├── Pure.hs │ │ │ ├── Structs.hsc │ │ │ ├── Wrappers.hs │ │ │ ├── adapter.hs │ │ │ ├── auxIpp.c │ │ │ ├── functions.txt │ │ │ ├── ptr_adapt.c │ │ │ └── ptr_adapt.h │ │ │ └── IPPICV.hs │ └── opencv │ │ ├── LICENSE │ │ ├── Setup.lhs │ │ ├── configure │ │ ├── configure.hs │ │ ├── hVision-opencv.cabal │ │ └── src │ │ ├── OpenCV.hs │ │ └── OpenCV │ │ ├── opencv1.c │ │ └── opencv2.cpp ├── lookforcabal.hs ├── lookforsource.hs ├── tools │ ├── LICENSE │ ├── Setup.lhs │ ├── artools.cabal │ └── src │ │ ├── Graphics │ │ └── SVG.hs │ │ ├── Util │ │ ├── Debug.hs │ │ ├── Misc.hs │ │ ├── Options.hs │ │ ├── Replace.hs │ │ ├── Statistics.hs │ │ ├── Text.hs │ │ ├── Time.hs │ │ └── oldText.hs │ │ └── tools │ │ ├── hextract.hs │ │ ├── hreplace.hs │ │ ├── hsplice.hs │ │ └── mkwb.hs └── uploadlocal.hs └── projects ├── Makefile ├── Makefile.include ├── examples ├── Makefile ├── cameracontrol.hs ├── chroma.hs ├── chroma2.hs ├── color.hs ├── crosscorr.hs ├── domain.hs ├── frames.hs ├── glyph.hs ├── gradient.hs ├── grid.hs ├── hessharr.hs ├── imagproc.hs ├── ippicv.hs ├── keypoints.hs ├── match2d.hs ├── mineig.hs ├── mirror.hs ├── otsu.hs ├── pose.hs ├── ransac.hs ├── resize.hs ├── spline.hs ├── st.hs ├── trail.hs ├── trazo.hs ├── twist.hs ├── warp.hs └── zcontours.hs ├── gpu ├── .gitignore ├── Makefile ├── classify.hs ├── match.hs ├── siftgpu.hs ├── track.hs └── track2.hs ├── help ├── HEADER ├── HIGHLIGHT ├── LINKS ├── MATHJAX ├── Makefile ├── click_points.md ├── ev-styles.css ├── examples.md ├── gui.md ├── help.md ├── helponhelp.md ├── icon.png ├── options.md ├── styles.css └── tutorial.md ├── old ├── classify │ ├── Makefile │ ├── README │ ├── cards.hs │ ├── catalog.hs │ ├── classifier.hs │ ├── ipclassifier.hs │ ├── lbpclassifier.hs │ ├── roiclass.hs │ └── roisel.hs ├── contours │ └── Makefile ├── gea │ ├── Makefile │ ├── dense.hs │ ├── gea.hs │ └── lieTest.hs ├── gpu │ ├── Makefile │ ├── README │ ├── matches-sift.hs │ ├── sift-classify.hs │ └── siftgpu.hs ├── lkt │ ├── Makefile │ ├── lkt.hs │ ├── lkt2.hs │ ├── lkt3.hs │ └── moments.hs ├── pano │ ├── Makefile │ ├── README │ ├── autopano.hs │ ├── single.hs │ └── twocams.hs ├── patrec │ └── ica.hs ├── pose │ ├── Makefile │ ├── README │ ├── dynamic.hs │ ├── ellipses.hs │ ├── ellipses2.hs │ ├── frontal.hs │ ├── multipose.hs │ ├── multiposenew-0.hs │ ├── multiposenew-1.hs │ ├── multiposenew.hs │ ├── newdynamic.hs │ ├── onlyRects.hs │ ├── pose.hs │ ├── poseTracker.hs │ ├── rectangles.hs │ ├── rightAngles.hs │ ├── virtual.hs │ └── whiteboard.hs ├── simple │ ├── Makefile │ ├── README │ ├── background.hs │ ├── capture.hs │ ├── corners0.hs │ ├── detect.hs │ ├── dethessian.hs │ ├── emph.hs │ ├── face.hs │ ├── fft.hs │ ├── harris.hs │ ├── histUV.hs │ ├── interpolate.hs │ ├── matches.hs │ ├── mser.hs │ ├── multicam.hs │ ├── multisave.hs │ ├── ocr.hs │ ├── olddemo.hs │ ├── pseudocolor.hs │ ├── record-old.hs │ ├── record.hs │ ├── rectify.hs │ ├── roiprof.hs │ ├── salience.hs │ ├── static.hs │ ├── virtual.hs │ └── zoom.hs ├── stereo │ ├── Makefile │ ├── README │ ├── autostereo.hs │ ├── demostereo.hs │ ├── multiview.hs │ ├── stereo.hs │ └── vergence.hs ├── synth │ ├── 5points.hs │ ├── Makefile │ ├── capturepoly.hs │ ├── lissajous.hs │ └── synthshape.hs ├── tracks │ ├── Makefile │ ├── corners.hs │ ├── epipolar.hs │ ├── newtracks.hs │ ├── notracks.hs │ ├── notracks2.hs │ ├── tracks.hs │ └── tracksold.hs ├── tutorial │ ├── Makefile │ ├── README │ ├── Util.hs │ ├── canny.hs │ ├── combi0.hs │ ├── combi1.hs │ ├── combi2.hs │ ├── combi3.hs │ ├── combi4.hs │ ├── conc-par.hs │ ├── conc0.hs │ ├── conc1.hs │ ├── offline.hs │ ├── offline0.hs │ ├── offline3.hs │ ├── parallel.hs │ ├── param1.hs │ ├── param1a.hs │ ├── param2.hs │ ├── param2a.hs │ ├── param2a2.hs │ ├── param3.hs │ ├── param4.hs │ ├── pipeline.hs │ ├── play.hs │ ├── play2.hs │ ├── play3.hs │ ├── playll.hs │ ├── points.hs │ ├── pose.hs │ ├── roi1.hs │ ├── roibrowse.hs │ ├── roiclass.hs │ ├── roisel.hs │ ├── simple.hs │ ├── state.hs │ ├── state2.hs │ ├── state3.hs │ └── zip.hs └── vision │ ├── Makefile │ ├── icacont.hs │ ├── multilin.hs │ └── stereo.hs ├── opencv ├── Makefile ├── blur.hs ├── face.hs ├── homography.hs ├── hough.hs ├── surf.hs ├── testwebcam.hs ├── undistort.hs └── warp.hs ├── other ├── Makefile ├── bezier.hs ├── cinematic.hs ├── koch3.hs ├── lander.hs └── minkowski.hs ├── patrec ├── .gitignore ├── Makefile ├── bayesgauss.hs ├── cs.hs ├── democlass.hs ├── demotest.hs ├── em.hs ├── ferns.hs ├── gptest.hs ├── graph.hs ├── median.hs ├── mnist.hs ├── pls.hs ├── probability.hs ├── scatters.hs ├── seecov.hs ├── seemix.hs └── ukf.hs ├── tour ├── .gitignore ├── Makefile ├── arrIO.hs ├── arrows.hs ├── batch.hs ├── batch2.hs ├── chanShow.hs ├── choice.hs ├── circuit.hs ├── clickPoints.hs ├── connect.hs ├── draw.hs ├── draw3DParam.hs ├── drawParam.hs ├── fast-slow.hs ├── grid.hs ├── hello.hs ├── interactive3D.hs ├── interface.hs ├── loop.hs ├── matrix.hs ├── nocircuit.hs ├── nogui.hs ├── param2.hs ├── param3.hs ├── passROI.hs ├── play.hs ├── play0.hs ├── play1.hs ├── play3.hs ├── play4.hs ├── play5.hs ├── play6.hs ├── playgray.hs ├── runS.hs ├── runmode0.hs ├── runmode00.hs ├── runmode01.hs ├── runmode02.hs ├── runmode03.hs ├── runmode04.hs ├── runmode05.hs ├── runmode06.hs ├── runmode1.hs ├── runmode2.hs ├── runmode3.hs ├── runmode4.hs ├── scanl1.hs ├── single.hs ├── skip.hs ├── smon.hs ├── stand1.hs ├── stand2.hs ├── stand3.hs ├── testwebcam.hs └── work.hs └── vision ├── geom ├── .gitignore ├── Makefile ├── conic.hs ├── crossratio.hs ├── horizon.hs ├── horizon2.hs ├── linemodels.hs ├── multiview.hs ├── pcon.txt ├── pcube28l.txt ├── pcube28r.txt ├── pcube37.txt ├── pl.txt ├── plain2d.txt ├── pr.txt ├── pts2d.txt ├── pts3d.txt ├── rectify.hs ├── ref3d.txt ├── resection.hs ├── resection2.hs ├── resection4.hs ├── stereo.hs └── synthcam.hs └── multiview ├── .gitignore ├── Makefile ├── Util └── ShowReco.hs └── geademo.hs /.gitignore: -------------------------------------------------------------------------------- 1 | _darcs 2 | push.sh 3 | index.html 4 | QuickList.txt 5 | dist 6 | *.buildinfo 7 | *.o 8 | *.hi 9 | misc 10 | experiments 11 | findFiles.sh 12 | data 13 | packages/devel 14 | packages/newdevel 15 | projects/examples/tests 16 | lib/ippicv_lnx 17 | 18 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | cd packages; make 3 | cd packages; make optional 4 | cd projects; make 5 | 6 | -------------------------------------------------------------------------------- /cameras.def: -------------------------------------------------------------------------------- 1 | logitech uvc0 --live 2 | webcam0 tv:// -tv driver=v4l2:device=/dev/video0:fps=25 --live 3 | webcam1 tv:// -tv driver=v4l2:device=/dev/video1:fps=25 --live 4 | webcam2 tv:// -tv driver=v4l2:device=/dev/video2:fps=25 --live 5 | webcam3 tv:// -tv driver=v4l2:device=/dev/video3:fps=25 --live 6 | webcam4 tv:// -tv driver=v4l2:device=/dev/video4:fps=25 --live 7 | webcam5 tv:// -tv driver=v4l2:device=/dev/video5:fps=25 --live 8 | 9 | firewire /dev/dv1394 -demuxer rawdv -cache 400 10 | s-video-di tv:// -tv driver=v4l2:device=/dev/video0 -vf pp=md 11 | 12 | -------------------------------------------------------------------------------- /data/dense/README: -------------------------------------------------------------------------------- 1 | datasets with the format in http://grail.cs.washington.edu/projects/mview/ 2 | 3 | -------------------------------------------------------------------------------- /data/images/barcode/barcode.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/barcode/barcode.jpg -------------------------------------------------------------------------------- /data/images/calibration/cal1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cal1.jpg -------------------------------------------------------------------------------- /data/images/calibration/cal2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cal2.jpg -------------------------------------------------------------------------------- /data/images/calibration/cal3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cal3.jpg -------------------------------------------------------------------------------- /data/images/calibration/cal4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cal4.jpg -------------------------------------------------------------------------------- /data/images/calibration/cube1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cube1.png -------------------------------------------------------------------------------- /data/images/calibration/cube2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cube2.png -------------------------------------------------------------------------------- /data/images/calibration/cube3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cube3.png -------------------------------------------------------------------------------- /data/images/calibration/cube4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/cube4.png -------------------------------------------------------------------------------- /data/images/calibration/disk1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/disk1.jpg -------------------------------------------------------------------------------- /data/images/calibration/disk2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/calibration/disk2.jpg -------------------------------------------------------------------------------- /data/images/pano/pano000.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano000.jpg -------------------------------------------------------------------------------- /data/images/pano/pano001.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano001.jpg -------------------------------------------------------------------------------- /data/images/pano/pano002.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano002.jpg -------------------------------------------------------------------------------- /data/images/pano/pano003.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano003.jpg -------------------------------------------------------------------------------- /data/images/pano/pano004.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano004.jpg -------------------------------------------------------------------------------- /data/images/pano/pano005.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano005.jpg -------------------------------------------------------------------------------- /data/images/pano/pano006.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano006.jpg -------------------------------------------------------------------------------- /data/images/pano/pano007.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/pano/pano007.jpg -------------------------------------------------------------------------------- /data/images/transi/.gitignore: -------------------------------------------------------------------------------- 1 | video.y4m 2 | 3 | -------------------------------------------------------------------------------- /data/images/transi/dscn2070.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/transi/dscn2070.jpg -------------------------------------------------------------------------------- /data/images/transi/dscn2479.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/transi/dscn2479.jpg -------------------------------------------------------------------------------- /data/images/transi/dscn2511.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/images/transi/dscn2511.jpg -------------------------------------------------------------------------------- /data/images/transi/regions.txt: -------------------------------------------------------------------------------- 1 | [("dscn2511.jpg",((Point {px = -0.39375, py = -0.325},Point {px = 0.28624999999999995, py = 0.185}),(Point {px = -0.6149999999999999, py = -0.44499999999999995},Point {px = 0.8749999999999999, py = 0.6725}))),("dscn2479.jpg",((Point {px = 0.18375000000000002, py = 9.499999999999997e-2},Point {px = 0.56375, py = 0.38}),(Point {px = -0.9333333333333333, py = -0.6950000000000001},Point {px = 0.8433333333333333, py = 0.6375}))),("dscn2070.jpg",((Point {px = 0.4387500000000001, py = -0.17750000000000005},Point {px = 0.9087500000000001, py = 0.175}),(Point {px = -0.93625, py = -0.53},Point {px = 0.32375, py = 0.41500000000000004})))] -------------------------------------------------------------------------------- /data/models3ds/STS.3ds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/models3ds/STS.3ds -------------------------------------------------------------------------------- /data/models3ds/lunarlandernofoil_carbajal.3ds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/models3ds/lunarlandernofoil_carbajal.3ds -------------------------------------------------------------------------------- /data/shapes/digits1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/digits1.png -------------------------------------------------------------------------------- /data/shapes/digits2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/digits2.png -------------------------------------------------------------------------------- /data/shapes/digits3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/digits3.png -------------------------------------------------------------------------------- /data/shapes/digits4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/digits4.png -------------------------------------------------------------------------------- /data/shapes/digits5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/digits5.png -------------------------------------------------------------------------------- /data/shapes/letters.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/letters.png -------------------------------------------------------------------------------- /data/shapes/letters1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/letters1.png -------------------------------------------------------------------------------- /data/shapes/letters2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/shapes/letters2.png -------------------------------------------------------------------------------- /data/shapes/squares.txt: -------------------------------------------------------------------------------- 1 | [(Closed {polyPts = [Point {px = 0.0, py = 0.0},Point {px = 1.0, py = 0.0},Point {px = 1.0, py = 1.0},Point {px = 0.0, py = 1.0}]},"."),(Closed {polyPts = [Point {px = 0.0, py = 0.0},Point {px = 2.0, py = 0.0},Point {px = 2.0, py = 1.0},Point {px = 0.0, py = 1.0}]},":"),(Closed {polyPts = [Point {px = 0.0, py = 0.0},Point {px = 3.0, py = 0.0},Point {px = 3.0, py = 1.0},Point {px = 0.0, py = 1.0}]},"!"),(Closed {polyPts = [Point {px = 2.0, py = 0.0},Point {px = 2.0, py = 1.0},Point {px = 1.0, py = 1.0},Point {px = 1.0, py = 2.0},Point {px = 0.0, py = 2.0},Point {px = 0.0, py = 0.0}]},">")] 2 | 3 | -------------------------------------------------------------------------------- /data/tracks/dinosaur/calib.txt: -------------------------------------------------------------------------------- 1 | -3217.328669 78.606641 289.867240 2 | 0.000000 -2292.424144 -1070.516235 3 | 0.000000 0.000000 1.000000 4 | -------------------------------------------------------------------------------- /data/tracks/maquette/calib.txt: -------------------------------------------------------------------------------- 1 | 851.57945 0.0 330.24755 2 | 0.0 853.01905 262.19500 3 | 0.0 0.0 1.0 4 | -------------------------------------------------------------------------------- /data/videos/chaos.avi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/videos/chaos.avi -------------------------------------------------------------------------------- /data/videos/digits.avi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/videos/digits.avi -------------------------------------------------------------------------------- /data/videos/rcube.avi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/videos/rcube.avi -------------------------------------------------------------------------------- /data/videos/rot4.avi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/data/videos/rot4.avi -------------------------------------------------------------------------------- /lib/lib32/libcontours.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib32/libcontours.so -------------------------------------------------------------------------------- /lib/lib32/libcudart.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib32/libcudart.so -------------------------------------------------------------------------------- /lib/lib32/libcudart.so.2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib32/libcudart.so.2 -------------------------------------------------------------------------------- /lib/lib32/libsiftgpu.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib32/libsiftgpu.so -------------------------------------------------------------------------------- /lib/lib64/libcontours.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib64/libcontours.so -------------------------------------------------------------------------------- /lib/lib64/libcudart.so: -------------------------------------------------------------------------------- 1 | libcudart.so.4 -------------------------------------------------------------------------------- /lib/lib64/libcudart.so.4: -------------------------------------------------------------------------------- 1 | libcudart.so.4.0.17 -------------------------------------------------------------------------------- /lib/lib64/libcudart.so.4.0.17: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib64/libcudart.so.4.0.17 -------------------------------------------------------------------------------- /lib/lib64/libsiftgpu.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/lib/lib64/libsiftgpu.so -------------------------------------------------------------------------------- /packages/Makefile: -------------------------------------------------------------------------------- 1 | IPPICV='http://sourceforge.net/projects/opencvlibrary/files/3rdparty/ippicv/ippicv_linux_20141027.tgz' 2 | 3 | pkgs=tools base gui geometry classifier contours/contours ip/custom contrib/examples ip/opencv contours/clipping contours/hcontours contours/CLK ip/ippicv ip/ipp hvision devel 4 | 5 | getippicv: 6 | if [ ! -e ../lib/ippicv_lnx ]; then \ 7 | cd ../lib; \ 8 | wget $(IPPICV); \ 9 | tar xzvf ippicv_linux_20141027.tgz; \ 10 | rm ippicv_linux_20141027.tgz; \ 11 | fi 12 | 13 | 14 | selpkgs=contours/contours contours/clipping contours/hcontours contours/CLK 15 | 16 | cabalcmd = \ 17 | for p in $(1); do \ 18 | if [ -e $$p ]; then \ 19 | cd $$p; cabal $(2) ; cd -; \ 20 | fi; \ 21 | done 22 | 23 | all: 24 | $(call cabalcmd, $(pkgs), install --force-reinstall --enable-documentation) 25 | 26 | selected: 27 | $(call cabalcmd, $(selpkgs), install --force-reinstall) 28 | 29 | fast: 30 | $(call cabalcmd, $(pkgs), install --force-reinstall) 31 | 32 | clean: 33 | $(call cabalcmd, $(pkgs), clean) 34 | 35 | -------------------------------------------------------------------------------- /packages/base/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/base/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/base/src/Image.hs: -------------------------------------------------------------------------------- 1 | module Image ( 2 | Image(), Size(..), ROI(..), Pixel(..), Point(..), 3 | I8u, I8u3, I32f, Word24(..), 4 | Gray, RGB, Channels(..), 5 | size, roi, modifyROI, setROI, 6 | saveImage, loadRGB, 7 | img2mat, mat2img, 8 | ) where 9 | 10 | import Image.Core 11 | import Image.Convert 12 | import Util.Geometry(Point(..)) 13 | 14 | data Channels = CHIm 15 | { yuv :: ImageYUV 16 | , yCh :: Image I8u 17 | , uCh :: Image I8u 18 | , vCh :: Image I8u 19 | , rgb :: Image Word24 20 | , rCh :: Image I8u 21 | , gCh :: Image I8u 22 | , bCh :: Image I8u 23 | , hsv :: Image Word24 24 | , hCh :: Image I8u 25 | , sCh :: Image I8u 26 | , fCh :: Image Float 27 | } 28 | 29 | -------------------------------------------------------------------------------- /packages/base/src/Util/Audio.hs: -------------------------------------------------------------------------------- 1 | module Util.Audio( 2 | loadAudio, 3 | savePlayAudio 4 | ) where 5 | 6 | import Numeric.LinearAlgebra 7 | import System.Process(system) 8 | 9 | -- | load an audio file (currently using sox, TO DO: read sample rate) 10 | loadAudio :: FilePath -> IO (Matrix Double) 11 | loadAudio fpath = do 12 | let f = fpath ++ ".txt" 13 | _ <- system $ "sox "++fpath ++" -t dat - | sed '/;/d' - > "++f 14 | r <- loadMatrix f 15 | _ <- system $ "rm " ++ f 16 | return r 17 | 18 | -- | save a matrix to an audio file and play it (using sox's play) 19 | savePlayAudio :: Int -> Matrix Double -> FilePath -> IO () 20 | savePlayAudio rate m fpath = do 21 | saveMatrix fpath "%f" m 22 | _ <- system $ "play -r "++show rate++" -v 0.5 "++fpath 23 | return () 24 | 25 | -------------------------------------------------------------------------------- /packages/classifier/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/classifier/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/classifier/src/Classifier.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | {- | 3 | Module : Classifier 4 | Copyright : (c) Alberto Ruiz 2006-10 5 | License : GPL 6 | 7 | Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | Stability : provisional 9 | 10 | Algorithms for pattern recognition and machine learning. 11 | 12 | -} 13 | ----------------------------------------------------------------------------- 14 | 15 | module Classifier ( 16 | module Classifier.Base, 17 | module Classifier.Prepro, 18 | module Classifier.Simple, 19 | module Classifier.Kernel, 20 | module Classifier.Neural, 21 | module Classifier.Adaboost, 22 | module Classifier.Tree, 23 | module Classifier.SVM 24 | ) where 25 | 26 | import Classifier.Base 27 | import Classifier.Prepro 28 | import Classifier.Simple 29 | import Classifier.Kernel 30 | import Classifier.Neural 31 | import Classifier.Adaboost 32 | import Classifier.SVM 33 | import Classifier.Tree 34 | 35 | -------------------------------------------------------------------------------- /packages/contours/CLK/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/contours/CLK/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/contours/CLK/hVision-CLK.cabal: -------------------------------------------------------------------------------- 1 | Name: hVision-CLK 2 | Version: 0.1.0 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: contour alignment 10 | Description: 11 | contour alignment 12 | 13 | Category: Math 14 | 15 | cabal-version: >=1.2 16 | build-type: Simple 17 | 18 | extra-source-files: 19 | 20 | library 21 | Build-Depends: base, hVision-base, hVision-contours, hclipping, 22 | hmatrix, hVision-geometry, artools, hVision-opencv 23 | 24 | hs-source-dirs: src 25 | 26 | Exposed-modules: Contours.CLK 27 | Contours.CLKP 28 | Contours.Refine 29 | 30 | ghc-prof-options: -auto-all 31 | 32 | -- ghc-options: -Wall 33 | 34 | -------------------------------------------------------------------------------- /packages/contours/clipping/LICENSE: -------------------------------------------------------------------------------- 1 | GPL 2 | 3 | -------------------------------------------------------------------------------- /packages/contours/clipping/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /packages/contours/clipping/hclipping.cabal: -------------------------------------------------------------------------------- 1 | Name: hclipping 2 | Version: 0.1.0 3 | License: GPL 4 | License-file: LICENSE 5 | Author: PARP Research Group , University of Murcia, Spain. 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: http://perception.inf.um.es/easyVision/ 9 | Synopsis: polygon clipping 10 | Description: polygon clipping 11 | 12 | Category: Math 13 | tested-with: GHC ==6.10.4, GHC ==6.12.1, GHC ==7.4 14 | 15 | cabal-version: >=1.2 16 | build-type: Simple 17 | 18 | extra-source-files: src/Contours/Clipping/clipping.h 19 | 20 | extra-tmp-files: 21 | 22 | library 23 | Build-Depends: base >= 3 && < 5, hmatrix, hVision-base, hVision-contours, 24 | artools 25 | 26 | hs-source-dirs: src 27 | 28 | Exposed-modules: Contours.Clipping 29 | 30 | other-modules: Contours.ClipRaw 31 | 32 | c-sources: src/Contours/Clipping/clipping.c 33 | 34 | include-dirs: src/Contours/Clipping 35 | 36 | cc-options: -O4 -msse2 -Wall 37 | 38 | ghc-prof-options: -auto-all 39 | 40 | ghc-options: -Wall 41 | 42 | -------------------------------------------------------------------------------- /packages/contours/clipping/test/.gitignore: -------------------------------------------------------------------------------- 1 | clipping 2 | delta 3 | test 4 | test2 5 | xor 6 | 7 | -------------------------------------------------------------------------------- /packages/contours/clipping/test/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../../projects/Makefile.include 2 | 3 | demo: 4 | ./test2 5 | ./test 6 | ./xor 7 | ./clipping 8 | ./delta 9 | ./test4 10 | -------------------------------------------------------------------------------- /packages/contours/clipping/test/clipping.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import ImagProc 3 | import Contours 4 | import Vision 5 | import Contours.Clipping 6 | import Util.Misc(debug) 7 | import Text.Printf(printf) 8 | 9 | main = runIt win 10 | 11 | win = browser "clipping" xys sh 12 | where 13 | cs = map (pre) pentominos 14 | xys = zip cs (tail cs) 15 | sh k (a,b) = Draw [ color red a, color blue b, color yellow zs 16 | , color white $ map drp (a:b:zs) 17 | ] 18 | where 19 | zs = clip ClipIntersection a b 20 | 21 | pre = transPol (scaling 0.2) . whitenContour . fst 22 | 23 | drp ps = Draw $ map g (polyPts ps) 24 | where 25 | g p@(Point x y) = textF Helvetica10 p (printf "(%.2f, %.2f)" x y) 26 | 27 | -------------------------------------------------------------------------------- /packages/contours/clipping/test/test.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import ImagProc 3 | import Contours 4 | import Vision 5 | import Contours.Clipping 6 | 7 | main = runIt $ do 8 | win "union" ClipUnion 9 | win "intersection" ClipIntersection 10 | win "difference" ClipDifference 11 | 12 | win name mode = browser name xys sh 13 | where 14 | cs = map (pre) pentominos 15 | xys = zip cs (tail cs) 16 | sh k (a,b) = clearColor white 17 | [ lineWd 7 [ color lightblue a, color pink b ] 18 | , lineWd 2 [ color black zs ] 19 | ] 20 | where 21 | zs = clip mode a b 22 | 23 | pre = transPol (scaling 0.2) . whitenContour . fst 24 | 25 | -------------------------------------------------------------------------------- /packages/contours/clipping/test/test4.hs: -------------------------------------------------------------------------------- 1 | import Contours.Clipping 2 | import ImagProc.Base 3 | import Contours 4 | 5 | p = Closed [ Point {px = 0.15270079428773498, py = 0.43295977213554554} 6 | , Point{px = -0.18595359038634324, py = 0.43571411250556147} 7 | , Point {px = -0.18911816070477735, py = 0.2711387097388278} 8 | , Point {px = 0.15581365744346226, py = 0.2701204873503819} ] 9 | 10 | q = Closed [ Point {px = 0.15270079428773498, py = 0.4329597721355455} 11 | , Point {px = -0.18595359038634324, py = 0.43571411250556147} 12 | , Point {px = -0.18911816070477738, py = 0.2711387097388278} 13 | , Point {px = 0.15581365744346232, py = 0.2701204873503819} ] 14 | 15 | test = sum $ map area $ clip ClipIntersection p q 16 | 17 | main = print test 18 | -------------------------------------------------------------------------------- /packages/contours/clipping/test/xor.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import ImagProc 3 | import Contours 4 | import Vision 5 | import Contours.Clipping 6 | 7 | main = runIt win 8 | 9 | win = browser "clipping" xys sh 10 | where 11 | cs = map (pre) pentominos 12 | xys = zip cs (tail cs) 13 | sh k (a,b) = Draw [ color yellow zs , color blue ys ] 14 | where 15 | zs = clip ClipDifference a b 16 | ys = clip ClipDifference b a 17 | 18 | pre = transPol (scaling 0.2) . whitenContour . fst 19 | 20 | -------------------------------------------------------------------------------- /packages/contours/contours/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/contours/contours/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/contours/contours/hVision-contours.cabal: -------------------------------------------------------------------------------- 1 | Name: hVision-contours 2 | Version: 0.2.0 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: contour functions and shape matching 10 | Description: 11 | contour functions and shape matching 12 | 13 | Category: Math 14 | 15 | cabal-version: >=1.2 16 | build-type: Simple 17 | 18 | extra-source-files: 19 | 20 | library 21 | Build-Depends: base, 22 | hmatrix, hmatrix-gsl, 23 | hVision-base, artools 24 | 25 | hs-source-dirs: src 26 | 27 | Exposed-modules: Contours 28 | Contours.Base 29 | Contours.Normalization 30 | Contours.Fourier 31 | Contours.Orientation 32 | Contours.Matching 33 | Contours.Reduction 34 | Contours.Resample 35 | Other-modules: Contours.GNS 36 | 37 | ghc-prof-options: -auto-all 38 | 39 | -- ghc-options: -Wall 40 | 41 | -------------------------------------------------------------------------------- /packages/contours/contours/src/Contours.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | {- | 3 | Module : Contours 4 | Copyright : (c) Alberto Ruiz 2011 5 | License : GPL 6 | 7 | Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | Stability : very provisional 9 | 10 | Contour functions. 11 | 12 | -} 13 | ----------------------------------------------------------------------------- 14 | 15 | module Contours ( 16 | module Contours.Base, 17 | module Contours.Normalization, 18 | module Contours.Fourier, 19 | module Contours.Orientation, 20 | module Contours.Matching, 21 | module Contours.Reduction, 22 | module Contours.Resample 23 | ) where 24 | 25 | import Contours.Base 26 | import Contours.Normalization 27 | import Contours.Fourier 28 | import Contours.Orientation 29 | import Contours.Matching 30 | import Contours.Reduction 31 | import Contours.Resample 32 | 33 | -------------------------------------------------------------------------------- /packages/contours/contours/src/Contours/Resample.hs: -------------------------------------------------------------------------------- 1 | module Contours.Resample( 2 | resample) 3 | where 4 | 5 | import Contours.Base 6 | import Contours.Normalization(momentsContour) 7 | import Util.Geometry 8 | import Data.Maybe(catMaybes) 9 | import Data.Function(on) 10 | import Data.List(sortBy) 11 | import Util.Misc(rotateLeft) 12 | 13 | resample :: Int -> Polyline -> [Point] 14 | resample n c = take n $ splitDelta delta delta xs 15 | where 16 | s = zip [0..] (asSegments c) 17 | ((k, Segment p q), r) 18 | | null ints = (s!!0, Point x y) -- FIXME 19 | | otherwise = head ints 20 | ints = sortBy (compare `on` px) $ catMaybes (map (si (Segment (Point (x-100) y) (Point (100+x) y))) s) 21 | p1:p2:ps = rotateLeft k (polyPts c) 22 | pts = r:p2:ps++[p1,r] 23 | ss = asSegments (Closed pts) 24 | ds = map segmentLength ss 25 | xs = zip ss ds 26 | delta = perimeter c / fromIntegral n 27 | (x,y,_,_,_) = momentsContour (polyPts c) 28 | si a (k,b) = fmap ((,) (k,b)) (segmentIntersection' a b) 29 | px (_,Point x _) = x 30 | 31 | splitDelta dl delta ((Segment p q,l):xs) 32 | | l > dl = p : splitDelta delta delta ((Segment r q, l-dl) : xs) 33 | | otherwise = p: tail (splitDelta (dl-l) delta xs) 34 | where 35 | r = interPoint (dl/l) p q 36 | 37 | -------------------------------------------------------------------------------- /packages/contours/hcontours/LICENSE: -------------------------------------------------------------------------------- 1 | All rights reserved 2 | 3 | -------------------------------------------------------------------------------- /packages/contours/hcontours/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMainWithHooks autoconfUserHooks 5 | -------------------------------------------------------------------------------- /packages/contours/hcontours/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* 4 | 5 | -------------------------------------------------------------------------------- /packages/contours/hcontours/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import System.Environment(getEnv) 4 | 5 | import Distribution.System(buildArch,Arch(..)) 6 | 7 | arch = if buildArch == X86_64 then "/lib/lib64" else "/lib/lib32" 8 | 9 | main = do 10 | lib <- getEnv "EASYVISION" 11 | putStrLn $ "EASYVISION path: " ++ lib 12 | writeFile "hcontours.buildinfo" $ 13 | "extra-lib-dirs: " ++ lib ++ arch ++"\n" 14 | 15 | -------------------------------------------------------------------------------- /packages/contours/hcontours/hcontours.cabal: -------------------------------------------------------------------------------- 1 | Name: hcontours 2 | Version: 0.2.0 3 | License: AllRightsReserved 4 | License-file: LICENSE 5 | Author: PARP Research Group , University of Murcia, Spain. 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Synopsis: subpixel contour extraction 9 | Description: interface to optimized C implementation of subpixel contour extraction 10 | 11 | Category: Image Processing 12 | tested-with: GHC ==7.6.3 13 | 14 | cabal-version: >=1.2 15 | build-type: Custom 16 | 17 | 18 | extra-tmp-files: hcontours.buildinfo 19 | extra-source-files: configure configure.hs 20 | src/ImagProc/Contrib/Contours/struct.h 21 | 22 | library 23 | Build-Depends: base >= 3 && < 5, hmatrix, hVision-base, hVision-gui 24 | 25 | hs-source-dirs: src 26 | 27 | Exposed-modules: ImagProc.Contrib.Contours 28 | 29 | other-modules: ImagProc.Contrib.Contours.Structs 30 | 31 | ghc-prof-options: -auto-all 32 | 33 | ghc-options: -Wall 34 | 35 | extra-libraries: contours m 36 | include-dirs: src/ImagProc/Contrib/Contours 37 | 38 | -------------------------------------------------------------------------------- /packages/contours/hcontours/src/ImagProc/Contrib/Contours/struct.h: -------------------------------------------------------------------------------- 1 | typedef struct { 2 | /// Arrays for contours data (x coordinates). 3 | float *x; 4 | /// Arrays for contours data (y coordinates). 5 | float *y; 6 | /// Arrays for contours data (u coordinates). 7 | float *u; 8 | /// Arrays for contours data (v coordinates). 9 | float *v; 10 | /// Arrays for contours data (b threshold). 11 | char *b; 12 | /// Array of sizes for contours data. 13 | int *cs; 14 | /// Array of starting indexes for contours data. 15 | int *ccs; 16 | /// Total number of points of all contours. 17 | int pn; 18 | /// Total number of contours. 19 | int cn; 20 | } TContours; 21 | 22 | -------------------------------------------------------------------------------- /packages/contrib/examples/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2012 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/contrib/examples/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | 5 | > main = defaultMainWithHooks autoconfUserHooks 6 | 7 | -------------------------------------------------------------------------------- /packages/contrib/examples/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* -------------------------------------------------------------------------------- /packages/contrib/examples/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import Image.Devel(getInclude) 4 | 5 | main = do 6 | incdir <- getInclude 7 | writeFile "hVision-contrib.buildinfo" $ unlines 8 | [ incdir 9 | ] 10 | 11 | -------------------------------------------------------------------------------- /packages/contrib/examples/hVision-contrib.cabal: -------------------------------------------------------------------------------- 1 | Name: hVision-contrib 2 | Version: 0.3 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: additional low level image processing functions 10 | Description: additional low level image processing functions 11 | 12 | Category: Math 13 | tested-with: GHC ==7.6.3 14 | 15 | cabal-version: >=1.2 16 | build-type: Custom 17 | 18 | extra-source-files: configure configure.hs 19 | extra-tmp-files: hVision-contrib.buildinfo 20 | 21 | 22 | library 23 | Build-Depends: base >= 3 && < 5, hVision-base 24 | 25 | hs-source-dirs: src 26 | 27 | Exposed-modules: ImagProc.Contrib.Examples 28 | 29 | other-modules: 30 | 31 | c-sources: src/ImagProc/Contrib/Examples/examples.c 32 | 33 | cc-options: -O4 -msse2 34 | 35 | ghc-prof-options: -auto-all 36 | 37 | ghc-options: -Wall 38 | 39 | -------------------------------------------------------------------------------- /packages/contrib/examples/src/ImagProc/Contrib/Examples.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | ----------------------------------------------------------------------------- 3 | {- | 4 | Module : ImagProc.Contrib.Examples 5 | Copyright : (c) Alberto Ruiz 2012 6 | License : GPL 7 | 8 | Maintainer : Alberto Ruiz (aruiz at um dot es) 9 | Stability : provisional 10 | 11 | -} 12 | ----------------------------------------------------------------------------- 13 | 14 | module ImagProc.Contrib.Examples ( 15 | sumInC, invertInC 16 | ) 17 | where 18 | 19 | import Image.Devel 20 | import Foreign.Marshal ( malloc, free ) 21 | import Foreign.Storable ( Storable(peek) ) 22 | 23 | ---------------------------------------------------- 24 | 25 | foreign import ccall "customSum" 26 | c_customSum :: Ptr CInt -> RawImage I8u (IO CInt) 27 | 28 | sumInC :: Image I8u -> Int 29 | sumInC x = ti . unsafePerformIO $ do 30 | presult <- malloc 31 | withImage x $ do 32 | c_customSum presult `appI` x // checkFFI "sumInC" 33 | result <- peek presult 34 | free presult 35 | return result 36 | 37 | ------------------------------------------------ 38 | 39 | foreign import ccall "customInvert" 40 | c_customInvert :: RawImage I8u (RawImage I8u (IO CInt)) 41 | invertInC :: Image I8u -> Image I8u 42 | invertInC = wrap11 "invertInC" c_customInvert 43 | 44 | ---------------------------------------------------- 45 | 46 | -------------------------------------------------------------------------------- /packages/contrib/examples/src/ImagProc/Contrib/Examples/examples.c: -------------------------------------------------------------------------------- 1 | #include "wrappers.h" 2 | #include 3 | #include 4 | 5 | int customSum(int*result, IM1(src)) { 6 | int r,c; 7 | int sum = 0; 8 | TRAV(src,0,r,c) { 9 | sum += P(src,r,c); 10 | } 11 | *result = sum; 12 | return 0; 13 | } 14 | 15 | int customInvert(IM1(src), IM1(dst)) { 16 | int r,c; 17 | TRAV(src,0,r,c) { 18 | P(dst,r,c) = 255 - P(src,r,c); 19 | } 20 | return 0; 21 | } 22 | 23 | -------------------------------------------------------------------------------- /packages/contrib/export/.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | 3 | -------------------------------------------------------------------------------- /packages/contrib/export/CLK/test.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include "HTools_stub.h" 4 | 5 | typedef struct { double x; double y; } TPoint; 6 | 7 | int main(int argc, char *argv[]) { 8 | hs_init(&argc,&argv); 9 | 10 | // load test input 11 | int n1 = 5; 12 | TPoint proto[5] = {{0,0},{0.5,0},{1,0},{1,1},{0,1}}; 13 | 14 | int n2 = 4; 15 | TPoint target[4] = {{1.1,0.1},{1.1,0.9},{-0.1,0.9},{-0.1,0.1}}; 16 | 17 | // output 18 | int m; 19 | TPoint *res; 20 | double h[3][3]; 21 | 22 | hfun(n1,proto,n2,target,&m,&res,h); 23 | 24 | printf("%d\n", m); 25 | int k; 26 | for (k=0; k IO CInt 9 | hsfun x = do 10 | putStrLn "Hello World" 11 | return (42 + x) 12 | 13 | hf2 :: Double -> Double 14 | hf2 x = eigenvaluesSH m @> 0 15 | where 16 | m = (2><2) [ 1 , x 17 | , x , x**2] 18 | 19 | foreign export ccall hsfun :: CInt -> IO CInt 20 | foreign export ccall hf2 :: Double -> Double 21 | 22 | -------------------------------------------------------------------------------- /packages/contrib/export/example/test.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "HTools_stub.h" 3 | 4 | int main(int argc, char *argv[]) { 5 | hs_init(&argc,&argv); 6 | 7 | int r = hsfun(5); 8 | printf("hsFun = %d\n", r); 9 | 10 | int k; 11 | for (k=0; k<=5; k++) { 12 | double x = k; 13 | printf("hf2(%f)=%f\n",x,hf2(x)); 14 | } 15 | 16 | hs_exit(); 17 | return 0; 18 | } 19 | 20 | -------------------------------------------------------------------------------- /packages/contrib/export/example/test.hs: -------------------------------------------------------------------------------- 1 | import HTools 2 | 3 | main = do 4 | k <- hsfun 5 5 | print k 6 | print (map hf2 [0..5]) 7 | 8 | -------------------------------------------------------------------------------- /packages/contrib/export/generate: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | HOUT="testh" 4 | COUT="testc" 5 | 6 | rm -f $COUT $HOUT *.hi *.o *_stub.h 7 | 8 | echo "GHC=`ghc --print-libdir`" > Makefile 9 | # ghc --print-libdir 10 | 11 | echo "GHCV=\"ghc-`ghc --numeric-version`\"" >> Makefile 12 | 13 | echo "CABAL=$HOME/.cabal/lib" >> Makefile 14 | echo "GCC=gcc" >> Makefile 15 | TMP="/tmp/ghc-generate-$RANDOM" 16 | ghc --make -O -threaded test.hs -o $HOUT -v 2> $TMP 17 | CC=`grep "\-L.*-l" $TMP | sed "s/\/tmp[^ ]*//g" | sed "s/$HOUT/$COUT/" | tr -d \' | sed "s/-o\ $COUT/test.c\ -o\ $COUT/g"` 18 | CC="$CC "'-I$(GHC)/include' 19 | 20 | rm $TMP 21 | echo "all:" >> Makefile 22 | echo -e "\t$CC" >> Makefile 23 | 24 | echo "clean:" >> Makefile 25 | echo -e "\trm -f *.hi *.o *_stub.h $HOUT $COUT" >> Makefile 26 | -------------------------------------------------------------------------------- /packages/contrib/export/imag/data.txt: -------------------------------------------------------------------------------- 1 | 1 0 -1 2 | 0 1 0 3 | 0 0 1 4 | 5 | -------------------------------------------------------------------------------- /packages/contrib/export/imag/test.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include "HTools_stub.h" 4 | 5 | float sum8u(unsigned char * p, int r, int c) { 6 | float s = 0; int k; 7 | for (k = 0; k)) 6 | import System.Environment(getArgs) 7 | import ImagProc 8 | 9 | main = do 10 | img <- grayscale . channelsFromRGB <$> (loadRGB . head =<< getArgs) 11 | 12 | m <- funInit "data.txt" 13 | print (sum8u (fun m 0 img)) 14 | print (sum8u (fun m 1 img)) 15 | print (sum8u (fun m 2 img)) 16 | print (sum8u (fun m 3 img)) 17 | 18 | -------------------------------------------------------------------------------- /packages/contrib/export/poly/HTools.hs: -------------------------------------------------------------------------------- 1 | -- example of exporting a contour processing function to C 2 | 3 | {-# LANGUAGE ForeignFunctionInterface #-} 4 | 5 | module HTools(fun, hfun) where 6 | 7 | import Foreign.C.Types 8 | import Foreign.C.String 9 | import Foreign.Ptr(Ptr,castPtr) 10 | import Foreign.Storable 11 | import Foreign.Marshal.Array 12 | 13 | import Contours 14 | 15 | -------------------------------------------------------------------------------- 16 | 17 | type HFun = Int -> Polyline -> Polyline 18 | 19 | fun :: HFun 20 | fun n = Closed . resample n 21 | 22 | -------------------------------------------------------------------------------- 23 | 24 | type CFun 25 | = CInt 26 | -> CInt -> Ptr Point 27 | -> Ptr CInt -> Ptr (Ptr Point) 28 | -> IO Int 29 | 30 | cfun :: CFun 31 | cfun s n ps pm pps = do 32 | x <- peekArray (fromIntegral n) ps 33 | 34 | let y = fun (fromIntegral s) (Closed x) 35 | rps = polyPts y 36 | m = length rps 37 | 38 | poke pm (fromIntegral m) 39 | x <- newArray rps 40 | poke pps x 41 | return 0 42 | 43 | hfun = cfun 44 | foreign export ccall hfun :: CFun 45 | 46 | -------------------------------------------------------------------------------- /packages/contrib/export/poly/README: -------------------------------------------------------------------------------- 1 | ../generate 2 | make 3 | ./testc 4 | 5 | -------------------------------------------------------------------------------- /packages/contrib/export/poly/test.c: -------------------------------------------------------------------------------- 1 | // use Haskell to resample a polyline 2 | 3 | #include 4 | #include 5 | #include "HTools_stub.h" 6 | 7 | typedef struct { double x; double y; } TPoint; 8 | 9 | int main(int argc, char *argv[]) { 10 | hs_init(&argc,&argv); // haskell init 11 | 12 | // load test input 13 | int n = 4; 14 | TPoint cont[4] = {{0,0},{1,0},{1,1},{0,1}}; 15 | 16 | // output 17 | int m; 18 | TPoint *res; 19 | 20 | hfun(8,n,cont,&m,&res); 21 | 22 | //printf("%p\n",&m); 23 | //printf("%p\n",&res); 24 | 25 | printf("%d\n", m); 26 | 27 | int k; 28 | for (k=0; k import Distribution.Simple 4 | > main = defaultMainWithHooks autoconfUserHooks 5 | -------------------------------------------------------------------------------- /packages/contrib/gpu/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* -------------------------------------------------------------------------------- /packages/contrib/gpu/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import System.Environment(getEnv) 4 | 5 | import Distribution.System(buildArch,Arch(..)) 6 | 7 | arch = if buildArch == X86_64 then "/lib/lib64" else "/lib/lib32" 8 | 9 | main = do 10 | lib <- getEnv "EASYVISION" 11 | putStrLn $ "EASYVISION path: " ++ lib 12 | writeFile "imagproc-gpu.buildinfo" $ 13 | "extra-lib-dirs: " ++ lib ++ arch ++"\n" 14 | 15 | -------------------------------------------------------------------------------- /packages/contrib/gpu/dso_handle.c: -------------------------------------------------------------------------------- 1 | 2 | void* __dso_handle; 3 | -------------------------------------------------------------------------------- /packages/contrib/gpu/imagproc-gpu.cabal: -------------------------------------------------------------------------------- 1 | Name: imagproc-gpu 2 | Version: 0.2.0 3 | License: LGPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/hmatrix 9 | Synopsis: image processing functions using the GPU 10 | Description: 11 | image processing functions using the GPU and CUDA 12 | 13 | Category: Math 14 | tested-with: GHC ==7.4 15 | 16 | cabal-version: >=1.2 17 | build-type: Custom 18 | 19 | extra-source-files: src/ImagProc/GPU/SIFT/SiftGPU.h 20 | 21 | extra-tmp-files: imagproc-gpu.buildinfo 22 | 23 | library 24 | Build-Depends: base >= 3 && < 5, 25 | hmatrix >= 0.8.3, imagproc >= 0.1, 26 | ev-gui, GLUT, camera 27 | 28 | hs-source-dirs: src 29 | 30 | Exposed-modules: ImagProc.GPU.SIFT 31 | 32 | other-modules: 33 | 34 | c-sources: src/ImagProc/GPU/SIFT/SiftGPU.cpp 35 | 36 | cc-options: -O4 37 | 38 | ghc-prof-options: -auto-all 39 | 40 | ghc-options: -Wall -fno-warn-missing-signatures 41 | 42 | extra-libraries: siftgpu cudart Cg CgGL GLEW IL glut 43 | 44 | -------------------------------------------------------------------------------- /packages/contrib/models3ds/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/contrib/models3ds/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/contrib/models3ds/src/EasyVision/GUI/Model3DS.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | module EasyVision.GUI.Model3DS( 4 | loadModel, 5 | storeModel, 6 | render3ds, 7 | prepareModel 8 | ) where 9 | 10 | import Foreign.Ptr 11 | import Foreign.C.String 12 | import Control.Applicative((<$>)) 13 | 14 | newtype ModelFile = ModelFile { modelFile :: Ptr () } 15 | newtype ModelData = ModelData { modelData :: Ptr () } 16 | 17 | loadModel :: FilePath -> IO ModelFile 18 | loadModel name = withCString name (fmap ModelFile . load3ds_c) 19 | 20 | foreign import ccall "load3ds" load3ds_c :: CString -> IO (Ptr ()) 21 | 22 | storeModel :: ModelFile -> IO ModelData 23 | storeModel = fmap ModelData . store3ds_c . modelFile 24 | 25 | foreign import ccall "store3ds" store3ds_c :: Ptr () -> IO (Ptr()) 26 | 27 | render3ds :: ModelData -> IO () 28 | render3ds = render3ds_c . modelData 29 | 30 | foreign import ccall "renderit" render3ds_c :: Ptr () -> IO () 31 | 32 | prepareModel :: String -> IO (IO ()) 33 | prepareModel name = do 34 | m <- loadModel name >>= storeModel 35 | return (render3ds m) 36 | 37 | -------------------------------------------------------------------------------- /packages/contrib/tesseract/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2012 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/contrib/tesseract/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /packages/contrib/tesseract/examples/.gitignore: -------------------------------------------------------------------------------- 1 | ocr 2 | 3 | 4 | -------------------------------------------------------------------------------- /packages/contrib/tesseract/examples/ocr.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import ImagProc 3 | import ImagProc.Contrib.Tesseract 4 | import Contours.Base(setRegion) 5 | 6 | main = run $ arr grayscale >>> clickOCR 7 | 8 | clickOCR = clickKeep "OCR" f sh (Just "") 9 | where 10 | f roi x = tesseract (setRegion roi x) 11 | sh (x,s) = Draw [ Draw x, text (Point 0.9 0) s ] 12 | 13 | -------------------------------------------------------------------------------- /packages/contrib/tesseract/htesseract.cabal: -------------------------------------------------------------------------------- 1 | Name: htesseract 2 | Version: 0.1.0 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: simple wrapper to tesseract ocr 10 | Description: simple wrapper to tesseract ocr 11 | 12 | Category: Vision 13 | tested-with: GHC ==7.4 14 | 15 | cabal-version: >=1.2 16 | build-type: Simple 17 | 18 | flag redir 19 | description: redirect output using 2> instead of &> 20 | default: False 21 | 22 | library 23 | Build-Depends: base, imagproc, process, temporary, filepath, directory 24 | 25 | hs-source-dirs: src 26 | 27 | Exposed-modules: ImagProc.Contrib.Tesseract 28 | 29 | ghc-prof-options: -auto-all 30 | 31 | ghc-options: -Wall 32 | 33 | Extensions: CPP 34 | 35 | if flag(redir) 36 | cpp-options: -DREDIR 37 | 38 | -------------------------------------------------------------------------------- /packages/contrib/zbar/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2012 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/contrib/zbar/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /packages/contrib/zbar/contrib.cabal: -------------------------------------------------------------------------------- 1 | Name: hzbar 2 | Version: 0.1.0 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: http://perception.inf.um.es/easyVision/ 9 | Synopsis: simple wrapper to zbar barcode reader 10 | Description: simple wrapper to zbar barcode reader 11 | 12 | Category: Math 13 | tested-with: GHC ==6.10.4, GHC ==6.12.1, GHC ==7.4 14 | 15 | cabal-version: >=1.2 16 | build-type: Simple 17 | 18 | extra-source-files: src/ImagProc/Contrib/wrappers.h 19 | 20 | extra-tmp-files: 21 | 22 | library 23 | Build-Depends: base >= 3 && < 5, imagproc, prcv-util 24 | 25 | hs-source-dirs: src 26 | 27 | Exposed-modules: ImagProc.Contrib.ZBar 28 | 29 | other-modules: ImagProc.Contrib.ZBar.Structs 30 | 31 | c-sources: src/ImagProc/Contrib/ZBar/zbar.c 32 | 33 | include-dirs: src/ImagProc/Contrib 34 | 35 | extra-libraries: zbar 36 | 37 | cc-options: -O3 -msse2 38 | 39 | ghc-prof-options: -auto-all 40 | 41 | ghc-options: -Wall 42 | 43 | -------------------------------------------------------------------------------- /packages/contrib/zbar/examples/.gitignore: -------------------------------------------------------------------------------- 1 | zbar 2 | zbar2 3 | 4 | -------------------------------------------------------------------------------- /packages/contrib/zbar/examples/demo.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ./zbar --photos=../../../../data/images/barcode 4 | ./zbar2 `ls ../../../../data/images/barcode/*.jpg` 5 | 6 | -------------------------------------------------------------------------------- /packages/contrib/zbar/examples/zbar.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import ImagProc 3 | import ImagProc.Contrib.ZBar 4 | import Contours(roi2poly) 5 | 6 | main = run $ observe "zbar" (f.grayscale) 7 | 8 | f x = Draw [ Draw x, drawBarcodes (size x) (zbar x) ] 9 | where 10 | drawBarcodes sz = Draw . map (drBC sz) 11 | drBC sz bc = color blue [ Draw bb, text p (bcType bc ++ ": " ++ bcValue bc) ] 12 | where 13 | bb = roi2poly sz (bcROI bc) 14 | p = last (polyPts bb) 15 | 16 | -------------------------------------------------------------------------------- /packages/contrib/zbar/examples/zbar2.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI (runITrans) 2 | import Control.Arrow (arr) 3 | import ImagProc (grayscale) 4 | import ImagProc.Camera (readImages) 5 | import ImagProc.Contrib.ZBar (zbar, Barcode(..)) 6 | import System.Environment (getArgs) 7 | import Data.List (intercalate) 8 | 9 | main = getArgs >>= readImages >>= runITrans (arr f) >>= mapM_ putStrLn 10 | 11 | f = intercalate ", " . map g . zbar . grayscale 12 | where 13 | g bc = bcType bc ++ ": " ++ bcValue bc 14 | 15 | -------------------------------------------------------------------------------- /packages/contrib/zbar/src/ImagProc/Contrib/wrappers.h: -------------------------------------------------------------------------------- 1 | #define IMG(X) unsigned char * X##pSrc, int X##sstep, int X##sr1, int X##sr2, int X##sc1, int X##sc2 2 | #define IMF(X) float * X##pSrc, int X##sstep, int X##sr1, int X##sr2, int X##sc1, int X##sc2 3 | #define P(X,r,c) (*(X##pSrc+(r)*X##sstep+(c))) 4 | #define TRAV(X,D,r,c) for (r=X##sr1+D; r<=X##sr2-D; r++) for(c=X##sc1+D; c<=X##sc2-D; c++) 5 | #define MAX(a,b) ((a)>(b)?(a):(b)) 6 | #define MIN(a,b) ((a)<(b)?(a):(b)) 7 | 8 | typedef struct { 9 | const char * symbol_type; 10 | const char * symbol_value; 11 | int bbr1, bbr2, bbc1, bbc2; // bounding box 12 | } TBarcode; 13 | 14 | -------------------------------------------------------------------------------- /packages/geometry/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/geometry/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/geometry/src/Vision.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS #-} 2 | ----------------------------------------------------------------------------- 3 | {- | 4 | Module : Vision 5 | Copyright : (c) Alberto Ruiz 2006-10 6 | License : GPL 7 | 8 | Maintainer : Alberto Ruiz (aruiz at um dot es) 9 | Stability : provisional 10 | 11 | 12 | Algorithms for geometric computer vision. 13 | 14 | -} 15 | ----------------------------------------------------------------------------- 16 | 17 | module Vision ( 18 | module Util.Homogeneous, 19 | module Util.Geometry, 20 | module Util.Estimation, 21 | module Vision.Camera, 22 | module Vision.Stereo 23 | ) where 24 | 25 | import Util.Geometry(Point(..),HLine(..)) 26 | import Util.Homogeneous 27 | import Util.Estimation 28 | import Vision.Camera 29 | import Vision.Stereo 30 | 31 | -------------------------------------------------------------------------------- /packages/gui/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/gui/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/hvision/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2012 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/hvision/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/hvision/hVision.cabal: -------------------------------------------------------------------------------- 1 | Name: hVision 2 | Version: 0.3.0 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: hVision tools 10 | Description: 11 | hVision tools 12 | 13 | Category: Math 14 | 15 | cabal-version: >=1.2 16 | build-type: Simple 17 | 18 | extra-source-files: 19 | 20 | library 21 | Build-Depends: base >= 3 && < 5, 22 | hmatrix, hmatrix-gsl, 23 | hVision-base, hVision-contours, hVision-gui, hVision-ipp, 24 | hVision-geometry, hVision-custom, artools 25 | 26 | hs-source-dirs: src 27 | 28 | Exposed-modules: Image.Processing 29 | Vision.GUI 30 | Contours.Polygons 31 | 32 | other-modules: Vision.Apps.ShCamera 33 | Vision.Apps.Show 34 | Image.Processing.Generic 35 | Image.Processing.Tools 36 | Image.Processing.Moments 37 | Image.Processing.Contour 38 | 39 | 40 | ghc-prof-options: -auto-all 41 | 42 | ghc-options: -Wall 43 | 44 | -------------------------------------------------------------------------------- /packages/ip/custom/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2012 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/ip/custom/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | 5 | > main = defaultMainWithHooks autoconfUserHooks 6 | 7 | -------------------------------------------------------------------------------- /packages/ip/custom/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* -------------------------------------------------------------------------------- /packages/ip/custom/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import Image.Devel(getInclude) 4 | 5 | main = do 6 | incdir <- getInclude 7 | writeFile "hVision-custom.buildinfo" $ unlines 8 | [ incdir 9 | ] 10 | 11 | -------------------------------------------------------------------------------- /packages/ip/custom/hVision-custom.cabal: -------------------------------------------------------------------------------- 1 | Name: hVision-custom 2 | Version: 0.1 3 | License: GPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: additional low level image processing functions 10 | Description: additional low level image processing functions 11 | 12 | Category: Math 13 | tested-with: GHC ==7.6.3 14 | 15 | cabal-version: >=1.2 16 | build-type: Custom 17 | 18 | extra-source-files: configure configure.hs 19 | extra-tmp-files: hVision-custom.buildinfo 20 | 21 | 22 | library 23 | Build-Depends: base, hVision-base, hmatrix 24 | 25 | hs-source-dirs: src 26 | 27 | Exposed-modules: Image.Processing.Custom 28 | 29 | other-modules: Image.Processing.Simple 30 | 31 | c-sources: src/Image/Processing/custom.c 32 | src/Image/Processing/simple.c 33 | 34 | cc-options: -O4 -msse2 35 | 36 | ghc-prof-options: -auto-all 37 | 38 | ghc-options: -Wall 39 | 40 | -------------------------------------------------------------------------------- /packages/ip/custom/src/Image/Processing/custom.c: -------------------------------------------------------------------------------- 1 | #include "wrappers.h" 2 | #include 3 | #include 4 | 5 | 6 | int histogram3D(int n, int d, IM1(src), int vn, float*vp) { 7 | int r,c,k; 8 | int x,y,z; 9 | for (k=0;k> d; 13 | y = PM(src,r,c,1) >> d; 14 | z = PM(src,r,c,2) >> d; 15 | vp[x*n*n + y*n + z]++; 16 | } 17 | return 0; 18 | } 19 | 20 | //////////////////////////////////////////////////////////////////////////////// 21 | 22 | int domainTrans32f(float w2, IMF(x),IMF(y),IMF(a),IMF(res)) { 23 | int r,c,nr,nc; 24 | TRAV(res,0,r,c) { 25 | nr = r + (int)(0.5+w2*PF(y,r,c)); 26 | nc = c + (int)(0.5+w2*PF(x,r,c)); 27 | if (nr >= ar1 && nr <= ar2 && nc >= ac1 && nc <= ac2) { 28 | PF(res,r,c) = PF(a,nr,nc); 29 | } 30 | } 31 | return 0; 32 | } 33 | 34 | -------------------------------------------------------------------------------- /packages/ip/ipp/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/ip/ipp/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > import Distribution.Simple.PreProcess 5 | > import Distribution.Simple.LocalBuildInfo 6 | > import Distribution.PackageDescription 7 | > import Distribution.Simple.Utils 8 | 9 | > main = defaultMainWithHooks autoconfUserHooks 10 | -------------------------------------------------------------------------------- /packages/ip/ipp/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* -------------------------------------------------------------------------------- /packages/ip/ipp/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import System.Environment(getEnv) 4 | import Image.Devel(getInclude) 5 | 6 | main = do 7 | ipp_inc <- getEnv "IPP_INC" 8 | ipp_sha <- getEnv "IPP_SHARED" 9 | ipp_lib <- getEnv "IPP_LIBS" 10 | ipp_lnk <- getEnv "IPP_LINK" 11 | putStrLn ipp_sha 12 | incdir <- getInclude 13 | writeFile "hVision-ipp.buildinfo" $ unlines 14 | [ incdir 15 | , "include-dirs: " ++ipp_inc 16 | , "extra-lib-dirs: " ++ f ipp_sha 17 | , "extra-libraries: "++ipp_lib 18 | , "ld-options: " ++ipp_lnk 19 | ] 20 | 21 | f = map g 22 | 23 | g ':' = ' ' 24 | g x = x 25 | 26 | -------------------------------------------------------------------------------- /packages/ip/ipp/src/Image/Processing/IPP.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | {- | 3 | Module : Image.Processing.IPP 4 | Copyright : (c) Alberto Ruiz 2006-13 5 | License : GPL 6 | 7 | Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | Stability : provisional 9 | Portability : requires IPP 10 | 11 | -} 12 | ----------------------------------------------------------------------------- 13 | 14 | module Image.Processing.IPP ( 15 | module Image.Processing.IPP.Pure, 16 | module Image.Processing.IPP.AdHoc, 17 | module Image.Processing.IPP.Structs, 18 | ippSetNumThreads 19 | ) where 20 | 21 | import Image.Processing.IPP.Pure 22 | import Image.Processing.IPP.AdHoc 23 | import Image.Processing.IPP.Structs 24 | import Image.Processing.IPP.Wrappers(ippSetNumThreads) 25 | 26 | -------------------------------------------------------------------------------- /packages/ip/ippicv/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2015 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/ip/ippicv/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > import Distribution.Simple.PreProcess 5 | > import Distribution.Simple.LocalBuildInfo 6 | > import Distribution.PackageDescription 7 | > import Distribution.Simple.Utils 8 | 9 | > main = defaultMainWithHooks autoconfUserHooks 10 | -------------------------------------------------------------------------------- /packages/ip/ippicv/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* -------------------------------------------------------------------------------- /packages/ip/ippicv/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import System.Environment(getEnv) 4 | import Image.Devel(getInclude) 5 | import Distribution.System(buildArch,Arch(..)) 6 | 7 | arch = if buildArch == X86_64 then "intel64" else "ia32" 8 | 9 | main = do 10 | evroot <- getEnv "EASYVISION" 11 | putStrLn $ "EASYVISION path: " ++ evroot 12 | 13 | incdir <- getInclude 14 | writeFile "hVision-ippicv.buildinfo" $ unlines 15 | [ incdir 16 | , "include-dirs: " ++evroot++"/lib/ippicv_lnx/include" 17 | , "extra-lib-dirs: " ++evroot++"/lib/ippicv_lnx/lib/"++arch 18 | ] 19 | 20 | -------------------------------------------------------------------------------- /packages/ip/ippicv/src/Image/Processing/IPP/Adapt.hs: -------------------------------------------------------------------------------- 1 | -- generated automatically by adapter.hs 2 | 3 | {-# LANGUAGE ForeignFunctionInterface #-} 4 | 5 | module Image.Processing.IPP.Adapt where 6 | 7 | import Foreign 8 | import Foreign.C.Types 9 | import Image.Processing.IPP.Structs 10 | 11 | foreign import ccall "ippiCopy_8u_C1Rx" 12 | ippiCopy_8u_C1Rx :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> Ptr IppiSize -> IO CInt 13 | ippiCopy_8u_C1R pSrc srcStep pDst dstStep roiSize = do 14 | proiSize <- new roiSize 15 | r <- ippiCopy_8u_C1Rx pSrc srcStep pDst dstStep proiSize 16 | free proiSize 17 | return r 18 | 19 | foreign import ccall "ippiRGBToGray_8u_C3C1Rx" 20 | ippiRGBToGray_8u_C3C1Rx :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> Ptr IppiSize -> IO CInt 21 | ippiRGBToGray_8u_C3C1R pSrc srcStep pDst dstStep roiSize = do 22 | proiSize <- new roiSize 23 | r <- ippiRGBToGray_8u_C3C1Rx pSrc srcStep pDst dstStep proiSize 24 | free proiSize 25 | return r 26 | 27 | -------------------------------------------------------------------------------- /packages/ip/ippicv/src/Image/Processing/IPP/Auto.hs: -------------------------------------------------------------------------------- 1 | -- generated automatically by adapter.hs 2 | 3 | module Image.Processing.IPP.Auto where 4 | 5 | import Image.Processing.IPP.AutoGen 6 | import Image.Processing.IPP.Adapt 7 | 8 | -------- arity 0 ------------- 9 | 10 | -------- arity 1 ------------- 11 | 12 | {- | copy pixel values from the source image to the destination image 13 | 14 | -} 15 | ioCopy_8u_C1R = {-# SCC "ippiCopy_8u_C1R" #-} auto_1_8u_C1R f "ippiCopy_8u_C1R" 16 | where f pSrc srcStep pDst dstStep roiSize = ippiCopy_8u_C1R pSrc srcStep pDst dstStep roiSize 17 | 18 | {- | Converts an RGB image to gray scale (fixed coefficients) -} 19 | ioRGBToGray_8u_C3C1R = {-# SCC "ippiRGBToGray_8u_C3C1R" #-} auto_1_8u_C3C1R f "ippiRGBToGray_8u_C3C1R" 20 | where f pSrc srcStep pDst dstStep roiSize = ippiRGBToGray_8u_C3C1R pSrc srcStep pDst dstStep roiSize 21 | 22 | 23 | ------ arity 2 ------------- 24 | 25 | 26 | ------ inplace arity 2 ------ 27 | 28 | 29 | ---------------------------- 30 | -------------------------------------------------------------------------------- /packages/ip/ippicv/src/Image/Processing/IPP/functions.txt: -------------------------------------------------------------------------------- 1 | ipp.h ippiRGBToGray_8u_C3C1R 2 | ipp.h ippiCopy_32f_C1R 3 | ipp.h ippiCopy_8u_C1R 4 | 5 | -------------------------------------------------------------------------------- /packages/ip/ippicv/src/Image/Processing/IPP/ptr_adapt.c: -------------------------------------------------------------------------------- 1 | /* generated automatically by adapter.hs */ 2 | 3 | #include 4 | 5 | int ippiCopy_8u_C1Rx(Ipp8u* pSrc, int srcStep, Ipp8u* pDst, int dstStep, IppiSize* roiSize) { 6 | return ippiCopy_8u_C1R(pSrc, srcStep, pDst, dstStep, *roiSize); 7 | } 8 | 9 | int ippiRGBToGray_8u_C3C1Rx(Ipp8u* pSrc, int srcStep, Ipp8u* pDst, int dstStep, IppiSize* roiSize) { 10 | return ippiRGBToGray_8u_C3C1R(pSrc, srcStep, pDst, dstStep, *roiSize); 11 | } 12 | 13 | -------------------------------------------------------------------------------- /packages/ip/ippicv/src/Image/Processing/IPP/ptr_adapt.h: -------------------------------------------------------------------------------- 1 | /* generated automatically by adapter.hs */ 2 | 3 | int ippiCopy_8u_C1Rx(unsigned char*, int, unsigned char*, int, void*); 4 | int ippiRGBToGray_8u_C3C1Rx(unsigned char*, int, unsigned char*, int, void*); 5 | -------------------------------------------------------------------------------- /packages/ip/ippicv/src/Image/Processing/IPPICV.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | {- | 3 | Module : Image.Processing.IPPICV 4 | Copyright : (c) Alberto Ruiz 2015 5 | License : GPL 6 | 7 | Maintainer : Alberto Ruiz 8 | Stability : provisional 9 | Portability : requires IPPICV 10 | 11 | -} 12 | ----------------------------------------------------------------------------- 13 | 14 | module Image.Processing.IPPICV ( 15 | module Image.Processing.IPP.Pure, 16 | module Image.Processing.IPP.AdHoc, 17 | module Image.Processing.IPP.Structs 18 | ) where 19 | 20 | import Image.Processing.IPP.Pure 21 | import Image.Processing.IPP.AdHoc 22 | import Image.Processing.IPP.Structs 23 | 24 | -------------------------------------------------------------------------------- /packages/ip/opencv/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Alberto Ruiz 2010 2 | GPL license 3 | -------------------------------------------------------------------------------- /packages/ip/opencv/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | 5 | > main = defaultMainWithHooks autoconfUserHooks 6 | 7 | -------------------------------------------------------------------------------- /packages/ip/opencv/configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | runhaskell configure.hs $* -------------------------------------------------------------------------------- /packages/ip/opencv/configure.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import Image.Devel(getInclude) 4 | import System.Directory(doesFileExist) 5 | import Data.List(isPrefixOf) 6 | import System.Process 7 | 8 | main = do 9 | incdir <- getInclude 10 | (_,version,_) <- readProcessWithExitCode "pkg-config" ["opencv","--modversion"] "" 11 | putStrLn $ "opencv "++ version 12 | let ver = flip isPrefixOf version 13 | let def = if ver "3" 14 | then [ "cc-options: -DOPENCV3" 15 | , "include-dirs: /usr/local/include /usr/local/include/opencv" 16 | , "extra-lib-dirs: /usr/local/lib" 17 | , "extra-libraries: opencv_core opencv_calib3d opencv_imgproc opencv_video opencv_objdetect opencv_videoio opencv_highgui" 18 | ] 19 | else if ver "2.4" 20 | then [ "cc-options: -DOPENCV24" 21 | , "pkgconfig-depends: opencv" 22 | ] 23 | else ["pkgconfig-depends: opencv" 24 | ] 25 | writeFile "hVision-opencv.buildinfo" $ unlines $ def ++ [ incdir ] 26 | 27 | -------------------------------------------------------------------------------- /packages/ip/opencv/hVision-opencv.cabal: -------------------------------------------------------------------------------- 1 | Name: hVision-opencv 2 | Version: 0.2.0 3 | License: LGPL 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/easyVision 9 | Synopsis: interface to selected opencv functions 10 | 11 | Description: interface to selected opencv functions 12 | 13 | 14 | Category: Math 15 | tested-with: GHC ==7.6.3 16 | 17 | cabal-version: >=1.2 18 | build-type: Custom 19 | 20 | extra-source-files: configure configure.hs 21 | 22 | extra-tmp-files: hVision-opencv.buildinfo 23 | 24 | library 25 | 26 | Build-Depends: base, hVision-base, hmatrix 27 | 28 | hs-source-dirs: src 29 | 30 | Exposed-modules: OpenCV 31 | 32 | other-modules: 33 | 34 | c-sources: src/OpenCV/opencv1.c 35 | src/OpenCV/opencv2.cpp 36 | 37 | ghc-prof-options: -auto-all 38 | 39 | ghc-options: -Wall 40 | 41 | pkgconfig-depends: opencv 42 | extra-libraries: stdc++ 43 | 44 | -------------------------------------------------------------------------------- /packages/lookforcabal.hs: -------------------------------------------------------------------------------- 1 | import System.Process 2 | import System.Directory 3 | import Data.List.Split 4 | import Data.List(isPrefixOf,isSuffixOf,intercalate,inits) 5 | import Control.Applicative((<$>)) 6 | import Control.Monad(when) 7 | import System.Environment 8 | import Control.Arrow 9 | 10 | isProperSuffixOf s x = x /= s && isSuffixOf s x 11 | 12 | filesAndDir p = do 13 | fs <- getDirectoryContents p 14 | return (fs,p) 15 | 16 | main = do 17 | current <- getCurrentDirectory 18 | -- print current 19 | let paths = filter (not . null) 20 | . reverse 21 | . map (intercalate "/") 22 | . inits 23 | . splitOn "/" 24 | $ current 25 | -- print paths 26 | look <- filter (not.null.fst) 27 | <$> mapM (((take 1 .filter (isProperSuffixOf ".cabal") *** id) <$>) . filesAndDir) 28 | paths 29 | -- print look 30 | when (null look) (error "cabal file not found") 31 | putStrLn (snd $ head look) 32 | 33 | -------------------------------------------------------------------------------- /packages/lookforsource.hs: -------------------------------------------------------------------------------- 1 | import System.Process 2 | import System.Directory 3 | import Data.List.Split 4 | import Data.List(isPrefixOf,isSuffixOf,intercalate,inits) 5 | import Control.Applicative((<$>)) 6 | import Control.Monad(when) 7 | import System.Environment 8 | import Control.Arrow 9 | 10 | main = do 11 | m:_ <- getArgs 12 | home <- getHomeDirectory 13 | let index = home ++ "/.cabal/share/doc/index.html" 14 | doc <- readFile index 15 | let entries = drop 2 $ map (f . take 2 . splitOn ">") $ splitOn "" doc 16 | (s,m') = (head &&& last) (words m) 17 | m'' = init . tail $ m' 18 | --print (s,m'') 19 | case lookup m entries of 20 | Just p -> putStrLn p 21 | Nothing -> case lookup m'' entries of 22 | Nothing -> putStrLn $ "http://holumbus.fh-wedel.de/hayoo/hayoo.html?query="++m'' 23 | Just p -> putStrLn $ p -- ++ "#v:"++s 24 | 25 | f [a,b] = (takeWhile (/='<') b, tail . init $ dropWhile (/='\"') a) 26 | 27 | -------------------------------------------------------------------------------- /packages/tools/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/tools/src/tools/hreplace.hs: -------------------------------------------------------------------------------- 1 | import Util.Replace 2 | import Util.Time(formattedDate) 3 | import Util.Options 4 | 5 | main :: IO () 6 | main = do 7 | pure <- getFlag "--pure" 8 | tex <- getFlag "--latex" 9 | grules <- optionString "--rules" "" 10 | let rules = parseRules grules ++ (if pure then [] else other tex) 11 | putStr . snd =<< ioReplace [] rules =<< getContents 12 | 13 | other :: Bool -> [Rule] 14 | other m = [date,include,ignore,define,quote,hscolour m,local] 15 | 16 | date :: Rule 17 | date = "!DATE" :> do t <- formattedDate; return ([],t) 18 | 19 | -------------------------------------------------------------------------------- /projects/Makefile: -------------------------------------------------------------------------------- 1 | projects = tour demos vision/geom vision/multiview patrec gpu 2 | 3 | all: 4 | for p in $(projects); do cd $$p; make clean; make; cd -; done 5 | 6 | -------------------------------------------------------------------------------- /projects/Makefile.include: -------------------------------------------------------------------------------- 1 | SRC = $(wildcard *.hs) 2 | EXEC = $(SRC:.hs=) 3 | 4 | all: $(EXEC) 5 | 6 | %: %.hs 7 | ghc --make -O2 -threaded -rtsopts $* 8 | rm $*.o $*.hi 9 | rm -f $*.dyn_o $*.dyn_hi 10 | 11 | clean: 12 | rm -rf $(wildcard *.o) 13 | rm -rf $(wildcard *.hi) 14 | rm -rf $(EXEC) 15 | 16 | -------------------------------------------------------------------------------- /projects/examples/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.include 2 | 3 | -------------------------------------------------------------------------------- /projects/examples/cameracontrol.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI.Simple 4 | import System.Process 5 | import Data.IORef 6 | import Control.Monad(join,when) 7 | 8 | autoParam "V4l2_ctl" "" 9 | [ ("device", "Int", intParam 1 0 1) 10 | , ("focus", "Int", intParam 0 0 255) 11 | , ("exposure_auto", "String", stringParam "1" ["0","1","3"]) 12 | , ("exposure_absolute", "Int" , intParam 166 1 10000) 13 | , ("power_line_frequency", "String", stringParam "0" ["0","1"]) 14 | ] 15 | 16 | ctl d p v = system ("v4l2-ctl -d /dev/video"++show d++" -c "++p++"="++v) >> return () 17 | 18 | main = runIt $ do 19 | (wp,gp) <- mkParam :: MkParam V4l2_ctl 20 | writeIORef (evNotify wp) $ do 21 | V4l2_ctl{..} <- gp 22 | ctl device "focus" (show focus) 23 | ctl device "sharpness" "0" 24 | when (exposure_auto/="0") $ 25 | ctl device "exposure_auto" exposure_auto 26 | when (exposure_auto=="0") $ 27 | ctl device "exposure_absolute" (show exposure_absolute) 28 | ctl device "power_line_frequency" power_line_frequency 29 | (join . readIORef) (evNotify wp) 30 | 31 | -------------------------------------------------------------------------------- /projects/examples/chroma.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Capture 4 | 5 | 6 | main = do 7 | base <- resize (Size 480 640) <$> loadRGB "../../data/images/transi/dscn2070.jpg" 8 | run $ getBackground 9 | >>> observe "template" (rgb.snd) 10 | >>> observe "image" (sh base) 11 | 12 | 13 | getBackground = clickKeep "click to set template" f g Nothing 14 | where 15 | f r = id 16 | g = Draw . rgb . fst 17 | 18 | sh b (x,t) = copyMask b (rgb x) mask 19 | where 20 | mask = uvdif x t .>. 20 21 | 22 | uvdif :: Channels -> Channels -> Image I8u 23 | uvdif b x = resize (size (rgb x)) $ add8u 1 (dc uCh x b) (dc vCh x b) 24 | where 25 | dc c = absDiff `on` c 26 | 27 | -------------------------------------------------------------------------------- /projects/examples/chroma2.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Capture 4 | import Util.Homogeneous 5 | import Numeric.LinearAlgebra 6 | 7 | 8 | main = do 9 | base <- loadRGB "../../data/images/transi/dscn2070.jpg" 10 | run $ getBackground 11 | >>> observe "template" (rgb.snd) 12 | >>> arrL (zip [0..]) 13 | >>> arr (\(k,(x,t)) -> (f k base, x, t)) 14 | >>> observe "image" sh 15 | 16 | f k = warp zeroP (Size 480 640) h 17 | where 18 | h = desp (0.0002*fromIntegral k-1 , 0) <> scaling (2*1.0002^k) 19 | 20 | 21 | getBackground = clickKeep "click to set template" f g Nothing 22 | where 23 | f r = id 24 | g = Draw . rgb . fst 25 | 26 | sh (b,x,t) = copyMask b (rgb x) mask 27 | where 28 | mask = uvdif x t .>. 20 29 | 30 | uvdif :: Channels -> Channels -> Image I8u 31 | uvdif b x = resize (size (rgb x)) $ add8u 1 (dc uCh x b) (dc vCh x b) 32 | where 33 | dc c = absDiff `on` c 34 | 35 | -------------------------------------------------------------------------------- /projects/examples/color.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Processing.Custom(histogram3D) 4 | import Numeric.LinearAlgebra 5 | import Util.Debug(debug) 6 | 7 | main = run $ getTemplate 8 | >>> observe "template" snd 9 | >>> observe "imageM" hm 10 | 11 | 12 | getTemplate = clickKeep "define region and click to set template" f g Nothing 13 | where 14 | f r = setRegion r . rgb 15 | g = Draw . rgb . fst 16 | 17 | nor img = recip mx .* img 18 | where 19 | (_,mx) = minmax img 20 | 21 | hm (x,t) = Draw [ Draw (rgb x) 22 | , text (Point 0.9 0.65) h 23 | ] 24 | where 25 | h = printf "%.2f" $ histoInter (histogram3D 4 t) (histogram3D 4 . rgb $ x) 26 | 27 | 28 | histoInter :: Vector Float -> Vector Float -> Float 29 | histoInter h1 h2 = s12 / s1 30 | where 31 | s1 = sumElements h1 32 | s2 = sumElements h2 33 | s12 = sumElements (minEach h1 h2) 34 | minEach a b = cond a b a a b 35 | 36 | -------------------------------------------------------------------------------- /projects/examples/crosscorr.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Util.Geometry ( Polyline(polyPts) ) 3 | import Image.Processing ( Image, size, crossCorr, copy, grayf, crossCorrLoc ) 4 | import Image.ROI ( topLeft, roi2poly ) 5 | 6 | sel = grayf 7 | fun = crossCorr 8 | 9 | main = run $ getTemplate 10 | >>> observe "template" snd 11 | >>> arr (\(x,t) -> ((sel x,t), fun t (sel x))) 12 | >>> observe "cross correlation" snd 13 | >>> observe "best match" (\((x,t),c) -> showMatch t x c) 14 | 15 | 16 | getTemplate = clickKeep "define region and click to set template" f g Nothing 17 | where 18 | f r = setRegion r . sel 19 | g = Draw . sel . fst 20 | 21 | 22 | showMatch t img corr | v > 0.5 = Draw [Draw (copy img [(t,topLeft r)]) 23 | , color green . lineWd 3 $ p 24 | , text p0 (show v) 25 | ] 26 | | otherwise = Draw img 27 | where 28 | (v,r) = crossCorrLoc t corr 29 | p = roi2poly (size img) r 30 | p0 = last (polyPts p) 31 | 32 | -------------------------------------------------------------------------------- /projects/examples/domain.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Capture 4 | import Image.ROI 5 | import Util.Homogeneous 6 | import Numeric.LinearAlgebra 7 | 8 | basis = imageBasis vga 9 | 10 | copyROI b x = copy b [(x,topLeft (roi x))] 11 | 12 | vga = Size 480 640 13 | 14 | k v = constantImage v vga :: Image Float 15 | 16 | u = k 0.2 17 | up = modifyROI (roiArray 3 3 2 2) (u |*| xIb basis) -- u 18 | x = k 0 -- `copyROI` up 19 | y = k 0 `copyROI` up 20 | t a = domainTrans32f (k 0.5) (x,y) a 21 | 22 | main = do 23 | base <- toFloat . rgbToGray . resize vga <$> loadRGB "../../data/images/transi/dscn2070.jpg" 24 | runIt $ browser "domain transformation" [t base, base] (const Draw) 25 | 26 | -------------------------------------------------------------------------------- /projects/examples/frames.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI ( Drawing(Draw), browser, runIt ) 2 | import Image.Capture ( readImages ) 3 | import Image.Processing ( Size(Size), warp, zeroP, saveImage ) 4 | import Util.Options ( optionString, getFlag ) 5 | import Util.Homogeneous ( scaling, desp ) 6 | import Numeric.LinearAlgebra 7 | import Text.Printf ( printf ) 8 | 9 | -------------------------------------------------------------------------------- 10 | 11 | transform img k = warp zeroP (Size 480 640) h img 12 | where 13 | h = desp (0.002*fromIntegral k-1, -0.2) <> scaling (2*1.002^k) 14 | 15 | -------------------------------------------------------------------------------- 16 | 17 | save k img = saveImage (printf "frames/frame-%03d.ppm" (k::Int)) img 18 | 19 | main = do 20 | filename <- optionString "--input" "../../data/images/transi/dscn2479.jpg" 21 | [img] <- readImages [filename] 22 | let frames = map (transform img) [1..100] 23 | 24 | ok <- getFlag "--save" 25 | if ok 26 | then 27 | sequence_ $ zipWith save [1..] frames 28 | else 29 | runIt $ browser "original" [img] (const Draw) 30 | >> browser "frames" frames (const Draw) 31 | 32 | -------------------------------------------------------------------------------- /projects/examples/glyph.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Capture 3 | import Image.Processing 4 | import Contours 5 | import Util.Geometry 6 | import Util.Homogeneous 7 | 8 | main = do 9 | [img] <- readImages ["../../data/images/text.png"] 10 | let x = rgbToGray img 11 | cs = contours 1000 50 (notI x) 12 | runIt $ browser "text" [x] (const Draw) 13 | >> browser "glyphs" (map (redu . normalShape) cs) (const Draw) 14 | where 15 | redu = ((unsafeFromMatrix (scaling 0.4) :: Homography) <|) 16 | 17 | -------------------------------------------------------------------------------- /projects/examples/gradient.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows, RecordWildCards, TemplateHaskell #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | autoParam "Smooth" "s-" [ ("sigma","Float",realParam 8 0 20) ] 7 | 8 | 9 | main = run $ arr (toFloat . grayscale) >>> shGrad 10 | 11 | shGrad = withParam f >>> showVectorField "gradient" g 12 | where 13 | f Smooth {..} x = gaussS sigma x 14 | g x = (x,(sc.*gx g, (-sc).*gy g)) 15 | where 16 | g = gradients x 17 | sc = 0.5 18 | 19 | -------------------------------------------------------------------------------- /projects/examples/grid.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Util.Misc(splitEvery) 4 | import Data.List(tails) 5 | 6 | grid n = map (blockImage . splitEvery n . take (n*n)) . tails 7 | 8 | main = run $ observe "source" id 9 | >>> arr (resize (Size 96 120) . rgb) 10 | >>> arrL (grid 5) 11 | >>> observe "grid" id 12 | 13 | -------------------------------------------------------------------------------- /projects/examples/ippicv.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Image.Devel 4 | import Image.Processing.IPPICV 5 | 6 | main = run $ observe "source" (float2gray . resize32f (Size 200 600) . gray2float . rgbToGray . rgb) 7 | 8 | -------------------------------------------------------------------------------- /projects/examples/keypoints.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Devel 4 | 5 | main = run $ arr grayf 6 | >>> observe "keypoints" g 7 | 8 | keypoints = (.>. 0.05) . localMax 1 . salienceC 3 9 | 10 | salienceC s1 = ((-1) .*) . hessian . gradients . gaussS s1 11 | 12 | g x = Draw [ Draw x, color red $ pointSz 3 (getPoints 300 (keypoints x))] 13 | 14 | -------------------------------------------------------------------------------- /projects/examples/mirror.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = run $ observe "Mirror" (mirror.grayscale) 5 | 6 | mirror im = blockImage [[im1, mirror8u 1 im1]] where 7 | Size h w = size im 8 | ROI r1 r2 c1 c2 = (roi im) 9 | im1 = resize (Size h (div w 2)) (modifyROI (const $ ROI r1 r2 c1 (div w 2)) im) 10 | 11 | -------------------------------------------------------------------------------- /projects/examples/otsu.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, TemplateHaskell #-} 2 | 3 | import Vision.GUI 4 | import Contours 5 | import Image.Processing 6 | import Image.ROI 7 | import Util.Misc(vec,stdpix) 8 | import Util.Debug(debug) 9 | import Numeric.LinearAlgebra 10 | 11 | autoParam "DemoParam" "" 12 | [ ("rad","Int",intParam 2 1 20) 13 | , ("val","Int",intParam 0 (-255) 255) 14 | , ("scale","Int",intParam 0 (-5) 5) 15 | , ("sigma","Float",realParam 1 1 10) 16 | , ("minArea","Double",realParam 10 1 200) 17 | , ("maxArea","Double",realParam 30 1 200) 18 | ] 19 | 20 | data Experiment = Experiment 21 | { orig :: Image RGB 22 | , mono :: Image I8u 23 | , bina :: Image I8u 24 | , cont :: [Polyline] 25 | } 26 | 27 | main = run $ withParam work 28 | >>> observe "source" orig 29 | >>> observe "grayscale" mono 30 | >>> observe "binary" bina 31 | >>> observe "contours" (color red . cont) 32 | 33 | work DemoParam{..} x = Experiment {..} 34 | where 35 | orig = rgb x 36 | mono = grayscale x 37 | bina = compareC8u (otsuThreshold mono) IppCmpLess mono 38 | cont = filter ((\a -> a <(maxArea*stdpix)^2 && a > (minArea*stdpix)^2) . area) $ contours 1000 10 bina 39 | 40 | 41 | -------------------------------------------------------------------------------- /projects/examples/resize.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.ROI(shrink) 4 | 5 | main = run $ arr rgb 6 | >>> observe "original" id 7 | >>> arr (modifyROI (shrink (150,200))) 8 | >>> observe "source" id 9 | >>> observe "resize" (resize (Size 50 50)) 10 | >>> observe "resizeFull" (resizeFull (Size 120 160)) 11 | 12 | -------------------------------------------------------------------------------- /projects/examples/st.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple ( Drawing(Draw), browser, runIt ) 2 | import Image.Capture ( readImages ) 3 | import Image.Devel 4 | 5 | 6 | main = do 7 | [img] <- readImages [ "../../data/images/calibration/cube3.png" ] 8 | runIt $ browser "test" [f img, img] (const Draw) 9 | 10 | 11 | stModifyPix f x p = stRead x p >>= stWrite x p . f 12 | 13 | h (Word24 r g b) = Word24 (255-r) 0 (255-b) 14 | 15 | 16 | f :: Image Word24 -> Image Word24 17 | f x = runSTImage $ do 18 | let rs = [100..200] 19 | cs = [150..250] 20 | z <- thawImage x 21 | sequence_ [ stModifyPix h z (Pixel i j) | i<-rs, j <- cs] 22 | sequence_ [ stWrite z (Pixel (i+50) (j+200)) (Word24 (fromIntegral i) 0 0) | i <- rs, j<-rs ] 23 | -- stWrite z (Pixel 10000 10000) (Word24 0 0 0) 24 | return z 25 | 26 | -------------------------------------------------------------------------------- /projects/examples/trail.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows, RecursiveDo #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = run $ arr grayf 7 | >>> optDo "-v" (observe "source" id) 8 | >>> mix 3 ( tempdiff 3 9 | >>> optDo "-v" (observe "tempdiff" gg) 10 | >>> drift 0.95 11 | >>> optDo "-v" (observe "drift" (5 .*)) 12 | ) 13 | >>> observe "trail" id 14 | 15 | 16 | drift alpha = proc x -> do 17 | rec py <- delay zero -< y 18 | let y = alpha .* py |+| (1-alpha) .* x 19 | returnA -< y 20 | 21 | tempdiff scale = proc x -> do 22 | px <- delay zero -< x 23 | returnA -< (scale) .* thresholdVal 0 0 IppCmpLess (x |-| px) 24 | 25 | zero = constantImage 0 (Size 480 640) 26 | 27 | mix alpha p = proc x -> do 28 | r <- p -< x 29 | returnA -< x |+| alpha .* r 30 | 31 | gg = scale32f8u (-1) 1 32 | 33 | -------------------------------------------------------------------------------- /projects/examples/twist.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Numeric.LinearAlgebra 4 | 5 | main = run $ observe "source" rgb 6 | >>> observe "twisted" (twistColors (toLists m) . rgb) 7 | 8 | m = (3><4) 9 | [ 0.5, 0.1, 0.1, 0.1 10 | , 0.1, 0.5, 0.1, 0.1 11 | , 0.1, 0.1, 0.5, 0.1 ] :: Matrix Float 12 | 13 | -------------------------------------------------------------------------------- /projects/examples/warp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | import Numeric.LinearAlgebra ((<>)) 6 | import Vision(ht,desp,scaling,kgen) 7 | import Util.Rotation 8 | import Util.Misc(degree) 9 | 10 | autoParam "CGParam" "cg-" 11 | [ ("pan", "Double", realParam (0) (-40) (40)) 12 | , ("dx", "Double", realParam (0) (-1) (1)) 13 | , ("dy", "Double", realParam (0) (-1) (1)) 14 | , ("tilt", "Double", realParam (15) (-30) (30)) 15 | , ("roll", "Double", realParam 20 (-40) (40)) 16 | , ("focal", "Double", listParam 2.8 [0.5, 0.7, 1, 2, 2.6, 2.8, 5, 5.5, 9,10]) 17 | , ("scale", "Double", listParam 0.8 [1.05**k|k<-[-20..20]])] 18 | 19 | main = run $ arr rgb 20 | >>> deskew @@@ winParam 21 | >>> observe "warped" id 22 | 23 | deskew par@CGParam{..} img = warp (Word24 80 0 0) (size img) r img 24 | where 25 | h = conjugateRotation par 26 | [[a,b]] = ht h [[dx,-dy]] 27 | r = desp (-a,-b) <> h 28 | 29 | conjugateRotation CGParam{..} = 30 | scaling scale 31 | <> kgen focal 32 | <> rot1 (tilt*degree) 33 | <> rot2 (pan*degree) 34 | <> rot3 (roll*degree) 35 | <> kgen (1/focal) 36 | 37 | -------------------------------------------------------------------------------- /projects/examples/zcontours.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import ImagProc.Contrib.Contours 4 | 5 | main = run $ arr yCh 6 | >>> arr id &&& (npContours @@@ winParam) 7 | >>> sMonitor "contours" gs 8 | 9 | -------------------------------------------------------------------------------- 10 | 11 | gs _ (image,contours) = [ Draw [Draw image, found] 12 | , found 13 | ] 14 | where 15 | ((dark,light),open) = contours 16 | found = Draw [ color lightgreen open 17 | , color blue $ dark 18 | , color red $ light 19 | ] 20 | 21 | -------------------------------------------------------------------------------- /projects/gpu/.gitignore: -------------------------------------------------------------------------------- 1 | classify 2 | match 3 | siftgpu 4 | track 5 | track2 6 | 7 | -------------------------------------------------------------------------------- /projects/gpu/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.include 2 | 3 | demo: 4 | ./siftgpu 5 | ./track 6 | ./match 7 | ./classify 8 | 9 | -------------------------------------------------------------------------------- /projects/gpu/classify.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import ImagProc 3 | import ImagProc.GPU.SIFT 4 | import Util.Misc(debug) 5 | import Data.Function(on) 6 | import Data.List(maximumBy) 7 | 8 | 9 | main = do 10 | prepare 11 | match <- getMatchGPU 12 | runNT_ camera $ sift grayscale >>> getView >>> viewProts >>> viewRecog match 13 | 14 | getView = clickList "click to get prototype" (const id) g [] 15 | where 16 | g ((x,_),_) = Draw (rgb x) 17 | 18 | viewProts = sMonitor "prototypes" f 19 | where 20 | f _ (_,prots) = map (Draw . rgb . fst) prots 21 | 22 | viewRecog match = observe "classify" f 23 | where 24 | f ((x,fs),[]) = Draw () 25 | f ((x,fs),prots) | score < 20 = text (Point 0 0) "???" 26 | | otherwise = Draw (rgb p) 27 | where 28 | scores = map (\(p,fps) -> (p, length (match 0.7 0.8 fs fps))) prots 29 | (p,score) = maximumBy (compare `on` snd) scores 30 | 31 | -------------------------------------------------------------------------------- /projects/gpu/siftgpu.hs: -------------------------------------------------------------------------------- 1 | -- demo of siftgpu 2 | 3 | import Vision.GUI 4 | import ImagProc 5 | import ImagProc.GPU.SIFT 6 | 7 | main = do 8 | prepare 9 | runNT_ camera $ sift grayscale >>> observe "SIFT GPU" sh 10 | 11 | sh (x, feats) = Draw [ Draw (rgb x), color yellow feats ] 12 | 13 | -------------------------------------------------------------------------------- /projects/gpu/track.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | import Vision.GUI 4 | import ImagProc 5 | import ImagProc.GPU.SIFT 6 | import Util.Misc(debug,quartiles) 7 | import Control.Arrow((&&&)) 8 | 9 | 10 | main = do 11 | prepare 12 | match <- getMatchGPU 13 | runNT_ camera $ sift grayscale >>> track match >>> see 14 | 15 | 16 | track match = proc (x,pxs) -> do 17 | pas <- delay'-< pxs 18 | let matches' = match 0.7 0.8 pxs pas 19 | matches = map (\[a,b]-> (Segment (ipPosition (pxs!! a)) (ipPosition(pas!! b)))) matches' 20 | returnA -< (x,matches) 21 | 22 | 23 | see = observe "tracks" g 24 | where 25 | g (x,matches) = Draw [ Draw (rgb x) 26 | , drmatches 27 | ] 28 | where 29 | drmatches | length matches < 5 = Draw () 30 | | otherwise = Draw [ (lineWd 2 . color red) $ naiveInliers matches 31 | ] 32 | 33 | naiveInliers ms = map snd . filter (( 2 | 3 | 4 | 5 | 6 | 7 | 8 | [title] 9 | 10 | 11 | -------------------------------------------------------------------------------- /projects/help/HIGHLIGHT: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /projects/help/LINKS: -------------------------------------------------------------------------------- 1 | 2 | [me]: http://dis.um.es/profesores/alberto 3 | [project]: https://github.com/albertoruiz/easyVision 4 | 5 | [help]: help.html 6 | [tutorial]: tutorial.html 7 | [gui]: gui.html 8 | [options]: options.html 9 | [points]: click_points.html 10 | [helponhelp]: helponhelp.html 11 | [examples]: examples.html 12 | 13 | -------------------------------------------------------------------------------- /projects/help/MATHJAX: -------------------------------------------------------------------------------- 1 | 4 | 5 | -------------------------------------------------------------------------------- /projects/help/Makefile: -------------------------------------------------------------------------------- 1 | sources = $(wildcard *.md) 2 | 3 | pages = $(sources:.md=.html) 4 | 5 | all: $(pages) 6 | 7 | %.html: %.md LINKS HEADER 8 | hreplace < $*.md \ 9 | | markdown \ 10 | | hreplace --rules='HSFILE name = !HSCOLOUR>{-- name\n\n#!INCLUDE name};

!TITLE X = #!REPLACE>{#!INCLUDE(HEADER)!WITH[title]=X}

; --!SPACE../ = --!SPACE' \ 11 | > $*.html 12 | 13 | clean: 14 | rm $(pages) 15 | 16 | ifneq ($(wildcard Makefile-dev),) 17 | include Makefile-dev 18 | endif 19 | 20 | -------------------------------------------------------------------------------- /projects/help/click_points.md: -------------------------------------------------------------------------------- 1 | !TITLE(hVision Help - click points) 2 | 3 | # hVision help 4 | 5 | - - - 6 | 7 | ## "click points" window 8 | 9 | 10 | $$\begin{array}{ll} 11 | \mathbf{\text{Left Button}} & \text{add point} \\\\ 12 | \mathbf{\text{Right Button}} & \text{move the closest point}\\\\ 13 | \mathbf{\text{Del}} & \text{remove last point}\\\\ 14 | \mathbf{\text{Ctrl-S}} & \text{print list of points to console} 15 | \end{array} 16 | $$ 17 | 18 | 19 | An initial list of points can be loaded from a file indicated as a command line option. 20 | - - - 21 | 22 | [general help][help] 23 | 24 | 25 | !INCLUDE(LINKS) 26 | 27 | !INCLUDE(MATHJAX) 28 | 29 | -------------------------------------------------------------------------------- /projects/help/gui.md: -------------------------------------------------------------------------------- 1 | !TITLE(hVision Help - GUI) 2 | 3 | # hVision GUI Help 4 | 5 | - - - 6 | 7 | ## zoom control 8 | 9 | **Ctrl-0** reset 10 | 11 | **Ctrl-KeyUp / Ctrl-WheelUp** zoom in 12 | 13 | **Ctrl-KeyDown / Ctrl-WheelDown** zoom out 14 | 15 | **Ctrl-Drag-LeftButton** move 16 | 17 | ## define region of interest 18 | 19 | **Ctrl-Drag-RightButton** set region 20 | 21 | **Alt-0** reset region 22 | 23 | ## 3D window 24 | 25 | **Shift-Wheel** rotate view 26 | 27 | **M** auto rotate 28 | 29 | **O** reset view 30 | 31 | ## camera control 32 | 33 | **SPACE** pause stream 34 | 35 | **Shift-SPACE** pause display 36 | 37 | **S** step (advance one frame) 38 | 39 | 40 | ## misc 41 | 42 | **ESC** exit application 43 | 44 | **I** save window screenshot as png 45 | 46 | **F11** toggle show ROI and display stats 47 | 48 | **Ctrl-F3** minimize window (and inhibit display) 49 | 50 | **F3** toggle window resize mode 51 | 52 | **F10** toggle sync display 53 | 54 | **F1**: [help](helponhelp.html) 55 | 56 | 57 | !INCLUDE(LINKS) 58 | 59 | -------------------------------------------------------------------------------- /projects/help/help.md: -------------------------------------------------------------------------------- 1 | !TITLE(hVision Help) 2 | 3 | # [hVision][project] help 4 | 5 | 6 | ## system 7 | 8 | - [tutorial][tutorial] 9 | 10 | - [example programs][examples] 11 | 12 | - [introductory slides](http://dis.um.es/~alberto/material/ev1.pdf) 13 | 14 | - [old blog](http://covector.blogspot.com.es/) 15 | 16 | ## programs 17 | 18 | - [GUI key binding][gui] 19 | 20 | - [command line options][options] 21 | 22 | - [interactive point capture][points] 23 | 24 | - [help in apps][helponhelp] 25 | 26 | !INCLUDE(LINKS) 27 | 28 | -------------------------------------------------------------------------------- /projects/help/helponhelp.md: -------------------------------------------------------------------------------- 1 | !TITLE(hVision Help) 2 | 3 | # [hVision][project] help pages 4 | 5 | 6 | The *hVision* help system uses simple HTML pages. Press **F1** in any graphical window to open the help page in the current directory, or in a "help" directory under or above the current one, with the same 7 | name as the program executable and extension ".html". If this page does not exist, we try the 8 | window name, or finally a default "help.html". 9 | 10 | We can write the help files using markdown, LaTeX (Mathjax), and syntax highlighting of code samples (hscolour). 11 | 12 | !INCLUDE(LINKS) 13 | 14 | -------------------------------------------------------------------------------- /projects/help/icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/albertoruiz/easyVision/26bb2efaa676c902cecb12047560a09377a969f2/projects/help/icon.png -------------------------------------------------------------------------------- /projects/help/styles.css: -------------------------------------------------------------------------------- 1 | 2 | html{ display: table; margin: auto; background: white 3 | } 4 | 5 | body{ width:800px; 6 | font-family: "FreeSans", sans-serif ; font-size:18px; 7 | margin:40px; background-color: #f8f8f8; border: 2px solid #afafaf; padding:20px 8 | } 9 | 10 | ul {list-style-type:square} 11 | 12 | h2 {color: #006000} 13 | 14 | p {margin:10px; margin-left: 20px; margin-top: 20px} 15 | 16 | pre {margin:40px; font-size: 16px; border: 1px solid gray; background: white; padding: 10px } 17 | 18 | #samp {margin:40px; font-size: 16px; border: none; background: #efefef; } 19 | 20 | -------------------------------------------------------------------------------- /projects/old/classify/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/classify/README: -------------------------------------------------------------------------------- 1 | Object classification experiments 2 | --------------------------------- 3 | 4 | - catalog: browser of database of labeled images 5 | 6 | - lbpclassifier: using local binary patterns 7 | 8 | - ipclassifier: using interest points 9 | 10 | * classifier: experiments 11 | 12 | * cards: demo of card rectification and classification 13 | 14 | - roisel: a tool for selection of images with associated roi 15 | 16 | - roiclass: detection of regions based on examples created by roisel 17 | -------------------------------------------------------------------------------- /projects/old/classify/catalog.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | import System.Environment(getArgs) 4 | import Util.Options 5 | 6 | main = do 7 | sz <- findSize 8 | file:_ <- getArgs 9 | catalog <- readCatalog (file++".yuv") sz (file++".labels") Nothing id 10 | n <- getOption "--goto" 1 11 | prepare 12 | catalogBrowser n catalog file sz 13 | mainLoop 14 | -------------------------------------------------------------------------------- /projects/old/contours/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/gea/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/gpu/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/gpu/README: -------------------------------------------------------------------------------- 1 | The programs using CUDA can only be run in compiled mode. 2 | 3 | Workaround: 4 | 5 | $ cp $EASYVISION/cabal/gpu/dso_handle.c . 6 | $ gcc -c dso_handle.c 7 | $ ghci prog.hs dso_handle.o 8 | 9 | -------------------------------------------------------------------------------- /projects/old/gpu/siftgpu.hs: -------------------------------------------------------------------------------- 1 | -- demo of siftgpu 2 | 3 | import EasyVision 4 | import ImagProc.GPU.SIFT 5 | import Control.Monad((>=>)) 6 | 7 | main = run $ camera >>= wsift grayscale >>= timeMonitor 8 | 9 | wsift f = sift f >=> siftmonitor f 10 | 11 | sift f cam = do 12 | fsift <- getSift 13 | o <- winSIFTParams 14 | return $ do 15 | x <- cam 16 | pars <- o 17 | return (x, fsift pars (f x)) 18 | 19 | siftmonitor f = monitor "SIFT GPU" (mpSize 20) sh where 20 | sh (x, feats) = do 21 | let im = f x 22 | drawImage' im 23 | pointCoordinates (size im) 24 | setColor 1 1 0 25 | drawInterestPoints feats 26 | 27 | -------------------------------------------------------------------------------- /projects/old/lkt/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/pano/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/pano/README: -------------------------------------------------------------------------------- 1 | automatic on-line image stitching 2 | ------------------------------------- 3 | 4 | - single: using one camera, selecting a base view 5 | 6 | - twocams: with two cameras 7 | 8 | * autopano: other experiments 9 | -------------------------------------------------------------------------------- /projects/old/pose/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/pose/README: -------------------------------------------------------------------------------- 1 | pose estimation and tracking 2 | ---------------------------- 3 | 4 | - pose: simple pose estimation from an A4 sheet of paper 5 | 6 | - augmented: adding a virtual object to the scene 7 | 8 | - dynamic: the virtual object moves 9 | 10 | - onlyRects: a camera combinator which "averages" all the rectangles found in the input sequence 11 | 12 | - rectangles: metric rectification of a planar scene from a single rectangle and uncalibrated diag(f,f,1) camera. 13 | 14 | - whiteboard: rectifies a white rectangle 15 | 16 | - frontal: automatic metric rectification (from manually selected points) from several views (demo for BMVC) 17 | 18 | - poseTracker: demo of camera pose estimation using ukf 19 | 20 | - multipose: multicamera calibration using a planar reference 21 | 22 | - ellipses: metric rectification of a planar scene from the images of two or more circles 23 | 24 | - rightAngles: metric rectification of a planar scene from (manually selected) the images of right angles 25 | -------------------------------------------------------------------------------- /projects/old/pose/onlyRects.hs: -------------------------------------------------------------------------------- 1 | -- average of all rectangles found 2 | 3 | import EasyVision 4 | import ImagProc.C.Segments 5 | import Text.Printf(printf) 6 | import Util.Options 7 | 8 | drift alpha = virtualCamera drifter 9 | where drifter (a:b:rest) = a : drifter ((alpha .* a |+| (1-alpha).* b):rest) 10 | 11 | main = do 12 | sz <- findSize 13 | ratio <- getOption "--ratio" (sqrt 2) 14 | alpha <- getOption "--alpha" 0.9 15 | let k = height sz `div` 32 16 | let szR = Size (32*k) (round (32*fromIntegral k*ratio)) 17 | nm = "ratio " ++ printf "%.2f" ratio 18 | prepare 19 | 20 | cam <- getCam 0 (mpSize 20) 21 | >>= monitor "video" (mpSize 5) drawImage 22 | ~> channels 23 | >>= onlyRectangles segments szR ratio grayscale 24 | ~~> map float . concat 25 | >>= drift alpha 26 | 27 | w <- evWindow () nm sz Nothing (const $ kbdQuit) 28 | 29 | launch $ do 30 | inWin w $ cam >>= drawImage 31 | -------------------------------------------------------------------------------- /projects/old/simple/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/simple/README: -------------------------------------------------------------------------------- 1 | simple examples 2 | --------------- 3 | 4 | - demo: several image processing filters and image properties which can be selected from a menu. 5 | 6 | - record: plays a given image source, which can be optionally recorded in a file. 7 | 8 | - warp: applies a synthetic rotation to the image source 9 | 10 | - detect: motion detector 11 | 12 | - static: detector of static frames 13 | 14 | - interpolate: examples of camera combinators (image sequence processing using ordinary list functions) 15 | 16 | - pseudocolor: computes simple color index from HSV 17 | 18 | - fft: uses peak in fft to normalize orientation and scale of text 19 | 20 | - matches: shows interest point correspondences 21 | 22 | - dethessian: simple object recognition based on interest points 23 | 24 | - contours: affine invariant silhouette recognition 25 | 26 | - corners: corner detector and tracker for static planar scenes 27 | 28 | - background: detection of something different from a background image 29 | 30 | - zoom: demo of zoom window, useful to observe pixel values 31 | 32 | - capture: extract drawing from a sheet of paper 33 | 34 | -------------------------------------------------------------------------------- /projects/old/simple/background.hs: -------------------------------------------------------------------------------- 1 | -- contour of something different from a background image 2 | 3 | import EasyVision 4 | import Graphics.UI.GLUT 5 | import Control.Monad(when) 6 | 7 | main = do 8 | sz <- findSize 9 | prepare 10 | 11 | cam <- getCam 0 sz ~> channels 12 | w <- evWindow (True,undefined) "contour" sz Nothing (mouse kbdQuit) 13 | 14 | launch $ do 15 | orig <- cam 16 | (rec,bg) <- getW w 17 | when rec $ do 18 | putW w (False,orig) 19 | when (not rec) $ inWin w $ do 20 | let mask = binarize8u 100 $ diffRGB bg orig 21 | drawImage $ copyMask32f (float . grayscale $ orig) mask 22 | 23 | 24 | mouse _ st (Char 's') Down _ _ = do 25 | (_,b) <- getW st 26 | putW st (True,b) 27 | 28 | mouse def _ a b c d = def a b c d 29 | 30 | diffRGB ch1 ch2 = toGray (rd |+| gd |+| bd) 31 | where 32 | rd = float $ absDiff8u (rCh ch1) (rCh ch2) 33 | gd = float $ absDiff8u (gCh ch1) (gCh ch2) 34 | bd = float $ absDiff8u (bCh ch1) (bCh ch2) 35 | -------------------------------------------------------------------------------- /projects/old/simple/capture.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards, NamedFieldPuns #-} 2 | 3 | import EasyVision 4 | 5 | autoParam "VParam" "vectorize-" 6 | [( "sigma","Float" ,realParam 0.6 0 2) 7 | ,( "thres","Int" ,intParam 140 0 255) 8 | ,( "scale","Float" ,realParam 1.5 0 5) 9 | ] 10 | 11 | mirror = mirror8u 0 . mirror8u 1 12 | 13 | main = run $ camera ~> mirror . grayscale >>= selectROI "jeje" id ~> uncurry (flip setROI) 14 | >>= vec .@. winVParam 15 | >>= observe "img" snd 16 | 17 | vec VParam{..} = notI .toGray . autoscale scale. float .notI .toGray 18 | . gaussS sigma. float . thresholdVal8u (fromIntegral thres) 255 IppCmpGreater 19 | 20 | 21 | autoscale s x = (s*recip mx) .* x 22 | where (mn,mx) = minmax x 23 | 24 | -------------------------------------------------------------------------------- /projects/old/simple/corners0.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = do 4 | corners <- getCornerDetector 5 | 6 | run $ camera ~> float . grayscale >>= corners >>= cornerMonitor "corners" 7 | -------------------------------------------------------------------------------- /projects/old/simple/detect.hs: -------------------------------------------------------------------------------- 1 | -- example of virtual camera 2 | 3 | import EasyVision 4 | import Graphics.UI.GLUT hiding (Size) 5 | import Util.Options 6 | 7 | main = do 8 | sz <- findSize 9 | 10 | th <- getOption "--sensi" 0.01 11 | 12 | (cam,ctrl) <- getCam 0 sz 13 | >>= addSmall (Size 90 120) (grayscale.channels) 14 | >>= detectMotion (th*255*90*120<) 15 | >>= withPause 16 | 17 | prepare 18 | 19 | w <- evWindow () "motion" sz Nothing (const (kbdcam ctrl)) 20 | windowStatus $= Hidden 21 | 22 | sv <- optionalSaver sz 23 | 24 | launch (worker w cam sv) 25 | 26 | ----------------------------------------------------------------- 27 | 28 | worker w cam save = do 29 | 30 | inWin w $ do 31 | orig <- cam >>= return . fst 32 | drawImage (yuvToRGB orig) 33 | -- system "artsplay /usr/share/sounds/KDE_Notify.wav" 34 | save orig 35 | windowStatus $= Shown 36 | -------------------------------------------------------------------------------- /projects/old/simple/emph.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import EasyVision 4 | 5 | autoParam "Param" "emph-" [("radius" ,"Int" ,intParam 10 0 30)] 6 | 7 | emph :: Int -> ImageGray -> ImageGray 8 | emph r x = sh d 9 | where 10 | f = float x 11 | s = filterBox r r f 12 | d = f |-| s 13 | sh = scale32f8u (-1) 1 14 | 15 | main = run $ camera ~> grayscale 16 | >>= observe "orig" id 17 | >>= (emph . radius) .@. winParam 18 | >>= monitorScanLine "emph" snd 19 | >>= timeMonitor 20 | 21 | -------------------------------------------------------------------------------- /projects/old/simple/face.hs: -------------------------------------------------------------------------------- 1 | import OpenCV 2 | import EasyVision 3 | 4 | main = run (camera ~> grayscale >>= face >>= observe "Face Detector" id >>= timeMonitor) 5 | 6 | face cam = do 7 | detect <- cascadeClassifier "../../data/haarcascades/haarcascade_frontalface_alt.xml" 8 | return $ do 9 | x <- cam 10 | let r = detect x 1 11 | if null r then return x 12 | else return $ modifyROI (const $ head r) x 13 | 14 | -------------------------------------------------------------------------------- /projects/old/simple/harris.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import EasyVision 4 | import Graphics.UI.GLUT hiding (Size) 5 | 6 | $(autoParam "Param" "" 7 | [("level","Int", intParam 1 0 6), 8 | ("thres","Float", realParam 0.01 0 0.1)] 9 | ) 10 | 11 | main = run $ (camera ~> grayscale ~> pyramid .&. winParam ) 12 | >>= disp 13 | >>= timeMonitor 14 | 15 | --main = run (camera>>= observe "kk" grayscale >>= timeMonitor) 16 | 17 | harris th im = pixelsToPoints (size im) 18 | $ getPoints32f 1000 19 | $ binarize32f th 20 | $ localMax 5 21 | $ a |*| b |-| c |*| c 22 | where 23 | g = gradients $ float im 24 | a = gauss Mask3x3 (gx g |*| gx g) 25 | b = gauss Mask3x3 (gy g |*| gy g) 26 | c = gauss Mask3x3 (gx g |*| gy g) 27 | 28 | 29 | disp = monitor "harris" (mpSize 20) f where 30 | f (p,Param{..}) = do 31 | drawImage (p!!0) 32 | pointCoordinates (mpSize 20) 33 | setColor 1 0 0 34 | pointSize $= 9 35 | renderPrimitive Points (mapM_ vertex $ harris thres (p!!(level + 2))) 36 | setColor 0 0 1 37 | pointSize $= 6 38 | renderPrimitive Points (mapM_ vertex $ harris thres (p!!(level+1))) 39 | setColor 1 1 1 40 | pointSize $= 3 41 | renderPrimitive Points (mapM_ vertex $ harris thres (p!!(level+0))) 42 | -------------------------------------------------------------------------------- /projects/old/simple/interpolate.hs: -------------------------------------------------------------------------------- 1 | -- example of virtual cameras 2 | 3 | import EasyVision 4 | import Util.Options 5 | 6 | ----------------------------------------------------------- 7 | 8 | interpolate = virtualCamera inter 9 | where inter (a:b:rest) = a: (0.5.*a |+| 0.5.*b) :inter (b:rest) 10 | 11 | drift alpha = virtualCamera drifter 12 | where drifter (a:b:rest) = a : drifter ((alpha .* a |+| (1-alpha).* b):rest) 13 | 14 | asFloat grab = return $ return . float . yuvToGray =<< grab 15 | 16 | ------------------------------------------------------------ 17 | 18 | main = do 19 | 20 | sz <- findSize 21 | 22 | alpha <- getOption "--alpha" 0.9 23 | 24 | prepare 25 | 26 | (cam,ctrl) <- getCam 0 sz 27 | >>= monitor "original" (Size 150 200) drawImage 28 | >>= asFloat 29 | >>= drift alpha >>= interpolate 30 | >>= withPause 31 | 32 | w <- evWindow () "interpolate" sz Nothing (const (kbdcam ctrl)) 33 | 34 | launch $ inWin w $ cam >>= drawImage 35 | -------------------------------------------------------------------------------- /projects/old/simple/mser.hs: -------------------------------------------------------------------------------- 1 | import OpenCV 2 | import EasyVision 3 | import Graphics.UI.GLUT 4 | import Control.Arrow 5 | 6 | main = run $ camera ~> grayscale 7 | >>= mserRaw .@. winMSERParams 8 | ~> (fst &&& mser.snd) >>= monitor "MSER" (mpSize 20) sh >>= timeMonitor 9 | 10 | sh (im, cs) = do 11 | drawImage im 12 | pointCoordinates (size im) 13 | setColor 1 0 0 14 | text2D 0.9 0.6 $ show (length cs) 15 | mapM_ shcont cs 16 | 17 | shcont (Closed c) = do 18 | renderPrimitive LineLoop $ mapM_ vertex c 19 | shcont (Open c) = do 20 | renderPrimitive LineStrip $ mapM_ vertex c 21 | 22 | mser im = map fst3 . contours 100 50 128 False $ im 23 | where 24 | fst3 (a,_,_) = Closed $ pixelsToPoints (size im) a -- $ douglasPeucker 1 a 25 | 26 | -------------------------------------------------------------------------------- /projects/old/simple/multicam.hs: -------------------------------------------------------------------------------- 1 | -- ./multicam webcam1 logitech etc. 2 | 3 | import EasyVision 4 | import Text.Printf 5 | import Data.List(tails,transpose) 6 | 7 | main = do 8 | sz <- findSize 9 | n <- numCams 10 | 11 | run $ getMulticam sz n 12 | ~~> history 2 13 | ~> difs 14 | >>= hist 15 | >>= observe "views" (\imgs -> blockImage [map grayscale imgs]) 16 | >>= timeMonitor 17 | 18 | ---------------------------------------------------------------------------- 19 | 20 | hist cam = do 21 | h <- signalMonitor "Sync" 50 100 (printf "%.0f gray levels") (0,640*480*255/10) 22 | return $ do 23 | (imgs,ds) <- cam 24 | h ds 25 | return imgs 26 | 27 | ----------------------------------------------------------------------------- 28 | 29 | history n = map (take n) . tails 30 | 31 | difs imgs = (last imgs, map f (transpose imgs)) where 32 | f [x,y] = sum8u $ absDiff8u (grayscale x) (grayscale y) 33 | 34 | ------------------------------------------------------------------------------ 35 | -------------------------------------------------------------------------------- /projects/old/simple/multisave.hs: -------------------------------------------------------------------------------- 1 | -- save multicamera video, interleaving frames 2 | -- ./multisave webcam0 webcam1 etc. 3 | 4 | import EasyVision 5 | import Graphics.UI.GLUT hiding (Size) 6 | import Text.Printf 7 | import Data.List(tails,transpose) 8 | 9 | main = do 10 | prepare 11 | sz <- findSize 12 | n <- numCams 13 | save <- optionalSaver sz 14 | 15 | multicam <- getMulticam sz n ~~> history 2 ~> difs 16 | wm <- evWindow () "views" (Size 150 (200*n)) Nothing (const kbdQuit) 17 | 18 | hist <- signalMonitor "Sync" 50 100 (printf "%.0f grayscale levels") (0,640*480*255/10) 19 | 20 | launch $ do 21 | (imgs,ds) <- multicam 22 | let x = blockImage [map grayscale imgs] 23 | hist ds 24 | inWin wm $ do 25 | drawImage x 26 | mapM_ (save.yuv) imgs 27 | 28 | ----------------------------------------------------------------------------- 29 | 30 | history n = map (take n) . tails 31 | 32 | difs imgs = (last imgs, map f (transpose imgs)) where 33 | f [x,y] = sum8u $ absDiff8u (grayscale x) (grayscale y) 34 | 35 | ------------------------------------------------------------------------------ 36 | -------------------------------------------------------------------------------- /projects/old/simple/ocr.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = runFPS 10 4 | $ camera 5 | >>= regionMarker rgb 6 | >>= rectifyRegion grayscale 400 .@. winAspectRatioParam ~> snd.snd 7 | >>= ocrWindow autoBinarize 8 | >>= timeMonitor 9 | 10 | -------------------------------------------------------------------------------- /projects/old/simple/pseudocolor.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Control.Monad((>=>)) 3 | import ImagProc.C.Segments 4 | import Util.Options 5 | 6 | onlyCards sz = onlyRectangles segments sz (sqrt 2) rgb 7 | >=> virtualCamera (map channelsFromRGB . concat) 8 | 9 | main = do 10 | sz <- findSize 11 | prepare 12 | 13 | rects <- getFlag "--rectangles" 14 | let vc = if rects then onlyCards sz 15 | else return . id 16 | 17 | (cam,ctrl) <- getCam 0 sz ~> channels 18 | >>= vc 19 | >>= monitor "video" (mpSize 10) (drawImage.rgb) 20 | >>= withPause 21 | 22 | hsvPalette 23 | 24 | o <- createParameters [("kb",intParam 60 0 255), 25 | ("kg",intParam 100 0 255), 26 | ("kw",intParam 200 0 255)] 27 | 28 | e <- evWindow () "pseudocolor" sz Nothing (const (kbdcam ctrl)) 29 | 30 | launch $ inWin e $ do 31 | kb <- fromIntegral `fmap` (getParam o "kb" :: IO Int) 32 | kg <- fromIntegral `fmap` (getParam o "kg" :: IO Int) 33 | kw <- fromIntegral `fmap` (getParam o "kw" :: IO Int) 34 | 35 | img <- cam 36 | 37 | drawImage $ hsvToRGB 38 | $ hsvCodeTest kb kg kw 39 | $ rgbToHSV 40 | $ rgb $ img 41 | -------------------------------------------------------------------------------- /projects/old/simple/record-old.hs: -------------------------------------------------------------------------------- 1 | -- save captured video 2 | -- then you can convert the generated yuv to a nicer format: 3 | -- $ ./record webcam1 --save=file.yuv [--limit=numframes] 4 | -- $ mencoder file.yuv -o file.avi -ovc lavc -fps 15 5 | 6 | import EasyVision 7 | import Graphics.UI.GLUT 8 | import Control.Monad(when) 9 | import Util.Options 10 | 11 | main = do 12 | sz <- findSize 13 | (cam,ctrl) <- getCam 0 sz >>= withPause 14 | prepare 15 | 16 | ok <- hasValue "--save" 17 | 18 | let title = if ok then "Click to start/stop recording" 19 | else "Image" 20 | 21 | w <- evWindow False title sz Nothing (mouse (kbdcam ctrl)) 22 | 23 | save <- optionalSaver sz 24 | 25 | launch $ do 26 | orig <- cam 27 | rec <- getW w 28 | 29 | inWin w $ do 30 | drawImage orig 31 | when rec $ do 32 | setColor 1 0 0 33 | text2D 20 20 "Recording..." 34 | save orig 35 | 36 | ---------------------------------------- 37 | 38 | mouse _ st (MouseButton LeftButton) Down _ _ = do 39 | updateW st not 40 | 41 | mouse def _ a b c d = def a b c d 42 | -------------------------------------------------------------------------------- /projects/old/simple/record.hs: -------------------------------------------------------------------------------- 1 | -- save captured video 2 | -- then you can convert the generated yuv to a nicer format: 3 | -- $ ./record webcam1 [--save=file.yuv] [--wait] [--limit=numframes] 4 | -- $ mencoder file.yuv -o file.avi -ovc lavc -fps 15 5 | 6 | import EasyVision 7 | 8 | main = run $ camera >>= saveWin yuv 9 | -------------------------------------------------------------------------------- /projects/old/simple/rectify.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = runFPS 10 4 | $ camera 5 | >>= regionMarker rgb 6 | >>= rectifyRegion rgb 400 .@. winAspectRatioParam ~> snd.snd 7 | >>= observe "result" id 8 | 9 | 10 | -------------------------------------------------------------------------------- /projects/old/simple/static.hs: -------------------------------------------------------------------------------- 1 | -- Detects and optionally saves the static frames in the image sequence 2 | 3 | import EasyVision 4 | import System.Process(system) 5 | import Control.Concurrent(forkIO) 6 | import Util.Options 7 | 8 | main = do 9 | th <- getOption "--sensi" 0.01 10 | thf <- getOption "--factor" 5 11 | env <- getOption "--env" 5 12 | 13 | run $ camera 14 | >>= detectStatic th thf env grayscale rgb 15 | >>= monitor "Snapshot" (mpSize 20) f 16 | >>= saveWin yuv 17 | 18 | f im = do 19 | drawImage (rgb im) 20 | forkIO $ system "play /usr/share/sounds/gnome/default/alerts/drip.ogg 2> /dev/null" >> return () 21 | return () 22 | 23 | -------------------------------------------------------------------------------- /projects/old/stereo/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/stereo/README: -------------------------------------------------------------------------------- 1 | basic 3D reconstruction experiments 2 | ----------------------------------- 3 | 4 | - multiview: 3D point detector from blue regions using multiple cameras calibrated with ../pose/multipose 5 | 6 | - demostereo: autocalibration and 3D point detector from blue regions. 7 | 8 | - vergence: demo of synthetic stereo rectification and distance measurement from a calibrated pair using ../pose/multipose 9 | 10 | * stereo: epipolar geometry from manually selected points 11 | 12 | * autostereo: automatic epipolar geometry 13 | -------------------------------------------------------------------------------- /projects/old/synth/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/synth/lissajous.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT hiding (Point) 3 | 4 | deltaf = 2*pi/1000 5 | sz = mpSize 20 6 | 7 | vert a b f t = vertex $ Point (0.6*cos (a*t-f)) (0.6*sin (b*t)) 8 | 9 | fi n = fromIntegral (n::Int) 10 | 11 | main = do 12 | prepare 13 | w <- evWindow 0 "Curve" sz Nothing (const kbdQuit) 14 | lineSmooth $= Enabled 15 | lineWidth $= 5 16 | setColor 1 1 0 17 | pointCoordinates sz 18 | p <- createParameters [("wx",intParam 2 1 10), 19 | ("wy",intParam 3 1 10), 20 | ("nd",intParam 5 1 100)] 21 | launchFreq 50 $ inWin w $ do 22 | a <- getParam p "wx" 23 | b <- getParam p "wy" 24 | nd <- getParam p "nd" 25 | let delta = 2*pi/(fi nd) 26 | t = [0,delta..2*pi] 27 | phi <- getW w 28 | putW w (phi+deltaf) 29 | renderPrimitive LineStrip $ mapM_ (vert (fi a) (fi b) phi) t 30 | -------------------------------------------------------------------------------- /projects/old/synth/synthshape.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT as GL hiding(Point) 3 | import Numeric.LinearAlgebra 4 | import Numeric.GSL.Fourier 5 | 6 | ------------------------------------------------------------ 7 | 8 | maxw = 8 9 | 10 | freqs w = [("f "++show w,realParam 0 0 1)| w <- [-w .. w :: Int]] 11 | 12 | main = do 13 | 14 | sz <- findSize 15 | 16 | prepare 17 | 18 | pa <- createParameters (freqs maxw) 19 | pf <- createParameters (freqs maxw) 20 | 21 | w <- evWindow () "Synthesizer" sz (Just $ disp pa pf) (const kbdQuit) 22 | clearColor $= Color4 1 1 1 1 23 | 24 | mainLoop 25 | 26 | ----------------------------------------------------------------- 27 | 28 | disp pa pf _ = do 29 | wa <- sequence $ map (\w -> getParam pa ("f "++show w)) [-maxw .. maxw] 30 | wf <- sequence $ map (\w -> getParam pf ("f "++show w)) [-maxw .. maxw] 31 | let f k = (wa!!(k+maxw) :+ 0) * cis (2*pi*wf!!(k+maxw)) 32 | pointCoordinates (mpSize 20) 33 | setColor 0 0 0 34 | shcont $ invFou 200 maxw f 35 | postRedisplay Nothing 36 | 37 | shcont (Closed c) = do 38 | --lineWidth $= 3 39 | renderPrimitive LineLoop $ mapM_ vertex c 40 | pointSize $= 5 41 | renderPrimitive Points (vertex (head c)) 42 | 43 | 44 | -------------------------------------------------------------------------------- /projects/old/tracks/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/tracks/corners.hs: -------------------------------------------------------------------------------- 1 | import EasyVision hiding ((.@.)) 2 | import EasyVision.MiniApps.Corners 3 | import Control.Arrow((&&&)) 4 | import Util.Options 5 | 6 | main1 = do 7 | corners <- getCornerDetector 8 | mintrk <- getOption "--mintrk" 20 9 | run $ camera ~> float . grayscale >>= corners >>= cornerTracker mintrk >>= timeMonitor 10 | 11 | main2 = run $ (camera ~> float . grayscale) 12 | ~> (id &&& corners defCornerParam) >>= cornerMonitor "kk" >>= timeMonitor 13 | 14 | main3 = run $ (camera ~> float . grayscale .&. winCornerParam) 15 | ~> (fst &&& (uncurry $ flip corners)) >>= cornerMonitor "kk" >>= timeMonitor 16 | 17 | 18 | main = run $ camera ~> float . grayscale >>= corners .@. winCornerParam >>= cornerMonitor "kk" >>= timeMonitor 19 | 20 | 21 | main4 = run $ camera ~> float . grayscale >>= cornerDetector >>= cornerMonitor "kk" >>= timeMonitor 22 | 23 | 24 | f .@. wp = (wp .&. ) . return >~> snd &&& uncurry f 25 | -------------------------------------------------------------------------------- /projects/old/tutorial/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/old/tutorial/README: -------------------------------------------------------------------------------- 1 | the examples in the tutorial 2 | ---------------------------- 3 | 4 | -------------------------------------------------------------------------------- /projects/old/tutorial/Util.hs: -------------------------------------------------------------------------------- 1 | module Util where 2 | 3 | import EasyVision 4 | import Numeric.LinearAlgebra 5 | import Classifier 6 | import Text.Printf 7 | 8 | readSelectedRois sz file = do 9 | roisraw <- readFile (file++".yuv.roi") 10 | let rois = map read (lines roisraw) :: [ROI] 11 | nframes = length rois 12 | cam <- mplayer (file++".yuv -benchmark") sz 13 | imgs <- sequence (replicate nframes cam) 14 | putStrLn $ show nframes ++ " cases in " ++ file 15 | return (zip imgs rois) 16 | 17 | createExamples commonproc candirois feat (img,roi) = ps ++ ns 18 | where candis = candirois (theROI img) 19 | imgproc = commonproc img 20 | ps = ejs "+" . sel (>0.5) $ candis 21 | ns = ejs "-" . sel (<0.2) $ candis 22 | ejs t = map (\r -> (overROI feat (r, imgproc), t)) 23 | sel c = filter (c.overlap roi) 24 | 25 | overROI feat (r, obj) = feat (modifyROI (const r) obj) 26 | 27 | shErr d c = putStrLn $ (printf "error %.3f" $ 100 * errorRate (quality d c)) ++ " %" 28 | shConf d c = putStrLn $ format " " (show.round) (confusion (quality d c)) 29 | -------------------------------------------------------------------------------- /projects/old/tutorial/canny.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | edges = canny (0.1,0.3) . gradients . gaussS 2 . float . grayscale 4 | 5 | main = run $ camera 6 | >>= observe "Canny's operator" (notI . edges) 7 | -------------------------------------------------------------------------------- /projects/old/tutorial/combi0.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | grid n = map (blockImage . splitEvery n) . splitEvery (n*n) . map (resize (mpSize 4)) 4 | where splitEvery _ [] = [] 5 | splitEvery k l = take k l : splitEvery k (drop k l) 6 | 7 | main = run $ camera ~> rgb 8 | ~~> grid 5 9 | >>= observe "grid" id 10 | -------------------------------------------------------------------------------- /projects/old/tutorial/combi1.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Util.Misc(splitEvery) 3 | 4 | grid n = map (blockImage . splitEvery n) . splitEvery (n*n) . map (resize (mpSize 4)) 5 | 6 | main = run $ camera ~> rgb 7 | >>= observe "original" id 8 | ~~> grid 2 9 | >>= observe "first grid" id 10 | ~~> grid 3 11 | >>= observe "second grid" id 12 | 13 | -------------------------------------------------------------------------------- /projects/old/tutorial/combi2.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | drift r a b = r .* a |+| (1-r) .* b 4 | 5 | main = run $ camera 6 | ~> float . grayscale 7 | ~~> scanl1 (drift 0.9) 8 | >>= observe "drift" id 9 | 10 | -------------------------------------------------------------------------------- /projects/old/tutorial/combi3.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | drift r a b = r .* a |+| (1-r) .* b 4 | 5 | interpolate (a:b:xs) = a: (0.5.*a |+| 0.5.*b) :interpolate (b:xs) 6 | 7 | main = run $ camera ~> float. grayscale 8 | ~~> scanl1 (drift 0.9) 9 | >>= observe "drift" id 10 | ~~> interpolate 11 | >>= zoomWindow "zoom" 600 toGray 12 | 13 | -------------------------------------------------------------------------------- /projects/old/tutorial/combi4.hs: -------------------------------------------------------------------------------- 1 | import EasyVision hiding (observe) 2 | import Util.Options 3 | 4 | observe winname = monitor' winname (mpSize 20) drawImage 5 | 6 | drift r a b = r .* a |+| (1-r) .* b 7 | interpolate (a:b:xs) = a: (0.5.*a |+| 0.5.*b) :interpolate (b:xs) 8 | 9 | main = do 10 | alpha <- getOption "--alpha" 0.9 11 | run $ camera ~> float . grayscale 12 | ~~> scanl1 (drift alpha) 13 | >>= observe "drift" 14 | ~~> interpolate 15 | >>= observe "interpolate" 16 | 17 | monitor' name sz fun cam = do 18 | w <- evWindow 0 name sz Nothing (const kbdQuit) 19 | return $ do 20 | thing <- cam 21 | n <- getW w 22 | inWin w $ do 23 | fun thing 24 | text2D 20 20 (show n) 25 | putW w (n+1) 26 | return thing 27 | -------------------------------------------------------------------------------- /projects/old/tutorial/conc-par.hs: -------------------------------------------------------------------------------- 1 | import EasyVision hiding (observe,run,camera,(.&.)) 2 | import Graphics.UI.GLUT(postRedisplay) 3 | import Control.Monad(liftM2) 4 | import Control.Arrow((***)) 5 | 6 | monitor' name sz fun = do 7 | w <- evWindow () name sz (Just (const fun)) (const kbdQuit) 8 | return $ postRedisplay (Just (evW w)) 9 | 10 | observe winname f a = monitor' winname (mpSize 12) (a >>= f) 11 | 12 | run n ws = sequence ws >>= launchFreq n . sequence_ 13 | 14 | camera k = findSize >>= getCam k ~> float . grayscale . channels 15 | 16 | (.&.) = liftM2 (liftM2 (,)) 17 | 18 | async f = asyncFun 0 id f 19 | infixl 1 -< 20 | f -< n = asyncFun 0 f n 21 | 22 | main = do 23 | prepare 24 | cams <- camera 0 .&. camera 1 >>= async 25 | 26 | feats <- g |***| g -< cams 27 | 28 | run 20 [ observe "cam1" (drawImage'.fst) cams 29 | , observe "cam2" (drawImage'.snd) cams 30 | , observe "f1" (sh.fst) feats 31 | , observe "f2" (sh.snd) feats 32 | ] 33 | 34 | sigmas = (take 15 $ getSigmas 1 3) 35 | fun img = (img, fullHessian (surf 2 2) sigmas 50 0.2 img) 36 | g = fun 37 | 38 | sh (img, feats) = do 39 | drawImage' img 40 | setColor 1 1 0 41 | text2D 20 20 (show $ length $ feats) 42 | mapM_ showFeat feats 43 | 44 | showFeat p = do 45 | drawROI $ roiFromPixel (ipRawScale p) (ipRawPosition p) 46 | let Pixel y x = ipRawPosition p 47 | drawVector x y (10*ipDescriptor (ip p)) 48 | -------------------------------------------------------------------------------- /projects/old/tutorial/conc0.hs: -------------------------------------------------------------------------------- 1 | import EasyVision hiding (run,observe,(.&.)) 2 | import Graphics.UI.GLUT(postRedisplay) 3 | import Control.Monad(liftM2) 4 | 5 | monitor' name sz fun = do 6 | w <- evWindow () name sz (Just (const fun)) (const kbdQuit) 7 | return $ postRedisplay (Just (evW w)) 8 | 9 | observe winname f a = monitor' winname (mpSize 20) (a >>= drawImage.f) 10 | 11 | run n ws = sequence ws >>= launchFreq n . sequence_ 12 | 13 | async f = asyncFun 0 id f 14 | 15 | infixl 1 -< 16 | (f,d) -< n = asyncFun d f n 17 | 18 | (.&.) = liftM2 (,) 19 | 20 | hz d = 10^6 `div` d 21 | 22 | main = do 23 | prepare 24 | 25 | cam <- findSize >>= getCam 0 >>= async ~> channels 26 | x <- (float . grayscale , hz 2) -< cam 27 | s <- (float.highPass8u Mask5x5 . grayscale , hz 30) -< cam 28 | dif <- (\(u,v) -> (0.8 .* u |+| 0.2 .* v), hz 25) -< x .&. s 29 | 30 | run 20 [ observe "cam" rgb cam 31 | , observe "dif" id dif 32 | , observe "s" id s 33 | , observe "x" id x 34 | ] 35 | -------------------------------------------------------------------------------- /projects/old/tutorial/conc1.hs: -------------------------------------------------------------------------------- 1 | import EasyVision hiding (observe,run,camera) 2 | import Graphics.UI.GLUT(postRedisplay) 3 | 4 | monitor' name sz fun = do 5 | w <- evWindow () name sz (Just (const fun)) (const kbdQuit) 6 | return $ postRedisplay (Just (evW w)) 7 | 8 | observe winname f a = monitor' winname (mpSize 20) (a >>= f) 9 | 10 | run n ws = sequence ws >>= launchFreq n . sequence_ 11 | 12 | camera k = findSize >>= getCam k >>= async ~> channels 13 | 14 | async f = asyncFun 0 id f 15 | infixl 1 -< 16 | f -< n = asyncFun 0 f n 17 | 18 | main = do 19 | prepare 20 | cam1 <- camera 0 21 | cam2 <- camera 1 22 | 23 | feat1 <- fun . float . grayscale -< cam1 24 | feat2 <- fun . float . grayscale -< cam2 25 | 26 | run 20 [ observe "cam1" (drawImage.rgb) cam1 27 | , observe "cam2" (drawImage.rgb) cam2 28 | , observe "f1" sh feat1 29 | , observe "f2" sh feat2 30 | ] 31 | 32 | sigmas = (take 15 $ getSigmas 1 3) 33 | 34 | fun img = (img, fullHessian (surf 2 2) sigmas 50 0.2 img) 35 | 36 | sh (img, feats) = do 37 | drawImage img 38 | setColor 1 1 0 39 | text2D 20 20 (show $ length $ feats) 40 | mapM_ showFeat feats 41 | 42 | showFeat p = do 43 | drawROI $ roiFromPixel (ipRawScale p) (ipRawPosition p) 44 | -- let Pixel y x = ipRawPosition p 45 | -- drawVector x y (10*ipDescriptor (ip p)) 46 | -------------------------------------------------------------------------------- /projects/old/tutorial/offline.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Data.List(foldl1',tails) 3 | 4 | edges = canny (0.05,0.2) . gradients . gaussS 2 . float . grayscale 5 | 6 | history k = map (notI . foldl1' orI . reverse . take k) . tail . tails 7 | 8 | main = run $ camera 9 | >>= observe "original" rgb 10 | ~~> history 5 . map edges 11 | >>= observe "edge history" id 12 | >>= saveFrame toYUV 13 | -------------------------------------------------------------------------------- /projects/old/tutorial/offline0.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | edges = notI . canny (0.05,0.2) . gradients . gaussS 2 . float . grayscale 4 | 5 | main = process (map edges) 6 | -------------------------------------------------------------------------------- /projects/old/tutorial/offline3.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | 4 | f = resize (mpSize 15) . grayscale . channels 5 | 6 | g = notI . canny (0.1,0.3) . gradients . gaussS 2 . float 7 | 8 | main = do 9 | prepare 10 | xs <- map f `fmap` readFrames 0 11 | let ys = map g $ xs 12 | zs = zipWith (\a b -> blockImage [[a,b]]) ys xs 13 | watchList "orig" xs 14 | watchList "canny" ys 15 | watchList "both" zs 16 | mainLoop 17 | 18 | watchList title zs = watch title (size (head zs)) (\k ims -> drawImage (ims!!k)) (inf zs) 19 | where inf xs = xs ++ repeat (last xs) 20 | 21 | watch title sz f x = evWindow 0 title sz (Just disp) (mouseGen acts kbdQuit) 22 | where 23 | disp st = do 24 | k <- get st 25 | f k x 26 | windowTitle $= (title ++ ": frame #"++ show k) 27 | acts = [((MouseButton WheelUp, Down, modif), \ _ k -> k +1) 28 | ,((MouseButton WheelDown, Down, modif), \ _ k -> max 0 (k-1))] 29 | 30 | -------------------------------------------------------------------------------- /projects/old/tutorial/parallel.hs: -------------------------------------------------------------------------------- 1 | import EasyVision hiding (camera, observe, (.&.)) 2 | import Control.Arrow 3 | import Control.Monad 4 | import Debug.Trace 5 | import Numeric.LinearAlgebra 6 | import Util.Options 7 | 8 | camera k = findSize >>= getCam k ~> channels 9 | observe winname f = monitor winname (mpSize 20) f 10 | (.&.) = liftM2 (liftM2 (,)) 11 | 12 | sigmas = (take 15 $ getSigmas 1 3) 13 | 14 | fun img = (img, fullHessian (surf 2 2) sigmas 50 0.2 img) 15 | 16 | g = fun.float.grayscale 17 | 18 | sh (img, feats) = do 19 | drawImage' img 20 | setColor 1 1 0 21 | text2D 20 20 (show $ length $ feats) 22 | mapM_ showFeat feats 23 | 24 | showFeat p = do 25 | drawROI $ roiFromPixel (ipRawScale p) (ipRawPosition p) 26 | let Pixel y x = ipRawPosition p 27 | drawVector x y (10*ipDescriptor (ip p)) 28 | 29 | 30 | main' op = run $ (camera 0 .&. camera 1) 31 | >>= observe "img 0" (drawImage'.rgb.fst) 32 | >>= observe "img 1" (drawImage'.rgb.snd) 33 | ~> g `op` g 34 | >>= observe "feats 0" (sh.fst) 35 | >>= observe "feats 1" (sh.snd) 36 | 37 | main = do 38 | two <- getFlag "-2" 39 | if two then main' (|***|) else main' (***) 40 | -------------------------------------------------------------------------------- /projects/old/tutorial/param1.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | smooth cam = do 4 | o <- createParameters [("sigma",realParam 3 0 20)] 5 | return $ do 6 | x <- cam 7 | sigma <- getParam o "sigma" 8 | return (gaussS sigma x) 9 | 10 | main = run $ camera ~> float . grayscale >>= smooth >>= observe "gauss" id 11 | -------------------------------------------------------------------------------- /projects/old/tutorial/param1a.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import EasyVision 4 | 5 | autoParam "Param" "" 6 | [("sigma","Float",realParam 3 0 20)] 7 | 8 | 9 | main = run $ (winParam ~> sigma .&. camera ~> float . grayscale) 10 | >>= observe "gauss" (uncurry gaussS) 11 | 12 | -------------------------------------------------------------------------------- /projects/old/tutorial/param2.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | import Control.Arrow 4 | import Control.Applicative 5 | 6 | camera' = camera ~> (grayscale >>> float) 7 | 8 | data Param = Param { sigma :: Float, rad :: Int, thres :: Float } 9 | 10 | main = run $ (camera' .&. userParam) 11 | ~> fst &&& corners 12 | >>= monitor "corners" (mpSize 20) sh 13 | 14 | corners (x,p) = gaussS (sigma p) 15 | >>> gradients 16 | >>> hessian 17 | >>> fixscale 18 | >>> thresholdVal32f (thres p) 0 IppCmpLess 19 | >>> localMax (rad p) 20 | >>> getPoints32f 100 21 | $ x 22 | 23 | fixscale im = (1/mn) .* im 24 | where (mn,_) = EasyVision.minmax im 25 | 26 | sh (im, pts) = do 27 | drawImage im 28 | pointSize $= 5; setColor 1 0 0 29 | renderPrimitive Points $ mapM_ vertex pts 30 | 31 | userParam = do 32 | o <- createParameters [("sigma",realParam 3 0 20), 33 | ("rad" ,intParam 4 1 25), 34 | ("thres",realParam 0.6 0 1)] 35 | return $ Param <$> getParam o "sigma" 36 | <*> getParam o "rad" 37 | <*> getParam o "thres" 38 | 39 | -------------------------------------------------------------------------------- /projects/old/tutorial/param2a.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards, NamedFieldPuns #-} 2 | 3 | import EasyVision 4 | import Graphics.UI.GLUT 5 | import Control.Arrow 6 | import Control.Monad 7 | 8 | $(autoParam "Param" "" 9 | [("sigma","Float", realParam 3 0 20), 10 | ("rad" ,"Int", intParam 4 1 25), 11 | ("thres","Float", realParam 0.6 0 1)]) 12 | 13 | main = run $ (camera ~> grayscale ~> float .&. winParam) 14 | ~> fst &&& corners 15 | >>= monitor "corners" (mpSize 20) sh 16 | 17 | corners (x,Param{..}) = 18 | gaussS sigma 19 | >>> gradients 20 | >>> hessian 21 | >>> fixscale 22 | >>> thresholdVal32f thres 0 IppCmpLess 23 | >>> localMax rad 24 | >>> getPoints32f 100 25 | $ x 26 | 27 | fixscale im = (1/mn) .* im 28 | where (mn,_) = EasyVision.minmax im 29 | 30 | sh (im, pts) = do 31 | drawImage im 32 | pointSize $= 5; setColor 1 0 0 33 | renderPrimitive Points $ mapM_ vertex pts 34 | -------------------------------------------------------------------------------- /projects/old/tutorial/param2a2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import EasyVision 4 | import Graphics.UI.GLUT 5 | 6 | autoParam "Param" "corners-" 7 | [("sigma","Float", realParam 3 0 20), 8 | ("rad" ,"Int", intParam 4 1 25), 9 | ("thres","Float", realParam 0.3 0 1)] 10 | 11 | main = run $ camera ~> grayscale >>= corners .@. winParam >>= shCor 12 | 13 | corners Param{..} = getPts 100 rad thres . hessian . gradients . gaussS sigma . float 14 | 15 | --------------------- 16 | 17 | getPts n r t = getPoints32f n . localMax r . thresholdVal32f t 0 IppCmpLess . fixscale 18 | 19 | fixscale im = (1/mn) .* im 20 | where (mn,_) = EasyVision.minmax im 21 | 22 | shCor = monitor "corners" (mpSize 20) sh where 23 | sh (im,pts) = do 24 | drawImage im 25 | pointSize $= 5; setColor 1 0 0 26 | renderPrimitive Points $ mapM_ vertex pts 27 | -------------------------------------------------------------------------------- /projects/old/tutorial/param3.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | 4 | main = do 5 | prepare 6 | sz <- findSize 7 | cam <- getCam 0 sz ~> float . grayscale . channels 8 | o <- createParameters [("sigma",realParam 3 0 20), 9 | ("rad" ,intParam 4 1 25), 10 | ("thres",realParam 0.6 0 1)] 11 | w <- evWindow () "corners" sz Nothing (const kbdQuit) 12 | launch $ do 13 | img <- cam 14 | sigma <- getParam o "sigma" 15 | rad <- getParam o "rad" 16 | thres <- getParam o "thres" 17 | let corners = getPoints32f 100 18 | . localMax rad 19 | . thresholdVal32f thres 0 IppCmpLess 20 | . fixscale 21 | . hessian 22 | . gradients 23 | . gaussS sigma 24 | $ img 25 | inWin w $ do 26 | drawImage img 27 | pointSize $= 5; setColor 1 0 0 28 | renderPrimitive Points $ mapM_ vertex corners 29 | 30 | fixscale im = (1/mn) .* im 31 | where (mn,_) = EasyVision.minmax im 32 | -------------------------------------------------------------------------------- /projects/old/tutorial/param4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import EasyVision 4 | 5 | drift (_,a) (r,b) = (r, r .* a |+| (1-r) .* b) 6 | 7 | autoParam "Param" "" [("alpha","Float",realParam 0.9 0 1)] 8 | 9 | main = run $ (winParam ~> alpha .&. camera ~> float . grayscale) 10 | ~~> scanl1 drift 11 | >>= mon 12 | >>= timeMonitor 13 | 14 | mon = monitor "drift with param" (mpSize 10) sh 15 | where 16 | sh (a,im) = do 17 | drawImage' im 18 | text2D 30 30 (show a) 19 | 20 | -------------------------------------------------------------------------------- /projects/old/tutorial/pipeline.hs: -------------------------------------------------------------------------------- 1 | -- time ./pipeline 'video.avi -benchmark -loop 1 -frames 100' +RTS -N2 2 | -- time ./pipeline 'video.avi -benchmark -loop 1 -frames 100' '--levels=(1,20)' +RTS -N2 3 | import EasyVision 4 | import Util.Options 5 | 6 | compose = foldr (.) id 7 | 8 | expensive k = compose (replicate k f) where 9 | f im = resize (size im) . block . gaussS 10 $ im 10 | block im = blockImage [[im,im],[im,im]] 11 | 12 | balance f = compose . map (pipeline . f) 13 | 14 | main = do 15 | s <- getOption "--stages" =<< uncurry replicate `fmap` getOption "--levels" (20,1) 16 | putStrLn $ "stages = " ++ show s 17 | 18 | run $ camera ~> float . grayscale 19 | >>= observe "original" id 20 | ~~> balance expensive s 21 | >>= observe "result" id 22 | -------------------------------------------------------------------------------- /projects/old/tutorial/play.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = run $ camera >>= observe "Video" rgb 4 | -------------------------------------------------------------------------------- /projects/old/tutorial/play2.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | f = gaussS 5.7 . float . grayscale 4 | 5 | main = run (camera >>= observe "Gauss" f) 6 | -------------------------------------------------------------------------------- /projects/old/tutorial/play3.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = run $ camera 4 | >>= observe "original" rgb 5 | ~> highPass8u Mask5x5 . median Mask5x5 . grayscale 6 | >>= observe "high-pass filter" id 7 | -------------------------------------------------------------------------------- /projects/old/tutorial/playll.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = do 4 | prepare 5 | sz <- findSize 6 | c <- getCam 0 sz 7 | w <- evWindow () "simple player" sz Nothing (const kbdQuit) 8 | launch (worker c w) 9 | 10 | worker cam win = do 11 | img <- cam 12 | inWin win $ do 13 | drawImage img 14 | -------------------------------------------------------------------------------- /projects/old/tutorial/points.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | import Control.Arrow 4 | 5 | save filename f cam = do 6 | writeFile filename "" 7 | return $ do 8 | x <- cam 9 | appendFile filename (show (f x)++"\n") 10 | return x 11 | 12 | sh (im, pts) = do 13 | drawImage im 14 | pointSize $= 5; setColor 1 0 0 15 | renderPrimitive Points $ mapM_ vertex pts 16 | 17 | salience s1 s2 = gaussS' 2.5 s2 . sqrt32f . abs32f . hessian . gradients . gaussS' 2.5 s1 18 | 19 | thres r im = thresholdVal32f (mx*r) 0 IppCmpLess im 20 | where (_,mx) = EasyVision.minmax im 21 | 22 | main = run $ camera ~> grayscale 23 | ~> id &&& (getPoints32f 300 . localMax 1 . thres 0.5 . salience 2 4 . float) 24 | >>= monitor "Corners" (mpSize 20) sh 25 | >>= save "points.txt" snd 26 | -------------------------------------------------------------------------------- /projects/old/tutorial/roi1.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = run $ camera ~> grayscale 4 | >>= selectROI "ROI" id 5 | >>= observe "invert" (notI . uncurry (flip setROI)) 6 | 7 | 8 | -------------------------------------------------------------------------------- /projects/old/tutorial/roibrowse.hs: -------------------------------------------------------------------------------- 1 | -- $ ./roibrowse selected.yuv 2 | -- Browses selected.yuv / selected.yuv.roi with mouse wheel 3 | import EasyVision 4 | import Graphics.UI.GLUT 5 | import System.Environment(getArgs) 6 | import qualified Data.Colour.Names as Col 7 | 8 | main = do 9 | prepare 10 | sz <- findSize 11 | file:_ <- getArgs 12 | roisraw <- readFile (file++".roi") 13 | let rois = map read (lines roisraw) :: [ROI] 14 | nframes = length rois 15 | cam <- mplayer (file++" -benchmark") sz 16 | imgs <- sequence (replicate nframes cam) 17 | putStrLn $ show nframes ++ " cases" 18 | seeRois imgs rois 19 | mainLoop 20 | 21 | seeRois imgs rois = evWindow 0 "Selected ROI" (mpSize 20) (Just disp) (mouse kbdQuit) 22 | where 23 | disp st = do 24 | k <- get st 25 | drawImage (imgs!!k) 26 | lineWidth $= 3; setColor' Col.yellow 27 | drawROI (rois!!k) 28 | text2D 50 50 (show $ k+1) 29 | mouse _ st (MouseButton WheelUp) Down _ _ = do 30 | updateW st (min (length imgs -1) . (+1)) 31 | postRedisplay Nothing 32 | mouse _ st (MouseButton WheelDown) Down _ _ = do 33 | updateW st (max 0 . subtract 1) 34 | postRedisplay Nothing 35 | mouse def _ a b c d = def a b c d 36 | -------------------------------------------------------------------------------- /projects/old/tutorial/roisel.hs: -------------------------------------------------------------------------------- 1 | -- $ ./roisel source --save=selected.yuv 2 | -- SPACE to stop video, mark region with mouse right button, 3 | -- S to save desired frame/region, ESC to end. 4 | import EasyVision 5 | import Graphics.UI.GLUT 6 | import Control.Monad(when) 7 | import Util.Options 8 | 9 | main = do 10 | sz <- findSize 11 | (cam,ctrl) <- getCam 0 sz >>= withPause 12 | prepare 13 | mbname <- getRawOption "--save" 14 | let name = case mbname of 15 | Nothing -> error "--save=filename.yuv is required" 16 | Just nm -> nm 17 | w <- evWindow False "Press S to save frame" 18 | sz Nothing (mouse (kbdcam ctrl)) 19 | save <- optionalSaver sz 20 | 21 | launch $ do 22 | orig <- cam 23 | rec <- getW w 24 | roi <- getROI w 25 | inWin w $ do 26 | drawImage orig 27 | drawROI roi 28 | when rec $ do 29 | save orig 30 | appendFile (name++".roi") (show roi++"\n") 31 | putW w False 32 | 33 | mouse _ st (Char 's') Down _ _ = putW st True 34 | mouse def _ a b c d = def a b c d 35 | -------------------------------------------------------------------------------- /projects/old/tutorial/simple.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | import System.Environment(getArgs) 4 | 5 | main = do 6 | sz <- findSize 7 | file:_ <- getArgs 8 | prepare 9 | cam <- mplayer ("mf://"++file) sz 10 | img <- cam 11 | 12 | let x = float. grayscale . channels $ img 13 | 14 | watch "Image" (const id) img 15 | watch "3 * 4" (const $ gaussS 3 . gaussS 4) x 16 | watch "Gaussian" (gaussS . fromIntegral) x 17 | 18 | mainLoop 19 | 20 | watch title f img = evWindow 0 title (size img) (Just disp) (mouse kbdQuit) 21 | where 22 | disp st = do 23 | k <- get st 24 | drawImage (f k img) 25 | text2D 15 15 (show k) 26 | mouse _ st (MouseButton WheelUp) Down _ _ = do 27 | updateW st (+1) 28 | postRedisplay Nothing 29 | mouse _ st (MouseButton WheelDown) Down _ _ = do 30 | updateW st (max 0 . subtract 1) 31 | postRedisplay Nothing 32 | mouse def _ a b c d = def a b c d 33 | -------------------------------------------------------------------------------- /projects/old/tutorial/state.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | 4 | main = do 5 | sz <- findSize 6 | prepare 7 | cam <- getCam 0 sz ~> channels 8 | w <- evWindow (True,undefined) "bg diff" sz Nothing (mouse kbdQuit) 9 | launch $ do 10 | img <- fmap grayscale cam 11 | (rec,bg) <- getW w 12 | if rec 13 | then putW w (False, img) 14 | else inWin w $ drawImage $ absDiff8u img bg 15 | 16 | mouse _ st (Char 's') Down _ _ = putW st (True,undefined) 17 | mouse def _ a b c d = def a b c d 18 | -------------------------------------------------------------------------------- /projects/old/tutorial/state2.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | import Graphics.UI.GLUT 3 | import Control.Monad(when) 4 | 5 | main = run (camera ~> grayscale >>= bgDiff) 6 | 7 | bgDiff cam = do 8 | w <- evWindow (True,undefined) "bg diff" (mpSize 20) Nothing (mouse kbdQuit) 9 | return $ do 10 | img <- cam 11 | (rec,_) <- getW w 12 | when rec (putW w (False, img)) 13 | (_,bg) <- getW w 14 | let r = absDiff8u img bg 15 | inWin w $ drawImage r 16 | return r 17 | where 18 | mouse _ st (Char 's') Down _ _ = putW st (True,undefined) 19 | mouse def _ a b c d = def a b c d 20 | -------------------------------------------------------------------------------- /projects/old/tutorial/state3.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = run $ camera ~> grayscale >>= getBackground 4 | 5 | getBackground = clickStatusWindow "background difference" (mpSize 10) Nothing f g h 6 | where 7 | f x _ = Just x 8 | h _ _ = return () 9 | g x Nothing = drawImage' x 10 | g x (Just bg) = drawImage' $ absDiff8u x bg 11 | 12 | -------------------------------------------------------------------------------- /projects/old/tutorial/zip.hs: -------------------------------------------------------------------------------- 1 | import EasyVision 2 | 3 | main = run $ camera ~> grayscale ~~> zip [0..] >>= mon 4 | 5 | mon = monitor "image and frame #" (mpSize 10) sh 6 | where 7 | sh (k,im) = do 8 | drawImage' im 9 | text2D 30 30 (show k) 10 | 11 | -------------------------------------------------------------------------------- /projects/old/vision/Makefile: -------------------------------------------------------------------------------- 1 | ../Makefile -------------------------------------------------------------------------------- /projects/opencv/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.include 2 | 3 | -------------------------------------------------------------------------------- /projects/opencv/blur.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI.Simple 4 | import Image 5 | import Image.Devel(gray2float,float2gray) 6 | import Numeric.LinearAlgebra ((<>),ident) 7 | import Vision(ht,desp,scaling,kgen) 8 | import Util.Rotation 9 | import Util.Misc(degree) 10 | import Util.Geometry(Polyline(..)) 11 | import qualified OpenCV 12 | 13 | autoParam "CGParam" "" 14 | [ ("sigma", "Double", realParam (1) (0) (20)) 15 | ] 16 | 17 | main = run $ arr yCh 18 | >>> blur @@@ winParam 19 | >>> observe "blur" id 20 | 21 | blur par@CGParam{..} img = OpenCV.gaussianBlur sigma img 22 | 23 | -------------------------------------------------------------------------------- /projects/opencv/face.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Image.ROI(roi2poly) 4 | import qualified OpenCV 5 | 6 | main = do 7 | faceDetector <- OpenCV.cascadeClassifier "/usr/share/opencv/haarcascades/haarcascade_frontalface_alt.xml" 8 | run $ arr yCh 9 | >>> observe "opencv face detector" (sh faceDetector) 10 | 11 | sh f x = Draw [ Draw x, lineWd 3 faces ] 12 | where 13 | faces = map (roi2poly (size x)) (f x 1) 14 | 15 | -------------------------------------------------------------------------------- /projects/opencv/homography.hs: -------------------------------------------------------------------------------- 1 | -- findHomography from OpenCV does not get minimum RMS error? 2 | 3 | import Devel.Vision.DLT 4 | import OpenCV (findHomography) 5 | import Numeric.LinearAlgebra 6 | import Util.Homogeneous((!<>)) 7 | import Util.Geometry 8 | import Vision 9 | import Numeric.LinearAlgebra.Util(norm) 10 | 11 | a = (5><2) 12 | [0,0 13 | ,1,0 14 | ,1,1 15 | ,0,1 16 | ,0,1.5] :: Matrix Double 17 | 18 | 19 | t = (3><3) 20 | [ 1,2,3 21 | , 0,2,4 22 | , 2,0,1 ] 23 | 24 | 25 | b = a !<> trans t + (5><2) [0,0,0,0,0,0,0,0,0,0.5] 26 | 27 | h1 = findHomography b a 28 | h2 = estimateHomography (toLists b) (toLists a) 29 | 30 | main = do 31 | print (rank t) 32 | print b 33 | print h1 34 | print (normat3 h2) 35 | print $ norm $ flatten $ (a!<>h1-b) 36 | print $ norm $ flatten $ (a!<>h2-b) 37 | 38 | -------------------------------------------------------------------------------- /projects/opencv/hough.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image.Capture ( readImages ) 3 | import Image.Devel ( rgb2gray ) 4 | import qualified OpenCV ( hough, canny ) 5 | 6 | main = do 7 | [img] <- readImages ["../../data/images/calibration/cube3.png"] 8 | let x = rgb2gray img 9 | y = OpenCV.canny x 10 | seg = OpenCV.hough 50 y 11 | 12 | runIt $ browser "canny" [y,x] (const Draw) 13 | >> browser "hough" [Draw [Draw x, color red $ seg]] (const id) 14 | 15 | -------------------------------------------------------------------------------- /projects/opencv/surf.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Image.ROI(roi2poly) 4 | import qualified OpenCV 5 | 6 | main = do 7 | run $ arr yCh 8 | >>> observe "opencv SURF detector" (shSURF) 9 | 10 | shSURF g = Draw [Draw g, color red . pointSz 5 $ pts] 11 | where 12 | pts = OpenCV.surf 1000 g 13 | 14 | -------------------------------------------------------------------------------- /projects/opencv/testwebcam.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import qualified OpenCV 3 | 4 | cam = OpenCV.webcam "/dev/video1" (Size 600 800) 30 5 | 6 | main = do 7 | runT_ cam (observe "source" id >>> freqMonitor) 8 | -------------------------------------------------------------------------------- /projects/opencv/undistort.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI.Simple 4 | import Image 5 | import Numeric.LinearAlgebra.HMatrix 6 | import qualified OpenCV 7 | 8 | autoParam "RDParam" "cg-" 9 | [ ("k1", "Double", realParam (0) (-1) 1) 10 | ] 11 | 12 | main = run $ arr yCh 13 | >>> observe "original" id 14 | >>> undistort @@@ winParam 15 | >>> observe "undistorted" id 16 | 17 | undistort par@RDParam{..} img = OpenCV.undistort8u k d k img 18 | where 19 | f = 1.6 20 | k = matrix 3 [f*320, 0 , 320 21 | , 0 , f*320, 240 22 | , 0 , 0, 1 ] 23 | d = vector [k1,0,0,0] 24 | 25 | -------------------------------------------------------------------------------- /projects/other/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.include 2 | 3 | -------------------------------------------------------------------------------- /projects/other/koch3.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Util.Geometry 3 | import Util.Misc(degree) 4 | 5 | main = animate 20000 (Size 600 600) "Koch snowflake" frame 6 | 7 | frame n = Draw 8 | [ -- text (Point 0.9 0.8) (show n), 9 | color orange . lineWd 3 10 | $ snowflake (mod n 100) (mod (div n 100) 6) (rotPoint z a p1) (rotPoint z a p2) 11 | ] 12 | where 13 | p1 = Point (-0.6) (-0.4) 14 | p2 = Point (0.6) (-0.4) 15 | z = Point 0 0 16 | a = fromIntegral n * 0.1*degree 17 | 18 | 19 | snowflake m n p1 p2 = Draw 20 | [ koch m n p1 p2 21 | , koch m n p2 p3 22 | , koch m n p3 p1 23 | ] 24 | where 25 | p3 = rotPoint p1 (60*degree) p2 26 | 27 | koch m 0 p1 p2 = Draw $ Open [p1, p2] 28 | koch m n p1 p2 = Draw 29 | [ koch m (n-1) p1 p3 30 | , koch m (n-1) p3 p4' 31 | , koch m (n-1) p4' p5 32 | , koch m (n-1) p5 p2 33 | ] 34 | where 35 | p3 = interPoint (1/3) p1 p2 36 | p5 = interPoint (2/3) p1 p2 37 | p4 = rotPoint p3 (-60*degree) p5 38 | p6 = interPoint 0.5 p1 p2 39 | p4' = interPoint f p4 p6 40 | f = 1-fromIntegral m' / 100 41 | m' = if n == 1 then m else 100 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /projects/patrec/.gitignore: -------------------------------------------------------------------------------- 1 | bayesgauss 2 | cs 3 | democlass 4 | demotest 5 | em 6 | ferns 7 | gptest 8 | graph 9 | median 10 | pls 11 | probability 12 | scatters 13 | ukf 14 | 15 | -------------------------------------------------------------------------------- /projects/patrec/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.include 2 | 3 | demo: 4 | ./democlass 5 | ./demotest 6 | ./scatters 7 | ./em 8 | ./ferns 9 | ./pls 10 | ./probability 11 | ./bayesgauss 12 | ./cs 13 | ./graph 14 | ./gptest 15 | ./median 16 | ./ukf 17 | ./seecov 18 | ./seemix 19 | 20 | -------------------------------------------------------------------------------- /projects/patrec/bayesgauss.hs: -------------------------------------------------------------------------------- 1 | -- bayes inference for gaussians 2 | 3 | import Numeric.LinearAlgebra 4 | import Util.Gaussian 5 | import Util.Misc(vec,mat) 6 | 7 | ---------------------------------------------------------------------- 8 | 9 | main = test 10 | 11 | disp = putStr . dispf 2 12 | 13 | z = N me co 14 | where 15 | me = vec [1,2,3,4] 16 | 17 | co = (4><4) [4, 2, 1, 0 18 | ,2, 4, 2, 1 19 | ,1, 2, 4, 2 20 | ,0, 1, 2, 4] 21 | 22 | 23 | test = do 24 | print $ conditional (vec [3]) $ jointLinear (N 0 4) 2 (N 5 1) 25 | print $ bayesGaussianLinear (vec [3]) (N 0 4) 2 (N 5 1) 26 | print $ bayesGaussianLinearK (vec [3]) (N 0 4) 2 (N 5 1) 27 | putStrLn "--------------------" 28 | let h = (2><4) [1,0,2,-3, 29 | 0,3,-1,7] 30 | o = vec [-1,3] 31 | r = (2><2) [4,1,1,4] 32 | y = vec [3,5] 33 | print $ jointLinear z h (N o r) 34 | print $ conditional y $ jointLinear z h (N o r) 35 | print $ bayesGaussianLinear y z h (N o r) 36 | print $ bayesGaussianLinearK y z h (N o r) 37 | 38 | -------------------------------------------------------------------------------- /projects/patrec/em.hs: -------------------------------------------------------------------------------- 1 | 2 | import Numeric.LinearAlgebra 3 | import Util.Gaussian 4 | import Util.Misc ( vec ) 5 | import Vision.GUI.Simple 6 | 7 | ---------------------------------------------------------------------- 8 | 9 | disp = putStr . dispf 2 10 | 11 | scw title p mix = browser title xs (const id) 12 | where 13 | xs = [scatter p (0,1) [] (shMix mix) ] 14 | 15 | scws title p mixs = browser title xs (const id) 16 | where 17 | xs = map (\m -> scatter p (0,1) [] (shMix m) ) mixs 18 | 19 | shMix mix = lineWd 3 . color black . map (drawGaussian.snd) $ mix 20 | 21 | drawGaussian g = Draw (ellipCov2D 2 g) 22 | 23 | ---------------------------------------------------------------------- 24 | 25 | cl1 = N (vec [0,0]) ((2><2) [2,0,0,1]) 26 | cl2 = N (vec [5,5]) ((2><2) [4,-2,-2,4]) 27 | cl3 = N (vec [0,5]) ((2><2) [1,0,0,1]) 28 | cl4 = N (vec [5,0]) ((2><2) [0.5,0.2,0.2,3]) 29 | 30 | m = [(0.25,cl1), (0.25,cl2), (0.25,cl3), (0.25,cl4)] 31 | 32 | dt = sampleMixture [7000,8000 ..] 1000 m 33 | 34 | main = runIt $ testEM >> testEMSeq 35 | 36 | testEMSeq = do 37 | let ms = emSeq dt 38 | mapM_ (print.snd) (take 10 ms) 39 | scws "EM" (map (id&&&const"1") (toRows dt)) (map fst $ take 10 ms) 40 | 41 | testEM = do 42 | let f m = scw ("EM MDL "++show (length m)) (map (id&&&const"1") (toRows dt)) m 43 | f (findMixture dt) 44 | 45 | -------------------------------------------------------------------------------- /projects/patrec/seecov.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Util.Geometry 3 | import Numeric.LinearAlgebra 4 | import Util.Gaussian 5 | import Util.Debug(debug) 6 | 7 | 8 | main :: IO () 9 | main = do 10 | runIt $ clickPoints "click points" "--points" () sh 11 | 12 | sh :: ([Point], ()) -> Drawing 13 | sh (ps,()) = clearColor white [ if okc then drwc else if okm then drwm else Draw () 14 | , pointSz 3 . color red $ ps 15 | ] 16 | where 17 | (m,c) = meanCov $ datMat $ ps 18 | mp = unsafeFromVector m :: Point 19 | drwm = pointSz 5 . color blue $ mp 20 | drwc = color blue $ map (flip ellipCov2D (N m c)) [0.75,1.5,3] 21 | okm = length ps > 0 22 | okc = length ps > 2 23 | 24 | -------------------------------------------------------------------------------- /projects/patrec/seemix.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Util.Geometry 3 | import Numeric.LinearAlgebra 4 | import Util.Gaussian 5 | 6 | main :: IO () 7 | main = do 8 | runIt $ clickPoints "click points" "--points" () sh 9 | 10 | sh :: ([Point], ()) -> Drawing 11 | sh (ps,()) = Draw [ if okc then drwmix else Draw () 12 | , pointSz 3 . color red $ ps 13 | ] 14 | where 15 | x = datMat ps 16 | (m,c) = meanCov x 17 | mp = unsafeFromVector m :: Point 18 | drwm = pointSz 5 . color blue $ mp 19 | drwc = color blue $ ellipCov2D 2 (N m c) 20 | okm = length ps > 0 21 | okc = length ps > 3 22 | mix = findMixture x 23 | drwmix = color blue $ map (ellipCov2D 2 . snd) mix 24 | 25 | -------------------------------------------------------------------------------- /projects/tour/.gitignore: -------------------------------------------------------------------------------- 1 | arrIO 2 | arrows 3 | batch 4 | batch2 5 | choice 6 | circuit 7 | clickPoints 8 | connect 9 | contrib 10 | draw 11 | draw3DParam 12 | drawParam 13 | fast-slow 14 | grid 15 | interactive3D 16 | interface 17 | loop 18 | nocircuit 19 | nogui 20 | param 21 | param2 22 | param3 23 | passROI 24 | play 25 | play0 26 | play1 27 | play3 28 | play4 29 | play5 30 | play6 31 | runS 32 | scanl1 33 | single 34 | smon 35 | stand1 36 | stand2 37 | stand3 38 | 39 | -------------------------------------------------------------------------------- /projects/tour/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.include 2 | 3 | demo: 4 | ./play 5 | ./play1 6 | ./play1 '../../data/videos/rot4.avi -benchmark' 7 | ./grid 8 | ./play3 '../../data/videos/rot4.avi -fps 30' --live 9 | ./play3 '../../data/videos/rot4.avi -fps 30' --chan 10 | ./play3 11 | ./arrows 12 | ./choice 13 | ./loop 14 | ./nocircuit ../../data/videos/rcube.avi 15 | ./circuit ../../data/videos/rcube.avi 16 | ./smon 17 | ./play4 18 | ./play5 19 | ./interface 20 | ./param 21 | ./stand1 22 | ./stand2 23 | ./stand3 24 | ./nogui '../../data/videos/rot4.avi -benchmark' 25 | ./batch '../../data/videos/rot4.avi -benchmark' 26 | ./single ../../data/images/transi/dscn2070.jpg \ 27 | ../../data/images/transi/dscn2070.jpg 28 | 29 | ./play6 30 | ./play0 31 | 32 | -------------------------------------------------------------------------------- /projects/tour/arrIO.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = run $ observe "img" rgb >>> arrIO (print . size . grayscale) 5 | 6 | -------------------------------------------------------------------------------- /projects/tour/arrows.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = run $ observe "source" rgb 7 | >>> arr grayscale 8 | >>> p 9 | >>> observe "result" (5.*) 10 | 11 | p = proc g -> do 12 | let f = toFloat g 13 | x <- observe "x" id -< f 14 | s <- (observe "s" id <<< arr (gaussS 5)) -< f 15 | observe "inverted" notI -< g 16 | returnA -< x |-| s 17 | 18 | -------------------------------------------------------------------------------- /projects/tour/batch.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = do 5 | x <- runT camera $ observe "image" rgb 6 | >>> arr (sumPixels.grayscale) 7 | print (sum $ take 1000 x) 8 | 9 | -------------------------------------------------------------------------------- /projects/tour/batch2.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Util.Debug(debug) 4 | 5 | main = run $ observe "image" rgb 6 | >>> arr (debug "S" (sumPixels.grayscale)) 7 | 8 | -------------------------------------------------------------------------------- /projects/tour/chanShow.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = run $ sMonitor "image" sh 5 | where 6 | sh _ x = [ Draw (rgb x), Draw x ] 7 | 8 | -------------------------------------------------------------------------------- /projects/tour/choice.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = run $ arrL (zip [0..]) 7 | >>> separ 8 | >>> observe "final" rgb 9 | 10 | separ = proc (k,img) -> do 11 | if odd (k `div` 25) 12 | then observe "monochrome" grayscale -< img 13 | else observe "negated" (notI . grayscale) -< img 14 | -------------------------------------------------------------------------------- /projects/tour/circuit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows, RecursiveDo #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | import Util.Geometry 6 | import Contours 7 | import Contours.Polygons 8 | import Numeric.LinearAlgebra((<>)) 9 | import Vision(cameraFromHomogZ0,estimateHomographyRaw,ht,scaling) 10 | import Util.Misc(rotateLeft,posMax) 11 | 12 | main = run $ proc im -> do 13 | rec let g = grayscale im 14 | prev <- delay zero -< s 15 | let cs = map (smoothPolyline 4) . otsuContours $ g 16 | ps = take 1 . polygons 10 5 (4, 4) $ cs 17 | s = f prev g ps 18 | (y,_,_) <- sMonitor "recursive" dr -< (s,g,ps) 19 | returnA -< y 20 | 21 | otsuContours = contours 1000 100 . notI . otsuBinarize 22 | 23 | -- dr would not be in scope if defined inside the proc 24 | dr _ (s,g,ps) = [ Draw s 25 | , Draw [ Draw g, (Draw . map (drawContourLabeled blue red white 2 3)) ps ] ] 26 | 27 | f a im (c:_) = warpon a [(h,im)] 28 | where 29 | h = estimateHomographyRaw (g c) [[1,r],[-1,r],[-1,-r],[1,-r]] <> scaling 0.95 30 | where 31 | r = 0.75 32 | g (Closed ps) = map (\(Point x y) -> [x,y]) (up ps) 33 | up = rotateLeft (k+2) 34 | k = posMax $ map segmentLength (asSegments c) 35 | f _ x _ = x 36 | 37 | zero = constantImage 0 (Size 200 200) 38 | 39 | -------------------------------------------------------------------------------- /projects/tour/clickPoints.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Util.Geometry 4 | import Util.Polygon 5 | import Data.Traversable(traverse) 6 | import Util.Options(getRawOption) 7 | 8 | main = do 9 | mbimg <- getRawOption "--image" >>= traverse loadRGB 10 | 11 | runIt $ do 12 | p <- clickPoints "click points" "--points" () (sh mbimg.fst) 13 | w <- browser "work with them" [] (const id) 14 | connectWith g p w 15 | 16 | sh mbimg pts = Draw [ Draw mbimg 17 | , color yellow . drawPointsLabeled $ pts] 18 | 19 | g (k,_) (ps,_) = (k, [ pointSz 5 ps 20 | , Draw (Closed ps) 21 | , color green $ fillPolygon (Polygon ps) 22 | , Draw (convexComponents (Polygon ps)) 23 | ]) 24 | 25 | -------------------------------------------------------------------------------- /projects/tour/connect.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Util.Geometry 4 | 5 | main = runIt $ do 6 | p <- click "click points" 7 | w <- browser "work with them" [] (const Draw) 8 | connectWith g p w 9 | 10 | g _ pts = (0, [ map (Segment (Point 0 0)) pts] ) 11 | 12 | click name = standalone (Size 400 400) name [] updts [] sh 13 | where 14 | updts = [ (key (MouseButton LeftButton), \_ p ps -> ps++[p]) ] 15 | sh = color yellow . drawPointsLabeled 16 | 17 | -------------------------------------------------------------------------------- /projects/tour/draw.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Util.Geometry 4 | 5 | main = runIt $ browser "points & lines" xs (const id) 6 | where 7 | xs = [drawing1] 8 | 9 | drawing1 :: Drawing 10 | drawing1 = Draw [ color yellow (HLine 0.1 1 0) 11 | , pointSz 5 [Point 0.5 0.5, Point 0 (-0.2)] 12 | ] 13 | 14 | -------------------------------------------------------------------------------- /projects/tour/draw3DParam.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI.Simple 4 | import Image 5 | import Util.Geometry 6 | import qualified Graphics.UI.GLUT as GL 7 | 8 | autoParam "Position" "" 9 | [ ("x", "Double", realParam 3 (-10) 10) 10 | , ("y", "Double", realParam 2 (-10) 10) 11 | , ("z", "Double", realParam 3 (-10) 10) 12 | ] 13 | 14 | main = runIt $ draw3DParam "3D drawing" drws 15 | 16 | drws Position{..} = 17 | [ clearColor white . blend $ 18 | [ color black . lineWd 2 $ axes3D 5 19 | , pointSz 3 . color red $ [p, p2] 20 | , color blue (gjoin p p2) 21 | , (lineWd 3 . color blue) (lineStrip [p, p2]) 22 | , color orange l 23 | , color lightgray [ projs p, projs p2 ] 24 | , colorAlpha lightgreen 0.8 (drawPolygon pol) 25 | ] 26 | ] 27 | where 28 | p = Point3D x y z 29 | p2 = Point3D 1 1 1 30 | projs p = lineStrip 31 | [ Point3D x y z 32 | , Point3D x y 0 33 | , Point3D x 0 0 34 | , Point3D x y 0 35 | , Point3D 0 y 0 ] 36 | where 37 | Point3D x y z = p 38 | 39 | l = meet (HPlane 0 0 1 (-z)) (HPlane 0 1 0 (-1)) 40 | 41 | 42 | pol = map (meet p) ls 43 | where 44 | p = HPlane 1 1 1 (-4) 45 | ls = map (gjoin (Point3D 0 0 0)) [Point3D 1 0 0, Point3D 0 1 0, Point3D 0 0 1] 46 | 47 | -------------------------------------------------------------------------------- /projects/tour/drawParam.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI 4 | import Image 5 | 6 | autoParam "Position" "" 7 | [ ("x", "Double", realParam (0) (-1) 1) 8 | , ("y", "Double", realParam (0) (-1) 1) 9 | ] 10 | 11 | main = runIt $ drawParam "my drawing" drws 12 | 13 | drws Position{..} = 14 | [ color red . pointSz 3 $ Point x y 15 | ] 16 | 17 | -------------------------------------------------------------------------------- /projects/tour/fast-slow.hs: -------------------------------------------------------------------------------- 1 | -- space leak tests 2 | -- proc2 and proc3 were leaky with the initial async arrow definition 3 | -- 4 | -- ej: $ ./fast-slow ../../data/videos/rot4.avi 5 | 6 | {-# LANGUAGE Arrows #-} 7 | 8 | import Vision.GUI 9 | import Image.Processing 10 | import Util.Misc(splitEvery) 11 | 12 | fast n = map head . splitEvery n 13 | 14 | main = run $ arr rgb >>> proc2 15 | 16 | proc1, proc2, proc3 :: ITrans (Image RGB) (Image RGB) 17 | 18 | -- "normal" order: show orig, filter, show fast, output fast 19 | proc1 = proc x -> do 20 | observe "orig" id -< x 21 | g <- arrL (fast 10) -< x 22 | observe "fast" id -< g 23 | returnA -< g 24 | 25 | -- show fast but output orig 26 | proc2 = proc x -> do 27 | observe "orig" id -< x 28 | g <- arrL (fast 10) -< x 29 | observe "fast" id -< g 30 | returnA -< x 31 | 32 | -- show orig after fast 33 | proc3 = proc x -> do 34 | g <- arrL (fast 10) -< x 35 | observe "fast" id -< g 36 | observe "orig" id -< x 37 | returnA -< g 38 | 39 | -------------------------------------------------------------------------------- /projects/tour/grid.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Util.Misc(splitEvery) 4 | import Data.List(tails) 5 | 6 | grid n = map (blockImage . splitEvery n . take (n*n)) . tails 7 | 8 | main = run $ arr (resize (Size 96 120) . rgb) 9 | >>> arrL (grid 5) 10 | >>> observe "grid" id 11 | 12 | -------------------------------------------------------------------------------- /projects/tour/hello.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Image.Capture 4 | 5 | main = do 6 | img <- loadRGB "../../data/images/transi/dscn2070.jpg" 7 | runIt $ browser "image" [img] (const Draw) 8 | 9 | -------------------------------------------------------------------------------- /projects/tour/interactive3D.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Util.Geometry 3 | 4 | pause = putStrLn "Press any key (here) to continue..." >> getChar 5 | 6 | -- the following session can also be done in ghci 7 | 8 | main = do 9 | (reset,add) <- interactive3D "my drawing" 10 | pause 11 | reset $ axes3D 4 12 | pause 13 | let r = [1 .. 3] 14 | reset $ Draw [axes3D 4, Draw [Point3D x y z | x <- r, y <- r, z <- r ]] 15 | pause 16 | reset $ clearColor white [color black (axes3D 4) 17 | , (color red . pointSz 3) [Point3D x y z | x <- r, y <- r, z <- r ]] 18 | pause 19 | let r = [1,1.5 .. 3] 20 | let ps = [Point3D x y z | x <- r, y <- r, z <- r ] 21 | reset $ Draw [color black (axes3D 4) , (color red . pointSz 3) ps] 22 | pause 23 | reset $ clearColor white (color black (axes3D 5)) 24 | pause 25 | let p1 = Point3D 2 1 1 26 | p2 = Point3D 3 3 3 27 | add $ (color green . pointSz 5) [p1, p2] 28 | pause 29 | let l12 = gjoin p1 p2 30 | add $ color gray l12 31 | pause 32 | 33 | -------------------------------------------------------------------------------- /projects/tour/interface.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI hiding (clickPoints) 2 | import Image.Processing 3 | 4 | main = run clickPoints 5 | 6 | clickPoints :: ITrans Channels ([Point], Image Gray) 7 | clickPoints = transUI $ interface (Size 240 320) "click points" 8 | state0 firsttime updts acts result display 9 | where 10 | state0 = [] 11 | firsttime _ _ = return () 12 | updts = [(key (MouseButton LeftButton), \_droi pt pts -> pt:pts)] 13 | acts = [] 14 | result _droi pts input = (pts, (pts, notI . grayscale $ input)) 15 | display _droi _pts _input (pts,x) = Draw [ Draw x, drwpts ] 16 | where drwpts = (color green . pointSz 3) pts 17 | 18 | -------------------------------------------------------------------------------- /projects/tour/loop.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = run $ observe "source" rgb 7 | >>> f 8 | >>> observe "result" (5.*) 9 | 10 | f = proc img -> do 11 | let x = (toFloat . grayscale) img 12 | p <- delay' -< x 13 | returnA -< x |-| p 14 | 15 | -------------------------------------------------------------------------------- /projects/tour/matrix.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Capture 4 | import Numeric.LinearAlgebra 5 | 6 | main = do 7 | img <- loadRGB "../../data/images/pano/pano002.jpg" 8 | runIt $ browser "image" [Draw img, Draw (f img)] (const id) 9 | 10 | f = mat2img . g . img2mat . toFloat . grayscale . channelsFromRGB 11 | 12 | g = {-subMatrix (100,100) (200,200) . -} trans 13 | 14 | -------------------------------------------------------------------------------- /projects/tour/nocircuit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | import Util.Geometry 6 | import Contours 7 | import Contours.Polygons 8 | import Numeric.LinearAlgebra((<>)) 9 | import Vision(cameraFromHomogZ0,estimateHomographyRaw,ht,scaling) 10 | import Util.Misc(rotateLeft,posMax) 11 | 12 | main = run $ proc im -> do 13 | let g = grayscale im 14 | prev <- delay zero -< g 15 | let cs = map (smoothPolyline 4) . otsuContours $ g 16 | ps = take 1 . polygons 10 5 (4, 4) $ cs 17 | s = f prev g ps 18 | (y,_,_) <- sMonitor "recursive" dr -< (s,g,ps) 19 | returnA -< y 20 | 21 | -- dr would not be in scope if defined inside the proc 22 | dr _ (s,g,ps) = [ Draw s 23 | , Draw [ Draw g, (Draw . map (drawContourLabeled blue red white 2 3)) ps ] ] 24 | 25 | otsuContours = contours 1000 100 . notI . otsuBinarize 26 | 27 | f a im (c:_) = warpon a [(h,im)] 28 | where 29 | h = estimateHomographyRaw (g c) [[1,r],[-1,r],[-1,-r],[1,-r]] <> scaling 0.95 30 | where 31 | r = 0.75 32 | g (Closed ps) = map (\(Point x y) -> [x,y]) (up ps) 33 | up = rotateLeft (k+2) 34 | k = posMax $ map segmentLength (asSegments c) 35 | f _ x _ = x 36 | 37 | zero = constantImage 0 (Size 100 100) 38 | 39 | -------------------------------------------------------------------------------- /projects/tour/nogui.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = do 5 | putStrLn "Working without GUI..." 6 | x <- runS camera $ arr (sumPixels.grayscale) 7 | >>> arrL (zip [1..] . take 1000) 8 | print x 9 | 10 | -------------------------------------------------------------------------------- /projects/tour/param2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | autoParam "SParam" "g-" [ ("sigma","Float",realParam 3 0 20) 7 | , ("scale","Float",realParam 1 0 5) ] 8 | 9 | main = run $ arr grayscale 10 | >>> withParam g 11 | >>> observe "gauss" id 12 | 13 | g SParam{..} = (scale .*) . gaussS sigma . toFloat 14 | 15 | -------------------------------------------------------------------------------- /projects/tour/param3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, RecordWildCards #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | autoParam "SParam" "g-" [ ("radius","Int",intParam 2 0 10) ] 7 | 8 | main = run $ arr grayscale 9 | >>> withParam (,) 10 | >>> observe "median filter" sh >>> freqMonitor 11 | 12 | sh (SParam{..}, x) = filterMedian radius x 13 | 14 | -------------------------------------------------------------------------------- /projects/tour/passROI.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.ROI 4 | 5 | 6 | main = run $ arr grayscale >>> getROI "change roi" >>> arr cleanROI >>> observe "only roi" Draw 7 | 8 | cleanROI im = resize (roiSize (roi im)) im 9 | 10 | getROI name = transUI 11 | $ interface (Size 240 360) name state0 firsttime updts acts result display 12 | where 13 | state0 = () 14 | firsttime _ _ = return () 15 | updts = [] 16 | acts = [] 17 | result droi _s input = ((), setRegion droi input) 18 | display _droi _s _input output = Draw output 19 | 20 | -------------------------------------------------------------------------------- /projects/tour/play.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | 4 | main = run $ observe "source" rgb 5 | 6 | -------------------------------------------------------------------------------- /projects/tour/play0.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = run $ transUI f >>> freqMonitor 5 | 6 | f :: VCN Channels (Image RGB) 7 | f = return . adaptMb $ \cam -> do 8 | x <- cam 9 | let r = rgb x 10 | print (size r) 11 | return r 12 | 13 | -------------------------------------------------------------------------------- /projects/tour/play1.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = run p 5 | 6 | p = observe "RGB" rgb >>> arr grayscale >>> observe "inverted" notI 7 | 8 | -------------------------------------------------------------------------------- /projects/tour/play3.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Util.Misc(splitEvery) 4 | 5 | main = run $ arrL f >>> observe "RGB" rgb >>> wait (100`div`30) 6 | 7 | f = concatMap (\x -> x ++ reverse x ++ x) . splitEvery 30 8 | 9 | -------------------------------------------------------------------------------- /projects/tour/play4.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = run $ observe "RGB" rgb >>> freqMonitor 5 | 6 | -------------------------------------------------------------------------------- /projects/tour/play5.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Data.Time(getCurrentTime, UTCTime) 4 | import Control.Concurrent(threadDelay) 5 | 6 | main = runT_ clock see 7 | 8 | see :: Show x => ITrans x x 9 | see = observe "time" (text (Point 0.9 0) . show) 10 | 11 | clock :: IO (IO (Maybe UTCTime)) 12 | clock = return (threadDelay 10000 >> Just `fmap` getCurrentTime ) 13 | 14 | -------------------------------------------------------------------------------- /projects/tour/play6.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import System.Random(randomIO) 4 | import Util.Misc(splitEvery) 5 | import Util.Statistics(mean) 6 | import Control.Concurrent(threadDelay) 7 | 8 | main = runT_ rnd $ see "x" >>> freqMonitor 9 | >>> arrL f >>> see "mean" >>> freqMonitor 10 | 11 | see name = observe name (text (Point 0.9 0) . show) 12 | 13 | rnd = return (threadDelay 1000 >> fmap (Just . flip mod 10) randomIO) 14 | 15 | avg = map (mean . map fromIntegral) . splitEvery 100 16 | 17 | f :: [Int] -> [(Int,Double)] 18 | f = zip [1..100] . avg 19 | 20 | -------------------------------------------------------------------------------- /projects/tour/playgray.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image.Processing 3 | 4 | main = run $ observe "image" grayscale 5 | -------------------------------------------------------------------------------- /projects/tour/runS.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | main = do 5 | r <- runS camera $ arr (size . grayscale) 6 | print $ take 10 r 7 | 8 | -------------------------------------------------------------------------------- /projects/tour/runmode0.hs: -------------------------------------------------------------------------------- 1 | -- no gui 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = do 7 | putStrLn "Working without GUI..." 8 | x <- runS camera $ arr (sumPixels . grayscale) 9 | >>> arrL (zip [1..] . take 10) 10 | print x 11 | print (length x) 12 | putStrLn "Bye" 13 | 14 | {-------------------------------------------------------------------- 15 | 16 | tests: 17 | 18 | work on a long video, take the initial sublist: 19 | 20 | $ ./runmode0 21 | Working without GUI... 22 | [(1,3.1243257e7),(2,4.0164279e7),(3,3.9031153e7),(4,3.9024777e7),(5,3.9032666e7), 23 | (6,3.9097742e7),(7,3.9104864e7),(8,3.9101045e7),(9,3.9166347e7),(10,3.9168896e7)] 24 | 10 25 | Bye 26 | 27 | work on a short video: 28 | 29 | ./runmode0 '../../data/videos/rot4.avi -frames 5 -loop 1' 30 | Working without GUI... 31 | [(1,3.1425134e7),(2,3.1350479e7),(3,3.1274583e7),(4,3.1188253e7),(5,3.1112087e7)] 32 | 5 33 | Bye 34 | 35 | 36 | ----------------------------------------------------------------------} 37 | 38 | -------------------------------------------------------------------------------- /projects/tour/runmode00.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | f = sumPixels . grayscale 5 | 6 | main = do 7 | cam <- camera 8 | mbimg <- cam 9 | print (f `fmap` mbimg) 10 | 11 | -------------------------------------------------------------------------------- /projects/tour/runmode01.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | f = sumPixels . grayscale 5 | 6 | main = do 7 | rs <- runS camera $ arr f 8 | print rs 9 | 10 | -------------------------------------------------------------------------------- /projects/tour/runmode02.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | f = sumPixels . grayscale 5 | 6 | main = do 7 | prepare 8 | rs <- runNT camera $ observe "Image" rgb >>> arr f 9 | print rs 10 | -------------------------------------------------------------------------------- /projects/tour/runmode03.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | f = sumPixels . grayscale 5 | 6 | main = runT camera (observe "Image" rgb >>> arr f) >>= print 7 | -------------------------------------------------------------------------------- /projects/tour/runmode04.hs: -------------------------------------------------------------------------------- 1 | import Image.Processing 2 | import System.Environment 3 | 4 | f = sumPixels . grayscale 5 | 6 | main = do 7 | filename:_ <- getArgs 8 | img <- channelsFromRGB `fmap` loadRGB filename 9 | print (f img) 10 | 11 | -------------------------------------------------------------------------------- /projects/tour/runmode05.hs: -------------------------------------------------------------------------------- 1 | import Image.Processing 2 | import Image.Capture 3 | import System.Environment 4 | 5 | f = sumPixels . grayscale . channelsFromRGB 6 | 7 | main = do 8 | folder:_ <- getArgs 9 | imgs <- readFolderIM folder 10 | print (map (f.fst) imgs) 11 | 12 | -------------------------------------------------------------------------------- /projects/tour/runmode06.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | 4 | f = sumPixels . grayscale 5 | 6 | main = runS camera (arr f) >>= print . sum 7 | 8 | -------------------------------------------------------------------------------- /projects/tour/runmode1.hs: -------------------------------------------------------------------------------- 1 | -- threaded GUI, output discarded 2 | -- clean exit by user ESC or end of stream 3 | 4 | import Vision.GUI.Simple 5 | import Image 6 | 7 | main = run (observe "image" rgb) 8 | -------------------------------------------------------------------------------- /projects/tour/runmode2.hs: -------------------------------------------------------------------------------- 1 | -- threaded GUI, returning result 2 | -- (this mode drops display frames) 3 | 4 | import Vision.GUI 5 | import Image.Processing 6 | 7 | main = do 8 | r <- runT camera (observe "image" rgb >>> arr (sumPixels.grayscale)) 9 | print r 10 | putStrLn "bye!" 11 | 12 | -------------------------------------------------------------------------------- /projects/tour/runmode3.hs: -------------------------------------------------------------------------------- 1 | -- non threaded GUI, discarding result 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = do 7 | prepare 8 | runNT_ camera (observe "image" rgb >>> arr (sumPixels.grayscale)) 9 | putStrLn "bye!" 10 | 11 | -------------------------------------------------------------------------------- /projects/tour/runmode4.hs: -------------------------------------------------------------------------------- 1 | -- non threaded GUI, returning result 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | main = do 7 | prepare 8 | r <- runNT camera (observe "image" rgb >>> arr (sumPixels.grayscale)) 9 | print r 10 | putStrLn "bye!" 11 | 12 | -------------------------------------------------------------------------------- /projects/tour/scanl1.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Contours.Polygons 4 | import Contours 5 | import Util.Geometry 6 | import Numeric.LinearAlgebra((<>)) 7 | import Vision(cameraFromHomogZ0,estimateHomographyRaw,ht,scaling) 8 | import Util.Misc(rotateLeft,posMax) 9 | 10 | darkContours = (id &&& (otsuContours >>> map (smoothPolyline 4))) 11 | 12 | otsuContours = contours 1000 100 . notI . otsuBinarize 13 | 14 | main = run $ arr grayscale 15 | >>> arr darkContours 16 | >>> arr (id *** take 1 . polygons 10 5 (4, 4)) 17 | >>> observe "detected" shinfo 18 | >>> arrL (scanl1 f) 19 | >>> observe "recursive" fst 20 | 21 | shinfo (im,ps) = Draw [ Draw im 22 | , (Draw . map (drawContourLabeled blue red white 2 3)) ps ] 23 | 24 | f (a,_) (im,c:_) = (warpon im [(h,a)], [c]) 25 | where 26 | h = estimateHomographyRaw (g c) [[1,r],[-1,r],[-1,-r],[1,-r]] <> scaling 0.95 27 | where 28 | r = 0.75 29 | g (Closed ps) = map (\(Point x y) -> [x,y]) (up ps) 30 | up = rotateLeft (k+2) 31 | k = posMax $ map segmentLength (asSegments c) 32 | f _ x = x 33 | 34 | -------------------------------------------------------------------------------- /projects/tour/single.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Image.Capture 4 | import System.Environment 5 | 6 | f = sumPixels . grayscale . channelsFromRGB 7 | 8 | main = getArgs >>= readImages >>= runITrans (arr f) >>= print 9 | 10 | -------------------------------------------------------------------------------- /projects/tour/skip.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image.Processing 3 | import Util.Options 4 | 5 | f = sumPixels . grayscale 6 | 7 | main = do 8 | n <- getOption "--skip" 0 9 | prepare 10 | r <- runNT camera $ arrL (drop n) >>> observe "image" rgb >>> arr f 11 | print (length r) 12 | 13 | -------------------------------------------------------------------------------- /projects/tour/smon.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Contours.Base 3 | import Image.Processing 4 | 5 | main = run $ sMonitor "result" f 6 | 7 | f roi x = [ msg "grayscale" [ Draw g ] 8 | , msg "gaussian filter " [ Draw smooth ] 9 | , msg "canny edges" [ Draw (notI edges) ] 10 | ] 11 | where 12 | img = rgb x 13 | g = setRegion roi (grayscale x) 14 | smooth = gauss Mask5x5 . toFloat $ g 15 | edges = canny (0.1,0.3) . gradients $ smooth 16 | 17 | msg s t = Draw [ Draw img 18 | , Draw t 19 | , color yellow $ text (Point 0.9 0.65) s 20 | ] 21 | 22 | -------------------------------------------------------------------------------- /projects/tour/stand1.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image 3 | 4 | main = runIt win 5 | 6 | win = standalone (Size 100 400) "click to change" x0 updts [] sh 7 | where 8 | x0 = 7 9 | sh = text (Point 0 0) . show 10 | updts = [(key (MouseButton LeftButton), \_droi _pt -> (+1)) ] 11 | 12 | -------------------------------------------------------------------------------- /projects/tour/stand2.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image 3 | 4 | main = runIt win 5 | 6 | win = browser "odd numbers" xs sh 7 | where 8 | xs = [1,3 .. 21] 9 | sh _k = text (Point 0 0) . show 10 | 11 | -------------------------------------------------------------------------------- /projects/tour/stand3.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image 3 | import Util.Misc(replaceAt) 4 | 5 | main = runIt win 6 | 7 | win = editor update save "editor" [2,4 .. 10] sh 8 | where 9 | sh k x = Draw [ color white $ text (Point 0 0) (show x) 10 | , color yellow $ text (Point 0.9 0.8) ("# "++show k) ] 11 | update = [ op (Char '+') succ 12 | , op (Char '-') pred 13 | , opS (Char 'P') (*10) 14 | ] 15 | save = [(ctrlS, \_roi _pt (_k,xs) -> print xs)] 16 | ctrlS = kCtrl (key (Char '\DC3')) 17 | op c f = updateItem (key c) (const.const $ f) 18 | opS c f = updateItem ((kShift . key) c) (const.const $ f) 19 | -------------------------------------------------------------------------------- /projects/tour/testwebcam.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image.Capture 3 | import Image.Devel 4 | 5 | cam = webcam "/dev/video1" (Size 600 800) 30 6 | 7 | main = do 8 | runT_ cam (observe "source" yuyv2rgb >>> freqMonitor) 9 | -------------------------------------------------------------------------------- /projects/tour/work.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, TemplateHaskell #-} 2 | 3 | import Vision.GUI 4 | import Image.Processing 5 | 6 | autoParam "DemoParam" "" 7 | [ ("sigma","Float",realParam 5 1 10) 8 | ] 9 | 10 | data Experiment = Experiment 11 | { orig :: Image RGB 12 | , mono :: Image Float 13 | , smooth :: Image Float 14 | } 15 | 16 | work DemoParam{..} x = Experiment {..} 17 | where 18 | orig = rgb x 19 | mono = grayf x 20 | smooth = gaussS sigma mono 21 | 22 | 23 | main = run $ withParam work 24 | >>> observe "source" orig 25 | -- >>> observe "smooth" smooth 26 | >>> sMonitor "grayscale" sh 27 | 28 | sh _roi Experiment{..} = [Draw smooth, Draw mono] 29 | 30 | 31 | -------------------------------------------------------------------------------- /projects/vision/geom/.gitignore: -------------------------------------------------------------------------------- 1 | conic 2 | linemodels 3 | horizon 4 | horizon2 5 | rectify 6 | resection 7 | resection2 8 | stereo 9 | 10 | -------------------------------------------------------------------------------- /projects/vision/geom/Makefile: -------------------------------------------------------------------------------- 1 | include ../../Makefile.include 2 | 3 | demo: 4 | ./horizon --points=pts2d.txt --image=../../../data/images/calibration/disk1.jpg 5 | ./horizon2 ../../../data/videos/rcube.avi 6 | ./rectify --points=pts2d.txt --image=../../../data/images/calibration/disk1.jpg 7 | ./resection --points=pts3d.txt --image=../../../data/images/calibration/cal1.jpg 8 | ./resection2 --points=pcube37.txt --image=../../../data/images/calibration/cube1.png 9 | ./resection4 --reference=ref3d.txt --points=plain2d.txt --image=../../../data/images/calibration/cube1.png 10 | ./stereo --points1=pl.txt --image1=../../../data/images/calibration/cube3.png --points2=pr.txt --image2=../../../data/images/calibration/cube4.png 11 | ./conic --points=pcon.txt 12 | ./multiview 13 | 14 | -------------------------------------------------------------------------------- /projects/vision/geom/conic.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Contours(asSegments) 4 | import Util.Ellipses 5 | import Util.Geometry 6 | 7 | main = runIt $ clickPoints "conic" "--points" () (sh.fst) 8 | 9 | l = gjoin (Point 0.5 0) (Point 0 0.5) 10 | 11 | sh pts | length pts >= 5 = Draw 12 | [ drwpts 13 | , (color col . drawConic) c 14 | , color red l 15 | , color yellow . pointSz 3 $ intersectionConicLine c l 16 | ] 17 | | otherwise = drwpts 18 | where 19 | c = computeConic pts 20 | drwpts = color white . drawPointsLabeled $ pts 21 | col = if isEllipse c then green else orange 22 | isEllipse c = null (intersectionConicLine c linf) 23 | linf = HLine 0 0 1 24 | 25 | drawConic c = Draw ss 26 | where 27 | ps = pointsConic 50 c 28 | ss = filter ((1>).segmentLength) $ asSegments (Closed ps) 29 | 30 | -------------------------------------------------------------------------------- /projects/vision/geom/crossratio.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI.Simple 2 | import Image 3 | import Util.Geometry 4 | import Util.Options(getRawOption) 5 | import Data.Traversable(traverse) 6 | import Numeric.LinearAlgebra hiding (join) 7 | import Numeric.LinearAlgebra.Util(unitary) 8 | 9 | main = do 10 | mbimg <- getRawOption "--image" >>= traverse loadRGB 11 | runIt $ clickPoints "cross ratio" "--points" () (sh mbimg.fst) 12 | 13 | sh mbi [] = Draw mbi 14 | sh mbi [p] = Draw [ Draw mbi, color white . drawPointsLabeled $ [p] ] 15 | sh mbi [p1,p2] = Draw 16 | [ Draw mbi 17 | , color gray (gjoin p1 p2) 18 | , drawPointsLabeled [p1,p2] 19 | ] 20 | sh mbi [p1,q2,p3] = Draw 21 | [ Draw mbi 22 | , color gray l 23 | , drawPointsLabeled [p1, p2, p3] 24 | , pointSz 3 q2 25 | , pointSz 3 . color red $ more 26 | ] 27 | where 28 | l = gjoin p1 p3 29 | p2 = inhomog $ closest l (homog q2) 30 | more = map unsafeFromVector (continue p1 p2 p3) :: [Point] 31 | 32 | 33 | closest l@(HLine a b c) p@(HPoint x y w) = meet l n 34 | where 35 | n = gjoin p (HPoint a b 0) 36 | 37 | continue p1 p2 p3 = [ v3 + dir * scalar (solveCR cr a b) | cr <- [1/4, 1/2*2/3, 1/2*3/4, 1/2] ] 38 | where 39 | [v1,_v2,v3] = map toVector [p1,p2,p3] 40 | dir = unitary (v3-v1) 41 | a = distPoints p1 p2 42 | b = distPoints p2 p3 43 | 44 | solveCR cr a b = (b*(a+b)*cr)/(a*(1-cr)-b*cr) 45 | 46 | -------------------------------------------------------------------------------- /projects/vision/geom/horizon.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Image 3 | import Image.Processing 4 | import Util.Options(optionFromFile,getRawOption) 5 | import Data.Traversable(traverse) 6 | import Numeric.LinearAlgebra hiding (gjoin) 7 | import Vision(estimateHomography,scaling) 8 | import Util.Geometry as G 9 | import Util.Debug(debug) 10 | --import Contours(bounding, poly2roi) 11 | 12 | main = do 13 | mbimg <- getRawOption "--image" >>= traverse loadRGB 14 | runIt $ do 15 | p <- clickPoints "click rectangle" "--points" () (sh mbimg.fst) 16 | w <- browser "horizon" [] (const id) 17 | connectWith (g mbimg) p w 18 | 19 | sh mbimg pts = Draw [ Draw mbimg 20 | , color lightgreen . drawPointsLabeled $ pts] 21 | 22 | g mbimg (k,_) (ps,_) = (k, [Draw [Draw smbimg, color red [ Draw sls, pointSz 5 sps ]] 23 | ]) 24 | where 25 | [p1,p2,p3,p4] = take 4 ps 26 | l1 = gjoin p1 p2 27 | l2 = gjoin p3 p4 28 | l3 = gjoin p1 p4 29 | l4 = gjoin p2 p3 30 | l_inf' = (meet l1 l2) `gjoin` (meet l3 l4) 31 | ls | length ps >=4 = [l_inf',l1,l2,l3,l4] 32 | | otherwise = [] 33 | h = unsafeFromMatrix $ scaling (1/3) :: Homography 34 | sls = h <| ls 35 | sps = h <| ps 36 | smbimg = warp (Word24 50 0 0) (maybe (Size 400 400) size mbimg) (toMatrix h) `fmap` mbimg 37 | 38 | -------------------------------------------------------------------------------- /projects/vision/geom/pcon.txt: -------------------------------------------------------------------------------- 1 | [Point (0.325) (0.58),Point (-0.325) (0.375),Point (-0.34500000000000003) (-8.000000000000002e-2),Point (-0.10500000000000002) (-0.325),Point (0.18499999999999997) (-5.500000000000002e-2)] 2 | 3 | -------------------------------------------------------------------------------- /projects/vision/geom/pl.txt: -------------------------------------------------------------------------------- 1 | [Point (0.13124999999999995) (-0.3218750000000001),Point (-4.6875000000000056e-2) (-0.22500000000000006),Point (-0.20625000000000007) (-0.12187500000000005),Point (-0.3531250000000001) (-4.3750000000000046e-2),Point (0.15624999999999994) (-0.20000000000000007),Point (-3.750000000000006e-2) (-0.10000000000000005),Point (-0.21562500000000007) (6.249999999999959e-3),Point (-0.35625000000000007) (9.374999999999996e-2),Point (0.18749999999999994) (-4.062500000000004e-2),Point (-1.2500000000000056e-2) (6.874999999999996e-2),Point (-0.21562500000000007) (0.16874999999999996),Point (-0.3812500000000001) (0.24999999999999997),Point (0.23749999999999996) (0.15937499999999996),Point (9.374999999999946e-3) (0.25625),Point (-0.21875000000000006) (0.359375),Point (-0.3968750000000001) (0.44687499999999997),Point (0.3625) (0.29062499999999997),Point (0.13749999999999996) (0.39375),Point (-6.250000000000006e-2) (0.47812499999999997),Point (-0.23437500000000006) (0.55),Point (0.46249999999999997) (0.41562499999999997),Point (0.25625) (0.490625),Point (5.6249999999999946e-2) (0.578125),Point (-0.10937500000000006) (0.628125),Point (0.54375) (0.496875),Point (0.34374999999999994) (0.56875),Point (0.14687499999999995) (0.634375),Point (6.249999999999945e-3) (0.684375)] 2 | 3 | -------------------------------------------------------------------------------- /projects/vision/geom/plain2d.txt: -------------------------------------------------------------------------------- 1 | -0.08438 -0.59063 2 | -0.23750 -0.46875 3 | -0.35938 -0.35000 4 | -0.46563 -0.25625 5 | -0.09063 -0.44063 6 | -0.25000 -0.33438 7 | -0.38125 -0.21563 8 | -0.48750 -0.13125 9 | -0.10625 -0.28125 10 | -0.26875 -0.16563 11 | -0.40938 -0.05313 12 | -0.51875 0.03125 13 | -0.10938 -0.07813 14 | -0.28125 0.02500 15 | -0.43750 0.12812 16 | -0.55313 0.21875 17 | 0.06875 0.03125 18 | -0.09063 0.13437 19 | -0.24375 0.22500 20 | -0.35625 0.29062 21 | 0.25000 0.12500 22 | 0.07187 0.22812 23 | -0.06875 0.29375 24 | -0.19063 0.35625 25 | 0.37813 0.20625 26 | 0.20312 0.28438 27 | 0.04375 0.35625 28 | -0.08438 0.39688 29 | 0.35000 0.02500 30 | 0.22500 -0.05625 31 | 0.08437 -0.15625 32 | 0.32500 -0.13125 33 | 0.21875 -0.21250 34 | 0.07500 -0.32813 35 | 0.30625 -0.25938 36 | 0.20625 -0.34375 37 | 0.07187 -0.45313 38 | 39 | -------------------------------------------------------------------------------- /projects/vision/geom/pr.txt: -------------------------------------------------------------------------------- 1 | [Point (0.425) (-0.49687500000000007),Point (0.29374999999999996) (-0.55625),Point (0.13437499999999994) (-0.6062500000000001),Point (-5.625000000000006e-2) (-0.6875000000000001),Point (0.46562499999999996) (-0.3687500000000001),Point (0.32499999999999996) (-0.41875000000000007),Point (0.14687499999999995) (-0.48125000000000007),Point (-3.437500000000006e-2) (-0.5375000000000001),Point (0.515625) (-0.20937500000000006),Point (0.365625) (-0.25312500000000004),Point (0.18124999999999997) (-0.31875000000000003),Point (-1.2500000000000056e-2) (-0.3687500000000001),Point (0.56875) (-3.4375000000000044e-2),Point (0.40312499999999996) (-7.812500000000004e-2),Point (0.21249999999999997) (-0.13750000000000004),Point (-3.1250000000000557e-3) (-0.18437500000000004),Point (0.41874999999999996) (6.874999999999996e-2),Point (0.271875) (4.062499999999996e-2),Point (9.062499999999996e-2) (-4.163336342344337e-17),Point (-0.11562500000000006) (-4.687500000000004e-2),Point (0.29374999999999996) (0.16249999999999998),Point (0.15937499999999996) (0.13749999999999996),Point (-2.1875000000000058e-2) (0.10624999999999997),Point (-0.20937500000000006) (6.249999999999996e-2),Point (0.19687499999999997) (0.21874999999999997),Point (6.562499999999995e-2) (0.19687499999999997),Point (-0.10000000000000006) (0.17187499999999997),Point (-0.27812500000000007) (0.14374999999999996)] 2 | 3 | -------------------------------------------------------------------------------- /projects/vision/geom/pts2d.txt: -------------------------------------------------------------------------------- 1 | [Point 0.7678780773739742 8.558030480656503e-2,Point 0.3036342321219227 (-0.5662368112543964),Point (-0.6647127784290737) (-0.18991793669402116),Point (-5.744431418522853e-2) 0.2754982415005861] 2 | -------------------------------------------------------------------------------- /projects/vision/geom/pts3d.txt: -------------------------------------------------------------------------------- 1 | [Point (0.5880239520958084) (1.1976047904191395e-3),Point (0.511377245508982) (-0.2383233532934132),Point (0.42035928143712575) (-0.5736526946107785),Point (0.3844311377245509) (0.42514970059880236),Point (0.27425149700598805) (0.2431137724550898),Point (0.10419161676646707) (-3.473053892215571e-2),Point (-2.275449101796406e-2) (0.27664670658682633),Point (-0.19760479041916165) (8.023952095808382e-2),Point (-0.437125748502994) (-0.1976047904191617)] 2 | -------------------------------------------------------------------------------- /projects/vision/geom/ref3d.txt: -------------------------------------------------------------------------------- 1 | 0.0 0.0 0.0 2 | 1.0 0.0 0.0 3 | 2.0 0.0 0.0 4 | 3.0 0.0 0.0 5 | 0.0 0.0 1.0 6 | 1.0 0.0 1.0 7 | 2.0 0.0 1.0 8 | 3.0 0.0 1.0 9 | 0.0 0.0 2.0 10 | 1.0 0.0 2.0 11 | 2.0 0.0 2.0 12 | 3.0 0.0 2.0 13 | 0.0 0.0 3.0 14 | 1.0 0.0 3.0 15 | 2.0 0.0 3.0 16 | 3.0 0.0 3.0 17 | 0.0 1.0 3.0 18 | 1.0 1.0 3.0 19 | 2.0 1.0 3.0 20 | 3.0 1.0 3.0 21 | 0.0 2.0 3.0 22 | 1.0 2.0 3.0 23 | 2.0 2.0 3.0 24 | 3.0 2.0 3.0 25 | 0.0 3.0 3.0 26 | 1.0 3.0 3.0 27 | 2.0 3.0 3.0 28 | 3.0 3.0 3.0 29 | 0.0 3.0 2.0 30 | 0.0 2.0 2.0 31 | 0.0 1.0 2.0 32 | 0.0 3.0 1.0 33 | 0.0 2.0 1.0 34 | 0.0 1.0 1.0 35 | 0.0 3.0 0.0 36 | 0.0 2.0 0.0 37 | 0.0 1.0 0.0 38 | -------------------------------------------------------------------------------- /projects/vision/geom/synthcam.hs: -------------------------------------------------------------------------------- 1 | import Vision.GUI 2 | import Util.Geometry 3 | import Vision 4 | import Util.Camera 5 | import Numeric.LinearAlgebra.HMatrix 6 | 7 | -- c = syntheticCamera $ easyCamera (pi/3) (4,4,1) (-1,2,5) 0 8 | c = syntheticCamera $ easyCamera (pi/3) (0,-4,5) (0,0,0) 0 9 | -- c = syntheticCamera $ easyCamera (pi/3) (0,0,5) (0,0,0) 0 10 | 11 | 12 | (k,rt) = sepCam c 13 | 14 | r = takeColumns 3 rt 15 | t = last (toColumns rt) 16 | 17 | ic = infoCam (unsafeFromMatrix c) 18 | 19 | p0 = inhomog $ cenCam ic 20 | [p1,p2,p3] = map (\r -> unsafeFromVector (r+toVector p0)) (toRows r) 21 | 22 | ipts = toImagePlane ic 1 [Point 1.2 0, Point 0 1.2] 23 | 24 | 25 | main = do 26 | disp 3 $ c 27 | disp 3 $ k 28 | disp 3 $ r 29 | disp 3 $ asRow t 30 | runIt $ browser3D "synth camera" [drw] (const Draw) 31 | 32 | drw = clearColor white 33 | [ color black $ axes3D 4 34 | , color red [ showCamera 1 ic Nothing 35 | , (text3DAtF Helvetica12 (inhomog $ ipts!!0) "x") 36 | , (text3DAtF Helvetica12 (inhomog $ ipts!!1) "y") 37 | ] 38 | , color blue $ lineWd 3 $ lineStrip [ p0,p1,p0,p2,p0,p3 ] 39 | ] 40 | 41 | -------------------------------------------------------------------------------- /projects/vision/multiview/.gitignore: -------------------------------------------------------------------------------- 1 | bootstrap.txt 2 | geademo 3 | 4 | -------------------------------------------------------------------------------- /projects/vision/multiview/Makefile: -------------------------------------------------------------------------------- 1 | include ../../Makefile.include 2 | 3 | demo: 4 | ./geademo ../../../data/tracks/dinosaur 5 | ./geademo ../../../data/tracks/trafalgar-21 6 | 7 | --------------------------------------------------------------------------------