-- feed-back area module of silicon (pretty picture) program
-- modified by McCreight, December 16, 1982 5:57 PM
DIRECTORY multiGraphicsDefs,
InlineDefs,
StringDefs,
DirectoryDefs,
AltoFileDefs,
IODefs,
StreamDefs,
ppdddefs,ppddefs,
ppdefs,ppfeeddefs;
ppfeed2: PROGRAM
IMPORTS ppdddefs,ppddefs,ppdefs,StringDefs,DirectoryDefs,StreamDefs,
ppfeeddefs,InlineDefs,multiGraphicsDefs
EXPORTS ppdefs,ppddefs,ppdddefs,ppfeeddefs = PUBLIC
BEGIN OPEN ppdefs,ppdddefs,ppddefs,ppfeeddefs,StringDefs,InlineDefs,
DirectoryDefs,IODefs,StreamDefs,multiGraphicsDefs;
cx,cy:PUBLIC INTEGER;
ystrt:INTEGER=350;
mButs: POINTER TO CARDINAL = LOOPHOLE[177030B];
scaleArray:ARRAY[1..20] OF RECORD[INTEGER,INTEGER]←
[[1,256],[1,128],[1,64],[1,32],[1,16],[1,8],[1,4],[1,2],[1,1],
[2,1],[3,1],[4,1],[6,1],[8,1],[12,1],[16,1],[24,1],[32,1],[48,1],[64,1]];
colTb:ARRAY[0..7] OF STRING=["Cut,","Dif,","Pol,","Met,","Imp,","?","?","?"];
sCodeDisp:ARRAY[1..2] OF PROCEDURE[qq:INTEGER] =
[setCscale,setBWscale];
-- MAGIC (variable) CONSTANTS:
--Xstr (transistor) parameters:
xRatiow:PUBLIC INTEGER←2;
xRatiol:PUBLIC INTEGER←1;
implant:PUBLIC BOOLEAN←FALSE;
pRatiow:PUBLIC INTEGER←1;
pRatiol:PUBLIC INTEGER←2;
pushLevel:PUBLIC INTEGER←0;
setInt:setProc =
BEGIN
j:CARDINAL;
i:INTEGER;
WHILE si<s.length AND NOT s[si] IN ['0..'9] DO si←si+1;ENDLOOP;
[i,j]←scan[s,si];
IF i>max THEN i←max;
IF i<min THEN i←min;
IF code>1 THEN i←i*code;
p↑←i;
END;
scan:PROCEDURE[s:STRING,si:CARDINAL] RETURNS[i:INTEGER,rsi:CARDINAL]=
BEGIN
j:CARDINAL;
i←0;
FOR j IN [si..s.length) DO
IF NOT s[j] IN ['0..'9] THEN BEGIN rsi←j;EXIT END;
i←i*10+(s[j]-'0);
ENDLOOP;
END;
setBool:setProc =
BEGIN
WHILE si<s.length AND s[si] IN ['A..'z] DO si←si+1;ENDLOOP;
WHILE si<s.length AND (s[si]=' OR s[si]=': OR s[si]='=)
DO si←si+1;ENDLOOP;
IF s[si]='1 OR s[si]='y OR s[si]='Y OR s[si]='t OR s[si]='T THEN
p↑←TRUE;
IF s[si]='0 OR s[si]='n OR s[si]='N OR s[si]='f OR s[si]='F THEN
p↑←FALSE;
END;
setCmx:setProc =
BEGIN
x,y,z:INTEGER;
WHILE si<s.length AND NOT s[si] IN ['0..'9] DO si←si+1;ENDLOOP;
[x,si]←scan[s,si];
WHILE si<s.length AND NOT s[si] IN ['0..'9] DO si←si+1;ENDLOOP;
[y,si]←scan[s,si];
z←findCTab[x,y];
IF z>=0 THEN setColorTable[z];
END;
setScl:setProc =
BEGIN
j:CARDINAL;
i:INTEGER;
WHILE si<s.length AND NOT s[si] IN ['0..'9] DO si←si+1;ENDLOOP;
[i,j]←scan[s,si];
IF i>max THEN i←max;
IF i<min THEN i←min;
sCodeDisp[code][i];
END;
doParmLine:PROCEDURE[s:STRING] =
BEGIN
i,j,k:CARDINAL;
ts:STRING;
okMatch:BOOLEAN;
FOR i IN [0..fbC) DO
ts←fbAr[i].setStr;
k←0;
okMatch←TRUE;
IF ts.length=0 THEN okMatch←FALSE;
FOR j IN [0..ts.length) DO
WHILE k<s.length AND NOT (s[k]=ts[j] OR s[k]+40B=ts[j]) DO
k←k+1;ENDLOOP;
k←k+1;
IF k>=s.length THEN BEGIN okMatch←FALSE;EXIT;END;
ENDLOOP;
IF okMatch THEN
BEGIN
fbAr[i].setP[fbAr[i].prm,fbAr[i].m,fbAr[i].n,fbAr[i].code,s,k,@fbAr[i]];
EXIT;
END;
ENDLOOP;
END;
doParmInit:PUBLIC PROCEDURE =
BEGIN
fHandle:DiskHandle;
fp:AltoFileDefs.FP;
s:STRING←[200];
k:CARDINAL;
IF NOT DirectoryLookup[@fp,"chipmonk.profile",FALSE] THEN RETURN;
fHandle←NewByteStream["chipmonk.profile",Read];
UNTIL fHandle.endof[fHandle] DO
s.length←0;
k←fHandle.get[fHandle];
UNTIL fHandle.endof[fHandle] OR k=15B DO
AppendChar[s,LOOPHOLE[k]];
k←fHandle.get[fHandle];
ENDLOOP;
doParmLine[s];
ENDLOOP;
fHandle.destroy[fHandle];
END;
dspCMix:dProc =
BEGIN
i,j:CARDINAL;
t,xx,yy:INTEGER;
FOR i IN [0..cTabCnt) DO
j←colorTabs[i][0];
xx←BITSHIFT[j,-8];
yy←BITAND[j,377B];
t←IF i=currentCTab THEN 7 ELSE 3;
xx←xx*10+x-t/2;
yy←yy*10+y-t/2;
ReplaceArea[xx,yy,xx+t,yy+t];
ENDLOOP;
RETURN[x];
END;
setCMix:modProc =
BEGIN
x,y,z:INTEGER;
x←(cx-max)/10;
y←(cy-min)/10;
z←findCTab[x,y];
IF z>=0 THEN setColorTable[z];
END;
resetCMix:modProc =
BEGIN
setColorTable[0];
END;
moveCMix:modProc =
BEGIN
i:CARDINAL;
ke:keyEvent;
x,y,z,w:INTEGER;
x←(cx-max)/10;
y←(cy-min)/10;
IF x<-5 OR y<-5 THEN RETURN;
z←findCTab[x,y];
IF z<0 THEN RETURN;
SetGrayLevel[14];
XorGray[max,min,max+90,min+100];
ke←getchr[];
UNTIL ke.k=77B DO IF ke.k=56B THEN
BEGIN SetGrayLevel[14];XorGray[max,min,max+90,min+100];
RETURN;END;ke←getchr[];ENDLOOP;
SetGrayLevel[14];
XorGray[max,min,max+90,min+100];
x←(ke.mx-colWidth-max)/10;
y←(ke.my-min)/10;
IF x<-5 OR y<-5 THEN RETURN;
w←findCTab[x,y];
IF w<0 THEN
BEGIN
w←cTabCnt;
cTabCnt←w+1;
i←BITOR[BITSHIFT[x,8],y];
colorTabs[w][0]←i;
END;
FOR i IN [1..49) DO colorTabs[w][i]←colorTabs[z][i];ENDLOOP;
setColorTable[w];
anyCTChanges←TRUE;
END;
currentPattern: PUBLIC CARDINAL ← 0;
dspCPat:dProc =
BEGIN
i:CARDINAL;
xx,yy:INTEGER;
yy←y+5;
FOR i IN [0..colPatNum) DO
xx←x+i*10;
ReplaceArea[xx-3,yy,xx+3,yy];
ReplaceArea[xx,yy-3,xx,yy+3];
IF i=currentPattern THEN ReplaceArea[xx-2,yy-2,xx+2,yy+2];
ENDLOOP;
RETURN[x];
END;
setCPat:modProc =
BEGIN
x:INTEGER;
x←(cx-max)/10;
IF colPatternBits[x]#0 THEN
BEGIN
currentPattern←x;
orLtab←colPatternTabs[x];
END;
END;
resetCPat:modProc =
BEGIN
currentPattern←0;
orLtab←colPatternTabs[0];
END;
moveCPat:modProc =
BEGIN
ke:keyEvent;
x,z:INTEGER;
z←(cx-max)/10;
IF z<-5 THEN RETURN;
IF colPatternBits[z]=0 THEN RETURN;
SetGrayLevel[14];
XorGray[max,min,max+90,min+18];
ke←getchr[];
UNTIL ke.k=77B DO IF ke.k=56B THEN
BEGIN SetGrayLevel[14];XorGray[max,min,max+90,min+18];
RETURN;END;ke←getchr[];ENDLOOP;
SetGrayLevel[14];
XorGray[max,min,max+90,min+18];
x←(ke.mx-colWidth-max)/10;
IF x<-5 THEN RETURN;
colPatternTabs[x]←colPatternTabs[z];
colPatternBits[x]←15;
anyCTChanges←TRUE;
currentPattern←x;
orLtab←colPatternTabs[x];
END;
findCTab:PROCEDURE[x,y:INTEGER] RETURNS[INTEGER] =
BEGIN
cc,i:CARDINAL;
IF x<0 THEN x←0;IF y<0 THEN y←0;
cc←BITOR[BITSHIFT[x,8],y];
FOR i IN [0..cTabCnt) DO
IF cc=colorTabs[i][0] THEN RETURN[i];
ENDLOOP;
RETURN[-1];
END;
nullMP:modProc = BEGIN NULL END;
nullDP:dProc = BEGIN RETURN[x] END;
dspLevVisible: dProc =
BEGIN
l: level = LOOPHOLE[code];
Surround[p: [parm.sx, parm.sy], s: parm.s1, gray: NOT showColorLevel[l], box: l=favLev];
RETURN[x];
END;
flipLevVisible: modProc =
BEGIN
l: level = LOOPHOLE[code];
showColorLevel[l] ← NOT showColorLevel[l];
parm.chgC ← TRUE;
END;
nullST:setProc = {NULL};
dspLam:dProc =
BEGIN
pp:POINTER TO INTEGER=LOOPHOLE[p];
ds:STRING←[14];
ds.length←0;
AppendDecimal[ds,pp↑/2];
RETURN[PutText[ds,x,y,fnt,normal]];
END;
dspCore:dProc =
BEGIN
ds:STRING←[18];
ds.length←0;
AppendDecimal[ds,swdsAloc];
AppendString[ds,", "];
appendLongDecimal[ds,lwdsAloc];
x←PutText[ds,x,y,fnt,normal];
RETURN[x];
END;
appendLongDecimal:PROCEDURE[s:STRING,n:LONG INTEGER]=
BEGIN
IF n<0 THEN BEGIN AppendChar[s,'-];n←-n;END;
apLD[s,n];
END;
apLD:PROCEDURE[s:STRING,n:LONG INTEGER]=
BEGIN
q:LONG INTEGER;
r:INTEGER;
q←n MOD 10;
r←LowHalf[q];
q←n/10;
IF q#0 THEN apLD[s,q];
AppendChar[s,'0+r]
END;
dspName:dProc =
BEGIN
s:STRING;
s←p↑;
RETURN[PutText[s,x,y,fnt,normal]];
END;
dspLM:dProc =
BEGIN
i,j:INTEGER;
i←p↑;
IF i=0 THEN RETURN[PutText["- - -",x,y,fnt,normal]];
FOR j IN [0..7] DO
IF BITAND[i,BITSHIFT[1,j]]#0 THEN
x←PutText[colTb[j],x,y,fnt,normal];
ENDLOOP;
RETURN[x];
END;
Surround: PROC [p: Point, s: STRING, box, gray: BOOLEAN ← FALSE,
font: StrikeFontPtr ← NIL] =
BEGIN
lastX: INTEGER;
IF font=NIL THEN font ← fnt;
lastX ← p.x+MeasureText[s: s, font: font];
IF box THEN
BEGIN
ReplaceArea[x1: p.x-2, y1: p.y-fnt.ascent-2, x2: p.x-1, y2: p.y+fnt.descent+1];
ReplaceArea[x1: lastX, y1: p.y-fnt.ascent-2, x2: lastX+1, y2: p.y+fnt.descent+1];
ReplaceArea[x1: p.x-2, y1: p.y-fnt.ascent-2, x2: lastX+1, y2: p.y-fnt.ascent-1];
ReplaceArea[x1: p.x-2, y1: p.y+fnt.descent, x2: lastX+1, y2: p.y+fnt.descent+1];
END;
IF gray THEN
BEGIN
halfGray: GrayPattern ←
[125252B, 52525B, 125252B, 52525B, 125252B, 52525B, 125252B];
SetArea[x1: p.x-1, y1: p.y-fnt.ascent-1, x2: lastX, y2: p.y+fnt.descent,
fn: paint, gray: @halfGray];
END;
END;
dspCM, dspFL:dProc =
BEGIN
Surround[p: [parm.sx, parm.sy], s: parm.s1, box: (code#0)=cMos];
RETURN[x];
END;
codeLev:ARRAY level OF CARDINAL = [0,1,2,3,0,0,0,0,0,4,0,5,0,0,0,0];
setFL:modProc = {favLev←LOOPHOLE[code, level]; parm.chgC ← FALSE};
setCM:modProc =
BEGIN
cMos←code#0;
END;
dspScl:dProc =
BEGIN
pos,i:INTEGER;
ds:STRING←[14];
ds.length←0;
i←p↑;
AppendDecimal[ds,i];
pos←PutText[ds,x,y,fnt,normal];
ReplaceArea[x,bwFeedTop+30,x+2,bwFeedTop+110];
ReplaceArea[x-4,bwFeedTop+113-i*4,x+6,bwFeedTop+115-i*4];
RETURN[pos];
END;
tyScl:modProc =
BEGIN
i:INTEGER;
i←bwFeedTop+114-cy;
i←i/4;
IF i>max THEN i←max;
IF i<min THEN i←min;
sCodeDisp[code][i];
END;
incScl:modProc =
BEGIN
i:INTEGER;
i←p↑;
i←i+1;
IF i>max THEN i←max;
sCodeDisp[code][i];
END;
decScl:modProc =
BEGIN
i:INTEGER;
i←p↑;
i←i-1;
IF i<min THEN i←min;
sCodeDisp[code][i];
END;
dspBool:dProc =
BEGIN
b:BOOLEAN;
b←LOOPHOLE[p↑];
IF b THEN
RETURN[PutText["YES",x,y,fnt,normal]]
ELSE
RETURN[PutText["NO",x,y,fnt,normal]];
END;
incBool:modProc =
BEGIN
b:BOOLEAN;
b←TRUE;
p↑←b;
END;
decBool:modProc =
BEGIN
b:BOOLEAN;
b←FALSE;
p↑←b;
END;
cmpBool:modProc =
BEGIN
b:BOOLEAN;
b←p↑;
b←NOT b;
p↑←b;
END;
dspMode:dProc =
BEGIN
IF wiring THEN RETURN[PutText["Wiring",x,y,fnt,normal]];
IF boxing THEN RETURN[PutText["AreaSel",x,y,fnt,normal]];
RETURN[PutText["none",x,y,fnt,normal]];
END;
dspInt:dProc =
BEGIN
ds:STRING←[14];
ds.length←0;
IF code>1 THEN
BEGIN
i:INTEGER←LOOPHOLE[p↑];
i←i/code;
AppendDecimal[ds,i];
END
ELSE AppendDecimal[ds,p↑];
RETURN[PutText[ds,x,y,fnt,normal]];
END;
incInt:modProc =
BEGIN
i:INTEGER;
i←p↑;
i←i+MAX[code,1];
IF i>max THEN i← IF code=1 THEN min ELSE max;
p↑←i;
END;
decInt:modProc =
BEGIN
i:INTEGER;
i←p↑;
i←i-MAX[code,1];
IF i<min THEN i← IF code=1 THEN max ELSE min;
p↑←i;
END;
tyInt:modProc =
BEGIN
i:INTEGER;
ke:keyEvent;
ke←getchr[];
UNTIL ke.k=60B OR ke.k=65B DO -- CR or ESC
IF ke.k=71B OR ke.k=72B OR ke.k=73B OR ke.k=56B THEN RETURN;
ke←getchr[];
ENDLOOP;
i←getNumber[];
IF i>max THEN i←max;
IF i<min THEN i←min;
IF code>1 THEN i←i*code;
p↑←i;
END;
displayParameters:PUBLIC PROCEDURE =
BEGIN
i:CARDINAL;
xx,yy:INTEGER;
EraseArea[0,bwFeedTop,606,808];
PutArea[0,bwBottom+1,700,bwBottom+3];
PutArea[0,bwMsgBottom-5,700,bwMsgBottom-3];
FOR i IN [0..fbC) DO
xx←fbAr[i].sx;
yy←fbAr[i].sy;
IF fbAr[i].s1.length>0 THEN xx←PutText[fbAr[i].s1,xx,yy,fnt,normal];
xx←fbAr[i].dspPrm[fbAr[i].prm,xx,yy,fbAr[i].code,@fbAr[i]];
IF fbAr[i].s2.length>0 THEN xx←PutText[fbAr[i].s2,xx,yy,fnt,normal];
ENDLOOP;
END;
doRfeed:PUBLIC PROCEDURE RETURNS[BOOLEAN,BOOLEAN] =
BEGIN
i:CARDINAL;
b:BOOLEAN;
[b,i]←feedTrack[];
IF NOT b THEN RETURN[FALSE,FALSE];
fbAr[i].rbP[fbAr[i].prm,fbAr[i].m,fbAr[i].n,fbAr[i].code,@fbAr[i]];
RETURN[fbAr[i].chgC,fbAr[i].chgB];
END;
doYfeed:PUBLIC PROCEDURE RETURNS[BOOLEAN,BOOLEAN] =
BEGIN
i:CARDINAL;
b:BOOLEAN;
[b,i]←feedTrack[];
IF NOT b THEN RETURN[FALSE,FALSE];
fbAr[i].ybP[fbAr[i].prm,fbAr[i].m,fbAr[i].n,fbAr[i].code,@fbAr[i]];
RETURN[fbAr[i].chgC,fbAr[i].chgB];
END;
doBfeed:PUBLIC PROCEDURE RETURNS[BOOLEAN,BOOLEAN] =
BEGIN
i:CARDINAL;
b:BOOLEAN;
[b,i]←feedTrack[];
IF NOT b THEN RETURN[FALSE,FALSE];
fbAr[i].bbP[fbAr[i].prm,fbAr[i].m,fbAr[i].n,fbAr[i].code,@fbAr[i]];
RETURN[fbAr[i].chgC,fbAr[i].chgB];
END;
feedTrack:PROCEDURE RETURNS[b:BOOLEAN,n:CARDINAL]=
BEGIN
i:CARDINAL;
ke:keyEvent;
b←FALSE;
UNTIL BITAND[mButs↑,7]=7 DO
cx←curx-colWidth;cy←cury;
IF b AND NOT (cx IN [fbAr[n].tx1..fbAr[n].tx2]
AND cy IN [fbAr[n].ty1..fbAr[n].ty2]) THEN
BEGIN
b←FALSE;
XorArea[fbAr[n].tx1,fbAr[n].ty1,fbAr[n].tx2,fbAr[n].ty2];
END;
IF NOT b THEN FOR i IN [0..fbC) DO
IF cx IN [fbAr[i].tx1..fbAr[i].tx2]
AND cy IN [fbAr[i].ty1..fbAr[i].ty2] THEN
BEGIN
n←i;
b←TRUE;
XorArea[fbAr[i].tx1,fbAr[i].ty1,fbAr[i].tx2,fbAr[i].ty2];
EXIT;
END;
ENDLOOP;
ENDLOOP;
ke←getchr[];
UNTIL ke.k IN [72B..74B] DO ke←getchr[];ENDLOOP;
cx←ke.mx-colWidth;cy←ke.my;
b←FALSE;
FOR i IN [0..fbC) DO
IF cx IN [fbAr[i].tx1..fbAr[i].tx2]
AND cy IN [fbAr[i].ty1..fbAr[i].ty2] THEN
BEGIN
n←i;
b←TRUE;
EXIT;
END;
ENDLOOP;
END;
END.