efp.txt100600 121566 1046 10221 10017515734 11040 0ustar hcsnobodyEscape From Pong rev 4 A 1K NES entry into the MiniGame 2003 Compo (http://www.ffd2.com/minigame/) by Halley's Comet Software http://here.is/halleyscomet http://hcs.freeshell.org/efp.html Assembled with DASM by Matthew Dillon. Written in edit.com 1,021 bytes of code and data. Object: Your goal, as a Ping Pong ball, is to avoid the paddles and other obstacles to escape from the screen in 13 variously difficult levels. Gameplay: Levels consist of one paddle which always tries to stay in front of the ball. There are also white walls which the ball will bounce off of and red walls which will restart the level if you contact them. If you get in the way of a paddle the level will also restart, this is to prevent you from having the paddle push you through a wall. In order to advance to the next level you must get the ball to leave the screen. The early levels do not have gravity, but later levels do. The difficulty level generally gets higher as the game progesses. When you have completed all 13 levels the game will restart from level 1, but the paddles will move faster. There is no way to actually "win" the game, but then again there is no way to "lose". I have personally played every level the first time through (with both control configurations), but I don't know if it is even physically possible to beat it again. Controls: The directional pad controls thrust. Remember that the ball will accelerate in the opposite direction of the button you press. Note: The included file efpbw.nes has the controls reversed for those who think it is easier to play that way. 4 bytes are different. Recommended Emulators: loopyNES (runs well on older computers, the best alternative to Nesticle), FCEU, nnnesterj NonRecommended Emulators: Nesticle (scroll issues), Nester (colors are wrong) Bugs: In rare situations it is possible for the ball to get stuck inside the paddle. Due to an optimization of the controller code the start, select, a, and b buttons also activate the thrust. This actually makes control quite a bit easier (you can use both hands), but it is an unintended feature. The directional buttons correspond to the other buttons as follows: B = Up A = Down Select = Left Start = Right I have not tested the program on an actual NES, so it very well may not work with the real hardware, but it works on every decent emulator I've tried it with. History: first release: er, it was the... first release? revision 1: Nintendulator helped me find a bug, I had not set the interrupt flag. Only unusually accurate emulators (and the NES itself, I suppose) would have a problem with it. revision 2: Fixed a glitch of the screen when loading a level by not enabling the screen in the middle of a frame, only required a slight reordering of commands. (this was the version entered in the MiniGame Compo) revision 3: Released under a BSD license, some clarification to source, included reversed version revision 4: Fixed bug with speed limitation in reversed version, added support for reversed gravity, added level 13, optimized palette loading so that file size did not change from rev 3 Based on concepts from: * Pong * Lunar Lander * Some QBasic game (I remember finding it on AOL, it involved a bouncing ball) * Several other games I've written (Rise of the Triangle, Cheese Reactor, Mushrong) Why the file is so big: The 1,021 bytes of the game are distributed as follows: 1,017 bytes at the beginning, which make up the program and header, and 4 bytes at the end (the reset and NMI vectors). The last two bytes, for the BRK/IRQ vector, are not used. No iNES format ROM can be less than 16,400 bytes in size, all of the other bytes are filler. Level data: The levels are read from "scripts" as specified by comments in the source. Level data begins at the label "level". Levels of up to 256 bytes and games of unlimited size (within the restraints of 16KB of PRGROM) can be created and should be fully supported by the physics engine. License: See the source or the included file LICENSE for details. LICENSE100600 121566 1046 2622 10006433646 10517 0ustar hcsnobodyCopyright (c) 2004 Halley's Comet Software All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. efp.asm100600 121566 1046 47043 10017515302 11004 0ustar hcsnobody; Escape from Pong rev 4 ; by Halley's Comet Software ; An Entry into the 2003 MiniGame Compo (http://www.ffd2.com/minigame/) ; rev 1: set interrupt flag, now works on Nintendulator ; rev 2: don't activate bg/spr until in vblank, fixes flicker after death/ ; between levels ; rev 3: released under a BSD license, some clarifications to comments ; rev 4: better speed limiting, added level 13, optimized palette loading, ; gravity can now be signed ; http://here.is/halleyscomet ; http://hcs.freeshell.org/efp.html ; Copyright (c) 2004 Halley's Comet Software ; All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; 3. The name of the author may not be used to endorse or promote products ; derived from this software without specific prior written permission. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. processor 6502 VRAMCN0 equ $2000 VRAMCN1 equ $2001 VRAMSTAT equ $2002 SPRADR equ $2003 SPRIO equ $2004 VRAMADR equ $2006 VRAMIO equ $2007 BGPAL equ $3F00 SPPAL equ $3F10 PT equ $0000 NT equ $2000 AT equ $23C0 SPRDMA equ $4014 JOY1 equ $4016 ARENA equ $0200 ; describes the structure of the arena ;THRUST equ $000a ; standard control THRUST equ -$000a ; "intuitive" control (accelerate in direction pressed) MAXX_ equ $7c MAXY_ equ $74 PADLIMX_ equ $0c PADLIMY_ equ $21 ; *********** DATA SEGMENT SEG.U data org $0000 ; Rules for using temp vars: ; 1) only use within a subroutine ; 2) don't expect any subroutine call to leave them unmodified TEMP BYTE TEMP2 BYTE TEMP3 BYTE LLCOORDX BYTE LLCOORDY BYTE LLCOORDSPEC BYTE DBX BYTE ; drawblock DBY BYTE IBALLX WORD ; two bytes for finer control IBALLY WORD IBALLVX WORD IBALLVY WORD IGRAV BYTE ; gravity y... IPADDLEX BYTE IPADDLEY BYTE BALLCOARSEX BYTE ; actual sprite pos BALLCOARSEY BYTE BALLX WORD BALLY WORD BALLVX WORD BALLVY WORD GRAV BYTE PADDLEX BYTE PADDLEY BYTE PADDLES BYTE ; speed INPADDLE BYTE BALLPX BYTE ; previous position BALLPY BYTE CON1 BYTE DEADFLAG BYTE LEVFLAG BYTE LEVSIZE BYTE ILLPROPS BYTE POSTHRUST WORD NEGTHRUST WORD MAXX WORD MAXY WORD LLCOUNT WORD LLPROPS BYTE PADLIMX BYTE PADLIMY BYTE LASTV ; ********* iNES header (after Joe Nahmias) SEG header org $8000-16 ; iNES magic BYTE $4e,$45,$53,$1a ; "NES",$1a ; Number of PRG-ROM blocks BYTE $01 ; Number of CHR-ROM blocks BYTE $00 ; ROM control bytes: Horizontal mirroring, no SRAM or trainer, Mapper #0 BYTE $00, $00 ; Padding BYTE $00, $00, $00, $00, $00, $00, $00, $00 ; ************ TEXT SEGMENT ; why is the code segment always called text? SEG text org $8000 start ; initialize cld sei ldx #$ff ; init stack txs ; fill palette ldx #[BGPAL >> 8] ldy #[BGPAL & $FF] jsr setvramadr ldy #$07 ; fill all palettes palloop2 ldx #$04 palloop lda allpalette-1,x sta VRAMIO dex bne palloop dey bne palloop2 sty PADDLES ; zero, from above loop restart_from_level_1 inc PADDLES ; load initialized data into the uninitialized segment ldx #$0c initloadloop lda initdata,x sta POSTHRUST,x dex bpl initloadloop level_start lda #$00 sta VRAMCN0 sta VRAMCN1 ; **************** START LOADLEVEL loadlevel subroutine lda #$00 tax sta DEADFLAG ; Lazarus mode sta LEVFLAG sta SPRADR .loop2 sta SPRIO ; clear sprites dex bne .loop2 lda #$40 ; end of game and LLPROPS bne restart_from_level_1 lda #$20 and LLPROPS bne .leavearena lda #$00 ; clear arena ldx #$00 .loop sta ARENA,x dex bne .loop ; clear VRAM pt,nt,at lda #$00 sta VRAMADR sta VRAMADR ldy #$30 ; clear $3000 bytes .ntloop2 ldx #$00 .ntloop sta VRAMIO inx bne .ntloop dey bne .ntloop2 .leavearena ldy #$00 ; no header lda #$10 and LLPROPS bne .skipheader ldy #$01 ldx #$02 .coordloop lda (LLCOUNT),y lsr sta IBALLX+1,x lda #$00 ror sta IBALLX,x dey dex dex beq .coordloop ; these pairs can be copied directly into the registers, same order ldy #$08 ldx #$07 .pairloop lda (LLCOUNT),y dey dex sta IBALLVX,x bne .pairloop ldy #$09 .skipheader ll_arenaloop lda (LLCOUNT),y sta ILLPROPS and #$0f asl ; WORD! tax lda ll_tbl,x sta TEMP lda ll_tbl+1,x sta TEMP+1 iny ; this restricts a level to 256 bytes jmp (TEMP) ll_hline lda #$00 ; X sta LLCOORDSPEC beq ll_line ; saving a byte here and there ll_vline lda #$01 ; Y sta LLCOORDSPEC bne ll_line ; also always true ll_end sty LEVSIZE ; initialize ball and paddle position ldx #$0a .initloop lda IBALLX,x sta BALLX,x dex bpl .initloop ; **************** END LOADLEVEL jsr initpat ; wait a few vblanks ldx #$40 vblankwait lda VRAMSTAT bmi vblankwait vblankwait2 lda VRAMSTAT bpl vblankwait2 lda #$1e ; sprites, bg visible, no clipping (only after 1st vblank!) sta VRAMCN1 dex bne vblankwait lda #$80 ; vblank interrupt sta VRAMCN0 ; *********** START WAIT LOOP *********** deadend lda DEADFLAG bne lev_s lda LEVFLAG beq deadend lda ILLPROPS sta LLPROPS lda LLCOUNT clc adc LEVSIZE sta LLCOUNT lda LLCOUNT+1 adc #$00 sta LLCOUNT+1 lev_s jmp level_start ; *********** END WAIT LOOP *********** ll_tbl WORD ll_end,ll_hline,ll_vline ll_line lda (LLCOUNT),y iny tax jsr denibbulize sta LLCOORDX txa and #$0F sta LLCOORDY lda (LLCOUNT),y iny tax tya pha ; y txa jsr denibbulize clc adc #$01 ; in level is len-1 pha ; len txa and #$0F pha ; type ll_lineloop ldx LLCOORDX ldy LLCOORDY ; write a 2x2 tile in nt and arena ; a = data to write ; x = x coord (screen x / 2) ; y = y coord (screen y / 2) drawblock subroutine pha stx DBX sty DBY sty TEMP ldy #$00 sty TEMP2 ldy #$04 .multloop asl TEMP dey bne .multloop lda TEMP sta TEMP3 asl TEMP rol TEMP2 txa ora TEMP3 tay pla pha sta ARENA,y txa ora TEMP asl php tay lda TEMP2 plp rol ora #$20 tax jsr setvramadr pla pha sta VRAMIO ; write NT byte #0 sta VRAMIO ; write NT byte #1 tya clc adc #$20 tay txa adc #$00 ; in case of carry... tax jsr setvramadr pla sta VRAMIO ; write NT byte #2 sta VRAMIO ; write NT byte #3 ; END OF DRAWBLOCK ldx LLCOORDSPEC inc LLCOORDX,x pla ; type tay pla ; len tax dex txa pha ; len tya pha ; type cpx #$00 bne ll_lineloop pla ; type pla ; len pla ; y tay jmp ll_arenaloop initpat subroutine ; fill pattern table (with solid blocks of three colors) ; (saved 13 bytes with subs) lda #$00 sta VRAMADR sta VRAMADR tax jsr patblk lda #$ff jsr patblk lda #$00 ldx #$ff jsr patblk jsr patblk ; rely on txa in patblk ; write ball graphic to pat tbl ldx #$08 chrloop lda ballchr-1,x sta VRAMIO dex bne chrloop ;ldx #$00 ; x already 0 (from above loop) jsr patblkhalf ; fill in high bytes with zeroes rts ; ************************* MAIN LOOP START ********************* mainloop ldx #$00 jsr dimensional_manipulation ldx #$02 jsr dimensional_manipulation lda BALLX asl lda BALLX+1 rol sta BALLCOARSEX lda BALLY asl lda BALLY+1 rol sta BALLCOARSEY ; get controller and accelerate appropriately ; By combining the controller read and acclelerate loops I was able to ; save 20 bytes. The side effect is that the start, a, b, and select buttons ; can be used to accelerate, too. ; When this was before dimensional_manipulation it was possible to ; accelerate through walls ; **************** START CONTROL control subroutine ldy #$00 ldx #$02 lda #$01 sta JOY1 stx JOY1 ; strobe .bizzareloop pha lda JOY1 and #$01 beq .notthisway lda BALLVX,x clc adc POSTHRUST,y pha lda BALLVX+1,x adc POSTHRUST+1,y ; speed regulation ; y: 0=pos, 2=neg ;cpy #$02 ;beq .noposclip cmp #$04 bpl .noupdate ;.noposclip ;cpy #$00 ;beq .nonegclip cmp #$fc bmi .noupdate ;.nonegclip sta BALLVX+1,x pla sta BALLVX,x pha .noupdate pla .notthisway tya eor #$02 tay bne .notchgx txa eor #$02 tax .notchgx pla asl bne .bizzareloop ; **************** END CONTROL ; Gravity ;ldy #$00 tay ; zero from above loop lda GRAV bpl notneg dey notneg clc adc BALLVY sta BALLVY tya adc BALLVY+1 sta BALLVY+1 ; **************** START ARENAL_PROCESSING ; process collision with arena elements (not adjustible) arenal_processing subroutine lda #$00 sta TEMP2 ; x collision? sta TEMP3 ; y collision? lda BALLY+1 ; %01111111->%11110000 clc adc #$02 asl and #$f0 sta TEMP pha ; y coord lda BALLX+1 ; %01111111->%00001111 clc adc #$02 lsr lsr lsr pha ; x coord ora TEMP tax lda ARENA,x ; wall type test cmp #$00 ; air beq .noprob cmp #$03 ; killer wall bne .notkill sta DEADFLAG .notkill pla pha cmp BALLPX beq .noxcollide ; The ball has made a transition from one tile to another along the x ; axis. *If* there is nothing in the arena in the space (BALLPX,Y) then ; there is an edge here and the ball is free to reflect on the x axis. ; Current x and y within x reg (from tax; lda ARENA,x;) txa and #$f0 sta TEMP lda BALLPX ora TEMP tay lda ARENA,y bne .noxcollide lda #$01 sta TEMP2 ; yes, there has been an x collision .noxcollide pla tay pla pha cmp BALLPY beq .noycollide ; ditto, if nothing in (X,BALLPY) txa and #$0f sta TEMP lda BALLPY ora TEMP tax lda ARENA,x bne .noycollide lda #$02 sta TEMP3 ; yes, there has been a y collision .noycollide tya pha lda TEMP2 pha ora TEMP3 bne .noconcave ; if neither, do both (concave corner) pla lda #$02 pha sta TEMP3 .noconcave pla jsr bouncer .noprob pla sta BALLPX pla sta BALLPY ; **************** END ARENAL_PROCESSING ; **************** START DRAWBALL drawball subroutine lda #$00 ; ball is sprite 0 sta SPRADR lda BALLCOARSEY sta SPRIO ; y coord lda #$04 sta SPRIO ; tile # lda #$20 sta SPRIO ; attributes lda BALLCOARSEX sta SPRIO ; x coord ; **************** END DRAWBALL ; lda PADDLEY ; never used, but good to have on hand ; cmp #$ff ; bne dopaddle ; jmp nopaddle dopaddle ; **************** START DRAWPADDLE ; not only draw paddle but also do processing drawpaddle subroutine ldx PADDLEY lda BALLCOARSEY sec sbc PADDLEY bcc .less cmp #$07 bcc .less cmp #$10 bcc .noproblem txa clc adc PADDLES jmp .lessend .less txa sec sbc PADDLES .lessend sta PADDLEY .noproblem ldy #$04 lda PADDLEY .loop sta SPRIO ; y clc adc #$08 ldx #$01 stx SPRIO ; tile # ldx #$00 stx SPRIO ; atr ldx PADDLEX stx SPRIO ; x dey bne .loop ; **************** END DRAWPADDLE ; **************** START PADELIC_PROCESSING ; process collision with paddle ; x = offset of paddle to consider padelic_processing subroutine ldx #$01 ldy #$00 .loop lda BALLCOARSEX,x clc adc #$05 sec sbc PADDLEX,x sta TEMP,x bcc .notin ; above cmp PADLIMX,x bcs .notin ; below dex bpl .loop lda INPADDLE sta DEADFLAG lda #$01 jsr bouncer ; x collision ldy #$01 .notin sty INPADDLE ; **************** END PADELIC_PROCESSING nopaddle lda #$00 sta VRAMADR sta VRAMADR rti ; ************************* MAIN LOOP END ********************* ; Draw a block in pat tbl ; a = low byte ; x = high byte patblk subroutine clc ; carry flag used to alternate between low and high byte .loop2 ldy #$08 .loop sta VRAMIO dey bne .loop bcs .end patblkhalf txa sec bcs .loop2 ; always true .end rts ; Many of these manipulations can be applied anywhere in memory... ; It would be easy (and space-efficient) to add another ball. ; Two players? ; applys velocity ; x = which dimension (0=x,2=y) dimensional_manipulation subroutine lda BALLVX,x clc adc BALLX,x sta BALLX,x lda BALLVX+1,x adc BALLX+1,x sta BALLX+1,x bvs .offscr bmi .offscr cmp MAXX,x bmi .end .offscr lda #$01 ; set level flag sta LEVFLAG .end rts ; x = dimension to reflect across (0=x, 2=y) dm_reflect sec lda #$0 sbc BALLVX,x sta BALLVX,x lda #$0 sbc BALLVX+1,x sta BALLVX+1,x rts bouncer subroutine beq .nox ldx #$00 jsr dm_reflect ldx #$00 jsr dimensional_manipulation .nox ldx TEMP3 beq .noy jsr dm_reflect ;TEMP3 set to $02 when active ldx #$02 jsr dimensional_manipulation .noy rts ; x = adr hi ; y = adr lo setvramadr subroutine stx VRAMADR sty VRAMADR rts denibbulize subroutine and #$f0 lsr lsr lsr lsr rts ballchr BYTE %00000000 BYTE %00011000 BYTE %00111100 BYTE %01111110 BYTE %01111110 BYTE %00111100 BYTE %00011000 BYTE %00000000 ; level format: ; 0x00: Initial X coordinate (actual screen coord) ; 0x01: Initial Y coordinate (actual screen coord) ; 0x02-0x03: Initial X velocity ; 0x04-0x05: Initial Y velocity ; 0x06: gravity (signed) ; 0x07: Paddle initial x ; 0x08: Paddle initial y ; 0x09-....: arena specification ; arena commands: ; 0x?0: end of level data (?=properties of next level) ; bit 0: 0 = use new header; 1 = use previous header (this has none) ; bit 1: 0 = clear arena; 1 = use old arena ; bit 2: 1 = end of game! ; 0x01: draw horizontal line ; parameters: Initial x coordinate (NIBBLE) (2x2 tile fmt) ; Initial y coordinate (NIBBLE) (2x2 tile fmt) ; Length-1 (NIBBLE) (2x2 tile fmt) ; Type (NIBBLE) (color/type to draw in) ; 0x02: draw vertical line ; parameters: Initial x coordinate (NIBBLE) (2x2 tile fmt) ; Initial y coordinate (NIBBLE) (2x2 tile fmt) ; Length-1 (NIBBLE) (2x2 tile fmt) ; Type (NIBBLE) (tile # to use in drawing) level ; level 1 (easy) BYTE $80,$60 WORD -$0100,$0080 BYTE $00 BYTE $10,$50 BYTE $01,%00000000,%11110001 BYTE $01,%00001110,%11110001 BYTE $02,%11110000,%11100001 BYTE $30 ; level 2 (small hole, trickier) BYTE $02,%00000010,%11000001 BYTE $30 ; level 3 (small hole in wall of death) BYTE $02,%00000010,%10110011 BYTE $30 ; level 4 (larger hole in wall of death, but in middle (no banking)) BYTE $02,%00000001,%00000011 BYTE $02,%00000111,%00010000 BYTE $30 ; level 5 (small hole in wall of death (pretty hard!)) BYTE $02,%00001000,%00000011 BYTE $20 ; new header ; level 6 (new experience: gravity) BYTE $12,$60 WORD $0100,$0000 BYTE $08 BYTE $e8,$00 BYTE $02,%00000000,%11100001 BYTE $02,%11110001,%00000000 BYTE $30 ; level 7 (gravity w/ killer floor (pretty hard!)) BYTE $01,%00011110,%11010011 BYTE $30 ; level 8 (killer floor higher up) BYTE $01,%00011000,%11010011 BYTE $30 ; level 9 (exit in line w/ killer floor) BYTE $01,%11101000,%00010000 BYTE $01,%11110001,%00000001 BYTE $30 ; level 10 (tighter, but with killer floor mostly covered...) BYTE $01,%00010010,%11010011 BYTE $01,%00010111,%10110001 BYTE $30 ; level 11 (w/ a small killer patch) BYTE $01,%00110111,%00010011 BYTE $30 ; level 12 (and a killer wall sticking up in front) (really hard!) BYTE $02,%01000101,%00010011 ; BYTE $40 BYTE $20 ; level 13 (grav reversed and lower) (ultra hard!) BYTE $12,$60 WORD $0100,$0000 BYTE -$06 BYTE $e8,$00 BYTE $40 ; After all levels are exhausted the speed increases. There is no end. allpalette BYTE $16 ; killer walls (red) ; 0x03 BYTE $10 ; unused ; 0x02 BYTE $20 ; normal walls (white) ; 0x01 BYTE $0f ; background (black) ; 0x00 initdata WORD THRUST WORD -THRUST WORD MAXX_ WORD MAXY_ WORD level BYTE 0 BYTE PADLIMX_ BYTE PADLIMY_ org $bffa,$00 ; THIS LINE SUPPLIES FILLER! WORD mainloop ; NMI WORD start ; RESET WORD 0 ; THIS LINE SUPPLIES FILLER! ; Outstanding OC Remixes listened to while writing this program: ; Secret of Mana FearOfTheFlava - McVaffe ; Metroid To Brinstar - Avien ; Super Metroid Zebesian Midnight - Vigilante ; DKC2 Assembly line Apparitions - Protrocity ; Castlevania Memblers Reaper - Memblers ; Zelda 64 Gerudo Interlude - djpretzel ; MM4 LetThereBeLight - AmIEvil ; Mega Man Cutman Sonata - McVaffe ; DKC2 Mechanical Swamp - Protrocity ; Final Fantasy 6 Terra In Black - Ailsean ; Final Fantasy 9 Black Magic Synthesis - SysteManiac ; Final Fantasy 7 CidSendsaDreamtotheUnderseaPalace - Star Salzman ; Final Fantasy 4 A Chocobo's Mystic Life - MexieuS ; Final Fantasy 4 Tororian Love Song - silent ; Final Fantasy 4 Rydia (Clean Mix) - Kaijin ; http://www.ocremix.org