Add Haddock documentation
This commit is contained in:
parent
f20497ecf3
commit
93578c7ddc
2 changed files with 48 additions and 11 deletions
|
@ -1,13 +1,17 @@
|
||||||
module Examples
|
module Examples
|
||||||
( gosper
|
( -- * Space-filling curves
|
||||||
|
gosper
|
||||||
, hilbert
|
, hilbert
|
||||||
|
-- * Fractals
|
||||||
, koch
|
, koch
|
||||||
|
, kochSnowflake
|
||||||
, sierpinski
|
, sierpinski
|
||||||
, sierpinskiArrow
|
, sierpinskiArrow
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Lib
|
import Lib
|
||||||
|
|
||||||
|
-- | Gosper curve
|
||||||
gosper :: LSystem Char
|
gosper :: LSystem Char
|
||||||
gosper = LSystem
|
gosper = LSystem
|
||||||
"AB+-"
|
"AB+-"
|
||||||
|
@ -18,6 +22,7 @@ gosper = LSystem
|
||||||
10
|
10
|
||||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||||
|
|
||||||
|
-- | Hilbert curve
|
||||||
hilbert = LSystem
|
hilbert = LSystem
|
||||||
"ABF+-"
|
"ABF+-"
|
||||||
"A"
|
"A"
|
||||||
|
@ -27,6 +32,7 @@ hilbert = LSystem
|
||||||
10
|
10
|
||||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||||
|
|
||||||
|
-- | Koch curve
|
||||||
koch = LSystem
|
koch = LSystem
|
||||||
"F+-"
|
"F+-"
|
||||||
"F"
|
"F"
|
||||||
|
@ -35,6 +41,16 @@ koch = LSystem
|
||||||
10
|
10
|
||||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||||
|
|
||||||
|
-- | Koch snowflake
|
||||||
|
kochSnowflake = LSystem
|
||||||
|
"F+-"
|
||||||
|
"F"
|
||||||
|
[('F', "F+F--F+F")]
|
||||||
|
60
|
||||||
|
10
|
||||||
|
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||||
|
|
||||||
|
-- | Sierpinski triangle
|
||||||
sierpinski = LSystem
|
sierpinski = LSystem
|
||||||
"AB+-"
|
"AB+-"
|
||||||
"A-B-B"
|
"A-B-B"
|
||||||
|
@ -44,6 +60,7 @@ sierpinski = LSystem
|
||||||
10
|
10
|
||||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||||
|
|
||||||
|
-- | Sierpinski arrowhead curve
|
||||||
sierpinskiArrow = LSystem
|
sierpinskiArrow = LSystem
|
||||||
"AB+-"
|
"AB+-"
|
||||||
"A"
|
"A"
|
||||||
|
|
40
src/Lib.hs
40
src/Lib.hs
|
@ -1,6 +1,8 @@
|
||||||
module Lib
|
module Lib
|
||||||
( LSystem(..)
|
( -- * L-system data types
|
||||||
|
LSystem(..)
|
||||||
, Instruction(..)
|
, Instruction(..)
|
||||||
|
-- * L-system functions
|
||||||
, iterateLSystem
|
, iterateLSystem
|
||||||
, instructions
|
, instructions
|
||||||
, drawLSystem
|
, drawLSystem
|
||||||
|
@ -9,20 +11,32 @@ module Lib
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Graphics.Gloss
|
import Graphics.Gloss
|
||||||
|
|
||||||
|
-- | L-system data type
|
||||||
data LSystem a = LSystem
|
data LSystem a = LSystem
|
||||||
{ alphabet :: [a]
|
{ alphabet :: [a] -- ^ variables and constants used by the system
|
||||||
, axiom :: [a]
|
, axiom :: [a] -- ^ initial state of the system
|
||||||
, rules :: [(a, [a])]
|
, rules :: [(a, [a])] -- ^ production rules defining how each
|
||||||
, angle :: Float
|
-- variable can be replaced by a sequence of
|
||||||
, distance :: Float
|
-- variables and constants
|
||||||
, representation :: [(a, Instruction)]
|
, angle :: Float -- ^ angle used for the representation
|
||||||
|
, distance :: Float -- ^ distance of each segment in the representation
|
||||||
|
, representation :: [(a, Instruction)] -- ^ representation rules
|
||||||
|
-- defining how each variable
|
||||||
|
-- and constant should be
|
||||||
|
-- represented
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
data Instruction = Forward | TurnRight | TurnLeft | Stay
|
-- | Instructions for displaying the L-system
|
||||||
|
data Instruction =
|
||||||
|
Forward -- ^ move forward
|
||||||
|
| TurnRight -- ^ turn right by angle
|
||||||
|
| TurnLeft -- ^ turn left by angle
|
||||||
|
| Stay -- ^ do nothing
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
iterateLSystem :: (Eq a, Num t, Eq t) => t -> LSystem a -> LSystem a
|
-- | Iterate the L-system by n steps
|
||||||
|
iterateLSystem :: (Eq a, Integral t) => t -> LSystem a -> LSystem a
|
||||||
iterateLSystem 0 lsystem = lsystem
|
iterateLSystem 0 lsystem = lsystem
|
||||||
iterateLSystem n (LSystem a ax r ang dist rep) =
|
iterateLSystem n (LSystem a ax r ang dist rep) =
|
||||||
iterateLSystem (n-1) $ LSystem a ax' r ang dist rep
|
iterateLSystem (n-1) $ LSystem a ax' r ang dist rep
|
||||||
|
@ -31,11 +45,16 @@ iterateLSystem n (LSystem a ax r ang dist rep) =
|
||||||
Just xs -> xs
|
Just xs -> xs
|
||||||
Nothing -> [x]
|
Nothing -> [x]
|
||||||
|
|
||||||
|
-- | Generate a set of instructions from an L-system
|
||||||
instructions :: Eq a => LSystem a -> [Instruction]
|
instructions :: Eq a => LSystem a -> [Instruction]
|
||||||
instructions (LSystem a ax r ang dist rep) = mapMaybe f ax
|
instructions (LSystem a ax r ang dist rep) = mapMaybe f ax
|
||||||
where f x = lookup x rep
|
where f x = lookup x rep
|
||||||
|
|
||||||
turtle :: Float -> Float -> [Instruction] -> Picture
|
-- | Draw a sequence of instructions
|
||||||
|
turtle :: Float -- ^ angle
|
||||||
|
-> Float -- ^ distance
|
||||||
|
-> [Instruction] -- ^ sequence of instruction
|
||||||
|
-> Picture -- ^ generated picture
|
||||||
turtle angle distance = go 0 (Line [(0,0)])
|
turtle angle distance = go 0 (Line [(0,0)])
|
||||||
where go _ ps [] = ps
|
where go _ ps [] = ps
|
||||||
go theta (Line path) (x:xs) =
|
go theta (Line path) (x:xs) =
|
||||||
|
@ -49,6 +68,7 @@ turtle angle distance = go 0 (Line [(0,0)])
|
||||||
thetaRad = theta * pi / 180
|
thetaRad = theta * pi / 180
|
||||||
p = (px + distance * cos thetaRad, py + distance * sin thetaRad)
|
p = (px + distance * cos thetaRad, py + distance * sin thetaRad)
|
||||||
|
|
||||||
|
-- | Draw an L-system
|
||||||
drawLSystem :: Eq a => LSystem a -> Picture
|
drawLSystem :: Eq a => LSystem a -> Picture
|
||||||
drawLSystem ls@(LSystem a ax r ang dist rep) = turtle ang dist $ instructions ls
|
drawLSystem ls@(LSystem a ax r ang dist rep) = turtle ang dist $ instructions ls
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue