-- An example showing how to turn an occam-pi array into a surface.
-- This is an inherently unsafe thing to do, so it's best to hide it in a
-- library if it's absolutely necessary...

#INCLUDE "occSDL.module"

PROC set.rect (SDL.Rect rect, VAL INT x, y, w, h)
  SEQ
    SDL.Rect.x.set (rect, INT16 x)
    SDL.Rect.y.set (rect, INT16 y)
    SDL.Rect.w.set (rect, INT16 w)
    SDL.Rect.h.set (rect, INT16 h)
:

PROC blit (SDL.Surface from, VAL INT from.x, from.y, w, h,
           SDL.Surface to, VAL INT to.x, to.y)
  INT result:
  SDL.Rect rect1, rect2:
  SEQ
    new.SDL.Rect (rect1)
    new.SDL.Rect (rect2)
    set.rect (rect1, from.x, from.y, w, h)
    set.rect (rect2, to.x, to.y, 0, 0)
    SDL.BlitSurface (from, rect1, to, rect2, result)
    ASSERT (result = 0)
    delete.SDL.Rect (rect1)
    delete.SDL.Rect (rect2)
:

PROC array.surface ()
  SDL.Surface screen:
  SDL.Event event:
  TIMER tim:
  INT result, t:
  SEQ
    occ.SDL.Init (SDL.INIT.VIDEO, result)
    ASSERT (result = 0)

    SDL.SetVideoMode (640, 480, 32, (SDL.HWSURFACE \/ SDL.DOUBLEBUF) \/ SDL.ANYFORMAT, screen)
    ASSERT (screen <> 0)

    new.SDL.Event (event)

    tim ? t

    INITIAL BOOL running IS TRUE:
    WHILE running
      SEQ frame = 0 FOR 256
        [256][512]INT pixels:
        SDL.Surface box:
        SEQ
          SEQ y = 0 FOR 256
            SEQ x = 0 FOR 256
              SEQ
                pixels[y][x * 2] := ((frame << 16) \/ (x << 8)) \/ y
                pixels[y][(x * 2) + 1] := pixels[y][x * 2]

          occ.SDL.make.surface (pixels, box)
          ASSERT (box <> 0)
          -- Now box contains a pointer to pixels -- so we need to make sure box
          -- is freed before pixels goes out of scope.

          blit (box, 0, 0, 512, 256, screen, (640 - 512) / 2, (480 - 256) / 2)

          SDL.Flip (screen, result)
          ASSERT (result = 0)

          SDL.FreeSurface (box)
          -- ... and now it's safe for pixels to disappear.

          --{{{  delay
          t := t PLUS 5000
          tim ? AFTER t
          --}}}

          --{{{  check for quit events
          SDL.PollEvent (event, result)
          IF
            result > 0
              BYTE type:
              SEQ
                SDL.Event.type.get (event, type)
                CASE INT type
                  SDL.QUIT
                    running := FALSE
                  ELSE
                    SKIP
            TRUE
              SKIP
          --}}}

    delete.SDL.Event (event)

    SDL.Quit ()
:
