module Data.Sifflet.Functoid
(Functoid(..)
, functoidName, functoidArgNames, functoidHeader
, FunctoidLayout(..), flayout
, flayoutBBox, flayoutSize, flayoutWidth, flayoutBottom
, flayoutWiden)
where
import Data.Graph.Inductive as G
import Data.Sifflet.Geometry
import Data.Sifflet.TreeLayout
import Language.Sifflet.Expr
import Language.Sifflet.ExprTree
data Functoid = FunctoidParts {fpName :: String,
fpArgs :: [String],
fpNodes :: [G.Node]}
| FunctoidFunc {fpFunc :: Function}
deriving (Show)
functoidName :: Functoid -> String
functoidName (FunctoidParts {fpName = name}) = name
functoidName (FunctoidFunc function) = functionName function
functoidArgNames :: Functoid -> [String]
functoidArgNames (FunctoidParts {fpArgs = args}) = args
functoidArgNames (FunctoidFunc function) = functionArgNames function
functoidHeader :: Functoid -> String
functoidHeader f = unwords (functoidName f : functoidArgNames f)
data FunctoidLayout = FLayoutTree (TreeLayout ExprNode)
| FLayoutForest [TreeLayout ExprNode] BBox
flayout :: Style -> Functoid -> Env -> Maybe [Value] -> FunctoidLayout
flayout style functoid env mvalues =
case functoid of
FunctoidParts {} ->
FLayoutForest [] (BBox (hpad style) (vpad style) 300 300)
FunctoidFunc function ->
let expr = functionBody function
aspecs = functionArgSpecs function
exprTree = case mvalues of
Nothing -> exprToTree expr
Just _values -> evalTree (exprToTree expr) env
tlo = treeLayout style
(exprNodeIoletCounter env aspecs)
exprTree
in FLayoutTree tlo
flayoutBBox :: FunctoidLayout -> BBox
flayoutBBox aflayout =
case aflayout of
FLayoutTree t -> layoutTreeBB t
FLayoutForest _ bbox -> bbox
flayoutSize :: FunctoidLayout -> Size
flayoutSize = bbSize . flayoutBBox
flayoutWidth :: FunctoidLayout -> Double
flayoutWidth = bbWidth . flayoutBBox
flayoutBottom :: FunctoidLayout -> Double
flayoutBottom = bbBottom . flayoutBBox
flayoutWiden :: FunctoidLayout -> Double -> FunctoidLayout
flayoutWiden aflayout minWidth =
case aflayout of
FLayoutTree t -> FLayoutTree (treeLayoutWiden t minWidth)
FLayoutForest f bbox -> FLayoutForest f bbox
instance Translate FunctoidLayout where
translate dx dy fl =
case fl of
FLayoutTree t ->
FLayoutTree (translate dx dy t)
FLayoutForest f b ->
FLayoutForest (translate dx dy f) (translate dx dy b)