; Memory locations
POKMSK                                  = $10
ICAX1Z                                  = $2a
ROWCRS                                  = $54
COLCRS                                  = $55
SAVMSC                                  = $58
SAVMSC_Hi                               = $59
ZPTR1                                   = $d4
ZPTR1_Hi                                = $d5
ZPTR2                                   = $d6
ZPTR2_Hi                                = $d7
ZPTR3                                   = $d8
ZPTR3_Hi                                = $d9
TablePointer                            = $da
TablePointer_HI                         = $db
ZPTR4                                   = $dc
ZPTR4_Hi                                = $dd
TextPointer                             = $e0
TextPointer_Hi                          = $e1
ScreenPointer                           = $ec
ScreenPointer_Hi                        = $ed
NextRowPointer                          = $ee
NextRowPointer_Hi                       = $ef
COLDST                                  = $0244
COLOR1                                  = $02c5
COLOR2                                  = $02c6
COLOR3                                  = $02c7
COLOR4                                  = $02c8
CRSINH                                  = $02f0
CH                                      = $02fc
ICHID                                   = $0340
ICDNO                                   = $0341
ICCOM                                   = $0342
ICSTA                                   = $0343
ICBAL                                   = $0344
ICBAH                                   = $0345
ICPTL                                   = $0346
ICPTH                                   = $0347
ICBLL                                   = $0348
ICBLH                                   = $0349
ICAX1                                   = $034a
ICAX2                                   = $034b
ICAX3                                   = $034c
ICAX4                                   = $034d
ICAX5                                   = $034e
ICAX6                                   = $034f
DriveSpec1                              = $0470
DriveSpec2                              = $0471
DriveSpec3                              = $0472
Flags                                   = $0499
Flag1_ObjectsCarried                    = $049a
Flag2_TimerDescribe                     = $049b
Flag3_TimerDescribeWhenDark             = $049c
Flag4_TimerDescribeWhenDarkAndNoLight   = $049d
Flag5_Timer1                            = $049e
Flag6_Timer2                            = $049f
Flag7_Timer3                            = $04a0
Flag8_Timer4                            = $04a1
Flag9_TimerWhenDark                     = $04a2
Flag10_TimerWhenDarkAndNoLight          = $04a3
Flag30_Score                            = $04b7
Flag31_Turns                            = $04b8
Flag32_Turns_Hi                         = $04b9
Flag33_W1                               = $04ba
Flag34_W2                               = $04bb
Flag35_CurrentLocation                  = $04bc
Flag36_Unused                           = $04bd
ObjLoc                                  = $04be
CheckSumLSB                             = $05be
CheckSumMSB                             = $05bf
DoneFlag                                = $05d0
AnyActionInvoked                        = $05d1
ProcessingEvents                        = $05d2
ResetIndicator                          = $05d3
SPSave                                  = $05d4
DebugFlag                               = $05d5
RNG1                                    = $05d9
RNG2                                    = $05da
DigitPrinted                            = $05db
RND                                     = $05dd
NewlineRequired                         = $05de
ParserWorkspace                         = $05e1
IndirectResetVector                     = $05e8
IndirectResetVector_Hi                  = $05e9
DisplayControlFlag_Perhaps              = $05ec
CurrentRow                              = $05ed
RowCount                                = $05ee
SaveCOLCRS                              = $05f2
SaveROWCRS                              = $05f3
InverseVideoMask                        = $05fc
SaveYInput                              = $05fd
SaveXPrint                              = $05fe
SaveYPrint                              = $05ff
RowsToScroll_Unclear                    = $0600
ScrollRowCount                          = $0601
IOCBNumberx16                           = $0602
KEYBDV_Copy_GetByte                     = $0603
KEYBDV_Copy_GetByte_Hi                  = $0604
PRINTV_Copy_PutByte                     = $0605
PRINTV_Copy_PutByte_Hi                  = $0606
Header_StartOfDatabase                  = $1d00
Header_COLOR1                           = $1d01
Header_COLOR2                           = $1d02
Header_COLOR4                           = $1d03
Header_MaxCarry                         = $1d04
Header_ObjectCount                      = $1d05
Header_LocationCount                    = $1d06
Header_MessageCount                     = $1d07
Header_SystemMessageCount               = $1d08
Header_EventTableStart                  = $1d09
Header_EventTableStart_Hi               = $1d0a
Header_StatusTableStart                 = $1d0b
Header_StatusTableStart_Hi              = $1d0c
Header_ObjectTableStart                 = $1d0d
Header_ObjectTableStart_Hi              = $1d0e
Header_LocationTableStart               = $1d0f
Header_LocationTableStart_Hi            = $1d10
Header_MessageTableStart                = $1d11
Header_MessageTableStart_Hi             = $1d12
Header_SystemMessageTableStart          = $1d13
Header_SystemMessageTableStart_Hi       = $1d14
Header_MovementTableStart               = $1d15
Header_MovementTableStart_Hi            = $1d16
Header_VocabularyTableStart             = $1d17
Header_VocabularyTableStart_Hi          = $1d18
Header_ObjectLocationTableStart         = $1d19
Header_ObjectLocationTableStart_Hi      = $1d1a
Header_EndOfDatabase                    = $1d1b
AUDF1                                   = $d200
AUDC1                                   = $d201
RANDOM                                  = $d20a
IRQEN                                   = $d20e
SKCTL                                   = $d20f
KEYBDV_GetByte                          = $e424
KEYBDV_GetByte_Hi                       = $e425
PRINTV_PutByte                          = $e436
PRINTV_PutByte_Hi                       = $e437
CIOV                                    = $e456
PowerUpResetVector                      = $fffc

;    * = $7c0d

; Get character via OS using indirect call
GetChar:
pydis_start:
    jmp (KEYBDV_Copy_GetByte)

; Put character via OS using indirect call
PutChar:
    jmp (PRINTV_Copy_PutByte)

Start:
    jsr InitialiseSystem
; Store a copy of the 6502 stack pointer not sure why.
    tsx
    stx SPSave
    lda #0
    sta DebugFlag
    jsr MoveCursorToLastRow
    jsr RestoreCursorAndSetMode3
; Set address of indirect reset vector.
    lda #$28 ; '('
    sta IndirectResetVector
    lda #$89
    sta IndirectResetVector_Hi
    lda #1
    sta ResetIndicator
    jmp CheckResetRequired

RestoreEnvironment:
    stx ZPTR3
    ldx SPSave
    txs
    ldx ZPTR3
    jsr PrintSystemError
CheckResetRequired:
    ldy ResetIndicator
    bne SkipReset
; Call the reset vector indirectly. Looks odd because we using two levels of
; indirection here.
    jmp (IndirectResetVector)

; Store random number from POKEY for use in RNG calculation elsewhere.
SkipReset:
    lda RANDOM
    sta RND
; Clear all audio freqency and control registers, silencing POKEY
    lda #0
    ldx #8
SilenceLoop:
    sta AUDF1,x
    dex
    bpl SilenceLoop
    lda #3
    sta SKCTL
    jsr InitialiseColours
; Clear all flags (36)
    ldy #$24 ; '$'
    lda #0
ClearFlagLoop:
    sta Flags,y
    dey
    bpl ClearFlagLoop
; Initialise object start locations
    lda Header_ObjectLocationTableStart
    sta ZPTR1
    lda Header_ObjectLocationTableStart_Hi
    sta ZPTR1_Hi
    lda #$be
    sta ZPTR3
    lda #4
    sta ZPTR3_Hi
    ldy #0
ObjStartLocLoop:
    lda (ZPTR1),y
    sta (ZPTR3),y
    iny
    cmp #$fe
; If not CARRIED or WORN, continue with next object.
    bcc ObjStartLocLoop
; If not CARRIED, jump to the start of main loop? Otherwise increment the objects
; carried count. This looks like a bug because the loop will terminate when a WORN or
; NOTCREATED object is detected. Also there's no test on the object count, so ending
; the loop depends on data in the database.
    bne MainGameLoop
    inc Flag1_ObjectsCarried
    jmp ObjStartLocLoop

; Start by decrementing timers
MainGameLoop:
    lda Flag2_TimerDescribe
    beq SkipFlag2Decrement
    dec Flag2_TimerDescribe
; Is location light?
SkipFlag2Decrement:
    lda Flags
    beq LocationIsLight
    lda Flag3_TimerDescribeWhenDark
    beq SkipFlag3Decrement
    dec Flag3_TimerDescribeWhenDark
; Is light source here?
SkipFlag3Decrement:
    lda ObjLoc
; Location is light if the light source is here.
    cmp Flag35_CurrentLocation
    beq LocationIsLight
; Location is light if the light source is WORN or CARRIED.
    cmp #$fd
    bcs LocationIsLight
; Print "Everything is dark..." system message
    lda #0
    jsr SystemMessage_2
    lda Flag4_TimerDescribeWhenDarkAndNoLight
    beq StartStatusProcessing
    dec Flag4_TimerDescribeWhenDarkAndNoLight
    jmp StartStatusProcessing

; We have light, so print the location description
LocationIsLight:
    lda Flag35_CurrentLocation
; Interpreter doesn't use split tables, so it needs mode code to get the address of the
; location description. It's saving the C flag from the ASL A so that we can add it
; back in to the MSB as we need 9 bits to store LocationNumber*2.
    asl
    php
    clc
    adc Header_LocationTableStart
    sta TablePointer
    lda Header_LocationTableStart_Hi
    adc #0
    plp
    adc #0
    sta TablePointer_HI
; TablePointer now points to the address table entry for the current location. Copy
; this address into ZPTR5.
    ldy #0
    lda (TablePointer),y
    sta TextPointer
    iny
    lda (TablePointer),y
    sta TextPointer_Hi
    jsr PrintTextAtZPTR5_1
; List objects here. ZPTR2 is repurposed here as a loop counter for object number.
    ldy #0
    sty ZPTR2
    sty DoneFlag
PrintObjectLoop:
    lda ObjLoc,y
; Table is terminated with $FF
    cmp #$ff
    beq StartStatusProcessing
; Check object is here.
    cmp Flag35_CurrentLocation
    bne AdvanceToNextObject
; Set indicator to 1 if currently 0 and print "You can also see..."
    ldx DoneFlag
    bne PrintObject
    lda #1
    sta DoneFlag
    jsr SystemMessage_1
PrintObject:
    lda ZPTR2
; Get address of object (number in ZPTR2) text into ZPTR5 and print it.
    asl
    php
    clc
    adc Header_ObjectTableStart
    sta TablePointer
    lda Header_ObjectTableStart_Hi
    adc #0
    plp
    adc #0
    sta TablePointer_HI
    ldy #0
    lda (TablePointer),y
    sta TextPointer
    iny
    lda (TablePointer),y
    sta TextPointer_Hi
    jsr PrintTextAtZPTR5_2
AdvanceToNextObject:
    inc ZPTR2
    ldy ZPTR2
    jmp PrintObjectLoop

; ZPTR1 = address of status table.
StartStatusProcessing:
    lda Header_StatusTableStart
    sta ZPTR1
    lda Header_StatusTableStart_Hi
    sta ZPTR1_Hi
; Indicate this is the start of something?
    lda #0
    sta ProcessingEvents
    jmp ProcessEvents1

DecrementFlag5:
    lda Flag5_Timer1
    beq DecrementFlag6
    dec Flag5_Timer1
DecrementFlag6:
    lda Flag6_Timer2
    beq DecrementFlag7
    dec Flag6_Timer2
DecrementFlag7:
    lda Flag7_Timer3
    beq DecrementFlag8
    dec Flag7_Timer3
DecrementFlag8:
    lda Flag8_Timer4
    beq DecrementFlag9
    dec Flag8_Timer4
DecrementFlag9:
    lda Flags
    beq IncrementTurns
    lda Flag9_TimerWhenDark
    beq DecrementFlag10
    dec Flag9_TimerWhenDark
DecrementFlag10:
    lda Flag10_TimerWhenDarkAndNoLight
    beq IncrementTurns
    lda ObjLoc
    cmp Flag35_CurrentLocation
    beq IncrementTurns
    cmp #$fd
    bcs IncrementTurns
    dec Flag10_TimerWhenDarkAndNoLight
IncrementTurns:
    inc Flag31_Turns
    bne ChoosePrompt
    inc Flag32_Turns_Hi
; Select prompt (system message 2-5) with probability 30%, 30%, 30%, 10%
ChoosePrompt:
    jsr GetRandomNumber
    ldy #2
    cmp #$1e
    bcc PrintPrompt
    iny
    cmp #$3c ; '<'
    bcc PrintPrompt
    iny
    cmp #$5a ; 'Z'
    bcc PrintPrompt
    iny
PrintPrompt:
    tya
    jsr SystemMessage_1
    jsr GetInputString
FindWord1Loop:
    jsr Parse1
; If word 1 didn't match, set it to FF then store it.
    cmp #0
    bne StoreW1
    lda #$ff
StoreW1:
    sta Flag33_W1
    cmp #$ff
    bne GetWord2
SkipSpaces1:
    ldx #0
    lda (ZPTR1,x)
    jsr IncZPTR1
    cmp #$20 ; ' '
    beq FindWord1Loop
; At end of line, print system message 6, (I don't understand).
    cmp #$9b
    bne SkipSpaces1
    lda #6
    jsr SystemMessage_1
    jmp StartStatusProcessing

GetWord2:
    lda #$ff
    sta Flag34_W2
SkipSpaces2:
    ldx #0
    lda (ZPTR1,x)
    jsr IncZPTR1
    cmp #$9b
    beq ProcessMovements
    cmp #$20 ; ' '
    bne SkipSpaces2
FindWord2Loop:
    jsr Parse1
    cmp #0
    bne StoreW2
    lda #$ff
StoreW2:
    sta Flag34_W2
    cmp #$ff
    bne ProcessMovements
SkipSpaces3:
    ldx #0
    lda (ZPTR1,x)
    jsr IncZPTR1
    cmp #$20 ; ' '
    beq FindWord2Loop
    cmp #$9b
    bne SkipSpaces3
; Same arithmetic as before to get the address of the movement table for this location
; into ZPTR1
ProcessMovements:
    lda Flag35_CurrentLocation
    asl
    php
    clc
    adc Header_MovementTableStart
    sta TablePointer
    lda Header_MovementTableStart_Hi
    adc #0
    plp
    adc #0
    sta TablePointer_HI
    ldy #0
    lda (TablePointer),y
    sta ZPTR1
    iny
    lda (TablePointer),y
    sta ZPTR1_Hi
MovementLoop:
    ldx #0
    lda (ZPTR1,x)
; End of table for this location, move to processing events
    cmp #$ff
    beq ProcessEvents
; Movement word matches W1, so change location and describe it.
    cmp Flag33_W1
    bne TryNextMovement
    jsr IncZPTR1
    lda (ZPTR1,x)
    sta Flag35_CurrentLocation
    jmp AOP_DESC

TryNextMovement:
    jsr IncZPTR1
    jsr IncZPTR1
    jmp MovementLoop

ProcessEvents:
    lda Header_EventTableStart
    sta ZPTR1
    lda Header_EventTableStart_Hi
    sta ZPTR1_Hi
    lda #1
    sta ProcessingEvents
    ldx #0
    stx AnyActionInvoked
ProcessEvents1:
    ldx #0
; If W1 = 0, that's the end of the table.
    lda (ZPTR1,x)
    bne NextEventOrStatus
; At the end of the table, if we're processing statuses, jump to updating flags,
; because that happens next.
    lda ProcessingEvents
    bne ProcessEvents2
    jmp DecrementFlag5

; If an event succeeded, loop back, otherwise print one of two error messages.
ProcessEvents2:
    lda AnyActionInvoked
    beq ProcessEvents3
    jmp StartStatusProcessing

ProcessEvents3:
    ldy #7
    lda Flag33_W1
    cmp #$0d
    bcc PrintGenericError
    iny
PrintGenericError:
    tya
    jsr SystemMessage_1
    jmp StartStatusProcessing

NextEventOrStatus:
    jsr IncZPTR1
    ldy ProcessingEvents
    beq GetAddressOfCondact
    cmp #$ff
    beq GetAddressOfCondact
    cmp Flag33_W1
    bne SkipOverUnmatchedEvent
    lda (ZPTR1,x)
    cmp #$ff
    beq GetAddressOfCondact
    cmp Flag34_W2
    beq GetAddressOfCondact
SkipOverUnmatchedEvent:
    lda ZPTR1
    clc
    adc #3
    sta ZPTR1
    lda ZPTR1_Hi
    adc #0
    sta ZPTR1_Hi
    jmp ProcessEvents1

GetAddressOfCondact:
    jsr IncZPTR1
    lda (ZPTR1,x)
    sta ZPTR2
    jsr IncZPTR1
    lda (ZPTR1,x)
    sta ZPTR2_Hi
    jsr IncZPTR1
GetNextConditionOpcode:
    ldx #0
    lda (ZPTR2,x)
; End of condition block, jump to action instruction processing.
    cmp #$ff
    bne InvokeCOP
    jmp ProcessAOPcodes

InvokeCOP:
    asl
; Push address of opcode A onto stack
    tay
    lda COPDispatch_MSB,y
    pha
    lda COPDispatch_LSB,y
    pha
; Advance to next byte and stash it in Y for later.
    jsr IncZPTR2
    lda (ZPTR2,x)
    tay
; On the off chance this refers to an object calculate the address of the object
; location in ZPTR3.
    clc
    adc #$be
    sta ZPTR3
    lda #4
    adc #0
    sta ZPTR3_Hi
; On the off change this refers to a flag, calculate the address of the flag and store
; it in TablePointer.
    tya
    clc
    adc #$99
    sta TablePointer
    lda #4
    adc #0
    sta TablePointer_HI
; Restore byte into A so it can be presented to the opcodes, then RTS to indirectly
; call the opcode.
    tya
    rts

; AT where A = location number
COP_AT:
    cmp Flag35_CurrentLocation
    beq ConditionInstructionTRUE
    jmp ConditionInstructionFALSE

; NOTAT where A = location number
COP_NOTAT:
    cmp Flag35_CurrentLocation
    bne ConditionInstructionTRUE
    jmp ConditionInstructionFALSE

; ATGT where A = location number
COP_ATGT:
    cmp Flag35_CurrentLocation
    bcc ConditionInstructionTRUE
    jmp ConditionInstructionFALSE

; ATLT where A = location number
COP_ATLT:
    cmp Flag35_CurrentLocation
    bcc ConditionInstructionFALSE
    beq ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; PRESENT where A = object number and ZPTR3 = address
COP_PRESENT:
    lda (ZPTR3,x)
    cmp Flag35_CurrentLocation
    beq ConditionInstructionTRUE
    cmp #$fd
    bcs ConditionInstructionTRUE
    jmp ConditionInstructionFALSE

; ABSENT where A = object number and ZPTR3 = address
COP_ABSENT:
    lda (ZPTR3,x)
    cmp Flag35_CurrentLocation
    beq ConditionInstructionFALSE
    cmp #$fd
    bcs ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; WORN where A = object number and ZPTR3 = address
COP_WORN:
    lda (ZPTR3,x)
    cmp #$fd
    beq ConditionInstructionTRUE
    jmp ConditionInstructionFALSE

; NOTWORN where A = object number and ZPTR3 = address
COP_NOTWORN:
    lda (ZPTR3,x)
    cmp #$fd
    beq ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; CARRIED where A = object number and ZPTR3 = address
COP_CARRIED:
    lda (ZPTR3,x)
    cmp #$fe
    bne ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; NOTCARR where A = object number and ZPTR3 = address
COP_NOTCARR:
    lda (ZPTR3,x)
    cmp #$fe
    beq ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; CHANCE where A = probability of success. Stash A in ZPTR4 as GetRandomNumber will
; overwrite it.
COP_CHANCE:
    sta ZPTR4
    jsr GetRandomNumber
    cmp ZPTR4
    bcc ConditionInstructionTRUE
; If the condition opcode was FALSE, continue processing at next CONDACT.
ConditionInstructionFALSE:
    jmp ProcessEvents1

; ZERO where A = flag number and TablePointer = address
COP_ZERO:
    lda (TablePointer,x)
    bne ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; NOTZERO where A = flag number and TablePointer = address
COP_NOTZERO:
    lda (TablePointer,x)
    beq ConditionInstructionFALSE
; If the condition opcode was TRUE, continue processing this CONDACT.
ConditionInstructionTRUE:
    jsr IncZPTR2
    jmp GetNextConditionOpcode

; EQ, increment ZPTR2 to get the constant to compare flag with
COP_EQ:
    jsr IncZPTR2
    lda (ZPTR2,x)
    cmp (TablePointer,x)
    bne ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

; GT, increment ZPTR2 to get the constant to compare flag with
COP_GT:
    jsr IncZPTR2
    lda (ZPTR2,x)
    cmp (TablePointer,x)
    bcc ConditionInstructionTRUE
    jmp ConditionInstructionFALSE

; LT, increment ZPTR2 to get the constant to compare flag with
COP_LT:
    jsr IncZPTR2
    lda (ZPTR2,x)
    cmp (TablePointer,x)
    bcc ConditionInstructionFALSE
    beq ConditionInstructionFALSE
    jmp ConditionInstructionTRUE

ProcessAOPcodes:
    jsr IncZPTR2
GetNextActionOpcode:
    ldx #0
    lda (ZPTR2,x)
; End of action block, continue processing at next CONDACT.
    cmp #$ff
    bne InvokeAOP
    jmp ProcessEvents1

; If we get here, then an event must have succeeded.
InvokeAOP:
    ldy #1
    sty AnyActionInvoked
; Logic is repeated here from InvokeCOP
    asl
    tay
    lda AOPDispatch_MSB,y
    pha
    lda AOPDispatch_LSB,y
    pha
    jsr IncZPTR2
    lda (ZPTR2,x)
    tay
    clc
    adc #$be
    sta ZPTR3
    lda #4
    adc #0
    sta ZPTR3_Hi
    tya
    clc
    adc #$99
    sta TablePointer
    lda #4
    adc #0
    sta TablePointer_HI
    tya
    rts

; Print inventory
; Start by printing system message 9, "You are carrying..."
AOP_INVEN:
    lda #9
    jsr SystemMessage_1
    stx DoneFlag
; ZPTR3 = ObjLoc
    lda #$be
    sta ZPTR3
    lda #4
; ZPTR1 = Object table
    sta ZPTR3_Hi
    lda Header_ObjectTableStart
    sta ZPTR1
    lda Header_ObjectTableStart_Hi
    sta ZPTR1_Hi
InventoryLoop:
    lda (ZPTR3,x)
; Seems like table is terminated with an FF
    cmp #$ff
    bne InventoryPrintObject
    jmp InventoryEnd

; If the object isn't WORN or CARRIED, skip to next one
InventoryPrintObject:
    cmp #$fd
    bcc InventoryNextObject
; Get the address if the object into ZPTR5, then print it. Note we preserve the
; processor status for the WORN check.
    php
    ldy #0
    lda (ZPTR1),y
    sta TextPointer
    iny
    lda (ZPTR1),y
    sta TextPointer_Hi
    sty DoneFlag
    jsr PrintTextAtZPTR5_3
; If the object isn't being WORN, skip next bit.
    plp
    bne InventoryNewLine2
; Set TablePointer = Address of system message table.
    lda Header_SystemMessageTableStart
    sta TablePointer
    lda Header_SystemMessageTableStart_Hi
    sta TablePointer_HI
; ZPTR5 = address of the "(worn)" message.
    ldy #$14
    lda (TablePointer),y
    sta TextPointer
    iny
    lda (TablePointer),y
    sta TextPointer_Hi
; ZPTR4 = address of the "nothing" message.
    iny
    lda (TablePointer),y
    sta ZPTR4
    iny
    lda (TablePointer),y
    sta ZPTR4_Hi
; ZPTR2 = ZPTR4 - ZPTR5 + 1 to get length of "(worn)" message, I think.
    lda ZPTR4
    clc
    sbc TextPointer
    sta ZPTR2
    lda ZPTR4_Hi
    sbc TextPointer_Hi
    sta ZPTR2_Hi
; If the length is over 255, give up and print a newline. Not sure this would ever
; happen in real life.
    bne InventoryNewLine1
    lda ZPTR2
; If the length is >= 40, give up and print a newline.
    cmp #$28 ; '('
    bcs InventoryNewLine1
; Calculate 40 - COLCRS, and of there's enough space on the line, print WORN
    lda #$28 ; '('
    sec
    sbc COLCRS
    cmp ZPTR2
    bcs InventoryPrintWorn
; Calculate 40 - length, store this, then print spaces until this value reaches COLCRS.
; Really don't understand what this is trying to do. Then finally print WORN message.
    lda #$28 ; '('
    sec
    sbc ZPTR2
    sta ZPTR2_Hi
InventorySpaceLoop:
    lda #$20 ; ' '
    jsr PrintOneCharacter
    lda ZPTR2_Hi
    cmp COLCRS
    bne InventorySpaceLoop
    jmp InventoryPrintWorn

InventoryNewLine1:
    lda #$9b
    jsr PrintOneCharacter
InventoryPrintWorn:
    jsr PrintTextAtZPTR5_3
InventoryNewLine2:
    lda #$9b
    jsr PrintOneCharacter
InventoryNextObject:
    jsr IncZPTR3
    jsr IncZPTR1
    jsr IncZPTR1
    jmp InventoryLoop

InventoryEnd:
    lda DoneFlag
    bne CheckSetDone
    lda #$0b
    jmp SystemMessageAndSetDone

; Describe current location. This just jumps to the start of the main game loop.
AOP_DESC:
    jmp MainGameLoop

; Quit
; Start by printing the "Do you want to quit?" system message.
AOP_QUIT:
    lda #$0c
    jsr SystemMessage_1
; Save ZPTR1
    lda ZPTR1_Hi
    pha
    lda ZPTR1
    pha
; Flush single character input buffer
    lda #$ff
    sta CH
; Get input from user and get first character into Y register
    jsr GetInputString
; ZPTR3 = address of system message table.
    ldy #0
    lda (ZPTR1),y
    tay
; Restore ZPTR1
    pla
    sta ZPTR1
    pla
    sta ZPTR1_Hi
    lda Header_SystemMessageTableStart
    sta ZPTR3
    lda Header_SystemMessageTableStart_Hi
    sta ZPTR3_Hi
; Save input character on stack
    tya
    pha
; ZPTR3 = address of system message 30, which defines the "Y" response.
    ldy #$3c ; '<'
    lda (ZPTR3),y
    tax
    iny
    lda (ZPTR3),y
    stx ZPTR3
    sta ZPTR3_Hi
; Does the input response start with "Y"?
    ldy #0
    pla
    eor #$ff
    cmp (ZPTR3),y
; If NOT set done, else proceed to the next opcode, which by convention should always
; be AOP_END
CheckSetDone:
    bne AOP_DONE
    jmp ProceedToNextOpcode

; End the game.
; Silence all the sound registers.
AOP_END:
    lda #0
    ldx #7
EndSilenceLoop:
    sta AUDF1,x
    dex
    bpl EndSilenceLoop
; Print end of game prompt.
    lda #$0d
    jsr SystemMessage_1
    lda #$ff
; Flush single character input buffer
    sta CH
; Get input from user
    jsr GetInputString
; ZPTR3 = address of system message table.
    ldy Header_SystemMessageTableStart
    sty ZPTR3
    ldy Header_SystemMessageTableStart_Hi
    sty ZPTR3_Hi
; ZPTR3 = address of system message 31, which defines the "N" response.
    ldy #$3e ; '>'
    lda (ZPTR3),y
    tax
    iny
    lda (ZPTR3),y
    stx ZPTR3
    sta ZPTR3_Hi
    ldy #0
; Does the input response start with "N"?
    lda (ZPTR3),y
    eor #$ff
    cmp (ZPTR1),y
; If TRUE, start the process to reset the computer.
    beq WantReset
    jmp SkipReset

; Print the "goodbye" message.
WantReset:
    lda #$0e
    jsr SystemMessage_1
; Set indicator that we DO want a system reset.
    ldx #0
    stx ResetIndicator
    jmp RestoreEnvironment

; Indicate DONE status
; Set ZPTR1 = $05D0, which is DoneFlag. Significance of this is unclear.
AOP_DONE:
    lda #$d0
    sta ZPTR1
    lda #5
    sta ZPTR1_Hi
; Set DoneFlag = 0, then start processing again.
    lda #0
    sta DoneFlag
    jmp ProcessEvents1

; Print OK message
AOP_OK:
    lda #$0f
    jmp SystemMessageAndSetDone

; Wait for a keypress.
; MORE WORK NEEDED HERE...
AOP_ANYKEY:
    jsr MoveCursorToLastRow
    lda #$10
    jsr SystemMessageNormalVideo
; Flush single character input buffer
    lda #$ff
    sta CH
; Get a single character, clearing ICAX1Z precautionary?
    lda #0
    sta ICAX1Z
    jsr GetChar
    jsr ClearLastRow
    jsr RestoreCursorAndSetMode3
    lda ROWCRS
    sta CurrentRow
    beq AnyKeySkipDecrementRow
    dec CurrentRow
AnyKeySkipDecrementRow:
    jmp ProceedToNextOpcode

; Save data to disk file, with checksum
AOP_SAVE:
    jsr CalculateChecksum
    jsr InputFileName
    jsr FindFreeIOCB
    bcs PrintIOErrorMessage
    lda #8
    jsr OpenChannel
    bcs CloseChannelOnError
    lda #$0b
    jsr GetPutBinaryData
    bcs CloseChannelOnError
    jsr CloseChannel
    bcs PrintIOErrorMessage
    jmp MainGameLoop

; Load data from disk file
AOP_LOAD:
    jsr InputFileName
    jsr FindFreeIOCB
    bcs PrintIOErrorMessage
    lda #4
    jsr OpenChannel
    bcs CloseChannelOnError
    lda #7
    jsr GetPutBinaryData
    bcs CloseChannelOnError
    jsr CloseChannel
    bcs PrintIOErrorMessage
; Copy checksum loaded from file into ZPTR4
    lda CheckSumLSB
    sta ZPTR4
    lda CheckSumMSB
    sta ZPTR4_Hi
; Calculate checksum
    jsr CalculateChecksum
; If checksum != ZPTR4, print IO error message
    lda CheckSumLSB
    cmp ZPTR4
    bne PrintIOErrorMessage
    lda CheckSumMSB
    cmp ZPTR4_Hi
    bne PrintIOErrorMessage
    jmp MainGameLoop

CloseChannelOnError:
    jsr CloseChannel
; Which I think is SystemError2
PrintIOErrorMessage:
    ldx #1
    jsr PrintSystemError
    jmp MainGameLoop

; Print number of turns.
; Print system message 17
AOP_TURNS:
    lda #$11
    jsr SystemMessageNormalVideo
; ZPTR3 = Score
; ZPTR3 = Turns
    lda Flag31_Turns
    sta ZPTR3
    lda Flag32_Turns_Hi
    sta ZPTR3_Hi
    jsr PrintNumberInZPTR3
; Print "turn" system message 18
    lda #$12
    jsr SystemMessageNormalVideo
    lda Flag32_Turns_Hi
    bne TurnsPlural
    lda Flag31_Turns
    cmp #1
    beq TurnsSinglular
; Print "s".
TurnsPlural:
    lda #$13
    jsr SystemMessageNormalVideo
; Print ".".
TurnsSinglular:
    lda #$14
TurnsAndScoreEndCode:
    jsr SystemMessage_1
    jmp ProceedToNextOpcode

; Print score (shares some code with AOP_TURNS)
; Print system message 21
AOP_SCORE:
    lda #$15
    jsr SystemMessageNormalVideo
    lda Flag30_Score
    sta ZPTR3
    lda #0
    sta ZPTR3_Hi
    jsr PrintNumberInZPTR3
; Print system message 22
    lda #$16
    jmp TurnsAndScoreEndCode

AOP_CLS:
    jsr ClearScreen
CLS_NextOpcode:
    jmp ProceedToNextOpcode

; Drop all carried objects
; Set flag to zero (X==0 on entry)
AOP_DROPALL:
    stx Flag1_ObjectsCarried
DropAllLoop:
    lda ObjLoc,x
; If we hit an object with location $FF, that means end of list.
    cmp #$ff
    beq CLS_NextOpcode
; If location < WORN, skip it as we only want to move WORN or CARRIED to current
; location
    cmp #$fd
    bcc PerformDrop
    lda Flag35_CurrentLocation
    sta ObjLoc,x
PerformDrop:
    inx
    jmp DropAllLoop

; Pause for A * 1/50th seconds. This is using 3 nested loops.
AOP_PAUSE:
    cmp #0
    bne SkipZeroPause
; Jumps into another opcode for code size reasons
    jmp AdvanceToNextInstruction

; Outer loop of 11 interations using Y register. So presumably this gives 1/50th of a
; second, approximately.
SkipZeroPause:
    ldy #$0b
; Empty loop of 256 iterations (X==0 on entry)
PauseLoop:
    dex
    beq PauseExitInnerLoop
    jmp PauseLoop

PauseExitInnerLoop:
    dey
    bne PauseLoop
    sec
    sbc #1
    jmp AOP_PAUSE

; Set screen colour to A
AOP_SCREEN:
    sta COLOR2
    jmp AdvanceToNextInstruction

; Set screen text luminosity to A*2
AOP_TEXT:
    asl
    sta COLOR1
    jmp AdvanceToNextInstruction

; Set border colour to A
AOP_BORDER:
    sta COLOR4
    jmp AdvanceToNextInstruction

; Change player's location to A
AOP_GOTO:
    sta Flag35_CurrentLocation
    jmp AdvanceToNextInstruction

; Print message A
; Get address of message A into ZPTR5
AOP_MESSAGE:
    asl
    php
    clc
    adc Header_MessageTableStart
    sta TablePointer
    lda Header_MessageTableStart_Hi
    adc #0
    plp
    adc #0
    sta TablePointer_HI
    ldy #0
    lda (TablePointer),y
    sta TextPointer
    iny
    lda (TablePointer),y
    sta TextPointer_Hi
    jsr PrintTextAtZPTR5_2
    jmp AdvanceToNextInstruction

; Remove a WORN object, moving it to carried
; On entry ZPTR3 points to the object's location
AOP_REMOVE:
    lda (ZPTR3,x)
    tay
; Prepare to print "not wearing..." system message
    lda #$17
; If not WORN, print system message and exit.
    cpy #$fd
    bne SystemMessageAndSetDone
; Otherwise prepare to print "...hands full" system message and jump into the middle of
; AOP_GET
    lda #$18
    jmp GetCheckMaxCarry

; Get object A
AOP_GET:
    lda (ZPTR3,x)
    tay
; Prepare to print "already carried" system message
    lda #$19
; If WORN or CARRIED, print system message and exit.
    cpy #$fd
    bcs SystemMessageAndSetDone
; Prepare to print "it's not here" system message
    lda #$1a
; If not here, print system message end exit
    cpy Flag35_CurrentLocation
    bne SystemMessageAndSetDone
; Prepare to print "can't carry more" system message
    lda #$1b
; Check if player can carry more objects and if GE, print system message and exit.
GetCheckMaxCarry:
    ldy Flag1_ObjectsCarried
    cpy Header_MaxCarry
    bcs SystemMessageAndSetDone
; Change object location to carried and increment object carried count.
    lda #$fe
    sta (ZPTR3,x)
    inc Flag1_ObjectsCarried
    jmp AdvanceToNextInstruction

SystemMessageAndSetDone:
    jsr SystemMessage_1
    jmp AOP_DONE

; Drop object A
AOP_DROP:
    lda (ZPTR3,x)
    tay
; Is object WORN? If not skip forward to checking for CARRIED.
    cpy #$fd
    bne Drop_CheckIsCarried
; Otherwise, check if object can be moved to location. Note that we skip decrement
; check for WORN objects. If not, print system message and exit.
    lda #$18
    ldy Flag1_ObjectsCarried
    cpy Header_MaxCarry
    bcs SystemMessageAndSetDone
    jmp Drop_ChangeObjectLocation

; Check object is carried and if not, print system message.
Drop_CheckIsCarried:
    lda #$1c
    cpy #$fe
    bne SystemMessageAndSetDone
; Drop object and decrement carried count
    dec Flag1_ObjectsCarried
Drop_ChangeObjectLocation:
    lda Flag35_CurrentLocation
    sta (ZPTR3,x)
    jmp AdvanceToNextInstruction

; Wear object A
AOP_WEAR:
    lda (ZPTR3,x)
    tay
; Print "already wearing" system message and exit if WORN
    lda #$1d
    cpy #$fd
    beq SystemMessageAndSetDone
; Print "don't have it" system message and exit if NOT CARRIED
    lda #$1c
    bcc SystemMessageAndSetDone
; Change object location to WORN and decrement carried count
    lda #$fd
    sta (ZPTR3,x)
    dec Flag1_ObjectsCarried
    jmp AdvanceToNextInstruction

; Destroy object A
AOP_DESTROY:
    lda (ZPTR3,x)
; Save existing location in Y and change location to NOTCREATED
    tay
    lda #$fc
    sta (ZPTR3,x)
; If object was carried, decrement carried count
DecrementCountIfObjectWasCarried:
    cpy #$fe
    bne AdvanceToNextInstruction
    dec Flag1_ObjectsCarried
    jmp AdvanceToNextInstruction

; Move object A to current location
AOP_CREATE:
    lda (ZPTR3,x)
    tay
    lda Flag35_CurrentLocation
    sta (ZPTR3,x)
    jmp DecrementCountIfObjectWasCarried

; Swap object A with the object in the next byte
AOP_SWAP:
    jsr IncZPTR2
; Get second object number into Y
    lda (ZPTR2,x)
    tay
; Get first object number into A and save it
    lda (ZPTR3,x)
    pha
; Copy second location into first
    lda ObjLoc,y
    sta (ZPTR3,x)
; Copy saved first location into second
    pla
    sta ObjLoc,y
    jmp AdvanceToNextInstruction

; Move object A into location in the next byte
AOP_PLACE:
    jsr IncZPTR2
; Get object location into Y
    lda (ZPTR3,x)
    tay
; Set object location to new location
    lda (ZPTR2,x)
    sta (ZPTR3,x)
; Check if object WAS carried.
    jmp DecrementCountIfObjectWasCarried

; Set flag A (to $FF)
AOP_SET:
    lda #$ff
    sta (TablePointer,x)
    jmp AdvanceToNextInstruction

; Clear flag A (set to zero)
AOP_CLEAR:
    txa
    sta (TablePointer,x)
AdvanceToNextInstruction:
    jsr IncZPTR2
ProceedToNextOpcode:
    jmp GetNextActionOpcode

; Add constant to flag, capping it at 255
AOP_PLUS:
    jsr IncZPTR2
; Get constant and add to flag.
    lda (ZPTR2,x)
    clc
    adc (TablePointer,x)
; Check for overflow and set to 255 if true
    bcc PlusMinusStoreResult
    lda #$ff
    sta (TablePointer,x)
    jmp AdvanceToNextInstruction

; Subtract constant from flag, with a collar of zero
AOP_MINUS:
    jsr IncZPTR2
; Get constant and subtract from flag
    lda (TablePointer,x)
    sec
    sbc (ZPTR2,x)
; Check for underflow and set to zero if true
    bcs PlusMinusStoreResult
    txa
PlusMinusStoreResult:
    sta (TablePointer,x)
    jmp AdvanceToNextInstruction

; Set flag A to constant
AOP_LET:
    jsr IncZPTR2
    lda (ZPTR2,x)
    sta (TablePointer,x)
    jmp AdvanceToNextInstruction

; Set sound registers (takes 4 arguments)
; Y = Voice number (n) * 2
AOP_SOUND:
    asl
    tay
; Set PITCH into AUDFn
    jsr IncZPTR2
    lda (ZPTR2,x)
    sta AUDF1,y
; A = DISTORTION * 16
    jsr IncZPTR2
    lda (ZPTR2,x)
    asl
    asl
    asl
    asl
; A |= VOLUME
    jsr IncZPTR2
    ora (ZPTR2,x)
    sta AUDC1,y
; Set A into AUDCn
    jmp AdvanceToNextInstruction

Parse1:
    ldx #0
; DF is SPACE ^ FF, so we're filling ParserWorkspace with 4 SPACES, then resetting Y to
; 0
    lda #$df
    ldy #3
Parse1FillSpaceLoop:
    sta ParserWorkspace,y
    dey
    bpl Parse1FillSpaceLoop
    iny
; Copy up to 4 characters starting at ZPTR1 into ParserWorkspace, ^ FF as we go
Parse1CopyLoop:
    lda (ZPTR1,x)
; Space marks end of word.
    cmp #$20 ; ' '
    beq Parse1EndOfWord
; Return marks end of input and hence word.
    cmp #$9b
    beq Parse1EndOfWord
    eor #$ff
    sta ParserWorkspace,y
    jsr IncZPTR1
    iny
    cpy #4
    bne Parse1CopyLoop
; Set ZPTR2 to start of vocabulary table.
Parse1EndOfWord:
    lda Header_VocabularyTableStart
    sta ZPTR2
    lda Header_VocabularyTableStart_Hi
    sta ZPTR2_Hi
Parse1NextWord:
    lda #0
    sta DoneFlag
    ldy #0
Parse1WordLoop:
    lda (ZPTR2,x)
; Zero (really FF ^ FF) terminates the vocabulary table.
    bne Parse1CompareCharacter
    rts

Parse1CompareCharacter:
    cmp ParserWorkspace,y
    beq Parse1CharacterMatches
; If the character didn't match, set indicator. Don't bail out here, complete the loop.
    lda #1
    sta DoneFlag
Parse1CharacterMatches:
    jsr IncZPTR2
    iny
    cpy #4
    bne Parse1WordLoop
; If the word didn't match, try to parse more text. Otherwise return word number in A.
    lda DoneFlag
    bne Parse1AdvanceToNextWord
    lda (ZPTR2,x)
    rts

Parse1AdvanceToNextWord:
    jsr IncZPTR2
    jmp Parse1NextWord

; Get LOAD/SAVE filename, without extension or drive from player
InputFileName:
    lda #$20 ; ' '
    jsr SystemMessage_1
    jsr GetInputString
    ldy #0
FileNameCopyLoop:
    lda (ZPTR1),y
; Check for RETURN character in input string
    cmp #$9b
    beq FileNameEnd
    iny
; Check for limit of 8 characters (Atari DOS is 8.3)
    cpy #8
    bne FileNameCopyLoop
; Append ".SAV" to filename
FileNameEnd:
    lda #$2e ; '.'
    sta (ZPTR1),y
    iny
    lda #$53 ; 'S'
    sta (ZPTR1),y
    iny
    lda #$41 ; 'A'
    sta (ZPTR1),y
    iny
    lda #$56 ; 'V'
    sta (ZPTR1),y
    iny
; Append RETURN to filename
    lda #$9b
    sta (ZPTR1),y
    rts

; ZPTR1 = $499
CalculateChecksum:
    lda #$99
    sta ZPTR1
    lda #4
    sta ZPTR1_Hi
; ZPTR2 = $FEDB
    lda #$fe
    sta ZPTR2_Hi
    lda #$db
    sta ZPTR2
    lda #0
    tax
    sta CheckSumMSB
ChecksumLoop:
    clc
    adc (ZPTR1,x)
    bcc ChecksumSkipMSB
    inc CheckSumMSB
ChecksumSkipMSB:
    jsr IncZPTR1
; Increment ZPTR2, which is being used as a counter. It will hit zero after $125 (293
; bytes), which is presumably the size of the flags & object locations area.
    jsr IncZPTR2
    bne ChecksumLoop
    sta CheckSumLSB
    rts

; Disable BREAK key.
InitialiseSystem:
    lda POKMSK
    and #$7f
    sta POKMSK
    sta IRQEN
; Enable reboot on RESET.
    lda #$ff
    sta COLDST
; Clear single character input buffer.
    sta CH
; Disable cursor.
    sta CRSINH
; Copy OS vectors and increment to get actual address.
    lda KEYBDV_GetByte
    sta KEYBDV_Copy_GetByte
    lda KEYBDV_GetByte_Hi
    sta KEYBDV_Copy_GetByte_Hi
    lda PRINTV_PutByte
    sta PRINTV_Copy_PutByte
    lda PRINTV_PutByte_Hi
    sta PRINTV_Copy_PutByte_Hi
    inc KEYBDV_Copy_GetByte
    bne SkipKEYBDVHigh
    inc KEYBDV_Copy_GetByte_Hi
SkipKEYBDVHigh:
    inc PRINTV_Copy_PutByte
    bne SkipPRINTVHigh
    inc PRINTV_Copy_PutByte_Hi
SkipPRINTVHigh:
    lda #0
    sta InverseVideoMask
    lda #$17
    sta RowCount
    lda #3
    sta DisplayControlFlag_Perhaps
    jsr ClearScreen
; Set up drive specification, "D1:".
    lda #$44 ; 'D'
    sta DriveSpec1
    lda #$31 ; '1'
    sta DriveSpec2
    lda #$3a ; ':'
    sta DriveSpec3
    rts

GetSystemMessageAddress:
    asl
    tay
    lda Header_SystemMessageTableStart
    sta TablePointer
    lda Header_SystemMessageTableStart_Hi
    sta TablePointer_HI
    lda (TablePointer),y
    sta TextPointer
    iny
    lda (TablePointer),y
    sta TextPointer_Hi
    rts

SystemMessage_1:
    jsr GetSystemMessageAddress
    jmp PrintTextAtZPTR5_2

SystemMessageNormalVideo:
    jsr GetSystemMessageAddress
    jmp PrintTextAtZPTR5_3

SystemMessage_2:
    jsr GetSystemMessageAddress
PrintTextAtZPTR5_1:
    jsr ClearScreen
PrintTextAtZPTR5_2:
    lda #$80
    sta NewlineRequired
PrintTextAtZPTR5_3:
    ldx #0
    lda (TextPointer,x)
    eor #$ff
    beq EndOfText
    jsr PrintOneCharacter
    inc TextPointer
    bne PrintTextAtZPTR5_3
    inc TextPointer_Hi
    jmp PrintTextAtZPTR5_3

EndOfText:
    lda NewlineRequired
    beq NewlineNotRequired
    lda #$9b
    jsr PrintOneCharacter
    lda #0
    sta NewlineRequired
NewlineNotRequired:
    rts

GetInputString:
    jsr PrintFlags
    jsr RestoreCursorAndSetMode3
    lda ROWCRS
    sta CurrentRow
    lda #$be
    jsr PrintOneCharacter
    lda #$73 ; 's'
    sta ZPTR1
    lda #4
    sta ZPTR1_Hi
    ldy #0
    sty SaveYInput
GetCharacter:
    jsr GetCharWithCursorFudge
    ldy SaveYInput
; Delete key?
    cmp #$7e ; '~'
    beq HandleDeleteKey
; Return?
    cmp #$9b
    beq HandleReturnKey
; Mask off high/inverse video bit
    and #$7f
; If character < 32, ignore it and try again.
    cmp #$20 ; ' '
    bcc GetCharacter
; If character == 96 (Control+.) ignore it and try again.
    cmp #$60 ; '`'
    beq GetCharacter
; If character == 123 (Control+;) ignore it and try again.
    cmp #$7b ; '{'
    beq GetCharacter
; If character >= 125, ignore it and try again.
    cmp #$7d ; '}'
    bcs GetCharacter
; If character < 96, skip over forcing it to uppercase.
    cmp #$60 ; '`'
    bcc SkipUppercaseConversion
    and #$df
; If Y = 37, ignore the input as we've reached the end of the input buffer.
SkipUppercaseConversion:
    cpy #$25 ; '%'
    beq GetCharacter
; Otherwise store the character, increment Y, print the character then loop back for
; more.
    sta (ZPTR1),y
    iny
    sty SaveYInput
    jsr PrintOneCharacter
    jmp GetCharacter

HandleDeleteKey:
    cpy #0
    beq GetCharacter
    dey
    sty SaveYInput
    lda #$1e
    jsr PrintOneCharacter
    jmp GetCharacter

HandleReturnKey:
    sta (ZPTR1),y
    jsr PrintOneCharacter
    jsr ClearLastRow
    jsr RestoreCursorAndSetMode3
    rts

; Prints inverse space, left arrow, then gets a character before printing space, left
; arrow.
; In wonder if this is some horrible hack to update the cursor position / display
; because we're bypassing CIOV for input.
GetCharWithCursorFudge:
    lda #$a0
    jsr PrintOneCharacter
    lda #$1e
    jsr PrintOneCharacter
    lda #0
    sta ICAX1Z
    jsr GetChar
    pha
    lda #$20 ; ' '
    jsr PrintOneCharacter
    lda #$1e
    jsr PrintOneCharacter
    pla
    rts

GetRandomNumber:
    lda RND
    clc
    adc #1
    sta RNG1
    lda #$65 ; 'e'
    sta RNG2
    lda #0
    sta RND
    ldx #8
RNGLoop:
    lsr RNG1
    bcc RNGSkipAdd
    clc
    adc RNG2
RNGSkipAdd:
    ror
    ror RND
    dex
    bne RNGLoop
    cmp #0
    beq GetRandomNumber
    rts

InitialiseColours:
    lda Header_COLOR4
    sta COLOR4
    lda Header_COLOR2
    sta COLOR2
    lda Header_COLOR1
    sta COLOR1
    rts

IncZPTR1:
    inc ZPTR1
    bne CommonIncRts
    inc ZPTR1_Hi
    rts

IncZPTR2:
    inc ZPTR2
    bne CommonIncRts
    inc ZPTR2_Hi
    rts

IncZPTR3:
    inc ZPTR3
    bne CommonIncRts
    inc ZPTR3_Hi
CommonIncRts:
    rts

PrintNumberInZPTR3:
    lda #0
    sta DigitPrinted
; ZPTR5 = 10000, print digit
    lda #$10
    sta TextPointer
    lda #$27 ; '''
    sta TextPointer_Hi
    jsr PrintDecimalDigit
; ZPTR5 = 1000, print digit
    lda #$e8
    sta TextPointer
    lda #3
    sta TextPointer_Hi
    jsr PrintDecimalDigit
; ZPTR5 = 100, print digit
    lda #$64 ; 'd'
    sta TextPointer
    lda #0
    sta TextPointer_Hi
    jsr PrintDecimalDigit
; ZPTR5 = 10, print digit
    lda #$0a
    sta TextPointer
    jsr PrintDecimalDigit
; Whatever is left is 0-9, so just print that.
    lda ZPTR3
    ora #$30 ; '0'
    jmp PrintOneCharacter

PrintDecimalDigit:
    ldx #$ff
SubtractPower10Loop:
    inx
; ZPTR3 -= ZPTR5
    lda ZPTR3
    sec
    sbc TextPointer
    sta ZPTR3
    lda ZPTR3_Hi
    sbc TextPointer_Hi
    sta ZPTR3_Hi
; Repeat until it goes negative, then ZPTR3 += ZPTR5. This looks odd, but it's pretty
; standard code.
    bcs SubtractPower10Loop
    lda ZPTR3
    clc
    adc TextPointer
    sta ZPTR3
    lda ZPTR3_Hi
    adc TextPointer_Hi
    sta ZPTR3_Hi
; If the digit is NOT zero, print it.
    txa
    bne PrintDigit
; If anything has already been printed, print the digit even if zero.
    ldx DigitPrinted
    bne PrintDigit
    rts

; Set flag to 1 to indicate we've printed something now. This is how we handle leading
; spaces.
PrintDigit:
    ldx #1
    stx DigitPrinted
    ora #$30 ; '0'
    jmp PrintOneCharacter

PrintFlags:
    lda DebugFlag
    beq PrintFlagReturn
    jsr MoveCursorToLastRow
    ldx #0
PrintFlagsLoop:
    stx ZPTR1
    jsr PrintFlag
    ldx ZPTR1
    inx
; If X < 33 just loop back.
    cpx #$21 ; '!'
    bcc PrintFlagsLoop
; If X == 33, set the inverse mask to $80, turning inverse video on
    bne PrintFlagsCheckEnd
    lda #$80
    sta InverseVideoMask
; If X < 35, loop back for next flag
PrintFlagsCheckEnd:
    cpx #$23 ; '#'
    bcc PrintFlagsLoop
; Print the last flag, then turn off inverse video.
    jsr PrintFlag
    lda #0
    sta InverseVideoMask
    rts

; If PrintFlag == 0, do nothing. In the interpreter, it will always be zero.
; Get flag X value into ZPTR3, extending it to a word value.
PrintFlag:
    lda #0
    sta ZPTR3_Hi
    lda Flags,x
    sta ZPTR3
; Flag >= 100, print space + number
    cmp #$64 ; 'd'
    bcs PrintFlagGE100
; Flag >= 10, print 2 spaces + number
    cmp #$0a
    bcs PrintFlagGE10
; Flag < 10, print 3 spaces + number
    lda #$20 ; ' '
    jsr PrintOneCharacter
PrintFlagGE10:
    lda #$20 ; ' '
    jsr PrintOneCharacter
PrintFlagGE100:
    lda #$20 ; ' '
    jsr PrintOneCharacter
    jsr PrintNumberInZPTR3
PrintFlagReturn:
    rts

PrintOneCharacter:
    stx SaveXPrint
    sty SaveYPrint
    ora InverseVideoMask
    pha
    lda DisplayControlFlag_Perhaps
    cmp #2
    bne DisplayModeNE2
    jmp PrintCharacterForceNormalVideo

DisplayModeNE2:
    cmp #1
    bne PrintCharacterWithMoreCheck
    jmp PrintCharacterWithAutomaticScroll

; Called when DisplayMode == 3
PrintCharacterWithMoreCheck:
    pla
    pha
    cmp #$1e
    beq CursorLeft
    cmp #$9b
    beq CursorDown
    jsr ATASCIIToInternalAndPrint
    inc COLCRS
    lda COLCRS
    cmp #$28 ; '('
    bne RestoreAXYAndReturn
; If ROWCRS == RowCount - 1, we might need to scroll
CursorDown:
    ldx ROWCRS
    inx
    cpx RowCount
    beq CheckMoreRequired
; If not, move cursor to start of next row.
    inc ROWCRS
    lda #0
    sta COLCRS
    jmp RestoreAXYAndReturn

CheckMoreRequired:
    dec CurrentRow
    bpl SkipMorePrompt
; Start of [More] handling. Clear last row to make space for the prompt.
    jsr ClearLastRow
; Screen pointer = address of last row on screen (24)
    clc
    lda SAVMSC
    adc #$98
    sta ScreenPointer
    lda SAVMSC_Hi
    adc #3
    sta ScreenPointer_Hi
; Print [More] in inverse video at start of last row. Works backwards.
    ldy #6
MoreLoop:
    lda MoreText,y
    sta (ScreenPointer),y
    dey
    bpl MoreLoop
; Wait for a keypress
    lda #$ff
    sta CH
    lda #0
    sta ICAX1Z
    jsr GetChar
; Clear last row to erase the prompt.
    jsr ClearLastRow
    lda ROWCRS
    sta CurrentRow
SkipMorePrompt:
    lda #0
    sta COLCRS
    sta RowsToScroll_Unclear
    lda RowCount
    sta ScrollRowCount
    jsr Scroll
RestoreAXYAndReturn:
    ldx SaveXPrint
    ldy SaveYPrint
    pla
    rts

; COLCRS--, return if >= 0, else set to 39 and ROWCRS--
CursorLeft:
    dec COLCRS
    bpl RestoreAXYAndReturn
    lda #$27 ; '''
    sta COLCRS
    dec ROWCRS
; ROWCRS--, return if >= 0
    bpl RestoreAXYAndReturn
; COLCRS = ROWCRS = 0 and return
    lda #0
    sta COLCRS
    sta ROWCRS
    beq RestoreAXYAndReturn
; Called when DisplayMode == 2
PrintCharacterForceNormalVideo:
    pla
    pha
; Don't mask off the inverse bit if printing a newline
    cmp #$9b
    beq SkipConvertIfReturn
    and #$7f
SkipConvertIfReturn:
    jsr PutChar
    jmp RestoreAXYAndReturn

; Called when DisplayMode == 1
PrintCharacterWithAutomaticScroll:
    pla
    pha
    cmp #$1e
    beq CursorLeft
    jsr ATASCIIToInternalAndPrint
    inc COLCRS
    lda COLCRS
    cmp #$28 ; '('
    bne RestoreAXYAndReturn
    lda #0
    sta COLCRS
    inc ROWCRS
    lda ROWCRS
    cmp #$18
    bne RestoreAXYAndReturn
    lda RowCount
    sta RowsToScroll_Unclear
    lda #$18
    sta ScrollRowCount
    dec ROWCRS
    jsr Scroll
    jmp RestoreAXYAndReturn

; ScreenPointer = address of RowNumber
Scroll:
    lda RowsToScroll_Unclear
    asl
    tax
    clc
    lda SAVMSC
    adc Add40Table,x
    sta ScreenPointer
    lda SAVMSC_Hi
    adc Add40Table_Hi,x
    sta ScreenPointer_Hi
; NextRowpointer = address of RowNumber+1
    lda ScreenPointer
    adc #$28 ; '('
    sta NextRowPointer
    lda ScreenPointer_Hi
    adc #0
    sta NextRowPointer_Hi
; X = RowCount2 - RowNumber - 1, I think CC here
    lda ScrollRowCount
    sbc RowsToScroll_Unclear
    tax
ScrollLoop:
    ldy #$27 ; '''
ScrollCopyRowLoop:
    lda (NextRowPointer),y
    sta (ScreenPointer),y
    dey
    bpl ScrollCopyRowLoop
; ScreenPointer += 40
    clc
    lda ScreenPointer
    adc #$28 ; '('
    sta ScreenPointer
    lda ScreenPointer_Hi
    adc #0
    sta ScreenPointer_Hi
; NextRowPointer += 40
    lda NextRowPointer
    adc #$28 ; '('
    sta NextRowPointer
    lda NextRowPointer_Hi
    adc #0
    sta NextRowPointer_Hi
    dex
    bne ScrollLoop
; Clear (last?) row
    lda #0
    ldy #$27 ; '''
ScrollClearRowLoop:
    sta (ScreenPointer),y
    dey
    bpl ScrollClearRowLoop
    rts

; On entry A = character to print. This routine is a convoluted way of doing things, I
; think.
ATASCIIToInternalAndPrint:
    pha
; ScreenPointer = address of row ROWCRS
    lda ROWCRS
    asl
    tax
    clc
    lda SAVMSC
    adc Add40Table,x
    sta ScreenPointer
    lda SAVMSC_Hi
    adc Add40Table_Hi,x
    sta ScreenPointer_Hi
; Y = COLCRS
    ldy COLCRS
; A = char * 2, then PHP to save inverse video bit in C flag
    pla
    asl
    php
; If a >= 192 (effectively char >= 96), skip to the print routine as internal ==
; ATASCII code)
    cmp #$c0
    bcs EmitInternal
; If a >= 64, (effectively char >= 32), skip to subtracting 64 (again, effectively 32)
    cmp #$40 ; '@'
    bcs Subtract64
; Otherwise, effectively add 192 and fall thorough to subtracting 64, this adding 128
; (again, effectively 64)
    ora #$c0
Subtract64:
    sec
    sbc #$40 ; '@'
; Restore C flag, rotate right to divide by two and merge in inverse bit, then store
; internal character to screen.
EmitInternal:
    plp
    ror
    sta (ScreenPointer),y
    rts

ClearScreen:
    pha
    lda #0
    sta CurrentRow
    sta COLCRS
    sta ROWCRS
    sta RowsToScroll_Unclear
    jsr ClearScreenFromRowNumber
    pla
    rts

; Save AXY
ClearLastRow:
    pha
    txa
    pha
    tya
    pha
    lda RowCount
    sta RowsToScroll_Unclear
    jsr ClearScreenFromRowNumber
; Restore AXY
    pla
    tay
    pla
    tax
    pla
    rts

    stx COLCRS
    sty ROWCRS
    rts

ClearScreenFromRowNumber:
    lda RowsToScroll_Unclear
; Get address of row to start clearing from into ScreenPointer.
    asl
    tax
    clc
    lda SAVMSC
    adc Add40Table,x
    sta ScreenPointer
    lda SAVMSC_Hi
    adc Add40Table_Hi,x
    sta ScreenPointer_Hi
; X = number of rows to clear
    lda #$19
    sbc RowsToScroll_Unclear
    tax
CLSLoop:
    lda #0
    ldy #$27 ; '''
; Clear one row (40 characters)
CLSRowLoop:
    sta (ScreenPointer),y
    dey
    bpl CLSRowLoop
; Advance ScreenPointer by 40 bytes
    clc
    lda ScreenPointer
    adc #$28 ; '('
    sta ScreenPointer
    lda ScreenPointer_Hi
    adc #0
    sta ScreenPointer_Hi
; Decrement row counter and loop back.
    dex
    bne CLSLoop
    rts

RestoreCursorAndSetMode3:
    pha
    lda DisplayControlFlag_Perhaps
    cmp #3
    beq RestoreCursorAndSetMode3Skip
    lda SaveCOLCRS
    sta COLCRS
    lda SaveROWCRS
    sta ROWCRS
    lda #3
    sta DisplayControlFlag_Perhaps
RestoreCursorAndSetMode3Skip:
    pla
    rts

; Probably unreferenced code
    pha
    lda DisplayControlFlag_Perhaps
    cmp #3
    bne Unreferenced1
    lda COLCRS
    sta SaveCOLCRS
    lda ROWCRS
    sta SaveROWCRS
Unreferenced1:
    lda #$9b
    jsr PutChar
    tya
    asl
    bcs Unreferenced2
    lda #2
    bne Unreferenced3
Unreferenced2:
    lda #3
Unreferenced3:
    sta DisplayControlFlag_Perhaps
    pla
    rts

MoveCursorToLastRow:
    pha
    lda DisplayControlFlag_Perhaps
    cmp #3
    bne SkipSaveCursor1
    lda COLCRS
    sta SaveCOLCRS
    lda ROWCRS
    sta SaveROWCRS
SkipSaveCursor1:
    lda #1
    sta DisplayControlFlag_Perhaps
    lda #$17
    sta ROWCRS
    lda #0
    sta COLCRS
    pla
    rts

PrintSystemError:
    txa
    pha
    jsr ClearLastRow
    jsr MoveCursorToLastRow
    pla
    asl
    tax
    lda SystemErrorAddressTable,x
    sta TextPointer
    inx
    lda SystemErrorAddressTable,x
    sta TextPointer_Hi
    jsr PrintTextAtZPTR5_3
    lda #$ff
    sta CH
    lda #0
    sta ICAX1Z
    jsr GetChar
    jsr ClearLastRow
    jsr RestoreCursorAndSetMode3
    rts

OpenChannel:
    ldx IOCBNumberx16
; Set ICAX1 to READ (4) or WRITE (8)
    sta ICAX1,x
; Set ICCOM to OPEN (3)
    lda #3
    sta ICCOM,x
; Set ICBAL/ICBAH to $470, which is the address of the filename
; Set ICBAL/ICBAH to $499, which is the address of the buffer
    lda #$70 ; 'p'
    sta ICBAL,x
    lda #4
    sta ICBAH,x
; Set ICAX2 to zero. Is this required?
    lda #0
    sta ICAX2,x
; Call CIO
    jsr CIOV
; Return status value * 2 in A
    ldx IOCBNumberx16
    lda ICSTA,x
    asl
    rts

GetPutBinaryData:
    ldx IOCBNumberx16
; Set ICCOM to GET (7) or PUT (11)
    sta ICCOM,x
    lda #$99
    sta ICBAL,x
    lda #4
    sta ICBAH,x
; Set ICBLL/ICBLH to $127, which is the length of the buffer, including the checksum
    lda #$27 ; '''
    sta ICBLL,x
    lda #1
    sta ICBLH,x
; Call CIO
    jsr CIOV
; Return status value * 2 in A
    ldx IOCBNumberx16
    lda ICSTA,x
    asl
    rts

CloseChannel:
    ldx IOCBNumberx16
; Set ICCOM to CLOSE (12)
    lda #$0c
    sta ICCOM,x
; Call CIO
    jsr CIOV
; Return status value * 2 in A
    ldx IOCBNumberx16
    lda ICSTA,x
    asl
    rts

; Find the first IOCB channel, in range 0-7, storing the free channel number * 16 in
; IOCBNumberx16. Return CC if found.
FindFreeIOCB:
    lda #0
    sta IOCBNumberx16
FindFreeIOCBLoop:
    ldx IOCBNumberx16
; ICHID == $FF indicates an unused channel
    lda ICHID,x
    cmp #$ff
    beq FreeIOCBFound
; Advance to next channel number
    clc
    lda IOCBNumberx16
    adc #$10
    sta IOCBNumberx16
; Check we've tried channels 0-7
    cmp #$80
    bne FindFreeIOCBLoop
    sec
    rts

FreeIOCBFound:
    clc
    rts

Reset:
    jmp (PowerUpResetVector)

COPDispatch_LSB:
COPDispatch_MSB = COPDispatch_LSB+1
    .word COP_AT-1
    .word COP_NOTAT-1
    .word COP_ATGT-1
    .word COP_ATLT-1
    .word COP_PRESENT-1
    .word COP_ABSENT-1
    .word COP_WORN-1
    .word COP_NOTWORN-1
    .word COP_CARRIED-1
    .word COP_NOTCARR-1
    .word COP_CHANCE-1
    .word COP_ZERO-1
    .word COP_NOTZERO-1
    .word COP_EQ-1
    .word COP_GT-1
    .word COP_LT-1
AOPDispatch_LSB:
AOPDispatch_MSB = AOPDispatch_LSB+1
    .word AOP_INVEN-1
    .word AOP_DESC-1
    .word AOP_QUIT-1
    .word AOP_END-1
    .word AOP_DONE-1
    .word AOP_OK-1
    .word AOP_ANYKEY-1
    .word AOP_SAVE-1
    .word AOP_LOAD-1
    .word AOP_TURNS-1
    .word AOP_SCORE-1
    .word AOP_CLS-1
    .word AOP_DROPALL-1
    .word AOP_PAUSE-1
    .word AOP_SCREEN-1
    .word AOP_TEXT-1
    .word AOP_BORDER-1
    .word AOP_GOTO-1
    .word AOP_MESSAGE-1
    .word AOP_REMOVE-1
    .word AOP_GET-1
    .word AOP_DROP-1
    .word AOP_WEAR-1
    .word AOP_DESTROY-1
    .word AOP_CREATE-1
    .word AOP_SWAP-1
    .word AOP_PLACE-1
    .word AOP_SET-1
    .word AOP_CLEAR-1
    .word AOP_PLUS-1
    .word AOP_MINUS-1
    .word AOP_LET-1
    .word AOP_SOUND-1
SystemErrorAddressTable:
    .word $899b, $899e, $89a8, $89ac, $89ba, $89c8, $89d2
; "OK"
SystemError1:
    .byte $b0, $b4, $ff
; "I/O ERROR" - this is the only one used in the interpreter.
SystemError2:
    .byte $b6, $d0, $b0, $df, $ba, $ad, $ad, $b0, $ad, $ff
; "DEI"
SystemError3:
    .byte $bb, $ba, $b6, $ff
; "LIMIT REACHED"
SystemError4:
    .byte $b3, $b6, $b2, $b6, $ab, $df, $ad, $ba, $be, $bc, $b7, $ba
    .byte $bb, $ff
; "DATABASE FULL"
SystemError5:
    .byte $bb, $be, $ab, $be, $bd, $be, $ac, $ba, $df, $b9, $aa, $b3
    .byte $b3, $ff
; "PROTECTED"
SystemError6:
    .byte $af, $ad, $b0, $ab, $ba, $bc, $ab, $ba, $bb, $ff
; "INPUT BUFFER FULL"
SystemError7:
    .byte $b6, $b1, $af, $aa, $ab, $df, $bd, $aa, $b9, $b9, $ba, $ad
    .byte $df, $b9, $aa, $b3, $b3, $ff
; Table of multiples of 40 to calculate address off start of screen row.
Add40Table:
Add40Table_Hi = Add40Table+1
    .word     0,   $28,   $50,   $78,   $a0,   $c8,   $f0, $0118
    .word $0140, $0168, $0190, $01b8, $01e0, $0208, $0230, $0258
    .word $0280, $02a8, $02d0, $02f8, $0320, $0348, $0370, $0398
; "More..." (inverse video)
MoreText:
    .byte $ad, $ef, $f2, $e5, $8e, $8e, $8e,   0
pydis_end: