Rasenschach-0.1: Object.hs

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

module Object

where

import FRP.Yampa -- (SF, Event)
import FRP.Yampa.Geometry
import FRP.Yampa.Forceable

import Graphics.UI.SDL as SDL (Pixel)

import AL
import Physics
import Message
import States
import BasicTypes


------------------------------------------------------------------------------
-- Object and related types
------------------------------------------------------------------------------

-- Objects are represented by signal functions, i.e. they are reactive and
-- can carry internal state.

type Object = SF ObjInput ObjOutput

type ALOut = AL ObjId ObjOutput
type ALObj = AL ObjId Object

--data MessageBody = GotoPosition Position2 | Wait


data ObjInput = ObjInput {
    oiMessages  :: !([MessageBody], Collisions),
    oiGameState :: ![VisibleState],
    oiGameInput :: !Input -- Mouse und Keyboard
}

data ObjOutput = ObjOutput {
    ooObsObjState :: !ObsObjState,
    ooKillReq     :: !(Event ()),
    ooSpawnReq    :: !(Event [Object]),
    ooMessages    :: ![Message]
}
instance Show ObjOutput where
   show (ObjOutput o _ _ _) = case o of
       OOSBall {} -> "OOSBall"
       OOSPlayer {} -> "OOSPlayer"
       OOSGame {} -> "OOSGame"


-- To avoid space leaks, all fields (except possibly dependent ones) are
-- strict.
data ObsObjState =
      OOSBall {
	  oosPos      :: !Position3,
	  oosVel      :: !Velocity3,
          oosBounced  :: !Bool,
          oosBState   :: !(BallState, BallStateParam)
      }
    | OOSPlayer {
	  oosPos           :: !Position3,
	  oosVel           :: !Velocity3,
          oosAcc           :: !Acceleration3,
          oosKicked        :: !Bool,
          oosSelected      :: !Bool,
          oosDesignated    :: !Bool,
          oosRadius        :: !Length,
          oosTeamInfo      :: !TeamInfo,
          oosPlayerInfo    :: !PlayerInfo,
          oosDir           :: !Heading,    -- Winkel in Bogenmaß (0 Grad: rechts, pi/2 Grad: oben etc.)
          oosBasicState    :: !(BasicState, BasicStateParam),
          oosTacticalState :: !(TacticalState, TacticalStateParam),
          oosOnFoot        :: !OnFoot
      }
    | OOSGame {
	  oosGameTime :: !Time,
          oosGameScore:: !(Int, Int),
          oosGameState:: !(GameState, GameStateParam),
          oosAttacker :: !Team,
          oosPos      :: !Position3  -- Dummy, zum Sortieren...
     }


-- Subset of ObjOutput that is visible to the other objects in the game
-- ObjId is needed for directing a message to the corresponding object
data VisibleState =
      VSBall {
          vsObjId     :: !ObjId,
          vsMessages  :: ![Message],
  	  vsPos       :: !Position3,
  	  vsVel       :: !Velocity3,
          vsBallState :: !(BallState, BallStateParam)
      }
    | VSPlayer {
          vsObjId     :: !ObjId,
          vsMessages  :: ![Message],
  	  vsPos       :: !Position3,
  	  vsVel       :: !Velocity3,
          vsAcc       :: !Acceleration3,
          vsDesignated:: !Bool,
          vsTeam      :: !Team,
          vsPlayerInfo:: !PlayerInfo,
          vsDir       :: !Heading,    -- Winkel in Bogenmaß (0 Grad: rechts, pi/2 Grad: oben etc.)
          vsPBState   :: !(BasicState, BasicStateParam),
          vsPTState   :: !(TacticalState, TacticalStateParam),
          vsOnFoot    :: !OnFoot
      }
    | VSGame {
          vsObjId     :: !ObjId,
          vsMessages  :: ![Message],
  	  vsGameTime  :: !Time,
          vsGameScore :: !(Int, Int),
          vsAttacker  :: !Team,
          vsGameState :: !(GameState, GameStateParam)
      }


vsFromObjOutput oid os = case ooObsObjState os of
  OOSBall p v _ s -> VSBall oid msg p v s
  OOSPlayer p v a _ _ des _ (t, _, _) pi d bs ts f -> VSPlayer oid msg p v a des t pi d bs ts f
  OOSGame t sc st att _ -> VSGame oid msg t sc att st
  where msg = ooMessages os

------------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------------

instance Forceable ObsObjState where
    -- If non-strict fields: oosNonStrict1 obj `seq` ... `seq` obj
    force obj = obj

------------------------------------------------------------------------------
-- Recognizers
------------------------------------------------------------------------------

isBall :: VisibleState -> Bool
isBall (VSBall {}) = True
isBall _            = False

isPlayer :: VisibleState -> Bool
isPlayer (VSPlayer {}) = True
isPlayer _               = False



newtype RuleId = RuleId Int deriving (Show, Eq)

type RuleName = String

newtype Priority = Priority Int deriving (Show, Eq, Ord)

type RuleFunction = [ObjId ] -> Facts -> [VisibleState] -> Maybe [Message]

instance Show RuleFunction where
 show x = "RuleFunction"

data Rule = Rule {
                opRuleId   :: RuleId,
                opRuleName :: RuleName,
                opPriority :: Priority,
                opRule     :: RuleFunction
              } deriving (Show)

type RuleBase = [Rule]