linden-0: Linden.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Text (Text)
import Data.Tree
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Reader
import Data.Random.Distribution.Normal
import Data.Hashable (hash)

import qualified Network.Wai.Handler.Warp as Warp

import Linden.Types
import Linden.RuleDSL
import Linden.Server
import Linden.Store.Memory

import Paths_linden

rule :: ReaderT FilePath IO Rule
rule = do
    basicBranch <- readBranchSym [hash ("basic"::Text)] "branch"
    return . compileRules . noDup $ do
      b <- curBranch
      --cs <- offspring <$> ask
      let s = bScale b
      angSum <- angleSum
      ls <- lightCones
      doNothing 100 -- Doing nothing is always an option
      when (not . null $ ls) $ do
        when (s==1) $ do
          addBranch 50 basicBranch 0 tscl 1
        when (s==tscl) $ do
          addBranch 50 basicBranch 0 tscl 1
          a <- lift . lift $ normal 20 10
          when (angSum < 180) $ addBranch 1 basicBranch a tscl 1
          when (angSum > -180) $ addBranch 1 basicBranch (-a) tscl 1
  where
    tscl = 1

axiom :: AxiomSource
axiom u t =
  return . LS u t 2 [Light 1 (0, 300) (-90) 90 0.7] .
         Just . PrettyJSTree $ Node (Branch 0 (Just "branch.png") (2, 0) (2, 19) 0 1 True True (map hash ["basic"::Text]) Nothing 0.5) []

main :: IO ()
main = do
  bp <- getDataDir
  ms <- memStore
  rule' <- return <$> runReaderT rule bp
  Warp.runEnv 8080 $ lindenApp bp ms "87fhn34wdfd2" 5.0 axiom rule' (return "")