home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d1xx
/
d101
/
psintrp.lha
/
PsIntrp
/
graphics.a
< prev
next >
Wrap
Text File
|
1987-09-05
|
29KB
|
1,591 lines
xref graphicsbase
xref rastport
xref viewport
xref type_mismatch
xref msg
xref reinterp
xref ipop
xref r.ipush
xref popnum
xref dictsearch
xref popxy,poprxy
xref _showg,_scaleg,_lengthg
xref xadvance
xref checklwidth,xywidth
section one
include "ps.h"
lref ClearScreen,4
lref TextLength,5
lref Text,6
lref SetFont,7
lref OpenFont,8
lref CloseFont,9
lref Move,36
lref Draw,37
lref AreaMove,38
lref AreaDraw,39
lref AreaEnd,40
lref InitArea,43
lref SetRGB4,44
lref RectFill,47
lref WritePixel,50
lref Flood,51
lref SetAPen,53
lref SetBPen,54
lref SetDrMd,55
lref InitTmpRas,74
lref AllocRaster,78
lref FreeRaster,79
lref GetRGB4,93
graphics macro
move.l A6,-(SP)
move.l graphicsbase,A6
move.l rastport,A1
jsr _LVO\1(A6)
move.l (SP)+,A6
endm
graph macro
move.l A6,-(SP)
move.l graphicsbase,A6
jsr _LVO\1(A6)
move.l (SP)+,A6
endm
xref mathffpbase
math macro
move.l A6,-(SP)
move.l mathffpbase,A6
jsr _LVO\1(A6)
move.l (SP)+,A6
endm
mathb macro
move.l mathffpbase,A6
endm
maths macro
jsr _LVO\1(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
AreaSize equ 500
PenMask equ NumColors-1
ifne HiRes
MaxY equ 399
endc
ifeq HiRes
MaxY equ 199
endc
*************************
xdef initgr
initgr
move.l rastport,A1
move.l #640,D0
move.l #MaxY+1,D1
move.l A1,-(SP)
graph AllocRaster
move.l D0,rasterpt
move.l (SP),A1
lea tmpras,A0
move.l A0,$0C(A1)
move.l D0,A1
move.l #640*(MaxY+1),D0
graph InitTmpRas
move.l (SP)+,A1
lea areasptrn,A0
move.l A0,$08(A1)
move.b #2,$1D(A1) 4 words
lea areainfo,A0
move.l A0,$10(A1)
lea areabuffer,A1
move.l #AreaSize,D0
graph InitArea
lea pstacktop,A0
move.l A0,pstack
clr.w pstackcnt
clr.w (A0)+
lea pathbuffer,A1
move.l A1,(A0)
clr.w pointcnt
move.l A1,nextpoint
moveq #1,D0
graphics SetAPen
moveq #0,D0
graphics SetBPen
moveq #1,D0
graphics SetDrMd
rts
xdef endgr
endgr
move.l rasterpt,A0
move.l #640,D0
move.l #MaxY+1,D1
graphics FreeRaster
move.l rastport,A1
clr.l $08(A1)
clr.l $0C(A1)
clr.l $10(A1)
rts
rasterpt dc.l 0
DEF stringwidth
move.b resfontflag,D0
bne _lengthg
ARG String
move.l D0,A0
moveq #0,D0
move.w (A0)+,D0
graphics TextLength
math SPFlt dx
move.w #Real,D2
bsr r.ipush
moveq #0,D0 dy = 0
bra r.ipush
DEF show
ARG String
move.l D0,-(SP)
bsr movehere
move.l (SP)+,D0
move.l D0,A0
move.b resfontflag,D0
bne showresfont
movem.l currdevpoint,D0/D1
graphics Move
move.l rastport,A1
move.w $24(A1),-(SP)
moveq #0,D0
move.w (A0)+,D0
graphics Text
move.l rastport,A1
moveq #0,D0
move.w $24(A1),D0
move.w (SP)+,D1
sub.w D1,D0
bsr xadvance
movem.l D0-D3,bpath
movem.l D0-D3,currdevpoint
rts
showresfont
move.l A0,D0
move.w #String,D2
bsr r.ipush
bra _showg
newpoint
moveq #0,D4
move.w #MaxY,D4
cmp.l D4,D1
ble 1$
move.l D4,D1
1$ tst.l D1
bpl 2$
clr.l D1
2$ move.w #639,D4
cmp.l D4,D0
ble 3$
move.l D4,D0
3$ tst.l D0
bpl 4$
clr.l D0
4$ rts
DEF newpath
move.l pstack,A0
move.w (A0)+,pointcnt
move.l (A0),nextpoint
move.b #0,strokepathflag
rts
xdef ggsave
ggsave
lea pstackcnt,A0
cmp.w #PstackSize,(A0)
beq 1$
addq.w #1,(A0)
move.l pstack,A0
move.l currfont,-(A0)
move.l graylevel,-(A0)
move.l linecap,-(A0)
move.l nextpoint,-(A0) must be pushed next last
move.w pointcnt,-(A0) must be pushed last
move.l A0,pstack
rts
1$ ERR psov
xdef ggrestore
ggrestore
lea pstackcnt,A0
tst.w (A0)
beq 1$
subq.w #1,(A0)
move.l pstack,A0
move.w (A0)+,pointcnt
move.l (A0)+,nextpoint
move.l (A0)+,linecap
move.l (A0)+,D0
move.l (A0)+,currfont
move.l A0,pstack
bsr resetgray
move.l currfont,D0
bra resetfont
1$ ERR psuv
c_moveto equ 1
c_lineto equ 2
c_closepath equ 3
appendpoint
lea pointcnt,A0
cmp.w #AreaSize,(A0)
beq pointprob
addq.w #1,(A0)
move.l nextpoint,A0
move.w D0,(A0)+
move.l D2,(A0)+
move.l D3,(A0)+
move.l A0,nextpoint
rts
pointprob
ERR pntsov
DEF rmoveto
bsr poprxy
bra ymoveto
DEF moveto
bsr popxy
xdef ymoveto
ymoveto
movem.l D0-D3,bpath
movem.l D0-D3,currdevpoint
moveq #c_moveto,D0
bra appendpoint
movehere
movem.l currdevpoint,D0-D3
xdef xmoveto
xmoveto
bsr newpoint
movem.l D0-D3,bpath
movem.l D0-D3,currdevpoint
graphics Move
rts
DEF rlineto
bsr poprxy
bra ylineto
DEF lineto
bsr popxy
xdef ylineto
ylineto
tst.w pointcnt
bne 1$
movem.l D0-D3,-(SP)
movem.l currdevpoint,D0-D3
bsr ymoveto
movem.l (SP)+,D0-D3
1$
movem.l D0-D3,currdevpoint
moveq #c_lineto,D0
bra appendpoint
xdef xclosepath
xclosepath
movem.l bpath,D0-D3
movem.l D0-D3,currdevpoint
xdef xlineto
xlineto
bsr arlineto
beq xxlineto
rts
xxlineto
bsr newpoint
graphics Draw
rts
DEF closepath
movem.l bpath,D0-D3
movem.l D0-D3,currdevpoint
moveq #c_closepath,D0
bra appendpoint
DEF pixel
* graphics WritePixel
* rts
bsr movehere
move.l rastport,A1
move.l 4(A1),A0 A0 -> bitmap
move.w $26(A1),D1 D1 = cp_y
mulu (A0),D1 cp_y * bytes per row
moveq #0,D0
move.w $24(A1),D0 cp_x
move.l D0,D2
lsr.l #3,D0 byte offset for x
add.l D0,D1 byte address of pixel
and.l #7,D2 bit offset
moveq #7,D0
sub D2,D0
move.b $19(A1),D3 pen color
move.l 8(A0),A1 base address of first screen
btst #0,D3
beq 1$
bsr 2$
1$ move.l 12(A0),A1 base address of second screen
btst #1,D3
beq 3$
2$ add.l D1,A1
bset D0,(A1)
3$ rts
**debug
ifd DEBUG2
pushA0
movem.l D0-D7/A1-A6,-(SP)
move.l A0,D0
move.w #Integer,D2
bsr r.ipush
movem.l (SP)+,D0-D7/A1-A6
rts
endc
xpixel
**debug
ifd DEBUG2
move.l D0,A0
bsr pushA0
move.l D1,A0
bsr pushA0
move.l D2,A0
bsr pushA0
endc
tst.b D2
beq 3$
tst.l D1
bmi 3$
tst.l D0
bmi 3$
cmp.l #639,D0
bhi 3$
cmp.l #MaxY,D1
bhi 3$
mulu (A5),D1 cp_y * bytes per row
move.l D2,A1 save pencolor
move.l D0,D2
lsr.l #3,D0 byte offset for x
add.l D0,D1 byte address of pixel
and.l #7,D2 bit offset
moveq #7,D0
sub D2,D0
move.l A1,D2 pen color
move.l 8(A5),A1 base address of first screen
btst #0,D2
beq 1$
bsr 2$
1$ move.l 12(A5),A1 base address of second screen
btst #1,D2
ifne HiRes
beq 10$
bsr 2$
10$
move.l 16(A5),A1
btst #2,D2
endc
beq 3$
2$ add.l D1,A1
bset D0,(A1)
3$ rts
arlineto
movem.l oldx,A0/A1 starting real coord
movem.l D2/D3,oldx ending real coord - save for next time
tst.l vint
beq 900$ 0 vint means use Amiga line drawer
* now draw antirasterized line from (A0,A1) to (D2,D3)
* (y-axis is still inverted)
movem.l D5-D7/A2-A6,-(SP)
* D2,D3,A0,A1,A6
move.l A0,D4
move.l A1,D5
* update cp
graphics Move
* set A6 for short math calls
mathb
* D2(ex),D3(ey),D4(sx),D5(sy),A6(mbase)
move.l D5,D0
move.l D3,D1
maths SPCmp
bcs 4$
exg D2,D4
exg D3,D5
4$
move.l D2,D0
move.l D4,D1
maths SPSub ex - sx
move.l D0,D6
move.l D3,D0
move.l D5,D1
maths SPSub ey - sy
move.l D0,D7
* D2(ex),D3(ey),D4(sx),D5(sy),D6(dx),D7(dy)
* move.l D7,D0
and.b #$7F,D0
move.l D6,D1
and.b #$7F,D1
maths SPCmp if abs(dy) >= abs(dx), exchange
bcs 10$
exg D2,D3
exg D4,D5
exg D6,D7
moveq #-1,D3 set exchange flag
bra 11$
10$
moveq #0,D3
11$
move.l D4,D0
move.l #PointFive,D1
maths SPAdd
maths SPFix
move.l D0,A2 A2 = rx = round(sx)
* D2(ex),D3(flag),D4(sx),D5(sy),D6(dx),D7(dy)
* A2(rx),A4(abs dx)
* move.l A2,D0 count = trunc(abs(ex - rx)) + 1
maths SPFlt
move.l D0,D1
move.l D2,D0
maths SPSub ex - flt(rx)
and.b #$7F,D0
* round not in original
move.l #PointFive,D1
maths SPAdd
maths SPFix
addq.l #1,D0
move.l D0,A4
move.l D3,D2 move flag
move.l D7,D0
move.l D6,D1
beq 800$
maths SPDiv
move.l D0,A5 A5 = slope = (ey - sy)/(ex - sx)
* D2(flag),D3(n.u.),D4(sx),D5(sy),D6(dx),D7(dy),A2(rx),A4(cnt),A5(slope),A6
move.l A2,D0
maths SPFlt
move.l D4,D1
maths SPSub rx - sx
move.l A5,D1
maths SPMul times slope
* abs ??
move.l D5,D1
maths SPAdd plus sy
move.l D0,D3 D3 = aux
* round ??
maths SPFix
move.l D0,A3 A3 = ry
move.l A5,D0
and.b #$7F,D0
move.l vint,D5
move.l D5,D1
maths SPMul
move.l D0,D4 D4 = dint = abs(slope) * vint
* D2(flag),D3(aux),D4(dint),D5(vint),D6(dx),D7(dy)
* A2(rx),A3(ry),A4(cnt),A5(n.u.),A6
move.l A3,D0
maths SPFlt
move.l D0,D1
move.l D3,D0
maths SPSub aux - ry
move.l D5,D1
maths SPMul times vint
move.l D0,D3 D3 = lint
* D2(flag),D3(lint),D4(dint),D5(vint),D6(dx),D7(dy)
* A2(rx),A3(ry),A4(cnt),A5(n.u.),A6
tst.w D2
bpl 20$
exg A2,A3
exg D6,D7
20$
move.l D6,D1 dx -> +-1
moveq #0,D0
maths SPCmp
bne 22$
moveq #1,D0
22$
move.l D0,D6
* move.l D7,D0 dy -> -+1
* moveq #0,D1
* maths SPCmp
* bne 24$
* moveq #-1,D0
*24$
* move.l D0,D7
move.l rastport,A0
move.l 4(A0),A5 bitmap
move.l #MaxY,D0 uninvert y-axis
move.l A3,D1
sub.l D1,D0
move.l D0,A3
* D0 (pass x)
* D1 (pass y)
* D2 flag dy > dx and pass pencolor
* D3 lint
* D4 dint
* D5 vint
* D6 sign dx
*** D7 sign dy (n.u. now)
* A0
* A1 (temp)
* A2 rx
* A3 ry
* A4 cnt
* A5 bitmap
* A6 mathffpbase
**debug
ifd DEBUG1
move.l A4,SAVECNT
move.l A2,SAVERX
move.l A3,SAVERY
move.l D6,SAVESDX
move.l D7,SAVESDY
move.l D3,SAVELINT
move.l D4,SAVEDINT
endc
100$
subq.l #1,A4
move.l A4,D0
bmi 800$
swap D2 save exchange flag
move.l D5,D0
move.l D3,D1
maths SPSub vint - lint
bsr pixreg
bsr xpixel pixel(rx,ry,rint)
move.l D3,D0
bsr pixreg
swap D2
tst.w D2
bpl 110$
add.l D6,D0 lx = rx + 1
bra 111$
110$
* add.l D7,D1 ly = ry + 1
subq.l #1,D1
111$
swap D2
bsr xpixel pixel(lx,ly,lint)
swap D2
move.l D3,D0
move.l D4,D1
maths SPAdd
move.l D0,D3 lint = lint + dint
move.l D5,D1
maths SPCmp
bcs 200$ not if lint < vint
tst.w D2
bmi 120$
* add.l D7,A3 ry = ry + sign(dy)
subq.l #1,A3
bra 130$
120$
add.l D6,A2 rx = rx + sign(dx)
130$
move.l D3,D0
move.l D5,D1
maths SPSub
move.l D0,D3 lint = lint - vint
200$
tst.w D2
bmi 220$
add.l D6,A2 rx = rx + 1
bra 100$
220$
* add.l D7,A3
subq.l #1,A3
bra 100$
800$
movem.l (SP)+,D5-D7/A2-A6
**debug
ifd DEBUG1
move.w #Integer,D2
move.l SAVECNT,D0
bsr r.ipush
move.l SAVERX,D0
bsr r.ipush
move.l SAVERY,D0
bsr r.ipush
move.l SAVESDX,D0
bsr r.ipush
move.l SAVESDY,D0
bsr r.ipush
move.w #Real,D2
move.l SAVELINT,D0
bsr r.ipush
move.l SAVEDINT,D0
bsr r.ipush
endc
moveq #1,D0 signal line is drawn
900$
rts
**debug
ifd DEBUG1
SAVECNT dc.l 0
SAVERX dc.l 0
SAVERY dc.l 0
SAVESDX dc.l 0
SAVESDY dc.l 0
SAVELINT dc.l 0
SAVEDINT dc.l 0
endc
pixreg
move.l #FourPoint,D1
maths SPMul
maths SPFix
cmp.b #4,D0
bne 2$
moveq #3,D0
2$ move.w D0,D2
move.l A2,D0
move.l A3,D1
* tst.l D7
* bmi 1$
* addq.l #1,D1
1$ rts
DEF greyline
bsr pop01
move.l D0,vint
rts
pop01
bsr ipop
move.l #OnePoint,D1
cmp.w #Real,D2
beq 1$
cmp.w #Integer,D2
bne type_mismatch
tst.l D0
beq 2$
subq.l #1,D0
bne range01
move.l D1,D0
1$ tst.b D0
bmi range01
move.l D0,D2
math SPCmp
bgt range01
move.l D2,D0
2$ rts
range01
ERR out01
vint dc.l 0
bpath dc.l 0,0
oldx dc.l 0,0
currdevpoint dc.l 0,0,0,0
DEF currentgray
move.l graylevel,D0
RETURN Real
DEF setgray
bsr pop01
resetgray
move.l D0,graylevel
lea areasptrn,A0
tst.l D0
beq 2$
move.l #FourPoint,D1
math SPMul
math SPFix
moveq #3,D1
cmp.l D1,D0
bls 1$
move.l D1,D0
1$ add.l D0,D0
add.l D0,D0
add.l D0,D0
lea areaptrn,A0
add.l D0,A0
2$ move.l rastport,A1
move.l A0,8(A1)
rts
DEF flood
bsr popxy
bsr newpoint
moveq #0,D2
move.l rastport,A1
move.b $19(A1),$1B(A1)
graphics Flood
rts
DEF fill
lea strokepathflag,A0
move.b (A0),D0
move.b #0,(A0)
tst.b D0
bne _stroke
moveq #-1,D0
bra ..strk
DEF strokepath
move.b #1,strokepathflag
rts
DEF stroke
moveq #0,D0
bsr checklwidth does line have width?
..strk
movem.l D5-D7/A2-A4,-(SP)
move.l D0,D7
moveq #-1,D0
move.l D0,buttremember
move.l D0,ibuttremember
move.l D0,buttbegin
move.l D0,ibuttbegin
move.l D0,a_linecap
move.l pstack,A0
move.w (A0)+,D0 pointcount at last newpath
move.l (A0),A2 nextpoint at last newpath
move.w pointcnt,D5
sub.w D0,D5
* lea pathbuffer,A2
1$ subq.w #1,D5
bmi 100$
move.w (A2)+,D6
move.l (A2)+,D2
move.l D2,D0
math SPFix
move.l D0,A3
move.l (A2)+,D3
move.l D3,D0
math SPFix
move.l #MaxY,D1
sub.l D0,D1
move.l A3,D0
tst.l D7
bmi 4$
bne 6$
cmp.b #c_moveto,D6
bne 2$
bsr xmoveto
bra 1$
2$
* cmp.b #c_lineto,D6
* bne 1$
bsr xlineto
3$ bra 1$
4$ cmp.b #c_moveto,D6
bne 5$
graphics AreaMove
bra 1$
5$
* cmp.b #c_lineto,D6
* bne 1$
graphics AreaDraw
bra 1$
6$ cmp.b #c_moveto,D6
bne 7$
movem.l D0-D3,arsource
* put caps on ends of last subpath
bsr dolinecaps
moveq #-1,D0
move.l D0,buttremember
move.l D0,ibuttremember
move.l D0,buttbegin
move.l D0,ibuttbegin
move.l D0,a_linecap
bra 1$
* draw thick stroke by filling
7$
* cmp.b #c_lineto,D6
* bne 1$
lea ardest,A4
movem.l D0-D3,(A4)
lea arsource,A3
* sub.l (A3),D0
* bpl 71$
* neg.l D0
*71$
* sub.l 4(A3),D1
* bpl 72$
* neg.l D1
*72$
* add.l D1,D0
* cmp.l #4,D0
* blt 1$
* rmath routine calculates sides of right triangle whose
* hypotenuse is perpendicular to this stroke and is
* 1/2 linewidth in length -- returns x-side in D2, y-side in D3
* also y in D0, x in D1 in device coordinates for x and y axes, resp.
bsr xywidth
movem.l D0/D1,deltayx
movem.l buttremember,D0/D1
tst.l D0
bpl 8$
* 1st corner at beginning of subpath
movem.l (A3),D0/D1
lea a_linecap,A0
movem.l D0-D3,(A0)
movem.l deltayx,D0/D1
movem.l D0/D1,16(A0)
movem.l (A0),D0/D1
sub.l D2,D0
sub.l D3,D1
movem.l D0/D1,buttbegin
8$ movem.l D0/D1,-(SP) save to close rectangle at end
bsr qamove
move.l buttremember,D0
bmi 9$
* connect 2nd corner of last stroke to 1st corner of this one
movem.l (A3),D0/D1
sub.l D2,D0
sub.l D3,D1
bsr qadraw
9$
* 2nd corner
movem.l (A4),D0/D1
lea b_linecap,A0
movem.l D0-D3,(A0)
movem.l deltayx,D0/D1
movem.l D0/D1,16(A0)
movem.l (A0),D0/D1
sub.l D2,D0
sub.l D3,D1
movem.l D0/D1,buttremember
bsr qadraw
cmp.b #c_closepath,D6
bne 10$
* signal don't do linecaps
moveq #-1,D0
move.l D0,a_linecap
* connect 2nd corner to 1st corner of stroke at
* beginning of subpath
movem.l buttbegin,D0/D1
tst.l D0
bmi 10$
bsr qadraw
movem.l ibuttbegin,D0/D1
tst.l D0
bmi 10$
bsr qadraw
10$
* 3rd corner
movem.l ibuttremember,D0/D1
movem.l D0/D1,-(SP)
movem.l (A4),D0/D1
add.l D2,D0
add.l D3,D1
movem.l D0/D1,ibuttremember
* may want move here instead of interior line
bsr qadraw
* 4th corner
movem.l (A3),D0/D1
add.l D2,D0
add.l D3,D1
lea ibuttbegin,A0
tst.l (A0)
bpl 11$
movem.l D0/D1,(A0)
11$
bsr qadraw
* connect 4th corner to 3rd corner of last stroke
movem.l (SP)+,D0/D1
tst.l D0
bmi 12$
bsr qadraw
12$
* close rectangle
movem.l (SP)+,D0/D1
bsr qadraw
* fill it
bsr qaend
movem.l (A4),D0-D3 this destination will be next source
movem.l D0-D3,(A3)
bra 1$
100$
bsr dolinecaps
move.l D7,D0
movem.l (SP)+,D5-D7/A2-A4
tst.l D0
bpl _newpath
graphics AreaEnd
bra _newpath
qamove
tst.b strokepathflag
bne 1$
move.l D2,D4
or.l D3,D4
beq 1$
graphics AreaMove
tst.l D0
bmi pointprob
rts
1$ movem.l D2/D3,-(SP)
bsr xmoveto
movem.l (SP)+,D2/D3
rts
qadraw
move.l D2,D4
or.l D3,D4
beq 1$
tst.b strokepathflag
bne ..qnd
graphics AreaDraw
tst.l D0
bmi pointprob
1$ rts
..qnd
movem.l D2/D3,-(SP)
bsr xxlineto
movem.l (SP)+,D2/D3
rts
qaend
move.l D2,D4
or.l D3,D4
beq ..qnd
tst.b strokepathflag
bne 1$
graphics AreaEnd
1$ rts
dolinecaps
movem.l D5/D6,-(SP)
lea a_linecap,A3
tst.l (A3)
bmi 100$
move.w linecap,D0
beq 100$
cmp.b #2,D0
beq 100$ no round ones yet
movem.l (A3),D0-D5
move.l D4,D6
bsr onecap
moveq #-1,D0
move.l D0,(A3) signal did it
lea b_linecap,A3
movem.l (A3),D0-D5
move.l D4,D6
add.l D5,D0
sub.l D4,D1
movem.l D0/D1,(A3)
bsr onecap
100$
movem.l (SP)+,D5/D6
rts
onecap
movem.l (A3),D0-D3
sub.l D2,D0
sub.l D5,D0
sub.l D3,D1
add.l D6,D1
movem.l D0/D1,-(SP)
bsr qamove
movem.l (A3),D0-D3
sub.l D2,D0
sub.l D3,D1
bsr qadraw
movem.l (A3),D0-D3
add.l D2,D0
add.l D3,D1
bsr qadraw
movem.l (A3),D0-D3
add.l D2,D0
sub.l D5,D0
add.l D3,D1
add.l D6,D1
bsr qadraw
movem.l (SP)+,D0/D1
bsr qadraw
bra qaend
DEF setlinecap
bsr popnum
tst.l D0
bmi type_mismatch
cmp.l #2,D0
bgt type_mismatch
move.w D0,linecap
rts
DEF currentlinecap
moveq #0,D0
move.w linecap,D0
RETURN Integer
DEF setlinejoin
bsr popnum
tst.l D0
bmi type_mismatch
cmp.l #2,D0
bgt type_mismatch
move.w D0,linejoin
rts
DEF currentlinejoin
moveq #0,D0
move.w linejoin,D0
RETURN Integer
arsource dc.l 0,0,0,0
ardest dc.l 0,0,0,0
deltayx dc.l 0,0
buttremember dc.l 0,0
ibuttremember dc.l 0,0
buttbegin dc.l 0,0
ibuttbegin dc.l 0,0
a_linecap dc.l 0,0,0,0,0,0
b_linecap dc.l 0,0,0,0,0,0
DEF erasepage
move.l rastport,A1
move.l 8(A1),-(SP) save pattern
moveq #0,D0
move.b $19(A1),D0 save fgpen
move.l D0,-(SP)
move.b $1C(A1),D0 save draw mode
move.l D0,-(SP)
lea areasptrn,A0 solid pattern
move.l A0,8(A1)
moveq #0,D0
graphics SetDrMd
moveq #0,D0
graphics SetAPen
moveq #0,D0
move.l D0,D1
move.l #639,D2
move.l #MaxY,D3
move.l A1,-(SP)
graphics RectFill
move.l (SP)+,A1
move.l (SP)+,D0 old mode
move.l (SP)+,D2 old fg pen
move.l (SP)+,8(A1) old pattern
graphics SetDrMd
move.l D2,D0
graphics SetAPen
rts
* above substituted for following, since system
* was corrupted by ClearScreen
* lea $24(A1),A2
* move.l (A2),-(SP) save currentpoint
* clr.l (A2) home
* graphics ClearScreen
* move.l (SP)+,(A2)
* rts
DEF pencolor
bsr popnum
moveq #PenMask,D1
and.l D1,D0
graphics SetAPen
rts
DEF penbcolor
bsr popnum
moveq #PenMask,D1
and.l D1,D0
graphics SetBPen
rts
DEF penmode
bsr popnum
graphics SetDrMd
rts
DEF penpattern
bsr popnum
move.l rastport,A1
move.w D0,$22(A1)
rts
DEF box
bsr popxy
bsr newpoint
movem.l D0/D1,-(SP)
bsr popxy
bsr newpoint
movem.l (SP)+,D2/D3
cmp.l D2,D0
bls 1$
exg D0,D2
1$ cmp.l D3,D1
bls 2$
exg D1,D3
2$
graphics RectFill
rts
DEF currentrgbcolor
move.l viewport,A0
move.l 4(A0),A0 colormap
move.l rastport,A1
moveq #0,D0
move.b $19(A1),D0
graphics GetRGB4
move.l D0,D3
move.w #Integer,D2
moveq #%1111,D1
lsr #8,D0
and.l D1,D0
bsr r.ipush
move.l D3,D0
lsr #4,D0
and.l D1,D0
bsr r.ipush
move.l D3,D0
and.l D1,D0
bra r.ipush
DEF setrgbcolor
bsr popnum
move.l D0,D3
bsr popnum
move.l D0,D4
bsr popnum
move.l D0,D1
move.l D4,D2
move.l viewport,A0
move.l rastport,A1
moveq #0,D0
move.b $19(A1),D0
graphics SetRGB4
rts
DEF findfont
bsr ipop
move.l D0,A1
cmp.w #Name,D2
beq 1$
cmp.w #String,D2
bne type_mismatch
move.b (A1)+,D0
bne 2$
1$ lea fontdirectory,A2
bsr dictsearch
tst.l D2
bmi 3$
RETURN FontID
2$ ERR big_key
3$ ERR no_font
DEF scalefont
bsr ipop
move.l D0,D1
move.w D2,D3
ARG FontID
move.l D0,-(SP)
move.w #FontID,D2
bsr r.ipush
move.l D1,D0
move.w D3,D2
bsr r.ipush
move.l (SP)+,A0
tst.w (A0)
bmi _scaleg
move.l A0,-(SP)
bsr popnum
move.l (SP)+,A0
move.w D0,(A0)
rts
DEF setfont
ARG FontID
resetfont
move.l D0,A2
move.l D0,A1
move.w (A1)+,D0 scaled size
bmi setresfont
move.l A1,D2 save ptr font address
move.l (A1)+,A0 font address, if open, and A1->TAttr
addq.l #4,A1
move.w (A1),D1 size in TAttr
cmp.w D1,D0
beq 1$ req. size same as known size?
move.w D0,(A1)
bra 2$ have to ask for new size
1$ move.l A0,D0 already open?
bne 4$ if so, use it
* correct font and size not known
* first see if it's on list of resident fonts
2$ lea 6(A2),A0 TAttr for following call
graphics OpenFont
tst.l D0
beq 20$ if was not found, try on disk
move.l D0,A0 for SetFont call
move.l D0,2(A2) may as well keep address, even if wrong size
move.w $14(A0),D0 size of font found
cmp.w (A2),D0 same as scaled value?
beq 4$ if so, go use it
20$
* well, maybe it's on disk
bsr opendflib make sure diskfont lib is open
tst.l D0
beq 3$ no diskfont lib
move.l A6,-(SP)
move.l D0,A6 diskfontbase
lea 6(A2),A0 TAttr
jsr -$1E(A6) OpenDiskFont
move.l (SP)+,A6
move.l D0,A0
tst.l D0
bne 4$ got it?
3$ print no_font alternatives exhausted
bra reinterp
4$ sf resfontflag
move.l A0,2(A2) save font address
move.l A2,currfont for currentfont operator
graphics SetFont
rts
setresfont
st resfontflag
move.l A2,currfont
rts
DEF currentfont
move.l currfont,D0
RETURN FontID
xdef currfont
currfont dc.l _topaz
*******
opendflib
move.l diskfontbase,D0
bne 1$
move.l A6,-(SP)
move.l 4,A6
lea dflibname,A1
moveq #0,D0
jsr -$228(A6)
move.l D0,diskfontbase
move.l (SP)+,A6
1$ rts
* not used yet
closedflib
move.l diskfontbase,D0
beq 1$
move.l A6,-(SP)
move.l 4,A6
lea dflibname,A1
moveq #0,D0
jsr -$19E(A6)
moveq #0,D0
move.l D0,diskfontbase
move.l (SP)+,A6
1$ rts
section gdata,data
diskfontbase dc.l 0
dflibname dc.b 'diskfont.library',0
resfontflag dc.b 0
cnop 0,2
newfont macro
_\1 dc.w \2
dc.l 0
dc.l 1$
dc.w \2
dc.b 0
dc.b %01100011
1$ dc.b '\1.font',0
cnop 0,2
endm
newfont topaz,8
newfont diamond,12
newfont ruby,12
newfont opal,11
newfont sapphire,19
newfont garnet,16
newfont emerald,20
_simplex dc.w $FFFF
dc.w Real
dc.l OnePoint
fentry macro
dc.l .\1
dc.w FontID
dc.l _\1
endm
nentry macro
.\1 dc.b 1$-*-1
dc.b '\1'
1$
endm
fontdirectory
fentry topaz
fentry diamond
fentry ruby
fentry opal
fentry sapphire
fentry garnet
fentry emerald
fentry simplex
dc.l 0
fontnames
nentry topaz
nentry diamond
nentry ruby
nentry opal
nentry sapphire
nentry garnet
nentry emerald
nentry simplex
bstr no_font,<can''t find font>
bstr big_key,<key too long>
bstr psov,<gsave overflow>
bstr psuv,<grestore underflow>
bstr pntsov,<too many points in path>
bstr out01,<arg outside 0...1 interval>
cnop 0,2
linecap dc.w 1 0=butt, 1=round, 2=projecting square
linejoin dc.w 0
graylevel dc.l 0
areasptrn
dc.w %1111111111111111
dc.w %1111111111111111
dc.w %1111111111111111
dc.w %1111111111111111
areaptrn
dc.w %0111011101110111
dc.w %1101110111011101
dc.w %0111011101110111
dc.w %1101110111011101
dc.w %0101010101010101
dc.w %1010101010101010
dc.w %0101010101010101
dc.w %1010101010101010
dc.w %0001000100010001
dc.w %0100010001000100
dc.w %0001000100010001
dc.w %0100010001000100
dc.w 0,0,0,0
xdef strokepathflag
strokepathflag dc.w 0
section groom,bss
pstackcnt ds.w 1
pstack ds.l 1
ds.b 18*PstackSize
pstacktop ds.w 1
ds.l 1
pointcnt ds.w 1
nextpoint ds.l 1
tmpras ds.l 2
areainfo ds.l 4
ds.w 4
areabuffer ds.b 5*AreaSize
pathbuffer ds.b 10*AreaSize
end