code/Sokoban.icl

   1 implementation module Sokoban
   2
   3 import StdFile
   4 import StdList
   5 import StdString
   6 import StdMisc
   7
   8 Start :: *World -> (String, *World)
   9 Start w
  10 # (s, w) = parse "../sokobanzip/screens/screen.1" w
  11 = ("\n" +++ toString s, w)
  12
  13 instance toString SokobanPuzzle where
  14         toString (Sokoban []) = ""
  15         toString (Sokoban [[]:rows]) = "\n" +++ toString (Sokoban rows)
  16         toString (Sokoban [[x:xs]:rows]) =
  17                 toString x +++ toString (Sokoban [xs:rows])
  18
  19 instance toString SokobanTile where
  20         toString Free = " "
  21         toString Wall = "#"
  22         toString Box = "$"
  23         toString Agent = "@"
  24         toString Target = "."
  25         toString TargetBox = "*"
  26         toString TargetAgent = "+"
  27
  28 parseFromFile :: *File -> (SokobanPuzzle, *File)
  29 parseFromFile f
  30 # (contents, f) = readEntireFile f
  31 | isEmpty contents = abort "File is empty or unreadable"
  32 = (Sokoban (parseRows contents), f)
  33
  34 parse :: String *World -> (SokobanPuzzle, *World)
  35 parse fp w
  36 # (ok, f, w) = fopen fp FReadText w
  37 | not ok = abort ("Couldn't open file: '" +++ fp +++ "'")
  38 # (puzzle, f) = parseFromFile f
  39 # (ok, w) = fclose f w
  40 | not ok = abort "Couldn't close file"
  41 = (puzzle, w)
  42
  43 numberOfBlocks :: SokobanPuzzle -> Int
  44 numberOfBlocks (Sokoban bs) = let fbs = flatten bs in
  45         length ([1\\(Box)<-fbs] ++ [1\\(TargetBox)<-fbs])
  46
  47 parseRows :: [Char] -> [[SokobanTile]]
  48 parseRows cs = case parseRow cs of
  49         ([], _) = []
  50         (x, rest) = [x:parseRows rest]
  51
  52 parseRow :: [Char] -> ([SokobanTile], [Char])
  53 parseRow [] = ([], [])
  54 parseRow ['\n':xs] = ([], xs)
  55 parseRow [x:xs]
  56 # (rest, xs) = parseRow xs
  57 # current = case x of
  58         '#' = Wall
  59         '$' = Box
  60         '@' = Agent
  61         '.' = Target
  62         '+' = TargetAgent
  63         '*' = TargetBox
  64         ' ' = Free
  65         _ = abort ("Unknown char: '" +++ toString x +++ "'")
  66 = ([current:rest], xs)
  67
  68 readEntireFile :: *File -> *([Char], *File)
  69 readEntireFile f
  70 # (b, c, f) = freadc f
  71 | not b = ([], f)
  72 # (cs, f) = readEntireFile f
  73 = ([c:cs], f)