-- feed-back area module of silicon (pretty picture) program
-- modified by McCreight, December 20, 1983 4:44 PM
DIRECTORY multiGraphicsDefs,
InlineDefs,
StringDefs,
DirectoryDefs,
AltoFileDefs,
IODefs,
StreamDefs,
ppCache,
ppdddefs,ppddefs,
ppdefs,ppfeeddefs;

ppfeed2: PROGRAM
IMPORTS ppCache,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:
lambdaGrid: PUBLIC CARDINAL ← Lambda;
xRatiow:PUBLIC INTEGER←2;
xRatiol:PUBLIC INTEGER←1;
implant:PUBLIC DepletionStrength←enhancement;
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
j,k:CARDINAL;
ts:STRING;
okMatch:BOOLEAN;
FOR fb: fbParmRPtr ← fbAr, fb.next WHILE fb#NIL DO
ts←fb.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
fb.setP[fb.prm,fb.m,fb.n,fb.code,s,k,fb];
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];
RETURN[Surround[p: [parm.sx, parm.sy], s: parm.s1,
gray: NOT showColorLevel[l], box:
(SELECT favLev FROM
dif, pdif, nwelCont, pwelCont => l=dif,
ENDCASE => l=favLev)]];
END;

flipLevVisible: modProc =
BEGIN
l: level = LOOPHOLE[code];
showColorLevel[l] ← NOT showColorLevel[l];
parm.chgC ← TRUE;
END;

flipCache: modProc =
BEGIN OPEN ppCache;
IF CachingIsEnabled[] THEN DisableCache[] ELSE EnableCache[];
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] RETURNS [nextX: INTEGER] =
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-3, y1: p.y-fnt.ascent-2, x2: p.x-2, y2: p.y+fnt.descent+1];
ReplaceArea[x1: lastX+1, y1: p.y-fnt.ascent-2, x2: lastX+2, y2: p.y+fnt.descent+1];
ReplaceArea[x1: p.x-3, y1: p.y-fnt.ascent-2, x2: lastX+2, y2: p.y-fnt.ascent-1];
ReplaceArea[x1: p.x-3, y1: p.y+fnt.descent, x2: lastX+2, y2: p.y+fnt.descent+1];
lastX ← lastX+3;
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;
RETURN[lastX];
END;

dspCache: dProc =
BEGIN
ds:STRING←[14];
x ← Surround[p: [parm.sx, parm.sy], s: parm.s1,
gray: NOT ppCache.CachingIsEnabled[]].nextX;
ds.length←0;
AppendDecimal[ds,p↑];
RETURN[PutText[ds,x,y,fnt,normal]];
END;

dspDifSex:dProc =
{RETURN[PutText[IF diffusionType=n THEN "n-" ELSE "p-", x, y, fnt, normal]]};

dspDifPurp:dProc =
{RETURN[PutText[IF diffusionPurpose=wiring THEN "wiring"
ELSE "contact", x, y, fnt, normal]]};

codeLev:ARRAY level OF CARDINAL = [0,1,2,3,0,0,0,0,0,4,0,5,0,0,0,0];

setFL:modProc =
BEGIN
SetFavLev[LOOPHOLE[code, level]];
parm.chgC ← FALSE
END;

flipDifSex: modProc =
BEGIN
diffusionType ← IF diffusionType = n THEN p ELSE n;
SetFavLev[favLev];
END;

flipDifPurp: modProc =
BEGIN
diffusionPurpose ← IF diffusionPurpose = wiring THEN wellCont ELSE wiring;
SetFavLev[favLev];
END;

SetFavLev: PUBLIC PROC [l: level] =
BEGIN
favLev ← SELECT l FROM
dif, pdif, nwelCont, pwelCont =>
(SELECT diffusionPurpose FROM
wiring => (SELECT diffusionType FROM
n => dif,
ENDCASE => pdif),
ENDCASE => (SELECT diffusionType FROM
n => nwelCont,
ENDCASE => pwelCont)),
ENDCASE => l;
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;

dspImplant: dProc =
{RETURN[PutText[DepletionStrengthName[implant],x,y,fnt,normal]]};

zeroImplant, maxImplant: modProc = {implant ← IF implant#LAST[DepletionStrength]
THEN LAST[DepletionStrength] ELSE FIRST[DepletionStrength]};

incImplant: modProc = {implant ← (IF implant=LAST[DepletionStrength]
THEN FIRST[DepletionStrength] ELSE implant+1)};

displayParameters:PUBLIC PROCEDURE =
BEGIN
xx,yy:INTEGER;
EraseArea[0,bwFeedTop,606,808];

PutArea[0,bwBottom+1,700,bwBottom+3];
PutArea[0,bwMsgBottom-5,700,bwMsgBottom-3];

FOR fb: fbParmRPtr ← fbAr, fb.next WHILE fb#NIL DO
xx←fb.sx;
yy←fb.sy;
IF fb.s1.length>0 THEN xx←PutText[fb.s1,xx,yy,fnt,normal];
xx←fb.dspPrm[fb.prm,xx,yy,fb.code,fb];
IF fb.s2.length>0 THEN xx←PutText[fb.s2,xx,yy,fnt,normal];
ENDLOOP;
END;

doRfeed:PUBLIC PROCEDURE RETURNS[BOOLEAN,BOOLEAN] =
BEGIN
fb: fbParmRPtr←feedTrack[];
IF fb=NIL THEN RETURN[FALSE,FALSE];
fb.rbP[fb.prm,fb.m,fb.n,fb.code,fb];
RETURN[fb.chgC,fb.chgB];
END;
doYfeed:PUBLIC PROCEDURE RETURNS[BOOLEAN,BOOLEAN] =
BEGIN
fb: fbParmRPtr←feedTrack[];
IF fb=NIL THEN RETURN[FALSE,FALSE];
fb.ybP[fb.prm,fb.m,fb.n,fb.code,fb];
RETURN[fb.chgC,fb.chgB];
END;
doBfeed:PUBLIC PROCEDURE RETURNS[BOOLEAN,BOOLEAN] =
BEGIN
fb: fbParmRPtr←feedTrack[];
IF fb=NIL THEN RETURN[FALSE,FALSE];
fb.bbP[fb.prm,fb.m,fb.n,fb.code,fb];
RETURN[fb.chgC,fb.chgB];
END;

feedTrack: PROCEDURE RETURNS [fb: fbParmRPtr]=
BEGIN
ke:keyEvent;

fb ← NIL;
UNTIL BITAND[mButs↑,7]=7 DO
cx←curx-colWidth;cy←cury;
IF fb#NIL AND NOT (cx IN [fb.tx1..fb.tx2] AND cy IN [fb.ty1..fb.ty2]) THEN
{XorArea[fb.tx1,fb.ty1,fb.tx2,fb.ty2]; fb ← NIL};
IF fb=NIL THEN FOR tfb: fbParmRPtr ← fbAr, tfb.next WHILE fb#NIL DO
IF cx IN [tfb.tx1..tfb.tx2] AND cy IN [tfb.ty1..tfb.ty2] THEN
BEGIN
fb ← tfb;
XorArea[fb.tx1,fb.ty1,fb.tx2,fb.ty2];
EXIT;
END;
ENDLOOP;
ENDLOOP;

ke←getchr[];
UNTIL ke.k IN [72B..74B] DO ke←getchr[] ENDLOOP;
cx←ke.mx-colWidth; cy←ke.my;
fb ← NIL;
FOR tfb: fbParmRPtr ← fbAr, tfb.next WHILE tfb#NIL DO
IF cx IN [tfb.tx1..tfb.tx2] AND cy IN [tfb.ty1..tfb.ty2] THEN
{fb ← tfb; EXIT};
ENDLOOP;
END;


END.