{-# 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