-- CreateBeads5.mesa
-- put in long pointers

-- dd etc
-- two backfacing transistors!

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

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;

allSticks: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;


FromInputToBeads:PUBLIC PROCEDURE[fileName:STRING,pr:BOOLEAN]=BEGIN
  i:CARDINAL;
  allSticks_SystemDefs.AllocateSegment[SIZE[StickStuff]];
  StringDefs.AppendString[fileName,".stick"];
  FromSilFileToSticks[fileName];
  fileName.length_fileName.length-6;
  IF pr THEN PrintAllSticks[allSticks,topStick];
  FindBoundsOfStickDiagram[];
  IF getWhatYouSee THEN BEGIN
     FOR i IN [0..topStick] DO WhatYouSeeIsWhatYouGet[i]; ENDLOOP;
     EliminateNulls[];
     END;
  IF pr THEN PrintAllSticks[allSticks,topStick];
  FOR i IN [0..topStick] DO MakeCloseTeeJctnsTouch[i]; ENDLOOP;
  IF pr THEN PrintAllSticks[allSticks,topStick];
  CompressStickCoordinates[];
  IF pr THEN PrintAllSticks[allSticks,topStick];
  FOR i IN [0..topStick] DO PutTeeJctnsInBeadTable[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topStick] DO PutCrossingsInBeadTable[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topStick] DO IF allSticks[i].color=y THEN allSticks[i].color_r; ENDLOOP;
  FOR i IN [0..topBead] DO Get[i].beadT_noBead; ENDLOOP;
  FOR i IN [0..topBead] DO ConvertMultipleLevelsToTiedBeads[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topBead] DO DoesBeadHaveNeighbors[i]; ENDLOOP;
  FOR i IN [0..topBead] DO RecordBeadsNeighbors[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topBead] DO StickToBeadCoordinates[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topBead] DO WiggleTiedBeadsUpAndDown[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topBead] DO Get[i].wire_FALSE; ENDLOOP;
  FOR i IN [0..topBead] DO AddWires[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  FOR i IN [0..topBead] DO SetHeightAndWidth[i]; ENDLOOP;
  FOR i IN [0..topBead] DO CorrectWireLength[i]; ENDLOOP;
  IF pr THEN PrintBeads[];
  MakeCircuits[];
  FOR i IN [0..topBead] DO SetTypeConstants[i]; ENDLOOP;
  SystemDefs.FreeSegment[allSticks];
  WriteOneNumber["size of stick table=  ",topStick];
  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;
      allSticks[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;
-- ///////////////
FindBoundsOfStickDiagram:PROCEDURE=BEGIN i:CARDINAL;
  xLo_yLo_10000;
  xHi_yHi_0;
  FOR i IN [0..topStick] DO IF allSticks[i].color#none THEN BEGIN
    is:Stick_allSticks[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; ENDLOOP;
  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_allSticks[i];
  j:CARDINAL; js:Stick;
  IF is.dir=h THEN FOR j IN (i..topStick] DO
    js_allSticks[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];
          allSticks[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 => allSticks[i].color_none;
             js.x>=is.x AND js.end<=is.end => allSticks[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_allSticks[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];
          allSticks[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 => allSticks[i].color_none;
             js.y>=is.y AND js.end<=is.end => allSticks[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 allSticks[i].color=none
      THEN allSticks[i]_allSticks[(topStick_topStick-1)+1]
      ELSE i_i+1;
    ENDLOOP;
  END;
-- ///////////////
MakeCloseTeeJctnsTouch:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
  is:Stick_allSticks[i];
  IF is.color=none THEN RETURN;
  IF Close[is.x,xLo] THEN is.x_xLo;
  IF Close[is.y,yLo] THEN is.y_yLo;
  IF is.dir=h THEN IF CloseS[is.end,xHi] THEN is.end_xHi ELSE NULL
              ELSE IF CloseS[is.end,yHi] THEN is.end_yHi ELSE NULL;
  FOR j IN [0..topStick] DO IF i#j THEN BEGIN
    js:Stick_allSticks[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;
    allSticks[i]_is;
  END;
-- ///////////////
CompressStickCoordinates:PROCEDURE=BEGIN i:CARDINAL;
  s,ad,c:INTEGER;
  s_0;
  FOR c IN [xLo..xHi] DO
    ad_IF c=xLo OR c=xHi THEN 1 ELSE 0;
    FOR i IN [0..topStick] DO
      IF allSticks[i].x=c THEN BEGIN allSticks[i].x_s; ad_1; END;
      IF allSticks[i].end=c AND allSticks[i].dir=h
            THEN BEGIN allSticks[i].end_s; ad_1; END;
      ENDLOOP;
    s_s+ad;
    ENDLOOP;
  xLo_0; xHi_s-1;
  s_0;
  FOR c IN [yLo..yHi] DO
    ad_IF c=xLo OR c=xHi THEN 1 ELSE 0;
    FOR i IN [0..topStick] DO
      IF allSticks[i].y=c THEN BEGIN allSticks[i].y_s; ad_1; END;
      IF allSticks[i].end=c AND allSticks[i].dir=v
            THEN BEGIN allSticks[i].end_s; ad_1; END;
      ENDLOOP;
    s_s+ad;
    ENDLOOP;
  yLo_0; yHi_s-1;
  END;

-- ///////////////
PutTeeJctnsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN is:Stick_allSticks[i];
  IF is.color=none THEN RETURN;
  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 j:CARDINAL;
  ic:Color_allSticks[i].color;
  IF Close[x,xHi] OR Close[x,xLo] OR Close[y,yHi] OR Close[y,yLo]
  THEN Cc[x,y,none,ic]
  ELSE FOR j IN [0..topStick] DO IF i#j THEN BEGIN
    js:Stick_allSticks[j];
    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; ENDLOOP;
  END;
-- ///////////////
PutCrossingsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
  is:Stick_allSticks[i];
  IF is.color=none THEN RETURN;
  FOR j IN [0..topStick] DO BEGIN
    js:Stick_allSticks[j];
    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; ENDLOOP;
  END;
-- ///////////////
ConvertMultipleLevelsToTiedBeads:PROCEDURE[i:CARDINAL]= BEGIN
    bpi:BeadPtr_Get[i];
    bpt1,bpt2:BeadPtr;
    SELECT bpi.t FROM
    rg,all=>BEGIN
      InsertBead[bpi^];
      bpt1_Get[topBead];
      InsertBead[bpi^];
      bpt2_Get[topBead];
      bpt1.t_rb; bpt1.beadT_topBead;
      bpt2.t_bf; bpt2.beadT_i;
      bpi .t_bg; bpi .beadT_topBead-1;
      END;
    rb=>BEGIN
      InsertBead[bpi^];
      bpt1_Get[topBead];
      bpt1.beadT_i;
      bpt1.t_bf;
      bpi.beadT_topBead;
      bpi.external_bpt1.external_2;
      END;
    bg=>BEGIN
      InsertBead[bpi^];
      bpt1_Get[topBead];
      bpt1.beadT_i;
      bpt1.t_bf;
      bpi.beadT_topBead;
      bpi.external_bpt1.external_2;
      END;
    ENDCASE;
  END;
-- ///////////////
DoesBeadHaveNeighbors:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
  bpi:BeadPtr_Get[i];
  bpi.beadR_bpi.beadL_bpi.beadU_bpi.beadD_noBead;
  FOR j IN [0..topStick] DO BEGIN js:Stick_allSticks[j];
    IF SELECT js.color FROM
      r,y=>SELECT bpi.t FROM all,jctnR,rg,rb,tt,ttV,dd,ddV,endR=>TRUE,
           ENDCASE=>FALSE,
      g=>  SELECT bpi.t FROM all,jctnG,rg,bg,tt,ttV,dd,ddV,endG=>TRUE,
           ENDCASE=>FALSE,
      b=> SELECT bpi.t FROM all,jctnB,endB,bf=>TRUE, ENDCASE=>FALSE,
      ENDCASE=>FALSE THEN BEGIN
    IF js.dir=h AND bpi.y=js.y THEN BEGIN
      IF bpi.x IN [js.x..js.end) THEN bpi.beadR_someBead;
      IF bpi.x IN (js.x..js.end] THEN bpi.beadL_someBead;
      END;
    IF js.dir=v AND bpi.x=js.x THEN BEGIN
      IF bpi.y IN [js.y..js.end) THEN bpi.beadU_someBead;
      IF bpi.y IN (js.y..js.end] THEN bpi.beadD_someBead;
      END;
      END;
  END; ENDLOOP;
  END;
-- ///////////////
RecordBeadsNeighbors:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
  bpi:BeadPtr_Get[i];
  bpa:BeadPtr;
    Find:PROCEDURE[q:CARDINAL] RETURNS[aBead:CARDINAL]=BEGIN
      min:BOOLEAN_q=0 OR q=2;
      ext:INTEGER_IF min THEN 10000 ELSE 0;
      aBead_noBead;
      FOR j IN [0..topBead] DO BEGIN
        bpj:BeadPtr_Get[j];
        sameX:BOOLEAN;
        jx:INTEGER_bpj.x; jy:INTEGER_bpj.y;
        ay,by:INTEGER;
        IF q<2 THEN BEGIN ay_jy; by_bpi.y; sameX_(jx=bpi.x); END
               ELSE BEGIN ay_jx; by_bpi.x; sameX_(jy=bpi.y); END;
        IF sameX
          AND (IF min THEN ay IN (by..ext] ELSE ay IN [ext..by))
          AND (IF q<2 THEN desP[bpi.t].bitPerLevelV=desP[bpj.t].bitPerLevelV
                      ELSE desP[bpi.t].bitPerLevel=desP[bpj.t].bitPerLevel)
          THEN BEGIN ext_ay; aBead_j; END;
        END; ENDLOOP;
       bpa_Get[aBead];
      IF noBead=(SELECT q FROM 0=>bpa.beadD, 1=>bpa.beadU,
         2=>bpa.beadL, ENDCASE=>bpa.beadR)
        THEN aBead_noBead; 
      END;
    IF bpi.beadU=someBead THEN bpi.beadU_Find[0];
    IF bpi.beadD=someBead THEN bpi.beadD_Find[1];
    IF bpi.beadR=someBead THEN bpi.beadR_Find[2];
    IF bpi.beadL=someBead THEN bpi.beadL_Find[3];
  END;
-- ///////////////
StickToBeadCoordinates:PROCEDURE[i:CARDINAL]=BEGIN
  bpi:BeadPtr_Get[i];
  m:CARDINAL_bpi.x; n:CARDINAL_bpi.y;
  bpi.x_m*stickScaling; bpi.y_n*stickScaling;
  END;
-- ///////////////
WiggleTiedBeadsUpAndDown:PROCEDURE[i:CARDINAL]= BEGIN
  New:TYPE=RECORD[rx,ry,gx,gy,bx,by:INTEGER];
  bpi:BeadPtr_Get[i];
  IF bpi.t=bg AND Get[bpi.beadT].t=rb THEN BEGIN
    green:CARDINAL=i;
    red:CARDINAL_bpi.beadT;
    blue:CARDINAL_Get[red].beadT;
    bpg:BeadPtr_Get[green];
    bpr:BeadPtr_Get[red];
    bpb:BeadPtr_Get[blue];
    IF bpb.t#bf OR bpb.beadT#green THEN Error;
      BEGIN
      lc:Color_IF bpg.beadL#noBead THEN g
                ELSE IF bpr.beadL#noBead THEN r ELSE none;
      rc:Color_IF bpg.beadR#noBead THEN g
                ELSE IF bpr.beadR#noBead THEN r ELSE none;
      uc:Color_IF bpg.beadU#noBead THEN g
                ELSE IF bpr.beadU#noBead THEN r ELSE none;
      dc:Color_IF bpg.beadD#noBead THEN g
                ELSE IF bpr.beadD#noBead THEN r ELSE none;
      new:New;
      IF bpr.beadL#noBead AND bpg.beadL#noBead THEN IllegalInput;
      IF bpr.beadR#noBead AND bpg.beadR#noBead THEN IllegalInput;
      IF bpr.beadU#noBead AND bpg.beadU#noBead THEN IllegalInput;
      IF bpr.beadD#noBead AND bpg.beadD#noBead 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];
      bpr.x_bpr.x+new.rx;
      bpg.x_bpg.x+new.gx;
      bpb.x_bpb.x+new.bx;
      bpr.y_bpr.y+new.ry;
      bpg.y_bpg.y+new.gy;
      bpb.y_bpb.y+new.by;
      bpr.external_  --1 means 6hx8w--
      bpg.external_  --1 means 6hx8w--
      bpb.external_IF new.ry#0 OR new.gy#0 THEN 1 ELSE 0;
           --1 means 12hx8w--
      END;
    END;
  END;
-- ///////////////
AddWires:PROCEDURE[i:CARDINAL]=BEGIN k:CARDINAL;
  bi:BeadPtr_Get[i];
  bpk,bpt:BeadPtr;
  IF (k_bi.beadR)#noBead THEN BEGIN
     bpk_Get[k];
     IF (topBead_topBead+1) NOT IN [0..noBead) THEN ERROR;
     bpt_Get[topBead];
     bpt.y_bi.y+10-((bi.y+10) MOD 20);
     bpt.beadU_bpt.beadD_bpt.beadT_noBead;
     bpt.beadL_i;
     bpt.beadR_k;
     bpt.t_desP[bi.t].rwc;
     bpt.external_0;
     bi.beadR_bpk.beadL_topBead;
     SetTypeConstants[topBead];
     END;
  IF (k_bi.beadU)#noBead THEN BEGIN
     bpk_Get[k];
     IF (topBead_topBead+1) NOT IN [0..noBead) THEN ERROR;
     bpt_Get[topBead];
     bpt.x_bi.x+10-((bi.x+10) MOD 20);
     bpt.beadL_bpt.beadR_bpt.beadT_noBead;
     bpt.beadD_i;
     bpt.beadU_k;
     bpt.t_desP[bi.t].uwc;
     bpt.external_0;
     bi.beadU_bpk.beadD_topBead;
     SetTypeConstants[topBead];
     END;
  END;

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

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

CorrectWireLength:PROCEDURE[i:CARDINAL]=BEGIN
    bpi:BeadPtr_Get[i];
    IF bpi.wire THEN BEGIN
      one,other:CARDINAL;
      t:INTEGER;
      type:BeadType_bpi.t;
      IF bpi.beadU=noBead THEN BEGIN
        one_bpi.beadL;
        other_bpi.beadR;
        t_bpi.x_Get[one].x+Get[one].w;
        bpi.w_Get[other].x-t;
        END
       ELSE BEGIN
        one_bpi.beadD;
        other_bpi.beadU;
        t_bpi.y_Get[one].y+Get[one].h;
        bpi.h_Get[other].y-t;
        END;
      END;
  END;
-- ///////////////
MakeCircuits:PUBLIC PROCEDURE=BEGIN i:CARDINAL; k:INTEGER_-1;
  FOR i IN [0..topBead] DO Get[i].circuit_noBead; ENDLOOP;
  FOR i IN [0..topBead]
    DO BEGIN foo:CARDINAL_Get[i].circuit;
    IF foo=noBead THEN SetCircuit[i,k_k+1];
    END;
    ENDLOOP;
  END;

SetCircuit:PROCEDURE[i:CARDINAL,k:INTEGER]=BEGIN
  bpi:BeadPtr_Get[i];
  foo:CARDINAL_bpi.circuit;
  IF i=noBead OR foo#noBead THEN RETURN;
  bpi.circuit_k;
  SELECT bpi.t FROM tt,dd=>NULL;
   ENDCASE=>BEGIN
     TryCircuitH[bpi.beadL,k]; TryCircuitH[bpi.beadR,k]; END;
  SELECT bpi.t FROM ttV,ddV=>NULL;
   ENDCASE=>BEGIN
     TryCircuitV[bpi.beadU,k]; TryCircuitV[bpi.beadD,k]; END;
  SetCircuit[bpi.beadT,k];
  END;

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

TryCircuitV:PROCEDURE[m:CARDINAL,k:INTEGER]=
  BEGIN SELECT Get[m].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 i:CARDINAL;
  bpi,bpt:BeadPtr;
  IF type=none THEN RETURN;
  IF topBead#177777B THEN FOR i IN [0..topBead] DO
    bpi_Get[i];
    IF Close[x,bpi.x] AND Close[y,bpi.y]
    THEN BEGIN bpi.t_CombineTypes[bpi.t,type]; RETURN; END;
    ENDLOOP;
  topBead_topBead+1;
  IF topBead>noBead THEN Error;
  bpt_Get[topBead];
  bpt.x_x;
  bpt.y_y;
  bpt.t_type;
  bpt.external_0;
  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]=BEGIN
   IF (topBead_topBead+1) NOT IN [0..noBead) THEN ERROR;
   Get[topBead]^_b;
   SetTypeConstants[topBead];
   END;

SetTypeConstants:PUBLIC PROCEDURE[i:CARDINAL]=BEGIN
  bpi:BeadPtr_Get[i];
  IF i NOT IN [0..noBead) THEN ERROR;
  bpi.wire_SELECT bpi.t FROM wireG,wireR,wireB,wireO=>TRUE, ENDCASE=>FALSE;
  END;

CheckBeads:PUBLIC PROCEDURE=BEGIN
  i,k:CARDINAL;
  FOR i IN [0..topBead] DO BEGIN
    bpi:BeadPtr_Get[i];
    bpk:BeadPtr;
    IF (k_bpi.beadR)#noBead THEN BEGIN
      bpk_Get[k];
      IF bpk.beadL#i THEN Error;
      IF bpi.x+bpi.w#bpk.x THEN Error;
      END;
    IF (k_bpi.beadU)#noBead THEN BEGIN
      bpk_Get[k];
      IF bpk.beadD#i THEN Error;
      IF bpi.y+bpi.h#bpk.y THEN Error;
      END;
    END; ENDLOOP;
  END;

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

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

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

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

WithinS:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
   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;

END..


(1792)\5182i30I9700i32I