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