Colour.lhs0000644000175000001440000002661010012200236012217 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Colour} \subsection{Header} This module implements Colour as an ADT, just like Point. It also defines some useful operations. The original Pancito had a whole pile of Colour functions that I never used; this one doesn't. Other changes include HSV support and pre-multiplied alpha. \begin{code} module Colour ( Colour, rgba, hsva, optimizeHsva, optimizeRgba, tiny, r, g, b, a, h, s, v, setR, setG, setB, setA, setH, setS, setV, Tint', Tint, red, green, blue, black, white, opacity, transparent, interp, lighten, darken, gamma, cyan, magenta, yellow, grey, rotateHue, saturate, brighten, brighten', overlay, combine, add, sub, average', average, cMap, ranColour, ranColour' ) where import Common import Random \end{code} \subsection{Constructor, Classes} Again, by using two different representations we can avoid unnecessary conversions (if the user is explicit in writing conversions) but still support both representations at any point. We can also check that components are within accepted value ranges. However, there are some disadvantages to using two different representations: some operations depend on the underlying type. In particular, adding two colours gives different results for HSVA and RGBA encoded values. This is ugly, but I'm not sure what the best solution is. At the moment, you are free to force the type using the two optimize functions. An alternative would be to provide different functions for the two operations. \begin{code} data Colour = RGBA Double Double Double Double | HSVA Double Double Double Double instance Eq Colour where p1 == p2 = equalColour p1 p2 equalColour (RGBA r1 g1 b1 a1) (RGBA r2 g2 b2 a2) = r1 == r2 && g1 == g2 && b1 == b2 && a1 == a2 equalColour (HSVA h1 s1 v1 a1) (HSVA h2 s2 v2 a2) = h1 == h2 && s1 == s2 && v1 == v2 && a1 == a2 equalColour c1 c2 = equalColour c1' c2' where c1' = optimizeRgba c1 c2' = optimizeRgba c2 instance Show Colour where show p = showColour p showColour (RGBA r g b a) = "rgb(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ "," ++ show a ++ ")" showColour (HSVA h s v a) = "hsv(" ++ show h ++ "," ++ show s ++ "," ++ show v ++ "," ++ show a ++ ")" \end{code} \subsection{Proxy Constructors} The constructor is hidden --- these should be used instead. They enforce value ranges (including pre--multiplied alpha) which are assumed when values are accessed later. \begin{code} rgba, hsva :: Double -> Double -> Double -> Double -> Colour rgba r g b a = RGBA (clip0 a' r) (clip0 a' g) (clip0 a' b) a' where a' = (clip01 a) hsva h s v a = HSVA (roll2pi h) (clip01 s) (clip0 a' v) a' where a' = (clip01 a) \end{code} \subsection{Conversion} Again, note that explicit conversion is optional, but improves efficiency. The conversions here are lifted from several posts on the internet (search for ``RGB HSV convert''), translated from C or pseudocode to Haskell. I hope an optimizing compiler can simplify the logic in the comparisons (I could do it by hand, but then it would even less readable). \begin{code} tiny = 0.000001 mkHSVA max min n x y a = hsva (rad * (n + xy)) s max a where d = max - min s = if max > tiny then d / max else 0 xy = if d > tiny then (x - y) / d else 0 rad = pi / 3.0 rgbaToHsva (RGBA r g b a) | abs (r - g) < tiny && abs (g - b) < tiny && abs (b - r) < tiny = hsva 0 0 r a | order b g r = mkHSVA r b 0 g b a | order g b r = mkHSVA r g 0 g b a | order r b g = mkHSVA g r 2 b r a | order b r g = mkHSVA g b 2 b r a | order g r b = mkHSVA b g 4 r g a | order r g b = mkHSVA b r 4 r g a where order x y z = x <= y && y <= z optimizeHsva :: Colour -> Colour optimizeHsva c = case c of (RGBA r g b a) -> rgbaToHsva c (HSVA h s v a) -> c mkRgba i p q t v a | i == 0 = rgba v t p a | i == 1 = rgba q v p a | i == 2 = rgba p v t a | i == 3 = rgba p q v a | i == 4 = rgba t p v a | i == 5 = rgba v p q a | otherwise = error ("case " ++ show i ++ " for " ++ show p ++ ", " ++ show q ++ ", " ++ show t ++ ", " ++ show v ++ ", " ++ show a ++ " in mkRgba") hsvaToRgba (HSVA h s v a) | s == 0.0 = rgba v v v a | otherwise = mkRgba i p q t v a where h' = h / rad rad = pi / 3.0 i = floor h' f = h' - fromIntegral i p = v * (1 - s) q = v * (1 - s * f) t = v * (1 - s * (1 - f)) optimizeRgba :: Colour -> Colour optimizeRgba c = case c of (RGBA r g b a) -> c (HSVA h s v a) -> hsvaToRgba c \end{code} \subsection{Access} The following operators pull values out from the ADT. \begin{code} r, g, b, a, h, s, v :: Colour -> Double r c = case c of (RGBA r' g b a) -> r' (HSVA h s v a) -> r (hsvaToRgba c) g c = case c of (RGBA r g' b a) -> g' (HSVA h s v a) -> g (hsvaToRgba c) b c = case c of (RGBA r g b' a) -> b' (HSVA h s v a) -> b (hsvaToRgba c) a c = case c of (RGBA r g b a') -> a' (HSVA h s v a') -> a' h c = case c of (RGBA r g b a) -> h (rgbaToHsva c) (HSVA h' s v a) -> h' s c = case c of (RGBA r g b a) -> s (rgbaToHsva c) (HSVA h s' v a) -> s' v c = case c of (RGBA r g b a) -> v (rgbaToHsva c) (HSVA h s v' a) -> v' \end{code} \subsection{Modification} Probably not very useful if alpha used (pre-multiplied). \begin{code} setR, setG, setB, setA, setH, setS, setV :: Double -> Colour -> Colour setR r c = rgba r (g c') (b c') (a c') where c' = optimizeRgba c setG g c = rgba (r c') g (b c') (a c') where c' = optimizeRgba c setB b c = rgba (r c') (g c') b (a c') where c' = optimizeRgba c setA a c = rgba (r c') (g c') (b c') a where c' = optimizeRgba c setH h c = hsva h (s c') (v c') (a c') where c' = optimizeHsva c setS s c = hsva (h c') s (v c') (a c') where c' = optimizeHsva c setV v c = hsva (h c') (s c') v (a c') where c' = optimizeHsva c \end{code} \subsection{Utilities} First, a few colours and simple tools. I've not provided anything to force a single component to a value (but see combining colours later). The Tint type will be discussed later when bring everything together into a pipeline. Note that, unlike Pancito 1, alpha is pre-multiplied (thanks to Conal Elliott for point me to Alvy Ray Smith's work\footnote{http://www.alvyray.com --- Memo ``Image Compositing Fundamentals''.}). \begin{code} type Tint' a b = a -> b type Tint = Tint' Colour Colour red, green, blue, black, white :: Colour red = rgba 1 0 0 1 green = rgba 0 1 0 1 blue = rgba 0 0 1 1 white = rgba 1 1 1 1 black = rgba 0 0 0 1 opacity :: Double -> Tint opacity x (RGBA r g b a) = rgba r' g' b' x where r' = rescale r a x g' = rescale g a x b' = rescale b a x opacity x (HSVA h s v a) = hsva h s' v' x where s' = rescale s a x v' = rescale v a x rescale x old new | old < tiny = 0 -- transparent is black? | otherwise = x * new / old transparent = opacity 0 black \end{code} Colours can be interpolated (this preserves alpha from the {\em second} colour, allowing functions like lighten and darken that leave transparency unchanged to be defined using currying): \begin{code} interp :: Double -> Colour -> Tint interp frac c1 c2 = rgba (intp r) (intp g) (intp b) a2 where intp f = (\x -> x + frac * ((f c2') - x)) (f c1') a2 = a c2 c1' = opacity a2 $ optimizeRgba c1 c2' = optimizeRgba c2 lighten, darken :: Double -> Tint lighten frac = interp (1 - frac) white darken frac = interp (1 - frac) black cyan, magenta, yellow, grey :: Colour cyan = interp 0.5 blue green magenta = interp 0.5 red blue yellow = interp 0.5 green red --- 0.6 looks better on my screen grey = interp 0.5 black white \end{code} The equivalent of interpolation when thinking is HSVA space is a bunch of separate actions: \begin{code} rotateHue, saturate, brighten, brighten' :: Double -> Tint rotateHue theta c = hsva (h c' + theta) (s c') (v c') (a c) where c' = optimizeHsva c saturate x c = hsva (h c') (s c' + x) (v c') (a c) where c' = optimizeHsva c brighten x c = hsva (h c') (s c') (v c' + x) (a c) where c' = optimizeHsva c brighten' x c = hsva (h c') (s c') (v c' * x) (a c) where c' = optimizeHsva c \end{code} Then there's gamma correction. \begin{code} gamma :: Double -> Tint gamma x c = rgba ((r c')**x) ((g c')**x) ((b c')**x) ((a c')**x) where c' = optimizeRgba c \end{code} \subsection{Combining Colours} The canonical way to combine colours is by overlaying and letting the alpha channel do its work. In Pancito 1, ``underlay'' had reversed arguments for use with foldl. I now understand foldr is the fundamental fold, so am back with ``overlay'' (the first argument is laid over the second). \begin{code} overlay :: Colour -> Colour -> Colour overlay c1 c2 = rgba (ov r) (ov g) (ov b) (ov a) where c1' = optimizeRgba c1 c2' = optimizeRgba c2 beta = a c1 ov clr = (clr c1') + (1 - beta) * (clr c2') \end{code} If this isn't what you want (it often isn't when you're dealing with pure colour images, as it loses saturation) the following might help (alpha is set to 1 to avoid limiting when pre--multiplication is enforced). \begin{code} combine :: (Double -> Double -> Double) -> Colour -> Colour -> Colour combine f (HSVA h1 s1 v1 a1) (HSVA h2 s2 v2 a2) = hsva (f h1 h2) (f s1 s2) (f v1 v2) 1 combine f (RGBA r1 g1 b1 a1) (RGBA r2 g2 b2 a2) = rgba (f r1 r2) (f g1 g2) (f b1 b2) 1 combine f c1 c2 = combine f c1' c2' where c1' = optimizeRgba c1 c2' = optimizeRgba c2 add, sub :: Colour -> Colour -> Colour add = combine (+) sub = combine (-) \end{code} An average (RGBA) of a list of colours is useful sometimes. \begin{code} average' :: Colour -> (Colour, Int) -> (Colour, Int) average' c1 (c2, n) = (clr, n') where n' = n + 1 clr = rgba (av r) (av g) (av b) (av a) c1' = optimizeRgba c1 c2' = optimizeRgba c2 k1 = 1.0 / fromIntegral n' k2 = fromIntegral n / fromIntegral n' av f = (k1 * f c1') + (k2 * f c2') average :: [Colour] -> Colour average = fst . foldr average' (black, 0) \end{code} It can also be convenient to apply a function to each component of a colour. \begin{code} cMap :: (Double -> Double) -> Colour -> Colour cMap f (HSVA h1 s1 v1 a1) = hsva (f h1) (f s1) (f v1) 1 cMap f (RGBA r1 g1 b1 a1) = rgba (f r1) (f g1) (f b1) 1 \end{code} \subsection{Random Colours} \begin{code} ranColour' :: StdGen -> [Colour] ranColour' ran = ranColour'' $ randoms ran ranColour'' :: [Double] -> [Colour] ranColour'' (r':g':b':rgb) = (rgba r' g' b' 1.0):(ranColour'' rgb) ranColour :: Int -> [Colour] ranColour n = ranColour' $ mkStdGen n \end{code} Common.lhs0000644000175000001440000000301210012200236012173 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Common} Some very basic common functions. \begin{code} module Common ( clip, clip0, clip01, roll, roll2pi ) where \end{code} \begin{code} roll :: Double -> Double -> Double -> Double roll lo hi x | x >= hi = roll lo hi (x - d) | x < lo = roll lo hi (x + d) | otherwise = x where d = hi - lo roll2pi :: Double -> Double roll2pi = roll 0.0 (2.0 * pi) clip :: Double -> Double -> Double -> Double clip lo hi x | x > hi = hi | x < lo = lo | otherwise = x clip0 :: Double -> Double -> Double clip0 = clip 0 clip01 :: Double -> Double clip01 = clip0 1 \end{code}COPYRIGHT0000644000175000001440000000146010012200236011533 0ustar andrewusers Pancito v 2.2 - Functional Images in Haskell Copyright 2004 Andrew Cooke (andrew@acooke.org) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Flux.lhs0000644000175000001440000001174610012200236011676 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Flux} \subsection{Header} This module supports images and transformations which conserve "flux" in a very general sense. More accurately, they work with (Point, Scaling) tuples, where Scaling is a factor that represents the cumulative Jacobean of the transformations made. What is a Jacobean? In simple terms, it's the ratio of pixel areas before and after a transform. It's useful when modelling some physical property that is fixed per unit area (in the case of images, typically light). So , for example, if you magnify something you're spreading the photons that were coming towards your eye over a wider area, and the image should appear darker. \begin{code} module Flux ( FPoint (FPoint), p, z, setP, setZ, fOrigin, fppm, fppm_, point, line, Render, idRender, mkRender, renderSat, fSat, renderHue, fHue, renderVal, fVal, renderVal', fVal', fTint ) where import Colour import Point import Pancito2 \end{code} \subsection{Point with Jacobean} \begin{code} data FPoint = FPoint Point Double setP :: Point -> FPoint -> FPoint setP p (FPoint _ z) = FPoint p z setZ :: Double -> FPoint -> FPoint setZ z (FPoint p _) = FPoint p z p :: FPoint -> Point p (FPoint p' _) = p' z :: FPoint -> Double z (FPoint _ z') = z' instance Point' FPoint where x = x . p y = y . p d = d . p t = t . p optimizeCartesian (FPoint p z) = FPoint (optimizeCartesian p) z optimizePolar (FPoint p z) = FPoint (optimizePolar p) z setXy x y (FPoint p z) = FPoint (setXy x y p) z setDt d t (FPoint p z) = FPoint (setDt d t p) z instance Eq FPoint where p1 == p2 = (p p1) == (p p2) instance Show FPoint where show (FPoint p z) = "[" ++ (show $ x p) ++ "," ++ (show $ y p) ++ "," ++ (show z) ++ "]" fOrigin :: FPoint fOrigin = FPoint origin 1.0 \end{code} \subsection{Output} It's easy to build output routines from the base code in the Pancito2 module. \begin{code} fppm :: Window' FPoint -> (Int, Int) -> String -> Image' FPoint -> IO () fppm = ppmBase idBox idImage idWrite (idPixels fOrigin) fppm_ :: Window' FPoint -> (Int, Int) -> String -> Image' FPoint -> IO () fppm_ = ppmBase idBox idImage monWrite (monPixels fOrigin) \end{code} \subsection{Lensing} The basic transforms for a lens. The first parameter gives the strength of the lensing, the second gives the scale. \begin{code} f a b x = x * (1.0 + (a * x) / (x**2 + b**2)) f' a b x = 1.0 + 2.0 * a * x / (x**2 + b**2) - 2.0 * a * x**3 / (x**2 + b**2)**2 \end{code} A point lens. \begin{code} point :: (Double, Double) -> FPoint -> Transform' FPoint point (a, b) c fp = setZ z' (c `add'` delta') where delta = fp `sub'` c dist = d delta dist' = f a b dist delta' = setD dist' delta z' = (z fp) * f' a b dist \end{code} A linear lens. \begin{code} line :: (Double, Double) -> Line FPoint -> Transform' FPoint line (a, b) ln fp = setZ z' (near `add'` delta') where near = nearest ln fp delta = fp `sub'` near dist = d delta dist' = f a b dist delta' = setD dist' delta z' = (z fp) * f' a b dist \end{code} \subsection{Rendering} The FPoint based transforms construct a filter that is applied to an underlying Image. The conversion from Image to Image' FPoint involves interpreting the Jacobean. \begin{code} type Render = Image -> Image' FPoint idRender :: Render idRender im fp = im (p fp) mkRender :: VTint' FPoint -> Render mkRender vt im fp = vt fp $ idRender im fp renderSat :: Render renderSat = mkRender fSat fSat :: VTint' FPoint fSat fp = saturate (z fp - 1.0) renderVal :: Render renderVal = mkRender fVal fVal :: VTint' FPoint fVal fp = brighten (z fp - 1.0) renderVal' :: Render renderVal' = mkRender fVal' fVal' :: VTint' FPoint fVal' fp = brighten' (z fp) renderHue :: Render renderHue = mkRender fHue fHue :: VTint' FPoint fHue fp = rotateHue (z fp - 1.0) \end{code} \subsection{Conversion} Rendering converts an image, but we also need to convert other types. \begin{code} fTint :: VTint -> VTint' FPoint fTint vt fp = vt (p fp) \end{code} haskell.sty0000644000175000001440000000620210012200236012423 0ustar andrewusers\ProvidesPackage{haskell} % (c) Andrew Cooke 2001 % Released under the GPL - see http://www.gnu.org % % This file is a simple Latex style file that, together with the % listings package (and the geometry, titlesec and graphicx packages if % you include the code below that sets up a particular page style), % supports mixing Latex and Haskell. % % These packages are present on my machine as part of tetex (which is % provided by the Debian/testing distribution). % % Haskell already supports a literate programming style. If you put % Haskell code into a file that ends in ``.lhs'' then the contents will % be ignored except for anything between \begin{code} and \end{code}. % % All that I do below is add the glue to make this invoke the % appropriate actions in the listings package when Latex processes the % file. This takes the code inside the code block and formats it % nicely. % % For examples, see http://www.andrewcooke.free-online.co.uk/jara/pancito % This stops warning from listings when used in article mode - you don't % want it if you are not using teh article style \newcounter{chapter} % Load the package that does the real work \usepackage{listings} \lstloadlanguages{Haskell} % Connect the code blocks to listins - this is the important bit! \lstnewenvironment{code} {\lstset{}% \csname lst@SetFirstLabel\endcsname} {\csname lst@SaveFirstLabel\endcsname} % The next chunk of code customizes the code appearance. See the % listings package documentation for full details. \lstset{ % basicstyle=\small, % swap this and the following line for prop. font basicstyle=\small\ttfamily, % keywordstyle=\underbar, % these look ugly % identifierstyle=\slshape, % commentstyle=\underbar flexiblecolumns=false, basewidth={0.5em,0.45em}, % The following replace compound charcters like -> % Something is missing - someone kindly sent me an email which % I've lost - but it's obvious how to add more. literate={-}{{$-$}}1 {+}{{$+$}}1 {/}{{$/$}}1 {*}{{$*$}}1 {=}{{$=$}}1 {>}{{$>$}}1 {<}{{$<$}}1 {->}{{$\rightarrow$}}2 {>=}{{$\geq$}}2 {<-}{{$\leftarrow$}}2 {<=}{{$\leq$}}2 {=>}{{$\Rightarrow$}}2 {\ .}{{ $\circ$}}2 } % From here down it's just arranging things on the page how I like them % - nothing to do with formatting code etc. % Page size \usepackage[hmargin={6cm,3cm},vmargin={2cm,2cm},offset=0pt,nohead]{geometry} % Titles, layout etc \usepackage{titlesec} \titleformat{\part}[frame] {\normalfont} {\filright\footnotesize\enspace Andrew Cooke \enspace} {8pt} {\Large\bfseries\sffamily\filcenter} \titlespacing{\part} {-3cm}{-0.5cm}{5ex} \titleformat{\section}[leftmargin] {\large\bfseries\sffamily\filleft} {}{0pt}{} \titlespacing{\section} {3cm}{2.5ex plus .1ex minus .2ex}{1pc} \titleformat{\subsection}[leftmargin] {\normalfont\bfseries\sffamily\filleft} {}{0pt}{} \titlespacing{\subsection} {3cm}{1.5ex plus .1ex minus .2ex}{1pc} \titleformat{\subsubsection}[hang] {\normalfont\bfseries\sffamily} {}{0pt}{} \titlespacing{\subsubsection} {0pt}{1.0ex plus .1ex minus .2ex}{1pc} \setlength{\parindent 0pt} \setlength{\parskip 1.5ex plus 0.5ex minus 0.2ex} % Support eps images \usepackage{graphicx} LICENCE0000644000175000001440000004330310012200236011227 0ustar andrewusers GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. Pancito2.lhs0000644000175000001440000004355710012200236012444 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Pancito2} \subsection{Header} This builds on the Colours and Points defined earlier to provide support for generating and writing Images. \begin{code} module Pancito2 ( Image'', Image', Image, flat, Merge, foldc, over, avg, boxToWindow, dimToWindow, dimToBox, VTint', VTint, o, Filter', Filter, mkFilter, pixelStream, pixelToPoint, openPpm, writePpm, closePpm, ppmBase, tileBox, MkBox, MkImage, PxWrite, MkPixels, idBox, idImage, idWrite, idPixels, ppm, ppmAlias, ppmAlias', tile, tileAlias, tileAlias', monWrite, monPixels, countBox, ppm_, ppmAlias_, ppmAlias'_, tile_, tileAlias_, tileAlias'_ ) where import Point import Colour import IO import Control.Monad import System.IO.Unsafe \end{code} \subsection{Image} Pancito considers images to be functions. Give an image a point and it gives you a colour: \begin{code} type Image'' p a = p -> a type Image' p = Image'' p Colour type Image = Image' Point flat :: Colour -> Image' p flat c _ = c \end{code} \subsection{Simple Image Pipelines} It's useful to think of a functional image as a pipeline (a flow from right to left matches Haskell's syntax when using function application or composition). To find the colour at a particular point in an image we pop the Point into the right of the pipeline. The Point can then pass through Transforms (defined in Point --- these can alter the Point coordinates, distorting the image) before entering an Image. The Image converts the Point to a Colour. The Colour then continues down the pipe to the left, possibly passing through Tints that alter it further, before finally appearing to us. Simple Tints can be made from functions defined in Colour (brighten or saturate, for example); Point has several Transforms. The description above is a very simple pipeline. Now we will extend them to include several pipes in parallel and Tints that can vary with position. \subsection{Parallel Images} A list of images can be generated in parallel and combind in some way. The simplest example of combination is by overlaying. \begin{code} type Merge' p a = [Image'' p a] -> Image'' p a type Merge p = Merge' p Colour foldc :: (a -> b -> b) -> b -> [Image'' p a] -> Image'' p b foldc f v ims p = foldr (\im v' -> f (im p) v') v ims over :: Colour -> Merge p over = foldc overlay avg :: Merge p avg ims p = fst $ foldc average' (black, 0) ims p \end{code} That code is fairly dense, so some examples will probably help clear things up: \begin{code} im1, im2, imR, imG :: Image' p imR = flat red imG = flat green im1 = over white [imR, imG] im2 = foldc add black [imR, imG] \end{code} Here im1 is white overlaid with a red and then a green image (and since green is opaque, the result will be green). Im2 is formed by adding the individual colour components and so will be yellow. \subsection{Varying Tints} The type system described so far doesn't support Tints that vary with position (within a pipeline defined purely using functional composition a Tint does not receive a Point). We can always work round this: \begin{code} {- mkTint :: Point -> Tint im1, im2 :: Image' im1 p = tint . im2 p where tint = mkTint p -} \end{code} but it's pretty ugly. Instead, we can replace the ``.'' of functional composition with a different operator, ``o'' that pulls a Point from earlier in the pipeline. \begin{code} type VTint' p = p -> Tint type VTint = VTint' Point o :: VTint' p -> Image' p -> Image' p o mkTint im p = mkTint p $ im p infixr 8 `o` \end{code} For example, \begin{code} {- brightPos :: VTint brightPos p = if (x p > 0) then brighten 0.5 else brighten (-0.5) im1, im2, imR :: Image' imR = flat red im1 = brightPos `o` imR . shift 1 2 im2 = (brightPos `o` imR) . shift 1 2 -} \end{code} Note that because ``o'' binds less strongly that ``.'' the coordinate received by the tint in im1 above will not be shifted. This behaviour can be altered using parentheses, as in im2. \subsection{Filter} A still more general operation is Filter. \begin{code} type Filter' p = Image' p -> Image' p type Filter = Filter' Point \end{code} While this could be any code, a simple way of building filters is by assembling a Tint and a Transform. \begin{code} mkFilter :: Tint -> Transform' p -> Filter' p mkFilter tint trans im = tint . im . trans \end{code} \section{Output} Yet again, the code here has changed. It was an embarassing mess before. Hopefully this will be much clearer (although more succinct). \subsection{Pixels and Points} An image is a function defined over a fixed range of points -- the image has a fixed domain. However, we may want to "realise" the image at a variety of different resolutions/sizes. So the number of pixels used to generate the image may vary. It's natural (and useful when tiling, for example) to identify pixels with Points at integer coordinates, but this raises a problem: as we change the number of pixels, we alter the range of values over which we evaluate the function. The functions below attempt to protect the user from this. Images are assumed to be defined over a certain window, which is supplied to the output routines. It is the responsibility of the output routines to generate the approrpiate transforms from pixel coordinates to the coordinates defined by the image window. Also, for various rather subtle practical reasons, it simplifies the code if the centres of pixels are at 0.5, 1.5, etc. Since each pixel has unit dimension this means that the bottom left corner of the image (bottom left corner of the bottom left pixel) is (0,0) and the top right corner is (nx, ny). The type Box is used internally to define the range of pixel values required. \begin{code} type Box = ((Int, Int), (Int, Int)) \end{code} \subsection{ppm Format} The ppm image format is simple, text based, verbose, and has no support for transparent images, but it does support arbitrary colour depth and can be converted to a wide variety of other formats using the netpbm and pbmplus packages (for CMYK encoded tiff files, see my own pnmtocmyktiff). A line in a ppm file can contain a maximum of 70 characters... \begin{code} lineLimit :: Int lineLimit = 69 -- allow for \n putChunk :: Handle -> Int -> String -> IO Int putChunk h soFar str | soFar == 0 = do hPutStr h str return len | tot >= lineLimit = do hPutChar h '\n' hPutStr h str return len | otherwise = do hPutChar h ' ' hPutStr h str return tot where len = length str tot = soFar + len + 1 \end{code} ...and begins with the following header: \begin{code} headerPpm :: Handle -> Box -> Int -> IO (Handle) headerPpm h ((xlo, ylo), (xhi, yhi)) n = do hPutStrLn h "P3" hPutStrLn h (show x) hPutStrLn h (show y) hPutStr h (show n) hPutStr h "\n" return h where x = xhi - xlo y = yhi - ylo \end{code} We must convert Colour to RGB values for printing. Note that here, n is a direct scale factor and we drop the transparency (not supported by ppm). \begin{code} colourToInts :: Int -> Colour -> [Int] colourToInts bits c = [flr r, flr g, flr b] where n = 2^bits - 1 flr f = max 0 (min n (floor (realToFrac n * f c'))) c' = optimizeRgba c groupRgb :: [Int] -> String groupRgb s = foldr addsp "" s where addsp x y = (show x) ++ " " ++ y showRgb :: Int -> Colour -> String showRgb bits = groupRgb . colourToInts bits \end{code} We can package these into three calls. Two open and close the file. The third is folded over the points to write the data. \begin{code} openPpm :: String -> Int -> Box -> IO(Handle) openPpm name b bx = do h <- openFile name WriteMode headerPpm h bx n where n = 2^b -1 closePpm :: Handle -> IO () closePpm h = do hPutStr h "\n" hClose h writePpm :: Point' p => Handle -> Int -> Image' p -> Int -> p -> IO(Int) writePpm h bits im soFar p = putChunk h soFar $ showRgb bits . im $ p \end{code} \subsection{Generating Images} Here we generate the sequence of points, provide utilities for converting between pixels and points, and wrap everything together. \begin{code} dimToBox :: (Int, Int) -> Box dimToBox dim = ((0, 0), dim) boxToWindow :: Point' p => p -> Box -> Window' p boxToWindow p0 ((xlo, ylo), (xhi, yhi)) = (setXy xlo' ylo' p0, setXy xhi' yhi' p0) where xlo' = fromIntegral xlo ylo' = fromIntegral ylo xhi' = fromIntegral xhi yhi' = fromIntegral yhi -- boxToWindow :: Box -> Window Point -- boxToWindow = boxToWindow' origin dimToWindow :: Point' p => p -> (Int, Int) -> Window' p dimToWindow p0 = boxToWindow p0 . dimToBox pixelStream :: Point' p => p -> Box -> [p] pixelStream p0 ((xlo, ylo), (xhi, yhi)) = [setXy (0.5 + fromIntegral x) (0.5 + fromIntegral y) p0 | y <- [yhi-1,yhi-2..ylo], x <- [xlo..xhi-1]] pixelToPoint :: Point' p => Window' p -> Box -> (p -> p) pixelToPoint w b p = mapWindow w (boxToWindow p b) p {- ppm :: Window -> (Int, Int) -> String -> Image -> IO () ppm w dim name im = do h <- openPpm name bits bx foldM (writePpm h bits im') 0 px closePpm h where bits = 8 bx = dimToBox dim im' = im . pixelToPoint w bx px = pixelStream bx -} \end{code} The definition of ppm above is not used because we derive it from a more general basis below. \subsection{Generalization} The following factorization has the benefit of hindsight. \begin{code} type MkBox = (Int, Int) -> Box type MkImage p a = Box -> Window' p -> Image'' p a -> Image'' p a type PxWrite p p' = Handle -> Int -> Image' p -> [p'] -> IO () type MkPixels p' = Box -> [p'] ppmBase :: MkBox -> MkImage p Colour -> PxWrite p p' -> MkPixels p' -> Window' p -> (Int, Int) -> String -> Image' p -> IO () ppmBase mkBox mkImage write mkPixels w dim name im = do h <- openPpm name bits bx write h bits im' px closePpm h where bits = 8 full = dimToBox dim im' = mkImage full w im bx = mkBox dim px = mkPixels bx idBox :: MkBox idBox = dimToBox idImage :: Point' p => MkImage p a idImage bx w im = im . pixelToPoint w bx idWrite :: Point' p => PxWrite p p idWrite h bits im px = foldM_ (writePpm h bits im) 0 px idPixels :: Point' p => p -> MkPixels p idPixels = pixelStream idPixels' :: MkPixels Point idPixels' = idPixels origin ppm :: Window -> (Int, Int) -> String -> Image -> IO () ppm = ppmBase idBox idImage idWrite idPixels' \end{code} \subsection{Transparency} Because ppm does not support transparency the opacity will be ignored --- this is equivalent to overlaying a transparent image on a black background. If a different background is required then it is trivial to do this using overlay. \begin{code} -- opaqueOnWhite = overlay transparentImage white \end{code} \subsection{Aliasing} Anti--aliasing sub--samples the image. To do this correctly requires information about the range and number of points that will be generated. This means that it must be integrated with the output routines (if the correct parameters are to be automatically carried across). It's simplest to generate the aliasing points before converting from integers to points within the coordinate system used by the image (ie inbetween pixelStream and pixelToPoint in the output routine above). So the code below generates a list of transforms that work on pixel numbers and then applies the correct transform afterwards. \begin{code} tranAlias :: Point' p => Int -> [p -> p] tranAlias n = map mkShift [(x, y) | x <- [1..n], y <- [1..n]] where mkShift (x, y) = shift (f x) (f y) f z = (fromIntegral z - 0.5) / (fromIntegral n) - 0.5 \end{code} This can then be used in an output routine. We reproduce the earlier code, but change the image into a list of parallel pipelines, one for each subsampled point, averaging the result. It's worth looking at this code in some detail --- once it's clear what's happening you'll have understood how to use parallel image pipelines (I hope!) (note that default aliasing is now over 4 samples, rather than 9 as in earlier versions). \begin{code} ppmAlias' :: Int -> Window -> (Int, Int) -> String -> Image -> IO () ppmAlias' x = ppmBase idBox mkImage idWrite idPixels' where mkImage bx w im = avg $ map ((im . (pixelToPoint w bx)) .) $ tranAlias x ppmAlias :: Window -> (Int, Int) -> String -> Image -> IO () ppmAlias = ppmAlias' 2 \end{code} \subsection{Image Tiling} On large images (a 1m square poster, for example, has about 24000 pixels on a side at standard printer resolution) generation of images can take a long time and consume a lot of resources (it can be impossible to view the images with some tools, or memory for Pancito may be limited, or the machine may need to be rebooted reglarly). These functions allow the image to be split into smaller pieces which, hopefully, can be combined later. Note that (like Box) the indices to tile start at (0,0). \begin{code} tileBox :: (Int, Int) -> (Int, Int) -> MkBox tileBox (nx, ny) (ix, iy) (x, y) = ((xlo, ylo), (xhi, yhi)) where xlo = f ix nx x xhi = f (ix+1) nx x ylo = f iy ny y yhi = f (iy+1) ny y f i n mx = if i == n then mx else i * floor (fromIntegral mx / fromIntegral n) tile :: (Int, Int) -> (Int, Int) -> Window -> (Int, Int) -> String -> Image -> IO () tile nxy ixy = ppmBase (tileBox nxy ixy) idImage idWrite idPixels' tileAlias' :: (Int, Int) -> (Int, Int) -> Int -> Window -> (Int, Int) -> String -> Image -> IO () tileAlias' nxy ixy x = ppmBase (tileBox nxy ixy) mkImage idWrite idPixels' where mkImage bx w im = avg $ map ((im . (pixelToPoint w bx)) .) $ tranAlias x tileAlias :: (Int, Int) -> (Int, Int) -> Window -> (Int, Int) -> String -> Image -> IO () tileAlias nxy ixy = tileAlias' nxy ixy 2 \end{code} \subsection{Progress Meter} While generating large images, it would be nice to have some idea of how far we have progressed. Although the following probably makes some unwarranted assumptions about the Haskell implementation, it appears to work well. \begin{code} monitor :: Show a => Int -> [a] -> [IO(a)] monitor n stream = monitor' (0, pc, stream) where pc = mkPercents n [(0.0, "%: "), (0.00001, "0.001 "), (0.0001, "0.01 "), (0.001, "0.1 "), (0.01, "1 "), (0.02, "2 "), (0.05, "5 "), (0.10, "10 "), (0.20, "20 "), (0.30, "30 "), (0.40, "40 "), (0.50, "50 "), (0.60, "60 "), (0.70, "70 "), (0.80, "80 "), (0.90, "90 "), (0.95, "95 "), (0.98, "98 "), (0.99, "99 "), (0.99999, "100 ")] monitor' :: Show a => (Int, [(Int, String)], [a]) -> [IO(a)] monitor' (n, ((n',s):ns), a:as) | n >= n' = (unsafeInterleaveIO $ putStr s >> hFlush stdout >> return a):(monitor' (n+1,ns,as)) | otherwise = (unsafeInterleaveIO $ return a):(monitor' (n+1,(n',s):ns,as)) monitor' (n, [], a:as) = (unsafeInterleaveIO $ return a):(monitor' (n+1,[],as)) monitor' (_, _, []) = [] mkPercents :: Int -> [(Double,String)] -> [(Int,String)] mkPercents n = map (\(x,s) -> (floor $ x * n',s)) where n' = fromIntegral n \end{code} And finally we can lift the previous writePpm and adapt the output functions to include this feedback. \begin{code} monWrite :: Point' p => PxWrite p (IO p) monWrite h bits im px = do join $ foldM (liftM2 (writePpm h bits im)) (return 0) px putStr "done\n" monPixels :: Point' p => p -> MkPixels (IO p) monPixels p0 bx = monitor (countBox bx) $ pixelStream p0 bx monPixels' :: MkPixels (IO Point) monPixels' = monPixels origin countBox :: Box -> Int countBox ((xlo, ylo), (xhi, yhi)) = (xhi-xlo)*(yhi-ylo) ppm_ :: Window -> (Int, Int) -> String -> Image -> IO () ppm_ = ppmBase idBox idImage monWrite monPixels' \end{code} Hopefully the apparently arbitrary abstraction of ppmBase is now explained. \begin{code} ppmAlias'_ :: Int -> Window -> (Int, Int) -> String -> Image-> IO () ppmAlias'_ x = ppmBase idBox mkImage monWrite monPixels' where mkImage bx w im = avg $ map ((im . (pixelToPoint w bx)) .) $ tranAlias x ppmAlias_ :: Window -> (Int, Int) -> String -> Image -> IO () ppmAlias_ = ppmAlias'_ 2 tile_ :: (Int, Int) -> (Int, Int) -> Window -> (Int, Int) -> String -> Image -> IO () tile_ nxy ixy = ppmBase (tileBox nxy ixy) idImage monWrite monPixels' tileAlias'_ :: (Int, Int) -> (Int, Int) -> Int -> Window -> (Int, Int) -> String -> Image -> IO () tileAlias'_ nxy ixy x = ppmBase (tileBox nxy ixy) mkImage monWrite monPixels' where mkImage bx w im = avg $ map ((im . (pixelToPoint w bx)) .) $ tranAlias x tileAlias_ :: (Int, Int) -> (Int, Int) -> Window -> (Int, Int) -> String -> Image -> IO () tileAlias_ nxy ixy = tileAlias'_ nxy ixy 2 \end{code} Pancito2.tex0000644000175000001440000001247610012200236012452 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \documentclass[a4paper,11pt]{article} \pagestyle{empty} \usepackage{haskell} \begin{document} \part{Pancito 2.2} \section{Introduction} \subsection{Pancito 2.2} Another minor release. Apart from random, undocumented changes (no-one uses this, as far as I know, apart from me), the I/O routines have been largely rewritten and some type classes introduced. Changes have been driven by practical use of the system -- I have been working on several images and hope, eventually, to have a gallery on the 'net. Important features of Pancito include: \begin{itemize} \item Pure, simple, functional Haskell. Images are purely functional, only the IO code requires a Monad. \item Useful practical features -- image tiling, progress bars. I suspect this package has been used more than any other functional image package for `artistic' work. \item Open, extensible framework. I'm moving towards parametric functions and modular code in many areas (eg the Image' a type, and the modular output routines). \item Support for reading files from disk. \end{itemize} \subsection{Pancito 2.1} This is a minor release of Pancito that has been extended to allow images to be read from files. It is otherwise identical to 2.0. \subsection{Pancito 1} The original Pancito was inspired by Pan\footnote{http://www.conal.net/pan} --- I tried to provide basic support for functional images on non-Win32 platforms. This boiled down to: \begin{itemize} \item A collection of types for the basic components (Images, Colours, Transforms etc) \item Basic support for these types (mainly Colours) \item Output to a disk file \end{itemize} In retrospect this suffered from several problems (I'm talking about Pancito here; I have not used Pan enough to know anything more than that it is a lot faster): \begin{itemize} \item Speed. It's slow. Sorry, but this doesn't bother me much - I can develop ideas with small images/windows. \item Clunky interfaces. For example: Colour was fixed as an RGBA representation; sometimes I wanted to experiments with HSV. And Point was in rectangular coordinates (unless it wasn't --- the compiler couldn't check). \item No higher order functions. Apart from functional composition I didn't give much thought about how to combine different components to assemble images. \item The only components that varied with location were images. Using Pancito later, I had to write extra code for (boolean) masks. \item Poor support for (efficient) transformations that require several points in an image (for example, blurring). This is tricky within the functional image approach and I don't have any good ideas about how to improve this yet. \end{itemize} Pancito 2 is going to fix some of these problems, I hope --- it's also an opportunity for me to think a bit more about software engineering (rather than just throwing some code together) in Haskell. If anyone does use both, I'd like to know which is easier to use. Cheers. \subsection{Version} This is version 2.2. It is partially backwards compatible with Pancito 2.1. It is {\em not} compatible with Pancito 1. {\bf Last altered: 10 February 2004.} \subsection{Haskell} This document, which describes the Pancito module, includes all the source code. Haskell compilers (at least, hugs, ghc and nhc98) should be able to compile Pancito directly from the document you are reading. \input{Point.lhs} \input{Colour.lhs} \input{Pancito2.lhs} \input{Reprocess.lhs} \input{Flux.lhs} \input{Pixels.lhs} \input{Test.lhs} \input{Utilities.lhs} \input{Common.lhs} \section{Documentation} You can generate a postscript document from the Pancito2 files by typing: \begin{verbatim} latex Pancito2.tex dvips Pancito2 -o Pancito2.ps \end{verbatim} This expects to find the haskell.sty file, which you can get from my web site if you do not already have it. That, in turn, expects to find various style files that are installed by default if you use the tetex package (I use the version included in the ``testing'' Debian distribution; older versions may not work correctly). Pancito2.tex also requires the source files Pancito2.lhs, Point.lhs, Colour.lhs and Test.lhs. \section{Credits} Thanks to Conal Elliot for Pan and all the people on c.l.functional and the Haskell mailing list for replying to questions. \section{Licencing Conditions} This document and all the code it includes are released under the GPL (see www.gnu.org for full details). Copyright 2001, 2002, 2003, 2004 Andrew Cooke (Jara Software) http://www.acooke.org/jara \end{document} Pixels.lhs0000644000175000001440000000567110012200236012224 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Pixels} \subsection{Header} These routines support images that display an image using "TV pixels". \begin{code} module Pixels ( toPix, fromPix, fuzz ) where import Common import Point import Colour import Pancito2 import Utilities \end{code} \subsection{Coordinate conversion} Conversion to and from the frame of the image that is used as a map of pixels (ie the image "on the TV"). \begin{code} toPix, fromPix :: (Int, Int) -> Window -> Transform toPix dim w = mapWindow w (dimToWindow dim) fromPix dim w = mapWindow (dimToWindow dim) w \end{code} \subsection{RGB} Fuzz takes two random images (see Utilities) and uses them to generate a filter that maps each pixel in the underlying image into a "sub-pixel" - the phosphor dots. There are two different levels of pixelisation here. First, the pixelated image (possibly text). Second, the pixels on the display device (phosphor dots), which sub-sample the image pixels. The adegree of sub-sampling is defined by the first argument to fuzz. There's some bleeding of information between phosphor dots. I'm not sure it's realistic, but it looks OK. \begin{code} fuzz :: (Int, Int) -> Image' Double -> Image' Double -> Image -> Image fuzz (nx, ny) rn1 rn2 im p = clr where (nx', ny') = (fromIntegral nx, fromIntegral ny) p' = scale nx' ny' p im' = im . unscale nx' ny' c1 = centre p' of1 = sub' p' c1 ang = t of1 c2 = centre $ add' c1 $ polar 1.49 ang of2 = sub' p' c2 cl1 = im' c1 cl2 = im' c2 r1 = max (abs $ x of1) (abs $ y of1) r2 = max (abs $ x of2) (abs $ y of2) z1 = 0.3 + 0.5 * rn1 p z2 = 0.1 * rn2 p x3 = roll 0.0 3.0 (x p') pxl cl = if x3 < 1.0 then rgba (r cl) 0.0 0.0 1.0 else if x3 < 2.0 then rgba 0.0 (g cl) 0.0 1.0 else rgba 0.0 0.0 (b cl) 1.0 clr = if v cl1 > 0.01 then shd r1 (pxl cl1) else shd r2 (pxl cl2) shd r c = if z1 > r && v c > 0.01 then c else rgba 0.05 0.05 0.05 1.0 \end{code}Point.lhs0000644000175000001440000002133510012200236012044 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Point} \subsection{Header} This module implements Point as an ADT. This has some disadvantages --- you can't pattern match to get the individual components --- but it provides a safe way of switching between polar and rectangular coordinates and it lets me introduce checks for value boundaries. And in 2.2, Point' is now a type class which Point implements. The Pancito package has support for writing the general Point' class, but the final output routines are for Point (since that is probably what you want and, if you don't, you know enough to pull in the general functions). To see Point' in use, check the Flux module. \begin{code} module Point ( Point', x, y, d, t, optimizePolar, optimizeCartesian, setXy, setDt, setX, setY, setD, setT, Point, cartesian, polar, xy, dt, Transform', Transform, shift, unshift, scale, unscale, shift', unshift', rotate, unrotate, expand, Window', Window, origin, unit, nUnit, square01, square11, mapWindow, Region', Region, contains, contains', winRegion, rot90, rot180, rot270, flipX, flipY, pixelate11, add', sub', trapezium, trapezium', pincushion, Line, nearest ) where import Common \end{code} \subsection{Constructor, Classes} The code is based on an example posted to the Haskell mailing list by Tom Pledger. By using two different representations we can avoid unnecessary conversions (if the user is explicit in writing conversions) but still support both representations at any point. \begin{code} class (Eq p, Show p) => Point' p where x :: p -> Double y :: p -> Double d :: p -> Double t :: p -> Double optimizeCartesian :: p -> p optimizePolar :: p -> p setXy :: Double -> Double -> p -> p setDt :: Double -> Double -> p -> p setX :: Double -> p -> p setX x p = setXy x (y p) p setY :: Double -> p -> p setY y p = setXy (x p) y p setD :: Double -> p -> p setD d p = setDt d (t p) p setT :: Double -> p -> p setT t p = setDt (d p) t p data Point = Cartesian Double Double | Polar Double Double instance Eq Point where p1 == p2 = equalPoint p1 p2 instance Point' Point where x = x' y = y' d = d' t = t' optimizeCartesian = optimizeCartesian' optimizePolar = optimizePolar' setXy x y _ = cartesian x y setDt d t _ = polar d t equalPoint (Cartesian x1 y1) (Cartesian x2 y2) = x1 == x2 && y1 == y2 equalPoint (Polar d1 t1) (Polar d2 t2) = d1 == d2 && t1 == t2 equalPoint p1 p2 = equalPoint p1' p2' where p1' = optimizeCartesian p1 p2' = optimizeCartesian p2 instance Show Point where show p = showPoint p showPoint (Cartesian x y) = "(" ++ show x ++ "," ++ show y ++ ")" showPoint (Polar d t) = "p(" ++ show d ++ "," ++ show t ++ ")" \end{code} \subsection{Proxy Constructors} The constructor is hidden --- these should be used instead. Note that explicit conversion is optional (it's provided to allow code to be optimized, hence the name) and isn't as important as for Colours because conversino is no less expensive than using d and t once each (so optimizing is only worthwhile if you will repeatedly use polar values from the same Point). \begin{code} cartesian, polar :: Double -> Double -> Point cartesian x y = Cartesian x y polar d t = Polar d (roll2pi t) optimizeCartesian', optimizePolar' :: Point -> Point optimizeCartesian' p = case p of (Polar d t) -> cartesian (x p) (y p) (Cartesian x y) -> p optimizePolar' p = case p of (Polar d t) -> p (Cartesian x y) -> polar (d p) (t p) \end{code} \subsection{Access} The following operators pull values out from the ADT. I've used d rather than r for the polar radial distance so that r can be used for the red component of colours. \begin{code} x', y', d', t' :: Point -> Double x' (Cartesian x y) = x x' (Polar d t) = d * cos t y' (Cartesian x y) = y y' (Polar d t) = d * sin t d' (Cartesian x y) = sqrt (x*x + y*y) d' (Polar d t) = d t' (Cartesian x y) = atan2 y x t' (Polar d t) = t xy, dt :: Point' p => p -> (Double, Double) xy p = (x p', y p') where p' = optimizeCartesian p dt p = (d p', t p') where p' = optimizePolar p \end{code} \subsection{Modifying Points} Remember that these alter coordinates before being passed to the image, and so are counterintuitive. For example, scaling the coordinates expands to include more of the image --- more of the image is displayed in the same area, so it appears "smaller". \begin{code} type Transform' p = p -> p type Transform = Transform' Point shift, unshift, scale, unscale :: Point' p => Double -> Double -> Transform' p shift dx dy p = setXy (x p + dx) (y p + dy) p unshift dx dy p = setXy (x p - dx) (y p - dy) p scale fx fy p = setXy (fx * x p) (fy * y p) p unscale fx fy p = setXy ((1.0 / fx) * x p) ((1.0 / fy) * y p) p shift', unshift' :: Point' p => p -> Transform' p shift' p = shift (x p) (y p) unshift' p = unshift (x p) (y p) rotate, unrotate, expand :: Point' p => Double -> Transform' p rotate theta p = setDt (d p) (t p + theta) p unrotate theta p = setDt (d p) (t p - theta) p expand k p = setD (k * d p) p \end{code} \subsection{Windows} Often it is necessary to convert from one ractangular region to another. \begin{code} type Window' p = (p, p) type Window = Window' Point origin, unit, nUnit :: Point origin = cartesian 0.0 0.0 unit = cartesian 1.0 1.0 nUnit = cartesian (-1.0) (-1.0) square01, square11 :: Window square01 = (origin, unit) square11 = (nUnit, unit) mapWindow :: Point' p => Window' p -> Window' p -> Transform' p mapWindow (toBL, toTR) (fromBL, fromTR) = shift dx dy . scale fx fy where fx = (x toTR - x toBL) / (x fromTR - x fromBL) fy = (y toTR - y toBL) / (y fromTR - y fromBL) dx = x toBL - x fromBL * fx dy = y toBL - y fromBL * fy \end{code} Windows are the simplest example of a more general idea --- describing a specific region of an image. The Window type is convenient for ractangles, but for more complex shapes we need functional Regions. \begin{code} type Region' p = p -> Bool type Region = Region' Point contains :: Point' p => Region' p -> p -> Bool contains r p = r p --- syntactic sugar contains' :: Point' p => Window' p -> p -> Bool contains' = contains . winRegion winRegion :: Point' p => Window' p -> Region' p winRegion (bl, tr) p = (x bl - x p) * (x p - x tr) >= 0 && (y bl - y p) * (y p - y tr) >= 0 \end{code} \subsection{Various Tools} Some simple flips and rotations. \begin{code} rot90, rot180, rot270, flipX, flipY :: Point' p => Transform' p rot90 p = setXy (-(y p)) (x p) p rot180 p = setXy (y p) (x p) p rot270 p = setXy (y p) (-(x p)) p flipX p = setY (-1 * y p) p flipY p = setX (-1 * x p) p \end{code} Transform the window ((n,m) (n+1,m+1)) to ((-1,-1) (1,1)). So each unit square is mapped to the same square11. \begin{code} pixelate11 :: Point' p => Transform' p pixelate11 p = setXy (f x) (f y) p where p' = optimizeCartesian p f xy = ((xy p') - fromIntegral (floor (xy p'))) * 2.0 - 1.0 \end{code} One day these might use overload arithmetic operators, but it's a lot of fuss. \begin{code} add', sub' :: Point' p => p -> p -> p add' p1 p2 = setXy (x p1 + x p2) (y p1 + y p2) p1 sub' p1 p2 = setXy (x p1 - x p2) (y p1 - y p2) p2 \end{code} And the adjustments on a TV. \begin{code} trapezium, trapezium' :: Point' p => Double -> Transform' p trapezium k p = setY (y'*(1.0+k*x')) p where (x', y') = (x p, y p) trapezium' k p = setX (x'*(1.0+k*y')) p where (x', y') = (x p, y p) pincushion :: Point' p => Double -> Transform' p pincushion k p = setD ((d p) ** k) p \end{code} The point on a line nearest a given point. We define a line as a point and a gradient. \begin{code} type Line p = (p, Double, Double) nearest :: Point' p => Line p -> p -> p nearest (o, dx, dy) p = setXy x' y' p where (ox, oy) = xy o (px, py) = xy p x' = (px*dx*dx+(py-oy)*dx*dy+ox*dy*dy)/(dx*dx+dy*dy) y' = (oy*dx*dx+(px-ox)*dx*dy+py*dy*dy)/(dx*dx+dy*dy) \end{code} Reprocess.lhs0000644000175000001440000002126010012200236012715 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Reprocess} \subsection{Header} This module allows you to read images back into the system (and reprocess them). Only ASCII ppm images can be read --- check out pnmtoplainpnm from the netpbm package (this is the same format that Pancito uses for output). \begin{code} module Reprocess ( readPpm, wrapArray, toDim, readPpm_ {- , subPpm, subPpm_ -}, monitor ) where import Point import Colour import Pancito2 import Word import IO import Array import System.IO.Unsafe \end{code} \subsection{Arrays} The image is read into an array. Functions here allow that array to be used as an Image. This function might be useful in its own right one day. TODO - wraparray unification? (later - what was i thinking here?) \begin{code} wrapArray :: Point' p => Window' p -> a -> Array (Int, Int) a -> Image'' p a wrapArray box c a p = if (winRegion box) p then a!(quant p box (bounds a)) else c quant :: Point' p => p -> Window' p -> ((Int, Int), (Int, Int)) -> (Int, Int) quant p (lo,hi) ((ilo,jlo),(ihi,jhi)) = (i, j) where x' = x p y' = y p xlo = x lo ylo = y lo xhi = x hi yhi = y hi dx = (x' - xlo) / (xhi - xlo) dy = (y' - ylo) / (yhi - ylo) ni = ihi - ilo + 1 nj = jhi - jlo + 1 i = min (ilo + floor(dx * fromIntegral ni)) ihi j = min (jlo + floor(dy * fromIntegral nj)) jhi wrapArray8 :: Point' p => Window' p -> Colour -> Array (Int, Int, Int) Word8 -> Image' p wrapArray8 box c a p = if (winRegion box) p then word8ToColour a (quant p box ((1, 1), (nx, ny))) else c where ((1, 1, 1), (nx, ny, 3)) = bounds a word8ToColour :: Array (Int, Int, Int) Word8 -> (Int, Int) -> Colour word8ToColour a (x, y) = rgba r g b 1.0 where r = fromIntegral (a!(x, y, 1)) / 255.0 g = fromIntegral (a!(x, y, 2)) / 255.0 b = fromIntegral (a!(x, y, 3)) / 255.0 \end{code} \subsection{Parsing the File} Simple utilities to parse the file contents. \begin{code} header :: String -> ((Int, Int), Int, [String]) header = headerParams . checkType . words . dropComment headerParams (nx:ny:n:s) = ((read nx, read ny), read n, s) headerParams _ = error "malformed header" checkType ("P3":s) = s checkType _ = error "incorrect file format" dropComment [] = [] dropComment ('#':s) = dropComment' s dropComment (c:s) = c:dropComment s dropComment' [] = [] dropComment' (c@'\n':s) = c:dropComment s dropComment' (c:s) = dropComment' s \end{code} \subsection{Read the Data} Put everything together. \begin{code} type PxFilter' a = [((Int, Int), a)] -> [((Int, Int), a)] type PxFilter a = (Int, Int) -> ((Int, Int), PxFilter' a) eagerParse8 :: PxFilter (String, String, String) -> Handle -> IO (Array (Int, Int, Int) Word8, (Int, Int)) eagerParse8 f h = do str <- hGetContents h (dim, mx, toks) <- return $ header str (dim', f') <- return $ f dim return $! (pixels8 dim dim' f' toks, dim') zipAll (a:as) (b:bs) = (a, b):(zipAll as bs) zipAll [] [] = [] zipAll _ _ = error "missing data" group3 (a:b:c:s) = (a, b, c):(group3 s) group3 [] = [] group3 _ = error "malformed data" pixels8 :: (Int, Int) -> (Int, Int) -> PxFilter' (String, String, String) -> [String] -> Array (Int, Int, Int) Word8 pixels8 (nx, ny) (dx, dy) filter s = array bnds . parse8 . filter $ zipAll xy pix where bnds = ((1, 1, 1), (dx, dy, 3)) xy = map (\(y,x) -> (x, ny-y+1)) (range ((1,1), (ny,nx))) pix = group3 s parse8 :: [((Int, Int), (String, String, String))] -> [((Int, Int, Int), Word8)] parse8 [] = [] parse8 (((x, y), (r, g, b)):ps) = ((x, y, 1), read r): ((x, y, 2), read g): ((x, y, 3), read b):(parse8 ps) readPpm :: Point' p => String -> Window' p -> Colour -> IO (Image' p, (Int, Int)) readPpm name w bg = do h <- openFile name ReadMode (a, dim) <- eagerParse8 idFilter h return (wrapArray8 w bg a, dim) where idFilter dim = (dim, id) \end{code} We can modify the pixel stream to generate a progress bar, just as with the output routines. TODO - merge with OP code \begin{code} monitorF :: PxFilter a monitorF dim@(nx, ny) = (dim, monitor (nx * ny)) monitor :: Int -> [a] -> [a] monitor n stream = monitor' (0, pc, stream) where pc = mkPercents n [(0.0, "%: "), (0.00001, "0.001 "), (0.0001, "0.01 "), (0.001, "0.1 "), (0.01, "1 "), (0.02, "2 "), (0.05, "5 "), (0.10, "10 "), (0.20, "20 "), (0.30, "30 "), (0.40, "40 "), (0.50, "50 "), (0.60, "60 "), (0.70, "70 "), (0.80, "80 "), (0.90, "90 "), (0.95, "95 "), (0.98, "98 "), (0.99, "99 "), (0.99999, "100 ")] monitor' :: (Int, [(Int, String)], [a]) -> [a] monitor' (n, pc@((n', s):ns), a:as) | n >= n' = (unsafePerformIO $ do putStr s hFlush stdout return a): (monitor' (n+1, ns, as)) | otherwise = a:(monitor' (n+1, pc, as)) monitor' (n, [], a:as) = a:(monitor' (n+1, [], as)) monitor' (_, _, []) = (unsafePerformIO $ do putStrLn "done" return []) mkPercents :: Int -> [(Double,String)] -> [(Int,String)] mkPercents n = map (\(x,s) -> (floor $ x * n',s)) where n' = fromIntegral n readPpm_ :: Point' p => String -> Window' p -> Colour -> IO (Image' p, (Int, Int)) readPpm_ name w bg = do h <- openFile name ReadMode (a, dim) <- eagerParse8 monitorF h return (wrapArray8 w bg a, dim) \end{code} And we can subsample the image with a suitable filter. \begin{code} everyN :: Int -> PxFilter a everyN n (nx, ny) = ((nx `div` n, ny `div` n), everyN' n) everyN' n [] = [] everyN' n (((x, y), pix):as) = if ok then ((x', y'), pix):(everyN' n as) else everyN' n as where (x', y') = (x `div` n, y `div` n) ok = n * x' == x && n * y' == y stackF :: PxFilter a -> PxFilter a -> PxFilter a stackF f' f dim = (dim'', f''' . f'') where (dim', f'') = f dim (dim'', f''') = f' dim' {- TOD merge subSample :: Int -> (PxFilter, DimFilter) subSample n = (subPix n, subDim n) subPix :: Int -> PxFilter subPix n ((x', y'), c) = if mtch then Just ((x'', y''), c) else Nothing where x'' = x' `div` n y'' = y' `div` n mtch = unsafePerformIO $ do m <- return $ x' == x'' * n && y' == y'' * n if m then print (x',y',x'',y'') else return () return m subDim :: Int -> DimFilter subDim n (nx, ny) = (nx `div` n, ny `div` n) subPpm :: Int -> String -> Window' -> Colour -> IO (Image, (Int, Int)) subPpm n = ppmBase' idRead idPixels (subSample n) subPpm_ :: Int -> String -> Window' -> Colour -> IO (Image, (Int, Int)) subPpm_ n = ppmBase' monRead monPixels (subSample n) -} \end{code} We might want to have the image as a function of its pixel coordinates. \begin{code} toDim :: Point' p => p -> (Int, Int) -> Window' p -> Transform' p toDim p0 = flip mapWindow . dimToWindow p0 \end{code} \subsection{Example} This is fairly obvious, I hope. TODO fix \begin{code} {- module Main where main :: IO () main = do img <- readPpm "test-in.ppm" square01 white ppm square11 (20, 20) "test-out.ppm" img -} \end{code} Test.lhs0000644000175000001440000001054410012200236011672 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Test} This section describes a ``typical'' image. \subsection{Modules} As well as the Pancito modules, we use random numbers. \begin{code} module Main where import Random import Pancito2 import Colour import Point \end{code} \subsection{Random Squares} This code is a bit clunky --- at one point it had an extra predicate in the comprehension that generated the list of colours (the idea was to test for suitable colour combinations). Without that test the number of random numbers required is fixed and the code could probably be simplified (ie there's no backtracking). \begin{code} mkImages :: Int -> Int -> [Double] -> [Bool] -> [Image] mkImages nx ny ran flip = map mkSquare $ zip [(x, y) | x <- [(-1)*nx..nx], y <- [(-1)*ny..ny]] (map mkBase $ zip [c | c <- threeColours ran] (double flip)) double :: [a] -> [(a,a)] double ran = (r1, r2) : double ran' where r1:r2:ran' = ran triple :: [a] -> [(a,a,a)] triple ran = (r1, r2, r3) : triple ran' where r1:r2:r3:ran' = ran mkColour :: (Double, Double, Double) -> Colour mkColour (r1, r2, r3) = hsva (2 * pi * r1) r2 r3 1 threeColours :: [Double] -> [(Colour, Colour, Colour)] threeColours ran = triple $ map mkColour $ triple ran \end{code} This is the function that varies the colour across a square. There is an implicit asumption that the colours are in HSVA format (addition in RGB would look different). This is a gotcha I discuss earlier. I could use optimizeHsva, but since I know that mkColour is generating HSVA values, there's no real need. \begin{code} mkBase :: ((Colour, Colour, Colour), (Bool, Bool)) -> Image mkBase ((c1, c2, c3), (b1, b2)) p = (cmb b2 (cmb b1 c1 c2 (x p)) c3 (y p)) where cmb b c1 c2 z = (if b then add else sub) c1 (cMap ((z * 0.2) *) c2) mkSquare :: ((Int, Int), Image) -> Image mkSquare ((x', y'), im) = (square im) . shift x'' y'' where x'' = 2 * fromIntegral x' y'' = 2 * fromIntegral y' box :: Region box p = abs (x p) < 0.7 && abs (y p) < 0.7 square :: Image -> Image square im p = if contains box p then im p else transparent \end{code} The arcPixel function quantizes the image in small arcs, giving the impression that the screen is made from pixels in a circular pattern. At least, that was the original intentions (and it does work on images which change colour fairly rapidly). Here, however, it simply crinkles the edges of the gem-like squares. \begin{code} arcPixel :: Transform arcPixel p = setDt qd qt p where d' = d p t' = t p qd = quant n d' qt = if qd < tiny then 0 else (quant n (qd * (t' + z))) / qd - z n = 40 z = 0.1 quant :: Double -> Double -> Double quant n x = (fromIntegral (round (n * x))) / n \end{code} Finally, combine everything. \begin{code} im :: Image im = (over black $ mkImages n n ran flip) . expand (2 * (1 + fromIntegral n)) . arcPixel where n = 2 ran = randoms $ mkStdGen 1 flip = randoms $ mkStdGen 2 main :: IO () main = ppmAlias_ square11 (200, 200) "test.ppm" im \end{code} To run this code, type (exact details depend on your compiler etc.): \begin{verbatim} ghc --make Test -O -o Test ./Test \end{verbatim} To generate the image (200x200 pixels, anti-aliased) takes less than a minute on a 2GHz desktop. Without anti-aliasing it should take just over 1/4 the time. I use xloadimage (or xli) and Gimp or NetPBM to view and manipulate the result. Intermediate results can be displayed with xloadimage (which will display partial images). Utilities.lhs0000644000175000001440000002145510012200236012731 0ustar andrewusers% % Pancito v 2.2 - Functional Images in Haskell % Copyright 2004 Andrew Cooke (andrew@acooke.org) % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2 of the License, or % (at your option) any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % \section{Utilities} \subsection{Header} This module is, strictly, not part of Pancito because it changes ``at random'' (ie within releases). It contains functions that I find useful. Often these are pulled out of previous image scripts; sometimes existing functions are made more general. \begin{code} module Utilities ( wedge, checks, centre, ranList, ranList', logo, logo', logo'', shiftLogo, Position (BottomRight, BottomLeft, TopRight, TopLeft), ranImage, parallel, wrap, ranImage', border, nLevels, mkQuant, nBright, limits, rescale, feather, gamma' ) where import Common import Point import Colour import Pancito2 import Random import Reprocess import Array \end{code} \subsection{Motifs} One process that interests me is tiling - repeating a motif across an image. I do this by defining a function that generates a motif within square11 and then using pixelate11 (both functions in the Points module). Wedge can be used to produce ``striped'' images where, for example, stripe width depends on intensity. \begin{code} wedge :: (Double, Double) -> (Colour, Colour) -> Image wedge (lo, hi) (fg, bg) p = if inside then fg else bg where x' = abs (x p) y' = y p x'' = lo + (hi - lo) * (y' + 1.0) / 2.0 inside = x' < x'' \end{code} \subsection{Other Tiling Functions} "Round" a point to 0.5,1.5,$\ldots$ \begin{code} centre :: Point' p => p -> p centre p = setXy x' y' p where x' = 0.5 + fromIntegral (floor (x p)) y' = 0.5 + fromIntegral (floor (y p)) \end{code} \subsection{Checkerboard} Useful for backgrounds, to give scaling, while working on images. \begin{code} checks :: Double -> Colour -> Colour -> Image checks sd c1 c2 p = if even (ix+iy) then c1 else c2 where ix = index (x p) iy = index (y p) index z = floor (z / sd) \end{code} \subsection{Logo} This assumes that logo.ppm exists in the current directory. The shiftLogo function can be used to place the logo, scaled to a given width, within the main image's coordinates. \begin{code} logo :: IO (Image, (Int, Int)) logo = do (img, dim) <- readPpm "logo.ppm" square01 transparent return (img . toDim origin dim square01, dim) data Position = BottomRight Point | BottomLeft Point | TopRight Point | TopLeft Point shiftLogo :: Double -> Position -> (Int, Int) -> Transform shiftLogo wd pos dim@(nx,ny) = mapWindow (dimToWindow origin dim) (case pos of (BottomRight p) -> (cartesian (x p - wd) (y p), cartesian (x p) (y p + ht)) (BottomLeft p) -> (cartesian (x p + wd) (y p + ht), cartesian (x p) (y p)) (TopRight p) -> (cartesian (x p) (y p), cartesian (x p - wd) (y p + ht)) (TopLeft p) -> (cartesian (x p + wd) (y p), cartesian (x p) (y p - ht))) where ht = wd * fromIntegral ny / fromIntegral nx logo' :: Tint -> Tint -> Tint -> ((Int, Int) -> Transform) -> IO VTint logo' fg bg cs tr = do (lg, dim) <- logo return $ tnt dim lg tr where tnt dim lg tr p = if winRegion (dimToWindow origin dim) p' then ltint fg bg cs $ lg p' else id where w = dimToWindow origin p' = tr dim p logo'' :: ((Int, Int) -> Transform) -> IO VTint logo'' tr = logo' (lighten 0.2) (darken 0.2) (overlay orange) tr where orange = rgba (214.0/255.0) (53.0/255.0) (12.0/255.0) 0.2 ltint :: Tint -> Tint -> Tint -> Colour -> Tint ltint fg bg cs c = if r' < 0.1 then bg else if r' > 0.9 then fg else cs where r' = r c \end{code} \subsection{Random Numbers} An infinite list of random generators is a useful thing to fold over when generating lists of random processes. \begin{code} ranList :: StdGen -> [StdGen] ranList g = g' : ranList g'' where (g', g'') = split g ranList' :: Int -> [StdGen] ranList' n = ranList (mkStdGen n) \end{code} Sometimes it's useful to have a random number for each pixel. We can generalise this to an image with any type of contents. \begin{code} ranImage :: StdGen -> (Int, Int) -> Window -> Image'' Point Double ranImage ran dim@(nx, ny) w = wrapArray w 0.0 a where bnds = ((1,1), dim) asc = zip (range bnds) (randomRs (0.0, 1.0) ran) a = array bnds $ monitor (nx * ny) asc parallel :: Image'' p a -> Image'' p b -> Image'' p (a, b) parallel im1 im2 p = (im1 p, im2 p) \end{code} Random images are expensive to generate. A smaller image plus wrapping of coordinates may be all you need. The function ranImage' takes care of worrying that the pixel density is the same as the image you are working on. \begin{code} wrap :: Point' p => Window' p -> Transform' p wrap (lo, hi) p = p' where (xlo, ylo) = (x lo, y lo) (xhi, yhi) = (x hi, y hi) p' = setXy (roll xlo xhi $ x p) (roll ylo yhi $ y p) p ranImage' :: StdGen -> (Int, Int) -> (Int, Int) -> Window -> Image'' Point Double ranImage' ran full dim w = ranImage ran dim w . wrap w . zm where zm = mapWindow (dimToWindow origin full) (dimToWindow origin dim) \end{code} \subsection{Dark Border} This is used to border the X-Ray image. The idea is to have a border that fades to black with some structure, reflecting the original image. The hard-coded power of 32 defines the width in a coordinate-dependent form (this should be seeparated into a parameter if this is re-used). \begin{code} wgtSum :: Point' p => Window' p -> Image' p -> p -> Double wgtSum (lo, hi) im p = wgtSum' dx (setXy xlo y' p) im p + wgtSum' dx (setXy xhi y' p) im p + wgtSum' dy (setXy x' ylo p) im p + wgtSum' dy (setXy x' yhi p) im p where (xlo, ylo) = xy lo (xhi, yhi) = xy hi (x', y') = xy p (dx, dy) = (xhi - xlo, yhi - ylo) wgtSum' :: Point' p => Double -> p -> Image' p -> p -> Double wgtSum' nrm p1 im p2 = (1.0 - v (im p1)) * ((nrm - abs (d (sub' p1 p2))) / nrm)^32 border :: Point' p => Window' p -> Filter' p border w im p = darken (x1+x2) $ im p where x1 = wgtSum w im p x2 = wgtSum w (flat black) p \end{code} \subsection{Quantisation} Helps generate contours. \begin{code} nLevels :: (Double, Double) -> Int -> Double -> Double nLevels (lo, hi) n x = x' where range = hi - lo bin = range / (fromIntegral n) norm = (fromIntegral n) * (x - lo) / range quant = fromIntegral $ floor norm quant' = min (fromIntegral $ n-1) $ max 0.0 quant x' = 0.5 * bin + lo + quant' * bin mkQuant :: (Colour -> Double) -> (Double -> Colour -> Colour) -> (Double -> Double) -> Tint mkQuant get set quant c = set (quant $ get c) c nBright :: Int -> Tint nBright n = mkQuant b setB (nLevels (0.0, 1.0) n) \end{code} \subsection{Range} Measure the range of some value in an image. \begin{code} limits :: Point' p => Window' p -> (Int, Int) -> (Double, Double) -> (a -> Double) -> p -> Image'' p a -> (Double, Double) limits w dim mnmx f p0 im = measure mnmx f im' px where full = dimToBox dim im' = idImage full w im bx = idBox dim px = idPixels p0 bx measure :: Point' p => (Double, Double) -> (a -> Double) -> Image'' p a -> [p] -> (Double, Double) measure mnmx f im ps = foldl getLim mnmx ps where getLim (mn, mx) p = (min mn a, max mx a) where a = f $ im p \end{code} \subsection{Rescale} Transform one range to another. \begin{code} rescale :: (Double, Double) -> (Double, Double) -> Double -> Double rescale (inlo, inhi) (outlo, outhi) x = outlo + (outhi - outlo) * ((x - inlo) / (inhi - inlo)) \end{code} \subsection{Feather} Fix the alpha channel to match the content (to give progressive overlaying where black). \begin{code} feather :: Tint feather c = setA (max 0.0 (max (r c) (max (g c) (b c)))) c \end{code} \subsection{Gamma} Apply a generalised gamma correction. \begin{code} gamma' :: (a -> Double) -> (Double -> a -> a) -> Double -> Tint' a a gamma' get set g a = set ((get a)**g) a \end{code}