{- $Id: Main.as,v 1.3 2003/11/13 20:11:00 henrik Exp $
******************************************************************************
*                              I N V A D E R S                               *
*                                                                            *
*       Module:		Main						     *
*       Purpose:	Main module.					     *
*       Author:		Henrik Nilsson					     *
*                                                                            *
*             Copyright (c) Yale University, 2003                            *
*                                                                            *
******************************************************************************
-}

module Main where

import Debug.Trace
import Random

import Maybe (isJust)
import Array

import AFRP
import AFRPInternals (Event(..))
import AFRPGeometry
import AFRPUtilities
import qualified Graphics.HGL{-- Jeff -- .Utils ----} as HGL

-- Temporary, just to make sure all modules compile.
import Animate
import ColorBindings
import Colors
import Command
import Diagnostics
import IdentityList
import Object
import ObjectBehavior
import Parser
import PhysicalDimensions
import RenderLandscape
import RenderObject
import WorldGeometry

type Score = Int

main = do
    g <- newStdGen
    animate 20 "S P A C E   I N V A D E R S" worldSizeX worldSizeY
               (\(score, ooss) ->
		    renderScore score
		    `HGL.overGraphic` renderObjects ooss
		    `HGL.overGraphic` landscape)
               (\_ -> [])
               (parseWinInput >>> restartingGame g)


-- Change name to "game"? What's now "game" would become "gameRound".
-- What about "game'"?
restartingGame :: RandomGen g => g -> SF GameInput (Int, [ObsObjState])
restartingGame g = rgAux g nAliens0 vydAlien0 0 1
    where
	nAliens0 = 2
	vydAlien0 = -10

        rgAux g nAliens vydAlien score numGuns =
            switch (game g' nAliens vydAlien score numGuns) $ \status ->
            case status of
		Left (score', numGuns') -> rgAux g'' (nAliens + 1) (vydAlien - 10) score' numGuns'
                Right finalScore -> rgAux g'' nAliens0 vydAlien0 0 1
	    where
	        (g', g'') = split g


-- How to arrange for splitting of g in general if we have spawning of aliens
-- "inside" the game? The spawner should
-- keep control over the supply of random generators.

game :: RandomGen g => g -> Int -> Velocity -> Score -> Int ->
	SF GameInput ((Int, [ObsObjState]), Event (Either (Score,Int) Score))
game g nAliens vydAlien score0 numGuns0 = proc gi -> do
    -- One could argue that feeding back only the ObsObjState part would
    -- make things a little smoother. But possibly somewhat less general.
    -- iPre not needed in the feedback path as long as dpSwitch is used,
    -- but there are many side conditions related to the game. E.g.
    -- the parts of the fed-back output used for hit detection not depending
    -- on the result of the hit detection and so on. So for robustness,
    -- maybe safest to leave the delay in.
    --
    -- BUT! We cannot have BOTH dpSwitch and iPre! That will cause e.g.
    -- hitting shots to be "seen" twice, due to a "double delay", and
    -- that in turn will inflict double dammage.
    --
    -- We could do score keeping *in this case* by simply *continusouly*
    -- counting the number of aliens. This count can be used both to detect
    -- a new round, and for computing the score as nAliens - alienCount.
    -- But this does not exactly invite to more elaborate scoring schemes.
    -- it would also be difficult to have different kinds of aliens of
    -- varying value, since the natural way to do that is to look at the
    -- actual object that is being removed in order to figure out its value,
    -- rather than tryingto figure out a score indirectly through the
    -- absence of objects!
    rec
        oos  <- game' objs0  -< (gi, oos {- oosp -})
        {- oosp <- iPre emptyIL -< oos -}
    score    <- accumHold score0 -< aliensDied oos
    gameOver <- edge             -< alienLanded oos
    newRound <- edge             -< noAliensLeft oos
    let numGuns = length $ filter isGun $ map ooObsObjState $ elemsIL oos
    returnA -< ((score, map ooObsObjState (elemsIL oos)),
                (newRound `tag` (Left (score,numGuns)))
	        `lMerge` (gameOver `tag` (Right score)) )
    where
	objs0 = listToIL (mkGuns numGuns0 ++ mkAliens g (worldXMin + d) 900 nAliens)
	d     = (worldXMax - worldXMin) / fromIntegral (nAliens + 1)

        mkGuns 0 = []
        mkGuns n = gun (Point2 (fromIntegral (n-1) * gunBase) 50) : mkGuns (n-1) 
	
	mkAliens g x y 0         = []
	mkAliens g x y n | n > 0 = alien g' (Point2 x y) vydAlien (n < 2)
				   : mkAliens g'' (x + d) y (n - 1)
	    where
		(g', g'') = split g

	aliensDied :: IL ObjOutput -> Event (Score -> Score)
	aliensDied oos =
	    fmap (\es -> (+length es))
	         (catEvents (map ooKillReq (findAllIL isAlien' oos)))
	    where
		isAlien' (_, ObjOutput {ooObsObjState = oos}) = isAlien oos

	alienLanded :: IL ObjOutput -> Bool
	alienLanded oos = isJust (findIL isLanded oos)
	    where
		isLanded (_, ObjOutput {ooObsObjState = oos}) =
		    isAlien oos && point2Y (oosPos oos) <= 0

	noAliensLeft :: IL ObjOutput -> Bool
	noAliensLeft oos = null (findAllIL isAlien' oos)
	    where
		isAlien' (_, ObjOutput {ooObsObjState = oos}) = isAlien oos || isFallingGun oos

	-- dpSwitch for now. This makes kill/spawn events observable,
	-- and allows feedback without iPre *in this case*, since only the
	-- switching depends on the feedback, and hit detection does not
	-- depend on any part of the fed-back output that in turn depends on
	-- the hit detection. But this is a really fragile property!
	-- Not that notYet is needed regardless of whether pSwictch or
	-- dpSwitch is used.
{-
	game' :: IL Object -> SF (GameInput, IL ObjOutput) (IL ObjOutput)
	game' objs = dpSwitch route
			      objs
                              (arr killOrSpawn >>> notYet)
		              (\sfs' f -> game' (f sfs'))
-}
	-- Slightly more efficient, and maybe clearer?
	game' :: IL Object -> SF (GameInput, IL ObjOutput) (IL ObjOutput)
	game' objs = 
            dpSwitch route
		     objs
                     (noEvent --> arr killOrSpawn)
		     (\sfs' f -> game' (f sfs'))

        route :: (GameInput, IL ObjOutput) -> IL sf -> IL (ObjInput, sf)
	route (gi,oos) objs = mapIL routeAux objs
	
	    where
		routeAux (k, obj) =
		    (ObjInput {oiHit = if (k) `elem` hs
				       then Event 0
				       else noEvent,
			       oiGameInput = gi},
		     obj)
		hs = hits (assocsIL (fmap ooObsObjState oos))


	-- This could be refined to full-fledged collision detection with
	-- computation of proper impulses, and merging (adding) of multiple
	-- impulses influencing a signle object.
	hits :: [(ILKey, ObsObjState)] -> [ILKey]
	hits kooss = concat (hitsAux kooss)
	    where
		hitsAux [] = []
		hitsAux ((k,oos):kooss) =
	            [ pickObj (k,oos) (k',oos') | (k', oos') <- kooss, oos `hit` oos' ]
		    ++ hitsAux kooss

                pickObj (k1,OOSGun {oosVel = v1}) (k2,OOSGun {oosVel = v2}) = 
                    let v1x = vector2X v1; v2x = vector2X v2 in
                    if v1x < v2x then [k1] else [k2]
                pickObj (k1,_) (k2,_) = [k1,k2]
	
	        oos1 `hit` oos2
		    |    isGun oos1 && isGun oos2 
                      || isMissile oos1 && isAlien oos2
	              || isAlien oos1 && isMissile oos2 = oos1 `colliding` oos2
		    | otherwise = False
	
	killOrSpawn :: (a, IL ObjOutput) -> (Event (IL Object -> IL Object))
        killOrSpawn (_, oos) =
            foldl (mergeBy (.)) noEvent es
            where
	        es :: [Event (IL Object -> IL Object)]
                es = [ mergeBy (.)
                               (ooKillReq oo `tag` (deleteIL k))
                               (fmap (foldl (.) id . map insertIL_)
                                     (ooSpawnReq oo))
                     | (k,oo) <- assocsIL oos ]

renderScore :: Score -> HGL.Graphic
renderScore score = 
    HGL.withTextColor (colorTable ! White) $
    HGL.withTextAlignment (HGL.Left', HGL.Top) $
    HGL.text gp (show score)
    where
	gp = position2ToGPoint (Point2 worldXMin worldYMax)