[stella] spacewar-ish work in progress

Subject: [stella] spacewar-ish work in progress
From: <richbon-lists4800@xxxxxxxxxxxxxx>
Date: Thu, 16 Jun 2005 23:02:37 -0400
 Hey Gang...

  I posted an earlier version of this a few weeks ago if anyone recalls. 
The ships still don't shoot or anything, but they zip around quite 
nicely. The view also zooms out when the ships get too far apart. And 
the thing that I'm most impressed with at the moment (if I do say so 
myself) is getting the starfield to move around in a convincing manner. 
That was an evil problem to get nailed down and working right. It's the 
ball graphic hmoved like crazy and turned on once every sixteen lines. 
I was really excited about that and had to show it off...

  So it's not quite critical yet, but time is going to start getting a 
little tight in the overscan and the vertical blank. Anyone have any 
thoughts on tightening things up a bit? Any other thoughts or feedback 
in general are much appreciated...

 -Rich

  (The latest source and binary should be attached. Let's see if they 
come through.)

Archives (includes files) at http://www.biglist.com/lists/stella/archives/
Unsub & more at http://stella.biglist.com
;Rich Boniface    http://shatterscape.com
;Atari 2600 programming project.

; Revision History
;  0.10  -  Moved some logic into subroutines
;  0.11  -  Moved more logic into subroutines, Added p1 ship
;           Also introduced weird vertical strech bug when both ships are on same horizontal line
;  0.12  -  Interleaved p0,p1 variables so that all offsets would be 0,1 (instead of 0,1 or 0,2)
;           Consolidated multiplication routines in populate_thrust_vectors
;           Also moved bzoneRepos routine further from its table, because the code had pushed
;           them too close and was screwing up the movement by not forcing a page boundary cross
;  0.13  -  Can't remember what I did here.  Should have written it down.
;  0.14  -  Implemented skipdraw.  That also fixed the weird strech bug.
;  0.15  -  Started playing with some ideas for adding a starfield
;           Added bitmaps for small ships for "zoomed out" view.
;           Modified subroutines to take X as player number instead of A.
;  0.16  -  Moved joystick routines into subroutine
;           Worked on math for "zoomed out" view - relative motion ("camera" centers between ships)
;  0.17  -  Actually add "zoomed out" view and auto-zoom feature
;           Modified bmp_select to use lookup tables instead of loops, and pick from small ships
;           Also modified bmp_select to use a 4 pixel horizontal left shift for small ships when
;           the reflection bit is turned on.
;  0.18  -  Starfield is on and scrolls correctly in the horizontal dimension.
;           Vertical starfield scroll not implemented yet.
;  0.19  -  Now the starfield scrolls in the correct vertical direction, but the
;           horizontal direction seems to be backwards now.  Also occasionally running
;           out of time in the overscan/vblank.
;  0.20  -  Attempt to implement a simpler starfield routine.
;           The starfield finally #&#%@ing works!
;  0.21  -  Switch to shorter bzoneRepos (horizontal positioning) routine.
;           Add "small ship" bitmaps for reflected positions, too, to avoid ghosting when
;           a player travels off the left side of the screen facing left.
;           Slow (halve) rate of star motion in zoomed-out view.
;           Added time_remaining variables to watch how much time is remaining in the
;           overscan and vertical blank blocks. (View in Z26 traces.)

                   processor 6502      ; Atari 2600 CPU
                   include "vcs.h"     ; Stella (TIA & PIA & RIOT) Definitions
                   include "macro.h"   ; Useful Functions

;///////////////////////////////////////////////////////////////////////////////

;some constants

C_KERNAL_HEIGHT     = 192
C_SHIP_HEIGHT       = 13
C_SMALL_SHIP_HEIGHT = 6
C_STAR_DENSITY      = $10    ;#16 
C_INIT_HOFF         = $60    ;#96 = 160 - 64

                   SEG.U Variables
                   ORG $80

player_v_pos_byte0          ds 2  ;player vertical position LSB
player_v_pos_byte1          ds 2  ;player vertical position middle byte
player_v_pos_byte2          ds 2  ;player vertical position MSB
player_h_pos_byte0          ds 2  ;player horizontal position LSB
player_h_pos_byte1          ds 2  ;player horizontal position middle byte
player_h_pos_byte2          ds 2  ;player horizontal position MSB
player_rot_pos_LSB        ds 2  ;player rotational position LSB
player_rot_pos_MSB        ds 2  ;player rotational position MSB
player_v_screen           ds 2  ;player vertical position onscreen
player_h_screen           ds 2  ;player horizontal position onscreen
player_bmp_height         ds 1  ;height of player bitmaps minus one
player_bmp_pointer        ds 2  ;p0,p1 pointers to current bitmap (2 bytes ea)
player1_bmp_pointer       ds 2  ;  keep the bmp pointers contiguous
 ;player_bmp_pointer could not be interleaved because of
 ;the way indirect addresses work, so p1 offset is 2
player_thrust_table       ds 10 ;calculated thrust vectors (bits 0-4 are p0, 5-9 are p1)
player_v_delta            ds 2  ;p0,p1 potential vertical acceleration (1 byte each)
player_h_delta            ds 2  ;p0,p1 potentail horizontal acceleration
player_v_speed_LSB        ds 2  ;player vertical velocity LSB
player_v_speed_MSB        ds 2  ;player vertical velocity MSB
player_h_speed_LSB        ds 2  ;player horizontal velocity LSB
player_h_speed_MSB        ds 2  ;player horizontal velocity MSB
p0_skipdraw_window        ds 1
p1_skipdraw_window        ds 1
game_state                ds 1  ;bit 7 - (0=zoomed in, 1=zoomed out)
temp_byte                 ds 4  ;general temporary bytes
game_counter              ds 1  ;increments once a frame
star_v_speed_LSB          ds 1  ;apparent star velocity
star_v_speed_MSB          ds 1
star_h_speed_LSB          ds 1  ;apparent star velocity
star_h_speed_MSB          ds 1
star_v_pos_sub            ds 1  ;subpixel portion of vertical star position
star_v_pos                ds 2  ;rectangular co-ord of first star on screen
star_h_pos_sub            ds 1  ;subpixel portion of horizontal star position
star_h_pos                ds 2  ;rectangular co-ord of first star on screen
star_v_screen             ds 1  ;actual position of first star on screen
star_h_screen             ds 1  ;actual position of first star on screen
star_counter              ds 1  ;counts horizontal lines between stars
vb_time_remain            ds 1  ;***DEBUG - Least amount of time left on vertical blank
os_time_remain            ds 1  ;***DEBUG - Lease amount of time left on overscan


 ECHO [*-$80]d,"out of 128 RAM bytes used",[$100-*]d,"bytes left"
;///////////////////////////////////////////////////////////////////////////////
                   SEG
                   
                   ORG $F000

Reset
                   CLEAN_START

         ;----------------------------------------------------------------------
         ; Once-only initialization

                   lda #$FF
                   sta vb_time_remain ;***DEBUG
                   sta os_time_remain ;***DEBUG

                   lda #$00         ;black
                   sta COLUBK       ;set background color
                   sta game_counter ;init game_counter
                   sta star_v_pos
                   sta star_h_pos
                   lda #$88         ;dark blue
                   sta COLUPF       ;set playfield color
                   lda #$16         ;orange
                   sta COLUP0       ;set p0 color
                   lda #$58         ;
                   sta COLUP1       ;set p1 color
                   lda #$0E
                   sta COLUPF       ;set ball color (stars)
                   
                   lda #$80
                   sta player_v_pos_byte1    ;init p0 vert pos
                   sta player_v_screen
                   lda #$02
                   sta player_h_pos_byte2    ;init p0 horiz pos
                   lda #$79
                   sta player_h_pos_byte1    ;init p0 horiz pos

                   lda #$80
                   sta player_v_pos_byte1+1  ;init p1 vert pos
                   sta player_v_screen+1
                   lda #$80
                   sta player_h_pos_byte1+1  ;init p1 horiz pos

                   ldx #$00  ;p0
                   lda #$20  ;p0 thrust
                   jsr populate_thrust_vectors
                   ldx #$01  ;p1
                   lda #$18  ;p1 thrust
                   jsr populate_thrust_vectors

                   lda #%0000000    ;game starts out zoomed-in
                   sta game_state
                   

         ;----------------------------------------------------------------------

StartOfFrame       lda #%00000010
                   sta VSYNC
                   sta WSYNC
                   sta WSYNC
                   lda #%00000000
                   sta WSYNC
                   sta VSYNC

         	   lda #43              ;initialize vertical blank timer
	           sta TIM64T

         ;----------------------------------------------------------------------
         ; Vertical blank - 2792 cycles avaliable

;***most of the action happens here and in the overscan

                   ldx #0
                   jsr bmp_select
                   lda player_h_screen         ;load p0 horiz. position (x still 0)
                   jsr bzoneRepos              ;call horizontal pos routine

                   ldx #1
                   jsr bmp_select
                   lda player_h_screen+1       ;load p1 horiz. position (x still 1)
                   jsr bzoneRepos              ;call horizontal pos routine
                   
                   jsr star_position           ;set the starfield position

                   lda star_v_screen
                   sta star_counter


                   sta WSYNC                   ;make all horizontal moves
                   sta HMOVE
                   
                   lda #$00       ;Until I get P1 drawn earlier in the scanline,
                   sta GRP1       ;this will prevent first line ghosts
                   
                   
     ;Note to self with regards to page boundary cross in skipdraw - could break image bank across
     ;pages so that no indirect addressing has to cross pages.  Would have to modify bmp_select
     ;routine to accomodate.
                   
     ;set up skipdraw window shade
     ;we want to set up a counter that reaches zero at the bottom of our on-screen image
     ;imagine we pull a shade down over a window and draw our character at the very bottom of the shade,
     ;so that the top line of our character is in the last line of the window
p0_skipdraw_prep   sec                         ;seems to work better without the -1
                   lda #C_KERNAL_HEIGHT ;+ #C_SHIP_HEIGHT ;- #1 ;pull the shade over the whole window
                   adc player_bmp_height
                   sec
                   sbc player_v_screen         ;raise the shade far enough to let p0 appear
                                               ;at the scanline we want him
                   sta p0_skipdraw_window      ;save it
                  
     ;modify bitmap pointer to use offset of raw scanline counter
     ;note: the bitmap for a single image shouldn't cross a page boundary
                   lda player_bmp_pointer      ;LSB of bitmap pointer
                   clc
                   adc player_bmp_height       ;point it at the last line of the bitmap (the "top" of the image)
                   sec
                   sbc player_v_screen         ;subtract the number of scanlines off the bottom
                   sta player_bmp_pointer      ;store the modified LSB pointer
                   bcs .no_page_crossed         ;if we crossed a page boundary,
                     dec player_bmp_pointer+1  ; we have to decrement the MSB of the pointer, too.
.no_page_crossed
                   
p1_skipdraw_prep   sec
                   lda #C_KERNAL_HEIGHT ;+ #C_SHIP_HEIGHT ;- #1 ;pull the shade over the whole window
                   adc player_bmp_height
                   sec
                   sbc player_v_screen+1      ;raise the shade far enough to let p1 appear
                                               ;at the scanline we want him
                   sta p1_skipdraw_window      ;save it
                  
     ;modify bitmap pointer to use offset of raw scanline counter
     ;note: the bitmap for a single image shouldn't cross a page boundary
                   lda player1_bmp_pointer     ;LSB of bitmap pointer
                   clc
                   adc player_bmp_height      ;point it at the last line of the bitmap (the "top" of the image)
                   sec
                   sbc player_v_screen+1      ;subtract the number of scanlines off the bottom
                   sta player1_bmp_pointer     ;store the modified LSB pointer
                   bcs .no_page_crossed2       ;if we crossed a page boundary,
                     dec player1_bmp_pointer+1 ; we have to decrement the MSB of the pointer, too.
.no_page_crossed2
   
                   inc game_counter
                   
                   sta HMCLR                  ;clear horizontal movement vectors
                   ;lda #$0E    
                   ;sta COLUPF  ;grey playfield and ball
                   lda #0
                   sta ENABL  ;disable the ball
                   lda #0     ;***DEBUG no movement
                   lda #%1000000 ;move ball left 8 clocks right every hmove
                   sta HMBL
   
;----------------------------------------------------   
;--How much time can we kill before we have problems?   DEBUG
                   lda INTIM
                   cmp vb_time_remain
                   bcs .noless_vb
                     sta vb_time_remain
.noless_vb         nop
                   nop
                   nop
                   ldx vb_time_remain
                   jsr time_check   ;***DEBUG
;----------------------------------------------------
   
         ;----------------------------------------------------------------------

WaitEndOfVBlank    lda INTIM
	                 bpl WaitEndOfVBlank      ;wait here for the end of the vertical blank
                   lda #%00000000
                   sta WSYNC

         ;----------------------------------------------------------------------
         ; Do 192 scanlines

                   ldy #192
                   sta VBLANK
                   jmp Kernel_start
                   ;.byte $2C  ;testing this trick
Kernel
                   sta WSYNC
                   sta HMOVE
                   ;--76 cycles max (incl. loop code at bottom)
Kernel_start       lda player_bmp_height
                   dcp p0_skipdraw_window  ;has our shade pulled down far enough?
                   bcs .doDraw0
                    lda #0
                    .byte $2C              ;slick little hack to ignore the next instruction
.doDraw0           lda (player_bmp_pointer),Y ;this is the money shot [5], [6] if cross page
                   sta GRP0                ;write player 0 to screen
                   lda player_bmp_height
                   dcp p1_skipdraw_window  ;has our shade pulled down far enough?
                   bcs .doDraw1
                    lda #0
                    .byte $2C              ;slick little hack to ignore the next instruction
.doDraw1           lda (player1_bmp_pointer),Y ;this is the money shot [5], [6] if cross page
                   sta GRP1                ;write player 1 to screen
                   ;[32] - [34] by here
                   lda C_STAR_DENSITY
                   dec star_counter
                   bne .nostar
                    sta star_counter
                    lda #2
.nostar            sta ENABL

                   ;----------------
                   dey                     ;[2] also moved wsync to top of loop
                   bne Kernel              ;[3] we only care when it jumps (hope not over a boundary)

         ;----------------------------------------------------------------------
         ; 30 scanlines of overscan

                   lda #%01000010
                   sta VBLANK
                   lda #35
                   sta TIM64T

         ;----------------------------------------------------------------------
         ; Overscan - 2256 cycles avaliable

                   ldx #0                  ;call subroutines for p0
                   jsr interpret_controller ;read p0 joystick
                   jsr rocket_engine       ;establish engine thrust for current rotation
                   jsr update_velocity     ;apply all forces to velocity
                   jsr update_position
                   jsr wrap_around
                   
                   ldx #1                  ;call subroutines for p1
                   jsr interpret_controller ;read p1 joystick
                   jsr rocket_engine       ;establish engine thrust for current rotation
                   jsr update_velocity     ;apply all forces to velocity
                   jsr update_position
                   jsr wrap_around

                   jsr update_relative_screen_positions

                   lda INTIM         ;***DEBUG
                   cmp os_time_remain
                   bcs .noless_os
                     sta os_time_remain
.noless_os         nop
                   nop
                   nop
                   ldx os_time_remain

                   jsr time_check   ;***DEBUG

         ; End of Overscan
         ;----------------------------------------------------------------------

WaitEndOfOverscan  lda INTIM
                   bpl WaitEndOfOverscan
                   sta WSYNC

                   jmp StartOfFrame
                   
                   
         ;----------------------------------------------------------------------          
         ; Subroutines
         
;time_check    ****************************************************
; More of a debugging routine - should be removed before releasing this.
; If the timer has run out, change the BG color so we know it.
; A destroyed, XY unchanged
time_check         lda INTIM
                   bpl .not_out_of_time
                     sta COLUBK  ;change the bg color
.not_out_of_time   rts
         
;Horizontal positioning ****************************************************
;shorter version provided by Fred Quimby on Stella list
;Input:  A = desired horizontal position
;        X = object to be positioned (0->4 = P0->BALL)
;Output: A detroyed, X unchanged, Y unchanged

bzoneRepos
        sec
        sta WSYNC
.divideby15
        sbc #15
        bcs .divideby15
        eor #7
        asl
        asl
        asl
        asl
        sta HMP0,x
        sta RESP0,x
        rts	

star_position        ;****************************************************
;Input:  none
;Output: A,X,Y destroyed 
;General plan: Sum velocities of p0,p1. Divide by 2. Negative.  Use to move stars.

        ldx #$00                   ;assume positive value for third byte
        clc                        ;Add the vertical player speeds
        lda player_v_speed_LSB
        adc player_v_speed_LSB+1
        sta star_v_speed_LSB
        lda player_v_speed_MSB
        adc player_v_speed_MSB+1
        sta star_v_speed_MSB
        clc                 ;assume sign is positive
        bpl .v_not_neg      ;make sure the correct sign bit shifts in during division
          sec
          ldx #$FF          ;and correct sign in third byte
.v_not_neg
        ror star_v_speed_MSB       ;Divide by 2
        ror star_v_speed_LSB
        lda #%10000000
        bit game_state
        bne .full_v               ;if we're zoomed out
          txa
          rol                     ;copy sign bit of X to C
          ror star_v_speed_MSB    ;Divide by 2 again
          ror star_v_speed_LSB
.full_v        
        
; Turns out flipping the vertical direction isn't necessary.

        clc                        ;update star vertical position with speed
        lda star_v_pos_sub
        adc star_v_speed_LSB
        sta star_v_pos_sub
        lda star_v_pos
        adc star_v_speed_MSB
        sta star_v_pos
        txa                        ;third "sign" byte we determined earlier
        adc star_v_pos+1
        sta star_v_pos+1


        clc                        ;Add the horizontal player speeds
        ldx #$FF                   ;assume positive value for third byte, but save 
        lda player_h_speed_LSB     ;   an eor #$FF later and avoid changing the sign flag
        adc player_h_speed_LSB+1
        sta star_h_speed_LSB
        lda player_h_speed_MSB
        adc player_h_speed_MSB+1
        sta star_h_speed_MSB
        clc                 ;assume sign is positive
        bpl .h_not_neg      ;make sure the correct sign bit shifts in during division
          sec
          ldx #$00          ;and correct sign in third byte (save an eor #$FF later)
.h_not_neg
        ror star_h_speed_MSB       ;Divide by 2
        ror star_h_speed_LSB
        
        lda #%10000000
        bit game_state
        bne .full_h               ;if we're zoomed out
          lda star_h_speed_MSB
          rol                     ;copy sign bit of MSB to C
          ror star_h_speed_MSB    ;Divide by 2 again
          ror star_h_speed_LSB
.full_h
        
        clc
        lda star_h_speed_LSB       ;flip sign
        eor #$FF
        adc #$01
        sta star_h_speed_LSB
        lda star_h_speed_MSB
        eor #$FF
        adc #$00
        sta star_h_speed_MSB
        txa
        adc #$00                   ;include "sign" byte
        tax

        
        clc                        ;update star horizontal position with speed
        lda star_h_pos_sub
        adc star_h_speed_LSB
        sta star_h_pos_sub
        lda star_h_pos
        adc star_h_speed_MSB
        sta star_h_pos
        txa                        ;third "sign" byte we determined earlier
        adc star_h_pos+1
        sta star_h_pos+1
        
horizontal_wrap      lda star_h_pos+1
                     bpl .no_l_wrap         ;did we wrap left (go negative?)
                       clc                  ;add 640 ($0280) to wrap around
                       lda star_h_pos
                       adc #$80
                       sta star_h_pos
                       lda star_h_pos+1
                       adc #$02
                       sta star_h_pos+1                     
.no_l_wrap           lda star_h_pos+1
                     cmp #$02
                     bne .no_r_wrap         ;if msb < $02, we haven't wrapped yet
                       lda star_h_pos
                       cmp #$80             ;if msb IS 2, check if lsb >= $80
                       bcc .no_r_wrap       ;if so, subtract 640 ($0280) to wrap around
                         lda star_h_pos     ; note carry is already set
                         sbc #$80
                         sta star_h_pos
                         lda star_h_pos+1
                         sbc #$02
                         sta star_h_pos+1
.no_r_wrap           


vertical_wrap        lda star_v_pos+1
                     bpl .no_u_wrap          ;did we wrap up (go negative?)
                       clc                   ;add 720 ($02D0) to wrap around
                       lda star_v_pos
                       adc #$D0
                       sta star_v_pos
                       lda star_v_pos+1
                       adc #$02
                       sta star_v_pos+1                    
.no_u_wrap           lda star_v_pos+1
                     cmp #$02
                     bne .no_d_wrap         ;if msb < $02, we haven't wrapped yet
                       lda star_v_pos
                       cmp #$D0             ;if msb IS 2, check if lsb >= $D0
                       bcc .no_d_wrap       ;if so, subtract 720 ($02D0) to wrap around
                        lda star_v_pos      ; note carry is already set
                        sbc #$D0
                        sta star_v_pos
                        lda star_v_pos+1
                        sbc #$02
                        sta star_v_pos+1
.no_d_wrap

                              ;the math for the "big" offset here is quivalent to
        lda star_v_pos        ; star_v_pos div 16 mod 5 mult 64
        and #%11110000        ;drop bits < 16
        sta temp_byte
        lda star_v_pos+1
        sta temp_byte+1

.mod80  lda temp_byte+1       
        bne .sub80            ;subtract 80 until vertical value is < 80
          lda temp_byte
          cmp #80
          bcc .mod80done
.sub80      sec               ;carry might not be set if we jumped here
            lda temp_byte     ;load lsb in case we jumped here
            sbc #80
            sta temp_byte
            lda temp_byte+1
            sbc #0
            sta temp_byte+1
            jmp .mod80
.mod80done

        asl temp_byte
        rol temp_byte+1
        asl temp_byte
        rol temp_byte+1        ;multiply by 4 to get "big" offset

        lda star_v_pos
        and #%00001111        ;mod 16 of vertical position
        adc #01               ;plus one so values are 1-16 (not 0-15)
        sta star_v_screen     ;save vertical screen position
        asl
        asl                   ;multiply by 4 (shift left by two places)
        ;sta temp_byte+3       ;save (this will be our 4y, "small" offset)
        clc
        adc temp_byte         ;add offsets together
        sta temp_byte
        lda temp_byte+1
        adc #0
        sta temp_byte+1       ;"big" and "small" offsets summed in temp_byte, temp_byte+1
        clc
        lda star_h_pos
        adc temp_byte         ;add offsets to horizontal, save in temp variables
        sta temp_byte
        lda star_h_pos+1
        adc temp_byte+1
        sta temp_byte+1

.mod160 lda temp_byte+1       ;we need new horizontal value mod 160, so...
        bne .sub160           ;subtract 160 until horizontal value is < 160
          lda temp_byte
          cmp #160
          bcc .mod160done
.sub160     sec               ;carry might not be set if we jumped here
            lda temp_byte     ;load lsb in case we jumped here
            sbc #160
            sta temp_byte
            lda temp_byte+1
            sbc #0
            sta temp_byte+1
            jmp .mod160
.mod160done
        
        lda temp_byte
        sta star_h_screen    ;save horizontal screen position
        
        ldx #4                   ;position the ball
        jsr bzoneRepos 
        
        rts

;wrap_around        ****************************************************
;Input:  X = 0 for p0, 1 for p1
;Output: A destroyed, X unchanged, Y unchanged


wrap_around         lda player_v_pos_byte2,X  ;make sure vertical is < 720 ($02D0)
                    cmp #$02
                    bcc .vert_in_bounds      ;if msb < $02, it's ok
                    bne .vert_out_bounds     ;if msb > $02, it's not ok
                     lda player_v_pos_byte1,X ;if msb = $02, we check for LSB < $D0
                     cmp #$D0
                     bcc .vert_in_bounds      ;if lsb < $D0, it's ok
.vert_out_bounds      lda player_v_speed_MSB,X
                      bmi .out_bottom           ;pop around in dir of travel
                        lda #0
                        sta player_v_pos_byte1,X
                        sta player_v_pos_byte2,X
                        jmp .vert_in_bounds
.out_bottom           lda #$02
                      sta player_v_pos_byte2,X
                      lda #$C9
                      sta player_v_pos_byte1,X
                      
.vert_in_bounds     lda player_h_pos_byte2,X  ;make sure horizontal is < 640 ($0280)
                    cmp #$02
                    bcc .horiz_in_bounds      ;if msb < $02, it's ok
                    bne .horiz_out_bounds     ;if msb > $02, it's not ok
                     lda player_h_pos_byte1,X ;if msb = $02, we check for LSB < $80
                     cmp #$80
                     bcc .horiz_in_bounds      ;if lsb < $80, it's ok
.horiz_out_bounds     lda player_h_speed_MSB,X
                      bmi .out_left           ;pop around in dir of travel
                        lda #0
                        sta player_h_pos_byte1,X
                        sta player_h_pos_byte2,X
                        jmp .horiz_in_bounds
.out_left             lda #$02
                      sta player_h_pos_byte2,X
                      lda #$79
                      sta player_h_pos_byte1,X
.horiz_in_bounds    rts
                    
                    

;update_position    ****************************************************
;Input:  X = 0 for p0, 1 for p1
;Output: A destroyed, leaves X as p#, Y unchanged

update_position     lda #0
                    sta temp_byte              ;assume speeds are positive
                    sta temp_byte+1
                    
                    lda player_v_speed_MSB,X
                    bpl .pos_v_speed
                      lda #$FF              ;if negative, be sure we 
                      sta temp_byte         ; carry negative to 3rd byte  
.pos_v_speed        clc
                    lda player_v_pos_byte0,X
                    adc player_v_speed_LSB,X
                    sta player_v_pos_byte0,X   ;update vertical position
                    lda player_v_pos_byte1,X
                    adc player_v_speed_MSB,X
                    sta player_v_pos_byte1,X
                    lda player_v_pos_byte2,X
                    adc temp_byte              ;either $00 or $FF
                    sta player_v_pos_byte2,X
                    
                    lda player_h_speed_MSB,X
                    bpl .pos_h_speed
                      lda #$FF              ;if negative, be sure we 
                      sta temp_byte+1       ; carry negative to 3rd byte  
.pos_h_speed        clc
                    lda player_h_pos_byte0,X
                    adc player_h_speed_LSB,X
                    sta player_h_pos_byte0,X   ;update horizontal position
                    lda player_h_pos_byte1,X
                    adc player_h_speed_MSB,X
                    sta player_h_pos_byte1,X
                    lda player_h_pos_byte2,X
                    adc temp_byte+1            ;either $00 or $FF
                    sta player_h_pos_byte2,X
                    rts
                                        

;update_velocity    ****************************************************
;Input:  X = 0 for p0, 1 for p1
;Output: A destroyed, X unchanged, Y destroyed

update_velocity     clc
                    lda #0                        ;assume we're adding positive numbers
                    sta temp_byte
                    sta temp_byte+1
                    ldy player_v_delta,X          ;get vertical delta
                    bpl .pos_vdelta               ;if v delta is negative
                     lda #$FF                     ; be sure we pass the sign to the MSB later
                     sta temp_byte
.pos_vdelta         tya
                    adc player_v_speed_LSB,X      ;same as above, but negative
                    sta player_v_speed_LSB,X      ;save it
                    lda temp_byte
                    adc player_v_speed_MSB,X      ;negative sign to msb
                    sta player_v_speed_MSB,X
.apply_hdelta       clc
                    ldy player_h_delta,X          ;get vertical delta
                    bpl .pos_hdelta               ;if h delta is negative
                     lda #$FF                     ; be sure we pass the sign to the MSB later
                     sta temp_byte+1
.pos_hdelta         tya
                    adc player_h_speed_LSB,X      ;same as above, but negative
                    sta player_h_speed_LSB,X      ;save it
                    lda temp_byte+1
                    adc player_h_speed_MSB,X      ;negative sign to msb
                    sta player_h_speed_MSB,X
                    rts

         
;rocket_engine         ****************************************************
;Input:  X = 0 for p0, 1 for p1
;Output: A destroyed, X unchanged, Y destroyed
;NOTE: Because this procedure also zeroes out the player's movement delta,
;      it should be called FIRST in the list of things that apply forces
;      to a player in a frame

;NOTE: How much shorter would this get if I precalculated the negatives as well?

rocket_engine    stx temp_byte+2         ;stash p# for later
                 lda #0                  ;assume no forces acting on player this frame
                 sta player_v_delta,X
                 sta player_h_delta,X
                 lda #%00010000          ;assume we are checking p0
                 ldy #0
                 cpx #0                  ;but are we?
                 beq .not_p1             ;if we're doing p1
                  lda #%00000001          ;check the correct joystick bit
                  ldy #5                  ;use the right thrust_table_offset
.not_p1          bit SWCHA               ;check the joystick register
                 beq .engine_on
                  rts                    ;return from the subroutine
.engine_on       sty temp_byte+3         ;tb3 now has 0 if p0, 5 if p1 - used for thrust_table_offset
                 lda player_rot_pos_MSB,X  ;get MSB of player rotation position
                 tay                     ;and stash it for later
                 and #%00000100          ;get bit 2 of rotation
                 lsr
                 lsr                     ;shift it to bit 0 position
                 tax                     ;and put it in X
                 tya
                 and #%00000011          ;right two bits of player rotation
                 adc temp_byte+3         ;plus thrust_table_offset (will not set carry)
                 sta temp_byte,X         ;stores in temp_byte if pos bit 2 was clear, else temp_byte+1
                 txa
                 eor #%00000001          ;if x was 0, now it's 1; if x was 1, now it's 0
                 tax
                 tya
                 and #%00000011          ;right two bits of player rotation
                 eor #%11111111          ;but negative this time (flip all bits, we'll add 1 later)
                 adc temp_byte+3         ;plus thrust_table_offset
                 clc                     ;because adding the offset may cause a carry
                 adc #$05                ;plus 4 (plus 1 to finish 2's complement)
                 sta temp_byte,X         ;stores in temp_byte+1 if pos bit 2 was clear, else temp_byte
                                         ;at this point, temp_byte has the horizontal offset
                                         ;  and temp_byte+1 has the vertical offset
                                         ;  for the precalculated player_thrust_table
                 ldx temp_byte
                 lda player_thrust_table,X ;get horizontal thrust
                 sta temp_byte           ;put it in temp_byte
                 ldx temp_byte+1
                 lda player_thrust_table,X ;get vertical thrust
                 sta temp_byte+1         ;put it in temp_byte+1
                 tya
                 and #%00001000          ;get rotational position bit 3
                 lsr                     ;shift to bit 2 (for later) also clears carry
                 sta temp_byte+3         ;save for later
                 beq .dont_flip_horiz
                  lda temp_byte          ;if pos bit 3 was set, flip horizontal thrust sign
                  eor #%11111111         ;flip the bits
                  adc #$01               ;add 1 (carry already clear)
                  sta temp_byte          ;put it back
.dont_flip_horiz tya
                 and #%00000100          ;get bit 2 of rot pos
                 eor temp_byte+3         ;xor pos bit 2 with pos bit 3 (shifted right one to 2 spot)
                 beq .dont_flip_vert
                  lda temp_byte+1        ;if bit 2 xor bit 3, flip vertical thrust sign
                  eor #%11111111         ;flip the bits
                  clc
                  adc #$01               ;add 1
                  sta temp_byte+1        ;put it back
.dont_flip_vert  ldx temp_byte+2         ;get player offset (0 for p0, 1 for p1)
                 lda temp_byte
                 sta player_h_delta,X    ;save player's horizontal thrust
                 lda temp_byte+1
                 sta player_v_delta,X    ;save player's vertical thrust
                 rts



         
;rotational bitmap select ****************************************************
;Input:  X = 0 for p0, 1 for p1
;Output: A destroyed, X unchanged, Y as p# times 2

bmp_select       stx temp_byte             ;stash player number for later
                 txa                       ;put player number in A
                 asl                       ;double player number, if 1 now 2, if 0 still 0
                 tay         ;put it in Y to use as the offset for two-byte memory structures
                 lda #>ship_0
                 sta player_bmp_pointer+1,Y ;get the MSB (page) of the bitmap pointer
                 lda #$00
                 sta REFP0,X               ;default reflection bit OFF
                 sta temp_byte+2           ;also clear temp_byte+2 (big/small ship offset)
                 lda #12                   ;bmp height minus 1
                 sta player_bmp_height     ;assume we're using the big ships
                 lda #%10000000
                 bit game_state
                 bne .zoomed_in            ;if we're zoomed out
                   lda #16                 ; use the "small ship" bitmaps
                   sta temp_byte+2
                   lda #5
                   sta player_bmp_height   ;set to small ship height
                   jmp .no_flip
.zoomed_in       lda player_rot_pos_MSB,X  ;get MSB of rotational position
                 sta temp_byte+1           ;(because bit can't indirect address)
                 lda #%00001000            ;also = $08
                 bit temp_byte+1           ;check bit 3 of rot pos MSB
                 beq .no_flip              ;if position bit 3 set
                  sta REFP0,X              ; then turn on reflect bit (a = $08 already)
.no_flip         clc
                 lda player_rot_pos_MSB,X  ;get MSB of rotational position
                 and #%00001111            ;only keep the right nibble (0-15)
                 adc temp_byte+2           ;add big/small ship offset
                 tax                       ;and use as offset for our lookup table
                 lda .big_ship_table,X     ;get LSB of bitmap pointer
                 sta player_bmp_pointer,Y  ;save LSB of the bitmap pointer
                 ldx temp_byte             ;get player number back into X
                 rts
                 
.big_ship_table                            ;note: this procedure assumes that
                 .byte #<ship_0            ; all the ship bitmaps are on the
                 .byte #<ship_1            ; same page of memory
                 .byte #<ship_2
                 .byte #<ship_3
                 .byte #<ship_4
                 .byte #<ship_5
                 .byte #<ship_6
                 .byte #<ship_7
                 .byte #<ship_8
                 .byte #<ship_7
                 .byte #<ship_6
                 .byte #<ship_5
                 .byte #<ship_4
                 .byte #<ship_3
                 .byte #<ship_2
                 .byte #<ship_1
                 
.small_ship_table
                 .byte #<small_ship_0
                 .byte #<small_ship_1
                 .byte #<small_ship_2
                 .byte #<small_ship_3
                 .byte #<small_ship_4
                 .byte #<small_ship_5
                 .byte #<small_ship_6
                 .byte #<small_ship_7
                 .byte #<small_ship_8
                 .byte #<small_ship_9
                 .byte #<small_ship_10
                 .byte #<small_ship_11
                 .byte #<small_ship_12
                 .byte #<small_ship_13
                 .byte #<small_ship_14
                 .byte #<small_ship_15
                 

;populate_thrust_vectors   ****************************************************
;Input: X = 0 for p0, 1 for p1
;       A = maximum thrust
;Output: A destroyed, X unchanged, Y destroyed

populate_thrust_vectors
                 sta temp_byte      ;save a copy of the max thrust
                 tay                ;and put a copy in Y
                 txa
                 beq .p0_offset     ;if doing p0, leave table offset = 0
                  ldx #$05          ;if doing p1, set table offset = 5
.p0_offset       lda #$00
                 sta player_thrust_table,X ;first value is always zero sin(0)=0
                 inx
                 lda #$61           ;$0.61 is roughly sin(22.5)
                 sta temp_byte+2    ;save sine approximation
                 jsr .mult
                 lda #$B5            ;$0.B5 is roughly sin(45)
                 sta temp_byte+2     ;save sine approximation
                 jsr .mult
                 lda #$EC            ;$0.EC is roughly sin(67.5)
                 sta temp_byte+2     ;save sine approximation
                 jsr .mult
                 sty player_thrust_table,X ; pos4 is max thrust [sin(90) = 1]
                 txa
                 sec
                 sbc #$04            ;restore original p0/p1 value in A
                 beq .exit
                  lda #$01
.exit            rts

;call this with max thrust in Y and sin approximation in temp_byte+2
.mult            lda #$00           ;start with A = 0
.mult_loop       clc
                 adc temp_byte+2    ;add sin approximation
                 sta temp_byte+1    ;save LSB
                 lda player_thrust_table,X ;load MSB
                 adc #$00           ;carry the one (if there is one)
                 sta player_thrust_table,X ;save MSB
                 lda temp_byte+1    ;load LSB for next addition
                 dey                ;dec max thrust loop counter
                 bne .mult_loop     ;loop again
                 inx                ;increment X pointer for next table location
                 ldy temp_byte      ;reload max thrust counter for next multiplication
                 rts


;update_relative_screen_position *************************************************
;Input: none - works for both players
;Output: A,X,Y destroyed

update_relative_screen_positions
                 ldy #$00             ;assume p0 is on top
                 sec
                 lda player_v_pos_byte1   ;subtract p1 v_pos from p0 v_pos
                 sbc player_v_pos_byte1+1 ; to find vertical distance
                 sta temp_byte+2
                 lda player_v_pos_byte2
                 sbc player_v_pos_byte2+1
                 sta temp_byte+3
                 bpl .v_dist_not_negative  ;if it's negative
                   ldy #$01                ; p1 is to the right
                   clc                     ; and flip v_dist sign positive
                   LDA temp_byte+2           
                   EOR #$FF
                   adc #$01
                   sta temp_byte+2
                   lda temp_byte+3
                   EOR #$FF
                   adc #$00                ;carry the one
                   sta temp_byte+3         ;now v_dist should be positive
.v_dist_not_negative    ;at this point, we have v_dist MSB in acc -- is v_dist > 360?
                 lda temp_byte+3           ;360 = $0168
                 cmp #$01              ;is MSB > $01?
                 bcc .v_in_view_range  ;if MSB < $01, we know it's ok
                 bne .sub_from_720     ;if MSB > $01, we know it's too big
                   lda temp_byte+2       ;if MSB = $01, we need to check the LSB
                   cmp #$68              
                   bcc .v_in_view_range    ;if LSB < $68 it's ok
.sub_from_720        lda #$D0              ;otherwise, subtract from 720 ($02D0)
                     sbc temp_byte+2         ; we know carry is set from cmp
                     sta temp_byte+2
                     lda #$02
                     sbc temp_byte+3
                     sta temp_byte+3
                     tya
                     eor #$01            ;swap right-side player
                     tay
.v_in_view_range   

                 ldx #$00             ;assume p0 is to the right
                 sec
                 lda player_h_pos_byte1   ;subtract p1 h_pos from p0 h_pos
                 sbc player_h_pos_byte1+1 ; to find horizontal distance
                 sta temp_byte
                 lda player_h_pos_byte2
                 sbc player_h_pos_byte2+1
                 sta temp_byte+1
                 bpl .h_dist_not_negative         ;if it's negative
                   ldx #$01                ; p1 is to the right
                   clc                     ; and flip h_dist sign positive
                   LDA temp_byte           
                   EOR #$FF
                   adc #$01
                   sta temp_byte
                   lda temp_byte+1
                   EOR #$FF
                   adc #$00                ;carry the one
                   sta temp_byte+1         ;now h_dist should be positive
.h_dist_not_negative    ;at this point, we have h_dist MSB in acc -- is h_dist > 320?
                 lda temp_byte+1           ;320 = $0140
                 cmp #$01              ;is MSB > $01?
                 bcc .h_in_view_range  ;if MSB < $01, we know it's ok
                 bne .sub_from_640     ;if MSB > $01, we know it's too big
                   lda temp_byte       ;if MSB = $01, we need to check the LSB
                   cmp #$40              
                   bcc .h_in_view_range    ;if LSB < $40 it's ok
.sub_from_640        lda #$80              ;otherwise, subtract from 640 ($0280)
                     sbc temp_byte         ; we know carry is set from cmp
                     sta temp_byte
                     lda #$02
                     sbc temp_byte+1
                     sta temp_byte+1
                     txa
                     eor #$01            ;swap right-side player
                     tax
.h_in_view_range
            ;Zoom Logic:  if v_dist >= 180 ($00B4) OR  h_dist >= 160 ($00A0) Zoom OUT!
            ;             if v_dist < 175 ($00AF) AND h_dist < 155 ($009B) Zoom IN!
            ;             else, use current zoom

.decide_zoom     lda temp_byte+1       
                 bne .zoom_out         ; if h_dist MSB > 0, zoom out
                 lda temp_byte+3       ;
                 bne .zoom_out         ; if v_dist MSB > 0, zoom out
                 lda temp_byte
                 cmp #$A0
                 bcs .zoom_out         ; if h_dist LSB >= 160 ($A0), zoom out
                 lda temp_byte+2
                 cmp #$B4
                 bcs .zoom_out         ; if v_dist LSB >= 180 ($B4), zoom out
                 lda temp_byte
                 cmp #$9B
                 bcs .zoom_unchanged   ; if h_dist LSB >= 155 ($9B), use current zoom
                 lda temp_byte+2
                 cmp #$AF
                 bcs .zoom_unchanged   ; if v_dist LSB >= 175 ($AF), use current zoom
                                       ; else, zoom in!
.zoom_in         lda game_state        ;game_state bit 7 - (0=zoomed in, 1=zoomed out)
                 ora #%10000000        ;set bit 7 - others unchanged
                 sta game_state
                 jmp .apply_zoom
.zoom_out        lda game_state
                 and #%01111111        ;clear bit 7 - others unchanged
                 sta game_state
.zoom_unchanged


.apply_zoom      ;lda #$50         ;other color **DEBUG
                 ;sta COLUBK       ;set background color **DEBUG
                 lda #%10000000
                 bit game_state        ;check zoom state
                 bne .do_vertical      ;if zoomed in, just continue
                   ;lda #$80         ;dark blue **DEBUG
                   ;sta COLUBK       ;set background color  **DEBUG
                   clc
                   ror temp_byte+3     ;if "zoomed out" divide by 2 for scale
                   ror temp_byte+2     ;  rotate vertical MSB.0 bit to LSB.7  
                   clc
                   ror temp_byte+1     ;if "zoomed out" divide by 2 for scale
                   ror temp_byte       ;  rotate horizontal MSB.0 bit to LSB.7

.do_vertical     clc
                 ror temp_byte+3
                 ror temp_byte+2       ;cut it in half to get distance from center
                 clc
                 lda #90
                 adc temp_byte+2       ;add to 90
                 sta player_v_screen,Y ;save as right-side player v pos
                 tya
                 eor #$01              ;switch players
                 tay
                 sec
                 lda #90
                 sbc temp_byte+2         ;subtract from 90
                 sta player_v_screen,Y ;save as left-side player v pos
                 
.do_horizontal   clc
                 ror temp_byte+1
                 ror temp_byte         ;cut it in half to get distance from center
                 clc
                 lda #80
                 adc temp_byte         ;add to 80
                 sta player_h_screen,X ;save as right-side player h pos
                 txa
                 eor #$01              ;switch players
                 tax
                 sec
                 lda #80
                 sbc temp_byte         ;subtract from 80
                 sta player_h_screen,X ;save as left-side player h pos
                 rts 
                 
                 
;interpret_controller  *****************************************************
;Input: X = 0 for p0, 1 for p1
;output: A destroyed, X unchanged, Y destroyed

interpret_controller  
                   lda SWCHA                  ;read joystick values
                   sta temp_byte              ;save 'em
                   ldy #0                     ;clear Y
                   txa
                   beq .doing_p0              ;if we're doing p1
                    ldy #5                    ; use 5 as thrust table offset
                    asl temp_byte             ; and rotate out the p0 bits
                    asl temp_byte
                    asl temp_byte
                    asl temp_byte
.doing_p0          lda temp_byte
                   bmi .not_right
                    sta temp_byte             ;save acc
                    lda player_thrust_table+4,Y ;how fast do we turn right?
                    asl                       ;double it, clear carry
                    adc player_rot_pos_LSB,X  ;update rotational position
                    sta player_rot_pos_LSB,X
                    lda #$00
                    adc player_rot_pos_MSB,X  ;update msb
                    sta player_rot_pos_MSB,X
                    lda temp_byte             ;restore acc
.not_right         rol
                   bmi .not_left
                    sta temp_byte             ;save acc
                    lda player_thrust_table+4,Y ;how fast do we turn left?
                    asl                       ;double it, clear carry
                    eor #$FF                  ;negative it!
                    adc #$01
                    adc player_rot_pos_LSB,X  ;update rotational position
                    sta player_rot_pos_LSB,X
                    lda #$FF
                    adc player_rot_pos_MSB,X  ;update msb
                    sta player_rot_pos_MSB,X
                    lda temp_byte             ;restore acc
.not_left          rol  
                   bmi .not_down
.not_down          rol  
                   bmi .not_up
.not_up            rts



;I copied this echo so I could see how much "real code" was in this, since the
;  next ORG position was tricking it into thinking more was used.

 ECHO [*-$F000+6]d,"out of 4096 ROM bytes used",[$FFFA-*]d,"bytes left"        

;-----------------------------

                  ORG $FF00
            
ship_0
                  .byte #%00110110
                  .byte #%00110110
                  .byte #%00110110
                  .byte #%00111110
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00001000
                  .byte #%00001000
                  .byte #%00001000
                  .byte #%00001000
ship_1
                  .byte #%00000000
                  .byte #%00001000
                  .byte #%00011000
                  .byte #%01011000
                  .byte #%11001000
                  .byte #%11111000
                  .byte #%01111000
                  .byte #%00111000
                  .byte #%00011000
                  .byte #%00011000
                  .byte #%00001000
                  .byte #%00001100
                  .byte #%00000100
ship_2
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%00001000
                  .byte #%00011000
                  .byte #%00011000
                  .byte #%00001000
                  .byte #%01011100
                  .byte #%11111100
                  .byte #%11111100
                  .byte #%00001110
                  .byte #%00000110
                  .byte #%00000001
                  .byte #%00000000
ship_3
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%01000000
                  .byte #%01100000
                  .byte #%01110000
                  .byte #%00111000
                  .byte #%00011100
                  .byte #%11111110
                  .byte #%11111111
                  .byte #%11000000
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%00000000
ship_4
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%11100000
                  .byte #%11100000
                  .byte #%11111000
                  .byte #%00111111
                  .byte #%00111111
                  .byte #%11111000
                  .byte #%11100000
                  .byte #%11100000
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%00000000
ship_5
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%11000000
                  .byte #%11111111
                  .byte #%11111110
                  .byte #%00011100
                  .byte #%00111000
                  .byte #%01110000
                  .byte #%01100000
                  .byte #%01000000
                  .byte #%00000000
                  .byte #%00000000
ship_6
                  .byte #%00000000
                  .byte #%00000001
                  .byte #%00000110
                  .byte #%00001110
                  .byte #%11111100
                  .byte #%11111100
                  .byte #%01011100
                  .byte #%00001000
                  .byte #%00011000
                  .byte #%00011000
                  .byte #%00001000
                  .byte #%00000000
                  .byte #%00000000
ship_7
                  .byte #%00000100
                  .byte #%00001100
                  .byte #%00001000
                  .byte #%00011000
                  .byte #%00011000
                  .byte #%00111000
                  .byte #%01111000
                  .byte #%11111000
                  .byte #%11001000
                  .byte #%01011000
                  .byte #%00011000
                  .byte #%00001000
                  .byte #%00000000
ship_8
                  .byte #%00001000
                  .byte #%00001000
                  .byte #%00001000
                  .byte #%00001000
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00011100
                  .byte #%00111110
                  .byte #%00110110
                  .byte #%00110110
                  .byte #%00110110

small_ship_0
                  .byte #%10100000
                  .byte #%10100000
                  .byte #%11100000
                  .byte #%01000000
                  .byte #%01000000
                  .byte #%01000000
small_ship_1
                  .byte #%00000000
                  .byte #%01000000
                  .byte #%11000000
                  .byte #%01000000
                  .byte #%00100000
                  .byte #%00100000
small_ship_2
                  .byte #%00000000
                  .byte #%01000000
                  .byte #%11000000
                  .byte #%00100000
                  .byte #%00010000
                  .byte #%00000000
small_ship_3
                  .byte #%00000000
                  .byte #%10000000
                  .byte #%01000000
                  .byte #%11110000
                  .byte #%00000000
                  .byte #%00000000
small_ship_4
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%11000000
                  .byte #%01110000
                  .byte #%11000000
                  .byte #%00000000
small_ship_5
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%11110000
                  .byte #%01000000
                  .byte #%10000000
                  .byte #%00000000
small_ship_6
                  .byte #%00000000
                  .byte #%00010000
                  .byte #%00100000
                  .byte #%11000000
                  .byte #%01000000
                  .byte #%00000000
small_ship_7
                  .byte #%00100000
                  .byte #%00100000
                  .byte #%01000000
                  .byte #%11000000
                  .byte #%01000000
                  .byte #%00000000
small_ship_8
                  .byte #%01000000
                  .byte #%01000000
                  .byte #%01000000
                  .byte #%11100000
                  .byte #%10100000
                  .byte #%10100000
                  
small_ship_9
                  .byte #%01000000
                  .byte #%01000000
                  .byte #%00100000
                  .byte #%00110000
                  .byte #%00100000
                  .byte #%00000000

small_ship_10
                  .byte #%00000000
                  .byte #%10000000
                  .byte #%01000000
                  .byte #%00110000
                  .byte #%00100000
                  .byte #%00000000

small_ship_11
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%11110000
                  .byte #%00100000
                  .byte #%00010000
                  .byte #%00000000
                  
small_ship_12
                  .byte #%00000000
                  .byte #%00000000
                  .byte #%00110000
                  .byte #%11100000
                  .byte #%00110000
                  .byte #%00000000

small_ship_13
                  .byte #%00000000
                  .byte #%00010000
                  .byte #%00100000
                  .byte #%11110000
                  .byte #%00000000
                  .byte #%00000000

small_ship_14
                  .byte #%00000000
                  .byte #%00100000
                  .byte #%00110000
                  .byte #%01000000
                  .byte #%10000000
                  .byte #%00000000

small_ship_15
                  .byte #%00000000
                  .byte #%00100000
                  .byte #%00110000
                  .byte #%00100000
                  .byte #%01000000
                  .byte #%01000000


;///////////////////////////////////////////////////////////////////////////////
 ECHO [*-$F000+6]d,"out of 4096 ROM bytes used",[$FFFA-*]d,"bytes left"

                   ORG $FFFA
InterruptVectors
                   .word Reset         ; NMI
                   .word Reset         ; RESET
                   .word Reset         ; IRQ

                   END

[demime 1.01d removed an attachment with a content-type header it could not parse.]
[Content-Type: data; name="test21.bin"]

Current Thread