! EDWIN driver for the Diana Colour Graphics protocol wrt. the Fred display

%external %integer %spec DEVICE
%external %integer %spec VIEWING

%include "fmacs:frame"
!%include "I:GRAPH.INC"
%include "polyfill"

%const %integer mouse delay = 40
%const %integer Di=5

! Screen information
%own %integer enable mode   = 0         { <0 and, 0 =overw, 1=or 2 =set }
%own %integer current enable = 7
%own %integer SX = 0
%own %integer SY = 0
%own %integer XL = 0
%const %integer xpixels = 688, ypixels = 512
%own %integer XR = xpixels;   !Right hand side of device window
%own %integer YB = 0
%own %integer YT = ypixels
%own %integer VIS = 0;     !0 if CVP inside VW

%external %routine FREDRICK %alias "ED__DI" (%integer COM, X, Y)
   %own %integer %array cols (0:7) = black, white, blue, green,
                                     red, magenta, yellow, cyan
   %own %integer WX, WY
   %integer i
   %switch SW (0:15)

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

   %routine triangle(%integer a,b,c,d,e)
     *move.l e,a0
     *move.l (a0),d4
     *move.l 4(a0),d5
     *jsr 16_1178
     *move.l #255,d5
   %end

   %routine circle(%integer x, y, r)
      %integer d, e, s, da, db, dda, ddb, oda, odb, odda, oddb
      e = 1
      s = 0
      %while e<r %cycle
         e = e<<1
         s = s+1
      %repeat
      d = e>>1
      da = r<<s-d
      dda = r
      db = d
      ddb = 0
      %cycle
         odda = dda
         oddb = ddb
         %cycle
            odb = db
            db = db+da>>s
            da = da-odb>>s
            dda = da>>s
         %repeat %until odda#dda
         ddb = db>>s
         line(x-ddb,y+odda,x+ddb,y+odda)
         fill(x-odda,y+oddb,x+odda,y+ddb)
         fill(x-odda,y-oddb,x+odda,y-ddb)
         line(x-ddb,y-odda,x+ddb,y-odda)
      %repeat %until db>=da
   %end

   %return %if device # di
   %return %unless 0<=COM<=15
   -> SW(COM)

SW(0): ! Initialise
       set up
       %return

SW(1): ! Terminate
       %return

SW(2): ! Update
       %return

SW(3): ! Newframe
       enable reg = 15
       current enable = 7
       set colour (black)
       fill (0, 0, 1023, 1023)
       set colour (current colour)
       enable reg = 7
       enable mode = 0
       %return

SW(4): ! Move
       SX = X;   SY = Y
       %return

SW(5): ! Line
       LINE (SX, SY, X, Y)
       SX = X;   SY = Y
       %return

SW(6): ! Char
       %signal 14, 14 { which sends it back as a software character }

SW(7): ! Attribute
       %if x=0 %start; ! Colour
           Y = 1 %unless 0<=Y<=7
           current colour = cols(y)
           %if enable mode < 0 %start
               ! and mode
           %else %if enable mode = 0
               ! overwrite mode
           %else %if enable mode = 1
               ! or mode
               enable reg = cols(y)
               current enable = cols(y)
           %else
               ! set plane mode
           %finish
           set colour (cols(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): ! Ignored
        %return
SW(11): ! and/or/planes......
        %if X = 0 %start
          enable mode = 0
          enable reg = 7;            ! overwrite
          current enable = 7
        %else %if x = 1             { pseudo and
          current enable = (\current enable) & 7
          enable reg = current enable
          enable mode = -1
        %else %if x = 2             { OR
          current enable =  current colour
          enable reg = current enable
          enable mode = 1
        %else %if x = 3 %and 0<=y<= 7           { ! enable reg
          enable reg = cols(Y)
          current enable = cols(Y)
          enable mode = 2
        %finish
        %return

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.
        fill (wx, wy, x, y)
        %return

sw(14): ! Circle
        circle (sx, sy, x)
        %return

sw(15): ! Area fill
!   fredrick (4, integer (y), integer(y+4))
!   fredrick (5, integer (y+(i-1)*4), integer (y+(i-1)*4+4)) %for I = 3, 2, 2*X-1
!   fredrick (5, integer (y), integer(y+4))
         poly fill (x, y)
!         %for com = 1, 1, x*2 %cycle
!              write (integer(y), 1)
!              y = y + 4
!         %repeat
!         newline

%end

%short %integer %spec (16_7FFF0) X coord
%short %integer %spec (16_7FFF2) Y coord
%byte  %integer %spec (16_7FFF4) buttons

%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 fcursor %alias "ED__DI_CUR" (%integer %name but,x,y)
  %own %integer first = 0,oldx=0,oldy=0
  %integer buts,i,j,lag,olb, oi, oj

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

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

%external %routine fcursor area %alias "ED__DI_CUR_AREA" (%integer %name xl, yb, xr, yt)
   %integer buts, lag, olb, B, X, Y, OX, OY, xld, ybd, ytd, xrd
   %const %integer left=1, centre=2, right=4

   F Cursor (B, OX, OY)
   %cycle;   %repeat %until BUTTONS&7=0
   enable reg = 8
   xl = ox - 50;   xld = xl;   xld = 0 %if xld < 0
   xr = ox + 50;   xrd = xr;   xrd = 1023 %if xrd > 1023
   yb = oy - 50;   ybd = yb;   ybd = 0 %if ybd < 0
   yt = oy + 50;   ytd = yt;   ytd = 1023 %if ytd > 1023
   SetColour(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 b = 1, 1, 1000 %cycle; %repeat
         buts = buttons & 7
      %repeat %until buts # 0
      %exit %if buts & centre # 0
      B = 1 %if buts & right # 0
      B = -1 %if buts & left # 0
      %unless B=-1 %and ( xr-xl<5 %and yt-yb<5) %start
         set colour(0) { Clear old box }
         Line (xld, ybd, xrd, ybd)
         Line (xrd, ybd, xrd, ytd)
         Line (xrd, ytd, xld, ytd)
         Line (xld, ytd, xld, ybd)
         xl = xl - b;   xld = xl;   xld = 0 %if xld < 0
         xr = xr + b;   xrd = xr;   xrd = 1023 %if xrd > 1023
         yb = yb - b;   ybd = yb;   ybd = 0 %if ybd < 0
         yt = yt + b;   ytd = yt;   ytd = 1023 %if ytd > 1023
         SetColour(8) { Draw new box }
         Line (xld, ybd, xrd, ybd)
         Line (xrd, ybd, xrd, ytd)
         Line (xrd, ytd, xld, ytd)
         Line (xld, ytd, xld, ybd)
      %finish
   %repeat
   %cycle;   %repeat %until buttons&7=0
   set colour (0)
   fill (0, 0, 1023, 1023)
   enable reg = current enable
   set colour(current colour)
%end

%end %of %file