| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
Aloha from Maui guys.
Forum: General Discussion
Last Post: Cobalt
1 minute ago
» Replies: 15
» Views: 467
|
Curious if I am thinking ...
Forum: Help Me!
Last Post: bplus
1 hour ago
» Replies: 19
» Views: 194
|
Glow Bug
Forum: Programs
Last Post: SierraKen
3 hours ago
» Replies: 7
» Views: 107
|
ADPCM compression
Forum: Petr
Last Post: Petr
6 hours ago
» Replies: 0
» Views: 29
|
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
7 hours ago
» Replies: 15
» Views: 209
|
Trojan infection !
Forum: Help Me!
Last Post: SMcNeill
9 hours ago
» Replies: 1
» Views: 39
|
BAM Sample Programs
Forum: QBJS, BAM, and Other BASICs
Last Post: CharlieJV
Today, 02:50 AM
» Replies: 36
» Views: 1,969
|
Audio storage, stereo swi...
Forum: Programs
Last Post: Petr
Yesterday, 09:03 PM
» Replies: 8
» Views: 370
|
_CONSOLEINPUT is blocking
Forum: General Discussion
Last Post: mdijkens
Yesterday, 12:24 PM
» Replies: 7
» Views: 129
|
Most efficient way to bui...
Forum: General Discussion
Last Post: ahenry3068
01-17-2025, 11:36 PM
» Replies: 9
» Views: 138
|
|
|
| under linux Program Console BUG |
|
Posted by: Coolman - 05-26-2022, 08:37 PM - Forum: General Discussion
- Replies (10)
|
 |
i made a console program ($Console:Only) that should run in a terminal. it seems that when executing a console program, the current directory is the one of the executable. the _CWD$ function confirms it.
|
|
|
| DRAGON CAVE |
|
Posted by: James D Jarvis - 05-26-2022, 01:12 PM - Forum: Works in Progress
- No Replies
|
 |
here's a wumpus-a-like I've been fiddling with. A simple treasure hunting/dragon slaying adventure. Simple text or choice base input control.
All planned features aren't in place yet but it's moving along.
Code: (Select All) 'dragon cave
'
'A wumpus-a-like by James D. Jarvis may,2022
'
_Title "D R A G O N C A V E"
Randomize Timer
Dim Shared cave(30, 9), cd$(50), pcl, score, havehearthstone, gd, gold
Dim Shared lootd$(8)
Dim Shared monster$(7)
Const pnorth = 1: Const peast = 3: Const psouth = 2: Const pwest = 4: Const pup = 5: Const pdown = 6
Const foe = 7: Const loot = 8: Const desc = 9
Dim Shared vigor, luck, perception, stealth, magic, arrows
Dim Shared maxvigor, maxluck, maxperception, maxstealth, maxmagic
Dim Shared dragonstate As Integer
Dim Shared spellheal, spellrabbitfoot, spellblast, spelloracle
load_cavedesc
load_monsters
load_loot
playagain:
score = 0
havehearthstone = 0
Cls
Print "D R A G O N C A V E"
Print
Print "Your quest is a simple one, seek the HearthStone and return it the Iron Dwarves."
Print ""
Print "Simple enough really, except for the dragon of course ..."
Print ""
Print "You have 3 magic arrows to defend yourself but be careful..."
Print "... as the Dragon is not alone."
Print " "
Print "<enter to continue>": Input any$
build_Player
show_scores
build_caves
pcl = droll(1, 10)
Print "<enter to continue>": Input any$
Cls
Print "The dwarves lower you deep into the caves, drawing back the line and sealing the way above"
Print "so the dragon can not escape through that route and catch them unaware."
Print "You will have to discover your own route out."
Print "<enter to continue>": Input any$
Do
Print
Print "====================================================================="
Print cd$(cave(pcl, desc))
Print "====================================================================="
Print " "
If cave(pcl, foe) > 0 Then
Print "There is a "; monster$(cave(pcl, foe)); " in this cave."
Print " "
End If
onward:
Print pickprompt$;: Input ask$
ask$ = LCase$(ask$)
ask$ = truncate$(ask$)
Select Case ask$
Case "scores", "stats", "abilities", "show scores", "show stats", "show abilities": show_scores
Case "score", "show score", "show": show_scores
Case "look", "search": do_look
Case "n", "north", "go n", "go north", "walk n", "walk north": go_passage pnorth, "walk"
Case "e", "east", "go e", "go east", "walk e", "walk east": go_passage peast, "walk"
Case "s", "south", "go s", "go south", "walk s", "walk south": go_passage psouth, "walk"
Case "w", "west", "go west", "go west", "walk west", "walk west": go_passage pwest, "walk"
Case "u", "up", "go u", "go up", "climb u", "climb up": go_passage pup, "climb"
Case "d", "down", "go d", "go down", "climb d", "climb down": go_passage pdown, "climb"
Case "run north", "run n": go_passage pnorth, "run"
Case "run south", "run s": go_passage psouth, "run"
Case "run south", "run e": go_passage peast, "run"
Case "run south", "run w": go_passage pwest, "run"
Case "jump up", "leap up", "hop up", "jump u", "leap u", "leap up": go_passage pup, "jump"
Case "jump down", "leap down", "hop down", "jump d", "leap down", "leap d": go_passage pdown, "jump"
Case "hit", "kill", "strike", "slay", "attack", "stab": attack
Case "shoot", "fire": shootarrow 0
Case "shootnorth": shootarrow pnorth
Case "shootsouth": shootarrow psouth
Case "shooteast": shootarrow peast
Case "shootwest": shootarrow pwest
Case "shootup": shootarrow pup
Case "shootdown": shootarrow pdown
Case "castblast": cast_spell "castblast"
Case "castheal": cast_spell "castheal"
Case "castrabbit": cast_spell "castrabbit"
Case "castoracle": cast_spell "castoracle"
Case "listen": do_listen
Case "sniff", "smell": do_smell
Case "get", "fetch", "pickup", "pick-up", "pick up", "grab": get_loot
Case "help", "h", "?": show_help
End Select
If cave(pcl, foe) > 0 And droll(1, 8) < cave(pcl, foe) Then
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "The "; monster$(cave(pcl, foe)); " attacks you."
Print
mattack = droll(1, 20) + cave(pcl, foe)
If mattack > vigor Then
di = droll(1, cave(pcl, foe))
Print "It strikes you for "; di; " points of damage "
vigor = vigor - di
Print
Else
ar = droll(1, 3)
Select Case ar
Case 1: Print "You narrowly avoid the blow."
Case 2: Print "It fails to stike you."
Case 3: Print "You parry the atatck."
End Select
Print
End If
End If
If cave(pcl, foe) < 0 And droll(1, 4) < cave(pcl, foe) Then
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
cave(pcl, foe) = Abs(cave(pcl, foe))
Print "A "; monster$(cave(pcl, foe)); " attempts to ambush you."
Print
mattack = droll(2, 20) + cave(pcl, foe)
If mattack > vigor + luck Then
di = droll(1, cave(pcl, foe))
Print "It strikes you for "; di; " points of damage "
vigor = vigor - di
Print
Else
luck = luck + 1
If luck > maxluck Then luck = maxluck
Print "You avoid it's attack"
Print
End If
End If
If vigor > 0 And vigor < 4 Then
Print
wr = droll(1, 3)
Select Case wr
Case 1: Print "You are exhausted..."
Case 2: Print "You feel weak..."
Case 3: Print "You are battered and bruised..."
End Select
lcheck = droll(1, 20)
If lcheck < luck Then
If luck < maxluck Then luck = luck + 1
Print "... but you pull through for now."
Else
luck = luck - (droll(1, 2) - 1)
Print " ..."
Sleep 0.25
Print " .... "
Sleep 0.25
Print " ..... you collapse."
End If
If Abs(cave(pcl, foe)) > 0 And droll(1, 100) > luck Then
cave(pcl, foe) = Abs(cave(pcl, foe))
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print " "
Print "The "; monster$(cave(pcl, foe)); " mauls you while you are down."
Print " "
di = droll(1, cave(pcl, foe))
Print "It harms you for "; di; " points of damage "
vigor = vigor - di
Print
Print "<enter to continue>": Input any$
End If
End If
If vigor < 1 Then
Print "! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !"
Print "-----------------------------------------------------------"
Print "! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !"
Print " "
dm = droll(1, 4)
Select Case dm
Case 1: Print " YOU HAVE BEEN VANQUISHED !"
Case 2: Print " YOU HAVE DIED !"
Case 3: Print " YOU HAVE FALLEN DUE TO YOUR WOUNDS !"
Case 4: Print " THE LAST THING YOU HEAR A DRAGONS ROAR !"
End Select
Print
Print "! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !"
Print "-----------------------------------------------------------"
Print "! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !"
ask$ = "quit"
End If
Loop Until ask$ = "quit"
Print
Sleep 0.25
Print " G A M E O V E R"
Print
Print "Final Score : "; score
Print
Print "play again";: Input A$
A$ = LCase$(A$)
If A$ = "y" Or A$ = "yes" Then GoTo playagain
cavedata:
Data 0,2,0,0,0,0,0,0,0: '1
Data 1,0,4,0,0,0,0,0,0: '2
Data 0,4,5,0,0,0,0,0,0: '3
Data 3,0,0,2,0,0,0,0,0: '4
Data 0,6,0,3,0,0,0,0,0: '5
Data 5,0,8,0,0,0,0,0,0: '6
Data 0,8,9,0,0,0,0,0,0: '7
Data 7,0,0,6,0,0,0,0,0: '8
Data 0,11,10,7,0,0,0,0,0: '9
Data 0,0,0,9,0,0,0,0,0: '10
Data 9,0,12,0,0,0,0,0,0: '11
Data 0,13,0,11,0,0,0,0,0: '12
Data 12,15,0,0,0,0,0,0,0: '13
Data 0,0,15,0,0,0,0,0,0: '14
Data 13,16,0,14,0,0,0,0,0: '15
Data 15,0,0,17,0,0,0,0,0: '16
Data 0,22,16,18,0,0,0,0,0: '17
Data 0,0,17,19,0,0,0,0,0: '18
Data 0,20,18,0,0,0,0,0,0: '19
Data 19,24,21,0,0,0,0,0,0: '20
Data 0,0,0,20,0,0,0,0,0: '21
Data 17,0,23,0,0,0,0,0,0: '22
Data 0,0,0,22,0,0,0,0,0: '23
Data 20,25,0,0,0,0,0,0,0: '24
Data 24,0,0,26,0,0,0,0,0: '25
Data 0,27,25,0,0,0,0,0,0: '26
Data 26,29,28,0,0,0,0,0,0: '27
Data 0,0,0,27,0,0,0,0,0: '28
Data 27,0,30,0,0,0,0,0,0: '29
Data 0,0,0,29,0,0,0,0,0: '30
cavedescdata:
Data "Musty cave"
Data "Cramped cave"
Data "Muddy cave"
Data "Bubbling pool of mud."
Data "Rancid pool of water."
Data "Dripping stalactities."
Data "Slippery sloped cave."
Data "Mineshaft."
Data "Crumbling old mineshaft."
Data "Mushroom garden."
Data "Fungus forest."
Data "Gloomy grotto."
Data "Dry cave."
Data "Cramped dusty cave."
Data "Mold encrusted walls."
Data "Carpeted in black mold."
Data "Floor covered in slime."
Data "Waist deep guano."
Data "Piles of guano crawling with vermin."
Data "Bottomles pit."
Data "Precarious bridge across a chasm."
Data "Chasm edge, no bottom in sight."
Data "Lava lake."
Data "Stream of lava splitting the chamber north and south."
Data "Lava flow splitting the chamber east and west."
Data "Bubbling pool of lava."
Data "Damp cave."
Data "Cavern choked with cave clams."
Data "Slime pit."
Data "Snake pit."
Data "Worm pit."
Data "Bone pit."
Data "Lava pit."
Data "Steamy cave."
Data "Cold cave."
Data "Ice Cave."
Data "Dusty cave."
Data "Cave full of crumbling pillars."
Data "Unearthy crytsal grotto."
Data "Pool of darkness."
Data "Hall of echoes."
Data "Heart of darkness."
Data "Ancient dwarf crypt."
Data "Ancient dwarf warehouse."
Data "Cold dwarven forge."
Data "Shattered dwarven throne."
Data "Cave littered with shards of dragon eggs."
Data "An old dragon nest."
Data "A fresh dragon nest."
Data "Dragon hoard."
monsterdata:
Data "Bat",
Data "Cavewight"
Data "Huge Bat"
Data "Molebear"
Data "Cave Clam"
Data "Shroombie"
Data "Dragon"
lootdata:
Data "Gold Nugget"
Data "Gold Coins"
Data "Gold Ingot"
Data "Healing Rune"
Data "Rabbit's Foot Rune"
Data "Blast Rune"
Data "Oracle Rune"
Data "HearthStone"
Sub heading_out
Print " TO THE SURFACE ..."
Print
Print " ... "
Sleep 0.25
If havehearthstone = 0 Then
Print "But you lack the HearthStone"
Print
Print "Turn back? <Y,N>"
Input A$
If LCase$(A$) = "yes" Or LCase$(A$) = "y" Then
ask$ = ""
gd = 0
Print " "
Print "back to..."
Print
Else
keepaskinghere:
Print "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
Print "How are yuo going to handle this situation?"
Print "1 - Sneak past the Iron dwarves?"
Print "2 - Tell them you quit."
Print "3 - Run away !"
Print "4- Challneg the king of the Iron Dwarves to single combat!"
Print
Print "Make yuor selection"
Input AA
If AA < 1 Or AA > 4 Then GoTo keepaskinghere
Select Case AA
Case 1:
If droll(1, 20) < luck Then
Print "You slip past the Iron Dwarves to go live your life in peace."
gd = 0
ask$ = "quit"
Else
Print
Print "The Dwarves grab you and give you a sound thrashing..."
Print " "
Print "'YOU AREN'T GETING OUT IF THIS DEAL SO EASY!'"
Print
Print "They toss you back in the caves."
Print
Sleep 0.25
vigor = vigor - droll(1, 4)
gd = 0
ask$ = ""
End If
Case 2:
Print "The dwarves ponder your request..."
Print
Sleep 0.25
If droll(1, 30) < luck Then
Print "Okay we'll let you off the hook..."
If droll(1, 20) < luck Then
Print "...the dwarves let yuo break tyour contract and live yuor life in peace."
gd = 0
ask$ = "quit"
Else
Print "...the dwarves rough yuo up and sieze your loot for being a coward."
gold = 0
score = score / 2
gd = 0
ask$ = "quit"
End If
Else
Print " "
Print "The Iron Dwarves laugh at you and send yuo back into the caves."
gd = 0
ask$ = ""
End If
Case 3:
Print "... Well that was easy..."
Print " "
Print "You are way too fast for the Iron dwarves to catch you, for now..."
Print
gd = 0
ask$ = "quit"
Case 4:
Print " "
Print "The dwarves all laugh at you and push yuo back into the caves."
Print " "
Sleep 0.25
gd = 0
ask$ = ""
End Select
End If
End If
If havehearthstone = 1 Then
Print
Print "YOU HAVE MADE IT OUT OF THE CAVES WITH THE HEARTHSTONE !!!"
Print
Print "What now?"
Print
Print "1 - Hand the HearhtStone over to the Iron Dwarves."
Print "2 - Sneak Away with the HearthStone."
Print "3 - Demand a larger reward."
Print
askhere2:
Input AA
If AA < 0 Or AA > 3 Then GoTo askhere2
Select Case AA
Case 1
Print " "
Print "There is much rejoicing !!!"
Print " "
Print " you are fairly rewarded and welcome in the hall sof the Iron Dwarves for the remainder off all yuor days."
Print
score = score + 1000
gold = gold + 500
gd = 0
ask$ = "quit"
Case 2
If droll(1, 30) < luck Then
Print
Print "You manage to slip past the Iro Dwarves..."
Print
Sleep 0.25
Print "Yuo find a byer for the HearhtStone in Skullport."
Print "If the Iron Dwarves ever find you it will not be pretty."
gold = gold + 5000
score = score + 500
gd = 0
ask$ = "quit"
Else
Print " "
Print "THIEF!!!"
Print
Print " .... COWARD ...."
Print
Print " ...VILLAIN!"
Print
Sleep 0.25
Print "The dwarves put you to the sword for your treachery."
gold = 0
score = score / 10
gd = 0
ask$ = "quit"
End If
Case 3
Print " "
Print "The Iron Dwarves all laugh at you..."
Print
Print "... they take the HearthStone and send you on your way."
Print
score = score + 100
gd = 0
ask$ = "quit"
End Select
End If
End Sub
Sub load_cavedesc
Restore cavedescdata
For c = 1 To 50
Read cd$(c)
Next c
End Sub
Sub do_look
Print
Print "====================================================================="
Print cd$(cave(pcl, desc))
Print "====================================================================="
Print " "
pcheck = droll(1, 12)
pcheck2 = droll(1, 20)
pcheck3 = droll(1, 24)
If pcheck <= perception Then
Print "There are exits:"
If cave(pcl, pnorth) > 0 Then Print "North"
If cave(pcl, psouth) > 0 Then Print "South"
If cave(pcl, peast) > 0 Then Print "East"
If cave(pcl, pwest) > 0 Then Print "West"
If cave(pcl, pup) > 0 Then Print "Up"
If cave(pcl, pdown) > 0 Then Print "Down"
Else
Print "The darkness keeps you from seeing much else."
End If
If pcheck2 <= perception And cave(pcl, foe) < 0 Then
Print "There is a "; monster$(Abs(cave(pcl, foe))); " hiding in here."
End If
If cave(pcl, loot) < 0 And cave(pcl, foe) = 0 Then
If pcheck3 < perception Then
cave(pcl, loot) = Abs(cave(pcl, loot))
Print "You discover a "; lootd$(cave(pcl, loot)); "."
End If
End If
If cave(pcl, loot) > 0 And pcheck3 / 2 < perception Then
Print "There is a "; lootd$(cave(pcl, loot)); " in this cave."
End If
End Sub
Sub load_loot
Restore lootdata
For x = 1 To 8
Read lootd$(x)
Next x
End Sub
Function pickprompt$
Dim pp$(4)
pp$(1) = "What now"
pp$(2) = "Choose your action"
pp$(3) = "What now burglar"
pp$(4) = "Be careful"
p = droll(1, 4)
pickprompt$ = pp$(p)
End Function
Sub build_caves
Restore cavedata
For c = 1 To 30
Read cave(c, 1), cave(c, 2), cave(c, 3), cave(c, 4), cave(c, 5), cave(c, 6), cave(c, 7), cave(c, 8), cave(c, 9)
Select Case c
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10: cave(c, 9) = droll(1, 20)
Case 11, 12, 13, 14, 15, 16, 16, 18, 19, 20: cave(c, 9) = droll(1, 40)
Case 21, 22, 23, 24, 25: cave(c, 9) = droll(1, 20) + 20
Case 26, 27, 28, 29, 30: cave(c, 9) = droll(1, 10) + 40
End Select
mr = droll(1, 20) - droll(1, 20)
If mr < -6 Or mr > 6 Then mr = 0
cave(c, foe) = mr
tr = droll(1, 16) - droll(1, 16)
If tr < -7 Or tr > 7 Then tr = 0
cave(c, loot) = tr
For x = 1 To 6
If cave(c, x) = 0 And droll(1, 6) > 5 Then
If c < 20 Then
nr = droll(1, 24)
cave(c, x) = nr
End If
If c > 19 Then
nr = droll(1, 15) + 15
cave(c, x) = nr
End If
End If
Next x
Next c
dragonlocation = droll(1, 10) + 20
heartstonelocation = droll(1, 10) + 20
cave(hearstone, loot) = 8
cave(dragonlocation, foe) = 7
exitlocation = droll(1, 6)
cave(exitlocation, dup) = 99
End Sub
Sub load_monsters
Restore monsterdata
For x = 1 To 7
Read monster$(x)
Next x
End Sub
Sub do_listen
pr = roll(1, 20) + perception
If pr > 10 And cave(pcl, foe) < 0 Then
cave(pcl, foe) = Abs(cave(pcl, foe))
Print "? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?"
Print "You hear a "; monster$(cave(pcl, foe)); " lurking in the shadows."
Print
Sleep 0.25
End If
If pr > 20 Then
Print "? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?"
For x = 1 To 6
If cave(pcl, x) > 0 Then
cn = Abs(cave(pcl, x))
Select Case x
Case 1
If cave(cn, foe) > 0 Then Print "Something stirs to the north."
Case 2
If cave(cn, foe) > 0 Then Print "There is a tiny noise to the south."
Case 3
If cave(cn, foe) > 0 Then Print "You hear whispers to the east."
Case 4
If cave(cn, foe) > 0 Then Print "The faintest of clamors can be heard to the west."
Case 5
If cave(cn, foe) > 0 Then Print "Steps from above can be heard."
Case 6
If cave(cn, foe) > 0 Then Print "A stir of echoes wafts up fron beneath you."
End Select
End If
Next x
End If
End Sub
Sub show_help
Cls
Print "DRAGON CAVE HELP"
Print "----------------------"
Print "This game uses simple text commands."
Print "Valid commands include the directions: north,south,east,west,up, and down."
Print "you can try to sneak, walk, go, run, climb, or jump as applicable."
Print "shoot, cast <spell name>, attack, hit, and such are valid as well."
Print "with some minor variations here and there."
Print
Print "Don't foget to search, look, listen, and sniff."
Print
Sleep 0.25
End Sub
Sub do_smell
dragonflag$ = "no"
Print "--------------- Sniff, sniff -------------"
Print
If droll(1, 16) < perception Then
If cave(pcl, foe) = -7 Then Print "You smell The Dragon nearby."
For x = 1 To 6
If cave(pcl, x) > 0 Then
cn = cave(pcl, x)
If Abs(cave(cn, foe)) = 7 Then Print "You smell The Dragon nearby."
End If
Next x
End If
End Sub
Sub get_loot
If cave(pcl, loot) > 0 Then
Print "+ + + + + + + + + + + + + + + + + + + + +"
Print
Print "You fetch the "; lootd$(cave(pcl, loot))
Print
Select Case cave(pcl, loot)
Case 1
cave(pcl, loot) = 0
gold = gold + droll(1, 4)
Case 2
cave(pcl, loot) = 0
gold = gold + droll(2, 10)
Case 3
cave(pcl, loot) = 0
gold = gold + droll(2, 20) * 5
Case 4
cave(pcl, loot) = 0
If spellheal = 0 Then
spellheal = 4
Beep
Print "\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/"
Print " You have learned the Heal Spell"
Print "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
Else
If spellheal > 1 Then spellheal = spellheal - 1
End If
score = score + 250
Case 5
cave(pcl, loot) = 0
If spellrabbitfoot = 0 Then
spellrabbitfoot = droll(2, 3)
Beep
Print "\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/"
Print " You have learned the Rabbit's Foot Spell"
Print "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
Else
If spellrabbitfoot > 1 Then spellrabbitfoot = spellrabbitfoot - 1
End If
score = score + 250
Case 6
cave(pcl, loot) = 0
If spellblast = 0 Then
spellbalst = 4
Beep
Print "\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/"
Print " You have learned the Blast Spell"
Print "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
Else
If spellblast > 1 Then spellblast = spellblast - 1
End If
score = score + 250
Case 7
cave(pcl, loot) = 0
If spelloracle = 0 Then
spelloracle = 4
Beep
Print "\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/"
Print " You have learned the Orcacle Spell"
Print "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
Else
If spelloracle > 1 Then spelloracle = spelloracle - 1
End If
score = score + 250
Case 8
cave(pcl, loot) = 0
havehearthstone = 1
score = score + 2000
Print "+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+"
Print " YOU HAVE THE HEARTHSTONE, SEEK THE EXIT"
Print "+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+"
End Select
End If
End Sub
Sub attack
par = vigor + droll(2, 6)
md = cave(pcl, foe)
mdr = droll(3, md) + droll(1, 12)
If cave(pcl, foe) = 0 Then
huh = droll(1, 3)
Print "? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?"
Print
Select Case huh
Case 1: Print "There is nothing there."
Case 2: Print "The air nimbly dodges your blow."
Case 3: Print "You attack the darkness."
End Select
Print
Print "? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?"
Print
Else
If par > mdr Then
Print "! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !"
Print
Print "You hit the "; monster$(Abs(cave(pcl, foe))); " ..."
Sleep 0.25
lr = luck - droll(1, 20)
If lr > 0 Then
score = score + Abs(cave(pcl, foe)) * 100
Print " S L A Y I N G I T ! "
Print
cave(pcl, foe) = 0
Else
score = score + Abs(cave(pcl, foe)) * 5
Print " forcing it to retreat."
Sleep 0.25
ishide = droll(1, 8)
If ishide > cave(pcl, foe) Then
Print
Print "The "; monster$(Abs(cave(pcl, foe))), " has scurried into the shadows."
Print
cave(pcl, foe) = -1 * cave(pcl, foe)
Else
score = score + Abs(cave(pcl, foe)) * 20
Print " "
Print "The ", monster$(Abs(cave(pcl, foe))), "has fled from this cave!"
Print
cave(pcl, foe) = 0
didhide = 0
go = 0
Do
go = go + 1
If cave(pcl, go) > 0 Then
cave(cave(pcl, go), foe) = cave(pcl, foe)
cave(pcl, foe) = 0
didhide = 1
End If
Loop Until didhide > 0
End If
End If
End If
End If
End Sub
Sub go_passage (gd As Integer, mode$)
walkflag$ = "no"
If cave(pcl, gd) = 0 Then
Print "You can't go that way."; ""
End If
If mode$ = "walk" Then
Print "walking"
If Abs(cave(pcl, foe)) > 0 Then
cave(pcl, foe) = Abs(cave(pcl, foe))
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "A "; monster$(cave(pcl, foe)); " blocks your way."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Else
walkflag$ = "yes"
End If
End If
If mode$ = "sneak" Then
Print "trying to sneak"
If Abs(cave(pcl, foe)) > 0 Then
cave(pcl, foe) = Abs(cave(pcl, foe))
If stealth + droll(2, 6) < (droll(4, 6) + cave(pcl, foe)) Then
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "A "; monster$(cave(pcl, foe)); " blocks your way."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Else
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "You slip past the "; monster$(cave(pcl, foe)); "."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print
walkflag$ = "yes"
End If
End If
End If
If mode$ = "run" Then
Print "trying to run"
If Abs(cave(pcl, foe)) > 0 And vigor > 0 Then
cave(pcl, foe) = Abs(cave(pcl, foe))
If vigor + droll(2, 6) < (droll(4, 6) + cave(pcl, foe)) And cave(pcl, foe) <> 5 Then
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "The "; monster$(cave(pcl, foe)); " blocks your way."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Else
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "You run past the "; monster$(cave(pcl, foe)); "."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print
walkflag$ = "yes"
End If
vigor = vigor - 1
End If
End If
If mode$ = "climb" Then
Print "trying to climb..."
If Abs(cave(pcl, foe)) > 0 And vigor > 0 Then
cave(pcl, foe) = Abs(cave(pcl, foe))
If vigor + droll(2, 6) < (droll(4, 6) + cave(pcl, foe)) And cave(pcl, foe) <> 5 Then
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "The "; monster$(cave(pcl, foe)); " blocks your way."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Else
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "You scramble past the "; monster$(cave(pcl, foe)); "."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print
If luck > droll(1, 12) Then
luck = luck - 1
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "You slip and hurt youself !."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
vigor = vigor - droll(1, 3)
Else
walkflag$ = "yes"
End If
End If
vigor = vigor - 1
End If
If mode$ = "jump" Then
If Abs(cave(pcl, foe)) > 0 And vigor > 0 Then
cave(pcl, foe) = Abs(cave(pcl, foe))
If vigor + droll(3, 6) < (droll(4, 6) + cave(pcl, foe)) Then
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "The "; monster$(cave(pcl, foe)); " blocks your way."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Else
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "You leap past the "; monster$(cave(pcl, foe)); "."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print
If luck > droll(1, 24) Then
luck = luck - 1
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
Print "You stumble and slam onto the rocky cave floor."
Print
Print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
Print
vigor = vigor - droll(1, 3) + 1
Else
walkflag$ = "yes"
End If
End If
vigor = vigor - 1
End If
End If
End If
If walkflag$ = "yes" Then
Print
Print "-----------------------------------------------------------"
Print
Print "You travel onward to..."
Print " "
If cave(pcl, gd) = 99 Then heading_out
If gd <> 0 Then pcl = cave(pcl, gd)
Print cd$(cave(pcl, desc))
Print
Print "-----------------------------------------------------------"
End If
End Sub
Function truncate$ (a$)
b$ = "-"
If InStr(a$, "kill ") > 0 Then b$ = "hit"
If InStr(a$, "hit ") > 0 Then b$ = "hit"
If InStr(a$, "strike ") > 0 Then b$ = "hit"
If InStr(a$, "slay ") > 0 Then b$ = "hit"
If InStr(a$, "fight ") > 0 Then b$ = "hit"
If InStr(a$, "attack ") > 0 Then b$ = "hit"
If InStr(a$, "arrow") > 0 Then b$ = "shoot"
If InStr(a$, "fire ") > 0 Then b$ = "shoot"
If InStr(a$, "shoot ") > 0 Then b$ = "shoot"
If InStr(a$, "loose ") > 0 Then b$ = "shoot"
If InStr(a$, "blast") > 0 Then b$ = "castblast"
If InStr(a$, "heal") > 0 Then b$ = "castheal"
If InStr(a$, "rabbit") > 0 Then b$ = "castrabbit"
If InStr(a$, "oracle") > 0 Then b$ = "castoracle"
If b$ = "shoot" And InStr(a$, "north") Then b$ = "shootnorth"
If b$ = "shoot" And InStr(a$, "east") Then b$ = "shooteast"
If b$ = "shoot" And InStr(a$, "south") Then b$ = "shootsouth"
If b$ = "shoot" And InStr(a$, "west") Then b$ = "shootwest"
If b$ = "shoot" And InStr(a$, "up") Then b$ = "shootup"
If b$ = "shoot" And InStr(a$, "down") Then b$ = "shootdown"
If b$ = "-" Then
a$ = a$
Else
a$ = b$
End If
truncate$ = a$
End Function
Sub shootarrow (ad As Integer)
shootflag$ = "no"
If arrows > 0 Then shootflag$ = "arrow"
If Abs(cave(pcl, foe)) > 0 And shootflag$ = "arrow" Then
Select Case ad
Case 1, 2, 3, 4, 5, 6
Print " ! ! ! ! ! ! ! ! ! ! !"
Print
Print "You can't fire an arrow into another cave..."
Print " ... while this cave is occupied !"
Print "<enter>": Input a$
Case 0
shootflag$ = "yes"
End Select
End If
If shootflag$ = "arrow" And cave(pcl, ad) > 0 Then
Print " "
Print ">>>>----------------------------->"
Print
Print "You loose a magical arrow into the distance..."
Sleep 0.25
tr = cave(pcl, ad)
If cave(tr, foe) = 7 Then
arrows = arrows - 1
ad = droll(1, 12)
If ad <= luck Then
Print "... and hear the dragon roar in angush... "
Print " ... AS THE DRAGON DIES !!!"
Print
Print ">>>>----------------------------->"
Print
Print "<enter>": Input a$
cave(tr, foe) = 0
score = score + 1000
End If
Else
Print "... and hear it break against stone."
arrows = arrows - 1
Print " "
If droll(1, 20) > luck Then Print "You hear the dragon roar in the distance."
End If
End If
If shootflag$ = "arrow" And cave(pcl, ad) = 0 Then
Print " "
Print "You can't shoot in that direction."
Print
Print "<enter>": Input a$
End If
If shootflag$ = "yes" Then
Print
Print ">>>>----------------------------->"
Print
Print "You loose a magcial arrow..."
arrows = arrows - 1
Sleep 0.25
If droll(1, 6) > 1 And cave(pcl, foe) <> 7 Then
Print "slaying the "; monster$(Abs(cave(pcl, foe))); " !"
Print
cave(pcl, foe) = 0
score = score + cave(pcl, foe) * 100
End If
Print
If droll(1, 10) > 2 And cave(pcl, foe) = 7 Then
Print "Sinking it into the dragon's heart."
Print
Print "YOU HAVE KILLED THE DRAGON !!!"
Print
Print
cave(pcl, foe) = 0
score = score + 1000
End If
End If
Print "<enter>": Input a$
End Sub
Sub build_Player
maxvigor = droll(2, 6) + 6
maxluck = droll(4, 4)
maxperception = droll(3, 6)
maxstealth = droll(3, 6)
maxmagic = droll(3, 6)
vigor = maxvigor
luck = maxluck
perception = maxperception
stealth = maxstealth
magic = maxmagic
gold = 0
arrows = 3
End Sub
Sub show_scores
If havehearthstone = 1 Then
Print "+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+"
Print "You have the HearthStone"
Print "+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+"
End If
Print "Your Ability Scores."
Print
Print "Vigor", maxvigor; "/"; vigor
Print "Luck", luck
Print "Perception ", perception
Print "Stealth ", stealth
Print "Magic ", maxmagic; "/"; magic
Print
Print "Spells Known:";
If spellheal > 0 Then Print "Heal",
If spellblast > 0 Then Print "Blast",
If spelloracle > 0 Then Print "Oracle",
If spellrabbitfoot > 0 Then Print "Rabbit's Foot",
Print
Print "Gold ", gold
Print "Arrows ", arrows
Print
Print "Score ", score
End Sub
Sub cast_spell (cast$)
If cast$ = "heal" And spellheal > 0 Then
mcheck = magic - spellheal
Print " * * * * * * * * * * * * * * * * * * * *"
Print
If mcheck > magic Then
Print "You lack the magical power to cast that."
Else
Print "You magciall yheal some of your wounds."
magic = magic - droll(1, spellheal)
vigor = vigor + 4
If vigor > maxvigor Then vigor = maxvigor
End If
Print
Print " * * * * * * * * * * * * * * * * * * * *"
Print
Sleep 0.25
End If
If cast$ = "rabbit" And spellrabbitfoot > 0 Then
mcheck = magic - spellrabbitfoot
Print " * * * * * * * * * * * * * * * * * * * *"
Print
If mcheck > magic Then
Print "You lack the magical power to cast that."
luck = luck - 1
Else
Print "You improve your luck."
magic = magic - droll(1, spellrabbitfoot)
luck = luck + droll(1, 6)
'luck can go over maxluck with thius spell
End If
Print
Print " * * * * * * * * * * * * * * * * * * * *"
Print
Sleep 0.25
End If
If cast$ = "oracle" And spelloracle > 0 Then
mcheck = magic - spelloracle
Print " * * * * * * * * * * * * * * * * * * * *"
Print
If mcheck > oracle Then
Print "You lack the magical power to cast that."
perception = perception - (droll(1, 2) - 1)
Else
Print "You improve your perception."
magic = magic - droll(1, spelloracle)
perception = perception + 2
cave(pcl, foe) = Abs(cave(pcl, foe))
cave(pcl, loot) = Abs(cave(pcl, loot))
'the can go overmax perception
End If
Print
Print " * * * * * * * * * * * * * * * * * * * *"
Print
Sleep 0.25
End If
If cast$ = "blast" And spellblast > 0 Then
mcheck = magic - spellblast
Print " * * * * * * * * * * * * * * * * * * * *"
Print
If mcheck > magic Then
Print "You lack the magical power to cast that."
Else
Print "You blast your foe with magical energy."
magic = magic - droll(1, spellblast)
perception = perception - (droll(1, 3) - 1)
'this is a loud spell
If cave(pcl, foe) = 0 Then
Print "This would be much more effective against a foe you could see."
Else
If droll(1, 12) > cave(pcl, foe) Then
Print "Destroying the "; cave(pcl, foe); " !!!"
score = score + cave(pcl, foe) * 50
cave(pcl, foe) = 0
End If
End If
End If
Print
Print " * * * * * * * * * * * * * * * * * * * *"
Print
Sleep 0.25
End If
Select Case cast$
Case "castblast"
If spellblast < 1 Then Print "You have yet to learn that spell."
Case "castheal"
If spellheal < 1 Then Print "You are not a healer, yet."
Case "castrabbit"
If spellrabbitfoot < 1 Then Print "Do not tempt fate as you have yet to learn that spell."
luck = luck - 1
Case "castorcale"
If spellrabbitfoot < 1 Then Print "You have yet to discover an Oracle's Rune."
End Select
End Sub
Function droll (num, sides)
dsum = 0
For x = 1 To num
dsum = dsum + Int(Rnd * sides) + 1
Next x
droll = dsum
End Function
|
|
|
|
Basic for games only |
|
Posted by: Kernelpanic - 05-25-2022, 11:56 PM - Forum: General Discussion
- Replies (26)
|
 |
I see again and again that Basic is apparently only used as a programming language for games etc., for example, but so Basic never gets rid of the "little-kids" level. Not that I want to deny games etc., but you can also develop serious programs with Basic, not just colorful circles and jumping who-knows-where.
So you can for example, write a program that calculates an additional payment to the pension.
An example: You take out an additional insurance into which you pay 3400.00 €/$ per year for 25 years. If you then go in pension, the program shows how much you can then have paid out from the supplementary insurance per month and for how many years. For me, this is a really practical program. There is certainly room for improvement, but this is something that can be used practically.
And in my very personal opinion, this is the only way to get Basic out of the gaming level and make it (again) a serious programming language.
That's my point of view.
|
|
|
|
| Bouncing lines & boxes |
|
Posted by: Dav - 05-25-2022, 10:46 PM - Forum: Programs
- Replies (5)
|
 |
Starting playing around with the power of LINE styles and it lead to 3d looking mystify like screensaver (in 1st code box). Afterwards changed it to bouncing boxes, added some fading. Kept in some LINE style stuff. (Code box #2). On my laptop 12 boxes seems to be the sweet spot when setting _LIMIT 30.
- Dav
Bouncing LINEs....
Code: (Select All) '=================
'BouncingLines.bas
'=================
'Coded by Dav, May/2022
SCREEN _NEWIMAGE(800, 600, 32)
RANDOMIZE TIMER
lines = 12 'Number of lines on screen
DIM line.x1(lines), line.y1(lines), line.cx1(lines), line.cy1(lines)
DIM line.x2(lines), line.y2(lines), line.cx2(lines), line.cy2(lines)
DIM line.r(lines), line.g(lines), line.b(lines), line.a(lines)
'Init values for each line
FOR s = 1 TO lines
line.y1(s) = INT(RND * _HEIGHT) + 1: line.x1(s) = INT(RND * _WIDTH) + 1
line.y2(s) = INT(RND * _HEIGHT) + 1: line.x2(s) = INT(RND * _WIDTH) + 1
line.cx1(s) = RND * 1: line.cy1(s) = RND * 1
line.cx2(s) = RND * 1: line.cy2(s) = RND * 1
line.r(s) = RND * 255: line.g(s) = RND * 255: line.b(s) = RND * 255
line.a(s) = RND * 75 + 15
NEXT
DO
FOR s = 1 TO lines
'draw line...
LINE (line.x1(s), line.y1(s))-(line.x2(s), line.y2(s)), _RGBA(line.r(s), line.g(s), line.b(s), line.a(s)), , 255
'shadow
LINE (line.x1(s) + 2, line.y1(s) + 2)-(line.x2(s) + 2, line.y2(s) + 2), _RGBA(0, 0, 0, line.a(s)), , 255
IF line.x1(s) <= 0 OR line.x1(s) >= _WIDTH THEN line.cx1(s) = -line.cx1(s)
IF line.y1(s) <= 0 OR line.y1(s) >= _HEIGHT THEN line.cy1(s) = -line.cy1(s)
IF line.x2(s) <= 0 OR line.x2(s) >= _WIDTH THEN line.cx2(s) = -line.cx2(s)
IF line.y2(s) <= 0 OR line.y2(s) >= _HEIGHT THEN line.cy2(s) = -line.cy2(s)
line.x1(s) = line.x1(s) + line.cx1(s): line.y1(s) = line.y1(s) + line.cy1(s)
line.x2(s) = line.x2(s) + line.cx2(s): line.y2(s) = line.y2(s) + line.cy2(s)
NEXT
_DISPLAY
_LIMIT 300
LOOP UNTIL INKEY$ <> ""
Bouncing faded boxes.....
Code: (Select All) '=================
'BouncingBoxes.bas
'=================
'Coded by Dav, May/2022
SCREEN _NEWIMAGE(800, 600, 32)
RANDOMIZE TIMER
boxes = 12 'Number of boxes on screen
DIM box.x1(boxes), box.y1(boxes), box.cx1(boxes), box.cy1(boxes)
DIM box.x2(boxes), box.y2(boxes), box.cx2(boxes), box.cy2(boxes)
DIM box.r(boxes), box.g(boxes), box.b(boxes), box.a(boxes)
'Init values for each box
FOR s = 1 TO boxes
box.y1(s) = INT(RND * _HEIGHT) + 1: box.x1(s) = INT(RND * _WIDTH) + 1
box.y2(s) = INT(RND * _HEIGHT) + 1: box.x2(s) = INT(RND * _WIDTH) + 1
box.cx1(s) = RND * 4: box.cy1(s) = RND * 4
box.cx2(s) = RND * 4: box.cy2(s) = RND * 4
box.r(s) = RND * 255: box.g(s) = RND * 255: box.b(s) = RND * 255
box.a(s) = RND * 75 + 15
NEXT
DO
CLS , _RGB(0, 0, 48)
FOR s = 1 TO boxes
'draw box
LINE (box.x1(s), box.y1(s))-(box.x2(s), box.y2(s)), _RGBA(box.r(s), box.g(s), box.b(s), box.a(s)), BF
'center lines
LINE (box.x1(s), box.y1(s))-(box.x2(s), box.y2(s)), _RGBA(255, 255, 255, box.a(s)), , 255
LINE (box.x2(s), box.y1(s))-(box.x1(s), box.y2(s)), _RGBA(255, 255, 255, box.a(s)), , 255
'box outline
LINE (box.x1(s), box.y1(s))-(box.x2(s), box.y2(s)), _RGBA(255, 255, 255, box.a(s)), B , 255
IF box.x1(s) <= 0 OR box.x1(s) >= _WIDTH THEN box.cx1(s) = -box.cx1(s)
IF box.y1(s) <= 0 OR box.y1(s) >= _HEIGHT THEN box.cy1(s) = -box.cy1(s)
IF box.x2(s) <= 0 OR box.x2(s) >= _WIDTH THEN box.cx2(s) = -box.cx2(s)
IF box.y2(s) <= 0 OR box.y2(s) >= _HEIGHT THEN box.cy2(s) = -box.cy2(s)
box.x1(s) = box.x1(s) + box.cx1(s): box.y1(s) = box.y1(s) + box.cy1(s)
box.x2(s) = box.x2(s) + box.cx2(s): box.y2(s) = box.y2(s) + box.cy2(s)
NEXT
_DISPLAY
_LIMIT 30
LOOP UNTIL INKEY$ <> ""
|
|
|
|
| Pong Clone |
|
Posted by: SierraKen - 05-25-2022, 07:46 PM - Forum: Programs
- Replies (18)
|
 |
With the help of B+'s reflection math code, I decided to make a Pong Clone today. You play against the computer using your mouse. First to reach 10 points wins. B+, I added your name to the welcome screen. Tell me what you think. It was a bit tricky to make it not too easy but also not impossible, I believe I found the right middle ground. There's a photo of it below.  Thanks for the help B+, I've always wanted to make my own Pong. I know most of them have rectangle rackets but I found it's more enjoyable to aim the ball with a round racket instead.
![[Image: Pong-Clone-by-Sierra-Ken.jpg]](https://i.ibb.co/mcr2MxG/Pong-Clone-by-Sierra-Ken.jpg)
Code: (Select All) 'Pong Clone by SierraKen - May 25, 2022.
'Thank you to B+ for the deflection math code!
_Title "Pong Clone - by SierraKen"
Screen _NewImage(800, 600, 32)
Cls
Locate 4, 35: Print "P O N G C L O N E"
Locate 7, 44: Print "By SierraKen"
Locate 10, 44: Print "With help by B+"
Locate 15, 25: Print "Use your mouse to control the round paddle on the right side."
Locate 16, 25: Print "First one to reach 10 points wins."
Locate 20, 37: Print "Press Mouse Button To Begin."
Do
While _MouseInput: Wend
If _MouseButton(1) = -1 Then GoTo begin:
Loop
begin:
Randomize Timer
' these remain constant
px = 350: py = 250: pr = 5: pc = _RGB32(0, 255, 0) ' <<<< lets label everything of puck with p
speed = 7 ' really keeping puck at constant speed
cx = 100: cy = 300: cr = 25: cc = _RGB32(255, 0, 0) 'Computer Racket
mx = 700: mr = 25: mc = _RGB32(255, 0, 0) ' <<<< evrything mouse starts with m , use different radius for mouse - Your Racket
score = 0
cscore = 0
start:
px = 400: py = 300
Cls
angle:
pa = _Pi(2) * Rnd ' pa = puck angle this is rnd times all directions 0 to 360 in degrees 0 to 2*pi in radians
ang = _R2D(pa)
If ang > 85 And ang < 95 Then GoTo angle:
If ang > 265 And ang < 275 Then GoTo angle:
Do
Cls ' Clear our work and recalulate and redraw everything
Line (25, 25)-(775, 25), _RGB32(255, 255, 255)
Line (25, 575)-(775, 575), _RGB32(255, 255, 255)
For nety = 25 To 575 Step 20
Line (400, nety)-(400, nety + 10), _RGB32(255, 255, 255)
Next nety
Locate 1, 10: Print " Computer: "; cscore
Locate 1, 78: Print " You: "; score
If cscore = 10 Then
_AutoDisplay
Cls
Locate 5, 40
Print "You Lose!"
Locate 10, 40
Print "Again (Y/N)?";
again:
ag$ = InKey$
If ag$ = "y" Or ag$ = "Y" Then GoTo begin:
If ag$ = "n" Or ag$ = "N" Or ag$ = Chr$(27) Then End
GoTo again
End If
If score = 10 Then
_AutoDisplay
Cls
Locate 5, 20
Print "You Win!"
Locate 10, 20
Print "Again (Y/N)?";
again2:
ag2$ = InKey$
If ag2$ = "y" Or ag2$ = "Y" Then GoTo begin:
If ag2$ = "n" Or ag2$ = "N" Or ag2$ = Chr$(27) Then End
GoTo again2
End If
a$ = InKey$
If a$ = " " Then GoTo start:
If a$ = Chr$(27) Then End
While _MouseInput: Wend ' better way to poll mouse and label mouse x, y as mx, my like everyone else
my = _MouseY
fillCircle mx, my, mr, mc ' draw mouse paddle
' check for collision
' first part measure distance between mouse center and puck center, is it less than radius of mouse + puck?
If Sqr((mx - px) ^ 2 + (my - py) ^ 2) < (pr + mr) Then ' (pr + pr2) to (r + rr) collision!
pa = _Atan2(py - my, px - mx) ' get the angle of the puck to the mouse
px = px + speed * Cos(pa) ' move the puck out of the mouse paddle
py = py + speed * Sin(pa) '
' show the collision and replacement of ball AFTER removed from inside the mouse
Line (mx, my)-(px, py), &HFFFFFFFF
_Display
_Delay .1
End If
If py > cy Then
cdist = py - cy
cy = cy + cdist / 6.25
End If
If py < cy Then
cdist = cy - py
cy = cy - cdist / 6.25
End If
fillCircle cx, cy, cr, cc
If Sqr((cx - px) ^ 2 + (cy - py) ^ 2) < (pr + cr) Then ' (pr + pr2) to (r + rr) collision!
pa = _Atan2(py - cy, px - cx) ' get the angle of the puck to the mouse
px = px + speed * Cos(pa) ' move the puck out of the mouse paddle
py = py + speed * Sin(pa) '
' show the collision and replacement of ball AFTER removed from inside the mouse
Line (cx, cy)-(px, py), &HFFFFFFFF
_Display
_Delay .1
End If
'keep puck out of wall = wall boundary +- radius of puck
If px > 775 Then cscore = cscore + 1: _Delay .25: GoTo start:
If px < 25 Then score = score + 1: _Delay .25: GoTo start:
If py > 575 - pr Then pa = -pa: py = 575 - pr ' move puck out of wall !!!
If py < 25 + pr Then pa = -pa: py = 25 + pr ' move puck out of wall !!!
' nove the puck along and draw it
px = px + speed * Cos(pa) ' now move the puck along it's new direction pa = puck angle
py = py + speed * Sin(pa) '
fillCircle px, py, pr, pc ' draw puck
_Display
_Limit 60 ' hold screen for moment
Loop
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
|
|
|
|
| FABS - Qbasic |
|
Posted by: G43 - 05-25-2022, 01:47 PM - Forum: General Discussion
- Replies (25)
|
|
Has anyone ever heard of FABS Plus Net from Computer Control Systems. We use a program at my workplace that was written specially for a handful of automotive stores in the 80's and it calls FABSMB regularly. I have been researching and found a reference to FABS here http://www.gcssoft.de/ I am trying to debug a couple of things in the program and i need to find a copy of this FABS if it is possible to look at the index files that are in use. Any help would be appreciated.
Thanks,
Garrett
|
|
|
|
| SQLite wrapper |
|
Posted by: jakebullet70 - 05-25-2022, 09:23 AM - Forum: Utilities
- Replies (1)
|
|
OK, this should be all you need to use SQLite 3 databases. See GitHub for all code needed including sample stuff.
https://github.com/jakebullet70/QB64-SQLite
Supported Subs / Functions
Code: (Select All) '--- open a sqlite DB
SUB DB_Open (CreateIfMissing AS _BYTE)
FUNCTION DB_Open%% (CreateIfMissing AS _BYTE)
'--- close a database
SUB DB_Close ()
'--- return primary key of last inserted record
FUNCTION DB_LastInsertedRowID& ()
'--- return number of rows the last query affected
FUNCTION DB_AffectedRows& ()
'--- return the last error message (if any)
FUNCTION DB_GetErrMsg$ ()
'--- return total of rows in a recordset
FUNCTION DB_RowCount& (RS() AS SQLITE_RESULTSET)
'--- return number of columns in a recordset
FUNCTION DB_ColCount& (RS() AS SQLITE_RESULTSET)
'--- Gets the value of a field
FUNCTION DB_GetField$ (RS() AS SQLITE_RESULTSET, Row AS LONG, FieldName AS STRING)
'--- Use for Scalar functions, returning 1 value
FUNCTION DB_ExecQuerySingleResult$ (sql_command AS STRING)
'--- Execute a SQL query and return a recordset
SUB DB_ExecQuery (sql_command AS STRING, RS() AS SQLITE_RESULTSET)
FUNCTION DB_ExecQuery& (sql_command AS STRING, RS() AS SQLITE_RESULTSET)
'--- Execute a SQL query with no return value
SUB DB_ExecNonQuery (sql_command AS STRING)
FUNCTION DB_ExecNonQuery& (sql_command AS STRING)
'--- Helper function to build SQL statements
FUNCTION DB_SqlParse$ (sql_str$, values_str$)
|
|
|
|
| Command Line INI Editor |
|
Posted by: AtomicSlaughter - 05-24-2022, 07:54 PM - Forum: Programs
- No Replies
|
 |
OK my ini include has been modified to work from the command line.
the usage format is
-add -f filename -s section -k key -d data
-del -f filename, -s section -k key
-delsec -f filename, -s section
-read -f filename, -s section -k key
-readsection -f filename, -s section
Code: (Select All) $Console:Only
Type Sections
lineNum As Integer
section As String
End Type
If Command$ <> "" Then
test$ = Command$(1)
For i = 2 To _CommandCount Step 2
Select Case Command$(i)
Case "-f"
FileName$ = Command$(i + 1)
Case "-s"
IniSection$ = Command$(i + 1)
Case "-d"
INIData$ = Command$(i + 1)
Case "-k"
INIKey$ = Command$(i + 1)
End Select
Next
Select Case test$
Case "-add": AddINI FileName$, IniSection$, INIKey$, INIData$: System
Case "-del": DelINI FileName$, IniSection$, INIKey$: System
Case "-delsec": DelSec FileName$, IniSection$: System
Case "-read": Print ReadINI(FileName$, IniSection$, INIKey$): System
Case "-readsection": ReadINISec FileName$, IniSection$: System
End Select
System
Else
Input "Command >", test$
Select Case test$
Case "add"
Input "Filename >", FileName$
Input "Section >", IniSection$
Input "Key >", INIKey$
Input "Data >", INIData$
AddINI FileName$, IniSection$, INIKey$, INIData$: System
Case "del"
Input "Filename >", FileName$
Input "Section >", IniSection$
Input "Key >", INIKey$
DelINI FileName$, IniSection$, INIKey$: System
Case "delsec"
Input "Filename >", FileName$
Input "Section >", IniSection$
DelSec FileName$, IniSection$
Case "read"
Input "Filename >", FileName$
Input "Section >", IniSection$
Input "Key >", INIKey$
Print ReadINI(FileName$, IniSection$, INIKey$): System: System
End Select
End If
Sub LoadINIFile (FileName As String, iniData() As String, iniSections() As Sections)
ReDim As String iniData(0)
ReDim As Sections iniSections(0)
If _FileExists(FileName) Then
file = FreeFile
Open FileName For Binary As #file
If LOF(file) = 0 Then Exit Sub
Do
Line Input #file, iniData(UBound(iniData))
If InStr(iniData(UBound(iniData)), "[") > 0 Then
iniSections(UBound(iniSections)).section = iniData(UBound(iniData))
iniSections(UBound(iniSections)).lineNum = x
ReDim _Preserve As Sections iniSections(UBound(iniSections) + 1)
End If
ReDim _Preserve iniData(UBound(iniData) + 1)
x = x + 1
Loop Until EOF(file)
Close
End If
iniSections(UBound(iniSections)).section = "End of File"
iniSections(UBound(iniSections)).lineNum = x
End Sub
Sub CheckSection (sec() As Sections, check As String, out1 As Single, out2 As Single, Ret As String)
For i = 0 To UBound(sec)
If LCase$(sec(i).section) = "[" + LCase$(check) + "]" Then
out1 = sec(i).lineNum + 1
out2 = sec(i + 1).lineNum - 1
Exit Sub
End If
Next
Ret = "New Section"
End Sub
Function ReadINI$ (FileName As String, Section As String, INIKey As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile FileName, ini(), sec()
If Section <> "" Then
CheckSection sec(), Section, start, finish, ret$
For i = start To finish
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReadINI = Right$(ini(i), (Len(ini(i)) - InStr(ini(i), "=")))
End If
Next
Else
Do
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReadINI = Right$(ini(i), (Len(ini(i)) - InStr(ini(i), "=")))
End If
i = i + 1
Loop Until ini(i) = ""
End If
End Function
Sub DelINI (FileName As String, Section As String, INIKey As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile FileName, ini(), sec()
If Section <> "" Then
CheckSection sec(), Section, start, finish, ret$
For i = start To finish
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReDim temp(UBound(ini) - 1) As String
For a = 0 To (i - 1)
temp(a) = ini(a)
Next
For a = i To UBound(temp)
temp(a) = ini(a + 1)
Next
End If
Next
Else
Do
If Left$(LCase$(ini(i)), InStr(ini(i), "=") - 1) = LCase$(INIKey) Then
ReDim temp(UBound(ini) - 1) As String
For a = 0 To i - 1
temp(a) = ini(a)
Next
For a = x To UBound(ini)
temp(x) = ini(x + 1)
Next
End If
i = i + 1
Loop Until ini(i) = ""
End If
Do
If temp(UBound(temp)) = "" Then ReDim _Preserve temp(UBound(temp) - 1)
Loop Until temp(UBound(temp)) <> ""
f = FreeFile
Open FileName For Output As #f
For i = 0 To UBound(temp)
Print #f, temp(i)
Next
Close
End Sub
Sub DelSec (FileName As String, Section As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile FileName, ini(), sec()
CheckSection sec(), Section, start, finish, ret$
ReDim Temp(UBound(ini)) As String
For i = 0 To start
Temp(i) = ini(i)
Next
For i = finish To UBound(ini)
Temp(i - finish) = ini(i)
Next
Do
If Temp(UBound(Temp)) = "" Then ReDim _Preserve Temp(UBound(Temp) - 1)
Loop Until Temp(UBound(Temp)) <> ""
f = FreeFile
Open FileName For Output As #f
For i = 0 To UBound(Temp)
Print #f, Temp(i)
Next
Close
End Sub
Sub AddINI (FileName As String, Section As String, INIKey As String, INIData As String)
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile FileName, ini(), sec()
CheckSection sec(), Section, start, finish, ret$
ReDim temp(UBound(ini) + 1) As String
If ret$ = "New Section" Then
ReDim temp(UBound(ini) + 3)
temp(0) = "[" + Section + "]"
temp(1) = INIKey + "=" + INIData
temp(2) = ""
For i = 3 To UBound(ini)
temp(i) = ini(i - 3)
Next
Else
If Section <> "" Then
For i = 0 To start
temp(i) = ini(i)
Next
temp(start) = INIKey + "=" + INIData
For i = start + 1 To UBound(ini)
temp(i) = ini(i - 1)
Next
Else
temp(0) = INIKey + "=" + INIData
For i = 1 To UBound(ini)
temp(i) = ini(i - 1)
Next
End If
End If
Do
If temp(UBound(temp)) = "" Then ReDim _Preserve temp(UBound(temp) - 1)
Loop Until temp(UBound(temp)) <> ""
ff = FreeFile
Open FileName For Output As #ff
For i = 0 To UBound(temp)
Print #ff, temp(i)
Next
Close
End Sub
Sub ReadINISec (FileName As String, Section As String)
Cls
Dim sec(0) As Sections: Dim ini(0) As String
Dim As Single start, finish
LoadINIFile FileName, ini(), sec()
CheckSection sec(), Section, start, finish, ret$
x = start: y = finish
Print ini(start - 1)
For i = x To y
Print ">> ", ini(i)
Next
End Sub
|
|
|
|
| Found a bug in QB64 |
|
Posted by: Coolman - 05-24-2022, 11:57 AM - Forum: General Discussion
- Replies (9)
|
|
i found a bug in qb64. if you have in the same location a *.bas file and a directory with the same name. the compilation will fail. example :
file test.bas and directory test
|
|
|
|
|
