module Game where
import Random
import Maybe (isJust, fromJust)
import Array
import AFRP
import AFRPInternals (Event(..))
import AFRPGeometry
import AFRPUtilities
import Collision
import Raybox
import BSP
import List
import MD3 (AnimState)
import Command
import Diagnostics
import IdentityList
import Object
import ObjectBehavior
import Parser
import Camera
import Matrix
import Visibility (aiVisTest)
 
game :: BSPMap -> [ILKey -> Object] -> SF GameInput [ObsObjState]
game bspmap objs
  = (loop
       (game'
	  (case (listToILA $ objs) of
	       x -> x)
	  bspmap
	  >>> arr (\ oos -> (oos, oos)))
       >>>
       arr
	 (\ oos ->
	    case (map ooObsObjState (elemsIL oos)) of
		y -> y))
 
game' ::
      IL Object -> BSPMap -> SF (GameInput, IL ObjOutput) (IL ObjOutput)
game' objs bspmap
  = dpSwitch (route bspmap) objs (noEvent --> arr killOrSpawn)
      (\ sfs' f -> game' (f sfs') bspmap)
 
route ::
      BSPMap -> (GameInput, IL ObjOutput) -> IL sf -> IL (ObjInput, sf)
route bspmap (gi, oos) objs = mapIL routeAux objs
  where routeAux (k, obj)
	  = case (find (\ (x, y, z) -> k == x) states) of
		Just (x, y, z) -> (z, obj)
		Nothing -> (ObjInput{oiHit = noEvent, oiMessage = noEvent,
				     oiCollisionPos = (0, 0, 0), oiCollision = dummy,
				     oiOnLand = False, oiVisibleObjs = noEvent, oiGameInput = gi},
			    obj)
	messages
	  = concat (map eventToList (elemsIL (fmap ooSendMessage oos)))
	states
	  = (clips bspmap gi (assocsIL (fmap ooObsObjState oos))
	       (assocsIL (fmap ooObsObjState oos)))
	      messages
	dummy = initCamera (80, 611, 60) (80, 611, 59) (0, 1, 0)
 
killOrSpawn :: (a, IL ObjOutput) -> Event (IL Object -> IL Object)
killOrSpawn (_, oos)
  = case (foldl (mergeBy (.)) noEvent es) of
	y -> y
  where  
	es :: [Event (IL Object -> IL Object)]
	es
	  = case
	      ([mergeBy (.) (ooKillReq oo `tag` (deleteIL k))
		  (fmap (foldl (.) id . map insertILA_) (ooSpawnReq oo))
		| (k, oo) <- assocsIL oos])
	      of
		x -> x
 
clips ::
      BSPMap ->
	GameInput ->
	  [(ILKey, ObsObjState)] ->
	    [(ILKey, ObsObjState)] ->
	      [(ILKey, (ILKey, Message))] -> [(ILKey, ObsObjState, ObjInput)]
clips map gi [] ooses msgs = []
clips map gi ((k, oos) : kooss) ooses msgs
  = case (clip map gi oos ooses k msgs) of
	x -> (k, oos, x) : (clips map gi kooss ooses msgs)
 
clip ::
     BSPMap ->
       GameInput ->
	 ObsObjState ->
	   [(ILKey, ObsObjState)] ->
	     ILKey -> [(ILKey, (ILKey, Message))] -> ObjInput
clip map gi cam@(OOSCamera{newCam = cam1, oldCam = cam2}) ooses k
  msgs
  = let (camera, grounded) = clipCamera map cam1 cam2 in
      ObjInput{oiHit = listToEvent $ findCollidingObjects ooses (k, cam),
	       oiMessage = findMessages k msgs, oiCollisionPos = (0, 0, 0),
	       oiCollision = camera, oiOnLand = grounded, oiVisibleObjs = noEvent,
	       oiGameInput = gi}
clip map gi
  acube@(OOSAICube{oosNewCubePos = pos1, oosOldCubePos = pos2,
		   oosCubeSize = sz, upperAnim = ua, health = h, target = t,
		   lowerAnim = la})
  ooses k msgs
  = let (clippedPos, grounded) = clipObject map pos1 pos2 sz in
      ObjInput{oiHit =
		 listToEvent $ findCollidingObjects ooses (k, acube),
	       oiCollision = initCamera (80, 611, 60) (80, 611, 59) (0, 1, 0),
	       oiMessage = findMessages k msgs, oiCollisionPos = clippedPos,
	       oiOnLand = grounded,
	       oiVisibleObjs =
		 (case (h == 100 && t == (0, 0, 0)) of
		      True -> (listToEvent $ findVisibleTargets map ooses (k, acube) 600)
		      _ -> (listToEvent $ findVisibleTargets map ooses (k, acube) 1800)),
	       oiGameInput = gi}
clip map gi
  OOSRay{rayStart = pos1, rayEnd = pos2, rayUC = pos3, clipped = ff}
  ooses k msgs
  | ff == False =
    let (clippedPos, hasCol) = clipRay map pos3 pos1 (0, 0, 0) in
      ObjInput{oiHit = noEvent, oiMessage = findMessages k msgs,
	       oiCollision = dummy, oiCollisionPos = fix hasCol pos2 pos3 pos1,
	       oiOnLand = hasCol, oiVisibleObjs = noEvent, oiGameInput = gi}
  | otherwise =
    ObjInput{oiHit = noEvent, oiMessage = findMessages k msgs,
	     oiCollision = dummy, oiCollisionPos = pos2, oiOnLand = True,
	     oiVisibleObjs = noEvent, oiGameInput = gi}
  where fix clipped p2 p3 p1
	  | clipped == True = tryAccurate map 4 p2 p3 p1
	  | otherwise = pos3
	dummy = initCamera (80, 611, 60) (80, 611, 59) (0, 1, 0)
clip map gi
  projectile@(OOSProjectile{projectileNewPos = pos3,
			    projectileOldPos = pos1})
  ooses k msgs
  = let (clippedPos, hasCol) = clipRay map pos3 pos1 (0, 0, 0) in
      ObjInput{oiHit =
		 listToEvent $ findCollidingObjects ooses (k, projectile),
	       oiMessage = noEvent,
	       oiCollision = (initCamera (80, 611, 60) (80, 611, 59) (0, 1, 0)),
	       oiCollisionPos = clippedPos, oiOnLand = hasCol,
	       oiVisibleObjs = noEvent, oiGameInput = gi}
 
listToEvent :: [a] -> Event [a]
listToEvent [] = noEvent
listToEvent list = Event list
 
eventToList :: Event [a] -> [a]
eventToList ev
  | isEvent ev = fromEvent ev
  | otherwise = []
 
tryAccurate :: BSPMap -> Int -> Vec3 -> Vec3 -> Vec3 -> Vec3
tryAccurate map n dv1 dv2 vec
  | n == 0 = (middle dv1 dv2 vec)
  | snd (clipRay map (middle dv1 dv2 vec) vec (0, 0, 0)) == True =
    tryAccurate map (n - 1) dv1 (middle dv1 dv2 vec) vec
  | otherwise = tryAccurate map (n - 1) (middle dv1 dv2 vec) dv2 vec
  where middle v1 v2 v3
	  = vectorAdd v1 (vectorMult (vectorSub v2 v1) 0.5)
 
findCollidingObjects ::
		     [(ILKey, ObsObjState)] ->
		       (ILKey, ObsObjState) -> [(ILKey, ObsObjState)]
findCollidingObjects ooses (k, obj)
  | isProjectile obj =
    [(k', oos') | (k', oos') <- ooses, k /= k', isCamera oos',
     checkCollision obj oos']
  | isCamera obj =
    [(k', oos') | (k', oos') <- ooses, k /= k', isProjectile oos',
     checkCollision obj oos']
  | isAICube obj =
    [(k', oos') | (k', oos') <- ooses, k /= k', isRay oos',
     checkCollision obj oos']
 
checkCollision :: ObsObjState -> ObsObjState -> Bool
checkCollision obj1 obj2
  | isCamera obj2 && isProjectile obj1 =
    pointBox (cpos (oldCam (obj2))) (projectileOldPos obj1)
      (20, 50, 20)
  | isCamera obj1 && isProjectile obj2 =
    pointBox (cpos (oldCam (obj1))) (projectileOldPos obj2)
      (20, 50, 20)
  | isAICube obj1 && isRay obj2 =
    let (x, y, z) = oosOldCubePos obj1
	(cx, cy, cz) = oosCubeSize obj1
      in
      rayBox (rayStart obj2) (rayEnd obj2) (x - cx, y - cy, z - cz)
	(x + cx, y + cy, z + cz)
 
findVisibleTargets ::
		   BSPMap ->
		     [(ILKey, ObsObjState)] ->
		       (ILKey, ObsObjState) -> Int -> [(ILKey, ObsObjState)]
findVisibleTargets bsp ooses (k, obj) range
  | isAICube obj =
    [(k', oos') | (k', oos') <- ooses, k /= k', isCamera oos',
     checkVisible bsp obj oos' range]
  | otherwise = []
 
checkVisible :: BSPMap -> ObsObjState -> ObsObjState -> Int -> Bool
checkVisible bsp obj1 obj2 range
  | isAICube obj1 && isCamera obj2 =
    let (x, y, z) = oosOldCubePos obj1
	(cx, cy, cz) = cpos (oldCam obj2)
      in aiVisTest bsp (x, y, z) (oosCubeAngle obj1) (cx, cy, cz) range
 
findMessages ::
	     ILKey -> [(ILKey, (ILKey, Message))] -> Event [(ILKey, Message)]
findMessages key messages
  = listToEvent $
      map snd (filter (\ (destkey, srcmsg) -> destkey == key) messages)