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 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"

View file

@ -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