{Probable bug in loop at label wireydrawn:}
{loop variable screwed up by complex condition}
{I'm afraid it takes level 1.5 graphics interaction to reproduce the exact}
{conditions of failure}

 %include "level1:graphinc.imp"

%begin

{framestore sizes}
%constant %integer framestorexl = 0, framestorexr = 687,
                   framestoreyb = 0, framestoreyt = 511

{display & editing area}
%constant %integer windowframe = 12,
  windowxl = framestorexl+windowframe,
  windowxr = framestorexr-windowframe,
  windowyb = framestoreyb+windowframe,
  windowyt = framestoreyt-windowframe

{virtual grid size}
%constant %integer vgridxl = 0, vgridxr = 255,
                   vgridyb = 0, vgridyt = 255

{virtual grid data structures}
%byte %integer %array vgrid(vgridxl:vgridxr, vgridyb:vgridyt)
%byte %integer %array hvgrid(vgridxl:vgridxr+1, vgridyb:vgridyt)
%byte %integer %array vvgrid(vgridxl:vgridxr, vgridyb:vgridyt+1)

{menu item codings}
%constant %integer mpoly = 1, mdiff = 2, mmetal1 = 3, mmetal2 = 4
%constant %integer mcontact = 5, msubcon = 6, mtranx = 7, mtrany = 8
%constant %integer mptranx = 9, mptrany = 10, mpwell = 11
%constant %integer mzoom = 12, minput = 13, moutput = 14
%constant %integer mitems = 14

{menu scales}
%constant %integer mwscale = 8, mtscale = 4, mtscale3 = 12

{positions of items in menu}
%constant %integer %array mitemx(1:mitems) = %c
  20, 48, 76, 104, 132, 160, 22, 56, 90, 124, 158,
  20, 20, 68
%constant %integer %array mitemxl(1:mitems) = %c
  0, 34, 62, 90, 118, 146, 0, 39, 73, 107, 141,
  0, 0, 53
%constant %integer %array mitemxr(1:mitems) = %c
  33, 61, 89, 117, 145, 180, 38, 72, 106, 140, 180,
  41, 52, 110
%constant %integer %array mitemy(1:mitems) = %c
  96(6), 66(5), 36, 10(2)
%constant %integer %array mitemyb(1:mitems) = %c
  84(6), 49(5), 23, 0(2)
%constant %integer %array mitemyt(1:mitems) = %c
  114(6), 83(5), 48, 22(2)

{menu size}
%constant %integer menuxs = 180, menuys = 114

{cursor outline box in scale units}
%constant %integer %array curxl(1:mitems) = %c
  -1(6), -3(5), -1(3)
%constant %integer %array curxr(1:mitems) = %c
  1(6), 3(5), 1(3)
%constant %integer %array curyb(1:mitems) = %c
  -1(6), -3(5), -1(3)
%constant %integer %array curyt(1:mitems) = %c
  1(6), 3(5), 1(3)

{layer codings}
%constant %integer poly = 1, diff = 2, metal1 = 4, metal2 = 8,
                   pwell = 16, contact = 32, alllayers = 63,
                   grid = 64, menuback = 128

{codings for wire erasing in progress}
%constant %integer polywireerased = 16, diffwireerased = 32,
                   metal1wireerased = 64, metal2wireerased = 128

{primitive codings}
%constant %integer tranx = 1, trany = 2, subcon = 4
                   {pwell = 16, contact = 32}

{window frame colours}
%constant %integer %array windowframelr(1:mitems) = %c
 poly, diff, metal1, metal2, menuback, menuback,
 poly, diff, poly, diff, pwell,
 menuback(3)
%constant %integer %array windowframebt(1:mitems) = %c
 poly, diff, metal1, metal2, menuback, menuback,
 diff, poly, diff, poly, pwell,
 menuback(3)

{wire drawing directions}
%constant %integer nodir = 0, south = 1, east = 2, north = 3, west = 4

{state values}
%constant %integer nostate = 0, drawing = 1, erasing = 2

{button states}
%constant %integer notpressed = 0, pressed = 1, released = 2, stillpressed = 3

%half %integer %array cmap (0:255)
%integer backgroundcolour, flashcolour

%routine %spec setupcolourmap
%routine %spec drawwindowframe(%integer b, r, t, l)
%routine %spec setupnewscale(%integer newscale)
%routine %spec clipfill(%integer xl, yb, xr, yt)
%routine %spec clipvline(%integer x, yb, yt)
%routine %spec cliphline(%integer xl, xr, y)
%routine %spec clipdbtline(%integer xl, yb, xr, yt)
%routine %spec clipdtbline(%integer xl, yt, xr, yb)
%routine %spec outline(%integer xl, yb, xr, yt)
%routine %spec clipoutline(%integer xl, yb, xr, yt)
%routine %spec drawwirex(%integer layer, gx, gy)
%routine %spec erasewirex(%integer layer, gx, gy)
%routine %spec drawwirey(%integer layer, gx, gy)
%routine %spec erasewirey(%integer layer, gx, gy)
%routine %spec drawtranx(%integer gx, gy)
%routine %spec drawtrany(%integer gx, gy)
%routine %spec drawcontact(%integer gx, gy)
%routine %spec drawsubcon(%integer gx, gy)
%routine %spec drawpwell(%integer gx, gy)
%routine %spec redrawdesign
%routine %spec redrawgridpoint(%integer gx, gy)
%routine %spec redrawprim(%integer gx, gy)
%routine %spec redrawwirex(%integer gx, gy)
%routine %spec redrawwirey(%integer gx, gy)
%routine %spec drawcursor
%routine %spec erasecursor
%routine %spec pan(%integer xi, yi)
%routine %spec zoomin
%routine %spec zoomout
%routine %spec drawmenu
%routine %spec erasemenu
%routine %spec flash

{display grid coordinate arrays}
{bounds -1 & +1 to avoid problems with off-display grid points}
%short %integer %array gridx(vgridxl-1:vgridxr+1),
                       gridy(vgridyb-1:vgridyt+1)

{grid window position within virtual grid}
%integer wgridxl, wgridxr, wgridyb, wgridyt

{display grid limits}
%constant %integer gridxl = 0, gridyb = 0
%integer gridxr, gridyt

{menu variables}
%integer menuxl, menuxr, menuyb, menuyt

%integer curbuts, curgx, curgy, newbuts, newgx, newgy, vgx, vgy, vg, vgw
%integer scale, scale2, scale3, scale4, scale6, x, y, xi, yi, curx, cury, s
%integer state, butl, butm, butr, curtype, newtype, vgwh, vgwv
%integer wirestartgx, wirestartgy, wirecurgx, wirecurgy
%integer curwiredir, newwiredir, layer
%integer xl, xr, yb, yt

%switch action(1:mitems), wireaction(0:2)
%switch wiredrawn(nodir:west), undrawwire(nodir:west), drawwire(nodir:west)
%switch wireerased(nodir:west), unerasewire(nodir:west), erasewire(nodir:west)

  {clear virtual grid}
  %for x = vgridxl, 1, vgridxr %cycle
    %for y = vgridyb, 1, vgridyt %cycle
      vgrid(x, y) = 0
      hvgrid(x, y) = 0
      vvgrid(x, y) = 0
    %repeat
  %repeat
  hvgrid(vgridxr+1, y) = 0 %for y = vgridyb, 1, vgridyt
  vvgrid(x, vgridyt+1) = 0 %for x = vgridxl, 1, vgridxr

  {initialise display}
  clear
  setupcolourmap
  drawwindowframe(poly, poly, poly, poly)

  {put display window in middle of virtual grid}
  wgridxl = (vgridxl+vgridxr)//2
  wgridyb = (vgridyb+vgridyt)//2

  {put cursor in middle of window}
  curgx = 0
  curgy = 0
  gridx(curgx) = (windowxl+windowxr)//2
  gridy(curgy) = (windowyb+windowyt)//2

  {create initial display}
  setupnewscale(6)

  mousex = (windowxr+windowxl)//2
  mousey = (windowyt+windowyb)//2

  curbuts = mousebuttons
  curtype = mpoly
  drawcursor

menu:{enter menu sequence}
  drawmenu

menuloop:{select next cursor type}
  x = mousex
  y = mousey
  %if x < menuxl %then x = menuxl %and mousex = x %else %c
  %if x > menuxr %then x = menuxr %and mousex = x
  %if y < menuyb %then y = menuyb %and mousey = y %else %c
  %if y > menuyt %then y = menuyt %and mousey = y

  {find new menu cursor type}
  x = x-menuxl
  y = y-menuyb
  %for newtype = 1, 1, mitems %cycle
    %if mitemxl(newtype) <= x <= mitemxr(newtype) %and %c
        mitemyb(newtype) <= y <= mitemyt(newtype) %then %exit
  %repeat

  {change cursor outline if necessary}
  %if newtype # curtype %then %start
    {erase old cursor}
    colour(0); enable(contact)
    outline(mitemxl(curtype)+menuxl, mitemyb(curtype)+menuyb,
            mitemxr(curtype)+menuxl, mitemyt(curtype)+menuyb)
    {draw new cursor}
    curtype = newtype
    colour(contact); enable(contact)
    outline(mitemxl(curtype)+menuxl, mitemyb(curtype)+menuyb,
            mitemxr(curtype)+menuxl, mitemyt(curtype)+menuyb)

  %finish

  {look at buttons}
  newbuts = mousebuttons
  butl = (curbuts&1)<<1!(newbuts&1)
  butm = (curbuts&2)!(newbuts&2)>>1
  butr = (curbuts&4)>>1!(newbuts&4)>>2
  ! 0 : not pressed
  ! 1 : pressed
  ! 2 : released
  ! 3 : still pressed
  curbuts = newbuts
  %unless butl = pressed %or butm = pressed %then ->menuloop

  {change window frame colour for selected menu item}
  drawwindowframe(windowframebt(curtype), windowframelr(curtype),
                  windowframebt(curtype), windowframelr(curtype))

display:{enter main edit loop}
  erasemenu
  drawcursor
  state = nostate

displayloop:{edit}

  {check for cursor at edge of display for panning}
  x = mousex
  y = mousey
  xi = 0
  yi = 0
  %if x < windowxl %then xi = -1 %else %c
  %if x > windowxr %then xi = 1
  %if y < windowyb %then yi = -1 %else %c
  %if y > windowyt %then yi = 1
  %if xi # 0 %or yi # 0 %then %start
    %if x < framestorexl %then x = framestorexl %and mousex = x
    %if x > framestorexr %then x = framestorexr %and mousex = x
    %if y < framestoreyb %then y = framestoreyb %and mousey = y
    %if y > framestoreyt %then y = framestoreyt %and mousey = y
    erasecursor
    colour(contact); enable(contact)
    plot(x,y)
    pan(xi, yi)
    ->displayloop
  %finish

  newgx = x//scale6
  newgy = y//scale6
  %if newgx < gridxl %then newgx = gridxl %else %c
  %if newgx > gridxr %then newgx = gridxr
  %if newgy < gridyb %then newgy = gridyb %else %c
  %if newgy > gridyt %then newgy = gridyt
  %if newgx # curgx %or newgy # curgy %then %start
    erasecursor
    curgx = newgx
    curgy = newgy
    drawcursor
  %finish

  {look at buttons}
  newbuts = mousebuttons
  butl = (curbuts&1)<<1!(newbuts&1)
  butm = (curbuts&2)!(newbuts&2)>>1
  butr = (curbuts&4)>>1!(newbuts&4)>>2
  ! 0 : not unpressed
  ! 1 : pressed
  ! 2 : released
  ! 3 : still pressed
  curbuts = newbuts
  %if butr = pressed %then ->menu

  vgx = curgx+wgridxl
  vgy = curgy+wgridyb
  vg = vgrid(vgx, vgy)
  {what wires come to this grid point?}
  vgwh = hvgrid(vgx,vgy)!hvgrid(vgx+1,vgy)
  vgwv = vvgrid(vgx,vgy)!vvgrid(vgx,vgy+1)
  vgw = vgwh!vgwv

  ->action(curtype)
      
{------------------------------------------------------------------------------}

action(mpoly):{poly selected}
  layer = poly
  ->wireaction(state)

{------------------------------------------------------------------------------}

action(mdiff):{diff selected}
  layer = diff
  ->wireaction(state)

{------------------------------------------------------------------------------}

action(mmetal1):{metal1 selected}
  layer = metal1
  ->wireaction(state)

{------------------------------------------------------------------------------}

action(mmetal2):{metal2 selected}
  layer = metal2
  ->wireaction(state)

{------------------------------------------------------------------------------}

wireaction(0):{no drawing or erasing in progress}
  %if butm = pressed %or butl = pressed %then %start  {start drawing or erasing}
    wirestartgx = curgx
    wirestartgy = curgy
    wirecurgx = curgx
    wirecurgy = curgy
    curwiredir = nodir
    %if butm = pressed %then state = drawing %else state = erasing
  %finish
  ->displayloop

{------------------------------------------------------------------------------}

wireaction(drawing):{drawing wire}
  %if butm = stillpressed %then ->wiredrawing
  {butm = released assumed}
  state = nostate
  {check and confirm wire drawn}
  ->wiredrawn(curwiredir)

wiredrawn(nodir):
    ->displayloop

wiredrawn(south):
    x = wirestartgx+wgridxl
    yb = wirecurgy+wgridyb+1
    yt = wirestartgy+wgridyb
%option "-code-tt"
wireydrawn:
    %for y = yb, 1, yt %cycle
      %if vvgrid(x, y)&layer # 0 %then %continue
      {check wire segment for incompatibility}
      %if layer = poly %then %start
        %if (vvgrid(x, y-1)!vvgrid(x, y)!vvgrid(x, y+1))&diff#0 %c
          %or (vgrid(x, y-1)!vgrid(x, y))&(tranx!contact!subcon)#0 %c
          %or ((hvgrid(x, y-1)!hvgrid(x+1, y-1))&diff # 0 %c
            %and vgrid(x-1, y)&trany = 0) %c
          %or ((hvgrid(x, y)!hvgrid(x+1, y))&diff # 0 %c
            %and vgrid(x, y)&trany = 0) %then ->wireyko
      %finish %else %c
      %if layer = diff %then %start
        %if (vvgrid(x, y-1)!vvgrid(x, y)!vvgrid(x, y+1))&poly#0 %c
          %or (vgrid(x, y-1)!vgrid(x, y))&(trany!contact!subcon)#0 %c
          %or ((hvgrid(x, y-1)!hvgrid(x+1, y-1))&poly # 0 %c
            %and vgrid(x, y-1)&tranx = 0) %c
          %or ((hvgrid(x, y)!hvgrid(x+1, y))&poly # 0 %c
            %and vgrid(x, y)&tranx = 0) %then ->wireyko
      %finish %else %start    {metal1 or metal2}
        %if (vgrid(x, y-1)!vgrid(x, y))&(contact!subcon) # 0 %then ->wireyko
      %finish
      vvgrid(x, y) = vvgrid(x, y)!layer
      %continue

wireyko:erasewirey(layer, x-wgridxl, y-wgridyb)
      %if y # yt %then drawwirey(layer, x-wgridxl, y+1-wgridyb)
      flash
    %repeat
    ->displayloop

wiredrawn(east):
    xl = wirestartgx+wgridxl+1
    xr = wirecurgx+wgridxl
    y = wirestartgy+wgridyb
wirexdrawn:
    %for x = xl, 1, xr %cycle
      %if hvgrid(x, y)&layer # 0 %then %continue
      {check wire segment for incompatibility}
      %if layer = poly %then %start
        %if (hvgrid(x-1, y)!hvgrid(x, y)!hvgrid(x+1, y))&diff#0 %c
          %or (vgrid(x-1, y)!vgrid(x, y))&(trany!contact!subcon)#0 %c
          %or vgrid(x-1, y)&pwell # vgrid(x, y)&pwell %c
          %or ((vvgrid(x-1, y)!vvgrid(x-1, y+1))&diff # 0 %c
            %and vgrid(x-1, y)&tranx = 0) %c
          %or ((vvgrid(x, y)!vvgrid(x, y+1))&diff # 0 %c
            %and vgrid(x, y)&tranx = 0) %then ->wirexko
      %finish %else %c
      %if layer = diff %then %start
        %if (hvgrid(x-1, y)!hvgrid(x, y)!hvgrid(x+1, y))&poly#0 %c
          %or (vgrid(x-1, y)!vgrid(x, y))&(tranx!contact!subcon)#0 %c
          %or ((vvgrid(x-1, y)!vvgrid(x-1, y+1))&poly # 0 %c
            %and vgrid(x-1, y)&trany = 0) %c
          %or ((vvgrid(x, y)!vvgrid(x, y+1))&poly # 0 %c
            %and vgrid(x, y)&trany = 0) %then ->wirexko
      %finish %else %start    {metal1 or metal2}
        %if (vgrid(x-1, y)!vgrid(x, y))&(contact!subcon) # 0 %then ->wirexko
      %finish
      hvgrid(x, y) = hvgrid(x, y)!layer
      drawwirex(layer, x-wgridxl, y-wgridyb)
      %continue

wirexko:erasewirex(layer, x-wgridxl, y-wgridyb)
      %if x # xr %then drawwirex(layer, x+1-wgridxl, y-wgridyb)
      flash
    %repeat
    ->displayloop

wiredrawn(north):
    x = wirestartgx+wgridxl
    yb = wirestartgy+wgridyb+1
    yt = wirecurgy+wgridyb
    ->wireydrawn

wiredrawn(west):
    xl = wirecurgx+wgridxl+1
    xr = wirestartgx+wgridxl
    y = wirestartgy+wgridyb
    ->wirexdrawn

wiredrawing:{button remaining pressed}

  {find new direction}
  x = curgx-wirestartgx
  y = curgy-wirestartgy
  %if x = 0 %and y = 0 %then newwiredir = nodir %else %start
    %if x >= y %then %start
      %if x > -y %then newwiredir = east %else newwiredir = south
    %finish %else %start
      %if x > -y %then newwiredir = north %else newwiredir = west
    %finish
  %finish

  %if newwiredir # curwiredir %then %start
    {erase wire so far drawn in wrong direction}
    ->undrawwire(curwiredir)

undrawwire(nodir):
    ->endundrawwire

undrawwire(south):
    erasewirey(layer, wirestartgx, y) %for y = wirecurgy+1, 1, wirestartgy
    ->endundrawwire

undrawwire(east):
    erasewirex(layer, x, wirestartgy) %for x = wirecurgx, -1, wirestartgx+1
    ->endundrawwire

undrawwire(north):
    erasewirey(layer, wirestartgx, y) %for y = wirecurgy, -1, wirestartgy+1
    ->endundrawwire

undrawwire(west):
    erasewirex(layer, x, wirestartgy) %for x = wirecurgx+1, 1, wirestartgx
    ->endundrawwire

endundrawwire:
    wirecurgx = wirestartgx
    wirecurgy = wirestartgy
    curwiredir = newwiredir
  %finish    {wire in wrong direction gotten rid of}
  ->drawwire(curwiredir)

{------------------------------------------------------------------------------}

drawwire(nodir):
  drawcursor    
  ->displayloop

{------------------------------------------------------------------------------}

drawwire(south):
  %if curgy <= wirecurgy %then %start    {extend southwards}
    yt = wirecurgy+1    {draw previous segment to allow for cursor erase}
    %if wirecurgy = wirestartgy %then yt = yt-1
    drawwirey(layer, wirestartgx, y) %for y = yt, -1, curgy+1
  %finish %else %start    {gone too far southwards}
    erasewirey(layer, wirestartgx, y) %for y = wirecurgy+1, 1, curgy
  %finish
  wirecurgy = curgy
  ->displayloop

{------------------------------------------------------------------------------}

drawwire(east):
  %if curgx >= wirecurgx %then %start    {extend eastwards}
    xl = wirecurgx    {draw previous segment to deal with cursor erase}
    %if wirecurgx = wirestartgx %then xl = xl+1    {not if at start}
    drawwirex(layer, x, wirestartgy) %for x = xl, 1, curgx
  %finish %else %start    {gone too far eastwards so erase back}
    erasewirex(layer, x, wirestartgy) %for x = wirecurgx, -1, curgx+1
  %finish
  wirecurgx = curgx
  ->displayloop

{------------------------------------------------------------------------------}

drawwire(north):
  %if curgy >= wirecurgy %then %start    {extend northwards}
    yb = wirecurgy    {draw previous wire segment also}
    %if wirecurgy = wirestartgy %then yb = yb+1
    drawwirey(layer, wirestartgx, y) %for y = yb, 1, curgy
  %finish %else %start    {gone too far northwards}
    erasewirey(layer, wirestartgx, y) %for y = wirecurgy, -1, curgy+1
  %finish
  wirecurgy = curgy
  ->displayloop

{------------------------------------------------------------------------------}

drawwire(west):
  %if curgx <= wirecurgx %then %start    {extend westwards}
    xr = wirecurgx+1
    %if wirecurgx = wirestartgx %then xr = xr-1
    drawwirex(layer, x, wirestartgy) %for x = xr, -1, curgx+1
  %finish %else %start    {gone too far westwards}
    erasewirex(layer, x, wirestartgy) %for x = wirecurgx+1, 1, curgx
  %finish
  wirecurgx = curgx
  ->displayloop

{------------------------------------------------------------------------------}

action(mcontact):{contact selected}
  %if butm = pressed %then %start    {draw contact}
    %if vg&(tranx!trany!subcon) # 0 %or (vgw # poly!metal1 %and %c
      vgw # diff!metal1 %and vgw # metal1!metal2) %then flash %c
      %else vgrid(vgx, vgy) = vg!contact
  %finish %else %c
  %if butl = pressed %then vgrid(vgx, vgy) = vg&(\contact)    {erase contact}
  ->displayloop

{------------------------------------------------------------------------------}

action(msubcon):{subcon selected}
  %if butm = pressed %then %start    {draw subcon}
    %if vg&(tranx!trany!contact) # 0 %or vgw&(\metal2) # metal1 %then flash %c
      %else vgrid(vgx, vgy) = vg!subcon
  %finish %else %c
  %if butl = pressed %then vgrid(vgx, vgy) = vg&(\subcon)    {erase subcon}
  ->displayloop

{------------------------------------------------------------------------------}

action(mtranx):{tranx selected}
  %if butm = pressed %then %start    {draw tranx}
    %if vg&(trany!contact!subcon) # 0 %c
      %or vgwh&diff # 0 %or vgwv&poly # 0 %c
      %then flash %else vgrid(vgx, vgy) = vg!tranx
  %finish %else %c
  %if butl = pressed %then vgrid(vgx, vgy) = vg&(\tranx)    {erase tranx}
  ->displayloop

{------------------------------------------------------------------------------}

action(mtrany):{trany selected}
  %if butm = pressed %then %start    {draw trany}
    %if vg&(tranx!contact!subcon) # 0 %c
      %or vgwh&poly # 0 %or vgwv&diff # 0 %c
      %then flash %else vgrid(vgx, vgy) = vg!trany
  %finish %else %c
  %if butl = pressed %then vgrid(vgx, vgy) = vg&(\trany)    {erase trany}
  ->displayloop

{------------------------------------------------------------------------------}

action(mptranx):{ptranx selected}
  %if butm = pressed %then %start    {draw ptranx}
    %if vg&(trany!contact!subcon) # 0 %c
      %or vgwh&diff # 0 %or vgwv&poly # 0 %c
      %then flash %else vgrid(vgx, vgy) = vg!tranx!pwell
  %finish %else %c
  %if butl = pressed %then vgrid(vgx, vgy) = vg&(\tranx)&(\pwell) {erase ptranx}
  ->displayloop

{------------------------------------------------------------------------------}

action(mptrany):{ptrany selected}
  %if butm = pressed %then %start    {draw ptrany}
    %if vg&(tranx!contact!subcon) # 0 %c
      %or vgwh&poly # 0 %or vgwv&diff # 0 %c
      %then flash %else vgrid(vgx, vgy) = vg!trany!pwell
  %finish %else %c
  %if butl = pressed %then vgrid(vgx, vgy) = vg&(\trany)&(\pwell) {erase ptrany}
  ->displayloop

{------------------------------------------------------------------------------}

action(mpwell):{pwell selected}
  %if butm = pressed %then %start    {draw pwell}
  %finish %else %c
  %if butl = pressed %then %start    {erase pwell}
  %finish
  ->displayloop

{------------------------------------------------------------------------------}

action(mzoom):{zoom selected}
  %if butm = pressed %then zoomin %else %c
  %if butl = pressed %then zoomout
  ->displayloop

{------------------------------------------------------------------------------}

%routine setupcolourmap
%integer %function cmapc (%integer red, green, blue)
  %result = (blue<<5!green)<<5+red
%end
%integer i

  cmap(i) = 0 %for i=0,1,255
  backgroundcolour = cmapc(14,16,14)
  flashcolour = cmapc(31,0,0)
  cmap(0) = backgroundcolour
  cmap(poly) = cmapc(28,0,0)
  cmap(diff) = cmapc(0,26,0)
  cmap(diff+poly) = cmapc(18,18,0)
  cmap(metal1) = cmapc(15,15,31)
  cmap(metal1+poly) = cmapc(22,8,22)
  cmap(metal1+diff) = cmapc(8,24,24)
  cmap(metal1+diff+poly) = cmapc(18,18,31)
  cmap(metal2) = cmapc(0,0,31)
  cmap(metal2+poly) = cmapc(24,0,31)
  cmap(metal2+diff) = cmapc(0,24,31)
  cmap(metal2+diff+poly) = cmapc(24,24,31)
  cmap(metal2+metal1) = cmapc(8,8,31)
  cmap(metal2+metal1+poly) = cmapc(31,8,31)
  cmap(metal2+metal1+diff) = cmapc(8,31,31)
  cmap(metal2+metal1+diff+poly) = cmapc(24,24,24)

  {pwell colour lowest priority}
  cmap(pwell) = cmapc(20,20,0)
  cmap(pwell+i) = cmap(i) %for i=1, 1, pwell-1

  {contact colour high priority}
  cmap(i) = cmapc(24,24,24) %for i=contact,1,2*contact-1

  {grid colour higher priority}
  cmap(i) = cmapc(28,28,28) %for i=grid,1,2*grid-1

  {menu background highest priority}
  cmap(i) = cmapc(16,18,16) %for i=menuback,1,2*menuback-1
  cmap(menuback+i) = cmap(i) %for i=1, 1, grid-1

  updatecolourmap(cmap(0))

%end

{------------------------------------------------------------------------------}

%routine drawwindowframe(%integer b, r, t, l)
%own %integer frame = 0

  %if frame = 0 %then %start
    colour(grid); enable(grid)
    outline(framestorexl, framestoreyb, framestorexr, windowyb-1)
    outline(windowxr+1, framestoreyb, framestorexr, framestoreyt)
    outline(framestorexl, windowyt+1, framestorexr, framestoreyt)
    outline(framestorexl, framestoreyb, windowxl-1, framestoreyt)
    frame = 1
  %finish

  {clear frame first}
  colour(0); enable(alllayers+menuback)
  fill(framestorexl+1, framestoreyb+1, windowxl-2, framestoreyt-1)
  fill(windowxr+2, framestoreyb+1, framestorexr-1, framestoreyt-1)
  fill(framestorexl+1, framestoreyb+1, framestorexr-1, windowyb-2)
  fill(framestorexl+1, windowyt+2, framestorexr-1, framestoreyt-1)

  {fill in new colours}
  colour(b); enable(b)
  fill(framestorexl+1, framestoreyb+1, framestorexr-1, windowyb-2)
  colour(r); enable(r)
  fill(windowxr+2, framestoreyb+1, framestorexr-1, framestoreyt-1)
  colour(t); enable(t)
  fill(framestorexl+1, windowyt+2, framestorexr-1, framestoreyt-1)
  colour(l); enable(l)
  fill(framestorexl+1, framestoreyb+1, windowxl-2, framestoreyt-1)

%end

{------------------------------------------------------------------------------}

%routine setupnewscale(%integer newscale)
%integer x, y, curx, cury, curvgx, curvgy

  scale = newscale
  scale2 = 2*scale
  scale3 = 3*scale
  scale4 = 4*scale
  scale6 = 6*scale

  {current pixel position in old scale; this is the zoom fixed point}
  curx = gridx(curgx)
  cury = gridy(curgy)

  {current virtual grid cursor position}
  curvgx = curgx+wgridxl
  curvgy = curgy+wgridyb

  {virtual grid position of new window}
  wgridxl = curvgx-(curx-windowxl)//scale6
  wgridxr = curvgx+(windowxr-curx)//scale6
  wgridyb = curvgy-(cury-windowyb)//scale6
  wgridyt = curvgy+(windowyt-cury)//scale6

  {new display window limits}
  gridxr = wgridxr-wgridxl
  gridyt = wgridyt-wgridyb

  {new current display grid position}
  curgx = curvgx-wgridxl
  curgy = curvgy-wgridyb

  {work out coordinate positions for display grid}
  {bounds -1 & +1 for first off-display grid points}
  curx = curx-scale6*(curgx+1)
  %for x = -1, 1, gridxr+1 %cycle
    gridx(x) = curx
    curx = curx+scale6
  %repeat

  cury = cury-scale6*(curgy+1)
  %for y = -1, 1, gridyt+1 %cycle
    gridy(y) = cury
    cury = cury+scale6
  %repeat

  {clear display window}
  colour(0); enable(alllayers+grid)
  fill(windowxl, windowyb, windowxr, windowyt)

  {redraw grid}
  colour(grid); enable(grid)
  %for x=gridxl, 1, gridxr %cycle
    %for y=gridyb, 1, gridyt %cycle
      plot(gridx(x), gridy(y))
    %repeat
  %repeat

  redrawdesign

%end

{------------------------------------------------------------------------------}

%routine clipfill(%integer xl, yb, xr, yt)

  %if xl < windowxl %then xl = windowxl
  %if yb < windowyb %then yb = windowyb
  %if xr > windowxr %then xr = windowxr
  %if yt > windowyt %then yt = windowyt
  fill(xl, yb, xr, yt)

%end

{------------------------------------------------------------------------------}

%routine clipvline(%integer x, yb, yt)
{clip & draw vertical line}

  %if x < windowxl %or x > windowxr %then %return
  %if yb < windowyb %then yb = windowyb
  %if yt > windowyt %then yt = windowyt
  vline(x, yb, yt)

%end

{------------------------------------------------------------------------------}

%routine cliphline(%integer xl, xr, y)
{clip & draw horizontal line}

  %if y < windowyb %or y > windowyt %then %return
  %if xl < windowxl %then xl = windowxl
  %if xr > windowxr %then xr = windowxr
  hline(xl, xr, y)

%end

{------------------------------------------------------------------------------}

%routine clipdbtline(%integer xl, yb, xr, yt)
{clip & draw (bottom left to top right) diagonal line}
%integer xll, xrr

  {clip bottom left end}
  %if xl < windowxl %or yb < windowyb %then %start
    xll = xl+windowyb-yb
    %if xll >= windowxl %then xl = xll %and yb = windowyb %c
                        %else xl = windowxl %and yb = yb+windowxl-xl
  %finish

  {clip top right end}
  %if xr > windowxr %or yt > windowyt %then %start
    xrr = xr+windowyt-yt
    %if xrr <= windowxr %then xr = xrr %and yt = windowyt %c
                        %else xr = windowxr %and yt = yt+windowxr-xr
  %finish

  line(xl, yb, xr, yt)

%end

{------------------------------------------------------------------------------}

%routine clipdtbline(%integer xl, yt, xr, yb)
{clip & draw (top left to bottom right) diagonal line}
%integer xll, xrr

  {clip top left end}
  %if xl < windowxl %or yt > windowyt %then %start
    xll = xl+yt-windowyt
    %if xll >= windowxl %then xl = xll %and yt = windowyt %c
                        %else xl = windowxl %and yt = yt+xl-windowxl
  %finish

  {clip bottom right end}
  %if xr > windowxr %or yb < windowyb %then %start
    xrr = xr+yb-windowyb
    %if xrr <= windowxr %then xr = xrr %and yb = windowyb %c
                        %else xr = windowxr %and yb = yb+xr-windowxr
  %finish

  line(xl, yt, xr, yb)

%end

{------------------------------------------------------------------------------}

%routine outline(%integer xl, yb, xr, yt)

  hline(xl, xr, yb)
  vline(xr, yb, yt)
  hline(xl, xr, yt)
  vline(xl, yb, yt)

%end

{------------------------------------------------------------------------------}

%routine clipoutline(%integer xl, yb, xr, yt)

  %if yb >= windowyb %then cliphline(xl, xr, yb)
  %if xr <= windowxr %then clipvline(xr, yb, yt)
  %if yt <= windowyt %then cliphline(xl, xr, yt)
  %if xl >= windowxl %then clipvline(xl, yb, yt)

%end

{------------------------------------------------------------------------------}

%routine drawwirex(%integer layer, gx, gy)

  colour(layer); enable(layer)

  clipfill(gridx(gx-1)-scale, gridy(gy)-scale,
           gridx(gx)+scale, gridy(gy)+scale)

%end

{------------------------------------------------------------------------------}

%routine erasewirex(%integer layer, gx, gy)

  colour(0); enable(layer)

  clipfill(gridx(gx-1)-scale, gridy(gy)-scale,
           gridx(gx)+scale, gridy(gy)+scale)

  {redraw end points}
  redrawgridpoint(gx-1, gy)
  redrawgridpoint(gx, gy)

%end

{------------------------------------------------------------------------------}

%routine drawwirey(%integer layer, gx, gy)

  colour(layer); enable(layer)

  clipfill(gridx(gx)-scale, gridy(gy-1)-scale,
           gridx(gx)+scale, gridy(gy)+scale)

%end

{------------------------------------------------------------------------------}

%routine erasewirey(%integer layer, gx, gy)

  colour(0); enable(layer)

  clipfill(gridx(gx)-scale, gridy(gy-1)-scale,
           gridx(gx)+scale, gridy(gy)+scale)

  {redraw end points}
  redrawgridpoint(gx, gy-1)
  redrawgridpoint(gx, gy)

%end

{------------------------------------------------------------------------------}

%routine drawtranx(%integer gx, gy)

  {poly in x-direction}
  colour(poly); enable(poly)

  clipfill(gridx(gx)-scale3, gridy(gy)-scale,
           gridx(gx)+scale3, gridy(gy)+scale)

  {diff in y-direction}
  colour(diff); enable(diff)

  clipfill(gridx(gx)-scale, gridy(gy)-scale3,
           gridx(gx)+scale, gridy(gy)+scale3)

%end

{------------------------------------------------------------------------------}

%routine drawtrany(%integer gx, gy)

  {poly in y-direction}
  colour(poly); enable(poly)

  clipfill(gridx(gx)-scale, gridy(gy)-3*scale,
           gridx(gx)+scale, gridy(gy)+3*scale)

  {diff in x-direction}
  colour(diff); enable(diff)

  clipfill(gridx(gx)-3*scale, gridy(gy)-scale,
           gridx(gx)+3*scale, gridy(gy)+scale)

%end

{------------------------------------------------------------------------------}

%routine drawcontact(%integer gx, gy)
%integer xm, xp, ym, yp 

  colour(contact); enable(contact)

  {draw outline}
  xm = gridx(gx)-scale2
  xp = xm+scale4
  ym = gridy(gy)-scale2
  yp = ym+scale4

  cliphline(xm, xp, ym)
  clipvline(xp, ym, yp)
  cliphline(xm, xp, yp)
  clipvline(xm, ym, yp)

  {draw diagonal lines}
  clipdbtline(xm, ym, xp, yp)
  clipdtbline(xm, yp, xp, ym)

%end

{------------------------------------------------------------------------------}

%routine drawsubcon(%integer gx, gy)
%integer x, y, xm, xp, ym, yp 

  colour(contact); enable(contact)

  {draw outline}
  x = gridx(gx)
  xm = x-scale2
  xp = xm+scale4
  y = gridy(gy)
  ym = y-scale2
  yp = ym+scale4

  cliphline(xm, xp, ym)
  clipvline(xp, ym, yp)
  cliphline(xm, xp, yp)
  clipvline(xm, ym, yp)

  {draw cross}
  clipvline(x, ym, yp)
  cliphline(xm, xp, y)

%end

{------------------------------------------------------------------------------}

%routine drawpwell(%integer gx, gy)
%integer x, y

  colour(pwell); enable(pwell)

  x = gridx(gx)
  y = gridy(gy)
  clipfill(x-scale3, y-scale3, x+scale3, y+scale3)

%end

{------------------------------------------------------------------------------}

%routine redrawdesign
%integer x, y

  %for x = gridxl, 1, gridxr %cycle
    %for y = gridyb, 1, gridyt %cycle
      redrawprim(x, y)
      redrawwirex(x, y)
      redrawwirey(x, y)
    %repeat
  %repeat

  {draw rightmost column of horizontal wires}
  redrawwirex(gridxr+1, y) %for y = gridyb, 1, gridyt

  {draw topmost row of vertical wires}
  redrawwirey(x, gridyt+1) %for x = gridxl, 1, gridxr

%end

{------------------------------------------------------------------------------}

%routine redrawgridpoint(%integer gx, gy)

  redrawprim(gx, gy)
  redrawwirex(gx, gy)
  redrawwirex(gx+1, gy)
  redrawwirey(gx, gy)
  redrawwirey(gx, gy+1)

%end

{------------------------------------------------------------------------------}

%routine redrawprim(%integer gx, gy)
%integer p

  p = vgrid(gx+wgridxl, gy+wgridyb)
  %if p # 0 %then %start
    %if p&pwell # 0 %then drawpwell(gx, gy)
    %if p&tranx # 0 %then drawtranx(gx, gy) %else %c
    %if p&trany # 0 %then drawtrany(gx, gy) %else %c
    %if p&contact # 0 %then drawcontact(gx, gy) %else %c
    %if p&subcon # 0 %then drawsubcon(gx, gy)
  %finish

%end

{------------------------------------------------------------------------------}

%routine redrawwirex(%integer gx, gy)
%integer wires, drawn, erased, layers

  wires = hvgrid(gx+wgridxl, gy+wgridyb)
  drawn = wires&16_f
  erased = wires>>4
  layers = drawn&(\erased)
  %if layers # 0 %then drawwirex(layers, gx, gy)

%end

{------------------------------------------------------------------------------}

%routine redrawwirey(%integer gx, gy)
%integer layers

  layers = vvgrid(gx+wgridxl, gy+wgridyb)
  %if layers # 0 %then drawwirey(layers, gx, gy)

%end

{------------------------------------------------------------------------------}

%routine pan(%integer xi, yi)

  {clear display window}
  colour(0)
  enable(alllayers)
  fill(windowxl, windowyb, windowxr, windowyt)

  wgridxl = wgridxl+xi
  wgridxr = wgridxr+xi
  wgridyb = wgridyb+yi
  wgridyt = wgridyt+yi
  redrawdesign

%end

{------------------------------------------------------------------------------}

%routine zoomin

  setupnewscale(scale+1)

%end

{------------------------------------------------------------------------------}

%routine zoomout

  setupnewscale(scale-1) %unless scale = 1

%end

{------------------------------------------------------------------------------}

%routine drawmenu
%integer x, y, xl, xr, yb, yt

  erasecursor

  {fit menu into display window}
  menuxl = mousex-mitemx(curtype)
  menuxr = menuxl+menuxs
  %if menuxl < windowxl %then menuxl = windowxl %and menuxr = menuxl+menuxs
  %if menuxr > windowxr %then menuxr = windowxr %and menuxl = menuxr-menuxs

  menuyb = mousey-mitemy(curtype)
  menuyt = menuyb+menuys
  %if menuyb < windowyb %then menuyb = windowyb %and menuyt = menuyb+menuys
  %if menuyt > windowyt %then menuyt = windowyt %and menuyb = menuyt-menuys

  {clear menu area and draw menu grid}
  colour(menuback)
  enable(alllayers+menuback)
  fill(menuxl, menuyb, menuxr, menuyt)

  {draw menu outline}
  colour(contact)
  enable(contact)
  outline(menuxl, menuyb, menuxr, menuyt)

  {draw menu poly}
  x = mitemx(mpoly)+menuxl
  y = mitemy(mpoly)+menuyb
  colour(poly); enable(poly)
  fill(x-mwscale, y-mwscale, x+mwscale, y+mwscale)

  {draw menu diff}
  x = mitemx(mdiff)+menuxl
  y = mitemy(mdiff)+menuyb
  colour(diff); enable(diff)
  fill(x-mwscale, y-mwscale, x+mwscale, y+mwscale)

  {draw menu metal1}
  x = mitemx(mmetal1)+menuxl
  y = mitemy(mmetal1)+menuyb
  colour(metal1); enable(metal1)
  fill(x-mwscale, y-mwscale, x+mwscale, y+mwscale)

  {draw menu metal2}
  x = mitemx(mmetal2)+menuxl
  y = mitemy(mmetal2)+menuyb
  colour(metal2); enable(metal2)
  fill(x-mwscale, y-mwscale, x+mwscale, y+mwscale)

  {draw menu contact}
  x = mitemx(mcontact)+menuxl
  xl = x-mwscale
  xr = x+mwscale
  y = mitemy(mcontact)+menuyb
  yb = y-mwscale
  yt = y+mwscale
  colour(contact); enable(contact)
  outline(xl, yb, xr, yt)
  line(xl, yb, xr, yt)
  line(xl, yt, xr, yb)

  {draw menu substrate contact}
  x = mitemx(msubcon)+menuxl
  xl = x-mwscale
  xr = x+mwscale
  y = mitemy(msubcon)+menuyb
  yb = y-mwscale
  yt = y+mwscale
  colour(contact); enable(contact)
  outline(xl, yb, xr, yt)
  vline(x, yb, yt)
  hline(xl, xr, y)

  {draw menu tranx}
  x = mitemx(mtranx)+menuxl
  y = mitemy(mtranx)+menuyb
  colour(poly); enable(poly)
  fill(x-mtscale3, y-mtscale, x+mtscale3, y+mtscale)
  colour(diff); enable(diff)
  fill(x-mtscale, y-mtscale3, x+mtscale, y+mtscale3)

  {draw menu trany}
  x = mitemx(mtrany)+menuxl
  y = mitemy(mtrany)+menuyb
  colour(poly); enable(poly)
  fill(x-mtscale, y-mtscale3, x+mtscale, y+mtscale3)
  colour(diff); enable(diff)
  fill(x-mtscale3, y-mtscale, x+mtscale3, y+mtscale)

  {draw menu ptranx}
  x = mitemx(mptranx)+menuxl
  y = mitemy(mptranx)+menuyb
  colour(pwell); enable(pwell)
  fill(x-mtscale3, y-mtscale3, x+mtscale3, y+mtscale3)
  colour(poly); enable(poly)
  fill(x-mtscale3, y-mtscale, x+mtscale3, y+mtscale)
  colour(diff); enable(diff)
  fill(x-mtscale, y-mtscale3, x+mtscale, y+mtscale3)

  {draw menu ptrany}
  x = mitemx(mptrany)+menuxl
  y = mitemy(mptrany)+menuyb
  colour(pwell); enable(pwell)
  fill(x-mtscale3, y-mtscale3, x+mtscale3, y+mtscale3)
  colour(poly); enable(poly)
  fill(x-mtscale, y-mtscale3, x+mtscale, y+mtscale3)
  colour(diff); enable(diff)
  fill(x-mtscale3, y-mtscale, x+mtscale3, y+mtscale)

  {draw menu pwell}
  x = mitemx(mpwell)+menuxl
  y = mitemy(mpwell)+menuyb
  colour(pwell); enable(pwell)
  fill(x-mtscale3, y-mtscale3, x+mtscale3, y+mtscale3)

  {draw zoom icon}
  colour(contact); enable(contact)
  x = mitemx(mzoom)+menuxl
  y = mitemy(mzoom)+menuyb
  outline(x-mwscale, y-mwscale, x+mwscale, y+mwscale)
  outline(x-mtscale, y-mtscale, x+mtscale, y+mtscale)

  {draw 'input' text}
  x = mitemx(minput)+menuxl
  y = mitemy(minput)+menuyb
  textat(x, y)
  showstring("in")

  {draw 'output' text}
  x = mitemx(moutput)+menuxl
  y = mitemy(moutput)+menuyb
  textat(x, y)
  showstring("out")

  {outline current cursor type}
  colour(contact); enable(contact)
  outline(mitemxl(curtype)+menuxl, mitemyb(curtype)+menuyb,
          mitemxr(curtype)+menuxl, mitemyt(curtype)+menuyb)

%end

{------------------------------------------------------------------------------}

%routine erasemenu

  {erase menu area}
  colour(0)
  enable(alllayers+menuback)
  fill(menuxl, menuyb, menuxr, menuyt)

  redrawdesign
  curgx = mousex//scale6
  curgy = mousey//scale6
  drawcursor

%end

{------------------------------------------------------------------------------}

%routine drawcursor
%integer x, y, xl, yb, xr, yt, layer
%switch cur(1:mitems)

  ->cur(curtype)

cur(mpoly):layer = poly
  ->wirecursor

cur(mdiff):layer = diff
  ->wirecursor

cur(mmetal1):layer = metal1
  ->wirecursor

cur(mmetal2):layer = metal2
  ->wirecursor

wirecursor:{draw cursor box for wires}
  x = gridx(curgx)
  xl = x-scale
  xr = x+scale
  y = gridy(curgy)
  yb = y-scale
  yt = y+scale

  colour(layer); enable(layer)
  clipfill(xl, yb, xr, yt)
  ->drawout
    
cur(mcontact):drawcontact(curgx, curgy)
  ->drawout

cur(msubcon):drawsubcon(curgx, curgy)
  ->drawout

cur(mtranx):drawtranx(curgx, curgy)
  ->drawout

cur(mtrany):drawtrany(curgx, curgy)
  ->drawout

cur(mptranx):drawpwell(curgx, curgy)
  drawtranx(curgx, curgy)
  ->drawout

cur(mptrany):drawpwell(curgx, curgy)
  drawtrany(curgx, curgy)
  ->drawout

cur(mpwell):drawpwell(curgx, curgy)
  ->drawout

cur(mzoom):
  x = gridx(curgx)
  xl = x-scale2
  xr = x+scale2
  y = gridy(curgy)
  yb = y-scale2
  yt = y+scale2

  colour(contact); enable(contact)
  clipoutline(xl, yb, xr, yt)
  ->drawout
    
drawout:{draw cursor outline)
  colour(contact); enable(contact)
  x = gridx(curgx)
  y = gridy(curgy)
  clipoutline(x+curxl(curtype)*scale, y+curyb(curtype)*scale,
              x+curxr(curtype)*scale, y+curyt(curtype)*scale)

%end

{------------------------------------------------------------------------------}

%routine erasecursor
%integer x, y

  x = gridx(curgx)
  y = gridy(curgy)
  colour(0); enable(alllayers)
  clipfill(x-scale3, y-scale3, x+scale3, y+scale3)

  redrawgridpoint(curgx, curgy)

%end

{------------------------------------------------------------------------------}

%routine flash
%integer i
  cmap(0) = flashcolour
  updatecolourmap(cmap(0))
  %for i = 1,1,20000 %cycle
  %repeat
  cmap(0) = backgroundcolour
  updatecolourmap(cmap(0))
%end
{------------------------------------------------------------------------------}

%endofprogram