%option "-low"
@16_E00000 %integerarray frame(0:32767)
@16_E20001 %byte colour reg
@16_E30000 %integer %array colour map(0:255)
@16_7F400 %short %integer mouse x
@16_7F402 %short %integer mouse y

%routine wait(%integer msec)
   msec = cputime + msec
   %while cputime <= msec %cycle
   %repeat
%end

%constant %integer mouse left=1, mouse middle=2, mouse right=4

%integerfn mouse buttons
%constinteger flip = mouseleft+mouseright, mask = flip+mousemiddle
@16_7F45B %byte %integer duartinp
%integer b
  b = duartinp>>1&mask
  %result = b %if b&flip=0 %or b&flip=flip
  %result = b!!flip
%end

%routine getbuttons(%bytename b,%integer msec)
%byte c
  %cycle
    b=mouse buttons
    wait(msec)
    c=mouse buttons
  %repeatuntil c=b
%end

%constbyte  msnone=0,
            msl=1,
            msm=2,
            mslm=3,
            msr=4,
            mslr=5,
            msmr=6,
            mslmr=7

@16_E20002 %short Origin Reg
@16_E20000 %byte Enable Reg

%const %real Level 0 = 0, Level 1 = 1, Level 15 = 1.5, Level 2 = 2
%own %real APM Level = 1
%ownbyte Mouse Flag
!
! 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


! 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 Set Colour(%integer C)
  Current Colour = C
  Colour Reg = Current Colour
%end

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

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

%routine Mix Image (%short %array %name CM (0:511), %integer C, R, G, B)
   CM (C<<1+1)=R+G<<5+B<<10
%end

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

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

%external %routine %spec vline %alias "FRED_GRAPHICS_VLINE" (%integer x, y0, y1)
%external %routine %spec hline %alias "FRED_GRAPHICS_HLINE" (%integer x0, x1, y)
%external %routine %spec clear %alias "FRED_GRAPHICS_CLEAR"
%external %routine %spec half clear %alias "FRED_GRAPHICS_HCLEAR" (%integer h)
%external %routine %spec line %alias "FRED_GRAPHICS_LINE" %c
                                                       (%integer x0, y0, x1, y1)
%external %routine %spec fill %alias "FRED_GRAPHICS_FILL" %c
                                                       (%integer x0, y0, x1, y1)
%external %routine %spec Circle %alias "FRED_GRAPHICS_DISC" (%integer x, y, r)
%external %routine %spec Round %alias "FRED_GRAPHICS_RING" (%integer x, y, r)
%external %routine %spec plot %alias "FRED_GRAPHICS_PLOT" (%integer x, y)
%external %routine %spec triangle %alias "FRED_GRAPHICS_TRIANGLE" %c
                                               (%integer x0, y0, x1, y1, x2, y2)
%external %routine %spec trapeze %alias "FRED_GRAPHICS_TRAPEZE" %c
                                           (%integer x00, x01, y0, x10, x11, y1)
%external %routine %spec paint %alias "FRED_GRAPHICS_PAINT" %c
                     (%integer %name s, %integer x0, y0, x1, y1, offset, stride)
%external %routine %spec poly %alias "FRED_GRAPHICS_POLY" (%integer x, y)
%external %routine %spec closepoly %alias "FRED_GRAPHICS_CLOSEPOLY"

%dynamic %routine %spec offset %alias "FRED_GRAPHICS_OFFSET" (%integer x, y)
%dynamic %routine %spec colour %alias "FRED_GRAPHICS_COLOUR" (%integer colour)
%dynamic %routine %spec enable %alias "FRED_GRAPHICS_ENABLE" (%integer planes)
%dynamic %routine %spec textat %alias "FRED_GRAPHICS_TEXTAT" (%integer x,y)
%dynamic %routine %spec read font %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)
%dynamic %volatile %integer %function %spec font height %alias "FRED_GRAPHICS_FONTHT"
%dynamic %volatile %integer %function %spec font depth %alias "FRED_GRAPHICS_FONTDP"
%dynamic %volatile %integer %function %spec max font width %c
                                             %alias "FRED_GRAPHICS_FONTWX"
%dynamic %volatile %integer %function %spec min font width %c
                                             %alias "FRED_GRAPHICS_FONTWN"
%dynamic %volatile %integer %function %spec string width %c
                        %alias "FRED_GRAPHICS_STRNGW" (%string(255) s)

%dynamic %volatile %integer %function %spec char height %c
                        %alias "FRED_GRAPHICS_CHARHT" (%integer c)
%dynamic %volatile %integer %function %spec char depth %c
                        %alias "FRED_GRAPHICS_CHARDP" (%integer c)
%dynamic %volatile %integer %function %spec char width %c
                        %alias "FRED_GRAPHICS_CHARWD" (%integer c)

%routine box(%integer x0,y0,x1,y1)
  line(x0,y0,x1,y0)
  line(x0,y0,x0,y1)
  line(x1,y0,x1,y1)
  line(x0,y1,x1,y1)
%end

%routine writenum(%integer num,x,y)
%string (255) str=""
%integer r
  textat(x,y)
  %if num<0 %start
    showsymbol('-')
    textat(x+charwidth('-'),y)
    num=|num|
  %finish
  %cycle
    r=rem(num,10)
    num=num//10
    str=tostring(r+48).str
  %repeatuntil num=0
  showstring(str)
%end

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

%routine Clear All
   VClear
   Clear
%end

%routine Clear and Set
  Clear
  Set 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"

%owninteger xpos=0, ypos=0

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

%routine Frame Message
   Newline; Print String ("WARNING : ");Newline
   Print String ("         This Program needs a Level 1.5 APM");Newline
   Print String ("which supports 32768 colours. You are using");Newline
   Print String ("a Level 1 APM with only 8 colours, so things");Newline
   Print String ("won't look quite the same. Try the machine in");Newline
   Print String ("the Fred Lab - the room with the prom blowers");Newline
   Newline
%end

%integerfn Whipped Cream
@16_7FFFF %byte Red Hot
@16_7FFFC %byte Who am I
@16_0372E %short Minutely
%constinteger Fish = 5
  Minutely = 0
  %cycle; %repeat %until Who am I & 8 # 0
  Red Hot = Fish
  %cycle; %repeat %until Who am I & 8 # 0
  %cycle
     %result = Minutely %unless Minutely = 0
  %repeat
%end

%routine Set Up
%integer i
%integer z = 0
  %on 0 %start
    APM Level = 0
    Newline
    Print String ("You'll find that the graphics routines don't work very well")
    Newline
    Print String ("unless your APM has a graphics monitor!")
    Newlines (2)
    %stop
  %finish
  Offset (0,0)
  Disable (0)
  Hi Font = 0
  Font Append = 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
  Check for Mouse
  %return %if APM Level # 1
  APM Level = 1.5 %if Whipped Cream = 16_37 %or Whipped Cream = 16_12 %c
                  %or Whipped Cream = 16_22 %or Whipped Cream = 16_20
%end

%end %of %file