! FRAME: Basic routines for framestore Mk III
! RWT Feb 1983 revised July 83
%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)
  %for i = 0, 32, 480 %cycle
     colour map(1+i) = z
     colour map(3+i) = 31
     colour map(5+i) = 31<<5
     colour map(7+i) = 31<<5+31
     colour map(9+i) = 31<<10
     colour map(11+i) = 31<<10+31
     colour map(13+i) = 31<<10+31<<5
     colour map(15+i) = 31<<10+31<<5+31
     colour map(17+i) = 31<<10+31<<5+31
     colour map(19+i) = 31<<10+31<<5
     colour map(21+i) = 31<<10+31
     colour map(23+i) = 31<<10
     colour map(25+i) = 31<<5+31
     colour map(27+i) = 31<<5
     colour map(29+i) = 31
     colour map(31+i) = z
  %repeat
%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
%routine lclear
! fsbase   set     $C00000
! fspwrten set     fsbase+$20000     bits 0-3 of byte
! fscolour set     fsbase+$20001     bits 0-3 of byte
! fsorigin set     fsbase+$20002     X bits 0-5, Y bits 6-15
!
! clear    move.w  #$FF00,fspwrten
!          movem.l d4-d7/a4-a6,-(sp)
!          movem.l cleardat,d0-d7/a0-a6
! fsclrlp  movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a5,-(a6)
!          movem.l d0-d6/a0-a3,-(a6)
!          dbra    d7,fsclrlp
!          movem.l (sp)+,d4-d7/a4-a6
!          rts
! cleardat dc.l    -1,-1,-1,-1,-1,-1,-1,$FF,-1,-1,-1,-1,-1,-1,fsbase+$20000
*=16_33FC;*=16_FF00;*=16_00C2;*=16_0000;
*=16_48E7;*=16_0F0E;*=16_4CFA;*=16_7FFF;
*=16_0034;*=16_48E6;*=16_FEFC;*=16_48E6;
*=16_FEFC;*=16_48E6;*=16_FEFC;*=16_48E6;
*=16_FEFC;*=16_48E6;*=16_FEFC;*=16_48E6;
*=16_FEFC;*=16_48E6;*=16_FEFC;*=16_48E6;
*=16_FEFC;*=16_48E6;*=16_FEFC;*=16_48E6;
*=16_FEF0;*=16_51CF;*=16_FFD6;*=16_4CDF;
*=16_70F0;*=16_4E75;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_0000;*=16_00FF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_00C2;*=16_0000;
%end
  lclear
  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 e, s, da, db, dda, ddb, oda, odb, odda, oddb
   e = 1
   s = 0
   %cycle
      e = e<<1
      s = s+1
   %repeat %until e>r
   s = s+1
   da = r<<s
   dda = r
   db = 0
   ddb = -1
   %cycle
      odda = dda
      oddb = ddb+1
      oda = dda<<s-e
      %cycle
         odb = db
         db = db+da>>s
         da = da-odb>>s
      %repeat %until da<oda
      dda = da>>s
      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 ddb>=dda
%end

%routine round(%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
   %exit %if ddb>=dda
      line(x+oddb,y+odda,x+ddb,y+dda)
      line(x+odda,y+oddb,x+dda,y+ddb)
      line(x+odda,y-oddb,x+dda,y-ddb)
      line(x+oddb,y-odda,x+ddb,y-dda)
      line(x-oddb,y-odda,x-ddb,y-dda)
      line(x-odda,y-oddb,x-dda,y-ddb)
      line(x-odda,y+oddb,x-dda,y+ddb)
      line(x-oddb,y+odda,x-ddb,y+dda)
   %repeat
   line(x+oddb,y+odda,x+odda,y+oddb)
   line(x+oddb,y-odda,x+odda,y-oddb)
   line(x-oddb,y-odda,x-odda,y-oddb)
   line(x-oddb,y+odda,x-odda,y+oddb)
%end

! Character stuff

%ownintegerarray font(0:4999)
! The layout of the array is as follows:
! For 0<=i<=255, let p(i)=j
! p(j) is height of character i
! p(j+1) is width of character i
! p(j+2) to p(j+p(j)+1) describe the character

{%external}%routine read font; ! Read in (one) font description
%integer char,index,num,i,n,min,max,height=0
  %integerfn reverse(%integer x)
    %integer n=0,y=16_80000000,c=16
    %cycle
      n = n+y %if x&1#0
      x = x>>1; y = y>>1; c = c-1
    %repeatuntil c=0
    %result=n
  %end
  openinput(3,"fmacs:font.visual")
  font(i) = 256 %for i=0,1,255; !Default: null character
  font(256) = 0; font(257) = 0; !This is the null character
  index = 258;                  !This is where the rest starts
  read(min); read(max)
  %for char=min,1,max %cycle
    readsymbol(num) %until num=':';  !Ignore character name
    font(char)=index
    read(num); font(index)=num; index=index+1
    read(font(index))
    %for i = num,-1,1 %cycle
      read(n); font(index+i) = reverse(n)
    %repeat
    height = num %if num>height;     !Note highest character
    index = index+num+1
  %repeat
  index = index-1
  closeinput; selectinput(0)
%end

%owninteger xpos=0, ypos=0

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

{%external}%routine showsymbol(%integer k)
%integer q = addr(frame(0))+(ypos&1023)<<7+(xpos&1023)>>4<<1
%integer shiftcount = xpos&15
%integer p = addr(font(font(k&255)))+4
%integer height = integer(p-4)
  xpos = xpos+integer(p)
  %returnif height=0
  *move.l p,a0
  *move.l q,a1
  *move.l height,d0
  *move.l (a0)+,d1;  !width
  *moveq #-128,d2
  *move.l shiftcount,d3
loop: *move.l (a0)+,d4
      *lsr.l d3,d4
      *move.l d4,(a1)
      *sub.l d2,a1
      *move.l a1,d1
      *=16_0881; *=17; !*bclr #17,d1
      *move.l d1,a1
      *subq #1,height
      *bgt loop
%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