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

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 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 #",
"#  #.  @#",
"#    .  #",
"#########"
]
```