Advent_101/advent101.bas

1311 lines
55 KiB
QBasic

'*********WRITTEN FOR XC=BASIC 3.1.2 - NO GUARANTEES FOR FUTURE VERSIONS!
OPTION INLINEDATA
goto data_mem_end
text_data_mem:
include "data_strings.bas"
verbs_struct:
include "data_verbs.bas"
objects_struct:
include "data_objects.bas"
rooms_struct:
include "data_rooms.bas"
commands_struct:
include "data_commands.bas"
general_help_struct:
include "data_general_help.bas"
'******OTHER FIXED STRINGS********
' "ADVENT 101"
fixed_str_gamename:
DATA AS BYTE $21, $24, $36, $25, $2E, $74, $11, $10, $D1
' "- >ORIGINAL DEVELOPMENT BY #>WILL #>CROWTHER, 1976|- >GREATLY EXPANDED BY #>DON #>WOODS, 1977|- >STREAMLINED WITH RANDOM MAPS AND NEW PUZZLES BY #>JEFFREY #>HENNING, 2017|::TROYPRESS.COM|- >PORTED TO >C64 >X>C=>B>A>S>I>C 3, BUG-FIXED AND FURTHER TOUCHES BY #>J>J>FLASH, 2023|::JJFLASH.ITCH.IO|- >X>C=>B>A>S>I>C 3 BY #>CSABA #>FEKETE, 2022-2023|::XC-BASIC.NET|- >THANKS TO #>DIDUZ : DIDUZ.ITCH.IO"
fixed_str_credits:
DATA AS BYTE $4D, $1E, $2F, $32, $29, $27, $29, $2E, $21, $6C, $24, $25, $36, $25, $2C, $2F, $30, $2D, $25, $2E, $74, $22, $79, $03, $1E, $37, $29, $2C, $6C, $03, $1E, $23, $32, $2F, $37, $34, $28, $25, $32, $0C, $11, $19, $17, $96, $4D, $1E, $27, $32, $25, $21, $34, $2C, $79, $25, $38, $30, $21, $2E, $24, $25, $64, $22, $79, $03, $1E, $24, $2F, $6E, $03, $1E, $37, $2F, $2F, $24, $33, $4C, $11, $19, $17, $97, $4D, $1E, $33, $34, $32, $25, $21, $2D, $2C, $29, $2E, $25, $64, $37, $29, $34, $68, $32, $21, $2E, $24, $2F, $6D, $2D, $21, $30, $73, $21, $2E, $64, $2E, $25, $B7, $30, $35, $3A, $3A, $2C, $25, $73, $22, $79, $03, $1E, $2A, $25, $26, $26, $32, $25, $79, $03, $1E, $28, $25, $2E, $2E, $29, $2E, $27, $4C, $12, $10, $11, $97, $1A, $1A, $34, $32, $2F, $39, $30, $32, $25, $33, $33, $0E, $23, $2F, $AD, $4D, $1E, $30, $2F, $32, $34, $25, $64, $34, $6F, $1E, $23, $16, $54, $1E, $38, $1E, $23, $1D, $1E, $22, $1E, $21, $1E, $33, $1E, $29, $1E, $63, $13, $4C, $22, $35, $27, $0D, $26, $29, $38, $25, $A4, $21, $2E, $64, $26, $35, $32, $34, $28, $25, $72, $34, $2F, $35, $23, $28, $25, $73, $22, $79, $03, $1E, $2A, $1E, $2A, $1E, $26, $2C, $21, $33, $28, $4C, $12, $10, $12, $93, $1A, $1A, $2A, $2A, $26, $2C, $21, $33, $28, $0E, $29, $34, $23, $28, $0E, $29, $AF, $4D, $1E, $38, $1E, $23, $1D, $1E, $22, $1E, $21, $1E, $33, $1E, $29, $1E, $63, $53, $22, $79, $03, $1E, $23, $33, $21, $22, $61, $03, $1E, $26, $25, $2B, $25, $34, $25, $4C, $12, $10, $12, $12, $0D, $12, $10, $12, $93, $1A, $1A, $38, $23, $0D, $22, $21, $33, $29, $23, $0E, $2E, $25, $B4, $4D, $1E, $34, $28, $21, $2E, $2B, $73, $34, $6F, $03, $1E, $24, $29, $24, $35, $7A, $5A, $24, $29, $24, $35, $3A, $0E, $29, $34, $23, $28, $0E, $29, $EF
' "SAY `HELP` FOR GENERAL & SPECIFIC HINTS. PRESS A KEY TO START YOUR CAVING ADVENTURE!"
fixed_str_start_game:
DATA AS BYTE $33, $21, $79, $02, $28, $25, $2C, $30, $42, $26, $2F, $72, $27, $25, $2E, $25, $32, $21, $6C, $46, $33, $30, $25, $23, $29, $26, $29, $63, $28, $29, $2E, $34, $33, $0E, $30, $32, $25, $33, $73, $61, $2B, $25, $79, $34, $6F, $33, $34, $21, $32, $74, $39, $2F, $35, $72, $23, $21, $36, $29, $2E, $A7, $21, $24, $36, $25, $2E, $34, $35, $32, $25, $C1
' "I SEE NO "
fixed_str_i_see_no:
DATA AS BYTE $69, $33, $25, $65, $2E, $2F, $C0
' " HERE."
fixed_str_here:
DATA AS BYTE $00, $28, $25, $32, $E5
' "IT IS NOW CLOSED."
fixed_str_it_is_now_closed:
DATA AS BYTE $29, $74, $29, $73, $2E, $2F, $77, $23, $2C, $2F, $33, $25, $E4
' "IT WAS ALREADY CLOSED."
fixed_str_it_was_already_closed:
DATA AS BYTE $29, $74, $37, $21, $73, $21, $2C, $32, $25, $21, $24, $79, $23, $2C, $2F, $33, $25, $E4
' "DROPPED."
fixed_str_dropped:
DATA AS BYTE $24, $32, $2F, $30, $30, $25, $E4
' "YOU GIVE THE "
fixed_str_you_give_the:
DATA AS BYTE $39, $2F, $75, $27, $29, $36, $65, $34, $28, $25, $C0
' " TO THE "
fixed_str_to_the:
DATA AS BYTE $00, $34, $6F, $34, $28, $25, $C0
' "LAMP"
fixed_str_headlamp:
DATA AS BYTE $2C, $21, $2D, $F0
' "AS YOU JUMPED, UNFORTUNATELY YOU DROPPED THE "
fixed_str_as_you_jumped_you_dropped_the:
DATA AS BYTE $21, $73, $39, $2F, $75, $2A, $35, $2D, $30, $25, $24, $4C, $35, $2E, $26, $2F, $32, $34, $35, $2E, $21, $34, $25, $2C, $79, $39, $2F, $75, $24, $32, $2F, $30, $30, $25, $24, $34, $28, $25, $C0
' "IT IS NOW OPENED."
fixed_str_it_is_now_opened:
DATA AS BYTE $29, $74, $29, $73, $2E, $2F, $77, $2F, $30, $25, $2E, $25, $E4
' "IT WAS ALREADY OPENED."
fixed_str_it_was_already_opened:
DATA AS BYTE $29, $74, $37, $21, $73, $21, $2C, $32, $25, $21, $24, $79, $2F, $30, $25, $2E, $25, $E4
' "YOU'RE ALREADY CARRYING IT."
fixed_str_youre_already_carrying_it:
DATA AS BYTE $39, $2F, $35, $07, $32, $65, $21, $2C, $32, $25, $21, $24, $79, $23, $21, $32, $32, $39, $29, $2E, $67, $29, $F4
' "TAKEN."
fixed_str_taken:
DATA AS BYTE $34, $21, $2B, $25, $EE
' "$TAKEN!"
fixed_str_treasure_taken:
DATA AS BYTE $04, $34, $21, $2B, $25, $2E, $C1
' "ALWAYS FULL DESCRIPTIONS FROM NOW ON."
fixed_str_always_full_descriptions_on:
DATA AS BYTE $21, $2C, $37, $21, $39, $73, $26, $35, $2C, $6C, $24, $25, $33, $23, $32, $29, $30, $34, $29, $2F, $2E, $73, $26, $32, $2F, $6D, $2E, $2F, $77, $2F, $EE
' "THAT WAS A RHETORICAL QUESTION."
fixed_str_that_was_a_rhetorical_question:
DATA AS BYTE $34, $28, $21, $74, $37, $21, $73, $61, $32, $28, $25, $34, $2F, $32, $29, $23, $21, $6C, $31, $35, $25, $33, $34, $29, $2F, $EE
' "YOU SCORED A TOTAL OF "
fixed_str_your_score:
DATA AS BYTE $39, $2F, $75, $33, $23, $2F, $32, $25, $64, $61, $34, $2F, $34, $21, $6C, $2F, $26, $C0
' " POINTS, OUT|OF A POSSIBLE MAXIMUM OF 125 POINTS."
fixed_str_maximum_score:
DATA AS BYTE $00, $30, $2F, $29, $2E, $34, $33, $4C, $2F, $35, $B4, $2F, $66, $61, $30, $2F, $33, $33, $29, $22, $2C, $65, $2D, $21, $38, $29, $2D, $35, $6D, $2F, $66, $11, $12, $55, $30, $2F, $29, $2E, $34, $F3
' "YOU WIN!!"
fixed_str_you_win:
DATA AS BYTE $39, $2F, $75, $37, $29, $2E, $01, $C1
' "YOU'VE SOLVED IT ALL!|HAIL THE CONQUERING ADVENTURER!"
fixed_str_conquered:
DATA AS BYTE $39, $2F, $35, $07, $36, $65, $33, $2F, $2C, $36, $25, $64, $29, $74, $21, $2C, $2C, $81, $28, $21, $29, $6C, $34, $28, $65, $23, $2F, $2E, $31, $35, $25, $32, $29, $2E, $67, $21, $24, $36, $25, $2E, $34, $35, $32, $25, $32, $C1
' "PRESS ANY KEY TO TRY AGAIN."
fixed_str_try_again:
DATA AS BYTE $30, $32, $25, $33, $73, $21, $2E, $79, $2B, $25, $79, $34, $6F, $34, $32, $79, $21, $27, $21, $29, $EE
data_mem_end:
declare sub strngPrnt(bLngStrng as BYTE, wMemLoc as WORD, bFirstCharOffset as BYTE, bCharOffset as BYTE, bExitFlag as BYTE) STATIC
declare sub describeRoom() STATIC
declare sub loadAndUpdateCurrentRoom() STATIC
declare function checkDirections as BYTE (bMovingDirection as BYTE) STATIC
declare sub processCommand() STATIC
declare sub prntSingleChar(bChar as BYTE) STATIC
declare sub shuffleRandomList() STATIC
declare sub eraseCharacters() STATIC
declare sub drawMap() STATIC
declare sub drawMap_drawRoom() STATIC
declare sub drawMap_clear() STATIC
declare sub moveObject(bObjectNumRequested as BYTE, bMoveTo_Col as BYTE, bMoveTo_Row as BYTE) STATIC
declare sub waitForKey() STATIC
declare sub updateScore() STATIC
declare sub makeApause(bJiffiesToWait as BYTE) STATIC
declare sub synchromyEnding() STATIC
declare function myRandom as BYTE (bMax as BYTE, bMask as BYTE) STATIC
Const TRUE = 255
Const FALSE = 0
type tVerbs
wpName as WORD
wpDefaultMessage as WORD
bCommandStartIndex as BYTE
end type
Dim aVerbs(26) as tVerbs @verbs_struct
type tObjects
wpName as WORD
bObjectKind as BYTE
wpDescription as WORD
end type
Dim aObjects(26) as tObjects @objects_struct
Const OBJECT_LIVE_MAP = 11
Const OBJECTKIND_TREASURE = 36
type tRooms
bRoomLetter as BYTE
bDirections as BYTE
wpBlockingReason as WORD
wpDescription as WORD
end type
Const ROOMS_MAXINDEX = 82
Dim aRooms(83) as tRooms @rooms_struct
Const ROOM_REPOSITORY = 62
Const ROOM_ENTRANCE = 1
Const ROOM_GAMEWON = 254
Const ROOM_GAMEQUIT = 253
type tCommands
bActionNumber as BYTE
bObjectNumber as BYTE
bLocationNumber as BYTE
bNewObjectLocationNumber as BYTE
wpNewObjectDescription as WORD
bNewLocationNumber as BYTE
wpNewLocationDescription as WORD
wpMessage as WORD
bNewDirections as BYTE
end type
Const COMMANDS_MAXINDEX = 109
Dim aCommands(110) as tCommands @commands_struct
type tMap
bRoomNumber as BYTE
wpRoomDescription as WORD
bRoomDirections as BYTE
bCharToDraw as BYTE
bCharColor as BYTE
end type
Const MAP_XMAX = 8
Const MAP_YMAX = 9
Dim aMap(9, 10) as tMap
Const DIR_NORTH = %00001000
Const DIR_EAST = %00000100
Const DIR_SOUTH = %00000010
Const DIR_WEST = %00000001
type tObjectsMap
bCol as BYTE
bRow as BYTE
wpCurrentDescription as WORD
bCurrentKind as BYTE
end type
Dim aObjectsMap(26) as tObjectsMap
Const OBJ_CARRIED = 255 '-1
Const OBJ_REMOVED = 254 '-2
Const OBJ_IN_ROOM = 253 '-3
Const OBJ_NOT_FOUND = 252 '-4
CONST GENHELP_MAXINDEX = 3
Dim aHelpLines(4) as WORD @general_help_struct
Dim bBorder as BYTE @$D020
Dim bBackground as BYTE @$D021
Dim bInkColor as BYTE @646 'text colour
Dim bCursorFlash as BYTE @$CC 'this controls the flashing of the cursor
Dim bCursorColumn as BYTE @211 'cursor LOGICAL column position...
Dim bCursorRow as BYTE @214 'cursor row position
bBorder = 0 : bBackground = 0 'black
sys $E544 FAST 'clear screen
poke 657, 128 'disable C= & Shift to change case
poke $D018, %00010111 'screen $0400, char location: $1800 (lowercase)
poke 808, 234 'THE OLD BASIC WAY OF DISABLING RUNSTOP+RESTORE! :'-)
Dim bLinesScrolled as BYTE : bLinesScrolled = 128 'the intro screen doesn't need counting the printed lines
Dim bBitFlags as BYTE FAST
Dim bLngStrng_LastChar as BYTE
Const LNG_STRNG = 255
Const SHRT_STRNG = 0
'***************************************PRINT INTRO SCREEN
bCursorRow = 23 : call prntSingleChar(13) 'so that it actually starts printing from line 24
bInkColor = 1 'white
call strngPrnt(LNG_STRNG, @fixed_str_gamename, 32, 0, %11000000) : call prntSingleChar(13)
bInkColor = 5 'green
call strngPrnt(SHRT_STRNG, @fixed_str_credits, 0, 0, %11000000)
call prntSingleChar(13) : call prntSingleChar(13)
bInkColor = 3 'cyan
call strngPrnt(LNG_STRNG, @fixed_str_start_game, 32, 0, %11000000)
'*********************************************************
'********************PATCH KERNAL**********************************
'Copy KERNAL to RAM, patch in the number of *unscrollable* lines (thanks Diduz! - https://diduz.itch.io )
memcpy $E000, $E000, 8192
POKE $01, 53 'for some MYSTERIOUS reason, $01 has to be %00110101 and NOT %00110100
POKE 59639, 9 'number of unscrollable lines (range 0 - 9)
'******************************************************************
restart_adv:
call waitForKey()
VOLUME 15
call prntSingleChar(13)
'******************DRAW UPPER PART**************************************
'clear upper part
memset $0400, 360, 32 'spaces on the first 9 lines of the screen
'brown colour for the Map space
memset $D800, 360, 9 'brown colour set on the first 9 lines of the screen
'N S E W
charat 26, 1, $4E, 11 '"N" - dark grey
charat 25, 2, $57, 11 '"W" - dark grey
charat 27, 2, $45, 11 '"E" - dark grey
charat 26, 3, $53, 11 '"S" - dark grey
'horizontal line on the 10th line of the screen
memset $D968, 40, 1 'set the 10th line of the screen to white
memset $0568, 40, $40
Dim bColIndex as BYTE FAST
Dim bRowIndex as BYTE FAST
For bRowIndex = 0 to 8
charat 23, bRowIndex, $5D, 1 'vertical line 1, white
charat 30, bRowIndex, $5D, 1 'vertical line 2, white
next bRowIndex
charat 23, 9, $71, 1 'junction with the horizontal line 1, in white
charat 30, 9, $71, 1 'junction with the horizontal line 1, in white
textat 24, 6, "Score:", 8 'orange
textat 26, 8, 0, 7 'yellow
textat 31, 3, "Inventory", 8 'orange
textat 33, 4, "count:", 8 'orange
textat 35, 6, 0, 7 'yellow
'***********************************************************************
bBorder = 11 'dark grey
VOICE 1 ADSR 8, 0, 8, 12 WAVE PULSE PULSE 1024 TONE 8192 ON
Dim bScanIndex as BYTE FAST 'multi-purpose variable for For-next cycles and whatnot
Dim bAccumulator as BYTE FAST 'multi-purpose variable
Randomize TI()
'discarding the first 10 random numbers as they are not that random, alas
For bScanIndex = 1 to 10
bAccumulator = RNDB() '"recycled" as dummy variable
next bScanIndex
Dim bPlayer_Row as BYTE
Dim bPlayer_Col as BYTE
Dim bPlayer_LastOppositeDirection as BYTE : bPlayer_LastOppositeDirection = 0
Dim bPlayer_InventoryCount as BYTE : bPlayer_InventoryCount = 0
Dim bPlayer_Score as BYTE : bPlayer_Score = 0
Dim bPlayer_Map_PreviousRow as BYTE FAST
Dim bPlayer_Map_PreviousCol as BYTE FAST
Dim bPlayer_PreviousRow as BYTE FAST
Dim bPlayer_PreviousCol as BYTE FAST
'-------------------------MAP-BUILDING----------------------------------------------
Dim aRandomList(90) as BYTE 'a deck of "cards" to store room numbers to shuffle
Dim aRandomObjectList(90) as BYTE 'a deck of "cards" to store object numbers to shuffle
'Shuffle the object numbers first
memset @aRandomList, 90, 255 'initialize the array with all 255s
for bScanIndex = 0 to 25
aObjectsMap(bScanIndex).bCol = OBJ_NOT_FOUND
if aObjects(bScanIndex).wpName > $0000 then aRandomList(bScanIndex) = bScanIndex
next bScanIndex
swap aRandomList(OBJECT_LIVE_MAP), aRandomList(0) 'swap the "L"ive map with the start of the deck
call shuffleRandomList()
bAccumulator = myRandom(3, 3) + 4
swap aRandomList(0), aRandomList(bAccumulator) 'move the "L"ive map to a position between 4 and 7 (swapping the cards)
memcpy @aRandomList, @aRandomObjectList, 90
'now re-use aRandomList for the rooms
memset @aRandomList, 90, 0 'initialize the array with all zeros
For bScanIndex = 1 to ROOMS_MAXINDEX
aRandomList(bScanIndex) = bScanIndex
next bScanIndex
swap aRandomList(ROOM_ENTRANCE), aRandomList(0) 'swap the Entrance room with the start of the deck
swap aRandomList(ROOM_REPOSITORY), aRandomList(85) 'swap the Repository room with the 86th position of the deck
call shuffleRandomList()
bAccumulator = myRandom(7, 7) + 47
swap aRandomList(85), aRandomList(bAccumulator)
For bColIndex = 0 to MAP_XMAX
For bRowIndex = 0 to MAP_YMAX
aMap(bColIndex, bRowIndex).bRoomNumber = 255 'mark the room as "new"
aMap(bColIndex, bRowIndex).bRoomDirections = 0 'every new room starts with no directions available
Next bRowIndex
Next bColIndex
bPlayer_Col = myRandom(MAP_XMAX, 15)
bPlayer_Row = myRandom(MAP_YMAX, 15)
'-------------------------END-MAP-BUILDING------------------------------------------
VOICE 1 TONE 16384 OFF
Dim bRoom_CurrNumber as BYTE
Dim bRoom_CurrDirections as BYTE
Dim bRoom_New as BYTE
Dim wpRoom_Creature as WORD
Dim bGenericCounter as BYTE FAST
Dim bNewRoomSequenceIndex as BYTE : bNewRoomSequenceIndex = 0
Dim bAction_Petscii as BYTE
Dim bObject_Petscii as BYTE
Dim bAction_Petscii_Previous as BYTE
Dim bAction_Index as BYTE
Dim bObject_Index as BYTE
Dim bObject_KindCached as BYTE
Dim bCommand_OK as BYTE
Dim wpPostPromptMessage as WORD
Dim bCommand_CurrStartIndex as BYTE FAST
Dim bVerboseDescripts as BYTE : bVerboseDescripts = FALSE
Dim bGenHelpIndex as BYTE : bGenHelpIndex = 0
Dim bInputPhase as BYTE
Dim aCursorPreviousColumnPos(3) as BYTE 'one for each phase of the Input
Dim bDrawMap_ForceRedraw as BYTE FAST : bDrawMap_ForceRedraw = TRUE
Dim wSoundTone as WORD FAST
Const SCORE_MAX = 125
Dim bScoreDelta as BYTE FAST : bScoreDelta = 0
bBorder = 6 'blue
'************************MAIN LOOP**************************************
bAction_Petscii = 0
bLinesScrolled = 0
call describeRoom()
do
'this is done up here because, in the event a Treasure is first "dealt" in the Repository, the score MUST be updated!
if bScoreDelta then call updateScore()
bLinesScrolled = 254 : call prntSingleChar(13) 'separate input prompt from any text printed before
call prntSingleChar(62) '">" a.k.a. the PROMPT
bAction_Petscii_Previous = bAction_Petscii
bInputPhase = 0
do
bCursorFlash = 0
call waitForKey()
bCursorFlash = 255
on bInputPhase goto INPT_VERB, INPT_SPACE, INPT_OBJECT, INPT_ENTER
INPT_VERB:
get bAction_Petscii
if (bAction_Petscii < 65) OR (bAction_Petscii > 90) then continue do
bAction_Index = bAction_Petscii - 65
if (aVerbs(bAction_Index).wpName = $0000) then continue do 'alas, a few verbs are empty...
bObject_Petscii = 0
aCursorPreviousColumnPos(0) = bCursorColumn
call strngPrnt(SHRT_STRNG, aVerbs(bAction_Index).wpName AND %0111111111111111, 32, 32, %11000000)
if (aVerbs(bAction_Index).wpName AND %1000000000000000) > 0 then
bInputPhase = bInputPhase + 1 'wait for SPACE
else
bInputPhase = 3 'wait directly for the RETURN key
end if
continue do
INPT_SPACE:
get bScanIndex 'recycled as temporary place to read the key pressed
if bScanIndex = 20 then 'Del (backspace)
bInputPhase = bInputPhase - 1 'go back to accept a Verb
call eraseCharacters()
continue do
end if
if bScanIndex = 32 then 'SPACE
aCursorPreviousColumnPos(1) = bCursorColumn
call prntSingleChar(32) 'print a SPACE
bInputPhase = bInputPhase + 1 'now wait for the Object to be inputted
end if
continue do
INPT_OBJECT:
get bObject_Petscii
if bObject_Petscii = 20 then 'Del (backspace)
bInputPhase = bInputPhase - 1 'go back waiting for a SPACE
call eraseCharacters()
continue do
end if
if (bObject_Petscii < 65) OR (bObject_Petscii > 90) then continue do
bObject_Index = bObject_Petscii - 65
if (aObjectsMap(bObject_Index).bCol = OBJ_NOT_FOUND) then continue do 'refuse Object if it hasn't been found yet
bObject_KindCached = aObjectsMap(bObject_Index).bCurrentKind
aCursorPreviousColumnPos(2) = bCursorColumn
call strngPrnt(SHRT_STRNG, aObjects(bObject_Index).wpName, 32, 32, %11000000)
bInputPhase = bInputPhase + 1 'now wait for the Return key
continue do
INPT_ENTER:
get bScanIndex 'recycled as temporary place to read the key pressed
if bScanIndex = 20 then 'Del (backspace)
if bObject_Petscii then
bInputPhase = bInputPhase - 1 'go back to accept another Object
else
bInputPhase = 0 'go straight back to accept another Verb
end if
call eraseCharacters()
continue do
end if
if bScanIndex = 13 then 'Return key
call prntSingleChar(32) 'prints a space to erase the cursor, in case it's visible
call prntSingleChar(13) 'print a CR
call prntSingleChar(13) 'print another CR to separate the input line from the text that will follow
exit do 'Everything needed has been inputted!
end if
loop
if bObject_Petscii then
if (bPlayer_Col <> aObjectsMap(bObject_Index).bCol OR bPlayer_Row <> aObjectsMap(bObject_Index).bRow) and aObjectsMap(bObject_Index).bCol <> OBJ_CARRIED then
bInkColor = 15 'light grey
call strngPrnt(SHRT_STRNG, @fixed_str_i_see_no, 32, 0, %11000000) '"I see no<space>"
call strngPrnt(SHRT_STRNG, aObjects(bObject_Index).wpName, 0, 0, %11000000) '"<object name>"
call strngPrnt(LNG_STRNG, @fixed_str_here, 0, 0, %11000000) '"<space>here." - The <CR> is automatic
continue do 'restart Main Loop
end if
end if
bCommand_OK = TRUE
bInkColor = 3 'cyan
wpPostPromptMessage = aVerbs(bAction_Index).wpDefaultMessage
'~ on bAction_Index goto VERB_ACTIONS, VERB_BACK, VERB_CLOSE, VERB_DROP, VERB_EAST, VERB_FIGHT, VERB_GIVE, VERB_HELP, VERB_INVENTORY, VERB_JUMP, _
'~ VERB_KICK, VERB_LOOK, VERB_MAP, VERB_NORTH, VERB_OPEN, VERB_POINTS, VERB_QUIT, VERB_READ, VERB_SOUTH, VERB_TAKE, _
'~ VERB_USE, VERB_VERBOSE, VERB_WEST, VERB_XPLORE, VERB_YES, VERB_ZZZ
on bAction_Index goto VERB_ACTIONS, VERB_BACK, VERB_CLOSE, VERB_DROP, VERB_EAST, VERB_FIGHT, VERB_GIVE, VERB_HELP, VERB_INVENTORY, VERB_JUMP, _
VERB_FIGHT, VERB_LOOK, VERB_end, VERB_NORTH, VERB_OPEN, VERB_end, VERB_end, VERB_end, VERB_SOUTH, VERB_TAKE, _
VERB_end, VERB_VERBOSE, VERB_WEST, VERB_XPLORE, VERB_YES, VERB_end
VERB_ACTIONS:
call strngPrnt(LNG_STRNG, wpPostPromptMessage, 32, 0, %11000000)
bGenericCounter = 0 'recycled to simulate TAB()
for bScanIndex = 0 to 25
if aVerbs(bScanIndex).wpName > 0 then
bCursorColumn = bGenericCounter
call strngPrnt(SHRT_STRNG, aVerbs(bScanIndex).wpName AND %0111111111111111, 32, 0, %11000000)
bGenericCounter = bGenericCounter + 10 : if bGenericCounter > 30 then call prntSingleChar(13) : bGenericCounter = 0
end if
next bScanIndex
goto VERB_end
VERB_BACK:
select case bPlayer_LastOppositeDirection
case DIR_NORTH
goto VERB_NORTH
case DIR_EAST
goto VERB_EAST
case DIR_SOUTH
goto VERB_SOUTH
case DIR_WEST
goto VERB_WEST
end select
goto VERB_end
VERB_CLOSE:
bCommand_OK = FALSE
if bObject_KindCached = $2B then '"+"
aObjectsMap(bObject_Index).bCurrentKind = $2D '"-"
wpPostPromptMessage = @fixed_str_it_is_now_closed
bCommand_OK = TRUE
else
if bObject_KindCached = $2D then '"-"
wpPostPromptMessage = @fixed_str_it_was_already_closed
end if
end if
goto VERB_end
VERB_DROP:
if aObjectsMap(bObject_Index).bCol <> OBJ_CARRIED then
bCommand_OK = FALSE
else
call moveObject(bObject_Index, bPlayer_Col, bPlayer_Row)
wpPostPromptMessage = @fixed_str_dropped
if bObject_Index = OBJECT_LIVE_MAP then call drawMap_clear() 'so that the Map is erased right away... >-(
end if
goto VERB_end
VERB_EAST:
if checkDirections(DIR_EAST) then
bPlayer_Col = bPlayer_Col + 1
if bPlayer_Col > MAP_XMAX then bPlayer_Col = 0
bPlayer_LastOppositeDirection = DIR_WEST
goto VERB_LOOK 'calls describeRoom() and loops
end if
goto VERB_end
VERB_FIGHT:
'these two are for handling an alias (KICK) which GOTOs here
bAction_Petscii = 70 '"F"ight
bAction_Index = 5
goto VERB_end
VERB_GIVE:
wpRoom_Creature = aMap(bPlayer_Col, bPlayer_Row).wpRoomDescription
do
bAccumulator = peek(wpRoom_Creature)
if (bAccumulator AND %11000000) = %11000000 then bCommand_OK = FALSE : exit do 'loop until the end of the string
wpRoom_Creature = wpRoom_Creature + 1
if (bAccumulator AND %00111111) = 32 then exit do 'that's "@" but "encoded" - the Creature name starts right after the @
loop
goto VERB_end
VERB_HELP:
wpPostPromptMessage = aHelpLines(bGenHelpIndex)
bGenHelpIndex = (bGenHelpIndex + 1) AND 3
goto VERB_end
VERB_INVENTORY:
call strngPrnt(LNG_STRNG, wpPostPromptMessage, 32, 0, %11000000)
for bScanIndex = 0 to 25
if aObjectsMap(bScanIndex).bCol = OBJ_CARRIED then
bInkColor = 1 'white
if aObjectsMap(bScanIndex).bCurrentKind = OBJECTKIND_TREASURE then bInkColor = 7 'yellow
call strngPrnt(SHRT_STRNG, aObjects(bScanIndex).wpName, 32, 0, %11000000)
call prntSingleChar(13)
end if
next bScanIndex
'"Lamp" is a fake object always carried
bInkColor = 15 'light grey
call strngPrnt(SHRT_STRNG, @fixed_str_headlamp, 32, 0, %11000000) : call prntSingleChar(13)
bInkColor = 1 'white
goto VERB_end
VERB_JUMP:
call strngPrnt(LNG_STRNG, wpPostPromptMessage, 32, 0, %11000000)
if (myRandom(255, 255) > 99) then ' ~60% probability of dropping an object
bGenericCounter = 255
for bScanIndex = 0 to 25
if (bScanIndex <> OBJECT_LIVE_MAP) AND (aObjectsMap(bScanIndex).bCol = OBJ_CARRIED) then bGenericCounter = bScanIndex
next bScanIndex
if bGenericCounter < 255 then
call strngPrnt(SHRT_STRNG, @fixed_str_as_you_jumped_you_dropped_the, 32, 0, %11000000)
call strngPrnt(SHRT_STRNG, aObjects(bGenericCounter).wpName, 0, 0, %11000000) : call prntSingleChar(33) '"<object name>!"
call prntSingleChar(13) 'CR
call moveObject(bGenericCounter, bPlayer_Col, bPlayer_Row)
end if
end if
goto VERB_XPLORE '*not* VERB_end !
VERB_LOOK:
call describeRoom()
continue do
VERB_NORTH:
if checkDirections(DIR_NORTH) then
bPlayer_Row = bPlayer_Row - 1
if bPlayer_Row = 255 then bPlayer_Row = MAP_YMAX
bPlayer_LastOppositeDirection = DIR_SOUTH
goto VERB_LOOK 'calls describeRoom() and loops
end if
goto VERB_end
VERB_OPEN:
bCommand_OK = FALSE
if bObject_KindCached = $2D then '"-"
aObjectsMap(bObject_Index).bCurrentKind = $2B '"+"
wpPostPromptMessage = @fixed_str_it_is_now_opened
bCommand_OK = TRUE
else
if bObject_KindCached = $2B then '"+"
wpPostPromptMessage = @fixed_str_it_was_already_opened
end if
end if
goto VERB_end
VERB_SOUTH:
if checkDirections(DIR_SOUTH) then
bPlayer_Row = bPlayer_Row + 1
if bPlayer_Row > MAP_YMAX then bPlayer_Row = 0
bPlayer_LastOppositeDirection = DIR_NORTH
goto VERB_LOOK 'calls describeRoom() and loops
end if
goto VERB_end
VERB_TAKE:
bCommand_OK = FALSE
if aObjectsMap(bObject_Index).bCol = OBJ_CARRIED then
wpPostPromptMessage = @fixed_str_youre_already_carrying_it
else
if bPlayer_InventoryCount < 8 then
bCommand_OK = TRUE
bPlayer_InventoryCount = bPlayer_InventoryCount + 1
call moveObject(bObject_Index, OBJ_CARRIED, OBJ_CARRIED)
wpPostPromptMessage = @fixed_str_taken
if bObject_KindCached = OBJECTKIND_TREASURE then wpPostPromptMessage = @fixed_str_treasure_taken
if bObject_Index = OBJECT_LIVE_MAP then call drawMap() 'so that the Map appears right away :-)
if (bRoom_CurrNumber = ROOM_REPOSITORY) AND (bObject_KindCached = OBJECTKIND_TREASURE) then bScoreDelta = %11111011 '"$", -5
end if
end if
goto VERB_end
VERB_VERBOSE:
bVerboseDescripts = NOT bVerboseDescripts
if bVerboseDescripts then wpPostPromptMessage = @fixed_str_always_full_descriptions_on
goto VERB_end
VERB_WEST:
if checkDirections(DIR_WEST) then
bPlayer_Col = bPlayer_Col - 1
if bPlayer_Col = 255 then bPlayer_Col = MAP_XMAX
bPlayer_LastOppositeDirection = DIR_EAST
goto VERB_LOOK 'calls describeRoom() and loops
end if
goto VERB_end
VERB_XPLORE:
bGenericCounter = 4 'recycled as the number of required open directions...
if bAction_Petscii = 88 then '"X"plore - JUMP also GOTOs here ...
call strngPrnt(LNG_STRNG, wpPostPromptMessage, 32, 0, %11000000)
bGenericCounter = 2 'recycled as the number of required open directions...
end if
call prntSingleChar(13) 'CR
Dim bNewRoomRandomIndex as BYTE FAST : bNewRoomRandomIndex = bNewRoomSequenceIndex - 1
Dim bFoundNewRandomRoom as BYTE FAST
VOICE 1 WAVE NOISE TONE 13169 ADSR 11, 0, 15, 10 ON
call makeApause(5)
for bScanIndex = 1 to 8 'eight tries to find a "new" room with the right number of open directions
do
do
bColIndex = myRandom(MAP_XMAX, 15) 'range 0-8
loop while bColIndex = bPlayer_Col
do
bRowIndex = myRandom(MAP_YMAX, 15) 'range 0-9
loop while bRowIndex = bPlayer_Row
bFoundNewRandomRoom = FALSE
bRoom_New = aMap(bColIndex, bRowIndex).bRoomDirections 'recycled to copy the possible new room directions
if aMap(bColIndex, bRowIndex).bRoomNumber = 255 then 'if the room is "new"
bFoundNewRandomRoom = TRUE
if bNewRoomRandomIndex < 89 then bNewRoomRandomIndex = bNewRoomRandomIndex + 1
bRoom_New = aRooms(aRandomList(bNewRoomRandomIndex)).bDirections
end if
bBitFlags = 0 'recycled to count the open directions
if (bRoom_New AND %10000000) then 'if this room is blocked, it's not a valid destination
else
if (bRoom_New AND DIR_NORTH) then bBitFlags = bBitFlags + 1
if (bRoom_New AND DIR_EAST) then bBitFlags = bBitFlags + 1
if (bRoom_New AND DIR_SOUTH) then bBitFlags = bBitFlags + 1
if (bRoom_New AND DIR_WEST) then bBitFlags = bBitFlags + 1
end if
loop while (bBitFlags > bGenericCounter) OR (bBitFlags = 0) 'the new room MUST have the number (or less, but not zero) of open directions required by JUMP or XPLORE
if (bFoundNewRandomRoom) then
swap aRandomList(bNewRoomSequenceIndex), aRandomList(bNewRoomRandomIndex)
exit for
end if
next bScanIndex 'after eight tries, even a room which is not "new" will be fine...
bPlayer_Col = bColIndex
bPlayer_Row = bRowIndex
bPlayer_LastOppositeDirection = 0 'forget where the Player came from
VOICE 1 OFF
goto VERB_LOOK 'calls describeRoom() and loops
VERB_YES:
if bAction_Petscii_Previous = 81 then '"Q"uit
bRoom_CurrNumber = ROOM_GAMEQUIT
'~ wpPostPromptMessage = 0 'skip default message
exit do 'nothing to process, nothing to print, it's simpler to directly exit the main loop
end if
if bLngStrng_LastChar = 63 then '"?"
wpPostPromptMessage = @fixed_str_that_was_a_rhetorical_question
end if
VERB_end:
if bCommand_OK then
bCommand_CurrStartIndex = aVerbs(bAction_Index).bCommandStartIndex
if bCommand_CurrStartIndex < 255 then call processCommand()
else
bInkColor = 15 'light grey
end if
if wpPostPromptMessage > 0 then
call strngPrnt(LNG_STRNG, wpPostPromptMessage, 32, 0, %11000000) 'this also zeroes wpPostPromptMessage
end if
loop while bRoom_CurrNumber < ROOM_GAMEQUIT 'end of MAIN LOOP *********************************************************************
'give 1 point for each Treasure carried
for bScanIndex = 0 to 25
if aObjectsMap(bScanIndex).bCurrentKind = OBJECTKIND_TREASURE then
if aObjectsMap(bScanIndex).bCol = OBJ_CARRIED then bScoreDelta = bScoreDelta + 1
end if
next bScanIndex
if bScoreDelta then call updateScore()
if bRoom_CurrNumber = ROOM_GAMEWON then
bInkColor = 7 'yellow
call strngPrnt(LNG_STRNG, @fixed_str_you_win, 32, 0, %11000000)
bInkColor = 3 'cyan
call prntSingleChar(13)
end if
call strngPrnt(SHRT_STRNG, @fixed_str_your_score, 32, 0, %11000000)
print bPlayer_Score ;
call strngPrnt(LNG_STRNG, @fixed_str_maximum_score, 0, 0, %11000000)
if bPlayer_Score = SCORE_MAX then
bLinesScrolled = 254
call strngPrnt(LNG_STRNG, @fixed_str_conquered, 32, 0, %11000000)
call synchromyEnding()
end if
call prntSingleChar(13)
call strngPrnt(LNG_STRNG, @fixed_str_try_again, 32, 0, %11000000)
goto restart_adv
sub strngPrnt(bLngStrng as BYTE, wMemLoc as WORD, bFirstCharOffset as BYTE, bCharOffset as BYTE, bExitFlag as BYTE) STATIC
dim bUpperCaseNumber as BYTE FAST : bUpperCaseNumber = bFirstCharOffset
dim bQuoteToggle as BYTE FAST : bQuoteToggle = 32
Dim bMainTextColor as BYTE FAST
bMainTextColor = bInkColor
do
bCommand_CurrStartIndex = peek(wMemLoc) 'recycled to cache the wMemLoc content
bAccumulator = (bCommand_CurrStartIndex AND %00111111) + 32 'adding 32 "decodes" the character
'Characters to intercept
select case bAccumulator
case $2A' "*" - marker for short descriptions
if NOT bVerboseDescripts then
if (bRoom_New = FALSE) AND (bAction_Petscii <> 76) then '"L"ook
bAccumulator = 65 '"A" - so that a full stop *will* be printed at the end
exit do
end if
end if
bAccumulator = 0
case $3E ' ">"
bUpperCaseNumber = 32 'always bring the next character to Upper case
bAccumulator = 0
case $23 ' "#"
bInkColor = 13 'light green
bAccumulator = 0
case $24 ' "$"
bInkColor = 7 'yellow
bAccumulator = 0
case $40 ' "@"
bInkColor = 10 'light red
bAccumulator = 0
end select
'Character printing
if bAccumulator then
if (bAccumulator AND %01000000) then 'if it contains a letter...
bAccumulator = bAccumulator + bUpperCaseNumber
bUpperCaseNumber = bCharOffset
else
select case bAccumulator
case $2E, $21, $3F '".", "!", "?"
bUpperCaseNumber = bFirstCharOffset
case $22 ' quotes
bUpperCaseNumber = bUpperCaseNumber OR bQuoteToggle
bQuoteToggle = bQuoteToggle XOR 32
case $2C ' ","
bInkColor = bMainTextColor
end select
end if
call prntSingleChar(bAccumulator)
end if
bBitFlags = (bCommand_CurrStartIndex AND %11000000)
if bBitFlags = bExitFlag then exit do '%11000000 = string END - %01000000 = SPACE
select case bBitFlags
case %01000000 'print SPACE
bInkColor = bMainTextColor
call prntSingleChar(32) 'SPACE
case %10000000 'print CR
bInkColor = bMainTextColor
call prntSingleChar(13) 'Carriage Return
end select
wMemLoc = wMemLoc + 1
loop
if bLngStrng then
bLngStrng_LastChar = bAccumulator
if (bAccumulator AND %01000000) then 'if the last char printed is a letter...
call prntSingleChar( $2E) 'full stop
end if
bInkColor = 1 'white - doing this to mitigate (but not completely solve) a problem with the flashing cursor not always showing in white
if bCursorColumn <> 40 then call prntSingleChar(13)
wpPostPromptMessage = 0 'the string has been printed, so this gets zeroed (and doesn't risk getting printed again)
end if
end sub
sub describeRoom() STATIC
if bAction_Petscii <> 76 then call loadAndUpdateCurrentRoom() 'if the player said "L"ook there's nothing to load & update & draw...
bInkColor = 5 'green
call strngPrnt(LNG_STRNG, aMap(bPlayer_Col, bPlayer_Row).wpRoomDescription, 32, 0, %11000000)
'Manage Objects in the Room!
bGenericCounter = 0
for bScanIndex = 0 to 25
if aObjectsMap(bScanIndex).bCol = OBJ_IN_ROOM then
if aObjectsMap(bScanIndex).bRow <> bRoom_CurrNumber then continue for
call moveObject(bScanIndex, bPlayer_Col, bPlayer_Row)
end if
if aObjectsMap(bScanIndex).bCol = bPlayer_Col AND aObjectsMap(bScanIndex).bRow = bPlayer_Row then
if bGenericCounter = 0 then call prntSingleChar(13) 'first object found separates its description from the room description
bInkColor = 5 'green
call strngPrnt(LNG_STRNG, aObjectsMap(bScanIndex).wpCurrentDescription, 32, 0, %11000000)
bGenericCounter = bGenericCounter + 1
end if
next bScanIndex
end sub
sub loadAndUpdateCurrentRoom() STATIC
bRoom_New = FALSE
bRoom_CurrNumber = aMap(bPlayer_Col, bPlayer_Row).bRoomNumber
bRoom_CurrDirections = aMap(bPlayer_Col, bPlayer_Row).bRoomDirections
if bRoom_CurrNumber = 255 then 'if the room is "new"...
bRoom_New = TRUE
bRoom_CurrNumber = aRandomList(bNewRoomSequenceIndex)
aMap(bPlayer_Col, bPlayer_Row).bRoomNumber = bRoom_CurrNumber
aMap(bPlayer_Col, bPlayer_Row).wpRoomDescription = aRooms(bRoom_CurrNumber).wpDescription
aMap(bPlayer_Col, bPlayer_Row).bCharToDraw = 32
if bRoom_CurrNumber = ROOM_REPOSITORY then
aMap(bPlayer_Col, bPlayer_Row).bCharToDraw = $D2 'reversed "R"
aMap(bPlayer_Col, bPlayer_Row).bCharColor = 7 'yellow
end if
bRoom_CurrDirections = aRooms(bRoom_CurrNumber).bDirections OR aMap(bPlayer_Col, bPlayer_Row).bRoomDirections
aMap(bPlayer_Col, bPlayer_Row).bRoomDirections = bRoom_CurrDirections
bScanIndex = aRandomObjectList(bNewRoomSequenceIndex) 'recycled to read the next newfound object to place here
if bScanIndex < 255 then
aObjectsMap(bScanIndex).wpCurrentDescription = aObjects(bScanIndex).wpDescription
aObjectsMap(bScanIndex).bCurrentKind = aObjects(bScanIndex).bObjectKind
call moveObject(bScanIndex, bPlayer_Col, bPlayer_Row)
end if
bNewRoomSequenceIndex = bNewRoomSequenceIndex + 1
end if 'if bRoom_CurrNumber = 255 then
'update adjacent rooms. Unfortunately I have to do this *ALWAYS* (too many exceptions to handle otherwise)
Dim bAdjacentRoomIndex as BYTE FAST
if (bRoom_CurrDirections AND DIR_NORTH) then
bAdjacentRoomIndex = bPlayer_Row - 1
if bAdjacentRoomIndex = 255 then bAdjacentRoomIndex = MAP_YMAX
aMap(bPlayer_Col, bAdjacentRoomIndex).bRoomDirections = aMap(bPlayer_Col, bAdjacentRoomIndex).bRoomDirections OR DIR_SOUTH
end if
if bRoom_CurrDirections AND DIR_SOUTH then
bAdjacentRoomIndex = bPlayer_Row + 1
if bAdjacentRoomIndex > MAP_YMAX then bAdjacentRoomIndex = 0
aMap(bPlayer_Col, bAdjacentRoomIndex).bRoomDirections = aMap(bPlayer_Col, bAdjacentRoomIndex).bRoomDirections OR DIR_NORTH
end if
if bRoom_CurrDirections AND DIR_WEST then
bAdjacentRoomIndex = bPlayer_Col - 1
if bAdjacentRoomIndex = 255 then bAdjacentRoomIndex = MAP_XMAX
aMap(bAdjacentRoomIndex, bPlayer_Row).bRoomDirections = aMap(bAdjacentRoomIndex, bPlayer_Row).bRoomDirections OR DIR_EAST
end if
if bRoom_CurrDirections AND DIR_EAST then
bAdjacentRoomIndex = bPlayer_Col + 1
if bAdjacentRoomIndex > MAP_XMAX then bAdjacentRoomIndex = 0
aMap(bAdjacentRoomIndex, bPlayer_Row).bRoomDirections = aMap(bAdjacentRoomIndex, bPlayer_Row).bRoomDirections OR DIR_WEST
end if
call drawMap()
end sub
function checkDirections as BYTE (bMovingDirection as BYTE) STATIC
if (bRoom_CurrDirections AND %10000000) then 'if it's a BLOCKED room...
if (bPlayer_LastOppositeDirection AND bMovingDirection) then return TRUE
wpPostPromptMessage = aRooms(bRoom_CurrNumber).wpBlockingReason
VOICE 1 WAVE SAW TONE 390 ADSR 0, 0, 15, 9 ON OFF
return FALSE
end if
if (bRoom_CurrDirections AND bMovingDirection) then return TRUE
return FALSE
end function
sub processCommand() STATIC
Dim bExaminedValue as BYTE FAST
Dim bAlreadyChanged as BYTE FAST
for bScanIndex = bCommand_CurrStartIndex to COMMANDS_MAXINDEX
if aCommands(bScanIndex).bActionNumber <> bAction_Petscii then exit for 'not the examined Verb anymore...
'Check the inputted object
bExaminedValue = aCommands(bScanIndex).bObjectNumber
if bExaminedValue >= 65 then 'if this line has a *specific* object in the Object field...
if bExaminedValue <> bObject_Petscii then continue for
else
if bExaminedValue >= 33 then 'if this line has a Object Kind in the Object field...
if bExaminedValue <> bObject_KindCached then continue for
end if
end if
'Or... the Object field can be blank, which is just fine
'Check the current location
bExaminedValue = aCommands(bScanIndex).bLocationNumber
if bExaminedValue then
if bExaminedValue <> bRoom_CurrNumber then continue for
end if
'Or... the Location field can be blank, and that's fine too
wSoundTone = 4096 'default sound
'Update the object location and description, and the location number, description & directions (where needed)
bAlreadyChanged = FALSE
bExaminedValue = aCommands(bScanIndex).bNewObjectLocationNumber
select case bExaminedValue
case 0 'empty - do nothing
case 252 '"DRO"
call moveObject(bObject_Index, bPlayer_Col, bPlayer_Row)
case 254 '"RMV"
call moveObject(bObject_Index, OBJ_REMOVED, OBJ_REMOVED)
wSoundTone = 1024 ' "negative" sound
case 255 '"RND"
do
bColIndex = myRandom(MAP_XMAX, 15)
loop while bColIndex = bPlayer_Col
call moveObject(bObject_Index, bColIndex, myRandom(MAP_YMAX, 15))
case else
call moveObject(bObject_Index, OBJ_IN_ROOM, bExaminedValue)
end select
if aCommands(bScanIndex).wpNewObjectDescription > $0000 then
if aObjectsMap(bObject_Index).wpCurrentDescription = aCommands(bScanIndex).wpNewObjectDescription then
bAlreadyChanged = TRUE
else
aObjectsMap(bObject_Index).wpCurrentDescription = aCommands(bScanIndex).wpNewObjectDescription
end if
end if
bExaminedValue = aCommands(bScanIndex).bNewLocationNumber
if bExaminedValue then
if aMap(bPlayer_Col, bPlayer_Row).wpRoomDescription = aCommands(bScanIndex).wpNewLocationDescription then
bAlreadyChanged = TRUE
else
aMap(bPlayer_Col, bPlayer_Row).bRoomNumber = bExaminedValue
aMap(bPlayer_Col, bPlayer_Row).wpRoomDescription = aCommands(bScanIndex).wpNewLocationDescription
aMap(bPlayer_Col, bPlayer_Row).bRoomDirections = aCommands(bScanIndex).bNewDirections OR (aMap(bPlayer_Col, bPlayer_Row).bRoomDirections AND %01111111)
bScoreDelta = 5
bDrawMap_ForceRedraw = FALSE
call loadAndUpdateCurrentRoom()
end if
end if
if NOT bAlreadyChanged then
wpPostPromptMessage = aCommands(bScanIndex).wpMessage
if bScoreDelta = 0 then
VOICE 1 OFF ADSR 0, 0, 9, 9 WAVE TRI TONE wSoundTone ON OFF
end if
end if
exit sub
next bScanIndex
if bAction_Petscii = 71 then '"G"ive
call moveObject(bObject_Index, OBJ_REMOVED, OBJ_REMOVED)
call strngPrnt(SHRT_STRNG, @fixed_str_you_give_the, 32, 0, %11000000)
call strngPrnt(SHRT_STRNG, aObjects(bObject_Index).wpName, 0, 0, %11000000)
call strngPrnt(SHRT_STRNG, @fixed_str_to_the, 0, 0, %11000000)
call strngPrnt(LNG_STRNG, wpRoom_Creature, 0, 0, %01000000) 'strngPrnt will end at the first SPACE, not the end of the string!
VOICE 1 WAVE TRI TONE 680 ADSR 0, 8, 1, 12 ON OFF
end if
end sub
sub prntSingleChar(bChar as BYTE) STATIC
asm
LDA {bChar}
JSR $FFD2
end asm
if (bCursorColumn = 0) OR (bCursorColumn = 40) then bLinesScrolled = bLinesScrolled + 1
if bLinesScrolled = 14 then 'number of lines: 15. 13 scrolled lines + the first one + the one for "(press a key)"
textat 0, 24, "(press a key)" 'can't use strngPrnt recursively! :-(
call waitForKey()
memset $07C0, 13, 32 'clear the "(press a key)" line (13 = length of the textat string)
bLinesScrolled = 0
end if
end sub
sub shuffleRandomList() STATIC
For bScanIndex = 1 to 84 'the first and last few cards are left alone
do
bAccumulator = myRandom(83, 127) + 1 '"recycled" as random selector
loop while bAccumulator = bScanIndex
swap aRandomList(bScanIndex), aRandomList(bAccumulator)
next bScanIndex
end sub
sub eraseCharacters() STATIC
call prntSingleChar(32) 'prints a space to erase the cursor, in case it's visible
do
call prntSingleChar(20) 'erase a character
loop until bCursorColumn = aCursorPreviousColumnPos(bInputPhase)
end sub
Dim bDrawMap_Col as BYTE FAST
Dim bDrawMap_Row as BYTE FAST
Dim bDrawMap_Row_Minus_One as BYTE FAST
Dim bDrawMap_Row_Plus_One as BYTE FAST
Dim bDrawMap_Col_Minus_One as BYTE FAST
Dim bDrawMap_Col_Plus_One as BYTE FAST
Dim bDrawMap_PreviousRowIndex as BYTE FAST
sub drawMap() STATIC
Dim bDrawMap_Row_Player as BYTE FAST
Dim bDrawMap_Col_Player as BYTE FAST
Dim bDrawMap_PlayerRowOffset as BYTE FAST
Dim bDrawMap_CurrDirections as BYTE FAST
'handle N W E S
bDrawMap_CurrDirections = bRoom_CurrDirections
if (bDrawMap_CurrDirections AND %10000000) then bDrawMap_CurrDirections = bPlayer_LastOppositeDirection
poke $D842, 11 'dark grey in the "N" position
if (bDrawMap_CurrDirections AND DIR_NORTH) then poke $D842, 1 'change it to white
poke $D869, 11 'dark grey in the "W" position
if (bDrawMap_CurrDirections AND DIR_WEST) then poke $D869, 1 'change it to white
poke $D86B, 11 'dark grey in the "E" position
if (bDrawMap_CurrDirections AND DIR_EAST) then poke $D86B, 1 'change it to white
poke $D892, 11 'dark grey in the "S" position
if (bDrawMap_CurrDirections AND DIR_SOUTH) then poke $D892, 1 'change it to white
'no Live Map if the Player is not carrying it!
if aObjectsMap(OBJECT_LIVE_MAP).bCol <> OBJ_CARRIED then exit sub
'set the Map "camera"
bRowIndex = bPlayer_Row
if bRowIndex then bRowIndex = bRowIndex - 1
if bRowIndex > 6 then bRowIndex = 6
bDrawMap_Row_Player = shl(bPlayer_Row, 1) + 1
if bPlayer_Row then
bDrawMap_PlayerRowOffset = shl(bPlayer_Row - 1, 1) 'the distance between bPlayerRow and Row 1, times 2)
if bDrawMap_PlayerRowOffset > 12 then bDrawMap_PlayerRowOffset = 12
bDrawMap_Row_Player = bDrawMap_Row_Player - bDrawMap_PlayerRowOffset
end if
bDrawMap_Col_Player = shl(bPlayer_Col, 1) + 3 '+ 1 + 2 ?
if (bRowIndex <> bDrawMap_PreviousRowIndex) OR (bDrawMap_ForceRedraw) then
'**************DRAW WHOLE MAP**************************************************
call drawMap_clear()
bDrawMap_PreviousRowIndex = bRowIndex
for bDrawMap_Row = 1 to 7 step 2
bDrawMap_Row_Minus_One = bDrawMap_Row - 1
bDrawMap_Row_Plus_One = bDrawMap_Row + 1
bColIndex = 0
for bDrawMap_Col = 3 to 19 step 2
bDrawMap_Col_Minus_One = bDrawMap_Col - 1
bDrawMap_Col_Plus_One = bDrawMap_Col + 1
call drawMap_drawRoom()
bColIndex = bColIndex + 1
next bDrawMap_Col
bRowIndex = bRowIndex + 1
next bDrawMap_Row
bDrawMap_ForceRedraw = FALSE
else
'**************DRAW ONLY THE PLAYER ROOM***************************************
charat bPlayer_Map_PreviousCol, bPlayer_Map_PreviousRow, _
aMap(bPlayer_PreviousCol, bPlayer_PreviousRow).bCharToDraw, _
aMap(bPlayer_PreviousCol, bPlayer_PreviousRow).bCharColor
bDrawMap_Row_Minus_One = bDrawMap_Row_Player - 1
bDrawMap_Row_Plus_One = bDrawMap_Row_Player + 1
bDrawMap_Col_Minus_One = bDrawMap_Col_Player - 1
bDrawMap_Col_Plus_One = bDrawMap_Col_Player + 1
bRowIndex = bPlayer_Row
bColIndex = bPlayer_Col
bDrawMap_Col = bDrawMap_Col_Player
bDrawMap_Row = bDrawMap_Row_Player
charat bDrawMap_Col_Player, bDrawMap_Row_Minus_One, $20 'space
charat bDrawMap_Col_Minus_One, bDrawMap_Row_Player, $20 'space
charat bDrawMap_Col_Plus_One, bDrawMap_Row_Player, $20 'space
charat bDrawMap_Col_Player, bDrawMap_Row_Plus_One, $20 'space
call drawMap_drawRoom()
end if
'**************PLOT PLAYER ASTERISK (AND CACHE THE PLAYER INFO)************
charat bDrawMap_Col_Player, bDrawMap_Row_Player, $AA, 1 'reversed asterisk, white
bPlayer_Map_PreviousCol = bDrawMap_Col_Player
bPlayer_Map_PreviousRow = bDrawMap_Row_Player
bPlayer_PreviousCol = bPlayer_Col
bPlayer_PreviousRow = bPlayer_Row
'***********************DRAW BLOCKED FRAME**********************************
if (bRoom_CurrDirections AND %10000000) then
bDrawMap_Row_Minus_One = bDrawMap_Row_Player - 1
bDrawMap_Row_Plus_One = bDrawMap_Row_Player + 1
bDrawMap_Col_Minus_One = bDrawMap_Col_Player - 1
bDrawMap_Col_Plus_One = bDrawMap_Col_Player + 1
charat bDrawMap_Col_Minus_One, bDrawMap_Row_Minus_One, $A3
if (bPlayer_LastOppositeDirection AND DIR_NORTH) then
else
charat bDrawMap_Col_Player, bDrawMap_Row_Minus_One, $A3
end if
charat bDrawMap_Col_Plus_One, bDrawMap_Row_Minus_One, $A3
if (bPlayer_LastOppositeDirection AND DIR_WEST) then
else
charat bDrawMap_Col_Minus_One, bDrawMap_Row_Player, $A3
end if
if (bPlayer_LastOppositeDirection AND DIR_EAST) then
else
charat bDrawMap_Col_Plus_One, bDrawMap_Row_Player, $A3
end if
charat bDrawMap_Col_Minus_One, bDrawMap_Row_Plus_One, $A3
if (bPlayer_LastOppositeDirection AND DIR_SOUTH) then
else
charat bDrawMap_Col_Player, bDrawMap_Row_Plus_One, $A3
end if
charat bDrawMap_Col_Plus_One, bDrawMap_Row_Plus_One, $A3
bDrawMap_ForceRedraw = TRUE 'so that the Map gets redrawn when the Player moves away from the blocked room
end if
end sub
sub drawMap_drawRoom() STATIC
if aMap(bColIndex, bRowIndex).bRoomNumber = 255 then 'if this room is "new"...
charat bDrawMap_Col, bDrawMap_Row, $3F, 11 '"?", dark grey
else
bGenericCounter = aMap(bColIndex, bRowIndex).bRoomDirections 'recycled
if (bGenericCounter AND %10000000) then
charat bDrawMap_Col, bDrawMap_Row, aRooms(aMap(bColIndex, bRowIndex).bRoomNumber).bRoomLetter, 2 ' red
else
charat (bDrawMap_Col_Minus_One), (bDrawMap_Row_Minus_One), $69
if (bGenericCounter AND DIR_NORTH) then
else
charat (bDrawMap_Col), (bDrawMap_Row_Minus_One), $5F
end if
charat (bDrawMap_Col_Plus_One), (bDrawMap_Row_Minus_One), $69
if (bGenericCounter AND DIR_WEST) then
else
charat (bDrawMap_Col_Minus_One), (bDrawMap_Row), $5F
end if
charat bDrawMap_Col, bDrawMap_Row, aMap(bColIndex, bRowIndex).bCharToDraw, aMap(bColIndex, bRowIndex).bCharColor
if (bGenericCounter AND DIR_EAST ) then
else
charat (bDrawMap_Col_Plus_One), (bDrawMap_Row), $5F
end if
charat (bDrawMap_Col_Minus_One), (bDrawMap_Row_Plus_One), $69
if (bGenericCounter AND DIR_SOUTH) then
else
charat (bDrawMap_Col), (bDrawMap_Row_Plus_One), $5F
end if
charat (bDrawMap_Col_Plus_One), (bDrawMap_Row_Plus_One), $69
end if
end if
end sub
sub drawMap_clear() STATIC
memset $0402, 19, 32
memset $042A, 19, 32
memset $0452, 19, 32
memset $047A, 19, 32
memset $04A2, 19, 32
memset $04CA, 19, 32
memset $04F2, 19, 32
memset $051A, 19, 32
memset $0542, 19, 32
bDrawMap_ForceRedraw = TRUE 'always force a Map redraw
end sub
sub moveObject(bObjectNumRequested as BYTE, bMoveTo_Col as BYTE, bMoveTo_Row as BYTE) STATIC
Dim bObjectReplacementIndex as BYTE FAST
'if the player is about to LOSE an object...
if aObjectsMap(bObjectNumRequested).bCol = OBJ_CARRIED then
bPlayer_InventoryCount = bPlayer_InventoryCount - 1
end if
charat 35, 6, ( $30 + bPlayer_InventoryCount), 7 'yellow
aObjectsMap(bObjectNumRequested).bCol = bMoveTo_Col
aObjectsMap(bObjectNumRequested).bRow = bMoveTo_Row
'if the requested Object is not to be placed where the Player is, it's not a Drop action, so a replacement for the player Map cell must be found
if (bMoveTo_Col <> bPlayer_Col) OR (bMoveTo_Row <> bPlayer_Row) then
if bRoom_CurrNumber <> ROOM_REPOSITORY then 'don't touch the Repository map position!
aMap(bPlayer_Col, bPlayer_Row).bCharToDraw = 32
for bObjectReplacementIndex = 0 to 25 'find a possible replacement for the Map
if aObjectsMap(bObjectReplacementIndex).bCol = bPlayer_Col and aObjectsMap(bObjectReplacementIndex).bRow = bPlayer_Row then
exit for
end if
next bObjectReplacementIndex
if (bObjectReplacementIndex < 26) then
aMap(bPlayer_Col, bPlayer_Row).bCharToDraw = 65 + bObjectReplacementIndex
aMap(bPlayer_Col, bPlayer_Row).bCharColor = 13 'light green
if aObjectsMap(bObjectReplacementIndex).bCurrentKind = OBJECTKIND_TREASURE then '"$"
aMap(bPlayer_Col, bPlayer_Row).bCharColor = 7 'yellow
end if
end if
end if
end if
'if the requested Object is to be placed here on the Map, then do it
if bMoveTo_Col <= MAP_XMAX then
'don't touch the Map if the Object requested moves in the Repository! But do give the treasure points...
if aMap(bMoveTo_Col, bMoveTo_Row).bRoomNumber = ROOM_REPOSITORY then
if aObjectsMap(bObjectNumRequested).bCurrentKind = OBJECTKIND_TREASURE then bScoreDelta = 5
exit sub
end if
aMap(bMoveTo_Col, bMoveTo_Row).bCharToDraw = 65 + bObjectNumRequested
aMap(bMoveTo_Col, bMoveTo_Row).bCharColor = 13 'light green
if aObjectsMap(bObjectNumRequested).bCurrentKind = OBJECTKIND_TREASURE then '"$"
aMap(bMoveTo_Col, bMoveTo_Row).bCharColor = 7 'yellow
end if
end if
end sub
sub waitForKey() STATIC
poke 198, 0 : wait 198, 1
end sub
sub updateScore() STATIC
dim bScoreColour as BYTE FAST
bPlayer_Score = bPlayer_Score + bScoreDelta
bGenericCounter = 26 'recycled
if bPlayer_Score > 99 then bGenericCounter = bGenericCounter - 1
memset $0559, 3, 32 'erase (32=SPACE) previous score, in case it goes down from 100 to 95 or from 10 to 5
textat bGenericCounter, 8, bPlayer_Score
bScoreColour = 0 'Black
wSoundTone = 12288
if bScoreDelta > 127 then wSoundTone = 768 'if the Delta is negative, play a "negative" sound
VOICE 1 OFF WAVE PULSE TONE wSoundTone PULSE 2047 ADSR 0, 0, 15, 9 ON OFF
for bScanIndex = 1 to 12
memset $D959, 3, bScoreColour 'change the score colour
call makeApause(2)
bScoreColour = bScoreColour XOR 7 'change to yellow or back to black
next bScanIndex
bScoreDelta = 0
end sub
sub makeApause(bJiffiesToWait as BYTE) STATIC
Dim bJiffyTimer as BYTE @ $A2
asm
sei
lda #$00
sta $A2
cli
end asm
do : loop while bJiffyTimer <= bJiffiesToWait
end sub
sub synchromyEnding() STATIC
Dim bDescendingVolume as BYTE FAST : bDescendingVolume = 15
Dim bVolumeDescendToggle as BYTE FAST: bVolumeDescendToggle = 0
VOICE 1 ADSR 0, 0, 15, 0 WAVE PULSE PULSE 2048
VOICE 2 ADSR 0, 0, 15, 0 WAVE PULSE PULSE 2048
do
VOICE 1 TONE 1277 ON
VOICE 2 TONE 10220 ON
call makeApause(1)
VOICE 2 TONE 20440 ON
call makeApause(1)
VOICE 1 TONE 5110 ON
VOICE 2 TONE 10220 ON
call makeApause(1)
VOICE 2 TONE 20440 ON
call makeApause(1)
bVolumeDescendToggle = bVolumeDescendToggle XOR 255
if bVolumeDescendToggle then bDescendingVolume = bDescendingVolume - 1
VOLUME bDescendingVolume
asm
inc $d020
end asm
loop while bDescendingVolume < 128
sound clear
bBorder = 6 'blue
end sub
function myRandom as BYTE (bMax as BYTE, bMask as BYTE) STATIC
do
myRandom = RNDB() AND bMask
loop while myRandom > bMax
end function