CODE_F% = P% LOAD_F% = LOAD% + P% - CODE%ELITE F FILE Produces the binary file ELTF.bin that gets loaded by elite-checksum.py.IF _SOURCE_DISK .SWAPPZERO LDX #K3+1 ; This routine starts copying zero page from $0015 and ; up, using X as an index .SWPZL LDA ZP,X ; Swap the X-th byte of zero page with the X-th byte of LDY $CE00,X ; $CE00 STA $CE00,X STY ZP,X INX ; Increment the loop counter BNE SWPZL ; Loop back for the next byte RTS ; Return from the subroutine ENDIFName: SWAPPZERO (source disk variant) [Show more] Type: Subroutine Category: Utility routines Summary: A routine that swaps zero page with the page at $CE00, so that zero page changes made by Kernal functions can be reversedContext: See this subroutine on its own page References: No direct references to this subroutine in this source file.NOSPRITES 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 LDA #%00000000 ; Clear bits 0 to 7 of VIC register $15 to disable all STA VIC+$15 ; eight sprites 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 .UKCHK2 BIT VIC+$11 ; Loop back to UKCHK2 until bit 7 of VIC-II register $11 BPL UKCHK2 ; (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 UKCHK2 until VIC-II register $12 equals BNE UKCHK2 ; 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 #%100 ; Set A = %100 and fall through into SETL1 to set the ; 6510 input/output port to the following: ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; 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.SETL1 SEI ; Disable interrupts while we set the 6510 input/output ; port register STA L1M ; Store the new value of the port register in L1M 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 new values CLI ; Re-enable interrupts RTS ; Return from the subroutineName: SETL1 [Show more] Type: Subroutine Category: Utility routines Summary: Set the 6510 input/output port register to control the memory mapContext: See this subroutine on its own page References: This subroutine is called as follows: * COLD calls SETL1 * DKSANYKEY calls SETL1 * KERNALSETUP calls SETL1 * LOD calls SETL1 * Main flight loop (Part 15 of 16) calls SETL1 * MVTRIBS calls SETL1 * NOSPRITES calls SETL1 * PTCLS2 calls SETL1 * RDKEY calls SETL1 * SIGHT calls SETL1 * startbd calls SETL1 * stopbd calls SETL1 * SVE calls SETL1
See page 260 of the Programmer's Reference Guide for details on how the 6510 input/output port register works.
Arguments: A The new value of the input/output port register: * Bit 0 controls LORAM * Bit 1 controls HIRAM * Bit 2 controls CHAREN.L1M EQUB %100 ; By default, this sets the 6510 input/output port to ; the following: ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; This sets the entire 64K memory map to RAM ; ; See the memory map at the top of page 265 in the ; Programmer's Reference GuideName: L1M [Show more] Type: Variable Category: Utility routines Summary: Temporary storage for the new value of the 6510 input/output port register.KS3 LDA P ; After shuffling the ship slots, P(1 0) will point to STA SLSP ; the new bottom of the ship line heap, so store this in LDA P+1 ; SLSP(1 0), which stores the bottom of the heap STA SLSP+1 RTS ; Return from the subroutineName: KS3 [Show more] Type: Subroutine Category: Universe Summary: Set the SLSP ship line heap pointer after shuffling ship slotsContext: See this subroutine on its own page References: This subroutine is called as follows: * KS2 calls KS3
The final part of the KILLSHP routine, called after we have shuffled the ship slots and sorted out our missiles. This simply sets SLSP to the new bottom of the ship line heap.
Arguments: P(1 0) Points to the ship line heap of the ship in the last occupied slot (i.e. it points to the bottom of the descending heap).KS1 LDX XSAV ; Store the current ship's slot number in XSAV JSR KILLSHP ; Call KILLSHP to remove the ship in slot X from our ; local bubble of universe LDX XSAV ; Restore the current ship's slot number from XSAV, ; which now points to the next ship in the bubble JMP MAL1 ; Jump to MAL1 to rejoin the main flight loop at the ; start of the ship analysis loopName: KS1 [Show more] Type: Subroutine Category: Universe Summary: Remove the current ship from our local bubble of universeContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 12 of 16) calls KS1
Part 12 of the main flight loop calls this routine to remove the ship that is currently being analysed by the flight loop. Once the ship is removed, it jumps back to MAL1 to rejoin the main flight loop, with X pointing to the same slot that we just cleared (and which now contains the next ship in the local bubble of universe).
Arguments: XX0 The address of the blueprint for this ship INF The address of the data block for this ship.KS4 JSR ZINF ; Call ZINF to reset the INWK ship workspace JSR FLFLLS ; Reset the LSO block, returns with A = 0 STA FRIN+1 ; Set the second slot in the FRIN table to 0, which ; sets this slot to empty, so when we call NWSHP below ; the new sun that gets created will go into FRIN+1 STA SSPR ; Set the "space station present" flag to 0, as we are ; no longer in the space station's safe zone JSR SPBLB ; Call SPBLB to redraw the space station bulb, which ; will erase it from the dashboard LDA #6 ; Set the sun's y_sign to 6 STA INWK+5 LDA #129 ; Set A = 129, the ship type for the sun JMP NWSHP ; Call NWSHP to set up the sun's data block and add it ; to FRIN, where it will get put in the second slot as ; we just cleared out the second slot, and the first ; slot is already taken by the planetName: KS4 [Show more] Type: Subroutine Category: Universe Summary: Remove the space station and replace it with the sunContext: See this subroutine on its own page References: This subroutine is called as follows: * KILLSHP calls KS4.KS2 LDX #$FF ; We want to go through the ships in our local bubble ; and pick out all the missiles, so set X to $FF to ; use as a counter .KSL4 INX ; Increment the counter (so it starts at 0 on the first ; iteration) LDA FRIN,X ; If slot X is empty then we have worked our way through BEQ KS3 ; all the slots, so jump to KS3 to stop looking CMP #MSL ; If the slot does not contain a missile, loop back to BNE KSL4 ; KSL4 to check the next slot ; We have found a slot containing a missile, so now we ; want to check whether it has target lock TXA ; Set Y = X * 2 and fetch the Y-th address from UNIV ASL A ; and store it in SC and SC+1 - in other words, set TAY ; SC(1 0) to point to the missile's ship data block LDA UNIV,Y STA SC LDA UNIV+1,Y STA SC+1 LDY #32 ; Fetch byte #32 from the missile's ship data (AI) LDA (SC),Y BPL KSL4 ; If bit 7 of byte #32 is clear, then the missile is ; dumb and has no AI, so loop back to KSL4 to move on ; to the next slot AND #%01111111 ; Otherwise this missile has AI, so clear bit 7 and LSR A ; shift right to set the C flag to the missile's "is ; locked" flag, and A to the target's slot number CMP XX4 ; If this missile's target is less than XX4, then the BCC KSL4 ; target's slot isn't being shuffled down, so jump to ; KSL4 to move on to the next slot BEQ KS6 ; If this missile was locked onto the ship that we just ; removed in KILLSHP, jump to KS6 to stop the missile ; from continuing to hunt it down SBC #1 ; Otherwise this missile is locked and has AI enabled, ; and its target will have moved down a slot, so ; subtract 1 from the target number (we know C is set ; from the BCC above) ASL A ; Shift the target number left by 1, so it's in bits ; 1-6 once again, and also set bit 0 to 1, as the C ; flag is still set, so this makes sure the missile is ; still set to being locked ORA #%10000000 ; Set bit 7, so the missile's AI is enabled STA (SC),Y ; Update the missile's AI flag to the value in A BNE KSL4 ; Loop back to KSL4 to move on to the next slot (this ; BNE is effectively a JMP as A will never be zero) .KS6 LDA #0 ; The missile's target lock just got removed, so set the STA (SC),Y ; AI flag to 0 to make it dumb and not locked BEQ KSL4 ; Loop back to KSL4 to move on to the next slot (this ; BEQ is effectively a JMP as A is always zero)Name: KS2 [Show more] Type: Subroutine Category: Universe Summary: Check the local bubble for missiles with target lockContext: See this subroutine on its own page References: This subroutine is called as follows: * KILLSHP calls KS2
Check the local bubble of universe to see if there are any missiles with target lock in the vicinity. If there are, then check their targets; if we just removed their target in the KILLSHP routine, then switch off their AI so they just drift in space, otherwise update their targets to reflect the newly shuffled slot numbers. This is called from KILLSHP once the slots have been shuffled down, following the removal of a ship.
Arguments: XX4 The slot number of the ship we removed just before calling this routine.KILLSHP STX XX4 ; Store the slot number of the ship to remove in XX4 LDA MSTG ; Check whether this slot matches the slot number in CMP XX4 ; MSTG, which is the target of our missile lock BNE KS5 ; If our missile is not locked on this ship, jump to KS5 LDY #GREEN2 ; Otherwise we need to remove our missile lock, so call JSR ABORT ; ABORT to disarm the missile and update the missile ; indicators on the dashboard to green (Y = #GREEN2) LDA #200 ; Print recursive token 40 ("TARGET LOST") as an JSR MESS ; in-flight message .KS5 LDY XX4 ; Restore the slot number of the ship to remove into Y LDX FRIN,Y ; Fetch the contents of the slot, which contains the ; ship type CPX #SST ; If this is the space station, then jump to KS4 to BEQ KS4 ; replace the space station with the sun CPX #CON ; Did we just kill the Constrictor from mission 1? If BNE lll ; not, jump to lll LDA TP ; We just killed the Constrictor from mission 1, so set ORA #%00000010 ; bit 1 of TP to indicate that we have successfully STA TP ; completed mission 1 INC TALLY+1 ; Award 256 kill points for killing the Constrictor .lll CPX #HER ; Did we just kill a rock hermit? If we did, jump to BEQ blacksuspenders ; blacksuspenders to decrease the junk count CPX #JL ; If JL <= X < JH, i.e. the type of ship we killed in X BCC KS7 ; is junk (escape pod, alloy plate, cargo canister, CPX #JH ; asteroid, splinter, Shuttle or Transporter), then keep BCS KS7 ; going, otherwise jump to KS7 .blacksuspenders DEC JUNK ; We just killed junk, so decrease the junk counter .KS7 DEC MANY,X ; Decrease the number of this type of ship in our little ; bubble, which is stored in MANY+X (where X is the ship ; type) LDX XX4 ; Restore the slot number of the ship to remove into X ; We now want to remove this ship and reclaim all the ; memory that it uses. Removing the ship will leave a ; gap in three places, which we need to close up: ; ; * The ship slots in FRIN ; ; * The ship data blocks in K% ; ; * The descending ship line heap at WP down ; ; The rest of this routine closes up these gaps by ; looping through all the occupied ship slots after the ; slot we are removing, one by one, and shuffling each ; ship's slot, data block and line heap down to close ; up the gaps left by the removed ship. As part of this, ; we have to make sure we update any address pointers ; so they point to the newly shuffled data blocks and ; line heaps ; ; In the following, when shuffling a ship's data down ; into the preceding empty slot, we call the ship that ; we are shuffling down the "source", and we call the ; empty slot we are shuffling it into the "destination" ; ; Before we start looping through the ships we need to ; shuffle down, we need to set up some variables to ; point to the source and destination line heaps LDY #5 ; Fetch byte #5 of the removed ship's blueprint into A, LDA (XX0),Y ; which gives the ship's maximum heap size for the ship ; we are removing (i.e. the size of the gap in the heap ; created by the ship removal) ; INF currently contains the ship data for the ship we ; are removing, and INF(34 33) contains the address of ; the bottom of the ship's heap, so we can calculate ; the address of the top of the heap by adding the heap ; size to this address LDY #33 ; First we add A and the address in INF+33, to get the CLC ; low byte of the top of the heap, which we store in P ADC (INF),Y STA P INY ; And next we add A and the address in INF+34, with any LDA (INF),Y ; carry from the previous addition, to get the high byte ADC #0 ; of the top of the heap, which we store in P+1, so STA P+1 ; P(1 0) points to the top of this ship's heap ; Now, we're ready to start looping through the ships ; we want to move, moving the slots, data blocks and ; line heap from the source to the destination. In the ; following, we set up SC to point to the source data, ; and INF (which currently points to the removed ship's ; data that we can now overwrite) points to the ; destination ; ; So P(1 0) now points to the top of the line heap for ; the destination .KSL1 INX ; On entry, X points to the empty slot we want to ; shuffle the next ship into (the destination), so ; this increment points X to the next slot - i.e. the ; source slot we want to shuffle down LDA FRIN,X ; Copy the contents of the source slot into the STA FRIN-1,X ; destination slot BNE P%+5 ; If the slot we just shuffled down is not empty, then ; skip the following instruction JMP KS2 ; The source slot is empty and we are done shuffling, ; so jump to KS2 to move on to processing missiles ASL A ; Otherwise we have a source ship to shuffle down into TAY ; the destination, so set Y = A * 2 so it can act as an ; index into the two-byte ship blueprint lookup table ; at XX21 for the source ship LDA XX21-2,Y ; Set SC(0 1) to point to the blueprint data for the STA SC ; source ship LDA XX21-1,Y STA SC+1 LDY #5 ; Fetch blueprint byte #5 for the source ship, which LDA (SC),Y ; gives us its maximum heap size, and store it in T STA T ; We now subtract T from P(1 0), so P(1 0) will point to ; the bottom of the line heap for the destination ; (which we will use later when closing up the gap in ; the heap space) LDA P ; First, we subtract the low bytes SEC SBC T STA P LDA P+1 ; And then we do the high bytes, for which we subtract SBC #0 ; 0 to include any carry, so this is effectively doing STA P+1 ; P(1 0) = P(1 0) - (0 T) ; Next, we want to set SC(1 0) to point to the source ; ship's data block TXA ; Set Y = X * 2 so it can act as an index into the ASL A ; two-byte lookup table at UNIV, which contains the TAY ; addresses of the ship data blocks. In this case we are ; multiplying X by 2, and X contains the source ship's ; slot number so Y is now an index for the source ship's ; entry in UNIV LDA UNIV,Y ; Set SC(1 0) to the address of the data block for the STA SC ; source ship LDA UNIV+1,Y STA SC+1 ; We have now set up our variables as follows: ; ; SC(1 0) points to the source's ship data block ; ; INF(1 0) points to the destination's ship data block ; ; P(1 0) points to the destination's line heap ; ; so let's start copying data from the source to the ; destination LDY #36 ; We are going to be using Y as a counter for the 37 ; bytes of ship data we want to copy from the source ; to the destination, so we set it to 36 to start things ; off, and will decrement Y for each byte we copy LDA (SC),Y ; Fetch byte #36 of the source's ship data block at SC, STA (INF),Y ; and store it in byte #36 of the destination's block DEY ; at INF, so that's the ship's NEWB flags copied from ; the source to the destination. One down, quite a few ; to go... LDA (SC),Y ; Fetch byte #35 of the source's ship data block at SC, STA (INF),Y ; and store it in byte #35 of the destination's block ; at INF, so that's the ship's energy copied from the ; source to the destination DEY ; Fetch byte #34 of the source ship, which is the LDA (SC),Y ; high byte of the source ship's line heap, and store STA K+1 ; in K+1 LDA P+1 ; Set the low byte of the destination's heap pointer STA (INF),Y ; to P+1 DEY ; Fetch byte #33 of the source ship, which is the LDA (SC),Y ; low byte of the source ship's heap, and store in K STA K ; so now we have the following: ; ; K(1 0) points to the source's line heap LDA P ; Set the low byte of the destination's heap pointer STA (INF),Y ; to P, so now the destination's heap pointer is to ; P(1 0), so that's the heap pointer in bytes #33 and ; #34 done DEY ; Luckily, we can just copy the rest of the source's ; ship data block into the destination, as there are no ; more address pointers, so first we decrement our ; counter in Y to point to the next byte (the AI flag) ; in byte #32) and then start looping .KSL2 ;DEY ; This instruction is commented out in the original ; source LDA (SC),Y ; Copy the Y-th byte of the source to the Y-th byte of STA (INF),Y ; the destination ;TYA ; This instruction is commented out in the original ; source DEY ; Decrement the counter BPL KSL2 ; Loop back to KSL2 to copy the next byte until we have ; copied the whole block ; We have now shuffled the ship's slot and the ship's ; data block, so we only have the heap data itself to do LDA SC ; First, we copy SC into INF, so when we loop round STA INF ; again, INF will correctly point to the destination for LDA SC+1 ; the next iteration STA INF+1 LDY T ; Now we want to move the contents of the heap, as all ; we did above was to update the pointers, so first ; we set a counter in Y that is initially set to T ; (which we set above to the maximum heap size for the ; source ship) ; ; As a reminder, we have already set the following: ; ; K(1 0) points to the source's line heap ; ; P(1 0) points to the destination's line heap ; ; so we can move the heap data by simply copying the ; correct number of bytes from K(1 0) to P(1 0) .KSL3 DEY ; Decrement the counter LDA (K),Y ; Copy the Y-th byte of the source heap at K(1 0) to STA (P),Y ; the destination heap at P(1 0) TYA ; Loop back to KSL3 to copy the next byte, until we BNE KSL3 ; have done them all BEQ KSL1 ; We have now shuffled everything down one slot, so ; jump back up to KSL1 to see if there is another slot ; that needs shuffling down (this BEQ is effectively a ; JMP as A will always be zero)Name: KILLSHP [Show more] Type: Subroutine Category: Universe Summary: Remove a ship from our local bubble of universeContext: See this subroutine on its own page References: This subroutine is called as follows: * KS1 calls KILLSHP
Remove the ship in slot X from our local bubble of universe. This happens when we kill a ship, collide with a ship and destroy it, or when a ship moves outside our local bubble. We also use this routine when we move out of range of the space station, in which case we replace it with the sun. When removing a ship, this creates a gap in the ship slots at FRIN, so we shuffle all the later slots down to close the gap. We also shuffle the ship data blocks at K% and ship line heap at WP, to reclaim all the memory that the removed ship used to occupy.
Arguments: X The slot number of the ship to remove XX0 The address of the blueprint for the ship to remove INF The address of the data block for the ship to remove.THERE LDX GCNT ; Set X = GCNT - 1 DEX BNE THEX ; If X is non-zero (i.e. GCNT is not 1, so we are not in ; the second galaxy), then jump to THEX LDA QQ0 ; Set A = the current system's galactic x-coordinate CMP #144 ; If A <> 144 then jump to THEX BNE THEX LDA QQ1 ; Set A = the current system's galactic y-coordinate CMP #33 ; If A = 33 then set the C flag BEQ THEX+1 ; If A = 33 then jump to THEX+1, so we return from the ; subroutine with the C flag set (otherwise we clear the ; C flag with the next instruction) .THEX CLC ; Clear the C flag RTS ; Return from the subroutineName: THERE [Show more] Type: Subroutine Category: Missions Summary: Check whether we are in the Constrictor's system in mission 1Context: See this subroutine on its own page References: This subroutine is called as follows: * Main game loop (Part 4 of 6) calls THERE
The stolen Constrictor is the target of mission 1. We finally track it down to the Orarra system in the second galaxy, which is at galactic coordinates (144, 33). This routine checks whether we are in this system and sets the C flag accordingly.
Returns: C flag Set if we are in the Constrictor system, otherwise clear.RESET JSR ZERO ; Reset the ship slots for the local bubble of universe, ; and various flight and ship status variables LDX #6 ; Set up a counter for zeroing BETA through BETA+6 .SAL3 STA BETA,X ; Zero the X-th byte after BETA DEX ; Decrement the loop counter BPL SAL3 ; Loop back for the next byte to zero TXA ; X is now negative - i.e. $FF - so this sets A and QQ12 STA QQ12 ; to $FF to indicate we are docked LDX #2 ; We're now going to recharge both shields and the ; energy bank, which live in the three bytes at FSH, ; ASH (FSH+1) and ENERGY (FSH+2), so set a loop counter ; in X for 3 bytes .REL5 STA FSH,X ; Set the X-th byte of FSH to $FF to charge up that ; shield/bank DEX ; Decrement the loop counter BPL REL5 ; Loop back to REL5 until we have recharged both shields ; and the energy bank ; Fall through into RES2 to reset the stardust and ship ; workspace at INWKName: RESET [Show more] Type: Subroutine Category: Start and end Summary: Reset most variablesContext: See this subroutine on its own page References: This subroutine is called as follows: * TITLE calls RESET * TT170 calls RESET
Reset our ship and various controls, recharge shields and energy, and then fall through into RES2 to reset the stardust and the ship workspace at INWK. In this subroutine, this means zero-filling the following locations: * Pages $9, $A, $B, $C and $D * BETA to BETA+6, which covers the following: * BETA, BET1 - Set pitch to 0 * XC, YC - Set text cursor to (0, 0) * QQ22 - Set hyperspace counters to 0 * ECMA - Turn E.C.M. off It also sets QQ12 to $FF, to indicate we are docked, recharges the shields and energy banks, and then falls through into RES2..RES2 JSR stopbd ; Stop playing the docking music (if it is playing) LDA BOMB ; If the energy bomb has been set off, then BOMB will be BPL BOMBOK ; negative, so this skips the following instructions if ; our energy bomb is not going off JSR BOMBOFF ; Switch off the energy bomb effect STA BOMB ; The call to BOMBOFF sets A = 0, so this zeroes BOMB to ; switch off the energy bomb explosion .BOMBOK LDA #NOST ; Reset NOSTM, the number of stardust particles, to the STA NOSTM ; maximum allowed (20) LDX #$FF ; Reset LSX2 and LSY2, the ball line heaps used by the STX LSX2 ; BLINE routine for drawing circles, to $FF, to set the STX LSY2 ; heap to empty STX MSTG ; Reset MSTG, the missile target, to $FF (no target) LDA #128 ; Set the current pitch rate to the mid-point, 128 STA JSTY STA ALP2 ; Reset ALP2 (roll sign) and BET2 (pitch sign) STA BET2 ; to negative, i.e. pitch and roll negative ASL A ; This sets A to 0 STA BETA ; Reset BETA (pitch angle alpha) to 0 STA BET1 ; Reset BET1 (magnitude of the pitch angle) to 0 STA ALP2+1 ; Reset ALP2+1 (flipped roll sign) and BET2+1 (flipped STA BET2+1 ; pitch sign) to positive, i.e. pitch and roll negative STA MCNT ; Reset MCNT (the main loop counter) to 0 STA TRIBCT ; Reset TRIBCT (the Trumbles counter) to 0 LDA #3 ; Reset DELTA (speed) to 3 STA DELTA STA ALPHA ; Reset ALPHA (roll angle alpha) to 3 STA ALP1 ; Reset ALP1 (magnitude of roll angle alpha) to 3 LDA #$10 ; Switch the text colour to white STA COL2 LDA #0 ; Set dontclip to 0 to enable line-clipping in the LL145 STA dontclip ; routine, as we only disable this for the Short-range ; Chart LDA #2*Y-1 ; Set Yx2M1 to the number of pixel lines in the space STA Yx2M1 ; view LDA SSPR ; Fetch the "space station present" flag, and if we are BEQ P%+5 ; not inside the safe zone, skip the next instruction JSR SPBLB ; Light up the space station bulb on the dashboard LDA ECMA ; Fetch the E.C.M. status flag, and if E.C.M. is off, BEQ yu ; skip the next instruction JSR ECMOF ; Turn off the E.C.M. sound .yu JSR WPSHPS ; Wipe all ships from the scanner JSR ZERO ; Reset the ship slots for the local bubble of universe, ; and various flight and ship status variables LDA #LO(LS%) ; We have reset the ship line heap, so we now point STA SLSP ; SLSP to LS% (the byte below the ship blueprints at D%) LDA #HI(LS%) ; to indicate that the heap is empty STA SLSP+1 ; Finally, fall through into ZINF to reset the INWK ; ship workspaceName: RES2 [Show more] Type: Subroutine Category: Start and end Summary: Reset a number of flight variables and workspacesContext: See this subroutine on its own page References: This subroutine is called as follows: * DEATH calls RES2 * DEATH2 calls RES2 * DOENTRY calls RES2 * ESCAPE calls RES2 * MJP calls RES2 * TT110 calls RES2 * TT18 calls RES2
This is called after we launch from a space station, arrive in a new system after hyperspace, launch an escape pod, or die a cold, lonely death in the depths of space.
Returns: Y Y is set to $FF.ZINF LDY #NI%-1 ; There are NI% bytes in the INWK workspace, so set a ; counter in Y so we can loop through them LDA #0 ; Set A to 0 so we can zero-fill the workspace .ZI1 STA INWK,Y ; Zero the Y-th byte of the INWK workspace DEY ; Decrement the loop counter BPL ZI1 ; Loop back for the next byte, ending when we have ; zero-filled the last byte at INWK, which leaves Y ; with a value of $FF ; Finally, we reset the orientation vectors as follows: ; ; sidev = (1, 0, 0) ; roofv = (0, 1, 0) ; nosev = (0, 0, -1) ; ; 96 * 256 ($6000) represents 1 in the orientation ; vectors, while -96 * 256 ($E000) represents -1. We ; already set the vectors to zero above, so we just ; need to set up the high bytes of the diagonal values ; and we're done. The negative nosev makes the ship ; point towards us, as the z-axis points into the screen LDA #96 ; Set A to represent a 1 (in vector terms) STA INWK+18 ; Set byte #18 = roofv_y_hi = 96 = 1 STA INWK+22 ; Set byte #22 = sidev_x_hi = 96 = 1 ORA #%10000000 ; Flip the sign of A to represent a -1 STA INWK+14 ; Set byte #14 = nosev_z_hi = -96 = -1 RTS ; Return from the subroutineName: ZINF [Show more] Type: Subroutine Category: Universe Summary: Reset the INWK workspace and orientation vectors Deep dive: Orientation vectorsContext: See this subroutine on its own page References: This subroutine is called as follows: * BRIEF calls ZINF * DOKEY calls ZINF * FRS1 calls ZINF * KS4 calls ZINF * Main game loop (Part 2 of 6) calls ZINF * SOLAR calls ZINF * Ze calls ZINF
Zero-fill the INWK ship workspace and reset the orientation vectors, with nosev pointing out of the screen, towards us.
Returns: Y Y is set to $FF.msblob LDX #4 ; Set up a loop counter in X to count through all four ; missile indicators .ss CPX NOMSL ; If the counter is equal to the number of missiles, BEQ SAL8 ; jump down to SAL8 to draw the remaining missiles, as ; the rest of them are present and should be drawn in ; green LDY #BLACK2 ; Draw the missile indicator at position X in black JSR MSBAR DEX ; Decrement the counter to point to the next missile BNE ss ; Loop back to ss if we still have missiles to draw RTS ; Return from the subroutine .SAL8 LDY #GREEN2 ; Draw the missile indicator at position X in green JSR MSBAR DEX ; Decrement the counter to point to the next missile BNE SAL8 ; Loop back to SAL8 if we still have missiles to draw RTS ; Return from the subroutineName: msblob [Show more] Type: Subroutine Category: Dashboard Summary: Display the dashboard's missile indicators in greenContext: See this subroutine on its own page References: This subroutine is called as follows: * BR1 (Part 2 of 2) calls msblob * EQSHP calls msblob * SOS1 calls msblob
Display the dashboard's missile indicators, with all the missiles reset to green (i.e. not armed or locked)..me2 LDA QQ11 ; If this is not the space view, jump down to clynsneed BNE clynsneed ; to skip displaying the in-flight message LDA MCH ; Fetch the token number of the current message into A JSR MESS ; Call MESS to print the token, which will remove it ; from the screen as printing uses EOR logic LDA #0 ; Set the delay in DLY to 0, so any new in-flight STA DLY ; messages will be shown instantly JMP me3 ; Jump back into the main spawning loop at me3 .clynsneed JSR CLYNS ; Clear the bottom three text rows of the upper screen, ; and move the text cursor to the first cleared row JMP me3 ; Jump back into the main spawning loop at me3Name: me2 [Show more] Type: Subroutine Category: Flight Summary: Remove an in-flight message from the space viewContext: See this subroutine on its own page References: This subroutine is called as follows: * Main game loop (Part 2 of 6) calls me2.Ze JSR ZINF ; Call ZINF to reset the INWK ship workspace JSR DORND ; Set A and X to random numbers STA T1 ; Store A in T1 AND #%10000000 ; Extract the sign of A and store in x_sign STA INWK+2 TXA ; Extract the sign of X and store in y_sign AND #%10000000 STA INWK+5 LDA #25 ; Set x_hi = y_hi = z_hi = 25, a fair distance away STA INWK+1 STA INWK+4 STA INWK+7 TXA ; Set the C flag if X >= 245 (4% chance) CMP #245 ROL A ; Set bit 0 of A to the C flag (i.e. there's a 4% ; chance of this ship having E.C.M.) ORA #%11000000 ; Set bits 6 and 7 of A, so the ship is hostile (bit 6 ; and has AI (bit 7) STA INWK+32 ; Store A in the AI flag of this ship ; Fall through into DORND2 to set A, X and the C flag ; randomlyName: Ze [Show more] Type: Subroutine Category: Universe Summary: Initialise the INWK workspace to a hostile ship Deep dive: Fixing ship positionsContext: See this subroutine on its own page References: This subroutine is called as follows: * DEATH calls Ze * GTHG calls Ze * Main game loop (Part 3 of 6) calls Ze * Main game loop (Part 4 of 6) calls Ze
Specifically, this routine does the following: * Reset the INWK ship workspace * Set the ship to a fair distance away in all axes, in front of us but randomly up or down, left or right * Give the ship a 4% chance of having E.C.M. * Set the ship to hostile, with AI enabled This routine also sets A, X, T1 and the C flag to random values. Note that because this routine uses the value of X returned by DORND, and X contains the value of A returned by the previous call to DORND, this routine does not necessarily set the new ship to a totally random location. See the deep dive on "Fixing ship positions" for details..DORND2 CLC ; Clear the C flag so the value of the C flag on entry ; doesn't affect the outcome .DORND LDA RAND ; Calculate the next two values f2 and f3 in the feeder ROL A ; sequence: TAX ; ADC RAND+2 ; * f2 = (f1 << 1) mod 256 + C flag on entry STA RAND ; * f3 = f0 + f2 + (1 if bit 7 of f1 is set) STX RAND+2 ; * C flag is set according to the f3 calculation LDA RAND+1 ; Calculate the next value m2 in the main sequence: TAX ; ADC RAND+3 ; * A = m2 = m0 + m1 + C flag from feeder calculation STA RAND+1 ; * X = m1 STX RAND+3 ; * C and V flags set according to the m2 calculation RTS ; Return from the subroutineName: DORND [Show more] Type: Subroutine Category: Maths (Arithmetic) Summary: Generate random numbers Deep dive: Generating random numbers Fixing ship positionsContext: See this subroutine on its own page References: This subroutine is called as follows: * DEATH calls DORND * DETOK2 calls DORND * ESCAPE calls DORND * GVL calls DORND * LASLI calls DORND * LL9 (Part 1 of 12) calls DORND * Main flight loop (Part 8 of 16) calls DORND * Main flight loop (Part 11 of 16) calls DORND * Main game loop (Part 1 of 6) calls DORND * Main game loop (Part 2 of 6) calls DORND * Main game loop (Part 4 of 6) calls DORND * Main game loop (Part 5 of 6) calls DORND * MT18 calls DORND * MVTRIBS calls DORND * nWq calls DORND * OUCH calls DORND * SFS1 calls DORND * SOLAR calls DORND * SPIN calls DORND * STARS1 calls DORND * STARS2 calls DORND * STARS6 calls DORND * SUN (Part 3 of 4) calls DORND * TACTICS (Part 1 of 7) calls DORND * TACTICS (Part 2 of 7) calls DORND * TACTICS (Part 3 of 7) calls DORND * TACTICS (Part 4 of 7) calls DORND * TACTICS (Part 5 of 7) calls DORND * TACTICS (Part 7 of 7) calls DORND * TT18 calls DORND * TT210 calls DORND * Ze calls DORND * PTCLS2 calls via DORND2
Set A and X to random numbers (though note that X is set to the random number that was returned in A the last time DORND was called). The C and V flags are also set randomly. If we want to generate a repeatable sequence of random numbers, when generating explosion clouds, for example, then we call DORND2 to ensure that the value of the C flag on entry doesn't affect the outcome, as otherwise we might not get the same sequence of numbers if the C flag changes.
Other entry points: DORND2 Make sure the C flag doesn't affect the outcome.MTT4 JSR DORND ; Set A and X to random numbers LSR A ; Clear bit 7 of our random number in A and set the C ; flag to bit 0 of A, which is random STA INWK+32 ; Store this in the ship's AI flag, so this ship does ; not have AI STA INWK+29 ; Store A in the ship's roll counter, giving it a ; clockwise roll (as bit 7 is clear), and a 1 in 127 ; chance of it having no damping ROL INWK+31 ; Set bit 0 of the ship's missile count randomly (as the ; C flag was set), giving the ship either no missiles or ; one missile AND #31 ; Set the ship speed to our random number, set to a ORA #16 ; minimum of 16 and a maximum of 31 STA INWK+27 JSR DORND ; Set A and X to random numbers, plus the C flag BMI nodo ; If A is negative (50% chance), jump to nodo to skip ; the following ; If we get here then we are going to spawn a ship that ; is minding its own business and trying to dock LDA INWK+32 ; Set bits 6 and 7 of the ship's AI flag, to make it ORA #%11000000 ; aggressive if attacked, and enable its AI STA INWK+32 LDX #%00010000 ; Set bit 4 of the ship's NEWB flags, to indicate that STX NEWB ; this ship is docking .nodo AND #2 ; If we jumped here with a random value of A from the ; BMI above, then this reduces A to a random value of ; either 0 or 2; if we didn't take the BMI and made the ; ship hostile, then A will be 0 ADC #CYL ; Set A = A + C + #CYL ; ; where A is 0 or 2 and C is 0 or 1, so this gives us a ; ship type from the following: Cobra Mk III, Python, ; Boa or Anaconda CMP #HER ; If A is now the ship type of a rock hermit, jump to BEQ TT100 ; TT100 to skip the following instruction JSR NWSHP ; Add a new ship of type A to the local bubble and fall ; through into the main game loop againName: Main game loop (Part 1 of 6) [Show more] Type: Subroutine Category: Main loop Summary: Spawn a trader (a Cobra Mk III, Python, Boa or Anaconda) Deep dive: Program flow of the main game loop Ship data blocksContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
This is part of the main game loop. This is where the core loop of the game lives, and it's in two parts. The shorter loop (just parts 5 and 6) is iterated when we are docked, while the entire loop from part 1 to 6 iterates if we are in space. This section covers the following: * Spawn a trader, i.e. a Cobra Mk III, Python, Boa or Anaconda, with a 50% chance of it having a missile, a 50% chance of it having an E.C.M., a 50% chance of it docking and being aggressive if attacked, a speed between 16 and 31, and a gentle clockwise roll We call this from within the main loop..TT100 JSR M% ; Call M% to iterate through the main flight loop DEC DLY ; Decrement the delay counter in DLY, so any in-flight ; messages get removed once the counter reaches zero BEQ me2 ; If DLY is now 0, jump to me2 to remove any in-flight ; message from the space view, and once done, return to ; me3 below, skipping the following two instructions BPL me3 ; If DLY is positive, jump to me3 to skip the next ; instruction INC DLY ; If we get here, DLY is negative, so we have gone too ; and need to increment DLY back to 0 .me3 DEC MCNT ; Decrement the main loop counter in MCNT BEQ P%+5 ; If the counter has reached zero, which it will do ; every 256 main loops, skip the next JMP instruction ; (or to put it another way, if the counter hasn't ; reached zero, jump down to MLOOP, skipping all the ; following checks) .ytq JMP MLOOP ; Jump down to MLOOP to do some end-of-loop tidying and ; restart the main loop ; We only get here once every 256 iterations of the ; main loop. If we aren't in witchspace and don't ; already have 3 or more asteroids in our local bubble, ; then this section has a 13% chance of spawning ; something benign (the other 87% of the time we jump ; down to consider spawning cops, pirates and bounty ; hunters) ; ; If we are in that 13%, then 50% of the time this will ; be a Cobra Mk III trader, and the other 50% of the ; time it will either be an asteroid (98.5% chance) or, ; very rarely, a cargo canister (1.5% chance) LDA MJ ; If we are in witchspace following a mis-jump, skip the BNE ytq ; following by jumping down to MLOOP (via ytq above) JSR DORND ; Set A and X to random numbers CMP #35 ; If A >= 35 (87% chance), jump down to MTT1 to skip BCS MTT1 ; the spawning of an asteroid or cargo canister and ; potentially spawn something else LDA JUNK ; If we already have 3 or more bits of junk in the local CMP #3 ; bubble, jump down to MTT1 to skip the following and BCS MTT1 ; potentially spawn something else JSR ZINF ; Call ZINF to reset the INWK ship workspace LDA #38 ; Set z_hi = 38 (far away) STA INWK+7 JSR DORND ; Set A, X and C flag to random numbers STA INWK ; Set x_lo = random STX INWK+3 ; Set y_lo = random ; ; Note that because we use the value of X returned by ; DORND, and X contains the value of A returned by the ; previous call to DORND, this does not set the new ship ; to a totally random location. See the deep dive on ; "Fixing ship positions" for details AND #%10000000 ; Set x_sign = bit 7 of x_lo STA INWK+2 TXA ; Set y_sign = bit 7 of y_lo AND #%10000000 STA INWK+5 ROL INWK+1 ; Set bit 1 of x_hi to the C flag, which is random, so ROL INWK+1 ; this randomly moves us off-centre by 512 (as if x_hi ; is %00000010, then (x_hi x_lo) is 512 + x_lo) JSR DORND ; Set A, X and V flag to random numbers BVS MTT4 ; If V flag is set (50% chance), jump up to MTT4 to ; spawn a trader ORA #%01101111 ; Take the random number in A and set bits 0-3 and 5-6, STA INWK+29 ; so the result has a 50% chance of being positive or ; negative, and a 50% chance of bits 0-6 being 127. ; Storing this number in the roll counter therefore ; gives our new ship a fast roll speed with a 50% ; chance of having no damping, plus a 50% chance of ; rolling clockwise or anti-clockwise LDA SSPR ; If we are inside the space station safe zone, jump BNE MTT1 ; down to MTT1 to skip the following and potentially ; spawn something else TXA ; Set A to the random X we set above, which we haven't BCS MTT2 ; used yet, and if the C flag is set (50% chance) jump ; down to MTT2 to skip the following AND #31 ; Set the ship speed to our random number, set to a ORA #16 ; minimum of 16 and a maximum of 31 STA INWK+27 BCC MTT3 ; Jump down to MTT3, skipping the following (this BCC ; is effectively a JMP as we know the C flag is clear, ; having passed through the BCS above) .MTT2 ORA #%01111111 ; Set bits 0-6 of A to 127, leaving bit 7 as random, so STA INWK+30 ; storing this number in the pitch counter means we have ; full pitch with no damping, with a 50% chance of ; pitching up or down .MTT3 JSR DORND ; Set A and X to random numbers CMP #252 ; If random A < 252 (98.8% of the time), jump to thongs BCC thongs ; to skip the following LDA #HER ; Set A to #HER so we spawn a rock hermit 1.2% of the ; time STA INWK+32 ; Set byte #32 to %00001111 to give the rock hermit an ; E.C.M. BNE whips ; Jump to whips (this BNE is effectively a JMP as A will ; never be zero) .thongs CMP #10 ; If random A >= 10 (96% of the time), set the C flag AND #1 ; Reduce A to a random number that's 0 or 1 ADC #OIL ; Set A = #OIL + A + C, so there's a tiny chance of us ; spawning a cargo canister (#OIL) and an even chance of ; us spawning either a boulder (#OIL + 1) or an asteroid ; (#OIL + 2) .whips JSR NWSHP ; Add our new asteroid or canister to the universeName: Main game loop (Part 2 of 6) [Show more] Type: Subroutine Category: Main loop Summary: Call the main flight loop, and potentially spawn a trader, an asteroid, or a cargo canister Deep dive: Program flow of the main game loop Ship data blocks Fixing ship positionsContext: See this subroutine on its own page References: This subroutine is called as follows: * Main game loop (Part 1 of 6) calls via TT100 * Main game loop (Part 6 of 6) calls via TT100 * me2 calls via me3
This section covers the following: * Call M% to do the main flight loop * Potentially spawn a trader, asteroid or cargo canister
Other entry points: TT100 The entry point for the start of the main game loop, which calls the main flight loop and the moves into the spawning routine me3 Used by me2 to jump back into the main game loop after printing an in-flight message.MTT1 LDA SSPR ; If we are outside the space station's safe zone, skip BEQ P%+5 ; the following instruction .MLOOPS JMP MLOOP ; Jump to MLOOP to skip the following JSR BAD ; Call BAD to work out how much illegal contraband we ; are carrying in our hold (A is up to 40 for a ; standard hold crammed with contraband, up to 70 for ; an extended cargo hold full of narcotics and slaves) ASL A ; Double A to a maximum of 80 or 140 LDX MANY+COPS ; If there are no cops in the local bubble, skip the BEQ P%+5 ; next instruction ORA FIST ; There are cops in the vicinity and we've got a hold ; full of jail time, so OR the value in A with FIST to ; get a new value that is at least as high as both ; values, to reflect the fact that they have almost ; certainly scanned our ship STA T ; Store our badness level in T JSR Ze ; Call Ze to initialise INWK to a potentially hostile ; ship, and set A and X to random values ; ; Note that because Ze uses the value of X returned by ; DORND, and X contains the value of A returned by the ; previous call to DORND, this does not set the new ship ; to a totally random location. See the deep dive on ; "Fixing ship positions" for details CMP #136 ; If the random number in A = 136 (0.4% chance), jump BEQ fothg ; to fothg in part 4 to spawn either a Thargoid or, very ; rarely, a Cougar CMP T ; If the random value in A >= our badness level, which BCS P%+7 ; will be the case unless we have been really, really ; bad, then skip the following two instructions (so ; if we are really bad, there's a higher chance of ; spawning a cop, otherwise we got away with it, for ; now) LDA #COPS ; Add a new police ship to the local bubble JSR NWSHP LDA MANY+COPS ; If we now have at least one cop in the local bubble, BNE MLOOPS ; jump down to MLOOPS to stop spawning, otherwise fall ; through into the next part to look at spawning ; something elseName: Main game loop (Part 3 of 6) [Show more] Type: Subroutine Category: Main loop Summary: Potentially spawn a cop, particularly if we've been bad Deep dive: Program flow of the main game loop Ship data blocks Fixing ship positionsContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
This section covers the following: * Potentially spawn a cop (in a Viper), very rarely if we have been good, more often if have been naughty, and very often if we have been properly bad * Very rarely, consider spawning a Thargoid, or vanishingly rarely, a CougarDEC EV ; Decrement EV, the extra vessels spawning delay, and if BPL MLOOPS ; it is still positive, jump to MLOOPS to stop spawning, ; so we only do the following when the EV counter runs ; down INC EV ; EV is negative, so bump it up again, setting it back ; to 0 LDA TP ; Fetch bits 2 and 3 of TP, which contain the status of AND #%00001100 ; mission 2 CMP #%00001000 ; If bit 3 is set and bit 2 is clear, keep going to BNE nopl ; spawn a Thargoid as we are transporting the plans in ; mission 2 and the Thargoids are trying to stop us, ; otherwise jump to nopl to skip spawning a Thargoid JSR DORND ; Set A and X to random numbers CMP #200 ; If the random number in A < 200 (78% chance), jump to BCC nopl ; nopl to skip spawning a Thargoid .fothg2 JSR GTHG ; Call GTHG to spawn a Thargoid ship and a Thargon ; companion .nopl JSR DORND ; Set A and X to random numbers LDY gov ; If the government of this system is 0 (anarchy), jump BEQ LABEL_2 ; straight to LABEL_2 to start spawning pirates or a ; lone bounty hunter CMP #90 ; If the random number in A >= 90 (65% chance), jump to BCS MLOOPS ; MLOOPS to stop spawning (so there's a 35% chance of ; spawning pirates or a lone bounty hunter) AND #7 ; Reduce the random number in A to the range 0-7, and CMP gov ; if A is less than government of this system, jump BCC MLOOPS ; to MLOOPS to stop spawning (so safer governments with ; larger gov numbers have a greater chance of jumping ; out, which is another way of saying that more ; dangerous systems spawn pirates and bounty hunters ; more often) .LABEL_2 ; Now to spawn a lone bounty hunter, a Thargoid or a ; group of pirates JSR Ze ; Call Ze to initialise INWK to a potentially hostile ; ship, and set A and X to random values ; ; Note that because Ze uses the value of X returned by ; DORND, and X contains the value of A returned by the ; previous call to DORND, this does not set the new ship ; to a totally random location. See the deep dive on ; "Fixing ship positions" for details CMP #100 ; If the random number in A >= 100 (61% chance), jump BCS mt1 ; to mt1 to spawn pirates, otherwise keep going to ; spawn a lone bounty hunter or a Thargoid INC EV ; Increase the extra vessels spawning counter, to ; prevent the next attempt to spawn extra vessels AND #3 ; Set A = random number in the range 0-3, which we ; will now use to determine the type of ship ADC #CYL2 ; Add A to #CYL2 (we know the C flag is clear as we ; passed through the BCS above), so A is now one of the ; lone bounty hunter ships, i.e. Cobra Mk III (pirate), ; Asp Mk II, Python (pirate) or Fer-de-lance ; ; Interestingly, this logic means that the Moray, which ; is the ship after the Fer-de-lance in the XX21 table, ; never spawns, as the above logic chooses a blueprint ; number in the range CYL2 to CYL2+3 (i.e. 24 to 27), ; and the Moray is blueprint 28 ; ; No other code spawns the ship with blueprint 28, so ; this means the Moray is never seen in Elite ; ; This is presumably a bug, which could be very easily ; fixed by inserting one of the following instructions ; before the ADC #CYL2 instruction above: ; ; * SEC would change the range to 25 to 28, which ; would cover the Asp Mk II, Python (pirate), ; Fer-de-lance and Moray ; ; * LSR A would set the C flag to a random number to ; give a range of 24 to 28, which would cover the ; Cobra Mk III (pirate), Asp Mk II, Python (pirate), ; Fer-de-lance and Moray ; ; It's hard to know what the authors' original intent ; was, but the second approach makes the Moray and Cobra ; Mk III the rarest choices, with the Asp Mk II, Python ; and Fer-de-Lance being more likely, and as the Moray ; is described in the literature as a rare ship, and the ; Cobra can already be spawned as part of a group of ; pirates (see mt1 below), I tend to favour the LSR A ; solution over the SEC approach TAY ; Copy the new ship type to Y JSR THERE ; Call THERE to see if we are in the Constrictor's ; system in mission 1 BCC NOCON ; If the C flag is clear then we are not in the ; Constrictor's system, so skip to NOCON LDA #%11111001 ; Set the AI flag of this ship so that it has E.C.M., STA INWK+32 ; has a very high aggression level of 28 out of 31, is ; hostile, and has AI enabled - nasty stuff! LDA TP ; Fetch bits 0 and 1 of TP, which contain the status of AND #%00000011 ; mission 1 LSR A ; Shift bit 0 into the C flag BCC NOCON ; If bit 0 is clear, skip to NOCON as mission 1 is not ; in progress ORA MANY+CON ; Bit 0 of A now contains bit 1 of TP, so this will be ; set if we have already completed mission 1, so this OR ; will be non-zero if we have either completed mission ; 1, or there is already a Constrictor in our local ; bubble of universe (in which case MANY+CON will be ; non-zero) BEQ YESCON ; If A = 0 then mission 1 is in progress, we haven't ; completed it yet, and there is no Constrictor in the ; vicinity, so jump to YESCON to spawn the Constrictor .NOCON LDA #%00000100 ; Set bit 2 of the NEWB flags and clear all other bits, STA NEWB ; so the ship we are about to spawn is hostile ; We now build the AI flag for this ship in A JSR DORND ; Set A and X to random numbers CMP #200 ; First, set the C flag if X >= 200 (22% chance) ROL A ; Set bit 0 of A to the C flag (i.e. there's a 22% ; chance of this ship having E.C.M.) ORA #%11000000 ; Set bits 6 and 7 of A, so the ship is hostile (bit 6) ; and has AI (bit 7) STA INWK+32 ; Store A in the AI flag of this ship TYA ; Set A to the new ship type in Y EQUB $2C ; Skip the next instruction by turning it into ; $2C $A9 $1F, or BIT $1FA9, which does nothing apart ; from affect the flags .YESCON LDA #CON ; If we jump straight here, we are in the mission 1 ; endgame and it's time to spawn the Constrictor, so ; set A to the Constrictor's type .focoug JSR NWSHP ; Spawn the new ship, whether it's a pirate, Thargoid, ; Cougar or Constrictor .mj1 JMP MLOOP ; Jump down to MLOOP, as we are done spawning ships .fothg LDA K%+6 ; Fetch the z_lo coordinate of the first ship in the K% AND #%00111110 ; block (i.e. the planet) and extract bits 1-5 BNE fothg2 ; If any of bits 1-5 are set (96.8% chance), jump up to ; fothg2 to spawn a Thargoid ; If we get here then we're going to spawn a Cougar, a ; very rare event indeed. How rare? Well, all the ; following have to happen in sequence: ; ; * Main loop iteration = 0 (1 in 256 iterations) ; * Skip asteroid spawning (87% chance) ; * Skip cop spawning (0.4% chance) ; * Skip Thargoid spawning (3.2% chance) ; ; so the chances of spawning a Cougar on any single main ; loop iteration are slim, to say the least LDA #18 ; Give the ship we're about to spawn a speed of 27 STA INWK+27 LDA #%01111001 ; Give it an E.C.M., and make it hostile and pretty STA INWK+32 ; aggressive (though don't give it AI) LDA #COU ; Set the ship type to a Cougar and jump up to focoug BNE focoug ; to spawn it .mt1 AND #3 ; It's time to spawn a group of pirates, so set A to a ; random number in the range 0-3, which will be the ; loop counter for spawning pirates below (so we will ; spawn 1-4 pirates) STA EV ; Delay further spawnings by this number STA XX13 ; Store the number in XX13, the pirate counter .mt3 JSR DORND ; Set A and X to random numbers STA T ; Set T to a random number JSR DORND ; Set A and X to random numbers AND T ; Set A to the AND of two random numbers, so each bit ; has 25% chance of being set which makes the chances ; of a smaller number higher AND #7 ; Reduce A to a random number in the range 0-7, though ; with a bigger chance of a smaller number in this range ADC #PACK ; #PACK is set to #SH3, the ship type for a Sidewinder, ; so this sets our new ship type to one of the pack ; hunters, namely a Sidewinder, Mamba, Krait, Adder, ; Gecko, Cobra Mk I, Worm or Cobra Mk III (pirate) JSR NWSHP ; Try adding a new ship of type A to the local bubble DEC XX13 ; Decrement the pirate counter BPL mt3 ; If we need more pirates, loop back up to mt3, ; otherwise we are done spawning, so fall through into ; the end of the main loop at MLOOPName: Main game loop (Part 4 of 6) [Show more] Type: Subroutine Category: Main loop Summary: Potentially spawn a lone bounty hunter, a Thargoid, or up to four pirates Deep dive: Program flow of the main game loop Ship data blocks Fixing ship positions The elusive CougarContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
This section covers the following: * Potentially spawn (35% chance) either a lone bounty hunter (a Cobra Mk III, Asp Mk II, Python or Fer-de-lance), a Thargoid, or a group of up to 4 pirates (a mix of Sidewinders, Mambas, Kraits, Adders, Geckos, Cobras Mk I and III, and Worms) * Also potentially spawn a Constrictor if this is the mission 1 endgame, or Thargoids if mission 2 is in progress.MLOOP LDX #$FF ; Set the stack pointer to $01FF, which is the standard TXS ; location for the 6502 stack, so this instruction ; effectively resets the stack LDX GNTMP ; If the laser temperature in GNTMP is non-zero, BEQ EE20 ; decrement it (i.e. cool it down a bit) DEC GNTMP .EE20 LDX LASCT ; Set X to the value of LASCT, the laser pulse count BEQ NOLASCT ; If X = 0 then jump to NOLASCT to skip reducing LASCT, ; as it can't be reduced any further DEX ; Decrement the value of LASCT in X BEQ P%+3 ; If X = 0, skip the next instruction DEX ; Decrement the value of LASCT in X again STX LASCT ; Store the decremented value of X in LASCT, so LASCT ; gets reduced by 2, but not into negative territory .NOLASCT LDA QQ11 ; If QQ11 is non-zero then this is not the space view, BNE P%+5 ; so skip the following instruction as only the space ; view has the dashboard JSR DIALS ; Call DIALS to update the dashboard LDA QQ11 ; If this is a space view, jump to plus13 to skip the BEQ plus13 ; following five instructions AND PATG ; If PATG = $FF (author names are shown on start-up) LSR A ; and bit 0 of QQ11 is 1 (the current view is type 1), BCS plus13 ; then skip the following two instructions LDY #2 ; Wait for 2/50 of a second (0.04 seconds) on PAL JSR DELAY ; systems, or 2/60 of a second (0.03 seconds) on NTSC, ; to slow the main loop down a bit .plus13 LDA TRIBBLE+1 ; If the high byte of TRIBBLE(1 0), the number of BEQ nobabies ; Trumbles in the hold, is zero, jump to nobabies to ; skip the following ; We have a lot of Trumbles in the hold, so let's see if ; any of them are breeding (note that Trumbles always ; breed when we jump into a new system in the SOLAR ; routine, but when we have lots of them, they also ; breed here in the main flight loop) JSR DORND ; Set A and X to random numbers CMP #220 ; If A >= 220 then set the C flag (14% chance) LDA TRIBBLE ; Add the C flag to TRIBBLE(1 0), starting with the low ADC #0 ; bytes STA TRIBBLE BCC nobabies ; And then the high bytes INC TRIBBLE+1 ; ; So there is a 14% chance of a Trumble being born BPL nobabies ; If the high byte of TRIBBLE(1 0) is now $80, then DEC TRIBBLE+1 ; decrement it back to $7F, so the number of Trumbles ; never goes above $7FFF (32767) .nobabies LDA TRIBBLE+1 ; If the high byte of TRIBBLE(1 0), the number of BEQ NOSQUEEK ; Trumbles in the hold, is zero, jump to NOSQUEEK to ; skip the following ; We have a lot of Trumbles in the hold, so they are ; probably making a bit of a noise STA T ; Store the high byte of the number of Trumbles in T LDA CABTMP ; If the cabin temperature is >= 224 then skip the ASL T CMP #224 ; instruction and leave the value of A as a lower value, BCS P%+4 ; so the chances of the Trumbles making a noise in hot ; temperatures is lessened (specifically, this is the ; temperature at which the fuel scoops start working) ASL T ; Set T = T * 2 JSR DORND ; Set A and X to random numbers CMP T ; If A >= T then jump to NOSQUEEK to skip making any BCS NOSQUEEK ; noise, so there is a higher chance of Trumbles making ; noise when there are lots of them and the cabin ; temperature is cool enough for the fuel scoops to be ; disabled (so they start to go quieter when things get ; too hot) ; If we get here then we want to make the noise of ; Trumbles living in our ship JSR DORND ; Set X to a random number in the range 64 to 255, which ORA #64 ; we will use as the frequency of the sound of Trumble TAX ; chatter (so they make a randomly pitched noise that's ; not too high) LDA #$80 ; Set A = $80 to pass to NOISE2 as the sustain volume ; and release length for when the cabin is relatively ; cool, so that's a sustain volume of 8 and a release ; length of 0 ; ; This makes the sounds more staccato and softer LDY CABTMP ; If the cabin temperature is < 224, jump to CPY #224 ; burnthebastards to make the noise of Trumbles lightly BCC burnthebastards ; toasting TXA ; Clip X to a random number in the range 0 to 15, so the AND #15 ; frequency of the Trumble chatter gets lower as the TAX ; cabin gets hotter LDA #$F1 ; Set A = $F1 to pass to NOISE2 as the sustain volume ; and release length for when the cabin is really hot, ; so that's a sustain volume of 15 and a release length ; of 1 ; ; This makes the sounds more drawn out and louder .burnthebastards LDY #sfxtrib ; Call the NOISE2 routine with Y = sfxtrib and A and X JSR NOISE2 ; set according to the cabin temperature: ; ; * A = $80, X = 64 to 255 when the cabin is cool ; (quieter, higher-pitched, more staccato squeaks) ; ; * A = $F1, X = 0 to 15 when the cabin is hot ; (louder, lower-pitched, more drawn out squeaks) ; ; This makes the sound of Trumbles either partying or ; or being slowly roasted .NOSQUEEK JSR TT17 ; Scan the keyboard for the cursor keys or joystick, ; returning the cursor's delta values in X and Y and ; the key pressed in AName: Main game loop (Part 5 of 6) [Show more] Type: Subroutine Category: Main loop Summary: Cool down lasers, make calls to update the dashboard Deep dive: Program flow of the main game loop The dashboard indicators The Trumbles missionContext: See this subroutine on its own page References: This subroutine is called as follows: * Main game loop (Part 2 of 6) calls via MLOOP * Main game loop (Part 3 of 6) calls via MLOOP * Main game loop (Part 4 of 6) calls via MLOOP * Main game loop (Part 6 of 6) calls via MLOOP
This is the first half of the minimal game loop, which we iterate when we are docked. This section covers the following: * Cool down lasers * Make calls to update the dashboard
Other entry points: MLOOP The entry point for the main game loop. This entry point comes after the call to the main flight loop and spawning routines, so it marks the start of the main game loop for when we are docked (as we don't need to call the main flight loop or spawning routines if we aren't in space).FRCE JSR TT102 ; Call TT102 to process the key pressed in A LDA QQ12 ; Fetch the docked flag from QQ12 into A BEQ P%+5 ; If we are docked, loop back up to MLOOP just above JMP MLOOP ; to restart the main loop, but skipping all the flight ; and spawning code in the top part of the main loop JMP TT100 ; Otherwise jump to TT100 to restart the main loop from ; the startName: Main game loop (Part 6 of 6) [Show more] Type: Subroutine Category: Main loop Summary: Process non-flight key presses (docked keys) Deep dive: Program flow of the main game loopContext: See this subroutine on its own page References: This subroutine is called as follows: * BAY calls via FRCE * TT219 calls via FRCE
This is the second half of the minimal game loop, which we iterate when we are docked. This section covers the following: * Process more key presses (red function keys, docked keys etc.) It also supports joining the main loop with a key already "pressed", so we can jump into the main game loop to perform a specific action. In practice, this is used when we enter the docking bay in BAY to display Status Mode, and when we finish buying or selling cargo in BAY2 to jump to the Inventory.
Other entry points: FRCE The entry point for the main game loop if we want to jump straight to a specific screen, by pretending to "press" a key, in which case A contains the internal key number of the key we want to "press".TT102 CMP #f8 ; If key "8" was pressed, jump to STATUS to show the BNE P%+5 ; Status Mode screen, returning from the subroutine JMP STATUS ; using a tail call CMP #f4 ; If key "4" was pressed, jump to TT22 to show the BNE P%+5 ; Long-range Chart, returning from the subroutine using JMP TT22 ; a tail call CMP #f5 ; If key "5" was pressed, jump to TT23 to show the BNE P%+5 ; Short-range Chart, returning from the subroutine using JMP TT23 ; a tail call CMP #f6 ; If key "6" was pressed, call TT111 to select the BNE TT92 ; system nearest to galactic coordinates (QQ9, QQ10) JSR TT111 ; (the location of the chart crosshairs) and set ZZ to JMP TT25 ; the system number, and then jump to TT25 to show the ; Data on System screen (along with an extended system ; description for the system in ZZ if we're docked), ; returning from the subroutine using a tail call .TT92 CMP #f9 ; If key "9" was pressed, jump to TT213 to show the BNE P%+5 ; Inventory screen, returning from the subroutine JMP TT213 ; using a tail call CMP #f7 ; If key "7" was pressed, jump to TT167 to show the BNE P%+5 ; Market Price screen, returning from the subroutine JMP TT167 ; using a tail call CMP #f0 ; If key F1 was pressed, jump to TT110 to launch our BNE fvw ; ship (if docked), returning from the subroutine using JMP TT110 ; a tail call .fvw BIT QQ12 ; If bit 7 of QQ12 is clear (i.e. we are not docked, but BPL INSP ; in space), jump to INSP to skip the following checks ; for f1-f3 and "@" (save commander file) key presses CMP #f3 ; If key "3" was pressed, jump to EQSHP to show the BNE P%+5 ; Equip Ship screen, returning from the subroutine using JMP EQSHP ; a tail call CMP #f1 ; If key "1" was pressed, jump to TT219 to show the BNE P%+5 ; Buy Cargo screen, returning from the subroutine using JMP TT219 ; a tail call CMP #$12 ; If "@" was not pressed, skip to nosave BNE nosave JSR SVE ; "@" was pressed, so call SVE to show the disk access ; menu BCC P%+5 ; If the C flag was set by SVE, then we loaded a new JMP QU5 ; commander file, so jump to QU5 to restart the game ; with the newly loaded commander JMP BAY ; Otherwise the C flag was clear, so jump to BAY to go ; to the docking bay (i.e. show the Status Mode screen) .nosave CMP #f2 ; If key "2" was pressed, jump to TT208 to show the BNE LABEL_3 ; Sell Cargo screen, returning from the subroutine using JMP TT208 ; a tail call .INSP CMP #f12 ; If key F3 was pressed, jump to chview1 BEQ chview1 CMP #f22 ; If key F5 was pressed, jump to chview2 BEQ chview2 CMP #f32 ; If key F7 was not pressed, jump to LABEL_3 to keep BNE LABEL_3 ; checking for which key was pressed LDX #3 ; Key F7 was pressed, so set the view number in X to ; 3 for the right view EQUB $2C ; Skip the next instruction by turning it into ; $2C $A2 $02, or BIT $02A2, which does nothing apart ; from affect the flags .chview2 LDX #2 ; If we jump to here, key F5 was pressed, so set the ; view number in X to 2 for the left view EQUB $2C ; Skip the next instruction by turning it into ; $2C $A2 $01, or BIT $02A2, which does nothing apart ; from affect the flags .chview1 LDX #1 ; If we jump to here, key F3 was pressed, so set the ; view number in X to 1 for the rear view JMP LOOK1 ; Jump to LOOK1 to switch to view X (rear, left or ; right), returning from the subroutine using a tail ; call .LABEL_3 BIT KLO+HINT ; If "H" was not pressed, skip the following instruction BPL P%+5 JMP hyp ; Jump to hyp to do a hyperspace jump (if we are in ; space), returning from the subroutine using a tail ; call .NWDAV5 CMP #DINT ; If "D" was pressed, jump to T95 to print the distance BEQ T95 ; to a system (if we are in one of the chart screens) CMP #FINT ; If "F" was not pressed, jump down to HME1, otherwise BNE HME1 ; keep going to process searching for systems LDA QQ12 ; If QQ12 = 0 (we are not docked), we can't search for BEQ t95 ; systems, so return from the subroutine (as t95 ; contains an RTS) LDA QQ11 ; If the current view is a chart (QQ11 = 64 or 128), AND #%11000000 ; keep going, otherwise return from the subroutine (as BEQ t95 ; t95 contains an RTS) JMP HME2 ; Jump to HME2 to let us search for a system, returning ; from the subroutine using a tail call .HME1 STA T1 ; Store A (the key that's been pressed) in T1 LDA QQ11 ; If the current view is a chart (QQ11 = 64 or 128), AND #%11000000 ; keep going, otherwise jump down to TT107 to skip the BEQ TT107 ; following LDA QQ22+1 ; If the on-screen hyperspace counter is non-zero, BNE TT107 ; then we are already counting down, so jump to TT107 ; to skip the following LDA T1 ; Restore the original value of A (the key that's been ; pressed) from T1 CMP #OINT ; If "O" was pressed, do the following three jumps, BNE ee2 ; otherwise skip to ee2 to continue JSR TT103 ; Draw small crosshairs at coordinates (QQ9, QQ10), ; which will erase the crosshairs currently there JSR ping ; Set the target system to the current system (which ; will move the location in (QQ9, QQ10) to the current ; home system JMP TT103 ; Draw small crosshairs at coordinates (QQ9, QQ10), ; which will draw the crosshairs at our current home ; system, and return from the subroutine using a tail ; call .ee2 JSR TT16 ; Call TT16 to move the crosshairs by the amount in X ; and Y, which were passed to this subroutine as ; arguments .TT107 LDA QQ22+1 ; If the on-screen hyperspace counter is zero, return BEQ t95 ; from the subroutine (as t95 contains an RTS), as we ; are not currently counting down to a hyperspace jump DEC QQ22 ; Decrement the internal hyperspace counter BNE t95 ; If the internal hyperspace counter is still non-zero, ; then we are still counting down, so return from the ; subroutine (as t95 contains an RTS) ; If we get here then the internal hyperspace counter ; has just reached zero and it wasn't zero before, so ; we need to reduce the on-screen counter and update ; the screen. We do this by first printing the next ; number in the countdown sequence, and then printing ; the old number, which will erase the old number ; and display the new one because printing uses EOR ; logic LDX QQ22+1 ; Set X = the on-screen hyperspace counter - 1 DEX ; (i.e. the next number in the sequence) JSR ee3 ; Print the 8-bit number in X at text location (0, 1) LDA #5 ; Reset the internal hyperspace counter to 5 STA QQ22 LDX QQ22+1 ; Set X = the on-screen hyperspace counter (i.e. the ; current number in the sequence, which is already ; shown on-screen) JSR ee3 ; Print the 8-bit number in X at text location (0, 1), ; i.e. print the hyperspace countdown in the top-left ; corner DEC QQ22+1 ; Decrement the on-screen hyperspace countdown BNE t95 ; If the countdown is not yet at zero, return from the ; subroutine (as t95 contains an RTS) JMP TT18 ; Otherwise the countdown has finished, so jump to TT18 ; to do a hyperspace jump, returning from the subroutine ; using a tail call .t95 RTS ; Return from the subroutine .T95 ; If we get here, "D" was pressed, so we need to show ; the distance to the selected system (if we are in a ; chart view) LDA QQ11 ; If the current view is a chart (QQ11 = 64 or 128), AND #%11000000 ; keep going, otherwise return from the subroutine (as BEQ t95 ; t95 contains an RTS) ;LDA #CYAN ; These instructions are commented out in the original ;JSR DOCOL ; source JSR hm ; Call hm to move the crosshairs to the target system ; in (QQ9, QQ10), returning with A = 0 STA QQ17 ; Set QQ17 = 0 to switch to ALL CAPS JSR cpl ; Print control code 3 (the selected system name) LDA #%10000000 ; Set bit 7 of QQ17 to switch to Sentence Case, with the STA QQ17 ; next letter in capitals LDA #12 ; Print a line feed to move the text cursor down a line JSR TT26 ;LDA #10 ; These instructions are commented out in the original ;JSR TT26 ; source ;LDA #1 ;JSR DOXC ;JSR INCYC JMP TT146 ; Print the distance to the selected system and return ; from the subroutine using a tail callName: TT102 [Show more] Type: Subroutine Category: Keyboard Summary: Process function key, save key, hyperspace and chart key presses and update the hyperspace counterContext: See this subroutine on its own page References: This subroutine is called as follows: * Main game loop (Part 6 of 6) calls TT102 * HME2 calls via T95
Process function key presses, plus "@" (save commander), "H" (hyperspace), "D" (show distance to system) and "O" (move chart cursor back to current system). We can also pass cursor position deltas in X and Y to indicate that the cursor keys or joystick have been used (i.e. the values that are returned by routine TT17). This routine also checks for the "F" key press (search for a system), which applies to enhanced versions only.
Arguments: A The key number of the key pressed X The amount to move the crosshairs in the x-axis Y The amount to move the crosshairs in the y-axis
Other entry points: T95 Print the distance to the selected system.BAD LDA QQ20+3 ; Set A to the number of tonnes of slaves in the hold CLC ; Clear the C flag so we can do addition without the ; C flag affecting the result ADC QQ20+6 ; Add the number of tonnes of narcotics in the hold ASL A ; Double the result and add the number of tonnes of ADC QQ20+10 ; firearms in the hold RTS ; Return from the subroutineName: BAD [Show more] Type: Subroutine Category: Status Summary: Calculate how bad we have beenContext: See this subroutine on its own page References: This subroutine is called as follows: * Main game loop (Part 3 of 6) calls BAD * TT110 calls BAD
Work out how bad we are from the amount of contraband in our hold. The formula is: (slaves + narcotics) * 2 + firearms so slaves and narcotics are twice as illegal as firearms. The value in FIST (our legal status) is set to at least this value whenever we launch from a space station, and a FIST of 50 or more gives us fugitive status, so leaving a station carrying 25 tonnes of slaves/narcotics, or 50 tonnes of firearms across multiple trips, is enough to make us a fugitive.
Returns: A A value that determines how bad we are from the amount of contraband in our hold.FAROF LDA #224 ; Set A = 224 and fall through into FAROF2 to do the ; comparisonName: FAROF [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Compare x_hi, y_hi and z_hi with 224Context: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 12 of 16) calls FAROF
Compare x_hi, y_hi and z_hi with 224, and set the C flag if all three <= 224, otherwise clear the C flag.
Returns: C flag Set if x_hi <= 224 and y_hi <= 224 and z_hi <= 224 Clear otherwise (i.e. if any one of them are bigger than 224).FAROF2 CMP INWK+1 ; If A < x_hi, C will be clear so jump to FA1 to BCC FA1 ; return from the subroutine with C clear, otherwise ; C will be set so move on to the next one CMP INWK+4 ; If A < y_hi, C will be clear so jump to FA1 to BCC FA1 ; return from the subroutine with C clear, otherwise ; C will be set so move on to the next one CMP INWK+7 ; If A < z_hi, C will be clear, otherwise C will be set .FA1 RTS ; Return from the subroutineName: FAROF2 [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Compare x_hi, y_hi and z_hi with AContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 14 of 16) calls FAROF2
Compare x_hi, y_hi and z_hi with A, and set the C flag if all three <= A, otherwise clear the C flag.
Returns: C flag Set if x_hi <= A and y_hi <= A and z_hi <= A Clear otherwise (i.e. if any one of them are bigger than A).MAS4 ORA INWK+1 ; OR A with x_hi, y_hi and z_hi ORA INWK+4 ORA INWK+7 RTS ; Return from the subroutineName: MAS4 [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Calculate a cap on the maximum distance to a shipContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 7 of 16) calls MAS4 * TACTICS (Part 1 of 7) calls MAS4 * TACTICS (Part 6 of 7) calls MAS4
Logical OR the value in A with the high bytes of the ship's position (x_hi, y_hi and z_hi).
Returns: A A OR x_hi OR y_hi OR z_hi.brkd EQUB 0Name: brkd [Show more] Type: Variable Category: Utility routines Summary: The brkd counter for error handlingContext: See this variable on its own page References: This variable is used as follows: * BRBR uses brkd * TITLE uses brkd
This counter starts at zero, and is decremented whenever the BRKV handler at BRBR prints an error message. It is incremented every time an error message is printed out as part of the TITLE routine..BRBR DEC brkd ; Decrement the brkd counter LDX #$FF ; Set the stack pointer to $01FF, which is the standard TXS ; location for the 6502 stack, so this instruction ; effectively resets the stack JSR backtonormal ; Disable the keyboard and set the SVN flag to 0 TAY ; The call to backtonormal sets A to 0, so this sets Y ; to 0, which we use as a loop counter below LDA #7 ; Set A = 7 to generate a beep before we print the error ; message .BRBRLOOP JSR CHPR ; Print the character in A, which contains a line feed ; on the first loop iteration, and then any non-zero ; characters we fetch from the error message INY ; Increment the loop counter LDA ($FD),Y ; Fetch the Y-th byte of the block pointed to by ; ($FD $FE), so that's the Y-th character of the message ; pointed to by the MOS error message pointer BNE BRBRLOOP ; If the fetched character is non-zero, loop back to the ; JSR OSWRCH above to print the it, and keep looping ; until we fetch a zero (which marks the end of the ; message) JMP BR1 ; Jump to BR1 to restart the gameName: BRBR [Show more] Type: Subroutine Category: Utility routines Summary: The standard BRKV handler for the gameContext: See this subroutine on its own page References: This subroutine is called as follows: * BRKBK calls BRBR
This routine is unused in this version of Elite (it is left over from the 6502 Second Processor version)..DEATH JSR EXNO3 ; Make the sound of us dying JSR RES2 ; Reset a number of flight variables and workspaces ASL DELTA ; Divide our speed in DELTA by 4 ASL DELTA LDX #24 ; Set the screen to only show 24 text rows, which hides JSR DET1 ; the dashboard, setting A to 6 in the process JSR TT66 ; Clear the top part of the screen, draw a border box, ; and set the current view type in QQ11 to 6 (death ; screen) JSR BOX ; Call BOX to redraw the same border box (BOX is part ; of TT66), which removes the border as it is drawn ; using EOR logic LDA #0 ; The BOX routine sets these addresses in the screen STA SCBASE+$1F1F ; bitmap to $FF and 1 respectively, but it doesn't use STA SCBASE+$118 ; EOR logic to do this, so we need to manually set them ; to 0 to remove the corresponding pixels from the ; screen, as the call we just made to BOX won't do this JSR nWq ; Create a cloud of stardust containing the correct ; number of dust particles (i.e. NOSTM of them) LDA #12 ; Move the text cursor to column 12 on row 12 JSR DOYC JSR DOXC ;LDA #YELLOW ; These instructions are commented out in the original ;JSR DOCOL ; source LDA #146 ; Print recursive token 146 ("{all caps}GAME OVER") JSR ex .D1 JSR Ze ; Call Ze to initialise INWK to a potentially hostile ; ship, and set A and X to random values LSR A ; Set A = A / 4, so A is now between 0 and 63, and LSR A ; store in byte #0 (x_lo) STA INWK LDY #0 ; Set the following to 0: the current view in QQ11 STY QQ11 ; (space view), x_hi, y_hi, z_hi and the AI flag (no AI STY INWK+1 ; or E.C.M. and not hostile) STY INWK+4 STY INWK+7 STY INWK+32 DEY ; Set Y = 255 STY MCNT ; Reset the main loop counter to 255, so all timer-based ; calls will be stopped EOR #%00101010 ; Flip bits 1, 3 and 5 in A (x_lo) to get another number STA INWK+3 ; between 48 and 63, and store in byte #3 (y_lo) ORA #%01010000 ; Set bits 4 and 6 of A to bump it up to between 112 and STA INWK+6 ; 127, and store in byte #6 (z_lo) TXA ; Set A to the random number in X and keep bits 0-3 and AND #%10001111 ; the sign in bit 7 to get a number between -15 and +15, STA INWK+29 ; and store in byte #29 (roll counter) to give our ship ; a gentle roll with damping LDY #64 ; Set the laser count to 64 to act as a counter in the STY LASCT ; D2 loop below, so this setting determines how long the ; death animation lasts (it's 64 * 2 iterations of the ; main flight loop) SEC ; Set the C flag ROR A ; This sets A to a number between 0 and +7, which we AND #%10000111 ; store in byte #30 (the pitch counter) to give our ship STA INWK+30 ; a very gentle downwards pitch with damping LDX #OIL ; Set X to #OIL, the ship type for a cargo canister LDA XX21-1+2*PLT ; Fetch the byte from location XX21 - 1 + 2 * PLT, which ; equates to XX21 + 7 (the high byte of the address of ; SHIP_PLATE), which seems a bit odd. It might make more ; sense to do LDA (XX21-2+2*PLT) as this would fetch the ; first byte of the alloy plate's blueprint (which ; determines what happens when alloys are destroyed), ; but there aren't any brackets, so instead this always ; returns $D0, which is never zero, so the following ; BEQ is never true. (If the brackets were there, then ; we could stop plates from spawning on death by setting ; byte #0 of the blueprint to 0... but then scooping ; plates wouldn't give us alloys, so who knows what this ; is all about?) BEQ D3 ; If A = 0, jump to D3 to skip the following instruction BCC D3 ; If the C flag is clear, which will be random following ; the above call to Ze, jump to D3 to skip the following ; instruction DEX ; Decrement X, which sets it to #PLT, the ship type for ; an alloy plate .D3 JSR fq1 ; Call fq1 with X set to #OIL or #PLT, which adds a new ; cargo canister or alloy plate to our local bubble of ; universe and points it away from us with double DELTA ; speed (i.e. 6, as DELTA was set to 3 by the call to ; RES2 above). INF is set to point to the new arrival's ; ship data block in K% JSR DORND ; Set A and X to random numbers and extract bit 7 from A AND #%10000000 LDY #31 ; Store this in byte #31 of the ship's data block, so it STA (INF),Y ; has a 50% chance of marking our new arrival as being ; killed (so it will explode) LDA FRIN+4 ; The call we made to RES2 before we entered the loop at BEQ D1 ; D1 will have reset all the ship slots at FRIN, so this ; checks to see if the fifth slot is empty, and if it ; is we loop back to D1 to add another canister, until ; we have added five of them JSR U% ; Clear the key logger, which also sets A = 0 STA DELTA ; Set our speed in DELTA to 0, as we aren't going ; anywhere any more JSR M% ; Call the M% routine to do the main flight loop once, ; which will display our exploding canister scene and ; move everything about, as well as decrementing the ; value in LASCT JSR NOSPRITES ; Call NOSPRITES to disable all sprites and remove them ; from the screen .D2 JSR M% ; Call the M% routine to do the main flight loop once, ; which will display our exploding canister scene and ; move everything about, as well as decrementing the ; value in LASCT DEC LASCT ; Decrement the counter in LASCT, which we set above, ; so for each loop around D2, we decrement LASCT by 5 ; (the main loop decrements it by 4, and this one makes ; it 5) BNE D2 ; Loop back to call the main flight loop again, until we ; have called it 127 times LDX #31 ; Set the screen to show all 31 text rows, which shows JSR DET1 ; the dashboard JMP DEATH2 ; Jump to DEATH2 to reset and restart the gameName: DEATH [Show more] Type: Subroutine Category: Start and end Summary: Display the death screenContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 9 of 16) calls DEATH * Main flight loop (Part 15 of 16) calls DEATH * OOPS calls DEATH
We have been killed, so display the chaos of our destruction above a "GAME OVER" sign, and clean up the mess ready for the next attempt..spasto EQUW $8888 ; This variable is set by routine BEGIN to the address ; of the Coriolis space station's ship blueprint.BEGIN ;JSR BRKBK ; This instruction is commented out in the original ; source LDX #(MUSILLY-COMC) ; We start by zeroing all the configuration variables ; between COMC and MUSILLY, to set them to their default ; values, so set a counter in X for MUSILLY - COMC bytes LDA #0 ; Set A = 0 so we can zero the variables .BEL1 STA COMC,X ; Zero the X-th configuration variable DEX ; Decrement the loop counter BPL BEL1 ; Loop back to BEL1 to zero the next byte, until we have ; zeroed them all LDA XX21+SST*2-2 ; Set spasto(1 0) to the Coriolis space station entry STA spasto ; from the ship blueprint lookup table at XX21 (so LDA XX21+SST*2-1 ; spasto(1 0) points to the Coriolis blueprint) STA spasto+1 JSR JAMESON ; Call JAMESON to set the last saved commander to the ; default "JAMESON" commander ; Fall through into TT170 to start the gameName: BEGIN [Show more] Type: Subroutine Category: Loader Summary: Initialise the configuration variables and start the gameContext: See this subroutine on its own page References: This subroutine is called as follows: * S% calls BEGIN.TT170 LDX #$FF ; Set the stack pointer to $01FF, which is the standard TXS ; location for the 6502 stack, so this instruction ; effectively resets the stack JSR RESET ; Call RESET to initialise most of the game variables ; Fall through into DEATH2 to start the gameName: TT170 [Show more] Type: Subroutine Category: Start and end Summary: Main entry point for the Elite game code Deep dive: Program flow of the main game loopContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
This is the main entry point for the main game code..DEATH2 LDX #$FF ; Set the stack pointer to $01FF, which is the standard TXS ; location for the 6502 stack, so this instruction ; effectively resets the stack JSR RES2 ; Reset a number of flight variables and workspaces ; and fall through into the entry code for the game ; to restart from the title screenName: DEATH2 [Show more] Type: Subroutine Category: Start and end Summary: Reset most of the game and restart from the title screenContext: See this subroutine on its own page References: This subroutine is called as follows: * DEATH calls DEATH2 * DK4 calls DEATH2
This routine is called following death, and when the game is quit by pressing ESCAPE when paused..BR1 JSR ZEKTRAN ; Call ZEKTRAN to clear the key logger LDA #3 ; Move the text cursor to column 3 JSR DOXC IF _GMA_RELEASE JSR startat ; Start playing the title music ELIF _SOURCE_DISK ;JSR FX200 ; This instruction is commented out in the original ; source ENDIF LDX #CYL ; Call TITLE to show a rotating Cobra Mk III (#CYL) and LDA #6 ; token 6 ("LOAD NEW {single cap}COMMANDER {all caps} LDY #210 ; (Y/N)?{sentence case}{cr}{cr}"), with the ship at a JSR TITLE ; distance of 210, returning with the internal number ; of the key pressed in A CMP #YINT ; Did we press "Y"? If not, jump to QU5, otherwise BNE QU5 ; continue on to load a new commander IF _GMA_RELEASE JSR stopat ; Stop playing the title music ENDIF JSR DFAULT ; Call DFAULT to reset the current commander data block ; to the last saved commander JSR SVE ; Call SVE to load a new commander into the last saved ; commander data block IF _GMA_RELEASE JSR startat ; Start playing the title music ENDIF .QU5 JSR DFAULT ; Call DFAULT to reset the current commander data block ; to the last saved commanderName: BR1 (Part 1 of 2) [Show more] Type: Subroutine Category: Start and end Summary: Show the "Load New Commander (Y/N)?" screen and start the gameContext: See this subroutine on its own page References: This subroutine is called as follows: * BRBR calls BR1 * TT102 calls via QU5
Other entry points: QU5 Restart the game using the last saved commander without asking whether to load a new commander fileJSR msblob ; Reset the dashboard's missile indicators so none of ; them are targeted LDA #7 ; Call TITLE to show a rotating Adder (#ADA) and token LDX #ADA ; 7 ("PRESS SPACE OR FIRE,{single cap}COMMANDER.{cr} LDY #48 ; {cr}"), with the ship at a distance of 48, returning JSR TITLE ; with the internal number of the key pressed in A IF _GMA_RELEASE JSR stopat ; Stop playing the title music ENDIF JSR ping ; Set the target system coordinates (QQ9, QQ10) to the ; current system coordinates (QQ0, QQ1) we just loaded JSR TT111 ; Select the system closest to galactic coordinates ; (QQ9, QQ10) JSR jmp ; Set the current system to the selected system LDX #5 ; We now want to copy the seeds for the selected system ; in QQ15 into QQ2, where we store the seeds for the ; current system, so set up a counter in X for copying ; 6 bytes (for three 16-bit seeds) ; The label below is called likeTT112 because this code ; is almost identical to the TT112 loop in the hyp1 ; routine .likeTT112 LDA QQ15,X ; Copy the X-th byte in QQ15 to the X-th byte in QQ2 STA QQ2,X DEX ; Decrement the counter BPL likeTT112 ; Loop back to likeTT112 if we still have more bytes to ; copy INX ; Set X = 0 (as we ended the above loop with X = $FF) STX EV ; Set EV, the extra vessels spawning counter, to 0, as ; we are entering a new system with no extra vessels ; spawned LDA QQ3 ; Set the current system's economy in QQ28 to the STA QQ28 ; selected system's economy from QQ3 LDA QQ5 ; Set the current system's tech level in tek to the STA tek ; selected system's economy from QQ5 LDA QQ4 ; Set the current system's government in gov to the STA gov ; selected system's government from QQ4 ; Fall through into the docking bay routine belowName: BR1 (Part 2 of 2) [Show more] Type: Subroutine Category: Start and end Summary: Show the "Press Fire or Space, Commander" screen and start the gameContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
BRKV is set to point to BR1 by the loading process..BAY LDA #$FF ; Set QQ12 = $FF (the docked flag) to indicate that we STA QQ12 ; are docked LDA #f8 ; Jump into the main loop at FRCE, setting the key JMP FRCE ; that's "pressed" to the Status Mode keyName: BAY [Show more] Type: Subroutine Category: Status Summary: Go to the docking bay (i.e. show the Status Mode screen)Context: See this subroutine on its own page References: This subroutine is called as follows: * BRP calls BAY * DOENTRY calls BAY * EQSHP calls BAY * TBRIEF calls BAY * TT102 calls BAY
We end up here after the start-up process (load commander etc.), as well as after a successful save, an escape pod launch, a successful docking, the end of a cargo sell, and various errors (such as not having enough cash, entering too many items when buying, trying to fit an item to your ship when you already have it, running out of cargo space, and so on)..DFAULT LDX #NT%+8 ; The size of the last saved commander data block is NT% ; bytes, and it is preceded by the 8 bytes of the ; commander name (seven characters plus a carriage ; return). The commander data block at NAME is followed ; by the commander data block, so we need to copy the ; name and data from the "last saved" buffer at NA% to ; the current commander workspace at NAME. So we set up ; a counter in X for the NT% + 8 bytes that we want to ; copy .QUL1 LDA NA%-1,X ; Copy the X-th byte of NA%-1 to the X-th byte of STA NAME-1,X ; NAME-1 (the -1 is because X is counting down from ; NT% + 8 to 1) DEX ; Decrement the loop counter BNE QUL1 ; Loop back for the next byte of the commander data ; block STX QQ11 ; X is 0 by the end of the above loop, so this sets QQ11 ; to 0, which means we will be showing a view without a ; boxed title at the top (i.e. we're going to use the ; screen layout of a space view in the following) ; If the commander check below fails, we keep jumping ; back to here to crash the game with an infinite loop .doitagain JSR CHECK ; Call the CHECK subroutine to calculate the checksum ; for the current commander block at NA%+8 and put it ; in A CMP CHK ; Test the calculated checksum against CHK IF _REMOVE_CHECKSUMS NOP ; If we have disabled checksums, then ignore the result NOP ; of the comparison and fall through into the next part ELSE BNE doitagain ; If the calculated checksum does not match CHK, then ; loop back to repeat the check - in other words, we ; enter an infinite loop here, as the checksum routine ; will keep returning the same incorrect value ENDIF ; The checksum CHK is correct, so now we check whether ; CHK2 = CHK EOR A9, and if this check fails, bit 7 of ; the competition flags at COK gets set, to indicate ; to Acornsoft via the competition code that there has ; been some hacking going on with this competition entry EOR #$A9 ; X = checksum EOR $A9 TAX LDA COK ; Set A to the competition flags in COK CPX CHK2 ; If X = CHK2, then skip the next instruction BEQ tZ ORA #%10000000 ; Set bit 7 of A to indicate this commander file has ; been tampered with .tZ ORA #%01000000 ; Set bit 6 of A to denote that this is the Master ; version STA COK ; Store the updated competition flags in COK JSR CHECK2 ; Call CHECK2 to calculate the third checksum for the ; last saved commander and return it in A CMP CHK3 ; Test the calculated checksum against CHK3 IF _REMOVE_CHECKSUMS NOP ; If we have disabled checksums, then ignore the result NOP ; of the comparison and fall through into the next part ELSE BNE doitagain ; If the calculated checksum does not match CHK3, then ; loop back to repeat the check - in other words, we ; enter an infinite loop here, as the checksum routine ; will keep returning the same incorrect value ENDIF RTS ; Return from the subroutineName: DFAULT [Show more] Type: Subroutine Category: Start and end Summary: Reset the current commander data block to the last saved commanderContext: See this subroutine on its own page References: This subroutine is called as follows: * BR1 (Part 1 of 2) calls DFAULT * SVE calls DFAULT.TITLE STY distaway ; Store the ship distance in distaway PHA ; Store the token number on the stack for later STX TYPE ; Store the ship type in location TYPE IF _GMA_RELEASE LDA #$FF ; Set MULIE to $FF to indicate that the RESET routine is STA MULIE ; in-progress, so we don't try to stop any music that ; may be playing (as RESET updates the music variables, ; so trying to update the music variables will lead to ; unpredictable behaviour) ENDIF JSR RESET ; Reset our ship so we can use it for the rotating ; title ship IF _GMA_RELEASE LDA #0 ; Set MULIE to 0 to indicate that the RESET routine is STA MULIE ; no longer being run, so the stopbd routine can work ; again ENDIF JSR ZEKTRAN ; Call ZEKTRAN to clear the key logger LDA #32 ; Switch to the palette for the title view, though this JSR DOVDU19 ; doesn't actually do anything in this version of Elite LDA #13 ; Clear the top part of the screen, draw a border box, JSR TT66 ; and set the current view type in QQ11 to 13 (rotating ; ship view) ;LDA #RED ; These instructions are commented out in the original ;JSR DOCOL ; source LDA #0 ; Set QQ11 to 0, so from here on we are using a space STA QQ11 ; view LDA #96 ; Set nosev_z hi = 96 (96 is the value of unity in the STA INWK+14 ; rotation vector) LDA #96 ; Set A = 96 as the distance that the ship starts at STA INWK+7 ; Set z_hi, the high byte of the ship's z-coordinate, ; to 96, which is the distance at which the rotating ; ship starts out before coming towards us LDX #127 ; Set roll counter = 127, so don't dampen the roll and STX INWK+29 ; make the roll direction clockwise STX INWK+30 ; Set pitch counter = 127, so don't dampen the pitch and ; set the pitch direction to dive INX ; Set QQ17 to 128 (so bit 7 is set) to switch to STX QQ17 ; Sentence Case, with the next letter printing in upper ; case LDA TYPE ; Set up a new ship, using the ship type in TYPE JSR NWSHP LDA #6 ; Move the text cursor to column 6 JSR DOXC LDA #30 ; Print recursive token 144 ("---- E L I T E ----") JSR plf ; followed by a newline LDA #10 ; Print a line feed to move the text cursor down a line JSR TT26 LDA #6 ; Move the text cursor to column 6 again JSR DOXC LDA PATG ; If PATG = 0, skip the following two lines, which BEQ awe ; print the author credits (PATG can be toggled by ; pausing the game and pressing "X") LDA #13 ; Print extended token 13 ("BY D.BRABEN & I.BELL") JSR DETOK .awe LDA brkd ; If brkd = 0, jump to BRBR2 to skip the following, as BEQ BRBR2 ; we do not have a system error message to display INC brkd ; Increment the brkd counter LDA #7 ; Move the text cursor to column 7 JSR DOXC LDA #10 ; Move the text cursor to row 10 JSR DOYC ; The following loop prints out the null-terminated ; message pointed to by ($FD $FE), which is the OS ; error message pointer - so this prints the error ; message on the next line LDY #0 ; Set Y = 0 to act as a character counter JSR CHPR ; Print the character in A (which contains a line feed ; on the first loop iteration), and then any non-zero ; characters we fetch from the error message INY ; Increment the loop counter LDA ($FD),Y ; Fetch the Y-th byte of the block pointed to by ; ($FD $FE), so that's the Y-th character of the message ; pointed to by the OS error message pointer BNE P%-6 ; If the fetched character is non-zero, loop back to the ; JSR CHPR above to print it, and keep looping until ; we fetch a zero (which marks the end of the message) .BRBR2 LDY #0 ; Set DELTA = 0 (i.e. ship speed = 0) STY DELTA STY JSTK ; Set JSTK = 0 (i.e. keyboard, not joystick) LDA #15 ; Move the text cursor to row 15 STA YC LDA #1 ; Move the text cursor to column 1 STA XC PLA ; Restore the recursive token number we stored on the ; stack at the start of this subroutine ;JSR ex ; This instruction is commented out in the original ; source (it would print the recursive token in A) JSR DETOK ; Print the extended token in A LDA #3 ; Move the text cursor to column 3 JSR DOXC LDA #12 ; Print extended token 12 ("{single cap}C) {single JSR DETOK ; cap}D.{single cap}BRABEN & {single cap}I.{single ; cap}BELL 1985") LDA #12 ; Set CNT2 = 12 as the outer loop counter for the loop STA CNT2 ; starting at TLL2 LDA #5 ; Set the main loop counter in MCNT to 5, to act as the STA MCNT ; inner loop counter for the loop starting at TLL2 LDA #$FF ; Set JSTK = $FF (i.e. joystick, not keyboard), which STA JSTK ; we will change later if joysticks are not chosen .TLL2 LDA INWK+7 ; If z_hi (the ship's distance) is 1, jump to TL1 to CMP #1 ; skip the following decrement BEQ TL1 DEC INWK+7 ; Decrement the ship's distance, to bring the ship ; a bit closer to us .TL1 JSR MVEIT ; Move the ship in space according to the orientation ; vectors and the new value in z_hi LDX distaway ; Set z_lo to the distance value we passed to the STX INWK+6 ; routine, so this is the closest the ship gets to us LDA MCNT ; This has no effect - it is presumably left over from AND #3 ; the other versions of Elite which only scan the ; keyboard once every four loops, but that isn't the ; case here as the result is not acted upon LDA #0 ; Set x_lo = 0, so the ship remains in the screen centre STA INWK STA INWK+3 ; Set y_lo = 0, so the ship remains in the screen centre JSR LL9 ; Call LL9 to display the ship JSR RDKEY ; Scan the keyboard for a key press and return the ; key in X (or 0 for no key press) ; ; This also clears the C flag if no keys are being ; pressed DEC MCNT ; Decrement the main loop counter BIT KY7 ; If the joystick's fire button is being pressed, jump BMI TL3 ; to TL3 to leave joysticks configured (i.e. JSTK = $FF) BCC TLL2 ; If no key is being pressed then the C flag will be ; clear from the call to RDKEY, so loop back up to ; move/rotate the ship and check again for a key press INC JSTK ; The joystick fire button was not pressed, so set JSTK ; to 0 (it was set to $FF above), to enable keyboard and ; disable joysticks .TL3 RTS ; Return from the subroutineName: TITLE [Show more] Type: Subroutine Category: Start and end Summary: Display a title screen with a rotating ship and promptContext: See this subroutine on its own page References: This subroutine is called as follows: * BR1 (Part 1 of 2) calls TITLE * BR1 (Part 2 of 2) calls TITLE
Display the title screen, with a rotating ship and a text token at the bottom of the screen.
Arguments: A The number of the extended token to show below the rotating ship (see variable TKN1 for details of recursive tokens) X The type of the ship to show (see variable XX21 for a list of ship types) Y The distance to show the ship rotating, once it has finished moving towards us
Returns: X If a key is being pressed, X contains the ASCII code of the key pressed.CHECK LDX #NT%-3 ; Set X to the size of the commander data block, less ; 3 (as there are two checksum bytes and the save count) CLC ; Clear the C flag so we can do addition without the ; C flag affecting the result TXA ; Seed the checksum calculation by setting A to the ; size of the commander data block, less 2 ; We now loop through the commander data block, ; starting at the end and looping down to the start ; (so at the start of this loop, the X-th byte is the ; last byte of the commander data block, i.e. the save ; count) .QUL2 ADC NA%+7,X ; Add the X-1-th byte of the data block to A, plus the ; C flag EOR NA%+8,X ; EOR A with the X-th byte of the data block DEX ; Decrement the loop counter BNE QUL2 ; Loop back for the next byte in the calculation, until ; we have added byte #0 and EOR'd with byte #1 of the ; data block RTS ; Return from the subroutineName: CHECK [Show more] Type: Subroutine Category: Save and load Summary: Calculate the checksum for the last saved commander data block Deep dive: Commander save filesContext: See this subroutine on its own page References: This subroutine is called as follows: * DFAULT calls CHECK * SVE calls CHECK
The checksum for the last saved commander data block is saved as part of the commander file, in two places (CHK AND CHK2), to protect against file tampering. This routine calculates the checksum and returns it in A. This algorithm is also implemented in elite-checksum.py.
Returns: A The checksum for the last saved commander data block.CHECK2 LDX #NT%-3 ; Set X to the size of the commander data block, less ; 3 (as there are two checksum bytes and the save count) CLC ; Clear the C flag so we can do addition without the ; C flag affecting the result TXA ; Seed the checksum calculation by setting A to the ; size of the commander data block, less 2 ; We now loop through the commander data block, ; starting at the end and looping down to the start ; (so at the start of this loop, the X-th byte is the ; last byte of the commander data block, i.e. the save ; count) .QU2L2 STX T ; Set A = A EOR X EOR T ; ROR A ; This additional step is the only difference between ; the original checksum from BBC Micro Elite (in CHECK), ; and this additional checksum in the Commodore 64 and ; Apple II versions ADC NA%+7,X ; Add the X-1-th byte of the data block to A, plus the ; C flag EOR NA%+8,X ; EOR A with the X-th byte of the data block DEX ; Decrement the loop counter BNE QU2L2 ; Loop back for the next byte in the calculation, until ; we have added byte #0 and EOR'd with byte #1 of the ; data block RTS ; Return from the subroutineName: CHECK2 [Show more] Type: Subroutine Category: Save and load Summary: Calculate the third checksum for the last saved commander data block (Commodore 64 and Apple II versions only)Context: See this subroutine on its own page References: This subroutine is called as follows: * DFAULT calls CHECK2 * SVE calls CHECK2.JAMESON LDY #(NAEND%-NA2%) ; We are going to copy the default commander at NA2% ; over the top of the last saved commander at NA%, so ; set a counter to copy all the bytes between NA2% and ; NAEND% .JAMEL1 LDA NA2%,Y ; Copy the Y-th byte of NA2% to the Y-th byte of NA% STA NA%,Y DEY ; Decrement the loop counter BPL JAMEL1 ; Loop back until we have copied the whole commander LDY #7 ; Set oldlong to 7, the length of the commander name STY oldlong ; "JAMESON" RTS ; Return from the subroutine.TRNME LDX #7 ; The commander's name can contain a maximum of 7 ; characters, and is terminated by a carriage return, ; so set up a counter in X to copy 8 characters LDA thislong ; Copy the length of the commander's name from thislong STA oldlong ; to oldlong (though this is never used, so this ; doesn't have any effect) .GTL1 LDA INWK+5,X ; Copy the X-th byte of INWK+5 to the X-th byte of NA% STA NA%,X DEX ; Decrement the loop counter BPL GTL1 ; Loop back until we have copied all 8 bytes ; Fall through into TR1 to copy the name back from NA% ; to INWK. This isn't necessary as the name is already ; there, but it does save one byte, as we don't need an ; RTS hereName: TRNME [Show more] Type: Subroutine Category: Save and load Summary: Copy the last saved commander's name from INWK to NA%Context: See this subroutine on its own page References: This subroutine is called as follows: * SVE calls TRNME.TR1 LDX #7 ; The commander's name can contain a maximum of 7 ; characters, and is terminated by a carriage return, ; so set up a counter in X to copy 8 characters .GTL2 LDA NA%,X ; Copy the X-th byte of NA% to the X-th byte of INWK+5 STA INWK+5,X DEX ; Decrement the loop counter BPL GTL2 ; Loop back until we have copied all 8 bytes RTS ; Return from the subroutineName: TR1 [Show more] Type: Subroutine Category: Save and load Summary: Copy the last saved commander's name from NA% to INWKContext: See this subroutine on its own page References: This subroutine is called as follows: * GTNMEW calls TR1.GTNMEW ;LDY #8 ; These instructions are commented out in the original ;JSR DELAY ; source .GTNME LDX #4 ; First we want to copy the drive and directory part of ; the commander file from NA%-5, so set a counter in X ; for 5 bytes, as the string is of the form ":0.E." .GTL3 LDA NA%-5,X ; Copy the X-th byte from NA%-5 to INWK STA INWK,X DEX ; Decrement the loop counter BPL GTL3 ; Loop back until the whole drive and directory string ; has been copied to INWK to INWK+4 LDA #7 ; The call to MT26 below uses the OSWORD block at RLINE STA RLINE+2 ; to fetch the line, and RLINE+2 defines the maximum ; line length allowed, so this changes the maximum ; length to 7 (as that's the longest commander name ; allowed) LDA #8 ; Print extended token 8 ("{single cap}COMMANDER'S JSR DETOK ; NAME? ") JSR MT26 ; Call MT26 to fetch a line of text from the keyboard ; to INWK+5, with the text length in Y, so INWK now ; contains the full pathname of the file, as in ; ":0.E.JAMESON", for example LDA #9 ; Reset the maximum length in RLINE+2 to the original STA RLINE+2 ; value of 9 TYA ; The OSWORD call returns the length of the commander's ; name in Y, so transfer this to A BEQ TR1 ; If A = 0, no name was entered, so jump to TR1 to copy ; the last saved commander's name from NA% to INWK ; and return from the subroutine there STY thislong ; Store the length of the length of the commander's that ; was entered in thislong RTS ; Return from the subroutineName: GTNMEW [Show more] Type: Subroutine Category: Save and load Summary: Fetch the name of a commander file to save or loadContext: See this subroutine on its own page References: This subroutine is called as follows: * SVE calls GTNMEW
Get the commander's name for loading or saving a commander file. The name is stored in the INWK workspace and is terminated by a return character (13). If ESCAPE is pressed or a blank name is entered, then the name stored is set to the name from the last saved commander block.
Returns: INWK The full filename, including drive and directory, in the form ":0.E.JAMESON", for example, terminated by a return character (13).MT26 LDA #MAG2 ; Switch the text colour to purple STA COL2 LDY #8 ; Wait for 8/50 of a second (0.16 seconds) on PAL JSR DELAY ; systems, or 8/60 of a second (0.13 seconds) on NTSC JSR FLKB ; Call FLKB to flush the keyboard buffer LDY #0 ; Set Y = 0 to hold the length of the text entered .OSW0L JSR TT217 ; Scan the keyboard until a key is pressed, and return ; the key's ASCII code in A (and X) CMP #13 ; If RETURN was pressed, jump to OSW03 BEQ OSW03 CMP #27 ; If ESCAPE was pressed, jump to OSW04 BEQ OSW04 CMP #127 ; If DELETE was pressed, jump to OSW05 BEQ OSW05 CPY RLINE+2 ; If Y >= RLINE+2 (the maximum line length from the BCS OSW01 ; OSWORD configuration block at RLINE), then jump to ; OSW01 to give an error beep as we have reached the ; character limit CMP RLINE+3 ; If the key pressed is less than the character in BCC OSW01 ; RLINE+3 (the lowest allowed character from the OSWORD ; configuration block at RLINE), then jump to OSW01 ; to give an error beep as the key pressed is out of ; range CMP RLINE+4 ; If the key pressed is greater than or equal to the BCS OSW01 ; character in RLINE+4 (the highest allowed character ; from the OSWORD configuration block at RLINE), then ; jump to OSW01 to give an error beep as the key ; pressed is out of range STA INWK+5,Y ; Store the key's ASCII code in the Y-th byte of INWK+5 INY ; Increment Y to point to the next free byte in INWK+5 EQUB $2C ; Skip the next instruction by turning it into ; $2C $A9 $07, or BIT $07A9, which does nothing apart ; from affect the flags .OSW01 LDA #7 ; Set A to the beep character, so the next instruction ; makes a system beep .OSW06 JSR CHPR ; Print the character in A (and clear the C flag) BCC OSW0L ; Loop back to OSW0L to fetch another key press (this ; BCC is effectively a JMP as CHPR clears the C flag) .OSW03 STA INWK+5,Y ; Store the return character in the Y-th byte of INWK+5 LDA #$10 ; Switch the text colour to white STA COL2 LDA #12 ; Print a newline and return from the subroutine using a JMP CHPR ; tail call .OSW04 LDA #$10 ; Switch the text colour to white STA COL2 SEC ; Set the C flag as ESCAPE was pressed RTS ; Return from the subroutine .OSW05 TYA ; If the length of the line so far in Y is 0, then we BEQ OSW01 ; just pressed DELETE on an empty line, so jump to ; OSW01 give an error beep DEY ; Otherwise we want to delete a character, so decrement ; the length of the line so far in Y LDA #127 ; Set A = 127 and jump back to OSW06 to print the BNE OSW06 ; character in A (i.e. the DELETE character) and listen ; for the next key pressName: MT26 [Show more] Type: Subroutine Category: Text Summary: Fetch a line of text from the keyboard Deep dive: Extended text tokensContext: See this subroutine on its own page References: This subroutine is called as follows: * GTNMEW calls MT26 * JMTB calls MT26
Returns: Y The size of the entered text, or 0 if none was entered INWK+5 The entered text, terminated by a carriage return C flag Set if ESCAPE was pressed.RLINE EQUW INWK+5 ; The address to store the input, so the text entered ; will be stored in INWK+5 as it is typed EQUB 9 ; Maximum line length = 9, as that's the maximum size ; for a commander's name including a directory name EQUB '!' ; Allow ASCII characters from "!" through to "{" in EQUB '{' ; the inputName: RLINE [Show more] Type: Variable Category: Text Summary: The OSWORD configuration block used to fetch a line of text from the keyboardContext: See this variable on its own page References: This variable is used as follows: * GTNMEW uses RLINE * MT26 uses RLINE
This block is left over from the BBC Micro version of Elite and is not used in this version..FILEPR LDA #3 ; Print extended token 3 + DISK, i.e. token 3 or 2 (as CLC ; DISK can be 0 or $FF). Token 2 is "disk" and token 3 ADC DISK ; is "tape", so this displays the currently selected JMP DETOK ; mediaName: FILEPR [Show more] Type: Subroutine Category: Save and load Summary: Display the currently selected media (disk or tape) Deep dive: Extended text tokensContext: See this subroutine on its own page References: This subroutine is called as follows: * JMTB calls FILEPR.OTHERFILEPR LDA #2 ; Print extended token 2 - DISK, i.e. token 2 or 3 (as SEC ; DISK can be 0 or $FF). Token 2 is "disk" and token 3 SBC DISK ; is "tape", so this displays the other, non-selected JMP DETOK ; mediaName: OTHERFILEPR [Show more] Type: Subroutine Category: Save and load Summary: Display the non-selected media (disk or tape) Deep dive: Extended text tokensContext: See this subroutine on its own page References: This subroutine is called as follows: * JMTB calls OTHERFILEPR.ZERO LDX #(de-FRIN) ; We're going to zero the UP workspace variables from ; FRIN to de, so set a counter in X for the correct ; number of bytes LDA #0 ; Set A = 0 so we can zero the variables .ZEL2 STA FRIN,X ; Zero the X-th byte of FRIN to de DEX ; Decrement the loop counter BPL ZEL2 ; Loop back to zero the next variable until we have done ; them all RTS ; Return from the subroutineName: ZERO [Show more] Type: Subroutine Category: Utility routines Summary: Reset the local bubble of universe and ship statusContext: See this subroutine on its own page References: This subroutine is called as follows: * RES2 calls ZERO * RESET calls ZERO
This resets the following workspaces to zero: * UP workspace variables from FRIN to de, which include the ship slots for the local bubble of universe, and various flight and ship status variables.ZEBC RTS ; Return from the subroutine, as ZEBC does nothing in ; this version of Elite (it is left over from the BBC ; Micro version) LDX #$C ; Call ZES1 with X = $C to zero-fill page $C JSR ZES1 DEX ; Decrement X to $B ; Fall through into ZES1 to zero-fill page $BName: ZEBC [Show more] Type: Subroutine Category: Utility routines Summary: Zero-fill pages $B and $CContext: See this subroutine on its own page References: No direct references to this subroutine in this source file.ZES1 LDY #0 ; If we set Y = SC = 0 and fall through into ZES2 STY SC ; below, then we will zero-fill 255 bytes starting from ; SC - in other words, we will zero-fill the whole of ; page XName: ZES1 [Show more] Type: Subroutine Category: Utility routines Summary: Zero-fill the page whose number is in XContext: See this subroutine on its own page References: This subroutine is called as follows: * ZEBC calls ZES1
Arguments: X The page we want to zero-fill.ZES2 LDA #0 ; Load A with the byte we want to fill the memory block ; with - i.e. zero STX SC+1 ; We want to zero-fill page X, so store this in the ; high byte of SC, so the 16-bit address in SC and ; SC+1 is now pointing to the SC-th byte of page X .ZEL1 STA (SC),Y ; Zero the Y-th byte of the block pointed to by SC, ; so that's effectively the Y-th byte before SC INY ; Increment the loop counter BNE ZEL1 ; Loop back to zero the next byte RTS ; Return from the subroutineName: ZES2 [Show more] Type: Subroutine Category: Utility routines Summary: Zero-fill a specific pageContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
Zero-fill from address (X SC) + Y to (X SC) + $FF.
Arguments: X The high byte (i.e. the page) of the starting point of the zero-fill Y The offset from (X SC) where we start zeroing, counting up to $FF SC The low byte (i.e. the offset into the page) of the starting point of the zero-fill
Returns: Z flag Z flag is set.SVE LDA #1 ; Print extended token 1, the disk access menu, which JSR DETOK ; presents these options: ; ; 1. Load New Commander ; 2. Save Commander {commander name} ; 3. Change to {other media} ; 4. Default JAMESON ; 5. Exit JSR t ; Scan the keyboard until a key is pressed, returning ; the ASCII code in A and X CMP #'1' ; Option 1 was chosen, so jump to loading to load a new BEQ loading ; commander CMP #'2' ; Option 2 was chosen, so jump to SV1 to save the BEQ SV1 ; current commander CMP #'3' ; Option 3 was chosen, so jump to feb10 to change to the BEQ feb10 ; other media CMP #'4' ; If option 4 wasn't chosen, jump to feb13 to exit the BNE feb13 ; menu LDA #224 ; Option 4 was chosen, so print extended token 224 JSR DETOK ; ("ARE YOU SURE?") JSR YESNO ; Call YESNO to wait until either "Y" or "N" is pressed BCC feb13 ; If "N" was pressed, jump to feb13 JSR JAMESON ; Otherwise "Y" was pressed, so call JAMESON to set the ; last saved commander to the default "JAMESON" ; commander JMP DFAULT ; Jump to DFAULT to reset the current commander data ; block to the last saved commander, returning from the ; subroutine using a tail call .feb13 CLC ; Option 5 was chosen, so clear the C flag to indicate ; that nothing was loaded RTS ; Return from the subroutine .feb10 LDA DISK ; Toggle the value of DISK between 0 and $FF to swap the EOR #$FF ; current media between tape and disk STA DISK JMP SVE ; Jump to SVE to display the disk access menu and return ; from the subroutine using a tail call .loading JSR GTNMEW ; If we get here then option 1 (load) was chosen, so ; call GTNMEW to fetch the name of the commander file ; to load (including drive number and directory) into ; INWK JSR LOD ; Call LOD to load the commander file JSR TRNME ; Transfer the commander filename from INWK to NA% SEC ; Set the C flag to indicate we loaded a new commander .jan2186 RTS ; Return from the subroutine .SV1 JSR GTNMEW ; If we get here then option 2 (save) was chosen, so ; call GTNMEW to fetch the name of the commander file ; to save (including drive number and directory) into ; INWK JSR TRNME ; Transfer the commander filename from INWK to NA% LSR SVC ; Halve the save count value in SVC LDA #4 ; Print extended token 4 ("COMPETITION NUMBER:") JSR DETOK LDX #NT% ; We now want to copy the current commander data block ; from location TP to the last saved commander block at ; NA%+8, so set a counter in X to copy the NT% bytes in ; the commander data block .SVL1 LDA TP,X ; Copy the X-th byte of TP to the X-th byte of NA%+8 ;STA $0B00,X ; STA NA%+8,X ; The STA is commented out in the original source DEX ; Decrement the loop counter BPL SVL1 ; Loop back until we have copied all the bytes in the ; commander data block JSR CHECK2 ; Call CHECK2 to calculate the third checksum for the ; last saved commander and return it in A STA CHK3 ; Store the checksum in CHK3, which is at the end of the ; last saved commander block JSR CHECK ; Call CHECK to calculate the checksum for the last ; saved commander and return it in A STA CHK ; Store the checksum in CHK, which is at the end of the ; last saved commander block PHA ; Store the checksum on the stack ORA #%10000000 ; Set K = checksum with bit 7 set STA K EOR COK ; Set K+2 = K EOR COK (the competition flags) STA K+2 EOR CASH+2 ; Set K+1 = K+2 EOR CASH+2 (the third cash byte) STA K+1 EOR #$5A ; Set K+3 = K+1 EOR $5A EOR TALLY+1 (the high byte of EOR TALLY+1 ; the kill tally) STA K+3 CLC ; Clear the C flag so the call to BPRNT does not include ; a decimal point JSR BPRNT ; Print the competition number stored in K to K+3. The ; value of U might affect how this is printed, and as ; it's a temporary variable in zero page that isn't ; reset by ZERO, it might have any value, but as the ; competition code is a 10-digit number, this just means ; it may or may not have an extra space of padding JSR TT67 ; Call TT67 twice to print two newlines JSR TT67 PLA ; Restore the checksum from the stack ;STA $0B00+NT% ; This instruction is commented out in the original ; source EOR #$A9 ; Store the checksum EOR $A9 in CHK2, the penultimate STA CHK2 ; byte of the last saved commander block ;STA $AFF+NT% ; This instruction is commented out in the original ; source ;LDA #0 ; These instructions are commented out in the original ;JSR QUS1 ; source JSR KERNALSETUP ; Set up memory so we can use the Kernal functions, ; which includes swapping the contents of zero page with ; the page at $CE00 (so the Kernal functions get a zero ; page that works for them, and any changes they make do ; not corrupt the game's zero page variables) ; ; This also enables interrupts that are generated by ; timer A underflow LDA #LO(NA%+8) ; Set $FD(1 0) = NA%+8 STA $FD ; LDA #HI(NA%+8) ; This sets the address at zero page location $FD and STA $FE ; $FD+1 to NA%+8, which is the address of the commander ; data that we want to save LDA #$FD ; Call the Kernal's SAVE function to save the commander LDX #LO(CHK+1) ; file as follows: LDY #HI(CHK+1) ; JSR KERNALSVE ; * A = address in zero page of the start address of ; the memory block to save, so this makes SAVE ; save the data from NA%+8 onwards ; ; * (Y X) = address of the end of the block of memory ; to save + 1, so this makes SAVE save the ; data from NA%+8 to CHK (inclusive) PHP ; If something goes wrong with the save then the C flag ; will be set, so save this on the stack so we can check ; it below SEI ; Disable interrupts while we configure the CIA and ; VIC-II BIT CIA+$D ; Reading from register $D of CIA1 will acknowledge any ; interrupts and clear them, so this line acknowledges ; any pending interrupts that might be waiting to be ; processed (using a BIT reads the location without ; changing any CPU registers - it only affects the ; flags, which we can simply ignore) LDA #%00000001 ; Set CIA1 register $0D to enable and disable interrupts STA CIA+$D ; as follows: ; ; * Bit 0 set = configure interrupts generated by ; timer A underflow ; ; * Bits 1-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, while leaving other interrupts as ; they are 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 #%100 ; Call SETL1 to set the 6510 input/output port to the JSR SETL1 ; following: ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; 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 CLI ; Enable interrupts again JSR SWAPPZERO ; The call to KERNALSETUP above swapped the contents of ; zero page with the page at $CE00, to ensure the Kernal ; routines ran with their copy of zero page rather than ; the game's zero page ; ; We are done using the Kernal functions, so now we swap ; them back so the Kernal's zero page is moved to $CE00 ; again, ready for next time, and the game's zero page ; variables are once again set up, ready for the game ; code to use PLP ; Retrieve the processor flags that we stashed after the ; call to KERNALSVE above CLI ; Enable interrupts to make sure the PHP doesn't disable ; interrupts (which it could feasibly do by restoring a ; set I flag) BCS saveerror ; If KERNALSVE returns with the C flag set then this ; indicates that a save error occurred, so jump to ; tapeerror via saveerror to print either "TAPE ERROR" ; or "DISK ERROR" JSR DFAULT ; Call DFAULT to reset the current commander data block ; to the last saved commander JSR t ; Scan the keyboard until a key is pressed, returning ; the ASCII code in A and X .SVEX CLC ; Clear the C flag to indicate we didn't just load a new ; commander file RTS ; Return from the subroutine .saveerror JMP tapeerror ; Jump to tapeerror to print either "TAPE ERROR" or ; "DISK ERROR" (this JMP enables us to use a branch ; instruction to jump to tapeerror)Name: SVE [Show more] Type: Subroutine Category: Save and load Summary: Display the disk access menu and process saving of commander files Deep dive: Commander save files The competition codeContext: See this subroutine on its own page References: This subroutine is called as follows: * BR1 (Part 1 of 2) calls SVE * LOD calls SVE * tapeerror calls SVE * TT102 calls SVE.thislong EQUB 7Name: thislong [Show more] Type: Variable Category: Save and load Summary: Contains the length of the most recently entered commander nameContext: See this variable on its own page References: This variable is used as follows: * GTNMEW uses thislong * KERNALSETUP uses thislong * TRNME uses thislong.oldlong EQUB 7.KERNALSETUP JSR SWAPPZERO ; Swap the contents of zero page with the page at $CE00, ; which we filled with the contents of zero page when we ; started the game ; ; This ensures that the Kernal functions get a zero page ; that works for them, and we can repeat the swap once ; we are done with the Kernal functions to ensure any ; changes they make do not corrupt the game's zero page ; variables LDA #%110 ; Set A to pass to the call to SETL1 so we page the ; Kernal ROM and I/O into the memory map SEI ; Disable interrupts so we can scan the keyboard ; without being hijacked JSR SETL1 ; Call SETL1 to set the 6510 input/output port to the ; following: ; ; * LORAM = 0 ; * HIRAM = 1 ; * 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, and ; $E000-$FFFF, which gets mapped to the Kernal ROM ; ; See the memory map at the bottom of page 264 in the ; Programmer's Reference Guide LDA #0 ; Clear bits 0-3 in VIC register $1A to disable the STA VIC+$1A ; following interrupts: ; ; * Bit 0 = raster interrupt ; ; * Bit 1 = sprite-background collision interrupt ; ; * Bit 2 = sprite-sprite collision interrupt ; ; * Bit 3 = light pen interrupt CLI ; Allow interrupts again (or, as a comment in the ; original source says, "tell Ian to go away") LDA #%10000001 ; Set CIA1 register $0D to enable and disable interrupts STA CIA+$D ; as follows: ; ; * Bit 0 set = configure interrupts generated by ; timer A underflow ; ; * Bits 1-4 clear = do not change configuration of ; other interrupts ; ; * Bit 7 set = enable interrupts whose corresponding ; bits are set ; ; So this enables interrupts that are generated by timer ; A underflow, while leaving other interrupts as they ; are LDA #%11000000 ; Call the Kernal's SETMSG function to set the system JSR KERNALSETMSG ; error display switch as follows: ; ; * Bit 6 set = display I/O error messages ; ; * Bit 7 set = display system messages ; ; This ensures that any file system errors are shown LDX DISK ; Set X = DISK + 1 INX ; ; DISK is $FF (i.e. -1) for disk and 0 for tape, so this ; sets X to 0 for disk and 1 for tape LDA filesys,X ; Set X to the device number for the current media from TAX ; the lookup tape at filesys, so X is now 1 for tape or ; 8 for disk LDA #1 ; Call the Kernal's SETLFS function to set the file LDY #0 ; parameters as follows: JSR KERNALSETLFS ; ; * A = logical number 1 ; ; * X = device number 1 (tape) or 8 (disk) ; ; * Y = secondary address 0 ; ; The last setting enables us to specify a load address ; in (Y X) when using the Kernal's LOAD function to load ; a commander file in the LOD routine ; Before calling KERNALSETUP, the filename we want to ; work with has already been put into INWK+5 by the MT26 ; routine, with the length of the filename in thislong ; ; The address of the filename is INWK+5 because the ; first five characters of INWK contain a BBC Micro ; pathname like ":0.E.", which we can ignore in the ; Commodore 64 version LDA thislong ; Call SETNAM to set the filename parameters as LDX #(INWK+5) ; follows: LDY #0 ; JMP KERNALSETNAM ; * A = filename length ; ; * (Y X) = address of filename (Y is set to zero as ; INWK is in zero page) ; ; The call to SETNAM returns from the subroutine using ; a tail callName: KERNALSETUP [Show more] Type: Subroutine Category: Save and load Summary: Set up memory and interrupts so we can use the Kernal functions and configure the file system device number and filenameContext: See this subroutine on its own page References: This subroutine is called as follows: * LOD calls KERNALSETUP * SVE calls KERNALSETUP.GTDRV LDA #2 ; Print extended token 2 ("{cr}WHICH DRIVE?") JSR DETOK JSR t ; Scan the keyboard until a key is pressed, returning ; the ASCII code in A and X ORA #%00010000 ; Set bit 4 of A, perhaps to avoid printing any control ; characters in the next instruction JSR CHPR ; Print the character in A PHA ; Store A on the stack so we can retrieve it after the ; call to FEED JSR FEED ; Print a newline PLA ; Restore A from the stack CMP #'0' ; If A < ASCII "0", then it is not a valid drive number, BCC LOR ; so jump to LOR to set the C flag and return from the ; subroutine CMP #'4' ; If A >= ASCII "4", then it is not a valid drive ; number, and this CMP sets the C flag, otherwise it is ; a valid drive number in the range 0-3, so clear it RTS ; Return from the subroutineName: GTDRV [Show more] Type: Subroutine Category: Save and load Summary: Get an ASCII disk drive number from the keyboardContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
Returns: A The ASCII value of the entered drive number ("0" to "3") C flag Clear if a valid drive number was entered (0-3), set otherwise.filesys EQUB 8 ; The device number for disk EQUB 1 ; The device number for tapeName: filesys [Show more] Type: Variable Category: Save and load Summary: A lookup table containing the device numbers for tape and diskContext: See this variable on its own page References: This variable is used as follows: * KERNALSETUP uses filesys.LOD JSR KERNALSETUP ; Set up memory so we can use the Kernal functions, ; which includes swapping the contents of zero page with ; the page at $CE00 (so the Kernal functions get a zero ; page that works for them, and any changes they make do ; not corrupt the game's zero page variables) LDA #0 ; Call the Kernal's LOAD function to load the commander LDX #LO(TAP%) ; file as follows: LDY #HI(TAP%) ; JSR KERNALLOAD ; * A = 0 to initiate a load operation ; ; * (Y X) = load address, so we load the commander to ; address TAP% PHP ; If something goes wrong with the save then the C flag ; will be set, so save this on the stack so we can check ; it below LDA #%00000001 ; Set CIA1 register $0D to enable and disable interrupts STA CIA+$D ; as follows: ; ; * Bit 0 set = configure interrupts generated by ; timer A underflow ; ; * Bits 1-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, while leaving other interrupts as ; they are SEI ; Disable interrupts while we configure the VIC-II 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 #%100 ; Call SETL1 to set the 6510 input/output port to the JSR SETL1 ; following: ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; 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 CLI ; Enable interrupts again JSR SWAPPZERO ; The call to KERNALSETUP above swapped the contents of ; zero page with the page at $CE00, to ensure the Kernal ; routines ran with their copy of zero page rather than ; the game's zero page ; ; We are done using the Kernal functions, so now we swap ; them back so the Kernal's zero page is moved to $CE00 ; again, ready for next time, and the game's zero page ; variables are once again set up, ready for the game ; code to use PLP ; Retrieve the processor flags that we stashed after the ; call to KERNALLOAD above CLI ; Enable interrupts to make sure the PHP doesn't disable ; interrupts (which it could feasibly do by restoring a ; set I flag) BCS tapeerror ; If KERNALLOAD returns with the C flag set then this ; indicates that a load error occurred, so jump to ; tapeerror to print either "TAPE ERROR" or "DISK ERROR" LDA TAP% ; If the first byte of the loaded file has bit 7 set, BMI ELT2F ; jump to ELT2F, as this is an invalid commander file ; ; ELT2F contains a BRK instruction, which will force an ; interrupt to call the address in BRKV, which will ; print out the system error at ELT2F LDY #NT% ; We have successfully loaded the commander file to the ; TAP% staging area, so now we want to copy it to the ; last saved commander data block at NA%+8, so we set up ; a counter in Y to copy NT% bytes .copyme LDA TAP%,Y ; Copy the Y-th byte of TAP% to the Y-th byte of NA%+8 STA NA%+8,Y DEY ; Decrement the loop counter BPL copyme ; Loop back until we have copied all NT% bytes .LOR SEC ; Set the C flag RTS ; Return from the subroutine .ELT2F LDA #9 ; Print extended token 9 ("{cr}{all caps}ILLEGAL ELITE JSR DETOK ; II FILE{sentence case}") JSR t ; Scan the keyboard until a key is pressed, returning ; the ASCII code in A and X JMP SVE ; Jump to SVE to display the disk access menu and return ; from the subroutine using a tail callName: LOD [Show more] Type: Subroutine Category: Save and load Summary: Load a commander fileContext: See this subroutine on its own page References: This subroutine is called as follows: * SVE calls LOD * GTDRV calls via LOR
The filename should be stored at INWK, terminated with a carriage return (13).
Other entry points: LOR Set the C flag and return from the subroutine.backtonormal RTS ; Return from the subroutine, as backtonormal does ; nothing in this version of Elite (it is left over from ; the 6502 Second Processor version)Name: backtonormal [Show more] Type: Subroutine Category: Utility routines Summary: Disable the keyboard, set the SVN flag to 0, and return with A = 0Context: See this subroutine on its own page References: This subroutine is called as follows: * BRBR calls backtonormal
This routine is unused in this version of Elite (it is left over from the 6502 Second Processor version)..tapeerror LDA #255 ; Print extended token 255 ("{cr}{currently selected JSR DETOK ; media} ERROR") JSR t ; Scan the keyboard until a key is pressed, returning ; the ASCII code in A and X JMP SVE ; Jump to SVE to display the disk access menu and return ; from the subroutine using a tail call.CLDELAY RTS ; Return from the subroutine, as CLDELAY does nothing in ; this version of Elite (it is left over from the 6502 ; Second Processor version)Name: CLDELAY [Show more] Type: Subroutine Category: Utility routines Summary: Delay by iterating through 5 * 256 (1280) empty loopsContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
This routine is unused in this version of Elite (it is left over from the 6502 Second Processor version)..ZEKTRAN LDX #64 ; We want to clear the 65 key logger locations from ; KEYLOOK to KEYLOOK+64, so set a counter in X LDA #0 ; We want to zero the key logger buffer, so set A % 0 STA thiskey ; Reset the value of thiskey in the key logger, which ; is used for logging keys that don't appear in the ; keyboard table .ZEKLOOP STA KEYLOOK,X ; Reset the X-th byte of the key logger buffer to 0 DEX ; Decrement the loop counter BPL ZEKLOOP ; Loop back until we have zeroed bytes #11 through #0 RTS ; Return from the subroutine RTS ; This instruction has no effect as we already returned ; from the subroutineName: ZEKTRAN [Show more] Type: Subroutine Category: Keyboard Summary: Clear the key loggerContext: See this subroutine on its own page References: This subroutine is called as follows: * BR1 (Part 1 of 2) calls ZEKTRAN * RDKEY calls ZEKTRAN * TITLE calls ZEKTRAN.SPS1 LDX #0 ; Copy the two high bytes of the planet's x-coordinate JSR SPS3 ; into K3(2 1 0), separating out the sign bit into K3+2 LDX #3 ; Copy the two high bytes of the planet's y-coordinate JSR SPS3 ; into K3(5 4 3), separating out the sign bit into K3+5 LDX #6 ; Copy the two high bytes of the planet's z-coordinate JSR SPS3 ; into K3(8 7 6), separating out the sign bit into K3+8 ; Fall through into TAS2 to build XX15 from K3Name: SPS1 [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Calculate the vector to the planet and store it in XX15Context: See this subroutine on its own page References: This subroutine is called as follows: * COMPAS calls SPS1 * Main flight loop (Part 9 of 16) calls SPS1 * TACTICS (Part 3 of 7) calls SPS1
Other entry points: SPS1+1 A BRK instruction.TAS2 LDA K3 ; OR the three low bytes and 1 to get a byte that has ORA K3+3 ; a 1 wherever any of the three low bytes has a 1 ORA K3+6 ; (as well as always having bit 0 set), and store in ORA #1 ; K3+9 STA K3+9 LDA K3+1 ; OR the three high bytes to get a byte in A that has a ORA K3+4 ; 1 wherever any of the three high bytes has a 1 ORA K3+7 ; (A K3+9) now has a 1 wherever any of the 16-bit ; values in K3 has a 1 .TAL2 ASL K3+9 ; Shift (A K3+9) to the left, so bit 7 of the high byte ROL A ; goes into the C flag BCS TA2 ; If the left shift pushed a 1 out of the end, then we ; know that at least one of the coordinates has a 1 in ; this position, so jump to TA2 as we can't shift the ; values in K3 any further to the left ASL K3 ; Shift K3(1 0), the x-coordinate, to the left ROL K3+1 ASL K3+3 ; Shift K3(4 3), the y-coordinate, to the left ROL K3+4 ASL K3+6 ; Shift K3(6 7), the z-coordinate, to the left ROL K3+7 BCC TAL2 ; Jump back to TAL2 to do another shift left (this BCC ; is effectively a JMP as we know bit 7 of K3+7 is not a ; 1, as otherwise bit 7 of A would have been a 1 and we ; would have taken the BCS above) .TA2 LDA K3+1 ; Fetch the high byte of the x-coordinate from our left- LSR A ; shifted K3, shift it right to clear bit 7, stick the ORA K3+2 ; sign bit in there from the x_sign part of K3, and STA XX15 ; store the resulting signed 8-bit x-coordinate in XX15 LDA K3+4 ; Fetch the high byte of the y-coordinate from our left- LSR A ; shifted K3, shift it right to clear bit 7, stick the ORA K3+5 ; sign bit in there from the y_sign part of K3, and STA XX15+1 ; store the resulting signed 8-bit y-coordinate in ; XX15+1 LDA K3+7 ; Fetch the high byte of the z-coordinate from our left- LSR A ; shifted K3, shift it right to clear bit 7, stick the ORA K3+8 ; sign bit in there from the z_sign part of K3, and STA XX15+2 ; store the resulting signed 8-bit z-coordinate in ; XX15+2 ; Now we have a signed 8-bit version of the vector K3 in ; XX15, so fall through into NORM to normalise itName: TAS2 [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Normalise the three-coordinate vector in K3Context: See this subroutine on its own page References: This subroutine is called as follows: * DOCKIT calls TAS2 * SPS4 calls TAS2 * TACTICS (Part 3 of 7) calls TAS2 * DOCKIT calls via TA2
Normalise the vector in K3, which has 16-bit values and separate sign bits, and store the normalised version in XX15 as a signed 8-bit vector. A normalised vector (also known as a unit vector) has length 1, so this routine takes an existing vector in K3 and scales it so the length of the new vector is 1. This is used in two places: when drawing the compass, and when applying AI tactics to ships. We do this in two stages. This stage shifts the 16-bit vector coordinates in K3 to the left as far as they will go without losing any bits off the end, so we can then take the high bytes and use them as the most accurate 8-bit vector to normalise. Then the next stage (in routine NORM) does the normalisation.
Arguments: K3(2 1 0) The 16-bit x-coordinate as (x_sign x_hi x_lo), where x_sign is just bit 7 K3(5 4 3) The 16-bit y-coordinate as (y_sign y_hi y_lo), where y_sign is just bit 7 K3(8 7 6) The 16-bit z-coordinate as (z_sign z_hi z_lo), where z_sign is just bit 7
Returns: XX15 The normalised vector, with: * The x-coordinate in XX15 * The y-coordinate in XX15+1 * The z-coordinate in XX15+2
Other entry points: TA2 Calculate the length of the vector in XX15 (ignoring the low coordinates), returning it in Q.NORM LDA XX15 ; Fetch the x-coordinate into A JSR SQUA ; Set (A P) = A * A = x^2 STA R ; Set (R Q) = (A P) = x^2 LDA P STA Q LDA XX15+1 ; Fetch the y-coordinate into A JSR SQUA ; Set (A P) = A * A = y^2 STA T ; Set (T P) = (A P) = y^2 LDA P ; Set (R Q) = (R Q) + (T P) = x^2 + y^2 ADC Q ; STA Q ; First, doing the low bytes, Q = Q + P LDA T ; And then the high bytes, R = R + T ADC R STA R LDA XX15+2 ; Fetch the z-coordinate into A JSR SQUA ; Set (A P) = A * A = z^2 STA T ; Set (T P) = (A P) = z^2 LDA P ; Set (R Q) = (R Q) + (T P) = x^2 + y^2 + z^2 ADC Q ; STA Q ; First, doing the low bytes, Q = Q + P LDA T ; And then the high bytes, R = R + T ADC R STA R JSR LL5 ; We now have the following: ; ; (R Q) = x^2 + y^2 + z^2 ; ; so we can call LL5 to use Pythagoras to get: ; ; Q = SQRT(R Q) ; = SQRT(x^2 + y^2 + z^2) ; ; So Q now contains the length of the vector (x, y, z), ; and we can normalise the vector by dividing each of ; the coordinates by this value, which we do by calling ; routine TIS2. TIS2 returns the divided figure, using ; 96 to represent 1 and 96 with bit 7 set for -1 LDA XX15 ; Call TIS2 to divide the x-coordinate in XX15 by Q, JSR TIS2 ; with 1 being represented by 96 STA XX15 LDA XX15+1 ; Call TIS2 to divide the y-coordinate in XX15+1 by Q, JSR TIS2 ; with 1 being represented by 96 STA XX15+1 LDA XX15+2 ; Call TIS2 to divide the z-coordinate in XX15+2 by Q, JSR TIS2 ; with 1 being represented by 96 STA XX15+2 .NO1 RTS ; Return from the subroutineName: NORM [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Normalise the three-coordinate vector in XX15 Deep dive: Tidying orthonormal vectors Orientation vectorsContext: See this subroutine on its own page References: This subroutine is called as follows: * TIDY calls NORM
We do this by dividing each of the three coordinates by the length of the vector, which we can calculate using Pythagoras. Once normalised, 96 ($60) is used to represent a value of 1, and 96 with bit 7 set ($E0) is used to represent -1. This enables us to represent fractional values of less than 1 using integers.
Arguments: XX15 The vector to normalise, with: * The x-coordinate in XX15 * The y-coordinate in XX15+1 * The z-coordinate in XX15+2
Returns: XX15 The normalised vector Q The length of the original XX15 vector
Other entry points: NO1 Contains an RTS.KEYLOOK SKIP 0 ; KEYLOOK and KLO share the same address ; ; [Show more]Name: KEYLOOK [Show more] Type: Workspace Address: $8D0C to $8D52 Category: Keyboard Summary: The key loggerContext: See this workspace on its own page References: This workspace is used as follows: * DKS4 uses KEYLOOK * RDKEY uses KEYLOOK * ZEKTRAN uses KEYLOOK
KEYLOOK (also known as KLO) is the Commodore 64 version's key logger. It does the same job as the KL key logger in the BBC Micro versions, but it has a very different structure, with one entry for every possible key press, rather than just one for each flight key. Specifically, it has one byte for each key in the Commodore 64 keyboard matrix, and it is laid out in the same order. The keyboard matrix is exposed to our code via port A on the CIA1 interface chip, through the memory-mapped locations $DC00 and $DC01. To read a key, you first set the column to scan by writing to $DC00, and the details of any key that is bring pressed in that column are returned in $DC01 (see the RDKEY routine for details). The keyboard matrix layout can be seen at https://sta.c64.org/cbm64kbdlay.html The KEYLOOK table mirrors the structure of the keyboard matrix, though it's reversed so that KEYLOOK maps to the keyboard matrix from the bottom corner of the above diagram, working right to left and down to up. (The RDKEY routine is responsible for filling the KEYLOOK table, and it chooses to work through the table in this direction). The RDKEY routine scans the keyboard matrix and sets each entry in KEYLOOK according to whether that key is being pressed. The entries that map to the flight keys have labels KY1 through KY7 for the main flight controls, and KY12 to KY20 for the secondary controls, so the main game code can check whether a key is being pressed by simply checking for non-zero values in the relevant KY entries. The order of the KY labels is strange because they are the same labels as in the BBC Micro version, and the order of the keys in the logger is completely different on the Commodore 64 (the labels are ordered from KY1 to KY7 and KY12 to KY20 in the BBC Micro version). The index of a key in the KEYLOOK table is referred to as the "internal key number" throughout this documentation, so the "@" key has an internal key number of 18 (or $12), for example, as it is stored at KEYLOOK+18. Note that the initial content of the KEYLOOK table is a simple repeated string of "123456789ABCDEF0", as this was used in the original source code to create the table during assembly. These initial values have no meaning.; ; This variable is used by the following: ; ; * DKS4 ; * RDKEY ; * ZEKTRAN ; ; 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.KLO EQUS "1" ; The key logger in the BBC Micro version has a spare ; byte at the start for storing the last key press, so ; we also include a spare byte here so the KLO logger ; in the Commodore 64 version behaves in a similar way ; to the KL key logger in the BBC Micro ; ; The Commodore 64 version doesn't use this byte, but ; instead it stores the last-pressed key in the KL and ; thi8skey variables ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * Main flight loop (Part 3 of 16) ; * TT102 ; * TT17 ; * U% ; ; 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 aboveEQUS "2" ; RUN/STOP is being pressed (KLO+$1) ; ; * 0 = no ; ; * Non-zero = yes EQUS "3" ; "Q" is being pressed (KLO+$2) ; ; * 0 = no ; ; * Non-zero = yes .KY12 EQUS "4" ; "C=" is being pressed (energy bomb, KLO+$3) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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.KY2 EQUS "5" ; Space is being pressed (speed up, KLO+$4) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * Main flight loop (Part 3 of 16) ; ; 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 aboveEQUS "6" ; "2" is being pressed (KLO+$5) ; ; * 0 = no ; ; * Non-zero = yes EQUS "7" ; CTRL is being pressed (KLO+$6) ; ; * 0 = no ; ; * Non-zero = yes .KY13 EQUS "8" ; Left arrow is being pressed (launch escape pod, ; KLO+$7) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "9" ; "1" is being pressed (KLO+$8) ; ; * 0 = no ; ; * Non-zero = yes .KY1 EQUS "A" ; "?" is being pressed (slow down, KLO+$9) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * Main flight loop (Part 3 of 16) ; ; 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 aboveEQUS "B" ; Up arrow is being pressed (KLO+$A) ; ; * 0 = no ; ; * Non-zero = yes EQUS "C" ; "=" is being pressed (KLO+$B) ; ; * 0 = no ; ; * Non-zero = yes EQUS "D" ; Right SHIFT is being pressed (KLO+$C) ; ; * 0 = no ; ; * Non-zero = yes EQUS "E" ; CLR/HOME is being pressed (KLO+$D) ; ; * 0 = no ; ; * Non-zero = yes EQUS "F" ; ";" is being pressed (KLO+$E) ; ; * 0 = no ; ; * Non-zero = yes EQUS "0" ; "*" is being pressed (KLO+$F) ; ; * 0 = no ; ; * Non-zero = yes EQUS "1" ; "£" is being pressed (KLO+$10) ; ; * 0 = no ; ; * Non-zero = yes .KY3 EQUS "2" ; "<" is being pressed (roll left, KYO+$11) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * RDKEY ; * TT17 ; ; 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 aboveEQUS "3" ; "@" is being pressed (KLO+$12) ; ; * 0 = no ; ; * Non-zero = yes EQUS "4" ; ":" is being pressed (KLO+$13) ; ; * 0 = no ; ; * Non-zero = yes .KY4 EQUS "5" ; ">" is being pressed (roll right, KLO+$14) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * RDKEY ; * TT17 ; ; 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 aboveEQUS "6" ; "-" is being pressed (KLO+$15) ; ; * 0 = no ; ; * Non-zero = yes EQUS "7" ; "L" is being pressed (KLO+$16) ; ; * 0 = no ; ; * Non-zero = yes .KY20 EQUS "8" ; "P" is being pressed (deactivate docking computer, ; KLO+$17) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "9" ; "+" is being pressed (KLO+$18) ; ; * 0 = no ; ; * Non-zero = yes EQUS "A" ; "N" is being pressed (KLO+$19) ; ; * 0 = no ; ; * Non-zero = yes EQUS "B" ; "O" is being pressed (KLO+$1A) ; ; * 0 = no ; ; * Non-zero = yes EQUS "C" ; "K" is being pressed (KLO+$1B) ; ; * 0 = no ; ; * Non-zero = yes .KY16 EQUS "D" ; "M" is being pressed (fire missile, KLO+$1C) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "E" ; "0" is being pressed (KLO+$1D) ; ; * 0 = no ; ; * Non-zero = yes .KY18 EQUS "F" ; "J" is being pressed (in-system jump, KLO+$1E) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "0" ; "I" is being pressed (KLO+$1F) ; ; * 0 = no ; ; * Non-zero = yes EQUS "1" ; "9" is being pressed (KLO+$20) ; ; * 0 = no ; ; * Non-zero = yes EQUS "2" ; "V" is being pressed (KLO+$21) ; ; * 0 = no ; ; * Non-zero = yes .KY15 EQUS "3" ; "U" is being pressed (unarm missile, KLO+$22) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "4" ; "H" is being pressed (KLO+$23) ; ; * 0 = no ; ; * Non-zero = yes EQUS "5" ; "B" is being pressed (KLO+$24) ; ; * 0 = no ; ; * Non-zero = yes EQUS "6" ; "8" is being pressed (KLO+$25) ; ; * 0 = no ; ; * Non-zero = yes EQUS "7" ; "G" is being pressed (KLO+$26) ; ; * 0 = no ; ; * Non-zero = yes EQUS "8" ; "Y" is being pressed (KLO+$27) ; ; * 0 = no ; ; * Non-zero = yes EQUS "9" ; "7" is being pressed (KLO+$28) ; ; * 0 = no ; ; * Non-zero = yes .KY5 EQUS "A" ; "X" is being pressed (pull up, KLO+$29) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * RDKEY ; * TT17 ; ; 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.KY14 EQUS "B" ; "T" is being pressed (target missile, KLO+$2A) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "C" ; "F" is being pressed (KLO+$2B) ; ; * 0 = no ; ; * Non-zero = yes .KY19 EQUS "D" ; "C" is being pressed (activate docking computer, ; KLO+$2C) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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 aboveEQUS "E" ; "6" is being pressed (KLO+$2D) ; ; * 0 = no ; ; * Non-zero = yes EQUS "F" ; "D" is being pressed (KLO+$2E) ; ; * 0 = no ; ; * Non-zero = yes EQUS "0" ; "R" is being pressed (KLO+$2F) ; ; * 0 = no ; ; * Non-zero = yes EQUS "1" ; "5" is being pressed (KLO+$30) ; ; * 0 = no ; ; * Non-zero = yes EQUS "2" ; Left SHIFT is being pressed (KLO+$31) ; ; * 0 = no ; ; * Non-zero = yes .KY17 EQUS "3" ; "E" is being pressed (activate E.C.M., KLO+$32) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; ; 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.KY6 EQUS "4" ; "S" is being pressed (pitch down, KLO+$33) ; ; * 0 = no ; ; * Non-zero = yes ; ; [Show more]; ; This variable is used by the following: ; ; * DOKEY ; * RDKEY ; * TT17 ; ; 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 aboveEQUS "5" ; "Z" is being pressed (KLO+$34) ; ; * 0 = no ; ; * Non-zero = yes EQUS "6" ; "4" is being pressed (KLO+$35) ; ; * 0 = no ; ; * Non-zero = yes .KY7 EQUS "7" ; "A" is being pressed (fire lasers, KLO+$36) ; ; * 0 = no ; ; * Non-zero = yes ; ; This is also set when the joystick fire button has ; been pressed ; ; [Show more]; ; This variable is used by the following: ; ; * Main flight loop (Part 3 of 16) ; * RDKEY ; * TITLE ; * TT17 ; ; 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 aboveEQUS "8" ; "W" is being pressed (KLO+$37) ; ; * 0 = no ; ; * Non-zero = yes EQUS "9" ; "3" is being pressed (KLO+$38) ; ; * 0 = no ; ; * Non-zero = yes EQUS "A" ; Cursor up/down is being pressed (KLO+$39) ; ; * 0 = no ; ; * Non-zero = yes EQUS "B" ; F5 is being pressed (KLO+$3A) ; ; * 0 = no ; ; * Non-zero = yes EQUS "C" ; F3 is being pressed (KLO+$3B) ; ; * 0 = no ; ; * Non-zero = yes EQUS "D" ; F1 is being pressed (KLO+$3C) ; ; * 0 = no ; ; * Non-zero = yes EQUS "E" ; F7 is being pressed (KLO+$3D) ; ; * 0 = no ; ; * Non-zero = yes EQUS "F" ; Cursor left/right is being pressed (KLO+$3E) ; ; * 0 = no ; ; * Non-zero = yes EQUS "0" ; RETURN is being pressed (KLO+$3F) ; ; * 0 = no ; ; * Non-zero = yes EQUS "1" ; INS/DEL is being pressed (KLO+$40) ; ; * 0 = no ; ; * Non-zero = yes EQUS "234567" ; These bytes appear to be unused.RDKEY TYA ; Store Y on the stack so we can preserve it across PHA ; calls to this 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 LDA VIC+$15 ; Clear bit 1 of VIC register $15 to disable sprite 1, AND #%11111101 ; so this removes the explosion sprite from the screen STA VIC+$15 ; if there is one (so that the explosion burst only ; appears fleetingly at the point of explosion, and ; doesn't linger too long) JSR ZEKTRAN ; Call ZEKTRAN to clear the key logger LDX JSTK ; IF JSTK = 0 then joysticks are not configured, so jump BEQ scanmatrix ; to scanmatrix to start scanning the keyboard matrix ; If joysticks are configured then JSTK = $FF, so X is ; now set to this value LDA CIA ; Set A to bits 0-4 of CIA1 register 0, which are set to AND #%00011111 ; the following: ; ; * Bit 0 = port 2 joystick up pressed ; ; * Bit 1 = port 2 joystick down pressed ; ; * Bit 2 = port 2 joystick left pressed ; ; * Bit 3 = port 2 joystick right pressed ; ; * Bit 4 = port 2 joystick fire pressed ; ; A clear bit indicates that the direction/button is ; being pressed, while a set bit indicates that it isn't IF _GMA_RELEASE EOR #%00011111 ; Flip the polarity of bits 0-4, so a set bit indicates BNE dojoystick ; activity, and jump to dojoystick with X = $FF if any ; of the bits are set ELIF _SOURCE_DISK CMP #%00011111 ; If nothing is being pressed then A will be %00011111, BNE dojoystick ; in which case keep going, otherwise something is being ; pressed, so jump to dojoystick with X = $FF ; ; This relies on the top three bits of CIA1 register 0 ; always being zero, which is probably why this test was ; rewritten for the GMA releases ENDIF .scanmatrix ; If we get here then we need to scan the keyboard ; matrix CLC ; Clear the C flag, so we can return this if no keys are ; being pressed LDX #0 ; Set X = 0 so we select every column in the keyboard ; matrix (so we can quickly check whether any keys are ; being held down) SEI ; Disable interrupts while we read the keyboard matrix STX $DC00 ; Set $DC00 = 0 to select every column in the keyboard ; matrix LDX $DC01 ; Read $DC01 to see whether any keys are being pressed ; in the columns we specified in $DC00 (i.e. in any ; columns) CLI ; Enable interrupts again INX ; If we read $FF from $DC01 then this indicates that no BEQ nokeys2 ; keys are being pressed in any columns in the keyboard ; matrix (as a pressed key is indicated by a clear bit ; for that column, and incrementing $FF gives us zero), ; so this jumps to nokeys2 if there are no keys being ; pressed, which will return from the subroutine with ; the C flag clear ; If we get here then something is being pressed on the ; keyboard, so we now loop through the whole matrix and ; populate the key logger LDX #$40 ; The key logger at KEYLOOK records key presses for each ; of the keys on the keyboard, from KEYLOOK+$1 to ; KEYLOOK+$40, so set a counter in X to work through the ; whole keyboard matrix LDA #%11111110 ; We can check whether anything is being pressed in a ; particular column in the keyboard matrix by clearing ; the corresponding bit in $DC00, so set a byte in A ; with one bit clear, so we can shift it along to work ; through the keyboard matrix from column 0 to 7 .Rdi1 SEI ; Disable interrupts while we read the keyboard matrix STA $DC00 ; Set $DC00 = A to select the column in the keyboard ; matrix that corresponds to the clear bit in A (so we ; start with column 0 and end with to column 7) PHA ; Store our column selector byte on the stack, so we can ; retrieve it for the next iteration around the loop LDY #8 ; Each column contains eight keys, one on each row of ; the keyboard matrix, so we now need to work our way ; through each row, checking to see if the key in that ; row has been pressed, so set a row counter in Y .Rdi0 LDA $DC01 ; Read $DC01 to see whether any keys are being pressed ; in the column we specified in $DC00 CMP $DC01 ; Keep reading the value from $DC01 until it is stable BNE Rdi0 ; for the duration of the LDA and CMP instructions, so ; we know we have a clean signal (this implements a ; simple "debounce", which is the act of delaying the ; effects of a button press to ensure that the action ; is only performed once rather than repeatedly) CLI ; Enable interrupts again ; We now have a result from the keyboard scan that will ; have a 0 in bit x if the key in row x is being ; pressed in the current column, so we need to loop ; through all eight bits in A to determine which keys ; are being pressed .Rdi2 LSR A ; Shift bit 0 of A into the C flag BCS Rdi3 ; If the bit is set then the key corresponding to this ; row is not being pressed, so jump to Rdi3 to leave the ; key logger entry for this key set to 0 DEC KEYLOOK,X ; Decrement the X-th entry in the key logger from 0 to ; $FF to indicate that this key is being pressed STX thiskey ; Store the value of X (which we're calling the internal ; key number in this commentary) in thiskey, which ; stores the number of the last key pressed SEC ; Set the C flag, so we can rotate it into the column ; selector byte below .Rdi3 DEX ; Decrement the key logger counter in X, so we move on ; to the next key BMI Rdiex ; If we have just decremented X past zero then we have ; processed all keys and have filled the whole key ; logger, so jump to Rdiex to finish up and return from ; the subroutine DEY ; Otherwise decrement the row counter in Y to check the ; next row in the current column BNE Rdi2 ; Loop back to Rdi2 to check the next key, until we have ; done all eight keys in this column PLA ; We now want to move on to the next column, so fetch ; the column selector byte from the stack, so we can ; move on to the next iteration around the loop ROL A ; Rotate the value in A to the left to move the clear ; bit along by one place, so we can select the next ; column ; ; Note that the ROL instruction rotates the C flag into ; bit 0 of A, and the C flag is set if we just detected ; a key press in the last column, so this ensures we ; don't select columns that we know contain key presses ; (but it does allow scans of columns that we know are ; not being pressed, though these won't affect the ; result of other column scans, as the scan only detects ; key presses that pull the matrix low) BNE Rdi1 ; Jump to Rdi1 to move on to the next column ; ; This BNE is effectively a JMP as A will never be zero ; by this point; the only way it could happen is if ; eight zeroes were rotated into A, but we know that at ; least one of those loops much have a key press as we ; already scanned the whole matrix at the start, so this ; can't happen .Rdiex PLA ; We put the column selector byte on the stack in the ; loop above, so make sure we remove it to prevent the ; stack from filling up SEC ; Set the C flag to return from the subroutine, to ; indicate that a key has been pressed .nokeys2 LDA #%01111111 ; Set bits 0 to 5 of $DC00 to deselect every column in STA $DC00 ; the keyboard matrix BNE nojoyst ; Jump to nojoyst to skip the joystick code (this BNE is ; effectively a JMP as A is never zero) .dojoystick ; If we get here then at least one of the joystick ; controls has been pressed: ; ; * Bit 0 = port 2 joystick up pressed ; ; * Bit 1 = port 2 joystick down pressed ; ; * Bit 2 = port 2 joystick left pressed ; ; * Bit 3 = port 2 joystick right pressed ; ; * Bit 4 = port 2 joystick fire pressed IF _GMA_RELEASE ; A set bit in A indicates that the direction/button ; is being pressed, while a clear bit indicates that it ; isn't ; ; X has the value $FF at this point LSR A ; Shift bit 0 into the C flag, and if it is set, store BCC downj ; $FF in KY6 to indicate the joystick is pointing up STX KY6 .downj LSR A ; Shift bit 1 into the C flag, and if it is set, store BCC upj ; $FF in KY5 to indicate the joystick is pointing down STX KY5 .upj LSR A ; Shift bit 2 into the C flag, and if it is set, store BCC leftj ; $FF in KY3 to indicate the joystick is pointing left STX KY3 .leftj LSR A ; Shift bit 3 into the C flag, and if it is set, store BCC rightj ; $FF in KY4 to indicate the joystick is pointing right STX KY4 .rightj LSR A ; Shift bit 4 into the C flag, and if it is set, store BCC firej ; $FF in KY7 to indicate the joystick fire button is STX KY7 ; being pressed .firej ; If we get here then the C flag is set if the joystick ; fire button is being pressed, or clear otherwise ELIF _SOURCE_DISK ; A clear bit in A indicates that the direction/button ; is being pressed, while a set bit indicates that it ; isn't ; ; X has the value $FF at this point LSR A ; Shift bit 0 into the C flag, and if it is clear, store BCS downj ; $FF in KY6 to indicate the joystick is pointing up STX KY6 .downj LSR A ; Shift bit 1 into the C flag, and if it is clear, store BCS upj ; $FF in KY5 to indicate the joystick is pointing down STX KY5 .upj LSR A ; Shift bit 2 into the C flag, and if it is clear, store BCS leftj ; $FF in KY3 to indicate the joystick is pointing left STX KY3 .leftj LSR A ; Shift bit 3 into the C flag, and if it is clear, store BCS rightj ; $FF in KY4 to indicate the joystick is pointing right STX KY4 .rightj LSR A ; Shift bit 4 into the C flag, and if it is clear, store BCS firej ; $FF in KY7 to indicate the joystick fire button is STX KY7 ; being pressed ; If we get here then the joystick fire button is being ; pressed, so the C flag is clear EQUB $24 ; Skip the next instruction by turning it into $24 $18, ; or BIT $0018, which does nothing apart from affect the ; flags ; ; This doesn't make a lot of sense as the next ; instruction is a CLC, and the C flag is already clear, ; so this has no effect; perhaps the next instruction is ; supposed to be a SEC, but as this part of the code was ; rewritten for the GMA release, it's all a bit moot .firej CLC ; Clear the C flag to indicate that no buttons are being ; pressed ENDIF LDA JSTGY ; If JSTGY is 0 then the game is not configured to BEQ noswapys ; reverse the controller y-axis, so jump to noswapys to ; skip the following and leave the joystick direction ; alone LDA KY5 ; Swap the values of KY5 and KY6, which are the two LDX KY6 ; y-axis directions (i.e. up and down) STA KY6 STX KY5 .noswapys LDA JSTE ; JSTE contains $FF if both joystick channels are BEQ noswapxs ; reversed and 0 otherwise, so skip to noswapxs if the ; joystick channels are not reversed LDA KY5 ; Swap the values of KY5 and KY6, which are the two LDX KY6 ; y-axis directions (i.e. up and down) STA KY6 STX KY5 LDA KY3 ; Swap the values of KY3 and KY4, which are the two LDX KY4 ; x-axis directions (i.e. right and left) STA KY4 STX KY3 .noswapxs .nojoyst LDA QQ11 ; If QQ11 = 0 then this is the space view, so jump to BEQ allkeys ; allkeys to skip resetting the secondary flight ; controls in the key logger LDA #0 ; This is not the space view, so reset the entries in STA KY12 ; the key logger for the secondary flight controls from STA KY13 ; KY12 to KY20, as these keys only have meaning in the STA KY14 ; space view STA KY15 STA KY16 STA KY17 STA KY18 STA KY19 STA KY20 .allkeys LDA #%100 ; Call SETL1 to set the 6510 input/output port to the JSR SETL1 ; following: ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; 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 PLA ; Retrieve the value of Y from the stack, which we TAY ; stored at the start of the subroutine, so the value of ; Y is preserved LDA thiskey ; Set A and X to the internal key number of the last key TAX ; that we scanned, so it is set as the last key pressed RTS ; Return from the subroutineName: RDKEY [Show more] Type: Subroutine Category: Keyboard Summary: Scan the keyboard for key pressesContext: See this subroutine on its own page References: This subroutine is called as follows: * DK4 calls RDKEY * DOKEY calls RDKEY * PAS1 calls RDKEY * PAUSE2 calls RDKEY * TITLE calls RDKEY * TT217 calls RDKEY
Returns: Y Y is preserved C flag The status of the result: * Clear if no keys are being pressed * Set if either a key is being pressed or the joystick fire button is being pressed.WARP LDX JUNK ; Set X to the total number of junk items in the ; vicinity (e.g. asteroids, escape pods, cargo ; canisters, Shuttles, Transporters and so on) LDA FRIN+2,X ; If the slot at FRIN+2+X is non-zero, then we have ; something else in the vicinity besides asteroids, ; escape pods and cargo canisters, so to check whether ; we can jump, we first grab the slot contents into A ORA SSPR ; If there is a space station nearby, then SSPR will ; be non-zero, so OR'ing with SSPR will produce a ; non-zero result if either A or SSPR are non-zero ORA MJ ; If we are in witchspace, then MJ will be non-zero, so ; OR'ing with MJ will produce a non-zero result if ; either A or SSPR or MJ are non-zero BNE WA1 ; A is non-zero if we have either a ship or a space ; station in the vicinity, or we are in witchspace, in ; which case jump to WA1 to make a low beep to show that ; we can't do an in-system jump LDY K%+8 ; Otherwise we can do an in-system jump, so now we fetch ; the byte at K%+8, which contains the z_sign for the ; first ship slot, i.e. the distance of the planet BMI WA3 ; If the planet's z_sign is negative, then the planet ; is behind us, so jump to WA3 to skip the following TAY ; Set A = Y = 0 (as we didn't BNE above) so the call ; to MAS2 measures the distance to the planet JSR MAS2 ; Call MAS2 to set A to the largest distance to the ; planet in any of the three axes (we could also call ; routine m to do the same thing, as A = 0) CMP #2 ; If A < 2 then jump to WA1 to abort the in-system jump BCC WA1 ; with a low beep, as we are facing the planet and are ; too close to jump in that direction .WA3 LDY K%+NI%+8 ; Fetch the z_sign (byte #8) of the second ship in the ; ship data workspace at K%, which is reserved for the ; sun or the space station (in this case it's the ; former, as we already confirmed there isn't a space ; station in the vicinity) BMI WA2 ; If the sun's z_sign is negative, then the sun is ; behind us, so jump to WA2 to skip the following LDY #NI% ; Set Y to point to the offset of the ship data block ; for the sun, which is NI% (as each block is NI% bytes ; long, and the sun is the second block) JSR m ; Call m to set A to the largest distance to the sun ; in any of the three axes CMP #2 ; If A < 2 then jump to WA1 to abort the in-system jump BCC WA1 ; with a low beep, as we are facing the sun and are too ; close to jump in that direction .WA2 ; If we get here, then we can do an in-system jump, as ; we don't have any ships or space stations in the ; vicinity, we are not in witchspace, and if we are ; facing the planet or the sun, we aren't too close to ; jump towards it ; ; We do an in-system jump by moving the sun and planet, ; rather than moving our own local bubble (this is why ; in-system jumps drag asteroids, cargo canisters and ; escape pods along for the ride). Specifically, we move ; them in the z-axis by a fixed amount in the opposite ; direction to travel, thus performing a jump towards ; our destination LDA #$81 ; Set R = R = P = $81 STA S STA R STA P LDA K%+8 ; Set A = z_sign for the planet JSR ADD ; Set (A X) = (A P) + (S R) ; = (z_sign $81) + $8181 ; = (z_sign $81) - $0181 ; ; This moves the planet against the direction of travel ; by reducing z_sign by 1, as the above maths is: ; ; z_sign 00000000 ; + 00000000 10000001 ; - 00000001 10000001 ; ; or: ; ; z_sign 00000000 ; + 00000000 00000000 ; - 00000001 00000000 ; ; i.e. the high byte is z_sign - 1, making sure the sign ; is preserved STA K%+8 ; Set the planet's z_sign to the high byte of the result LDA K%+NI%+8 ; Set A = z_sign for the sun JSR ADD ; Set (A X) = (A P) + (S R) ; = (z_sign $81) + $8181 ; = (z_sign $81) - $0181 ; ; which moves the sun against the direction of travel ; by reducing z_sign by 1 STA K%+NI%+8 ; Set the planet's z_sign to the high byte of the result LDA #1 ; Temporarily set the view type to a non-zero value, so STA QQ11 ; the call to LOOK1 below clears the screen before ; switching to the space view STA MCNT ; Set the main loop counter to 1, so the next iteration ; through the main loop will potentially spawn ships ; (see part 2 of the main game loop at me3) LSR A ; Set EV, the extra vessels spawning counter, to 0 STA EV ; (the LSR produces a 0 as A was previously 1) LDX VIEW ; Set X to the current view (front, rear, left or right) JMP LOOK1 ; and jump to LOOK1 to initialise that view, returning ; from the subroutine using a tail call .WA1 LDY #sfxboop ; If we get here then we can't do an in-system jump, so JMP NOISE ; call the NOISE routine with Y = sfxboop to make a ; long, low beep and return from the subroutine using a ; tail callName: WARP [Show more] Type: Subroutine Category: Flight Summary: Perform an in-system jumpContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 3 of 16) calls WARP
This is called when we press "J" during flight. The following checks are performed: * Make sure we don't have any ships or space stations in the vicinity * Make sure we are not in witchspace * If we are facing the planet, make sure we aren't too close * If we are facing the sun, make sure we aren't too close If the above checks are passed, then we perform an in-system jump by moving the sun and planet in the opposite direction to travel, so we appear to jump in space. This means that any asteroids, cargo canisters or escape pods get dragged along for the ride..KYTB RTS ; Return from the subroutine (used as an entry point and ; a fall-through from above) ; These are the primary flight controls (pitch, roll, ; speed and lasers): EQUB $68 + 128 ; ? KYTB+1 Slow down EQUB $62 + 128 ; Space KYTB+2 Speed up EQUB $66 + 128 ; < KYTB+3 Roll left EQUB $67 + 128 ; > KYTB+4 Roll right EQUB $42 + 128 ; X KYTB+5 Pull up EQUB $51 + 128 ; S KYTB+6 Pitch down EQUB $41 + 128 ; A KYTB+7 Fire lasers ; These are the secondary flight controls: EQUB $60 ; TAB KYTB+8 Energy bomb EQUB $70 ; ESCAPE KYTB+9 Launch escape pod EQUB $23 ; T KYTB+10 Arm missile EQUB $35 ; U KYTB+11 Unarm missile EQUB $65 ; M KYTB+12 Fire missile EQUB $22 ; E KYTB+13 E.C.M. EQUB $45 ; J KYTB+14 In-system jump EQUB $52 ; C KYTB+15 Docking computer EQUB $37 ; P KYTB+16 Cancel docking computerName: KYTB [Show more] Type: Variable Category: Keyboard Summary: Lookup table for in-flight keyboard controls Deep dive: The key loggerContext: See this variable on its own page References: No direct references to this variable in this source file
This table is not used by the Commodore 64 version of Elite, and is left over from the BBC Micro version..CTRL LDX #6 ; Set X to the internal key number for CTRL and fall ; through into DKS4 to fetch the relevant entry from ; the key loggerName: CTRL [Show more] Type: Subroutine Category: Keyboard Summary: Scan the keyboard to see if CTRL is currently pressedContext: See this subroutine on its own page References: This subroutine is called as follows: * hyp calls CTRL * TT18 calls CTRL
Returns: X X = %10000001 (i.e. 129 or -127) if CTRL is being pressed X = 1 if CTRL is not being pressed A Contains the same as X.DKS4 LDA KEYLOOK,X ; Fetch the entry from the key logger for the key in X TAX ; Copy A to X RTS ; Return from the subroutineName: DKS4 [Show more] Type: Subroutine Category: Keyboard Summary: Scan the keyboard to see if a specific key is being pressed Deep dive: The key loggerContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
Arguments: X The internal number of the key to check
Returns: A $FF if the key is being pressed, 0 otherwise X Contains the same as A.DKSANYKEY 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 read the keyboard matrix STX $DC00 ; Set $DC00 = X to select the column in the keyboard ; matrix that corresponds to the clear bit in X LDX $DC01 ; Read $DC01 to see whether any keys are being pressed ; in the column we specified in $DC00 CLI ; Enable interrupts again INX ; If we read $FF from $DC01 then this indicates that no BEQ DKSL1 ; keys are being pressed in the specified column in the ; keyboard matrix (as a pressed key is indicated by a ; clear bit for that column, and incrementing $FF gives ; us zero), so this jumps to DKSL1 with X = 0 if there ; are no keys being pressed in that column LDX #$FF ; If we get here then something is being pressed on the ; keyboard in the specified column, so set X = $FF .DKSL1 LDA #%100 ; Call SETL1 to set the 6510 input/output port to the JSR SETL1 ; following: ; ; * LORAM = 0 ; * HIRAM = 0 ; * CHAREN = 1 ; ; 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 TXA ; Copy the result from X into A RTS ; Return from the subroutine RTS ; This instruction has no effect, as we already returned ; from the subroutineName: DKSANYKEY [Show more] Type: Subroutine Category: Keyboard Summary: Scan a specific column in the keyboard matrix for a key pressContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
Arguments: X The value to pass to $DC00 (i.e. set all bits apart from one clear bit in the position of the column that we want to scan)
Returns: A The result: * $FF if a key is being pressed in the specified column * 0 if no key is being pressed in the specified column X Contains the same as A.DKS2 LDA KTRAN+7,X ; Fetch either the joystick X value or joystick Y value ; from the key logger buffer, depending on the value of ; X (i.e. fetch either KTRAN+8 or KTRAN+0) EOR JSTE ; The high byte A is now EOR'd with the value in ; location JSTE, which contains $FF if both joystick ; channels are reversed and 0 otherwise (so A now ; contains the high byte but inverted, if that's what ; the current settings say) RTS ; Return from the subroutineName: DKS2 [Show more] Type: Subroutine Category: Keyboard Summary: Read the joystick positionContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
This routine is not used in this version of Elite. It is left over from the BBC Micro version..DKS3 TXA ; Copy the ASCII code of the key that has been pressed ; into A CMP TGINT,Y ; If the pressed key doesn't match the configuration key BNE Dk3 ; for option Y (as listed in the TGINT table), then jump ; to Dk3 to return from the subroutine LDA DAMP,Y ; The configuration keys listed in TGINT correspond to EOR #$FF ; the configuration option settings from DAMP onwards, STA DAMP,Y ; so to toggle a setting, we fetch the existing byte ; from DAMP+Y, invert it and put it back (0 means no ; and $FF means yes in the configuration bytes, so ; this toggles the setting) JSR BELL ; Make a beep sound so we know something has happened TYA ; Store Y and A on the stack so we can retrieve them PHA ; below LDY #20 ; Wait for 20/50 of a second (0.4 seconds) on PAL JSR DELAY ; systems, or 20/60 of a second (0.33 seconds) on NTSC PLA ; Restore A and Y from the stack TAY .Dk3 RTS ; Return from the subroutineName: DKS3 [Show more] Type: Subroutine Category: Keyboard Summary: Toggle a configuration setting and emit a beepContext: See this subroutine on its own page References: This subroutine is called as follows: * DK4 calls DKS3
This is called when the game is paused and a key is pressed that changes the game's configuration. Specifically, this routine toggles the configuration settings for the following keys: * RUN/STOP toggles keyboard flight damping (0) * A toggles keyboard auto-recentre (1) * X toggles author names on start-up screen (2) * F toggles flashing console bars (3) * Y toggles reverse joystick Y channel (4) * J toggles reverse both joystick channels (5) * K toggles keyboard and joystick (6) * M toggles docking music (7) * T toggles current media between tape and disk (8) * P toggles planetary details (9) * C toggles whether docking music can be toggled (10) * E swaps the docking and title music (11) * B toggles whether sounds are played during music (12) The numbers in brackets are the configuration options that we pass in Y. We pass the ASCII code of the key that has been pressed in X, and the option to check it against in Y, so this routine is typically called in a loop that loops through the various configuration option.
Arguments: X The internal number of the key that's been pressed Y The number of the configuration option to check against from the list above (i.e. Y must be from 0 to 12);.DKJ1 ; These instructions are commented out in the original ;LDA auto ; source (they are from the BBC Micro version) ;BNE auton ;LDA KTRAN+1 ;STA KL+1 ;LDA KTRAN+2 ;STA KL+2 ;.BS1 ;LDA KTRAN+12 ;TAX ;AND #16 ;EOR #16 ;STA KL+7 ;LDX #1 ;JSR DKS2 ;ORA #1 ;STA JSTX ;LDX #2 ;JSR DKS2 ;EOR JSTGY ;STA JSTY ;JMP DK4Name: DKJ1 [Show more] Type: Subroutine Category: Keyboard Summary: Read joystick and flight controlsContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
Specifically, scan the keyboard for the speed up and slow down keys, and read the joystick's fire button and X and Y axes, storing the results in the key logger and the joystick position variables. This routine is only called if joysticks are enabled (JSTK = non-zero)..U% LDA #0 ; Set A to 0, as this means "key not pressed" in the ; key logger at KLO LDY #56 ; We want to clear the 16 key logger locations from KY1 ; to KY20, and we want to zero the 40 variable bytes ; from LSP to TYPE, so set a counter in Y .DKL3 STA KLO,Y ; Store 0 in the Y-th byte of the key logger DEY ; Decrement the counter BNE DKL3 ; And loop back for the next key, until we have just ; KLO+1 STA KL ; Clear KL, which is used for logging keys that don't ; appear in the keyboard table RTS ; Return from the subroutineName: U% [Show more] Type: Subroutine Category: Keyboard Summary: Clear the key logger and reset a number of flight variablesContext: See this subroutine on its own page References: This subroutine is called as follows: * DEATH calls U%
This routine zeroes the 17 key logger locations from KY1 to KY20 and the key variable at KL, and resets the 40 variable bytes from LSP to TYPE. Returns: A A is set to 0 Y Y is set to 0.DOKEY JSR RDKEY ; Scan the keyboard for a key press and return the ; internal code of the key pressed in X ;JSR U% ; These instructions are commented out in the original ;JMP DK15 ; source LDA auto ; If auto is 0, then the docking computer is not BEQ DK15 ; currently activated, so jump to DK15 to skip the ; docking computer manoeuvring code below .auton JSR ZINF ; Call ZINF to reset the INWK ship workspace LDA #96 ; Set nosev_z_hi = 96 STA INWK+14 ORA #%10000000 ; Set sidev_x_hi = -96 STA INWK+22 STA TYPE ; Set the ship type to -96, so the negative value will ; let us check in the DOCKIT routine whether this is our ; ship that is activating its docking computer, rather ; than an NPC ship docking LDA DELTA ; Set the ship speed to DELTA (our speed) STA INWK+27 JSR DOCKIT ; Call DOCKIT to calculate the docking computer's moves ; and update INWK with the results ; We now "press" the relevant flight keys, depending on ; the results from DOCKIT, starting with the pitch keys LDA INWK+27 ; Fetch the updated ship speed from byte #27 into A CMP #22 ; If A < 22, skip the next instruction BCC P%+4 LDA #22 ; Set A = 22, so the maximum speed during docking is 22 STA DELTA ; Update DELTA to the new value in A LDA #$FF ; Set A = $FF, which we can insert into the key logger ; to "fake" the docking computer working the keyboard LDX #(KY1-KLO) ; Set X to the offset of KY1 within the KLO table, so we ; "press" KY1 below ("?", slow down) LDY INWK+28 ; If the updated acceleration in byte #28 is zero, skip BEQ DK11 ; to DK11 BMI P%+4 ; If the updated acceleration is negative, skip the ; following instruction LDX #(KY2-KLO) ; Set X to the offset of KY2 within the KLO table, so we ; "press" KY2 with the next instruction (Space, speed ; up) STA KLO,X ; Store $FF in either KY1 or KY2 to "press" the relevant ; key, depending on whether the updated acceleration is ; negative (in which case we "press" KY1, "?", to slow ; down) or positive (in which case we "press" KY2, ; Space, to speed up) .DK11 ; We now "press" the relevant roll keys, depending on ; the results from DOCKIT LDA #128 ; Set A = 128, which indicates no change in roll when ; stored in JSTX (i.e. the centre of the roll indicator) LDX #(KY3-KLO) ; Set X to the offset of KY3 within the KLO table, so we ; "press" KY3 below ("<", increase roll) ASL INWK+29 ; Shift ship byte #29 left, which shifts bit 7 of the ; updated roll counter (i.e. the roll direction) into ; the C flag BEQ DK12 ; If the remains of byte #29 is zero, then the updated ; roll counter is zero, so jump to DK12 set JSTX to 128, ; to indicate there's no change in the roll BCC P%+4 ; If the C flag is clear, skip the following instruction LDX #(KY4-KLO) ; Set X to the offset of KY4 within the KLO table, so we ; "press" KY4 below (">", decrease roll) BIT INWK+29 ; We shifted the updated roll counter to the left above, BPL DK14 ; so this tests bit 6 of the original value, and if it ; is clear (i.e. the magnitude is less than 64), jump to ; DK14 to "press" the key and leave JSTX unchanged LDA #64 ; The magnitude of the updated roll is 64 or more, so STA JSTX ; set JSTX to 64 (so the roll decreases at half the ; maximum rate) LDA #0 ; And set A = 0 so we do not "press" any keys (so if the ; docking computer needs to make a serious roll, it does ; so by setting JSTX directly rather than by "pressing" ; a key) .DK14 STA KLO,X ; Store A in either KY3 or KY4, depending on whether ; the updated roll rate is increasing (KY3) or ; decreasing (KY4) LDA JSTX ; Fetch A from JSTX so the next instruction has no ; effect .DK12 STA JSTX ; Store A in JSTX to update the current roll rate ; We now "press" the relevant pitch keys, depending on ; the results from DOCKIT LDA #128 ; Set A = 128, which indicates no change in pitch when ; stored in JSTX (i.e. the centre of the pitch ; indicator) LDX #(KY5-KLO) ; Set X to the offset of KY5 within the KLO table, so we ; "press" KY5 below ("X", decrease pitch, pulling the ; nose up) ASL INWK+30 ; Shift ship byte #30 left, which shifts bit 7 of the ; updated pitch counter (i.e. the pitch direction) into ; the C flag BEQ DK13 ; If the remains of byte #30 is zero, then the updated ; pitch counter is zero, so jump to DK13 set JSTY to ; 128, to indicate there's no change in the pitch BCS P%+4 ; If the C flag is set, skip the following instruction LDX #(KY6-KLO) ; Set X to the offset of KY6 within the KLO table, so we ; "press" KY6 below ("S", increase pitch, so the nose ; dives) STA KLO,X ; Store 128 in either KY5 or KY6 to "press" the relevant ; key, depending on whether the pitch direction is ; negative (in which case we "press" KY5, "X", to ; decrease the pitch, pulling the nose up) or positive ; (in which case we "press" KY6, "S", to increase the ; pitch, pushing the nose down) LDA JSTY ; Fetch A from JSTY so the next instruction has no ; effect .DK13 STA JSTY ; Store A in JSTY to update the current pitch rate .DK15 LDX JSTX ; Set X = JSTX, the current roll rate (as shown in the ; RL indicator on the dashboard) LDA #14 ; Set A to 14, which is the amount we want to alter the ; roll rate by if the roll keys are being pressed LDY KY3 ; If the "<" key is not being pressed, skip the next BEQ P%+5 ; instruction JSR BUMP2 ; The "<" key is being pressed, so call the BUMP2 ; routine to increase the roll rate in X by A LDY KY4 ; If the ">" key is not being pressed, skip the next BEQ P%+5 ; instruction JSR REDU2 ; The "<" key is being pressed, so call the REDU2 ; routine to decrease the roll rate in X by A, taking ; the keyboard auto re-centre setting into account STX JSTX ; Store the updated roll rate in JSTX ;ASL A ; This instruction is commented out in the original ; source LDX JSTY ; Set X = JSTY, the current pitch rate (as shown in the ; DC indicator on the dashboard) LDY KY5 ; If the "X" key is not being pressed, skip the next BEQ P%+5 ; instruction JSR REDU2 ; The "X" key is being pressed, so call the REDU2 ; routine to decrease the pitch rate in X by A, taking ; the keyboard auto re-centre setting into account LDY KY6 ; If the "S" key is not being pressed, skip the next BEQ P%+5 ; instruction JSR BUMP2 ; The "S" key is being pressed, so call the BUMP2 ; routine to increase the pitch rate in X by A STX JSTY ; Store the updated roll rate in JSTY LDA JSTK ; If JSTK is zero, then we are configured to use the BEQ ant ; keyboard rather than the joystick, so jump to ant to ; skip the following LDA auto ; If the docking computer is currently activated, jump BNE ant ; to ant to skip the following ; If we get here then the joystick is configured and the ; docking computer is not activated, so we now centre ; the roll and pitch rates if required LDX #128 ; Set X to 128, which is the centre value for roll and ; pitch, and represents no change to the current roll or ; pitch LDA KY3 ; If the joystick is being moved left or right, jump to ORA KY4 ; termite to skip the following instruction BNE termite STX JSTX ; Set JSTX = 128 to set the roll rate to zero .termite LDA KY5 ; If the joystick is being moved up or down, jump to ant ORA KY6 ; to skip the following instruction, so pressing buttons BNE ant ; on the controller overrides the docking computer STX JSTY ; Set JSTX = 128 to set the pitch rate to zero .ant ; Fall through into DK4 to scan for other keysName: DOKEY [Show more] Type: Subroutine Category: Keyboard Summary: Scan for the seven primary flight controls and apply the docking computer manoeuvring code Deep dive: The key logger The docking computerContext: See this subroutine on its own page References: This subroutine is called as follows: * TT17 calls DOKEY
Scan for the seven primary flight controls (or the equivalent on joystick), pause and configuration keys, and secondary flight controls, and update the key logger accordingly. Specifically, this part clears the key logger and updates it for the seven primary flight controls, and updates the pitch and roll rates accordingly. We then end up at DK4 to scan for other keys, beyond the seven primary flight controls..DK4 LDX thiskey ; Fetch the key pressed from thiskey in the key logger STX KL ; Store X in KL, which is used to store the value of the ; last key pressed CPX #$40 ; If INST/DEL is not being pressed, jump to DK2 below, BNE DK2 ; otherwise let's process the configuration keys .FREEZE ; COPY is being pressed, so we enter a loop that ; listens for configuration keys, and we keep looping ; until we detect a DELETE key press. This effectively ; pauses the game when COPY is pressed, and unpauses ; it when DELETE is pressed JSR WSCAN ; Call WSCAN to wait for the vertical sync, so the whole ; screen gets drawn JSR RDKEY ; Scan the keyboard for a key press and return the ; internal key number in A and X (or 0 for no key press) CPX #$02 ; If "Q" is not being pressed, skip to DK6 BNE DK6 STX DNOIZ ; "Q" is being pressed, so set DNOIZ to a non-zero value ; to turn the sound off .DK6 LDY #0 ; We now want to loop through the keys that toggle ; various settings, so set a counter in Y to work our ; way through them .DKL4 JSR DKS3 ; Call DKS3 to scan for the key given in Y, and toggle ; the relevant setting if it is pressed INY ; Increment Y to point to the next toggle key CPY #(MUFOR-DAMP) ; Check to see whether we have reached the last toggle ; key (i.e. MUFOR-1, as the standard set of options run ; from DAMP to PLTOG, which just before MUFOR) BNE DKL4 ; If not, loop back to check for the next toggle key BIT PATG ; If bit 7 of PATG is clear then the "X" configuration BPL nosillytog ; option has not been enabled, so jump to nosillytog to ; skip the following .DKL42 ; If we get here then the "X" configuration option has ; been enabled, so the title screen shows the authors' ; names, we can force a mis-jump, and we can alter the ; MUFOR, MUDOCK and MUSILLY configuration options, which ; are unavailable by default JSR DKS3 ; Call DKS3 to scan for the key given in Y, and toggle ; the relevant setting if it is pressed INY ; Increment Y to point to the next toggle key CPY #(MUSILLY+1-DAMP) ; Check to see whether we have reached the last toggle ; key (i.e. MUSILLY, as the standard set of options run ; from DAMP to PLTOG, and the extended options run from ; MUFOR to MUSILLY) BNE DKL42 ; If not, loop back to check for the next toggle key .nosillytog LDA MUTOK ; If the value of MUTOK has changed (i.e. it does not CMP MUTOKOLD ; match the value in MUTOKOLD) then the docking music BEQ P%+5 ; has either been enabled or disabled, so call MUTOKCH JSR MUTOKCH ; to process a change in the docking music configuration ; setting CPX #$33 ; If "S" is not being pressed, jump to DK7 BNE DK7 LDA #0 ; "S" is being pressed, so set DNOIZ to 0 to turn the STA DNOIZ ; sound on .DK7 CPX #$07 ; If left arrow is not being pressed, skip over the next BNE P%+5 ; instruction JMP DEATH2 ; Left arrow is being pressed, so jump to DEATH2 to end ; the game CPX #$0D ; If CLR/HOME is not being pressed, we are still paused, BNE FREEZE ; so loop back up to keep listening for configuration ; keys, otherwise fall through into the rest of the ; key detection code, which unpauses the game .DK2 RTS ; Return from the subroutineName: DK4 [Show more] Type: Subroutine Category: Keyboard Summary: Scan for pause, configuration and secondary flight keys Deep dive: The key loggerContext: See this subroutine on its own page References: No direct references to this subroutine in this source file
Scan for pause and configuration keys, and if this is a space view, also scan for secondary flight controls. Specifically: * Scan for the pause button (INST/DEL) and if it's pressed, pause the game and process any configuration key presses until the game is unpaused (CLR/HOME) * If this is a space view, scan for secondary flight keys and update the relevant bytes in the key logger
Other entry points: FREEZE Rejoin the pause routine after processing a screen save.TT217 STY YSAV ; Store Y in temporary storage, so we can restore it ; later .t LDY #2 ; Wait for 2/50 of a second (0.04 seconds) on PAL JSR DELAY ; systems, or 2/60 of a second (0.33 seconds) on NTSC, ; to implement a simple keyboard debounce and prevent ; multiple key presses being recorded JSR RDKEY ; Scan the keyboard for a key press and return the ; internal key number in A and X (or 0 for no key press) BNE t ; If a key was already being held down when we entered ; this routine, keep looping back up to t, until the ; key is released .t2 JSR RDKEY ; Any pre-existing key press is now gone, so we can ; start scanning the keyboard again, returning the ; internal key number in A and X (or 0 for no key press) BEQ t2 ; Keep looping up to t2 until a key is pressed LDA TRANTABLE,X ; TRANTABLE points to the key translation table, which ; is used to translate internal key numbers to ASCII, so ; this fetches the key's ASCII code into A LDY YSAV ; Restore the original value of Y we stored above TAX ; Copy A into X .out RTS ; Return from the subroutineName: TT217 [Show more] Type: Subroutine Category: Keyboard Summary: Scan the keyboard until a key is pressedContext: See this subroutine on its own page References: This subroutine is called as follows: * gnum calls TT217 * MT26 calls TT217 * qv calls TT217 * TT214 calls TT217 * mes9 calls via out * OUCH calls via out * GTDRV calls via t * LOD calls via t * SVE calls via t * tapeerror calls via t * YESNO calls via t
Scan the keyboard until a key is pressed, and return the key's ASCII code. If, on entry, a key is already being held down, then wait until that key is released first (so this routine detects the first key down event following the subroutine call).
Returns: X The ASCII code of the key that was pressed A Contains the same as X Y Y is preserved
Other entry points: out Contains an RTS t As TT217 but don't preserve Y, set it to YSAV instead.me1 STX DLY ; Set the message delay in DLY to 0, so any new ; in-flight messages will be shown instantly PHA ; Store the new message token we want to print LDA MCH ; Set A to the token number of the message that is JSR mes9 ; currently on-screen, and call mes9 to print it (which ; will remove it from the screen, as printing is done ; using EOR logic) PLA ; Restore the new message tokenName: me1 [Show more] Type: Subroutine Category: Flight Summary: Erase an old in-flight message and display a new oneContext: See this subroutine on its own page References: This subroutine is called as follows: * MESS calls me1
Arguments: A The text token to be printed X Must be set to 0.MESS PHA ; Store A on the stack so we can restore it after the ; following LDA #16 ; Set A = 16 to use as the text row for the message if ; this is a space view LDX QQ11 ; If this is the space view, skip the following BEQ infrontvw ; instruction JSR CLYNS ; Clear the bottom three text rows of the upper screen, ; and move the text cursor to the first cleared row LDA #25 ; Set A = 25 to use as the text row for the message if ; this is not a space view EQUB $2C ; Skip the next instruction by turning it into ; $2C $85 $33, or BIT $3385, which does nothing apart ; from affect the flags .infrontvw STA YC ; Move the text cursor to the row specified in A LDX #0 ; Set QQ17 = 0 to switch to ALL CAPS STX QQ17 LDA messXC ; Move the text cursor to column messXC, in case we JSR DOXC ; jump to me1 below to erase the current in-flight ; message (whose column we stored in messXC when we ; called MESS to put it there in the first place) PLA ; Restore A from the stack LDY #20 ; Set Y = 20 for setting the message delay below CPX DLY ; If the message delay in DLY is not zero, jump up to BNE me1 ; me1 to erase the current message first (whose token ; number will be in MCH) STY DLY ; Set the message delay in DLY to 20 STA MCH ; Set MCH to the token we are about to display ; Before we fall through into mes9 to print the token, ; we need to work out the starting column for the ; message we want to print, so it's centred on-screen, ; so the following doesn't print anything, it just uses ; the justified text mechanism to work out the number of ; characters in the message we are going to print LDA #%11000000 ; Set the DTW4 flag to %11000000 (justify text, buffer STA DTW4 ; entire token including carriage returns) LDA de ; Set the C flag to bit 1 of the destruction flag in de LSR A LDA #0 ; Set A = 0 BCC P%+4 ; If the destruction flag in de is not set, skip the ; following instruction LDA #10 ; Set A = 10 STA DTW5 ; Store A in DTW5, so DTW5 (which holds the size of the ; justified text buffer at BUF) is set to 0 if the ; destruction flag is not set, or 10 if it is (10 being ; the number of characters in the " DESTROYED" token) LDA MCH ; Call TT27 to print the token in MCH into the buffer JSR TT27 ; (this doesn't print it on-screen, it just puts it into ; the buffer and moves the DTW5 pointer along, so DTW5 ; now contains the size of the message we want to print, ; including the " DESTROYED" part if that's going to be ; included) LDA #32 ; Set A = (32 - DTW5) / 2 SEC ; SBC DTW5 ; so A now contains the column number we need to print LSR A ; our message at for it to be centred on-screen (as ; there are 32 columns) STA messXC ; Store A in messXC, so when we erase the message via ; the branch to me1 above, messXC will tell us where to ; print it JSR DOXC ; Move the text cursor to column messXC JSR MT15 ; Call MT15 to switch to left-aligned text when printing ; extended tokens disabling the justify text setting we ; set above LDA MCH ; Set MCH to the token we are about to display ; Fall through into mes9 to print the token in AName: MESS [Show more] Type: Subroutine Category: Flight Summary: Display an in-flight messageContext: See this subroutine on its own page References: This subroutine is called as follows: * EXNO2 calls MESS * FR1 calls MESS * Ghy calls MESS * KILLSHP calls MESS * Main flight loop (Part 8 of 16) calls MESS * Main flight loop (Part 12 of 16) calls MESS * Main flight loop (Part 15 of 16) calls MESS * me2 calls MESS * ou2 calls MESS * ou3 calls MESS * OUCH calls MESS * SFRMIS calls MESS
Display an in-flight message in capitals at the bottom of the space view, erasing any existing in-flight message first.
Arguments: A The text token to be printed.mes9 JSR TT27 ; Call TT27 to print the text token in A LSR de ; If bit 0 of variable de is clear, return from the BCC out ; subroutine (as out contains an RTS) LDA #253 ; Print recursive token 93 (" DESTROYED") and return JMP TT27 ; from the subroutine using a tail callName: mes9 [Show more] Type: Subroutine Category: Flight Summary: Print a text token, possibly followed by " DESTROYED"Context: See this subroutine on its own page References: This subroutine is called as follows: * me1 calls mes9
Print a text token, followed by " DESTROYED" if the destruction flag is set (for when a piece of equipment is destroyed)..OUCH JSR DORND ; Set A and X to random numbers BMI out ; If A < 0 (50% chance), return from the subroutine ; (as out contains an RTS) CPX #22 ; If X >= 22 (91% chance), return from the subroutine BCS out ; (as out contains an RTS) LDA QQ20,X ; If we do not have any of item QQ20+X, return from the BEQ out ; subroutine (as out contains an RTS). X is in the range ; 0-21, so this not only checks for cargo, but also for ; E.C.M., fuel scoops, energy bomb, energy unit and ; docking computer, all of which can be destroyed LDA DLY ; If there is already an in-flight message on-screen, BNE out ; return from the subroutine (as out contains an RTS) LDY #3 ; Set bit 1 of de, the equipment destruction flag, so STY de ; that when we call MESS below, " DESTROYED" is appended ; to the in-flight message STA QQ20,X ; A is 0 (as we didn't branch with the BNE above), so ; this sets QQ20+X to 0, which destroys any cargo or ; equipment we have of that type CPX #17 ; If X >= 17 then we just lost a piece of equipment, so BCS ou1 ; jump to ou1 to print the relevant message TXA ; Print recursive token 48 + A as an in-flight token, ADC #208 ; which will be in the range 48 ("FOOD") to 64 ("ALIEN JMP MESS ; ITEMS") as the C flag is clear, so this prints the ; destroyed item's name, followed by " DESTROYED" (as we ; set bit 1 of the de flag above), and returns from the ; subroutine using a tail call .ou1 BEQ ou2 ; If X = 17, jump to ou2 to print "E.C.M.SYSTEM ; DESTROYED" and return from the subroutine using a tail ; call CPX #18 ; If X = 18, jump to ou3 to print "FUEL SCOOPS BEQ ou3 ; DESTROYED" and return from the subroutine using a tail ; call TXA ; Otherwise X is in the range 19 to 21 and the C flag is ADC #113-20 ; set (as we got here via a BCS to ou1), so we set A as ; follows: ; ; A = 113 - 20 + X + C ; = 113 - 19 + X ; = 113 to 115 JMP MESS ; Print recursive token A ("ENERGY BOMB", "ENERGY UNIT" ; or "DOCKING COMPUTERS") as an in-flight message, ; followed by " DESTROYED", and return from the ; subroutine using a tail callName: OUCH [Show more] Type: Subroutine Category: Flight Summary: Potentially lose cargo or equipment following damageContext: See this subroutine on its own page References: This subroutine is called as follows: * OOPS calls OUCH
Our shields are dead and we are taking damage, so there is a small chance of losing cargo or equipment..ou2 LDA #108 ; Set A to recursive token 108 ("E.C.M.SYSTEM") JMP MESS ; Print recursive token A as an in-flight message, ; followed by " DESTROYED", and return from the ; subroutine using a tail callName: ou2 [Show more] Type: Subroutine Category: Flight Summary: Display "E.C.M.SYSTEM DESTROYED" as an in-flight messageContext: See this subroutine on its own page References: This subroutine is called as follows: * OUCH calls ou2.ou3 LDA #111 ; Set A to recursive token 111 ("FUEL SCOOPS") JMP MESS ; Print recursive token A as an in-flight message, ; followed by " DESTROYED", and return from the ; subroutine using a tail callName: ou3 [Show more] Type: Subroutine Category: Flight Summary: Display "FUEL SCOOPS DESTROYED" as an in-flight messageContext: See this subroutine on its own page References: This subroutine is called as follows: * OUCH calls ou3MACRO ITEM price, factor, units, quantity, mask IF factor < 0 s = 1 << 7 ELSE s = 0 ENDIF IF units = 't' u = 0 ELIF units = 'k' u = 1 << 5 ELSE u = 1 << 6 ENDIF e = ABS(factor) EQUB price EQUB s + u + e EQUB quantity EQUB mask ENDMACROName: ITEM [Show more] Type: Macro Category: Market Summary: Macro definition for the market prices table Deep dive: Market item prices and availability
The following macro is used to build the market prices table: ITEM price, factor, units, quantity, mask It inserts an item into the market prices table at QQ23. See the deep dive on "Market item prices and availability" for more information on how the market system works.
Arguments: price Base price factor Economic factor units Units: "t", "g" or "k" quantity Base quantity mask Fluctuations mask.QQ23 ITEM 19, -2, 't', 6, %00000001 ; 0 = Food ITEM 20, -1, 't', 10, %00000011 ; 1 = Textiles ITEM 65, -3, 't', 2, %00000111 ; 2 = Radioactives ITEM 40, -5, 't', 226, %00011111 ; 3 = Slaves ITEM 83, -5, 't', 251, %00001111 ; 4 = Liquor/Wines ITEM 196, 8, 't', 54, %00000011 ; 5 = Luxuries ITEM 235, 29, 't', 8, %01111000 ; 6 = Narcotics ITEM 154, 14, 't', 56, %00000011 ; 7 = Computers ITEM 117, 6, 't', 40, %00000111 ; 8 = Machinery ITEM 78, 1, 't', 17, %00011111 ; 9 = Alloys ITEM 124, 13, 't', 29, %00000111 ; 10 = Firearms ITEM 176, -9, 't', 220, %00111111 ; 11 = Furs ITEM 32, -1, 't', 53, %00000011 ; 12 = Minerals ITEM 97, -1, 'k', 66, %00000111 ; 13 = Gold ;EQUD $360A118 ; This data is commented out in the original source ITEM 171, -2, 'k', 55, %00011111 ; 14 = Platinum ITEM 45, -1, 'g', 250, %00001111 ; 15 = Gem-Stones ITEM 53, 15, 't', 192, %00000111 ; 16 = Alien itemsName: QQ23 [Show more] Type: Variable Category: Market Summary: Market prices tableContext: See this variable on its own page References: This variable is used as follows: * GVL uses QQ23 * TT151 uses QQ23 * TT210 uses QQ23
Each item has four bytes of data, like this: Byte #0 = Base price Byte #1 = Economic factor in bits 0-4, with the sign in bit 7 Unit in bits 5-6 Byte #2 = Base quantity Byte #3 = Mask to control price fluctuations To make it easier for humans to follow, we've defined a macro called ITEM that takes the following arguments and builds the four bytes for us: ITEM base price, economic factor, units, base quantity, mask So for food, we have the following: * Base price = 19 * Economic factor = -2 * Unit = tonnes * Base quantity = 6 * Mask = %00000001.TI2 ; Called from below with A = 0, X = 0, Y = 4 when ; nosev_x and nosev_y are small, so we assume that ; nosev_z is big TYA ; A = Y = 4 LDY #2 JSR TIS3 ; Call TIS3 with X = 0, Y = 2, A = 4, to set roofv_z = STA INWK+20 ; -(nosev_x * roofv_x + nosev_y * roofv_y) / nosev_z JMP TI3 ; Jump to TI3 to keep tidying .TI1 ; Called from below with A = 0, Y = 4 when nosev_x is ; small TAX ; Set X = A = 0 LDA XX15+1 ; Set A = nosev_y, and if the top two magnitude bits AND #%01100000 ; are both clear, jump to TI2 with A = 0, X = 0, Y = 4 BEQ TI2 LDA #2 ; Otherwise nosev_y is big, so set up the index values ; to pass to TIS3 JSR TIS3 ; Call TIS3 with X = 0, Y = 4, A = 2, to set roofv_y = STA INWK+18 ; -(nosev_x * roofv_x + nosev_z * roofv_z) / nosev_y JMP TI3 ; Jump to TI3 to keep tidying .TIDY LDA INWK+10 ; Set (XX15, XX15+1, XX15+2) = nosev STA XX15 LDA INWK+12 STA XX15+1 LDA INWK+14 STA XX15+2 JSR NORM ; Call NORM to normalise the vector in XX15, i.e. nosev LDA XX15 ; Set nosev = (XX15, XX15+1, XX15+2) STA INWK+10 LDA XX15+1 STA INWK+12 LDA XX15+2 STA INWK+14 LDY #4 ; Set Y = 4 LDA XX15 ; Set A = nosev_x, and if the top two magnitude bits AND #%01100000 ; are both clear, jump to TI1 with A = 0, Y = 4 BEQ TI1 LDX #2 ; Otherwise nosev_x is big, so set up the index values LDA #0 ; to pass to TIS3 JSR TIS3 ; Call TIS3 with X = 2, Y = 4, A = 0, to set roofv_x = STA INWK+16 ; -(nosev_y * roofv_y + nosev_z * roofv_z) / nosev_x .TI3 LDA INWK+16 ; Set (XX15, XX15+1, XX15+2) = roofv STA XX15 LDA INWK+18 STA XX15+1 LDA INWK+20 STA XX15+2 JSR NORM ; Call NORM to normalise the vector in XX15, i.e. roofv LDA XX15 ; Set roofv = (XX15, XX15+1, XX15+2) STA INWK+16 LDA XX15+1 STA INWK+18 LDA XX15+2 STA INWK+20 LDA INWK+12 ; Set Q = nosev_y STA Q LDA INWK+20 ; Set A = roofv_z JSR MULT12 ; Set (S R) = Q * A = nosev_y * roofv_z LDX INWK+14 ; Set X = nosev_z LDA INWK+18 ; Set A = roofv_y JSR TIS1 ; Set (A ?) = (-X * A + (S R)) / 96 ; = (-nosev_z * roofv_y + nosev_y * roofv_z) / 96 ; ; This also sets Q = nosev_z EOR #%10000000 ; Set sidev_x = -A STA INWK+22 ; = (nosev_z * roofv_y - nosev_y * roofv_z) / 96 LDA INWK+16 ; Set A = roofv_x JSR MULT12 ; Set (S R) = Q * A = nosev_z * roofv_x LDX INWK+10 ; Set X = nosev_x LDA INWK+20 ; Set A = roofv_z JSR TIS1 ; Set (A ?) = (-X * A + (S R)) / 96 ; = (-nosev_x * roofv_z + nosev_z * roofv_x) / 96 ; ; This also sets Q = nosev_x EOR #%10000000 ; Set sidev_y = -A STA INWK+24 ; = (nosev_x * roofv_z - nosev_z * roofv_x) / 96 LDA INWK+18 ; Set A = roofv_y JSR MULT12 ; Set (S R) = Q * A = nosev_x * roofv_y LDX INWK+12 ; Set X = nosev_y LDA INWK+16 ; Set A = roofv_x JSR TIS1 ; Set (A ?) = (-X * A + (S R)) / 96 ; = (-nosev_y * roofv_x + nosev_x * roofv_y) / 96 EOR #%10000000 ; Set sidev_z = -A STA INWK+26 ; = (nosev_y * roofv_x - nosev_x * roofv_y) / 96 LDA #0 ; Set A = 0 so we can clear the low bytes of the ; orientation vectors LDX #14 ; We want to clear the low bytes, so start from sidev_y ; at byte #9+14 (we clear all except sidev_z_lo, though ; I suspect this is in error and that X should be 16) .TIL1 STA INWK+9,X ; Set the low byte in byte #9+X to zero DEX ; Set X = X - 2 to jump down to the next low byte DEX BPL TIL1 ; Loop back until we have zeroed all the low bytes RTS ; Return from the subroutineName: TIDY [Show more] Type: Subroutine Category: Maths (Geometry) Summary: Orthonormalise the orientation vectors for a ship Deep dive: Tidying orthonormal vectors Orientation vectorsContext: See this subroutine on its own page References: This subroutine is called as follows: * MVEIT (Part 1 of 9) calls TIDY
This routine orthonormalises the orientation vectors for a ship. This means making the three orientation vectors orthogonal (perpendicular to each other), and normal (so each of the vectors has length 1). We do this because we use the small angle approximation to rotate these vectors in space. It is not completely accurate, so the three vectors tend to get stretched over time, so periodically we tidy the vectors with this routine to ensure they remain as orthonormal as possible..TIS2 TAY ; Store the argument A in Y AND #%01111111 ; Strip the sign bit from the argument, so A = |A| CMP Q ; If A >= Q then jump to TI4 to return a 1 with the BCS TI4 ; correct sign LDX #%11111110 ; Set T to have bits 1-7 set, so we can rotate through 7 STX T ; loop iterations, getting a 1 each time, and then ; getting a 0 on the 8th iteration... and we can also ; use T to catch our result bits into bit 0 each time .TIL2 ASL A ; Shift A to the left CMP Q ; If A < Q skip the following subtraction BCC P%+4 SBC Q ; A >= Q, so set A = A - Q ; ; Going into this subtraction we know the C flag is ; set as we passed through the BCC above, and we also ; know that A >= Q, so the C flag will still be set once ; we are done ROL T ; Rotate the counter in T to the left, and catch the ; result bit into bit 0 (which will be a 0 if we didn't ; do the subtraction, or 1 if we did) BCS TIL2 ; If we still have set bits in T, loop back to TIL2 to ; do the next iteration of 7 ; We've done the division and now have a result in the ; range 0-255 here, which we need to reduce to the range ; 0-96. We can do that by multiplying the result by 3/8, ; as 256 * 3/8 = 96 LDA T ; Set T = T / 4 LSR A LSR A STA T LSR A ; Set T = T / 8 + T / 4 ADC T ; = 3T / 8 STA T TYA ; Fetch the sign bit of the original argument A AND #%10000000 ORA T ; Apply the sign bit to T RTS ; Return from the subroutine .TI4 TYA ; Fetch the sign bit of the original argument A AND #%10000000 ORA #96 ; Apply the sign bit to 96 (which represents 1) RTS ; Return from the subroutineName: TIS2 [Show more] Type: Subroutine Category: Maths (Arithmetic) Summary: Calculate A = A / Q Deep dive: Shift-and-subtract divisionContext: See this subroutine on its own page References: This subroutine is called as follows: * NORM calls TIS2
Calculate the following division, where A is a sign-magnitude number and Q is a positive integer: A = A / Q The value of A is returned as a sign-magnitude number with 96 representing 1, and the maximum value returned is 1 (i.e. 96). This routine is used when normalising vectors, where we represent fractions using integers, so this gives us an approximation to two decimal places..TIS3 STA P+2 ; Store P+2 in A for later LDA INWK+10,X ; Set Q = nosev_x_hi (plus X) STA Q LDA INWK+16,X ; Set A = roofv_x_hi (plus X) JSR MULT12 ; Set (S R) = Q * A ; = nosev_x_hi * roofv_x_hi LDX INWK+10,Y ; Set Q = nosev_x_hi (plus Y) STX Q LDA INWK+16,Y ; Set A = roofv_x_hi (plus Y) JSR MAD ; Set (A X) = Q * A + (S R) ; = (nosev_x,X * roofv_x,X) + ; (nosev_x,Y * roofv_x,Y) STX P ; Store low byte of result in P, so result is now in ; (A P) LDY P+2 ; Set Q = roofv_x_hi (plus argument A) LDX INWK+10,Y STX Q EOR #%10000000 ; Flip the sign of A ; Fall through into DIVDT to do: ; ; (P+1 A) = (A P) / Q ; ; = -((nosev_x,X * roofv_x,X) + ; (nosev_x,Y * roofv_x,Y)) ; / nosev_x,AName: TIS3 [Show more] Type: Subroutine Category: Maths (Arithmetic) Summary: Calculate -(nosev_1 * roofv_1 + nosev_2 * roofv_2) / nosev_3Context: See this subroutine on its own page References: This subroutine is called as follows: * TIDY calls TIS3
Calculate the following expression: A = -(nosev_1 * roofv_1 + nosev_2 * roofv_2) / nosev_3 where 1, 2 and 3 are x, y, or z, depending on the values of X, Y and A. This routine is called with the following values: X = 0, Y = 2, A = 4 -> A = -(nosev_x * roofv_x + nosev_y * roofv_y) / nosev_z X = 0, Y = 4, A = 2 -> A = -(nosev_x * roofv_x + nosev_z * roofv_z) / nosev_y X = 2, Y = 4, A = 0 -> A = -(nosev_y * roofv_y + nosev_z * roofv_z) / nosev_x
Arguments: X Index 1 (0 = x, 2 = y, 4 = z) Y Index 2 (0 = x, 2 = y, 4 = z) A Index 3 (0 = x, 2 = y, 4 = z).DVIDT STA P+1 ; Set P+1 = A, so P(1 0) = (A P) EOR Q ; Set T = the sign bit of A EOR Q, so it's 1 if A and Q AND #%10000000 ; have different signs, i.e. it's the sign of the result STA T ; of A / Q LDA #0 ; Set A = 0 for us to build a result LDX #16 ; Set a counter in X to count the 16 bits in P(1 0) ASL P ; Shift P(1 0) left ROL P+1 ASL Q ; Clear the sign bit of Q the C flag at the same time LSR Q .DVL2 ROL A ; Shift A to the left CMP Q ; If A < Q skip the following subtraction BCC P%+4 SBC Q ; Set A = A - Q ; ; Going into this subtraction we know the C flag is ; set as we passed through the BCC above, and we also ; know that A >= Q, so the C flag will still be set once ; we are done ROL P ; Rotate P(1 0) to the left, and catch the result bit ROL P+1 ; into the C flag (which will be a 0 if we didn't ; do the subtraction, or 1 if we did) DEX ; Decrement the loop counter BNE DVL2 ; Loop back for the next bit until we have done all 16 ; bits of P(1 0) LDA P ; Set A = P so the low byte is in the result in A ORA T ; Set A to the correct sign bit that we set in T above .itsoff RTS ; Return from the subroutineName: DVIDT [Show more] Type: Subroutine Category: Maths (Arithmetic) Summary: Calculate (P+1 A) = (A P) / QContext: See this subroutine on its own page References: This subroutine is called as follows: * startbd calls via itsoff * stopbd calls via itsoff
Calculate the following integer division between sign-magnitude numbers: (P+1 A) = (A P) / Q This uses the same shift-and-subtract algorithm as TIS2.
Other entry points: itsoff Contains an RTSIF _GMA_RELEASE .startat LDA #LO(THEME-1) ; Set (A X) to THEME-1, which is the address before LDX #HI(THEME-1) ; the start of the title music at THEME BNE startat2 ; Jump to startat2 to play the title music (this BNE is ; effectively a JMP as X is never zero) ENDIFName: startat [Show more] Type: Subroutine Category: Sound Summary: Start playing the title music, if configuredContext: See this subroutine on its own page References: This subroutine is called as follows: * BR1 (Part 1 of 2) calls startat * startbd calls startat.startbd IF _GMA_RELEASE BIT MUDOCK ; If bit 7 of MUDOCK is set then the docking computer BMI startat ; has been configured to play the title music rather ; than the docking music, so jump to startat to set ; (A X) to the address of the title music to play when ; docking LDA #LO(musicstart) ; Set (A X) = musicstart, the address before the start LDX #HI(musicstart) ; of the docking music .startat2 STA value5 ; Set value5(1 0) = (A X) STX value5+1 ; ; So value5 contains the address before the start of the ; music we want to play ENDIF BIT MUPLA ; If bit 7 of MUPLA is set then there is already music BMI itsoff ; playing so we don't want to start any more, so jump to ; itsoff to return from the subroutine (as itsoff ; contains an RTS) BIT MUFOR ; If bit 7 of MUFOR is set then the docking music is BMI april16 ; configured so that it cannot be disabled, so skip the ; following check for MUTOK BIT MUTOK ; If bit 7 of MUTOK is set then the docking music is BMI itsoff ; disabled, so jump to itsoff to return from the ; subroutine without playing the docking music (as ; itsoff contains an RTS) .april16 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 JSR BDENTRY ; Start playing the configured background music LDA #$FF ; Set MUPLA to $FF to indicate that music is now playing STA MUPLA BNE coffeeex ; Jump to coffeeex to restore the memory configuration ; and return from the subroutine (this BNE is ; effectively a JMP as A is never zero)Name: startbd [Show more] Type: Subroutine Category: Sound Summary: Start playing the docking music, if configuredContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 3 of 16) calls startbd * stopbd calls startbd * MUTOKCH calls via april16 * startat calls via startat2
Other entry points: april16 Start playing the docking music, irrespective of the current configuration settings startat2 Start playing the music at address (A X) + 1.MUTOKCH STA MUTOKOLD ; Store the new value of MUTOK in MUTOKOLD so we can ; check whether it changes again EOR #$FF ; If MUTOK = 0 and bit 7 of auto is set, then the AND auto ; docking music has just been enabled and the docking BMI april16 ; computer is running, so jump to april16 to start ; playing the docking music ; Otherwise either the docking music has just been ; disabled and/or the docking computer is not running, ; so fall through into stopbd to stop playing the ; docking musicName: MUTOKCH [Show more] Type: Subroutine Category: Sound Summary: Process a change in the docking music configuration settingContext: See this subroutine on its own page References: This subroutine is called as follows: * DK4 calls MUTOKCH
Arguments: A The new value of MUTOK.stopbd IF _GMA_RELEASE BIT MULIE ; If bit 7 of MULIE is set then the RESET routine is BMI itsoff ; currently being run ; ; This means the music configuration variables may be in ; a state of flux as they are updated by the RESET ; routine, so if this is the case, jump to itsoff to ; return from the subroutine (as itsoff contains an RTS) ENDIF BIT MUFOR ; If bit 7 of MUFOR is set then the docking music is BMI startbd ; configured so that it cannot be disabled, so jump to ; startbd to start playing the docking music instead .stopat BIT MUPLA ; If bit 7 of MUPLA is clear then no music is currently BPL itsoff ; playing, so jump to itsoff to return from the ; subroutine (as itsoff contains an RTS) JSR SOFLUSH ; Call SOFLUSH to reset the sound buffers 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 LDA #0 ; Set MUPLA to 0 to indicate that no music is playing STA MUPLA LDX #$18 ; We now want to zero SID registers $00 to $18, so set ; an index counter in X SEI ; Disable interrupts while we update the SID registers .coffeeloop STA SID,X ; Zero the X-th SID register DEX ; Decrement the loop counter BPL coffeeloop ; Loop back until we have zeroed all SID registers from ; $18 down to $00 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 CLI ; Enable interrupts again .coffeeex LDA #%100 ; Call SETL1 to set the 6510 input/output port to the JMP SETL1 ; following: ; ; * 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 GuideName: stopbd [Show more] Type: Subroutine Category: Sound Summary: Stop playing the docking musicContext: See this subroutine on its own page References: This subroutine is called as follows: * Main flight loop (Part 3 of 16) calls stopbd * Main flight loop (Part 9 of 16) calls stopbd * RES2 calls stopbd * BR1 (Part 1 of 2) calls via stopat * BR1 (Part 2 of 2) calls via stopat * startbd calls via coffeeex
Other entry points: stopat Stop playing the current music coffeeex Restore the memory configuration and return from the subroutine.buf EQUB 2 ; Transmit 2 bytes as part of this command EQUB 15 ; Receive 15 bytes as part of this command .KTRAN EQUS "1234567890" ; A 17-byte buffer to hold the key logger data from the EQUS "1234567" ; KEYBOARD routine in the I/O processor (note that only ; 12 of these bytes are actually updated by the KEYBOARD ; routine)Name: KTRAN [Show more] Type: Variable Category: Keyboard Summary: An unused key logger buffer that's left over from the 6502 Second Processor version of EliteContext: See this variable on its own page References: This variable is used as follows: * DKS2 uses KTRAN.TRANTABLE EQUB 0 ; Not used EQUB 1 ; RUN/STOP is translated to ASCII 1 EQUS "Q" EQUB 2 ; "C=" is translated to ASCII 2 EQUS " 2" EQUB 3 ; CTRL is translated to ASCII 3 EQUB 27 ; Left arrow is translated to ASCII 27 EQUS "1/" EQUS "^" ; UP arrow is translated to "^" EQUS "=" EQUB 5 ; Right SHIFT is translated to ASCII 5 EQUB 6 ; CLR/HOME is translated to ASCII 6 EQUS "!DELIMITER!*" EQUS "`" ; "£" is translated to "`" EQUS ",@:.-LP+" EQUS "NOKM0JI9" EQUS "VUHB8GY7" EQUS "XTFC6DR5" EQUB 7 ; Left SHIFT is translated to ASCII 7 EQUS "ESZ4AW3" EQUB 8 ; Cursor up/down is translated to ASCII 8 EQUB 9 ; F5 is translated to ASCII 9 EQUB 10 ; F3 is translated to ASCII 10 EQUB 11 ; F1 is translated to ASCII 11 EQUB 12 ; F7 is translated to ASCII 12 EQUB 14 ; Cursor left/right is translated to ASCII 14 EQUB 13 ; RETURN is translated to ASCII 13 EQUB 127 ; INS/DEL is translated to ASCII 127Name: TRANTABLE [Show more] Type: Variable Category: Keyboard Summary: Translation table from internal key number to ASCIIContext: See this variable on its own page References: This variable is used as follows: * TT217 uses TRANTABLE
This table translates internal key numbers (i.e. the offset of a key in the key logger table at KEYLOOK) into ASCII.PRINT "ELITE F" PRINT "Assembled at ", ~CODE_F% PRINT "Ends at ", ~P% PRINT "Code size is ", ~(P% - CODE_F%) PRINT "Execute at ", ~LOAD% PRINT "Reload at ", ~LOAD_F% PRINT "S.ELTF ", ~CODE_F%, " ", ~P%, " ", ~LOAD%, " ", ~LOAD_F% SAVE "3-assembled-output/ELTF.bin", CODE_F%, P%, LOAD%Save ELTF.bin
[X]
Subroutine ABORT (category: Dashboard)
Disarm missiles and update the dashboard indicators
[X]
Configuration variable ADA
Ship type for an Adder
[X]
Subroutine ADD (category: Maths (Arithmetic))
Calculate (A X) = (A P) + (S R)
[X]
Subroutine BAD (category: Status)
Calculate how bad we have been
[X]
Subroutine BAY (category: Status)
Go to the docking bay (i.e. show the Status Mode screen)
[X]
Subroutine BDENTRY (category: Sound)
Start playing a new tune as background music
[X]
Subroutine BELL (category: Sound)
Make a standard system beep
[X]
Configuration variable BLACK2
A multicolour bitmap mode palette byte for screen RAM that sets dark grey ($B) for %01 in the bitmap and yellow (7) for %10 in the bitmap, for displaying an empty missile indicator
[X]
Subroutine BOMBOFF (category: Drawing the screen)
Switch off the energy bomb effect
[X]
Subroutine BPRNT (category: Text)
Print a 32-bit number, left-padded to a specific number of digits, with an optional decimal point
[X]
Subroutine BR1 (Part 1 of 2) (category: Start and end)
Show the "Load New Commander (Y/N)?" screen and start the game
[X]
Subroutine BUMP2 (category: Dashboard)
Bump up the value of the pitch or roll dashboard indicator
[X]
Subroutine CHECK (category: Save and load)
Calculate the checksum for the last saved commander data block
[X]
Subroutine CHECK2 (category: Save and load)
Calculate the third checksum for the last saved commander data block (Commodore 64 and Apple II versions only)
[X]
Variable CHK (category: Save and load)
First checksum byte for the saved commander data file
[X]
Variable CHK2 (category: Save and load)
Second checksum byte for the saved commander data file
[X]
Variable CHK3 (category: Save and load)
Third checksum byte for the saved commander data file
[X]
Subroutine CHPR (category: Text)
Print a character at the text cursor by poking into screen memory
[X]
Configuration variable CIA
Registers for the CIA1 I/O interface chip, which are memory-mapped to the 16 bytes from $DC00 to $DC0F (see page 428 of the Programmer's Reference Guide)
[X]
Subroutine CLYNS (category: Drawing the screen)
Clear the bottom three text rows of the space view
[X]
Variable COMC in workspace Option variables
The colour of the dot on the compass
[X]
Configuration variable CON
Ship type for a Constrictor
[X]
Configuration variable COPS
Ship type for a Viper
[X]
Configuration variable COU
Ship type for a Cougar
[X]
Configuration variable CYL
Ship type for a Cobra Mk III
[X]
Configuration variable CYL2
Ship type for a Cobra Mk III (pirate)
[X]
Variable DAMP in workspace Option variables
Keyboard damping configuration setting
[X]
Subroutine DEATH2 (category: Start and end)
Reset most of the game and restart from the title screen
[X]
Subroutine DELAY (category: Utility routines)
Wait for a specified time, in either 1/50s of a second (on PAL systems) or 1/60s of a second (on NTSC systems)
[X]
Subroutine DET1 (category: Drawing the screen)
Show or hide the dashboard (for when we die)
[X]
Subroutine DETOK (category: Text)
Print an extended recursive token from the TKN1 token table
[X]
Subroutine DFAULT (category: Start and end)
Reset the current commander data block to the last saved commander
[X]
Subroutine DIALS (Part 1 of 4) (category: Dashboard)
Update the dashboard: speed indicator
[X]
Configuration variable DINT
Internal key number for key "D" (Distance to system)
[X]
Variable DISK in workspace Option variables
Current media configuration setting
[X]
Subroutine DKS3 (category: Keyboard)
Toggle a configuration setting and emit a beep
[X]
Variable DNOIZ in workspace Option variables
Sound on/off configuration setting
[X]
Subroutine DOCKIT (category: Flight)
Apply docking manoeuvres to the ship in INWK
[X]
Subroutine DORND (category: Maths (Arithmetic))
Generate random numbers
[X]
Subroutine DOVDU19 (category: Drawing the screen)
Implement the #SETVDU19 command (change mode 1 palette)
[X]
Subroutine DOXC (category: Text)
Move the text cursor to a specific column
[X]
Subroutine DOYC (category: Text)
Move the text cursor to a specific row
[X]
Variable DTW4 (category: Text)
Flags that govern how justified extended text tokens are printed
[X]
Variable DTW5 (category: Text)
The size of the justified text buffer at BUF
[X]
Subroutine ECMOF (category: Sound)
Switch off the E.C.M.
[X]
Label EE20 in subroutine Main game loop (Part 5 of 6)
[X]
Subroutine EQSHP (category: Equipment)
Show the Equip Ship screen
[X]
Subroutine EXNO3 (category: Sound)
Make an explosion sound
[X]
Subroutine FEED (category: Text)
Print a newline
[X]
Configuration variable FINT
Internal key number for key "F" (System search)
[X]
Subroutine FLFLLS (category: Drawing suns)
Reset the sun line heap
[X]
Subroutine FLKB (category: Keyboard)
Flush the keyboard buffer
[X]
Entry point FRCE in subroutine Main game loop (Part 6 of 6) (category: Main loop)
The entry point for the main game loop if we want to jump straight to a specific screen, by pretending to "press" a key, in which case A contains the internal key number of the key we want to "press"
[X]
Configuration variable GREEN2
A multicolour bitmap mode palette byte for screen RAM that sets green (5) for %01 in the bitmap and yellow (7) for %10 in the bitmap, for displaying a green missile indicator
[X]
Subroutine GTHG (category: Universe)
Spawn a Thargoid ship and a Thargon companion
[X]
Subroutine GTNMEW (category: Save and load)
Fetch the name of a commander file to save or load
[X]
Configuration variable HER
Ship type for a rock hermit (asteroid)
[X]
Configuration variable HINT
Internal key number for key "H" (Hyperspace)
[X]
Subroutine HME2 (category: Charts)
Search the galaxy for a system
[X]
Macro ITEM (category: Market)
Macro definition for the market prices table
[X]
Subroutine JAMESON (category: Save and load)
Restore the default JAMESON commander
[X]
Configuration variable JH
Junk is defined as ending before the Cobra Mk III
[X]
Configuration variable JL
Junk is defined as starting from the escape pod
[X]
Variable JSTE in workspace Option variables
Reverse both joystick channels configuration setting
[X]
Variable JSTGY in workspace Option variables
Reverse joystick Y-channel configuration setting
[X]
Variable JSTK in workspace Option variables
Keyboard or joystick configuration setting
[X]
Workspace K% (category: Workspaces)
Ship data blocks and ship line heaps
[X]
Configuration variable KERNALLOAD
The Kernal function to load a file from a device
[X]
Configuration variable KERNALSETLFS
The Kernal function to set the logical, first, and second addresses for file access
[X]
Configuration variable KERNALSETMSG
The Kernal function to control Kernal messages
[X]
Configuration variable KERNALSETNAM
The Kernal function to set a filename
[X]
Subroutine KERNALSETUP (category: Save and load)
Set up memory and interrupts so we can use the Kernal functions and configure the file system device number and filename
[X]
Configuration variable KERNALSVE
The Kernal function to save a file to a device
[X]
Workspace KEYLOOK (category: Keyboard)
The key logger
[X]
Subroutine KILLSHP (category: Universe)
Remove a ship from our local bubble of universe
[X]
Subroutine KS2 (category: Universe)
Check the local bubble for missiles with target lock
[X]
Subroutine KS3 (category: Universe)
Set the SLSP ship line heap pointer after shuffling ship slots
[X]
Subroutine KS4 (category: Universe)
Remove the space station and replace it with the sun
[X]
Variable KTRAN (category: Keyboard)
An unused key logger buffer that's left over from the 6502 Second Processor version of Elite
[X]
Variable L1M (category: Utility routines)
Temporary storage for the new value of the 6510 input/output port register
[X]
Label LABEL_2 in subroutine Main game loop (Part 4 of 6)
[X]
Subroutine LL5 (category: Maths (Arithmetic))
Calculate Q = SQRT(R Q)
[X]
Subroutine LL9 (Part 1 of 12) (category: Drawing ships)
Draw ship: Check if ship is exploding, check if ship is in front
[X]
Subroutine LOD (category: Save and load)
Load a commander file
[X]
Subroutine LOOK1 (category: Flight)
Initialise the space view
[X]
Configuration variable LS%
The start of the descending ship line heap
[X]
Variable LSX2 (category: Drawing lines)
The ball line heap for storing x-coordinates
[X]
Variable LSY2 (category: Drawing lines)
The ball line heap for storing y-coordinates
[X]
Entry point M% in subroutine Main flight loop (Part 1 of 16) (category: Main loop)
The entry point for the main flight loop NOMVETR The re-entry point in the main game loop for when there are no sprites to move
[X]
Subroutine MAD (category: Maths (Arithmetic))
Calculate (A X) = Q * A + (S R)
[X]
Configuration variable MAG2
A multicolour text mode palette byte for screen RAM that displays purple (4) foreground text on a black (0) background for showing player input in the text view
[X]
Entry point MAL1 in subroutine Main flight loop (Part 4 of 16) (category: Main loop)
Marks the beginning of the ship analysis loop, so we can jump back here from part 12 of the main flight loop to work our way through each ship in the local bubble. We also jump back here when a ship is removed from the bubble, so we can continue processing from the next ship
[X]
Subroutine MAS2 (category: Maths (Geometry))
Calculate a cap on the maximum distance to the planet or sun
[X]
Subroutine MESS (category: Flight)
Display an in-flight message
[X]
Entry point MLOOP in subroutine Main game loop (Part 5 of 6) (category: Main loop)
The entry point for the main game loop. This entry point comes after the call to the main flight loop and spawning routines, so it marks the start of the main game loop for when we are docked (as we don't need to call the main flight loop or spawning routines if we aren't in space)
[X]
Label MLOOPS in subroutine Main game loop (Part 3 of 6)
[X]
Subroutine MSBAR (category: Dashboard)
Draw a specific indicator in the dashboard's missile bar
[X]
Configuration variable MSL
Ship type for a missile
[X]
Subroutine MT15 (category: Text)
Switch to left-aligned text when printing extended tokens
[X]
Subroutine MT26 (category: Text)
Fetch a line of text from the keyboard
[X]
Label MTT1 in subroutine Main game loop (Part 3 of 6)
[X]
Label MTT2 in subroutine Main game loop (Part 2 of 6)
[X]
Label MTT3 in subroutine Main game loop (Part 2 of 6)
[X]
Label MTT4 in subroutine Main game loop (Part 1 of 6)
[X]
Variable MUDOCK in workspace Option variables
Docking music tune configuration setting
[X]
Variable MUFOR in workspace Option variables
Configuration setting that controls whether the docking music can be enabled or disabled
[X]
Variable MULIE in workspace Option variables
A flag to record whether the RESET routine is currently being run, in which case the music configuration variables may be in a state of flux
[X]
Subroutine MULT12 (category: Maths (Arithmetic))
Calculate (S R) = Q * A
[X]
Variable MUPLA in workspace Option variables
A flag to record whether any music is currently playing
[X]
Variable MUSILLY in workspace Option variables
Sounds during music configuration setting
[X]
Variable MUTOK in workspace Option variables
Docking music configuration setting
[X]
Subroutine MUTOKCH (category: Sound)
Process a change in the docking music configuration setting
[X]
Variable MUTOKOLD in workspace Option variables
Used to store the previous value of MUTOK, so we can track whether the docking music configuration changes
[X]
Subroutine MVEIT (Part 1 of 9) (category: Moving)
Move current ship: Tidy the orientation vectors
[X]
Variable NA% (category: Save and load)
The data block for the last saved commander
[X]
Variable NA2% (category: Save and load)
The data block for the default commander
[X]
Configuration variable NI%
The number of bytes in each ship's data block (as stored in INWK and K%)
[X]
Label NOCON in subroutine Main game loop (Part 4 of 6)
[X]
Subroutine NOISE (category: Sound)
Make the sound whose number is in Y
[X]
Subroutine NOISE2 (category: Sound)
Make a sound effect with a specific volume and release length
[X]
Label NOLASCT in subroutine Main game loop (Part 5 of 6)
[X]
Subroutine NORM (category: Maths (Geometry))
Normalise the three-coordinate vector in XX15
[X]
Subroutine NOSPRITES (category: Missions)
Disable all sprites and remove them from the screen
[X]
Label NOSQUEEK in subroutine Main game loop (Part 5 of 6)
[X]
Configuration variable NOST
The number of stardust particles in normal space (this goes down to 3 in witchspace)
[X]
Subroutine NWSHP (category: Universe)
Add a new ship to our local bubble of universe
[X]
Configuration variable OIL
Ship type for a cargo canister
[X]
Configuration variable OINT
Internal key number for key "O" (Crosshairs home)
[X]
Configuration variable PACK
The first of the eight pack-hunter ships, which tend to spawn in groups. With the default value of PACK the pack-hunters are the Sidewinder, Mamba, Krait, Adder, Gecko, Cobra Mk I, Worm and Cobra Mk III (pirate)
[X]
Configuration variable PALCK
When USA% is set to FALSE, a timing loop is included in the build that waits until the raster line in PALCK is reached; the LO() extracts the lower byte of the raster line to make it easier to compare with VIC-II register $12, which contains the bottom byte of the 9-bit raster line count
[X]
Variable PATG in workspace Option variables
Configuration setting to show the author names on the start-up screen and enable manual hyperspace mis-jumps
[X]
Configuration variable PLT
Ship type for an alloy plate
[X]
Entry point QU5 in subroutine BR1 (Part 1 of 2) (category: Start and end)
Restart the game using the last saved commander without asking whether to load a new commander file
[X]
Variable RASTCT (category: Drawing the screen)
The current raster count, which flips between 0 and 1 on each call to the COMIRQ1 interrupt handler (0 = space view, 1 = dashboard)
[X]
Subroutine RDKEY (category: Keyboard)
Scan the keyboard for key presses
[X]
Subroutine REDU2 (category: Dashboard)
Reduce the value of the pitch or roll dashboard indicator
[X]
Subroutine RES2 (category: Start and end)
Reset a number of flight variables and workspaces
[X]
Subroutine RESET (category: Start and end)
Reset most variables
[X]
Variable RLINE (category: Text)
The OSWORD configuration block used to fetch a line of text from the keyboard
[X]
Configuration variable SCBASE
The address of the screen bitmap
[X]
Subroutine SETL1 (category: Utility routines)
Set the 6510 input/output port register to control the memory map
[X]
Configuration variable SID
Registers for the SID sound synthesis chip, which are memory-mapped to the 29 bytes from $D400 to $D41C (see page 461 of the Programmer's Reference Guide)
[X]
Subroutine SOFLUSH (category: Sound)
Reset the sound buffers and turn off all sound channels
[X]
Subroutine SPBLB (category: Dashboard)
Light up the space station indicator ("S") on the dashboard
[X]
Subroutine SPS3 (category: Maths (Geometry))
Copy a space coordinate from the K% block into K3
[X]
Subroutine SQUA (category: Maths (Arithmetic))
Clear bit 7 of A and calculate (A P) = A * A
[X]
Configuration variable SST
Ship type for a Coriolis space station
[X]
Subroutine STATUS (category: Status)
Show the Status Mode screen
[X]
Subroutine SVE (category: Save and load)
Display the disk access menu and process saving of commander files
[X]
Subroutine SWAPPZERO (category: Utility routines)
A routine that swaps zero page with the page at $CE00, so that zero page changes made by Kernal functions can be reversed
[X]
Configuration variable TAP%
The staging area where we copy files after loading and before saving
[X]
Variable TGINT (category: Keyboard)
The keys used to toggle configuration settings when the game is paused
[X]
Subroutine THERE (category: Missions)
Check whether we are in the Constrictor's system in mission 1
[X]
[X]
Subroutine TIS1 (category: Maths (Arithmetic))
Calculate (A ?) = (-X * A + (S R)) / 96
[X]
Subroutine TIS2 (category: Maths (Arithmetic))
Calculate A = A / Q
[X]
Subroutine TIS3 (category: Maths (Arithmetic))
Calculate -(nosev_1 * roofv_1 + nosev_2 * roofv_2) / nosev_3
[X]
Subroutine TITLE (category: Start and end)
Display a title screen with a rotating ship and prompt
[X]
Subroutine TR1 (category: Save and load)
Copy the last saved commander's name from NA% to INWK
[X]
Variable TRANTABLE (category: Keyboard)
Translation table from internal key number to ASCII
[X]
Subroutine TRNME (category: Save and load)
Copy the last saved commander's name from INWK to NA%
[X]
Entry point TT100 in subroutine Main game loop (Part 2 of 6) (category: Main loop)
The entry point for the start of the main game loop, which calls the main flight loop and the moves into the spawning routine
[X]
Subroutine TT102 (category: Keyboard)
Process function key, save key, hyperspace and chart key presses and update the hyperspace counter
[X]
Subroutine TT103 (category: Charts)
Draw a small set of crosshairs on a chart
[X]
Subroutine TT110 (category: Flight)
Launch from a station or show the front space view
[X]
Subroutine TT111 (category: Universe)
Set the current system to the nearest system to a point
[X]
Subroutine TT146 (category: Universe)
Print the distance to the selected system in light years
[X]
Subroutine TT16 (category: Charts)
Move the crosshairs on a chart
[X]
Subroutine TT167 (category: Market)
Show the Market Price screen
[X]
Subroutine TT17 (category: Keyboard)
Scan the keyboard for cursor key or joystick movement
[X]
Subroutine TT18 (category: Flight)
Try to initiate a jump into hyperspace
[X]
Subroutine TT208 (category: Market)
Show the Sell Cargo screen
[X]
Subroutine TT213 (category: Market)
Show the Inventory screen
[X]
Subroutine TT217 (category: Keyboard)
Scan the keyboard until a key is pressed
[X]
Subroutine TT219 (category: Market)
Show the Buy Cargo screen
[X]
Subroutine TT22 (category: Charts)
Show the Long-range Chart
[X]
Subroutine TT23 (category: Charts)
Show the Short-range Chart
[X]
Subroutine TT25 (category: Universe)
Show the Data on System screen
[X]
Subroutine TT26 (category: Text)
Print a character at the text cursor, with support for verified text in extended tokens
[X]
Subroutine TT27 (category: Text)
Print a text token
[X]
Subroutine TT66 (category: Drawing the screen)
Clear the screen and set the current view type
[X]
Subroutine TT67 (category: Text)
Print a newline
[X]
Subroutine U% (category: Keyboard)
Clear the key logger and reset a number of flight variables
[X]
Variable UNIV (category: Universe)
Table of pointers to the local universe's ship data blocks
[X]
Configuration variable VIC
Registers for the VIC-II video controller chip, which are memory-mapped to the 46 bytes from $D000 to $D02E (see page 454 of the Programmer's Reference Guide)
[X]
Subroutine WPSHPS (category: Dashboard)
Clear the scanner, reset the ball line and sun line heaps
[X]
Subroutine WSCAN (category: Drawing the screen)
Wait for the vertical sync
[X]
Temporary storage, used to store the address of a ship blueprint. For example, it is used when we add a new ship to the local bubble in routine NWSHP, and it contains the address of the current ship's blueprint as we loop through all the nearby ships in the main flight loop
[X]
Configuration variable XX21
The address of the ship blueprints lookup table, as set in elite-data.asm
[X]
Configuration variable Y
The centre y-coordinate of the 256 x 144 space view
[X]
Label YESCON in subroutine Main game loop (Part 4 of 6)
[X]
Subroutine YESNO (category: Keyboard)
Wait until either "Y" or "N" is pressed
[X]
Configuration variable YINT
Internal key number for key "Y" (Y/N)
[X]
Subroutine ZEKTRAN (category: Keyboard)
Clear the key logger
[X]
Subroutine ZERO (category: Utility routines)
Reset the local bubble of universe and ship status
[X]
Subroutine ZES1 (category: Utility routines)
Zero-fill the page whose number is in X
[X]
Subroutine ZINF (category: Universe)
Reset the INWK workspace and orientation vectors
[X]
Workspace ZP (category: Workspaces)
Lots of important variables are stored in the zero page workspace as it is quicker and more space-efficient to access memory here
[X]
Subroutine Ze (category: Universe)
Initialise the INWK workspace to a hostile ship
[X]
Subroutine backtonormal (category: Utility routines)
Disable the keyboard, set the SVN flag to 0, and return with A = 0
[X]
Label blacksuspenders in subroutine KILLSHP
[X]
Variable brkd (category: Utility routines)
The brkd counter for error handling
[X]
Label burnthebastards in subroutine Main game loop (Part 5 of 6)
[X]
Label coffeeloop in subroutine stopbd
[X]
Subroutine cpl (category: Universe)
Print the selected system name
[X]
Label dojoystick in subroutine RDKEY
[X]
Subroutine ee3 (category: Flight)
Print the hyperspace countdown in the top-left of the screen
[X]
Subroutine ex (category: Text)
Print a recursive token
[X]
Configuration variable f0
Internal key number for key F1 (Launch, Front)
[X]
Configuration variable f1
Internal key number for key "1" (Buy Cargo)
[X]
Configuration variable f12
Internal key number for key F3 (Rear)
[X]
Configuration variable f2
Internal key number for key "2" (Sell Cargo)
[X]
Configuration variable f22
Internal key number for key F5 (Left)
[X]
Configuration variable f3
Internal key number for key "3" (Equip Ship)
[X]
Configuration variable f32
Internal key number for key F7 (Right)
[X]
Configuration variable f4
Internal key number for key "4" (Long-range Chart)
[X]
Configuration variable f5
Internal key number for key "5" (Short-range Chart)
[X]
Configuration variable f6
Internal key number for key "6" (Data on System)
[X]
Configuration variable f7
Internal key number for key "7" (Market Price)
[X]
Configuration variable f8
Internal key number for key "8" (Status Mode)
[X]
Configuration variable f9
Internal key number for key "9" (Inventory)
[X]
Variable filesys (category: Save and load)
A lookup table containing the device numbers for tape and disk
[X]
Label focoug in subroutine Main game loop (Part 4 of 6)
[X]
Label fothg in subroutine Main game loop (Part 4 of 6)
[X]
Label fothg2 in subroutine Main game loop (Part 4 of 6)
[X]
Subroutine hm (category: Charts)
Select the closest system and redraw the chart crosshairs
[X]
Subroutine hyp (category: Flight)
Start the hyperspace process
[X]
Subroutine jmp (category: Universe)
Set the current system to the selected system
[X]
Configuration variable l1
The 6510 input/output port register, which we can use to configure the Commodore 64 memory layout (see page 260 of the Programmer's Reference Guide)
[X]
Label likeTT112 in subroutine BR1 (Part 2 of 2)
[X]
[X]
Subroutine me1 (category: Flight)
Erase an old in-flight message and display a new one
[X]
Subroutine me2 (category: Flight)
Remove an in-flight message from the space view
[X]
Entry point me3 in subroutine Main game loop (Part 2 of 6) (category: Main loop)
Used by me2 to jump back into the main game loop after printing an in-flight message
[X]
Subroutine mes9 (category: Flight)
Print a text token, possibly followed by " DESTROYED"
[X]
Subroutine msblob (category: Dashboard)
Display the dashboard's missile indicators in green
[X]
Label mt1 in subroutine Main game loop (Part 4 of 6)
[X]
Label mt3 in subroutine Main game loop (Part 4 of 6)
[X]
Label musicstart in variable BDJMPTBH
[X]
Subroutine nWq (category: Stardust)
Create a random cloud of stardust
[X]
Label nobabies in subroutine Main game loop (Part 5 of 6)
[X]
Label nodo in subroutine Main game loop (Part 1 of 6)
[X]
Label nopl in subroutine Main game loop (Part 4 of 6)
[X]
Label nosillytog in subroutine DK4
[X]
Variable oldlong (category: Save and load)
Contains the length of the last saved commander name
[X]
Subroutine ou2 (category: Flight)
Display "E.C.M.SYSTEM DESTROYED" as an in-flight message
[X]
Subroutine ou3 (category: Flight)
Display "FUEL SCOOPS DESTROYED" as an in-flight message
[X]
Subroutine ping (category: Universe)
Set the selected system to the current system
[X]
Subroutine plf (category: Text)
Print a text token followed by a newline
[X]
Label plus13 in subroutine Main game loop (Part 5 of 6)
[X]
[X]
[X]
Label scanmatrix in subroutine RDKEY
[X]
Configuration variable sfxboop
Sound 6 = Long, low beep
[X]
Configuration variable sfxtrib
Sound 14 = Trumbles dying
[X]
Variable spasto (category: Universe)
Contains the address of the Coriolis space station's ship blueprint
[X]
Subroutine startat (category: Sound)
Start playing the title music, if configured
[X]
Subroutine startbd (category: Sound)
Start playing the docking music, if configured
[X]
Subroutine stopbd (category: Sound)
Stop playing the docking music
[X]
Subroutine tapeerror (category: Save and load)
Print either "TAPE ERROR" or "DISK ERROR"
[X]
Variable thislong (category: Save and load)
Contains the length of the most recently entered commander name
[X]
Label thongs in subroutine Main game loop (Part 2 of 6)
[X]
Variable value5 in workspace Music variables
The address before the start of the music data for the tune that is configured to play for docking, so this can be changed to alter the docking music
[X]
Label whips in subroutine Main game loop (Part 2 of 6)
[X]
Label ytq in subroutine Main game loop (Part 2 of 6)