add functionality for machines

Element.hs

@@ -0,0 +1,24 @@
+module Element where
+
+data Element = Element { value :: Integer
+                       , xPos  :: Int
+                       , yPos  :: Int
+                       } deriving (Eq, Show)
+
+decVal :: Element -> Element
+decVal e = Element (value e - 1) (xPos e) (yPos e)
+
+incVal :: Element -> Element
+incVal e = Element (value e + 1) (xPos e) (yPos e)
+
+incXPos :: Element -> Element
+incXPos e = Element (value e) (xPos e + 1) (yPos e)
+
+decXPos :: Element -> Element
+decXPos e = Element (value e) (xPos e - 1) (yPos e)
+
+incYPos :: Element -> Element
+incYPos e = Element (value e) (xPos e) (yPos e + 1)
+
+decYPos :: Element -> Element
+decYPos e = Element (value e) (xPos e) (yPos e - 1)

Main.hs

@@ -1,49 +1,80 @@
 module Main where
 
--- TODO: ncurses-representation (probably not ncurses (pls))
---       more functions
---       proper drawing
+-- TODO:
+--   arithmetic
+--   I/O
 
 import Data.List
+import Element
 
 main :: IO ()
 main = do
   input <- readFile "test.fac"
   let internalFactory = stringsToFactory $ lines input
-  interpretLoop internalFactory [Element
-                                 0
-                                 (1 + (fst $ entryPointLocation internalFactory))
-                                 (snd $ entryPointLocation internalFactory)]
-
-indexFactory :: Factory -> [(Int, [(Int, Tile)])]
-indexFactory tiles = indexed
-  where indexed = zip [0..] $ indexTiles tiles
-        indexTiles [] = []
-        indexTiles (a:as) = (zip [0..] a) : (indexTiles as)
+  interpretLoop internalFactory [ Element
+                                  0
+                                  (1 + fst (entryPointLocation internalFactory))
+                                  (snd $ entryPointLocation internalFactory)]
+                                -- , Element
+                                --   1
+                                --   (2 + (fst $ entryPointLocation internalFactory))
+                                --   (snd $ entryPointLocation internalFactory)]
 
 interpretLoop :: Factory -> [Element] -> IO ()
 interpretLoop f es = do
   let elements = stepInterpret f es
-  printFactory f
+  printFactory f elements
   a <- getChar
-  if a == 'q' then return () else interpretLoop f es
+  if a == 'q' then return () else interpretLoop f elements
 
-printFactory :: Factory -> IO ()
-printFactory f = mapM_ (print . show) f
 
+-- printing factory state with elements overlayed
+replaceNth :: Int -> a -> [a] -> [a]
+replaceNth _ _ []           = []
+replaceNth 0 a (first:rest) = a : rest
+replaceNth n a (first:rest) = first : replaceNth (n-1) a rest
+
+changeLine :: Element -> (Int, [Char]) -> (Int, [Char])
+changeLine e (index, line)
+  | yPos e == index = (index, replaceNth (xPos e) (head $ show $ value e) line)
+  | otherwise       = (index, line)
+
+changeTiles :: Element -> [(Int, [Char])] -> [(Int, [Char])]
+changeTiles e []     = []
+changeTiles e cs = map (changeLine e) cs
+
+putElements :: [Element] -> [(Int, [Char])] -> [(Int, [Char])]
+putElements [e] cs = changeTiles e cs
+putElements (e:es) cs = changeTiles e (putElements es cs)
+
+indexFactory :: Factory -> [(Int, [Tile])]
+indexFactory tiles = indexed
+  where indexed = zip [0..] tiles
+
+indexCharFactory :: Factory -> [(Int, [Char])]
+indexCharFactory f = zip [0..] charFactory
+  where charFactory = showFactory f
+
+showFactory :: Factory -> [[Char]]
+showFactory [] = []
+showFactory f  = map (map (head . show)) f
+
+printFactory :: Factory -> [Element] -> IO ()
+printFactory f es = mapM_ (print . snd) lines
+  where lines = putElements es $ indexCharFactory f
 
 type Entrypoint = Char
 
 data Direction = North | South | East | West
   deriving (Eq, Ord)
 
-data Element = Element { value :: Integer
-                       , xPos  :: Int
-                       , yPos  :: Int
-                       } deriving (Eq, Show)
+data ModifierKind = Increment | Decrement
+  deriving (Eq)
 
 data Tile = Entrypoint
           | Track Direction
+          | Modifier ModifierKind
+          | Machine Char -- user defined machines
           | Ignored
   deriving (Eq)
 
@@ -59,20 +90,24 @@ charToTile c = case c of
   '<' -> Track West
   'v' -> Track South
   '^' -> Track North
+  '+' -> Modifier Increment
+  '-' -> Modifier Decrement
   _   -> Ignored
 
 tileToChar :: Tile -> Char
 tileToChar t = case t of
-  Entrypoint  -> 'E'
-  Track East  -> '>'
-  Track West  -> '<'
-  Track South -> 'v'
-  Track North -> '^'
-  _           -> ' '
+  Entrypoint         -> 'E'
+  Track East         -> '>'
+  Track West         -> '<'
+  Track South        -> 'v'
+  Track North        -> '^'
+  Modifier Increment -> '+'
+  Modifier Decrement -> '-'
+  _                  -> ' '
 
 stringsToFactory :: [[Char]] -> [[Tile]]
-stringsToFactory []       = []
-stringsToFactory (s:rest) = map charToTile s : stringsToFactory rest
+stringsToFactory [] = []
+stringsToFactory s  = map (map charToTile) s
 
 tupAdd :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
 tupAdd (a, b) (c, d) = (a + c, b + d)
@@ -89,21 +124,31 @@ oobCheck f e = yPos e >= length f
                || xPos e >= length (f !! yPos e)
 
 -- custom hashmap thingy, but uses lists so it's slow on large things (luckily this is small)
-tileActionMap :: Tile -> [(Tile, (Element -> Element))] -> (Element -> Element)
+tileActionMap :: Tile -> [(Tile, Element -> Element)] -> (Element -> Element)
 tileActionMap _ [] = id
 tileActionMap tile (pair:rest)
   | tile == fst pair = snd pair
   | otherwise        = tileActionMap tile rest
 
+-- TODO: make this safe, aka boundary check
+spitOut :: Factory -> Element -> Element
+spitOut f elem
+  | (f !! yPos elem) !! (xPos elem + 1) == Track East  = incXPos elem
+  | (f !! (yPos elem + 1)) !! xPos elem == Track South = incYPos elem
+  | (f !! yPos elem) !! (xPos elem - 1) == Track West  = decXPos elem
+  | (f !! (yPos elem - 1)) !! xPos elem == Track North = decYPos elem
+
 update :: Factory -> Element -> Element
 update f e = if oobCheck f e then error "Element out of bounds check failed!"
-  else (tileActionMap t tileActions) e
+  else tileActionMap t tileActions e
   where t = (f !! yPos e) !! xPos e
-        tileActions = [ (Track East,  (\e -> Element (value e) (xPos e + 1) (yPos e)))
-                      , (Track West,  (\e -> Element (value e) (xPos e - 1) (yPos e)))
-                      , (Track South, (\e -> Element (value e) (xPos e) (yPos e + 1)))
-                      , (Track South, (\e -> Element (value e) (xPos e) (yPos e - 1)))
+        tileActions = [ (Track East,  \e -> Element (value e) (xPos e + 1) (yPos e))
+                      , (Track West,  \e -> Element (value e) (xPos e - 1) (yPos e))
+                      , (Track South, \e -> Element (value e) (xPos e) (yPos e + 1))
+                      , (Track North, \e -> Element (value e) (xPos e) (yPos e - 1))
+                      , (Modifier Increment, incVal . spitOut f)
+                      , (Modifier Decrement, decVal . spitOut f)
                       ]
 
 stepInterpret :: Factory -> [Element] -> [Element]
-stepInterpret f es = stepInterpret f (map (update f) es)
+stepInterpret f = map (update f)

test.fac

@@ -1,5 +1,8 @@
-foo
-
-   E>>>>>
-b
- f:
+E>>>v  |
+  ^ v  |
+  ^ v  |
+  ^ +  |
+  ^ v  |
+  ^ v  |
+  ^ v  |
+  ^<<  |