-- ppcolset.mesa
-- color setting module of silicon (pretty picture) program
-- last modified by McCreight, December 13, 1982 2:49 PM
DIRECTORY
multiGraphicsDefs,
InlineDefs,
StringDefs,
ppdefs,
ppddefs;
ppcolset: PROGRAM
IMPORTS ppdefs, ppddefs, multiGraphicsDefs, InlineDefs EXPORTS ppdefs =
BEGIN OPEN ppdefs, ppddefs, multiGraphicsDefs, InlineDefs;
Buttons: TYPE = MACHINE DEPENDENT RECORD [
KeyPadAndGarbage: [0..10000B), Red: [0..1], Blu: [0..1], Yel: [0..1]];
mButs: POINTER TO Buttons = LOOPHOLE[177030B];
ke: keyEvent;
quitflg: BOOLEAN ← FALSE;
rAr: ARRAY [0..90] OF RECORD [x1, x2, y1, y2: INTEGER, ccc: CARDINAL];
rArCnt: CARDINAL ← 0;
marked: BOOLEAN ← FALSE;
i, k, j,cc: CARDINAL;
x,y: INTEGER;
lv:level;
curcol: INTEGER ← 0;
ystrt: INTEGER = 122;
found: BOOLEAN;
--color setting stuff:
Ctab: ARRAY [0..7] OF CARDINAL ← [9, 1, 4, 2, 76B, 8, 11, 10];
mak: PROCEDURE [x, y, xs, ys: INTEGER, c: CARDINAL] =
BEGIN
rAr[rArCnt] ← [
x1: x - xs/2, x2: x + xs/2, y1: y - ys/2, y2: y + ys/2, ccc: c];
-- rAr[rArCnt]←[x1:x-xs/2,x2:x+xs/2,y1:y-ys/2,y2:y+ys/2,ccc:Ctab[l]];
rArCnt ← rArCnt + 1;
END;
ersScrn: PROCEDURE [w, x, y, z: INTEGER] = INLINE
{ReplaceColorArea[x1: w, y1: x, x2: y, y2: z, c: 0]};
orAreaUS: PROCEDURE [w, x, y, z: INTEGER, l: CARDINAL] =
BEGIN
gray: GrayPattern ← GetColorGray[l];
SetColorArea[x1: w, y1: x, x2: y, y2: z,
fn: IF l IN [8..15] THEN replace ELSE paint, cGray: @gray];
-- SetGrayLevel[l];
-- PutGray[w,x,y,z];
END;
makCross: PROCEDURE [x, y, bsiz, siz1, siz2, col1, col2: INTEGER] =
BEGIN mak[x, y, bsiz*2, siz1*2, col1]; mak[x, y, siz2*2, bsiz*2, col2]; END;
initColors: PUBLIC PROCEDURE =
BEGIN
rArCnt ← 0;
k←15;
FOR lv IN level DO
mak[k,450,20,20,orLtab[lv]];
mak[k,390,14,14,BITAND[orLtab[lv],15]];
mak[k,420,14,14,BITAND[BITSHIFT[orLtab[lv],-4],15]];
k←k+30;
ENDLOOP;
FOR i IN [0..1] DO
FOR j IN [0..7] DO mak[55 + j*55, 40 + i*55, 35, 35, i*8 + j]; ENDLOOP;
ENDLOOP;
makCross[100, 180, 30, 8, 12, 1, 2];
makCross[300, 180, 30, 8, 12, 4, 2];
makCross[200, 250, 30, 16, 8, 1, 4];
mak[298, 300, 40, 8, 4];
mak[322, 300, 40, 8, 1];
mak[310, 285, 12, 40, 2];
mak[100, 330, 16, 16, 3];
mak[100, 330, 8, 8, 9];
mak[130, 330, 16, 16, 6];
mak[130, 330, 8, 8, 9];
mak[160, 322, 16, 8, 6];
mak[160, 328, 16, 4, 7];
mak[160, 336, 16, 12, 3];
mak[160, 330, 8, 16, 9];
END;
setColors: PUBLIC PROCEDURE =
BEGIN
savGrid: CARDINAL ← gridCol;
gridCol ← 1;
quitflg ← FALSE;
ke.k ← 65B;
UNTIL quitflg DO
IF ke.k = 32B OR ke.k = 56B THEN quitflg ← TRUE;
IF ke.k = 77B AND ke.ctl = 1 THEN -- red button push
BEGIN
IF curx IN [405..470] AND cury IN [ystrt - 10..ystrt + 265] THEN
BEGIN
j ← (curx - 400)/25;
k ← IF cury < ystrt THEN 0 ELSE cury - ystrt;
IF k > 255 THEN k ← 255;
setGlev[curcol, j, k];
WHILE mButs.Red = 0 DO
IF curx < 400 OR curx > 475 OR cury < ystrt - 30 THEN LOOP;
j ← (curx - 400)/25;
k ← IF cury < ystrt THEN 0 ELSE cury - ystrt;
IF k > 255 THEN k ← 255;
setGlev[curcol, j, k];
ENDLOOP;
ersScrn[410, ystrt - 1, 472, ystrt + 260];
FOR i IN [0..2] DO
j ← i;
IF i = 0 THEN j ← 4;
k ← getCurrenColor[curcol, i];
orAreaUS[412 + i*25, ystrt, 418 + i*25, ystrt + 255, j];
orAreaUS[410 + i*25, ystrt + k, 420 + i*25, ystrt + k, 10];
ENDLOOP;
END
ELSE IF cury IN [412..428] THEN
BEGIN
k←curx/30;
ke.k←65B;
lv←FIRST[level];
IF k>15 THEN k←15;
THROUGH [0..k) DO lv←SUCC[lv];ENDLOOP;
k←orLtab[lv];
orLtab[lv]←IF k>255 OR k<16 THEN BITOR[BITAND[k,17B],20B]
ELSE IF BITAND[k,60B]=60B THEN BITOR[BITOR[
BITAND[k,17B],BITSHIFT[BITAND[k,17B],4]],1000B]
ELSE k+20B;
END;
END;
IF ke.k = 77B AND ke.ctl = 3 THEN -- blue button push
BEGIN
j ← 0;
found ← FALSE;
FOR i IN [0..rArCnt) DO
IF curx IN [rAr[i].x1..rAr[i].x2] AND cury IN [rAr[i].y1..rAr[i].y2]
THEN
BEGIN
found ← TRUE;
k ← rAr[i].ccc;
IF k < 9 THEN j ← BITOR[j, k] ELSE BEGIN j ← k; EXIT; END;
END;
ENDLOOP;
IF found AND j<16 THEN
BEGIN
curcol ← j;
ersScrn[410, ystrt - 1, 472, ystrt + 260];
ersScrn[480, ystrt, 520, ystrt+40];
orAreaUS[480, ystrt, 520, ystrt+40, curcol];
FOR i IN [0..2] DO
j ← i;
IF i = 0 THEN j ← 4;
k ← getCurrenColor[curcol, i];
orAreaUS[412 + i*25, ystrt, 418 + i*25, ystrt + 255, j];
orAreaUS[410 + i*25, ystrt + k, 420 + i*25, ystrt + k, 10];
ENDLOOP;
END;
END;
IF ke.k = 77B AND ke.ctl = 2 THEN -- yellow butn
BEGIN
ke.k←65B;
j ← 0;
found ← FALSE;
FOR i IN [0..rArCnt) DO
IF curx IN [rAr[i].x1..rAr[i].x2] AND cury IN [rAr[i].y1..rAr[i].y2]
THEN
BEGIN
found ← TRUE;
k ← rAr[i].ccc;
IF k < 9 THEN j ← BITOR[j, k] ELSE BEGIN j ← k; EXIT; END;
END;
ENDLOOP;
IF found AND j<16 THEN
BEGIN
WHILE mButs.Yel = 0 DO
x←curx;y←cury;
ENDLOOP;
cc←j;
j ← 0;
found ← FALSE;
FOR i IN [0..rArCnt) DO
IF x IN [rAr[i].x1..rAr[i].x2] AND y IN [rAr[i].y1..rAr[i].y2]
THEN
BEGIN
found ← TRUE;
k ← rAr[i].ccc;
IF k < 9 THEN j ← BITOR[j, k] ELSE BEGIN j ← k; EXIT; END;
END;
ENDLOOP;
IF found AND j<16 THEN
BEGIN
IF y<380 THEN
BEGIN
FOR i IN [0..2] DO
setGlev[j, i, getCurrenColor[cc, i]];
ENDLOOP;
END
ELSE
BEGIN
lv←FIRST[level];
k←x/30;
IF k>15 THEN k←15;
THROUGH [0..k) DO lv←SUCC[lv];ENDLOOP;
k←BITOR[orLtab[lv],1000B];
orLtab[lv]←IF y<405 THEN BITOR[BITAND[k,177760B],cc]
ELSE BITOR[BITAND[k,177417B],BITSHIFT[cc,4]];
END;
END;
END;
END;
IF ke.k = 65B THEN -- esc or yellow butn
BEGIN
ersScrn[0, 0, 700, 700];
i←0;
FOR lv IN level DO
k←orLtab[lv];
rAr[i].ccc←k;
rAr[i+1].ccc←BITAND[k,15];
rAr[i+2].ccc←IF k>255 THEN BITAND[BITSHIFT[k,-4],15]
ELSE k;
i←i+3;
ENDLOOP;
FOR i IN [0..rArCnt) DO
orAreaUS[rAr[i].x1, rAr[i].y1, rAr[i].x2, rAr[i].y2, rAr[i].ccc];
ENDLOOP;
FOR i IN [0..2] DO
j ← i;
IF i = 0 THEN j ← 4;
k ← getCurrenColor[curcol, i];
orAreaUS[412 + i*25, ystrt, 418 + i*25, ystrt + 255, j];
orAreaUS[410 + i*25, ystrt + k, 420 + i*25, ystrt + k, 10];
ENDLOOP;
orAreaUS[480, ystrt, 520, ystrt+40, curcol];
END;
IF NOT quitflg THEN ke ← getchr[];
ENDLOOP;
anyCTChanges ← TRUE;
gridCol ← savGrid;
colPatternTabs[currentPattern]←orLtab;
END;
END.