{-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Wumpus.Drawing.Chains.Base -- Copyright : (c) Stephen Tetley 2010-2011 -- License : BSD3 -- -- Maintainer : stephen.tetley@gmail.com -- Stability : unstable -- Portability : GHC -- -- Generate points in an iterated chain. -- -- \*\* WARNING \*\* - unstable. Names are not so good, also -- Wumpus-Basic has a @chain1@ operator... -- -------------------------------------------------------------------------------- module Wumpus.Drawing.Chains.Base ( Chain , LocChain , unchain , zipchain , zipchainWith , unchainTD , zipchainTD , zipchainWithTD ) where import Wumpus.Basic.Kernel -- package: wumpus-basic import Wumpus.Core -- package: wumpus-core -- | A 'Chain' is a list of points. The list is often expected to -- be inifinte, but if it was a Stream it would loose the ability -- to use list comprehensions. -- type Chain u = [Point2 u] -- | A LocChain is a function from a starting point to a 'Chain'. -- type LocChain u = Point2 u -> Chain u -- | Note - commonly a 'Chain' may be infinite, so it is only -- unrolled a finite number of times. -- unchain :: Int -> LocGraphic u -> Chain u -> TraceDrawing u () unchain i op chn = go i chn where go n _ | n <= 0 = return () go _ [] = return () go n (x:xs) = draw (op `at` x) >> go (n-1) xs zipchain :: [LocGraphic u] -> Chain u -> TraceDrawing u () zipchain (g:gs) (p:ps) = draw (g `at` p) >> zipchain gs ps zipchain _ _ = return () zipchainWith :: (a -> LocGraphic u) -> [a] -> Chain u -> TraceDrawing u () zipchainWith op xs chn = go xs chn where go (a:as) (p:ps) = draw (op a `at` p) >> go as ps go _ _ = return () -- | Variant of 'unchain' where the drawing argument is a -- @TraceDrawing@ not a @LocGraphic@. -- unchainTD :: Int -> (Point2 u -> TraceDrawing u ()) -> Chain u -> TraceDrawing u () unchainTD i op chn = go i chn where go n _ | n <= 0 = return () go _ [] = return () go n (x:xs) = (op x) >> go (n-1) xs zipchainTD :: [Point2 u -> TraceDrawing u ()] -> Chain u -> TraceDrawing u () zipchainTD (g:gs) (p:ps) = g p >> zipchainTD gs ps zipchainTD _ _ = return () zipchainWithTD :: (a -> Point2 u -> TraceDrawing u ()) -> [a] -> Chain u -> TraceDrawing u () zipchainWithTD op xs chn = go xs chn where go (a:as) (p:ps) = op a p >> go as ps go _ _ = return () -- Notes - something like TikZ\'s chains could possibly be -- achieved with a Reader monad (@local@ initially seems better -- for \"state change\" than @set@ as local models a stack). -- -- It\'s almost tempting to put point-supply directly in the -- Trace monad so that TikZ style chaining is transparent. -- (The argument against is: how compatible this would be with -- the Turtle monad for example?). --