hgr: starfield, why not hgr too

This commit is contained in:
Vince Weaver 2021-06-13 00:03:47 -04:00
parent 09786f09c7
commit 4c6ea54f22
5 changed files with 579 additions and 2 deletions

View File

@ -3,13 +3,21 @@ include ../../../Makefile.inc
DOS33 = ../../../utils/dos33fs-utils/dos33
TOKENIZE = ../../../utils/asoft_basic-utils/tokenize_asoft
LINKER_SCRIPTS = ../../../linker_scripts
EMPTY_DISK = ../../../empty_disk
all: starfield.dsk
starfield.dsk: STARS FASTAR
cp empty.dsk starfield.dsk
starfield.dsk: HELLO STARS FASTAR STARBOT
cp $(EMPTY_DISK)/empty.dsk starfield.dsk
$(DOS33) -y starfield.dsk SAVE A HELLO
$(DOS33) -y starfield.dsk BSAVE -a 0x0300 STARS
$(DOS33) -y starfield.dsk BSAVE -a 0x0C00 FASTAR
$(DOS33) -y starfield.dsk BSAVE -a 0x0C00 STARBOT
###
HELLO: hello.bas
$(TOKENIZE) < hello.bas > HELLO
###
@ -30,5 +38,14 @@ stars.o: stars.s
###
STARBOT: starbot.o
ld65 -o STARBOT starbot.o -C $(LINKER_SCRIPTS)/apple2_c00.inc
starbot.o: starbot.s
ca65 -o starbot.o starbot.s -l starbot.lst
###
clean:
rm -f *~ *.o *.lst STARS FASTAR

Binary file not shown.

View File

@ -0,0 +1,2 @@
5 HOME
10 PRINT CHR$(4);"CATALOG"

View File

@ -0,0 +1,279 @@
; starfield tiny -- Apple II Hires
; by Vince `deater` Weaver
; 139 bytes -- lores version
; zero page locations
COLOR = $30
star_z = $60
oldx = $70
oldy = $80
star_x = $90
star_y = $A0
HGR_COLOR = $E4
HGR_PAGE = $E6
SAVEX = $F8
TEMP = $F9
QUOTIENT = $FA
DIVISOR = $FB
DIVIDEND = $FC
XX = $FD
YY = $FE
FRAME = $FF
; soft-switches
; ROM routines
HGR2 = $F3D8 ; set hires page2 and clear $4000-$5fff
HGR = $F3E2 ; set hires page1 and clear $2000-$3fff
HPLOT0 = $F457 ; plot at (Y,X), (A)
HCOLOR1 = $F6F0 ; set HGR_COLOR to value in X
PLOT = $F800 ; PLOT AT Y,A (A colors output, Y preserved)
NEXTCOL = $F85F ; COLOR=COLOR+3
SETCOL = $F864 ; COLOR=A
SETGR = $FB40 ; set graphics and clear LO-RES screen
WAIT = $FCA8 ; delay 1/2(26+27A+5A^2) us
small_starfield:
;0GR:DIMV(64,48):FORZ=1TO48:FORX=0TO64:V(X,Z)=(X*4-128)/Z+20:NEXTX,Z
jsr HGR ; A is ? after
;===================================
; draw the stars
;===================================
; there are ways to skip this, but on real hardware there's
; no guarantee star_z will be in a valid state, so waste the bytes
ldx #15
make_orig_stars:
jsr make_new_star
dex
bpl make_orig_stars
;===================================
; starloop
;2FORP=0TO15
big_loop:
ldx #15
; really tried hard not to have to set this value
; hard to judge best value for this
lda #80
jsr WAIT
; jsr $FBE4 ; BEEP delays too
; A now 0
star_loop:
; X=FF
;===================
; erase old star
;4 COLOR=0
lda #$00 ; color to black
sta HGR_COLOR ; set HGR_COLOR to value in X
;PLOT O(P),Q(P)
stx SAVEX
ldy oldx,X
sty TEMP
lda oldy,X
ldx TEMP
ldy #0
jsr HPLOT0 ; plot at (Y,X), (A)
ldx SAVEX
;===========================
; position Z
; lda star_z,X
; beq new_star ; should never happen
; sta DIVISOR
; DIVISOR always star_z,X so can hard code this in divide routine
;==============================
; get Y/Z
; Y=V(B(P),Z(P))
; get YY
lda star_y,X ; get Y of star
jsr do_divide
; if off-screen then need new star
bmi new_star ; if <0
cmp #40
bcs new_star ; bge >39
sta YY ; YY
;==============================
; get X/Z
; X=V(A(P),Z(P))
; get XX
lda star_x,X ; get X of start
jsr do_divide
tay ; put XX in Y
; if offscreen then draw new star
bmi new_star ; if <0
cpy #40
bcs new_star ; bge >40
;========================
; adjust Z
;Z(P)=Z(P)-1
dec star_z,X
beq new_star ; if Z=0 new star
; draw the star
draw_star:
lda #$7f ; white (with green/purple highlights)
sta HGR_COLOR ; set HGR_COLOR to value in X
;===========================
; actually plot the star
;HPLOT X,Y
; O(P)=X:Q(P)=Y
stx SAVEX
lda YY ; YY
sta oldy,X ; ;save for next time to erase
; ldy XX ; XX already in Y
sty oldx,X ; save for next time to erase
sty TEMP
ldx TEMP
lda YY
ldy #0
jsr HPLOT0 ; plot at (Y,X), (A)
ldx SAVEX
jmp done_star ; bra
new_star:
jsr make_new_star ;
done_star:
;7NEXT
dex
bpl star_loop
; GOTO2
bmi big_loop ; bra
;===========================
; NEW STAR
;===========================
make_new_star:
;IFX<0ORX>39ORY<0ORY>39ORZ(P)<1THEN
; A(P)=RND(1)*64
; B(P)=RND(1)*64
; Z(P)=RND(1)*48+1:GOTO7
ldy FRAME
lda $F000,Y
sta star_x,X ; random XX
color_lookup:
lda $F100,Y
sta star_y,X ; random YY
lda $F002,Y
and #$3f ; random ZZ 0..63
ora #$1 ; avoid 0
sta star_z,X
inc FRAME
rts
;=============================
; do signed divide
; the signed part is the pain
;=============================
; Z is in divisor
; x/y is in A
do_divide:
; A was just loaded so flags still valid
php
bpl not_negative
eor #$ff ; make positive for division
clc ; is this necessary?
adc #1
not_negative:
ldy #$ff ; QUOTIENT
div_loop:
iny ; inc QUOTIENT
sec
sbc star_z,X ; DIVIDEND=DIVIDEND-DIVISOR
bpl div_loop
; write out quotient
tya ; lda QUOTIENT
plp
bpl pos_add
eor #$ff
; sec ; FIXME: made math inaccurate to save room
; bcs do_add
pos_add:
clc
do_add:
adc #20 ; pre-adjust to have star origin mid screen
early_out:
rts
; for BASIC bot load
; need this to be at $3F5
; it's at 8C, so 6D
jmp small_starfield

View File

@ -0,0 +1,279 @@
; starfield tiny -- Apple II Hires
; by Vince `deater` Weaver
; 139 bytes -- lores version
; zero page locations
COLOR = $30
star_z = $60
oldx = $70
oldy = $80
star_x = $90
star_y = $A0
HGR_COLOR = $E4
HGR_PAGE = $E6
SAVEX = $F8
TEMP = $F9
QUOTIENT = $FA
DIVISOR = $FB
DIVIDEND = $FC
XX = $FD
YY = $FE
FRAME = $FF
; soft-switches
; ROM routines
HGR2 = $F3D8 ; set hires page2 and clear $4000-$5fff
HGR = $F3E2 ; set hires page1 and clear $2000-$3fff
HPLOT0 = $F457 ; plot at (Y,X), (A)
HCOLOR1 = $F6F0 ; set HGR_COLOR to value in X
PLOT = $F800 ; PLOT AT Y,A (A colors output, Y preserved)
NEXTCOL = $F85F ; COLOR=COLOR+3
SETCOL = $F864 ; COLOR=A
SETGR = $FB40 ; set graphics and clear LO-RES screen
WAIT = $FCA8 ; delay 1/2(26+27A+5A^2) us
small_starfield:
;0GR:DIMV(64,48):FORZ=1TO48:FORX=0TO64:V(X,Z)=(X*4-128)/Z+20:NEXTX,Z
jsr HGR ; A is ? after
;===================================
; draw the stars
;===================================
; there are ways to skip this, but on real hardware there's
; no guarantee star_z will be in a valid state, so waste the bytes
ldx #15
make_orig_stars:
jsr make_new_star
dex
bpl make_orig_stars
;===================================
; starloop
;2FORP=0TO15
big_loop:
ldx #15
; really tried hard not to have to set this value
; hard to judge best value for this
lda #80
jsr WAIT
; jsr $FBE4 ; BEEP delays too
; A now 0
star_loop:
; X=FF
;===================
; erase old star
;4 COLOR=0
lda #$00 ; color to black
sta HGR_COLOR ; set HGR_COLOR to value in X
;PLOT O(P),Q(P)
stx SAVEX
ldy oldx,X
sty TEMP
lda oldy,X
ldx TEMP
ldy #0
jsr HPLOT0 ; plot at (Y,X), (A)
ldx SAVEX
;===========================
; position Z
; lda star_z,X
; beq new_star ; should never happen
; sta DIVISOR
; DIVISOR always star_z,X so can hard code this in divide routine
;==============================
; get Y/Z
; Y=V(B(P),Z(P))
; get YY
lda star_y,X ; get Y of star
jsr do_divide
; if off-screen then need new star
bmi new_star ; if <0
cmp #40
bcs new_star ; bge >39
sta YY ; YY
;==============================
; get X/Z
; X=V(A(P),Z(P))
; get XX
lda star_x,X ; get X of start
jsr do_divide
tay ; put XX in Y
; if offscreen then draw new star
bmi new_star ; if <0
cpy #40
bcs new_star ; bge >40
;========================
; adjust Z
;Z(P)=Z(P)-1
dec star_z,X
beq new_star ; if Z=0 new star
; draw the star
draw_star:
lda #$7f ; white (with green/purple highlights)
sta HGR_COLOR ; set HGR_COLOR to value in X
;===========================
; actually plot the star
;HPLOT X,Y
; O(P)=X:Q(P)=Y
stx SAVEX
lda YY ; YY
sta oldy,X ; ;save for next time to erase
; ldy XX ; XX already in Y
sty oldx,X ; save for next time to erase
sty TEMP
ldx TEMP
lda YY
ldy #0
jsr HPLOT0 ; plot at (Y,X), (A)
ldx SAVEX
jmp done_star ; bra
new_star:
jsr make_new_star ;
done_star:
;7NEXT
dex
bpl star_loop
; GOTO2
bmi big_loop ; bra
;===========================
; NEW STAR
;===========================
make_new_star:
;IFX<0ORX>39ORY<0ORY>39ORZ(P)<1THEN
; A(P)=RND(1)*64
; B(P)=RND(1)*64
; Z(P)=RND(1)*48+1:GOTO7
ldy FRAME
lda $F000,Y
sta star_x,X ; random XX
color_lookup:
lda $F100,Y
sta star_y,X ; random YY
lda $F002,Y
and #$3f ; random ZZ 0..63
ora #$1 ; avoid 0
sta star_z,X
inc FRAME
rts
;=============================
; do signed divide
; the signed part is the pain
;=============================
; Z is in divisor
; x/y is in A
do_divide:
; A was just loaded so flags still valid
php
bpl not_negative
eor #$ff ; make positive for division
clc ; is this necessary?
adc #1
not_negative:
ldy #$ff ; QUOTIENT
div_loop:
iny ; inc QUOTIENT
sec
sbc star_z,X ; DIVIDEND=DIVIDEND-DIVISOR
bpl div_loop
; write out quotient
tya ; lda QUOTIENT
plp
bpl pos_add
eor #$ff
; sec ; FIXME: made math inaccurate to save room
; bcs do_add
pos_add:
clc
do_add:
adc #20 ; pre-adjust to have star origin mid screen
early_out:
rts
; for BASIC bot load
; need this to be at $3F5
; it's at 8C, so 6D
jmp small_starfield