Difference between revisions of "Haskell Quiz/Sokoban/Solution Jethr0"

From HaskellWiki
Jump to: navigation, search
m
 
(Deleting page that hasn't been updated for over 10 years)
Line 1: Line 1:
[[Category:Haskell Quiz solutions|Countdown]]
 
 
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 ;)
 
 
<haskell>
 
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 #",
 
"# #. @#",
 
"# . #",
 
"#########"
 
]
 
 
</haskell>
 

Revision as of 14:32, 6 February 2021