Skip to navigation


Elite I source

[Commodore 64 version]

ELITE I FILE Produces the binary file ELTI.bin that gets loaded by elite-checksum.py.
CODE_I% = P% LOAD_I% = LOAD% + P% - CODE%
Name: yetanotherrts [Show more] Type: Subroutine Category: Tactics Summary: Contains an RTS
Context: See this subroutine on its own page References: This subroutine is called as follows: * SFRMIS calls yetanotherrts

This routine contains an RTS so we can return from the SFRMIS subroutine with a branch instruction. It also contains the DEMON label, which is left over from the 6502 Second Processor version, where it implements the demo (there is no demo in this version of Elite).
.yetanotherrts .DEMON RTS ; Return from the subroutine
Name: ECMOF [Show more] Type: Subroutine Category: Sound Summary: Switch off the E.C.M.
Context: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 16 of 16) calls ECMOF * RES2 calls ECMOF

Switch the E.C.M. off, turn off the dashboard bulb and make the sound of the E.C.M. switching off).
.ECMOF LDA #0 ; Set ECMA and ECMP to 0 to indicate that no E.C.M. is STA ECMA ; currently running STA ECMP JSR ECBLB ; Update the E.C.M. indicator bulb on the dashboard LDY #sfxecm ; Call the NOISEOFF routine with A = sfxecm to turn off JMP NOISEOFF ; the sound of the E.C.M. and return from the subroutine ; using a tail call
Name: SFRMIS [Show more] Type: Subroutine Category: Tactics Summary: Add an enemy missile to our local bubble of universe
Context: See this subroutine on its own page References: This subroutine is called as follows: * TACTICS (Part 5 of 7) calls SFRMIS

An enemy has fired a missile, so add the missile to our universe if there is room, and if there is, make the appropriate warnings and noises.
.SFRMIS LDX #MSL ; Set X to the ship type of a missile, and call SFS1-2 JSR SFS1-2 ; to add the missile to our universe with an AI flag ; of %11111110 (AI enabled, hostile, no E.C.M.) BCC yetanotherrts ; The C flag will be set if the call to SFS1-2 was a ; success, so if it's clear, jump to yetanotherrts to ; return from the subroutine (as yetanotherrts contains ; an RTS) LDA #120 ; Print recursive token 120 ("INCOMING MISSILE") as an JSR MESS ; in-flight message LDY #sfxwhosh ; Call the NOISE routine with Y = sfxwhosh to make the JMP NOISE ; sound of the missile being launched and return from ; the subroutine using a tail call
Name: EXNO2 [Show more] Type: Subroutine Category: Status Summary: Process us making a kill Deep dive: Combat rank
Context: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 5 of 16) calls EXNO2 * Main flight loop (Part 11 of 16) calls EXNO2 * TACTICS (Part 1 of 7) calls EXNO2

We have killed a ship, so increase the kill tally, displaying an iconic message of encouragement if the kill total is a multiple of 256, and then make a nearby explosion sound.
Arguments: X The type of the ship that was killed
.EXNO2 LDA TALLYL ; We now add the fractional kill count to our tally, CLC ; starting with the fractional bytes: ADC KWL%-1,X ; STA TALLYL ; TALLYL = TALLYL + fractional kill count ; ; where the fractional kill count is taken from the ; KWL% table, according to the ship's type (we look up ; the X-1-th value from KWL% because ship types start ; at 1 rather than 0) LDA TALLY ; And then we add the low byte of TALLY(1 0): ADC KWH%-1,X ; STA TALLY ; TALLY = TALLY + carry + integer kill count ; ; where the integer kill count is taken from the KWH% ; table in the same way BCC davidscockup ; If there is no carry, jump straight to EXNO3 to skip ; the following three instructions INC TALLY+1 ; Increment the high byte of the kill count in TALLY LDA #101 ; The kill total is a multiple of 256, so it's time JSR MESS ; for a pat on the back, so print recursive token 101 ; ("RIGHT ON COMMANDER!") as an in-flight message .davidscockup LDA INWK+7 ; Fetch z_hi, the distance of the ship being hit in ; terms of the z-axis (in and out of the screen) LDX #11 ; We now set X to a number between 11 and 15 depending ; on the z-axis distance to the exploding ship, with 11 ; for distant ships and 15 for close ships CMP #16 ; If z_hi >= 16, jump to quiet2 with X = 11 BCS quiet2 INX ; Increment X to 12 CMP #8 ; If z_hi >= 8, jump to quiet2 with X = 12 BCS quiet2 INX ; Increment X to 13 CMP #6 ; If z_hi >= 6, jump to quiet2 with X = 13 BCS quiet2 INX ; Increment X to 14 CMP #3 ; If z_hi >= 3, jump to quiet2 with X = 14 BCS quiet2 INX ; Increment X to 15 .quiet2 TXA ; Set A = X << 4 ASL A ; ASL A ; So the value of X is in the high nibble of A, so we ASL A ; can pass it to NOISE2 as the sustain volume ASL A ORA #3 ; Set the low nibble of A to 3, so we can pass it to ; NOISE2 as the release length LDY #sfxexpl ; Call the NOISE2 routine with Y = sfxexpl, a frequency LDX #81 ; of 81 in X, and A set according to the explosion JMP NOISE2 ; distance: ; ; * Low nibble of A = release length of 3 ; ; * High nibble of A = sustain volume in the range 11 ; to 15, so closer explosions have a higher sustain ; volume and are therefore louder ; ; The call to NOISE2 returns from the subroutine using a ; tail call
Name: EXNO [Show more] Type: Subroutine Category: Sound Summary: Make the sound of a laser strike or ship explosion
Context: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 11 of 16) calls EXNO

Make the two-part explosion sound of us making a laser strike, or of another ship exploding. The volume of the first explosion is affected by the distance of the ship being hit, with more distant ships being quieter.
.EXNO LDA INWK+7 ; Fetch z_hi, the distance of the ship being hit in ; terms of the z-axis (in and out of the screen) LDX #11 ; We now set X to a number between 11 and 15 depending ; on the z-axis distance to the exploding ship, with 11 ; for distant ships and 15 for close ships CMP #8 ; If z_hi >= 8, jump to quiet with X = 11 BCS quiet INX ; Increment X to 12 CMP #4 ; If z_hi >= 4, jump to quiet with X = 12 BCS quiet INX ; Increment X to 13 CMP #3 ; If z_hi >= 3, jump to quiet with X = 13 BCS quiet INX ; Increment X to 14 CMP #2 ; If z_hi >= 2, jump to quiet with X = 14 BCS quiet INX ; Increment X to 15 .quiet TXA ; Set A = X << 4 ASL A ; ASL A ; So the value of X is in the high nibble of A ASL A ASL A ORA #3 ; Set the low nibble of A to 3, so we can pass it to ; NOISE2 as the release length LDY #sfxhit ; Call the NOISE2 routine with Y = sfxhit, a frequency LDX #208 ; of 208 in X, and A set according to the explosion JMP NOISE2 ; distance: ; ; * Low nibble of A = release length of 3 ; ; * High nibble of A = sustain volume in the range 11 ; to 15, so closer explosions have a higher sustain ; volume and are therefore louder ; ; The call to NOISE2 returns from the subroutine using a ; tail call
Name: BEEP [Show more] Type: Subroutine Category: Sound Summary: Make a short, high beep
Context: See this subroutine on its own page References: This subroutine is called as follows: * dn2 calls BEEP * Main flight loop (Part 11 of 16) calls BEEP * R5 calls BEEP
.BEEP LDY #sfxbeep ; Call the NOISE routine with Y = sfxbeep to make a BNE NOISE ; short, high beep, returning from the subroutine using ; a tail call (this BNE is effectively a JMP as Y will ; never be zero)
Name: EXNO3 [Show more] Type: Subroutine Category: Sound Summary: Make an explosion sound
Context: See this subroutine on its own page References: This subroutine is called as follows: * DEATH calls EXNO3 * Main flight loop (Part 10 of 16) calls EXNO3 * OOPS calls EXNO3 * TACTICS (Part 1 of 7) calls EXNO3

Make the sound of death in the cold, hard vacuum of space. Apparently, in Elite space, everyone can hear you scream. This routine also makes the sound of a destroyed cargo canister if we don't get scooping right, the sound of us colliding with another ship, and the sound of us being hit with depleted shields. It is not a good sound to hear.
.EXNO3 LDY #sfxexpl ; Call the NOISE routine with Y = sfxexpl to make the BNE NOISE ; sound of an explosion, returning from the subroutine ; using a tail call (this BNE is effectively a JMP as Y ; will never be zero)
Name: SOFLUSH [Show more] Type: Subroutine Category: Sound Summary: Reset the sound buffers and turn off all sound channels
Context: See this subroutine on its own page References: This subroutine is called as follows: * stopbd calls SOFLUSH * NOISE calls via SOUR1 * NOISE2 calls via SOUR1 * NOISEOFF calls via SOUR1

Other entry points: SOUR1 Contains an RTS
.SOFLUSH LDY #3 ; We need to zero the first 3 bytes of the sound buffer ; at SOCNT, so set a counter in Y LDA #1 ; Set A to 1 so we can reset the sound buffer to contain ; values of 1 .SOUL2 STA SOCNT-1,Y ; Zero the Y-1th byte of SOCNT DEY ; Decrement the loop counter BNE SOUL2 ; Loop back to zero the next byte until we have done all ; three from SOFLG+2 down to SOFLG .SOUR1 RTS ; Return from the subroutine
Name: NOISEOFF [Show more] Type: Subroutine Category: Sound Summary: Turn off a specific sound effect in whichever voice it is currently playing in
Context: See this subroutine on its own page References: This subroutine is called as follows: * ECMOF calls NOISEOFF

Arguments: Y The number of the sound effect to turn off
.NOISEOFF LDX #3 ; Set X = 3 to use as a counter to work through the ; three voices, so we can match the voice that is ; currently playing the sound effect in Y INY ; Set XX15+2 to the number of the sound effect we want STY XX15+2 ; to turn off, plus 1 .SOUL1 DEX ; Decrement X to work through the voices, so we start ; from 2 and go down to 0 BMI SOUR1 ; If X is negative then we have checked all three ; voices, jump to SOUR1 to return from the subroutine ; (as SOUR1 contains an RTS) LDA SOFLG,X ; Set A to bits 0-5 of SOFLG for voice X AND #%00111111 CMP XX15+2 ; If this doesn't match the incremented sound effect BNE SOUL1 ; number in XX15+2, loop back to check the next voice LDA #1 ; If we get here then voice X is playing the sound STA SOCNT,X ; effect we want to stop, so set the SOCNT entry for ; this voice to 1, to run down the sound's counter and ; stop the sound RTS ; Return from the subroutine
Name: HYPNOISE [Show more] Type: Subroutine Category: Sound Summary: Make the sound of the hyperspace drive being engaged
Context: See this subroutine on its own page References: This subroutine is called as follows: * LL164 calls HYPNOISE
.HYPNOISE LDY #sfxhyp1 ; Call the NOISE2 routine with Y = sfxhyp1, a frequency LDA #$F5 ; of 240 in X, and A set as follows: LDX #240 ; JSR NOISE2 ; * Low nibble of A = release length of 5 ; ; * High nibble of A = sustain volume of 15 LDY #sfxwhosh ; Call the NOISE routine with Y = sfxwhosh to make the JSR NOISE ; sound of the ship launching LDY #1 ; Wait for 1/50 of a second (0.02 seconds) on PAL JSR DELAY ; systems, or 1/60 of a second (0.017 seconds) on NTSC LDY #(sfxhyp1+128) ; Call the NOISE routine with Y = sfxhyp1 + 128, which BNE NOISE ; makes the sfxhyp1 hyperspace effect, but without first ; checking to see if it is already playing (so the ; effect can layer on top of the first sound effect we ; made above) ; ; The call to NOISE returns from the subroutine using a ; tail call (this BNE is effectively a JMP as Y is never ; zero)
Name: NOISE2 [Show more] Type: Subroutine Category: Sound Summary: Make a sound effect with a specific volume and release length
Context: See this subroutine on its own page References: This subroutine is called as follows: * EXNO calls NOISE2 * EXNO2 calls NOISE2 * HYPNOISE calls NOISE2 * Main game loop (Part 5 of 6) calls NOISE2

Arguments: A Determines the release length and sustain volume of the sound effect * Bits 0-3 contain the release length * Bits 4-7 contain the sustain volume X The frequency of the sound effect
.NOISE2 BIT SOUR1 ; SOUR1 contains an RTS instruction, which has opcode ; $60 (or %01100000), and as the BIT instructions sets ; the V flag to bit 6 of its operand, this instruction ; sets the V flag ; ; There is no SEV instruction in the 6502, hence the ; need for this workaround STA XX15 ; Store the sustain volume/release length in XX15 STX XX15+1 ; Store the frequency in XX15+1 EQUB $50 ; Skip the next instruction by turning it into ; $50 $B8, or BVC $B8, which does nothing because we ; set the V flag above ; Fall through into NOISE with the V flag set
Name: NOISE [Show more] Type: Subroutine Category: Sound Summary: Make the sound whose number is in Y
Context: See this subroutine on its own page References: This subroutine is called as follows: * BEEP calls NOISE * ECBLB2 calls NOISE * EXNO3 calls NOISE * FRMIS calls NOISE * HME2 calls NOISE * HYPNOISE calls NOISE * LAUN calls NOISE * Main flight loop (Part 3 of 16) calls NOISE * SFRMIS calls NOISE * TACTICS (Part 6 of 7) calls NOISE * WARP calls NOISE

Arguments: Y The number of the sound effect to be made If bit 7 is set (i.e. Y = 128 + sound effect number) then it will play the sound effect without first checking to see if it is already playing, so the sound effect can be made on more than one voice at the same time V flag If set, use the values in XX15 and XX15+1 to determine the release length, sustain volume and frequency XX15 Determines the release length and sustain volume of the sound effect (when V is set) * Bits 0-3 contain the release length * Bits 4-7 contain the sustain volume XX15+1 The frequency of the sound effect (when V is set)
.NOISE CLV ; Clear the V flag, unless we fell into this routine ; from the NOISE2 routine, in which case this ; instruction is skipped (and V remains set) LDA DNOIZ ; If DNOIZ is non-zero, then sound is disabled, so BNE SOUR1 ; return from the subroutine (as SOUR1 contains an RTS) LDX #2 ; Set X = 2 so we can loop through all three voices, ; from voice 2 down to voice 0 INY ; Set XX15+2 = sound effect number in Y + 1 STY XX15+2 DEY LDA SFXPR,Y ; If bit 0 of SFXPR value for this sound effect is set, LSR A ; then we don't need to check the three voice channels BCS SOUX9 ; to see if any of them are already playing this sound ; effect, so jump to SOUX9 to skip the following ; ; If NOISE was called with a sound effect of 128 + sound ; effect number, this lookup will be fairly random, as ; it is fetching values from game code ; Bit 1 of SFXPR for this sound effect is clear, so now ; we check to see if this sound effect is already ; playing, and if it is, we jump to SOUX6 with the voice ; number in X .SOUX7 LDA SOFLG,X ; Set A to bits 0-5 of SOFLG for voice X, which contains AND #%00111111 ; the sound effect number currently playing in voice X, ; incremented by 1 CMP XX15+2 ; If this matches the incremented sound effect number BEQ SOUX6 ; in XX15+2, then the sound effect is already playing on ; voice X, so jump to SOUX6 to play the new sound effect ; using the same voice DEX ; Decrement the voice number in X BPL SOUX7 ; Loop back to check the next voice, until we have ; checked them all .SOUX9 ; The sound effect is not already being played, so now ; we find out which voice currently has the lowest ; priority, which is stored in the SOPR table LDX #0 ; Set X = 0 to denote voice 1 LDA SOPR ; If SOPR < SOPR+1, jump to SOUX1 as voice 1 currently CMP SOPR+1 ; has a lower priority than voice 2 BCC SOUX1 INX ; Voice 1 has a higher priority than voice 2, so set ; X = 1 to denote voice 2 LDA SOPR+1 ; Set A to the priority of voice 2 .SOUX1 CMP SOPR+2 ; If A < SOPR+2, then the priority in A is a lower BCC P%+4 ; priority than voice 3, so skip the following ; instruction to keep the value of X unchanged LDX #2 ; Set X = 2 so we make the sound effect in voice 3 ; ; So if we jumped here because voice 1 has a lower ; priority than voice 2, we set X as follows: ; ; * X = 0 to choose voice 1 as the lowest priority ; if voice 1 is lower priority than voice 3 ; as v1 < v3 and v1 < v2 ; ; * X = 2 to choose voice 3 as the lowest priority ; if voice 1 is higher priority than voice 3 ; as v1 > v3 and v1 < v2 ; ; If we fell through from above because voice 1 has a ; higher priority than voice 2, then we set X as ; follows: ; ; * X = 1 to choose voice 2 as the lowest priority ; if voice 2 is lower priority than voice 3 ; as v2 < v3 and v1 > v2 ; ; * X = 2 to choose voice 3 as the lowest priority ; if voice 2 is higher priority than voice 3 ; as v2 > v3 and v1 > v2 ; ; The result is that X now contains the voice with the ; lowest priority in the SOPR table, so this is where we ; make our new sound effect .SOUX6 ; By this point X contains the voice number for our new ; sound effect, where X = 0, 1 or 2 (for voices 1 to 3) TYA ; Clear bit 0 of Y, so that if NOISE was called with a AND #%01111111 ; sound effect of 128 + sound effect number, the 128 TAY ; part is now cleared from Y, so Y now contains the ; sound effect number that we want to make LDA SFXPR,Y ; If sound effect Y's priority in SFXPR is less than CMP SOPR,X ; the current priority of voice X in SOPR+X, then the BCC SOUR1 ; sound currently playing in voice X is a higher ; priority than the new sound, so jump to SOUR1 to ; return from the subroutine (as SOUR1 contains an RTS) SEI ; Disable interrupts while we make the sound effect STA SOPR,X ; Store the priority of the sound effect we are making ; in the SOPR entry for voice X, so we can use this to ; check the priority if we want to make sounds in this ; voice in future BVS SOUX4 ; If the V flag is set then we got here via NOISE2, in ; which case the release length and sustain volume were ; passed to the routine in XX15, so skip to SOUX4 to ; set A to this value LDA SFXSUS,Y ; Set A to the release length and sustain volume for ; sound effect Y EQUB $CD ; Skip the next instruction by turning it into ; $CD $A5 $6B, or CMP $6BA5, which does nothing apart ; from affect the C and Z flags ; ; This is similar to the EQUB $2C trick that we see ; throughout Elite, but that uses a BIT opcode to skip ; an instruction, and that would change the value of the ; V flag (which we are using), so here we change the ; next instruction into a CMP instead, as that doesn't ; affect the V flag .SOUX4 LDA XX15 ; Set A to XX15, which contains the release length and ; sustain volume that were passed here via NOISE2 (we ; only run this instruction if the V flag is set) STA SOSUS,X ; Store the release length and sustain volume in A into ; the SOSUS entry for voice X LDA SFXCNT,Y ; Store the counter for sound effect Y in the SOCNT STA SOCNT,X ; entry for voice X LDA SFXFRCH,Y ; Store the frequency change for sound effect Y in the STA SOFRCH,X ; SOFRCH entry for voice X LDA SFXCR,Y ; Store the voice control register for sound effect Y in STA SOCR,X ; the SOCR entry for voice X BVS SOUX5 ; If the V flag is set then we got here via NOISE2, in ; which case the frequency was passed to the routine in ; XX15+1, so skip to SOUX5 to set A to this value LDA SFXFQ,Y ; Set A to the frequency for sound effect Y EQUB $CD ; Skip the next instruction by turning it into ; $CD $A5 $6C, or CMP $6CA5, which does nothing apart ; from affect the C and Z flags .SOUX5 LDA XX15+1 ; Set A to XX15+1, which contains the frequency that was ; passed here via NOISE2 (we only run this instruction ; if the V flag is set) STA SOFRQ,X ; Store the frequency in A into the SOFRQ entry for ; voice X LDA SFXATK,Y ; Store the attack and decay length for sound effect Y STA SOATK,X ; in the SOATK entry for voice X LDA SFXVCH,Y ; Store the volume change rate for sound effect Y in the STA SOVCH,X ; SOVCH entry for voice X INY ; Increment the sound effect number in Y TYA ; Store the incremented sound effect number in the low ORA #%10000000 ; bits of the SOFLG entry for voice X (so the lower bits STA SOFLG,X ; are non-zero) and set bit 7 to indicate that this is a ; new sound effect, so the interrupt handler in SOINT ; can correctly process the sound effect CLI ; Enable interrupts again SEC ; Set the C flag RTS ; Return from the subroutine
Name: RASTCT [Show more] Type: Variable Category: Drawing the screen Summary: The current raster count, which flips between 0 and 1 on each call to the COMIRQ1 interrupt handler (0 = space view, 1 = dashboard)
Context: See this variable on its own page References: This variable is used as follows: * COLD uses RASTCT * COMIRQ1 uses RASTCT * LOD uses RASTCT * SVE uses RASTCT * WSCAN uses RASTCT
.RASTCT EQUB 0
Name: zebop [Show more] Type: Variable Category: Drawing the screen Summary: The value for VIC register $18 to set the screen RAM address for a raster count of 0 in the interrupt routine (i.e. the space view)
Context: See this variable on its own page References: This variable is used as follows: * COMIRQ1 uses zebop
.zebop EQUB $81 ; Determines the address of screen RAM to use for colour ; data in the upper portion of the screen (this sets the ; address of screen RAM to $6000 and does not change)
Name: abraxas [Show more] Type: Variable Category: Drawing the screen Summary: The value for VIC register $18 to set the screen RAM address for a raster count of 1 in the interrupt routine (i.e. the dashboard)
Context: See this variable on its own page References: This variable is used as follows: * TTX66K uses abraxas * wantdials uses abraxas
.abraxas EQUB $81 ; Determines the address of screen RAM to use for colour ; data the lower portion of the screen, where the ; dashboard lives in the space view: ; ; * When abraxas is $81, the colour of the lower part ; of the screen is determined by screen RAM at $6000 ; (i.e. when the dashboard is not being shown) ; ; * When abraxas is $91, the colour of the lower part ; of the screen is determined by screen RAM at $6400 ; (i.e. when the dashboard is being shown)
Name: innersec [Show more] Type: Variable Category: Drawing the screen Summary: A table for converting the value of X from 0 to 1 or from 1 to 0, for use when flipping RASCT between 0 and 1 on each interrupt
Context: See this variable on its own page References: This variable is used as follows: * COMIRQ1 uses innersec
.innersec EQUB 1 ; Lookup value to change 0 to 1 EQUB 0 ; Lookup value to change 1 to 0
Name: shango [Show more] Type: Variable Category: Drawing the screen Summary: The raster lines that fire the raster interrupt, so it fires at the top of the screen (51) and the top of the dashboard (51 + 143)
Context: See this variable on its own page References: This variable is used as follows: * COMIRQ1 uses shango
.shango EQUB 51 + 143 ; The raster line at the top of the dashboard EQUB 51 ; The raster line at the top of the visible screen
Name: moonflower [Show more] Type: Variable Category: Drawing the screen Summary: Controls the energy bomb effect by switching between multicolour and standard mode
Context: See this variable on its own page References: This variable is used as follows: * BOMBOFF uses moonflower * COMIRQ1 uses moonflower * Main flight loop (Part 3 of 16) uses moonflower
.moonflower EQUB %11000000 ; The bitmap mode for the upper part of the screen
Name: caravanserai [Show more] Type: Variable Category: Drawing the screen Summary: Controls whether multicolour or standard bitmap mode is used for the lower part of the screen (i.e. the dashboard)
Context: See this variable on its own page References: This variable is used as follows: * TTX66K uses caravanserai * wantdials uses caravanserai
.caravanserai EQUB %11000000 ; The bitmap mode for the lower part of the screen
Name: santana [Show more] Type: Variable Category: Drawing the screen Summary: Controls whether sprite 1 (the explosion sprite) is drawn in single colour or multicolour mode
Context: See this variable on its own page References: This variable is used as follows: * COMIRQ1 uses santana
.santana EQUB %11111110 ; Multicolour mode for the upper part of the screen EQUB %11111100 ; Single colour mode for the lower part of the screen
Name: lotus [Show more] Type: Variable Category: Drawing the screen Summary: The colour of the explosion sprite in the upper and lower parts of the screen
Context: See this variable on its own page References: This variable is used as follows: * COMIRQ1 uses lotus
.lotus EQUB 2 ; Colour 2 (red) for %10 bit pairs in the upper part of ; the screen EQUB 0 ; Colour 0 (transparent) for set bits in the lower part ; of the screen
Name: welcome [Show more] Type: Variable Category: Drawing the screen Summary: The background colour for the upper and lower parts of the screen, used by the energy bomb to flash the screen's background colour
Context: See this variable on its own page References: This variable is used as follows: * BOMBOFF uses welcome * COMIRQ1 uses welcome
.welcome EQUB 0 ; The background colour for the upper part of the screen EQUB 0 ; The background colour for the lower part of the screen
Name: SOUL3b [Show more] Type: Subroutine Category: Sound Summary: Check whether this is the last voice when making sound effects in the interrupt routine, and return from the interrupt if it is
Context: See this subroutine on its own page References: This subroutine is called as follows: * SOINT calls SOUL3b

Arguments: Y The voice number that is currently being processed in the interrupt routine at SOINT (0 to 2)
.SOUL3b DEY ; Decrement the voice number BPL SOUL8 ; If we have not yet processed all three voices then Y ; will still be positive (i.e. 0, 1 or 2), so jump to ; SOUL8 to process this voice ; If we get here then we have processed all three voices ; in the sound effects interrupt routine, so we now need ; to return from the interrupt PLA ; Retrieve the value of Y we stored on the stack at the TAY ; start of the music section of the interrupt routine, ; so it is preserved ; Fall through into COMIRQ3 to restore the A and X ; registers and the correct memory configuration, and ; return from the interrupt
Name: COMIRQ1 [Show more] Type: Subroutine Category: Drawing the screen Summary: The split screen and sound interrupt handler (the IRQ interrupt service hardware vector at $FFFE points here)
Context: See this subroutine on its own page References: This subroutine is called as follows: * COLD calls COMIRQ1
.COMIRQ3 ; If we get here then we want to return from the ; interrupt, so we first have to restore the registers ; we want to preserve, and restore the correct memory ; configuration PLA ; Retrieve the value of X we stored on the stack at the TAX ; start of the interrupt routine, so it is preserved LDA l1 ; Set bits 0 to 2 of the port register at location l1 AND #%11111000 ; ($0001) to bits 0 to 2 of L1M, leaving bits 3 to 7 ORA L1M ; unchanged STA l1 ; ; This sets LORAM, HIRAM and CHAREN to the values in ; L1M, which ensures we return memory to the same ; configuration as when we entered the interrupt routine PLA ; Retrieve the value of A we stored on the stack at the ; start of the interrupt routine, so it is preserved RTI ; Return from the interrupt .COMIRQ1 PHA ; Store A on the stack, so we can preserve it across ; calls to the interrupt handler LDA l1 ; Set bits 0 to 2 of the 6510 port register at location AND #%11111000 ; l1 to %101 to set the input/output port to the ORA #%00000101 ; following: STA l1 ; ; * LORAM = 1 ; * HIRAM = 0 ; * CHAREN = 1 ; ; This sets the entire 64K memory map to RAM except for ; the I/O memory map at $D000-$DFFF, which gets mapped ; to registers in the VIC-II video controller chip, the ; SID sound chip, the two CIA I/O chips, and so on ; ; See the memory map at the top of page 264 in the ; Programmer's Reference Guide .iansint LDA VIC+$19 ; Set bit 7 of VIC register $19, to acknowledge any IRQ ORA #%10000000 ; interrupts that are pending STA VIC+$19 ; ; I'm not sure why we acknowledge IRQ interrupts by ; setting bit 7 rather than setting bit 0 to acknowledge ; the raster interrupt, but perhaps this prevents any ; pending IRQ interrupts from being triggered and ; messing up the timing of the split screen and sound ; interrupt routines TXA ; Store X on the stack, so we can preserve it across PHA ; calls to the interrupt handler LDX RASTCT ; Set X to the current raster count ; ; The code below flips this on each interrupt between ; the two values in innersec, which are set to 0 and 1, ; so X oscillates between 0 and 1 each time the ; interrupt routine is called ; ; The COMIRQ1 interrupt handler is called when the ; raster interrupt is triggered, which happens when the ; VIC-II starts to draw the raster lines defined in the ; shango variable (see below) ; ; These raster lines coincide with the top of the screen ; and the top of the dashboard, so this routine gets ; called twice on each screen redraw, once when the ; raster starts drawing the top of the screen, and again ; when the raster returns to the top of the dashboard ; ; When the interrupt routine is called at the top of the ; screen, the value of RASCT is 0, so the various VIC-II ; registers in the following get set up for the upper ; part of the screen; this includes setting the raster ; interrupt to fire at the top of the dashboard. RASCT ; is flipped to a value of 1 after the upper part of the ; screen has been configured ; ; When the raster reaches the top of the dashboard, the ; interrupt routine is called and RASCT is still 1, so ; the screen is configured for the dashboard (if there ; is one); this includes setting the raster interrupt to ; fire at the top of the screen once again. RASCT is ; flipped back to a value of 0 after the lower part of ; the screen has been configured, ready for the whole ; process to repeat ; ; So, in the following: ; ; * X = RASCT = 0 indicates that we are drawing the ; upper part of the screen ; ; * X = RASCT = 1 indicates that we are drawing the ; lower part of the screen LDA zebop,X ; Set VIC register $18 to the value in zebop (when STA VIC+$18 ; X = 0, for the upper part of the screen) or abraxas ; (when X = 1, for the lower part of the screen) ; ; zebop is always set to $81, which will set the address ; of screen RAM to offset $2000 within the VIC-II bank ; at $4000 (so the screen's colour data is at $6000) ; ; abraxas is $81 by default, in which case this will ; also set screen RAM to $6000, but the wantdials ; routine sets it to $91 when we need to display the ; space view and the dashboard, which sets the address ; of screen RAM to offset $2400 within the VIC-II bank ; at $4000 (so the screen's colour data is at $6400) ; ; In other words: ; ; * When abraxas is $81, the colour of the lower part ; of the screen is determined by screen RAM at $6000 ; (i.e. when the dashboard is not being shown) ; ; * When abraxas is $91, the colour of the lower part ; of the screen is determined by screen RAM at $6400 ; (i.e. when the dashboard is being shown) ; ; This enables us to colour the dashboard independently ; from the corresponding lower part of the text view LDA moonflower,X ; Set VIC register $16 to the value in moonflower (when STA VIC+$16 ; X = 0, for the upper part of the screen) or ; caravanserai (when X = 1, for the lower part of the ; screen) ; ; moonflower has bit 4 clear by default, so this sets ; the upper part of the screen to standard bitmap mode, ; for the space and text views ; ; Bit 4 of moonflower gets set in part 3 of the main ; flight loop when the energy bomb is set off, which ; changes the space view into multicolour bitmap mode ; for the duration of the explosion; this makes the ; space view turn into a coloured mess of double-width ; pixels while the energy bomb is going off ; ; Bit 4 of moonflower gets cleared again in the BOMBOFF ; routine, which is called once the energy bomb has ; finished exploding ; ; caravanserai has bit 4 clear by default, which sets ; the lower part of the screen to standard bitmap mode, ; but the wantdials routine sets bit 4 when we need to ; display the space view and the dashboard, so this ; ensures that the dashboard in the lower part of the ; screen is shown in multicolour bitmap mode LDA shango,X ; Set VIC register $12 to the X-th entry in shango, STA VIC+$12 ; which configures a raster interrupt to fire when the ; VIC-II reaches the relevant line ; ; When X = 0, we are currently configuring the VIC-II ; for the upper part of the screen, so this sets the ; next interrupt to fire at line 51 + 143, which is at ; the top of the dashboard ; ; When X = 1, we are currently configuring the VIC-II ; for the lower part of the screen, this sets the next ; interrupt to fire at line 51, which is at the top of ; the visible screen ; ; So this ensures that the interrupt routine will be ; called once the raster reaches the next line at which ; we need to reconfigure the VIC-II LDA santana,X ; Set VIC register $12 to the X-th entry in santana, STA VIC+$1C ; so it sets bit 1 of the register for the upper part of ; the screen, and clears it again for the lower part ; ; This switches sprite 1, the explosion sprite, between ; multicolour in the upper part of the screen and single ; colour in the bottom part LDA lotus,X ; Set VIC register $28 to the X-th entry in lotus, so STA VIC+$28 ; this sets the colour of sprite 1 to red (colour 2) ; when it's in the upper part of the screen, and to ; colour 0 in the lower part of the screen ; ; As we just switched sprite 1 between multicolour and ; single colour mode (for the upper and lower parts of ; the screen respectively), this means the explosion ; sprite appears in multicolour in the space view (as ; VIC+$28 is used to define the colour of %10 bits in ; the bitmap, so those are shown in red), but in the ; lower part of the screen the sprite is single colour ; with any set bits mapped to colour 0, making the ; sprite transparent ; ; In other words, this restricts the explosion sprite ; to appear in the space view only, so explosions don't ; occur in front of the dashboard BIT BOMB ; If bit 7 of BOMB is zero then the energy bomb is not BPL nobombef ; currently going off, so jump to nobombef to skip the ; following instruction INC welcome ; The energy bomb is going off, so increment welcome so ; we work our way through a range of background colours .nobombef LDA welcome,X ; Set VIC register $21 to the X-th entry in welcome, so STA VIC+$21 ; we change the background colour of the space view ; through a whole range of colours while the energy bomb ; is going off ; ; The value of welcome+1 is never changed, so the colour ; change only applies to the upper part of the screen, ; i.e. the space view ; ; The value of welcome gets set to 0 in the BOMBOFF ; routine, which is called once the energy bomb has ; finished exploding, so this stops the background ; colour from changing LDA innersec,X ; Set RASCT to the X-th entry from innersec, so this STA RASTCT ; flips the value of RASCT from 0 to 1 or from 1 to 0 BNE COMIRQ3 ; If we just flipped RASCT from 0 to 1 then jump to ; COMIRQ3 to return from the interrupt handler ; We now play the background music, if configured ; ; The BNE above means that we only do the following ; every other call to the interrupt handler, which is ; once per frame (so that's 60 or 50 times a second, ; depending on whether this is an NTSC or PAL machine) TYA ; Store Y on the stack, so we can preserve it across PHA ; calls to the interrupt handler BIT MUPLA ; If bit 7 of MUPLA is clear then there is no music BPL SOINT ; currently playing, so jump to SOINT to make any sound ; effects that are in progress JSR BDirqhere ; Play the background music for this frame BIT MUSILLY ; If bit 7 of MUSILLY is set then sounds are configured BMI SOINT ; to be played during music, and we know that music is ; already playing, so jump to SOINT to make any sound ; effects that are in progress JMP coffee ; Otherwise sounds are configured not to play during ; music, and we know that music is playing, so jmp to ; coffee to return from the interrupt handler without ; making the sound effect
Name: SOINT [Show more] Type: Subroutine Category: Sound Summary: Process the contents of the sound buffer and send it to the sound chip, to make sound effects as part of the interrupt routine
Context: See this subroutine on its own page References: This subroutine is called as follows: * COMIRQ1 calls SOINT * SOUL3b calls via SOUL8

Other entry points: SOUL8 Process the sound buffer from voice Y to 0
.SOINT LDY #2 ; We are going to work our way through the three voices ; and process each one in turn, so set a voice counter ; in Y to go from 2 to 0, for voices 3 to 1 .SOUL8 LDA SOFLG,Y ; Set A to the sound flag in SOFLG for voice Y BEQ SOUL3b ; If the sound flag is zero then no sound effect is ; being made on voice Y, so jump to SOUL3b to move on to ; the next voice, or return from the interrupt if this ; is the last voice BMI SOUL4 ; If bit 7 of the sound flag is set then we are just ; starting to make a new sound effect, so jump to SOUL4 ; to reset the SID registers for voice Y LDX SEVENS,Y ; Use the lookup table at SEVENS to set X = 7 * Y, so it ; can be used as an index into the SID registers for ; voice Y (as each of the three voices has seven ; associated register bytes, starting at to SID, SID+$7 ; and SID+$E for voices 1, 2 and 3 respectively) LDA SOFRCH,Y ; If the SOFRCH value for voice Y is zero, then there is BEQ SOUL5 ; no frequency change to apply, so jump to SOUL5 to skip ; past the frequency addition in SOUX2 BNE SOUX2 ; Otherwise jump to SOUX2 to apply the frequency change ; in A (this BNE is effectively a JMP as we just passed ; through a BEQ above) ;EQUB $2C ; This instruction is commented out in the original ; source .SOUL4 ; If we get here then this is a new sound on voice Y, so ; we need to initialise the voice LDA SEVENS,Y ; Use the lookup table at SEVENS to set A = 7 * Y STA SOUX3+1 ; Modify the STA instruction at SOUX3 to point to the ; correct block of seven SID registers for voice Y, so ; we zero the SID registers for voice Y in the following LDA #0 ; Set A = 0 to use for zeroing the SID registers LDX #6 ; There are seven bytes of SID registers for each voice, ; so set a counter in X so we can zero them all .SOUX3 STA SID,X ; Zero SID register X for voice Y ; ; This instruction was modified by the above to point to ; the register block for voice Y, so it zeroes register ; byte X for voice Y, rather than voice 1 DEX ; Decrement the byte counter BPL SOUX3 ; Loop back until we have zeroed all seven bytes of SID ; registers for voice Y LDX SEVENS,Y ; Use the lookup table at SEVENS to set X = 7 * Y, so it ; can be used as an index into the SID registers for ; voice Y LDA SOCR,Y ; Set SID register $4 (the voice control register) for STA SID+$4,X ; voice Y to the value from SOPR for voice Y, to control ; the sound as follows: ; ; * Bit 0: 0 = voice off, release cycle ; 1 = voice on, attack-decay-sustain cycle ; ; * Bit 1 set = synchronization enabled ; ; * Bit 2 set = ring modulation enabled ; ; * Bit 3 set = disable voice, reset noise generator ; ; * Bit 4 set = triangle waveform enabled ; ; * Bit 5 set = saw waveform enabled ; ; * Bit 6 set = square waveform enabled ; ; * Bit 7 set = noise waveform enabled ; ; These values come from the SFXCR table LDA SOATK,Y ; Set SID register $5 (the attack and decay length) for STA SID+$5,X ; voice Y to the value from SOATK for voice Y, to ; control the sound as follows: ; ; * Bits 0-3 = decay length ; ; * Bits 4-7 = attack length ; ; These values come from the SFXATK table LDA SOSUS,Y ; Set SID register $6 (the release length and sustain STA SID+$6,X ; volume) for voice Y to the value from SOSUS for voice ; Y, to control the sound as follows: ; ; * Bits 0-3 = release length ; ; * Bits 4-7 = sustain volume ; ; These values come from the SFXSUS table, but can be ; overridden manually using the NOISE2 routine LDA #0 ; Set A = 0 so the following frequency calculation has ; no effect, as we are just adding 0 to the frequency .SOUX2 ; We jump here if this is an existing sound whose SOFRCH ; value is non-zero, in which case the non-zero value is ; in A ; ; SOFRCH contains a frequency change to be applied in ; each frame, so we now add that to the frequency in ; SOFRQ ; ; If this is a new sound then we get here with A = 0, so ; the frequency doesn't change ; ; Is this is an existing sound with a frequency change ; of 0, then we already jumped past this calculation and ; went straight to SOUL5 from above CLC ; Add A to the SOFRQ value for voice Y, so the frequency CLD ; change gets applied ADC SOFRQ,Y STA SOFRQ,Y PHA ; Store the frequency from SOFRQ on the stack, so we can ; extract the different parts to send to the SID chip LSR A ; Set SID register $1 (high byte of the frequency) for LSR A ; voice Y to bits 2-7 of A STA SID+$1,X PLA ; Set SID register $0 (low byte of the frequency) for ASL A ; voice Y so that bits 0-1 of A are in bits 6-7 ASL A ; ASL A ; So if "f" represents the value from SOFRQ, this sets ASL A ; the 16-bit frequency as follows (with the high byte on ASL A ; the left): ASL A ; STA SID,X ; 00ffffff ff000000 ; ; Or, to put it another way, the frequency is set to ; SOFRQ << 6, or SOFR * 64 LDA PULSEW ; Set SID register $3 (pulse width) for voice Y to the STA SID+$3,X ; value of PULSEW, which oscillates between 2 and 6 ; for each frame .SOUL5 LDA SOFLG,Y ; If bit 7 of the sound flag is set then this is a new BMI SOUL6 ; sound effect, and we just started making it, so jump ; to SOUL6 to clear this bit in the sound flag as this ; is no longer a new sound TYA ; Set X = Y, so both X and Y contain the voice number TAX ; in the range 0 to 2, which we'll call voice Y DEC SOPR,X ; Decrement the priority in SOPR for voice Y, keeping BNE P%+5 ; it above zero, so sounds diminish in priority as they INC SOPR,X ; play out DEC SOCNT,X ; Decrement the counter in SOCNT for voice Y BEQ SOKILL ; If the counter has reached zero then it has just run ; out and this sound effect has finished, so jump to ; SOKILL to terminate it ; The SFXVCH table contains values whose lower bits are ; all set (e.g. %00000011, %00001111, %000111111, ; %11111111 and so on) ; ; If we AND a number this with a value, this the result ; will only be zero when the number is a multiple of the ; SFXVCH value LDA SOCNT,X ; If the sound effect counter is not a multiple of the AND SOVCH,Y ; SOVCH value for voice Y, jump to SOUL3 to move on to BNE SOUL3 ; the next voice ; If we get here then the sound effect counter is a ; multiple of the SOVCH value for voice Y LDA SOSUS,Y ; Subtract 16 from the release length and sustain SEC ; volume in SOSUS for voice Y SBC #16 ; STA SOSUS,Y ; This actually subtracts 1 from the high nibble of the ; release length and sustain volume, and the high nibble ; of the SOSUS value contains the sustain volume, so ; this subtracts 1 from the sustain volume LDX SEVENS,Y ; Use the lookup table at SEVENS to set X = 7 * Y, so it ; can be used as an index into the SID registers for ; voice Y STA SID+$6,X ; Update SID register $6 (release length and sustain ; volume) with the new value to reduce the volume of ; the sound by 1 JMP SOUL3 ; Jump to SOUL3 to move on to the next voice .SOKILL ; If we get here then the sound effect in voice Y has ; reached the end of its counter, so we need to ; terminate it LDX SEVENS,Y ; Use the lookup table at SEVENS to set X = 7 * Y, so it ; can be used as an index into the SID registers for ; voice Y LDA SOCR,Y ; Set SID register $4 (the voice control register) for AND #%11111110 ; voice Y to the value from SOPR for voice Y, but with STA SID+$4,X ; bit 0 clear ; ; Bit 0 controls the sound as follows: ; ; * Bit 0: 0 = voice off, release cycle ; 1 = voice on, attack-decay-sustain cycle ; ; So this turns the voice off, while leaving everything ; else as it was LDA #0 ; Zero the sound flag in SOFLG for voice Y to indicate STA SOFLG,Y ; that no sound effect is playing on this voice any more STA SOPR,Y ; Set the priority in SOPR for voice Y to zero, so any ; new sound effects will always override the priority ; of voice Y BEQ SOUL3 ; Jump to SOUL3 to move on to the next voice (this BEQ ; is effectively a JMP as A is always zero) .SOUL6 ; If we get here then bit 7 of the sound flag is set for ; this sound (to indicate that it's a new sound effect), ; and A contains the whole sound flag AND #%01111111 ; Clear bit 7 of A to indicate that this is no longer a ; new sound effect STA SOFLG,Y ; Update the sound flag for voice Y with the newly ; cleared bit 7 .SOUL3 DEY ; Decrement the voice number in Y to move on to the next ; voice BMI P%+5 ; If we just decremented the voice number to a negative ; value, then we have already processed all three ; voices, so skip the following instruction to return ; from the interrupt handler JMP SOUL8 ; Otherwise Y is still positive, so jump back to SOUL8 ; to make any sound effects on voice Y LDA PULSEW ; Flip bit 2 of PULSEW, so it oscillates between 2 and 6 EOR #%00000100 STA PULSEW ;LDA #1 ; These instructions are commented out in the original ;STA intcnt ; source ; Fall through into coffee to return from the interrupt ; handler
Name: coffee [Show more] Type: Subroutine Category: Sound Summary: Return from the interrupt routine, for when we are making sound effects
Context: See this subroutine on its own page References: This subroutine is called as follows: * COMIRQ1 calls coffee
.coffee PLA ; Retrieve the value of Y we stored on the stack at the TAY ; start of the music section of the interrupt routine, ; so it is preserved PLA ; Retrieve the value of X we stored on the stack at the TAX ; start of the interrupt routine, so it is preserved LDA l1 ; Set bits 0 to 2 of the port register at location l1 AND #%11111000 ; ($0001) to bits 0 to 2 of L1M, leaving bits 3 to 7 ORA L1M ; unchanged STA l1 ; ; This sets LORAM, HIRAM and CHAREN to the values in ; L1M, which ensures we return memory to the same ; configuration as when we entered the interrupt routine PLA ; Retrieve the value of A we stored on the stack at the ; start of the interrupt routine, so it is preserved RTI ; Return from the interrupt
Name: Sound variables [Show more] Type: Workspace Address: $AA13 to $1461 Category: Sound Summary: The sound buffer where the data to be sent to the sound chip is processed
Context: See this workspace on its own page References: No direct references to this workspace in this source file
.SOFLG EQUB 0 ; Sound buffer for sound effect flags EQUB 0 ; EQUB 0 ; SOFLG,Y contains the following: ; ; * Bits 0-5: sound effect number + 1 of the sound ; currently being made on voice Y ; ; * Bit 7 is set if this is a new sound being made, ; rather than one that is in progress ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * NOISEOFF ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOCNT EQUB 0 ; Sound buffer for sound effect counters EQUB 0 ; EQUB 0 ; SOCNT,Y contains the counter of the sound currently ; being made on voice Y ; ; The counter decrements each frame, and when it reaches ; zero, the sound effect has finished ; ; These values come from the SFXCNT table ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * NOISEOFF ; * SOFLUSH ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOPR EQUB 0 ; Sound buffer for SOPR values EQUB 0 ; EQUB 0 ; SOPR,Y contains the priority of the sound currently ; being made on voice Y ; ; These values come from the SFXPR table ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.PULSEW EQUB 2 ; The current pulse width for sound effects ; ; This flips between 2 and 6 on each frame ; ; [Show more]
; ; This variable is used by the following: ; ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOFRCH EQUB 0 ; Sound buffer for frequency change values EQUB 0 ; EQUB 0 ; SOFRCH,Y contains the frequency change to be applied ; to the sound currently being made on voice Y in each ; frame ; ; These values come from the SFXFRCH table ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOFRQ EQUB 0 ; Sound buffer for SFXFQ values EQUB 0 ; EQUB 0 ; SOFRQ,Y contains the frequency of the sound currently ; being made on voice Y ; ; These values come from the SFXFQ table, and have the ; frequency change from the SFXFRCH table applied in ; each frame ; ; The frequency sent to the SID chip is SOFRQ * 64 ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOCR EQUB 0 ; Sound buffer for voice control register values EQUB 0 ; EQUB 0 ; SOCR,Y contains the voice control register for the ; sound currently being made on voice Y ; ; These values come from the SFXCR table ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOATK EQUB 0 ; Sound buffer for attack and decay lengths EQUB 0 ; EQUB 0 ; SOATK,Y contains the attack and decay length for the ; sound currently being made on voice Y ; ; * Bits 0-3 = decay length ; ; * Bits 4-7 = attack length ; ; These values come from the SFXATK table ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOSUS EQUB 0 ; Sound buffer for release length and sustain volume EQUB 0 ; EQUB 0 ; SOATK,Y contains the release length and sustain volume ; for the sound currently being made on voice Y ; ; * Bits 0-3 = release length ; ; * Bits 4-7 = sustain volume ; ; These values come from the SFXSUS table, but can be ; overridden manually using the NOISE2 routine ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
.SOVCH EQUB 0 ; Sound buffer for the volume change rate EQUB 0 ; EQUB 0 ; SOVCH,Y contains the volume change rate of the sound ; currently being made on voice Y ; ; The sound's volume gets reduced by one every SOVCH,Y ; frames ; ; These values come from the SFXVCH table ; ; [Show more]
; ; This variable is used by the following: ; ; * NOISE ; * SOINT ; ; This list only includes code that refers to the ; variable by name; there may be other references to ; this memory location that don't use this label, and ; these will not be mentioned above
Name: SEVENS [Show more] Type: Variable Category: Sound Summary: A table for converting the value of Y to 7 * Y
Context: See this variable on its own page References: This variable is used as follows: * SOINT uses SEVENS
.SEVENS EQUB 0 ; Lookup value to change 0 to 0 EQUB 7 ; Lookup value to change 1 to 7 EQUB 14 ; Lookup value to change 2 to 14
Name: SFXPR [Show more] Type: Variable Category: Sound Summary: The priority level for each sound effect
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXPR
.SFXPR EQUB 114 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB 112 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB 116 ; Sound 2 = sfxhit = Other ship exploding EQUB 119 ; Sound 3 = sfxexpl = We died / Collision EQUB 115 ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB 104 ; Sound 5 = sfxbeep = Short, high beep EQUB 96 ; Sound 6 = sfxboop = Long, low beep EQUB 240 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB 48 ; Sound 8 = sfxeng = This sound is not used EQUB 254 ; Sound 9 = sfxecm = E.C.M. on EQUB 114 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB 114 ; Sound 11 = sfxalas = Military lasers fired by us EQUB 146 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB 225 ; Sound 13 = sfxbomb = Energy bomb EQUB 81 ; Sound 14 = sfxtrib = Trumbles dying EQUB 2 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXCNT [Show more] Type: Variable Category: Sound Summary: The counter for each sound effect, which defines the duration of the effect in frames
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXCNT
.SFXCNT EQUB 20 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB 14 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB 12 ; Sound 2 = sfxhit = Other ship exploding EQUB 80 ; Sound 3 = sfxexpl = We died / Collision EQUB 63 ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB 5 ; Sound 5 = sfxbeep = Short, high beep EQUB 24 ; Sound 6 = sfxboop = Long, low beep EQUB 128 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB 48 ; Sound 8 = sfxeng = This sound is not used EQUB 255 ; Sound 9 = sfxecm = E.C.M. on EQUB 16 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB 16 ; Sound 11 = sfxalas = Military lasers fired by us EQUB 112 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB 64 ; Sound 13 = sfxbomb = Energy bomb EQUB 15 ; Sound 14 = sfxtrib = Trumbles dying EQUB 14 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXFQ [Show more] Type: Variable Category: Sound Summary: The frequency (SID+$5) for each sound effect
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXFQ
.SFXFQ EQUB 69 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB 72 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB 208 ; Sound 2 = sfxhit = Other ship exploding EQUB 81 ; Sound 3 = sfxexpl = We died / Collision EQUB 64 ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB 240 ; Sound 5 = sfxbeep = Short, high beep EQUB 64 ; Sound 6 = sfxboop = Long, low beep EQUB 128 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB 16 ; Sound 8 = sfxeng = This sound is not used EQUB 80 ; Sound 9 = sfxecm = E.C.M. on EQUB 52 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB 51 ; Sound 11 = sfxalas = Military lasers fired by us EQUB 96 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB 85 ; Sound 13 = sfxbomb = Energy bomb EQUB 128 ; Sound 14 = sfxtrib = Trumbles dying EQUB 64 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXCR [Show more] Type: Variable Category: Sound Summary: The voice control register (SID+$4) for each sound effect
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXCR

The voice control register is set in this table as follows: * Bit 0: 0 = voice off, release cycle 1 = voice on, attack-decay-sustain cycle * Bit 1 set = synchronization enabled * Bit 2 set = ring modulation enabled * Bit 3 set = disable voice, reset noise generator * Bit 4 set = triangle waveform enabled * Bit 5 set = saw waveform enabled * Bit 6 set = square waveform enabled * Bit 7 set = noise waveform enabled
.SFXCR EQUB %01000001 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB %00010001 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB %10000001 ; Sound 2 = sfxhit = Other ship exploding EQUB %10000001 ; Sound 3 = sfxexpl = We died / Collision EQUB %10000001 ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB %00010001 ; Sound 5 = sfxbeep = Short, high beep EQUB %00010001 ; Sound 6 = sfxboop = Long, low beep EQUB %01000001 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB %00100001 ; Sound 8 = sfxeng = This sound is not used EQUB %01000001 ; Sound 9 = sfxecm = E.C.M. on EQUB %00100001 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB %00100001 ; Sound 11 = sfxalas = Military lasers fired by us EQUB %00010001 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB %10000001 ; Sound 13 = sfxbomb = Energy bomb EQUB %00010001 ; Sound 14 = sfxtrib = Trumbles dying EQUB %00100001 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXATK [Show more] Type: Variable Category: Sound Summary: The attack and decay length (SID+$5) for each sound effect
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXATK

The attack and decay are set in this table as follows: * Bits 0-3 = decay length * Bits 4-7 = attack length
.SFXATK EQUB $01 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB $09 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB $20 ; Sound 2 = sfxhit = Other ship exploding EQUB $08 ; Sound 3 = sfxexpl = We died / Collision EQUB $0C ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB $00 ; Sound 5 = sfxbeep = Short, high beep EQUB $63 ; Sound 6 = sfxboop = Long, low beep EQUB $18 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB $44 ; Sound 8 = sfxeng = This sound is not used EQUB $11 ; Sound 9 = sfxecm = E.C.M. on EQUB $00 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB $00 ; Sound 11 = sfxalas = Military lasers fired by us EQUB $44 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB $11 ; Sound 13 = sfxbomb = Energy bomb EQUB $18 ; Sound 14 = sfxtrib = Trumbles dying EQUB $09 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXSUS [Show more] Type: Variable Category: Sound Summary: The release length and sustain volume (SID+$6) for each sound effect
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXSUS

The release length and sustain volume are set in this table as follows: * Bits 0-3 = release length * Bits 4-7 = sustain volume
.SFXSUS EQUB $D1 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB $F1 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB $E5 ; Sound 2 = sfxhit = Other ship exploding EQUB $FB ; Sound 3 = sfxexpl = We died / Collision EQUB $DC ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB $F0 ; Sound 5 = sfxbeep = Short, high beep EQUB $F3 ; Sound 6 = sfxboop = Long, low beep EQUB $D8 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB $00 ; Sound 8 = sfxeng = This sound is not used EQUB $E1 ; Sound 9 = sfxecm = E.C.M. on EQUB $E1 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB $F1 ; Sound 11 = sfxalas = Military lasers fired by us EQUB $F4 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB $E3 ; Sound 13 = sfxbomb = Energy bomb EQUB $B0 ; Sound 14 = sfxtrib = Trumbles dying EQUB $A1 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXFRCH [Show more] Type: Variable Category: Sound Summary: The frequency change to be applied to each sound effect in each frame (as a signed number)
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXFRCH
.SFXFRCH EQUB 254 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB 254 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB 243 ; Sound 2 = sfxhit = Other ship exploding EQUB 255 ; Sound 3 = sfxexpl = We died / Collision EQUB 0 ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB 0 ; Sound 5 = sfxbeep = Short, high beep EQUB 0 ; Sound 6 = sfxboop = Long, low beep EQUB 68 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB 0 ; Sound 8 = sfxeng = This sound is not used EQUB 85 ; Sound 9 = sfxecm = E.C.M. on EQUB 254 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB 255 ; Sound 11 = sfxalas = Military lasers fired by us EQUB 239 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB 119 ; Sound 13 = sfxbomb = Energy bomb EQUB 123 ; Sound 14 = sfxtrib = Trumbles dying EQUB 254 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: SFXVCH [Show more] Type: Variable Category: Sound Summary: The volume change rate for each sound effect, i.e. how many frames need to pass before the sound effect's volume is reduced by one
Context: See this variable on its own page References: This variable is used as follows: * NOISE uses SFXVCH
.SFXVCH EQUB 3 ; Sound 0 = sfxplas = Pulse lasers fired by us EQUB 3 ; Sound 1 = sfxelas = Being hit by lasers 1 EQUB 3 ; Sound 2 = sfxhit = Other ship exploding EQUB 15 ; Sound 3 = sfxexpl = We died / Collision EQUB 15 ; Sound 4 = sfxwhosh = Missile launched / Ship launch EQUB 255 ; Sound 5 = sfxbeep = Short, high beep EQUB 255 ; Sound 6 = sfxboop = Long, low beep EQUB 31 ; Sound 7 = sfxhyp1 = Hyperspace drive engaged 1 EQUB 255 ; Sound 8 = sfxeng = This sound is not used EQUB 255 ; Sound 9 = sfxecm = E.C.M. on EQUB 3 ; Sound 10 = sfxblas = Beam lasers fired by us EQUB 3 ; Sound 11 = sfxalas = Military lasers fired by us EQUB 15 ; Sound 12 = sfxmlas = Mining lasers fired by us EQUB 255 ; Sound 13 = sfxbomb = Energy bomb EQUB 255 ; Sound 14 = sfxtrib = Trumbles dying EQUB 3 ; Sound 15 = sfxelas2 = Being hit by lasers 2
Name: COLD [Show more] Type: Subroutine Category: Loader Summary: Configure memory, set up interrupt handlers and configure the VIC-II, SID and CIA chips
Context: See this subroutine on its own page References: This subroutine is called as follows: * S% calls COLD
.COLD ; We start by zeroing three pages of memory from $0400 ; to $05FF, so that zeroes the following: ; ; * The UP from workspace $0400 to $0540 ; ; * The WP from workspace $0580 to $06FB ; ; So this initialises all the variables in the UP and WP ; workspaces LDA #4 ; Set the high byte of SC(1 0) to 4 STA SC+1 LDX #3 ; Set X = 3 to act as a page counter, so we zero three ; whole pages of memory LDA #0 ; Set A = 0 so we can use this to zero memory locations STA SC ; Set the low byte of SC(1 0) to zero, so SC is now set ; to $0400 TAY ; Set Y = 0 to act as a byte counter within each page .zerowksploop STA (SC),Y ; Zero the Y-th byte of SC(1 0) INY ; Increment the byte counter BNE zerowksploop ; Loop back until we have zeroed a whole page of memory INC SC+1 ; Increment the high byte of SC(1 0) to point to the ; next page in memory DEX ; Decrement the page counter in X BNE zerowksploop ; Loop back until we have zeroed all three pages LDA #LO(NMIpissoff) ; Set the NMI interrupt vector in NMIV to point to the STA NMIV ; NMIpissoff routine, which acknowledges NMI interrupts LDA #HI(NMIpissoff) ; and ignores them STA NMIV+1 LDA #LO(CHPR2) ; Set the CHRV interrupt vector in CHRV to point to the STA CHRV ; CHPR2 routine, which prints valid ASCII characters LDA #HI(CHPR2) ; using the CHPR routine (so this replaces the normal STA CHRV+1 ; text-printing routine with Elite's own CHPR routine) LDA #%101 ; Call SETL1 to set the 6510 input/output port to the JSR SETL1 ; following: ; ; * LORAM = 1 ; * HIRAM = 0 ; * CHAREN = 1 ; ; This sets the entire 64K memory map to RAM except for ; the I/O memory map at $D000-$DFFF, which gets mapped ; to registers in the VIC-II video controller chip, the ; SID sound chip, the two CIA I/O chips, and so on ; ; See the memory map at the top of page 264 in the ; Programmer's Reference Guide SEI ; Disable interrupts while we configure the VIC-II, CIA ; and SID chips and update the interrupt handlers IF NOT(USA%) ; We only include this code if USA% is FALSE ; ; It is designed to slow down PAL machines to match the ; speed of NTSC machines (though the GMA86 PAL version ; doesn't actually include this code) ; ; Specifically, it waits until raster line 256 + PALCK ; is reached before continuing LDA #PALCK ; Set A = PALCK, which contains the bottom byte of the ; the raster line that we want to wait for .UKCHK BIT VIC+$11 ; Loop back to UKCHK until bit 7 of VIC-II register $11 BPL UKCHK ; (control register 1) is set ; ; Bit 7 of register $11 contains the top bit of the ; current raster line (which is a 9-bit value), so this ; waits until the raster has reached at least line 256 CMP VIC+$12 ; Loop back to UKCHK until VIC-II register $12 equals BNE UKCHK ; PALCK ; ; VIC-II register $12 contains the bottom byte of the ; current raster line (which is a 9-bit value), and we ; only get here when the top bit of the raster line is ; set, so this waits until we have reached raster line ; 256 + PALCK ENDIF LDA #%00000011 ; Set CIA1 register $0D to enable and disable interrupts STA CIA+$D ; as follows: ; ; * Bit 0 set = configure interrupts generated by ; timer A underflow ; ; * Bit 1 set = configure interrupts generated by ; timer B underflow ; ; * Bits 2-4 clear = do not change configuration of ; other interrupts ; ; * Bit 7 clear = disable interrupts whose ; corresponding bits are set ; ; So this disables interrupts that are generated by ; timer A underflow and timer B underflow, while leaving ; other interrupts as they are STA CIA2+$D ; Set CIA2 register $0D to enable and disable interrupts ; as follows: ; ; * Bit 0 set = configure interrupts generated by ; timer A underflow ; ; * Bit 1 set = configure interrupts generated by ; timer B underflow ; ; * Bits 2-4 clear = do not change configuration of ; other interrupts ; ; * Bit 7 clear = disable interrupts whose ; corresponding bits are set ; ; So this disables interrupts that are generated by ; timer A underflow and timer B underflow, while leaving ; other interrupts as they are ;LDA #2 ; These instructions are commented out in the original ;STA VIC+$20 ; source LDA #%00001111 ; Set SID register $18 to control the sound as follows: STA SID+$18 ; ; * Bits 0-3: set the volume to 15 (maximum) ; ; * Bit 4 clear: disable the low-pass filter ; ; * Bit 5 clear: disable the bandpass filter ; ; * Bit 6 clear: disable the high-pass filter ; ; * Bit 7 clear: enable voice 3 LDX #0 ; Set the raster count to 0 to initialise the raster STX RASTCT ; effects in the COMIRQ handler (such as the split ; screen) INX ; Set bit 0 of VIC register $1A and clear bits 1-3 to STX VIC+$1A ; configure the following interrupts: ; ; * Bit 0 = enable raster interrupt ; ; * Bit 1 = disable sprite-background collision ; interrupt ; ; * Bit 2 = disable sprite-sprite collision interrupt ; ; * Bit 3 = disable light pen interrupt LDA VIC+$11 ; Clear bit 7 of VIC register $11, to clear the top bit AND #%01111111 ; of the raster line that generates the interrupt (as STA VIC+$11 ; the line number is a 9-bit value, with bits 0-7 in VIC ; register $12) LDA #40 ; Set VIC register $11 to 40, so along with bit 7 of VIC STA VIC+$12 ; register $10, this sets the raster interrupt to be ; generated when the raster reaches line 40 LDA l1 ; Set bits 0 to 2 of the 6510 port register at location AND #%11111000 ; l1 to %100 to set the input/output port to the ORA #%00000100 ; following: STA l1 ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; and return from the subroutine using a tail call ; ; This sets the entire 64K memory map to RAM ; ; See the memory map at the top of page 265 in the ; Programmer's Reference Guide LDA #%100 ; Set L1M to %100, so the default action of the SETL1 STA L1M ; routine will configure memory as above LDA #LO(NMIpissoff) ; Set the NMI interrupt service hardware vector at $FFFA STA $FFFA ; to point to the NMIpissoff routine, which acknowledges LDA #HI(NMIpissoff) ; NMI interrupts and ignores them STA $FFFB ; ; This ensures that even if the Kernal is not paged into ; memory, NMIs will be processed LDA #HI(COMIRQ1) ; Set the IRQ interrupt service hardware vector at $FFFE STA $FFFF ; to point to COMIRQ1, so it gets called to handle all LDA #LO(COMIRQ1) ; IRQ interrupts and BRK instructions (COMIRQ1 plays the STA $FFFE ; background music and manages the split screen) ; ; This ensures that even if the Kernal is not paged into ; memory, IRQs will be processed CLI ; Re-enable interrupts RTS ; Return from the subroutine
Name: NMIpissoff [Show more] Type: Subroutine Category: Loader Summary: Acknowledge NMI interrupts and ignore them
Context: See this subroutine on its own page References: This subroutine is called as follows: * COLD calls NMIpissoff
.NMIpissoff CLI ; Enable interrupts, so we acknowledge the NMI and ; basically ignore it RTI ; Return from the interrupt
Save ELTI.bin
PRINT "ELITE I" PRINT "Assembled at ", ~CODE_I% PRINT "Ends at ", ~P% PRINT "Code size is ", ~(P% - CODE_I%) PRINT "Execute at ", ~LOAD% PRINT "Reload at ", ~LOAD_I% PRINT "S.ELTI ", ~CODE_I%, " ", ~P%, " ", ~LOAD%, " ", ~LOAD_H% SAVE "3-assembled-output/ELTI.bin", CODE_I%, P%, LOAD%