Initial commit

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+lsystems.cabal
+*~

LICENSE

@@ -0,0 +1,30 @@
+Copyright Dimitri Lozeve (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Dimitri Lozeve nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.org

@@ -0,0 +1,3 @@
+* L-Systems
+
+

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Examples.hs

@@ -0,0 +1,54 @@
+module Examples
+  ( gosper
+  , hilbert
+  , koch
+  , sierpinski
+  , sierpinskiArrow
+  ) where
+
+import Lib
+
+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)]
+
+hilbert = LSystem
+          "ABF+-"
+          "A"
+          [ ('A', "-BF+AFA+FB-")
+          , ('B', "+AF-BFB-FA+")]
+          90
+          10
+          [('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
+
+koch = LSystem
+       "F+-"
+       "F"
+       [('F', "F+F-F-F+F")]
+       90
+       10
+       [('F',Forward), ('+',TurnRight), ('-',TurnLeft)]
+
+sierpinski = LSystem
+             "AB+-"
+             "A-B-B"
+             [ ('A', "A-B+A+B-A")
+             , ('B', "BB")]
+             120
+             10
+             [('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]
+
+sierpinskiArrow = LSystem
+                  "AB+-"
+                  "A"
+                  [ ('A', "B+A+B")
+                  , ('B', "A-B-A")]
+                  60
+                  10
+                  [('A',Forward), ('B',Forward), ('+',TurnRight), ('-',TurnLeft)]

app/Main.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import Graphics.Gloss
+
+import Lib
+import Examples
+
+main :: IO ()
+main =
+  display (InWindow "L-System" (200, 200) (10, 10)) black (color white pic)
+  where pic = drawLSystem $ iterateLSystem 5 gosper

package.yaml

@@ -0,0 +1,48 @@
+name:                lsystems
+version:             0.1.0.0
+github:              "dlozeve/lsystems"
+license:             BSD3
+author:              "Dimitri Lozeve"
+maintainer:          "dimitri@lozeve.com"
+copyright:           "Copyright (c) 2018 Dimitri Lozeve"
+
+extra-source-files:
+- README.org
+
+# Metadata used when publishing your package
+# synopsis:            Generate and draw L-Systems
+# category:            Math
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on Github at <https://github.com/dlozeve/lsystems#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- gloss
+
+library:
+  source-dirs: src
+
+executables:
+  lsystems-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - lsystems
+
+tests:
+  lsystems-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - lsystems

src/Lib.hs

@@ -0,0 +1,53 @@
+module Lib
+    ( LSystem(..)
+    , Instruction(..)
+    , iterateLSystem
+    , drawLSystem
+    ) where
+
+import Data.Maybe
+import Graphics.Gloss
+
+data LSystem a = LSystem
+  { alphabet :: [a]
+  , axiom :: [a]
+  , rules :: [(a, [a])]
+  , angle :: Float
+  , distance :: Float
+  , representation :: [(a, Instruction)]
+  } deriving (Eq, Show)
+
+data Instruction = Forward | TurnRight | TurnLeft | Stay
+  deriving (Eq, Show)
+
+
+iterateLSystem :: (Eq a, Num t, Eq 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
+  where ax' = concat $ map f ax
+        f x = case lookup x r of
+                Just xs -> xs
+                Nothing -> [x]
+
+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
+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)
+
+drawLSystem :: Eq a => LSystem a -> Picture
+drawLSystem ls@(LSystem a ax r ang dist rep) = turtle ang dist $ instructions ls
+

stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-10.3
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.6"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"