forked from tA/cellularAutomata
working 2d animation, but leaks memory
This commit is contained in:
parent
b45de145fe
commit
d582c20af3
@ -18,6 +18,8 @@ build-type: Simple
|
||||
|
||||
executable cellularAutomata
|
||||
main-is: Main.hs
|
||||
ghc-options: -threaded
|
||||
-O2
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.13 && <4.14
|
||||
@ -25,6 +27,12 @@ executable cellularAutomata
|
||||
, turtle
|
||||
, brick
|
||||
, process
|
||||
, containers
|
||||
, linear
|
||||
, microlens
|
||||
, microlens-th
|
||||
, vty
|
||||
, deepseq
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
extra-libraries: ncurses
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{ mkDerivation, base, brick, lib, ncurses, process, random, turtle
|
||||
{ mkDerivation, base, brick, containers, deepseq, lib, linear
|
||||
, microlens, microlens-th, ncurses, process, random, turtle, vty
|
||||
}:
|
||||
mkDerivation {
|
||||
pname = "cellularAutomata";
|
||||
@ -6,7 +7,10 @@ mkDerivation {
|
||||
src = ./..;
|
||||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
executableHaskellDepends = [ base brick process random turtle ];
|
||||
executableHaskellDepends = [
|
||||
base brick containers deepseq linear microlens microlens-th process
|
||||
random turtle vty
|
||||
];
|
||||
executableSystemDepends = [ ncurses ];
|
||||
license = "unknown";
|
||||
hydraPlatforms = lib.platforms.none;
|
||||
|
||||
89
src/Automata.hs
Normal file
89
src/Automata.hs
Normal file
@ -0,0 +1,89 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Automata where
|
||||
|
||||
import Comonad
|
||||
import Spaces
|
||||
import System.Random
|
||||
import GHC.Generics
|
||||
import Control.DeepSeq
|
||||
|
||||
-----------------------
|
||||
-- cellular automata --
|
||||
-----------------------
|
||||
|
||||
-- the states our cells can be in
|
||||
-- may need to provide an ordering
|
||||
-- may need to generalise the number
|
||||
-- of states
|
||||
data CellState = Rock | Paper | Scissors
|
||||
deriving (Eq, Bounded, Enum, Generic)
|
||||
|
||||
instance NFData CellState
|
||||
|
||||
instance Random CellState where
|
||||
random g = case randomR (fromEnum (minBound :: CellState), fromEnum (maxBound :: CellState)) g of
|
||||
(r, g') -> (toEnum r, g')
|
||||
randomR (a,b) g = case randomR (fromEnum a, fromEnum b) g of
|
||||
(r, g') -> (toEnum r, g')
|
||||
|
||||
-- how the states are displayed on screen
|
||||
-- this should probably be input to a function
|
||||
-- rather than hardcoded
|
||||
instance Show CellState
|
||||
where
|
||||
show Rock = "⬤"
|
||||
show Paper = " "
|
||||
show Scissors = "_"
|
||||
|
||||
-- -- a rule stating how a cell is determined
|
||||
-- rule :: Space CellState -> CellState
|
||||
-- rule (Space (l:_) _ (r:_))
|
||||
-- | l == r = Dead
|
||||
-- | otherwise = Alive
|
||||
--
|
||||
-- -- a second rule for example
|
||||
-- rule2 :: Space CellState -> CellState
|
||||
-- rule2 (Space (l1:l2:_) m (r1:r2:_))
|
||||
-- | m == Alive && numAlive == 1 = Dead
|
||||
-- | m == Alive && numAlive == 4 = Dead
|
||||
-- | m == Dead && numAlive == 3 = Alive
|
||||
-- | otherwise = m
|
||||
-- where
|
||||
-- ns = [l1, l2, r1, r2]
|
||||
-- numAlive = length $ filter (== Alive) ns
|
||||
--
|
||||
-- rule3 :: Space CellState -> CellState
|
||||
-- rule3 (Space (l:_) m (r:_))
|
||||
-- | l == r = m
|
||||
-- | otherwise = if m == Alive then Dead else Alive
|
||||
|
||||
--------------
|
||||
-- 2d rules --
|
||||
--------------
|
||||
|
||||
rps :: Space2 CellState -> CellState
|
||||
rps (Space2 u m d)
|
||||
= case me of
|
||||
Rock -> if (length $ filter (== Paper) ns) > 2 then Paper else Rock
|
||||
Paper -> if (length $ filter (== Scissors) ns) > 2 then Scissors else Paper
|
||||
Scissors -> if (length $ filter (== Rock) ns) > 2 then Rock else Scissors
|
||||
where
|
||||
f b (Space (l:_) m (r:_)) = [l,r] ++ (if b then [m] else [])
|
||||
f b (Space [] m (r:_)) = [r] ++ (if b then [m] else [])
|
||||
f b (Space (l:_) m []) = [l] ++ (if b then [m] else [])
|
||||
f b (Space [] m []) = if b then [m] else []
|
||||
safeHead _ [] = []
|
||||
safeHead b (x:_) = f b x
|
||||
ns = concat [ (safeHead True u), (f False m), (safeHead True d) ]
|
||||
me = extract m
|
||||
|
||||
--conway :: Space2 CellState -> CellState
|
||||
--conway (Space2 (u:_) m (d:_))
|
||||
-- = case me of
|
||||
-- Alive -> if (length ns) == 2 || (length ns == 3) then Alive else Dead
|
||||
-- Dead -> if (length ns) == 3 then Alive else Dead
|
||||
-- where
|
||||
-- f b (Space (l:_) m (r:_)) = [l,r] ++ (if b then [m] else [])
|
||||
-- ns = filter (== Alive) $ concat [ (f True u), (f False m), (f True d) ]
|
||||
-- me = extract m
|
||||
12
src/Comonad.hs
Normal file
12
src/Comonad.hs
Normal file
@ -0,0 +1,12 @@
|
||||
module Comonad where
|
||||
|
||||
-------------------
|
||||
-- comonad class --
|
||||
-------------------
|
||||
|
||||
class Functor w => Comonad w
|
||||
where
|
||||
(=>>) :: w a -> (w a -> b) -> w b
|
||||
extract :: w a -> a
|
||||
duplicate :: w a -> w (w a)
|
||||
x =>> f = fmap f (duplicate x)
|
||||
284
src/Main.hs
284
src/Main.hs
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Monad
|
||||
@ -6,122 +8,45 @@ import System.Random
|
||||
import System.Console.GetOpt
|
||||
import System.Environment(getArgs, getProgName)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Comonad
|
||||
import Spaces
|
||||
import Automata
|
||||
import Brick
|
||||
import Brick.BChan (newBChan, writeBChan)
|
||||
import qualified Brick.Widgets.Border as B
|
||||
import qualified Brick.Widgets.Border.Style as BS
|
||||
import qualified Brick.Widgets.Center as C
|
||||
import qualified Graphics.Vty as V
|
||||
import Control.Applicative
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Concurrent
|
||||
import Control.DeepSeq
|
||||
|
||||
-------------------
|
||||
-- comonad class --
|
||||
-------------------
|
||||
-----------------
|
||||
-- brick stuff --
|
||||
-----------------
|
||||
|
||||
class Functor w => Comonad w
|
||||
where
|
||||
(=>>) :: w a -> (w a -> b) -> w b
|
||||
extract :: w a -> a
|
||||
duplicate :: w a -> w (w a)
|
||||
x =>> f = fmap f (duplicate x)
|
||||
data Tick = Tick
|
||||
type Name = ()
|
||||
|
||||
------------
|
||||
-- spaces --
|
||||
------------
|
||||
-- App definition
|
||||
|
||||
-- a locally focussed space
|
||||
data Space t = Space [t] t [t]
|
||||
app :: Int -> Int -> App (Space2 CellState) Tick Name
|
||||
app h w = App { appDraw = drawUI h w
|
||||
, appChooseCursor = neverShowCursor
|
||||
, appHandleEvent = handleEvent
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const theMap
|
||||
}
|
||||
|
||||
-- spaces are also functors
|
||||
instance Functor Space where
|
||||
fmap f (Space l c r) = Space (map f l) (f c) (map f r)
|
||||
-- Handling events
|
||||
|
||||
-- our space is a comonad
|
||||
instance Comonad Space where
|
||||
-- duplicate will create a new space where
|
||||
-- the focussed element is our original space
|
||||
-- and each side is increasingly shifted copies
|
||||
-- in that direction
|
||||
duplicate w =
|
||||
Space (tail $ iterate left w)
|
||||
w
|
||||
(tail $ iterate right w)
|
||||
-- extract simply returns the focussed element
|
||||
extract (Space _ c _) = c
|
||||
|
||||
-- functions for moving the point
|
||||
-- of locality.
|
||||
-- todo: question the empty list cases
|
||||
-- most spaces should be infinite
|
||||
right :: Space t -> Space t
|
||||
right s@(Space l c []) = s
|
||||
right (Space l c (r:rs)) = Space (c:l) r rs
|
||||
|
||||
left :: Space t -> Space t
|
||||
left s@(Space [] c r) = s
|
||||
left (Space (l:ls) c r) = Space ls l (c:r)
|
||||
|
||||
-- bound will take an infinite space
|
||||
-- and bound it by i and j on each side
|
||||
-- (not including the focus) and
|
||||
-- turn it into a list for printing
|
||||
bound :: Int -> Int -> Space t -> [t]
|
||||
bound i j (Space l c r) = (reverse (take i l)) ++ (c:(take j r))
|
||||
|
||||
-- boundw works as above, but the
|
||||
-- entire list will be the size
|
||||
-- given
|
||||
boundw :: Int -> Space t -> [t]
|
||||
boundw n = bound (x-m) x
|
||||
where
|
||||
o = if odd n then 1 else 0
|
||||
m = if even n then 1 else 0
|
||||
x = (n - o) `div` 2
|
||||
|
||||
-----------------------
|
||||
-- cellular automata --
|
||||
-----------------------
|
||||
|
||||
-- the states our cells can be in
|
||||
-- may need to provide an ordering
|
||||
-- may need to generalise the number
|
||||
-- of states
|
||||
data CellState = Alive | Dead
|
||||
deriving (Eq, Bounded, Enum)
|
||||
|
||||
instance Random CellState where
|
||||
random g = case randomR (fromEnum (minBound :: CellState), fromEnum (maxBound :: CellState)) g of
|
||||
(r, g') -> (toEnum r, g')
|
||||
randomR (a,b) g = case randomR (fromEnum a, fromEnum b) g of
|
||||
(r, g') -> (toEnum r, g')
|
||||
|
||||
-- how the states are displayed on screen
|
||||
-- this should probably be input to a function
|
||||
-- rather than hardcoded
|
||||
instance Show CellState
|
||||
where
|
||||
show Alive = "█"
|
||||
show Dead = " "
|
||||
|
||||
-- a rule stating how a cell is determined
|
||||
rule :: Space CellState -> CellState
|
||||
rule (Space (l:_) _ (r:_))
|
||||
| l == r = Dead
|
||||
| otherwise = Alive
|
||||
|
||||
-- a second rule for example
|
||||
rule2 :: Space CellState -> CellState
|
||||
rule2 (Space (l1:l2:_) m (r1:r2:_))
|
||||
| m == Alive && numAlive == 1 = Dead
|
||||
| m == Alive && numAlive == 4 = Dead
|
||||
| m == Dead && numAlive == 3 = Alive
|
||||
| otherwise = m
|
||||
where
|
||||
ns = [l1, l2, r1, r2]
|
||||
numAlive = length $ filter (== Alive) ns
|
||||
|
||||
rule3 :: Space CellState -> CellState
|
||||
rule3 (Space (l:_) m (r:_))
|
||||
| l == r = m
|
||||
| otherwise = if m == Alive then Dead else Alive
|
||||
|
||||
-- take a space and a rule and
|
||||
-- return the next space
|
||||
step :: Comonad w => (w t -> t) -> w t -> w t
|
||||
step f w = w =>> f
|
||||
theMap :: AttrMap
|
||||
theMap = attrMap V.defAttr
|
||||
[ (rockAttr, V.red `on` V.blue)
|
||||
, (scissorsAttr, V.green `on` V.red)
|
||||
, (paperAttr, V.blue `on` V.green)
|
||||
]
|
||||
|
||||
---------------
|
||||
-- rng stuff --
|
||||
@ -134,74 +59,6 @@ ilobs rng = b : (ilobs r)
|
||||
where
|
||||
(b,r) = random rng
|
||||
|
||||
-- this is kinda gross but if it works it works
|
||||
takeGive :: Int -> [a] -> ([a],[a])
|
||||
takeGive n as = ( (take n as), (drop n as) )
|
||||
|
||||
--------------------------
|
||||
-- 2d cellular automata --
|
||||
--------------------------
|
||||
|
||||
data Space2 t =
|
||||
Space2 [(Space t)]
|
||||
(Space t)
|
||||
[(Space t)]
|
||||
|
||||
instance Functor Space2 where
|
||||
fmap f (Space2 u m d) =
|
||||
Space2 (fmap (fmap f) u) (fmap f m) (fmap (fmap f) d)
|
||||
|
||||
instance Comonad Space2 where
|
||||
duplicate w =
|
||||
Space2 (tail $ iterate (f up2) dm)
|
||||
dm
|
||||
(tail $ iterate (f down2) dm)
|
||||
where
|
||||
f g (Space l m r) = Space (fmap g l) (g m) (fmap g r)
|
||||
dm = Space (tail $ iterate left2 w) w (tail $ iterate right2 w)
|
||||
extract (Space2 _ m _) = extract m
|
||||
|
||||
down2 :: Space2 t -> Space2 t
|
||||
down2 w@(Space2 u m []) = w
|
||||
down2 (Space2 u m (d:ds)) = Space2 (m:u) d ds
|
||||
|
||||
up2 :: Space2 t -> Space2 t
|
||||
up2 w@(Space2 [] m d) = w
|
||||
up2 (Space2 (u:us) m d) = Space2 us u (m:d)
|
||||
|
||||
left2 :: Space2 t -> Space2 t
|
||||
left2 (Space2 u m d) = Space2 (fmap left u) (left m) (fmap left d)
|
||||
|
||||
right2 :: Space2 t -> Space2 t
|
||||
right2 (Space2 u m d) = Space2 (fmap right u) (right m) (fmap right d)
|
||||
|
||||
bound2 :: Int -> Int -> Int -> Int -> Space2 t -> [[t]]
|
||||
bound2 u d l r (Space2 uw mw dw) = (reverse (take u (map (bound l r) uw))) ++ ((bound l r mw):(take d (map (bound l r) dw)))
|
||||
|
||||
bound2w :: Int -> Int -> Space2 t -> [[t]]
|
||||
bound2w x y = bound2 (r-q) r (n-m) n
|
||||
where
|
||||
o = if odd x then 1 else 0
|
||||
m = if even x then 1 else 0
|
||||
n = (x - o) `div` 2
|
||||
p = if odd y then 1 else 0
|
||||
q = if even y then 1 else 0
|
||||
r = (y - p) `div` 2
|
||||
|
||||
--------------
|
||||
-- 2d rules --
|
||||
--------------
|
||||
|
||||
conway :: Space2 CellState -> CellState
|
||||
conway (Space2 (u:_) m (d:_))
|
||||
= case me of
|
||||
Alive -> if (length ns) == 2 || (length ns == 3) then Alive else Dead
|
||||
Dead -> if (length ns) == 3 then Alive else Dead
|
||||
where
|
||||
f b (Space (l:_) m (r:_)) = [l,r] ++ (if b then [m] else [])
|
||||
ns = filter (== Alive) $ concat [ (f True u), (f False m), (f True d) ]
|
||||
me = extract m
|
||||
|
||||
-----------------
|
||||
-- gross io bs --
|
||||
-----------------
|
||||
@ -262,47 +119,50 @@ parseArgs = do
|
||||
header = "Usage: " ++ progName ++ " [OPTION...]"
|
||||
helpMessage = usageInfo header options
|
||||
|
||||
initGame :: IO (Space2 CellState)
|
||||
initGame = do
|
||||
rng <- getStdGen
|
||||
return $ createRandSpace2 rng
|
||||
|
||||
---------------
|
||||
-- main loop --
|
||||
---------------
|
||||
|
||||
createRandSpace :: StdGen -> Space CellState
|
||||
createRandSpace rng =
|
||||
Space (tail $ map snd $ iterate f (r1, Alive))
|
||||
(fst (random rng))
|
||||
(tail $ map snd $ iterate f (r2, Alive))
|
||||
where
|
||||
f (r,b) = let (nb,nr) = (random r) in (nr,nb)
|
||||
(r1,r2) = split rng
|
||||
|
||||
createRandSpace2 :: StdGen -> Space2 CellState
|
||||
createRandSpace2 rng =
|
||||
Space2 (tail $ map snd $ iterate f (r1, (createRandSpace r1)))
|
||||
(createRandSpace rng)
|
||||
(tail $ map snd $ iterate f (r2, (createRandSpace r2)))
|
||||
where
|
||||
f (r,s) = let (nr1,nr2) = split r in (nr2, (createRandSpace nr1))
|
||||
(r1,r2) = split rng
|
||||
|
||||
-- simply print the current space, then recurse to the next
|
||||
--runAutomata :: Space2 CellState -> Int -> Int -> IO ()
|
||||
--runAutomata s 0 w = putStrLn $ concat $ map show $ boundw w s
|
||||
--runAutomata s n w = do
|
||||
-- mapM_ putStrLn $ map show $ concat $ bound2w w s
|
||||
-- runAutomata (step conway s) (n - 1) w
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
options <- parseArgs
|
||||
rng <- getStdGen
|
||||
let cs = map (\x -> if x then Alive else Dead) $ ilobs rng
|
||||
let w = (optWidth options)
|
||||
let h = (optHeight options)
|
||||
let g = (optGenerations options)
|
||||
let s = createRandSpace2 rng
|
||||
mapM_ (f w h) (loop conway g s)
|
||||
chan <- newBChan 1
|
||||
forkIO $ forever $ do
|
||||
writeBChan chan Tick
|
||||
threadDelay 100000
|
||||
g <- initGame
|
||||
let buildVty = V.mkVty V.defaultConfig
|
||||
initialVty <- buildVty
|
||||
void $ customMain initialVty buildVty (Just chan) (app h w) (clamp2cw w h g)
|
||||
|
||||
handleEvent :: (Space2 CellState) -> BrickEvent Name Tick -> EventM Name (Next (Space2 CellState))
|
||||
handleEvent g (AppEvent Tick) = continue $ step rps g
|
||||
handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g
|
||||
handleEvent g _ = continue g
|
||||
|
||||
drawUI :: Int -> Int -> Space2 CellState -> [Widget Name]
|
||||
drawUI h w g = [ C.center $ drawGrid h w g ]
|
||||
|
||||
drawGrid :: Int -> Int -> Space2 CellState -> Widget Name
|
||||
drawGrid h w g = vBox rows
|
||||
where
|
||||
f w h s = do
|
||||
mapM_ putStrLn $ map (concat . (map show)) $ bound2w w h s
|
||||
putStrLn (take w (repeat '-'))
|
||||
loop f n s = take n $ iterate (step f) s
|
||||
bw = bound2cw w h g
|
||||
rows = [ hBox $ cellsInRow r | r <- bw ]
|
||||
cellsInRow y = map drawCell y
|
||||
|
||||
drawCell :: CellState -> Widget Name
|
||||
drawCell Paper = withAttr paperAttr $ str " "
|
||||
drawCell Scissors = withAttr scissorsAttr $ str " "
|
||||
drawCell Rock = withAttr rockAttr $ str " "
|
||||
|
||||
rockAttr, scissorsAttr, paperAttr :: AttrName
|
||||
rockAttr = "rockAttr"
|
||||
paperAttr = "paperAttr"
|
||||
scissorsAttr = "scissorsAttr"
|
||||
|
||||
176
src/Spaces.hs
Normal file
176
src/Spaces.hs
Normal file
@ -0,0 +1,176 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Spaces where
|
||||
|
||||
import Comonad
|
||||
import System.Random
|
||||
import Control.DeepSeq
|
||||
import GHC.Generics
|
||||
|
||||
------------
|
||||
-- spaces --
|
||||
------------
|
||||
|
||||
-- a locally focussed space
|
||||
data Space t = Space [t] t [t]
|
||||
deriving (Generic, Generic1)
|
||||
|
||||
instance NFData a => NFData (Space a)
|
||||
instance NFData1 Space
|
||||
|
||||
-- spaces are also functors
|
||||
instance Functor Space where
|
||||
fmap f (Space l c r) = Space (map f l) (f c) (map f r)
|
||||
|
||||
-- our space is a comonad
|
||||
instance Comonad Space where
|
||||
-- duplicate will create a new space where
|
||||
-- the focussed element is our original space
|
||||
-- and each side is increasingly shifted copies
|
||||
-- in that direction
|
||||
duplicate w =
|
||||
Space (tail $ iterate left w)
|
||||
w
|
||||
(tail $ iterate right w)
|
||||
-- extract simply returns the focussed element
|
||||
extract (Space _ c _) = c
|
||||
|
||||
-- functions for moving the point
|
||||
-- of locality.
|
||||
-- todo: question the empty list cases
|
||||
-- most spaces should be infinite
|
||||
right :: Space t -> Space t
|
||||
right w@(Space l m []) = w
|
||||
right (Space l c (r:rs)) = Space (c:l) r rs
|
||||
|
||||
left :: Space t -> Space t
|
||||
left w@(Space [] m r) = w
|
||||
left (Space (l:ls) c r) = Space ls l (c:r)
|
||||
|
||||
-- bound will take an infinite space
|
||||
-- and bound it by i and j on each side
|
||||
-- (not including the focus) and
|
||||
-- turn it into a list for printing
|
||||
bound :: Int -> Int -> Space t -> [t]
|
||||
bound i j (Space l c r) = (reverse (take i l)) ++ (c:(take j r))
|
||||
|
||||
-- boundw works as above, but the
|
||||
-- entire list will be the size
|
||||
-- given
|
||||
boundw :: Int -> Space t -> [t]
|
||||
boundw n = bound (x-m) x
|
||||
where
|
||||
o = if odd n then 1 else 0
|
||||
m = if even n then 1 else 0
|
||||
x = (n - o) `div` 2
|
||||
|
||||
---------------
|
||||
-- 2d spaces --
|
||||
---------------
|
||||
|
||||
data Space2 t =
|
||||
Space2 [(Space t)]
|
||||
(Space t)
|
||||
[(Space t)]
|
||||
deriving (Generic, Generic1)
|
||||
|
||||
instance NFData a => NFData (Space2 a)
|
||||
instance NFData1 Space2
|
||||
|
||||
instance Functor Space2 where
|
||||
fmap f (Space2 u m d) =
|
||||
Space2 (fmap (fmap f) u) (fmap f m) (fmap (fmap f) d)
|
||||
|
||||
instance Comonad Space2 where
|
||||
duplicate w =
|
||||
Space2 (tail $ iterate (f up2) dm)
|
||||
dm
|
||||
(tail $ iterate (f down2) dm)
|
||||
where
|
||||
f g (Space l m r) = Space (fmap g l) (g m) (fmap g r)
|
||||
dm = Space (tail $ iterate left2 w) w (tail $ iterate right2 w)
|
||||
extract (Space2 _ m _) = extract m
|
||||
|
||||
down2 :: Space2 t -> Space2 t
|
||||
down2 w@(Space2 u m []) = w
|
||||
down2 (Space2 u m (d:ds)) = Space2 (m:u) d ds
|
||||
|
||||
up2 :: Space2 t -> Space2 t
|
||||
up2 w@(Space2 [] m d) = w
|
||||
up2 (Space2 (u:us) m d) = Space2 us u (m:d)
|
||||
|
||||
left2 :: Space2 t -> Space2 t
|
||||
left2 (Space2 u m d) = Space2 (fmap left u) (left m) (fmap left d)
|
||||
|
||||
right2 :: Space2 t -> Space2 t
|
||||
right2 (Space2 u m d) = Space2 (fmap right u) (right m) (fmap right d)
|
||||
|
||||
bound2 :: Int -> Int -> Int -> Int -> Space2 t -> [[t]]
|
||||
bound2 u d l r (Space2 uw mw dw) = (reverse (take u (map (bound l r) uw))) ++ ((bound l r mw):(take d (map (bound l r) dw)))
|
||||
|
||||
bound2w :: Int -> Int -> Space2 t -> [[t]]
|
||||
bound2w x y = bound2 (r-q) r (n-m) n
|
||||
where
|
||||
o = if odd x then 1 else 0
|
||||
m = if even x then 1 else 0
|
||||
n = (x - o) `div` 2
|
||||
p = if odd y then 1 else 0
|
||||
q = if even y then 1 else 0
|
||||
r = (y - p) `div` 2
|
||||
|
||||
bound2cw :: NFData t => Int -> Int -> Space2 t -> [[t]]
|
||||
bound2cw x y w = bound2 (r-q) r (n-m) n $ clamp2 (r-q+1) (r+1) (n-m+1) (n+1) w
|
||||
where
|
||||
o = if odd x then 1 else 0
|
||||
m = if even x then 1 else 0
|
||||
n = (x - o) `div` 2
|
||||
p = if odd y then 1 else 0
|
||||
q = if even y then 1 else 0
|
||||
r = (y - p) `div` 2
|
||||
|
||||
clamp2cw :: NFData t => Int -> Int -> Space2 t -> Space2 t
|
||||
clamp2cw x y w = clamp2 (r-q+1) (r+1) (n-m+1) (n+1) w
|
||||
where
|
||||
o = if odd x then 1 else 0
|
||||
m = if even x then 1 else 0
|
||||
n = (x - o) `div` 2
|
||||
p = if odd y then 1 else 0
|
||||
q = if even y then 1 else 0
|
||||
r = (y - p) `div` 2
|
||||
|
||||
clamp2 :: NFData t => Int -> Int -> Int -> Int -> Space2 t -> Space2 t
|
||||
clamp2 u d l r (Space2 uw mw dw)
|
||||
= force $ Space2 (take u $ fmap (clamp l r) uw)
|
||||
(clamp l r mw)
|
||||
(take d $ fmap (clamp l r) dw)
|
||||
|
||||
clamp :: NFData t => Int -> Int -> Space t -> Space t
|
||||
clamp x y (Space l m r) = force $ Space (take x l) m (take y r)
|
||||
|
||||
-- take a space and a rule and
|
||||
-- return the next space
|
||||
step :: Comonad w => (w t -> t) -> w t -> w t
|
||||
step f w = w =>> f
|
||||
|
||||
-------------------
|
||||
-- Random Spaces --
|
||||
-------------------
|
||||
|
||||
createRandSpace :: Random a => StdGen -> Space a
|
||||
createRandSpace rng =
|
||||
Space (tail $ map snd $ iterate f (r1, (fst (random rng))))
|
||||
(fst (random rng))
|
||||
(tail $ map snd $ iterate f (r2, (fst (random rng))))
|
||||
where
|
||||
f (r,b) = let (nb,nr) = (random r) in (nr,nb)
|
||||
(r1,r2) = split rng
|
||||
|
||||
createRandSpace2 :: Random a => StdGen -> Space2 a
|
||||
createRandSpace2 rng =
|
||||
Space2 (tail $ map snd $ iterate f (r1, (createRandSpace r1)))
|
||||
(createRandSpace rng)
|
||||
(tail $ map snd $ iterate f (r2, (createRandSpace r2)))
|
||||
where
|
||||
f (r,s) = let (nr1,nr2) = split r in (nr2, (createRandSpace nr1))
|
||||
(r1,r2) = split rng
|
||||
Loading…
Reference in New Issue
Block a user