-- 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.