We need just an editor and a command line terminal, but I recommend that you configure your editor to compile and run programs directly using shortcut keys. Most people prefer emacs or vim but I happily use gedit with "snippets" and "external tools" configured to do many useful tasks.
It is also convenient to open a navigation tab with the local Haddock documentation.
Show a single image:
-- tour/hello.hs
import Vision.GUI.Simple
import Image
import Image.Capture
main = do
img <- loadRGB "../../data/images/transi/dscn2070.jpg"
runIt $ browser "image" [img] (const Draw)
Show a live video sequence captured from the input source (the webcam by default):
-- tour/play.hs import Vision.GUI.Simple import Image main = run $ observe "source" rgb
The pipeline generated by the input sequence is a "Channels" structure. We choose any projection function for the observation windows.
-- tour/playgray.hs import Vision.GUI.Simple import Image.Processing main = run $ observe "image" grayscale
The pipeline functions are composed with (>>>). "arr" maps a pure function on the infinite list of data items generated by the camera.
-- tour/play1.hs import Vision.GUI import Image.Processing main = run p p = observe "RGB" rgb >>> arr grayscale >>> observe "inverted" notI
The above processing pipeline p produces grayscale images. The observation windows show some features of the processed objects, but the results are not sent forward.
We can show different things in a window, selected with the mouse wheel:
-- tour/smon.hs
import Vision.GUI
import Contours.Base
import Image.Processing
main = run $ sMonitor "result" f
f roi x = [ msg "grayscale" [ Draw g ]
, msg "gaussian filter " [ Draw smooth ]
, msg "canny edges" [ Draw (notI edges) ]
]
where
img = rgb x
g = setRegion roi (grayscale x)
smooth = gauss Mask5x5 . toFloat $ g
edges = canny (0.1,0.3) . gradients $ smooth
msg s t = Draw [ Draw img
, Draw t
, color yellow $ text (Point 0.9 0.65) s
]
The Show instance of the Channels structure shows the separate RGB channels and the grayscale image in a 4x4 grid.
-- tour/chanShow.hs
import Vision.GUI
import Image.Processing
main = run $ sMonitor "image" sh
where
sh _ x = [ Draw (rgb x), Draw x ]
We can apply an IO operation to each element in the input pipeline:
-- tour/arrIO.hs import Vision.GUI import Image.Processing main = run $ observe "img" rgb >>> arrIO (print . size . grayscale)
The development of certain algorithms requires displaying many intermediate results for debugging purposes. As a result of fast prototyping, some pieces of code are often included in the display functions, which at the end requires some refactoring.
A way to keep things well organized is to separate the algorithmic work from the display functions. I find it useful to define a record with all the intermediate steps in a computation and populate it in a worker function possibly depending on interactive parameters. If the experiment is successful it is easy to extract the relevant code to a library function.
-- tour/work.hs
{-# LANGUAGE RecordWildCards, TemplateHaskell #-}
import Vision.GUI
import Image.Processing
autoParam "DemoParam" ""
[ ("sigma","Float",realParam 5 1 10)
]
data Experiment = Experiment
{ orig :: Image RGB
, mono :: Image Float
, smooth :: Image Float
}
work DemoParam{..} x = Experiment {..}
where
orig = rgb x
mono = grayf x
smooth = gaussS sigma mono
main = run $ withParam work
>>> observe "source" orig
-- >>> observe "smooth" smooth
>>> sMonitor "grayscale" sh
sh _roi Experiment{..} = [Draw smooth, Draw mono]
arrows: Arrow notation (include diagram):
loop: circuit loop in arrow notation:
-- tour/loop.hs
{-# LANGUAGE Arrows #-}
import Vision.GUI
import Image.Processing
main = run $ observe "source" rgb
>>> f
>>> observe "result" (5.*)
f = proc img -> do
let x = (toFloat . grayscale) img
p <- delay' -< x
returnA -< x |-| p
choice: circuit with choice.
-- tour/choice.hs
{-# LANGUAGE Arrows #-}
import Vision.GUI
import Image.Processing
main = run $ arrL (zip [0..])
>>> separ
>>> observe "final" rgb
separ = proc (k,img) -> do
if odd (k `div` 25)
then observe "monochrome" grayscale -< img
else observe "negated" (notI . grayscale) -< img
circuit, nocircuit: arrow notation and recursive do.
fast-slow: pipeline at two frame rates. Check that there is no leaks.
play0: create a pipeline step explicitly using transUI
play3: insert frames in the video sequence.
-- tour/play3.hs import Vision.GUI import Image.Processing import Util.Misc(splitEvery) main = run $ arrL f >>> observe "RGB" rgb >>> wait (100`div`30) f = concatMap (\x -> x ++ reverse x ++ x) . splitEvery 30
play4: add frame rate measurement window:
-- tour/play4.hs import Vision.GUI import Image.Processing main = run $ observe "RGB" rgb >>> freqMonitor
testwebcam: explicitly open the webcam image source.
-- tour/testwebcam.hs
import Vision.GUI.Simple
import Image.Capture
import Image.Devel
cam = webcam "/dev/video1" (Size 600 800) 30
main = do
runT_ cam (observe "source" yuyv2rgb >>> freqMonitor)
play5: the pipeline can be used with sequences of any kind of information. This is a clock:
-- tour/play5.hs import Vision.GUI import Image.Processing import Data.Time(getCurrentTime, UTCTime) import Control.Concurrent(threadDelay) main = runT_ clock see see :: Show x => ITrans x x see = observe "time" (text (Point 0.9 0) . show) clock :: IO (IO (Maybe UTCTime)) clock = return (threadDelay 10000 >> Just `fmap` getCurrentTime )
play6: In this example we generate random numbers at about 1000Hz, and take the average of each group of 100 elements, producing a final 10Hz output.
-- tour/play6.hs
import Vision.GUI
import Image.Processing
import System.Random(randomIO)
import Util.Misc(splitEvery)
import Util.Statistics(mean)
import Control.Concurrent(threadDelay)
main = runT_ rnd $ see "x" >>> freqMonitor
>>> arrL f >>> see "mean" >>> freqMonitor
see name = observe name (text (Point 0.9 0) . show)
rnd = return (threadDelay 1000 >> fmap (Just . flip mod 10) randomIO)
avg = map (mean . map fromIntegral) . splitEvery 100
f :: [Int] -> [(Int,Double)]
f = zip [1..100] . avg
runmode0: work without GUI
-- tour/runmode0.hs
-- no gui
import Vision.GUI
import Image.Processing
main = do
putStrLn "Working without GUI..."
x <- runS camera $ arr (sumPixels . grayscale)
>>> arrL (zip [1..] . take 10)
print x
print (length x)
putStrLn "Bye"
{--------------------------------------------------------------------
tests:
work on a long video, take the initial sublist:
$ ./runmode0
Working without GUI...
[(1,3.1243257e7),(2,4.0164279e7),(3,3.9031153e7),(4,3.9024777e7),(5,3.9032666e7),
(6,3.9097742e7),(7,3.9104864e7),(8,3.9101045e7),(9,3.9166347e7),(10,3.9168896e7)]
10
Bye
work on a short video:
./runmode0 '../../data/videos/rot4.avi -frames 5 -loop 1'
Working without GUI...
[(1,3.1425134e7),(2,3.1350479e7),(3,3.1274583e7),(4,3.1188253e7),(5,3.1112087e7)]
5
Bye
----------------------------------------------------------------------}
runmode1: normal threaded mode
-- tour/runmode1.hs -- threaded GUI, output discarded -- clean exit by user ESC or end of stream import Vision.GUI.Simple import Image main = run (observe "image" rgb)
runmode00: explicitly open the input source and extract elements:
-- tour/runmode00.hs
import Vision.GUI
import Image.Processing
f = sumPixels . grayscale
main = do
cam <- camera
mbimg <- cam
print (f `fmap` mbimg)
A Maybe type is used to indicate if there is a new element available in the stream or if there are no remaining items. We usually work with the data type ‘Channels’ which provides a few useful image color channels and image formats.
runmode01: run a pipeline wihout a GUI:
-- tour/runmode01.hs
import Vision.GUI
import Image.Processing
f = sumPixels . grayscale
main = do
rs <- runS camera $ arr f
print rs
nogui: run a pipeline without GUI:
-- tour/nogui.hs
import Vision.GUI
import Image.Processing
main = do
putStrLn "Working without GUI..."
x <- runS camera $ arr (sumPixels.grayscale)
>>> arrL (zip [1..] . take 1000)
print x
runmode2: threaded GUI, returning result:
-- tour/runmode01.hs
import Vision.GUI
import Image.Processing
f = sumPixels . grayscale
main = do
rs <- runS camera $ arr f
print rs
runmode02: nonthreaded GUI, returning result:
-- tour/runmode02.hs
import Vision.GUI
import Image.Processing
f = sumPixels . grayscale
main = do
prepare
rs <- runNT camera $ observe "Image" rgb >>> arr f
print rs
runmode3: nonthreaded GUI, returning result:
-- tour/runmode3.hs
-- non threaded GUI, discarding result
import Vision.GUI
import Image.Processing
main = do
prepare
runNT_ camera (observe "image" rgb >>> arr (sumPixels.grayscale))
putStrLn "bye!"
runmode03: threaded GUI, returning result:
-- tour/runmode03.hs import Vision.GUI import Image.Processing f = sumPixels . grayscale main = runT camera (observe "Image" rgb >>> arr f) >>= print
runmode4: nonthreaded GUI, returning result:
-- tour/runmode4.hs
-- non threaded GUI, returning result
import Vision.GUI
import Image.Processing
main = do
prepare
r <- runNT camera (observe "image" rgb >>> arr (sumPixels.grayscale))
print r
putStrLn "bye!"
runmode04: load single image from the command line:
-- tour/runmode04.hs
import Image.Processing
import System.Environment
f = sumPixels . grayscale
main = do
filename:_ <- getArgs
img <- channelsFromRGB `fmap` loadRGB filename
print (f img)
runmode05: load lazily all images in a directory:
-- tour/runmode05.hs
import Image.Processing
import Image.Capture
import System.Environment
f = sumPixels . grayscale . channelsFromRGB
main = do
folder:_ <- getArgs
imgs <- readFolderIM folder
print (map (f.fst) imgs)
runmode06: process pipeline and then work with it:
-- tour/runmode06.hs import Vision.GUI import Image.Processing f = sumPixels . grayscale main = runS camera (arr f) >>= print . sum
runS: same thing.
-- tour/runS.hs
import Vision.GUI
import Image.Processing
main = do
r <- runS camera $ arr (size . grayscale)
print $ take 10 r
scanl1: scanl to perform a recursive computation. The video is shown inside the video. Run as
$ ./scanl1 ../../data/videos/rcube.avi
-- tour/scanl1.hs
import Vision.GUI
import Image.Processing
import Contours.Polygons
import Contours
import Util.Geometry
import Numeric.LinearAlgebra((<>))
import Vision(cameraFromHomogZ0,estimateHomographyRaw,ht,scaling)
import Util.Misc(rotateLeft,posMax)
darkContours = (id &&& (otsuContours >>> map (smoothPolyline 4)))
otsuContours = contours 1000 100 . notI . otsuBinarize
main = run $ arr grayscale
>>> arr darkContours
>>> arr (id *** take 1 . polygons 10 5 (4, 4))
>>> observe "detected" shinfo
>>> arrL (scanl1 f)
>>> observe "recursive" fst
shinfo (im,ps) = Draw [ Draw im
, (Draw . map (drawContourLabeled blue red white 2 3)) ps ]
f (a,_) (im,c:_) = (warpon im [(h,a)], [c])
where
h = estimateHomographyRaw (g c) [[1,r],[-1,r],[-1,-r],[1,-r]] <> scaling 0.95
where
r = 0.75
g (Closed ps) = map (\(Point x y) -> [x,y]) (up ps)
up = rotateLeft (k+2)
k = posMax $ map segmentLength (asSegments c)
f _ x = x
single: read a list of image files and lazily work with them. Run as
(fixme)
-- tour/single.hs import Vision.GUI import Image.Processing import Image.Capture import System.Environment f = sumPixels . grayscale . channelsFromRGB main = getArgs >>= readImages >>= runITrans (arr f) >>= print
skip: drop the first n frames of the input sequence
(fixme)
-- tour/skip.hs
import Vision.GUI
import Image.Processing
import Util.Options
f = sumPixels . grayscale
main = do
n <- getOption "--skip" 0
prepare
r <- runNT camera $ arrL (drop n) >>> observe "image" rgb >>> arr f
print (length r)
Used in pipelines.
example of an intercative window which captures clicked points:
-- tour/interface.hs
import Vision.GUI hiding (clickPoints)
import Image.Processing
main = run clickPoints
clickPoints :: ITrans Channels ([Point], Image Gray)
clickPoints = transUI $ interface (Size 240 320) "click points"
state0 firsttime updts acts result display
where
state0 = []
firsttime _ _ = return ()
updts = [(key (MouseButton LeftButton), \_droi pt pts -> pt:pts)]
acts = []
result _droi pts input = (pts, (pts, notI . grayscale $ input))
display _droi _pts _input (pts,x) = Draw [ Draw x, drwpts ]
where drwpts = (color green . pointSz 3) pts
passROI: example of an interactive window to capture the region of interest.
-- tour/passROI.hs
import Vision.GUI
import Image.Processing
import Image.ROI
main = run $ arr grayscale >>> getROI "change roi" >>> arr cleanROI >>> observe "only roi" Draw
cleanROI im = resize (roiSize (roi im)) im
getROI name = transUI
$ interface (Size 240 360) name state0 firsttime updts acts result display
where
state0 = ()
firsttime _ _ = return ()
updts = []
acts = []
result droi _s input = ((), setRegion droi input)
display _droi _s _input output = Draw output
GUI for more conventional programs.
"standalone" interactive graphic window. Click to change state:
-- tour/stand1.hs
import Vision.GUI
import Image
main = runIt win
win = standalone (Size 100 400) "click to change" x0 updts [] sh
where
x0 = 7
sh = text (Point 0 0) . show
updts = [(key (MouseButton LeftButton), \_droi _pt -> (+1)) ]
"browser" window. Use the wheel to see the elements of a list of things:
-- tour/stand2.hs
import Vision.GUI
import Image
main = runIt win
win = browser "odd numbers" xs sh
where
xs = [1,3 .. 21]
sh _k = text (Point 0 0) . show
"editor" window. change the elements of a list of things:
-- tour/stand3.hs
import Vision.GUI
import Image
import Util.Misc(replaceAt)
main = runIt win
win = editor update save "editor" [2,4 .. 10] sh
where
sh k x = Draw [ color white $ text (Point 0 0) (show x)
, color yellow $ text (Point 0.9 0.8) ("# "++show k) ]
update = [ op (Char '+') succ
, op (Char '-') pred
, opS (Char 'P') (*10)
]
save = [(ctrlS, \_roi _pt (_k,xs) -> print xs)]
ctrlS = kCtrl (key (Char '\DC3'))
op c f = updateItem (key c) (const.const $ f)
opS c f = updateItem ((kShift . key) c) (const.const $ f)
draw, drawParam, drawParam3D: example of drawing functions.
interactive3D: add elements to a 3D graphic from ghci.
"autoParam" automagically creates the parameter record, the interactive window, and support for command line arguments. "withParam" supplies the "current" value to a pure function.
-- tour/param2.hs
{-# LANGUAGE TemplateHaskell, RecordWildCards #-}
import Vision.GUI
import Image.Processing
autoParam "SParam" "g-" [ ("sigma","Float",realParam 3 0 20)
, ("scale","Float",realParam 1 0 5) ]
main = run $ arr grayscale
>>> withParam g
>>> observe "gauss" id
g SParam{..} = (scale .*) . gaussS sigma . toFloat
-- tour/param3.hs
{-# LANGUAGE TemplateHaskell, RecordWildCards #-}
import Vision.GUI
import Image.Processing
autoParam "SParam" "g-" [ ("radius","Int",intParam 2 0 10) ]
main = run $ arr grayscale
>>> withParam (,)
>>> observe "median filter" sh >>> freqMonitor
sh (SParam{..}, x) = filterMedian radius x
The initial value of any parameter can be set in the command line:
$ ./ param --g-sigma=1.5
all parameter windows can be removed:
$ ./ param --default
observe and sMonitor windows can be selectively removed:
$ ./ param --no-gauss
--options shows all options recognized by a program
Changes in the state of a window may trigger changes in other windows:
-- tour/connect.hs
import Vision.GUI.Simple
import Image
import Util.Geometry
main = runIt $ do
p <- click "click points"
w <- browser "work with them" [] (const Draw)
connectWith g p w
g _ pts = (0, [ map (Segment (Point 0 0)) pts] )
click name = standalone (Size 400 400) name [] updts [] sh
where
updts = [ (key (MouseButton LeftButton), \_ p ps -> ps++[p]) ]
sh = color yellow . drawPointsLabeled
Using the general purpuse "clickPoints" window:
-- tour/clickPoints.hs
import Vision.GUI.Simple
import Image
import Util.Geometry
import Util.Polygon
import Data.Traversable(traverse)
import Util.Options(getRawOption)
main = do
mbimg <- getRawOption "--image" >>= traverse loadRGB
runIt $ do
p <- clickPoints "click points" "--points" () (sh mbimg.fst)
w <- browser "work with them" [] (const id)
connectWith g p w
sh mbimg pts = Draw [ Draw mbimg
, color yellow . drawPointsLabeled $ pts]
g (k,_) (ps,_) = (k, [ pointSz 5 ps
, Draw (Closed ps)
, color green $ fillPolygon (Polygon ps)
, Draw (convexComponents (Polygon ps))
])
Explicit use of "evNotify" to do things when the state of an interface window changes.
-- examples/cameracontrol.hs
{-# LANGUAGE TemplateHaskell, RecordWildCards #-}
import Vision.GUI
import System.Process
import Data.IORef
import Control.Monad(join,when)
autoParam "V4l2_ctl" ""
[ ("device", "Int", intParam 1 0 1)
, ("focus", "Int", intParam 0 0 255)
, ("exposure_auto", "String", stringParam "1" ["0","1","3"])
, ("exposure_absolute", "Int" , intParam 166 1 10000)
, ("power_line_frequency", "String", stringParam "0" ["0","1"])
]
ctl d p v = system ("v4l2-ctl -d /dev/video"++show d++" -c "++p++"="++v) >> return ()
main = runIt $ do
(wp,gp) <- mkParam :: MkParam V4l2_ctl
writeIORef (evNotify wp) $ do
V4l2_ctl{..} <- gp
ctl device "focus" (show focus)
ctl device "sharpness" "0"
when (exposure_auto/="0") $
ctl device "exposure_auto" exposure_auto
when (exposure_auto=="0") $
ctl device "exposure_absolute" (show exposure_absolute)
ctl device "power_line_frequency" power_line_frequency
(join . readIORef) (evNotify wp)
noleak, noleak2: check that there are no space leaks caused by observed results no longer used.
noguiraw: tests of low level lazyIO functions.
batch, batch2 (run modes?)