diff --git a/LSystem/LSystem.hs b/LSystem/LSystem.hs --- a/LSystem/LSystem.hs +++ b/LSystem/LSystem.hs @@ -1,9 +1,9 @@ -- | Lindenmayer system definition, expander and renderer. module LSystem.LSystem where -import Graphics.PS.Pt +import Data.CG.Minus {- hcg-minus -} import LSystem.Turtle -import Data.Map as Map +import qualified Data.Map as M -- | Element of 'Axiom'. type Element = Char @@ -11,8 +11,8 @@ -- | An axiom (sequence of 'Elements'). type Axiom = [Element] --- | A 'Map.Map' from 'Element's to 'Axiom's. -type Rules = Map.Map Element Axiom +-- | A 'M.Map' from 'Element's to 'Axiom's. +type Rules = M.Map Element Axiom -- | An 'LSystem' is an 'Axiom' and a set of 'Rules'. data LSystem = LSystem Axiom Rules deriving (Eq,Show) @@ -21,11 +21,11 @@ -- -- > lSystem "F+F+F" [('F',"F-F+F")] lSystem :: Axiom -> [(Element,[Element])] -> LSystem -lSystem a rs = LSystem a (fromList rs) +lSystem a rs = LSystem a (M.fromList rs) -- | Rule lookup. getRule :: Rules -> Element -> [Element] -getRule rs c = Map.findWithDefault [c] c rs +getRule rs c = M.findWithDefault [c] c rs -- | Rule application. applyRule :: [Element] -> Rules -> [Element] @@ -62,7 +62,7 @@ _ -> (stateT e t, i) -- | Fold over an expanded L-system using standard turtle commands. -render :: b -> (b -> Pt -> Pt -> b) -> [Element] -> Turtle -> b +render :: b -> (b -> Pt R -> Pt R -> 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) diff --git a/LSystem/Render/PS.hs b/LSystem/Render/PS.hs --- a/LSystem/Render/PS.hs +++ b/LSystem/Render/PS.hs @@ -1,25 +1,22 @@ -- | Postscript renderer for 'LSystem's. module LSystem.Render.PS where -import Graphics.PS +import Graphics.PS {- hps -} + import LSystem.LSystem import LSystem.Turtle --- | Given initial 'ta', 'ls' and 'll' values render /i/ steps of an +-- | Given initial 'ta', 'ls' and 'lls' 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 +renderL :: (LSystem,Double,Double) -> Int -> Double -> [Ln R] +renderL (l,ta',lls') i ll' = + let a = Turtle (radians ta') 1 pt_origin (pi / 2) ll' lls' [] + in render [] (\ll'' p1 p2 -> Ln p1 p2 : ll'') (expand l i) a --- | Given a scalar and a 'Path' render a 'greyGS' 'Image'. -draw :: Double -> Path -> Image -draw z p = +-- | Draw output of 'renderL' normalised, scaled to /m/ and translated +-- by /o/. +draw :: R -> R -> [Ln R] -> Image +draw o m l = 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 + p = renderLines' (lns_normalise m l) + in translate o o (Stroke g p) diff --git a/LSystem/Systems.hs b/LSystem/Systems.hs --- a/LSystem/Systems.hs +++ b/LSystem/Systems.hs @@ -62,32 +62,40 @@ lCd = (lC,36.0,1) lDd = (lD,60.0,1) +-- * Line sets + +l0l,l1l,l2l,l3l,l4l,l5l,l6l,l7l,l8l,l9l,lAl,lBl,lCl,lDl :: [Ln R] +l0l = renderL l0d 3 5 +l1l = renderL l1d 3 5 +l2l = renderL l2d 5 5 +l3l = renderL l3d 12 5 +l4l = renderL l4d 6 5 +l5l = renderL l5d 4 5 +l6l = renderL l6d 7 5 +l7l = renderL l7d 4 5 +l8l = renderL l8d 6 5 +l9l = renderL l9d 10 40 +lAl = renderL lAd 11 5 +lBl = renderL lBd 6 5 +lCl = renderL lCd 5 5 +lDl = renderL lDd 5 1 + +-- > map (wn_from_extent . l_extent) systems_l +systems_l :: [[Ln R]] +systems_l = [l0l,l1l,l2l,l3l,l4l,l5l,l6l,l7l,l8l,l9l,lAl,lBl,lCl,lDl] + -- * 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) +-- > map imageStatistics systems_i +systems_i :: [Image] +systems_i = map (draw 25 750) systems_l -- | 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] +systems_ps fn = ps fn (Paper 285 285) systems_i -- Local Variables: -- truncate-lines:t diff --git a/LSystem/Turtle.hs b/LSystem/Turtle.hs --- a/LSystem/Turtle.hs +++ b/LSystem/Turtle.hs @@ -1,15 +1,15 @@ -- | Standard 'Turtle' graphics. module LSystem.Turtle where -import Graphics.PS.Pt +import Data.CG.Minus {- hcg-minus -} -- | Turtle. data Turtle = Turtle {ta :: Double -- ^ turning angle ,tai :: Double -- ^ turning angle increment - ,loc :: Pt -- ^ location + ,loc :: Pt Double -- ^ location ,hdg :: Double -- ^ heading ,ll :: Double -- ^ line length - ,ls :: Double -- ^ length scalar + ,lls :: Double -- ^ line length scalar ,stk :: [Turtle] -- ^ turtle stack } -- lw = line width,lwi = line width increment, @@ -25,13 +25,15 @@ turnBack :: Turtle -> Turtle turnBack t = t {hdg = hdg t + pi} --- | Increment line length ('ll') by multiplying by line scalar ('ls'). +-- | Increment line length ('ll') by multiplying by line length scalar +-- ('lls'). incrLine :: Turtle -> Turtle -incrLine t = t {ll = ll t * ls t} +incrLine t = t {ll = ll t * lls t} --- | Decrement line length ('ll') by dividing by line scalar ('ls'). +-- | Decrement line length ('ll') by dividing by line length scalar +-- ('lls'). decrLine :: Turtle -> Turtle -decrLine t = t {ll = ll t / ls t} +decrLine t = t {ll = ll t / lls t} -- | Move 'loc' of 'Turtle' by 'll' on current 'hdg'. forward :: Turtle -> Turtle @@ -49,7 +51,7 @@ -- | 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 :: (t -> Pt R -> Pt R -> b) -> Turtle -> t -> (Turtle,b) stepTurtle f t i = let p = loc t t' = forward t diff --git a/README b/README --- a/README +++ b/README @@ -1,6 +1,14 @@ -hls - haskell lindenmayer systems +hls +--- - http://slavepianos.org/rd/?t=hls +[haskell][hs] lindenmayer systems -(c) rohan drape, 2006-2011 - gpl, http://gnu.org/copyleft/ +> Aristid Lindenmayer, "Mathematical models for cellular interaction +> in development." _J. Theoret. Biology_, 18:280—315, 1968. + +[hs]: http://haskell.org + +© [rohan drape][rd], 2006-2012, [gpl] + +[rd]: http://rd.slavepianos.org/ +[gpl]: http://gnu.org/copyleft/ diff --git a/hls.cabal b/hls.cabal --- a/hls.cabal +++ b/hls.cabal @@ -1,22 +1,25 @@ Name: hls -Version: 0.11 +Version: 0.14 Synopsis: Haskell Lindenmayer Systems Description: Haskell library for generating Lindemayer systems License: GPL Category: Graphics -Copyright: Rohan Drape, 2006-2011 +Copyright: Rohan Drape, 2006-2013 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental -Homepage: http://www.slavepianos.org/rd/?t=hls -Tested-With: GHC == 7.2.2 +Homepage: http://rd.slavepianos.org/?t=hls +Tested-With: GHC == 7.6.1 Build-Type: Simple Cabal-Version: >= 1.8 Data-files: README Library - Build-Depends: base==4.*, containers, hps==0.11.* + Build-Depends: base==4.*, + containers, + hcg-minus == 0.14.*, + hps == 0.14.* GHC-Options: -Wall -fwarn-tabs Exposed-modules: LSystem.LSystem LSystem.Turtle @@ -25,4 +28,4 @@ Source-Repository head Type: darcs - Location: http://slavepianos.org/rd/sw/hls + Location: http://rd.slavepianos.org/sw/hls