Re: Fruit & Co

--
-- A simple implementation of a space invaders game in Fruit
--
-- Author: Antony Courtney, 06 Feb. 03
--
-- In response to a message on the Haskell GUI list <[email protected]>
-- by George Russell of 04 Feb 2003.

module SpaceInvaders where

import Haven
import GUI
import Random
import List
import AFRPSimUtils
import GUISimUtils

-- N.B.:  I'll try to develop this in a modular way from the original
-- specification, developing some individual components that can
-- be tested and reused independently of one another as much as possible.

-- Simple graphics stuff:
-- walls:
rpath :: Point -> Double -> Double -> Path
rpath pt w h = outline $ rectangle pt w h

vWalls :: Path
vWalls = rpath (point 0 0) 10 500
	<++> rpath (point 400 0) 10 500

wallPath :: Path
wallPath = vWalls

wallPic :: Picture
wallPic = withColor black $ picFill wallPath


-- the outline of an invader centered at (xpos,ypos), with heading theta.
-- We'll rotate the triangle so that it points in the direction of the
-- heading:
invaderPath :: Double -> Double -> Double -> Path
invaderPath xpos ypos theta = 
  translate (vector xpos ypos) %$ rotate (-theta) %$ 
    polygon [point (-15) (-10),point 15 0,point (-15) 10]

-- render invaders in red:
renderInvader :: Path -> Picture
renderInvader invader = withColor red $ picFill invader

-- First, let's construct an animation of a ship that accelerates in the
-- direction specified by accTheta.
-- Since we know that accTheta will eventually be a time-varying input,
-- we specify it as an input signal rather than a (static) argument.
simpleInvader :: Double -> Point -> SF Double Path
simpleInvader gameSpeed pt0 = proc accTheta -> do
  rec -- accelerate in x faster than in y:
      vx <- integral -< 3 * gameSpeed * cos accTheta
      vy <- integral -< (-gameSpeed) * sin accTheta
      xi <- integral -< vx
      yi <- integral -< vy
      let xpos = (pointX pt0) + xi
	  ypos = (pointY pt0) + yi
      let invader = invaderPath xpos ypos accTheta
  returnA -< invader

-- An executable test of simpleInvader:
invTest0 :: GUI () ()
invTest0 = proc (gin,_) -> do
  inv <- simpleInvader 50 (point 250 0) -< ((-pi) / 6)
  returnA -< (renderInvader inv,())

-- According to the spec, an alien is a triangular space ship that can
-- change between one of three directions at random.
--
-- We'll maintain two random signals:  One will tell us whether or
-- not to change direction, and the other will tell us what the new
-- heading should be.
randomInvader :: (RandomGen g) => g -> Double -> Point -> SF () Path
randomInvader g gameSpeed pt0 = proc _ -> do
  rec rs <- randomRsf (1 :: Int,100) g -< ()
      changeDirE <- edge -< (rs < (round (p * 100)))
      ds <- randomRsf (0,2) g -< ()
      let newDirE = changeDirE `tag` (headings !! ds)
      theta <- hold ((-pi)/4) -< newDirE
      invader <- simpleInvader gameSpeed pt0 -< theta
  returnA -< invader
  where
    headings = [ ((-pi) * (3/4)), ((-pi) / 2), ((-pi) / 4)]
    p = 0.07 -- instantaneous probability of change in direction

invTest1 :: (RandomGen g) => g -> GUI () ()
invTest1 g = proc (gin,_) -> do
  inv <- randomInvader g 20 (point 250 0) -< ()
  returnA -< (renderInvader inv,())

-- Now let's make the invader bounce off of the walls.
--
-- All we need to do here is detect when we hit a wall (x position crosess
-- below left wall or above right wall) and create an impulse in the
-- acceleration (which leads to a sudden step in velocity).  We'll use
-- the impulseIntegral utility signal function for this.  (There is no
-- "magic" in this utility function; See Paddleball implementation in
-- Hudak's book or the fruit paper for a similar "bounce" effect).
-- The code here is copied from simpleInvader, with a few minor changes
-- to use impulseIntegral in place of integral for computing x velocity.
bounceInvader :: Double -> Point -> SF Double Path
bounceInvader gameSpeed pt0 = proc accTheta -> do
  rec -- accelerate in x faster than in y:
      let ax = 3 * gameSpeed * cos accTheta
      vx <- impulseIntegral -< (ax, xbounce)
      vy <- integral -< (-gameSpeed) * sin accTheta
      xi <- integral -< vx
      yi <- integral -< vy
      let xpos = (pointX pt0) + xi
	  ypos = (pointY pt0) + yi
      hitL <- edge -< xpos < 15
      hitR <- edge -< xpos > 400
      -- We use the velocity just before the time of impact to compute
      -- the impulse:
      dvx <- iPre 0 -< vx
      let xbounce = (hitL `merge` hitR) `tag` (-2 * dvx)
      let invader = invaderPath xpos ypos accTheta
  returnA -< invader

invTest2 :: GUI () ()
invTest2 = proc (gin,_) -> do
  inv <- bounceInvader 50 (point 250 0) -< ((-pi) * 0.75)
  returnA -< (renderInvader inv,())

-- Now let's just use "bounceInvader" in place of "simpleInvader" in
-- the implementation of randomInvader:
rbounceInvader :: (RandomGen g) => g -> Double -> Point -> SF () Path
rbounceInvader g gameSpeed pt0 = proc _ -> do
  rec rs <- randomRsf (1 :: Int,100) g -< ()
      changeDirE <- edge -< (rs < (round (p * 100)))
      ds <- randomRsf (0,2) g -< ()
      let newDirE = changeDirE `tag` (headings !! ds)
      theta <- hold ((-pi)/4) -< newDirE
      invader <- bounceInvader gameSpeed pt0 -< theta
  returnA -< invader
  where
    headings = [ ((-pi) * (3/4)), ((-pi) / 2), ((-pi) / 4)]
    p = 0.07 -- instantaneous probability of change in direction

invTest3 :: (RandomGen g) => g -> GUI () ()
invTest3 g = proc (gin,_) -> do
  inv <- rbounceInvader g 20 (point 250 0) -< ()
  returnA -< (renderInvader inv,())

-- The player's gun, centered at the given x position:
gunPath :: Double -> Path
gunPath xpos =
  outline $ rectangle (point (xpos - 15) 450) 30 20

renderGun :: Path -> Picture
renderGun gun = withColor blue $ picFill gun

gunTest0 :: GUI () ()
gunTest0 = proc (gin,_) -> do
  mpos <- ginMouse -< gin
  let gunPic = renderGun (gunPath (pointX mpos))
  returnA -< (gunPic,())


-- Let's assemble these components into a game, using the basic 
-- simulation framework provided by GUISimUtils.
--

-- Recall that, in Fruit, a GUI is just:
--   GUI a b = SF (GUIInput,a) (Picture,b)

-- Our simulation framework provides a small amount of infrastructure
-- (built around AFRP's pSwitch combinator) for simulations composed of
-- a time-varying collection of signal functions.  The user needs only
-- to specify the initial collection, a signal function that specifies
-- when to add a new element to the collection, and a function (applied
-- pointwise) to determine when an element should be removed from the
-- collection.

--
-- Each simulated entity has type:
--  SimGUI a b = SF ((GUIInput,a),[b]) (Picture,b)
--
-- This is almost identical to the (GUI a b), but the input signal to 
-- a SimGUI includes a [b]; this is a delayed, fed-back view of the entire
-- simulated world, which allows simulated entities to react to other
-- entities in the simulation.

-- In addition to a Picture, each SimGUI produces an output signal
-- carrying the individual GUI's contribution to the game universe,
-- collected together in the following algebraic data type:
--

data GameObject = Invader { objPath :: Path,
                            objKilled :: Event (), -- hit by a bullet
                            invLanded :: Event () -- game over!
			   }
		| Bullet { objPath :: Path,
			   objKilled :: Event () -- hit an invader
			 }
		| Gun { objPath :: Path, 
			objKilled :: Event (), -- never
			gunFired :: Event Double 
		      }

-- some useful auxiliary functions on GameObjects:
isGunshot :: GameObject -> Bool
isGunshot g@(Gun {}) = isEvent (gunFired g)
isGunshot _ = False

isDeadInvader :: GameObject -> Bool
isDeadInvader g@(Invader {}) = isEvent (objKilled g)
isDeadInvader _ = False

isLandedInvader :: GameObject -> Bool
isLandedInvader g@(Invader {}) = isEvent (invLanded g)
isLandedInvader _ = False

isBullet :: GameObject -> Bool
isBullet (Bullet {}) = True
isBullet _ = False

isInvader :: GameObject -> Bool
isInvader (Invader {}) = True
isInvader _ = False

bulletPaths :: [GameObject] -> [Path]
bulletPaths = map objPath . filter isBullet

invaderPaths :: [GameObject] -> [Path]
invaderPaths = map objPath . filter isInvader

hitAny :: [Path] -> Path -> Bool
hitAny paths tpath = or $ map (\p -> intersectsRect p (bounds tpath)) paths

-- An invader as a SimGUI.  Note that the output signal is a GameObject,
-- and the input signal includes a list of GameObject (an observation of
-- the other members of the dynamic collection).
--
mkInvader :: (RandomGen g) => g -> Double -> Point -> SimGUI () GameObject
mkInvader g gameSpeed pt0 = proc ((gin,_),world) -> do
  invader <- rbounceInvader g gameSpeed pt0 -< ()
  hitGround <- edge -< pointY (rectPointA (bounds invader)) > 420
  hitBullet <- edge -< hitAny (bulletPaths world) invader
  returnA -< (renderInvader invader,
	      Invader { objPath = invader,
			invLanded = hitGround,
			objKilled = hitBullet
		      })

gun :: SimGUI () GameObject
gun = proc ((gin,_),_) -> do
  mpos <- ginMouse -< gin
  lbp <- ginLbp -< gin
  let gunPos = pointX mpos
      gpath = gunPath gunPos
  returnA -< (renderGun gpath,
	      Gun { objPath = gpath,
		    objKilled = noEvent,
		    gunFired = (lbp `tag` gunPos)
		  })

-- A bullet, located at (x,y)
bulletPath :: Double -> Double -> Path
bulletPath x y =
  outline $ rectangle (point (x-2.5) (y-5)) 5 10

renderBullet :: Path -> Picture
renderBullet b = withColor yellow $ picFill b

-- A simple, constant velocity bullet:
simpleBullet :: Double -> SF () Path
simpleBullet xpos = proc _ -> do
  yi <- integral -< (-150)
  let ypos = yi + 450
  returnA -< bulletPath xpos ypos

bullet :: Double -> SimGUI () GameObject
bullet xpos = proc ((gin,_),world) -> do
  b <- simpleBullet xpos -< ()
  hitInvader <- edge -< hitAny (invaderPaths world) b
  returnA -< (renderBullet b,
	      Bullet { objPath = b,
		       objKilled = hitInvader
		     })

-- And now just invoke the guiSimulator, passing as arguments an initial 
-- world, a signal function that spawns new bullets, and a function to
-- determine when invaders or bullets die.
--

-- This version implements just a single invader that dies when hit
-- by a bullet:
--
basicInvaders :: (RandomGen g) => g -> Double -> GUI () ()
basicInvaders g gameSpeed = proc (gin,_) -> do
  (pic,objs) <- guiSimulator_ world0 spawnsf 
		 (isEvent . objKilled) -< (gin,())
  returnA -< (pic <++> wallPic,())
  where
    world0 =  [mkInvader g gameSpeed (point 250 0), gun ]

    -- A signal function that observes the external input and the collection
    -- output and produces an event when a new signal function should be
    -- spliced in to the collection.
    --
    -- For SpaceInvaders, we examine the world for any shots fired
    -- from any guns, and use this to spawn a bullet from the location of
    -- the shot.
    spawnsf :: SF ((),[GameObject])
                  (Event [SimGUI () GameObject])
    spawnsf = proc (_,world) -> do
      let -- spawnE :: Event [GUI () GameObject]
          spawnE = maybe noEvent (\g -> fmap ((:[]) . bullet) (gunFired g))
                      (find isGunshot world)
      returnA -< spawnE

-- A slightly more sophisticated version; here we will spawn a new
-- invader every time an invader is killed, and we keep track of score:
multiInvaders :: (RandomGen g) => g -> Double -> GUI () ([GameObject],Int)
multiInvaders g gameSpeed = proc (gin,_) -> do
  (pic,(objs,score)) <- guiSimulator world0 spawnsf 
		  	(isEvent . objKilled) accScore 0 -< (gin,())
  returnA -< (pic <++> wallPic,(objs,score))
  where
    -- let's also have a few more invaders at the start, to add to the
    -- challenge:
    world0 =  [mkInvader g gameSpeed (point 50 0), 
	       mkInvader g gameSpeed (point 150 0), 
	       mkInvader g gameSpeed (point 350 0), 
	       gun ]

    -- A signal function that observes the external input and the collection
    -- output and produces an event when a new signal function should be
    -- spliced in to the collection.
    --
    -- For SpaceInvaders, we examine the world for any shots fired
    -- from any guns, and use this to spawn a bullet from the location of
    -- the shot.
    spawnsf :: SF ((),[GameObject])
                  (Event [SimGUI () GameObject])
    spawnsf = proc (_,world) -> do
      nextypos <- randomRsf (50,350) g -< ()
      let spawnBulletE = maybe noEvent (\gun -> fmap ((:[]) . bullet) 
              					(gunFired gun))
			 (find isGunshot world)
	  spawnInvaderE = maybe noEvent 
                                (\inv -> objKilled inv `tag`
				         [mkInvader g gameSpeed 
						      (point nextypos 0)])
			  (find isDeadInvader world)
          spawnE = mergeBy (++) spawnBulletE spawnInvaderE
      returnA -< spawnE
    accScore score obj =
      if (isInvader obj) then score+1 else score

-- Now, let's add detection of when the game is over (due to an alien
-- succesfully landing), and an extra "gameOver" state that will nicely
-- display the user's score (over a snapshot of the Picture of the
-- in-progress game) and allow the user to restart the game.
--
-- Note that we all of this functionality is added as a wrapper around
-- multiInvaders; no cut and paste required.
--

-- We use the "kSwitch" combinator here to construct a simple state machine,
-- running the game until an invader lands, and then switching into a
-- "gameOver" GUI until the user restarts the game.  kSwitch has the
-- signature:
--    kSwitch  :: SF a b                -- SF to run initially
--                -> SF (a,b) (Event c) -- tells us when to switch
--                -> (SF a b -> c -> SF a b) -- determines what we switch into
--                -> SF a b
--
invaders :: (RandomGen g) => g -> Double 
	          -> GUI () (Maybe ([GameObject],Int))
invaders rgen gameSpeed = 
  kSwitch maybeInvaders checkLanding (gameOver rgen gameSpeed)
  where
    -- A lifting of the output sample to maybe type:
    maybeInvaders :: GUI () (Maybe ([GameObject],Int))
    maybeInvaders = proc (gin,_) -> do
      rec (pic,(world,score)) <- multiInvaders rgen gameSpeed -< (gin,())
      returnA -< (pic,Just (world,score))
    -- A signal function to check whether any invader has
    -- succesfully landed, indicating that the game is over:
    checkLanding :: SF ((GUIInput,()),(Picture,Maybe ([GameObject],
						      Int))) 
		       (Event (Picture,Int))
    checkLanding = proc ((gin,_),(pic,Just (world,score))) -> do
      let landed = any isLandedInvader world
      gameOverE <- edge -< landed
      returnA -< (gameOverE `tag` (pic,score))

gameOver :: (RandomGen g) => g -> Double 
            -> (GUI () (Maybe ([GameObject],Int)))
            -> (Picture,Int)
            -> (GUI () (Maybe ([GameObject],Int)))
gameOver rgen gameSpeed _ (gpic,score) = 
  kSwitch scoreGUI checklbp (\_ _ -> invaders rgen gameSpeed)
  where
    checklbp = proc ((gin,_),_) -> do
      ginLbp -< gin
    scoreGUI = proc (gin,_) -> do
      returnA -< (scorePic gpic score, Nothing)
    -- place game over message over the picture of the game:
    scorePic :: Picture -> Int -> Picture
    scorePic bg score =
      let f_SS_b = font "SansSerif" bold 28
      in (place (point 20 100) $ withColor black $ withFont f_SS_b $
	  (picText "GAME OVER!" 
	   `vcomp` picText ("Your Score: " ++ show score)
	   `vcomp` picText "Press mouse button"
           `vcomp` picText "to play again."))
         <++> bg