Haskell Quiz/Sokoban/Solution Jethr0
< Haskell Quiz | Sokoban
Jump to navigation
Jump to search
Revision as of 15:19, 6 February 2021 by Gwern (talk | contribs) (Reverted edits by Tomjaguarpaw (talk) to last revision by JohannesAhlmann)
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
Obviously the most uncool kind of interface you could imagine. No readline, no clearscreen, you name it. But I was kinda reminded of the "good ole' days" when writing/playing this ;)
module Main where
import Prelude hiding (Either(..))
import qualified Data.List as L
import qualified Data.Char as C
import Control.Monad
import System.IO (getChar, hSetEcho, stdin)
type Coord = (Int,Int)
(|+|) :: Coord -> Coord -> Coord
(a,b) |+| (c,d) = (a+c, b+d)
data Move = Up | Down | Left | Right deriving (Show,Eq)
data SokoState = SokoState {sWalls, sCrates, sStorages :: [Coord]
,sWorker :: Coord
,sSteps :: Int}
deriving (Eq)
modifyWalls f st = st{sWalls = f . sWalls $ st}
modifyCrates f st = st{sCrates = f . sCrates $ st}
modifyStorages f st = st{sStorages = f . sStorages $ st}
modifyWorker f st = st{sWorker = f . sWorker $ st}
modifySteps f st = st{sSteps = f . sSteps $ st}
moveToCoord :: Move -> Coord
moveToCoord Up = ( 0,-1)
moveToCoord Down = ( 0, 1)
moveToCoord Left = (-1, 0)
moveToCoord Right = ( 1, 0)
-- given a move and a state, compute the next state
step :: Move -> SokoState -> SokoState
step move state
| isWall next1 = state
| isCrate next1 =
if isWall next2 || isCrate next2
then state
else modifyCrates ((next2:) . (filter (next1/=))) moveWorker
| otherwise = moveWorker
where SokoState{sWalls = walls, sCrates = crates, sWorker = worker} = state
moveCoord = moveToCoord move
next1 = worker |+| moveCoord
next2 = next1 |+| moveCoord
isCrate = (`elem` crates)
isWall = (`elem` walls)
moveWorker = modifySteps (+1) state{sWorker = next1}
-- check if a level is solved by comparing crate and storage locations
finished :: SokoState -> Bool
finished SokoState{sCrates = cs, sStorages = ss} =
L.sort cs == L.sort ss
---
drawState :: SokoState -> [String]
drawState state@SokoState{sWalls = ws, sCrates = cs, sStorages = ss
,sWorker = wrk, sSteps = steps} =
show steps : [[charRep (x,y) | x <- [0..maxX]] | y <- [0..maxY]]
where
maxX = maximum $ map fst ws
maxY = maximum $ map snd ws
charRep coord
| isWorker && isStorage = '+'
| isCrate && isStorage = '*'
| isWorker = '@'
| isCrate = 'o'
| isStorage = '.'
| isWall = '#'
| otherwise = ' '
where isWorker = coord == wrk
isCrate = coord `elem` cs
isStorage = coord `elem` ss
isWall = coord `elem` ws
instance Show SokoState where
show = unlines . drawState
-- recreate a level from its ascii representation
fromLevel :: [String] -> SokoState
fromLevel level = foldl newCell emptyState $ (concat cells)
where cells = map (\(y,xs) -> zipWith (\x c -> ((x,y),c)) [0..] xs)
(zip [0..] level)
newCell st (coord,char) =
case char of
'#' -> modifyWalls (coord:) st
'o' -> modifyCrates (coord:) st
'.' -> modifyStorages (coord:) st
'*' -> modifyStorages (coord:) . modifyCrates (coord:) $ st
'+' -> modifyStorages (coord:) . modifyWorker (const coord) $ st
'@' -> modifyWorker (const coord) st
otherwise -> st
emptyState = SokoState {sWalls = []
,sStorages = []
,sCrates = []
,sWorker = (0,0) -- *brr*
,sSteps = 0
}
---
-- ask for input until the level is solved
-- TODO: add key to quit
loop st = do
print st
c <- getChar
let move = case c of
'j' -> step Left
'k' -> step Down
'l' -> step Right
'i' -> step Up
otherwise -> id
st' = move st
if finished st'
then print st' >> print "you won"
else loop st'
main = do
hSetEcho stdin False
loop $ fromLevel level_1
hSetEcho stdin True
---
level_1 = [
"#########",
"# #",
"# oo #",
"# #. @#",
"# . #",
"#########"
]