Add command line arguments (L-system and number of iterations)
This commit is contained in:
Dimitri Lozeve
parent
e71eda7c5e
commit
ebe12ac42b
5 changed files with 177 additions and 88 deletions
16
README.org
16
README.org
|
|
@ -45,6 +45,22 @@ For tests and documentation, run:
|
|||
stack test --haddock
|
||||
#+END_SRC
|
||||
|
||||
You can choose the L-system and the number of iteration via
|
||||
command-line arguments, see the output of ~--help~:
|
||||
|
||||
#+BEGIN_SRC
|
||||
lsystems -- Generate L-systems
|
||||
|
||||
Usage: lsystems-exe [LSYSTEM] [-n|--iterations N]
|
||||
Generate and draw an L-system
|
||||
|
||||
Available options:
|
||||
LSYSTEM L-system to generate (default: penroseP3)
|
||||
-n,--iterations N Number of iterations (default: 5)
|
||||
-h,--help Show this help text
|
||||
#+END_SRC
|
||||
|
||||
|
||||
** Examples provided
|
||||
|
||||
*** Space-filling curves
|
||||
|
|
|
|||
50
app/Main.hs
50
app/Main.hs
|
|
@ -1,11 +1,55 @@
|
|||
module Main where
|
||||
|
||||
import Graphics.Gloss
|
||||
import Options.Applicative
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.List
|
||||
|
||||
import Lib
|
||||
import Examples
|
||||
|
||||
data Options = Options
|
||||
{ optionLSystem :: LSystem Char
|
||||
, optionIterations :: Integer
|
||||
}
|
||||
|
||||
selectLSystem :: [LSystem a] -> String -> Either String (LSystem a)
|
||||
selectLSystem ls s = case find (\x -> name x == s) ls of
|
||||
Just x -> Right x
|
||||
Nothing -> Left $ "Cannot find L-system \"" ++ s ++ "\""
|
||||
|
||||
lsystem :: Parser (LSystem Char)
|
||||
lsystem = argument (eitherReader (selectLSystem lsystems))
|
||||
(metavar "LSYSTEM"
|
||||
<> help "L-system to generate"
|
||||
<> showDefaultWith name
|
||||
<> value penroseP3
|
||||
<> completeWith (map name lsystems)
|
||||
<> completer (listCompleter (map name lsystems)))
|
||||
|
||||
iterations :: Parser Integer
|
||||
iterations = option auto
|
||||
(long "iterations"
|
||||
<> short 'n'
|
||||
<> help "Number of iterations"
|
||||
<> showDefault
|
||||
<> value 5
|
||||
<> metavar "N")
|
||||
|
||||
options :: Parser Options
|
||||
options = Options <$> lsystem <*> iterations
|
||||
|
||||
opts :: ParserInfo Options
|
||||
opts = info (options <**> helper)
|
||||
( fullDesc
|
||||
<> progDesc "Generate and draw an L-system"
|
||||
<> header "lsystems -- Generate L-systems")
|
||||
|
||||
createDisplay :: (Eq a, Integral p) => p -> LSystem a -> IO ()
|
||||
createDisplay n ls = display (InWindow "L-System" (200, 200) (10, 10)) black (color white pic)
|
||||
where pic = drawLSystem $ iterateLSystem n ls
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
display (InWindow "L-System" (200, 200) (10, 10)) black (color white pic)
|
||||
where pic = drawLSystem $ iterateLSystem 6 penroseP3
|
||||
main = do
|
||||
Options ls n <- execParser opts
|
||||
createDisplay n ls
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ description: Please see the README on Github at <https://github.com/dloz
|
|||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
- gloss
|
||||
- optparse-applicative
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
|
|
|||
187
src/Examples.hs
187
src/Examples.hs
|
|
@ -1,6 +1,7 @@
|
|||
module Examples
|
||||
( -- * Space-filling curves
|
||||
gosper
|
||||
( lsystems
|
||||
-- * Space-filling curves
|
||||
, gosper
|
||||
, hilbert
|
||||
-- * Fractals
|
||||
, levyC
|
||||
|
|
@ -17,107 +18,133 @@ module Examples
|
|||
|
||||
import Lib
|
||||
|
||||
-- | List of all exported L-systems
|
||||
lsystems :: [LSystem Char]
|
||||
lsystems = [gosper, hilbert, levyC, koch, kochSnowflake, sierpinski, sierpinskiArrow,
|
||||
dragon, tree, plant, penroseP3]
|
||||
|
||||
-- | Gosper curve
|
||||
gosper :: LSystem Char
|
||||
gosper = LSystem
|
||||
"AB+-"
|
||||
"A"
|
||||
[ ('A', "A-B--B+A++AA+B-")
|
||||
, ('B', "+A-BB--B-A++A+B")]
|
||||
60
|
||||
10
|
||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
gosper =
|
||||
LSystem
|
||||
"gosper"
|
||||
"AB+-"
|
||||
"A"
|
||||
[ ('A', "A-B--B+A++AA+B-")
|
||||
, ('B', "+A-BB--B-A++A+B")]
|
||||
60
|
||||
10
|
||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Hilbert curve
|
||||
hilbert = LSystem
|
||||
"ABF+-"
|
||||
"A"
|
||||
[ ('A', "-BF+AFA+FB-")
|
||||
, ('B', "+AF-BFB-FA+")]
|
||||
90
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
hilbert =
|
||||
LSystem
|
||||
"hilbert"
|
||||
"ABF+-"
|
||||
"A"
|
||||
[ ('A', "-BF+AFA+FB-")
|
||||
, ('B', "+AF-BFB-FA+")]
|
||||
90
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Lévy C curve
|
||||
levyC = LSystem
|
||||
"F+-"
|
||||
"F"
|
||||
[('F', "+F--F+")]
|
||||
45
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
levyC =
|
||||
LSystem
|
||||
"levyC"
|
||||
"F+-"
|
||||
"F"
|
||||
[('F', "+F--F+")]
|
||||
45
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Koch curve
|
||||
koch = LSystem
|
||||
"F+-"
|
||||
"F"
|
||||
[('F', "F+F-F-F+F")]
|
||||
90
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
koch =
|
||||
LSystem
|
||||
"koch"
|
||||
"F+-"
|
||||
"F"
|
||||
[('F', "F+F-F-F+F")]
|
||||
90
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Koch snowflake
|
||||
kochSnowflake = LSystem
|
||||
"F+-"
|
||||
"F"
|
||||
[('F', "F+F--F+F")]
|
||||
60
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
kochSnowflake =
|
||||
LSystem
|
||||
"kochSnowflake"
|
||||
"F+-"
|
||||
"F"
|
||||
[('F', "F-F++F-F")]
|
||||
60
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Sierpinski triangle
|
||||
sierpinski = LSystem
|
||||
"AB+-"
|
||||
"A-B-B"
|
||||
[ ('A', "A-B+A+B-A")
|
||||
, ('B', "BB")]
|
||||
120
|
||||
10
|
||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
sierpinski =
|
||||
LSystem
|
||||
"sierpinski"
|
||||
"AB+-"
|
||||
"A-B-B"
|
||||
[ ('A', "A-B+A+B-A")
|
||||
, ('B', "BB")]
|
||||
120
|
||||
10
|
||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Sierpinski arrowhead curve
|
||||
sierpinskiArrow = LSystem
|
||||
"AB+-"
|
||||
"A"
|
||||
[ ('A', "B+A+B")
|
||||
, ('B', "A-B-A")]
|
||||
60
|
||||
10
|
||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
sierpinskiArrow =
|
||||
LSystem
|
||||
"sierpinskiArrow"
|
||||
"AB+-"
|
||||
"A"
|
||||
[ ('A', "B+A+B")
|
||||
, ('B', "A-B-A")]
|
||||
60
|
||||
10
|
||||
[('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
|
||||
-- | Dragon curve
|
||||
dragon = LSystem
|
||||
"FX+-"
|
||||
"FX"
|
||||
[('X', "X+YF+"),
|
||||
('Y', "-FX-Y")]
|
||||
90
|
||||
10
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
|
||||
dragon =
|
||||
LSystem
|
||||
"dragon"
|
||||
"FX+-"
|
||||
"FX"
|
||||
[('X', "X+YF+"),
|
||||
('Y', "-FX-Y")]
|
||||
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)]
|
||||
|
||||
tree =
|
||||
LSystem
|
||||
"tree"
|
||||
"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)]
|
||||
plant =
|
||||
LSystem
|
||||
"plant"
|
||||
"FX+-[]"
|
||||
"X"
|
||||
[('X', "F[-X][X]F[-X]+FX")
|
||||
,('F', "FF")]
|
||||
25
|
||||
1
|
||||
[('F',Forward), ('+',TurnRight), ('-',TurnLeft), ('[',Push), (']',Pop)]
|
||||
|
||||
-- | Penrose P3
|
||||
penroseP3 =
|
||||
LSystem
|
||||
"penroseP3"
|
||||
"MNOPA+-[]"
|
||||
"[N]++[N]++[N]++[N]++[N]"
|
||||
[('M',"OA++PA----NA[-OA----MA]++")
|
||||
|
|
|
|||
11
src/Lib.hs
11
src/Lib.hs
|
|
@ -14,7 +14,8 @@ import Graphics.Gloss
|
|||
|
||||
-- | L-system data type
|
||||
data LSystem a = LSystem
|
||||
{ alphabet :: [a] -- ^ variables and constants used by the system
|
||||
{ name :: String
|
||||
, 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
|
||||
|
|
@ -41,9 +42,9 @@ data Instruction =
|
|||
-- | 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
|
||||
iterateLSystem n lsystem | n < 0 = iterateLSystem (-n) lsystem
|
||||
iterateLSystem n (LSystem na a ax r ang dist rep) =
|
||||
iterateLSystem (n-1) $ LSystem na a ax' r ang dist rep
|
||||
where ax' = concat $ map f ax
|
||||
f x = case lookup x r of
|
||||
Just xs -> xs
|
||||
|
|
@ -51,7 +52,7 @@ iterateLSystem n lsystem | n < 0 = iterateLSystem (-n) lsystem
|
|||
|
||||
-- | 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
|
||||
instructions (LSystem na a ax r ang dist rep) = mapMaybe f ax
|
||||
where f x = lookup x rep
|
||||
|
||||
-- | Draw a sequence of instructions
|
||||
|
|
@ -79,5 +80,5 @@ turtle angle distance = go 90 (Line [(0,0)]) (Pictures []) []
|
|||
|
||||
-- | Draw an L-system
|
||||
drawLSystem :: Eq a => LSystem a -> Picture
|
||||
drawLSystem ls@(LSystem a ax r ang dist rep) = turtle ang dist $ instructions ls
|
||||
drawLSystem ls@(LSystem na a ax r ang dist rep) = turtle ang dist $ instructions ls
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue