!!!Fast Graphics 15 Routines
General Information
Author: Carsten Strotmann \\
Language: ACTION! \\
Compiler/Interpreter: ACTION! \\
Published: 12.04.90 \\
! Fast Graphics 15 Routines
{{{
00010 .LI OFF
00020 ******************************
00030 * *
00040 * PROGRAMM:GR15GRAFIK *
00050 * AUTOR :CARSTEN STROTMANN *
00060 * DATUM : *
00070 * VERSION : *
00080 * FUER :ACTION! *
00090 * *
00100 ******************************
00110 ;
00120 ROWAC = $70
00130 COLAC = $72
00140 BITMSK = $6E
00150 SHFAMT = $6F
00160 SAVMSC = $58
00170 XNEU = $5A
00180 YNEU = $5B
00190 XALT = $55
00200 YALT = $54
00210 ZAEHLER = $E4
00220 DELTAX = $76
00230 DELTAY = $77
00240 XFLAG = $74
00250 YFLAG = $75
00251 HLP = $E6
00260 HILFA = $E9
00270 HILFB = $EB
00280 HILFT = $ED
00290 FILLDAT = $2FD
00300 ;
00310 ;
00320 .OR $0600
00330 .OF "D:GR15MOD.COM"
00340 ;
00350 ;
00360 PLOT
00370 AND #3
00380 STA BITMSK
00390 STX XALT
00400 STY YALT
00410 LDA #0
00420 STA HLP
00430 STA HLP+1
00440 STA HLP+2
00450 TYA
00460 ASL
00470 ROL HLP
00480 ASL
00490 ROL HLP
00500 ASL
00510 ROL HLP Y*8
00520 STA HLP+1
00530 LDX HLP
00540 STX HLP+2
00550 ASL
00560 ROL HLP
00570 ASL
00580 ROL HLP
00590 CLC
00600 ADC HLP+1
00610 STA HLP+1
00620 LDA HLP+2
00630 ADC HLP
00640 STA HLP+2
00650 CLC
00660 LDA SAVMSC
00670 ADC HLP+1
00680 STA ROWAC
00690 LDA SAVMSC+1
00700 ADC HLP+2
00710 STA ROWAC+1
00720 LDA XALT
00730 AND #3 ;X MOD 4
00740 STA SHFAMT
00750 LDA XALT
00760 LSR ;X/4
00770 LSR
00780 CLC
00790 ADC ROWAC
00800 STA ROWAC
00810 BCC .3
00820 INC ROWAC+1
00830 .3 LDX BITMSK
00840 LDA COLR,X
00850 LDX SHFAMT
00860 AND OFFS,X
00870 STA BITMSK
00880 LDY #0
00890 LDA (ROWAC),Y
00900 AND OFF2,X
00910 ORA BITMSK
00920 STA (ROWAC),Y
00930 RTS
00940 ------------------------------
00950 OFFS .HX C0300C03
00960 OFF2 .HX 3FCFF3FC
00970 COLR .HX 00AA55FF
00990 ------------------------------
01000 .OR $7000
01010 ;
01020 LINE
01030 STX XNEU
01040 STY YNEU
01050 STA FILLDAT
01060 LDX XALT
01070 LDY YALT
01080 JSR PLOT
01090 LDA #0
01100 STA XFLAG
01110 STA YFLAG
01120 LDX XNEU
01130 LDY YNEU
01140 ;
01150 CPX XALT
01160 BNE .1
01170 CPY YALT
01180 BNE .1
01190 RTS
01200 ;
01210 .1 CPX XALT
01220 BCC DRX
01230 INC XFLAG
01240 TXA
01250 SBC XALT
01260 JMP DR2
01270 ;
01280 DRX
01290 DEC XFLAG
01300 SEC
01310 LDA XALT
01320 SBC XNEU
01330 ;
01340 DR2
01350 STA DELTAX
01360 CPY YALT
01370 BCC DRY
01380 INC YFLAG
01390 TYA
01400 SBC YALT
01410 JMP DR3
01420 ;
01430 DRY
01440 DEC YFLAG
01450 SEC
01460 LDA YALT
01470 SBC YNEU
01480 ;
01490 DR3
01500 STA DELTAY
01510 LDA XALT
01520 STA XNEU
01530 LDA YALT
01540 STA YNEU
01550 LDA DELTAX
01560 CMP DELTAY
01570 BCC DRYSTEP
01580 ;
01590 LDA DELTAY
01600 ASL
01610 STA HILFA
01620 LDA #0
01630 ROL
01640 STA HILFA+1
01650 ;
01660 SEC
01670 LDA HILFA
01680 SBC DELTAX
01690 STA HILFT
01700 LDA HILFA+1
01710 SBC #0
01720 STA HILFT+1
01730 ;
01740 SEC
01750 LDA HILFT
01760 SBC DELTAX
01770 STA HILFB
01780 LDA HILFT+1
01790 SBC #0
01800 STA HILFB+1
01810 ;
01820 LDA DELTAX
01830 STA ZAEHLER
01840 ;
01850 DXSCHL
01860 CLC
01870 LDA XNEU
01880 ADC XFLAG
01890 STA XNEU
01900 LDA HILFT+1
01910 BPL DRX5
01920 ;
01930 CLC
01940 LDA HILFT
01950 ADC HILFA
01960 STA HILFT
01970 LDA HILFT+1
01980 ADC HILFA+1
01990 STA HILFT+1
02000 ;
02010 JMP DRX4
02020 ;
02030 DRX5
02040 CLC
02050 LDA HILFT
02060 ADC HILFB
02070 STA HILFT
02080 LDA HILFT+1
02090 ADC HILFB+1
02100 STA HILFT+1
02110 ;
02120 CLC
02130 LDA YNEU
02140 ADC YFLAG
02150 STA YNEU
02160 ;
02170 DRX4
02180 LDX XNEU
02190 LDY YNEU
02200 LDA FILLDAT
02210 JSR PLOT
02220 DEC ZAEHLER
02230 BNE DXSCHL
02240 JMP DREND
02250 ;
02260 DRYSTEP
02270 LDA DELTAX
02280 ASL
02290 STA HILFA
02300 LDA #0
02310 ROL
02320 STA HILFA+1
02330 ;
02340 SEC
02350 LDA HILFA
02360 SBC DELTAY
02370 STA HILFT
02380 LDA HILFA+1
02390 SBC #0
02400 STA HILFT+1
02410 ;
02420 SEC
02430 LDA HILFT
02440 SBC DELTAY
02450 STA HILFB
02460 LDA HILFT+1
02470 SBC #0
02480 STA HILFB+1
02490 ;
02500 LDA DELTAY
02510 STA ZAEHLER
02520 ;
02530 DYSCHL
02540 CLC
02550 LDA YNEU
02560 ADC YFLAG
02570 STA YNEU
02580 LDA HILFT+1
02590 BPL DRY5
02600 ;
02610 CLC
02620 LDA HILFT
02630 ADC HILFA
02640 STA HILFT
02650 LDA HILFT+1
02660 ADC HILFA+1
02670 STA HILFT+1
02680 ;
02690 JMP DRY4
02700 ;
02710 DRY5
02720 CLC
02730 LDA HILFT
02740 ADC HILFB
02750 STA HILFT
02760 LDA HILFT+1
02770 ADC HILFB+1
02780 STA HILFT+1
02790 CLC
02800 LDA XNEU
02810 ADC XFLAG
02820 STA XNEU
02830 DRY4
02840 LDX XNEU
02850 LDY YNEU
02860 LDA FILLDAT
02870 JSR PLOT
02880 DEC ZAEHLER
02890 BNE DYSCHL
02900 ;
02910 DREND
02920 LDX XNEU
02930 LDY YNEU
02940 STX XALT
02950 STY YALT
02960 RTS
02970 ------------------------------
}}}
----
! ACTION Routinen
{{{
;********************************
;** **
;** Phoenix SoftCrew ACTION! **
;** Programme und Tips f. 8Bit **
;** **
;** Carsten Strotmann **
;** **
;********************************
; Programmname:Gr.15 Fast Modul
; done by:Carsten Strotmann
; Filename:GR15MOD.ACT
; first Version:12.04.90
; last change:12.04.90
; fast gr 15 routines
;
;
PROC FPlot=$0600 (BYTE color,x,y)
PROC FLine=$7000 (BYTE color,x,y)
PROC Pixel (CARD x,y)
IF x>=0 AND x<160 AND y>=0 AND y<192 THEN
FPlot (color,x,y)
FI
RETURN
PROC LineTo (BYTE x1,y1,x2,y2)
Pixel (x1,y1)
FLine (color,x2,y2)
RETURN
CARD FUNC Abs (INT val)
IF val<0 THEN
val=-val
FI
RETURN (val)
{code}
----
1.1.1 Demo Program
{code}
;********************************
;** **
;** Phoenix SoftCrew ACTION! **
;** Programme und Tips f. 8Bit **
;** **
;** Carsten Strotmann **
;** **
;********************************
; Programname:BOX15.ACT
; done by:BJOERN ISREAL/CARSTEN STROTMANN
; Filename:BOX15.ACT
; first Version:22.04.90
; last change:22.04.90
; DEMO
;
INCLUDE "GR15MOD.ACT"
PROC Kiste ()
BYTE hcol=710,pcol=709,rcol=712,
za,c,pza,
xpos1,xpos2,px1,px2,
ypos1,ypos2,py1,py2,
x2pos1,x2pos2,px21,px22,
y2pos1,y2pos2,py21,py22,
rra,rri,obra,obri,ura,uri,lra,lri
rra=150
rri=140
obra=3
obri=13
ura=190
uri=180
lra=3
lri=13
xpos1=10
ypos1=10
xpos2=30
ypos2=20
x2pos1=10
y2pos1=10
x2pos2=30
y2pos2=20
px1=3
px2=3
py1=3
py2=3
px21=3
px22=3
py21=3
py22=3
c=1
pza=0
za=0
Graphics (31)
hcol=12
pcol=2
rcol=14
color=2
LineTo (0,0,159,0)
LineTo (159,0,159,191)
LineTo (159,191,0,191)
LineTo (0,191,0,0)
DO
xpos1==+px1
xpos2==+px2
ypos1==+py1
ypos2==+py2
IF xpos1>rra THEN
px1=-3
FI
IF xpos1<lra THEN
px1=3
FI
IF xpos2>rri THEN
px2=-3
FI
IF xpos2<lri THEN
px2=3
FI
;
;******
;
IF ypos1>ura THEN
py1=-3
FI
IF ypos1<obra THEN
py1=3
FI
IF ypos2>uri THEN
py2=-3
FI
IF ypos2<obri THEN
py2=3
FI
;
;****
;
color=1
LineTo (xpos1,ypos1,xpos2,ypos2)
IF pza=0 THEN
za==+1
FI
IF za=30 THEN
pza=1
x2pos1==+px21
x2pos2==+px22
y2pos1==+py21
y2pos2==+py22
IF x2pos1>rra THEN
px21=-3
FI
IF x2pos1<lra THEN
px21=3
FI
IF x2pos2>rri THEN
px22=-3
FI
IF x2pos2<lri THEN
px22=3
FI
;
;****
;
IF y2pos1>ura THEN
py21=-3
FI
IF y2pos1<obra THEN
py21=3
FI
IF y2pos2>uri THEN
py22=-3
FI
IF y2pos2<obri THEN
py22=3
FI
;
;****
;
color=0
LineTo (x2pos1,y2pos1,x2pos2,y2pos2)
FI
OD
RETURN
}}}