-- beadsCreate.mesa

-- dd etc
-- two backfacing transistors!

DIRECTORY IODefs:FROM"IODefs",
          BeadsDefs:FROM"BeadsDefs",
          BeadsInlines:FROM"BeadsInlines",
          InlineDefs:FROM"InlineDefs",
          SystemDefs:FROM"SystemDefs",
          StringDefs:FROM"StringDefs",
          StreamDefs:FROM"StreamDefs";
BeadsCreate:PROGRAM
  IMPORTS BeadsInlines, InlineDefs,SystemDefs,StringDefs,StreamDefs,IODefs,BeadsDefs
  EXPORTS BeadsDefs =
  BEGIN OPEN BeadsDefs, BeadsInlines;

Error:SIGNAL=CODE;
IllegalInput:SIGNAL=CODE;

someBead:CARDINAL=noBead+1;

PackedInput:TYPE=RECORD[a:[0..17B],b:[0..7777B]];
PackedBytes:TYPE=RECORD[a,b:Byte];
Byte:TYPE=[0..256);
pieces:PackedBytes;
right:BOOLEAN;
altoYMax:CARDINAL=1000;
inputStream:StreamDefs.DiskHandle;

Stick:TYPE=RECORD[dir:Direction,color:Color,x,y,end:INTEGER];
maxStick:CARDINAL=300;
StickStuff:TYPE=ARRAY [0..maxStick] OF Stick;
StkPtr:TYPE=POINTER TO Stick;

stks:POINTER TO StickStuff;
topStick:CARDINAL;
xLo,yLo,xHi,yHi:[0..10000];
stickScaling:CARDINAL=20;

--allContacts:ConStuff;
--topContact:CARDINAL_0;

getWhatYouSee:PUBLIC BOOLEAN;

--BeadType:TYPE={none,all,rg,rb,bg,tt,dd,ttV,ddV,endG,endR,endB,stub,
--               jctn,jctnR,jctnB,bf,wireG,wireR,wireB,wireO,of};

typeFromColor:ARRAY Color OF ARRAY Color OF BeadType_[
  [none,endR,endB,endG,endR,endO],
  [none,jctnR,rb,rg,jctnR,endO],
  [none,rb,jctnB,bg,rb,endO],
  [none,rg,bg,jctnG,rg,endO],
  [none,jctnR,rb,rg,jctnR,endO],
  [none,endO,endO,endO,endO,endO]];

ColorToLevel:ARRAY Color OF CARDINAL_[0,1,2,1,1,3];
      --none,red,blue,green,yellow,orange
ColorToType:ARRAY Color OF ARRAY Color OF BeadType_--1st guy horizontal
   [[none ,none ,none ,none ,none ,none],
    [none ,jctnR,none , ttV ,jctnR, endO ],
    [none ,none ,jctnB,none ,none , endO ],
    [none ,  tt ,none ,jctnG,  dd , endO ],
    [none ,jctnR,none , ddV ,jctnR, endO ],
    [none, endO  , endO  , endO  , endO  , endO ]];

-- Code:   jctn,jctnR,jctnB,rb,bg,rg,all,other
TwoCodes:ARRAY [0..5] OF ARRAY [0..5] OF BeadType_[
    [jctnG, rg  , bg  , all , bg  , rg  ],
    [ rg  ,jctnR, rb  , rb  , all , rg  ],
    [ bg  , rb  ,jctnB, rb  , bg  , all ],
    [ all , rb  , rb  , rb  , all , all ],
    [ bg  , all , bg  , all , bg  , all ],
    [ rg  , rg  , all , all , all , rg  ]];
inTry:CARDINAL;

pr,disp:BOOLEAN;


FromInputToBeads:PUBLIC PROCEDURE[fileName:STRING,print:BOOLEAN]=BEGIN
  pr_print; disp_FALSE;
  stks_SystemDefs.AllocateSegment[SIZE[StickStuff]];
  StringDefs.AppendString[fileName,".stick"];
  FromSilFileToSticks[fileName];
  fileName.length_fileName.length-6;
  xLo_yLo_10000; xHi_yHi_0;
  EnumerateSticks[t,FindBoundsOfDiagram];
  IF getWhatYouSee THEN EnumerateSticks[t,WhatYouSeeIsWhatYouGet];
  IF getWhatYouSee THEN EliminateNulls[];
  EnumerateSticks[t,MakeCloseTeeJctnsTouch];
  CompressStickCoordinates[];
  EnumerateSticks[t,PutTeeJctnsInBeadTable];
  EnumerateSticks[t,PutCrossingsInBeadTable];
  EnumerateSticks[t,YellowToRed];
  EnumerateBeads[t,ConvertMultipleLevelsToTiedBeads];
  EnumerateBeads[f,DoesBeadHaveNeighbors];
  EnumerateBeads[t,RecordBeadsNeighbors];
  EnumerateBeads[t,StickToBeadCoordinates];
  EnumerateBeads[t,WiggleTiedBeadsUpAndDown];
  EnumerateBeads[f,ClearWire];
  EnumerateBeads[t,AddWires];
  EnumerateBeads[f,SetHeightAndWidth];
  EnumerateBeads[t,FixWire];
  MakeCircuits[];
  EnumerateBeads[f,SetTypeConstants];
  SystemDefs.FreeSegment[stks];
  WriteOneNumber["size of stick table=  ",topStick+1];
  END;

PMode:TYPE={t,f,s,b,n};

EnumerateSticks:PROCEDURE[m:PMode,call:PROCEDURE[CARDINAL]]=BEGIN
  FOR j:CARDINAL IN [0..topStick]
  DO IF stks[j].color#none THEN call[j]; ENDLOOP;
  IF m=t THEN Show[s];
  END;

EnumStksWhichMightTouch:PROCEDURE[i:CARDINAL,call:PROCEDURE[CARDINAL,StkPtr]]=
  BEGIN
  FOR j:CARDINAL IN [0..topStick]
  DO s:StkPtr_@stks[j]; IF s.color#none AND i#j THEN call[j,s]; ENDLOOP;
  END;

EnumerateBeads:PROCEDURE[m:PMode,call:PROCEDURE[Desc]]=BEGIN
  BeadsDefs.EnumerateBeads[call]; IF m=t THEN Show[b]; END;

YellowToRed:PROCEDURE[i:CARDINAL]={IF stks[i].color=y THEN stks[i].color_r};
ClearWire:PROCEDURE[i:Desc]=BEGIN i.p.wire_FALSE;  END;

Show:PROCEDURE[mode:PMode]=BEGIN
  IF pr THEN SELECT mode FROM
     s=>PrintAllSticks[topStick];
     b=>PrintBeads[];
     n,f=>NULL;
    ENDCASE=>Error;
  IF disp THEN SELECT mode FROM
     s=>DisplayAllSticks[stks,topStick];
     b=>DisplayBeads[];
     n,f=>NULL;
    ENDCASE=>Error;
  END;

DisplayBeads:PROCEDURE=BEGIN END;
DisplayAllSticks:PROCEDURE[s:POINTER TO StickStuff,i:CARDINAL]=BEGIN END;

FromSilFileToSticks:PROCEDURE[inName:STRING]=BEGIN
  a,i:CARDINAL; m:PackedInput;
  s,x,y,xMax,yMax,f:CARDINAL; string:STRING_[100]; c:Color;
  inTry_0;
  inputStream_StreamDefs.NewWordStream[inName,StreamDefs.Read];
  a_RW[]; SELECT a FROM 34562B,34563B=>NULL; ENDCASE=>Error;
  topStick_0;
  UNTIL inputStream.endof[inputStream] DO
    IF (a_RW[])#177777B THEN Error; -- type non-macro
    m_LOOPHOLE[RW[]]; x_m.b;
    yMax_altoYMax-RW[]; IF yMax>altoYMax THEN Error;
    m_LOOPHOLE[RW[]]; xMax_m.b;
    c_SELECT m.a FROM 1=>r, 2=>y, 3=>g, 4=>b, 9=>o, ENDCASE=>none;
      --black,red,yellow,green,cyan,violet,magenta,white,
      --brown,orange,lime,turquoise,aqua,ultraviolet,pink,smoke
    m_LOOPHOLE[RW[]]; f_m.a; y_altoYMax-m.b; IF y>3777B THEN Error;
    IF f<=13 THEN BEGIN
      s_RB[];
      FOR i IN [0..s) DO string[i]_LOOPHOLE[RB[],CHARACTER]; ENDLOOP;
      END;
    IF c#none AND f=14 THEN BEGIN
      w:CARDINAL_xMax-x;
      h:CARDINAL_yMax-y;
      stks[topStick]_IF h>w THEN [v,c,x+w/2,y,yMax]
                                 ELSE [h,c,x,y+h/2,xMax];
      topStick_topStick+1;
      IF topStick>maxStick THEN Error;
      END;
    --process exception stuff
    ENDLOOP;
    topStick_topStick-1;
    inputStream.destroy[inputStream];
  END;
-- ///////////////
FindBoundsOfDiagram:PROCEDURE[i:CARDINAL]=BEGIN
  is:Stick_stks[i];
  IF is.dir=h THEN SetLoHi[is.x,is.y-4,is.end,is.y+4]
              ELSE SetLoHi[is.x-4,is.y,is.x+4,is.end];
  END;

SetLoHi:PROCEDURE[a,b,c,d:INTEGER]=BEGIN
  IF a<xLo THEN xLo_a;
  IF b<yLo THEN yLo_b;
  IF c>xHi THEN xHi_c;
  IF d>yHi THEN yHi_d;
  END;
-- ///////////////
WhatYouSeeIsWhatYouGet:PROCEDURE[i:CARDINAL]=BEGIN
  is:Stick_stks[i];
  j:CARDINAL; js:Stick;
  IF is.dir=h THEN FOR j IN (i..topStick] DO
    js_stks[j];
    IF js.dir=h AND is.color=js.color AND is.y=js.y AND js.x<=is.end
          AND js.end>=is.x THEN BEGIN
          js.x_MIN[is.x,js.x];
          js.end_MAX[is.end,js.end];
          stks[i].color_none;
          EXIT;
          END;
    IF js.dir=h AND (is.color=r AND js.color=g OR is.color=g AND js.color=r)
        AND is.y=js.y AND js.x<is.end
          AND js.end>is.x THEN BEGIN--should complain if vert wire nearby
          SELECT TRUE FROM
             is.x>=js.x AND is.end<=js.end => stks[i].color_none;
             js.x>=is.x AND js.end<=is.end => stks[j].color_none;
             is.x>js.x => js.end_is.x;
             ENDCASE=>is.end_js.x;
          EXIT;
          END;
    ENDLOOP
  ELSE FOR j IN (i..topStick] DO
    js_stks[j];
    IF js.dir=v AND is.color=js.color AND is.x=js.x AND js.y<=is.end
          AND js.end>=is.y THEN BEGIN
          js.y_MIN[is.y,js.y];
          js.end_MAX[is.end,js.end];
          stks[i].color_none;
          EXIT;
          END;
    IF js.dir=v AND (is.color=r AND js.color=g OR is.color=g AND js.color=r)
        AND is.x=js.x AND js.y<is.end
          AND js.end>is.y THEN BEGIN--should complain if vert wire nearby
          SELECT TRUE FROM
             is.y>=js.y AND is.end<=js.end => stks[i].color_none;
             js.y>=is.y AND js.end<=is.end => stks[j].color_none;
             is.y>js.y => js.end_is.y;
             ENDCASE=>is.end_js.y;
          EXIT;
          END;
    ENDLOOP;
  END;

EliminateNulls:PROCEDURE=BEGIN
  i:CARDINAL_0;
  UNTIL i=topStick DO
    IF stks[i].color=none
      THEN stks[i]_stks[(topStick_topStick-1)+1] ELSE i_i+1;
    ENDLOOP;
  END;
-- ///////////////
MakeCloseTeeJctnsTouch:PROCEDURE[i:CARDINAL]=BEGIN
  is:Stick_stks[i];
  lim:INTEGER_IF is.dir=h THEN xHi ELSE yHi;
  IF Close[is.x,xLo] THEN is.x_xLo;
  IF Close[is.y,yLo] THEN is.y_yLo;
  IF CloseS[is.end,lim] THEN is.end_lim;
  FOR j:CARDINAL IN [0..topStick] DO IF i#j THEN BEGIN
    js:Stick_stks[j];
    IF is.dir=js.dir THEN BEGIN
       IF is.dir=h AND CloseS[is.y,js.y] AND is.y#js.y
         AND (WithinS[is.end,js.x,js.end] OR WithinS[is.x,js.x,js.end])
         THEN Error;
       IF is.dir=v AND CloseS[is.x,js.x] AND is.x#js.x
         AND (WithinS[is.end,js.y,js.end] OR WithinS[is.y,js.y,js.end])
         THEN Error;
       END
     ELSE BEGIN
        IF is.dir=h AND WithinS[is.y,js.y,js.end] THEN BEGIN
           IF CloseS[is.x,js.x] THEN is.x_js.x;
           IF CloseS[is.end,js.x] THEN is.end_js.x;
           END;
        IF is.dir=v AND WithinS[is.x,js.x,js.end] THEN BEGIN
           IF CloseS[is.y,js.y] THEN is.y_js.y;
           IF CloseS[is.end,js.y] THEN is.end_js.y;
           END;
        END;
    END; ENDLOOP;
    stks[i]_is;
  END;
-- ///////////////
CompressStickCoordinates:PROCEDURE=BEGIN
  CompressX:PROCEDURE[i:CARDINAL]=BEGIN
    psi:StkPtr_@stks[i];
    IF psi.x=c THEN  {psi.x_s; ad_1;} ;
    IF psi.end=c AND psi.dir=h THEN {psi.end_s; ad_1};
    END;
  CompressY:PROCEDURE[i:CARDINAL]=BEGIN
   psi:StkPtr_@stks[i];
   IF psi.y=c THEN BEGIN psi.y_s; ad_1; END;
   IF psi.end=c AND psi.dir=v THEN  {psi.end_s; ad_1;};
   END;
  s,ad,c:INTEGER;
  s_0;
  FOR c IN [xLo..xHi] DO
    ad_IF c=xLo OR c=xHi THEN 1 ELSE 0;
    EnumerateSticks[f,CompressX];
    s_s+ad;
    ENDLOOP;
  xLo_0; xHi_s-1;
  s_0;
  FOR c IN [yLo..yHi] DO
    ad_IF c=yLo OR c=yHi THEN 1 ELSE 0;
    EnumerateSticks[f,CompressY];
    s_s+ad;
    ENDLOOP;
  yLo_0; yHi_s-1;
  Show[s];
  END;

-- ///////////////
PutTeeJctnsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN is:Stick_stks[i];
  SeeIfButts[is.x,is.y,i];
  IF is.dir=h THEN SeeIfButts[is.end,is.y,i] ELSE SeeIfButts[is.x,is.end,i];
  END;

SeeIfButts:PROCEDURE[x,y:INTEGER,i:CARDINAL]=BEGIN
  SeeIfOneButs:PROCEDURE[j:CARDINAL,js:StkPtr]=BEGIN
    IF js.dir=h AND Close[y,js.y] AND Within[x,js.x,js.end]
    OR js.dir=v AND Close[x,js.x] AND Within[y,js.y,js.end]
      THEN Cc[x,y,ic,js.color];
    END;
  ic:Color_stks[i].color;
  IF Close[x,xHi] OR Close[x,xLo] OR Close[y,yHi] OR Close[y,yLo]
  THEN Cc[x,y,none,ic];
  EnumStksWhichMightTouch[i,SeeIfOneButs];
  END;
-- ///////////////
PutCrossingsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN
  SeeIfOneCrosses:PROCEDURE[j:CARDINAL,js:StkPtr]=BEGIN
    IF is.dir=h AND js.dir=v AND is.y IN (js.y..js.end) 
      AND js.x IN (is.x..is.end)
    THEN BEGIN
      type:BeadType_ColorToType[is.color][js.color];
      IF type#none THEN InsertContact[js.x,is.y,type];
      END;
  END;
  is:Stick_stks[i];
  EnumStksWhichMightTouch[i,SeeIfOneCrosses];
  END;
-- ///////////////
ConvertMultipleLevelsToTiedBeads:PROCEDURE[i:Desc]= BEGIN
    SELECT i.p.t FROM
    rg,all=>BEGIN
      a:Desc_InsertBead[i.p^];
      b:Desc_InsertBead[i.p^];
      a.p.t_rb; a.p.beadT_b.z;
      b.p.t_bf; b.p.beadT_i.z;
      i.p.t_bg; i.p.beadT_a.z;
      END;
    rb,bg=>BEGIN
      a:Desc_InsertBead[i.p^];
      a.p.t_bf; a.p.beadT_i.z;
      i.p.beadT_a.z;
      i.p.external_a.p.external_2;
      END;
    ENDCASE;
  END;
-- ///////////////
DoesBeadHaveNeighbors:PROCEDURE[i:Desc]=BEGIN
  i.p.beadR_i.p.beadL_i.p.beadU_i.p.beadD_noBead;
  FOR j:CARDINAL IN [0..topStick] DO js:Stick_stks[j];
    IF SELECT js.color FROM
      r,y=>SELECT i.p.t FROM all,jctnR,rg,rb,tt,ttV,dd,ddV,endR=>TRUE,
           ENDCASE=>FALSE,
      g=>  SELECT i.p.t FROM all,jctnG,rg,bg,tt,ttV,dd,ddV,endG=>TRUE,
           ENDCASE=>FALSE,
      b=> SELECT i.p.t FROM all,jctnB,endB,bf=>TRUE, ENDCASE=>FALSE,
      ENDCASE=>FALSE THEN BEGIN
        IF js.dir=h AND Bot[i]=js.y THEN BEGIN
          IF Lfm[i] IN [js.x..js.end) THEN i.p.beadR_someBead;
          IF Lfm[i] IN (js.x..js.end] THEN i.p.beadL_someBead;
          END;
        IF js.dir=v AND Lfm[i]=js.x THEN BEGIN
          IF Bot[i] IN [js.y..js.end) THEN i.p.beadU_someBead;
          IF Bot[i] IN (js.y..js.end] THEN i.p.beadD_someBead;
          END;
      END;
    ENDLOOP;
  END;
-- ///////////////
RecordBeadsNeighbors:PROCEDURE[i:Desc]=BEGIN
  Find:PROCEDURE[q:CARDINAL] RETURNS[aBead:CARDINAL]=BEGIN
    NoName:PROCEDURE[j:Desc]=BEGIN
      ay:INTEGER_IF q<2 THEN Bot[j] ELSE Lfm[j];
      by:INTEGER_IF q<2 THEN Bot[i] ELSE Lfm[i];
      sameX:BOOLEAN_IF q<2 THEN Lfm[j]=Lfm[i] ELSE Bot[j]=Bot[i];
      IF sameX
          AND (IF min THEN ay IN (by..ext] ELSE ay IN [ext..by))
          AND (IF q<2 THEN desP[i.p.t].bitPerLevelV=desP[j.p.t].bitPerLevelV
                      ELSE desP[i.p.t].bitPerLevel =desP[j.p.t].bitPerLevel)
          THEN BEGIN ext_ay; aBead_j.z; END;
      END;
    min:BOOLEAN_q=0 OR q=2;
    ext:INTEGER_IF min THEN 10000 ELSE 0;
    aBead_noBead;
    BeadsDefs.EnumerateBeads[NoName];
    BEGIN
    a:Desc_GetDesc[aBead];
    IF noBead=(SELECT q FROM 0=>a.p.beadD, 1=>a.p.beadU,
         2=>a.p.beadL, ENDCASE=>a.p.beadR)
        THEN aBead_noBead; 
    END; END;
  IF i.p.beadU=someBead THEN i.p.beadU_Find[0];
  IF i.p.beadD=someBead THEN i.p.beadD_Find[1];
  IF i.p.beadR=someBead THEN i.p.beadR_Find[2];
  IF i.p.beadL=someBead THEN i.p.beadL_Find[3];
  END;
-- ///////////////
StickToBeadCoordinates:PROCEDURE[i:Desc]=BEGIN
  m:CARDINAL_Lfm[i]; n:CARDINAL_Bot[i];
  i.p.x_m*stickScaling; i.p.y_n*stickScaling;
  END;
-- ///////////////
WiggleTiedBeadsUpAndDown:PROCEDURE[i:Desc]= BEGIN
  New:TYPE=RECORD[rx,ry,gx,gy,bx,by:INTEGER];
  IF i.p.t=bg AND Get[i.p.beadT].t=rb THEN BEGIN
    g:Desc_i;
    r:Desc_GetDesc[i.p.beadT];
    b:Desc_GetDesc[r.p.beadT];
    IF b.p.t#bf OR b.p.beadT#g.z THEN Error;
      BEGIN
      lc:Color_IF ~NoBeadL[g] THEN g ELSE IF NoBeadL[r] THEN none ELSE r;
      rc:Color_IF ~NoBeadR[g] THEN g ELSE IF NoBeadR[r] THEN none ELSE r;
      uc:Color_IF ~NoBeadU[g] THEN g ELSE IF NoBeadU[r] THEN none ELSE r;
      dc:Color_IF ~NoBeadD[g] THEN g ELSE IF NoBeadD[r] THEN none ELSE r;
      new:New;
      IF ~NoBeadL[r] AND ~NoBeadL[g] THEN IllegalInput;
      IF ~NoBeadR[r] AND ~NoBeadR[g] THEN IllegalInput;
      IF ~NoBeadU[r] AND ~NoBeadU[g] THEN IllegalInput;
      IF ~NoBeadD[r] AND ~NoBeadD[g] THEN IllegalInput;
      new_SELECT TRUE FROM  --There has got to be a better way!
       lc=g AND rc=g AND uc=r =>[0,6,0, 0,0, 0],
       lc=g AND rc=g          =>[0,-6,0,0,0,-6],
       lc=r AND rc=r AND uc=g =>[0,0,0, 6,0, 0],
       lc=r AND rc=r          =>[0,0,0,-6,0,-6],
       uc=g AND dc=g AND lc=r =>[-6,0,0,0,-6,0],
       uc=g AND dc=g          =>[ 6,0,0,0, 0,0],
       uc=r AND dc=r AND lc=g =>[0,0,-6,0,-6,0],
       uc=r AND dc=r          =>[0,0,6,0, 0, 0],
       lc#g AND rc#g AND uc=g =>[0,0,0, 6,0, 0],
       lc#g AND rc#g          =>[0,0,0,-6,0,-6],
       lc#r AND rc#r AND uc=r =>[0, 6,0,0,0, 0],
       lc#r AND rc#r          =>[0,-6,0,0,0,-6],
       uc#g AND dc#g AND rc=g =>[0,0, 6,0, 0,0],
       uc#g AND dc#g          =>[0,0,-6,0,-6,0],
       uc#r AND dc#r AND rc=r =>[ 6,0,0,0, 0,0],
       ENDCASE       =>         [-6,0,0,0,-6,0];
      r.p.x_r.p.x+new.rx;
      g.p.x_g.p.x+new.gx;
      b.p.x_b.p.x+new.bx;
      r.p.y_r.p.y+new.ry;
      g.p.y_g.p.y+new.gy;
      b.p.y_b.p.y+new.by;
      r.p.external_  --1 means 6hx8w--
      g.p.external_  --1 means 6hx8w--
      b.p.external_IF new.ry#0 OR new.gy#0 THEN 1 ELSE 0;
           --1 means 12hx8w--
      END;
    END;
  END;
-- ///////////////
AddWires:PROCEDURE[i:Desc]=BEGIN
  IF ~NoBeadR[i] THEN BEGIN
     k:Desc_GetDesc[i.p.beadR];
     t:Desc_GetFreeBead[];
     t.p.y_i.p.y+10-((i.p.y+10) MOD 20);
     t.p.beadL_i.z;
     t.p.beadR_k.z;
     t.p.t_desP[i.p.t].rwc;
     i.p.beadR_k.p.beadL_topBead;
     SetTypeConstants[t];
     END;
  IF ~NoBeadU[i] THEN BEGIN
     k:Desc_GetDesc[i.p.beadU];
     t:Desc_GetFreeBead[];
     t.p.x_i.p.x+10-((i.p.x+10) MOD 20);
     t.p.beadD_i.z;
     t.p.beadU_k.z;
     t.p.t_desP[i.p.t].uwc;
     i.p.beadU_k.p.beadD_topBead;
     SetTypeConstants[t];
     END;
  END;

-- ///////////////

SetHeightAndWidth:PROCEDURE[i:Desc]=BEGIN
    type:BeadType_i.p.t;
    i.p.h_desP[type].h;
    i.p.w_desP[type].w;
    SELECT type FROM-- ext=0,1,or2
      bf=>BEGIN
          i.p.h_IF i.p.external=1 THEN 12 ELSE 8;
          i.p.w_IF i.p.external=0 THEN 12 ELSE 8;
          END;
      bg,rb=>BEGIN
          i.p.h_IF i.p.external=1 THEN 6 ELSE 8;
          i.p.w_IF i.p.external=0 THEN 6 ELSE 8;
          END;
     ENDCASE;
  END;

-- ///////////////
MakeCircuits:PUBLIC PROCEDURE=
 BEGIN cNo_0; EnumerateBeads[f,ClearCircuit]; EnumerateBeads[f,MakeCir]; END;

cNo:INTEGER;

ClearCircuit:PROCEDURE[i:Desc]=
 BEGIN i.p.circuit_IF Type[i]=wireO OR Type[i]=EndO THEN 0 ELSE noBead; END;

MakeCir:PROCEDURE[i:Desc]=
  BEGIN IF i.p.circuit=LOOPHOLE[noBead] THEN SetCircuit[i,cNo_cNo+1]; END;

SetCircuit:PROCEDURE[i:Desc,k:INTEGER]=BEGIN
  foo:CARDINAL_i.p.circuit;
  IF i.z=noBead OR foo#noBead THEN RETURN;
  i.p.circuit_k;
  SELECT i.p.t FROM tt,dd=>NULL;
         ENDCASE=>{TryCircuitH[i.p.beadL,k]; TryCircuitH[i.p.beadR,k]};
  SELECT i.p.t FROM ttV,ddV=>NULL;
         ENDCASE=>{TryCircuitV[i.p.beadU,k]; TryCircuitV[i.p.beadD,k]};
  SetCircuit[GetDesc[i.p.beadT],k];
  END;

TryCircuitH:PROCEDURE[mm:CARDINAL,k:INTEGER]= BEGIN
   m:Desc_GetDesc[mm];
   SELECT m.p.t FROM tt,dd=>NULL; ENDCASE=>SetCircuit[m,k]; END;

TryCircuitV:PROCEDURE[mm:CARDINAL,k:INTEGER]= BEGIN
   m:Desc_GetDesc[mm];
  SELECT m.p.t FROM ttV,ddV=>NULL; ENDCASE=>SetCircuit[m,k]; END;

-- ///////////////


Cc:PROCEDURE[x,y:INTEGER,ic,jc:Color]=BEGIN
  InsertContact[x,y,typeFromColor[ic][jc]]; END;

InsertContact:PROCEDURE[x,y:INTEGER,type:BeadType]=BEGIN
  IF type=none THEN RETURN;
  IF topBead#177777B THEN  FOR ii:CARDINAL IN [0..topBead] DO
    i:Desc_GetDesc[ii];
    IF Close[x,Lfm[i]] AND Close[y,Bot[i]]
    THEN BEGIN i.p.t_CombineTypes[i.p.t,type]; RETURN; END;
    ENDLOOP;
  BEGIN
  t:Desc_GetFreeBead[];
  t.p.x_x; t.p.y_y; t.p.t_type;
  END; END;

CombineTypes:PROCEDURE[s,t:BeadType] RETURNS[BeadType]=BEGIN
  s1:CARDINAL_desP[s].toCode;
  t1:CARDINAL_desP[t].toCode;
  IF s1>6 OR t1>6 THEN Error;
  RETURN[IF s1=6 OR t1=6 THEN all ELSE TwoCodes[s1][t1]];
  END;

InsertBead:PUBLIC PROCEDURE[b:Bead] RETURNS[t:Desc]=
  BEGIN t_GetFreeBead[]; t.p^_b; SetTypeConstants[t]; END;

SetTypeConstants:PROCEDURE[i:Desc]=
 BEGIN IF i.z NOT IN [0..noBead) THEN ERROR ELSE i.p.wire_Wire[i]; END;

CheckBeads:PUBLIC PROCEDURE=BEGIN BeadsDefs.EnumerateBeads[CheckBead]; END;

CheckBead:PROCEDURE[i:Desc]=BEGIN
  IF ~NoBeadR[i] THEN BEGIN
      k:Desc_GetDesc[i.p.beadR];
      IF k.p.beadL#i.z THEN Error;
      IF Rtm[i]#Lfm[k] THEN Error;
      END;
  IF ~NoBeadU[i] THEN BEGIN
      k:Desc_GetDesc[i.p.beadU];
      IF k.p.beadD#i.z THEN Error;
      IF Top[i]#Bot[k] THEN Error;
      END;
  END;

TwoClose:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
   INLINE BEGIN RETURN[Close[a,b] OR Close[a,c]]; END;

Close:PROCEDURE[a,b:INTEGER] RETURNS[BOOLEAN]=INLINE BEGIN RETURN[a=b]; END;

Within:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
   INLINE BEGIN RETURN[a IN [b..c]]; END;

CloseS:PROCEDURE[a,b:INTEGER] RETURNS[BOOLEAN]=
   INLINE BEGIN RETURN[a-b IN [-1..1]]; END;

WithinS:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
   INLINE BEGIN RETURN[a IN [b-1..c+1]]; END;

RW:PROCEDURE RETURNS[CARDINAL]=
 BEGIN right_FALSE; RETURN[inputStream.get[inputStream]]; END;

RB:PROCEDURE RETURNS[Byte]=BEGIN
  IF right THEN  pieces.a_pieces.b ELSE pieces_LOOPHOLE[RW[]];
  right_~right; RETURN[pieces.a]; END;

KeepMesaHappy:PROCEDURE=BEGIN IODefs.WriteChar[' ]; END;

PrintAllSticks:PROCEDURE[top:CARDINAL]=
  BEGIN OPEN IODefs;
  WriteChar[CR];
  FOR i:CARDINAL IN [0..top] DO
    a:Stick_stks[i];
    WriteChar[CR];
    WriteNumber[i,[10,FALSE,TRUE,3]];
    WriteString[SELECT a.dir FROM v=>"  vert  ", ENDCASE=>"  horr  "];
    WriteString[SELECT a.color FROM
      r=>"  red", g=>"green", b=>" blue", ENDCASE=>"error"];
    WriteNumber[a.x,  [10,FALSE,TRUE,5]];
    WriteNumber[a.y,  [10,FALSE,TRUE,5]];
    WriteNumber[a.end,[10,FALSE,TRUE,5]];
    ENDLOOP;
  END;--print sticks

END..


(1792)\5706i30I8614i32I