--
--	mrtestprog.occ -- test prog (ported from old X raster sources to sdlraster)
--	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"

#INCLUDE "complex.inc"
#INCLUDE "complex_inline.inc"

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


INT FUNCTION calc (VAL COMPLEX32 a)
  INT count:
  VALOF
    INITIAL COMPLEX32 iter IS [0.0, 0.0]:
    SEQ
      count := 0
      WHILE ((COMPLEX32ABSSQ (iter) < 4.0) AND (count < 200))
        SEQ
          iter := (iter * iter) + a
          count := count + 1
    RESULT count
:

PROC clear.matrix (RASTER r)
  VAL [4]BYTE dm.backpixel IS [#50,#40,#20,#FF]:
  VAL [4]BYTE dm.blackpixel IS [0,0,0,#FF]:
  SEQ
    -- clear raster
    SEQ y = 0 FOR (SIZE r)
      SEQ x = 0 FOR (SIZE r[y])
        [4]BYTE pix RETYPES r[y][x]:
        pix := dm.blackpixel
    -- draw dot-matrix dots
    SEQ y = 0 FOR ((SIZE r) / 4) STEP 4
      SEQ yi = (y+1) FOR 2
        SEQ x = 0 FOR ((SIZE r[yi]) / 4) STEP 4
          SEQ xi = (x+1) FOR 2
            [4]BYTE pix RETYPES r[yi][xi]:
            pix := dm.backpixel
:

PROC dot.matrix (CHAN RASTER in?, out!)
  RASTER r:
  WHILE TRUE
    BYTE pix3:
    SEQ
      in ? r
      [4]BYTE pix RETYPES r[0][0]:
      pix3 := pix[3]
      IF
        pix3 <> #FF
          clear.matrix (r)
        TRUE
          SKIP
      out ! r
:

PROC set.dot.x.y (RASTER r, VAL INT x, y, VAL [4]BYTE pixel)
  SEQ yi = ((y * 4) + 1) FOR 2
    SEQ xi = ((x * 4) + 1) FOR 2
      [4]BYTE pix RETYPES r[yi][xi]:
      pix := pixel
:

PROC get.dot.x.y (RASTER r, VAL INT x, y, [4]BYTE pixel)
  [4]BYTE pix RETYPES r[(y * 4) + 1][(x * 4) + 1]:
  pixel := pix
:

PROC enhance.dot.x.y (RASTER r, VAL INT x, y, VAL [4]BYTE pixel)
  [4]BYTE newpixel:
  SEQ
    [4]BYTE pix RETYPES r[(y * 4) + 1][(x * 4) + 1]:
    newpixel := pix

    SEQ i = 0 FOR 3
      IF
        ((INT newpixel[i]) + (INT pixel[i])) > 255
          newpixel[i] := #FF
        TRUE
          newpixel[i] := newpixel[i] + pixel[i]
    SEQ yi = ((y * 4) + 1) FOR 2
      SEQ xi = ((x * 4) + 1) FOR 2
        [4]BYTE pix RETYPES r[yi][xi]:
        pix := newpixel
:

PROC dot.walk (CHAN RASTER in?, out!)
  VAL [4]BYTE dm.backpixel IS [#50,#40,#20,#FF]:
  VAL [3]BYTE dm.gpixels IS [#E0,#90,#40]:
  RASTER r:
  INITIAL INT dot.x IS 0:
  WHILE TRUE
    SEQ
      in ? r
      SEQ i = 0 FOR 3
        INT real.x:
        SEQ
          IF
            (dot.x - i) < 0
              real.x := (dot.x + 80) - i
            TRUE
              real.x := dot.x - i
          SEQ y = 0 FOR 50
            enhance.dot.x.y (r, real.x, y, [#00,dm.gpixels[i],#00,#FF])
      out ! r
      dot.x := ((dot.x + 1) \ 80)
:

PROC map.char (VAL [5][5]INT char, [5][5][4]BYTE dest, VAL INT depth, VAL INT pixelset)
  VAL [3][5][4]BYTE dm.pixels IS [[[#50,#E0,#20,#FF],[#50,#C0,#20,#FF],[#50,#A0,#20,#FF],[#50,#80,#20,#FF],[#50,#40,#20,#FF]],
                                  [[#E0,#B0,#50,#FF],[#C0,#90,#50,#FF],[#A0,#70,#40,#FF],[#70,#50,#30,#FF],[#50,#40,#20,#FF]],
                                  [[#50,#40,#E0,#FF],[#50,#40,#C0,#FF],[#50,#40,#90,#FF],[#50,#40,#50,#FF],[#50,#40,#20,#FF]]]:
  SEQ y = 0 FOR 5
    SEQ x = 0 FOR 5
      IF
        char[y][x] = 1
          dest[y][x] := dm.pixels[pixelset][depth]
        TRUE
          dest[y][x] := [#50,#40,#20,#FF]
:

BOOL FUNCTION barray.eq (VAL []BYTE a, b)
  BOOL eq:
  VALOF
    IF
      (SIZE a) <> (SIZE b)
        eq := FALSE
      IF i = 0 FOR SIZE a
        a[i] <> b[i]
          eq := FALSE
      TRUE
        eq := TRUE
    RESULT eq
:

PROC set.char (RASTER r, VAL INT x, y, VAL BYTE ch, VAL [37][5][5][4]BYTE cmap)
  IF
    (((ch >= 'a') AND (ch <= 'z')) OR (ch = '.')) OR ((ch >= '0') AND (ch <= '9'))
      INT idx:
      SEQ
        IF
          (ch >= 'a') AND (ch <= 'z')
            idx := INT (ch - 'a'(BYTE))
          (ch >= '0') AND (ch <= '9')
            idx := (INT (ch - '0'(BYTE))) + 27
          TRUE
            idx := 26
        SEQ dy = 0 FOR 5
          SEQ dx = 0 FOR 5
            IF
              (((x+dx) >= 0) AND ((x + dx) < 80)) AND ((y + dy) < 50)
                [4]BYTE temp:
                SEQ
                  get.dot.x.y (r, x+dx, y+dy, temp)
                  IF
                    barray.eq (cmap[idx][dy][dx], [#50,#40,#20,#FF])
                      SKIP
                    TRUE
                      SEQ v = 0 FOR 3
                        IF
                          ((INT temp[v]) + (INT cmap[idx][dy][dx][v])) > 200
                            temp[v] := 230
                          TRUE
                            temp[v] := (temp[v] + cmap[idx][dy][dx][v])
                  set.dot.x.y (r, x+dx, y+dy, temp)
              TRUE
                SKIP
    TRUE
      SKIP
:

PROC set.chars (RASTER r, VAL INT x, y, VAL []BYTE str, VAL [37][5][5][4]BYTE cmap)
  SEQ i = 0 FOR (SIZE str)
    set.char (r, (x + (i * 6)), y, str[i], cmap)
:

PROC map.in.charset ([37][5][5][4]BYTE cmap, VAL INT depth, VAL INT pixelset)
  SEQ
    map.char ([[0,1,1,1,0],[1,0,0,0,1],[1,1,1,1,1],[1,0,0,0,1],[1,0,0,0,1]], cmap[0], depth, pixelset)	-- A
    map.char ([[1,1,1,1,0],[1,0,0,0,1],[1,1,1,1,0],[1,0,0,0,1],[1,1,1,1,0]], cmap[1], depth, pixelset)	-- B
    map.char ([[0,1,1,1,0],[1,0,0,0,1],[1,0,0,0,0],[1,0,0,0,1],[0,1,1,1,0]], cmap[2], depth, pixelset)	-- C
    map.char ([[1,1,1,1,0],[1,0,0,0,1],[1,0,0,0,1],[1,0,0,0,1],[1,1,1,1,0]], cmap[3], depth, pixelset)	-- D
    map.char ([[1,1,1,1,1],[1,0,0,0,0],[1,1,1,1,0],[1,0,0,0,0],[1,1,1,1,1]], cmap[4], depth, pixelset)	-- E
    map.char ([[1,1,1,1,1],[1,0,0,0,0],[1,1,1,1,0],[1,0,0,0,0],[1,0,0,0,0]], cmap[5], depth, pixelset)	-- F
    map.char ([[0,1,1,1,0],[1,0,0,0,0],[1,0,1,1,0],[1,0,0,0,1],[0,1,1,1,0]], cmap[6], depth, pixelset)	-- G
    map.char ([[1,0,0,0,1],[1,0,0,0,1],[1,1,1,1,1],[1,0,0,0,1],[1,0,0,0,1]], cmap[7], depth, pixelset)	-- H
    map.char ([[1,1,1,1,1],[0,0,1,0,0],[0,0,1,0,0],[0,0,1,0,0],[1,1,1,1,1]], cmap[8], depth, pixelset)	-- I
    map.char ([[1,1,1,1,1],[0,0,1,0,0],[0,0,1,0,0],[1,0,1,0,0],[0,1,0,0,0]], cmap[9], depth, pixelset)	-- J
    map.char ([[1,0,0,0,0],[1,0,0,0,0],[1,0,0,0,0],[1,0,0,0,0],[1,1,1,1,1]], cmap[11], depth, pixelset)	-- L
    map.char ([[1,0,0,0,1],[1,1,0,1,1],[1,0,1,0,1],[1,0,0,0,1],[1,0,0,0,1]], cmap[12], depth, pixelset)	-- M
    map.char ([[1,0,0,0,1],[1,1,0,0,1],[1,0,1,0,1],[1,0,0,1,1],[1,0,0,0,1]], cmap[13], depth, pixelset)	-- N
    map.char ([[0,1,1,1,0],[1,0,0,0,1],[1,0,0,0,1],[1,0,0,0,1],[0,1,1,1,0]], cmap[14], depth, pixelset)	-- O
    map.char ([[1,1,1,1,0],[1,0,0,0,1],[1,1,1,1,0],[1,0,0,0,0],[1,0,0,0,0]], cmap[15], depth, pixelset)	-- P
    map.char ([[1,1,1,1,0],[1,0,0,0,1],[1,1,1,1,0],[1,0,0,1,0],[1,0,0,0,1]], cmap[17], depth, pixelset)	-- R
    map.char ([[0,1,1,1,0],[1,0,0,0,0],[0,1,1,1,0],[0,0,0,0,1],[1,1,1,1,0]], cmap[18], depth, pixelset)	-- S
    map.char ([[1,1,1,1,1],[0,0,1,0,0],[0,0,1,0,0],[0,0,1,0,0],[0,0,1,0,0]], cmap[19], depth, pixelset)	-- T
    map.char ([[1,0,0,0,1],[1,0,0,0,1],[1,0,0,0,1],[1,0,0,0,1],[0,1,1,1,0]], cmap[20], depth, pixelset)	-- U
    map.char ([[1,0,0,0,1],[1,0,0,0,1],[1,0,1,0,1],[1,1,0,1,1],[1,0,0,0,1]], cmap[22], depth, pixelset)	-- W
    map.char ([[1,0,0,0,1],[0,1,0,1,0],[0,0,1,0,0],[0,1,0,1,0],[1,0,0,0,1]], cmap[23], depth, pixelset)	-- X
    map.char ([[1,0,0,0,1],[1,0,0,0,1],[0,1,0,1,0],[0,0,1,0,0],[0,0,1,0,0]], cmap[24], depth, pixelset)	-- Y
    map.char ([[0,0,0,0,0],[0,0,0,0,0],[0,0,0,0,0],[0,1,1,0,0],[0,1,1,0,0]], cmap[26], depth, pixelset)	-- .
:

PROC char.gen (CHAN RASTER in?, out!)
  INT FUNCTION local.inc (VAL INT v)
    INT r:
    VALOF
      IF
        v < 4
          r := (v + 1)
        TRUE
          r := -20
      RESULT r
  :

  [5][37][5][5][4]BYTE charmap:
  VAL [5]BYTE r.depthmap IS [#FF,#E0,#C0,#A0,#80]:
  [5]INT loop.count:
  VAL [5][]BYTE strings IS ["all your    ","occam are   ", "belong to   ", "us..        ","ha ha ha    "]:
  SEQ
    -- init charmap
    SEQ depth = 0 FOR 5
      SEQ letter = 0 FOR 37
        SEQ y = 0 FOR 5
          SEQ x = 0 FOR 5
            charmap[depth][letter][y][x] := [#00,#00,r.depthmap[depth],#FF]
    SEQ depth = 0 FOR 5
      map.in.charset (charmap[depth], depth, 2)
    SEQ i = 0 FOR SIZE loop.count
      loop.count[i] := ((-10) - i)
    RASTER r:
    WHILE TRUE
      SEQ
        in ? r
        SEQ i = 0 FOR SIZE loop.count
          IF
            loop.count[i] <= 0
              set.chars (r, 2, (2 + (7 * i)), strings[i], charmap[0])
            TRUE
              set.chars (r, 2, (2 + (7 * i)), strings[i], charmap[loop.count[i]])
        out ! r
        SEQ i = 0 FOR SIZE loop.count
          loop.count[i] := local.inc (loop.count[i])
:

PROC text.scroll.gen (CHAN RASTER in?, out!)
  RASTER r:
  [5][37][5][5][4]BYTE charmap:
  VAL [5]BYTE r.depthmap IS [#FF,#E0,#C0,#A0,#80]:
  VAL [4]BYTE dm.backpixel IS [#50,#40,#20,#FF]:
  INT major.off, minor.off:
  VAL []BYTE str IS "              welcome to the wonderful world of occam.  hope you enjoy the show.  this is text.scroll.gen by the way                  ":
  SEQ
    -- init charmap
    SEQ depth = 0 FOR 5
      SEQ letter = 0 FOR 37
        SEQ y = 0 FOR 5
          SEQ x = 0 FOR 5
            charmap[depth][letter][y][x] := [#00,#00,r.depthmap[depth],#FF]
    SEQ depth = 0 FOR 5
      map.in.charset (charmap[depth], depth, 1)
    major.off := 0
    minor.off := 0
    WHILE TRUE
      SEQ
        in ? r
        -- SEQ y = 40 FOR 5
        --  SEQ x = 0 FOR 80
        --    set.dot.x.y (r, x, y, dm.backpixel)
        set.chars (r, 2 - minor.off, 40, [str FROM major.off FOR 14], charmap[0])
        out ! r
        minor.off := (minor.off + 1)
        IF
          minor.off >= 6
            SEQ
              minor.off := minor.off \ 6
              major.off := major.off + 1
              IF
                major.off = ((SIZE str) - 14)
                  major.off := 0
                TRUE
                  SKIP
          TRUE
            SKIP
:

PROC random.dots (CHAN RASTER in?, out!)
  RASTER r:
  TIMER tim:
  INT seed:
  SEQ
    tim ? seed
    IF
      seed < 0
        seed := (seed /\ #7FFFFFFF)
      seed = 0
        seed := 1
      TRUE
        SKIP
    WHILE TRUE
      SEQ
        in ? r
        SEQ i = 0 FOR 5
          INT rx, ry:
          SEQ
            rx, seed := random (80, seed)
            ry, seed := random (50, seed)
            set.dot.x.y (r, rx, ry, [#00,#00,#FF,#FF])
        out ! r
:

PROC mandelbrot (CHAN RASTER in?, out!, VAL REAL32 sx.adj, sy.adj, VAL INT psel, CHAN BOOL zoom.finished!)
  RASTER stored, r:
  VAL [10]BYTE intensity.map IS [#20,#30,#50,#70,#90,#A0,#B0,#C0,#D0,#FF]:
  CHAN RASTER c:
  PAR
    --{{{  generate pretty rasters and chuck them out
    RASTER local:
    REAL32 x.mult, y.mult:
    REAL32 x.delta, y.delta:
    SEQ
      x.mult := 36.0
      y.mult := 20.0
      x.delta := (-0.5) + sx.adj
      y.delta := 0.0 + sy.adj
      INITIAL BOOL running IS TRUE:
      WHILE running
        SEQ
          local := MOBILE [XRASTER.HEIGHT][XRASTER.WIDTH]INT
          clear.matrix (local)
          SEQ i = -40 FOR 80
            SEQ
              SEQ j = -25 FOR 50
                VAL REAL32 x IS ((REAL32 TRUNC i) / x.mult) + x.delta:
                VAL REAL32 y IS ((REAL32 TRUNC j) / y.mult) + y.delta:
                INT idx:
                SEQ
                  idx := calc ([x,y](COMPLEX32)) \ 10
                  CASE psel
                    0
                      set.dot.x.y (local, (i+40), (j+25), [intensity.map[idx],#10,#10,#FF])
                    1
                      enhance.dot.x.y (local, (i+40), (j+25), [#00,intensity.map[idx],#00,#FF])
                    2
                      enhance.dot.x.y (local, (i+40), (j+25), [#00,#00,intensity.map[idx],#FF])
              RESCHEDULE ()
          c ! local
          x.mult := (x.mult * 1.02)
          y.mult := (y.mult * 1.02)
          IF
            x.mult < 70.0
              SEQ
                x.delta := (x.delta - 0.005)
                y.delta := (y.delta + 0.0035)
            x.mult < 100.0
              x.delta := (x.delta - 0.005)
            x.mult < 1000.0
              SKIP
            x.mult < 1900.0
              x.delta := (x.delta - 0.0006)
            x.mult > 2000000.0
              running := FALSE
            TRUE
              SKIP
          TIMER tim:
          INT t:
          SEQ
            tim ? t
            tim ? AFTER (t PLUS 40000)
      zoom.finished ! TRUE
    --}}}  
    --{{{  ALT from input and raster generator
    INITIAL BOOL got IS FALSE:
    WHILE TRUE
      PRI ALT
        got & in ? r
          out ! CLONE stored
          -- out ! stored
        c ? stored
          SEQ
            RESCHEDULE ()
            got := TRUE
    --}}}  
:

PROC set.horiz.line (RASTER r, VAL INT x, y, length, VAL [4]BYTE pixel)
  IF
    length > 0
      SEQ i = x FOR length
        enhance.dot.x.y (r, i, y, pixel)
    TRUE
      SEQ i = x FOR -length STEP -1
        enhance.dot.x.y (r, i, y, pixel)
:

PROC x.logo (CHAN RASTER in?, out!, CHAN BOOL frac.finished?)
  RASTER r:
  VAL [][4]BYTE enhance.map IS [[#00,#00,#00,#FF],[#00,#00,#00,#FF],[#00,#00,#00,#FF],[#10,#08,#10,#FF],
                                [#20,#10,#20,#FF],[#30,#18,#30,#FF],[#40,#20,#40,#FF],[#40,#20,#40,#FF],
                                [#40,#20,#40,#FF]]:
  SEQ
    BOOL any:
    --frac.finished ? any
    INITIAL BOOL increasing IS TRUE:
    INITIAL INT index IS 0:
    WHILE TRUE
      SEQ
        in ? r
        SEQ y = 0 FOR 22
          SEQ
            set.horiz.line (r, (y + 9), y, 12, enhance.map[index])
            set.horiz.line (r, (66 - y), y, 4, enhance.map[index])
            set.horiz.line (r, (59 - y), (49 - y), 12, enhance.map[index])
            set.horiz.line (r, (y + 10), (49 - y), 4, enhance.map[index])
        INITIAL INT length IS 10:
        SEQ y = 22 FOR 6
          SEQ
            set.horiz.line (r, (66 - y), y, length, enhance.map[index])
            set.horiz.line (r, (y + 10), (49 - y), length, enhance.map[index])
            length := (length - 2)
        out ! r
        IF
          increasing
            IF
              index = ((SIZE enhance.map) - 1)
                increasing := FALSE
              TRUE
                index := (index + 1)
          TRUE
            IF
              index = 0
                increasing := TRUE
              TRUE
                index := (index - 1)
:

PROC frame.limiter (CHAN RASTER in?, out!, VAL INT delay)
  TIMER tim:
  INT t:
  SEQ
    tim ? t
    t := t PLUS delay
    WHILE TRUE
      RASTER r:
      SEQ
        in ? r
        tim ? AFTER t
        t := t PLUS delay
        out ! r
:

PROC testprog ()
  [8]CHAN RASTER c:
  CHAN INT control:
  CHAN BOOL z.finished, z.finished2:
  PAR
    dot.matrix (c[0]?, c[1]!)
    mandelbrot (c[1]?, c[3]!, 0.0, 0.0, 0, z.finished!)
    --mandelbrot (c[2]?, c[3]!, 0.2, 0.5, 2, z.finished2!)
    char.gen (c[3]?, c[4]!)
    text.scroll.gen (c[4]?, c[5]!)
    dot.walk (c[5]?, c[6]!)
    frame.limiter (c[6]?, c[7]!, 25000)
    raster.display.simple ("xraster testprog", XRASTER.WIDTH, XRASTER.HEIGHT, 2, c[7]?, c[0]!)
:


