118 lines
4.3 KiB
Haskell
118 lines
4.3 KiB
Haskell
module Main where
|
|
|
|
import Data.List
|
|
import System.Environment
|
|
import System.Exit
|
|
|
|
import Element
|
|
import Types
|
|
import Dirty
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
if null args
|
|
then die "No filename provided."
|
|
else run $ head args
|
|
|
|
run :: String -> IO ()
|
|
run inputFile = do
|
|
input <- readFile inputFile
|
|
let internalFactory = stringsToFactory $ lines input
|
|
let el = entryPointLocation internalFactory
|
|
interpretLoop internalFactory [Element 0 (fst el) (snd el) True]
|
|
|
|
interpretLoop :: Factory -> [Element] -> IO ()
|
|
interpretLoop f es =
|
|
let getDeadElement (e:es)
|
|
| state e == False = e
|
|
| otherwise = getDeadElement es
|
|
in do
|
|
let elements = stepInterpret f es
|
|
if any (\e -> state e == False) es
|
|
then if 0 == (value $ getDeadElement es)
|
|
then exitWith ExitSuccess
|
|
else exitWith (ExitFailure $ mod (fromInteger $ value $ getDeadElement es) 256)
|
|
else printFactory f elements
|
|
a <- getChar
|
|
case a of
|
|
'q' -> return ()
|
|
_ -> interpretLoop f elements
|
|
|
|
stringsToFactory :: [[Char]] -> [[Tile]]
|
|
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)
|
|
|
|
entryPointLocation :: Factory -> (Int, Int)
|
|
entryPointLocation [] = error "Couldn't find an entrypoint (E)."
|
|
entryPointLocation (l:ls) = case index of
|
|
Nothing -> tupAdd (0, 1) (entryPointLocation ls)
|
|
Just x -> (x, 0)
|
|
where index = elemIndex Entrypoint l
|
|
|
|
oobCheck :: Factory -> Element -> Bool
|
|
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 _ [] = singleton
|
|
tileActionMap tile (pair:rest)
|
|
| tile == fst pair = snd pair
|
|
| otherwise = tileActionMap tile rest
|
|
|
|
spitOutBehaviour :: Direction -> (Element -> Element)
|
|
spitOutBehaviour dir = case dir of
|
|
East -> incXPos
|
|
South -> incYPos
|
|
West -> decXPos
|
|
North -> decYPos
|
|
|
|
spitOut :: Direction -> Factory -> Element -> Element
|
|
spitOut dir f elem = (correctFunction f (dir, succ dir, succ $ succ dir, succ $ succ $ succ dir) elem) elem
|
|
where correctFunction :: Factory -> (Direction, Direction, Direction, Direction) -> Element -> (Element -> Element)
|
|
correctFunction f (a, b, c, d) elem
|
|
| getTile a f elem == Just (Track a) = spitOutBehaviour a
|
|
| getTile b f elem == Just (Track b) = spitOutBehaviour b
|
|
| getTile c f elem == Just (Track c) = spitOutBehaviour c
|
|
| getTile d f elem == Just (Track d) = spitOutBehaviour d
|
|
|
|
spitOutNth :: Int -> Direction -> Factory -> Element -> Element
|
|
spitOutNth 0 dir f elem = spitOut dir f elem
|
|
spitOutNth n dir f elem = spitOutNth decremented (succ dir) f elem
|
|
where decremented
|
|
| (getTile dir f elem) == (Just $ Track dir) = n - 1
|
|
| otherwise = n
|
|
|
|
singleton :: a -> [a]
|
|
singleton a = [a]
|
|
|
|
update :: Factory -> Element -> [Element]
|
|
update f e = if oobCheck f e then error "Element out of bounds check failed!"
|
|
else tileActionMap t tileActions e
|
|
where t = (f !! yPos e) !! xPos e
|
|
tileActions = [ (Track East, singleton . incXPos)
|
|
, (Track West, singleton . decXPos)
|
|
, (Track South, singleton . incYPos)
|
|
, (Track North, singleton . decYPos)
|
|
, (Modifier Increment, singleton . incVal . spitOut East f)
|
|
, (Modifier Decrement, singleton . decVal . spitOut East f)
|
|
, (Special Duplicate, dupFunc)
|
|
, (Special Conditional, singleton . zeroBranch)
|
|
, (Entrypoint, singleton . spitOut East f)
|
|
, (Exitpoint, singleton . kill)
|
|
]
|
|
dupFunc :: Element -> [Element]
|
|
dupFunc elem = [ spitOutNth 0 East f elem
|
|
, spitOutNth 1 East f elem
|
|
]
|
|
zeroBranch elem = if value elem == 0
|
|
then spitOutNth 0 East f elem
|
|
else spitOutNth 1 East f elem
|
|
|
|
stepInterpret :: Factory -> [Element] -> [Element]
|
|
stepInterpret f = concatMap (update f)
|