{-# LANGUAGE PatternGuards #-}
module Gloss.Event
where
-- friends
import Common.Type
import Scene.State
-- library
import Data.Char
import Data.Label
import Graphics.Gloss.Interface.Pure.Game as G
handleEvent :: Event -> State -> State
handleEvent event state
= case event of
EventKey (Char c) s _ _ -> char (toLower c) s state
EventKey (SpecialKey c) s _ _ -> special c s state
EventKey (MouseButton b) s _ l -> click b l s state
EventMotion p -> motion p
_ -> state
where
toggle f x Down = set f (Just x)
toggle f _ Up = set f Nothing
char 'w' = toggle stateEyeVert Fwd
char ',' = toggle stateEyeVert Fwd
char 's' = toggle stateEyeVert Rev
char 'o' = toggle stateEyeVert Rev
char 'a' = toggle stateEyeHoriz Rev
char 'd' = toggle stateEyeHoriz Fwd
char 'e' = toggle stateEyeHoriz Fwd
char _ = const id
click LeftButton = toggle stateLeftClick
click _ = const (const id)
special KeyUp = toggle stateLightVert Fwd
special KeyDown = toggle stateLightVert Rev
special KeyRight = toggle stateLightHoriz Fwd
special KeyLeft = toggle stateLightHoriz Rev
special _ = const id
motion (x,y)
| Just (oX, oY) <- get stateLeftClick state
, V3 eyeX eyeY eyeZ <- get stateEyeDelta state
= let eyeX' = eyeX + (x - oX)
eyeY' = eyeY
eyeZ' = eyeZ + (y - oY)
in
set stateEyeDelta (V3 eyeX' eyeY' eyeZ')
$ set stateLeftClick (Just (x, y))
$ state
motion _
= state