From 87ff0ba948b4a664ef44ec82c018778d29344b9d Mon Sep 17 00:00:00 2001 From: JJFlash Date: Sat, 24 Jun 2023 12:43:02 +0200 Subject: [PATCH] Upload files to '' --- advent101.bas | 1308 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1308 insertions(+) create mode 100644 advent101.bas diff --git a/advent101.bas b/advent101.bas new file mode 100644 index 0000000..eb3c04d --- /dev/null +++ b/advent101.bas @@ -0,0 +1,1308 @@ +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" + call strngPrnt(SHRT_STRNG, aObjects(bObject_Index).wpName, 0, 0, %11000000) '"" + call strngPrnt(LNG_STRNG, @fixed_str_here, 0, 0, %11000000) '"here." - The 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) '"!" + 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