;     Fortran Friends 2018
; update log
;    grsett generalised to amy # colours                 08 Jul 2018
;
    TTL   gr_arcs
pc  RN    15
lr  RN    14
sp  RN    13
ip  RN    12
fp  RN    11
R3  RN     3
R2  RN     2
R1  RN     1
R0  RN     0
F3  FN     3
F2  FN     2
F1  FN     1
F0  FN     0
    AREA   |C$$code|,CODE,READONLY
    EXPORT GR_arcs         ;input (IXC,IYC,IR,A1,A2)
; ip points to extra args.
; output on stack (IXC,IYC) then points on circumference
; at angles A1,(A1+A2)/2, A2
GR_arcs
    LDFS   F0,[R3]         ;A1
    LDR    R3,[ip]
    LDFS   F1,[R3]         ;A2
    CMFE   F0,F1           ;check A1<A2
    SUFLTS F2,F1,F0
    LDFLTS F3,=6.28319
    CMFLT  F2,F3           ;check (A2-A1)<pi
    LDMGEDB fp,{fp,sp,pc}  ;return to Fortran if failed
    LDR    R0,[R0]         ;IXC
    LDR    R1,[R1]         ;IYC
    LDR    R2,[R2]         ;IR
    FLTS   F2,R2           ;R
    SINS   F3,F1           ;SIN(A2)
    FMLS   F3,F2,F3        ;R*SIN(A2)
    FIX    R3,F3
    ADD    R3,R3,R1        ;y
    COSS   F3,F1           ;COS(A2)
    FMLS   F3,F2,F3        ;R*COS(A2)
    FIX    R2,F3
    ADD    R2,R2,R0        ;x
    STMFD  sp!,{R2,R3}     ;store (A2) on stack
    ADFS   F1,F0,F1        ;A1+A2
    FMLS   F1,F1,#0.5      ;A3=(A1+A2)/2
    SINS   F3,F1           ;SIN(A3)
    FMLS   F3,F2,F3        ;R*SIN(A3)
    FIX    R3,F3
    ADD    R3,R3,R1        ;y
    COSS   F3,F1           ;COS(A3)
    FMLS   F3,F2,F3        ;R*COS(A3)
    FIX    R2,F3
    ADD    R2,R2,R0        ;x
    STMFD  sp!,{R2,R3}     ;store (A3) on stack
    SINS   F3,F0           ;SIN(A1)
    FMLS   F3,F2,F3        ;R*SIN(A1)
    FIX    R3,F3
    ADD    R3,R3,R1        ;y
    COSS   F3,F0           ;COS(A1)
    FMLS   F3,F2,F3        ;R*COS(A1)
    FIX    R2,F3
    ADD    R2,R2,R0        ;x
    STMFD  sp!,{R0-R3}     ;store (A1) and centre on stack
    MOV    pc,lr           ;return to calling routine
    END
;
    TTL    grarcc
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_Plot EQU &45
    AREA   |C$$code|,CODE,READONLY
    EXPORT grarcc_         ;(IXC,IYC,IR,A1,A2)
    IMPORT GR_arcs
    DCB    "grarcc_",0,8,0,0,255
grarcc_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    BL     GR_arcs         ;calculate arc ends
    LDMIA  sp!,{R1,R2}     ;get centre
    MOV    R0,#4
    SWI    OS_Plot         ;move to centre
    LDMIA  sp!,{R1,R2}     ;get first point
    MOV    R0,#4
    SWI    OS_Plot         ;move to first point
    ADD    sp,sp,#8
    LDMIA  sp!,{R1,R2}     ;get second point
    MOV    R0,#165
    SWI    OS_Plot         ;draw circular arc
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grchar
pc  RN     15
lr  RN     14
sp  RN    13
ip  RN    12
fp  RN    11
R2  RN     2
R1  RN     1
R0  RN     0
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grchar_         ;(ICH,IARRAY)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grchar_",0,8,0,0,255
grchar_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDRB   R0,[R0]          ;ICH
    CMP    R0,#32
    RSBGES R2,R0,#255
    LDMLTDB fp,{fp,sp,pc}   ;return if <32 or >255
    SWI    vdu+23          ;vdu23
    SWI    OS_WriteC       ;send to vdu
    MOV    R2,#8           ;8 bytes to send
ch1 LDRB   R0,[R1],#4      ;get byte
    SWI    OS_WriteC       ;send to vdu
    SUBS   R2,R2,#1
    BGT    ch1             ;loop over arguments
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grcirc
pc  RN     15
lr  RN     14
sp  RN    13
ip  RN    12
fp  RN    11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
IX  RN     1
IY  RN     2
OS_Plot EQU &45
    AREA   |C$$Code|,CODE,READONLY
    EXPORT grcirc_         ;(IX,IY,IR,FILL)
; plots circle at (IX,IY) radius IR, filled if FILL is true
    DCB    "grcirc_",0,8,0,0,255
grcirc_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,[R2]         ;save IR
    LDR    IY,[R1]         ;get IY
    LDR    IX,[R0]         ;get IX
    MOV    R0,#4           ;4 for MOVE
    SWI    OS_Plot         ;move to centre
    MOV    IX,#0           ;get zero in IX
    MOV    IY,ip           ;and IR in IY
    LDR    R3,[R3]         ;get fill
    TEQ    R3,#0           ;test it
    MOVNE  R0,#153         ;PLOT153 for filled circle
    MOVEQ  R0,#145         ;PLOT145 for outline
    SWI    OS_Plot         ;plot the circle
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grclrg
pc  RN     15
lr  RN     14
vdu EQU &100
    EXPORT grclrg_         ;clear graphics window (VDU16)
    AREA   |C$$Code|,CODE,READONLY
grclrg_
    SWI    vdu+16
    MOV    pc,lr           ;return
    END
;
    TTL    grclrt
pc  RN     15
lr  RN     14
vdu EQU &100
    EXPORT grclrt_         ;clear text window (VDU12)
    AREA   |C$$Code|,CODE,READONLY
grclrt_
    SWI    vdu+12
    MOV    pc,lr           ;return
    END
;
    TTL    grcmv
pc  RN     15
lr  RN     14
sp  RN    13
ip  RN    12
fp  RN    11
R0  RN     0
R1  RN     1
R2  RN     2
OS_CheckModeValid EQU &3F
    EXPORT grcmv_          ;(MODE,NEWMOD) returns valid MODE
; MODE = mode requested
; NEWMODE = valid mode
;           -1 if unknown
;           -2 if not enough space
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grcmv_",0,0,8,0,0,255
grcmv_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;get 'MODE'
    MOV    R2,R1           ;save address of NEWMODE
    SWI    OS_CheckModeValid
    CMPCS  R1,#0
    MOVCS  R0,R1           ;set new mode
    STR    R0,[R2]         ;store NEWMODE
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grcopy
pc  RN     15
lr  RN     14
sp  RN    13
ip  RN    12
fp  RN    11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
IX  RN     1
IY  RN     2
OS_Plot EQU &45
    AREA   |C$$Code|,CODE,READONLY
    EXPORT grcopy_         ;(IX1,IY1,IX2,IY2,IX3,IY3)
    DCB    "grcopy_",0,8,0,0,255
grcopy_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,[R2]         ;save IX2
    LDR    IY,[R1]         ;get IY1
    LDR    IX,[R0]         ;get IX1
    MOV    R0,#4           ;4 for MOVE
    SWI    OS_Plot         ;move to bottom left
    MOV    IX,ip           ;get IX2
    LDR    IY,[R3]         ;get IY2
    MOV    R0,#4           ;4 for MOVE
    SWI    OS_Plot         ;move to top right
    LDMIB  fp,{R0,R1}      ;addresses of IX3,IY3
    LDR    IY,[R1]         ;get IY3
    LDR    IX,[R0]         ;get IX3
    MOV    R0,#190         ;4 for COPY
    SWI    OS_Plot         ;copy rectangle
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grcurs
pc  RN     15
lr  RN     14
sp  RN    13
ip  RN    12
fp  RN    11
R0  RN     0
OS_RestoreCursors EQU &37
OS_RemoveCursors EQU &36
    EXPORT grcurs_         ;(ISTAT)turn cursor on (ISTAT=TRUE) or off (FALSE)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grcurs_",0,8,0,0,255
grcurs_
    MOV    ip,sp
    STMDB  sp!,{R0,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]          ;get ISTAT
    TEQ    R0,#0
    SWINE  OS_RestoreCursors
    SWIEQ  OS_RemoveCursors
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grdefd
pc  RN     15
lr  RN     14
sp  RN    13
ip  RN    12
fp  RN    11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_Byte EQU 6
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grdefd_         ;(STRING)
; STRING contains 1's and 0's defining the line
; structure. If LEN(STRING).EQ.1 then sets default
; If LEN(STRING).GT.64 or there are characters other
; than ASCII 0 and 1, then nothing happens.
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grdefd_",0,8,0,0,255
grdefd_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    CMP    R1,#64
    LDMGTDB fp,{fp,sp,pc} ;return if LEN>64
    CMP    R1,#1           ;check for single character
    BNE    gd1
    MOV    R0,#163
    MOV    R1,#242
    MOV    R2,#0           ;default dot-dash pattern
    SWI    OS_Byte
    LDMDB  fp,{fp,sp,pc}   ;return
gd1 MOV    R3,R0           ;save address of STRING
    MOV    ip,R1           ;save LEN(STRING)
; now check string is legal
l1  LDRB   R2,[R0],#1
    CMP    R2,#"0"
    RSBGES R2,R2,#"1"
    LDMLTDB fp,{fp,sp,pc}; return if not '0' or '1'
    SUBS   R1,R1,#1
    BGT    l1              ;loop over bits
; OK, now define length
    MOV    R0,#163
    MOV    R1,#242
    MOV    R2,ip
    SWI    OS_Byte
; now send bit string
    SWI    vdu+23
    SWI    vdu+6
    MOV    R2,#8           ;count of bytes
l2  MOV    R1,#8           ;count of bits
    MOV    R0,#0           ;accumulator
l3  SUBS   ip,ip,#1        ;count total bits
    LDRGEB lr,[R3],#1
    SUBGE  lr,lr,#"0"      ;get bit
    ORRGE  R0,lr,R0,LSL#1  ;insert bit
    SUBGES R1,R1,#1
    BGT    l3
    MOV    R0,R0,LSL R1
    SWI    OS_WriteC       ;send byte
    SUBS   R2,R2,#1
    BGT    l2
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grdpol
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
sl  RN     10
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
R5  RN     5
R6  RN     6
Draw_Stroke   EQU &60704
Draw_Fill     EQU &60702
    AREA   |C$$code|,CODE,READONLY
    EXPORT grdpol_;(IXY,N,CLOSE,IFILL,IWID,IDASH)  plots a polygon, IXY(2,N)
;          closed if CLOSE=.TRUE. (1)
;          line width IWID,
;          fill colour IFILL (BBGGRR00 or -1 for no fill),
;          dashed lines if IDASH<>0
    IMPORT __rt_stkovf_split_big
    DCB    "grdpol_",0,8,0,0,255
grdpol_
    MOV    ip,sp
    STMDB  sp!,{R0-R6,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R1,[R1]         ;N
    CMP    R1,#2
    LDMCCDB fp,{R4-R6,fp,sp,pc} ;return if less than two points
    LDR    R2,[R2]         ;CLOSE
    ADC    R4,R1,R1,LSL#1  ;3*N + 1                             03/11/1999
    TST    R2,#1
    ADDNE  R4,R4,#1        ;3*N + 1 (+1 if CLOSE)               03/11/1999
    SUB    ip,sp,R4,LSL#2  ;stack address needed for path
    CMP    ip,sl           ;check there is room
    BLLT   __rt_stkovf_split_big;ask for more if necessary
    SUB    sp,sp,R4,LSL#2  ;reserve space
;          set up the path on the stack
    MOV    R4,sp
    MOV    R5,#2           ;'move' code
lp1 LDMIA  R0!,{ip,lr}     ;get X,Y
    MOV    ip,ip,LSL#8     ;convert to draw units
    MOV    lr,lr,LSL#8
    STMIA  R4!,{R5,ip,lr}  ;store code,X,Y
    SUBS   R1,R1,#1
    MOVGT  R5,#8           ;'draw' code
    BGT    lp1
    TST    R2,#1
    MOVNE  R5,#5
    STRNE  R5,[R4],#4      ;store 'close' code
    STR    R1,[R4],#4      ;store 'end' code
    LDR    ip,[R3]         ;fill
    MOV    R0,sp           ;pointer to path
    MOV    R1,R2,LSR#1     ;style (=CLOSE/2)               03/11/1999
    AND    R1,R1,#3        ;remove any stray extra bits    03/11/1999
    ORR    R1,R1,#&30      ;plot to middle of boundary     03/11/1999
    MOV    R2,#0           ;no transform
    MOV    R3,#0           ;no flatness
    CMP    ip,#0
    BNE    pt2
    LDMIB  fp,{R4,R6}      ;(IWID),(DASH)
    LDR    R4,[R4]         ;IWID
    MOVS   R4,R4 ; LSL#8 removed shift 23/07/2002
    EOREQ  R1,R1,#&28      ;change default style for zero width line 03/11/1999
    LDR    R6,[R6]         ;IDASH
    CMP    R6,#0
    BEQ    pt1
    MOV    R5,#4           ;set up dash pattern
lp2 MOV    ip,R6,LSL#8
    AND    ip,ip,#&FF00
    STR    ip,[sp,#-4]!
    MOV    R6,R6,LSR#8
    SUBS   R5,R5,#1
    BGT    lp2
    MOV    R6,#4
    STMFD  sp!,{R5,R6}
    MOV    R6,sp
pt1 LDR    R5,jptr
    SWI    Draw_Stroke
    LDMDB  fp,{R4-R6,fp,sp,pc} ;return
pt2 SWI    Draw_Fill
    LDMDB  fp,{R4-R6,fp,sp,pc} ;return after fill
    EXPORT grdtri_;(IEND,IWID,ILENG)
;              sets triangular cap ends
;              IEND=1 for beginning, =2 for end
;              anything else does nothing
;              IWID arrow width [1:127] of line width
;              ILENG arrow length [1:127] of line width
;              if IWID=ILENG=0, reset to square end
;              anything else makes ordinary square ends
;
    DCB    "grdtri_",0,8,0,0,255
grdtri_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]        ;IEND
    LDR    R1,[R1]        ;IWID
    LDR    R2,[R2]        ;ILENG
    CMP    R0,#0
    RSBHIS ip,R0,#3
    RSBHIS ip,R1,#128
    RSBHIS ip,R2,#128
    LDMLSDB fp,{R4,fp,sp,pc} ;return on error
    MOV    lr,R1,LSL#8    ;width
    ORR    lr,lr,R2,LSL#24;length
    LDR    ip,jptr
    CMP    R0,#1
    LDMIA  ip,{R0-R3}
    MOVLE  R2,lr
    MOVLE  R4,#&0300      ;triangle beginning cap
    MOVGT  R3,lr
    MOVGT  R4,#&030000    ;triangle endcap
    CMP    lr,#0
    ORRNE  R0,R0,R4
    BICEQ  R0,R0,R4
    STMIA  ip,{R0-R3}
    LDMDB  fp,{R4,fp,sp,pc} ;return
;
jptr DCD   join
    AREA   |C$$data|,DATA
join DCD   2               ;bevelled joins
    DCD    0,0,0
    END
;
    TTL    grdraw
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
IX  RN     1
IY  RN     2
OS_Plot EQU &45
    EXPORT grdraw_         ;(IX,IY) draws line to IX,IY
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grdraw_",0,8,0,0,255
grdraw_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    IY,[R1]         ;get IY
    LDR    IX,[R0]         ;get IX
    MOV    R0,#5           ;for plot5
    SWI    OS_Plot         ;draw line
    LDMDB  fp,{fp,sp,pc} ;return
    END
;
    TTL    grelip
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
F0  FN     0
F1  FN     1
F2  FN     2
F3  FN     3
OS_Plot EQU &45
    AREA   |C$$Code|,CODE,READONLY
    EXPORT grelip_         ;(IXC,IYC,IA,IB,PHI,FILL)
; draws ellipse with centre (IXC,IYC), semi-axes IA,IB
; angle PHI to x-axis (Radians). FILL = .TRUE. or .FALSE.
    DCB    "grelip_",0,8,0,0,255
grelip_
    MOV    ip,sp
    STMDB  sp!,{R0-R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDMIA  ip,{R4,ip}      ;addresses of PHI and FILL
    LDFS   F1,[R4]         ;PHI
    COSS   F0,F1           ;COS(PHI)
    SINS   F1,F1           ;SIN(PHI)
    LDR    R4,[R2]         ;IA
    LDR    R2,[R1]         ;IYC
    LDR    R1,[R0]         ;IXC
    MOV    R0,#4
    SWI    OS_Plot         ;MOVE to IXC,IYC
    MUL    R0,R4,R4        ;IA**2
    LDR    R3,[R3]         ;IB
    MUL    R1,R3,R3        ;IB**2
    SUB    R0,R0,R1
    FLTS   F2,R0           ;A**2-B**2
    FMLS   F2,F1,F2        ;(A**2-B**2)*SIN(PHI)
    FMLS   F3,F1,F2        ;(A**2-B**2)*SIN**2(PHI)
    FMLS   F2,F0,F2        ;(A**2-B**2)*SIN(PHI)*COS(PHI)
    FLTS   F0,R1           ;B**2
    ADFS   F3,F3,F0        ;(A*SIN(PHI))**2+(B*COS(PHI))**2
    SQTS   F3,F3           ;maxy=SQRT((A*SIN(PHI))**2+(B*COS(PHI))**2)
    FDVS   F2,F2,F3        ;shearx
    MUL    R3,R4,R3        ;IA*IB
    FLTS   F0,R3           ;A*B
    FDVS   F0,F0,F3        ;slicewidth
    FIX    R1,F0
    FIX    R2,F3
    MOV    R0,#0
    MOV    R3,R1           ;save slicewidth
    SWI    OS_Plot         ;MOVE to slicewidth, maxy
    MOV    R2,#0           ;keep y the same
    FIX    R1,F2
    SUB    R1,R1,R3        ;subtract slicewidth
    LDR    ip,[ip]         ;FILL
    CMP    ip,#0
    MOVEQ  R0,#193         ;prepare for outline ellipse
    MOVNE  R0,#201         ;prepare for filled ellipse
    SWI    OS_Plot         ;plot ellipse
    LDMDB  fp,{R4,fp,sp,pc} ;return
    END
;
    TTL    grfill
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
IX  RN     1
IY  RN     2
R0  RN     0
R1  RN     1
OS_Plot EQU &45
    EXPORT grfilb_         ;(IX,IY)  fills an area around IX,IY to non-backgroun
    EXPORT grfilf_         ;(IX,IY)  fills an area around IX,IY to foreground
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grfilb_",0,8,0,0,255
grfilb_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    IY,[R1]         ;get IY
    LDR    IX,[R0]         ;get IX
    MOV    R0,#133         ;for plot133
    SWI    OS_Plot         ;plot point
    LDMDB  fp,{fp,sp,pc}   ;return
;
    DCB    "grfilf_",0,8,0,0,255
grfilf_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    IY,[R1]         ;get IY
    LDR    IX,[R0]         ;get IX
    MOV    R0,#141         ;for plot141
    SWI    OS_Plot         ;plot point
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grgcol
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grgcol_         ;(IACT,ICOL)
; set current graphics colour in 2,4,16 colour modes
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grgcol_",0,8,0,0,255
grgcol_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+18
    LDR    R0,[R0]         ;get IACT
    SWI    OS_WriteC
    LDR    R0,[R1]         ;get ICOL
    SWI    OS_WriteC
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grgetc
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
R5  RN     5
R6  RN     6
R7  RN     7
OS_ReadModeVariable EQU &35
OS_ReadPoint EQU &32
OS_ReadPalette EQU &2F
    EXPORT grgetc_         ;(IX,IY,IR,IG,IB)
; get physical colour at (IX,IY), each colour in range [0:255]
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grgetc_",0,8,0,0,255
grgetc_
    MOV    ip,sp
    STMDB  sp!,{R0-R7,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;IX
    LDR    R1,[R1]         ;IY
    SWI    OS_ReadPoint    ;get colour
    CMP    R4,#0           ;check point is on screen\
    MOVLT  R5,#-1
    MOVLT  R6,#-1
    MOVLT  R7,#-1
    BLT    store
    MOV    ip,R2           ;save colour
    MOV    R0,#-1
    MOV    R1,#9
    SWI    OS_ReadModeVariable;get # bits/pixel
; now we have: R2 = # bits/pixel, R3 = tint, ip = colour
; get R,G,B into R5,R6,R7 in range [0:255]
    CMP    R2,#3
    BEQ    c256            ;256 colour mode
    BGT    m256            ;more than 256
    MOV    R0,ip           ;get colour from palette for less colours
    MOV    R1,#16
    SWI    OS_ReadPalette
    MOV    ip,R2,LSR#8     ;store as BBGGRR
m256
    CMP    R2,#4
    MOVEQ  R7,ip,LSR#7     ;blue in 16-bit mode
    ANDEQ  R7,R7,#&F8
    MOVEQ  R6,ip,LSR#2     ;green in 16-bit mode
    ANDEQ  R6,R6,#&F8
    MOVEQ  R5,ip,LSL#3     ;red in 16-bit mode
    ANDEQ  R5,R5,#&F8
    MOVNE  R7,ip,LSR#16    ;blue in 16-bit mode
    MOVNE  R6,ip,LSR#8     ;green in 32-bit mode
    ANDNE  R6,R6,#&FF
    ANDNE  R5,ip,#&FF      ;red in 32-bit mode
    B      store           ;done RISC_PC modes
c256; 256 colour mode (2bits colours + 2bits tint)
    MOV    R7,ip,LSR#4     ;blue in 256 colour mode
    MOV    R6,ip,LSR#2     ;green in 256 colour mode
    AND    R6,R6,#3
    AND    R5,ip,#3        ;red in 256 colour mode
    MOV    R3,R3,LSR#2
    ADD    R7,R3,R7,LSL#6  ;add tint to blue
    ADD    R6,R3,R6,LSL#6  ;add tint to green
    ADD    R5,R3,R5,LSL#6  ;add tint to red
store; store results
    LDMIB  sp,{R1-R3}
    STR    R5,[R2]         ;store IR
    STR    R6,[R3]         ;store IG
    LDR    R4,[fp,#4]
    STR    R7,[R4]         ;store IB
    LDMDB  fp,{R4-R7,fp,sp,pc} 
    END
;
    TTL    grgetl
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
OS_ReadPoint EQU &32
    EXPORT grgetl_         ;(IX,IY,LOGCOL)
; get logical colour in 2,4,16 colour modes
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grgetl_",0,8,0,0,255
grgetl_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;IX
    LDR    R1,[R1]         ;IY
    MOV    ip,R2           ;save address of LOGCOL
    SWI    OS_ReadPoint    ;get colour
    STR    R2,[ip]         ;store in LOGCOL
    LDMDB  fp,{R4,fp,sp,pc};return
    END
;
    TTL    grgetm
pc  RN     15
lr  RN     14
ip  RN     12
R0  RN     0
R2  RN     2
OS_Byte EQU 6
    EXPORT grgetm_         ;(MODE) get current mode (or mode selector pointer)
    AREA   |C$$Code|,CODE,READONLY
grgetm_
    MOV    ip,R0           ;save pointer to MODE
    MOV    R0,#135
    SWI    OS_Byte
    STR    R2,[ip]
    MOV    pc,lr
    END
;
    TTL    grgwin
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R3  RN     3
OS_WriteN EQU &46
vdu EQU &100
    EXPORT grgwin_         ;(IX1,IY1,IX2,IY2) set graphics window
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grgwin_",0,8,0,0,255
grgwin_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+24          ;vdu24
    MOV    R3,#4           ;4 words to send
    MOV    R1,#2           ;#bytes/word
gl  LDR    R0,[sp],#4      ;get argument address
    SWI    OS_WriteN       ;send to vdu
    SUBS   R3,R3,#1
    BGT    gl              ;loop over arguments
    LDMDB  fp,{fp,sp,pc};return
    END
;
    TTL    grhour
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
HourGlass_On EQU &406C0
HourGlass_Off EQU &406C1
HourGlass_Percentage EQU &406C4
    AREA   |C$$data|,DATA
GRhour_data DCD    0
    AREA   |C$$code|,CODE,READONLY
    EXPORT grhour_         ;(IGL)
    DCB    "grhour_",0,8,0,0,255
grhour_
    MOV    ip,sp
    STMDB  sp!,{R0,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;IGL
    LDR    R1,ptr
    LDR    R2,[R1]         ;get state
    CMP    R2,#0
    BEQ    ntn             ;not hourglass
    CMP    R0,#0
    BNE    gh1
    STR    R0,[R1]         ;flag for turned off
    SWI    HourGlass_Off
    LDMDB  fp,{fp,sp,pc};return
gh1 CMP    R0,#100
    SWILO  HourGlass_Percentage
    LDMDB  fp,{fp,sp,pc};return
ntn CMP    R0,#0
    LDMEQDB  fp,{fp,sp,pc};return can't turn off
    STR    R0,[R1]         ;flag for turned on
    SWI    HourGlass_On    ;turn on
    CMP    R0,#100
    SWILO  HourGlass_Percentage
    LDMDB  fp,{fp,sp,pc};return
ptr DCD    GRhour_data
    END
;
    TTL    grline
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
IX  RN     1
IY  RN     2
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_Plot EQU &45
    EXPORT grline_         ;(IX1,IY1,IX2,IY2) draws line between 1&2
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grline_",0,8,0,0,255
grline_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,[R2]          ;save IX2
    LDR    IY,[R1]         ;get IY1
    LDR    IX,[R0]         ;get IX1
    MOV    R0,#4           ;for plot5
    SWI    OS_Plot         ;move to point
    MOV    IX,ip           ;get IX2
    LDR    IY,[R3]         ;get IY2
    MOV    R0,#5           ;for plot5
    SWI    OS_Plot         ;draw line
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grmove
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
IX  RN     1
IY  RN     2
R0  RN     0
R1  RN     1
OS_Plot EQU &45
    EXPORT grmove_         ;(IX,IY) moves to IX,IY
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grmove_",0,8,0,0,255
grmove_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    IY,[R1]         ;get IY
    LDR    IX,[R0]         ;get IX
    MOV    R0,#4           ;for plot4
    SWI    OS_Plot         ;move to point
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grorig
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
OS_WriteN EQU &46
vdu EQU &100
    EXPORT grorig_         ;(IX,IY) moves graphics origin to IX,IY
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grorig_",0,8,0,0,255
grorig_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+29          ;vdu29
    MOV    R2,R1           ;save address of IY
    MOV    R1,#2           ;2 byte words
    SWI    OS_WriteN       ;send IX to vdu
    MOV    R0,R2
    SWI    OS_WriteN       ;send IY to vdu
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grpal
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grpal_          ;(LOGCOL,IRED,IBLUE,IGREEN)
; sets logical colour to RGB (each in the range 0 to 15) in 2,4 16 colour modes
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grpal_",0,0,8,0,0,255
grpal_
    MOV    ip,sp
    STMDB  sp!,{R0-R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+19          ;vdu19
    LDRB   R0,[R0]         ;LOGCOL
    AND    R0,R0,#15
    SWI    OS_WriteC       ;send to vdu
    SWI    vdu+16          ;16 means colours to follow
    LDRB   R0,[R1]         ;RED
    SWI    OS_WriteC       ;send to vdu
    LDRB   R0,[R2]         ;GREEN
    SWI    OS_WriteC       ;send to vdu
    LDRB   R0,[R3]         ;BLUE
    SWI    OS_WriteC       ;send to vdu
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grplot
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
OS_Plot EQU &45
    EXPORT grplot_         ;(IPL,IX,IY) standard plot command to IX,IY
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grplot_",0,8,0,0,255
grplot_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;for plot IPL
    LDR    R1,[R1]         ;get IX
    LDR    R2,[R2]         ;get IY
    SWI    OS_Plot         ;draw line
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grpointer
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
OS_Byte EQU  6
OS_Mouse EQU 28
OS_Word EQU  7
    AREA   |C$$data|,DATA
buf %    12
    AREA   |C$$code|,CODE,READONLY
    EXPORT grpbox_         ;(IX1,IY1,IX2,IY2)
    DCB    "grpbox_",0,8,0,0,255
grpbox_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;IX1
    LDR    R1,[R1]         ;IY1
    LDR    R2,[R2]         ;IX2
    LDR    R3,[R3]         ;IY2
    CMP    R2,R0           ;check IX2>IX1
    CMPGT  R3,R1           ;check IY2>IY1
    LDMLEDB  fp,{fp,sp,pc} ;return if not
    CMP    R2,#&8000
    CMPLT  R3,#&8000       ;check upper limit
    LDMGEDB  fp,{fp,sp,pc} ;return if failed
    LDR    ip,msk
    CMP    R0,ip,ASR#1
    CMPGE  R1,ip,ASR#1     ;check lower limits
    LDMLTDB fp,{fp,sp,pc} ;return if failed
    BIC    R0,R0,ip        ;mask IX1
    ORR    R0,R0,R1,LSL#16 ;add IY1
    BIC    R2,R2,ip        ;mask IX2
    ORR    R2,R2,R3,LSL#16 ;add IY2
    LDR    R1,ptr          ;address for OS_Word buffer
    STR    R0,[R1,#1]
    STR    R2,[R1,#5]
    MOV    R0,#21          ;OSWord 21,
    MOV    R2,#1
    STRB   R2,[R1]         ;,1
    SWI    OS_Word         ;set pointer box
    LDMDB  fp,{fp,sp,pc}   ;return
;
    EXPORT grpbut_         ;(IX,IY,IB)
    IMPORT _stop
    DCB    "grpbut_",0,8,0,0,255
grpbut_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
lp1 SWI    OS_Mouse        ;get mouse button
    CMP    R2,#0
    BNE    lp1             ;wait until no button pressed
    MOV    R0,#21
    MOV    R1,#9
    SWI    OS_Byte         ;flush mouse buffer
    MOV    R1,#0
    SWI    OS_Byte         ;flush keyboard buffer
lp2 SWI    OS_Mouse        ;get mouse button
    MOVS   R1,R2
    BNE    pt1
    MOV    R0,#129
    SWI    OS_Byte         ;check for keyboard press
    CMP    R2,#&FF
    BEQ    lp2             ;no keyboard
    CMP    R2,#&1B         ;check for <escape>
    BEQ    ded
pt1 MOV    ip,R1           ;button or keypress
pt2 LDR    R1,ptr
    MOV    R0,#21          ;OSWord 21,
    MOV    R2,#6
    STRB   R2,[R1]         ;,6
    SWI    OS_Word         ;read pointer position (not mouse!)
    LDR    R0,[R1,#1]      ;get coordinates
    MOV    R1,R0,ASR#16    ;IY
    MOV    R0,R0,LSL#16
    MOV    R0,R0,ASR#16    ;IX
    LDMFD  sp!,{R2-R3,lr}     ;restore arguments
    STR    R0,[R2]         ;->IX
    STR    R1,[R3]         ;->IY
    STR    ip,[lr]         ;->IB
    LDMDB  fp,{fp,sp,pc}   ;return
ded MOV    R1,#29
    ADR    R0,stp
    B      _stop
ptr DCD    buf+3
msk DCD    &FFFF0000
stp DCB    "<Escape> - program terminated",0,0,0
;
    EXPORT grpget_         ;(IX,IY,IB)
    DCB    "grpget_",0,8,0,0,255
grpget_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    OS_Mouse        ;get IB
    MOV    ip,R2           ;save it
    B      pt2             ;get pointer position etc.
;
    EXPORT grpput_         ;(IX,IY)
    DCB    "grpput_",0,8,0,0,255
grpput_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;IX
    LDR    R1,[R1]         ;IY
    LDR    R2,msk
    CMP    R0,R2,LSR#17
    CMPLE  R1,R2,LSR#17
    LDMGTDB fp,{fp,sp,pc}  ;too big, so return
    CMP    R0,R2,ASR#1
    CMPGE  R1,R2,ASR#1
    LDMLTDB fp,{fp,sp,pc}  ;too small, so return
    BIC    R0,R0,R2
    ORR    R0,R0,R1,LSL#16 ;make up word
    LDR    R1,ptr
    STR    R0,[R1,#1]
    MOV    R0,#21          ;OSWord 21,
    MOV    R2,#3
    STRB   R2,[R1]         ;,3
    SWI    OS_Word         ;set mouse position
    MOV    R2,#5
    STRB   R2,[R1]         ;,5
    SWI    OS_Word         ;set pointer position
    LDMDB  fp,{fp,sp,pc}   ;return
;
    EXPORT grpset_         ;(IS)
    DCB    "grpset_",0,8,0,0,255
grpset_
    MOV    ip,sp
    STMDB  sp!,{R0,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R1,[R0]         ;IS
    CMP    R1,#1
    MOVHI  R1,#&81
    MOV    R0,#106
    SWI    OS_Byte
    LDMDB  fp,{fp,sp,pc}   ;return
;
    EXPORT grpspd_         ;(ISPD)
    DCB    "grpspd_",0,8,0,0,255
grpspd_
    MOV    ip,sp
    STMDB  sp!,{R0,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]
    ADDS   R1,R0,#128
    RSBGES R1,R1,#255
    BGE    gp1
    MOV    R0,#161         ;outside range
    MOV    R1,#194
    SWI    OS_Byte         ;get configured value
    MOV    R0,R2
gp1 AND    R0,R0,#255
    ORR    R0,R0,R0,LSL#8
    LDR    R1,ptr
    STR    R0,[R1,#1]
    MOV    R0,#21          ;OSWord 21,
    MOV    R2,#2
    STRB   R2,[R1]         ;,2
    SWI    OS_Word         ;define mouse multiplier
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grpoly
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
IX  RN     1
IY  RN     2
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
R5  RN     5
R6  RN     6
R7  RN     7
OS_Plot EQU &45
    EXPORT grpoly_         ;(N,IX,IY,FILL) plots polygon
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grpoly_",0,8,0,0,255
grpoly_
    MOV    ip,sp
    STMDB  sp!,{R0-R7,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R3,[R3]         ;get fill
    LDR    ip,[R0]         ;get number of points
    SUBS   ip,ip,#1
    LDMLEDB fp,{R4-R7,fp,sp,pc} ;return if N <2
    MOV    R4,R1
    MOV    R5,R2
    LDR    IX,[R4],#4      ;get IX(1)
    LDR    IY,[R5],#4      ;get IY(1)
    TEQ    R3,#0
    MOVNE  R6,IX           ;save first point for fill procedure
    MOVNE  R7,IY
    MOV    R0,#4
    SWI    OS_Plot         ;move to point 1
    LDR    IX,[R4],#4      ;get IX(2)
    LDR    IY,[R5],#4      ;get IY(2)
    TEQ    R3,#0
    MOVNE  R0,#4           ;move or
    MOVEQ  R0,#5           ;draw
    SWI    OS_Plot         ;to next point
pl  SUBS   ip,ip,#1
    LDMLEDB fp,{R4-R7,fp,sp,pc} ;return
    LDR    IX,[R4],#4      ;get IX(I)
    LDR    IY,[R5],#4      ;get IY(I)
    TEQ    R3,#0
    MOVNE  R0,#85          ;triangle or
    MOVEQ  R0,#5           ;draw
    SWI    OS_Plot         ;to next point
    TEQ    R3,#0
    MOVNE  IX,R6           ;draw back to origin for triangle fill
    MOVNE  IY,R7
    MOVNE  R0,#5
    SWINE  OS_Plot         ;draw to point 1
    B      pl              ;loop over I = 3 to N
    END
;
    TTL    grrect
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
IX  RN     1
IY  RN     2
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
R5  RN     5
OS_Plot EQU &45
    EXPORT grrect_         ;(IX1,IY1,IX2,IY2,FILL) draws rectangle
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grrect_",0,8,0,0,255
grrect_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,R4-R5,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,[fp,#4]      ;address of fill
    LDR    ip,[ip]         ;fill
    LDR    lr,[R2]         ;get IX2
    LDR    R3,[R3]         ;get IY2
    LDR    IY,[R1]         ;get IY1
    LDR    IX,[R0]         ;get IX1
    MOV    R4,IX           ;save IX1
    MOV    R5,IY           ;save IY1
    MOV    R0,#4           ;for plot4
    SWI    OS_Plot         ;move to point
    TEQ    ip,#0           ;test for FALSE
    BEQ    gt1
    MOV    IX,lr           ;get IX2
    MOV    IY,R3           ;get IY2
    MOV    R0,#101         ;type 101 plots filled rectangle
    SWI    OS_Plot
    LDMDB  fp,{R4-R5,fp,sp,pc};return
gt1 MOV    IX,R4           ;get IX1
    MOV    IY,R3           ;get IY2
    MOV    R0,#5
    SWI    OS_Plot         ;draw to IX1,IY2
    MOV    IX,lr           ;get IX2
    MOV    IY,R3           ;get IY2
    MOV    R0,#5
    SWI    OS_Plot         ;draw to IX2,IY2
    MOV    IX,lr           ;get IX2
    MOV    IY,R5           ;get IY1
    MOV    R0,#5
    SWI    OS_Plot         ;draw to IX2,IY1
    MOV    IX,R4           ;get IX1
    MOV    IY,R5           ;get IY1
    MOV    R0,#5
    SWI    OS_Plot         ;draw to IX1,IY1
    LDMDB  fp,{R4-R5,fp,sp,pc};return
    END
;
    TTL    grrmv
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_ReadModeVariable EQU &35
    EXPORT grrmv_          ;(MODE,NVAR,IVAL) returns MODE variable
; NVAR defined on page 350 of Ref manual I. Set
; MODE = -1 for current mode
; IVAL is returned value (0 if error)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grrmv_",0,0,8,0,0,255
grrmv_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]         ;get 'MODE'
    LDR    R1,[R1]         ;get NVAR
    MOV    R3,R2           ;save return address
    SWI    OS_ReadModeVariable
    MOVVS  R2,#0           ;return 0 if illegal
    CMP    R1,#3
    BNE    fin
    CMP    R2,#63          ;correct 256 colour mode
    MOVEQ  R2,#255
    CMP    R2,#-1
    MOVEQ  R2,R2,LSR#8     ;correct 16M colour mode
fin STR    R2,[R3]         ;store IVAL
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grrvv
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_ReadVduVariables EQU &31
    EXPORT grrvv_          ;(NVAR,IVAL) Function returning Vdu variable NVAR
; defined on page 345 of Ref. Manual I
; IVAL is returned value (0 if error)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grrvv_",0,0,8,0,0,255
grrvv_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R2,[R0]         ;get NVAR
    LDR    R0,ipb          ;pointer to input block
    MOV    R3,#-1
    STMIA  R0,{R2,R3}      ;store NVAR,-1 in input block
    SWI    OS_ReadVduVariables
    LDMDB  fp,{fp,sp,pc}   ;return
ipb DCD    blk
    AREA   |C$$data|,DATA
blk %      8               ;space for input block
    END
;
    TTL    grsect
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_Plot EQU &45
    AREA   |C$$code|,CODE,READONLY
    EXPORT grsect_         ;(IXC,IYC,IR,A1,A2,FILL)
    IMPORT GR_arcs
    DCB    "grsect_",0,8,0,0,255
grsect_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    BL     GR_arcs         ;calculate arc ends
    MOV    lr,sp
    LDMIA  lr!,{R1,R2}     ;get centre
    MOV    R0,#4
    SWI    OS_Plot         ;move to centre
    LDMIA  lr,{R1,R2}      ;get first point
    MOV    R0,#4
    SWI    OS_Plot         ;move to first point
    ADD    R3,lr,#16
    LDMIA  R3,{R1,R2}      ;get second point
    MOV    R0,#165
    SWI    OS_Plot         ;draw circular arc
    LDMIA  lr,{R1,R2}      ;get first point
    MOV    R0,#5
    SWI    OS_Plot         ;draw chord to first point
    LDR    ip,[ip,#4]
    LDR    ip,[ip]         ;FILL
    CMP    ip,#0
    LDMNEIA R3,{R0,R1}     ;second point
    LDMNEIA lr!,{R2,R3}    ;first point
    ADDNE   R0,R0,R2
    ADDNE   R1,R1,R3       ;2x centre of chord
    LDMNEIA lr,{R2,R3}     ;centre of arc
    ADDNE   R0,R2,R0,ASR#1
    ADDNE   R1,R3,R1,ASR#1 ;2x centre of sector
    MOVNE   R2,R1,ASR#1
    MOVNE   R1,R0,ASR#1    ;centre of sector
    MOVNE   R0,#141
    SWINE   OS_Plot        ;flood fill to foreground
    LDMDB   fp,{fp,sp,pc}  ;return
    END
;
    TTL    grsegc
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_Plot EQU &45
    AREA   |C$$code|,CODE,READONLY
    EXPORT grsegc_         ;(IXC,IYC,IR,A1,A2,FILL)
    IMPORT GR_arcs
    DCB    "grsegc_",0,8,0,0,255
grsegc_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    BL     GR_arcs         ;calculate arc ends
    MOV    lr,sp
    LDMIA  lr!,{R1,R2}     ;get centre
    MOV    R0,#4
    SWI    OS_Plot         ;move to centre
    LDMIA  lr!,{R1,R2}     ;get first point
    MOV    R0,#5
    SWI    OS_Plot         ;draw to first point
    ADD    R3,lr,#8
    LDMIA  R3,{R1,R2}      ;get second point
    MOV    R0,#165
    SWI    OS_Plot         ;draw circular arc
    LDMIA  sp,{R1,R2}      ;get centre
    MOV    R0,#5
    SWI    OS_Plot         ;draw back to centre
    LDR    ip,[ip,#4]
    LDR    ip,[ip]         ;FILL
    CMP    ip,#0
    LDMNEIA sp,{R0,R1}     ;centre
    LDMNEIA lr,{R2,R3}     ;centre of arc
    ADDNE  R0,R0,R2
    ADDNE  R1,R1,R3        ;2x centre of radius
    MOVNE  R2,R1,ASR#1
    MOVNE  R1,R0,ASR#1     ;centre of radius
    MOVNE  R0,#141
    SWINE  OS_Plot         ;flood fill to foreground
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grsetc
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
XColourTrans_SetGCOL EQU &60743
    EXPORT grsetc_         ;(IACT,IRED,IGREEN,IBLUE)
; IACT = GCOL action (add 128 for background)
; IRED,IGREEN,IBLUE = colours (0:255)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grsetc_",0,8,0,0,255
grsetc_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDRB   R4,[R0]         ;Gcol action                   15/02/1997
    LDRB   R1,[R1]         ;red                           15/02/1997
    LDRB   R2,[R2]         ;green                         15/02/1997
    LDRB   R3,[R3]         ;blue                          15/02/1997
    MOV    R0,R3,LSL#24
    ORR    R0,R0,R2,LSL#16
    ORR    R0,R0,R1,LSL#8  ;'palette' word: &BBGGRR00
    AND    R3,R4,#&80      ;background flag
    AND    R4,R4,#&3F      ;gcol action
    SWI    XColourTrans_SetGCOL
    LDMDB  fp,{R4,fp,sp,pc};return
    END
;
    TTL    grsetm
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R1  RN     1
R0  RN     0
OS_WriteC EQU 0
vdu EQU &100
XOS_ScreenMode EQU &20065
    EXPORT grsetm_         ;(M) sets graphics mode
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grsetm_",0,8,0,0,255
grsetm_
    MOV    ip,sp
    STMDB  sp!,{R0,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R1,[R0]
    CMP    R1,#256
    BLT    gm1
    MOV    R0,#0
    SWI    XOS_ScreenMode  ;select with mode specifier
    LDMDB  fp,{fp,sp,pc}   ;return
gm1 SWI    vdu+22          ;22 is vdu code for setting mode
    MOV    R0,R1           ;M
    SWI    OS_WriteC       ;send it to vdu
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grsett
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
XColourTrans_SetTextColour EQU &60761
    EXPORT grsett_         ;(IRED,IGREEN,IBLUE)
; IRED,IGREEN,IBLUE = colours (0:255)
; add 256 to IRED for background
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grsett_",0,8,0,0,255
grsett_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDRB   R3,[R0,#1]      ;background flag
    MOV    R3,R3,LSL#7     ;move to bit 7
    LDRB   R0,[R0]         ;red
    LDRB   R1,[R1]         ;green 
    LDRB   R2,[R2]         ;blue
    MOV    R0,R0,LSL#8
    ORR    R0,R0,R1,LSL#16
    ORR    R0,R0,R2,LSL#24  ;'palette' word: &BBGGRR00
    SWI    XColourTrans_SetTextColour
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grspot
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
IX  RN     1
IY  RN     2
R0  RN     0
R1  RN     1
OS_Plot EQU &45
    EXPORT grspot_         ;(IX,IY) plots point in current graphics colour
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grspot_",0,8,0,0,255
grspot_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    IY,[R1]         ;get IY
    LDR    IX,[R0]         ;get IX
    MOV    R0,#69          ;for plot69
    SWI    OS_Plot         ;plot point
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grtab
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grtab_          ;(IX,IY) sets print tab position
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grtab_",0,0,8,0,0,255
grtab_
    MOV    ip,sp
    STMDB  sp!,{R0-R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+31
    LDR    R0,[R0]         ;get IX
    SWI    OS_WriteC
    LDR    R0,[R1]         ;get IY
    SWI    OS_WriteC
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grtcol
pc  RN     15
lr  RN     14
R0  RN     0
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grtcol_         ;(K) sets colour for text in 16 colour modes
    AREA   |C$$Code|,CODE,READONLY
grtcol_
    SWI    vdu+17          ;VDU 17
    LDR    R0,[R0]         ;get K
    SWI    OS_WriteC       ;VDU K
    MOV    pc,lr
    END
;
    TTL    grtri
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
IX  RN     1
IY  RN     2
OS_Plot EQU &45
    EXPORT grtri_          ;(IX1,IY1,IX2,IY2,IX3,IY3,FILL) draw triangle
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grtri_",0,0,8,0,0,255
grtri_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,[R2]         ;save IX2
    LDR    IY,[R1]         ;get IY1
    LDR    IX,[R0]         ;get IX1
    STMDB  sp!,{IX,IY}      ;save (IX1,IY1)
    MOV    R0,#4
    SWI    OS_Plot         ;move to IX1,IY1
    MOV    IX,ip           ;IX2
    LDR    IY,[R3]         ;IY2
    MOV    R0,#5
    SWI    OS_Plot         ;draw to IX2,IY2
    LDMIB  fp,{R1-R3}      ;addresses of IX3,IY3,FILL
    LDR    IX,[R1]         ;IX3
    LDR    IY,[R2]         ;IY3
    LDR    R3,[R3]         ;fill
    CMP    R3,#0
    MOVNE  R0,#85          ;fill, so do PLOT85
    MOVEQ  R0,#5           ;not fill, so draw
    SWI    OS_Plot         ;or draw to IX3,IY3
    CMP    R3,#0
    LDMEQIA sp,{IX,IY}     ;restore IX1,IY1
    MOVEQ  R0,#5
    SWIEQ  OS_Plot         ;and draw to IX1,IY1
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grtwin
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_WriteC EQU 0
vdu EQU &100
    EXPORT grtwin_         ;(IX1,IY1,IX2,IY2) text window
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grtwin_",0,8,0,0,255
grtwin_
    MOV    ip,sp
    STMDB  sp!,{R0-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+28          ;vdu28
    LDRB   R0,[R0]         ;IX1
    SWI    OS_WriteC       ;send to vdu
    LDRB   R0,[R1]         ;IY1
    SWI    OS_WriteC       ;send to vdu
    LDRB   R0,[R2]         ;IX2
    SWI    OS_WriteC       ;send to vdu
    LDRB   R0,[R3]         ;IY2
    SWI    OS_WriteC       ;send to vdu
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grvdu
pc  RN     15
lr  RN     14
R0  RN     0
OS_WriteC EQU 0
    EXPORT grvdu_          ;(I) send VDU I
    AREA   |C$$Code|,CODE,READONLY
grvdu_
    LDR    R0,[R0]         ;get I
    SWI    OS_WriteC       ;send to vdu
    MOV    pc,lr           ;return
    END
;
    TTL    grwait
pc  RN     15
lr  RN     14
R0  RN     0
OS_Byte EQU   6
    EXPORT grwait_         ;wait for TV frame scan
    AREA   |C$$Code|,CODE,READONLY
grwait_
    MOV    R0,#19
    SWI    OS_Byte         ;*FX19
    MOV    pc,lr           ;return
    END
;
    TTL    grwbig
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
R4  RN     4
R6  RN     6
R7  RN     7
OS_SpriteOp EQU &2E
OS_ReadVduVariables EQU &31
OS_ReadModeVariable EQU &35
    AREA   |C$$data|,DATA
scl DCD    1,1,1,1         ;scale factors
    EXPORT grwbig_         ;(IX,IY,TEXT,ISIZE)
; prints TEXT at graphics location (IX,IY)
; ISIZE times larger ( 0< ISIZE <21 )
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grwbig_",0,8,0,0,255
grwbig_
    MOV    ip,sp
    STMDB  sp!,{R0-R7,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,[fp,#4]      ;length of TEXT
    MOV    R7,R2           ;address of TEXT
    LDR    lr,[R3]         ;isize
    CMP    lr,#1
    MOVLT  lr,#1           ;isize>0
    CMP    lr,#20
    MOVGT  lr,#20          ;isize<21
    LDR    R4,[R1]         ;IY
    LDR    R3,[R0]         ;IX
    LDR    R6,ptr          ;pointer to scale factors
    ADR    R0,scp
    MOV    R1,R6
    SWI    OS_ReadVduVariables;get x size in pixels
    MOV    R0,#-1
    MOV    R1,#4
    SWI    OS_ReadModeVariable;get pixels to screen coordinates
    LDR    R1,[R6]
    MOV    R1,R1,LSL R2
    STR    lr,[R6]         ;X multiplier
    STR    lr,[R6,#4]      ;Y multiplier
    MUL    lr,R1,lr
    MOV    R0,#51          ;SpriteOp type 51
lp1 LDRB   R1,[R7],#1      ;get byte
    SWI    OS_SpriteOp     ;print it
    SUBS   ip,ip,#1        ;decrement count of characters
    ADDGT  R3,R3,lr        ;increment IX
    BGT    lp1
    LDMDB  fp,{R4-R7,fp,sp,pc}   ;return
scp DCD    162,-1
ptr DCD    scl
    END
;
    TTL    grwog
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_Plot EQU &45
OS_WriteN EQU &46
vdu EQU &100
    EXPORT grwog_          ;(IX,IY,TEXT)
; prints TEXT at graphics location (IX,IY)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grwog_",0,0,8,0,0,255
grwog_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
    MOV    ip,R2           ;save address of TEXT
    LDR    R2,[R1]         ;IY
    LDR    R1,[R0]         ;IX
    MOV    R0,#4
    SWI    OS_Plot         ;move to (IX,IY)
    SWI    vdu+5           ;VDU5 (print at graphics cursor)
    MOV    R0,ip           ;address of TEXT
    MOV    R1,R3           ;length of TEXT
    SWI    OS_WriteN       ;print it
    SWI    vdu+4           ;VDU4 return printing to text cursor
    LDMDB  fp,{fp,sp,pc}   ;return
    END
;
    TTL    grwot
pc  RN     15
lr  RN     14
sp  RN     13
ip  RN     12
fp  RN     11
R0  RN     0
R1  RN     1
R2  RN     2
R3  RN     3
OS_WriteC EQU 0
OS_WriteN EQU &46
vdu EQU &100
    EXPORT grwot_          ;(IX,IY,TEXT) prints TEXT at TAB(IX,IY)
    AREA   |C$$Code|,CODE,READONLY
    DCB    "grwot_",0,0,8,0,0,255
grwot_
    MOV    ip,sp
    STMDB  sp!,{R0-R2,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    vdu+4           ;ensure writing text at text cursor
    SWI    vdu+31
    LDR    R0,[R0]         ;get IX
    SWI    OS_WriteC
    LDR    R0,[R1]         ;get IY
    SWI    OS_WriteC
    MOV    R0,R2           ;address of text
    MOV    R1,R3           ;length of text
    SWI    OS_WriteN       ;print it
    LDMDB  fp,{fp,sp,pc}   ;return
    END
