--
--	Occade
--	Copyright (C) 2007  University of Kent
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation, either
--	version 2 of the License, or (at your option) any later version.
--
--	This library 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
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library.  If not, see
--	<http://www.gnu.org/licenses/>.
--

--** @module occade

-- To do:
-- - Z ordering

#INCLUDE "occSDL.module"
#INCLUDE "file.module"
#INCLUDE "course.module"
#INCLUDE "raster.module"
#INCLUDE "rasterio.module"
#INCLUDE "sdlraster.module"

#INCLUDE "occade.inc"

--*{{{ PRI Process priorities
--* Priority for buffer processes.
VAL INT PRI.BUFFERS IS 10:
--* Priority for display server.
VAL INT PRI.DISPLAY IS 12:
--* Priority for sprite servers.
VAL INT PRI.SPRITES IS 14:
--* Priority for input filters.
VAL INT PRI.INPUT IS 12:
--* Priority for user processes.
VAL INT PRI.USER IS 20:
--*}}}

--{{{ PROC occade.write (VAL []BYTE s)
--* Write a string to stderr.
-- This uses direct filelib calls rather than the TLP channel interface, so
-- it can be used anywhere in your code, which may be useful for debugging.
-- @param s String to print
PROC occade.write (VAL []BYTE s)
  VAL INT STDERR IS 2:
  INT result:
  SEQ
    file.write (STDERR, s, result)
    ASSERT (result = (SIZE s))
:
--}}}

--{{{ PROC occade.write.int (VAL INT n)
--* Write an integer to stderr.
-- See [@ref occade.write].
-- @param n Integer to print
PROC occade.write.int (VAL INT n)
  [20]BYTE s:
  INITIAL INT i IS 0:
  INITIAL INT n IS n:
  SEQ
    IF
      n < 0
        SEQ
          occade.write ("-")
          n := -n
      TRUE
        SKIP
    i := (SIZE s) - 1
    WHILE n >= 10
      SEQ
        s[i] := '0' + (BYTE (n \ 10))
        n := n / 10
        i := i - 1
    s[i] := '0' + (BYTE (n \ 10))
    occade.write ([s FROM i])
:
--}}}

--{{{ PROC occade.check.sdl (VAL BOOL cond, VAL []BYTE message)
--* Check that a condition holds; if it doesn't, print the current SDL error
-- and die.
-- @private
PROC occade.check.sdl (VAL BOOL cond, VAL []BYTE message)
  IF
    cond
      SKIP
    TRUE
      [256]BYTE error:
      INT len:
      SEQ
        occade.write (message)
        occade.write (": ")
        occ.SDL.GetError (error, SIZE error, len)
        IF
          len > 0
            occade.write ([error FOR len])
          TRUE
            occade.write ("no SDL error")
        occade.write ("*n")
        STOP
:
--}}}

--{{{ INT FUNCTION occade.clamp.int (VAL INT in, left, width)
--* Limit an integer to a particular range.
-- For example, if you call this with [@code left = 3] and [@code width = 3],
-- then the output value will be in the range [@code 3 .. 5].
-- You can use this with a sprite's coordinates to limit it to a particular
-- part of the screen.
-- @param in Input value
-- @param left The lowest value in the range
-- @param width The width of the range
INT FUNCTION occade.clamp.int (VAL INT in, left, width)
  INT out:
  VALOF
    IF
      in < left
        out := left
      VAL INT max IS (left + width) - 1:
      in > max
        out := max
      TRUE
        out := in
    RESULT out
:
--}}}

--{{{ BOOL FUNCTION occade.same.string (VAL []BYTE a, b)
--* Compare two strings for equality.
-- @private
BOOL FUNCTION occade.same.string (VAL []BYTE a, b)
  BOOL r:
  VALOF
    IF
      (SIZE a) <> (SIZE b)
        r := FALSE
      IF i = 0 FOR SIZE a
        a[i] <> b[i]
          r := FALSE
      TRUE
        r := TRUE
    RESULT r
:
--}}}

--{{{ PROC occade.append.string (MOBILE []BYTE out, VAL []BYTE in)
--* Append a string to a string.
-- @param out String to append to.
-- @param in String that will be appended to [@code out].
PROC occade.append.string (MOBILE []BYTE out, VAL []BYTE in)
  MOBILE []BYTE new:
  SEQ
    new := MOBILE [(SIZE out) + (SIZE in)]BYTE
    [new FOR SIZE out] := out
    [new FROM SIZE out] := in
    out := new
:
--}}}

--{{{ PROC occade.append.int (MOBILE []BYTE out, VAL INT n)
--* Append a number to a string.
-- @param out String to which the decimal representation of [@code n] will be appended.
-- @param n Integer to format.
PROC occade.append.int (MOBILE []BYTE out, VAL INT n)
  [20]BYTE s:
  INITIAL INT i IS 0:
  INITIAL INT n IS n:
  INITIAL BOOL neg IS FALSE:
  SEQ
    IF
      n < 0
        SEQ
          neg := TRUE
          n := -n
      TRUE
        SKIP
    i := (SIZE s) - 1
    WHILE n >= 10
      SEQ
        s[i] := '0' + (BYTE (n \ 10))
        n := n / 10
        i := i - 1
    s[i] := '0' + (BYTE (n \ 10))
    IF
      neg
        SEQ
          i := i - 1
          s[i] := '-'
      TRUE
        SKIP
    occade.append.string(out, [s FROM i])
:
--}}}

--{{{ PROC occade.get.transparent (SDL.Surface surface, INT colour)
--* Get the Occade transparent colour for a particular surface.
-- @private
PROC occade.get.transparent (SDL.Surface surface, INT colour)
  SEQ
    SDL.PixelFormat format:
    SEQ
      get.SDL.Surface.format (format, surface)
      SDL.MapRGB (colour, format,
                  OCCADE.TRANSPARENT.COLOUR[0],
                  OCCADE.TRANSPARENT.COLOUR[1],
                  OCCADE.TRANSPARENT.COLOUR[2])
:
--}}}

--{{{ PROC occade.make.transparent (SDL.Surface surface)
--* Make an SDL surface transparent using our colour key.
-- @private
PROC occade.make.transparent (SDL.Surface surface)
  INT result, key:
  SEQ
    occade.get.transparent (surface, key)
    SDL.SetColorKey (result, surface, SDL.SRCCOLORKEY \/ SDL.RLEACCEL, key)
    occade.check.sdl (result = 0, "Failed to make surface transparent")
:
--}}}

--{{{ PROC occade.image.cache (CHAN MOBILE []BYTE in?, CHAN SDL.Surface out!)
--* Image cache: map image filenames to surfaces.
-- The cache owns the surfaces it returns, so you musn't free them yourself.
-- @private
PROC occade.image.cache (CHAN OCCADE.TO.IMAGE.CACHE in?, CHAN SDL.Surface out!)
  VAL INT MAX.IMAGES IS 100:
  INITIAL INT num.loaded IS 0:
  INITIAL MOBILE []MOBILE []BYTE names IS MOBILE [MAX.IMAGES]MOBILE []BYTE:
  [MAX.IMAGES]SDL.Surface surfaces:
  INITIAL BOOL running IS TRUE:
  WHILE running
    in ? CASE
      MOBILE []BYTE name:
      SDL.Surface surface:
      image; name
        --{{{ find or load image
        SEQ
          IF
            IF i = 0 FOR num.loaded
              occade.same.string (name, names[i])
                surface := surfaces[i]
            num.loaded < MAX.IMAGES
              --{{{ load image
              MOBILE []BYTE real.name:
              BOOL exists:
              SEQ
                --{{{  find the image
                file.check.access (name, R.OK, exists)
                IF
                  exists
                    real.name := CLONE name
                  TRUE
                    SEQ
                      real.name := ##OCCADE.DATA.DIR
                      occade.append.string (real.name, "/")
                      occade.append.string (real.name, name)
                --}}}
                IF
                  ends.with.string (".bmp", real.name)
                    --{{{  use SDL's BMP loader
                    MOBILE []BYTE namez:
                    SEQ
                      occ.SDL.zero.terminate (real.name, namez)
                      occ.SDL.LoadBMP (surface, namez)
                    --}}}
                  TRUE
                    --{{{  use rasterio
                    RASTER r:
                    SEQ
                      read.raster (real.name, r)
                      SDL.CreateRGBSurface (surface, SDL.HWSURFACE,
                                            SIZE r[0], SIZE r, 24, 0, 0, 0, 0)
                      occade.check.sdl (surface <> 0, "Creating raster image surface failed")
                      occ.SDL.blit.raster (r, 0, 0, SIZE r[0], SIZE r, surface, 0, 0)
                    --}}}
                surfaces[num.loaded] := surface
                names[num.loaded] := name
                num.loaded := num.loaded + 1
              --}}}
            TRUE
              occade.check.sdl (FALSE, "Too many images loaded")
          --{{{ check it loaded OK
          MOBILE []BYTE s:
          SEQ
            s := "Failed to load image "
            occade.append.string (s, name)
            occade.check.sdl (surface <> 0, s)
          --}}}
          occade.make.transparent (surface)
          out ! surface
        --}}}
      quit
        running := FALSE
:
--}}}

--{{{ PROC occade.display.server (OCCADE? svr, VAL OCCADE.PARAMS params)
--* The main display process that [@ref occade.start] forks off.
-- @private
PROC occade.display.server (OCCADE? svr, VAL OCCADE.PARAMS params, VAL []BYTE app.name)
  INT result:
  SDL.Surface screen, playfield:
  SDL.Event event:

  VAL INT MAX.FILTERS IS 100:
  [MAX.FILTERS]INT filter.ids:
  INITIAL MOBILE []OCCADE.FILTER.INTERNAL! filter.clis IS MOBILE [MAX.FILTERS]OCCADE.FILTER.INTERNAL!:
  INITIAL INT num.filters IS 0:
  INITIAL INT filter.id.counter IS 0:

  INITIAL BOOL is.fullscreen IS FALSE:
  --{{{  PROC toggle.fullscreen
  PROC toggle.fullscreen ()
    SEQ
      -- Ignore the error; this won't work on all displays.
      INT result:
      SDL.WM.ToggleFullScreen (result, screen)
      is.fullscreen := NOT is.fullscreen
  :
  --}}}

  --{{{ PROC process.input.events
  PROC process.input.events ()
    INITIAL BOOL running IS TRUE:
    WHILE running
      SEQ
        SDL.PollEvent (result, event)
        IF
          result = 0
            running := FALSE
          TRUE
            --{{{ got an event
            RASTER.EVENT ev:
            INITIAL BOOL transmit IS FALSE:
            SEQ
              raster.convert.event (event, ev)
              --{{{  check for special keys
              VAL INT ANY.ALT IS (KMOD.LALT \/ KMOD.RALT) \/ (KMOD.LMETA \/ KMOD.RMETA):
              IF
                ev[type] = (-1)
                  --{{{  unknown event
                  SKIP
                  --}}}
                (ev[type] = RASTER.ET.KEYDOWN) AND (ev[id] = SDLK.RETURN) AND ((ev[mod] /\ ANY.ALT) <> 0)
                  --{{{  Alt-Enter: toggle full-screen mode
                  toggle.fullscreen ()
                  --}}}
                (ev[type] = RASTER.ET.KEYDOWN) AND (ev[id] = SDLK.BACKSPACE) AND ((ev[mod] /\ ANY.ALT) <> 0)
                  --{{{  Alt-Backspace: STOP
                  SEQ
                    --{{{  leave full-screen mode first
                    IF
                      is.fullscreen
                        toggle.fullscreen ()
                      TRUE
                        SKIP
                    --}}}
                    STOP
                  --}}}
                TRUE
                  transmit := TRUE
              --}}}
              --{{{ send it to all the filters
              IF
                transmit
                  PAR i = 0 FOR num.filters
                    filter.clis[i][events] ! ev
                TRUE
                  SKIP
              --}}}
            --}}}
  :
  --}}}

  VAL INT MAX.SPRITES IS 5000:
  DATA TYPE SPRITE
    RECORD
      INT id, user.id:
      OCCADE.SPRITE.INFO info:
      SDL.Surface surface:
      BOOL free.surface:
      INT w, h:
      INT old.x, old.y, old.w, old.h:
  :
  INITIAL INT num.sprites IS 0:
  [MAX.SPRITES]SPRITE sprites:
  [MAX.SPRITES][MAX.SPRITES]BOOL is.colliding:
  INITIAL MOBILE []OCCADE.SPRITE.INTERNAL! sprite.clis IS MOBILE [MAX.SPRITES]OCCADE.SPRITE.INTERNAL!:
  INITIAL INT sprite.id.counter IS -1:

  --{{{ PROC init.sprite
  PROC init.sprite (SPRITE s)
    s := [0, -1,
          [0, 0, FALSE, FALSE, FALSE, FALSE],
          0,
          FALSE,
          0, 0,
          -1, -1, 0, 0]
  :
  --}}}
  PROC free.sprite (SPRITE s)
    IF
      s[free.surface]
        SEQ
          SDL.FreeSurface (s[surface])
          s[free.surface] := FALSE
      TRUE
        SKIP
  :
  --{{{ FUNCTION colliding
  BOOL FUNCTION colliding (VAL SPRITE a, b)
    BOOL r:
    VALOF
      VAL INT al IS a[info][x]:
      VAL INT ar IS al + a[w]:
      VAL INT at IS a[info][y]:
      VAL INT ab IS at + a[h]:
      VAL INT bl IS b[info][x]:
      VAL INT br IS bl + b[w]:
      VAL INT bt IS b[info][y]:
      VAL INT bb IS bt + b[h]:
      IF
        (ar < bl) OR (al > br)
          r := FALSE
        (ab < bt) OR (at > bb)
          r := FALSE
        TRUE
          r := TRUE
      RESULT r
  :
  --}}}
  --{{{ PROC check.collisions
  PROC check.collisions (VAL INT i)
    SEQ
      IF
        (sprites[i][user.id] < 0) OR (NOT sprites[i][info][position.set])
          --{{{ no collisions for this sprite
          SKIP
          --}}}
        (sprites[i][old.x] <> sprites[i][info][x]) OR (sprites[i][old.y] <> sprites[i][info][y])
          --{{{ scan for collisions with other sprites
          SEQ j = 0 FOR num.sprites
            IF
              i = j
                --{{{ same sprite!
                SKIP
                --}}}
              (sprites[j][user.id] < 0) OR (NOT sprites[j][info][position.set])
                --{{{ no collisions for other sprite
                SKIP
                --}}}
              colliding (sprites[i], sprites[j])
                --{{{ we've got a collision
                IF
                  is.colliding[i][j]
                    --{{{ but we've already reported it
                    SKIP
                    --}}}
                  TRUE
                    --{{{ and it's new
                    SEQ
                      is.colliding[i][j] := TRUE
                      is.colliding[j][i] := TRUE
                      IF
                        sprites[i][info][collisions]
                          --{{{ notify "this" sprite
                          VAL OCCADE.COLLISION coll IS [sprites[j][user.id],
                             sprites[j][info][x], sprites[j][info][y],
                             sprites[j][w], sprites[j][h]]:
                          sprite.clis[i][collisions] ! coll
                          --}}}
                        TRUE
                          SKIP
                      IF
                        sprites[j][info][collisions]
                        --{{{ notify "the other" sprite
                          VAL OCCADE.COLLISION coll IS [sprites[i][user.id],
                             sprites[i][info][x], sprites[i][info][y],
                             sprites[i][w], sprites[i][h]]:
                          sprite.clis[j][collisions] ! coll
                        --}}}
                        TRUE
                          SKIP
                    --}}}
                --}}}
              TRUE
                SEQ
                  is.colliding[i][j] := FALSE
                  is.colliding[j][i] := FALSE
          --}}}
        TRUE
          SKIP
  :
  --}}}

  TIMER tim:
  INT next.update:
  INITIAL INT frame.time IS 1000000 / 30:
  VAL INT UPDATE.SPRITES IS 1 << 0:
  VAL INT UPDATE.ALL IS 1 << 1:
  INITIAL INT need.update IS 0:

  --{{{ PROC update.display
  PROC update.display ()
    SEQ
      IF
        (need.update /\ UPDATE.ALL) <> 0
          --{{{ redraw entire playfield
          occ.SDL.blit (playfield, 0, 0, params[width], params[height],
                        screen, 0, 0)
          --}}}
        (need.update /\ UPDATE.SPRITES) <> 0
          --{{{ erase area covered by each sprite
          SEQ i = 0 FOR num.sprites
            SPRITE s IS sprites[i]:
            IF
              s[old.x] <> (-1)
                occ.SDL.blit (playfield, s[old.x], s[old.y], s[old.w], s[old.h],
                              screen, s[old.x], s[old.y])
              TRUE
                SKIP
          --}}}
        TRUE
          SKIP

      IF
        need.update <> 0
          SEQ
            --{{{ draw each sprite
            SEQ i = 0 FOR num.sprites
              SPRITE s IS sprites[i]:
              IF
                s[info][visible] AND ((s[surface] <> 0) AND s[info][position.set])
                  SEQ
                    occ.SDL.blit (s[surface], 0, 0, s[w], s[h],
                                  screen, s[info][x], s[info][y])
                    s[old.x], s[old.y] := s[info][x], s[info][y]
                    s[old.w], s[old.h] := s[w], s[h]
                TRUE
                  SKIP
            --}}}

            SDL.Flip (result, screen)
            occade.check.sdl (result = 0, "Flip failed")
        TRUE
          SKIP
      need.update := 0
  :
  --}}}

  INITIAL INT random.seed IS 19812509:

  SEQ
    --{{{ start up
    SETPRI (PRI.DISPLAY)

    occ.SDL.Init (result, SDL.INIT.VIDEO)
    occade.check.sdl (result = 0, "SDL startup failed")

    MOBILE []BYTE app.namez:
    SEQ
      occ.SDL.zero.terminate (app.name, app.namez)
      SDL.WM.SetCaption (app.namez, app.namez)

    SDL.SetVideoMode (screen, params[width], params[height], params[depth],
                      (SDL.HWSURFACE \/ SDL.DOUBLEBUF) \/ SDL.ANYFORMAT)
    occade.check.sdl (screen <> 0, "Setting video mode failed")

    SDL.CreateRGBSurface (playfield, SDL.HWSURFACE,
                          params[width], params[height], params[depth],
                          0, 0, 0, 0)
    occade.check.sdl (playfield <> 0, "Creating playfield surface failed")

    create.SDL.Event (event)

    SEQ i = 0 FOR MAX.SPRITES
      SEQ
        init.sprite (sprites[i])
        SEQ j = 0 FOR MAX.SPRITES
          is.colliding[i][j] := FALSE
    --}}}
    CHAN OCCADE.TO.IMAGE.CACHE to.cache:
    CHAN SDL.Surface from.cache:
    PAR
      occade.image.cache (to.cache?, from.cache!)
      --{{{ main loop
      SEQ
        tim ? next.update
        INITIAL BOOL running IS TRUE:
        WHILE running
          ALT
            svr[req] ? CASE
              MOBILE []BYTE name:
              INT x, y, w, h:
              load.playfield; name; x; y
                --{{{
                SDL.Surface surface:
                SEQ
                  to.cache ! image; name
                  from.cache ? surface
                  get.SDL.Surface.w (w, surface)
                  get.SDL.Surface.h (h, surface)
                  occ.SDL.blit (surface, 0, 0, w, h, playfield, x, y)

                  need.update := need.update \/ UPDATE.ALL
                --}}}
              RASTER r:
              INT x, y:
              draw.playfield; r; x; y
                --{{{
                SEQ
                  occ.SDL.blit.raster (r, 0, 0, SIZE r[0], SIZE r, playfield, x, y)
                  need.update := need.update \/ UPDATE.ALL
                  svr[resp] ! return.raster; r
                --}}}
              INT user.id:
              OCCADE.SPRITE.INTERNAL! cli:
              new.sprite; user.id; cli
                --{{{
                SEQ
                  occade.check.sdl (num.sprites < MAX.SPRITES, "Too many sprites created")
                  sprite.clis[num.sprites] := cli
                  SPRITE s IS sprites[num.sprites]:
                  SEQ
                    init.sprite (s)
                    s[user.id] := user.id
                    s[id] := sprite.id.counter
                    sprite.id.counter := sprite.id.counter + 1
                    svr[resp] ! new.sprite; s[id]
                  num.sprites := num.sprites + 1
                --}}}
              INT id:
              delete.sprite; id
                --{{{
                IF i = 0 FOR num.sprites
                  sprites[i][id] = id
                    SEQ
                      --{{{ move the last sprite down to this place
                      IF
                        i <> (num.sprites - 1)
                          SEQ
                            sprites[i] := sprites[num.sprites - 1]
                            sprite.clis[i] := sprite.clis[num.sprites - 1]
                        TRUE
                          SKIP
                      --}}}
                      num.sprites := num.sprites - 1
                      need.update := need.update \/ UPDATE.ALL
                --}}}
              INT id:
              MOBILE []BYTE name:
              load.sprite.image; id; name
                --{{{
                IF i = 0 FOR num.sprites
                  sprites[i][id] = id
                    SPRITE s IS sprites[i]:
                    INT n:
                    SEQ
                      free.sprite (s)
                      to.cache ! image; name
                      from.cache ? s[surface]
                      -- FIXME: Temporary variable used here to work around a KRoC bug
                      get.SDL.Surface.w (n, s[surface])
                      s[w] := n
                      get.SDL.Surface.h (n, s[surface])
                      s[h] := n
                      need.update := need.update \/ UPDATE.SPRITES
                --}}}
              INT id:
              RASTER r:
              load.sprite.raster; id; r
                --{{{
                IF
                  IF i = 0 FOR num.sprites
                    sprites[i][id] = id
                      SPRITE s IS sprites[i]:
                      SEQ
                        free.sprite (s)
                        --{{{ create a new surface
                        s[w] := SIZE r[0]
                        s[h] := SIZE r
                        SDL.CreateRGBSurface (s[surface], SDL.HWSURFACE,
                                              s[w], s[h], 24, 0, 0, 0, 0)
                        occade.check.sdl (s[surface] <> 0, "Creating raster surface failed")
                        s[free.surface] := TRUE
                        --}}}
                        occ.SDL.blit.raster (r, 0, 0, SIZE r[0], SIZE r, s[surface], 0, 0)
                        occade.make.transparent (s[surface])
                        need.update := need.update \/ UPDATE.SPRITES
                        svr[resp] ! return.raster; r
                --}}}
              INT id:
              MOBILE []BYTE text:
              MOBILE []BYTE font:
              load.sprite.text; id; text; font
                --{{{
                IF i = 0 FOR num.sprites
                  sprites[i][id] = id
                    SPRITE s IS sprites[i]:
                    INT font.w, font.h:
                    SDL.Surface font.surface:
                    SEQ
                      --{{{ fetch the font
                      to.cache ! image; font
                      from.cache ? font.surface

                      get.SDL.Surface.w (font.w, font.surface)
                      occade.check.sdl ((font.w \ 16) = 0, "Bad font image size")
                      font.w := font.w / 16
                      get.SDL.Surface.h (font.h, font.surface)
                      occade.check.sdl ((font.h \ 16) = 0, "Bad font image size")
                      font.h := font.h / 16
                      --}}}
                      --{{{ render text to a new surface
                      free.sprite (s)
                      s[w] := font.w * (SIZE text)
                      s[h] := font.h
                      SDL.CreateRGBSurface (s[surface], SDL.HWSURFACE,
                                            s[w], s[h], 24, 0, 0, 0, 0)
                      occade.check.sdl (s[surface] <> 0, "Creating text surface failed")
                      s[free.surface] := TRUE
                      INT key:
                      INITIAL SDL.Rect null IS 0:
                      SEQ
                        occade.get.transparent (s[surface], key)
                        SDL.FillRect (result, s[surface], null, key)
                        occade.check.sdl (result = 0, "Clearing text surface failed")
                      SEQ i = 0 FOR SIZE text
                        VAL INT row IS (INT text[i]) / 16:
                        VAL INT col IS (INT text[i]) \ 16:
                        occ.SDL.blit (font.surface, col * font.w, row * font.h,
                                      font.w, font.h,
                                      s[surface], i * font.w, 0)
                      occade.make.transparent (s[surface])
                      --}}}
                      need.update := need.update \/ UPDATE.SPRITES
                --}}}
              INT id:
              OCCADE.SPRITE.INFO info:
              set.sprite.info; id; info
                --{{{
                IF i = 0 FOR num.sprites
                  sprites[i][id] = id
                    SEQ
                      IF
                        info[centre]
                          SEQ
                            info[x] := info[x] - (sprites[i][w] / 2)
                            info[y] := info[y] - (sprites[i][h] / 2)
                        TRUE
                          SKIP
                      sprites[i][info] := info
                      need.update := need.update \/ UPDATE.SPRITES

                      check.collisions (i)
                --}}}
              INT id:
              get.sprite.size; id
                --{{{
                IF i = 0 FOR num.sprites
                  sprites[i][id] = id
                    svr[resp] ! get.sprite.size; sprites[i][w]; sprites[i][h]
                --}}}
              OCCADE.FILTER.INTERNAL! cli:
              attach.filter; cli
                --{{{
                SEQ
                  occade.check.sdl (num.filters < MAX.FILTERS, "Too many filters attached")
                  filter.clis[num.filters] := cli
                  filter.ids[num.filters] := filter.id.counter
                  svr[resp] ! attach.filter; filter.id.counter
                  filter.id.counter := filter.id.counter + 1
                  num.filters := num.filters + 1
                --}}}
              INT id:
              detach.filter; id
                --{{{
                IF i = 0 FOR num.filters
                  filter.ids[i] = id
                    SEQ
                      --{{{ move the last filter down to this place
                      IF
                        i <> (num.filters - 1)
                          SEQ
                            filter.ids[i] := filter.ids[num.filters - 1]
                            filter.clis[i] := filter.clis[num.filters - 1]
                        TRUE
                          SKIP
                      --}}}
                      num.filters := num.filters - 1
                --}}}
              INT range:
              random; range
                --{{{
                INT n:
                SEQ
                  n, random.seed := random (range, random.seed)
                  svr[resp] ! random; n
                --}}}
              quit
                --{{{
                -- FIXME: Need to tell all the other procs to terminate.
                SEQ
                  to.cache ! quit
                  running := FALSE
                --}}}
            tim ? AFTER next.update PLUS frame.time
              --{{{ timeout expired
              SEQ
                update.display ()
                process.input.events ()

                next.update := next.update PLUS frame.time
              --}}}
      --}}}
    --{{{ shut down
    SDL.Quit ()
    --}}}
:
--}}}

--{{{ PROC occade.start (RESULT SHARED OCCADE! handle, VAL OCCADE.PARAMS params)
--* Start up the display and return a handle for communicating with it.
-- This must be the first call your program makes into the library.
-- @param handle Occade handle, returned for other library PROCs to use
-- @param params Display parameters (see [@ref OCCADE.PARAMS])
-- @param app.name The application name
PROC occade.start (RESULT SHARED OCCADE! handle, VAL OCCADE.PARAMS params,
                   VAL []BYTE app.name)
  OCCADE? svr:
  SEQ
    handle, svr := MOBILE OCCADE
    FORK occade.display.server (svr, params, app.name)
    SETPRI (PRI.USER)
:
--}}}

--{{{ PROC occade.load.playfield (SHARED OCCADE! handle, VAL []BYTE name, VAL INT x, y)
--* Load an image onto the playfield at the given position.
-- This is intended for static background images; if you want things to overlap
-- or move around, use sprites instead.
-- @param handle Occade handle
-- @param name Image filename
-- @param x, y Top left corner coordinates
PROC occade.load.playfield (SHARED OCCADE! handle, VAL []BYTE name, VAL INT x, y)
  CLAIM handle
    handle[req] ! load.playfield; name; x; y
:
--}}}

--{{{ PROC occade.draw.playfield (SHARED OCCADE! handle, RASTER raster, VAL INT x, y)
--* Draw a raster image onto the playfield at the given position.
-- @param handle Occade handle
-- @param raster Raster image
-- @param x, y Top left corner coordinates
PROC occade.draw.playfield (SHARED OCCADE! handle, RASTER raster, VAL INT x, y)
  CLAIM handle
    SEQ
      handle[req] ! draw.playfield; raster; x; y
      handle[resp] ? CASE return.raster; raster
:
--}}}

--{{{ PROC occade.collision.buffer (CHAN OCCADE.COLLISION in?, out!, CHAN BOOL kill?)
--* Overwriting N-place buffer of collisions.
-- @private
PROC occade.collision.buffer (CHAN OCCADE.COLLISION in?, out!, CHAN BOOL kill?)
  VAL INT BUFFER.SIZE IS 20:

  DATA TYPE ITEM IS OCCADE.COLLISION:
  #INCLUDE "overwriting-buffer.inc"

  CHAN ITEM in.r? RETYPES in?:
  CHAN ITEM out.r! RETYPES out!:
  SEQ
    SETPRI (PRI.BUFFERS)
    overwriting.buffer (in.r?, out.r!, kill?, BUFFER.SIZE)
:
--}}}

--{{{ PROC occade.sprite.server (SHARED OCCADE! handle, OCCADE.SPRITE? svr, VAL INT want.id)
--* The server process for sprites forked by [@ref occade.start.sprite].
-- @private
PROC occade.sprite.server (SHARED OCCADE! handle, OCCADE.SPRITE? svr, VAL INT user.id)
  INT id:
  OCCADE.SPRITE.INFO info:
  OCCADE.SPRITE.INTERNAL! internal.cli:
  OCCADE.SPRITE.INTERNAL? internal.svr:
  SEQ
    --{{{ initialise
    SETPRI (PRI.SPRITES)

    info[x] := 0
    info[y] := 0
    info[visible] := TRUE

    internal.cli, internal.svr := MOBILE OCCADE.SPRITE.INTERNAL

    CLAIM handle
      SEQ
        handle[req] ! new.sprite; user.id; internal.cli
        handle[resp] ? CASE new.sprite; id
    --}}}
    CHAN BOOL kill:
    PAR
      --{{{ process requests
      INITIAL BOOL running IS TRUE:
      WHILE running
        INITIAL BOOL send IS FALSE:
        SEQ
          svr[req] ? CASE
            MOBILE []BYTE name:
            load.image; name
              --{{{
              CLAIM handle
                handle[req] ! load.sprite.image; id; name
              --}}}
            RASTER r:
            load.raster; r
              --{{{
              CLAIM handle
                SEQ
                  handle[req] ! load.sprite.raster; id; r
                  handle[resp] ? CASE return.raster; r
                  svr[resp] ! return.raster; r
              --}}}
            MOBILE []BYTE text:
            MOBILE []BYTE font:
            load.text; text; font
              --{{{
              CLAIM handle
                handle[req] ! load.sprite.text; id; text; font
              --}}}
            move; info[x]; info[y]; info[centre]
              send, info[position.set] := TRUE, TRUE
            visible; info[visible]
              send := TRUE
            collisions; info[collisions]
              send := TRUE
            get.size
              INT w, h:
              SEQ
                CLAIM handle
                  SEQ
                    handle[req] ! get.sprite.size; id
                    handle[resp] ? CASE get.sprite.size; w; h
                svr[resp] ! get.size; w; h
            quit
              --{{{
              SEQ
                --{{{ shut down
                CLAIM handle
                  handle[req] ! delete.sprite; id
                --}}}
                kill ! TRUE
                running := FALSE
              --}}}
          IF
            send
              CLAIM handle
                handle[req] ! set.sprite.info; id; info
            TRUE
              SKIP
      --}}}
      occade.collision.buffer (internal.svr[collisions]?, svr[collisions]!, kill?)
:
--}}}

--{{{ PROC occade.start.sprite (SHARED OCCADE! handle, RESULT OCCADE.SPRITE! control, VAL INT id)
--* Start up a new sprite and return its control interface.
-- Sprites are graphical objects that can move around and change appearance;
-- you should use them for any moving or changing graphical elements.
--
-- Sprites can report collisions with other sprites. So that you know which
-- sprites have run into each other, you must give your sprites ID
-- numbers if you want them to partiticipate in collision detection. For
-- example, if you give your player's missile sprites the ID number 5, then you
-- know that whenever an enemy collides with ID 5 it's been hit by a missile.
-- (You can give more than one sprite the same ID.)
--
-- If you've got a sprite where you don't care about collisions -- for
-- example, one that's displaying the number of lives the player has left --
-- then pass [@code -1] as the ID and Occade won't bother doing collision
-- detection on it.
--
-- Sprites are invisible with no image loaded by default; you must set up your
-- sprite and make it visible before you can see it on the screen.
-- @param handle Occade handle
-- @param control Control interface for the sprite
-- @param id ID number for the sprite.
--   If this is negative, the sprite won't participate in collision detection.
PROC occade.start.sprite (SHARED OCCADE! handle, RESULT OCCADE.SPRITE! control,
                          VAL INT id)
  OCCADE.SPRITE? svr:
  SEQ
    control, svr := MOBILE OCCADE.SPRITE
    FORK occade.sprite.server (handle, svr, id)
:
--}}}

--{{{ PROC occade.finish.sprite (OCCADE.SPRITE! sprite)
--* Make a sprite quit, and consume any remaining collision reports.
PROC occade.finish.sprite (OCCADE.SPRITE! sprite)
  SEQ
    sprite[req] ! quit
    --{{{ eat leftover collisions
    INITIAL BOOL eating IS TRUE:
    WHILE eating
      PRI ALT
        OCCADE.COLLISION coll:
        sprite[collisions] ? coll
          SKIP
        SKIP
          eating := FALSE
    --}}}
:
--}}}

--{{{ PROC occade.input.buffer (CHAN OCCADE.INPUT.EVENT in?, out!, CHAN BOOL kill?)
--* Overwriting N-place buffer of input events.
-- @private
PROC occade.input.buffer (CHAN RASTER.EVENT in?, out!, CHAN BOOL kill?)
  VAL INT BUFFER.SIZE IS 100:

  DATA TYPE ITEM IS RASTER.EVENT:
  #INCLUDE "overwriting-buffer.inc"

  CHAN ITEM in.r? RETYPES in?:
  CHAN ITEM out.r! RETYPES out!:
  SEQ
    SETPRI (PRI.BUFFERS)
    overwriting.buffer (in.r?, out.r!, kill?, BUFFER.SIZE)
:
--}}}

--{{{ PROC occade.input.filter (SHARED OCCADE! handle, OCCADE.INPUT? svr)
--* The filter process forked by [@ref occade.start.input].
-- @private
PROC occade.input.filter (SHARED OCCADE! handle, OCCADE.INPUT? svr)
  INT id:
  OCCADE.FILTER.INTERNAL! internal.cli:
  OCCADE.FILTER.INTERNAL? internal.svr:
  INITIAL INT interesting IS 0:
  SEQ
    --{{{ initialise
    SETPRI (PRI.INPUT)

    internal.cli, internal.svr := MOBILE OCCADE.FILTER.INTERNAL
    CLAIM handle
      SEQ
        handle[req] ! attach.filter; internal.cli
        handle[resp] ? CASE attach.filter; id
    --}}}
    CHAN RASTER.EVENT events.thru:
    CHAN BOOL kill:
    PAR
      --{{{ handle requests
      INITIAL BOOL running IS TRUE:
      WHILE running
        ALT
          svr[req] ? CASE
            enable; interesting
              SKIP
            quit
              --{{{
              SEQ
                CLAIM handle
                  handle[req] ! detach.filter; id
                kill ! TRUE
                running := FALSE
              --}}}
          RASTER.EVENT event:
          internal.svr[events] ? event
            IF
              (event[type] /\ interesting) <> 0
                --{{{ interesting event; put it in the buffer
                events.thru ! event
                --}}}
              TRUE
                SKIP
      --}}}
      occade.input.buffer (events.thru?, svr[events]!, kill?)
:
--}}}

--{{{ PROC occade.start.input (SHARED OCCADE! handle, RESULT OCCADE.INPUT! control)
--* Start up a new input filter and return its control interface.
-- Input filters look at all the events coming in to the program and pick out
-- the ones you've told them you're interested in. You can have multiple input
-- filters listening for the same or different events; for example, in a
-- two-player game you might want to have an input filter for each player.
--
-- Filters don't report any events by default; you must enable the types of
-- event you're interested in.
-- @param handle Occade handle
-- @param control Control interface for the filter
PROC occade.start.input (SHARED OCCADE! handle, RESULT OCCADE.INPUT! control)
  OCCADE.INPUT? svr:
  SEQ
    control, svr := MOBILE OCCADE.INPUT
    FORK occade.input.filter (handle, svr)
:
--}}}

--{{{ PROC occade.finish.input (OCCADE.INPUT! input)
--* Make an input filter quit, and consume any remaining input events.
PROC occade.finish.input (OCCADE.INPUT! input)
  SEQ
    input[req] ! quit
    --{{{ eat leftover events
    INITIAL BOOL eating IS TRUE:
    WHILE eating
      PRI ALT
        RASTER.EVENT event:
        input[events] ? event
          SKIP
        SKIP
          eating := FALSE
    --}}}
:
--}}}

--{{{ PROC occade.random (SHARED OCCADE! handle, VAL INT max, RESULT INT n)
--* Generate a random integer.
-- @param handle Occade handle
-- @param max Limit
-- @param n Number generated, in the range [@code 0] to [@code max - 1].
PROC occade.random (SHARED OCCADE! handle, VAL INT max, RESULT INT n)
  CLAIM handle
    SEQ
      handle[req] ! random; max
      handle[resp] ? CASE random; n
:
--}}}

--{{{ PROC occade.delay (VAL INT time)
--* Wait for a period of time.
-- @param time The delay in microseconds
PROC occade.delay (VAL INT time)
  TIMER tim:
  INT t:
  SEQ
    tim ? t
    tim ? AFTER t PLUS time
:
--}}}

