;     Fortran Friends 2018
;                Update history
;
    TTL    FONT_WK
    AREA   FONT_WK,NOINIT
    EXPORT FONT_WK
    % 256
    END
;
    TTL    FTBBOX
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_ReadInfo       EQU &60084
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftbbox_;(IHAND,IXMIN,IYMIN,IXMAX,IYMAX)
    DCB    "ftbbox_",0,8,0,0,255
ftbbox_
    MOV    ip,sp
    STMDB  sp!,{R0-R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]       ;IHAND
    SWI    XFont_ReadInfo
    MOVVS  R1,#0         ;zero the results if it failed
    MOVVS  R2,#0
    MOVVS  R3,#0
    MOVVS  R4,#0
    LDMIB  sp,{R0,ip,lr} ;addresses of IXMIN,IYMIN,IXMAX
    STR    R1,[R0]       ;store IXMIN
    STR    R2,[ip]       ;store IYMIN
    STR    R3,[lr]       ;store IXMAX
    LDR    ip,[fp,#4]    ;address of IYMAX
    STR    R4,[ip]       ;store IXMAX
    LDMDB  fp,{R4,fp,sp,pc} 
    END
;
    TTL    FTCACH
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_CacheAddr       EQU &40080
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftcach_;(ISIZE,IUSED)
    DCB    "ftcach_",0,8,0,0,255
ftcach_
    MOV    ip,sp
    STMDB  sp!,{R0,R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    Font_CacheAddr
    LDMIA  sp!,{R0,R1}
    STR    R2,[R0]
    STR    R3,[R1]
    LDMDB  fp,{fp,sp,pc} 
    END
;
    TTL    FTFCRT
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
R5  RN 5
R6  RN 6
R7  RN 7
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_SetFont        EQU &6008A
Font_Converttopoints EQU &40089
Font_FindCaretJ      EQU &40096
Font_ConverttoOS     EQU &40088
Font_StringWidth     EQU &40085
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftfcrt_;(IHAND,STRING,IXIN,JUST,IXOUT,NPC,INDX)
    IMPORT FONT_WK
    DCB    "ftfcrt_",0,8,0,0,255
ftfcrt_
    MOV    ip,sp
    STMDB  sp!,{R4-R7,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDMIA  ip,{R4-R7}
    LDR    R0,[R0]
    SWI    XFont_SetFont
    MVNVS  R0,#0
    STRVS  R0,[R4]
    STRVS  R0,[R5]
    STRVS  R0,[R6]
    LDMVSDB fp,{R4-R7,fp,sp,pc} 
    MOV    R0,R1
    LDR    R1,ptr
    MOV    lr,#0
    CMP    R7,#&FF
    MOVGT  R7,#&FF
lp1 STRB   lr,[R1,R7]
    SUBS   R7,R7,#1
    LDRGEB lr,[R0,R7]
    BGE    lp1
    LDR    R1,[R2]
    MOV    R2,#0
    SWI    Font_Converttopoints
    MOV    R2,R1
    LDR    R7,[R3]
    CMP    R7,#0
    MOVEQ  R4,#0
    BLNE   pt1
    MOV    R3,#0
    MOV    R5,#0
    LDR    R1,ptr
    SWI    Font_FindCaretJ
    MOV    R1,R2
    MOV    R2,#0
    SWI    Font_ConverttoOS
    LDMIA  ip,{R0,R2,R3}
    STR    R1,[R0]
    STR    R4,[R2]
    STR    R5,[R3]
    LDMDB  fp,{R4-R7,fp,sp,pc}
; 
pt1 STMDB  sp!,{R2,lr}
    MOV    R1,R7
    MOV    R2,#0
    SWI    Font_Converttopoints
    MOV    R7,R1
    LDR    R1,ptr
    MOV    R2,#&3F000000
    MOV    R3,R2
    MVN    R4,#0
    MOV    R5,#&0100
    SWI    Font_StringWidth
    SUBS   R4,R7,R2
    MOVLE  R4,#0
    LDMLEIA sp!,{R2,pc} 
    LDR    R1,ptr
    MOV    R2,#0
lp2 LDRB   lr,[R1],#1
    CMP    lr,#&20
    ADDEQ  R2,R2,#1
    BGE    lp2
    CMP    lr,#9
    CMPNE  lr,#&0B
    CMPNE  lr,#&12
    ADDEQ  R1,R1,#3
    BEQ    lp2
    CMP    lr,#&11
    CMPNE  lr,#&1A
    ADDEQ  R1,R1,#1
    BEQ    lp2
    CMP    lr,#&15
    BEQ    lp4
    CMP    lr,#&19
    ADDEQ  R1,R1,#2
    BEQ    lp2
    CMP    R2,#0
    MOVLE  R4,#0
    LDMLEIA sp!,{R2,pc} 
    MOV    R0,#&21
    MOV    R3,#0
lp3 CMP    R3,R2
    SUBCS  R3,R3,R2
    ADCS   R4,R4,R4
    ADC    R3,R3,R3
    SUBS   R0,R0,#1
    BGT    lp3
    LDMIA  sp!,{R2,pc} 
lp4 LDRB   lr,[R1],#1
    CMP    lr,#&20
    BGE    lp4
    B      lp2
ptr DCD    FONT_WK
    END
;
    TTL    FTFIND
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
R5  RN 5
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_LoseFont       EQU &60082
XFont_FindFont       EQU &60081
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    IMPORT __rt_sdiv; R0 = R1/R0
    EXPORT ftfind_;(NAME,IHIGH,IWIDE,IHAND)
    EXPORT ftlose_;(IHAND)
    DCB    "ftfind_",0,8,0,0,255
ftfind_
    MOV    ip,sp
    STMDB  sp!,{R0-R5,fp,ip,lr,pc}
    SUB    fp,ip,#4
    BL     convert       ;convert y-size to stack
    BL     convert       ;convert x-size to stack
    LDMFD  sp,{R2,R3,R4}    ;get x,y sizes and address of NAME
    LDR    R1,ptr
    LDR    ip,[fp,#4]    ;LEN(NAME)
    CMP    ip,#&FF
    MOVGT  ip,#&FF
lp1 LDRB   lr,[R4],#1
    CMP    lr,#" "
    STRGTB lr,[R1],#1
    SUBS   ip,ip,#1
    BGT    lp1
    STRB   ip,[R1]
    LDR    R1,ptr
    MOV    R4,#0
    MOV    R5,#0
    SWI    XFont_FindFont
    MVNVS  R0,#0
    LDR    R3,[fp,#-24]  ;address of IHAND
    STR    R0,[R3]
    LDMVSDB fp,{R4,R5,fp,sp,pc} ;return on error
    LDR    R1,pth
    LDR    R2,[R1]
    CMP    R2,#20
    LDMGEDB fp,{R4,R5,fp,sp,pc} ;return if no room in handle list
    MOV    ip,#0
lp2 CMP    ip,R2        ;check for end of stored handles
    ADD    ip,ip,#1
    STRGE  R0,[R1,ip,LSL#2];store new handle
    STRGE  ip,[R1]      ;store new # handles
    LDMGEDB fp,{R4,R5,fp,sp,pc} ;return
    LDR    lr,[R1,ip,LSL#2]
    CMP    lr,R0
    BNE    lp2
    LDMDB  fp,{R4,R5,fp,sp,pc} 
;
convert; converts OS to 1/16 point (32/5)
    MOV    R5,lr
    LDR    ip,[sp,#8]    ;address of word to translate
    LDR    R1,[ip]
    MOV    R1,R1,LSL#5
    MOV    R0,#5
    BL     __rt_sdiv
    STR    R0,[sp,#-4]!
    MOV    pc,R5
ptr DCD    FONT_WK
pth DCD    font_handles
;
    DCB    "ftlose_",0,8,0,0,255
ftlose_
    MOV    ip,sp
    STMDB  sp!,{fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]    ;font handle to lose
    LDR    R1,pth
    LDR    R2,[R1]    ;# font handles in use
    SUB    ip,R2,#1
    ADD    R3,R1,#4
lp3 SUBS   R2,R2,#1
    LDMLTDB fp,{fp,sp,pc} ;not found !
    LDR    lr,[R3],#4
    CMP    lr,R0
    BNE    lp3
lp4 LDR    lr,[R3],#4
    STR    lr,[R3,#-8];compact the list
    SUBS   R2,R2,#1
    BGT    lp4
    STR    ip,[R1]  ;store new # handles
    SWI    XFont_LoseFont
    LDMDB  fp,{fp,sp,pc} 
;
    AREA   font_handles,COMMON  ; zeroed by the loader
    %      4        ;# font handles stored
    %      80       ;space for 20 font handles
    END
;
    TTL    FTGETC
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_SetFont        EQU &6008A
Font_CurrentFont     EQU &4008B
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftgetc_;(IHAND,IBKGD,IFGND,IOFF)
    DCB    "FTGETC",0,0,8,0,0,255
ftgetc_
    MOV    ip,sp
    STMDB  sp!,{R1-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]
    SWI    XFont_SetFont
    SWIVC  Font_CurrentFont
    MVNVS  R1,#0
    MVNVS  R2,#0
    MVNVS  R3,#0
    LDMIA  sp!,{R0,ip,lr}
    STR    R1,[R0]
    STR    R2,[ip]
    STR    R3,[lr]
    LDMDB  fp,{fp,sp,pc} 
    END
;
    TTL    FTGETP
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_SetFont        EQU &6008A
Font_CurrentFont     EQU &4008B
OS_ReadPalette       EQU &2002F
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftgetp_;(IHAND,IBKGD,IFGND,IOFF)
    DCB    "ftgetp_",0,8,0,0,255
ftgetp_
    MOV    ip,sp
    STMDB  sp!,{R1-R3,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]
    SWI    XFont_SetFont
    SWIVC  Font_CurrentFont
    BVS    err
    LDR    ip,[fp,#-16] ;address of IOFF
    CMP    R3,#0
    RSBLT  R3,R3,#0     ;|IOFF|
    STR    R3,[ip]      ;store |IOFF|
    MOV    ip,R2        ;save foreground logical colour
    MOV    lr,#1        ;two colours to send
    MOV    R0,R1        ;background logical colour
lp1 MOV    R1,#16       ;ordinary colour
    SWI    OS_ReadPalette
    BVS    err
    LDR    R1,[sp],#4   ;address of IBKGD/IFGND
    MOV    R3,#8        ;
lp2 MOV    R0,R2,LSR R3
    AND    R0,R0,#&FF
    STR    R0,[R1],#4
    ADD    R3,R3,#8
    CMP    R3,#32
    BLT    lp2          ;loop over RGB
    SUBS   lr,lr,#1
    MOVEQ  R0,ip        ;foreground logical colour
    BEQ    lp1          ;go translate foreground
    LDMDB  fp,{fp,sp,pc} ;return
err MOV    R0,#-1
    LDR    R3,[fp,#-16] ;address of IOFF
    STR    R0,[R3]
    LDMDB  fp,{fp,sp,pc} 
    END
;
    TTL    FTGETT
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_ReadThresholds  EQU &40094
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftgett_;(ITHRSH)
    DCB    "ftgett_",0,8,0,0,255
ftgett_
    MOV    ip,sp
    STMDB  sp!,{fp,ip,lr,pc}
    SUB    fp,ip,#4
    MOV    R1,R0
    SWI    Font_ReadThresholds
    MOV    R0,#-1
lp1 ADD    R0,R0,#1
    LDRB   R2,[R1,R0]
    CMP    R2,#&FF
    CMPNE  R0,#15
    BNE    lp1
    MOV    R2,#-1
lp2 STR    R2,[R1,R0,LSL#2]
    SUBS   R0,R0,#1
    LDRGEB R2,[R1,R0]
    BGE    lp2
    LDMDB  fp,{fp,sp,pc} 
    END
;
    TTL    FTLIST
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_ListFonts       EQU &40091
    AREA   FTLIST_DATA,DATA
    DCD    0
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    EXPORT ftlist_;(NAME)
    DCB    "ftlist_",0,8,0,0,255
ftlist_
    MOV    ip,sp
    STMDB  sp!,{R0,R1,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    ip,ptl         ;pointer to private counter
    LDR    R2,[ip]        ;count
    LDR    R1,ptw         ;pointer to 40-byte buffer
    MVN    R3,#0          ;use Font$Path
    SWI    Font_ListFonts
    CMP    R2,#0
    MOVLT  R2,#0          ;no more names so reset count
    STRLT  R2,[R1]        ;and make null name
    STR    R2,[ip]        ;store new count
    LDMIA  sp!,{R0,R2}    ;restore address and length of NAME
lp1 LDRB   ip,[R1],#1     ;transfer result to NAME
    CMP    ip,#&1F
    STRGTB ip,[R0],#1
    SUBGTS R2,R2,#1
    BGT    lp1
    MOV    ip,#&20
lp2 SUBS   R2,R2,#1       ;blank fill
    STRGEB ip,[R0],#1
    BGT    lp2
    LDMDB  fp,{fp,sp,pc} 
ptw DCD    FONT_WK
ptl DCD    FTLIST_DATA
    END
;
    TTL    FTPREF
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_ReadFontPrefix EQU &6009D
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    EXPORT ftpref_;(IHAND,PREFIX)
    DCB    "ftpref_",0,8,0,0,255
ftpref_
    MOV    ip,sp
    STMDB  sp!,{fp,ip,lr,pc}
    SUB    fp,ip,#4
    MOV    R3,R1
    MOV    ip,R2
    LDR    R0,[R0]
    LDR    R1,ptr         ;temporary buffer
    MOV    R2,#256        ;length 256 bytes
    SWI    XFont_ReadFontPrefix
    LDR    R1,ptr
lp1 LDRB   R0,[R1],#1     ;move to PREFIX
    CMP    R0,#31
    STRGTB R0,[R3],#1
    SUBGTS ip,ip,#1
    BGT    lp1
    MOV    R0,#" "
lp2 SUBS   ip,ip,#1
    STRGEB R0,[R3],#1     ;blank fill
    BGT    lp2
    LDMDB  fp,{fp,sp,pc} 
ptr DCD    FONT_WK
    END
;
    TTL    FTPRNT
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
R5  RN 5
R6  RN 6
R7  RN 7
R8  RN 8
R9  RN 9
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_SetFont        EQU &6008A
Font_StringBBox      EQU &40097
Font_ConverttoOS     EQU &40088
Font_Converttopoints EQU &40089
XFont_Paint          EQU &60086
OS_Plot              EQU &45
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    EXPORT ftprnt_;(IHAND,STRING,IX,IY,BLANK,JUST)
    DCB    "ftprnt_",0,8,0,0,255
ftprnt_
    MOV    ip,sp
    STMDB  sp!,{R1-R9,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]        ;font handle
    SWI    XFont_SetFont  ;select the font
    LDMVSDB fp,{R4-R9,fp,sp,pc} 
    LDMIA  ip,{R4-R6}     ;addresses of BLANK, JUST and length of STRING
    LDR    R8,[R2]        ;IX
    LDR    R9,[R3]        ;IY
    MOV    ip,R1          ;save address of STRING
    LDR    R1,ptr         ;address of FONT_WK (256 bytes of scratch area
    CMP    R6,#255        ;length of STRING
    MOVGT  R6,#255        ;limit STRING to 255 characters
    MOV    lr,#0
lp1 STRB   lr,[R1,R6]     ;move STRING (null terminated)
    SUBS   R6,R6,#1       ;to workspace
    LDRGEB lr,[ip,R6]
    BGE    lp1
    LDR    R7,[R5]        ;JUST
    LDR    R6,[R4]        ;BLANK
;       background blanking here
    SWI    Font_StringBBox ;get string bounding box in R1-R4
    SWI    Font_ConverttoOS;convert bottom left
    ADD    R1,R1,R8
    ADD    R2,R2,R9
    MOV    R0,#4
    SWI    OS_Plot         ;move to bottom left
    MOV    R1,R3
    MOV    R2,R4
    SWI    Font_ConverttoOS;convert top right
    CMP    R7,#0           ;JUST
    ADDLE  R1,R1,R8        ;get x of end
    ADDGT  R1,R7,R8        ;get x of end justified
    ADD    R2,R2,R9        ;y of end
    MOV    R0,#4
    STMGTFD sp!,{R0-R2}
    SWI    OS_Plot         ;move to top right
    CMP    R7,#0
    LDMGTFD sp!,{R0-R2}
    SWIGT  OS_Plot         ;top right again for justified text
    CMP    R7,#0
    MOVEQ  R2,#&10
    MOVNE  R2,#&11
    CMP    R6,#0
    ORRNE  R2,R2,#2
    LDR    R1,ptr
    MOV    R3,R8
    MOV    R4,R9
    SWI    XFont_Paint
    LDMDB  fp,{R4-R9,fp,sp,pc} 
ptr DCD    FONT_WK
    END
;
    TTL    FTPRTA
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
R5  RN 5
R6  RN 6
R7  RN 7
R8  RN 8
R9  RN 9
F0  FN 0
F1  FN 1
F2  FN 2
F3  FN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_SetFont        EQU &6008A
Font_StringBBox      EQU &40097
Font_ConverttoOS     EQU &40088
XFont_Paint          EQU &60086
OS_Plot              EQU &45
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    EXPORT ftprta_;(IHAND,STRING,IX,IY,BLANK,ANGLE,RMAG)
    DCB    "ftprta_",0,8,0,0,255
ftprta_
    MOV    ip,sp
    STMDB  sp!,{R1-R9,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]        ;font handle
    SWI    XFont_SetFont  ;select the font
    LDMVSDB fp,{R4-R9,fp,sp,pc} 
    LDMIA  ip,{R4-R7}     ;addresses of BLANK, ANGLE, RMAG and length of STRING
    MOV    ip,R1
    LDR    R1,ptr
    CMP    R7,#255
    MOVGT  R7,#255        ;limit string to 255 characters
    MOV    lr,#0
lp1 STRB   lr,[R1,R7]     ;move STRING (null terminated)
    SUBS   R7,R7,#1       ;to workspace
    LDRGEB lr,[ip,R7]
    BGE    lp1
;    MOV    R1,ip                     removed 21/02/99
    LDFS   F0,[R5]        ;angle
    LDFS   F1,[R6]        ;rmag
    LDFS   F2,mult        ;multiplier to get binary point 16
    FMLS   F1,F1,F2       ;multiplier
    COSS   F3,F0
    SINS   F2,F0
    FMLS   F0,F3,F1       ;r*cos
    FMLS   F1,F2,F1       ;r*sin
    FIX    R5,F0
    FIX    R6,F1
    RSB    R7,R6,#0
    MOV    R8,R5
    MOV    R9,#0
    MOV    lr,#0
    STMFD  sp!,{R5-R9,lr} ;store transformation matrix
    LDR    R8,[R2]        ;IX
    LDR    R9,[R3]        ;IY
    LDR    R4,[R4]        ;BLANK
    CMP    R4,#0
    BEQ    nob            ;no blanking
;       background blanking here
    SWI    Font_StringBBox ;get string bounding box
    SWI    Font_ConverttoOS;convert bottom left
    STMFD  sp!,{R1,R2}     ;store x1,y1 on stack
    MOV    R1,R3
    MOV    R2,R4
    SWI    Font_ConverttoOS;convert top right
    LDMFD  sp,{R0,R3}      ;restore x1,y1
    STMFD  sp!,{R0,R2}     ;store x1,y2 on stack
    STMFD  sp!,{R1,R3}     ;store x2,y1 on stack
    STMFD  sp!,{R1,R2}     ;store x2,y2 on stack
    MOV    R0,#4           ;start blanking rectangle
    BL     plot            ;move to x2,y2
    MOV    R0,#7
    BL     plot            ;draw to x2,y1
    MOV    R0,#87
    BL     plot            ;triangle to x1,y2
    MOV    R0,#87
    BL     plot            ;triangle to x1,y1
    LDR    R1,ptr
nob MOV    R2,#&40
    MOV    R0,#400
    MUL    R3,R8,R0
    MUL    R4,R9,R0
    MOV    R6,sp
    MOV    R0,#0
    SWI    XFont_Paint
    LDMDB  fp,{R4-R9,fp,sp,pc} 
mult DCFS  65536.
ptr DCD    FONT_WK
plot;       transform point on stack and plot it
    LDMFD  sp!,{R3,R4}     ;get point
    MUL    R1,R5,R3
    MLA    R1,R7,R4,R1     ;rotate to x'
    ADD    R1,R8,R1,ASR#16 ;translate
    MUL    R2,R5,R4
    MLA    R2,R6,R3,R2     ;rotate y'
    ADD    R2,R9,R2,ASR#16 ;translate
    SWI    OS_Plot         ;plot it
    MOV    pc,lr
    END
;
    TTL    FTRFMX
R0  RN 0
R1  RN 1
R4  RN 4
R5  RN 5
R7  RN 7
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_ReadFontMax     EQU &4009C
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftrfmx_;(MAX,MAX15)
    DCB    "ftrfmx_",0,8,0,0,255
ftrfmx_
    MOV    ip,sp
    STMDB  sp!,{R0,R1,R4-R7,fp,ip,lr,pc}
    SUB    fp,ip,#4
    SWI    Font_ReadFontMax ;corrupts R6,R7!
    LDMIA  sp!,{ip,lr}
    STR    R0,[ip]
    STMIA  lr,{R1-R5}
    LDMDB  fp,{R4-R7,fp,sp,pc} 
    END
;
    TTL    FTSCRT
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_ReadInfo       EQU &60084
Font_Caret           EQU &40087
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftscrt_;(IHAND,ICOLOR,IX,IY)
    DCB    "ftscrt_",0,8,0,0,255
ftscrt_
    MOV    ip,sp
    STMDB  sp!,{R1-R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]        ;IHAND
    SWI    XFont_ReadInfo ;get font bounding box
    SUBVC  R1,R4,R2       ;y size (OS units)
    LDMVCIA sp!,{R0,ip,lr};addresses of ICOLOR,IX,IY
    LDRVC  R0,[R0]        ;ICOLOR
    LDRVC  R3,[ip]        ;IX
    LDRVC  R4,[lr]        ;IY
    ADDVC  R4,R4,R2       ;adjust height to bounding box
    MOVVC  R2,#&10        ;bit 4 for OS units
    SWIVC  Font_Caret
    LDMDB  fp,{R4,fp,sp,pc} 
    END
;
    TTL    FTSETC
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_SetFontColours EQU &60092
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftsetc_;(IHAND,IBKGD,IFGND,IOFF)
    DCB    "ftsetc_",0,8,0,0,255
ftsetc_
    MOV    ip,sp
    STMDB  sp!,{fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]
    LDR    R1,[R1]
    LDR    R2,[R2]
    LDR    R3,[R3]
    SWI    XFont_SetFontColours
    LDMDB  fp,{fp,sp,pc} 
    END
;
    TTL    FTSETP
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
R5  RN 5
R6  RN 6
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XColourTrans_SetFontColours EQU &6074F
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftsetp_;(IHAND,IBKGD,IFGND,IOFF)
    DCB    "ftsetp_",0,8,0,0,255
ftsetp_
    MOV    ip,sp
    STMDB  sp!,{R4-R6,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDRB   ip,[R1]          ;background RED
    LDRB   lr,[R1,#4]       ;background GREEN
    LDRB   R1,[R1,#8]       ;background BLUE
    MOV    R1,R1,LSL#24
    ORR    R1,R1,lr,LSL#16
    ORR    R1,R1,ip,LSL#8   ;make up RGB background palette entry
    LDRB   ip,[R2]          ;foreground RED
    LDRB   lr,[R2,#4]       ;foreground GREEN
    LDRB   R2,[R2,#8]       ;foreground BLUE
    MOV    R2,R2,LSL#24
    ORR    R2,R2,lr,LSL#16
    ORR    R2,R2,ip,LSL#8   ;make up RGB foreground palette entry
    LDR    R0,[R0]
    LDR    R3,[R3]          ;maximum allowed offset
    CMP    R3,#15
    MOVCS  R3,#14
    SWI    XColourTrans_SetFontColours
    LDMDB  fp,{R4-R6,fp,sp,pc} 
    END
;
    TTL    FTSETT
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_SetThresholds   EQU &40095
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    EXPORT ftsett_;(ITHRSH)
    DCB    "ftsett_",0,8,0,0,255
ftsett_
    MOV    ip,sp
    STMDB  sp!,{fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R1,ptr
    MOV    R3,#0
lp1 LDR    R2,[R0,R3,LSL#2];move the thresholds from ITHRSH
    CMP    R2,#0
    STRGEB R2,[R1,R3]      ;to a byte array
    ADDGE  R3,R3,#1
    RSBGES lr,R3,#14
    BGE    lp1
    MOV    R2,#&FF
    STRB   R2,[R1,R3]      ;make the last one &FF
    SWI    Font_SetThresholds
    LDMDB  fp,{fp,sp,pc} 
ptr DCD    FONT_WK
    END
;
    TTL    FTSIZC
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
XFont_CharBBox       EQU &6008E
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftsizc_;(IHAND,ICHAR,IXMIN,IYMIN,IXMAX,IYMAX)
    DCB    "ftsizc_",0,8,0,0,255
ftsizc_
    MOV    ip,sp
    STMDB  sp!,{R2-R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]        ;IHAND
    LDRB   R1,[R1]        ;ICHAR
    MOV    R2,#&10        ;bit 4 to return OS units
    SWI    XFont_CharBBox
    MOVVS  R1,#0          ;zero to store if SWI fails
    MOVVS  R2,#0
    MOVVS  R3,#0
    MOVVS  R4,#0
    LDMIA  sp,{ip,lr}
    STR    R1,[ip]        ;store IXMIN
    STR    R2,[lr]        ;store IYMIN
    LDMIB  fp,{ip,lr}
    STR    R3,[ip]        ;store IXMAX
    STR    R4,[lr]        ;store IYMAX
    LDMDB  fp,{R4,fp,sp,pc} 
    END
;
    TTL    FTSZXY
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_StringBBox      EQU &40097
XFont_SetFont        EQU &6008A
Font_ConverttoOS     EQU &40088
    AREA   |C$$code|,CODE,READONLY
    IMPORT FONT_WK
    EXPORT ftszxy_;(IHAND,STRING,IXMIN,IYMIN,IXMAX,IYMAX)
    DCB    "ftszxy_",0,8,0,0,255
ftszxy_
    MOV    ip,sp
    STMDB  sp!,{R2-R4,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]
    SWI    XFont_SetFont
    MVNVS  R0,#0
    STRVS  R0,[R2]
    STRVS  R0,[R3]
    LDMVSIB fp,{R2,R3}
    STRVS  R0,[R2]
    STRVS  R0,[R3]
    LDMVSDB fp,{R4,fp,sp,pc} 
    MOV    ip,R1
    LDR    R1,ptr
    LDR    R4,[fp,#12]    ;length of STRING
    CMP    R4,#&FF
    MOVGT  R4,#&FF
    MOV    lr,#0
lp1 STRB   lr,[R1,R4]
    SUBS   R4,R4,#1
    LDRGEB lr,[ip,R4]
    BGE    lp1
    SWI    Font_StringBBox
    SWI    Font_ConverttoOS
    LDMIA  sp,{ip,lr}     ;restore pointers to IXMIN,IYMIN
    STR    R1,[ip]
    STR    R2,[lr]
    MOV    R1,R3
    MOV    R2,R4
    SWI    Font_ConverttoOS
    LDMIB  fp,{ip,lr}     ;restore pointers to IXMAX,IYMAX
    STR    R1,[ip]
    STR    R2,[lr]
    LDMDB  fp,{R4,fp,sp,pc} 
ptr DCD    FONT_WK
    END
;
    TTL    FTWFMX
R0  RN 0
R1  RN 1
R2  RN 2
R3  RN 3
R4  RN 4
R5  RN 5
R6  RN 6
R7  RN 7
fp  RN 11
ip  RN 12
sp  RN 13
lr  RN 14
pc  RN 15
Font_SetFontMax      EQU &4009B
    AREA   |C$$code|,CODE,READONLY
    EXPORT ftwfmx_;(MAX,MAX15)
    DCB    "ftwfmx_",0,8,0,0,255
ftwfmx_
    MOV    ip,sp
    STMDB  sp!,{R4-R7,fp,ip,lr,pc}
    SUB    fp,ip,#4
    LDR    R0,[R0]
    LDMIA  R1,{R1-R5}
    MOV    R6,#0
    MOV    R7,#0
    SWI    Font_SetFontMax
    LDMDB  fp,{R4-R7,fp,sp,pc} 
    END
