--
--	Breakout game for Occade
--	Copyright (C) 2007  University of Kent
--
--	This program is free software; you can redistribute it and/or
--	modify it under the terms of the GNU General Public License as
--	published by the Free Software Foundation, either version 2 of the
--	License, or (at your option) any later version.
--
--	This program is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	General Public License for more details.
--
--	You should have received a copy of the GNU General Public License
--	along with this program.  If not, see
--	<http://www.gnu.org/licenses/>.
--

--** Breakout style game.
--
-- @module occade.breakout

#INCLUDE "occade.module"
#INCLUDE "maths.module"
#INCLUDE "shutdown.inc"
#USE "shutdown"

--{{{ constants
VAL INT WIDTH IS 640:
VAL INT HEIGHT IS 480:
VAL INT PLAY.TOP IS 20:
VAL INT PLAY.LEFT IS 40:
VAL INT PLAY.RIGHT IS 600: -- 40px border
VAL INT PLAY.WIDTH IS PLAY.RIGHT - PLAY.LEFT:
VAL INT PLAY.HEIGHT IS HEIGHT - PLAY.TOP:
VAL INT BAR.W IS 54:
VAL INT BAR.H IS 18:
VAL REAL32 BALL.START.X IS 320.0:
VAL REAL32 BALL.START.Y IS 430.0:
VAL REAL32 BALL.RADIUS IS 9.0 / 2.0:
VAL REAL32 BALL.START.VOL IS 0.71: -- vector [0.71, 0.71] gives hyp of 1
VAL INT START.LIVES IS 4:
VAL INT MAX.LIVES IS 6:
--}}}

--{{{ sprite IDs
VAL INT BAR.ID IS 1:
VAL INT BALL.ID IS 2:
VAL INT BLOCK.ID IS 3:
--}}}

--{{{ PROTOCOL BALL
--* Command to create a new ball.
-- @item x, y Initial position
-- @item dx, dy Initial velocity
PROTOCOL BALL
  CASE
    start; REAL32; REAL32; REAL32; REAL32
    stop
:
--}}}

--{{{ PROTOCOL SCORE
--* Score reports.
PROTOCOL SCORE
  CASE
    score; INT
    quit
:
--}}}

--{{{ LIVES channel bundle
--* Commands that can be sent to the lives counter
PROTOCOL LIVES.REQ
  CASE
    --* Request the current lives. This will respond with current.lives; INT
    get.lives
    --* Decrement one from the current lives.
    decrement
    --* Incrememnt one to the current lives.
    increment
    --* Ask lives counter to quit
    quit
:

--* Responses from the lives counter
PROTOCOL LIVES.RESP
  CASE
    --* Current lives held in counter. In response to get.lives
    current.lives; INT
:

--* Channel bundle for communicating with lives counter
CHAN TYPE LIVES
  MOBILE RECORD
    CHAN LIVES.REQ req?:
    CHAN LIVES.RESP resp!:
:
--}}}

--{{{ Info screens
--{{{ PROC start.text
--* Scroll a sprite into place that's displaying some text.
PROC start.text (SHARED OCCADE! occade, RESULT OCCADE.SPRITE! sprite, VAL []BYTE text, font, VAL INT x, y)
  TIMER tim:
  INT t:
  SEQ
    occade.start.sprite (occade, sprite, -1)
    sprite[req] ! load.text; text; font
    tim ? t
    SEQ i = -30 FOR y + 30
      SEQ
        sprite[req] ! move; x; i; TRUE
        t := t PLUS 700
        tim ? AFTER t
    sprite[req] ! visible; TRUE
:
--}}}

--{{{ PROC wait.for.key
--* Wait for a key to be pressed.
PROC wait.for.key (SHARED OCCADE! occade, VAL INT key, VAL []BYTE message)
  OCCADE.INPUT! input:
  OCCADE.SPRITE! sprite:
  SEQ
    start.text (occade, sprite, message,
                "images/font10x20.png", WIDTH / 2, (HEIGHT * 7) / 8)

    occade.start.input (occade, input)
    input[req] ! enable; RASTER.ET.KEYDOWN
    INITIAL BOOL waiting IS TRUE:
    WHILE waiting
      RASTER.EVENT event:
      SEQ
        input[events] ? event
        waiting := (event[id] <> key)
    occade.finish.input (input)

    occade.finish.sprite (sprite)
:
--}}}

--{{{ PROC title.screen
--* Draw the title screen.
PROC title.screen (SHARED OCCADE! occade)
  OCCADE.SPRITE! title, byline, keys, bar, ball:
  SEQ
    start.text (occade, title, "B R E A K O U T",
                "images/font10x20.png", WIDTH / 2, (HEIGHT / 4) - 12)
    start.text (occade, byline, "Concurrent programming with occam-pi",
                "images/font10x20.png", WIDTH / 2, (HEIGHT / 4) + 12)
    start.text (occade, keys, "Left and right to move",
                "images/font10x20.png", WIDTH / 2, (HEIGHT * 5) / 8)

    occade.start.sprite (occade, bar, -1)
    bar[req] ! load.image; "images/bar.png"
    bar[req] ! visible; TRUE

    occade.start.sprite (occade, ball, -1)
    ball[req] ! load.image; "images/ball.png"
    ball[req] ! visible; TRUE

    CHAN BOOL stop:
    PAR
      --{{{ wait for a keypress
      SEQ
        wait.for.key (occade, 's', "Hit s to start")
        stop ! FALSE
      --}}}
      --{{{ animate the characters
      VAL REAL32 xr IS REAL32 ROUND ((3 * WIDTH) / 8):
      VAL REAL32 yr IS REAL32 ROUND (HEIGHT / 5):
      TIMER tim:
      INT t, last.shape.time:
      SEQ
        tim ? t
        tim ? last.shape.time
        INITIAL REAL32 theta IS 0.0:
        INITIAL BOOL running IS TRUE:
        WHILE running
          SEQ
            theta := theta + 0.001
            IF
              theta > (2.0 * PI)
                theta := theta - (2.0 * PI)
              TRUE
                SKIP

            VAL INT x IS INT ROUND (xr * COS (theta)):
            VAL INT y IS INT ROUND (yr * SIN (theta)):
            SEQ
              bar[req] ! move; (WIDTH / 2) + x; (HEIGHT / 4) + y; TRUE
              ball[req] ! move; (WIDTH / 2) - x; (HEIGHT / 4) - y; TRUE

            PRI ALT
              stop ? running
                SKIP
              tim ? AFTER t PLUS 1000
                t := t PLUS 1000
      --}}}

    occade.finish.sprite (title)
    occade.finish.sprite (byline)
    occade.finish.sprite (keys)
    occade.finish.sprite (bar)
    occade.finish.sprite (ball)
:
--}}}

--{{{ PROC level.screen
--* Draw the start-of-level message.
PROC level.screen (SHARED OCCADE! occade, VAL INT level)
  OCCADE.SPRITE! text:
  MOBILE []BYTE s:
  SEQ
    s := "Level "
    occade.append.int (s, level)
    start.text (occade, text, s, "images/font10x20.png", WIDTH / 2, HEIGHT / 2)
    occade.delay (500000)
    occade.finish.sprite (text)
:
--}}}

--{{{ PROC death.screen
--* Draw the death screen.
PROC death.screen (SHARED OCCADE! occade, VAL INT score)
  OCCADE.SPRITE! message, score.display:
  MOBILE []BYTE s:
  SEQ
    start.text (occade, message, "You ran out of lives.",
                "images/font10x20.png", WIDTH / 2, HEIGHT / 4)

    s := "You scored "
    occade.append.int (s, score)
    occade.append.string (s, " points")
    start.text (occade, score.display, s,
                "images/font10x20.png", WIDTH / 2, (HEIGHT * 5) / 8)

    --explosion (occade, WIDTH / 2, HEIGHT / 2, 200)

    wait.for.key (occade, 's', "Hit s to continue")

    occade.finish.sprite (message)
    occade.finish.sprite (score.display)
:
--}}}
--}}}

--{{{ PROC scorekeeper
--* Keep track of the score, and render the score display.
PROC scorekeeper (SHARED OCCADE! occade, CHAN SCORE in?, INT score)
  OCCADE.SPRITE! score.display:
  SEQ
    occade.start.sprite (occade, score.display, -1)
    score.display[req] ! move; 450; 3; FALSE
    score.display[req] ! visible; TRUE

    INITIAL BOOL running IS TRUE:
    WHILE running
      MOBILE []BYTE s:
      SEQ
        s := "Score: "
        occade.append.int (s, score)
        score.display[req] ! load.text; s; "images/font10x20.png"

        in ? CASE
          INT n:
          score; n
            score := score + n
          quit
            running := FALSE
    occade.finish.sprite (score.display)
:
--}}}

--{{{ PROC lives.counter
--* Keep track of current lives and render a lives display.
PROC lives.counter (SHARED OCCADE! occade, LIVES? in)
  INITIAL INT cur.lives IS START.LIVES:
  MOBILE []OCCADE.SPRITE! sprite:
  SEQ
    sprite := MOBILE [MAX.LIVES]OCCADE.SPRITE!
    SEQ i = 0 FOR MAX.LIVES
      SEQ
        occade.start.sprite (occade, sprite[i], -1)
        sprite[i][req] ! move; 6; 465 - (i * 20); FALSE
        sprite[i][req] ! visible; TRUE
        IF
          i < cur.lives
            sprite[i][req] ! load.image; "images/lifeyes.png"
          TRUE
            sprite[i][req] ! load.image; "images/lifeno.png"

    INITIAL BOOL running IS TRUE:
    WHILE running
      SEQ
        in[req] ? CASE
          get.lives
            in[resp] ! current.lives; cur.lives
          decrement
            IF
              cur.lives > 0
                SEQ
                  cur.lives := cur.lives - 1
                  sprite[cur.lives][req] ! load.image; "images/lifeno.png"
              TRUE
                cur.lives := -1
          increment
            IF
              cur.lives < MAX.LIVES
                SEQ
                  sprite[cur.lives][req] ! load.image; "images/lifeyes.png"
                  cur.lives := cur.lives + 1
              TRUE
                SKIP
          quit
            SEQ
              running := FALSE
              cur.lives := -1
    SEQ i = 0 FOR MAX.LIVES
      occade.finish.sprite (sprite[i])
:
--}}}

--{{{ PROC ball
--* Animate a ball bouncing around the screen.
PROC ball (SHARED OCCADE! occade, SHARED SHUTDOWN.CTL! shutdown, 
           VAL INT id, VAL REAL32 n.x, n.y, n.dx, n.dy,
           SHARED CHAN BALL new.ball!)
  SHUTDOWN! shutdown.cli:
  OCCADE.SPRITE! sprite:
  INT n:
  INITIAL REAL32 x IS n.x:
  INITIAL REAL32 y IS n.y:
  INITIAL REAL32 dx IS n.dx:
  INITIAL REAL32 dy IS n.dy:
  VAL REAL32 min.x IS (REAL32 ROUND PLAY.LEFT) + BALL.RADIUS:
  VAL REAL32 max.x IS (REAL32 ROUND PLAY.RIGHT) - BALL.RADIUS:
  VAL REAL32 min.y IS (REAL32 ROUND PLAY.TOP) + BALL.RADIUS:
  VAL REAL32 max.y IS (REAL32 ROUND HEIGHT) - BALL.RADIUS:
  TIMER tim:
  INT t:
  SEQ
    occade.start.sprite (occade, sprite, id)
    sprite[req] ! load.image; "images/ball.png"
    sprite[req] ! visible; TRUE
    sprite[req] ! collisions; TRUE

    shutdown.connect (shutdown, shutdown.cli)

    occade.random (occade, 2, n)
    IF
      n = 1
        dx := (-1.0) * dx
      TRUE
        SKIP

    INITIAL BOOL alive IS TRUE: 
    WHILE alive
      SEQ
        sprite[req] ! move; INT ROUND x; INT ROUND y; TRUE


        --{{{ delay, while reading collision events
        -- This is one way of handling collision reporting -- most sprite
        -- behaviours are going to have a delay in them somewhere, so while
        -- your process would otherwise be twiddling its thumbs it can catch up
        -- on all the collisions that have happened lately.
        tim ? t
        INITIAL BOOL waiting IS TRUE:
        WHILE waiting
          PRI ALT
            OCCADE.COLLISION coll:
            sprite[collisions] ? coll
              CASE coll[id]
                --{{{ Bounce off the bar
                BAR.ID
                  #IF FALSE
                  REAL32 n.y:
                  REAL32 n.x:
                  SEQ
                    --{{{ Here be maths
                    -- Create a normal between the centre of the bar and the
                    -- ball. Reflect dx/dy of ball around this normal. Odd
                    -- effects when the ball comes in steep near the middle.
                    -- Messy and hard to predict for the player. Can get very
                    -- shallow balls that take ages to reach the blocks.

                    -- normal.y = bar.y + bar.heigh/2 - ball.y
                    n.y := ((REAL32 ROUND coll[y]) + ((REAL32 ROUND coll[h]) / 2.0)) - y
                    -- normal.x = bar.x + bar.width/2 - ball.x
                    n.x := ((REAL32 ROUND coll[x]) + ((REAL32 ROUND coll[w]) / 2.0)) - x
                    dx := COS ((2.0 * ATAN (n.y / n.x)) - ATAN (dy / dx))
                    dy := -SQRT (1.0 - (dx*dx))
                    -- }}}
                  #ELSE
                  REAL32 ox:
                  SEQ
                    --{{{ Method of bar bounce used by lbreakout2.
                    -- Ignore ball's incoming vector and just bounce depending
                    -- on where on the bar it hit. Will always exit between 45
                    -- and 135 degs.
                    ox := x - (REAL32 ROUND coll[x])
                    IF
                      ox < 0.0
                        dx, dy := -BALL.START.VOL, -BALL.START.VOL
                      ox > (REAL32 ROUND coll[w])
                        dx, dy := BALL.START.VOL, -BALL.START.VOL
                      REAL32 theta:
                      TRUE
                        SEQ
                          -- theta = offset.x / bar.width * pi/2 + pi/4
                          --  (degrees: offset.x / bar.width * 90 + 45)
                          theta := ((ox / (REAL32 ROUND coll[w])) * 1.57) + 0.785
                          -- negate x so balls bounce away from the bar centre
                          dx := -COS (theta)
                          -- negate y so balls bounce up the screen
                          dy := -SIN (theta)
                    --}}}
                  #ENDIF
                  --dy := -ABS (dy) -- simply send the ball back up
                --}}}
                --{{{ bounce off a block
                VAL INT sx IS INT ROUND x:
                VAL INT sy IS INT ROUND y:
                BLOCK.ID
                  SEQ
                    IF 
                      sx < coll[x]
                        dx := -ABS (dx)
                      sx > (coll[x] + coll[w])
                        dx := ABS (dx)
                      TRUE
                        SKIP
                    IF
                      sy < coll[y]
                        dy := -ABS (dy)
                      sy > (coll[y] + coll[h])
                        dy := ABS (dy)
                      TRUE
                        SKIP
                --}}}
                ELSE
                  SKIP
            BOOL b:
            shutdown.cli[kill] ? b
              SEQ
                waiting := FALSE
                alive := FALSE
            tim ? AFTER t PLUS 3000
              waiting := FALSE
        --}}}

        -- Update coordinates
        x, y := x + dx, y + dy
        IF
          x <= min.x
            x, dx := min.x, ABS (dx)
          x >= max.x
            x, dx := max.x, -ABS (dx)
          TRUE
            SKIP
        IF
          y <= min.y
            y, dy := min.y, ABS (dy)
          y >= max.y
            -- Fall off the bottom
            alive := FALSE
          TRUE
            SKIP

    shutdown.finish (shutdown.cli)
    occade.finish.sprite (sprite)

    CLAIM new.ball!
      new.ball ! stop
:
--}}}

--{{{ PROC ball.factory
PROC ball.factory (SHARED OCCADE! occade, SHARED SHUTDOWN.CTL! shutdown, 
                   SHARED CHAN BALL out!, CHAN BALL in?)
  INITIAL INT num.balls IS 0:
  INITIAL BOOL running IS TRUE:
  WHILE running
    SEQ
      in ? CASE
        REAL32 x, y, dx, dy:
        start; x; y; dx; dy
          SEQ
            FORK ball (occade, shutdown, BALL.ID, x, y, dx, dy, out!)
            num.balls := num.balls + 1
        stop
          num.balls := num.balls - 1

      running := num.balls > 0
:
--}}}

--{{{ PROC bar
PROC bar (SHARED OCCADE! occade, CHAN BOOL quit?)
  OCCADE.INPUT! input:
  OCCADE.SPRITE! sprite:
  TIMER tim:
  INT last.update:
  SEQ
    occade.start.input (occade, input)
    input[req] ! enable; RASTER.ET.KEYDOWN \/ RASTER.ET.KEYUP

    occade.start.sprite (occade, sprite, BAR.ID)
    sprite[req] ! load.image; "images/bar.png"
    sprite[req] ! visible; TRUE
    sprite[req] ! collisions; FALSE

    tim ? last.update

    VAL INT update.time IS 3000:
    INITIAL INT x IS WIDTH / 2:
    INITIAL INT y IS (HEIGHT - BAR.H) - 13:
    INITIAL INT dir IS 0:
    INITIAL BOOL running IS TRUE:
    WHILE running
      PROC move ()
        SEQ
          x := occade.clamp.int (x + dir, PLAY.LEFT + (BAR.W / 2), PLAY.WIDTH - BAR.W)
          sprite[req] ! move; x; y; TRUE
      :
      PRI ALT
        RASTER.EVENT event:
        input[events] ? event
          --{{{
          CASE event[type]
            RASTER.ET.KEYDOWN
              --{{{
              CASE event[id]
                SDLK.LEFT
                  SEQ
                    dir := -1
                    move ()
                SDLK.RIGHT
                  SEQ
                    dir := 1
                    move ()
                ELSE
                  SKIP
              --}}}
            RASTER.ET.KEYUP
              --{{{
              CASE event[id]
                SDLK.LEFT
                  IF
                    dir = (-1)
                      dir := 0
                    TRUE
                      SKIP
                SDLK.RIGHT
                  IF
                    dir = 1
                      dir := 0
                    TRUE
                      SKIP
                ELSE
                  SKIP
              --}}}
          --}}}
        BOOL a:
        quit ? a
          running := FALSE
        tim ? AFTER last.update PLUS update.time
          --{{{
          SEQ
            move ()
            last.update := last.update PLUS update.time
          --}}}
    occade.finish.sprite (sprite)
    occade.finish.input (input)
:
--}}}

--{{{ PROC block
PROC block (SHARED OCCADE! occade, SHARED SHUTDOWN.CTL! shutdown, 
            SHARED CHAN SCORE scores!, VAL INT x, y)
  SHUTDOWN! shutdown.cli:
  OCCADE.SPRITE! sprite:
  SEQ
    occade.start.sprite (occade, sprite, BLOCK.ID)
    sprite[req] ! load.image; "images/block.png"
    sprite[req] ! visible; TRUE
    sprite[req] ! collisions; TRUE
    sprite[req] ! move; x; y; FALSE
    
    shutdown.connect (shutdown, shutdown.cli)

    INITIAL BOOL alive IS TRUE:
    WHILE alive
      PRI ALT
        OCCADE.COLLISION coll:
        sprite[collisions] ? coll
          CASE coll[id]
            BALL.ID
              SEQ
                alive := FALSE
                CLAIM scores!
                  scores ! score; 100
            ELSE
              SKIP
        BOOL b:
        shutdown.cli[kill] ? b
          alive := FALSE

    shutdown.finish (shutdown.cli)
    occade.finish.sprite (sprite)
:
--}}}

--{{{ PROC play.level
PROC play.level (SHARED OCCADE! occade, SHARED SHUTDOWN.CTL! shutdown,
                 VAL INT level, SHARED CHAN SCORE scores!)
  FORKING
    CASE level
      1
        FORK block (occade, shutdown, scores!, 300, 60)
      ELSE
        PAR y = 60 FOR 8 STEP 20
          PAR x = 80 FOR 12 STEP 40
            FORK block (occade, shutdown, scores!, x, y)
:
--}}}

--{{{ PROC play.round
--* Play a round of the game (i.e. until the user wins or loses).
-- @param occade Occade handle.
-- @param level Current level.
-- @param scores Channel to score board.
-- @param result TRUE if player won (destroyed all blocks) or FALSE if player
-- lost all lives.
-- @param lives Number of lives the player has left.
PROC play.round (SHARED OCCADE! occade, VAL INT level,
                 SHARED CHAN SCORE scores!, SHARED LIVES! lives,
                 BOOL result)
  CHAN BOOL bar.quit, all.lives, all.block, quit:
  SHARED SHUTDOWN.CTL! ball.shutdown, block.shutdown:
  SEQ
    start.shutdown.server (ball.shutdown)
    start.shutdown.server (block.shutdown)

    PAR
      --{{{ Run until lives run out
      INT cur.lives:
      SEQ
        CLAIM lives
          SEQ
            lives[req] ! get.lives
            lives[resp] ? CASE current.lives; cur.lives
        WHILE cur.lives >= 0
          SEQ
            occade.delay (1000000)

            SHARED! CHAN BALL new.ball:
            PAR
              ball.factory (occade, ball.shutdown, new.ball!, new.ball?)
              CLAIM new.ball!
                new.ball ! start; BALL.START.X; BALL.START.Y; 
                                  BALL.START.VOL; -BALL.START.VOL
            PRI ALT
              BOOL b:
              quit ? b -- Player won
                cur.lives := -1
              SKIP
                CLAIM lives
                  SEQ
                    lives[req] ! decrement
                    lives[req] ! get.lives
                    lives[resp] ? CASE current.lives; cur.lives
        CLAIM ball.shutdown
          ball.shutdown[req] ! quit
        all.lives ! TRUE
      --}}}

      --{{{ Run until blocks run out
      SEQ
        play.level (occade, block.shutdown, level, scores!)
        CLAIM block.shutdown
          block.shutdown[req] ! quit
        all.block ! TRUE
      --}}}

      bar (occade, bar.quit?)

      ALT
        --{{{ All blocks were destroyed, thus player won.
        BOOL b:
        all.block ? b
          PAR
            quit ! TRUE -- inform WHILE loop to quit
            CLAIM ball.shutdown
              ball.shutdown[req] ! kill -- kill balls
            bar.quit ! TRUE -- Kill bar
            all.lives ? b -- Wait for balls to die and WHILE loop to finish
            result := TRUE
        --}}}
        --{{{ All lives lost, player loses
        BOOL b:
        all.lives ? b
          SEQ
            CLAIM block.shutdown
              block.shutdown[req] ! kill -- Kill blocks
            bar.quit ! TRUE  -- Kill bar
            all.block ? b -- Wait for blocks to quit
            result := FALSE
        --}}}
:
--}}}

--{{{ PROC main
--* Entry point.
PROC main ()
  SHARED OCCADE! occade:
  INITIAL OCCADE.PARAMS params IS occade.default.params:
  SEQ
    params[width] := WIDTH
    params[height] := HEIGHT
    occade.start (occade, params, "Occade demo")

    occade.load.playfield (occade, "images/breakoutbg.png", 0, 0)

    FORKING
      WHILE TRUE
        INITIAL INT score IS 0:
        LIVES? lives.svr:
        SHARED LIVES! lives.cli:
        SEQ
          title.screen (occade)
          lives.svr, lives.cli := MOBILE LIVES

          SHARED! CHAN SCORE scores:
          PAR
            scorekeeper (occade, scores?, score)
            lives.counter (occade, lives.svr)
            SEQ
              INITIAL BOOL alive IS TRUE:
              INITIAL INT level IS 1:
              WHILE alive
                SEQ
                  level.screen (occade, level)
                  play.round (occade, level, scores!, lives.cli, alive)
                  level := level +1
              CLAIM scores!
                scores ! quit
              CLAIM lives.cli
                lives.cli[req] ! quit

          death.screen (occade, score)
:
--}}}
