cis194_week2

readme.md

solution of cis194 week2 homework

cis194_02.hs

{-# LANGUAGE OverloadedStrings #-}
import CodeWorld
import Data.Foldable

character, wall, ground, storage, box :: Picture
wall =    colored (grey 0.4) (solidRectangle 1 1)
ground =  colored yellow     (solidRectangle 1 1)
storage = solidCircle 0.3 & ground
box =     colored brown      (solidRectangle 1 1)
character = colored green $ solidCircle 0.2 & translated 0.2 0 (solidCircle 0.1)


data Tile = Tile {stepAble :: Bool, picture :: Picture}
wallTile = Tile False wall
groundTile = Tile True ground
storageTile = Tile True storage
boxTile = Tile False box
blankTile = Tile False blank

pictureOfMaze :: Picture
pictureOfMaze = let coordinates = [C x y | x <- [-10..10], y <- [-10..10]]
                    pictures = drawTileAt <$> coordinates
                in fold pictures

trans :: Coord -> Picture -> Picture
trans coord@(C x y) = translated (fromIntegral x) (fromIntegral y)

drawTileAt :: Coord -> Picture
drawTileAt coord = trans coord (drawTile (maze coord))
  where drawTile :: Tile -> Picture
        drawTile tile = picture tile

maze :: Coord -> Tile
maze (C x y)
  | abs x > 4  || abs y > 4  = blankTile
  | abs x == 4 || abs y == 4 = wallTile
  | x ==  2 && y <= 0        = wallTile
  | x ==  3 && y <= 0        = storageTile
  | x >= -2 && y == 0        = boxTile
  | otherwise                = groundTile


data Direction = R | U | L | D

data Coord = C Integer Integer

data State = State {characterCoord :: Coord, characterDirection :: Direction}

initialState :: State
initialState = State (C 0 1) R

adjacentCoord :: Direction -> Coord -> Coord
adjacentCoord R (C x y) = C (x+1) y
adjacentCoord U (C x y) = C  x   (y+1)
adjacentCoord L (C x y) = C (x-1) y
adjacentCoord D (C x y) = C  x   (y-1)

handleTime :: Double -> State -> State
handleTime _ s = s

handleEvent :: Event -> State -> State
handleEvent (KeyPress key) oldState@(State c h)
    | key == "Right" = nextState (adjacentCoord R c) R
    | key == "Up"    = nextState (adjacentCoord U c) U
    | key == "Left"  = nextState (adjacentCoord L c) L
    | key == "Down"  = nextState (adjacentCoord D c) D
    | otherwise      = oldState
    where nextState :: Coord -> Direction -> State
          nextState newCoord newDirection = if canStepTo newCoord
                                            then State newCoord newDirection
                                            else State c newDirection

          canStepTo :: Coord -> Bool
          canStepTo c = stepAble $ maze c

handleEvent _ s      = s

characterPicture :: State -> Picture
characterPicture (State coord heading) = trans coord (rotated (degree heading) character)
  where degree :: Direction -> Double
        degree R = 0
        degree L = pi
        degree U = pi / 2
        degree D = (-pi) / 2

drawWorld :: State -> Picture
drawWorld s = (characterPicture s) & pictureOfMaze

resetableInteractionOf ::
    world ->
    (Double -> world -> world) ->
    (Event -> world -> world) ->
    (world -> Picture) ->
    IO ()
resetableInteractionOf init timeHandler eventHandler drawer = interactionOf init timeHandler eventHandlerWithReset drawer
  where eventHandlerWithReset event@(KeyPress key) state
          | key == "Esc" = eventHandler event init
          | otherwise = eventHandler event state
        eventHandlerWithReset e s = eventHandler e s

main :: IO ()
main = resetableInteractionOf initialState handleTime handleEvent drawWorld

cis194_03.hs

{-# LANGUAGE OverloadedStrings #-}
import CodeWorld
import Data.Foldable

data SSState world = StartScreen | Running world

data Interaction world = Interaction
  world
  (Double -> world -> world)
  (Event -> world -> world)
  (world -> Picture)

resetable :: Interaction s -> Interaction s
resetable (Interaction state0 step handle draw)
  = Interaction state0 step handle' draw
  where handle' (KeyPress key) _ | key == "Esc" = state0
        handle' e s = handle e s

startScreen :: Picture
startScreen = scaled 3 3 (text "Sokoban!")

withStartScreen :: Interaction s -> Interaction (SSState s)
withStartScreen (Interaction state0 step handle draw)
  = Interaction state0' step' handle' draw'
  where
    state0' = StartScreen

    step' _ StartScreen = StartScreen
    step' t (Running s) = Running (step t s)

    handle' (KeyPress key) StartScreen
         | key == " "                  = Running state0
    handle' _              StartScreen = StartScreen
    handle' e              (Running s) = Running (handle e s)

    draw' StartScreen = startScreen
    draw' (Running s) = draw s

exercise2 :: Interaction State
exercise2 = Interaction initialState (\_ c -> c) handleEvent draw

runInteraction :: Interaction s -> IO ()
runInteraction (Interaction state0 step handle draw)
  = interactionOf state0 step handle draw

main = runInteraction (resetable (withStartScreen exercise2))

character, wall, ground, storage, box :: Picture
wall =    colored (grey 0.4) (solidRectangle 1 1)
ground =  colored yellow     (solidRectangle 1 1)
storage = solidCircle 0.3 & ground
box =     colored brown      (solidRectangle 1 1)
character = colored green $ solidCircle 0.2 & translated 0.2 0 (solidCircle 0.1)


data Tile =
    Wall
  | Ground
  | Storage
  | Box
  | Blank
  deriving (Eq, Show)

picture :: Tile -> Picture
picture Wall = wall
picture Ground = ground
picture Storage = storage
picture Box = box
picture Blank = blank

stepAble :: Tile -> Bool
stepAble Wall = False
stepAble Ground = True
stepAble Storage = True
stepAble Box = False
stepAble Blank = False

pictureOfMaze :: [Coord] -> Picture
pictureOfMaze boxes = let pictures = (drawTileAt boxes) <$> boardCoordinates
                      in fold pictures

trans :: Coord -> Picture -> Picture
trans coord@(C x y) = translated (fromIntegral x) (fromIntegral y)

drawTileAt :: [Coord] -> Coord -> Picture
drawTileAt boxes coord = trans coord (drawTile tile)
  where drawTile :: Tile -> Picture
        drawTile tile = picture tile
        tile = if elem coord boxes
               then Box
               else  mazeWithoutBoxes coord

maze :: Coord -> Tile
maze (C x y)
  | abs x > 4  || abs y > 4  = Blank
  | abs x == 4 || abs y == 4 = Wall
  | x ==  2 && y <= 0        = Wall
  | x ==  3 && y <= 0        = Storage
  | x >= -2 && y == 0        = Box
  | otherwise                = Ground

mazeWithoutBoxes :: Coord -> Tile
mazeWithoutBoxes c = tileAtCoordinate `except` Box
  where tileAtCoordinate = maze c
        except tile exception = if tile == exception
                                then Ground
                                else tile

data Direction = R | U | L | D

data Coord = C Integer Integer deriving Eq
boardCoordinates = [C x y | x <- [-10..10], y <- [-10..10]]

data State = State
  { characterCoord :: Coord
  , characterDirection :: Direction
  , boxes :: [Coord]
  }

isWon :: State -> Bool
isWon s = all ((Storage ==).maze) (boxes s)

initialState :: State
initialState = State (C 0 1) R boxes
  where boxes = filter ((Box ==).maze) boardCoordinates

adjacentCoord :: Direction -> Coord -> Coord
adjacentCoord R (C x y) = C (x+1) y
adjacentCoord U (C x y) = C  x   (y+1)
adjacentCoord L (C x y) = C (x-1) y
adjacentCoord D (C x y) = C  x   (y-1)

handleTime :: Double -> State -> State
handleTime _ s = s

handleEvent :: Event -> State -> State
handleEvent (KeyPress key) oldState@(State c h b) = stateAfterStep
  where stateAfterStep = if canStep
                         then stepState
                         else pushState
        pushState = if pushable
                    then State destinationCoord nextDirection boxesAfterPush
                    else stateAfterDirectionUpdate
        boxesAfterPush = pushDestination : (filter ((/=) destinationCoord) b)
        pushable = (destinationTile == Box) && (stepAble $ tileAt pushDestination)
        pushDestination = adjacentCoord nextDirection destinationCoord
        stepState = stateAfterDirectionUpdate {characterCoord = destinationCoord}
        canStep = stepAble $ destinationTile
        tileAt coord = if elem coord b
                       then Box
                       else mazeWithoutBoxes coord
        destinationTile = tileAt destinationCoord
        destinationCoord = adjacentCoord nextDirection c
        stateAfterDirectionUpdate = oldState {characterDirection = nextDirection}
        nextDirection = case key of
                          "Right" -> R
                          "Up" -> U
                          "Left" -> L
                          "Down" -> D
                          _ -> h
handleEvent _ s      = s

characterPicture :: State -> Picture
characterPicture (State coord heading _) = trans coord (rotated (degree heading) character)
  where degree :: Direction -> Double
        degree R = 0
        degree L = pi
        degree U = pi / 2
        degree D = (-pi) / 2

draw :: State -> Picture
draw s =
  if isWon s
  then styledText Bold Fancy "You won!"
  else (characterPicture s) & pictureOfMaze $ boxes s


resetableInteractionOf ::
    world ->
    (Double -> world -> world) ->
    (Event -> world -> world) ->
    (world -> Picture) ->
    IO ()

resetableInteractionOf init timeHandler eventHandler drawer = interactionOf init timeHandler eventHandlerWithReset drawer
  where eventHandlerWithReset event@(KeyPress key) state
          | key == "Esc" = eventHandler event init
          | otherwise = eventHandler event state
        eventHandlerWithReset e s = eventHandler e s