! EDWIN driver for the Level 2 graphics system, Igor's board.

%include "Edwin:device.inc"
%include "Edwin:icodes.inc"
%option "-LOW"

%constinteger YPIXELS=512, XPIXELS= 784

@16_7F400 %short %integer mousex
@16_7F402 %short %integer mousey
@16_7F45B %byte %integer mousebuts
%constinteger mouseleft=8, mousemiddle=4, mouseright=2, mouseall=14
%owninteger mouse=0

%constinteger black=0, red=1, green=2, blue=4, cursorp=8
%constinteger yellow=red+green, magenta=red+blue, cyan=blue+green
%constinteger white=red+green+blue
%ownbytearray cols (0:8) =0,white,blue,green,red,magenta,yellow,cyan,cursorp

! Screen information
%owninteger current colour = 0
%owninteger planes mode = 0   {0:overwrite; 1:and; 2:or}
%owninteger current planes = 16_ff

%owninteger XL = 0
%owninteger XR = xpixels-1;   !Right hand side of device window
%owninteger YB = 0
%owninteger YT = ypixels-1
%owninteger VIS = 0;     !0 if CVP inside VW

%owninteger Xpos = 0
%owninteger Ypos = 0

%owninteger WX = 0
%owninteger WY = 0

%ownshortintegername curclearplanes

%ownshortintegername curboxplanes
%ownshortintegername curboxcolour
%ownshortintegername curboxmovex
%ownshortintegername curboxmovey
%ownshortintegername curboxx
%ownshortintegername curboxy

%ownshortintegername curlineplanes
%ownshortintegername curlinecolour
%ownshortintegername curlinemovex
%ownshortintegername curlinemovey
%ownshortintegername curlinex
%ownshortintegername curliney

%ownshortintegername curcharplanes
%ownshortintegername curcharcolour
%ownshortintegername curcharmovex
%ownshortintegername curcharmovey
%recordformat charf(%short dummy,%byte char,term)  {dummy to get short alignment}
%ownrecord(charf) curchar
%ownbyteintegername curcharp

{ *** node format }
%recordformat nodef(%byte code,
                    %byte flags,
                    (%short x,y %or %integer arg),
                    %short bbl,bbb,bbr,bbt,
                    %record(nodef)%name d,r)

{ *** execution flags }
%constantbyte optimise=128,waitf=64,pointer=32,indexA=16,indexB=8,
              cursor=4,down=2,right=1

{ *** instruction codes }
%constantbyte drawbox=0,setink=1,setpmask=2,setcursor=3,
              setarguments=4,setclip=5,move=6,setdscale=7,
              setiteration=8,deciteration=9,
              flybacky=10,setxy=11,pan=12,report=13,drawline=14,
              putBstring=15,putVstring=16,puttemplate=17,
              setrefpoint=18,moveto=19,boxto=20,lineto=21

{ *** graphics processor addresses }
%constantinteger procaddr = 16_00D00000,
       exebutton=procaddr +     16_4000,
      exepointer=procaddr +     16_E000,
     workenvbase=procaddr +     16_E006

%recordformat environment(%short currink,%short currplan,
                          %short workX     ,%short workY,
                          %short bblX,%short bbbY,%short bbrX,%short bbtY,
                          %short cblX,%short cbbY,%short cbrX,%short cbtY,
                          %short iscaleX,iscaleY,
                          %short dscaleX,dscaleY,
                          %short iteration,
                          %integer currfont,
                          %integer currargarray,
                          %integer currcursor,
                          %integer reportaddr,
                          %short refpointX,%short refpointY)

@workenvbase %record(environment) workenvir

%ownshort reportword=0
%ownshortarray berkfont(0:1)   {dummy}

@exepointer %record(nodef)%name entrynodep
@exebutton %short evaluate

%ownrecord(nodef) node
%ownrecord(nodef)%name curnodep,clearp,boxp,linep,charp

%routine dnode(%short code,x,y)
%record(nodef)%name nodep
  nodep==new(node)
  curnodep_d==nodep
  curnodep_flags=curnodep_flags!down
  nodep_code=code
  nodep_flags=0
  nodep_x=x
  nodep_y=y
  curnodep==nodep
%end

%routine rnode(%short code,x,y)
%record(nodef)%name nodep
  nodep==new(node)
  curnodep_r==nodep
  curnodep_flags=curnodep_flags!right
  nodep_code=code
  nodep_flags=0
  nodep_x=x
  nodep_y=y
  curnodep==nodep
%end

%routine danode(%short code,%integer arg)
%record(nodef)%name nodep
  nodep==new(node)
  curnodep_d==nodep
  curnodep_flags=curnodep_flags!down
  nodep_code=code
  nodep_flags=0
  nodep_arg=arg
  curnodep==nodep
%end

%routine ranode(%short code,%integer arg)
%record(nodef)%name nodep
  nodep==new(node)
  curnodep_r==nodep
  curnodep_flags=curnodep_flags!right
  nodep_code=code
  nodep_flags=0
  nodep_arg=arg
  curnodep==nodep
%end

%routine dsetxy(%short x,y)
  dnode(setxy,x,y)
%end

%routine dpan(%short x,y)
  dnode(pan,x,y)
%end

%routine dsetref(%short x,y)
  dnode(setrefpoint,x,y)
%end

%routine dcolour(%short colour)
  dnode(setink,colour,0)
%end

%routine dplanes(%short planes)
  dnode(setpmask,planes,0)
%end

%routine dmove(%short x,y)
  dnode(move,x,y)
%end

%routine dmoveto(%short x,y)
  dnode(moveto,x,y)
%end

%routine dbox(%short x,y)
  dnode(drawbox,x,y)
%end

%routine dboxto(%short x,y)
  dnode(boxto,x,y)
%end

%routine dline(%short x,y)
  dnode(drawline,x,y)
%end

%routine dlineto(%short x,y)
  dnode(lineto,x,y)
%end

%routine dvstring(%integer ptr)
  danode(putvstring,ptr)
%end

%routine dbstring(%integer ptr)
  danode(putbstring,ptr)
%end

%routine rsetxy(%short x,y)
  rnode(setxy,x,y)
%end

%routine rpan(%short x,y)
  rnode(pan,x,y)
%end

%routine rsetref(%short x,y)
  rnode(setrefpoint,x,y)
%end

%routine rcolour(%short colour)
  rnode(setink,colour,0)
%end

%routine rplanes(%short planes)
  rnode(setpmask,planes,0)
%end

%routine rmove(%short x,y)
  rnode(move,x,y)
%end

%routine rmoveto(%short x,y)
  rnode(moveto,x,y)
%end

%routine rbox(%short x,y)
  rnode(drawbox,x,y)
%end

%routine rboxto(%short x,y)
  rnode(boxto,x,y)
%end

%routine rline(%short x,y)
  rnode(drawline,x,y)
%end

%routine rlineto(%short x,y)
  rnode(lineto,x,y)
%end

%routine rvstring(%integer ptr)
  ranode(putvstring,ptr)
%end

%routine rbstring(%integer ptr)
  ranode(putbstring,ptr)
%end

%routine rreport(%short value)
  rnode(report,value,0)
%end

%routine timeout
%integer i,j
  %for i=1,1,10000 %cycle
    %if reportword=0 %then %start
      %for j=1,1,20 %cycle
        {wait a little bit longer}
      %repeat
      %return
    %finish
  %repeat
  {treat as reported anyway}
%end

%routine clear(%integer planes)
  curclearplanes=planes
  timeout
  entrynodep==clearp
  reportword=1
  evaluate=16_ff
%end

%routine line(%integer xl,yb,xr,yt,col,pl)
  curlineplanes=pl
  curlinecolour=col
  curlinemovex=xl
  curlinemovey=yb
  curlinex=xr
  curliney=yt
  timeout
  entrynodep==linep
  reportword=1
  evaluate=16_ff
%end

%external %routine IGOR %alias "EDWIN___I" (%integer COM, X, Y)

%record(nodef) topnode
%record(nodef)%name savenodep

%integer i
%switch SW (0:MAX COM)

%routine SWAP (%integername  A, B)
%integer C
   C = A;   A = B;   B = C
%end

   %return %unless 0<=COM<=MAX COM
{  write(com,4) ; write(x,4) ; write(y,4) ; newline
  -> SW(COM)

SW(0): ! Initialise
  dev data_name = "Level 2 Graphics"
  dev data_DVX = X PIXELS-1
  dev data_DVY = Y PIXELS-1
  dev data_MVX = X PIXELS-1
  dev data_MVY = Y PIXELS-1

  workenvir_currink=0          {current colour black}
  workenvir_currplan=16_ff     {all planes enabled} 
  workenvir_workX=0            {work at (0,0)}
  workenvir_workY=0
  workenvir_bblX=0             {current bounding box}
  workenvir_bbbY=0
  workenvir_bbrX=0
  workenvir_bbtY=0
  workenvir_cblX=0             {current clip box}
  workenvir_cbbY=0
  workenvir_cbrX=xpixels
  workenvir_cbtY=ypixels
  workenvir_iscaleX=16_0100
  workenvir_iscaleY=16_0100
  workenvir_dscaleX=16_0100
  workenvir_dscaleY=16_0100
  workenvir_iteration=1
  workenvir_currfont=addr(berkfont(0))
  workenvir_currargarray=0
  workenvir_currcursor=0
  workenvir_reportaddr=addr(reportword)
  workenvir_refpointX=0
  workenvir_refpointY=0

  curnodep==topnode
  dsetxy(0,0)
  dpan(0,0)
  dsetref(0,0)
  dplanes(16_ff)
  curclearplanes==curnodep_x
  dcolour(0)
  dmove(0,0)
  dbox(xpixels,ypixels)
  curnodep==topnode_d
  rreport(0)
  clearp==topnode_d

  clear(16_ff)
  clear(16_ff)    {again for power up case}

  {set up data structure for box drawing}
  curnodep==topnode
  dplanes(16_ff)   ;   curboxplanes==curnodep_x
  dcolour(0)       ;   curboxcolour==curnodep_x
  dmoveto(0,0)     ;   curboxmovex==curnodep_x ; curboxmovey==curnodep_y
  dboxto(0,0)      ;   curboxx==curnodep_x ; curboxy==curnodep_y
  curnodep==topnode_d
  rreport(0)
  boxp==topnode_d

  {set up data structure for line drawing}
  curnodep==topnode
  dplanes(16_ff)   ;   curlineplanes==curnodep_x
  dcolour(0)       ;   curlinecolour==curnodep_x
  dmoveto(0,0)     ;   curlinemovex==curnodep_x ; curlinemovey==curnodep_y
  dlineto(0,0)     ;   curlinex==curnodep_x ; curliney==curnodep_y
  curnodep==topnode_d
  rreport(0)
  linep==topnode_d

  {set up data structure for char drawing}
  curnodep==topnode
  dplanes(16_ff)   ;   curcharplanes==curnodep_x
  dcolour(0)       ;   curcharcolour==curnodep_x
  dmoveto(0,0)     ;   curcharmovex==curnodep_x ; curcharmovey==curnodep_y
  curchar_term=nl    {string terminator}
  curcharp==curchar_char
  dvstring(addr(curcharp))
  curnodep==topnode_d
  rreport(0)
  charp==topnode_d

  %return

SW(1): ! Terminate
  %return

SW(2): ! Update
  %return

SW(3): ! Newframe
  clear(16_ff)
  %return

SW(4): ! Move
  Xpos = X
  Ypos = Y
  %return

SW(5): ! Line
  %if planes mode=2 %then i=current colour %else i=16_ff
  line(Xpos,Ypos,X,Y,current colour,i)
  Xpos=X
  Ypos=Y
  %return

SW(6): ! Char
  %if planes mode=2 %then i=current colour %else i=16_ff
  curcharplanes=i
  curcharcolour=current colour
  curcharmovex=Xpos
  curcharmovey=Ypos
  curcharp=x
  timeout
  entrynodep==charp
  reportword=1
  evaluate=16_ff
  %return

SW(7): ! Attribute
  %if x=0 %start; ! Colour
      Y = 1 %unless 0<=Y<=8
      current colour = cols(y)
  %finish %else %if X=9 %start; ! Colour mode
      planes mode = Y
  %finish
  %return

SW(8): ! Lower window bounds
  XL = X;   YB = Y
  %return

SW(9): ! Upper window bounds
  XR = X;   YT = Y
  %return

SW(11): ! and/or/planes......   (old entry point)
   Y = X;   X = 9;  -> SW (7)
 
SW(12): ! Remember lower box bounds
   WX = X;   WY = Y
   %return

SW(13): ! Upper box bounds & do the box
  SWAP (WX, X) %if WX > X
  SWAP (WY, Y) %if WY > Y

  %return %if WX > XR %or X < XL %or WY > YT %or Y < YB

  WX = XL %if WX < XL
  WY = YB %if WY < YB
  X = XR %if X > XR
  Y = YT %if Y > YT
  ! Box now clipped into the screen.

  %if planes mode=2 %then curboxplanes=current colour %c
                    %else curboxplanes=16_ff
  curboxcolour=current colour
  curboxmovex=WX
  curboxmovey=WY
  curboxx=X
  curboxy=Y

  timeout

  entrynodep==boxp
  reportword=1
  evaluate=16_ff

  %return

sw(14): ! Circle
   %return

sw(15): ! Area fill
   %return

sw(*): ! Anything else ignored
%end

%external %routine I SAM %alias "EDWIN___I_SAM" (%integer %name S, X, Y)
%constbytearray mt(0:7)=0,4,2,6,1,5,3,7    {reverses bits 0 & 2}

  %on 0 %start
    %signal 14, 8
  %finish

  %if mouse = 0 %start
    mouse = 1
    mousex = xpixels//2
    mousey = ypixels//2
  %finish

  x = mousex
  y = mousey
  s = mt((mousebuts & mouseall)>>1)    {for compatibility}
%end
 
%external %routine I REQ %alias "EDWIN___I_REQ" (%integer %name but,x,y)
%integer i,buts,mx,my
%constinteger cs=10    {cross size}

  %on 0 %start
    %signal 14, 8
  %finish

  %if mouse = 0 %start
    mouse = 1
    mousex = xpixels//2
    mousey = ypixels//2
  %finish

  %cycle;   %repeat %until mousebuts&mouseall=0
  x = xpixels//2;   y = ypixels//2
  {draw default cross to start with}
  line(x-cs,y,x+cs,y,cursorp,cursorp)
  line(x,y-cs,x,y+cs,cursorp,cursorp)
  mousex=x ; mousey=y
  %cycle       {select area wanted}
    %cycle     {wait until something happens to mouse}
       %for I = 1, 1, 100 %cycle; %repeat   {slow down a bit}
       mx = mousex
       my = mousey
       buts = mousebuts & mouseall
    %repeat %until buts # 0 %or mx#x %or my#y
    %exit %if buts & mousemiddle # 0    {exit if finished}
    {delete old cross}
    line(x-cs,y,x+cs,y,0,cursorp)
    line(x,y-cs,x,y+cs,0,cursorp)
    x=mx ; y=my
    %if x<0 %then x=0 %and mousex=0 %else %c
    %if x>=xpixels %then x=xpixels-1 %and mousex=xpixels-1
    %if y<0 %then y=0 %and mousey=0 %else %c
    %if y>=ypixels %then y=ypixels-1 %and mousey=ypixels-1
    line(x-cs,y,x+cs,y,cursorp,cursorp)
    line(x,y-cs,x,y+cs,cursorp,cursorp)
  %repeat
  clear(cursorp)    {gets rid of last cross (and noise crap!) }
  %cycle;   %repeat %until mousebuts&mouseall=0
%end

%external %routine I box %alias "EDWIN___I_BOX" (%integer %name xl, yb, xr, yt)
%integer ox,oy,buts,mx,my,b,i

  %on 0 %start
    %signal 14, 8
  %finish

  %if mouse = 0 %start
    mouse = 1
    mousex = xpixels//2
    mousey = ypixels//2
  %finish

  %cycle;   %repeat %until mousebuts&mouseall=0
  b = 50;   ox = xpixels//2;   oy = ypixels//2
  xl=ox-b ; xr=ox+b
  yb=oy-b ; yt=oy+b
  {draw default box to start with}
  line(xl,yb,xr,yb,cursorp,cursorp)
  line(xr,yb,xr,yt,cursorp,cursorp)
  line(xr,yt,xl,yt,cursorp,cursorp)
  line(xl,yt,xl,yb,cursorp,cursorp)
  mousex=ox ; mousey=oy
  %cycle       {select area wanted}
    %cycle     {wait until something happens to mouse}
       %for I = 1, 1, 100 %cycle; %repeat   {slow down a bit}
       mx = mousex
       my = mousey
       buts = mousebuts & mouseall
    %repeat %until buts # 0 %or mx#ox %or my#oy
    %exit %if buts & mousemiddle # 0    {exit if finished}
    {delete old box}
    line(xl,yb,xr,yb,0,cursorp)
    line(xr,yb,xr,yt,0,cursorp)
    line(xr,yt,xl,yt,0,cursorp)
    line(xl,yt,xl,yb,0,cursorp)
    b = b+1 %if buts & mouseright # 0 %and b<ypixels//2-1
    b = b-1 %if buts & mouseleft # 0 %and b>2
    ox=mx ; oy=my
    %if ox<0 %then ox=0 %and mousex=0 %else %c
    %if ox>=xpixels %then ox=xpixels-1 %and mousex=xpixels-1
    %if oy<0 %then oy=0 %and mousey=0 %else %c
    %if oy>=ypixels %then oy=ypixels-1 %and mousey=ypixels-1
    xl = ox - b
    xr = ox + b
    yb = oy - b
    yt = oy + b
    line(xl,yb,xr,yb,cursorp,cursorp)
    line(xr,yb,xr,yt,cursorp,cursorp)
    line(xr,yt,xl,yt,cursorp,cursorp)
    line(xl,yt,xl,yb,cursorp,cursorp)
  %repeat
  clear(cursorp)    {gets rid of last box (and noise crap!) }
  %cycle;   %repeat %until mousebuts&mouseall=0
%end

%end %of %file