--
--	mrshadebob.occ -- type of shade-bob thingie (ported from old xraster examples)
--	Copyright (C) 2001,2007 Fred Barnes <frmb2@ukc.ac.uk>
--
--	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, write to the Free Software
--	Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
--

#INCLUDE "course.module"
#INCLUDE "sdlraster.module"

VAL INT XRASTER.WIDTH IS 320:
VAL INT XRASTER.HEIGHT IS 200:

VAL [4]BYTE black.pixel IS [#00,#00,#00,#00]:
VAL [4]BYTE white.pixel IS [#FF,#FF,#FF,#00]:
VAL [4]BYTE red.pixel IS [#00,#FF,#00,#00]:
VAL [4]BYTE green.pixel IS [#00,#00,#FF,#00]:
VAL [4]BYTE blue.pixel IS [#FF,#00,#00,#00]:

PROC random.raster (RASTER r, [4]BYTE pixel)
  SEQ y = 0 FOR SIZE r
    SEQ
      SEQ x = 0 FOR SIZE r[y]
        [4]BYTE pix RETYPES r[y][x]:
        pix := pixel
      pixel[0] := (pixel[1] PLUS #01)
      pixel[1] := (pixel[2] PLUS #01)
      pixel[2] := (pixel[0] PLUS pixel[1])
:

[4]BYTE FUNCTION "+" (VAL [4]BYTE first, VAL [4]BYTE second)
  [4]BYTE r:
  VALOF
    SEQ i = 0 FOR 4
      IF
        (first[i] PLUS second[i]) <= first[i]
          r[i] := #FF
        TRUE
          r[i] := (first[i] PLUS second[i])
    RESULT r
:

[4]BYTE FUNCTION "-" (VAL [4]BYTE first, VAL [4]BYTE second)
  [4]BYTE r:
  VALOF
    SEQ i = 0 FOR 4
      IF
        (first[i] MINUS second[i]) >= first[i]
          r[i] := #00
        TRUE
          r[i] := (first[i] MINUS second[i])
    RESULT r
:

PROC shade.bob (VAL INT i.x, i.y, i.d, VAL [4]BYTE colour, CHAN RASTER in?, out!)
  INITIAL INT x IS i.x:
  INITIAL INT y IS i.y:
  RASTER r:
  INITIAL INT dir IS i.d:    -- 0 = down-right, 1 = down-left, 2 = up-right, 3 = up-left
  VAL INT icon.size IS 32:
  VAL INT max.x IS (XRASTER.WIDTH - icon.size):
  VAL INT max.y IS (XRASTER.HEIGHT - icon.size):
  VAL INT x.diff IS 4:
  VAL INT y.diff IS 2:
  WHILE TRUE
    SEQ
      SEQ loop = 0 FOR 2
        SEQ
          in ? r
          SEQ r.y = y FOR icon.size
            SEQ r.x = x FOR icon.size
              [4]BYTE pix RETYPES r[r.y][r.x]:
              IF
                (dir = 0) OR (dir = 2)
                  pix := (pix + colour)
                TRUE
                  pix := (pix - colour)
          out ! r
      CASE dir
        0
          x, y := (x + x.diff), (y + y.diff)
        1
          x, y := (x - x.diff), (y + y.diff)
        2
          x, y := (x + x.diff), (y - y.diff)
        3
          x, y := (x - x.diff), (y - y.diff)
      IF
        x > max.x
          dir, x := (dir + 1), max.x
        x < 0
          dir, x := (dir - 1), 0
        TRUE
          SKIP
      IF
        y > max.y
          dir, y := (dir + 2), max.y
        y < 0
          dir, y := (dir - 2), 0
        TRUE
          SKIP
:

PROC app.network (CHAN OF RASTER in, out)
  RASTER r:
  TIMER tim:
  INT t:
  [4]BYTE pixel:
  BYTE v:
  SEQ
    pixel := [#00, #00, #00, #00]
    v := #FF
    SEQ v = 0 FOR 2
      SEQ
        in ? r
        SEQ y = 0 FOR SIZE r
          SEQ x = 0 FOR SIZE r[y]
            [4]BYTE pix RETYPES r[y][x]:
            pix := black.pixel
        out ! r

    -- network
    CHAN RASTER from.bob, inter.bob.1, inter.bob.2, inter.bob.3, to.disp:
    PAR
      shade.bob (0, 0, 0, [#01,#10,#01,#00], in?, from.bob!)
      shade.bob (48, 0, 0, [#01,#01,#10,#00], from.bob?, inter.bob.1!)
      shade.bob (96, 0, 0, [#10,#01,#01,#00], inter.bob.1?, inter.bob.2!)
      shade.bob (144, 0, 0, [#08,#04,#08,#00], inter.bob.2?, to.disp!)
      -- shade.bob (240, 0, 0, [#0E,#0E,#0E,#00], inter.bob.2, to.disp)
      SEQ
        tim ? t
        WHILE TRUE
          SEQ
            to.disp ? r
            t := (t PLUS 20000)
            tim ? AFTER t
            out ! r
:

PROC raster.buffer (CHAN RASTER in?, out!)
  WHILE TRUE
    RASTER r:
    SEQ
      in ? r
      out ! r
:

PROC main (CHAN OF BYTE kyb, scr, err)
  CHAN RASTER c.from.disp, c.to.disp:
  CHAN RASTER c.bufchan1, c.bufchan2:
  CHAN INT control:
  PAR
    raster.display.simple ("xraster shadebob", XRASTER.WIDTH, XRASTER.HEIGHT, 2, c.to.disp?, c.bufchan1!)
    raster.buffer (c.bufchan1?, c.bufchan2!)
    raster.buffer (c.bufchan2?, c.from.disp!)
    app.network (c.from.disp, c.to.disp)
:


