Collection of Basic Computer Games

[eoredson]

Hi,

Find attached the collection of Basic Computer Games written by David H. Ahl

Erik.



Which can also be found at:
http://www.vintage-basic.net/games.html

btw: I have rewritten SuperTrek into Strek9x for QB64.
  Which is compatible with QB11, QB45, and QB71.

Version history:

Code: (Select All)

Version history of Strek9x 09/01/2024 PD for QB64.
  New version v1.0a
    Includes Romulans and a Vulcan starbase.
  New version v2.0a
    And function softkeys and row 24 statusline.
    Now prompts for Captains name.
  New version v3.0a
    Adds several new commands.
      Including BUY/PUR/RND/TOP.
  New version v4.0a includes
     All text prints lowercased.
     Adds color statements to all prints.
     Adds Executive command.
     Adds Top Ten Captain datafile.
  New version v5.0a includes
     Adds Save/Load current game.
     Moves instructions to textfile.
     Adds Ferengi Starbase.
     Adds debris to destroyed ship.

Now 1370 lines.

Code: (Select All)

Additional commands for QB64:
   FIX  (Repair All Devcies)
      Attempts to repair all damaged devices. Costs 100 energy units.
      This failsafe function is also called when all devices damaged.
   INC  (Increment Device)
      Prompts to increase status of any device.
      Costs 10 energy units per device.
   PHO  (Star Destroyer Torpedo)
      Fires a star destoyer torpedo.
      This torpedo also obliterates stars.
      If all stars in a quadrant are destroyed then the Captain
      will be found unfit for duty and the game will quit.
   GEN  (Genesis Device)
      Initiates the star creator Gensis Device.
      This creates a star. When the star is formed all enemies in the quadrant
      will be vaporized and the starship hit for 50 shield points.
   LOC  (Starbase Locate)
      Lists all Starbase coordinates in the galaxy.
   DIS  (Display Klingons/Romulans)
      Lists all klingon and romulan coordinates in the Galaxy.
   SEA  (Searchs Galaxy)
      Prompts for Quadrant values to search in Galaxy.
   RAT  (Display Current Rating)
      Displays the Captains current effeceincy rating.
   BUY  (Buy Star Photonic Device)
      Purchases a star photonic destroyer device at a vulcan starbase.
      Costs 100 credits.
   PUR  (Purchase Energy)
      Purchases 100 energy points at a vulcan starbase.
      Costs 100 credits.
   RND  (Random Course)
      Moves the Enterprise in a random direction at a random warp factor.
   LST  (List Staff)
      Lists all 10 Enterprise staff crew.
   EXE  (Executive Command)
      Uses executive order to destroy ships in all nearby quadrants.
      Reduces ship energy by 1000 units.
   TOP  (Top 10 Report)
      Displays top 10 scores from most recent Captains.
   SAV  (Save Current Game)
      Prompts for and saves current game.
   LOA  (Load Game Number)
      Prompts for and loads a saved game.
   QUIT (Exits Current Game)
      Exits game and prompts to restart.
   INIT (Initializes Top 10)
      Deletes and restarts Top 10 datafile.
   SAVE/LOAD  (Save or Load a Game)
      Also allows <n> after command.

[bplus]

bcg i tried two games and 2 games failed
   
   

[eoredson]

Hey.. I didn't write any of this code. But from what I can tell you may have to manually rewrite these programs one by one for QB64.

They appear to be old line number oriented source from Basica.com in MS-DOS and have never been tested in QB.

Erik.

[eoredson]

Seriously:

In Amazing.bas when it prompted for dimensions you need to enter 2 values separated by a comma:

100 Input "WHAT ARE YOUR WIDTH AND LENGTH"; H, V

or else you get an array subscript error..

(otherwise change):
102 If H > 1 And V > 1 Then 110

In Checkers.bas there is a badly nested for loop which can be changed to:

Code: (Select All)

1340 X = R(3): Y = R(4)
1350 If S(X, Y) = -1 Then B = -2: For A = -2 To 2 Step 4: GoSub 1370: Next A: If R(0) <> -99 Then Print "TO"; R(3); R(4);: R(0) = -99: GoTo 1240
1360 If S(X, Y) = -2 Then For A = -2 To 2 Step 4: For B = -2 To 2 Step 4: GoSub 1370: Next B: Next A: If R(0) <> -99 Then Print "TO"; R(3); R(4);: R(0) = -99: GoTo 1240

[bplus]

I was curious how fast I could get Acey Ducey up and running. 40 minutes around 50 LOC. But when I went to save it, turns out I had tried this exercise once already:

Code: (Select All)

_Title "Acey Ducey" 'b+ 2021-03-03 see how long it takes to write game from scratch 12:15
' 1 hr to get it going + 2/3 to make it pretty,
' thing is there is no end to making pretty, I could add comma's to player's total for next beautification.
Randomize Timer
Cards$ = "23456789XJQKA" ' I guess Ace is highest
player& = 100 ' player
round& = 0 ' round
Do
    round& = round& + 1
    CPR 2, "Acey Ducey   Round #" + ts$(round&)
    card1& = Int(Rnd * 13) + 1 ' not exactly playing from a full deck here, could draw 5 aces in a row
    card2& = Int(Rnd * 13) + 1 ' ok it's like 13 cards shuffled before each draw
    cardWinLose& = Int(Rnd * 13) + 1
    CPR 5, "First Card: " + Mid$(Cards$, card1&, 1)
    CPR 6, "  2nd Card: " + Mid$(Cards$, card2&, 1)
    CPR 8, "Player you have: $" + ts$(player&)
    CPR 10, " Of that amount, please enter how much you would like to bet"
    Locate 11, 11
    Input " that the next card is = or between those two cards"; bet&
    If bet& > player& Then bet& = player&
    CPR 13, " Win | Lose Card: " + Mid$(Cards$, cardWinLose&, 1)
    If cardWinLose& > card1& And cardWinLose& > card2& Or cardWinLose& < card1& And cardWinLose& < card2& Then
        CPR 15, "Player Lost $" + ts$(bet&)
        player& = player& - bet&
    Else
        CPR 15, "Player Won $" + ts$(bet&)
        player& = player& + bet&
    End If
    CPR 20, "Zzz... press any"
    Sleep
    _KeyClear
    Cls
Loop Until player& <= 0
CPR 23, " Player you are bankrupt, good day!"

Sub CPR (Row, S$) 'Center Print Row
    Locate Row, (_Width - Len(S$)) / 2: Print S$
End Sub
Function ts$ (N As Long)
    ts$ = _Trim$(Str$(N))
End Function

And it had several nice features to save LOC, ie a Deck and shuffling is not need for 3 cards, neither are any subs or functions...

so another 43 minutes rewrite and down to 17 lines, still very readable:

Code: (Select All)

_Title "Acey Ducey 2024-07-21 version" ' b+ 2024-07-21
Randomize Timer
ranking$ = "23456789TJQKA" ' one letter or digit to designate card value
bank = 100
While bank
    r1 = Int(Rnd * 13) + 1: r2 = Int(Rnd * 13) + 1: r3 = Int(Rnd * 13) + 1
    If r1 < r2 Then low = r1: high = r2 Else low = r2: high = r1
    Print Mid$(ranking$, r1, 1); " "; Mid$(ranking$, r2, 1)
    Print "You have"; bank; "to bet."
    Input "Enter your bet "; bet
    If bet > bank Then bet = bank
    If bet = 0 Then bet = 1
    Print "Betting"; bet; Chr$(10); Mid$(ranking$, r3, 1)
    If r3 >= low And r3 <= high Then bank = bank + bet: Print "You won"; bet: Print
    If r3 < low Or r3 > high Then bank = bank - bet: Print "You lost"; bet: Print
Wend
Print "Game Over, no money left to bet."

[bplus]

Here's an Update for Change:

Code: (Select All)

_Title "Change Update" ' b+ 2024-07-21
Dim a&(1 To 10), s$(1 To 10)
a&(1) = 5000: a&(2) = 2000: a&(3) = 1000: a&(4) = 500: a&(5) = 100
a&(6) = 50: a&(7) = 25: a&(8) = 10: a&(9) = 5: a&(10) = 1
s$(1) = "$50 bills": s$(2) = "$20 bills": s$(3) = "$10 bills": s$(4) = "$5 bills": s$(5) = "$1 bills"
s$(6) = "half dollars": s$(7) = "quarters": s$(8) = "dimes": s$(9) = "nickels": s$(10) = "pennies"
restart:
Print: Input "Enter amount to collect up to 100.00 (0 to quit)"; collect
If collect <= 0 Or collect > 100 Then End
Input "Enter amount paid "; paid
change = paid - collect
If change < 0 Then Print "You did not pay enough.": GoTo restart
If change = 0 Then Print "Thank you come again.": GoTo restart
c& = change * 100
For i = 1 To 10
    amt& = Int(c& / a&(i)): TotChange = TotChange + amt& * a&(i)
    If amt& Then c& = c& - amt& * a&(i): Print amt&; " "; s$(i)
Next
GoTo restart

[bplus]

Here's an Update for Reverse:

Code: (Select All)

_Title "Reverse Update" 'b+ 2024-07-21 directions 7-22
' compare to Reverse here www.vintage-basic.net/games.html
' David Ahl's compilation of Basic Games and other stuff

'     Directions for Reverse Puzzle:

' Reverse goal is to get the given string of digits back in order from 1 to 9.
' Asking to reverse say 5 will swap first with 5th, 2nd with 4th and that leaves 3 unmoved.
' so   5 4 3 2 1 6 7 8 9 reverse 5
' gets 1 2 3 4 5 6 7 8 9 exactly what we are trying to achieve, you got it!
' reverse always starts on left and counts n to right, note: so reverse 1 does nothing.
'
' Another example from help in original code:
' 2 3 4 5 1 6 7 8 9
' reverse 4
' 5 4 3 2 1 6 7 8 9
' now just reverse 5
' 1 2 3 4 5 6 7 8 9 You got it!
'
' numbers printed on far left are just counting the number of times you use reverse.

Randomize Timer
Dim Shared c$
r$ = " 1 2 3 4 5 6 7 8 9"
c$ = r$
restart:
cnt = 0
fini% = Int(Rnd * 11) + 2
For i = 1 To fini%
    r% = Int(Rnd * 8) + 2
    c$ = reverse$(r%)
Next
Do
    Print cnt, c$
    Input "Enter how many to reverse (0 quits)"; n
    c$ = reverse$(n)
    If c$ = r$ Then Print cnt, c$; " You did it!": Print: Print: Exit Do Else cnt = cnt + 1
Loop
GoTo restart

Function reverse$ (n As Integer)
    If n = 0 Then End
    For i = 1 To 2 * n Step 2
        b$ = Mid$(c$, i, 2) + b$
    Next
    reverse$ = b$ + Mid$(c$, 2 * n + 1)
End Function

[bplus]

Sit back and relax while ReverseAI plays the Reverse Puzzle Game for you!

Code: (Select All)

_Title "Reverse Update with AI" 'b+ 2024-07-21 directions 7-22 with AI 7-22
' compare to Reverse here www.vintage-basic.net/games.html
' David Ahl's compilation of Basic Games and other stuff

'     Directions for Reverse Puzzle:

' Reverse goal is to get the given string of digits back in order from 1 to 9.
' Asking to reverse say 5 will swap first with 5th, 2nd with 4th and that leaves 3 unmoved.
' so   5 4 3 2 1 6 7 8 9 reverse 5
' gets 1 2 3 4 5 6 7 8 9 exactly what we are trying to achieve, you got it!
' reverse always starts on left and counts n to right, note: so reverse 1 does nothing.
'
' Another example from help in original code:
' 2 3 4 5 1 6 7 8 9
' reverse 4
' 5 4 3 2 1 6 7 8 9
' now just reverse 5
' 1 2 3 4 5 6 7 8 9 You got it!
'
' numbers printed on far left are just counting the number of times you use reverse.

Randomize Timer
Dim Shared c$
r$ = " 1 2 3 4 5 6 7 8 9"
c$ = r$
restart:
cnt = 0
fini% = Int(Rnd * 11) + 2
For i = 1 To fini%
    r% = Int(Rnd * 8) + 2
    c$ = reverse$(r%)
Next
Do
    Print cnt; " reverses", c$
    'Input "Enter how many to reverse (0 quits)"; n
    n = reverseAI%
    If n = 0 Then Print "Already done!": Exit Do
    Print "AI says reverse"; n
    c$ = reverse$(n)
    If c$ = r$ Then Print cnt, c$; " AI did it!": Print: Print: Exit Do Else cnt = cnt + 1
    _Delay 10
Loop
GoTo restart

Function reverse$ (n As Integer)
    For i = 1 To 2 * n Step 2
        b$ = Mid$(c$, i, 2) + b$
    Next
    reverse$ = b$ + Mid$(c$, 2 * n + 1)
End Function

Function reverseAI%
    ' from right to left find the first digit out of order
    Dim As Integer i, x, place
    For i = 9 To 2 Step -1
        x$ = Mid$(c$, i * 2, 1)
        If x$ <> _Trim$(Str$(i)) Then
            lookup$ = _Trim$(Str$(i))
            'Print "lookup$ "; lookup$
            Exit For
        End If
    Next
    place = InStr(c$, lookup$) / 2
    'Print "place"; place
    If place = 1 Then reverseAI% = Val(lookup$) Else reverseAI% = place
End Function

Slowed way down so humans might be able to follow moves AI makes.