-- ColorKinetic.mesa
-- Last edited by Doug Wyatt, 31-Mar-82 15:30:23

-- Pilot version

DIRECTORY
  BitBlt,
  ColorDisplay,
  Inline,
  Keys USING [KeyBits],
  Process USING [MsecToTicks, Pause],
  UserTerminal USING[keyboard];

ColorKinetic: PROGRAM
IMPORTS BitBlt, ColorDisplay, Inline, Process, UserTerminal =
BEGIN

keys: LONG POINTER TO Keys.KeyBits _ LOOPHOLE[UserTerminal.keyboard];

sym: BOOLEAN _ FALSE;

bbspace: BitBlt.BBTableSpace;
bb: BitBlt.BBptr _ InitBB[@bbspace];
grayword: CARDINAL _ 0;

bitmap,bitmapB: LONG POINTER _ NIL;
wpl,wplB: CARDINAL _ 0;
width,height: CARDINAL _ 0;
lbpp,lbppB: CARDINAL _ 0; -- log (base 2) bits per pixel
bpp,bppB: CARDINAL _ 0; -- bits per pixel
full: BOOLEAN _ FALSE;
ashow,bshow: BOOLEAN _ TRUE;
splat: BOOLEAN _ TRUE;
test: BOOLEAN _ FALSE;
neg: BOOLEAN _ FALSE;
cornerSize: CARDINAL _ 4;
cornerColor: CARDINAL _ 8;

Triple: TYPE = RECORD[r,g,b: [0..256)];

testmap: ARRAY[0..8] OF Triple _ [
  [127,127,127], -- gray (background)
  [  0,  0,  0], -- black
  [255,  0,  0], -- red
  [  0,255,  0], -- green
  [255,255,  0], -- yellow
  [  0,  0,255], -- blue
  [255,  0,255], -- magenta
  [  0,255,255], -- cyan
  [255,255,255]  -- white
  ];

TestPattern: PROC = {
  x: CARDINAL = 60;
  h: CARDINAL = 60;
  w: CARDINAL = 50;
  gap: CARDINAL = 15;
  IF NOT full THEN {
    FOR i: CARDINAL IN[0..9) DO
      ColorDisplay.SetColor[pixelA: i, r: testmap[i].r, g: testmap[i].g, b: testmap[i].b];
      ENDLOOP;
    ColorDisplay.Show[TRUE,FALSE,FALSE];
    };
  -- gray background
  Rect[0,0,width,height,0];
  -- four corners
  { s: CARDINAL = cornerSize;
    c: CARDINAL = cornerColor; -- color
    Rect[0,0,s,s,c];
    Rect[width-s,0,s,s,c];
    Rect[0,height-s,s,s,c];
    Rect[width-s,height-s,s,s,c];
    };
  -- various colors at left edge
  FOR i: CARDINAL IN[0..8) DO
    r,g,b: [0..256);
    r _ (i MOD 2)*255;
    g _ ((i/2) MOD 2)*255;
    b _ ((i/4) MOD 2)*255;
    Rect[4,i*h+10,x,h-20,i+1];
    ENDLOOP;
  -- a bunch of stripes
  FOR i: CARDINAL IN[0..8) DO
    r,g,b: [0..256);
    r _ (i MOD 2)*255;
    g _ ((i/2) MOD 2)*255;
    b _ ((i/4) MOD 2)*255;
    Rect[x+i*w+gap,0,w-gap,8*h,i+1];
    ENDLOOP;
  };
  
Rect: PROC[x,y,w,h: CARDINAL, i: [0..8]] = {
  IF NOT (x<width AND y<height) THEN RETURN;
  w _ MIN[w,width-x]; h _ MIN[h,height-y];
  IF full THEN FullRect[x,y,w,h,testmap[i].r,testmap[i].g,testmap[i].b]
  ELSE ARect[x,y,w,h,i];
  };

SetUpColors: PROCEDURE = BEGIN
  k: CARDINAL _ Inline.BITSHIFT[1,bpp]; -- number of pixel values
  FOR n: CARDINAL IN [0..k) DO
    r,g,b: [0..256);
    Alter: PROC[c: [0..256)] RETURNS[[0..256)] = INLINE { RETURN[255-(255-c)/2] };
    r _ MyRandom[256]; g _ MyRandom[256]; b _ MyRandom[256];
    ColorDisplay.SetColor[pixelA: n, pixelB: 0, r: r, g: g, b: b];
    ColorDisplay.SetColor[pixelA: n, pixelB: 1, r: Alter[r], g: Alter[g], b: Alter[b]];
    ENDLOOP;
  END;

Positive: PROC = {
  IF NOT full THEN RETURN;
  ColorDisplay.TurnOff[];
  FOR i: CARDINAL IN[0..256) DO
    ColorDisplay.SetRedMap[i,i];
    ColorDisplay.SetGreenMap[i,i];
    ColorDisplay.SetBlueMap[i,i];
    ENDLOOP;
  ColorDisplay.TurnOn[];
  };

Negative: PROC = {
  IF NOT full THEN RETURN;
  ColorDisplay.TurnOff[];
  FOR i: CARDINAL IN[0..256) DO
    ColorDisplay.SetRedMap[i,255-i];
    ColorDisplay.SetGreenMap[i,255-i];
    ColorDisplay.SetBlueMap[i,255-i];
    ENDLOOP;
  ColorDisplay.TurnOn[];
  };

MyRandom: PROCEDURE [max: CARDINAL] RETURNS [CARDINAL] = INLINE BEGIN
  RETURN[Random[] MOD max];
  END;

SetGray: PROC[g: [0..256)] = { grayword _ MakeGray[g] };

MakeGray: PROC[g: [0..256)] RETURNS[CARDINAL] = {
  grayword: CARDINAL _ 0;
  IF bpp#0 THEN {
    ppw: CARDINAL _ 16/bpp; -- pixels per word
    mask: CARDINAL _ Inline.BITNOT[Inline.BITSHIFT[-1,bpp]];
    g _ Inline.BITAND[g,mask];
    THROUGH [0..ppw) DO grayword _ Inline.BITSHIFT[grayword,bpp] + g ENDLOOP;
    };
  RETURN[grayword];
  };

InitBB: PROC[bbs: POINTER TO BitBlt.BBTableSpace] RETURNS[BitBlt.BBptr] = INLINE {
  bb: BitBlt.BBptr _ BitBlt.AlignedBBTable[bbs];
  bb^ _ [
    dst: [word: NIL, bit: 0],
    dstBpl: 0,
    src: [word: @grayword, bit: 0],
    srcDesc: [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 0]]],
    width: 0, height: 0,
    flags: [disjoint: TRUE, gray: TRUE]
    ];
  RETURN[bb];
  };

FullRect: PROC[x,y,w,h: CARDINAL, r,g,b: [0..256)] = {
  rgword: CARDINAL _ 256*r + g;
  bbword: CARDINAL _ 256*b + b;
  IF NOT full THEN RETURN;
  -- bitmap A
  bb.dst _ [word: ColorDisplay.baseA + LONG[y]*ColorDisplay.wplA + x, bit: 0];
  bb.dstBpl _ 16*ColorDisplay.wplA;
  bb.src _ [word: @rgword, bit: 0];
  bb.width _ 16*w;
  bb.height _ h;
  bb.flags.dstFunc _ null;
  BitBlt.BITBLT[bb];
  -- bitmap B
  bb.dst _ [word: ColorDisplay.baseB + LONG[y]*ColorDisplay.wplB + x/2, bit: 8*(x MOD 2)];
  bb.dstBpl _ 16*ColorDisplay.wplB;
  bb.src _ [word: @bbword, bit: bb.dst.bit];
  bb.width _ 8*w;
  bb.height _ h;
  bb.flags.dstFunc _ null;
  BitBlt.BITBLT[bb];
  };

ARect: PROC[x,y,w,h: CARDINAL, i: [0..256), fn: BitBlt.DstFunc _ null] = {
  iword: CARDINAL _ MakeGray[i];
  xbit: CARDINAL _ Inline.BITSHIFT[x,lbpp];
  bb.dst _ [word: ColorDisplay.baseA + LONG[y]*ColorDisplay.wplA + xbit/16, bit: xbit MOD 16];
  bb.dstBpl _ 16*ColorDisplay.wplA;
  bb.src _ [word: @iword, bit: bb.dst.bit];
  bb.width _ Inline.BITSHIFT[w,lbpp];
  bb.height _ h;
  bb.flags.dstFunc _ fn;
  BitBlt.BITBLT[bb];
  };

index: [0..256) _ 0;

Rectangle: PROC[lx,ty,rx,by: CARDINAL, fn: BitBlt.DstFunc _ null] = {
  IF full THEN {
    r,g,b: [0..256);
    r _ MyRandom[256]; g _ MyRandom[256]; b _ MyRandom[256];
    FullRect[lx,ty,rx-lx,by-ty,r,g,b];
    }
  ELSE {
    index _ (index + 1) MOD 256;
    ARect[lx,ty,rx-lx,by-ty,index,fn];
    };
  };

BRectangle: PROC[lx,ty,rx,by: CARDINAL] = {
  xbit: CARDINAL _ Inline.BITSHIFT[lx,lbppB];
  black: CARDINAL _ 177777B;
  bb.dst _ [word: bitmapB + LONG[ty]*wplB + xbit/16, bit: xbit MOD 16];
  bb.dstBpl _ 16*wplB;
  bb.src _ [word: @black, bit: 0];
  bb.width _ Inline.BITSHIFT[(rx-lx),lbppB];
  bb.height _ by-ty;
  bb.flags.dstFunc _ xor;
  BitBlt.BITBLT[bb];
  };

RandomSplat: PROCEDURE = BEGIN
  screenX: CARDINAL = width;
  screenY: CARDINAL = height;
  XorRatio: CARDINAL = 3;
  ty, ty2, lx, w, h: CARDINAL;
  fn: BitBlt.DstFunc _ (IF MyRandom[XorRatio]=0 THEN xor ELSE null);
  SetGray[MyRandom[256]];

  IF sym THEN BEGIN
    ty _ ty2 _ MyRandom[screenY/2];
    lx _ MyRandom[screenX/2];
    w _ MyRandom[screenX/2-lx];
    h _ MyRandom[screenY/2-ty];
    Rectangle[lx, ty, lx+w, ty+h, fn];
    ty _ screenY/2+(screenY/2-ty)-h;
    Rectangle[lx, ty, lx+w, ty+h, fn];
    lx _ screenX/2+(screenX/2-lx)-w;
    Rectangle[lx, ty, lx+w, ty+h, fn];
    Rectangle[lx, ty2, lx+w, ty2+h, fn];
    END
  ELSE BEGIN
    ty _ MyRandom[screenY];
    lx _ MyRandom[screenX];
    w _ MyRandom[screenX-lx];
    h _ MyRandom[screenY-ty];
    Rectangle[lx, ty, lx+w, ty+h, fn];
    END;
  IF bitmapB#NIL THEN {
    ty _ MyRandom[screenY];
    lx _ MyRandom[screenX];
    w _ MyRandom[screenX-lx];
    h _ MyRandom[screenY-ty];
    BRectangle[lx, ty, lx+w, ty+h];
    };
  IF keys[Lock]=down THEN BEGIN
    Wait[200]; -- slow mode
    IF keys[S]=down THEN BEGIN
      sym _ ~sym;
      ClearScreen[];
      WHILE keys[S]=down DO ENDLOOP;
      END;
    WHILE keys[F]=down DO
      IF full THEN LOOP;
      IF keys[C]=down THEN {
        SetUpColors; Wait[500];
	UNTIL keys[C]=up DO SetUpColors; Wait[200] ENDLOOP;
	};
      IF keys[R]=down THEN {
        Roll; Wait[500];
        UNTIL keys[R]=up DO Roll; Wait[100] ENDLOOP;
        };
      ENDLOOP;
    END;
  END;

Roll: PROC = {
  r,g,b,r0,g0,b0: [0..256);
  [r0,g0,b0] _ ColorDisplay.GetColor[0];
  FOR i: CARDINAL IN[0..255) DO
    [r,g,b] _ ColorDisplay.GetColor[i+1];
    ColorDisplay.SetColor[i,0,r,g,b];
    ENDLOOP;
  ColorDisplay.SetColor[255,0,r0,g0,b0];
  };

SetBackground: PROCEDURE [v: INTEGER] = BEGIN
  background _ v;
  ColorDisplay.SetColor[0, 0, v, v, v];
  END;

background: INTEGER _ 255; -- initially white
ClearScreen: PROCEDURE = {
  IF NOT full THEN {
    ColorDisplay.SetColor[0, 0, background, background, background];
    SetGray[0] };
  Rectangle[0,0,width,height];
  };

Wait: PROCEDURE[millisecs: CARDINAL] = INLINE {
  Process.Pause[Process.MsecToTicks[millisecs]] };

  -- Constant definitions (meanings described in InitRandom below)

  defaultSeed: CARDINAL = 27183;
  numCalls: INTEGER = 3;


  -- Module state
  
  a: ARRAY [0..55] OF CARDINAL;
    -- Holds 55 random cardinals, to be returned by Random. (A[0] is wasted to make the
    --code generator produce better array accesses.)
  p: INTEGER [0..55];
    -- a[1..p-1] has not yet been returned by Random; p is [1..55] except within Random.


  -- Procedures

  InitRandom: PUBLIC PROC[seed: INTEGER] RETURNS[INTEGER] = {
    -- The parameter seed determines the sequence generated by procedure Random below.
    -- If seed=0, a default seed value is used to determine the starting point of the
    --sequence; if seed>0, seed is scaled if necessary and then used;  if seed<0, a seed
    --value is derived from the system clock.  In any case, the seed value actually used
    --(after scaling) is the integer value returned.

    minSeed: CARDINAL = LAST[CARDINAL]/10;
    g, gPrev, gSave: CARDINAL;

    IF seed<=0 THEN seed _ defaultSeed;
    -- Now scale the seed into the proper range (no log routine available...)
    WHILE seed<minSeed DO seed _ seed*3 ENDLOOP;
    -- Seed can't be too big since LAST[INTEGER] < LAST[CARDINAL]*(9/10)
    -- The array a is initialized by placing seed in a[55], and scattering the values

    --  (-1)**(i-1) * (F(i) - seed*F(i-1)) MOD maxRand, 0<i<55,

    -- (where F(i) denotes the i-th Fibonacci number) throughout the rest of a.  Then
    --the generating procedure RandomGen is called, numCalls times, to make things
    --sufficiently random.

    a[55] _ gPrev _ seed;
    g _ 1;
    FOR i: INTEGER IN [1..54] DO
      p _ (21*i) MOD 55;
      a[p] _ gSave _ g;  g _ gPrev-g;  gPrev _ gSave;
    ENDLOOP;
    THROUGH [1..numCalls) DO
      RandomGen[];
    ENDLOOP;
    -- Show a as being empty;  first call to Random will call RandomGen again. 
    p _ 1;
    RETURN[seed]
  };--InitRandom


  Random: PUBLIC PROC RETURNS[CARDINAL] = INLINE {
    p _ p-1;
    IF p=0 THEN {  RandomGen[];  p _ 55  };
    RETURN[a[p]]
  };--Random


  RandomGen: PROC = INLINE {
    -- Additive random number generator using the recurrence  y(n) = y(n-55) - y(n-24)
    --mod maxRand. See John F. Reiser, "Analysis of Additive Random Number Generators",
    --STAN-CS-77-601, March 1977, or Knuth Volume 2 (second edition.)
    FOR i: INTEGER IN [1..24] DO 
      a[i] _ a[i] - a[i+31];
    ENDLOOP;
    FOR i: INTEGER IN [25..55] DO 
      a[i] _ a[i] - a[i-24];
    ENDLOOP;
  };--RandomGen


  Choose: PUBLIC PROC[min, max: CARDINAL] RETURNS[CARDINAL--[min..max]--] = {
    intervalLen: CARDINAL;
    IF min > max THEN ERROR;
    intervalLen _ max - min + 1; --is 0 when min=0, max=LAST[CARDINAL]
    IF intervalLen = 0 THEN RETURN[Random[]];
    DO
      -- Draw a number in [0..LAST[CARDINAL]].  We want to reject this number if it lies in the
      --"odd interval" at the high end of this range (there is no odd interval if intervalLen
      --divides 2^16).  The funny test below does it (claim).  The average number of numbers drawn
      --is less than 2, and much closer to 1 for small intervalLen.
      r, rem: CARDINAL;
      -- Inline expansion of Random[];
      p _ p-1;
      IF p=0 THEN {  RandomGen[];  p _ 55  };
      r _ a[p];
      rem _ r MOD intervalLen;
      IF (r - rem) > LOOPHOLE[-LOOPHOLE[intervalLen,INTEGER],CARDINAL] THEN LOOP;
      RETURN[min + rem];
    ENDLOOP;
  };--Choose

SetLogBitsPerPixel: PROC[n: [0..4)] RETURNS[BOOLEAN] = {
  b: CARDINAL _ Inline.BITSHIFT[1,n];
  mode: ColorDisplay.Mode _ [FALSE,b,1];
  IF NOT ColorDisplay.HasMode[mode] THEN {
    mode.bitsPerPixelB _ 0;
    IF NOT ColorDisplay.HasMode[mode] THEN RETURN[FALSE];
    };
  IF NOT ColorDisplay.SetMode[mode] THEN ERROR;
  lbpp _ n; bpp _ b; full _ FALSE;
  lbppB _ 0; bppB _ 1;
  ashow _ bshow _ TRUE;
  width _ ColorDisplay.width; height _ ColorDisplay.height;
  bitmap _ ColorDisplay.baseA; wpl _ ColorDisplay.wplA;
  bitmapB _ ColorDisplay.baseB; wplB _ ColorDisplay.wplB;
  ClearScreen;
  SetUpColors;
  ColorDisplay.TurnOn[];
  RETURN[TRUE];
  };

Set24BitsPerPixel: PROC = {
  mode: ColorDisplay.Mode _ [TRUE,0,0];
  IF NOT ColorDisplay.HasMode[mode] THEN RETURN;
  IF NOT ColorDisplay.SetMode[mode] THEN ERROR;
  lbpp _ 0; bpp _ 0; full _ TRUE;
  bitmap _ NIL; bitmapB _ NIL; wpl _ 0;
  ashow _ bshow _ TRUE;
  width _ ColorDisplay.width; height _ ColorDisplay.height;
  IF test THEN { TestPattern[]; test _ FALSE } ELSE ClearScreen;
  IF neg THEN Negative ELSE Positive;
  ColorDisplay.TurnOn[];
  };

Go: PROC = {
[] _ InitRandom[0];

SELECT TRUE FROM
  SetLogBitsPerPixel[3] => NULL;
  SetLogBitsPerPixel[2] => NULL;
  ENDCASE => RETURN;
-- PrintDirections;

DO
IF keys[E]=down THEN EXIT;
IF keys[One]=down AND bpp#1 THEN { [] _ SetLogBitsPerPixel[0];
  IF NOT splat THEN test _ TRUE };
IF keys[Two]=down AND bpp#2 THEN { [] _ SetLogBitsPerPixel[1];
  IF NOT splat THEN test _ TRUE };
IF keys[Four]=down AND bpp#4 THEN { [] _ SetLogBitsPerPixel[2];
  IF NOT splat THEN test _ TRUE };
IF keys[Eight]=down AND bpp#8 THEN { [] _ SetLogBitsPerPixel[3];
  IF NOT splat THEN test _ TRUE };
IF keys[Zero]=down AND NOT full THEN { Set24BitsPerPixel[];
  IF NOT splat THEN test _ TRUE };
IF keys[A]=down THEN { ashow _ NOT ashow; ColorDisplay.Show[ashow,bshow,TRUE];
  WHILE keys[A]=down DO ENDLOOP };
IF keys[B]=down THEN { bshow _ NOT bshow; ColorDisplay.Show[ashow,bshow,TRUE];
  WHILE keys[B]=down DO ENDLOOP };
IF keys[R]=down THEN { splat _ NOT splat;
  WHILE keys[R]=down DO ENDLOOP };
IF keys[N]=down THEN { neg _ NOT neg;
  WHILE keys[N]=down DO ENDLOOP };
IF keys[T]=down THEN { test _ TRUE; splat _ FALSE };
IF test THEN { TestPattern[]; test _ FALSE };
IF splat THEN RandomSplat;
ENDLOOP;

IF NOT ColorDisplay.SetMode[ColorDisplay.disconnected] THEN ERROR;
};

Go[];

END.