!14/05/
!
! stic circuit graphics editor
!
%endoflist

!    mouse position and switches
%shortintegerspec(16_7FFF0) newx
%shortintegerspec(16_7FFF2) newy
%byteintegerspec(16_7FFF4)  switches

! TRACE CURSOR positions
%owninteger origin x= 0, origin y= 0
%owninteger  x= 50 ,y=  50
%constinteger seperation= 30

! storage upkeep constants
%constinteger delete=  0
%constinteger install= 100


!        screen dimensions
%owninteger zoom= 1
%constinteger screen left= 0
%constinteger screen right= 690
%constinteger screen top= 512
%constinteger screen bottom= 0
%constinteger flip top= 2*screen top

!        colour controls
%constinteger cursors= 8
%constinteger scrub cursor= 0
%constinteger any colour= 15

%constinteger device width=15


! mouse switches
%constinteger switch1 = 249
%constinteger switch2 = 250
%constinteger switch3 = 252

! wire tracing globals
%owninteger startX=0,  startY= 0
%owninteger trace x= 0,trace y=0
%owninteger Twire= no
%owninteger toggle= 2

%owninteger updated= 5

%constinteger bel= 7            {error warning beep
!_______________________________________________________________________
%routinespec DRAW(%integer offset)
%routinespec RESET SCREEN(%integername flip screen)
%routinespec DRAW  SCREEN(%integername flip screen)


!                  --==<< screen routines >>==--

%routine DISPLAY(%string(255)s,%integer x,y,colour)
  enable reg= any colour
  set colour(colour)
  at(x,y)
  showstring(s)
%end

%integerfunction BOUND(%integer coord,max,flip screen)
%integer res= coord
  %if coord> max+flip screen  %then res= max +flip screen
  %if coord< flip screen   %then res= flip screen
%result= res
%end
  
!________________________________________________

%integerfunction REGULARISE(%integer coord)
%integer temp
%integer a= (coord//seperation)*seperation,
         b= a+seperation
 %if coord-a < b-coord %then temp= a %else temp= b
%result= temp
%end

!___________________________________________________________________

%routine TRACE CURSOR(%integername  x,y,moving,%integer size)
%integer flip screen,
         reg= yes

%own %integer offx=-60, offy=-180
%own %integer oldx=not set,oldy=not set

! keep cursor on screen
%if oldx# not set %start
   %if oldx>= mouse display x-90-10 %and oldy >= screen y-10 %c
       %and size= no %start
       %if (oldy-(screen y-10)) < (old x- ((mouse display x-90)-10)) %start
              offy= new y-screen y+10
       %else
              offx= new x-(mouse display x-90)+10
       %finish
   %finish
   %if oldx>= screen right-10 %then offx= newx-screen right+10 
   %if oldy>= screen top-10 %then offy= newy-screen top+10 
   %if oldx<= screen left+10 %then offx= newx-screen left-10 
   %if oldy<= screen bottom+10 %then offy= newy-screen bottom-10 
%finish
!  takes latest mouse position
  x= newx-offx
  y= newy-offy

%if y < screen y-20 %and y > screen bottom + 20 %and %c
    x < screen right-20 %and x> screen left+20 %and %c
   ((x < mouse display x-90 %or y < screen y-20) %and size= no) %start
  x= regularise(x) 
  y= regularise(y)
%finish

%if x# old x %or y# old y %start
  enable reg= cursors
%for flip screen= 0,screen top,screen top %cycle
  SETCOLOUR(scrub cursor)
! overwrite  old cursor
  LINE(oldx-5, flip screen + oldy-5, oldx+5, flip screen + oldy+5)
  LINE(oldx-5, flip screen + oldy+5, oldx+5, flip screen + oldy-5)
  SETCOLOUR(cursors)
  LINE(x-5, flip screen+y-5, x+5, flip screen+y+5)
  LINE(x-5, flip screen+y+5, x+5, flip screen+y-5)
%repeat
%finish
old x= x
old y= y
%end



!________________________________________________________________

%routine  DRAW DEVICE(%integer x,y,type,menu,ratio)
 %record %format TRI(%integer x,y)
 %record (TRI) a,b,c
 %switch devic(contact:pass tran)
 %integer inc1= 12//zoom,
          inc2= 9//zoom

%if (%not(screen y-10<y<screen top) %and y> 10 %andnot %c
        (screen top+screen y-10<y<screentop*2)) %or menu= yes %start
%if CPM <= type <= CDM %or CPDE <= type <= CPDS %then type= contact
%if PUE <= type <= PUN %Then type= pull up
enable reg= white
set colour(white)
   ->devic(type)
       devic(contact):CIRCLE(x,y,inc2)
                      ->skip
       devic(pull up): a_x=x   ;  a_y=y+inc2
                       b_x=x-inc1; b_y=y-inc2
                       c_x=x+inc1; c_y=y-inc2
                       TRIANGLE(a,b,c)
                      ->skip
     devic(pull down): a_x=x   ;  a_y=y-inc2
                       b_x=x-inc1;  b_y=y+inc2
                       c_x=x+inc1;  c_y=y+inc2
                       TRIANGLE(a,b,c)
                      ->skip
     devic(pass tran): FILL(x-inc2,y-inc2,x+inc2,y+inc2)
                skip:
     %if moving= no %and ratio# 0 %and %c
       zoom= 1 %and y< screen y %then %c
         DISPLAY(ITOS(ratio,0),x-4,y-5,blue)

%finish
%end


!_____________________________________________________________

%routine DRAW WIRE(%integername sx,sy,ex,ey,%integer type,flip screen)
enable reg= type
DISABLE(\type)
SET COLOUR(type)
    sx= BOUND(sx,screen x,0)
    ex= BOUND(ex,screen x,0)
    sy= BOUND(sy,screen y,flip screen)
    ey= BOUND(ey,screen y,flip screen)
! don't trap lines along screen edges , only perpedicular clipping !
    %if (sx=ex %and ex#0) %or (sy=ey %and ey#flip screen) %then %c
        LINE(sx,sy,ex,ey) 
%end

!_________________________________________________________________


%routine  ROTATION(%integername x,y,%integer rot,type)
 %if rot= 0 %or rot= 180 %start
   x= cell x(type)
   y= cell y(type)
 %finish %else %start
   x= cell y(type)
   y= cell x(type)
 %finish
%end

!_________________________________________________________________

%routine DRAW CELL(%integer x1,y1,type,colour,flip screen,rot)
%string(20) s
%integer x2,y2,
         pos x,
         pos y

ROTATION(x2,y2,rot,type)
x2= x2//zoom
y2= y2//zoom

 
 pos x= x1+x2//2
 pos y= y1+y2//2
 %if pos y > flip screen %and pos y < screen y + flip screen -10 %start
   set colour(white)
   enable reg= any colour
   at(posx,posy)
   showstring(cellname(type))
 %finish
 x2= x1 + x2
 y2= y1 + y2
 DRAW WIRE(x2,y2,x1,y2,colour,flip screen)
 DRAW WIRE(x1,y2,x1,y1,colour,flip screen)
 DRAW WIRE(x1,y1,x2,y1,colour,flip screen)
 DRAW WIRE(x2,y1,x2,y2,colour,flip screen)
%end



!________________________________________________________________
%owninteger gnsx,gnsy,gnex,gney     {routines cannot handle 8 parameteres
                                 {so local globals are used

%routine TRACE LINE(%integername osx,osy,oex,oey, %c
                    %integer update,finish,colour)
%integer sy,ey
!o= old,  n= new
!e= end,  s= start

 enable reg= any colour
 DISABLE(\colour)
 SET COLOUR(black)
 LINE(osx,osy,oex,oey)
 LINE(osx,osy+screen top,oex,oey+ screen top)
 %if finish= no %start
   DRAW WIRE(gnsx,gnsy,gnex,gney,colour,0)
   sy= gnsy + screen top
   ey= gney + screen top
   DRAW WIRE(gnsx,sy,gnex,ey,colour,screen top)
 %finish
 %if update= yes %start
  osx= gnsx
  osy= gnsy
  oex= gnex
  oey= gney
 %finish
%end

!_______________________________________________________________

%routine TRACE WIRE(%integer nsx,nsy,%integername nex,ney,moved,start,%c
                    %integer finish)
%owninteger osx=0,osy=0,oex=0,oey=0,ox=0,oy=0
!!o=old ,n=new
!!e=end ,s=start
 %if start= yes %start
   osx= 0
   osy= 0
   oex= 0
   oey= 0
   start= no
 %finish

! only update if neccessary
%if ox# x %or oy# y %or moved= yes %start
! i.e. has either end of traced wire moved
   %if |x-nsx| > |y-nsy| %start
     nex= x
     ney= nsy
   %else
     nex= nsx
     ney= y
   %finish
   gnsx=nsx; gnsy=nsy
   gnex=nex; gney=ney
   TRACE LINE(osx,osy,oex,oey,yes,finish,toggle)
 %finish
moved= no
ox= x
oy= y
%end


!________________________________________________________________

%routine TRACE CELL(%integer type,rot,request)
%integer flip screen
%integer len x,len y
%own %integer old x= 0,old y=0
%own %integer ox1= 0,oy1= 0,ox2= 0,oy2= 0,
              d1= 0,d2= 0,d3= 0
%integer nx1,ny1,nx2,ny2

!o=old, n=new
!e=end, s=start

! only update if neccessary
 %if old x# x %or old y# y %or request= yes %start
  ROTATION(len x,len y,rot,type)
  len x= (len x//2)//zoom
  len y= (len y//2)//zoom
  nx1=x-len x
  ny1=y+len y
  nx2=x+len x
  ny2=y-len y
  gnsx=nx1;gnsy=ny1;gnex=nx2;gney=ny1
  TRACE LINE(ox1,oy1,ox2,oy1,no,no,cursors)
  gnsx=nx2;gney=ny2
  TRACE LINE(ox2,oy1,ox2,oy2,no,no,cursors)
  gnsx=nx1;gnsy=ny2
  TRACE LINE(d1,d2,ox2,d3,yes,no,cursors)
  gnsy=ny1;gnex=nx1
  TRACE LINE(ox1,oy1,ox1,oy2,yes,no,cursors)
%finish
 old x= x
 old y= y
%end

  

!_______________________________________________________________________

%routine CLEAR TOGGLE(%integer off)
 SET COLOUR(black)
 FILL(370,off+screen y+2,450,off+screen y+24)
 FILL(450,off+screen y+2,screen x,off+screen y+40)
%end

!______________________________________________________________________

%routine change TOGGLE(%integer cell,zoom,size,%string(255) prompt)
%integer off,function,len

 enable reg= any colour
 CLEAR TOGGLE(off) %for off= 0,screen top,screen top

 %if toggle= 4 %then toggle= 0 %else %c
            %if toggle=0 %then toggle=1 %else %c
                  toggle= toggle*2

%if cell=no %or zoom= no %or size= no %or prompt# "" %start
   %for off= 0,screen top,screen top %cycle
    %if prompt# ""  %start
     len= length(prompt)*8
     DISPLAY(prompt.":",mouse display x+40-len,off+screen y + 10,cyan)
    %finish %else %c
    %if size= yes %start
      DISPLAY("mouse the device or wire >>>",mouse display x,off + screen y + 10,magenta)
    %finish %else %c
    %if size= find size %start
      DISPLAY("01 02 03 04 05 06 07 08 " ,
         mouse display x,off + screen y+15,cyan)
      DISPLAY("09 10 11 12 13 14 15 16",mouse display x,off+screen y+5,cyan)
    %finish %else %c
    %if cell= yes %start
      SETCOLOUR(cyan)
      at(381,off+screen y +8)
      showstring("CELL: ".cell name(current cell). %c
                 "     ROT: ".ITOS(current rot,0))
      SETCOLOUR(yellow)
      at(450,off+screen y +25)
      SHOWSTRING("1:place cell  2:rotate cell ")
    %finish %else %if cell= no %and zoom= no %start
      SETCOLOUR(toggle)
      FILL(518,off+screen y+7,543,off+screen y+34)
      SET COLOUR(white)
      LINE(515,off+screen y+4,546,off+screen y+4)
      LINE(515,off+screen y+4,515,off+screen y+37)
      LINE(546,off+screen y+4,546,off+screen y+37)
      LINE(515,off+screen y+37,546,off+screeny+37)
      DRAW DEVICE(660,off+screen y+20,toggle,yes,0)
      DISPLAY("R",550,off+screen y+7,magenta)
      DISPLAY(devices(toggle),560,off+screen y+7,yellow)
      DISPLAY("M",451,off+screen y + 7,magenta)
      DISPLAY(wires(toggle),463,off+screen y+ 7,yellow)
      DISPLAY("L",381,off+screen y+7,magenta)
      DISPLAY("toggle",391,off+screen y+7,cyan)
    %finish
   %repeat
%finish
%end

!______________________________________________________________________
%routine simple help
clear frame
newlines(2)
 printstring("          a:menu          -  any mouse key selects

")
 printstring("          b:mouse 

                       1     0      0      Toggle")
printstring("      

                       0     1      0      Wire       (type=toggle)
                                            or delete")
printstring("
                       0     0      1      device     (type=toggle)
                                            or contact")
printstring("

          c:movement      -  cursor to screen edge gives unlimited paper")
printstring("

          d:abandon wire  -  make 0 length")
printstring("

          e:beep          -  overwrite warning

")
%end





!                       --==<< picture storage >>==--

%record(NODE)%map CONNECT(%record(NODE)%name node,%integer dir)
  %if dir= Xdir %then %result== node_next x %else %result== node_next y
%end


!#############################################
%routine SCAN
!%record(NODE)%name  edge== screens(Xdir)_ptr_next y,node
!%record(NODE LIST)%name cellist== cell list_next
!new lines(2)
!%while edge## nil %cycle
!   node== edge_next x
!   printstring("COL>")
!   %while node## nil %cycle
!    write(node_x,3);write(node_y,3);write(node_coord3,3)
!    %if node_class= cell %then printsymbol('C') %else %c
!    %if node_class= device %then printstring("D") %else %c
!    %if node_class= horiz wire %then printstring("hw") %else %c
!    %if node_class=vert wire %then printstring("vw") %else %c
!      printstring("error device")
!    newline
!    node== node_next x
!   %repeat
!  edge== edge_next y
! %repeat
!printstring("CELLS")
!%while cellist## nil %cycle
!  write(cellist_node_x,3)
!  write(cellist_node_y,3)
!  spaces(3)
!  cellist== cellist_next
!%repeat
%end

!______________________________________________________________________

%predicate ON WIRE(%record(NODE)%name node,%integer new x,new y)

 %if node_class= horiz wire %start
  %if node_y= new y %and %c
      node_X+ seperation<= newx %and %c
       node_coord3-seperation>= newX %then %TRUE
 %else %if node_class= vert wire
  %if node_x= new x %and %c
     node_y+ seperation<= newy %and %c
        node_coord3-seperation>= newy %and node_x=newx %then  %TRUE
%finish
%FALSE
%end


!______________________________________________________________________

%predicate ON ALL OF WIRE(%record(NODE)%name node,%integer new x,new y)

 %if node_class= horiz wire %start
  %if node_y= new y %and %c
    node_coord3-node_x = seperation %and %c
      (node_x= new x %or new x= node_coord3) %then %TRUE
 %else %if node_class= vert wire
  %if node_x= new x %and %C
     node_coord3-node_y= seperation %and %c
       (node_y= new y %or node_coord3= new y) %then %TRUE
%finish
%if ON WIRE(node,new x,new y) %then %TRUE
%FALSE
%end


!______________________________________________________________________

%predicate OVERLAP WIRE(%record(NODE)%name new input,node)
%if new input_class= node_class %and new input_type= node_type %and %c
   (new input_class= horiz wire %or new input_class= vert wire) %start
  %if new input_class= horiz wire %and node_y= new input_ y %start
      %if node_x < new input_x < node_coord3 %or %c
          node_x < new input_coord3 < node_coord3 %then %TRUE
  %else %if new input_class= vert wire %and new input_x= node_x
      %if node_y < new input_y < node_coord3 %or %c
          node_y < new input_coord3 < node_coord3 %then %TRUE
  %finish
 %finish
%FALSE
%end


!__________________________________________________________________________
%predicate ON CELL(%record(NODE)%name node,%integer new x,new y)
!%integer len x,leny
!
! ROTATION(lenx,leny,node_rot,node_type)
! %if node_class= cell %and %c
!      newx< node_x+ len x  %c
!          %and newx> node_x %c
!              %and newy< node_y+ leny  %c
!                %and newy> node_y %c
!                    %then %TRUE
%FALSE
%end

!_________________________________________________________________________

%predicate CORRUPTS CELL(%record(NODE)%name new input,node)
! %integer len x,
!          len y,
!          new len x,
!          new len y,
!          new x= new input_x,
!          new y= new input_y,
!          end  = newinput_coord3
! ROTATION(len x,len y,node_rot,node_type)
!          len x= node_x + len x
!          len y= node_y + len y          
!! check if point on cell
! %if ON CELL(node,new input_x,new input_y) %then %TRUE
!! check if other end of wire is on cell
! %if (new input_class= horiz wire %and ON CELL(node,new input_coord3,new input_y)) %c
! %or (new input_class= vert wire  %and ON CELL(node,new input_x,new input_coord3)) %c
!    %then %TRUE
!! check if wire crosses cell
! %if ( new input_class= horiz wire %and new x <= node_x %and %c
!     end >=  len x %and new y > node_y %and newy < len y) %or %c
!    ( new input_class= vert wire %and  new y <= node_y %and %c
!     end >=  len y %and new x > node_x %and new x < len x) %then %TRUE
!! check if device lies on cell edge
! %if new input_class= device %and %c
!   (( new x > node_x %and new x <  len x %and %c
!      (new y= node_y %or new y=  len y)) %or %c
!    ( new y > node_y %and new y <  len y %and %c
!      (new x= node_x %or new x=  len x))) %then %TRUE
!! check if new cell is over writing an old cell
! %if new input_class= cell %start
!   ROTATION(new len x,new len y ,new input_rot,new input_type)
!   new len x= new input_x + new len x
!   new len y= new input_y + new len y
!   %if ON CELL(node,new input_x,new len y) %or %c
!       ON CELL(node,new len x,new input_y) %or %c
!       ON CELL(node,new len x,new len y) %or %c
!       (new input_x <= node_x %and  new len x >=  len x %c
!        %and ((new input_y>node_y %and newinput_y< len y) %or %c
!              (new len y > node_y %and  new len y < len y))) %c
!        %or %c
!       (new input_y <= node_y %and  new len y >= len y %c
!        %and ((new input_x>node_x %and new input_x < lenx) %or %c
!              (new len x > node_x %and new len x < len x))) %c
!       %then %TRUE
! %finish
%FALSE
%end

!________________________________________________________________________
%predicate ON DEVICE(%record(NODE)%name n1,%integer x,y)
  %if (n1_class= device %or n1_class= notional) %and %c
       n1_x= x %and n1_y= y %then %TRUE 
 %FALSE
%end

!________________________________________________________________________
%predicate OVERLAP DEVICE(%record(NODE)%name n1,n2)
  %if ON DEVICE(n1,n2_x,n2_y) %and ON DEVICE(n2,n1_x,n1_y) %then %TRUE
  %FALSE
%end

!________________________________________________________________________

%record(NODE)%map  DELETE CELL(%integer x,y)
!%record(NODE LIST)%name cell==  cell list,
!                        nextt== cell_next,
!                        temp
!%record(NODE)%name res
!
!%while nextt## nil %cycle
!  %if ON CELL(nextt_node,x,y) %start
!    temp== nextt
!    res== nextt_node
!    cell_next== nextt_next
!    DISPOSE NODE LIST(temp)
!    %result== res
!  %finish
!  cell== nextt
!  nextt== nextt_next
!%repeat
%result== error
%end

!________________________________________________________________________

%predicate CELLS CORRUPTED(%record(NODE)%name new input)
!%record(NODE LIST)%name cell== cell list_next
!
!%while cell## nil %cycle
!  %if CORRUPTS CELL(new input,cell_node) %then %TRUE
!cell== cell_next
!%repeat
%FALSE
%end


!________________________________________________________________________

%record(NODE)%map FIND EDGE(%integer x,y,dir)
%record(NODE)%name node== screens(dir)_ptr,new

%while (dir= Xdir %and node_next y_x <= x) %or %c
       (dir= Ydir %and node_next x_y <= y) %cycle
 node== CONNECT(node,1-dir)
%repeat

%if (dir= Xdir %and node_x# x) %or %c
    (dir= ydir %and node_y# y) %start
     new== NEW NODE
     %if dir= xdir %start
        new_x= x
        new_y= bottom side
        new_next y== node_next y
        node_next y== new
        %result== new
     %finish %else %start
        new_x= left side
        new_y= y
        new_next x== node_next x
        node_next x== new
        %result== new
     %finish
%finish
%result== node
%end
     


!_________________________________________________________________________

%record(NODE)%map CROSSES EDGE OR AREA(%integer max,min,cross coord,dir, %c
                                       area,length)
!%record(NODE)%name edge== FIND EDGE(min,min,dir),
!                   node
!
!%while (dir= Xdir %and edge_x <= max ) %or %c
!       (dir= Ydir %and edge_y <= max) %cycle
!  node== CONNECT(edge,dir)
!  %while node## nil %and dir= Xdir %and node_y <  cross coord %cycle
!    %if ON WIRE(node,edge_x,cross coord) %then %result== node
!    node== node_next x
!  %repeat
!
!  %if area= yes %and node## nil %and node_y < length %start
!    %if (node_class= horiz wire %and node_x# max) %or %c
!        (node_class= vert wire %and node_y# length) %or %c
!         node_class= device %then %result== nil
!  %finish
!
!  %while node## nil %and dir= Ydir %and node_x < cross coord %cycle
!    %if ON WIRE(node,cross coord,edge_y) %then %result== node
!    node== node_next y
!  %repeat
!
! edge== CONNECT(edge,1-dir)
!%repeat
%result== error
%end



!_________________________________________________________________________

%predicate NOT FREE AREA(%record(NODE)%name new input)
!%record(NODE)%name res
!%integer lenx,leny
!ROTATION(lenx,leny,new input_rot,new input_type)
!len x= new input_x + len x
!len y= new input_y + len y
!! 1st check if any wires exist in this area
!res== CROSSES EDGE OR AREA(len x,new input_x,new input_y,Xdir,yes,len y)
!%if res## error %then %TRUE 
!res== CROSSES EDGE OR AREA(len y,new input_y,new input_x,Ydir,no,0)
!%if res## error %then %TRUE 
%FALSE
%end

!________________________________________________________________________

%integer %function INSERT NODE(%record(NODE)%name new input)
%owninteger id= 0
%record(NODE)%name node,
                   found1== nil,
                   found2== nil,
                   nextt

%if   CELLS CORRUPTED(new input) %then %result= no

 node== FIND EDGE(new input_x,new input_y,Xdir)
 nextt== CONNECT(node,Xdir)

 %while nextt ## nil %and (found1== nil %or nextt_y= new input_y) %cycle
   %if found1== nil %and  nextt_y >= new input_y %then %c
                 found1== node
     %if nextt_y= new input_y %start
        %if  new input_class= device %then found1== nextt
        %if  nextt_class= vert wire %then found1== nextt
     %finish

     %if  OVERLAP DEVICE(nextt,new input) %or %c
          OVERLAP WIRE(new input,nextt) %then %result= no
   node==  nextt
   nextt== CONNECT(node,Xdir)
 %repeat

 %if found1== nil %then found 1== node


 node== FIND EDGE(new input_x,new input_y,Ydir)
 nextt== CONNECT(node,Ydir)
 %while nextt## nil %and (found2== nil %or nextt_x= new input_x) %cycle
   %if  found2== nil %and nextt_x >= new input_x %then %c
                       found2== node
     %if nextt_x= new input_X %start
        %if new input_class= device %then found2== nextt
        %if nextt_class= vert wire %then found2== nextt
     %finish
     %if   OVERLAP DEVICE(nextt,new input) %or %c
           OVERLAP WIRE(new input,nextt) %then %result= no
   node==  nextt
   nextt== CONNECT(node,Ydir)
 %repeat
 %if found 2== nil %then found2== node

  %if new input_class= cell %and NOT FREE AREA(new input) %c
            %then TRACE CELL(node_type,node_rot,yes) %and %result= no

    new input_next x== found1_next x
    found1_next x==    new input
    new input_next y== found2_next y
    found2_next y==    new input

%result= yes
%end

!________________________________________________________________________

%record(NODE)%map FIND NODE(%integer x,y,dir,%record(NODE)%name other)
%record(NODE)%name node== FIND EDGE(x,y,dir),
                   nextt== CONNECT(node,dir),
                   res== error
%while nextt## nil %cycle
 %if  nextt== other %then %result== node
 %if ON ALL OF WIRE(nextt,x,y) %then res== node
 %if ON DEVICE(nextt,x,y)%then %result== node
 node== nextt
 nextt== CONNECT(node,dir)
%repeat
%result== res
%end


!_________________________________________________________________________

%record(NODE)%map DELETE OR SIZE NODE(%integer x,y,size,
                                      %record(NODE)%name match,new)

%integer i
%record(NODELiST)%name list,
                       remove
%record(NODE)%name node1,
                   node2,
                   temp
! %if size= no %and match## nil %start
!  temp==DELETE CELL(x,y)
!  %if temp## error %then x= temp_x %and y=temp_y %and special= yes
! %finish

  node1== FIND NODE(x,y,Xdir,match)
  %if node1## error %and node1_next x_class= vert wire %then %c
      node2== FIND NODE(x,node1_next x_y,Ydir,node1_next x) %else %c
      node2== FIND NODE(x,y,Ydir,match) 
  %if node1== error %and node2## error %then %c
      node1== FIND NODE(node2_next y_x,y,Xdir,node2_next y)

  %if node1## error %and node2## error %start
     temp== node1_next x
      %if size= yes %then %result== temp
      node1_next x== node1_next x_next x
      node2_next y== node2_next y_next y

      %for i= topp,1,bottom %cycle
            list== port list(i)
            %while list_next## nil %cycle
               %if list_next_node== temp %start
                %if new== nil %start
                 remove== list_next
                 list_next== list_next_next
                 DISPOSE NODELIST(remove)
                %else
                 list_next_node== new
                 list== list_next
                %finish
               %else
                list== list_next
               %finish
            %repeat 
      %repeat

      DISPOSE NODE(temp)
      %if match== nil %start
         DRAW(screen top)
         offset(0,-screen top)
         DRAW(0)
         offset(0,0)
      %finish
  %finish %else printsymbol(bel)
 
%result== nil
%end
  
!_________________________________________________________________________
%routine CLEAR TRACE
enable reg= cursors
set colour(scrub cursor)
fill(0,0,screen x,screen top+screen y)
%end


!__________________________________________________________________________

   
%record(SETS)%map SWITCH OP(%byteinteger function,type, %c
                         %integer x,y, %c
                              %integername start x,start y, %c
                                   %record(SETS)%name settings)
%integer a,b,len x,len y
%integer flip screen=0
%integer temp x,
         temp y,
         valid= yes,
         value

%switch func(switch1:switch3)
%switch func2(switch1:switch3)
%record(NODE)%name new input== nil, 
                   dump
%record(NODE LIST)%name new
%own%record(NODE)%name nodde
%own %integer begin x=0,
              begin y=0
%integer tcell= settings_cell,
         twire= settings_wire,
         tsize= settings_size



%if Tsize= yes  %start

  nodde== DELETE OR SIZE NODE(REGULARISE(x+origin x),
                              REGULARISE(y+origin y),yes,nil,nil)
  %if nodde_class= device %and %c
              (nodde_type# pull up %and nodde_type# pull down) %start
   printsymbol(bel)
   nodde== nil 
  %finish %else %if nodde## nil %start
   Tsize= find size
   CHANGE TOGGLE(no,no,find size,"")
  %finish



%finish %else %if Tsize= find size %start

   %if  screen y < y< screen y + 30 %And %c
        x > mouse display x %and nodde## nil %start

     value= ((x-mouse display x)//28)+1
     %if y< screen y + mouse display y %then value= value + 8
     %if nodde_class= device %then nodde_ratio= value %else %c
                                   nodde_width= value
     CHANGE TOGGLE(no,no,yes,"")
     flip screen= screen top
     DRAW SCREEN(flip screen)
     reset SCREEN(flip screen)
     Tsize= yes
  %finish %else printsymbol(bel)
  
%finish %else %c
%if Tcell= yes %start

 -> func2(function)

func2(switch 1):
         CLEAR TRACE
         new input== NEW NODE
         new input_class= cell
         new input_type= current cell
         new input_rot=  current rot
         ROTATION(len x,len y,current rot,current cell)
         a= REGULARISE((x-offset x)*zoom- len x//2 + origin x)
         b= REGULARISE((y-offset y)*zoom- len y//2 + origin y)
         new input_x= a
         new input_y= b
         valid= INSERT NODE(new input)
         %if valid= yes %start
!              add to cell list
               new== NEW NODE LIST
               new_next== cell list_next
               cell list_next== new
               new_node== new input
               DRAW SCREEN(flip screen)
               RESET SCREEN(flip screen)
         %finish
         ->outt2

func2(switch2):
         current rot= current rot+90
         %if current rot= 360 %then current rot= 0
         TRACE CELL(current cell,current rot,yes)
         CHANGE TOGGLE(yes,no,no,"")
func2(*):
        outt2:


%else 


  ->func(function)

  func(switch1):change TOGGLE(no,no,no,""); ->outt

  func(switch3):
            compacted= no
            compiled= no
            %if y < screen y %or settings_start= fileload %start
                 %if Twire# yes %start
                   new input== NEW NODE
                   new input_class= device
                   new input_coord3= ignore
                   new input_type= type
                   %if settings_ratio= ignore %start
                       %if type= pull up %then %c
                           new input_ratio= min pu ratio %else %c
                        %if type# contact %then %c
                           new input_ratio= 1
                   %else
                     new input_ratio= settings_ratio
                   %finish
                   temp x= REGULARISE(x+origin x)
                   temp y= REGULARISE(y+origin y)
                   new input_x= temp x
                   new input_y= temp y
                   valid= INSERT NODE(new input)
                   %if valid= yes %and y<screen y- device width %then %c
                     DRAW DEVICE(temp x-origin x,temp y-origin y,%c
                                 type,no,new input_ratio)
                   %finish
                %finish
              %finish
             ->outt
func(switch2):
             compacted= no
             compiled= no
             %if y < screen y %or settings_start= fileload %start
               %if toggle= delete %start
                %if Twire=no %start
                  dump==DELETE OR SIZE NODE(REGULARISE(x+origin x),%c
                        REGULARISE(y+origin y),no,nil,nil)
                  Clear Trace
                %finish %else %start
                  CLEAR TRACE
                  Twire= no
                %finish
               %finish %else %start
               %if Twire= no %start
                 Twire= yes
                 begin x= REGULARISE(x+origin x)
                 begin y= REGULARISE(y+origin y)
                 start x= begin x-origin x
                 start y= begin y-origin y
                 settings_start= yes
               %finish %else %start
                     Twire= no
                     new input== NEW NODE
                     new input_type= type
                     %if settings_ratio= ignore %then %c
                         new input_width= min width(new input_type) %c
                         %else new input_ratio= settings_ratio
                     trace X= REGULARISE(trace x+origin x)
                     trace Y= REGULARISE(trace y+origin y)
                     temp x= |begin x-trace x|
                     temp y= |begin y-trace y|

                     %if temp x > temp y %start
                       new input_class= horiz wire
                       %if begin x < trace x %start
                           new input_x=      begin x
                           new input_coord3= trace x 
                       %finish %else %start
                           new input_x=      trace x
                           new input_coord3= begin x
                       %finish
                       new input_y= begin y
                     %finish %else %if temp x < temp y %start
                        new input_class= vert wire
                        %if begin y < trace y %start
                           new input_y=      begin y
                           new input_coord3= trace y
                        %finish %else %start
                           new input_y=      trace y
                           new input_coord3= begin y
                        %finish
                        new input_x= begin x
                     %finish
 
                     %if temp x# temp y %start
                       valid= INSERT NODE(new input)
                       trace x= trace x-origin x
                       trace y= trace y-origin y
                       %if valid= yes %then %c
                        DRAW WIRE(start x,start y,trace x,trace y,type,0)
                     %finish
                  %finish
                 %finish
               outt:
            func(*):
%finish
%if valid= no  %then DISPOSE NODE(new input) %and printsymbol(bel)
settings_wire= twire
settings_size= tsize
settings_node== new input

scan
%result== settings
%end
                  

!_________________________________________________________________________

       %routine REDRAW(%record(NODE)%name nodeptr,%integer offset)
       %integer coord1= nodeptr_x//zoom-origin x ,
                coord2= offset + nodeptr_y//zoom-origin y,
                coord3= coord1,
                coord4= coord2

       %if nodeptr_class= device %start
           %if coord2> offset + device width//zoom %and %c
               coord2< offset + screen y - device width//zoom %and %c
               coord1> device width %start
                  DRAW DEVICE(coord1,coord2,nodeptr_type,no,nodeptr_ratio) 
           %finish
       %finish %else %if nodeptr_class= horiz wire %start
         coord3= nodeptr_coord3//zoom- origin x 
         DRAW WIRE(coord1,coord2,coord3,coord4,nodeptr_type,offset)
         %if moving= no %and nodeptr_width > min width(nodeptr_type) %start
          DISPLAY(ITOS(nodeptr_width,0),coord1+30,coord2-5,magenta)
         %finish
       %finish %else %if nodeptr_class= vert wire %start
         coord4= nodeptr_coord3//zoom- origin y +offset
         DRAW WIRE(coord1,coord2,coord3,coord4,nodeptr_type,offset)
         %if moving= no %and nodeptr_width > min width(nodeptr_type) %start
          DISPLAY(ITOS(nodeptr_width,0),coord1-5,coord4-30,magenta)
         %finish
       %finish %else %if nodeptr_class= cell %then %c
             DRAW CELL(coord1,coord2,nodeptr_type,white,offset,nodeptr_rot)
     %end


!_________________________________________________________________________

       %predicate ON SCREEN(%integer this coord,end coord,origin,max)
          %if (this coord//zoom> origin %and this coord//zoom< origin + max) %c
            %or (this coord//zoom<= origin %and end coord//zoom> origin ) %c
              %then %TRUE %else %FALSE
       %end


!_________________________________________________________________________

%routine DRAW(%integer offset)
%integer len x,
         len y,
         origin
%record(NODE)%name node,
                   edge== screens(Y dir)_ptr
%record(NODE LIST)%name cellptr== cell list_next
%record(NODELIST)%name list
%integer i,xx
%string(255) name

 SETCOLOUR(black)
 enable reg= any colour - cursors
 FILL(0,offset,screenx,screen y+offset)

origin x= origin x//zoom -offset x
origin y= origin y//zoom -offset y

%if tzoom= yes %then %c
             DRAW CELL(offset x,offset+offset y,0,yellow,offset,0) %c

! 1st draw any horizontal lines which bridge the left edge
 
%while edge_y//zoom<origin y %cycle
 edge== edge_next x
%repeat

%while edge_y//zoom< origin y + screen y  %cycle
  node== edge_next y
 %while node## nil %and node_x//zoom < origin x %cycle
    %if node_class= horiz wire %and %c
     ON SCREEN(node_x,node_coord3,origin x,screen x) %c
            %then REDRAW(node,offset) %and %exit
    node== node_next y
 %repeat
edge== edge_next x
%repeat

! now draw the rest of the visible structure 

 edge== screens(X dir)_ptr
 %while edge_x//zoom< origin x   %cycle
  edge== edge_next y
 %repeat

 %while edge_x//zoom< origin x+ screen x  %cycle
  node== edge_next x
   %while node## nil %and node_y//zoom< origin y+ screen y %cycle
        %if node_class# cell %and %c
           ON SCREEN(node_y,node_coord3,origin y,screen y) %c
                          %then REDRAW(node,offset)
        node== node_next x
    %repeat
   edge== edge_next y
 %repeat

! now draw any cells that appear on screen
 %while cellptr## nil %cycle
   ROTATION(len x,len y,cellptr_node_rot,cellptr_node_type)
   len x= len x + cellptr_node_x
   len y= len y + cellptr_node_y
   %if (ON SCREEN(cellptr_node_x,len x, origin x,screen x) %and %c
        ON SCREEN(cellptr_node_y,ignore,origin y,screen y) )%or %c
       (ON SCREEN(cellptr_node_x,len x, origin x,screen x) %and %c
        ON SCREEN(len y,ignore,origin y,screen y)) %c
        %then REDRAW(cellptr_node,offset)
     cellptr== cellptr_next
  %repeat

! name those ports 

       %if zoom= 1 %start
         %for i= topp,1,bottom %cycle
            list== PORT LIST(i)_next
            %while list## nil %cycle
             %if origin x < port pos(list_rx,Xdir) < origin x + screen x %and %c
                 origin y < port pos(list_rx,Ydir) < origin y + screen y %start
                 xx= port pos(list_rx,Xdir)
                 name= port name(list_rx)
                 %if xx= port side(left) %then xx= xx-(8*length(name))
                 xx= xx-originx
                 DISPLAY(name,xx, %c
                         port pos(list_rx,Ydir)-origin y+offset,yellow)
             %finish
             lisT== list_next
            %repeat
         %repeat
       %finish

origin x= (origin x+ offset x)*zoom
origin y= (origin y+ offset y)*zoom
%end

!___________________________________________________________________________
%routine DELAY(%integer count)
  count= count-1 %until count= 0
%end

!__________________________________________________________________________

%routine DRAW SCREEN(%integername flip screen)
       flip screen= screen top - flip screen
       DRAW(flip screen)
       offset(0,-flip screen)
%end

!___________________________________________________________________________

%routine RESET SCREEN(%integername flip screen)
%record(NODELIST)%name list
%integer i
%if flip screen= screen top %start
  DELAY(100)
  DRAW(0)
  offset(0,0)
  flip screen= 0
 %finish
%end


!____________________________________________________________________________

%routine  MOVE SCREEN(%integername origin x,origin y,start x,start y,moving,
                      moved,%integer size)

%const %integer move wait= 2000
%record(NODELIST)%name list
%integer inc= 10*zoom,
                 xx

%own %integer  move wanted= 0,
               flip screen= 0
%integer       incre
%integername   origin,
               start

   %routine MOVE PICTURE(%integername origin,start,flip screen,%c
                         %integer movement)
    %const %integer move reqd= 100
    %own %integer sample
     sample= sample+ 1 
     %if sample= move reqd %start
       moved= yes
       sample= 0
       origin= origin + movement
       start= start-  movement
       DRAW SCREEN(flipscreen)
     %finish
   %end

%if move wanted < move wait %then move wanted= move wanted + 1 
moving= yes
 %if x<=screen left+15 %start
             origin== origin x
             start==  start x
             incre=  -inc
 %finish %else %c
 %if x>=screen right-15 %start
             origin== origin x
             start==  start x
             incre=  inc
 %finish %else %c
 %if y>=screen top-15 %or %c
(size=no %and y>= screen y-15 %and x> mouse display x-80)%start
             origin== origin y
             start==  start y
             incre=  inc
 %finish %else %c
%if y<=screen bottom+15 %start
             origin== origin y
             start== start y
             incre=  -inc
 %finish %else %start
    moving= no
    %if move wanted= move wait %start
       origin x= regularise(origin x)
       origin y= regularise(origin y)
       DRAW SCREEN(flip screen)
       RESET SCREEN(flip screen)
    %finish
    move wanted =0
 %finish
 %if move wanted= move wait  %start
     MOVE PICTURE(origin,start,flip screen,incre)
 %finish
%end

!___________________________________________________________________________

%routine GET DESIRED CELL(%integername current cell,current rot)
!%integer i= 1,test
!
!current rot= 0
!select output(0)
!select input(0)
!clearframe
!printstring(" 
!
! Please enter cell's number:
!
!")
!%while cellname(i)# "" %cycle
!  spaces(10)
!  write(i,0);printstring("   ]: ")
!  printstring(cellname(i))
!  newline
!  i= i+1
!%repeat
!
!%cycle
!
!
!      gotoxy(1,17)
!      prompt("number?:")
!      read(current cell)
!      
!      %if  current cell < 0 %or current cell > i-1 %then  %c
!         printstring("
!
!            ...... CELL NOT LISTED !") %else %exit
!%repeat
%end

!__________________________________________________________________________
%routine DO ZOOM(%integername origin x,origin y,zoom,off x,off y,%integer a,b,c)
%const %integer screen= 0
%integer flip screen= 0,
         last= cputime,
         i,j

    %for i=a,b,c %cycle
       %if switches# no switch  %or b=-1 %start
             zoom= i
             off x= screen x//2-(screen x//2)//zoom
             off y= screen y//2-(screen y//2)//zoom
             DRAW SCREEN(flip screen)
        %finish
        j= 1
        %cycle
           j=j+1
           %exit %if j= 1000
        %repeatuntil cputime-last > 75
     %repeat
     RESET SCREEN(flip screen)
     %if b= -1 %then offset x= 0 %and offset y= 0
 %end
 
!_______________________________________________________________________
%routine CLEAN DATA(%integer full) 
%record(NODELIST)%name list,remove3
%record(NODE)%name edge== screens(Xdir)_ptr,
                   remove,
                   nodde
%record(ARCC)%name arc,
                   remove2
%integer flip screen= screen top,
         dir,i,j

%routine clean core(%record(NODE)%name node)
%integer dir
   %for dir= xdir,1,ydir %cycle
     arc== node_arccs(dir)
     %while arc## nil %cycle
      remove2== arc
      arc== arc_another arcc
      DISPOSE ARCC(remove2)
     %repeat
     node_arccs(dir)== nil
        arc== node_cons(dir)
        %while arc## nil %cycle
          remove2== arc
          arc== arc_another arcc
          DISPOSE ARCC(remove2)
        %repeat
        node_cons(dir)== nil
        node_in arc count(dir)= 0
        node_cc(dir)= 0
   %repeat
   node_checked= 0
   node_concheck= 0
   node_idd= 0
%end

%while edge## nil %cycle
  nodde== edge_next x
  %while nodde## nil %cycle
   CLEAN CORE(nodde)
   remove== nodde
   nodde== nodde_next x
   %if full= yes %start
    DISPOSE NODE(remove)
   %else
    %if remove_class= notional %start
       remove== DELETE or SIZE NODE(remove_x,remove_y,no,remove,nil) 
    %else
       %if CPDE <= remove_type <= CPDS %or CPM <= remove_type <= CDM %c
           %then remove_type= contact
       %if PUE <= remove_type <= PUN %then remove_type= pull up
    %finish
   %finish
  %repeat
  edge== edge_next y
%repeat

%if full= yes %start
  edge== bottom edge_next x
  %while edge## top edge %cycle
    remove== edge
    edge== edge_next x
    dispose node(remove)
  %repeat
  edge== left edge_next y
  %while edge## right edge %cycle
    remove== edge
    edge== edge_next y
    dispose node(remove)
  %repeat
  %for i=topp,1,bottom %cycle
     list== PORT LIST(i)_next
     %while list## nil %cycle
      remove3== list
      list== list_next
      DISPOSE NODELIST(remove3)
     %repeat
     port list(i)_next== nil
  %repeat
  port count= 1
  INIT
%finish

%if full= yes %or full= 2 %start
  %for i=topp,1,bottom %cycle
       list== port list(i)_next
       %while list## nil %cycle
        remove3== list
        list== list_next
        DISPOSE NODE LIST(remove3)
       %repeat
       port list(i)_next== nil
  %repeat
%finish
%if full# no %start
  DRAW SCREEN(flip screen)
  RESET SCREEN(flipscreen)
%finish
CLEAN CORE(left edge)
CLEAN CORE(right edge)
CLEAN CORE(top edge)
CLEAN CORE(bottom edge)
%end


  
%list
%endoffile