! EDWIN driver for the Level 1 graphics system, Fred's board.

%include "Edwin:device.inc"
%include "Edwin:icodes.inc"
%include "level1:graphinc.imp"
%include "edwin:gkspoly"

%constinteger YPIXELS=511, XPIXELS= 687
%const %integer mouse delay = 40
%const %integer all planes = 15
%const %integer cursor plane = 8
%const %integer non cursor planes = all planes & (\cursor plane)
%const %integer yoffset = 512

! Screen information
%own %short font read = 0
%own %short shade mode = 0        { 2 => Points, 3 => Solids, otherwise lines }
%own %short enable mode = 0       { <0 and, =0 overw, >0 or }
%own %short shading = 0
%own %integer current enable = non cursor planes
%own %short current colour = white
%own %integer Xpos=0, Ypos=0
%own %integer XL = 0
%own %integer XR = xpixels;   !Right hand side of device window
%own %integer YB = 0
%own %integer YT = ypixels
%const %integer Tcs = 8

%external %routine FRED %alias "EDWIN___F" (%integer COM, X, Y)
   %own %byte %array cols (0:8) =
        0, white, blue, green, red, magenta, yellow, cyan, cursor plane
   %own %integer WX, WY
   %integer i
   %switch SW (0:MAX COM)

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

   %return %unless 0<=COM<=MAX COM
   -> SW(COM)

SW(0): ! Initialise
       dev data_name = "Level 1 graphics board"
       dev data_DVX = X PIXELS
       dev data_DVY = Y PIXELS
       dev data_MVX = X PIXELS
       dev data_MVY = Y PIXELS
       enable mode = 0
       shading = 0
       current enable = non cursor planes
       enable  (current enable)
       %return

SW(1): ! Terminate
       %return

SW(2): ! Update
       %return

SW(3): ! Newframe
       enable  (all planes)
       colour (black)
       %if viewing = 0 %start
           fill (0, 0, 1023, 511)
       %else
           fill (0, 511, 1023, 1023)
       %finish
       colour (current colour)
       enable  (current enable)
       %return

SW(4): ! Move
       Xpos = X;   Ypos = Y
       Ypos = Ypos + Yoffset %if Viewing > 0
       %return

SW(5): ! Line
       Y = Y + Yoffset %if Viewing > 0
       %if Shade mode = 2 %start
           Plot (x, y)
       %else %if Shade mode = 3
           Add point (x, y)
       %else
           LINE (Xpos, Ypos, X, Y)
       %finish
       Xpos = X;   Ypos = Y
       %return

SW(6): ! Char
       %if Xpos < 1023-tcs %start
           TEXT AT (Xpos, Ypos)
           SHOW SYMBOL (X)
       %finish
       Xpos = Xpos + tcs
       %return

SW(7): ! Attribute
       %if x=0 %start; ! Colour
           Y = 1 %unless 0<=Y<=8
           current colour = cols(y)
           current enable = cursor plane %if current colour = cursor plane
           %if Y#0 %start
               %if enable mode < 0 %start
                   ! and mode 
               %else %if enable mode = 0
                   enable (cursor plane) %if current colour = cursor plane
                   ! overwrite mode
               %else
                   ! or mode
                   enable (cols(y))
                   current enable = cols(y)
               %finish
           %finish
           colour (cols(y))
       %finish %else %if X=9 %start; ! Colour mode
           %if Y = 0 %start
               enable mode = 0                       { overwrite
               current enable = 7
           %else %if Y = 1                           { pseudo and
               current enable = (\current enable) & 7
               enable mode = -1
           %else %if Y = 2                           { OR
               current enable =  current colour
               enable mode = 1
           %else %if Y = 3                           { Cursor mode
               current enable = cursor plane
               enable mode = 0
           %finish
           enable (current enable)
       %else %if X=10; ! Shading
           shading <- Y
       %finish
       %return

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

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

SW(10): ! Shade mode
        Shade mode = X
        Close Polygon %if X#3 %and NE#0
        %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.
        WY = WY + Yoffset %if Viewing > 0
        Y = Y + Yoffset %if viewing > 0
        fill (wx, wy, x, y)
        %return

sw(14): ! Circle
        %if shading = 0 %start
            ring (xpos, ypos, x)
        %else
            disc (xpos, ypos, x)
        %finish
        %return

sw(*): ! Anything else ignored
%end

%own %short first = 0

%routine Initialise Mouse
   %on 0 %start
       %signal 14, 8
   %finish

   first = 1
   Mouse x = 0
   Mouse y = 0
%end

%external %routine F SAM %alias "EDWIN___F_SAM" (%integer %name S, X, Y)
   Initialise Mouse %if First = 0
   X = Mouse X >> 1
   Y = Mouse Y >> 1
   S = Mouse Buttons & 7
%end
 
%routine draw cross(%integer i,j)
  %constant %integer xsize = 10,ysize = 10
 
  %if xsize < i < 1023-xsize %then line(i-xsize,j,i+xsize,j) %else %start
    %if i <= xsize %start
      line(0,j,i+xsize,j)
      line(1023,j,1023-xsize+i,j)
    %else
      line(i-xsize,j,1023,j)
      line(0,j,i+xsize-1023,j)
    %finish
  %finish
  %if ysize < j < 1023-ysize %then line(i,j-ysize,i,j+ysize) %else %start
    %if j <= ysize %start
      line(i,0,i,ysize+j)
      line(i,1023,i,1023-ysize+j)
    %else
      line(i,j-ysize,i,1023)
      line(i,0,i,j+ysize-1023)
    %finish
  %finish
%end

%external %routine REQUEST %alias "EDWIN___F_REQ" (%integer %name but,x,y)
  %own %integer oldx=0,oldy=0
  %integer buts,i,j,lag,olb, oi, oj

  Initialise Mouse %if First = 0
  buts = Mouse buttons & 7
  colour (8)
  enable (8)
  draw cross (oldx, oldy)
  oi = Mouse x >> 1
  oj = Mouse y >> 1
  restart:
  %cycle
    %cycle
       i = Mouse x >> 1
       j = Mouse y >> 1
    %repeat %until i # oi %or j # oj %or buts # Mouse buttons & 7
    oi = i;   oj = j
    colour (Black)
    draw cross(oldx,oldy)
    colour (8)
    oldx = oi & 1023
    oldy = oj & 1023
    draw cross(oldx,oldy)
  %repeat %until Mouse buttons&7 # buts
  olb = Mouse buttons & 7
  lag = cputime
  %cycle
  %repeat %until lag + mouse delay < cputime { give Mouse buttons time}
  -> restart %if olb # Mouse buttons&7
  but = Mouse buttons & 7
  x = oldx
  y = oldy
  colour (Black)
  fill (0, 0, 1023, 1023)
  enable (current enable)
  colour (current colour)
%end

%external %routine f box %alias "EDWIN___F_BOX" (%integer %name xl, yb, xr, yt)
   %integer buts, lag, olb, B, X, Y, OX, OY, xld, ybd, ytd, xrd, I, LX, LY, LB
   %const %integer left=1, centre=2, right=4

   Initialise Mouse %if First = 0
   %cycle;   %repeat %until Mouse BUTTONS&7=0
   enable (8)
   B = 50;   OX = 340;   OY = 255
   LX = -1;   LY = -1;   LB = B
   xl = ox - B;   xld = xl;   xld = 0 %if xld < 0
   xr = ox + B;   xrd = xr;   xrd = 1023 %if xrd > 1023
   yb = oy - B;   ybd = yb;   ybd = 0 %if ybd < 0
   yt = oy + B;   ytd = yt;   ytd = 1023 %if ytd > 1023
   Colour (8) { Draw new box }
   Line (xld, ybd, xrd, ybd)
   Line (xrd, ybd, xrd, ytd)
   Line (xrd, ytd, xld, ytd)
   Line (xld, ytd, xld, ybd)
   %cycle
      %cycle
         %for I = 1, 1, 1000 %cycle; %repeat         
         ox = Mouse x >> 1
         oy = Mouse y >> 1
         buts = Mouse buttons & 7
      %repeat %until buts # 0 %or ox#lx %or oy#ly
      %exit %if buts & centre # 0
      B = B+1 %if buts & right # 0 %and B<800
      B = B-1 %if buts & left # 0 %and B>2
      lx = ox;   ly = oy;   lb = b
      colour (Black) { Clear old box }
      Line (xld, ybd, xrd, ybd)
      Line (xrd, ybd, xrd, ytd)
      Line (xrd, ytd, xld, ytd)
      Line (xld, ytd, xld, ybd)
      xl = ox - B;   xld = xl;   xld = 0 %if xld < 0
      xr = ox + B;   xrd = xr;   xrd = 1023 %if xrd > 1023
      yb = oy - B;   ybd = yb;   ybd = 0 %if ybd < 0
      yt = oy + B;   ytd = yt;   ytd = 1023 %if ytd > 1023
      Colour (8) { Draw new box }
      Line (xld, ybd, xrd, ybd)
      Line (xrd, ybd, xrd, ytd)
      Line (xrd, ytd, xld, ytd)
      Line (xld, ytd, xld, ybd)
   %repeat
   %cycle;   %repeat %until Mouse buttons&7=0
   colour (Black)
   fill (0, 0, 1023, 1023)
   enable (current enable)
   colour (current colour)
%end

%external %routine display %alias "EDWIN_LEVEL_1_DISPLAY" (%integer WHICH)
   %if WHICH = 0 %start
       OFFSET (0, 0)
   %else
       OFFSET (0, Yoffset)
   %finish
%end

%end %of %file