From 73ab63cdafba43cd824b67833e002d31ed5098ad Mon Sep 17 00:00:00 2001 From: JJFlash Date: Sat, 24 Jun 2023 12:49:21 +0200 Subject: [PATCH] Upload files to 'FreeBasic_Data_Compiler' --- .../CHK_colossal_cave_VERBS.csv | 27 + .../prep_Colossal_Cave.bas | 524 ++++++++++++++++++ 2 files changed, 551 insertions(+) create mode 100644 FreeBasic_Data_Compiler/CHK_colossal_cave_VERBS.csv create mode 100644 FreeBasic_Data_Compiler/prep_Colossal_Cave.bas diff --git a/FreeBasic_Data_Compiler/CHK_colossal_cave_VERBS.csv b/FreeBasic_Data_Compiler/CHK_colossal_cave_VERBS.csv new file mode 100644 index 0000000..922399f --- /dev/null +++ b/FreeBasic_Data_Compiler/CHK_colossal_cave_VERBS.csv @@ -0,0 +1,27 @@ +DATA "ACTIONS","I","HERE'S MY VOCABULARY OF ACTIONS:" +DATA "BACK","I","SORRY, >I NO LONGER SEEM TO REMEMBER HOW IT WAS YOU GOT HERE." +DATA "CLOSE","T","I DON'T KNOW HOW TO OPEN OR CLOSE SUCH A THING." +DATA "DROP","T","YOU AREN'T CARRYING IT." +DATA "EAST","I","YOU CAN'T GO THAT WAY." +DATA "NORTH","I","YOU CAN'T GO THAT WAY." +DATA "SOUTH","I","YOU CAN'T GO THAT WAY." +DATA "WEST","I","YOU CAN'T GO THAT WAY." +DATA "FIGHT","I","THERE'S NOTHING HERE TO FIGHT." +DATA "GIVE","T","THERE'S NO ONE HERE." +DATA "HELP","I","" +DATA "INVENTORY","I","YOU'RE CARRYING:" +DATA "JUMP","I","YOU LANDED IN A PIT THEN CRAWLED A LONG WAY." +DATA "KICK","I","THERE'S NOTHING HERE TO KICK." +DATA "LOOK","I","" +rem DATA "","I","" +DATA "OPEN","T","IT CAN'T BE OPENED." +rem DATA "","I","" +DATA "QUIT","I","DO YOU REALLY WANT TO QUIT NOW?" +DATA "READ","T","NOTHING IS WRITTEN ON IT." +DATA "TAKE","T","YOU CAN'T CARRY ANYTHING MORE. YOU'LL HAVE TO DROP SOMETHING FIRST." +DATA "USE","T","IT IS NOT IMMEDIATELY USEFUL." +DATA "VERBOSE","I","FULL DESCRIPTIONS ONLY ON FIRST VISIT. SAY `LOOK` FOR FULL DESCRIPTIONS." +DATA "XPLORE","I","YOU HAVE CRAWLED AROUND IN SOME LITTLE HOLES..." +DATA "YES","I","I COULDN'T AGREE MORE." +DATA "ZZZ...","I","THAT WAS REFRESHING. EVEN THE KISSES OF THE DWARVES COULD NOT WAKE YOU." + diff --git a/FreeBasic_Data_Compiler/prep_Colossal_Cave.bas b/FreeBasic_Data_Compiler/prep_Colossal_Cave.bas new file mode 100644 index 0000000..81e1471 --- /dev/null +++ b/FreeBasic_Data_Compiler/prep_Colossal_Cave.bas @@ -0,0 +1,524 @@ +#include "CHK_colossal_cave_ROOMS.csv" +#include "CHK_colossal_cave_VERBS.csv" +#include "CHK_colossal_cave_OBJECTS.csv" +#include "CHK_colossal_cave_COMMANDS.csv" +#include "CHK_colossal_cave_GENERAL_HELP.csv" + +CONST XCB_DATA_START_MEM as USHORT = &H082B 'the XCB data will start from here! + +declare function findRoomNumber(sStringToSearch as STRING) as UBYTE +declare sub encodeFixedString(sLabel as STRING, sFixedStringToEncode as STRING) + +Dim iTotalScore as USHORT 'UBYTE ? + +type tStringArch + sArchivedString as STRING + uArchivedOffset as USHORT +end type + +function encodeString(byVal sStringToEncode as STRING) as USHORT + dim iLineCharPos_Start as INTEGER + dim iLineCharPos_End as INTEGER + dim iCharPosition as INTEGER + dim bByteCharacter as UBYTE + + Static aStringArchive(1 To 512) as tStringArch + Static iStringArchIndex as INTEGER + + Static iMemoryOffset as USHORT + Static iPreviousOffset as USHORT + + Dim L as INTEGER 'all-purpose for-next index + + + if sStringToEncode = "" then return 0 + + if iStringArchIndex then + For L = iStringArchIndex To 1 Step -1 + with aStringArchive(L) + if sStringToEncode = .sArchivedString then + print .sArchivedString ''''''''''''''''''''debug + return .uArchivedOffset + end if + end with + next L + else + iMemoryOffset = XCB_DATA_START_MEM + end if + + iStringArchIndex += 1 + with aStringArchive(iStringArchIndex) + .sArchivedString = sStringToEncode + .uArchivedOffset = iMemoryOffset + end with + + iPreviousOffset = iMemoryOffset + + if len(sStringToEncode) > 40 then + iLineCharPos_Start = 1 + iLineCharPos_End = 40 + do + iCharPosition = iLineCharPos_Start + do + iCharPosition = instr(iCharPosition, sStringToEncode, Any "*@>#$|") + if iCharPosition > 0 and iCharPosition <= iLineCharPos_End then + if mid$(sStringToEncode, iCharPosition, 1) = "|" then + iLineCharPos_End = iCharPosition + exit do + else + iLineCharPos_End += 1 + iCharPosition += 1 + end if + else + exit do + end if + loop + + if iLineCharPos_End < len(sStringToEncode) then + + if (mid$(sStringToEncode, iLineCharPos_End + 1, 1) = " ") OR _ + (mid$(sStringToEncode, iLineCharPos_End + 1, 1) = "|") then 'if the next 40-char line starts with a space or forced CR... + iLineCharPos_End += 1 + mid$(sStringToEncode, iLineCharPos_End, 1) = chr$(10) 'this space/CR will get eliminated during the encoding + elseif mid$(sStringToEncode, iLineCharPos_End, 1) = "|" then 'if there's a forced Carriage Return here... + mid$(sStringToEncode, iLineCharPos_End, 1) = chr$(13) + else + iLineCharPos_End = InStrRev(sStringToEncode, " ", iLineCharPos_End) + mid$(sStringToEncode, iLineCharPos_End, 1) = chr$(13) + end if + + end if + + iLineCharPos_Start = iLineCharPos_End + 1 + iLineCharPos_End +=40 '39 + 1 to skip the space! + loop until iLineCharPos_End > len(sStringToEncode) + end if + + if right$(sStringToEncode, 1) = "." then + bByteCharacter = asc(right$(sStringToEncode, 2)) + if (bByteCharacter AND &B01000000) AND (bByteCharacter <> 96) then ' if the next-to-last character is a letter and NOT a back-quote... + sStringToEncode = left$(sStringToEncode, len(sStringToEncode) - 1) + end if + end if + + print #1, "DATA AS BYTE"; + + for L = 1 to len(sStringToEncode) + bByteCharacter = asc(sStringToEncode, L) + select case bByteCharacter + case 10 'skip "Line Feeds" (actually removed spaces from above) + Continue For + case 96 '"fake" quotes become _real_ quotes + bByteCharacter = 34 + end select + bByteCharacter -= 32 '"encodes" the character + if L < len(sStringToEncode) then + select case asc(sStringToEncode, L + 1) + case 32 + if L < (len(sStringToEncode) - 1) then + bByteCharacter OR= &B01000000 'bits 7-6 = 01 -> indicates SPACE + L += 1 'skip next space + end if + case 13 + bByteCharacter OR= &B10000000 'bits 7-6 = 10 -> indicates CARRIAGE RETURN + if L < (len(sStringToEncode) - 1) then L += 1 'skip next CR + end select + else + bByteCharacter OR= &B11000000 'bits 7-6 = 11 -> indicates END OF STRING + end if + + print #1, " $" ; hex(bByteCharacter, 2) ; iif(L < len (sStringToEncode), ",", "") ; + iMemoryOffset += 1 + next L + + print #1, "" + encodeString = iPreviousOffset +end function + +type tRooms + sName as STRING + 'Not interested in the short name, on the XCB side - I'll use the first letter though, for the blocked rooms on the Map + + sDirections as STRING + bDirections as UBYTE + wpBlockingReason as USHORT + + sDescription as STRING + wpDescription as USHORT + + bAlreadySolved as BOOLEAN +end type +Const ROOM_INITIAL_COUNT as INTEGER = 83 +Dim SHARED iRooms_number as INTEGER : iRooms_number = ROOM_INITIAL_COUNT +Dim SHARED aRooms(1 to 128) as tRooms + +for nRoom as INTEGER = 1 to ROOM_INITIAL_COUNT + with aRooms(nRoom) + read .sName, .sDirections, .sDescription + end with +next nRoom + +type tVerbs + sName as STRING + wpName as USHORT + + sTransitive as STRING + 'No equivalent in XCB for sTransitive, I'll use the highest bit of wpName for that! + + sDefaultMessage as STRING + wpDefaultMessage as USHORT + + bCommandStartIndex as UBYTE +end Type +Dim aVerbs(1 to 26) as tVerbs + +dim nArrayPos as INTEGER +dim sTempString as STRING +do + read sTempString + nArrayPos = asc(sTempString) - 64 + with aVerbs(nArrayPos) + .sName = sTempString + read .sTransitive, .sDefaultMessage + .bCommandStartIndex = 255 'initialised to "-1" + end with +loop until left$(sTempString, 1) = "Z" + +type tObjects + sName as STRING + wpName as USHORT + + sKind as STRING + bObjectFlags as UBYTE + + sDescription as STRING + wpDescription as USHORT +end Type +Dim aObjects(1 to 26) as tObjects + +do + read sTempString + nArrayPos = asc(sTempString) - 64 + with aObjects(nArrayPos) + .sName = sTempString + read .sKind, .sDescription + 'SCORE************************************************************************************ + if .sKind = "$" then + iTotalScore += 5 + end if + end with +loop until left$(sTempString, 1) = "Z" + +type tCommands + sAction as STRING + bActionNumber as UBYTE + + sObject as STRING + bObjectNumber as UBYTE + + sLocation as STRING + bLocationNumber as UBYTE + + sTransformedObject as STRING + bNewObjectLocationNumber as UBYTE + wpNewObjectDescription as USHORT + + sTransformedLocation as STRING + bNewLocationNumber as UBYTE + wpNewLocationDescription as USHORT + + sMessage as STRING + wpMessage as USHORT + bNewDirections as UBYTE +end type +Dim iCommands_Number as INTEGER +Dim aCommands(1 to 128) as tCommands + +do + iCommands_Number += 1 + with aCommands(iCommands_Number) + read .sAction, .sObject, .sLocation, .sTransformedObject, .sTransformedLocation, .sMessage + end with +loop until aCommands(iCommands_Number).sAction = "WEST" AND aCommands(iCommands_Number).sLocation = "DED" + +Dim iHelpStringsNum as INTEGER +Dim aHelpStrings(1 to 4) as tStringArch 're-using this type for the general Help strings + +do + iHelpStringsNum += 1 + read aHelpStrings(iHelpStringsNum).sArchivedString +loop until instr(aHelpStrings(iHelpStringsNum).sArchivedString, "FINE") + +'-------------------------------------S-T-R-I-N-G-S----------------------------------------------------------------------- +Dim K as INTEGER +Dim iFullStopPos as INTEGER + +open "..\data_strings.bas" for output as #1 + + print #1, "'***********VERBS***********" + for K = 1 to 26 + with aVerbs(K) + if .sName <> "" then + print #1, "' """ ; .sName ; """, """ ; .sTransitive ; """, """ ; .sDefaultMessage ; """" + + .wpName = encodeString(.sName) + if .sTransitive = "T" then .wpName OR= &B1000000000000000 + + .wpDefaultMessage = encodeString(.sDefaultMessage) + end if + end with + next K + print #1, "" + + print #1, "'***********OBJECTS***********" + for K = 1 to 26 + with aObjects(K) + if .sName <> "" then + print #1, "' """ ; .sName ; """, """ ; .sKind ; """, """ ; .sDescription ; """" + + .wpName = encodeString(.sName) + .bObjectFlags = asc(.sKind) + .wpDescription = encodeString(.sDescription) + + end if + end with + next K + print #1, "" + + print #1, "'***********ROOMS***********" + for K = 1 to iRooms_number + with aRooms(K) + print #1, "' """ ;.sName ; """, """ ; .sDirections ; """, """ ; .sDescription ; """" + + sTempString = .sDescription + if instr(sTempString, "*") = 0 and len(.sDirections) <= 4 then 'always full descriptions in blocked rooms + iFullStopPos = instr(sTempString, ".") + if iFullStopPos < len(sTempString) then + sTempString = left$(sTempString, iFullStopPos - 1) & "*" & mid$(sTempString, iFullStopPos) + end if + end if + .wpDescription = encodeString(sTempString) + + if len(.sDirections) > 4 then + .wpBlockingReason = encodeString(.sDirections) + .bDirections = 128 '%10000000 - BLOCKED with no open directions + else + .wpBlockingReason = 0 + .bDirections = IIf(instr(.sDirections, "N"), 8, 0) + .bDirections OR= IIf(instr(.sDirections, "E"), 4, 0) + .bDirections OR= IIf(instr(.sDirections, "S"), 2, 0) + .bDirections OR= IIf(instr(.sDirections, "W"), 1, 0) + end if + + end with + + next K + print #1, "" + + print #1, "'***********COMMANDS***********" + for K = 1 to iCommands_Number + with aCommands(K) + print #1, "' """ ; .sAction ; """, "; + print #1, """" ; .sObject ; """, "; + print #1, """" ; .sLocation ; """, "; + print #1, """" ; .sTransformedObject ; """, "; + print #1, """" ; .sTransformedLocation ; """, "; + print #1, """" ; .sMessage ; """" + + .bActionNumber = asc(.sAction) + .bObjectNumber = asc(.sObject) + .bLocationNumber = findRoomNumber(.sLocation) + + if aVerbs(.bActionNumber - 64).bCommandStartIndex = 255 then + aVerbs(.bActionNumber - 64).bCommandStartIndex = K - 1 + end if + + sTempString = .sTransformedObject + if sTempString <> "" then + select case left$(sTempString, 3) + case "DRO" + .bNewObjectLocationNumber = 252 + sTempString = "" + case "TAK" + .bNewObjectLocationNumber = 0 'previously 253 + sTempString = "" + case "RMV" + .bNewObjectLocationNumber = 254 + sTempString = "" + case "RND" + .bNewObjectLocationNumber = 255 + sTempString = mid$(sTempString, 6) + case else + if mid$(sTempString, 4, 1) = ":" then + .bNewObjectLocationNumber = findRoomNumber(left$(sTempString, 3)) + sTempString = mid$(sTempString, 6) + end if + end select + end if + if sTempString <> "" then .wpNewObjectDescription = encodeString(sTempString) + + if .sTransformedLocation <> "" then + .bNewLocationNumber = findRoomNumber(left$(.sTransformedLocation, 3)) + if .bNewLocationNumber <> 254 then 'if the new room is not "WIN"... + sTempString = mid$(.sTransformedLocation, 6) + if instr(sTempString, "*") = 0 then + iFullStopPos = instr(sTempString, ".") + if iFullStopPos < len(sTempString) then + sTempString = left$(sTempString, iFullStopPos - 1) & "*" & mid$(sTempString, iFullStopPos) + end if + end if + .wpNewLocationDescription = encodeString(sTempString) + .bNewDirections = IIf(instr(.sTransformedLocation, "NORTH"), 8, 0) + .bNewDirections OR= IIf(instr(.sTransformedLocation, "EAST"), 4, 0) + .bNewDirections OR= IIf(instr(.sTransformedLocation, "SOUTH"), 2, 0) + .bNewDirections OR= IIf(instr(.sTransformedLocation, "WEST"), 1, 0) + if .bNewDirections = 0 then .bNewDirections = 15 'set to all directions... + end if + + 'SCORE************************************************************************************ + if aRooms(.bLocationNumber).bAlreadySolved = False then + aRooms(.bLocationNumber).bAlreadySolved = True + iTotalScore += 5 + 'if the Object specified in the Command is a Treasure, *OR* the Object KIND specified is "Treasure"... + if iif(asc(.sObject) > 64, aObjects(asc(.sObject) - 64).sKind = "$", .sObject = "$") then + if .bNewObjectLocationNumber = 254 then 'if the Object used to solve gets "RMV"d after... + iTotalScore -= 5 + end if + end if + end if + + + end if + + .wpMessage = encodeString(.sMessage) + + end with + next K + print #1, "" + + print #1, "'***********GENERAL HELP***********" + for K = 1 to iHelpStringsNum + with aHelpStrings(K) + .uArchivedOffset = encodeString(.sArchivedString) + end with + next K + +close #1 + +'--------------------------------------D A T A---D-A-T-A---D-A-T-A------------------------------------------------------ +open "..\data_verbs.bas" for output as #1 + For K = 1 to 26 + with aVerbs(K) + print #1, "' """ ; .sName ; """, """ ; .sTransitive ; """, """ ; .sDefaultMessage ; """" + print #1, "DATA AS WORD $" ; hex(.wpName, 4) ; ", $" ; hex(.wpDefaultMessage, 4) + print #1, "DATA AS BYTE $" ; hex(.bCommandStartIndex, 2) + end with + next K +close #1 + +open "..\data_objects.bas" for output as #1 + For K = 1 to 26 + with aObjects(K) + print #1, "' """ ; .sName ; """, """ ; .sKind ; """, """ ; .sDescription ; """" + print #1, "DATA AS WORD $" ; hex(.wpName, 4) + print #1, "DATA AS BYTE $" ; hex(.bObjectFlags, 2) + print #1, "DATA AS WORD $" ; hex(.wpDescription, 4) + end with + next K +close #1 + +open "..\data_rooms.bas" for output as #1 + For K = 1 to ROOM_INITIAL_COUNT 'only the "starting" rooms! + with aRooms(K) + print #1, "' """ ; .sName ; """, """ ; .sDirections ; """, """ ; .sDescription ; """" + print #1, "DATA AS BYTE $" ; hex(asc(.sName) + 128, 2) ; ", $" ; hex(.bDirections, 2) + print #1, "DATA AS WORD $" ; hex(.wpBlockingReason, 4) ; ", $" ; hex(.wpDescription, 4) + end with + next K +close #1 + +open "..\data_commands.bas" for output as #1 + For K = 1 to iCommands_Number + with aCommands(K) + print #1, "' """ ; .sAction ; """, "; + print #1, """" ; .sObject ; """, "; + print #1, """" ; .sLocation ; """, "; + print #1, """" ; .sTransformedObject ; """, "; + print #1, """" ; .sTransformedLocation ; """, "; + print #1, """" ; .sMessage ; """" + + print #1, "DATA AS BYTE $" ; hex(.bActionNumber, 2) ; ", $" ; hex(.bObjectNumber, 2) ; ", $" ; hex(.bLocationNumber, 2) + print #1, "DATA AS BYTE $" ; hex(.bNewObjectLocationNumber, 2) + print #1, "DATA AS WORD $" ; hex(.wpNewObjectDescription, 4) + print #1, "DATA AS BYTE $" ; hex(.bNewLocationNumber, 2) + print #1, "DATA AS WORD $" ; hex(.wpNewLocationDescription, 4) + print #1, "DATA AS WORD $" ; hex(.wpMessage, 4) + print #1, "DATA AS BYTE $" ; hex(.bNewDirections, 2) + end with + next K +close #1 + +open "..\data_general_help.bas" for output as #1 + For K = 1 to iHelpStringsNum + with aHelpStrings(K) + print #1, "' """ ; .sArchivedString ; """" + print #1, "DATA AS WORD $" ; hex(.uArchivedOffset, 4) + end with + next K +close #1 + +open "..\fixed_strings.bas" for output as #1 + encodeFixedString("gamename", "ADVENT 101") + encodeFixedString("credits", "- >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") + encodeFixedString("start_game", "SAY `HELP` FOR GENERAL & SPECIFIC HINTS. PRESS A KEY TO START YOUR CAVING ADVENTURE!") + encodeFixedString("i_see_no", "I SEE NO ") + encodeFixedString("here", " HERE.") + encodeFixedString("it_is_now_closed", "IT IS NOW CLOSED.") + encodeFixedString("it_was_already_closed", "IT WAS ALREADY CLOSED.") + encodeFixedString("dropped", "DROPPED.") + encodeFixedString("you_give_the", "YOU GIVE THE ") + encodeFixedString("to_the", " TO THE ") + encodeFixedString("headlamp", "LAMP") + encodeFixedString("as_you_jumped_you_dropped_the", "AS YOU JUMPED, UNFORTUNATELY YOU DROPPED THE ") + encodeFixedString("it_is_now_opened", "IT IS NOW OPENED.") + encodeFixedString("it_was_already_opened", "IT WAS ALREADY OPENED.") + encodeFixedString("youre_already_carrying_it", "YOU'RE ALREADY CARRYING IT.") + encodeFixedString("taken", "TAKEN.") + encodeFixedString("treasure_taken", "$TAKEN!") + encodeFixedString("always_full_descriptions_on", "ALWAYS FULL DESCRIPTIONS FROM NOW ON.") + encodeFixedString("that_was_a_rhetorical_question", "THAT WAS A RHETORICAL QUESTION.") + encodeFixedString("your_score", "YOU SCORED A TOTAL OF ") + encodeFixedString("maximum_score", " POINTS, OUT|OF A POSSIBLE MAXIMUM OF " & str$(iTotalScore) & " POINTS.") + encodeFixedString("you_win", "YOU WIN!!") + encodeFixedString("conquered", "YOU'VE SOLVED IT ALL!|HAIL THE CONQUERING ADVENTURER!") + encodeFixedString("try_again", "PRESS ANY KEY TO TRY AGAIN.") +close #1 + +print +print "done!" +print " Commands: " ; iCommands_Number +print " Help lines: " ; iHelpStringsNum +print +print " Total SCORE: " ; iTotalScore +sleep + +function findRoomNumber(sStringToSearch as STRING) as UBYTE + if sStringToSearch = " " then return 0 + if sStringToSearch = "WIN" then return 254 + For S as UBYTE = 1 to iRooms_number + if aRooms(S).sName = sStringToSearch then return (S - 1) + next S + iRooms_number += 1 + aRooms(iRooms_number).sName = sStringToSearch + findRoomNumber = (iRooms_number - 1) +end function + +sub encodeFixedString(sLabel as STRING, sFixedStringToEncode as STRING) + print #1, "' """ ; sFixedStringToEncode ; """" + print #1, "fixed_str_" ; sLabel ; ":" + encodeString (sFixedStringToEncode) +end sub