module Lseed.Data where
import Data.Foldable (Foldable, foldMap)
import Data.Traversable (Traversable, sequenceA)
import Control.Applicative ((<$>),(<*>),pure)
import Control.Arrow (second)
import Data.Monoid
import System.Time (ClockTime)
import Data.Monoid
type UserTag = String
type Angle = Double
type Garden a = [ Planted a ]
type GrowingGarden = Garden GrowthState
type AnnotatedGarden = Garden StipeInfo
data Planted a = Planted
{ plantPosition :: Double
, plantOwner :: Integer
, plantOwnerName:: String
, genome :: GrammarFile
, phenotype :: Plant a
}
deriving (Show)
type GrowingPlanted = Planted GrowthState
type AnnotatedPlanted = Planted StipeInfo
data Plant a
= Plant { pData :: a
, pLength :: Double
, pAngle :: Angle
, pUserTag :: UserTag
, pBranches :: [ Plant a ]
}
deriving (Show)
inititalPlant = Plant () 0 0 "" []
data StipeInfo = StipeInfo
{ siLength :: Double
, siSubLength :: Double
, siLight :: Double
, siSubLight :: Double
, siAngle :: Angle
, siDirection :: Angle
, siOffset :: Double
, siHeight :: Double
, siDistance :: Double
, siGrowth :: GrowthState
}
deriving (Show)
data GrowthState = NoGrowth
| EnlargingTo Double
| GrowingSeed Double
deriving (Show)
type GrowingPlant = Plant GrowthState
type AnnotatedPlant = Plant StipeInfo
data ScreenContent = ScreenContent
{ scGarden :: AnnotatedGarden
, scLightAngle :: Double
, scTime :: String
, scMessage :: Maybe String
}
data Observer = Observer {
obInit :: IO ()
, obState :: Integer -> Angle -> GrowingGarden -> IO ()
, obGrowingState :: (ClockTime -> ScreenContent) -> IO ()
, obFinished :: GrowingGarden -> IO ()
, obShutdown :: IO ()
}
nullObserver = Observer (return ()) (\_ _ _ -> return ()) (\_ -> return ()) (\_ -> return ()) (return ())
data GardenSource = GardenSource {
getGarden :: IO (Garden ())
, getUpdatedCode :: Planted () -> IO GrammarFile
, getScreenMessage :: IO (Maybe String)
}
constGardenSource :: Garden () -> GardenSource
constGardenSource garden = GardenSource (return garden) (return . genome) (return Nothing)
type GrammarFile = [ GrammarRule ]
type Priority = Int
type Weight = Int
defaultPriority :: Priority
defaultPriority = 0
defaultWeight :: Weight
defaultWeight = 1
data GrammarRule = GrammarRule
{ grName :: String
, grPriority :: Priority
, grWeight :: Weight
, grCondition :: Condition
, grAction :: GrammarAction
}
deriving (Read,Show)
data Matchable
= MatchLight
| MatchSubLight
| MatchLength
| MatchSubLength
| MatchDirection
| MatchAngle
| MatchDistance
deriving (Read,Show)
data Cmp
= LE
| Less
| Equals
| Greater
| GE
deriving (Read,Show)
data Condition
= Always Bool
| Condition `And` Condition
| Condition `Or` Condition
| UserTagIs String
| NumCond Matchable Cmp Double
deriving (Read,Show)
data GrammarAction
= SetLength (Maybe UserTag) LengthDescr
| AddBranches (Maybe UserTag) Double [(Angle, Double, Maybe UserTag)]
| Blossom (Maybe UserTag)
deriving (Read,Show)
data LengthDescr = Absolute Double
| Additional Double
| AdditionalRelative Double
deriving (Read,Show)
instance Functor Plant where
fmap f p = p { pData = f (pData p)
, pBranches = map (fmap f) (pBranches p)
}
instance Foldable Plant where
foldMap f p = mconcat $ f (pData p) : map (foldMap f) (pBranches p)
instance Traversable Plant where
sequenceA (Plant x len ang ut ps) =
Plant <$> x <*> pure len <*> pure ang <*> pure ut <*>
sequenceA (map sequenceA ps)
instance Functor Planted where
fmap f planted = planted { phenotype = fmap f (phenotype planted) }
instance Foldable Planted where
foldMap f planted = foldMap f (phenotype planted)
instance Traversable Planted where
sequenceA planted = (\x -> planted { phenotype = x }) <$> sequenceA (phenotype planted)
instance Monoid Observer where
mempty = nullObserver
obs1 `mappend` obs2 = nullObserver {
obInit = obInit obs1 >> obInit obs2,
obState = \d g -> obState obs1 d g >> obState obs2 d g,
obGrowingState = \f -> obGrowingState obs1 f >> obGrowingState obs2 f,
obFinished = \g -> obFinished obs1 g >> obFinished obs2 g,
obShutdown = obShutdown obs1 >> obShutdown obs2
}