packages feed

hls (empty) → 0.11

raw patch · 7 files changed

+282/−0 lines, 7 filesdep +basedep +containersdep +hpssetup-changed

Dependencies added: base, containers, hps

Files

+ LSystem/LSystem.hs view
@@ -0,0 +1,68 @@+-- | Lindenmayer system definition, expander and renderer.+module LSystem.LSystem where++import Graphics.PS.Pt+import LSystem.Turtle+import Data.Map as Map++-- | Element of 'Axiom'.+type Element = Char++-- | An axiom (sequence of 'Elements').+type Axiom = [Element]++-- | A 'Map.Map' from 'Element's to 'Axiom's.+type Rules = Map.Map Element Axiom++-- | An 'LSystem' is an 'Axiom' and a set of 'Rules'.+data LSystem = LSystem Axiom Rules deriving (Eq,Show)++-- | L-System constructor.+--+-- > lSystem "F+F+F" [('F',"F-F+F")]+lSystem :: Axiom -> [(Element,[Element])] -> LSystem+lSystem a rs = LSystem a (fromList rs)++-- | Rule lookup.+getRule :: Rules -> Element -> [Element]+getRule rs c = Map.findWithDefault [c] c rs++-- | Rule application.+applyRule :: [Element] -> Rules -> [Element]+applyRule a rs = concatMap (getRule rs) a++-- | /n/ iterations of the specified 'LSystem'.+--+-- > expand (lSystem "F+F+F" [('F',"F-F+F")]) 1 == "F-F+F+F-F+F+F-F+F"+expand :: LSystem -> Int -> [Element]+expand (LSystem a rs) n =+    case n of+      0 -> a+      _ -> expand (LSystem (applyRule a rs) rs) (n - 1)++-- | State transformer 'Turtle' commands.+stateT :: Element -> Turtle -> Turtle+stateT e =+    case e of+      '+' -> turnRight+      '-' -> turnLeft+      '|' -> turnBack+      '>' -> incrLine+      '<' -> decrLine+      '[' -> push+      ']' -> pop+      'f' -> forward+      _   -> id++-- | Operational 'Turtle' commands.+cmd :: (Turtle -> b -> (Turtle,b)) -> Element -> Turtle -> b -> (Turtle,b)+cmd f e t i =+    case e of+      'F' -> f t i+      _ -> (stateT e t, i)++-- | Fold over an expanded L-system using standard turtle commands.+render :: b -> (b -> Pt -> Pt -> b) -> [Element] -> Turtle -> b+render i f l t =+    let g (u,j) c = cmd (stepTurtle f) c u j+    in snd (foldl g (t, i) l)
+ LSystem/Render/PS.hs view
@@ -0,0 +1,25 @@+-- | Postscript renderer for 'LSystem's.+module LSystem.Render.PS where++import Graphics.PS+import LSystem.LSystem+import LSystem.Turtle++-- | Given initial 'ta', 'ls' and 'll' values render /i/ steps of an+-- 'LSystem'.+renderL :: (LSystem,Double,Double) -> Int -> Double -> [(Pt,Pt)]+renderL (l,ta',ls') i ll' =+    let a = Turtle (radians ta') 1 origin (pi / 2) ll' ls' []+    in render [] (\ll'' p1 p2 -> (p1,p2) : ll'') (expand l i) a++-- | Given a scalar and a 'Path' render a 'greyGS' 'Image'.+draw :: Double -> Path -> Image+draw z p =+    let g = greyGS 0.5+    in (translate 200 200 . scale z z) (Stroke g p)++-- | Rendering functions for grounded (ie. with 'ta' and 'ls' values)+-- 'LSystems'.+renderLL,renderLO :: (LSystem,Double,Double) -> Int -> Double -> Path+renderLL a b = renderLines . renderL a b+renderLO a b = renderLines' . renderL a b
+ LSystem/Systems.hs view
@@ -0,0 +1,94 @@+-- | Various 'LSystem's.+-- For 'l0' through 'lB' see <http://paulbourke.net/fractals/lsys/>.+-- For 'lC' see <http://en.wikipedia.org/wiki/Penrose_tiling>.+-- For 'lD' see <http://hackage.haskell.org/package/nymphaea>.+module LSystem.Systems where++import Graphics.PS+import LSystem.LSystem+import LSystem.Render.PS++-- * 'LSystem' definitions++l0,l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB :: LSystem+l0 = lSystem "F+F+F+F" [('F',"F+F-F-FF+F+F-F")]+l1 = lSystem "F+F+F+F" [('F',"FF+F-F+F+FF")]+l2 = lSystem "X" [('F',"FF")+                 ,('X',"F-[[X]+X]+F[+FX]-X")]+l3 = lSystem "a" [('F',">F<")+                 ,('a',"F[+x]Fb")+                 ,('b',"F[-y]Fa")+                 ,('x',"a")+                 ,('y',"b")]+l4 = lSystem "Y" [('X',"X[-FFF][+FFF]FX")+                 ,('Y',"YFX[+Y][-Y]")]+l5 = lSystem "F" [('F',"FF+[+F-F-F]-[-F+F+F]")]+l6 = lSystem "X" [('F',"FF")+                 ,('X',"F[+X]F[-X]+X")]+l7 = lSystem "F" [('F',"F[+FF][-FF]F[-F][+F]F")]+l8 = lSystem "F" [('F',"FFF-[XY]+[XY]")+                 ,('X',"+FY")+                 ,('Y',"-FX")]+l9 = lSystem "FX" [('X',">[-FX]+FX")]+lA = lSystem "FX" [('Y',"-FX-Y")+                  ,('X',"X+YF+")]+lB = lSystem "F+F+F" [('F',"F-F+F")]++lC :: LSystem+lC = lSystem "[7]++[7]++[7]++[7]++[7]" [('6',"8F++9F----7F[-8F----6F]++")+                                       ,('7',"+8F--9F[---6F--7F]+")+                                       ,('8',"-6F++7F[+++8F++9F]-")+                                       ,('9',"--8F++++6F[+9F++++7F]--7F")+                                       ,('F',"")]++lD :: LSystem+lD = lSystem "F+F+F+F+F+F" [('F',"F-F++F-F")]++-- * With turning angle and line scalar++l0d,l1d,l2d,l3d,l4d,l5d,l6d,l7d,l8d,l9d,lAd,lBd,lCd,lDd :: (LSystem,Double,Double)+l0d = (l0,90.0,1)+l1d = (l1,90.0,1)+l2d = (l2,22.5,1)+l3d = (l3,45.0,1.36)+l4d = (l4,25.7,1)+l5d = (l5,22.5,1)+l6d = (l6,20.0,1)+l7d = (l7,35.0,1)+l8d = (l8,22.5,1)+l9d = (l9,40.0,0.6)+lAd = (lA,90.0,1)+lBd = (lB,120.0,1)+lCd = (lC,36.0,1)+lDd = (lD,60.0,1)++-- * PS Images++l0i,l1i,l2i,l3i,l4i,l5i,l6i,l7i,l8i,l9i,lAi,lBi,lCi,lDi :: Image+l0i = draw 0.4 (renderLO l0d 3 5)+l1i = draw 1.25 (renderLO l1d 3 5)+l2i = draw 1.0 (renderLO l2d 5 5)+l3i = draw 0.4 (renderLO l3d 12 5)+l4i = draw 1.0 (renderLO l4d 6 5)+l5i = draw 1.2 (renderLO l5d 4 5)+l6i = draw 0.5 (renderLO l6d 7 5)+l7i = draw 1.0 (renderLO l7d 4 5)+l8i = draw 0.1 (renderLO l8d 6 5)+l9i = draw 1.2 (renderLO l9d 10 40)+lAi = draw 0.8 (renderLO lAd 11 5)+lBi = draw 1.0 (renderLO lBd 6 5)+lCi = draw 2.0 (renderLO lCd 5 5)+lDi = draw 0.4 (renderLO lDd 5 1)++-- | Generate postscript file with drawings of 'l0' through 'lD'.+--+-- > systems_ps "/tmp/hls.ps"+-- > System.Process.system "gv /tmp/hls.ps"+systems_ps :: FilePath -> IO ()+systems_ps fn = ps fn (Paper 300 300) [l0i,l1i,l2i,l3i,l4i,l5i+                                      ,l6i,l7i,l8i,l9i,lAi,lBi+                                      ,lCi,lDi]++-- Local Variables:+-- truncate-lines:t+-- End:
+ LSystem/Turtle.hs view
@@ -0,0 +1,58 @@+-- | Standard 'Turtle' graphics.+module LSystem.Turtle where++import Graphics.PS.Pt++-- | Turtle.+data Turtle = Turtle {ta :: Double -- ^ turning angle+                     ,tai :: Double -- ^ turning angle increment+                     ,loc :: Pt -- ^ location+                     ,hdg :: Double -- ^ heading+                     ,ll :: Double -- ^ line length+                     ,ls :: Double -- ^ length scalar+                     ,stk :: [Turtle] -- ^ turtle stack+                    } -- lw = line width,lwi = line width increment,++-- | Right turn by 'ta'.+turnRight :: Turtle -> Turtle+turnRight t = t {hdg = hdg t + (ta t)}++-- | Left turn by 'ta'.+turnLeft :: Turtle -> Turtle+turnLeft t = t {hdg = hdg t - (ta t)}++-- | @180@ degree turn.+turnBack :: Turtle -> Turtle+turnBack t = t {hdg = hdg t + pi}++-- | Increment line length ('ll') by multiplying by line scalar ('ls').+incrLine :: Turtle -> Turtle+incrLine t = t {ll = ll t * ls t}++-- | Decrement line length ('ll') by dividing by line scalar ('ls').+decrLine :: Turtle -> Turtle+decrLine t = t {ll = ll t / ls t}++-- | Move 'loc' of 'Turtle' by 'll' on current 'hdg'.+forward :: Turtle -> Turtle+forward t =+    let shift (Pt x y) r d = Pt (x + r * cos d) (y + r * sin d)+    in t {loc = shift (loc t) (ll t) (hdg t)}++-- | Push 'Turtle' onto 'stk'.+push :: Turtle -> Turtle+push t = t {stk = t : stk t}++-- | Fetch 'Turtle' from 'stk'.+pop :: Turtle -> Turtle+pop t = head (stk t)++-- | Given state processing function /f/, a 'Turtle' and an initial+-- state, step 'Turtle' and state.+stepTurtle :: (t -> Pt -> Pt -> b) -> Turtle -> t -> (Turtle,b)+stepTurtle f t i =+    let p  = loc  t+        t' = forward t+        p' = loc  t'+        i' = f i p p'+    in (t',i')
+ README view
@@ -0,0 +1,6 @@+hls - haskell lindenmayer systems++  http://slavepianos.org/rd/?t=hls++(c) rohan drape, 2006-2011+    gpl, http://gnu.org/copyleft/
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ hls.cabal view
@@ -0,0 +1,28 @@+Name:              hls+Version:           0.11+Synopsis:          Haskell Lindenmayer Systems+Description:       Haskell library for generating Lindemayer systems+License:           GPL+Category:          Graphics+Copyright:         Rohan Drape, 2006-2011+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://www.slavepianos.org/rd/?t=hls+Tested-With:       GHC == 7.2.2+Build-Type:        Simple+Cabal-Version:     >= 1.8++Data-files:        README++Library+  Build-Depends:   base==4.*, containers, hps==0.11.*+  GHC-Options:     -Wall -fwarn-tabs+  Exposed-modules: LSystem.LSystem+                   LSystem.Turtle+                   LSystem.Render.PS+                   LSystem.Systems++Source-Repository  head+  Type:            darcs+  Location:        http://slavepianos.org/rd/sw/hls