add functionality for machines
This commit is contained in:
parent
87bcb22af1
commit
b194e980fe
|
@ -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)
|
117
Main.hs
117
Main.hs
|
@ -1,49 +1,80 @@
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
-- TODO: ncurses-representation (probably not ncurses (pls))
|
-- TODO:
|
||||||
-- more functions
|
-- arithmetic
|
||||||
-- proper drawing
|
-- I/O
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Element
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
input <- readFile "test.fac"
|
input <- readFile "test.fac"
|
||||||
let internalFactory = stringsToFactory $ lines input
|
let internalFactory = stringsToFactory $ lines input
|
||||||
interpretLoop internalFactory [Element
|
interpretLoop internalFactory [ Element
|
||||||
0
|
0
|
||||||
(1 + (fst $ entryPointLocation internalFactory))
|
(1 + fst (entryPointLocation internalFactory))
|
||||||
(snd $ entryPointLocation internalFactory)]
|
(snd $ entryPointLocation internalFactory)]
|
||||||
|
-- , Element
|
||||||
indexFactory :: Factory -> [(Int, [(Int, Tile)])]
|
-- 1
|
||||||
indexFactory tiles = indexed
|
-- (2 + (fst $ entryPointLocation internalFactory))
|
||||||
where indexed = zip [0..] $ indexTiles tiles
|
-- (snd $ entryPointLocation internalFactory)]
|
||||||
indexTiles [] = []
|
|
||||||
indexTiles (a:as) = (zip [0..] a) : (indexTiles as)
|
|
||||||
|
|
||||||
interpretLoop :: Factory -> [Element] -> IO ()
|
interpretLoop :: Factory -> [Element] -> IO ()
|
||||||
interpretLoop f es = do
|
interpretLoop f es = do
|
||||||
let elements = stepInterpret f es
|
let elements = stepInterpret f es
|
||||||
printFactory f
|
printFactory f elements
|
||||||
a <- getChar
|
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
|
type Entrypoint = Char
|
||||||
|
|
||||||
data Direction = North | South | East | West
|
data Direction = North | South | East | West
|
||||||
deriving (Eq, Ord)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
data Element = Element { value :: Integer
|
data ModifierKind = Increment | Decrement
|
||||||
, xPos :: Int
|
deriving (Eq)
|
||||||
, yPos :: Int
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
data Tile = Entrypoint
|
data Tile = Entrypoint
|
||||||
| Track Direction
|
| Track Direction
|
||||||
|
| Modifier ModifierKind
|
||||||
|
| Machine Char -- user defined machines
|
||||||
| Ignored
|
| Ignored
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
|
@ -59,20 +90,24 @@ charToTile c = case c of
|
||||||
'<' -> Track West
|
'<' -> Track West
|
||||||
'v' -> Track South
|
'v' -> Track South
|
||||||
'^' -> Track North
|
'^' -> Track North
|
||||||
|
'+' -> Modifier Increment
|
||||||
|
'-' -> Modifier Decrement
|
||||||
_ -> Ignored
|
_ -> Ignored
|
||||||
|
|
||||||
tileToChar :: Tile -> Char
|
tileToChar :: Tile -> Char
|
||||||
tileToChar t = case t of
|
tileToChar t = case t of
|
||||||
Entrypoint -> 'E'
|
Entrypoint -> 'E'
|
||||||
Track East -> '>'
|
Track East -> '>'
|
||||||
Track West -> '<'
|
Track West -> '<'
|
||||||
Track South -> 'v'
|
Track South -> 'v'
|
||||||
Track North -> '^'
|
Track North -> '^'
|
||||||
_ -> ' '
|
Modifier Increment -> '+'
|
||||||
|
Modifier Decrement -> '-'
|
||||||
|
_ -> ' '
|
||||||
|
|
||||||
stringsToFactory :: [[Char]] -> [[Tile]]
|
stringsToFactory :: [[Char]] -> [[Tile]]
|
||||||
stringsToFactory [] = []
|
stringsToFactory [] = []
|
||||||
stringsToFactory (s:rest) = map charToTile s : stringsToFactory rest
|
stringsToFactory s = map (map charToTile) s
|
||||||
|
|
||||||
tupAdd :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
|
tupAdd :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
|
||||||
tupAdd (a, b) (c, d) = (a + c, b + d)
|
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)
|
|| xPos e >= length (f !! yPos e)
|
||||||
|
|
||||||
-- custom hashmap thingy, but uses lists so it's slow on large things (luckily this is small)
|
-- 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 _ [] = id
|
||||||
tileActionMap tile (pair:rest)
|
tileActionMap tile (pair:rest)
|
||||||
| tile == fst pair = snd pair
|
| tile == fst pair = snd pair
|
||||||
| otherwise = tileActionMap tile rest
|
| 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 :: Factory -> Element -> Element
|
||||||
update f e = if oobCheck f e then error "Element out of bounds check failed!"
|
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
|
where t = (f !! yPos e) !! xPos e
|
||||||
tileActions = [ (Track East, (\e -> Element (value e) (xPos e + 1) (yPos 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 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))
|
||||||
, (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 :: Factory -> [Element] -> [Element]
|
||||||
stepInterpret f es = stepInterpret f (map (update f) es)
|
stepInterpret f = map (update f)
|
||||||
|
|
Loading…
Reference in New Issue