dedbad960e
Only manually, but who cares, this is a fun enough game to play and doesn’t take very long
118 lines
3.3 KiB
Haskell
118 lines
3.3 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Main where
|
|
|
|
import Data.List.Split
|
|
import qualified Data.Map.Strict as M
|
|
import Helpers
|
|
import Intcode
|
|
import Linear.V2
|
|
import System.Console.ANSI
|
|
import System.IO
|
|
( BufferMode(NoBuffering)
|
|
, hReady
|
|
, hSetBuffering
|
|
, hSetEcho
|
|
, stdin
|
|
)
|
|
import Debug.Trace
|
|
import System.Random
|
|
|
|
type ScreenBuffer = M.Map (V2 Int) Integer
|
|
|
|
main :: IO ()
|
|
main = do
|
|
program <- readIntcode <$> readFile "input"
|
|
mode <- queryMode
|
|
let tm = defaultTM Nothing program
|
|
let run x = runGameloop $ pure (tm {state = AwaitInput}, M.empty, V2 0 20, 0, mode)
|
|
(_, buf, _, _, _) <- run 0
|
|
putStrLn "Done."
|
|
|
|
queryMode :: IO Bool
|
|
queryMode = do
|
|
putStrLn "Do you want to play the game yourself? [y/n]"
|
|
getLine >>= \case
|
|
"y" -> pure True
|
|
"n" -> pure False
|
|
_ -> do print "Illegal input."
|
|
queryMode
|
|
|
|
runGameloop ::
|
|
IO (TuringMachine, ScreenBuffer, V2 Int, Integer, Bool)
|
|
-> IO (TuringMachine, ScreenBuffer, V2 Int, Integer, Bool)
|
|
runGameloop io = do
|
|
(tm, buf, oldPos, maxStep, mode) <- io
|
|
case state tm of
|
|
AwaitInput -> do
|
|
nextCommand <-
|
|
if mode
|
|
then do
|
|
clearScreen
|
|
getInput
|
|
else getInputBot
|
|
let newPosTry = oldPos + case nextCommand of
|
|
1 -> V2 0 1
|
|
2 -> V2 0 (-1)
|
|
3 -> V2 1 0
|
|
4 -> V2 (-1) 0
|
|
let tmNew = execSteps tm{input = Just nextCommand}
|
|
let tmNewOut = head $ output tmNew
|
|
let newPos = case tmNewOut of
|
|
0 -> oldPos
|
|
_ -> newPosTry
|
|
let bufNew = if tmNewOut == 0 then M.insert newPosTry 0 buf else buf
|
|
let bufNew2 = if newPos /= oldPos then updatePath bufNew oldPos newPos else bufNew
|
|
if tmNewOut == 2 then print $ countSteps bufNew2 else return ()
|
|
print mode
|
|
let newMode = if tmNewOut == 2 then True else mode
|
|
let bufNew3 = if tmNewOut == 2 then M.filter (/=1) bufNew2 else bufNew2
|
|
let newMaxStep = max maxStep tmNewOut
|
|
putStrLn $ drawBoard (M.insert newPos 3 bufNew3)
|
|
print $ countSteps bufNew2
|
|
print newMaxStep
|
|
runGameloop $
|
|
pure (tmNew {input = Just nextCommand, output = []}, bufNew3, newPos, newMaxStep, newMode)
|
|
_ -> pure (tm, buf, oldPos, maxStep, mode)
|
|
|
|
updatePath :: ScreenBuffer -> V2 Int -> V2 Int -> ScreenBuffer
|
|
updatePath buf oldPos newPos = if M.member newPos buf then M.delete oldPos buf else M.insert newPos 1 buf
|
|
|
|
countSteps :: ScreenBuffer -> Int
|
|
countSteps = M.size . M.filter (==1)
|
|
|
|
getInputBot :: IO Integer
|
|
getInputBot = do
|
|
randomRIO (1,4)
|
|
|
|
getInput :: IO Integer
|
|
getInput = do
|
|
hSetBuffering stdin NoBuffering
|
|
hSetEcho stdin False
|
|
getKeyNow >>= \case
|
|
"l" -> pure 1
|
|
"a" -> pure 2
|
|
"i" -> pure 3
|
|
"e" -> pure 4
|
|
_ -> getInput
|
|
|
|
getKeyNow :: IO String
|
|
getKeyNow = reverse <$> getKey' ""
|
|
where
|
|
getKey' chars = do
|
|
char <- getChar
|
|
more <- hReady stdin
|
|
(if more
|
|
then getKey'
|
|
else return)
|
|
(char : chars)
|
|
|
|
updateScreenBuffer :: ScreenBuffer -> [Integer] -> ScreenBuffer
|
|
updateScreenBuffer buf xs = foldl pttrans buf $ chunksOf 3 xs
|
|
where
|
|
pttrans board [x, y, n] =
|
|
M.insert (V2 (fromIntegral x) (fromIntegral y)) n board
|
|
|
|
drawBoard :: ScreenBuffer -> String
|
|
drawBoard = drawMap (M.fromList [(0, '█'), (2, '⌂'), (3, 'I'), (1, '•')])
|