Add Haddock documentation

This commit is contained in:
Dimitri Lozeve 2018-01-16 10:24:13 +00:00
parent f20497ecf3
commit 93578c7ddc
2 changed files with 48 additions and 11 deletions

View file

@ -1,13 +1,17 @@
module Examples
( gosper
( -- * Space-filling curves
gosper
, hilbert
-- * Fractals
, koch
, kochSnowflake
, sierpinski
, sierpinskiArrow
) where
import Lib
-- | Gosper curve
gosper :: LSystem Char
gosper = LSystem
"AB+-"
@ -18,6 +22,7 @@ gosper = LSystem
10
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
-- | Hilbert curve
hilbert = LSystem
"ABF+-"
"A"
@ -27,6 +32,7 @@ hilbert = LSystem
10
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
-- | Koch curve
koch = LSystem
"F+-"
"F"
@ -35,6 +41,16 @@ koch = LSystem
10
[('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
"AB+-"
"A-B-B"
@ -44,6 +60,7 @@ sierpinski = LSystem
10
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
-- | Sierpinski arrowhead curve
sierpinskiArrow = LSystem
"AB+-"
"A"

View file

@ -1,6 +1,8 @@
module Lib
( LSystem(..)
( -- * L-system data types
LSystem(..)
, Instruction(..)
-- * L-system functions
, iterateLSystem
, instructions
, drawLSystem
@ -9,20 +11,32 @@ module Lib
import Data.Maybe
import Graphics.Gloss
-- | L-system data type
data LSystem a = LSystem
{ alphabet :: [a]
, axiom :: [a]
, rules :: [(a, [a])]
, angle :: Float
, distance :: Float
, representation :: [(a, Instruction)]
{ alphabet :: [a] -- ^ variables and constants used by the system
, axiom :: [a] -- ^ initial state of the system
, rules :: [(a, [a])] -- ^ production rules defining how each
-- variable can be replaced by a sequence of
-- variables and constants
, 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)
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)
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 n (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
Nothing -> [x]
-- | Generate a set of instructions from an L-system
instructions :: Eq a => LSystem a -> [Instruction]
instructions (LSystem a ax r ang dist rep) = mapMaybe f ax
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)])
where go _ ps [] = ps
go theta (Line path) (x:xs) =
@ -49,6 +68,7 @@ turtle angle distance = go 0 (Line [(0,0)])
thetaRad = theta * pi / 180
p = (px + distance * cos thetaRad, py + distance * sin thetaRad)
-- | Draw an L-system
drawLSystem :: Eq a => LSystem a -> Picture
drawLSystem ls@(LSystem a ax r ang dist rep) = turtle ang dist $ instructions ls