home *** CD-ROM | disk | FTP | other *** search
Text File | 1987-09-05 | 24.9 KB | 1,530 lines |
-
- * link with lmath.o
- xref lmulu
- xref ldivu
- xref ldivs
- xref lmoddivu
-
- xref ipop
- xref popnum
- xref r.ipush
- xref mathffpbase
- xref mathtransbase
- xref _fontalloc
-
- xref msg for 'print' macro
- xref reinterp
- xref type_mismatch
-
- xref xmoveto,xlineto,xclosepath
- xref ymoveto,ylineto,_closepath
- xref ggsave,ggrestore
-
- xref simplex
- xref strokepathflag
- xref currfont
-
- section one
-
- include "ps.h"
-
-
- math macro
- move.l A6,-(SP)
- move.l mathffpbase,A6
- jsr _LVO\1(A6)
- move.l (SP)+,A6
- endm
-
- ieee macro
- move.l A6,-(SP)
- move.l mathtransbase,A6
- jsr _LVO\1(A6)
- move.l (SP)+,A6
- endm
-
-
-
- lref SPFix,1
- lref SPFlt,2
- lref SPCmp,3
- lref SPTst,4
- lref SPAbs,5
- lref SPNeg,6
- lref SPAdd,7
- lref SPSub,8
- lref SPMul,9
- lref SPDiv,10
-
- lref fieee,14
- lref tieee,13
- lref sqrt,12
- lref ln,10
- lref exp,9
- lref pow,11
- lref tanh,8
- lref cosh,7
- lref sinh,6
- lref sincos,5
- lref tan,4
- lref cos,3
- lref sin,2
- lref atan,1
-
- ifne HiRes
- MaxY equ 399
- VFactor equ $C8000040
- endc
- ifeq HiRes
- MaxY equ 199
- VFactor equ $C800003F
- endc
-
-
- GsaveSize equ 11
-
-
- popri
- bsr ipop
- move.l D0,D1
- cmp.w #Real,D2
- bne 1$
- bsr ipop
- cmp.w #Real,D2
- beq 7$
- cmp.w #Integer,D2
- bne type_mismatch
- move.l D1,D3
- math SPFlt
- move.l D3,D1
- move.w #Real,D2
- bra 7$
-
- 1$ cmp.w #Integer,D2
- bne type_mismatch
- bsr ipop
- cmp.w #Integer,D2
- beq 8$
- cmp.w #Real,D2
- bne type_mismatch
- move.l D0,D3
- move.l D1,D0
- math SPFlt
- move.l D0,D1
- move.l D3,D0
-
- 7$ moveq #-1,D3 ret neq with 2 reals
- 8$ rts ret eq with 2 integers
-
- popr
- bsr ipop
- cmp.w #Real,D2
- beq 1$
- cmp.w #Integer,D2
- bne type_mismatch
- move.l D1,-(SP)
- math SPFlt
- move.l (SP)+,D1
- move.w #Real,D2
- 1$ rts
-
- DEF eq
- bsr compare
- beq is_true
- rts
-
- DEF ne
- bsr compare
- bne is_true
- rts
-
- DEF ge
- bsr compare
- bge is_true
- rts
-
- DEF gt
- bsr compare
- bgt is_true
- rts
-
- DEF le
- bsr compare
- ble is_true
- rts
-
- DEF lt
- bsr compare
- blt is_true
- rts
-
-
- compare
- move.l (SP)+,A0
- pea is_false
- move.l A0,-(SP)
- bsr popri
- beq 1$
- math SPCmp
- rts
- 1$ cmp.l D1,D0
- rts
-
- is_false
- moveq #0,D0
- RETURN Boolean
-
- is_true
- addq.l #4,SP
- moveq #-1,D0
- RETURN Boolean
-
-
-
- DEF add
- bsr popri
- bne 1$
- add.l D1,D0
- bra r.ipush
- 1$ math SPAdd
- bra r.ipush
-
- DEF sub
- bsr popri
- bne 1$
- sub.l D1,D0
- bra r.ipush
- 1$ math SPSub
- bra r.ipush
-
- DEF mul
- bsr popri
- bne 1$
- jsr lmulu
- bra r.ipush
- 1$ math SPMul
- bra r.ipush
-
- DEF div
- bsr popr
- move.l D0,D1
- bsr popr
- tst.b D1
- beq diverr
- math SPDiv
- bra r.ipush
-
- DEF idiv
- bsr popnum
- move.l D0,D1
- bsr popnum
- tst.l D1
- beq diverr
- jsr ldivs
- bra r.ipush
-
- diverr
- ERR divzero
-
- DEF mod
- bsr popnum
- move.l D0,D1
- bsr popnum
- move.l D0,D3
- tst.l D0
- bpl 1$
- neg.l D0
- 1$ tst.l D1
- bpl 2$
- neg.l D1
- 2$ move.l D1,D2
- move.l D0,D1
- jsr lmoddivu
- tst.l D3
- bpl 3$
- neg.l D0
- 3$ bra retinteger
-
- DEF abs
- bsr ipop
- cmp.w #Integer,D2
- bne 2$
- tst.l D0
- bpl 1$
- neg.l D0
- 1$ bra r.ipush
- 2$ cmp.w #Real,D2
- bne type_mismatch
- math SPAbs
- bra retreal
-
- DEF neg
- bsr ipop
- cmp.w #Integer,D2
- bne 2$
- bra r.ipush
- 2$ cmp.w #Real,D2
- bne type_mismatch
- math SPNeg
- bra retreal
-
- DEF floor
- moveq #-1,D4
- bra ..clng
- DEF ceiling
- moveq #0,D4
- ..clng
- bsr ipop
- cmp.w #Integer,D2
- beq r.ipush
- cmp.w #Real,D2
- bne type_mismatch
- move.l D0,D3
- math SPFix
- move.l D0,D2
- math SPFlt
- move.l D3,D1
- math SPCmp
- beq 3$
-
- tst.l D4
- bne 1$
- tst.l D2
- bmi 3$
- addq.l #1,D2
- bra 3$
- 1$ tst.l D2
- bpl 3$
- subq.l #1,D2
-
- 3$ move.l D2,D0
- bra retinteger
-
- DEF round
- bsr ipop
- cmp.w #Integer,D2
- beq r.ipush
- cmp.w #Real,D2
- bne type_mismatch
- move.l D0,D3
- and.b #$7F,D0
- move.l #PointFive,D1
- math SPAdd
- math SPFix
- and.b #$80,D3
- beq retinteger
- neg.l D0
- bra retinteger
-
- DEF truncate
- bsr ipop
- cmp.w #Integer,D2
- beq r.ipush
- cmp.w #Real,D2
- bne type_mismatch
- math SPFix
- bra retinteger
-
- retinteger
- RETURN Integer
-
- retreal
- RETURN Real
-
-
-
- ief macro
- xdef _\1
- _\1
- bsr popr
- ieee \1
- bra retreal
- endm
-
-
- iefa macro
- xdef _\1
- _\1
- bsr popr
- move.l #$8EFA353B,D1
- math SPMul
- ieee \1
- bra retreal
- endm
-
- ief fieee
- ief tieee
- ief sqrt
- ief ln
- ief exp
- ief pow
- iefa tanh
- iefa cosh
- iefa sinh
- * ief sincos
- iefa tan
- iefa cos
- iefa sin
-
-
- DEF log
- bsr popr
- ieee ln
- move.l #$935D8D42,D1
- math SPDiv
- bra retreal
-
-
- DEF atan
- bsr popr x
- move.l D0,D1
- bsr popr y
- moveq #0,D3
- tst.b D1
- beq ..vrt
- bpl 1$
- move.w #180,D3 +y/-x
- tst.b D0
- bpl 2$
- move.w #270,D3 -y/-x
- bra 2$
- 1$ tst.b D0
- bpl 2$
- move.w #360,D3 -y/+x
- 2$
- math SPDiv
- and.b #$7F,D0
- ieee atan
- move.l #$8EFA353B,D1
- math SPDiv
- tst.l D3
- beq retreal
- or.b #$80,D0 subtr. from 180,270, or 360
- exg D0,D3
- math SPFlt
- move.l D3,D1
- math SPAdd
- bra retreal
- ..vrt
- move.l D0,D1
- move.l #90,D0
- tst.b D1
- beq diverr
- bpl retinteger
- move.w #270,D0
- bra retinteger
-
-
- DEF gsave
- lea gsavecnt,A0
- cmp.w #PstackSize,(A0)
- beq 2$
- move.w (A0),D0
- addq.w #1,(A0)
- mulu #GsaveSize*4,D0
- moveq #GsaveSize-1,D1
- lea CTM,A0
- lea sCTM,A1
- add.l D0,A1
- 1$ move.l (A0)+,(A1)+
- dbra D1,1$
- bra ggsave
- 2$ ERR gsov
-
-
- DEF grestore
- lea gsavecnt,A0
- tst.w (A0)
- beq 2$
- subq.w #1,(A0)
- move.w (A0),D0
- mulu #GsaveSize*4,D0
-
- moveq #GsaveSize-1,D1
- lea CTM,A0
- lea sCTM,A1
- add.l D0,A1
- 1$ move.l (A1)+,(A0)+
- dbra D1,1$
- bra ggrestore
- 2$ ERR gsuv
-
-
- matA equ 0
- matB equ 4
- matC equ 8
- matD equ 12
- matTx equ 16
- matTy equ 20
-
- * convert array of 6 numbers at D0 to matrix
- arrayto2matrix
- lea temp2matrix,A1
- bra ..arrtm
- arraytomatrix
- lea tempmatrix,A1
- ..arrtm
- move.l D0,A0
- cmp.w #6,(A0)+
- bne materr
- moveq #5,D3
- 1$
- move.w (A0)+,D2
- move.l (A0)+,D0
- cmp.w #Real,D2
- beq 2$
- cmp.w #Integer,D2
- bne materr
- math SPFlt
- 2$
- move.l D0,(A1)+
- dbra D3,1$
- rts
-
- materr
- ERR materror
-
-
- DEF translate
- lea v_translate,A0
- domatrix
- move.l A4,-(SP)
- move.l A0,A4
- bsr ipop
- cmp.w #Array,D2
- bne 1$
- move.l D0,-(SP)
- bsr arraytomatrix
- lea tempmatrix,A2
- move.l A2,-(SP)
- jsr (A4)
- move.l (SP)+,A2
- move.l (SP),D0
- bsr matrixtoarray
- move.l (SP)+,D0
- move.l (SP)+,A4
- RETURN Array
- 1$
- bsr r.ipush
- lea CTM,A2
- jsr (A4)
- move.l (SP)+,A4
- rts
-
- matrixtoarray
- move.l D0,A0
- lea 2(A0),A0 past length
- moveq #5,D3
- move.w #Real,D2
- 1$ move.w D2,(A0)+
- move.l (A2)+,(A0)+
- dbra D3,1$
- rts
-
- v_translate
- bsr popr
- move.l D0,D3
- bsr popr
- * lea CTM,A2
- xtranslate
- move.l matTx(A2),D1
- math SPAdd
- move.l D0,matTx(A2)
- move.l D3,D0
- move.l matTy(A2),D1
- math SPAdd
- move.l D0,matTy(A2)
- rts
-
- DEF scale
- lea v_scale,A0
- bra domatrix
- v_scale
- bsr popr
- tst.b D0
- beq diverr
- move.l D0,D3
- bsr popr
- tst.b D0
- beq diverr
- move.l D0,D2
- * lea CTM,A2
- bsr xscale
-
- exg D2,D3
- move.l currx,D0
- move.l D2,D1
- math SPDiv
- move.l D0,D2
-
- move.l curry,D0
- move.l D3,D1
- math SPDiv
- move.l D0,D3
-
- bra xy
-
-
- xscale
- move.l (A2),D1
- bsr rmul
- move.l D0,(A2) sx * a
-
- move.l matB(A2),D1
- bsr rmul
- move.l D0,matB(A2) sx * b
-
- exg D3,D2
- move.l matC(A2),D1
- bsr rmul
- move.l D0,matC(A2) sy * c
-
- move.l matD(A2),D1
- bsr rmul
- move.l D0,matD(A2) sy * d
-
- rts
-
- DEF rotate
- lea v_rotate,A0
- bra domatrix
- v_rotate
- bsr popr
- move.l #$8EFA353B,D1
- math SPMul
- move.l D0,D3
- ieee sin
- exg D0,D3
- ieee cos
- move.l D0,D4
- * D3 = sin, D4 = cos
-
- * lea CTM,A2
- bsr rot1
-
- lea 4(A2),A2
- rot1
- move.l (A2),D0
- move.l D0,-(SP)
- move.l D4,D1
- math SPMul
- move.l D0,D2 a * cos (b * cos)
-
- move.l matC(A2),D0
- move.l D0,-(SP) c (d)
- move.l D3,D1
- math SPMul c * sin (d * sin)
- move.l D2,D1
- math SPAdd
- move.l D0,(A2) a * cos + c * sin (b * cos + d * sin)
-
- move.l (SP)+,D0 c (d)
- move.l D4,D1
- math SPMul
- move.l D0,D2 c * cos
- move.l (SP)+,D0 a (b)
- move.l D3,D1
- math SPMul a * sin
- move.l D2,D1
- exg D0,D1
- math SPSub c * cos - a * sin (d * cos - b * sin)
- move.l D0,matC(A2)
- rts
-
- rmul
- beq 2$
- move.l D2,D0
- beq 1$
- math SPMul
- 1$ rts
- 2$ moveq #0,D0
- rts
-
- DEF concatmatrix
- ARG Array
- move.l D0,-(SP) save result matrix to return
- move.l D0,A0
- cmp.w #6,(A0) right size?
- bne materr
- ARG Array
- bsr arrayto2matrix matrix2
- ARG Array
- bsr arraytomatrix matrix1
-
- lea tempmatrix,A0
- lea temp2matrix,A2
- move.l A2,-(SP)
- bsr y_concat
- move.l (SP)+,A2
- move.l (SP),D0
- bsr matrixtoarray
- move.l (SP)+,D0
- RETURN Array
-
- DEF concat
- ARG Array
- bsr arraytomatrix
- lea tempmatrix,A0
- lea CTM,A2
-
- * matrix at A2 = matrix at A0 X matrix at A2
- y_concat
- movem.l D4/A3,-(SP)
- move.l A0,A3
- bsr halfmul
- lea 4(A2),A2
- bsr halfmul
- movem.l (SP)+,D4/A3
- rts
-
- * uses D2 = a2 D3 = c2 D4 = multiplicand
- halfmul
- move.l (A2),D2
- move.l matC(A2),D3
-
- move.l (A3),D0
- move.l D2,D1
- math SPMul
- move.l D0,D4
-
- move.l matB(A3),D0
- move.l D3,D1
- math SPMul
- move.l D4,D1
- math SPAdd
- move.l D0,(A2)
-
- move.l matC(A3),D0
- move.l D2,D1
- math SPMul
- move.l D0,D4
-
- move.l matD(A3),D0
- move.l D3,D1
- math SPMul
- move.l D4,D1
- math SPAdd
- move.l D0,matC(A2)
-
- move.l matTx(A3),D0
- move.l D2,D1
- math SPMul
- move.l D0,D4
-
- move.l matTy(A3),D0
- move.l D3,D1
- math SPMul
- move.l D4,D1
- math SPAdd
- move.l matTx(A2),D1
- math SPAdd
- move.l D0,matTx(A2)
-
- rts
-
- DEF dtransform
- lea y_dtransform,A0
- bra domatrix
- y_dtransform
- bsr popr
- move.l D0,D3
- bsr popr
- move.l D0,D2
- bsr xxy
- move.l vcurrx,D0
- move.l matTx(A2),D1
- math SPSub
- move.w #Real,D2
- bsr r.ipush
- move.l vcurry,D0
- move.l matTy(A2),D1
- math SPSub
- bra r.ipush
-
- DEF transform
- lea y_transform,A0
- bra domatrix
- y_transform
- bsr popr
- move.l D0,D3
- bsr popr
- move.l D0,D2
- bsr xxy
- move.w #Real,D2
- move.l vcurrx,D0
- bsr r.ipush
- move.l vcurry,D0
- bra r.ipush
-
-
- DEF currentpoint
- move.w #Real,D2
- move.l currx,D0
- bsr r.ipush
- move.l curry,D0
- bra r.ipush
-
- xdef poprxy
- poprxy
- bsr popr
- move.l curry,D1
- math SPAdd
- move.l D0,D3
- bsr popr
- move.l currx,D1
- math SPAdd
- move.l D0,D2
- bra xy
-
-
- xdef popxy
- * get coordinate from stack and convert
- * to screen address in D0=x and D1=y
- * also, in real form, D2=x and D3=y
- popxy
- bsr popr
- move.l D0,D3
- bsr popr
- move.l D0,D2
- xy
- movem.l D2/D3,currx
- lea CTM,A2
- xxy
- move.l (A2),D1
- bsr rmul ax
- move.l matTx(A2),D1
- math SPAdd + tx
- move.l D0,D4
- exg D2,D3
- move.l matC(A2),D1
- bsr rmul cy
- move.l D4,D1
- math SPAdd + cy
- move.l D0,vcurrx
-
- move.l #PointFive,D1
- math SPAdd
- math SPFix
- move.l D0,-(SP)
-
- exg D2,D3
- move.l matB(A2),D1
- bsr rmul bx
- move.l matTy(A2),D1
- math SPAdd + ty
- move.l D0,D4
- exg D2,D3
- move.l matD(A2),D1
- bsr rmul dy
- move.l D4,D1
- exg D2,D3
- math SPAdd + dy
- move.l D0,vcurry
-
- * times 200/512 = 25/64 = .390625
- move.l #VFactor,D1
- math SPMul
-
- move.l D0,D3 for antiraster lineto
- move.l vcurrx,D2
-
- move.l #PointFive,D1
- math SPAdd
- math SPFix
- move.l #MaxY,D1
- sub.l D0,D1
-
- move.l (SP)+,D0
- rts
-
- DEF currentlinewidth
- move.l linewidth,D0
- bra retreal
-
- DEF setlinewidth
- bsr popr
- tst.b D0
- bmi type_mismatch
- move.l D0,linewidth
- rts
-
- * called by stroke to see if lines currently have width
- * should return D0=1 if so, D0=0 if not
- xdef checklwidth
- checklwidth
- move.l linewidth,D0
- move.l #PointFive,D1
- math SPMul
- move.l D0,D2
- move.l D2,D3
- bsr deltaxy
- or.l D2,D3
- bne 1$
- moveq #0,D0
- rts
- 1$ moveq #1,D0
- rts
-
- deltaxy
- move.l A2,-(SP)
- lea CTM,A2
- * move.l matB(A2),-(SP)
- * move.l matC(A2),-(SP)
- move.l matTx(A2),-(SP)
- move.l matTy(A2),-(SP)
- * clr.l matB(A2)
- * clr.l matC(A2)
- clr.l matTx(A2)
- clr.l matTy(A2)
- bsr xxy
- move.l (SP)+,matTy(A2)
- move.l (SP)+,matTx(A2)
- * move.l (SP)+,matC(A2)
- * move.l (SP)+,matB(A2)
- move.l (SP)+,A2
-
- move.l D0,D2
- bpl 1$
- neg.l D2
- 1$
- move.l D3,D0
- and.b #$7F,D0
- move.l #PointFive,D1
- math SPAdd
- math SPFix
- move.l D0,D3
-
- rts
-
- * called by stroke routine to calculate
- * x and y components of linewidth
- * A3 -> source: (int,int) (real,real)
- * A4 -> dest: ditto
- * returns D2=dx D3=dy
- xdef xywidth
- xywidth
- move.l linewidth,D0
- move.l #PointFive,D1
- math SPMul
- move.l D0,-(SP)
-
- move.l 12(A4),D0 y1
- move.l 12(A3),D1 y0
- math SPSub y1 - y0
- move.l #VFactor,D1
- math SPDiv
- move.l D0,D2
-
- move.l 8(A4),D0 x1
- move.l 8(A3),D1 x0
- math SPSub x1 - x0
-
- tst.b D0
- bne 1$
- moveq #0,D3 cos = 0
- move.l (SP),D0 sin = 1
- bra 2$
- 1$
- move.l D0,D1
- move.l D2,D0
- math SPDiv (y1-y0)/(x1-x0)
- and.b #$7F,D0
-
- ieee atan
- move.l D0,D2
- ieee cos
- move.l D0,D3
- move.l D2,D0
- ieee sin
-
- move.l (SP),D1
- math SPMul
- 2$
- move.l D0,D2
-
- move.l (SP)+,D1
- move.l D3,D0
- math SPMul
- move.l D0,D3
-
- movem.l D2/D3,-(SP)
- exg D2,D3
- bsr deltaxy
- exg D2,D3
-
- bsr 22$
- move.l D2,D0
- move.l D3,D1
- movem.l (SP)+,D2/D3
-
- movem.l D0/D1,-(SP)
- bsr 21$
- movem.l (SP)+,D0/D1
- rts
-
- 21$
- bsr deltaxy
- 22$
-
- move.l (A4),D0
- cmp.l (A3),D0
- bne 3$
- moveq #0,D3
- bra 4$
- 3$ bpl 4$
- neg.l D3
- 4$ move.l 4(A4),D0
- cmp.l 4(A3),D0
- bne 5$
- moveq #0,D2
- bra 6$
- 5$ blt 6$
- neg.l D2
- 6$
- rts
-
-
-
- xdef xadvance
- xadvance
- math SPFlt
- move.l currx,D1
- math SPAdd
- move.l D0,D2
- move.l curry,D3
- bra xy
-
- DEF setflat
- bsr popr
- and.b #$7F,D0
- cmp.b #$42,D0
- bcs type_mismatch
- move.l D0,flatness
- rts
- DEF currentflat
- move.l flatness,D0
- RETURN Real
-
-
- ctx0 equ 0
- cty0 equ 4
- ctx1 equ 8
- cty1 equ 12
- ctx2 equ 16
- cty2 equ 20
- ctx3 equ 24
- cty3 equ 28
-
- ctax equ 0
- ctbx equ 8
- ctcx equ 16
-
- DEF rcurveto
- moveq #-1,D0
- bra ..crvt
-
- DEF curveto
- moveq #0,D0
- ..crvt
- movem.l D6/D7/A3/A4,-(SP)
- move.l D0,D6
- lea ct_xy,A4
- lea currx,A3
- bsr ctxystow
- bsr popxy
- lea 16(A4),A4
- bsr ctxystow
- bsr popxy
- lea -16(A4),A4
- bsr ctxystow
- bsr popxy
- lea -16(A4),A4
- bsr ctxystow
-
- lea ct_xy,A3
- tst.l D6
- beq 11$
-
- lea ctx1(A3),A4
- moveq #2,D3
- 10$
- move.l (A3),D0
- move.l (A4),D1
- math SPAdd
- move.l D0,(A4)+
- move.l cty0(A3),D0
- move.l (A4),D1
- math SPAdd
- move.l D0,(A4)+
- dbra D3,10$
-
- 11$
- lea ct_abc,A4
- bsr ctabcfigure
- movem.l D4/A3/A4,-(SP)
- lea 4(A3),A3
- lea 4(A4),A4
- bsr ctabcfigure
- move.l D4,D3
- movem.l (SP)+,D4/A3/A4
- * D3 = y3 - y0; D4 = x3 - x0
- and.b #$7F,D4
- and.b #$7F,D3
- move.l D4,D0
- move.l D3,D1
- math SPCmp
- bgt 1$
- move.l D3,D4
- 1$
- move.l D4,D1
- move.l flatness,D0 (make setable)
- math SPDiv dt = 4/dx or 4/dy
- tst.b D0
- beq 100$
-
- move.l D0,D7
- move.l D7,D3
-
- moveq #-1,D4
- move.l (A3),D0
- move.l cty0(A3),D1
- bsr ctto
-
- 2$
- cmp.b #$41,D3
- blt 3$
- move.l ctx3(A3),D0
- move.l cty3(A3),D1
- clr.l D4
- bsr ctto
- bra 100$
- 3$
- bsr ctxfigure
- movem.l D0/A3/A4,-(SP)
- lea 4(A3),A3
- lea 4(A4),A4
- bsr ctxfigure
- move.l D0,D1
- movem.l (SP)+,D0/A3/A4
-
- clr.l D4
- bsr ctto
-
- move.l D7,D0
- move.l D3,D1
- math SPAdd
- move.l D0,D3
- bra 2$
-
- 100$
- movem.l (SP)+,D6/D7/A3/A4
- rts
-
- ctto
- movem.l D3/A3/A4,-(SP)
- move.l D0,D2
- move.l D1,D3
- bsr xy
- tst.l D4
- bne 1$
- bsr ylineto
- bra 2$
- 1$ bsr ymoveto
- 2$ movem.l (SP)+,D3/A3/A4
- rts
-
- ctabcfigure
- move.l ctx1(A3),D0
- move.l ctx0(A3),D1
- math SPSub
- move.l #ThreePoint,D1
- move.l D1,D2
- math SPMul
- move.l D0,ctcx(A4)
- move.l D0,D3
-
- move.l ctx2(A3),D0
- move.l ctx1(A3),D1
- math SPSub
- move.l D2,D1
- math SPMul
- move.l D3,D1
- math SPSub
- move.l D0,ctbx(A4)
- move.l D0,D2
-
- move.l ctx3(A3),D0
- move.l ctx0(A3),D1
- math SPSub
- move.l D0,D4
- move.l D2,D1
- math SPSub
- move.l D3,D1
- math SPSub
- move.l D0,ctax(A4)
-
- rts
-
- * D3 = t
- ctxfigure
- move.l ctax(A4),D0
- move.l D3,D1
- math SPMul
- move.l ctbx(A4),D1
- math SPAdd
- move.l D3,D1
- math SPMul
- move.l ctcx(A4),D1
- math SPAdd
- move.l D3,D1
- math SPMul
- move.l (A3),D1
- math SPAdd
- rts
-
-
- ctxystow
- move.l A3,-(SP)
- move.l (A3)+,(A4)+
- move.l (A3)+,(A4)+
- move.l (SP)+,A3
- rts
-
-
- ct_xy dcb.l 8,0
- ct_abc dcb.l 6,0
-
-
- DEF makefont
- ARG Array
- bsr _fontalloc
- move.l A0,D1
- move.w #-1,(A0)+
- move.w #Array,(A0)+
- move.l D0,(A0)+
- ARG FontID
- move.l D0,A0
- tst.w (A0)
- bpl type_mismatch
- move.l D1,D0
- RETURN FontID
-
-
- DEF scaleg
- bsr popr
- bsr _fontalloc
- move.l A0,D1
- move.w #-1,(A0)+
- move.w #Real,(A0)+
- move.l D0,(A0)+
- ARG FontID
- move.l D1,D0
- RETURN FontID
-
-
- initfctm
-
- * copy current CTM to fCTM
- moveq #5,D1
- lea CTM,A0
- lea fCTM,A1
- move.l A0,A2
- 1$ move.l (A0)+,(A1)+
- dbra D1,1$
-
- * translate to current position
- move.l curry,D3
- move.l currx,D2
- bsr xxy
- lea fCTM,A2
- move.l vcurry,matTy(A2)
- move.l vcurrx,matTx(A2)
-
- * zero temp matrix
- lea tempmatrix,A0
- moveq #5,D1
- moveq #0,D0
- 2$ move.l D0,(A0)+
- dbra D1,2$
-
- move.l currfont,A0
- tst.w (A0)+
- bmi 3$
- move.l #OnePoint,D0 ??
- bra 4$
- 3$
- move.w (A0)+,D2
- move.l (A0),D0
- cmp.w #Real,D2
- bne 5$
- 4$
- lea tempmatrix,A0
- move.l D0,(A0)
- move.l D0,matD(A0)
- bra 6$
- 5$
- cmp.w #Array,D2
- bne type_mismatch
- bsr arraytomatrix
-
- 6$
- lea tempmatrix,A2
- move.w simplex_base,D0
- ext.l D0
- math SPFlt
- move.l matTy(A2),D1
- math SPAdd
- move.l D0,matTy(A2)
-
- * scale down by nominal height
- move.w simplex_height,D0
- ext.l D0
- math SPFlt
- move.l D0,D1
- move.l #OnePoint,D0
- math SPDiv
- move.l D0,D2
- move.l D0,D3
- bsr xscale
-
- * save 'a' for currentpoint update
- move.l (A2),simplex_scale
-
- * concat with copy of CTM
- lea tempmatrix,A0
- lea fCTM,A2
- bsr y_concat
-
- lea fCTM,A2
-
- rts
-
-
- xdef _lengthg
- _lengthg
- movem.l D5/D6,-(SP)
- moveq #0,D6
- bra ..shwg
-
- DEF charpath
- ARG Boolean
- beq 1$
- move.b #1,strokepathflag
- 1$
- movem.l D5/D6,-(SP)
- moveq #-1,D6
- bra ..shwg
-
- DEF showg
- movem.l D5/D6,-(SP)
- moveq #1,D6
- ..shwg
- bsr initfctm henceforth A2 -> fCTM
-
- ARG String
-
- move.l D0,A0
- moveq #0,D0
- move.l D0,lastx
- move.l D0,xoffset
- move.w (A0)+,D3
- 1$
- subq.w #1,D3
- bpl 2$
-
- move.l lastx,D0
- math SPFlt
-
- move.l simplex_scale,D1
- math SPMul
-
- move.l D6,D4
- movem.l (SP)+,D5/D6
-
- tst.l D4
- bne 10$
- move.w #Real,D2
- bsr r.ipush
- moveq #0,D0
- bra r.ipush
-
- 10$
- move.l currx,D1
- math SPAdd
- move.l D0,D2
- move.l curry,D3
- bsr xy
- tst.l D4
- bpl xmoveto
- bra ymoveto
-
- 2$
- moveq #0,D0
- move.b (A0)+,D0
- movem.l D3/A0,-(SP)
- bsr drawchar
- movem.l (SP)+,D3/A0
- bra 1$
-
-
- drawchar
- cmp.b #' ',D0
- bcs ..dcret
- cmp.b #$7F,D0
- bhi ..dcret
-
- sub.b #' ',D0
- add.l D0,D0
- lea simplex,A0
- move.l A0,A3
- add.l D0,A0
- add.w (A0),A3
-
-
- * x-offset to center of character
-
- move.b (A3)+,D0 left bound
- ext.w D0
- ext.l D0
- neg.l D0
- move.l lastx,D1
- add.l D1,D0
- move.l D0,xoffset
- move.l D0,D2 save to update currx
-
- * update currx
- move.b (A3)+,D0 right bound
- ext.w D0
- ext.l D0
- add.l D2,D0
- move.l D0,lastx
-
- tst.l D6
- beq ..dcret
-
- clr.l D5 pen is up
-
- f_endchar equ 0
- f_penup equ 1
- f_closepath equ 2
-
-
- * start drawing
- nextpoint
- move.b (A3)+,D0 x
- move.b (A3)+,D3 y
- cmp.b #64,D0 special command?
- bne dopoint
- cmp.b #f_endchar,D3
- bne ..dc1
- ..dcret
- rts
-
- ..dc1
- cmp.b #f_closepath,D3
- bne ..dc2
- tst.l D6
- bpl 1$
- bsr _closepath
- bra 2$
- 1$ bsr xclosepath
- 2$ clr.l D5 pen up
- bra nextpoint
-
- ..dc2
- cmp.b #f_penup,D3
- bne nextpoint unknown
- clr.l D5 pen up
- bra nextpoint
-
- dopoint
- ext.w D0
- ext.l D0
- move.l xoffset,D1
- add.l D1,D0
- math SPFlt
- move.l D0,D2
-
- move.b D3,D0
- ext.w D0
- ext.l D0
- neg.l D0
- math SPFlt
- move.l D0,D3
- bsr xxy get device coordinates
- tst.l D5
- bmi 3$
-
- tst.l D6
- bpl 1$
- bsr ymoveto
- bra 2$
- 1$ bsr xmoveto
- 2$ moveq #-1,D5 now pen is down
- bra nextpoint
-
- 3$ tst.l D6
- bpl 4$
- bsr ylineto
- bra nextpoint
-
- 4$ bsr xlineto
- bra nextpoint
-
-
-
- section three,data
-
-
- CTM
- dc.l OnePoint
- dc.l 0
- dc.l 0
- dc.l OnePoint
- dc.l 0
- dc.l 0
- currx
- dc.l 0
- curry
- dc.l 0
- vcurrx
- dc.l 0
- vcurry
- dc.l 0
- linewidth
- dc.l 0
- flatness
- dc.l FourPoint not saved
-
-
-
- fCTM
- dc.l OnePoint
- dc.l 0
- dc.l 0
- dc.l OnePoint
- dc.l 0
- dc.l 0
-
- lastx dc.l 0
- xoffset dc.l 0
-
- simplex_scale dc.l $BA2E8C3C 1/22
- simplex_base dc.w 9
- simplex_height dc.w 22
-
- gsavecnt dc.w 0
-
- bstr gsov,<gsave overflow>
- bstr gsuv,<grestore underflow>
- bstr divzero,<divide by zero>
- bstr materror,<matrix error>
-
- section mroom,bss
-
- tempmatrix ds.l 6
- temp2matrix ds.l 6
- sCTM ds.l PstackSize*GsaveSize
-
- end
-