diff --git a/app/Main.hs b/app/Main.hs index 02e6545..d845858 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,4 +8,4 @@ import Examples main :: IO () main = display (InWindow "L-System" (200, 200) (10, 10)) black (color white pic) - where pic = drawLSystem $ iterateLSystem 5 gosper + where pic = drawLSystem $ iterateLSystem 7 plant diff --git a/src/Examples.hs b/src/Examples.hs index fad92e6..80a4206 100644 --- a/src/Examples.hs +++ b/src/Examples.hs @@ -9,6 +9,8 @@ module Examples , sierpinski , sierpinskiArrow , dragon + , tree + , plant ) where import Lib @@ -90,3 +92,23 @@ dragon = LSystem 90 10 [('F',Forward), ('+',TurnRight), ('-',TurnLeft)] + +-- | Binary tree +tree = LSystem + "AB+-[]" + "A" + [('B', "BB") + ,('A', "B[+A]-A")] + 45 + 1 + [('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft), ('[',Push), (']',Pop)] + +-- | Fractal plant +plant = LSystem + "FX+-[]" + "X" + [('X', "F[-X][X]F[-X]+FX") + ,('F', "FF")] + 25 + 1 + [('F',Forward), ('+',TurnRight), ('-',TurnLeft), ('[',Push), (']',Pop)] diff --git a/src/Lib.hs b/src/Lib.hs index 993da56..c52a003 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -5,6 +5,7 @@ module Lib -- * L-system functions , iterateLSystem , instructions + , turtle , drawLSystem ) where @@ -31,6 +32,8 @@ data Instruction = Forward -- ^ move forward | TurnRight -- ^ turn right by angle | TurnLeft -- ^ turn left by angle + | Push -- ^ push a position on the stack + | Pop -- ^ pop a position from the stack | Stay -- ^ do nothing deriving (Eq, Show) @@ -55,18 +58,23 @@ turtle :: Float -- ^ angle -> Float -- ^ distance -> [Instruction] -- ^ sequence of instruction -> Picture -- ^ generated picture -turtle angle distance = go 0 (Line [(0,0)]) - where go _ ps [] = ps - go theta (Line path) (x:xs) = - case x of - Forward -> go theta (Line (p:path)) xs - TurnRight -> go (theta + angle) (Line path) xs - TurnLeft -> go (theta - angle) (Line path) xs - Stay -> go theta (Line path) xs - where - (px, py) = head path - thetaRad = theta * pi / 180 - p = (px + distance * cos thetaRad, py + distance * sin thetaRad) +turtle angle distance = go 90 (Line [(0,0)]) (Pictures []) [] + where + go :: Float -> Picture -> Picture -> [(Point,Float)] -> [Instruction] -> Picture + go _ line (Pictures ps) _ [] = Pictures (line:ps) + go theta (Line path) (Pictures ps) stack (x:xs) = + case x of + Forward -> go theta (Line (p:path)) (Pictures ps) stack xs + TurnRight -> go (theta + angle) (Line path) (Pictures ps) stack xs + TurnLeft -> go (theta - angle) (Line path) (Pictures ps) stack xs + Push -> go theta (Line path) (Pictures ps) ((head path, theta):stack) xs + Pop -> let (pos, theta'):t = stack in + go theta' (Line [pos]) (Pictures ((Line path):ps)) t xs + Stay -> go theta (Line path) (Pictures ps) stack xs + where + (px, py) = head path + thetaRad = theta * pi / 180 + p = (px + distance * cos thetaRad, py + distance * sin thetaRad) -- | Draw an L-system drawLSystem :: Eq a => LSystem a -> Picture diff --git a/test/Tests.hs b/test/Tests.hs index 52d712a..a243e10 100644 --- a/test/Tests.hs +++ b/test/Tests.hs @@ -23,10 +23,6 @@ unitTests = testGroup "Unit tests" $ instructions (iterateLSystem 1 gosper) @?= [Forward,TurnLeft,Forward,TurnLeft,TurnLeft,Forward,TurnRight,Forward,TurnRight,TurnRight,Forward,Forward,TurnRight,Forward,TurnLeft] , testCase "instructions of one iteration of sierpinski" $ instructions (iterateLSystem 1 sierpinski) @?= [Forward,TurnLeft,Forward,TurnRight,Forward,TurnRight,Forward,TurnLeft,Forward,TurnLeft,Forward,Forward,TurnLeft,Forward,Forward] - , testCase "draw axiom of gosper" - $ drawLSystem gosper @?= Line [(10.0,0.0),(0.0,0.0)] - , testCase "draw one iteration of gosper" - $ drawLSystem (iterateLSystem 1 gosper) @?= Line [(25.0,-8.660253),(20.0,-17.320507),(10.0,-17.320507),(-4.7683716e-7,-17.320507),(5.0,-8.660254),(15.0,-8.6602545),(10.0,0.0),(0.0,0.0)] ] propertyChecks :: TestTree