kanidouraku.elm

kanidouraku.elm

import Keyboard
import Signal (..)
import Time (..)
import Color(rgb)
import Graphics.Element (..)
import Graphics.Collage (..)
import Random
import Time
 
type ClawPos = Left | Right
type ArrowKey = ArrowLeft | ArrowRight
type GameState = Play | Finished | Title
    
type alias Game =
    { state:GameState
    , score:Int
    , claws:Claws
    , kanidouraku:Kanidouraku
    }

type alias Claws =
    { leftPos:ClawPos, rightPos:ClawPos }
    
type alias Input =
    { space: Bool
    , arrow: ArrowKey
    }

type alias Kanidouraku = (Bool, Bool, Bool, Bool)

main : Signal Element
main = view <~ foldp update defaultGame userInput
    
update : Input -> Game -> Game
update { space, arrow } game =
    let newClaws = updateClaws game.claws arrow
        collision = checkCollision game.kanidouraku game.claws
        newKanidouraku = updateKanidouraku collision game.kanidouraku
        newScore = updateScore collision game.score
    in { state = Title
       , score = newScore
       , claws = newClaws
       , kanidouraku = newKanidouraku
       }

checkCollision : Kanidouraku -> Claws -> Bool
checkCollision kani claws =
    let clawsMapped = case (claws.leftPos, claws.rightPos) of
                        (Left, Left)   -> (True, False, True, False)
                        (Right, Left)  -> (False, True, True, False)
                        (Left, Right)  -> (True, False, False, True)
                        (Right, Right) -> (True, False, False, True)
    in kani == clawsMapped
    
updateKanidouraku : Bool -> Kanidouraku -> Kanidouraku
updateKanidouraku collision kani = case collision of
                                     True -> kani
                                     False -> kani

updateScore : Bool -> Int -> Int
updateScore collision score = case collision of
                                True -> score + 1
                                False -> score

updateClaws : Claws -> ArrowKey -> Claws
updateClaws claws arrow = { leftPos = case (claws.leftPos, arrow) of
                                        (Left, ArrowLeft) -> Right
                                        (Right, ArrowLeft) -> Left
                                        (pos, _) -> pos
                          , rightPos = case (claws.rightPos, arrow) of
                                         (Left, ArrowRight) -> Right
                                         (Right, ArrowRight) -> Left
                                         (pos, _) -> pos
                          }
    
defaultGame : Game
defaultGame = { state = Title
              , score = 0
              , claws = { leftPos = Left, rightPos = Right }
              , kanidouraku = (True, True, True, True)
              }

userInput = map2 Input Keyboard.space arrowInput

arrowInput : Signal ArrowKey
arrowInput = merge leftPressed rightPressed

leftPressed = map (\x -> ArrowLeft) <| dropIf not False <| Keyboard.isDown 37
rightPressed = map (\x -> ArrowRight) <| dropIf not False <| Keyboard.isDown 39

view : Game -> Element
view game = gameView game
         
(gameWidth,gameHeight) = (500,500)

gameView { state, score, claws } = flow down [ image gameWidth 200 "logo.gif"
                                             , flow right <| clawsView claws
                                             , image gameWidth 200 "kani_body.png"
                                             ]

clawsView {leftPos, rightPos} =
    let left = case leftPos of
             Left  -> [ leftClawView, emptyClawView ]
             Right -> [ emptyClawView, rightClawView ]
        right = case rightPos of
              Left  -> [ leftClawView, emptyClawView ]
              Right -> [ emptyClawView, rightClawView ]
    in left ++ right

leftClawView  = image (floor <| gameWidth/4) 200 "kani_left.png"
rightClawView = image (floor <| gameWidth/4) 200 "kani_right.png"
emptyClawView = collage (floor <| gameWidth/4) 200 [ filled (rgb 255 255 255) (rect (gameWidth/4) 200) ]