{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