! FRAME: Basic routines for framestore Mk III
! RWT Feb 1983 revised July 83
! FDC changed font handling May 1984
%endoflist

@16_c00000 %integerarray frame(0:32767)
@16_c20002 %short origin reg
@16_c20001 %byte colour reg
@16_c20000 %byte enable reg
@16_c30000 %shortintegerarray colourmap(0:511)

%constinteger black=0,red=1,green=2,blue=4
%constinteger yellow=red+green,magenta=red+blue,cyan=blue+green
%constinteger white=red+green+blue
%constinteger yfiddle=511
%owninteger currentcolour

{%external}%routine offset(%integer x,y)
! Set frame origin to screen coordinate x,y
! (Screen origin is bottom left)
  origin reg = x>>4&63+(y+yfiddle)<<6
%end

{%external}%routine set colour(%integer c)
  currentcolour = c
  colour reg = currentcolour
%end

{%external}%routine disable(%integer planes)
  enable reg = planes!!255
%end

{%external}%routine setup
%integer z = 0
%integer i
  currentcolour = white
  offset(0,0)
  disable(0)
  set colour(white)
  colour map(i) = z %for i = 1, 2, 511
  colour map(3) = 31
  colour map(5) = 31<<5
  colour map(7) = 31<<5+31
  colour map(9) = 31<<10
  colour map(11) = 31<<10+31
  colour map(13) = 31<<10+31<<5
  colour map(15) = 31<<10+31<<5+31
  colour map(17) = 31<<10+31<<5+31
  colour map(19) = 31<<10+31<<5
  colour map(21) = 31<<10+31
  colour map(23) = 31<<10
  colour map(25) = 31<<5+31
  colour map(27) = 31<<5
  colour map(29) = 31
%end

! Dot and line drawing routines

!{%external}%routinespec(16_11b4)plot(%integer x,y)
{%external}%routine plot(%integer x,y)
  frame((y&1023)<<5+(x&1023)>>5) = 1<<(31-x&31)
%end

@16_1170 %routine line(%integer x1,y1,x2,y2)
@16_11A4 %routine hline(%integer x1,x2,y)

! Area filling routines

@16_11A8 %routine fill(%integer x1,y1,x2,y2)

%routine clear
  @16_11AC %routine clear
  clear
  set colour(currentcolour)
!%integer x = currentcolour
!  set colour(black); fill(0,0,1023,1023)
!  set colour(x)
%end

%routine paint(%integer%name s, %record(*)%name ll, tr, %integer st, be)
  *move.l d5,-(sp)
  *move.l d0,d4
  *move.l d1,d5
  *move.l (a1)+,d0
  *move.l (a1),d1
  *move.l (a2)+,d2
  *move.l (a2),d3
  *move.l #16_11a0,a1
  *jsr    (a1)
  *move.l (sp)+,d5
%end

%routine triangle(%record(*)%name p1,p2,p3)
  *move.l d5,-(sp)
  *move.l (a0)+,d0
  *move.l (a0),d1
  *move.l (a1)+,d2
  *move.l (a1),d3
  *move.l (a2)+,d4
  *move.l (a2),d5
  *move.l #16_1178,a0
  *jsr (a0)
  *move.l (sp)+,d5
%end

%routine trapeze(%record(*)%name s1,s2)
  *move.l d5,-(sp)
  *move.l (a0)+,d0
  *move.l (a0)+,d1
  *move.l (a0),d2
  *move.l (a1)+,d3
  *move.l (a1)+,d4
  *move.l (a1),d5
  *move.l #16_1174,a0
  *jsr (a0)
  *move.l (sp)+,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

! Character stuff

%record %format font header fm (%short first, last,
                                %integer dimtab offset,
                                %integer %array raster offset(0:255))
%record %format font dimtab fm (%short HSize, VSize,
                                       HOffs, VOffs,
                                       HIncr, VIncr)
%record %format font raster fm (%short dimtab index,
                                %short %array raster(0:999999))

%own %record (font header fm) %name font header

%externalroutinespec CONNECT FILE(%string(255) f, %integer mode,
                                %integername start,len)
%routine read font
   %integer start, length

   connect file("font:visual", 0, start, length)
   font header == record(start)
%end

%owninteger xpos=0, ypos=0

{%external}%routine at(%integer x,y)
  xpos = x; ypos = y
%end

%routine showsymbol(%integer k)
   %integer ro = font header_raster offset(k - font header_first)
   %record (font raster fm) %name raster == record(addr(font header) + ro)
   %record (font dimtab fm) %name dimtab
   %integer x, y, source, dest, width, height, d, shift

   write(ro, 6); write(raster_dimtab index, 6)
   %return %if ro = 0
   dimtab == record(addr(font header) + font header_dimtab offset + %c
             sizeof(dimtab) * raster_dimtab index)
   x = xpos + dimtab_HOffs
   y = xpos + dimtab_VOffs
   xpos = xpos + dimtab_HIncr
   ypos = ypos + dimtab_VIncr
   source = addr(raster_raster(0))
   dest = addr(frame(0)) + (y&1023)<<7 + (x&1023)>>4 << 1
   shift = 16 - (x & 15)
   width = (dimtab_HSize + 15) >> 4
   d = dest - 1
   write(k, 6); write(dimtab_HSize, 6); write(dimtab_VSize, 6)
   write(dimtab_HOffs, 6); write(dimtab_VOffs, 6); write(dimtab_HIncr, 6)
   write(dimtab_VIncr, 6); newline
   %while width > 0 %cycle
      height = dimtab_VSize
      d = d + 1
      %while height > 0 %cycle
         integer(d) = (shortinteger(source) & 16_ffff) << shift
         d = d + 128
         d = d - 131072 %if d >= addr(frame(0)) + 131072
         height = height - 1
      %repeat
      width = width - 1
   %repeat
%end

%routine showstring(%string(255)s)
%integer i
  showsymbol(charno(s,i)) %for i=1,1,length(s)
%end

! Mouse stuff

%constinteger MouseLeft=1,MouseMiddle=2,MouseRight=4
@16_7FFF0 %short MouseX
@16_7FFF2 %short MouseY
@16_7FFF4 %byte  MouseButtons

%list
%endoffile

! SOME OLD PROCEDURES placed here to speed up compilations
%ownintegerarray left(0:31)
%ownintegerarray right(0:31)
%ownintegerarray bit(0:31)

  %for i=0,1,31 %cycle
    left(i) = (-1)>>i
    right(i) = (-1)<<(31-i)
    bit(i) = 1<<(31-i)
  %repeat
!{%external}%routine line(%integer x1,y1,x2,y2)
!  x1 = x1&1023; x2 = x2&1023; y1 = y1&1023; y2 = y2&1023
!%integer temp,dx=x2-x1
!  %if dx<0 %start
!    x1 = x1+dx; x2 = x2-dx; dx = -dx
!    temp = y1; y1 = y2; y2 = temp
!  %finish
!%integer p = addr(frame(y1<<5+x1>>5)), b = bit(x1&31)
!%integer one=1,s=128,dy = y2-y1
!  %if dy<0 %start
!    dy = -dy; s = -128; one = -1
!  %finish
!%integer k=dx-dy
!  %if k<0 %start
!    k = dy>>1
!    %cycle
!      integer(p) = b; %exitif y1=y2; y1 = y1+one; p = p+s
!      k = k-dx
!      %if k<0 %start
!        k = k+dy; b = b>>1
!        b = 16_80000000 %and p = p+4 %if b=0
!      %finish
!    %repeat
!  %finishelsestart
!    k = dx>>1
!    %cycle
!      integer(p) = b; %exitif x1=x2; x1 = x1+1
!      b = b>>1; b = 16_80000000 %and p = p+4 %if b=0
!      k = k-dy; k = k+dx %and p = p+s %if k<0
!    %repeat
!  %finish
!%end

!%routinespec(16_11b0) vline(%integer x,y1,y2)
!  x1 = x1&1023; x2 = x2&1023; y = y&1023
!%integer dx = x2-x1
!  %if dx<0 %start
!    x1 = x1+dx; x2 = x2-dx; dx = -dx
!  %finish
!%integer p = addr(frame(y<<5+x1>>5)), b = left(x1&31)
!%integer q = addr(frame(y<<5+x2>>5)), c = right(x2&31)
!  %if p=q %start
!    integer(p) = b&c
!  %finishelsestart
!    integer(p) = b; p = p+4; b = -1
!    %while p<q %cycle
!      integer(p) = b; p = p+4
!    %repeat
!    integer(q) = c
!  %finish
!%end
!%routine fill(%integer x1,y1,x2,y2)
!%integer dy = y2-y1
!  %if dy<0 %start
!    y1 = y1+dy; y2 = y2-dy
!  %finish
!  hline(x1,x2,y1) %for y1 = y1,1,y2
!%end
!%routine trapeze(%record(*)%name a,b)
!%recordformat hlinef(%integer l,r,y)
!%record(hlinef)%name lo,hi
!  lo == a; hi == b
!  %if lo_y>hi_y %start
!    lo == b; hi == a
!  %finish
!%integer xl=lo_l, xr=lo_r, yb=lo_y, yt=hi_y
!%integer dxl=hi_l-xl, dxr=hi_r-xr, dy=yt-yb
!%integer kl=dy>>1, kr=kl, onel=1, oner=1
!  onel = -1 %and dxl = -dxl %if dxl<0
!  oner = -1 %and dxr = -dxr %if dxr<0
!  %cycle
!    hline(xl,xr,yb); %exitif yb=yt; yb = yb+1
!    kl = kl-dxl
!    kl = kl+dy %and xl = xl+onel %while kl<0
!    kr = kr-dxr
!    kr = kr+dy %and xr = xr+oner %while kr<0
!  %repeat
!%end

!%routine triangle(%record(*)%name a,b,c)
!%recordformat pf(%integer x,y)
!%recordformat hf(%integer l,r,y)
!%record(hf)low,mid,hig
!%record(pf)%name p,q,r,lo,mi,hi
!  p == a; q == b; r == c
!  lo == p
!  lo == q %if lo_y>q_y
!  lo == r %if lo_y>r_y
!  hi == p
!  hi == q %if hi_y<=q_y
!  hi == r %if hi_y<=r_y
!  %signal 15 %if lo==hi
!  mi == p
!  mi == q %if lo==mi %or hi==mi
!  mi == r %if lo==mi %or hi==mi
!  low_l = lo_x; low_r = lo_x; low_y = lo_y
!  hig_l = hi_x; hig_r = hi_x; hig_y = hi_y
!  %if lo_y=mi_y %start
!    low_r = mi_x; trapeze(low,hig)
!  %finishelseif hi_y=mi_y %start
!    hig_r = mi_x; trapeze(low,hig)
!  %finishelsestart
!    mid_l = mi_x; mid_y = mi_y
!    mid_r = ((mi_y-lo_y)*(hi_x-lo_x))//(hi_y-lo_y)+lo_x
!    trapeze(low,mid); trapeze(mid,hig)
!  %finish
!%end