-- Haskell module for creating postscript diagrams from turtle paths
-- Jeremy Yallop, Nov. 2005.

module LSystem where


import List
import System
import Control.Monad.State(get,put,runState,State)

-- invoke gs to display the file.  If you're running on a different
-- system, this is what you'll need to change.

display :: Float -> Command -> IO ()
display n ps = 
    do 
    -- we'll use the username to create a filename that doesn't clash
    -- with other users
    username <- getEnv "LOGNAME"
    let filename = "/tmp/turtle-" ++ username ++ ".ps"

    -- Delete the previous version of the file
    -- "-f" means "don't complain if the file to be deleted doesn't
    -- exist".
    system ("rm -f " ++ filename)

    -- Convert the command to postscript and write it to the file
    writeFile filename (dumpPS n ps)

    -- invoke the postscript viewer, `gv', to display the file
    system ("gv " ++ filename)

    -- 
    return ()


-- colours, and how to manipulate them
data Pen = Colour Float Float Float
         | Inkless
              deriving (Eq, Ord, Show)

white, black, red, green, blue :: Pen
white = Colour 1.0 1.0 1.0
black = Colour 0.0 0.0 0.0
red   = Colour 1.0 0.0 0.0
green = Colour 0.0 1.0 0.0
blue  = Colour 0.0 0.0 1.0

mix :: Pen -> Pen -> Pen
mix (Colour a b c) (Colour a' b' c') = Colour ((a+a') / 2) ((b+b') / 2) ((c+c') / 2)

-- paths
type Distance = Float
type Angle = Float

data Command = Go Distance
          | Turn Angle -- turn to the left
          | Sit
          | Command :#: Command
          | Branch Command
          | GrabPen Pen
          deriving (Eq, Ord, Show)

-- postscript
type PostScript = String

                       
toPSC (Colour r g b) = show r ++ " " ++ show g ++ " " ++ show b ++ " c\n"
toPSC Inkless = ""

type PState a = State Pen a

toPSM :: Command -> PState String
-- draw horizontal line of length d, move to end of line
toPSM (Go d) = do pen <- get 
                  return $ case pen of 
                                    Inkless -> show d ++ " 0 moveto currentpoint translate\n"
                                    _ -> show d ++ " 0 f\n"

-- rotate current page coordinates by angle
toPSM (Turn angle) = return $ show angle ++ " rotate\n"

-- one thing, then the next
toPSM (p :#: q) = do
                 pen <- get
                 p1 <- toPSM p
                 p2 <- toPSM q
                 return $ p1 ++ p2

-- change the colour of the following bits
toPSM (GrabPen c) = do put c; return $ toPSC c

toPSM (Branch p) = do path <- toPSM p
                      return $ "gsave\n" ++ path ++ " grestore\n"

-- null path
toPSM Sit = return ""

header =  ("/f { lineto currentpoint translate currentpoint stroke moveto } def\n"
           ++ "/c { /DeviceRGB setcolorspace setrgbcolor } def\n"
           ++ "newpath\n"
           ++ "300 450 translate\n"
           ++ "90 rotate\n")

-- toplevel: wrap it inside appropriate header/footer
dumpPS :: Float -> Command -> PostScript
dumpPS n p = header ++ scale ++ " 0 0 moveto\n" ++ pathbit ++ " stroke showpage\n"
    where (pathbit, _) = runState (toPSM p) black
          scale = show n ++ " " ++ show n ++ " scale\n"

-- equivalence testing
equivalent a b = nosit(flatten a) == nosit(flatten b)
    where nosit (a :#: Sit) = nosit a
          nosit (Sit :#: b) = b
          nosit (a :#: b) = nosit a :#: b
          nosit cmd = cmd
flatten :: Command -> Command
flatten (a :#: (b :#: c)) = flatten(a :#: b :#: c)
flatten (a :#: b) = (flatten a :#: b)
flatten cmd = cmd

-- sample LSystems
triangle :: Int -> Command
triangle x  =  n :#: f x
    where f 0      = Go 10
          f (x+1)  = f x :#: p :#: f x :#: n :#: f x :#: n :#: f x :#: p :#: f x
          n        = Turn 90
          p        = Turn (-90)

tree :: Int -> Command
tree x  =  f x
    where f 0      = GrabPen red :#: Go 10
          f (x+1)  = g x :#: Branch (n :#: f x)
                         :#: Branch (p :#: f x)
                         :#: Branch (g x :#: f x)
          g 0      = GrabPen blue :#: Go 10
          g (x+1)  = g x :#: g x
          n        = Turn 45
          p        = Turn (-45)