Safe Haskell | None |
---|
- data Tile
- type Program = State St
- runProgram :: Program a -> (a, [(Int, Int, Int)], Map Int Tile)
- execProgram :: Program () -> ([(Int, Int, Int)], Map Int Tile)
- simulate :: Int -> Int -> [(Int, Int, Int)] -> [(Int, Int)] -> Map Int Tile -> IO (Int, Int, Int, Int, Map Position Int)
- seed :: Int -> Int -> Program ()
- movex :: Int -> Program ()
- movey :: Int -> Program ()
- discreteVect :: Int -> Int -> Program ()
- repete :: Int -> Program () -> Program ()
- pump :: Program () -> Program ()
- newtype Cur = Cur Int
- currentTile :: Program Cur
- nextTile :: Cur -> Program Cur
- prevTile :: Cur -> Program Cur
- data Dir
- bind :: Dir -> Cur -> Program ()
- rewindBy :: Int -> Program ()
- rewindTo :: Cur -> Program ()
- eraseAfter :: Cur -> Program ()
- type Color = (Double, Double, Double)
- setColor :: Color -> Program ()
- red :: Color
- green :: Color
- blue :: Color
- black :: Color
- plot :: FilePath -> PlotOptions -> Map Int Tile -> Map Position Int -> IO ()
- data PlotOptions = Plot {}
- defaultPlot :: PlotOptions
- traceTile :: MonadState St m => Cur -> m ()
- tikzPlot :: FilePath -> PlotOptions -> Map Int Tile -> Map Position Int -> IO ()
Documentation
runProgram :: Program a -> (a, [(Int, Int, Int)], Map Int Tile)Source
Run the program, returning its return value, along with the produced tileset.
execProgram :: Program () -> ([(Int, Int, Int)], Map Int Tile)Source
Run the program, returning the produced tileset.
simulate :: Int -> Int -> [(Int, Int, Int)] -> [(Int, Int)] -> Map Int Tile -> IO (Int, Int, Int, Int, Map Position Int)Source
simulate file margin w h showGlues seeds tiles
simulates the given
tileset, with seeds at the given positions (x,y,type)
, and
returns the maximal manhattan distance reached. The showGlues
argument indicates whether glues should be written in the output
file (results in bigger files).
Initialization
seed :: Int -> Int -> Program ()Source
Adds a new seed to the program, at the given position. There may be several seeds, and they will all be placed before anything else is grown.
Basic moves
discreteVect :: Int -> Int -> Program ()Source
Approximates a discrete vector, by walking as close as possible to the corresponding straight line.
Combinators
repete :: Int -> Program () -> Program ()Source
Repeat a program a given number of times. If the original program
produces n
tile types, then repeating it t
times produces mt
tile types.
pump :: Program () -> Program ()Source
Pump a given program, that is, allowing its first tile to attach to its last tile. It is up to the user to check that this is possible; the assembly is likely to stop else.
Rembering specific tile types - equivalents to formal let.
currentTile :: Program CurSource
Get the last tile placed (raises error if no tile has been placed).
nextTile :: Cur -> Program CurSource
Get the tile immediately following a given tile in program order.
prevTile :: Cur -> Program CurSource
Get the tile immediately following a given tile in program order.
Editing and branching - equivalents to the formal bind and from.
bind :: Dir -> Cur -> Program ()Source
Binds the given tile to the given side of the current tile. This function modifies the given tile if and only if the complementary side was not used. This modification can result in unwanted assemblies.
eraseAfter :: Cur -> Program ()Source
Delete every tile produced after the given tile. Mostly useful in
combination with currentTile
.
Coloring tiles - tile decorations
Debugging and output
data PlotOptions Source
traceTile :: MonadState St m => Cur -> m ()Source