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
