frag-1.1: src/Game.hs

module Game where

import AFRP
import AFRPInternals (Event(..))
import Collision
import Raybox
import BSP
import List
import IdentityList
import Object
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, _, _) -> k == x) states) of
                Just (_, _, 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::Int, 611::Int, 60::Int) (80::Int, 611::Int, 59::Int) (0::Int, 1::Int, 0::Int)

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 _ _ [] _ _ = []
clips mp gi ((k, oos) : kooss) ooses msgs
  = case (clip mp gi oos ooses k msgs) of
        x -> (k, oos, x) : (clips mp gi kooss ooses msgs)

clip :: BSPMap -> GameInput -> ObsObjState -> [(ILKey, ObsObjState)] ->
       ILKey -> [(ILKey, (ILKey, Message))] -> ObjInput
clip mp gi cam@(OOSCamera{newCam = cam1, oldCam = cam2}) ooses k msgs
  = let (camera, grounded) = clipCamera mp 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 mp gi
  acube@(OOSAICube{oosNewCubePos = pos1, oosOldCubePos = pos2,
                   oosCubeSize = sz, health = h, target = t})
  ooses k msgs
  = let (clippedPos, grounded) = clipObject mp pos1 pos2 sz in
      ObjInput{oiHit =
                 listToEvent $ findCollidingObjects ooses (k, acube),
               oiCollision = initCamera (80::Int, 611, 60) (80::Int, 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 mp ooses (k, acube) 600)
                      _ -> (listToEvent $ findVisibleTargets mp ooses (k, acube) 1800)),
               oiGameInput = gi}
clip mp gi
  OOSRay{rayStart = pos1, rayEnd = pos2, rayUC = pos3, clipped = ff}
  _ k msgs
  | ff == False =
    let (_, hasCol) = clipRay mp 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 clpped p2 p3 p1
          | clpped == True = tryAccurate mp 4 p2 p3 p1
          | otherwise = pos3
        dummy = initCamera (80::Int, 611, 60) (80::Int, 611, 59) (0, 1, 0)
clip mp gi
  projectile@(OOSProjectile{projectileNewPos = pos3,
                            projectileOldPos = pos1})
  ooses k _
  = let (clippedPos, hasCol) = clipRay mp pos3 pos1 (0, 0, 0) in
      ObjInput{oiHit =
                 listToEvent $ findCollidingObjects ooses (k, projectile),
               oiMessage = noEvent,
               oiCollision = (initCamera (80::Int, 611, 60) (80::Int, 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 mp n dv1 dv2 vec
  | n == 0 = (middle dv1 dv2 vec)
  | snd (clipRay mp (middle dv1 dv2 vec) vec (0, 0, 0)) == True =
    tryAccurate mp (n - 1) dv1 (middle dv1 dv2 vec) vec
  | otherwise = tryAccurate mp (n - 1) (middle dv1 dv2 vec) dv2 vec
  where middle v1 v2 _ = 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)
checkCollision _ _ = False

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
checkVisible _ _ _ _ = True

findMessages ::
             ILKey -> [(ILKey, (ILKey, Message))] -> Event [(ILKey, Message)]
findMessages key messages
  = listToEvent $
      map snd (filter (\ (destkey, _) -> destkey == key) messages)