module Wumpus.Drawing.Paths.Base.BuildCommon
(
BuildLog
, PathEnd(..)
, Vamp(..)
, extractTrace
, addInsert
, addPen
, insert1
, pen1
) where
import Wumpus.Drawing.Paths.Base.RelPath ( RelPath )
import Wumpus.Basic.Kernel
import Wumpus.Basic.Utils.HList
import Wumpus.Core
import Data.Monoid
data BuildLog a = Log { insert_trace :: H a
, pen_trace :: H a
}
| NoLog
data PathEnd = PATH_CLOSED | PATH_OPEN
deriving (Eq,Show)
data Vamp u = Vamp
{ vamp_move_span :: Vec2 u
, vamp_move_start :: Vec2 u
, vamp_dc_update :: DrawingContextF
, vamp_deco_path :: RelPath u
, vamp_path_end :: PathEnd
}
type instance DUnit (Vamp u) = u
instance Monoid (BuildLog a) where
mempty = NoLog
NoLog `mappend` b = b
a `mappend` NoLog = a
Log li lp `mappend` Log ri rp = Log (li `appendH` ri) (lp `appendH` rp)
extractTrace :: OPlus a => a -> BuildLog a -> (a,a)
extractTrace zero NoLog = (zero,zero)
extractTrace zero (Log ins pen) = (pent,inst)
where
pent = altconcat zero $ toListH $ pen
inst = altconcat zero $ toListH $ ins
addInsert :: a -> BuildLog a -> BuildLog a
addInsert a NoLog = Log { insert_trace = wrapH a, pen_trace = emptyH }
addInsert a s@(Log { insert_trace=i }) = s { insert_trace = i `snocH` a }
insert1 :: a -> BuildLog a
insert1 a = Log { insert_trace = wrapH a, pen_trace = emptyH }
addPen :: a -> BuildLog a -> BuildLog a
addPen a NoLog = Log { insert_trace = wrapH a, pen_trace = emptyH }
addPen a s@(Log { pen_trace=i }) = s { pen_trace = i `snocH` a }
pen1 :: a -> BuildLog a
pen1 a = Log { insert_trace = emptyH, pen_trace = wrapH a }