%endoflist
! 
! PR_1:GRAPH.INC - graphics routines, based on Level1:GraphInc.Imp
!
%const %integer Frame Addr = 16_E00000
@Frame Addr %integerarray Frame(0:32767)
@16_E20002 %short Origin Reg
@16_E20001 %byte Colour Reg
@16_E20000 %byte Enable Reg
@16_E30000 %integer %array Colour Map (0:255)

! MOUSE constants and locations
!
@16_7FFF0 %short MouseX
@16_7FFF2 %short MouseY
@16_7FFF4  %byte MouseButtons
@16_7FFF4  %byte MsButtons
%const %real Level 0 = 0, Level 1 = 1, Level 15 = 1.5, Level 2 = 2
%own %real APM Level = 1
%ownbyte Mouse Flag
%const %string (1) nls = "
"
%constinteger NO ECHO=1, NO TERMECHO=2, SINGLE=4, NO PAGE=8
@16_1140%routine SET TERMINAL MODE(%integer mode)
%system%routine%spec READ LINE(%string(*)%name s)
@16_10D4 %integerfn TestSymbol
!
! Values returned by MouseButtons
!
%const %byte MsNone = 248,
             MsL    = 249,
             MsM    = 250,
             MsLM   = 251,
             MsR    = 252,
             MsLR   = 253,
             MsMR   = 254,
             MsLMR  = 255
!
! Colour & Plane Constants
!
%const %byte Black = 0,
             Red = 1,
             Green = 2,
             Blue = 4,
             Yellow = Red + Green,
             Magenta = Red + Blue,
             Cyan = Blue + Green,
             White = Red + Blue + Green,
             Invert = 8,
             RGB Plane = 7

%own %integer Current Colour
%ownshort Hi Font
%ownbyte Font Append

%routine Wait (%integer MS)
%integer T
   T = MS + Cpu Time
   %cycle
   %repeat %until Cpu Time >= T
%end

! MOUSE FLAG = 1 %if there is a Mouse attached
!
%routine Check for Mouse
%byte Dummy
   %on 0 %start
      Mouse Flag = 0
      %return
   %finish
   Dummy = MouseButtons
   Mouse Flag =1
%end

!%routine Offset(%integer x,y)
!  Origin Reg <- x>>4&63+(y+511)<<6
!%end

%dynamic %routine %spec colour %alias "FRED_GRAPHICS_COLOUR" (%integer colour)

!%routine Set Colour(%integer C)
!  Current Colour = C
!  Colour Reg = Current Colour
!%end

%routine Disable (%integer Planes)
  Enable Reg = Planes!!255
%end

%routine Mix Colour (%byte Col, %integer Red, Green, Blue)
   Colour Map(Col)=Red+Green<<5+Blue<<10
%end

%routine Mix Image (%half %array %name CM (0:255), %byte C, %integer R, G, B)
   CM (C)=R+G<<5+B<<10
%end

%routine Mix and Set (%byte Col, %integer Red, Green, Blue)
   Colour Map(Col)=(Red&31)+(Green&31)<<5+(Blue&31)<<10
!   Current Colour = Col; Colour Reg = Current Colour
   Colour (Col)
%end

%routine Map Cycle (%integer C1, C2, Val, %half %array %name CM (0:255))
%integer i, T=C2-C1
   Colour Map ((i+C1)<<1+1)=CM((Rem(i+Val,T+1)+C1)<<1+1) %for i=0,1,T
%end

%dynamic %routine %spec vline %alias "FRED_GRAPHICS_VLINE" (%integer x, y0, y1)
%dynamic %routine %spec hline %alias "FRED_GRAPHICS_HLINE" (%integer x0, x1, y)
%dynamic %routine %spec clear %alias "FRED_GRAPHICS_CLEAR"
%dynamic %routine %spec half clear %alias "FRED_GRAPHICS_HCLEAR" (%integer h)
%dynamic %routine %spec line %alias "FRED_GRAPHICS_LINE" %c
                                                       (%integer x0, y0, x1, y1)
%dynamic %routine %spec fill %alias "FRED_GRAPHICS_FILL" %c
                                                       (%integer x0, y0, x1, y1)
%dynamic %routine %spec Circle %alias "FRED_GRAPHICS_DISC" (%integer x, y, r)
%dynamic %routine %spec Round %alias "FRED_GRAPHICS_RING" (%integer x, y, r)
%dynamic %routine %spec plot %alias "FRED_GRAPHICS_PLOT" (%integer x, y)
%dynamic %routine %spec triangle %alias "FRED_GRAPHICS_TRIANGLE" %c
                                               (%integer x0, y0, x1, y1, x2, y2)
%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; *clr d4
%end

!%dynamic %routine %spec trapeze %alias "FRED_GRAPHICS_TRAPEZE" %c
!                                           (%integer x00, x01, y0, x10, x11, y1)
%dynamic %routine %spec paint %alias "FRED_GRAPHICS_PAINT" %c
                     (%integer %name s, %integer x0, y0, x1, y1, offset, stride)
%dynamic %routine %spec poly %alias "FRED_GRAPHICS_POLY" (%integer x, y)
%dynamic %routine %spec closepoly %alias "FRED_GRAPHICS_CLOSEPOLY"

%dynamic %routine %spec offset %alias "FRED_GRAPHICS_OFFSET" (%integer x, y)
%dynamic %routine %spec enable %alias "FRED_GRAPHICS_ENABLE" (%integer planes)
%dynamic %routine %spec update colour map %alias "FRED_GRAPHICS_UPCMAP" %c
                                                 (%half %integer %name new map)
!%dynamic %routine %spec textat %alias "FRED_GRAPHICS_TEXTAT" (%integer x,y)
!%dynamic %routine %spec readfont %alias "FRED_GRAPHICS_READFONT" %c
!                                        (%string(255) file, %integer %name font)
!%dynamic %routine %spec showsymbol %alias "FRED_GRAPHICS_SHOWSYM" %c
!                                                                    (%integer k)
!%dynamic %routine %spec showstring %alias "FRED_GRAPHICS_SHOWSTR" %c
!                                                                (%string(255) s)
!%dynamic %routine %spec font %alias "FRED_GRAPHICS_FONT" (%integer f)

%routine VClear
   Print Symbol (27); Print Symbol (118)
%end

%routine Clear All
   VClear
   Clear
%end

%routine Clear and Set
  Clear
  Colour (Current Colour)
%end

! FONT handling routines
! 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

%integerarray Font(0:5999)

%const %string (255) Default Font = "Fmacs:Font.Visual"

%routine Read Font (%string (255) File)
%owninteger Index=128, Num Chars
%integer Char,Num,i,n,Min,Max

   %integer %fn Reverse (%integer N)
      *Move.l N,d0
      *Clr.l  d1
      *Move.w #31,d2
   L: *Roxr.l #1,d0
      *Roxl.l #1,d1
      *Dbra   d2,L
      *Move.l d1,N
      %result = N
   %end

   Open Input(3, File)
   %if Font Append = 0 %start
      Font(i) = 256 %for i=0,1,255
      Font(256) = 0; Font(257) = 0
      Index = 258; Hi Font = 0
   %finish %else Font Append = 0
   read(Min); read(Max); Num Chars = Max - Min
   %for char=0,1,Num Chars %cycle
      readsymbol(num) %until num=':'
      font(Hi 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
      index = index+num+1
   %repeat
   Hi Font = Hi Font + Num Chars + 1
   closeinput; selectinput(0)
%end

%routine Append Font (%string (255) File)
   Font Append = 1
   Read Font (File)
%end

%routine Read Default Font
   Read Font (Default Font)
%end

%owninteger xpos=0, ypos=0

%routine At(%integer x,y)
  xpos = x; ypos = y
%end

%routine Show Symbol (%integer k)
%integer q = Frame Addr + (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,d0
      *bgt loop
   *clr.l d4
%end

%routine Show Symbol2 (%integer k)
%integer p = addr(font(font(k&255)))+4
   Show Symbol (k)
   xpos = xpos-integer(p)
%end

%routine Show String (%string (255) s)
%integer i
  Show Symbol (Char No (s,i)) %for i = 1,1, Length (s)
%end

!%routine Show Number (%integer N)
!%external %real %fn %spec LOG TEN (%real x)
!%integer p10
!   Show Symbol ('0') %and %return %if N <= 0
!   %if N < 10 %then p10 = 1 %else p10 = 10 ^^ Int Pt (Log Ten (N))
!   %cycle
!      Show Symbol (N//p10 + '0')
!      N = Rem (n,p10)
!      p10 = p10//10
!   %repeat %until p10 = 0
!%end

%routine Set Up
%integer i
%integer z = 0
  %on 0 %start
    APM Level = 0
    Newline
    Print String ("Software requires a graphics system")
    Newlines (2)
    %stop
  %finish
  Offset (0,0)
  Disable (0)
  Hi Font = 0
  Font Append = 0
  Colour (White)
  %for i = 0, 8, 248 %cycle
     Colour Map (i) = z
     Colour Map (i+1) = 31
     Colour Map (i+2) = 31<<5
     Colour Map (i+3) = 31<<5+31
     Colour Map (i+4) = 31<<10
     Colour Map (i+5) = 31<<10+31
     Colour Map (i+6) = 31<<10+31<<5
     Colour Map (i+7) = 31<<10+31<<5+31
  %repeat
  Check for Mouse
  Set Terminal Mode (Nopage)
%end

%list
