;     Fortran Friends 2018
;                       update log
;
; needs dummy group 0 do define overall size.
;
       TTL    drawf
       GET    s.DWcommon
OS_Args  EQU  &20009
OS_File  EQU  &20008
OS_Find  EQU  &2000D
OS_BPut  EQU  &2000B
OS_GBPB  EQU  &2000C
       AREA   DW_code,CODE,READONLY
       EXPORT dwinit_;(FILENM,PAGESZ,XL,YL,XH,YH,IERR)
       EXPORT dwdone_;(KEEP)
       EXPORT dwbgrp_;(IERR)
       EXPORT dwegrp_;(IERR)
       EXPORT DW_writ;(string,LEN)
       EXPORT DW_wrpt;(XY)
       EXPORT DW_chk
       EXPORT DW_wrd
;
       DCB    "dwinit_",0,8,0,0,255
dwinit_
       MOV    ip,sp
       STMDB  sp!,{R4-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDMFD  ip,{R4-R8}     ;get last 3 args, name & pagesize lengths
       LDR    R9,comptr
       LDR    ip,idhand        ;get file handle
       CMP    ip,#0
       MOVNE  lr,#-5
       BNE    err1
       MOV    lr,#3          ;error 3 for bad page size
       LDRB   ip,[R1,#2]     ;third character
       CMP    ip,#"P"        ;check for 'P'
       CMPNE  ip,#"L"
       CMPEQ  R8,#3
       LDRB   R8,[R1]        ;get first character of page size
       CMPEQ  R8,#"A"
       BNE    err1           ;first character not 'A'
       LDRB   R8,[R1,#1]     ;get second character
       SUBS   R8,R8,#"0"
       BLT    err1           ;< "0"
       CMP    R8,#5
       BGT    err1           ;> 5
       ADR    lr,A0
       LDR    R8,[lr,R8,LSL#2]!;get long side
       LDR    lr,[lr,#4]     ;get short side
       CMP    ip,#"P"        ;check for portrait
       STREQ  lr,iwid        ;then store short length in x
       STREQ  R8,ihite       ;store long length in y
       STRNE  lr,ihite       ;or store short length in y
       STRNE  R8,iwid        ;store long length in x
       FLTEQS F0,lr          ;x length
       FLTEQS F1,R8          ;y length
       FLTNES F0,R8          ;x length
       FLTNES F1,lr          ;y length
       LDFS   F2,[R2]        ;XL
       LDFS   F3,[R4]        ;XH
       STFS   F2,xlow        ;store in common
       STFS   F3,xhigh
       SUFS   F3,F3,F2       ;x width
       MOV    lr,#4          ;error 4 for bad area
       CMFE   F3,#0
       BLE    err1
       FDVS   F0,F0,F3       ;x scale
       LDFS   F2,[R3]        ;YL
       LDFS   F3,[R5]        ;YH
       STFS   F2,ylow        ;store in common
       STFS   F3,yhigh
       SUFS   F3,F3,F2       ;y width
       CMFE   F3,#0
       BLE    err1
       FDVS   F1,F1,F3       ;y scale
       CMFE   F0,F1          ;find the smaller scale
       MVFGTS F0,F1
       STFS   F0,scl         ;store in SCL
       FRDS   F1,F0,#1       ;reciprocate
       STFS   F1,rscl        ;store in RSCL
       MOV    R1,#0          ;maximum font
       MOV    R2,#0          ;black text
       MOV    R3,#&FFFFFF00  ;white background
       MOV    R4,#0          ;text style 0
       MOV    R5,#6400       ;10 point in x
       MOV    R8,#6400       ;10 point in y
       ADR    ip,mxfont
       STMIA  ip!,{R1-R5,R8} ;store 6 default text parameters
       MOV    R1,#-1         ;transparent fill
       MOV    R2,#0          ;black lines
       MOV    R3,#0          ;thinnest lines
       LDR    R4,style       ;default style
       STMIA  ip,{R1-R4}     ;store 4 default line parameters
       ADR    R4,igroup+4
       MOV    R1,#maxgrp
loop1  STR    R3,[R4],#36    ;no groups yet
       SUBS   R1,R1,#1
       BGT    loop1
       ADR    R1,flname      ;address of file name
loop2  STRB   R3,[R1,R7]     ;zero terminate name
       SUBS   R7,R7,#1
       LDRGEB R3,[R0,R7]
       BGE    loop2          ;copy file name
       MOV    R0,#&83        ;prepare to open new file for read/write
       SWI    OS_Find
       STRVC  R0,idhand
       MOVVS  lr,#1          ;can't open file
       BVS    err1
       ADR    R1,head
       ADD    R0,R1,#4
       BL     DW_writ
       ADREQ  R0,ixy0
       ADREQ  R1,lbound
       BLEQ   DW_writ
       MOV    lr,R0          ;error number
err1   STR    lr,[R6]        ;store IERR
       LDMDB  fp,{R4-R9,fp,sp,pc} ;return
A0     DCD    2155237        ;in draw units
A1     DCD    1523905
A2     DCD    1077619
A3     DCD     761953
A4     DCD     538809
A5     DCD     380976
A6     DCD     269405
comptr DCD    DW_common
style  DCD    &20100042
head   DCD    24             ;header
       DCB    "Draw"
       DCD    201
       DCD    0
       DCB    "FortDraw    "
lbound DCD    16
DW_wrd; write out word R0 (R9 assumed set)
       STMFD  sp!,{R0-R4,lr}
       MOV    R0,#2
       LDR    R1,idhand
       MOV    R2,sp          ;address of bytes
       MOV    R3,#4          ;4 bytes
       SWI    OS_GBPB        ;write bytes
       MOVVSS R0,#-4
       MOVVCS R0,#0
       ADD    sp,sp,#4
       LDMFD  sp!,{R1-R4,pc} ;return error and status
DW_writ;(IB,NB)   write NB bytes from IB
       STMFD  sp!,{R2-R4,R9,lr}
       LDR    R3,[R1]        ;#bytes
       LDR    R1,idhand      ;file handle
       MOV    R2,R0          ;address of IB
       MOV    R0,#2          ;write from current address
       SWI    OS_GBPB        ;write bytes
       MOVVCS R0,#0
       MOVVSS R0,#-4         ;error code returned in R0
       LDMFD  sp!,{R2-R4,R9,pc};return
DW_wrpt;(XY)
       STMFD  sp!,{R1-R9,lr}
       LDFS   F0,scl         ;get scale
       LDFS   F1,[R0]        ;X
       LDFS   F2,xlow
       SUFS   F1,F1,F2
       FMLS   F1,F1,F0       ;transform
       FIXZ  R3,F1          ;fix
       CMP    R3,#0
       MOVLT  R3,#0
       LDR    R1,iwid
       CMP    R3,R1
       MOVGT  R3,R1
       LDFS   F1,[R0,#4]     ;Y
       LDFS   F2,ylow
       SUFS   F1,F1,F2
       FMLS   F1,F1,F0       ;transform
       FIXZ  R4,F1          ;fix
       CMP    R4,#0
       MOVLT  R4,#0
       LDR    R1,ihite
       CMP    R4,R1
       MOVGT  R4,R1
       ADR    R2,iblock
       STMIA  R2,{R3,R4}     ;store in iblock
       ADR    R0,igroup+4
       LDMIA  R0,{R1,R5-R8}  ;get group info
       CMP    R1,#0
       BEQ    dww1           ; no group active
       CMP    R3,R5
       MOVLT  R5,R3
       CMP    R3,R7
       MOVGT  R7,R3
       CMP    R4,R6
       MOVLT  R6,R4
       CMP    R4,R8
       MOVGT  R8,R4
       STMIB  R0,{R5-R8}     ;update group dimensions
dww1   LDR    R1,idhand      ;file handle
       MOV    R3,#8
       MOV    R0,#2          ;write from current address
       SWI    OS_GBPB        ;write 8 bytes
       MOVVCS R0,#0
       MOVVSS R0,#-4
       LDMFD  sp!,{R1-R9,pc} ;return
;
       DCB    "dwdone_",0,8,0,0,255
dwdone_
       MOV    ip,sp
       STMDB  sp!,{R0,R4,R5,R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R9,comptr
dwd1   LDR    R4,igroup+4
       CMP    R4,#0
       BLE    dwd2
       ADR    R0,scl          ;address for dummy IERR
       BL     dwegrp_         ;end group
       B      dwd1
dwd2   LDR    R1,idhand       ;get file handle
       CMP    R1,#0
       LDMEQDB fp,{R4,R5,R9,fp,sp,pc} ;return if file not open
       LDR    R0,[sp]
       LDR    R3,[R0]         ;KEEP
       MOV    R0,#0           ;to close file
       SWI    OS_Find
       STR    R0,idhand       ;set file handle 0
       ADR    R1,flname       ;pointer to name
       CMP    R3,#0           ;check if 'DELETE'
       MOVNE  R0,#18          ;for settype
       LDRNE  R2,=&AFF        ;drawfile type
       MOVEQ  R0,#6           ;for delete
       SWI    OS_File
       LDMDB  fp,{R4,R5,R9,fp,sp,pc} ;return
;
       DCB    "dwbgrp_",0,8,0,0,255
dwbgrp_
       MOV    ip,sp
       STMDB  sp!,{R0,R4-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk
       BNE    err2
       MOV    R0,#0           ;maximum depth of grouping
       ADR    R3,igroup
lpgp1  LDR    R2,[R3,#4]      ;search for empty group
       CMP    R2,#0
       ADDNE  R0,R0,#1
       CMPNE  R0,#maxgrp
       ADDNE  R3,R3,#36
       BNE    lpgp1
       CMP    R2,#0           ;check we have found one
       MOVNE  R0,#-7
       BNE    err2
       ADD    R2,R3,#36
       CMP    R0,#0
lpgp2  LDMGTDB R3!,{R4-R8}    ;move up the 9-word blocks
       STMGTDB R2!,{R4-R8}
       LDMGTDB R3!,{R4-R7}
       STMGTDB R2!,{R4-R7}
       SUBGTS  R0,R0,#1
       BGT     lpgp2
       LDR    R1,idhand
       SWI    OS_Args         ;get file pointer in R2
       MOV    R0,#6           ;group object type
       ADR    R8,iwid
       LDMIA  R8,{R3,R4}      ;minimum of group area
       ADR    R8,ixy0
       LDMIA  R8,{R5,R6}      ;maximum of group area
       ADR    R8,igroup
       STMIA  R8!,{R0,R2-R6}  ;group header (24 bytes)
       MOV    R0,#" "
       MOV    R3,#12
lpgp3  STRB   R0,[R8],#1      ;and blank name (12 bytes)
       SUBS   R3,R3,#1
       BGT    lpgp3
       ADD    R2,R2,#36
       MOV    R0,#1
       SWI    OS_Args         ;reserve space for 36 bytes in file
err0   MOVVC  R0,#0
       MOVVS  R0,#-4
err2   LDR    R1,[sp],#4
       STR    R0,[R1]         ;store IERR
       LDMDB  fp,{R4-R9,fp,sp,pc} ;return
;
       DCB    "dwegrp_",0,8,0,0,255
dwegrp_
       MOV    ip,sp
       STMDB  sp!,{R0,R4-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R9,comptr
       LDR    R1,idhand       ;file handle
       CMP    R1,#0
       MOVEQ  R0,#2
       BEQ    err2
       LDR    R4,igroup+4     ;pointer to group in file
       CMP    R4,#0
       MOVEQ  R0,#-8
       BEQ    err2
       MOV    R6,#0
       STR    R6,[R0]         ;IERR = 0
       MOV    R0,#0
       SWI    OS_Args         ;get current file position
       MOV    R5,R2           ;save in R5
       ADR    R2,igroup       ;address of group object
       SUB    R7,R5,R4
       MOV    R0,#1
       CMP    R7,#36          ;check there are any objects in group
       MOVLE  R2,R4
       BLE    egp1
       STR    R7,igroup+4     ;store length of group
       MOV    R3,#36
       SWI    OS_GBPB         ;write out group block (36 bytes)
       BVS    err0
       MOV    R2,R5
egp1   SWI    OS_Args         ;restore file pointer
       CMP    R7,#36          ;check there are any objects (again)
       MOVLE  R0,#3
       SWILE  OS_Args         ;reset extent if no objects
;           now move down stack of groups
       ADR    R0,igroup+4
       MOV    R1,#maxgrp
lpgp4  SUBS   R1,R1,#0
       MOV    ip,R1
       LDRNE  ip,[R0,#36]     ;file address of next group
       CMPNE  ip,#0
       STREQ  ip,[R0]
       BEQ    err0            ;no more groups
       ADD    ip,R0,#36
       LDMIB  R0,{R2-R5}      ;get inner group dimensions
       LDMIA  ip!,{R6-R9,lr}  ;get outer group dimensions
       CMP    R2,R7
       MOVLT  R7,R2
       CMP    R3,R8
       MOVLT  R8,R3
       CMP    R4,R9
       MOVGT  R9,R4
       CMP    R5,lr
       MOVGT  lr,R5
       STMIA  R0,{R6-R9,lr}   ;store address and new values
       ADD    R0,R0,#36
       B      lpgp4
;
DW_chk; check if fonts to be written
;       assumes that R9 has been saved
       STMFD  sp!,{R0-R7,lr}
       CMP    sp,sl
       LDR    R9,comptr      ;base of common
       LDR    R1,idhand      ;file handle
       CMP    R1,#0
       MOVEQ  R0,#2
       BEQ    err
       LDR    lr,mxfont
       CMP    lr,#0
       MOVGE  R0,#0
       BGE    err            ;no font to save
       ADR    R6,flname
lp1    LDRB   R4,[R6],#1
       CMP    R4,#0
       BNE    lp1            ;find end of file name
       MOV    R5,R6          ;address of first font
       RSB    lr,lr,#0       ;count of font files
       STR    lr,mxfont      ;flag that block has been written
       MOV    R0,lr
       ADD    R3,R0,#11      ;initialize # bytes to write
lp2    LDRB   R4,[R6],#1
       CMP    R4,#0
       ADD    R3,R3,#1
       SUBEQS R0,R0,#1
       BNE    lp2
       BIC    R6,R3,#3       ;round to whole words
       ADR    R2,iblock
       STMIA  R2,{R0,R6}
       MOV    R3,#8
       MOV    R0,#2
       SWI    OS_GBPB        ;write font block header
       BVS    erm4
       SUB    R6,R6,#8       ;count bytes remaining
       MOV    R7,#0          ;font count
lp3    ADD    R7,R7,#1
       MOV    R0,R7
       SWI    OS_BPut        ;write font handle
       SUB    R6,R6,#1       ;count bytes remaining
       MOV    R2,R5          ;address of font name
lp4    LDRB   R4,[R5],#1
       CMP    R4,#0
       BNE    lp4            ;find end of font name
       SUB    R3,R5,R2       ;#bytes in font name (incl. null term.)
       SUBS   R6,R6,R3       ;count bytes remaining
       MOV    R0,#2
       SWI    OS_GBPB        ;write font name
       BVS    erm4
       CMP    R7,lr
       BLT    lp3            ;loop over font names
       MOV    R0,#0
       CMP    R6,#0
lp5    SWIGT  OS_BPut        ;pad to whole word boundary
       SUBS   R6,R6,#1       ;count bytes remaining
       BGT    lp5            ;loop but don't check on V flag
erm4   MOVVS  R0,#-4         ;error if can't write
err    CMP    R0,#0
       ADDNE  sp,sp,#4
       LDMNEFD sp!,{R1-R7,pc};return with error
       LDMEQFD sp!,{R0-R7,pc};return with no error
       AREA DW_common,COMDEF
       %    lencom
       END
;
       TTL    colour
       GET    s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwtxbc_;(IR,IG,IB)
       EXPORT dwcolf_;(IR,IG,IB)
       EXPORT dwcoll_;(IR,IG,IB)
       EXPORT dwtxfc_;(IR,IG,IB)
;
       DCB   "dwtxbc_",0,8,0,0,255
dwtxbc_
       MOV   ip,sp
       STMDB sp!,{fp,ip,lr,pc}
       SUB   fp,ip,#4
       MOV   R3,#kbgtxt-idhand
       B     mcol
;
       DCB   "dwcolf_",0,8,0,0,255
dwcolf_
       MOV   ip,sp
       STMDB sp!,{fp,ip,lr,pc}
       SUB   fp,ip,#4
       MOV   R3,#kfill-idhand
dcol1  LDR   R0,[R0]
       CMP   R0,#-1
       BNE   mcol1      ;normal fill
       LDR   R1,comptr
       STR   R0,[R1,R3] ;transparent fill
       LDMDB  fp,{fp,sp,pc} 
;
       DCB   "dwcoll_",0,8,0,0,255
dwcoll_
       MOV   ip,sp
       STMDB sp!,{fp,ip,lr,pc}
       SUB   fp,ip,#4
       MOV   R3,#kline-idhand
       B     dcol1      ;go check for no outline
;
       DCB   "dwtxfc_",0,8,0,0,255
dwtxfc_
       MOV   ip,sp
       STMDB sp!,{fp,ip,lr,pc}
       SUB   fp,ip,#4
       MOV   R3,#ktext-idhand
mcol   LDR   R0,[R0]    ;IRED
mcol1  CMP   R0,#0
       MOVLT R0,#0
       CMP   R0,#255
       MOVGT R0,#255
       LDR   R1,[R1]    ;IGREEN
       CMP   R1,#0
       MOVLT R1,#0
       CMP   R1,#255
       MOVGT R1,#255
       LDR   R2,[R2]    ;IBLUE
       CMP   R2,#0
       MOVLT R2,#0
       CMP   R2,#255
       MOVGT R2,#255
       ORR   R0,R0,R1,LSL#8;build colour word
       ORR   R0,R0,R2,LSL#16
       MOV   R0,R0,LSL#8
       LDR   ip,comptr
       STR   R0,[ip,R3]
       LDMDB  fp,{fp,sp,pc} ;return
comptr DCD   DW_common
       AREA DW_common,COMMON,NOINIT
       %    lencom
       END
;
       TTL DWCirc
       GET s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwcirc_;(XYC,RADIUS,IERR)
       EXPORT dwsect_;(XYC,RADIUS,TH1,TH2,IERR)
       EXPORT dwarcc_;(XYC,RADIUS,TH1,TH2,IERR)
       EXPORT dwsegc_;(XYC,RADIUS,TH1,TH2,IERR)
       IMPORT DW_head
       IMPORT DW_wrpt
       IMPORT DW_chk
       IMPORT DW_wrd
;
       DCB    "dwcirc_",0,8,0,0,255
dwcirc_
       MOV    ip,sp
       STMDB  sp!,{R0-R2,R4-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       MOV    R8,R2          ;address of IERR
       MVFS   F0,#0          ;TH
       LDFS   F1,twopi       ;DTH
       MOV    R4,#1          ;CLOSE (TRUE)
       MOV    R5,#2          ;IFIRST
       B      p20
       DCB    "dwsect_",0,8,0,0,255
dwsect_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R8,[ip]        ;address of IERR
       MOV    R4,#1          ;CLOSE (TRUE)
       MOV    R5,#2          ;FIRST
       B      q1x
       DCB    "dwarcc_",0,8,0,0,255
dwarcc_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R8,[ip]        ;address of IERR
       MOV    R4,#0          ;CLOSE (FALSE)
       MOV    R5,#2          ;FIRST
       B      q1x
       DCB    "dwsegc_",0,8,0,0,255
dwsegc_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R8,[ip]        ;address of IERR
       MOV    R4,#1          ;CLOSE (TRUE)
       MOV    R5,#1          ;FIRST
q1x    LDFS   F0,[R2]        ;TH = TH1
       LDFS   F1,[R3]        ;TH2
       SUFS   F1,F1,F0       ;DTH
       LDFS   F2,twopi
       CMFE   F1,#0
       CMFGE  F2,F1
       MOVLT  R0,#-13
       BLT    err1           ;DTH out of bounds
p20    STFE   F7,[sp,#-12]!  ;save F7
       STFE   F6,[sp,#-12]!  ;save F6
       STFE   F5,[sp,#-12]!  ;save F5
       STFE   F4,[sp,#-12]!  ;save F4
       BL     DW_chk         ;check file & fonts
       BNE    err
;            find # segments
       LDFS   F2,fac
       FMLS   F2,F2,F1
       FIXP  R6,F2          ;NSEG
       FLTS   F2,R6
       FDVS   F1,F1,F2       ;DTH per segment
       LDFS   F2,[R1]        ;RADIUS
;            get Bezier length
       FDVS   F3,F1,#4       ;DTH/4
       TANS   F3,F3          ;TAN(DTH/4)
       LDFS   F4,fourb3
       FMLS   F3,F3,F4       ;ALPHA = (4/3) * TAN(DTH/4)
       COSS   F4,F0          ;CT2
       SINS   F5,F0          ;ST2
       COSS   F6,F1          ;COS(DTH)
       SINS   F7,F1          ;SIN(DTH)
       FMLS   F4,F4,F2       ;R*COS(TH)
       FMLS   F5,F5,F2       ;R*SIN(TH)
       STFS   F6,iblock      ;save R*COS(DTH)
       ADR    R7,xytemp+8    ;address XYT(2)
       STFS   F4,[R7],#4     ;store XT(2)
       STFS   F5,[R7],#4     ;store YT(2)
       CMP    R5,#1          ;if IFIRST=1
       MOVEQ  ip,#0
       STREQ  ip,xytemp      ;coordinates of centre
       STREQ  ip,xytemp+4
;             loop over segments
       MOV    R3,R6          ;segment count
       MOV    R2,#2          ;initialise NPT
lp1    MVFS   F0,F4          ;CT1
       MVFS   F1,F5          ;ST1
       FMLS   F4,F0,F6       ;CT1*CDT
       FMLS   F2,F1,F7       ;ST1*SDT
       SUFS   F4,F4,F2       ;CT2
       FMLS   F5,F1,F6       ;ST1*CDT
       FMLS   F2,F0,F7       ;CT1*SDT
       ADFS   F5,F5,F2       ;ST2
       LDFS   F6,[R7,#-8]    ;previous XT
       FMLS   F2,F1,F3       ;ALPHA * ST1
       SUFS   F6,F6,F2
       STFS   F6,[R7],#4     ;store 1st Bezier X
       LDFS   F6,[R7,#-8]
       FMLS   F2,F0,F3       ;ALPHA * CT1
       ADFS   F6,F6,F2
       STFS   F6,[R7],#4     ;store 1st Bezier Y
       FMLS   F2,F5,F3
       ADFS   F2,F2,F4
       STFS   F2,[R7],#4     ;store 2nd Bezier X
       FMLS   F2,F4,F3
       SUFS   F2,F5,F2
       STFS   F2,[R7],#4     ;store 2nd Bezier Y
       STFS   F4,[R7],#4     ;store X
       STFS   F5,[R7],#4     ;store Y
       ADD    R2,R2,#3       ;count points
       SUBS   R3,R3,#1
       LDFGTS F6,iblock      ;restore R*COS(DTH)
       BGT    lp1
       ADR    R3,xytemp-8
       ADD    R3,R3,R5,LSL#3 ;pointer to XT(IFIRST)
       LDFS   F0,[R0]        ;XC
       LDFS   F1,[R0,#4]     ;YC
       LDFS   F2,[R3]
       ADFS   F2,F2,F0
       STFS   F2,[R3],#4     ;translate first X
       LDFS   F3,[R3]
       ADFS   F3,F3,F1
       STFS   F3,[R3],#4     ;translate first Y
       MVFS   F4,F2          ;XMAX
       MVFS   F5,F3          ;YMAX
;              loop through rest of points
pt2    LDFS   F6,[R3]
       ADFS   F6,F6,F0
       STFS   F6,[R3],#4
       LDFS   F7,[R3]
       ADFS   F7,F7,F1
       STFS   F7,[R3],#4
       CMFE   F6,F2          ;keep min and max
       MVFLTS F2,F6
       CMFE   F6,F4
       MVFGTS F4,F6
       CMFE   F7,F3
       MVFLTS F3,F7
       CMFE   F7,F5
       MVFGTS F5,F7
       CMP    R3,R7
       BLT    pt2
       LDFS   F0,xlow
       LDFS   F1,ylow
       CMFE   F2,F0
       CMFGE  F3,F1
       LDFGES F0,xhigh
       LDFGES F1,yhigh
       CMFGE  F0,F4
       CMFGE  F1,F5
       MOVLT  R0,#-1
       BLT    err
;         find number of entries in path
       ADD    R0,R6,R2,LSL#1
       SUB    R0,R0,R5
       SUB    R0,R0,R5,LSL#1
       ADD    R0,R0,#6
       CMP    R4,#0
       ADDNE  R0,R0,#1           ;# words in path
       ADR    R1,xytemp+240      ;adress of XYMM
       STFS   F2,[R1]
       STFS   F3,[R1,#4]
       STFS   F4,[R1,#8]
       STFS   F5,[R1,#12]
       BL     DW_head
       BNE    err
       MOV    R0,#2
       BL     DW_wrd
       BNE    err
       ADR    R3,xytemp-8
       ADD    R3,R3,R5,LSL#3 ;pointer to XT(IFIRST)
       MOV    R1,R5
;             write out path
lp3    CMP    R1,#3
       MOVEQ  R1,#0
       MOVEQ  R0,#6
       BLEQ   DW_wrd         ;write out 'Bezier'
       ADD    R1,R1,#1
       MOV    R0,R3
       BL     DW_wrpt        ;write coord pair
       ADD    R3,R3,#8
       CMP    R5,#1
       MOVEQ  R0,#8
       BLEQ   DW_wrd
       ADD    R5,R5,#1
       CMP    R5,R2
       BLE    lp3
       CMP    R4,#0
       MOVNE  R0,#5
       BLNE   DW_wrd
       MOV    R0,#0
       BL     DW_wrd
err    LDFE   F4,[sp],#12    ;restore F4
       LDFE   F5,[sp],#12    ;restore F5
       LDFE   F6,[sp],#12    ;restore F6
       LDFE   F7,[sp],#12    ;restore F7
err1   STR    R0,[R8]        ;store error
       LDMDB  fp,{R4-R9,fp,sp,pc} 
twopi  DCFS   6.28318531
;           f1 is slightly less than 2/PI
fac    DCFS   0.6366
fourb3 DCFS   1.33333333
       END
;
       TTL DWCurv
       GET   s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwcurv_;(XY,N,CLOSE,IERR)
       IMPORT DW_head
       IMPORT dwpoly_
       IMPORT DW_wrpt
       IMPORT DW_wrd
       IMPORT DW_chk
;
dwcurv_
       LDR    ip,[R1]        ;get N
       CMP    ip,#3
       BLT    dwpoly_        ;do straight lines if <3
       B      dwc1
       DCB    "dwcurv_",0,8,0,0,255
dwc1   MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       STFE   F7,[sp,#-12]!  ;save F7
       STFE   F6,[sp,#-12]!  ;save F6
       STFE   F5,[sp,#-12]!  ;save F5
       STFE   F4,[sp,#-12]!  ;save F4
       BL     DW_chk
       BNE    err
       ADR    R7,xytemp
       LDMIA  R0,{R3,R4}     ;X(1),Y(1)
       LDMIA  R0,{R5,R6}
       STMIA  R7,{R3-R6}     ;initialize xmin,ymin,xmax,ymax
       LDR    R1,[R1]        ;N
       LDR    R2,[R2]        ;CLOSE
       MOV    R3,R1          ;NPT = N
       CMP    R2,#0
       ADDNE  R3,R1,#1       ;or NPT = N+1 if CLOSE istrue
       MOV    R4,#1          ;initialise ipass = 1
lp1    CMP    R2,#0
       SUBNE  R5,R1,#1       ;point N
       MOVNE  R6,#0          ;point 1
       MOVEQ  R5,#0
       MOVEQ  R6,#1
       BL     l_theta
       MOV    ip,#1          ;count of points
lp2    MOV    R8,ip          ;set IPT = IP
       CMP    ip,R1
       MOVGT  R8,#1
       MVFS   F4,F6          ;TL1 = TL2
       MVFS   F5,F7          ;TH1 = TH2
       CMP    R2,#0          ;test close
       SUBNE  R5,R1,#1       ;point N
       MOVNE  R6,#0          ;point 1
       SUBEQ  R5,R1,#2       ;point N-1
       SUBEQ  R6,R1,#1       ;point N
       CMP    R8,R1
       SUBNE  R5,R8,#1       ;point IPT
       MOVNE  R6,R8          ;point IPT+1
       BL     l_theta
;               find the angle of the tangent
;               assuming theta in the range -pi to +pi
       SUFS   F0,F5,F7
       LDFS   F1,pi
       ABSS   F0,F0
       CMFE   F0,F1
       ADFS   F0,F5,F7
       FMLS   F0,F0,#0.5
       ADFGTS F0,F0,F1
       COSS   F2,F0
       SINS   F3,F0
       LDFS   F5,alpha
       FMLS   F2,F2,F5      ;cos(theta)*alpha
       FMLS   F3,F3,F5      ;sin(theta)*alpha
       ADD    lr,R0,R8,LSL#3;pointer to X(IPT+1)
       CMP    R4,#2
       LDFS   F0,[lr,#-8]   ;X(IPT)
       FMLS   F5,F4,F2      ;TL1 * ACTH
       SUFS   F5,F0,F5      ;X(IPT) - TL1 * ACTH
       STFEQS F5,[R7,#20]   ;store in XTEMP(1)
       LDFS   F1,[lr,#-4]   ;Y(IPT)
       FMLS   F4,F4,F3      ;TL1 * ASTH
       SUFS   F4,F1,F4      ;Y(IPT) - TL1 * ASTH
       STFEQS F4,[R7,#24]   ;store in YTEMP(1)
       FMLS   F2,F6,F2      ;TL2 * ACTH
       ADFS   F2,F0,F2      ;X(IPT) + TL2 * ACTH
       STFEQS F2,[R7,#28]   ;store in XTEMP(2)
       FMLS   F3,F6,F3      ;TL2 * ASTH
       ADFS   F3,F1,F3      ;Y(IPT) + TL2 * ASTH
       STFEQS F3,[R7,#32]   ;store in YTEMP(2)
       BEQ    pass2
;               first pass, calculate min and max
       STFS   F7,[sp,#-4]!  ;save F7 (TH2)
       CMP    R8,#1
       MVFEQS F4,F3         ;on first point, don't check first Bezier point
       MVFEQS F5,F2
       CMP    R8,R3         ;on last point, don't check second Bezier point
       MVFEQS F3,F4
       MVFEQS F2,F5
       LDFS   F7,[R7]       ;xmin
       CMFE   F7,F0
       MVFGTS F7,F0
       CMFE   F7,F5
       MVFGTS F7,F5
       CMFE   F7,F2
       MVFGTS F7,F2
       STFS   F7,[R7]       ;new xmin
       LDFS   F7,[R7,#8]    ;xmax
       CMFE   F7,F0
       MVFGTS F0,F7
       CMFE   F0,F5
       MVFLTS F0,F5
       CMFE   F0,F2
       MVFLTS F0,F2
       STFS   F0,[R7,#8]    ;new xmax
       LDFS   F2,[R7,#4]    ;ymin
       CMFE   F2,F1
       MVFGTS F2,F1
       CMFE   F2,F3
       MVFGTS F2,F3
       CMFE   F2,F4
       MVFGTS F2,F4
       STFS   F2,[R7,#4]    ;new ymin
       LDFS   F5,[R7,#12]   ;ymax
       CMFE   F5,F1
       MVFLTS F5,F1
       CMFE   F5,F3
       MVFLTS F5,F3
       CMFE   F5,F4
       MVFLTS F5,F4
       STFS   F5,[R7,#12]   ;new ymax
       ADD    ip,ip,#1      ;increment IP
       CMP    ip,R1         ;compare with N
       LDFS   F7,[sp],#4    ;restore F7
       BLE    lp2           ;loop over points
;              at end of first pass check boundaries
       LDFS   F7,[R7]       ;xmin
       LDFS   F1,xlow
       CMFE   F7,F1         ;compare with xlow
       LDFGES F6,ylow
       CMFGE  F2,F6         ;compare ymin with ylow
       LDFGES F1,xhigh
       CMFGE  F1,F0         ;compare xmax with xhigh
       LDFGES F6,yhigh
       CMFGE  F6,F5         ;compare ymax with yhigh
       MOVLT  R0,#-1
       BLT    err           ;outside boundaries
;              write out header
       STMFD  sp!,{R0-R3}   ;save R0 etc
       RSB    R0,R3,R3,LSL#3;NPT*7
       SUB    R0,R0,#3
       CMP    R2,#0
       ADDNE  R0,R0,#1      ;path length
       MOV    R1,R7         ;address of xmin etc.
       BL     DW_head       ;write out header
       MOV    R5,R0         ;save possible error #
       LDMFD  sp!,{R0-R3}   ;restore R0 etc
       MOVNE  R0,R5
       BNE    err           ;error in DWHEAD
       MOV    R4,#2
       B      lp1           ;now do pass 2
pass2;                second pass, write out point
       STMFD  sp!,{R0-R3,ip}   ;save R0 etc
       ADD    R6,R0,R8,LSL#3   ;pointer to X(IPT+1)
       CMP    ip,#1            ;check if first point
       MOVEQ  R0,#2
       BLEQ   DW_wrd           ;write 'move'
       CMP    ip,#1            ;check if first point
       ADDNE  R0,R7,#20        ;pointer to X2
       BLNE   DW_wrpt          ;if not, write out second Bezier point
       SUB    R0,R6,#8         ;pointer to X(IPT)
       BL     DW_wrpt          ;write out point
       CMP    ip,R3            ;check for real point
       MOVLT  R0,#6
       BLLT   DW_wrd           ;'bezier'
       CMP    ip,R3            ;check for real point
       ADDLT  R0,R7,#28
       BLLT   DW_wrpt          ;write out first Bezier point
       LDMFD  sp!,{R0-R3,ip}   ;restore R0 etc
       ADD    ip,ip,#1      ;increment IP
       CMP    ip,R3         ;compare with NPT
       BLE    lp2           ;loop over points
;             at end of second pass
       CMP    R2,#0
       MOVNE  R0,#5
       BLNE   DW_wrd       ;write out 'close sub-path
       MOV    R0,#0
       BL     DW_wrd       ;write out end path
err;
       LDFE   F4,[sp],#12   ;restore F4
       LDFE   F5,[sp],#12   ;restore F5
       LDFE   F6,[sp],#12   ;restore F6
       LDFE   F7,[sp],#12   ;restore F7
       LDR    R8,[sp,#12]   ;address of IERR
       STR    R0,[R8]       ;store error
       LDMDB  fp,{R4-R9,fp,sp,pc} 
l_theta; calculate length and angle into F6,F7
       ; from point R5 to point R6
       ; uses F0,F1
       ADD    R5,R0,R5,LSL#3  ;address of X(I)
       ADD    R6,R0,R6,LSL#3  ;address of X(J)
       LDFS   F0,[R5]         ;X(I)
       LDFS   F1,[R6]         ;X(J)
       SUFS   F0,F1,F0        ;DX
       LDFS   F7,[R5,#4]      ;Y(I)
       LDFS   F1,[R6,#4]      ;Y(J)
       SUFS   F1,F1,F7        ;DY
       FMLS   F7,F0,F0
       FMLS   F6,F1,F1
       ADFS   F6,F7,F6
       CMFE   F6,#0           ;check for zero length
       MOVLE  R0,#-14
       BLE    err             ;return error
       SQTS   F6,F6           ;length
       POLS   F7,F0,F1        ;atan2(DY,DX)
       MOV    pc,lr
;           alpha is 2/3(2-SQRT(2))
alpha  DCFS   0.3905242
pi     DCFS   3.1415927
       END
;
       TTL DWElip
       GET   s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwelip_;(XYC,A,B,THETA,IERR)
       IMPORT DW_head
       IMPORT DW_wrpt
       IMPORT DW_chk
       IMPORT DW_wrd
;
       DCB    "dwelip_",0,8,0,0,255
dwelip_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R8,[ip]        ;address of IERR
       STFE   F7,[sp,#-12]!  ;save F7
       STFE   F6,[sp,#-12]!  ;save F6
       STFE   F5,[sp,#-12]!  ;save F5
       STFE   F4,[sp,#-12]!  ;save F4
       BL     DW_chk         ;check file & fonts
       BNE    err
       LDFS   F2,[R1]        ;A
       LDFS   F3,[R2]        ;B
       LDFS   F4,[R3]        ;THETA
       SINS   F5,F4          ;SIN(THETA)
       COSS   F4,F4          ;COS(THETA)
       ADR    lr,xytemp      ;space for coordinates
       ADR    ip,alpha
       LDMIA  ip,{R1-R6}     ;get 6 coordinates
       STMIA  lr!,{R1-R6}    ;store coordinates
       ADR    R4,xytemp
       MOV    ip,#12         ;12 coordinate pairs to rotate
lp1    LDMIA  R4!,{R2,R3}
       EOR    R1,R3,#&80000000;x = -y
       STMIA  lr!,{R1,R2}
       SUBS   ip,ip,#1
       BGT    lp1            ;get all circle
;              transform to ellipse
       MOV    ip,#12         ;12 points
       ADR    lr,xytemp      ;space for coordinates
lp2    LDFS   F6,[lr]        ;x
       LDFS   F7,[lr,#4]     ;y
       FMLS   F6,F6,F2       ;expand
       FMLS   F7,F7,F3
       FMLS   F0,F6,F4       ;x*cos(th)
       FMLS   F1,F7,F5       ;y*sin(th)
       SUFS   F0,F0,F1
       LDFS   F1,[R0]        ;XC
       ADFS   F0,F1,F0       ;translate
       STFS   F0,[lr],#4     ;store new x
       FMLS   F0,F7,F4       ;y*cos(th)
       FMLS   F1,F6,F5       ;x*sin(th)
       ADFS   F0,F0,F1
       LDFS   F1,[R0,#4]     ;YC
       ADFS   F1,F0,F1       ;translate
       STFS   F1,[lr],#4     ;store new y
       SUBS   ip,ip,#1
       BGT    lp2            ;loop over points
;                  find min and max
       ADR    lr,xytemp      ;space for coordinates
       LDFS   F0,[lr],#4     ;xmin
       LDFS   F1,[lr],#4     ;ymin
       MVFS   F2,F0          ;xmax
       MVFS   F3,F1          ;ymax
       MOV    ip,#11         ;11 more points
lp3    LDFS   F4,[lr],#4     ;x
       LDFS   F5,[lr],#4     ;y
       CMFE   F4,F0
       MVFLTS F0,F4          ;set min(x)
       CMFE   F5,F1
       MVFLTS F1,F5          ;set min(y)
       CMFE   F4,F2
       MVFGTS F2,F4          ;set max(x)
       CMFE   F5,F3
       MVFGTS F3,F5          ;set max(y)
       SUBS   ip,ip,#1
       BGT    lp3
       MOV    R1,lr          ;address of XYMM
       STFS   F0,[lr],#4     ;store XYMM
       STFS   F1,[lr],#4
       STFS   F2,[lr],#4
       STFS   F3,[lr]
;                compare with boundaries
       LDFS   F4,xlow
       LDFS   F5,ylow
       LDFS   F6,xhigh
       LDFS   F7,yhigh
       CMFE   F0,F4
       CMFGE  F6,F2
       CMFGE  F1,F5
       CMFGE  F7,F3
       MOVLT  R0,#-1
       BLT    err            ;outside boundaries
       MOV    R0,#33
       BL     DW_head        ;write out header
       BNE    err
       MOV    R0,#2
       BL     DW_wrd         ;'move' command
       ADR    R0,xytemp+88   ;last coordinate pair
       BL     DW_wrpt        ;move to first point
       MOV    R4,#4          ;4 triplets
       ADR    R6,xytemp      ;first coordinate address
lp4    MOV    R0,#6
       BL     DW_wrd         ;write Bezier heade
       MOV    R5,#3          ;3 coordinate pairs
lp5    MOV    R0,R6
       BL     DW_wrpt        ;write out point
       ADD    R6,R6,#8
       SUBS   R5,R5,#1
       BGT    lp5
       SUBS   R4,R4,#1
       BGT    lp4
       MOV    R0,#5
       BL     DW_wrd         ;close sub-path
       BL     DW_wrd         ;end path
err    STR    R0,[R8]        ;store error
       LDFE   F4,[sp],#12    ;restore F4
       LDFE   F5,[sp],#12    ;restore F5
       LDFE   F6,[sp],#12    ;restore F6
       LDFE   F7,[sp],#12    ;restore F7
       LDMDB  fp,{R4-R9,fp,sp,pc} 
;             ALPHA is 4/3((1-COS(45)/SIN(45))
alpha  DCFS   1.
       DCFS   0.55228475
       DCFS   0.55228475
       DCFS   1.
       DCFS   0.
       DCFS   1.
       END
;
       TTL DWFont
       GET   s.DWcommon
Font_FindFont EQU &60081
Font_LoseFont EQU &60082
OS_Args       EQU &20009
       AREA   DW_code,CODE,READONLY
       EXPORT dwfont_;(FONTNM,IHFONT)
;
       DCB    "dwfont_",0,8,0,0,255
dwfont_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    R9,comptr      ;base of common
       LDR    R1,idhand
       CMP    R1,#0
       MOV    lr,#0
       BEQ    err            ;file not opened
       LDR    R8,mxfont      ;maximum font defined
       CMP    R8,#0
       MOV    lr,#-10
       BGT    err            ;font object already written
       MOV    R0,#0
       SWI    OS_Args        ;find sequential file pointer
       CMP    R2,#40
       BGT    err            ;font object already written
       RSB    ip,R8,#1
       ADR    R7,flname
lp1    LDRB   lr,[R7],#1
       CMP    lr,#0
       SUBEQS ip,ip,#1
       BNE    lp1            ;find end of last font name
       LDMIA  sp,{R0-R2}     ;restore args
       ADD    ip,R2,R7
       ADR    lr,endcom
       CMP    ip,lr
       MOVGE  lr,#-9
       BGE    err
       MOV    R1,R7          ;pointer to font name
lp2    LDRB   ip,[R0],#1
       STRB   ip,[R7],#1     ;move in new font name
       SUBS   R2,R2,#1
       BGT    lp2
       STRB   R2,[R7]        ;null terminate
       MOV    R2,#1          ;.1-point
       MOV    R3,#1          ;.1-point
       MOV    R4,#0
       MOV    R5,#0
       SWI    Font_FindFont  ;look for font
       MOVVS  lr,#-2
       BVS    err
       SWI    Font_LoseFont  ;drop font
       SUB    R8,R8,#1
       STR    R8,mxfont      ;increment font count
       RSB    lr,R8,#0
err    LDR    R1,[sp,#4]     ;address of IHFONT
       STR    lr,[R1]
       LDMDB  fp,{R4-R9,fp,sp,pc} 
comptr DCD   DW_common
       AREA DW_common,COMMON,NOINIT
       %    lencom
       END
;
       TTL DWHead
       GET   s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT DW_head;(LPATH,XYMM)
       IMPORT DW_writ
       IMPORT DW_wrpt
;
DW_head
       STMFD  sp!,{R1,R9,lr}
       MOV    lr,#16          ;init LHEAD
       LDR    ip,lstyle
       TST    ip,#&80         ;test for dash pattern
       LDRNE  ip,ipatn+4
       ADDNE  lr,lr,ip,LSL#2
       ADDNE  lr,lr,#8        ;LHEAD (*4)
       MOV    ip,R0           ;LPATH
       ADD    ip,ip,#6
       ADD    ip,lr,ip,LSL#2  ;block length
       MOV    R1,#2           ;block type
       ADR    R0,iblock
       STMIA  R0,{R1,ip,lr}   ;store block type, length & header length
       ADR    R1,eight
       BL     DW_writ         ;write out first two words
       LDREQ  R0,[sp]         ;address of (xmin,ymin)
       BLEQ   DW_wrpt
       LDREQ  R0,[sp]         ;address of (xmin,ymin)
       ADDEQ  R0,R0,#8        ;address of (xmax,ymax)
       BLEQ   DW_wrpt
       ADREQ  R0,kfill
       ADREQ  R1,iblock+8     ;address of header length
       BLEQ   DW_writ         ;write out header
       LDMFD  sp!,{R1,R9,pc}
eight  DCD    8
       END
;
       TTL DWJPEG
       GET   s.DWcommon
OS_ReadDynamicArea  EQU    &5C
OS_ReadModeVariable EQU    &35
Wimp_BaseOfSprites  EQU &400EA
       AREA   DW_code,CODE,READONLY
       EXPORT dwjpeg_;(JPG,LJPG,XY,IERR)
       IMPORT DW_chk
       IMPORT DW_wrpt
       IMPORT DW_writ
       IMPORT DW_wrd
       IMPORT dwjpsz_
;
       DCB    "dwjpeg_",0,8,0,0,255
dwjpeg_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk         ;check file & fonts
       BNE    err            ;R0 reset if error
       SUB    sp,sp,#8
       MOV    R2,sp
       BL     dwjpsz_
       ADD    sp,sp,#8
       CMP    R0,#0
       BNE    err
;            F1 is width, F0 is height
       LDMIA  sp,{R0-R3}     ;restore registers
;            define bounding box
       LDFS   F2,[R2]        ;left x
       LDFS   F3,xlow
       CMFE   F3,F2
       ADFLES F1,F1,F2       ;right x
       LDFLES F3,xhigh
       CMFLE  F1,F3
       LDFLES F2,[R2,#4]     ;bottom y
       LDFLES F3,ylow
       CMFLE  F3,F2
       ADFLES F2,F2,F0       ;top edge
       LDFLES F0,yhigh
       CMFLE  F2,F0
       MOVGT  R0,#-1
       BGT    err            ;jpeg outside area
       STFS   F1,xytemp      ;store right x
       STFS   F2,xytemp+4    ;store top y
;            jpeg is OK, write it out
       MOV    R0,#16
       BL     DW_wrd         ;object type 16
       BNE    err
       LDR    R8,[R1]        ;length of jpeg
       ADD    R7,R8,#3
       BIC    R7,R7,#3       ;rounded up to words
       ADD    R0,R7,#68      ;header length 
       BL     DW_wrd         ;write out length
       BNE    err
       MOV    R0,R2
       BL     DW_wrpt        ;write out lower left corner
       BNE    err
       ADR    R0,xytemp
       BL     DW_wrpt        ;write out upper right corner
       BNE    err
       LDR    R0,xytemp+8
       BL     DW_wrd         ;write out width in Draw units
       BNE    err
       LDR    R0,xytemp+12
       BL     DW_wrd         ;write out height in Draw units
       BNE    err
       MOV    R0,#90         ;pixel density
       BL     DW_wrd
       BNE    err
       MOV    R0,#90         ;pixel density
       BL     DW_wrd
       BNE    err
       MOV    R0,#&10000     ;transfomation matrix (6 words)
       BL     DW_wrd
       BNE    err
       BL     DW_wrd
       BNE    err
       BL     DW_wrd
       BNE    err
       MOV    R0,#&10000
       BL     DW_wrd
       BNE    err
       MOV    R0,R2
       BL     DW_wrpt        ;write out lower left corner
       BNE    err
       MOV    R0,R8          ;length of jpeg image
       BL     DW_wrd
       BNE    err
;                      now send the jpeg
       STR    R7,xytemp
       LDR    R0,[sp]
       ADR    R1,xytemp
       BL     DW_writ        ;write out jpeg
err    LDR    R3,[sp,#12]    ;address of IERR
       STR    R0,[R3]        ;store error
       LDMDB  fp,{R4-R9,fp,sp,pc} 
       END
;
       TTL DWJPSZ
       GET   s.DWcommon
OS_ReadModeVariable EQU    &35
       AREA   DW_code,CODE,READONLY
       EXPORT dwjpsz_;(JPG,LJPG,XY,IERR)
       IMPORT DW_chk
;
       DCB    "dwjpsz_",0,8,0,0,255
dwjpsz_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk         ;check file & fonts
       BNE    err            ;R0 reset if error
;             check for JPEG format
       LDR    R6,[R1]        ;LJPG
       ADD    R6,R6,R0
       ADR    R4,intr
       MOV    R5,#9
lp1    LDRB   ip,[R0,R5]
       LDRB   lr,[R4,R5]
       CMP    ip,lr
       MOVNE  R0,#2
       BNE    err
       SUBS   R5,R5,#1
       BGE    lp1
;          get dimensions of jpeg image
       ADD    R5,R0,#2
lp2
       LDRB   ip,[R5]
       CMP    ip,#255
       MOVNE  R0,#3
       BNE    err
       LDRB   ip,[R5,#1]
       CMP    ip,#&C0
       BEQ    pt1
       LDRB   ip,[R5,#2]
       LDRB   lr,[R5,#3]
       ADD    lr,lr,ip,LSL#8
       ADD    R5,R5,lr
       ADD    R5,R5,#2
       CMP    R5,R6
       BLT    lp2
       MOV    R0,#4
       B      err
pt1    LDRB   ip,[R5,#5]
       LDRB   lr,[R5,#6]
       ADD    R4,lr,ip,LSL#8
;          R4 is height in pixels
       LDRB   ip,[R5,#7]
       LDRB   lr,[R5,#8]
       ADD    R3,lr,ip,LSL#8
;          R3 is width in pixels
       MOV    R0,#-1
       MOV    R1,#4
       SWI    OS_ReadModeVariable;get log_2(# OS units/x-pixel)
       ADD    R2,R2,#8
       MOV    R3,R3,LSL R2   ;width in draw units
       STR    R3,xytemp+8    ;for dwjpeg
       MOV    R1,#5
       SWI    OS_ReadModeVariable;get log_2(# OS units/y-pixel)
       ADD    R2,R2,#8
       MOV    R4,R4,LSL R2   ;height in draw units
       STR    R4,xytemp+12
;            define bounding box
       LDFS   F3,rscl        ;scale draw to user coordinates
       FLTS   F1,R3
       FLTS   F0,R4
       FMLS   F1,F1,F3       ;width in user coordinates
       FMLS   F0,F0,F3       ;height in user coordinates
       LDR    R2,[sp,#8]     ;restore pointer to XY
       STFS   F1,[R2]        ;store width
       STFS   F0,[R2,#4]     ;store height
       MOV    R0,#0
err    LDR    R3,[sp,#12]    ;address of IERR
       STR    R0,[R3]        ;store error
       LDMDB  fp,{R4-R9,fp,sp,pc} 
intr   DCB    &FF,&D8,&FF,&E0,&00,&10,&4A,&46,&49,&46
       END
;
       TTL    DWPoly
       GET    s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwpoly_;(XY,N,CLOSE,IERR)
       IMPORT DW_head
       IMPORT DW_wrd
       IMPORT DW_wrpt
       IMPORT DW_chk
;
       DCB    "dwpoly_",0,8,0,0,255
dwpoly_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       STFE   F4,[sp,#-12]!  ;save F4
       BL     DW_chk         ;check file & fonts
       BNE    err
       MOV    R7,R3          ;save address of IERR
       MOV    R4,R0          ;save address of XY
       LDR    R5,[R1]        ;N
       SUBS   R1,R5,#1
       MOVLE  R0,#-6
       BLE    err            ;less than two points
; get xmin and xmax
       MOV    ip,R4          ;address of x
       LDFS   F0,[ip],#4     ;initialise xmin
       LDFS   F2,[ip],#4     ;initialise ymin
       MVFS   F1,F0          ;initialise xmax
       MVFS   F3,F2          ;initialise ymax
lp1    LDFS   F4,[ip],#4
       CMFE   F4,F0
       MVFLTS F0,F4          ;get xmin
       CMFE   F4,F1
       MVFGTS F1,F4          ;get xmax
       LDFS   F4,[ip],#4
       CMFE   F4,F2
       MVFLTS F2,F4          ;get ymin
       CMFE   F4,F3
       MVFGTS F3,F4          ;get ymax
       SUBS   R1,R1,#1
       BGT    lp1
       LDFS   F4,xlow
       CMFE   F0,F4
       LDFGES F4,ylow
       CMFGE  F2,F4
       LDFGES F4,xhigh
       CMFGE  F4,F1
       LDFGES F4,yhigh
       CMFGE  F4,F3
       MOVLT  R0,#-1
       BLT    err
       ADR    R1,flname+480  ;space for xmin,ymin etc.
       STFS   F0,[R1]        ;store xmin etc.
       STFS   F2,[R1,#4]
       STFS   F1,[R1,#8]
       STFS   F3,[R1,#12]
       ADD    R0,R5,R5,LSL#1 ;3N
       ADD    R0,R0,#1       ;allow for end path
       LDR    R8,[R2]        ;CLOSE
       CMP    R8,#0
       ADDNE  R0,R0,#1
       BL     DW_head
       BNE    err
       MOV    R0,#2          ;'move'
lp3    BL     DW_wrd         ;write header
       BNE    err
       MOV    R0,R4          ;address of xy
       BL     DW_wrpt
       ADD    R4,R4,#8
       SUBS   R5,R5,#1
       MOVGT  R0,#8          ;'draw'
       BGT    lp3            ;loop over points
       CMP    R8,#0
       MOVNE  R0,#5          ;'close'
       BLNE   DW_wrd         ;write out close
       MOV    R0,#0          ;'end path'
       BL     DW_wrd         ;write out end path
err    STR    R0,[R7]        ;store error
       LDFE   F4,[sp],#12    ;restore F4
       LDMDB  fp,{R4-R9,fp,sp,pc} 
       END
;
       TTL DWSprt
       GET   s.DWcommon
OS_ReadDynamicArea  EQU    &5C
OS_ReadModeVariable EQU    &35
Wimp_BaseOfSprites  EQU &400EA
       AREA   DW_code,CODE,READONLY
       EXPORT dwsprt_;(IAREA,SPNAME,XY,IERR)
       IMPORT DW_chk
       IMPORT DW_wrpt
       IMPORT DW_writ
       IMPORT DW_wrd
;
       DCB    "dwsprt_",0,8,0,0,255
dwsprt_
       MOV    ip,sp
       STMDB  sp!,{R0-R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk         ;check file & fonts
       BNE    err            ;R0 reset if error
       LDR    R4,[fp,#4]     ;length of name
       LDR    R5,[R0]        ;1st word of sprite area
       CMP    R5,#0
       BGT    spt2
       BEQ    spt1
       SWI    Wimp_BaseOfSprites
       RSB    R5,R1,#0       ;-base of RMA area
       B      spt2
spt1   MOV    R0,#3          ;system area, get location
       SWI    OS_ReadDynamicArea
       CMP    R1,#0
       MOVEQ  R0,#-15
       BEQ    err            ;no system area
spt2   LDMIB  sp,{R1,R2}     ;restore registers
rma    LDR    R3,[R0,#4]     ;# sprites in area
       LDR    R8,[R0,#8]     ;offset to 1st sprite
lp1    ADD    R0,R0,R8       ;address of sprite
       SUBS   R3,R3,#1       ;count sprites
       BLT    nf
       LDR    R8,[R0]        ;offset to next sprite
       ADD    R6,R0,#4       ;pointer to name
       MOV    ip,R4          ;length of name
       MOV    lr,#0          ;null termination
       CMP    ip,#12
lp2    LDRNEB R7,[R6,ip]
       CMPNE  lr,R7
       BNE    lp1
       SUBS   ip,ip,#1
       LDRGEB lr,[R1,ip]
       BGE    lp2
;             found match, first get dimensions of sprite
       MOV    R8,R0          ;address of sprite
       LDR    R0,[R8,#40]    ;screen mode
       MOV    R1,#9
       SWI    OS_ReadModeVariable;get log_2(# bits/pixel)
       LDR    R3,[R8,#28]    ;last bit used
       LDR    R4,[R8,#24]    ;first bit used
       SUB    R3,R3,R4
       ADD    R3,R3,#1
       LDR    R4,[R8,#16]    ;width in words -1
       ADD    R3,R3,R4,LSL#5 ;width in bits
       MOV    R3,R3,LSR R2   ;width in pixels
       MOV    R1,#4
       SWI    OS_ReadModeVariable;get log_2(# OS units/x-pixel)
       ADD    R2,R2,#8
       MOV    R3,R3,LSL R2   ;width in draw units
       LDR    R4,[R8,#20]
       ADD    R4,R4,#1       ;height in pixels
       MOV    R1,#5
       SWI    OS_ReadModeVariable;get log_2(# OS units/y-pixel)
       ADD    R2,R2,#8
       MOV    R4,R4,LSL R2   ;height in draw units
       LDR    R2,[sp,#8]     ;restore pointer to XY
;            define bounding box
       LDFS   F3,rscl        ;scale draw to user coordinates
       LDFS   F0,[R2]        ;left x
       LDFS   F1,xlow
       CMFE   F1,F0
       LDFLES F2,[R2,#4]     ;bottom y
       LDFLES F1,ylow
       CMFLE  F1,F2
       FLTLES F1,R3
       FMLLES F1,F1,F3       ;width in user coordinates
       ADFLES F1,F1,F0       ;right hand edge
       FLTLES F0,R4
       FMLLES F0,F0,F3       ;height in user coordinates
       ADFLES F2,F2,F0       ;top edge
       LDFLES F0,xhigh
       CMFLE  F1,F0
       LDFLES F0,yhigh
       CMFLE  F2,F0
       MOVGT  R0,#-1
       BGT    err            ;sprite outside area
       STFS   F1,xytemp      ;store top right corner in xytemp
       STFS   F2,xytemp+4
;            sprite is OK, write it out
       MOV    R0,#5
       BL     DW_wrd         ;object type 5
       BNE    err
       LDR    R0,[R8]        ;length of sprite
       ADD    R0,R0,#24      ;header length
       BL     DW_wrd         ;write out length
       BNE    err
       MOV    R0,R2
       BL     DW_wrpt        ;write out lower left corner
       BNE    err
       ADR    R0,xytemp
       BL     DW_wrpt        ;write out upper right corner
       BNE    err
       MOV    R1,R8          ;pointer to # bytes in sprite
       MOV    R0,R8          ;pointer to sprite
       BL     DW_writ        ;write out sprite
       B      err
nf     RSBS   R0,R5,#0
       MOVGT  R5,#0
       BGT    rma            ;search RMA sprites
       MOV    R0,#-15
err    LDR    R3,[sp,#12]    ;address of IERR
       STR    R0,[R3]        ;store error
       LDMDB  fp,{R4-R9,fp,sp,pc} 
       END
;
       TTL    DWszxy
       GET    s.DWcommon
Font_FindFont    EQU &60081
Font_LoseFont    EQU &60082
Font_StringBBox  EQU &60097
       AREA   DW_code,CODE,READONLY
       EXPORT dwszxy_;(STRING,XY,IERR)
       IMPORT DW_chk
;
       DCB    "dwszxy_",0,8,0,0,255
dwszxy_
       MOV    ip,sp
       STMDB  sp!,{R0-R5,R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk
       BNE    err
       CMP    R3,#255
       MOVGT  R3,#255        ;limit string to 255 characters
lp1    SUBS   R3,R3,#1
       LDRGEB lr,[R0,R3]
       CMPGE  lr,#" "
       BEQ    lp1            ;find last non-blank
       ADDS   R3,R3,#1
       ADDEQ  R3,R3,#1       ;allow for single blank
       LDR    R5,ktstyl
       CMP    R5,#0
       BGT    font
       STR    R5,[R1],#4     ;XY(1)=0
       STR    R5,[R1],#4     ;XY(2)=0
       LDR    ip,kfxsiz
       MUL    ip,R3,ip
       MOV    R5,#2          ;two points to store
       LDFS   F1,rscl
sl1    FLTS   F0,ip
       FMLS   F0,F0,F1       ;scale to user coords
       STFS   F0,[R1],#4     ;store coord
       SUBS   R5,R5,#1
       LDRGT  ip,kfysiz
       BGT    sl1
done   MOV    R0,#0
err    LDR    R2,[fp,#-32]
       STR    R0,[R2]
       LDMDB  fp,{R4-R5,R9,fp,sp,pc} 
font; call for font text, calculate size
       ADR    ip,xytemp      ;space for null terminated text
       MOV    lr,#0
fl1    STRB   lr,[ip,R3]     ;make null terminated string
       SUBS   R3,R3,#1
       LDRGEB lr,[R0,R3]
       BGE    fl1
       ADR    R1,flname
fl2    LDRB   lr,[R1],#1
       CMP    lr,#0
       SUBEQS R5,R5,#1
       BNE    fl2            ;find address of font name
       LDR    ip,kfxsiz
       BL     getpoint       ;get point size for FindFont
       MOV    R2,R3
       LDR    ip,kfysiz
       BL     getpoint
       MOV    R4,#0
       MOV    R5,#0
       SWI    Font_FindFont
       ADRVC  R1,xytemp    ;pointer to string
       SWIVC  Font_StringBBox
       SWIVC  Font_LoseFont
       MOVVS  R0,#-2
       BVS    err
       STMFD  sp!,{R1-R4}    ;result in millipoints in R1 to R4
       LDFS   F1,rscl
       LDFS   F0,=0.64
       FMLS   F0,F1,F0       ;scaling from font to user
       MOV    R2,#4          ;4 coords to transfer
       LDR    R0,[fp,#-36]   ;address of result (XY)
fl3    LDR    R1,[sp],#4
       FLTS   F1,R1          ;get coord in millipoints
       FMLS   F2,F1,F0       ;scale to user coords
       STFS   F2,[R0],#4     ;store in XY
       SUBS   R2,R2,#1
       BGT    fl3
       B      done           ;finished with no error
getpoint; divide ip by 40 & store in R3
       MOV    R3,#0
gp1    SUBS   ip,ip,#40
       ADD    R3,R3,#1
       BGT    gp1
       MOV    pc,lr
       END
;
       TTL    DWText
       GET    s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwtext_;(XY1,STRING,XY,IERR)
       IMPORT dwszxy_;(STRING,XY,IERR)
       IMPORT DW_writ
       IMPORT DW_wrpt
       IMPORT DW_chk
;
       DCB    "dwtext_",0,8,0,0,255
dwtext_
       MOV    ip,sp
       STMDB  sp!,{R0-R3,R8,R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk
       BNE    err
       LDMIB  sp,{R0-R2}     ;(STRING,XY,IERR)
       LDR    R3,[fp,#4]     ;LEN(STRING)
       BL     dwszxy_        ;get text boundary
       CMP    R0,#0
       BNE    err            ;error in DWSZXY
       LDMIA  sp,{R0-R3}     ;(XY1,STRING,XY,IERR)
;          translate box to XY1
       LDFS   F2,[R0]        ;XY1(1)
       LDFS   F3,[R0,#4]     ;XY1(2)
       LDFS   F0,[R2,#8]     ;XY(1,2)
       LDFS   F1,[R2,#12]    ;XY(2,2)
       ADFS   F0,F0,F2       ;translate to XY1
       ADFS   F1,F1,F3
       STFS   F0,[R2,#16]    ;->XY(1,3)
       STFS   F0,[R2,#24]    ;->XY(1,4)
       STFS   F1,[R2,#12]    ;->XY(2,2)
       STFS   F1,[R2,#20]    ;->XY(2,3)
       LDFS   F0,[R2]        ;XY(1,1)
       LDFS   F1,[R2,#4]     ;XY(2,1)
       ADFS   F0,F0,F2       ;translate to XY1
       ADFS   F1,F1,F3
       STFS   F0,[R2]        ;->XY(1,1)
       STFS   F0,[R2,#8]     ;->XY(1,2)
       STFS   F1,[R2,#4]     ;->XY(2,1)
       STFS   F1,[R2,#28]    ;->XY(2,4)
;           check bounds
       LDFS   F2,xlow
       LDFS   F3,ylow
       CMFE   F0,F2
       CMFGE  F1,F3
       LDFGES F2,xhigh
       LDFGES F3,yhigh
       LDFGES F0,[R2,#24]    ;->XY(1,4)
       LDFGES F1,[R2,#12]    ;->XY(2,2)
       CMFGE  F2,F0
       CMFGE  F3,F1
       MOVLT  R0,#-1
       BLT    err
;           now write block
       LDR    R8,[fp,#4]     ;length of string
lp1    SUBS   R8,R8,#1
       LDRGEB lr,[R1,R8]
       CMPGE  lr,#" "
       BEQ    lp1            ;find last non-blank
       ADDS   R8,R8,#1
       BEQ    done           ;all blank
       MOV    ip,#1          ;build block
       BIC    lr,R8,#3
       ADD    lr,lr,#14*4
       ADR    R0,iblock
       STMIA  R0,{ip,lr}
       ADR    R1,eight
       BL     DW_writ        ;write out 2 header words
       ADDEQ  R0,R2,#0       ;address of xy(1,1)
       BLEQ   DW_wrpt        ;write out xy(1,1)
       ADDEQ  R0,R2,#16      ;address of xy(1,3)
       BLEQ   DW_wrpt        ;write out xy(1,3)
       ADREQ  R0,ktext
       ADREQ  R1,twenty
       BLEQ   DW_writ        ;write out 5 header words
       LDREQ  R0,[sp]        ;address of xy1
       BLEQ   DW_wrpt        ;write out xy1
       LDREQ  R0,[sp,#4]     ;address of string
       ADREQ  R1,iblock
       STREQ  R8,[R1]        ;length to write
       BLEQ   DW_writ        ;write out string
       ADREQ  R0,iblock
       MOVEQ  R1,#0
       ANDEQ  R2,R8,#3
       RSBEQ  R2,R2,#4
       STMEQIA  R0,{R1,R2}
       ADDEQ  R1,R0,#4
       BLEQ   DW_writ        ;write out 1 to 4 trailing zeros
done   MOVEQ  R0,#0
err    LDR    R3,[sp,#12]
       STR    R0,[R3]
       LDMDB  fp,{R8-R9,fp,sp,pc} 
eight  DCD    8
twenty DCD    20
       END
;
       TTL    DWTxta
       GET    s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwtxta_;(XY1,ANGLE,STRING,XY2,IERR)
       IMPORT dwszxy_;(STRING,XY,IERR)
       IMPORT DW_writ
       IMPORT DW_wrpt
       IMPORT DW_chk
;
       DCB    "dwtxta_",0,8,0,0,255
dwtxta_
       MOV    ip,sp
       STMDB  sp!,{R0-R3,R8,R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       STFE   F7,[sp,#-12]!  ;save F7
       STFE   F6,[sp,#-12]!  ;save F6
       STFE   F5,[sp,#-12]!  ;save F5
       STFE   F4,[sp,#-12]!  ;save F4
       BL     DW_chk
       BNE    err
       SUBS   sp,sp,#16      ;space for string size
       MOV    R0,R2          ;address of string
       MOV    R1,sp          ;address of answer
       LDMIB  fp,{R2,R3}     ;address of IERR and length of string
       BL     dwszxy_        ;get text boundary
       MOVS   ip,R0          ;IERR
       BNE    err            ;error found in DWSZXY
       SUB    ip,fp,#36
       LDMIA  ip,{R0-R3}     ;restore arguments
       LDR    R8,[fp,#8]     ;length of string
lp1    SUBS   R8,R8,#1
       LDRGEB lr,[R2,R8]
       CMPGE  lr,#" "
       BEQ    lp1            ;find last non-blank
       ADDS   R8,R8,#1
       BEQ    done           ;all blank
       LDFS   F0,[R1]        ;ANGLE
       SINS   F7,F0
       COSS   F6,F0
;          store corners in xy2 (R3)
       LDFS   F0,[sp]
       LDFS   F1,[sp,#4]     ;xy of first point (x1,y1)
       LDFS   F4,[R0]
       LDFS   F5,[R0,#4]     ;xy1
       MOV    ip,#3          ;4 points
lp2    FMLS   F2,F0,F6       ;X*Cos(A)
       FMLS   F3,F1,F7       ;Y*Sin(A)
       ADFS   F2,F2,F4
       SUFS   F2,F2,F3
       STFS   F2,[R3],#4     ;X' = X1 + X*Cos(A) - Y*Sin(A)
       FMLS   F3,F1,F6       ;Y*Cos(A)
       FMLS   F2,F0,F7       ;X*Sin(A)
       ADFS   F3,F3,F5
       ADFS   F3,F3,F2
       STFS   F3,[R3],#4     ;Y' = Y1 + Y*Cos(A) + X*Sin(A)
       CMP    ip,#2
       LDFGTS F1,[sp,#12]    ;second point is (x1,y2)
       LDFEQS F0,[sp,#8]     ;third point is (x2,y2)
       SUBS   ip,ip,#1
       LDFEQS F1,[sp,#4]     ;fourth point is (x2,y1)
       BGE    lp2
;          check it is inside bounding box
       LDFS   F0,xlow
       LDFS   F1,ylow
       LDFS   F2,xhigh
       LDFS   F3,yhigh
       MOV    ip,#4
lp3    LDFS   F5,[R3,#-4]!   ;get xy of a corner
       LDFS   F4,[R3,#-4]!
       CMFE   F4,F0
       CMFGE  F5,F1
       CMFGE  F2,F4
       CMFGE  F3,F5
       SUBGES ip,ip,#1
       BGT    lp3
       MOVLT  R0,#-1
       BLT    err
;          find bounding box
       MOV    ip,#4
lp4    LDFS   F4,[R3],#4
       LDFS   F5,[R3],#4    ;get xy of a corner
       CMFE   F4,F0
       MVFGTS F0,F4         ;find maximum x
       CMFE   F5,F1
       MVFGTS F1,F5         ;find maximum y
       CMFE   F4,F2
       MVFLTS F2,F4         ;find minimum x
       CMFE   F5,F3
       MVFLTS F3,F5         ;find minimum y
       SUBS   ip,ip,#1
       BGT    lp4
       STFS   F2,[sp]        ;store bounding box
       STFS   F3,[sp,#4]
       STFS   F0,[sp,#8]
       STFS   F1,[sp,#12]
;            now write out the block type 12
       MOV    R1,#12         ;build block
       BIC    ip,R8,#3
       ADD    R2,ip,#21*4
       ADR    R0,iblock
       STMIA  R0,{R1,R2}
       ADR    R1,eight
       BL     DW_writ        ;write out 2 header words
;           write out bounding box
       MOV    R0,sp
       BLEQ   DW_wrpt        ;write out xy1
       ADD    R0,sp,#8
       BLEQ   DW_wrpt        ;write out xy2
;           now the transformation matrix
       LDFS   F3,=65536.0
       ADR    R0,iblock
       FMLS   F0,F3,F6
       FMLS   F1,F3,F7
       FIX   R1,F0          ;Cos(A)
       FIX   R2,F1          ;Sin(A)
       MOV    ip,R1          ;Cos(A)
       RSB    R3,R2,#0       ;-Sin(A)
       STMIA  R0,{R1-R3,ip}
       MOV    R1,#0
       STR    R1,[R0,#16]    ;no translation
       STR    R1,[R0,#20]    ;no translation
       STR    R1,[R0,#24]    ;no font flags
       ADR    R1,x28
       BL     DW_writ        ;write out 6 words of transform + 0 flags
       ADREQ  R0,ktext
       ADREQ  R1,twenty
       BLEQ   DW_writ        ;write out 5 header words
       LDREQ  R0,[fp,#-36]   ;address of xy1
       BLEQ   DW_wrpt        ;write out xy1
       LDREQ  R0,[fp,#-28]   ;address of string
       ADREQ  R1,iblock
       STREQ  R8,[R1]        ;length to write
       BLEQ   DW_writ        ;write out string
       ADREQ  R0,iblock
       MOVEQ  R1,#0
       ANDEQ  R2,R8,#3
       RSBEQ  R2,R2,#4
       STMEQIA  R0,{R1,R2}
       ADDEQ  R1,R0,#4
       BLEQ   DW_writ        ;write out 1 to 4 trailing zeros
done   MOVEQ  R0,#0
err    LDFE   F4,[sp,#16]    ;restore F4
       LDFE   F5,[sp,#28]    ;restore F5
       LDFE   F6,[sp,#40]    ;restore F6
       LDFE   F7,[sp,#52]    ;restore F7
       LDR    R3,[fp,#4]
       STR    R0,[R3]
       LDMDB  fp,{R8,R9,fp,sp,pc} 
       LTORG
eight  DCD    8
twenty DCD    20
x28    DCD    28
       END
;
       TTL    linetype
       GET    s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwlwid_;(IWID)
       EXPORT dwstyl_;(JOIN,IECAP,IBCAP,IWRULE,ITCWID,ITCLEN)
       EXPORT dwdash_;(NPART,IP1,IP2,  etc.)
;
       DCB    "dwlwid_",0,8,0,0,255
dwlwid_
       MOV   ip,sp
       STMDB sp!,{fp,ip,lr,pc}
       SUB   fp,ip,#4
       LDR   R0,[R0]  ;IWID
       CMP   R0,#0
       MOVLT R0,#0
       CMP   R0,#&FF00 ; 23/07/02
       MOVGT R0,#&FF00 ; 23/07/02
;       MOV   R0,R0,LSL#8  removed 23/07/02
       LDR   ip,lwiptr
       STR   R0,[ip]
       LDMDB  fp,{fp,sp,pc} 
lwiptr DCD  DW_common+lwidth-idhand
;
       DCB    "dwstyl_",0,8,0,0,255
dwstyl_
       MOV    ip,sp
       STMDB  sp!,{fp,ip,lr,pc}
       SUB    fp,ip,#4
       LDR    lr,stptr
       LDR    lr,[lr]       ;current style
       LDR    R0,[R0]       ;JOIN
       CMP    R0,#0
       LDMLTDB fp,{fp,sp,pc} ;negative so return
       CMP    R0,#2
       MOVGT  R0,#2         ;>2, so set to default 2
       BIC    lr,lr,#3
       ORR    lr,lr,R0
       LDR    R0,[R1]       ;IECAP
       CMP    R0,#0
       BLT    done          ;<0 so finished
       CMP    R0,#3
       MOVGT  R0,#0         ;>3 so set to default 0
       BIC    lr,lr,#&C
       ORR    lr,lr,R0,LSL#2
       LDR    R0,[R2]       ;IBCAP
       CMP    R0,#0
       BLT    done          ;<0 so finished
       CMP    R0,#3
       MOVGT  R0,#0         ;>3 so set to default 0
       BIC    lr,lr,#&30
       ORR    lr,lr,R0,LSL#4
       LDR    R0,[R3]       ;IWRULE
       CMP    R0,#0
       BLT    done          ;<0 so finished
       CMP    R0,#1
       MOVGT  R0,#1         ;>1 so set to default 1
       BIC    lr,lr,#&40
       ORR    lr,lr,R0,LSL#6
       LDMIA  ip,{R1-R3}
       LDR    R1,[R1]       ;IWCWID
       CMP    R1,#0
       BLT    done          ;<0 so finished
       CMP    R1,#255
       MOVGT  R1,#16        ;>255 so set to default 16
       BIC    lr,lr,#&FF0000
       ORR    lr,lr,R1,LSL#16
       LDR    R1,[R2]       ;IWCLEN
       CMP    R1,#0
       BLT    done          ;<0 so finished
       CMP    R1,#255
       MOVGT  R1,#32        ;>255 so set to default 32
       BIC    lr,lr,#&FF000000
       ORR    lr,lr,R1,LSL#24
done   LDR    R0,stptr
       STR    lr,[R0]       ;store style
       LDMDB  fp,{fp,sp,pc} 
stptr  DCD  DW_common+lstyle-idhand
;
dwdash_
       STMFD  sp!,{R1-R3}   ;store rest of dash parameters on stack
       B      dash1
       DCB    "dwdash_",0,8,0,0,255
dash1  ADD    ip,sp,#12     ;pointer to original stack
       STMDB  sp!,{fp,ip,lr,pc}
       SUB    ip,ip,#12
       SUB    fp,ip,#4
       LDR    lr,[R0]       ;NPART
       LDR    R0,stptr
       LDR    R2,[R0]
       CMP    lr,#0         ;if <=0
       BICLE  R2,R2,#&80    ;clear dash bit
       STRLE  R2,[R0]
       LDMLEDB fp,{fp,sp,pc} ;return
       ORR    R2,R2,#&80
       STR    R2,[R0],#4    ;set dash bit
       MOV    R1,#0
       STMIA  R0!,{R1,lr}   ;store offset (0) and count
loop   SUBS   lr,lr,#1
       LDR    R1,[ip,lr,LSL#2]
       LDR    R1,[R1]
       MOV    R1,R1,LSL#8
       STR    R1,[R0,lr,LSL#2]
       BGT    loop
       LDMDB  fp,{fp,sp,pc} 
       AREA DW_common,COMMON,NOINIT
       %    lencom
       END
;
       TTL TextPar
       GET   s.DWcommon
       AREA   DW_code,CODE,READONLY
       EXPORT dwtxfs_;(IFONT,IXSIZ,IYSIZ,IERR)
       IMPORT DW_chk
;
       DCB    "dwtxfs_",0,8,0,0,255
dwtxfs_
       MOV    ip,sp
       STMDB  sp!,{R9,fp,ip,lr,pc}
       SUB    fp,ip,#4
       BL     DW_chk         ;check file & fonts
       BNE    err
       LDR    lr,[R2]        ;IYSIZ
       LDR    R2,[R1]        ;IXSIZ
       LDR    R1,[R0]        ;IFONT
       MOV    R0,#0          ;initialize IERR
       CMP    R1,#0
       LDRGT  ip,mxfont
       CMPGT  ip,R1
       MOVLT  R1,#0          ;set to default if out of range
       MOVLT  R0,#-11        ;set error flag
       CMP    R2,#6
       CMPGE  lr,#6
       RSBGES ip,R2,#144
       RSBGES ip,lr,#144
       MOVLT  R2,#10         ;set to default
       MOVLT  lr,#10
       MOVLT  R0,#-12
       ADD    R2,R2,R2,LSL#2 ;*5
       MOV    R2,R2,LSL#7    ;*128 (*640 altogether)
       ADD    lr,lr,lr,LSL#2 ;*5
       MOV    lr,lr,LSL#7    ;*128 (*640 altogether)
       ADR    ip,ktstyl
       STMIA  ip,{R1,R2,lr}  ;store values
err    STR    R0,[R3]        ;store IERR
       LDMDB  fp,{R9,fp,sp,pc} 
       END
