| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
What are good things now to add to QB64? |
|
Posted by: mnrvovrfc - 08-16-2023, 11:39 PM - Forum: General Discussion
- Replies (5)
|
 |
(08-16-2023, 09:50 PM)grymmjack Wrote: As long as we're wishing...
@SMcNeill @a740g @offbyone I asked this in private already, but would like to share this here.
Are there plans to evolve the language further with things like...
- Native BOOL _TRUE and _FALSE (maybe using '$:BOOL to make it optional)
- Optional parameters for SUBs and FUNCTIONs
- EVAL("QB CODE")
- Returning arrays from SUBs and FUNCTIONs
- Arrays inside UDTs
- Arrays of UDTs inside UDTs
- Passing FUNCTIONs and SUBs into other FUNCTIONs and SUBs
- '$INCLUDE_ONCE:
- Native JSON ('$JSON)
- Native DICTIONARY ('$DICTIONARY)
- FUNCTIONs and SUBs inside other FUNCTIONs and SUBs
These things are so nice in other languages, I'm finding I'm really missing them.
The issue isn't that QB64PE isn't like every other language - it can be it's own thing, the issue is I'm building bad habits.
GOSUB and GOTO lol - Nothing wrong with them they work fine, but the reason I used those recently is because it's so cumbersome to pass variables around elegantly. The language isn't DRY (Don't Repeat Yourself) at all.
So instead of shimming everything into funcs and subs where i am now using gosub and goto, i just move on with life.
Meanwhile my cognitive load is higher than it should be in QB64 vs. other languages.
Anyway
Just some thoughts
I've decided to start a new thread so the one by Terry isn't being derailed too much. Not a popularity contest for me LOL.
(1) will require "real" boolean variables and values like Lua and Pascal. In other words, cannot choose any non-zero value as true anymore. Few BASIC programmers would enjoy that, only those like me that had some exposure to languages having boolean types.
(2) This is a high request from me. 
(3) Wasn't DSMan or someone else in QB64 team trying to come up with a QB64 interpreter? Because that's what it would involve. If it's only a parser for arithmetic and first-year sequential math stuff then Steve already did that.
(4) This is the same problem as doing it with UDT's -- often too large if it has to be copied. :/
(5) Static arrays inside UDT's is more like it. Otherwise use _MEM. Otherwise figure out how to do an "union" like in C.
(6) No comment.
(7) This could be confusing and difficult to debug; we would need an industrial-strength debugger like that of Purebasic. It's easy to get fancy with function pointers even with simple programs so that other constructs like SELECT CASE... END SELECT are neglected.
(8) Well you already proposed it grymmjack and I support you.
(9) I have to learn that stuff then.
(10) Associative arrays would be a big boost to this programming language despite the performance overhead and the bloat to executables.
(11) Nested subprograms could be a mixed bag like #7. Some people then are going to want function pointers that could point to "local" functions. I'd rather do without it.
How about "AS (type)" at the end of the parameter list, instead of sigil right after FUNCTION name? How about "RESULT =" on LHS instead of having to type in the long-ass FUNCTION name? This last point could over some people who write sloppy programs assigning the function result several times instead of cleanly doing it once, and relying far too much on EXIT FUNCTION.
Don't get me started about GOSUB and RETURN made worthless in Freebasic, for me that's one of the biggest scandals they've ever made. Sorry but in BASIC I want my RETURN back for GOSUB.
|
|
|
| Lost in Jungle |
|
Posted by: bplus - 08-16-2023, 08:50 PM - Forum: Programs
- Replies (8)
|
 |
This was ported by me to QB64 from felixp7 port to FB from somewhere else:
@johnno56 you might like this.
Code: (Select All) Option _Explicit
' Lost in the Jungle: a silly little survival game.
' 2023-08-10 Felix PleÅŸoianu <https://felix.plesoianu.ro/>
' Use as you like, and enjoy!
' port to QB64pe b+ 2023-08-14
_Title "Lost in Jungle - port felixp7 port to FB to QB64pe"
Randomize Timer
Dim Shared nl$: nl$ = Chr$(10)
Dim Shared fatigue: fatigue = 0.0
Dim Shared health: health = 5.0
Dim Shared bullets: bullets = 6
Dim Shared skill: skill = 0.15
Dim Shared distance: distance = 50.0
Dim Shared hours: hours = 0
Dim Shared chances(0 To 7)
Print "You survived the plane crash."
Print
Print "With all your gear intact, too:"
Print
Print "Gun, knife, compass, lighter."
Print
Print "But you have no food or water."
Print
Print "And a big bad jungle to cross."
Dim GameMenu$(1 To 3)
GameMenu$(1) = "Play"
GameMenu$(2) = "Help"
GameMenu$(3) = "Quit"
again:
Select Case menu&(GameMenu$())
Case 1: startGame: playGame
Case 2: Print: help: GoTo again
Case 3: Print: Print "See you around!"
End Select
Print: Print "(press any key)"
Sleep
Sub startGame
fatigue = 0.0
health = 5.0
bullets = 6
skill = 0.15
distance = 45 + Int(Rnd * 11)
hours = 0
Dim i
For i = 0 To 7
chances(i) = 0.0
Next
End Sub
Function tiredness$ (fatigue, health)
Dim energy
energy = health - fatigue
If energy <= 1 Then
tiredness$ = "drained"
ElseIf energy <= 3 Then
tiredness$ = "tired"
Else
tiredness$ = "fresh"
End If
End Function
Function healthLevel$ (health)
If health < 2 Then
healthLevel$ = "bad"
ElseIf health < 4 Then
healthLevel$ = "decent"
Else
healthLevel$ = "good"
End If
End Function
Sub setStatus (status1 As String, status2 As String)
Cls
status1 = "In " + healthLevel$(health) + " health; " + tiredness$(fatigue, health) + nl$ + _
" Bullets:" + Str$(bullets) + nl$ + " Time:" + Str$(hours) + " hrs." + nl$
If distance >= 35 Then
status2 = " Can't see the sky for the forest canopy."
ElseIf distance >= 15 Then
status2 = " Shafts of sunlight mark the path ahead."
Else
status2 = " The trees are growing farther apart now."
End If
End Sub
Function menu& (options() As String)
Print
Dim i
For i = LBound(options) To UBound(options)
Print i; ") "; options(i)
Next
Print
Dim result As Long
Do
Input ; result
Loop Until result >= LBound(options) And result <= UBound(options)
Print
menu& = result
End Function
Sub noEncounter
Print " Around you, the jungle looms."
Dim QuietMenu$(1 To 2)
QuietMenu$(1) = "March on"
QuietMenu$(2) = "Get some rest"
Select Case menu&(QuietMenu$())
Case 1: doWalk
Case 2: doRest
End Select
End Sub
Sub doWalk
If fatigue >= health Then
Print "You can't take another step."
doRest
Else
Dim walked
walked = health - fatigue
distance = distance - walked
fatigue = fatigue - 1
hours = hours + 1
If walked <= 1 Then
Print "You crawl along tiredly."
ElseIf walked <= 3 Then
Print "You march on, making steady progress."
Else
Print "You advance quickly for now..."
End If
End If
End Sub
Sub doRest
hours = hours + 1
If health < 5 Then
health = health + 0.5
If health > 5 Then health = 5
If fatigue >= health Then
fatigue = fatigue - 1
Else
fatigue = fatigue - 0.5
End If
If fatigue < 0 Then fatigue = 0
Print "You rest and heal a little."
Else
If fatigue >= health Then
fatigue = fatigue - 2
Else
fatigue = fatigue - 1
End If
If fatigue < 0 Then fatigue = 0
Print "You get some good rest."
End If
Select Case Rnd
Case Is < 0.15
Print "But while you were sleeping..." ' what is !"But
fightMonkeys
Case Is < 0.3
Print "But while you were sleeping..." ' what is !"But
itsVenomous
End Select
End Sub
Sub findWater
Print "You find a pool of water."
Dim water_menu(1 To 2) As String
water_menu(1) = "Drink some"
water_menu(2) = "Leave it"
Select Case menu&(water_menu())
Case 1: drinkWater
Case 2: noDrinking
End Select
End Sub
Sub drinkWater
fatigue = fatigue - 2
If fatigue < 0 Then fatigue = 0
Print "The water is cool. You feel refreshed."
If Rnd >= skill Then
Print "But drinking from the pool soon makes you ill."
Print "At least you learn the signs better."
health = health - 1
skill = skill + 0.05
End If
End Sub
Sub noDrinking
Print "Better not chance taking a drink at this time."
End Sub
Sub findFruit
Print "You find strange fruit."
Dim fruit_menu(1 To 2) As String
fruit_menu(1) = "Eat some"
fruit_menu(2) = "Leave it"
Select Case menu&(fruit_menu())
Case 1: eatFruit
Case 2: noEating
End Select
End Sub
Sub eatFruit
health = health + 1
If health > 5 Then health = 5
Print "The fruit is tasty. You recover some strength."
If Rnd >= skill Then
Print "But soon after eating it you feel drowsy."
Print "At least you learn the signs better."
fatigue = fatigue + 2
skill = skill + 0.05
End If
End Sub
Sub noEating
Print "Better not chance taking a bite at this time."
End Sub
Sub huntGame
Dim critter(0 To 2) As String
critter(0) = "A small herbivore"
critter(1) = "Some large rodent"
critter(2) = "A flightless bird"
Dim action(0 To 1) As String
action(0) = " hears your steps and bolts."
action(1) = " stumbles out of the bushes."
Dim hunt_menu(1 To 3) As String
hunt_menu(1) = "Shoot it"
hunt_menu(2) = "Run after it"
hunt_menu(3) = "Just move on"
Print critter(Int(Rnd * 3)); action(Int(Rnd * 2))
Select Case menu&(hunt_menu())
Case 1: shootGame
Case 2: chaseGame
Case 3: ignoreGame
End Select
End Sub
Sub shootGame
If bullets < 1 Then
Print "Click! Click! No more bullets..."
Print "The lucky creature soon vanishes."
Else
bullets = bullets - 1
Print "You carefully take aim and... BANG!"
eatGame
End If
End Sub
Sub chaseGame
If fatigue >= health Then
Print "You're too tired to give chase."
ElseIf Rnd < skill Then
fatigue = fatigue + 1
Print "You hunt it down and catch it."
eatGame
Else
fatigue = fatigue + 1
skill = skill + 0.05
Print "You chase after it, but it's too fast."
Print "At least you learn new tricks."
End If
End Sub
Sub eatGame
hours = hours + 1
health = health + 2
If health > 5 Then health = 5
Print "Poor critter is tasty roasted on a tiny fire."
Print "You recover much of your strength."
End Sub
Sub ignoreGame
Print "You decide against playing hunter right now."
End Sub
Sub fightMonkeys
Print "Screaming monkeys come out of nowhere to harass you!"
Dim monkey_menu(1 To 3) As String
monkey_menu(1) = "Shoot at them"
monkey_menu(2) = "Look scary"
monkey_menu(3) = "Run away"
Select Case menu&(monkey_menu())
Case 1: shootMonkeys
Case 2: scareMonkeys
Case 3: runAway
End Select
End Sub
Sub shootMonkeys
If bullets < 1 Then
Print "Click! Click! No more bullets..."
getMauled
Else
bullets = bullets - 1
Print "BANG! Your bullet goes crashing through the foliage."
Print "The monkeys scatter, shrieking even more loudly."
End If
End Sub
Sub scareMonkeys
Print "You shout and wave a branch, trying to look bigger."
If Rnd < skill Then
Print "The monkeys laugh mockingly at you as they scatter."
Else
skill = skill + 0.05
Print "It doesn't seem to be working very well at all."
getMauled
End If
End Sub
Sub getMauled
health = health - 2
Print "A rain of kicks and bites descends upon you!"
Print "At long last, the monkeys scatter, shrieking."
End Sub
Sub runAway
hours = hours + 1
fatigue = fatigue + 1 ' Should be less bad than what we're risking.
Print "You run away blindly, until your lungs burn."
Print "The chorus of shrieks slowly remains behind."
End Sub
Sub itsVenomous
Dim crawlie(0 To 2) As String
crawlie(0) = "giant centipede"
crawlie(1) = "big hairy spider"
crawlie(2) = "colorful snake"
Print "A "; crawlie(Int(Rnd * 3)); " falls on you from above!"
Dim crawlie_menu(1 To 2) As String
crawlie_menu(1) = "Remove it carefully"
crawlie_menu(2) = "Stand still"
Select Case menu&(crawlie_menu())
Case 1: removeCrawlie
Case 2: waitOutCrawlie
End Select
End Sub
Sub removeCrawlie
If Rnd < skill Then
Print "The crawlie wriggles wetly in your grasp. Yuck!"
Else
skill = skill + 0.05
health = health - 1.5
Print "You carefully try to pick up the crawlie, but... OW!"
Print "It bites! You're poisoned. Burns pretty badly, too."
End If
Print "At least it's gone now. Hopefully."
End Sub
Sub waitOutCrawlie
hours = hours + 1
fatigue = fatigue + 1 ' Should be less bad than what we're risking.
Print "You wait tensely for what seems like hours."
Print "In the end, it's gone, and you're sweating."
End Sub
Sub findRuins
Print "You discover ancient ruins..."
Dim ruins_menu(1 To 3) As String
ruins_menu(1) = "Rest here"
ruins_menu(2) = "Search the place"
ruins_menu(3) = "Just move on"
Select Case menu&(ruins_menu())
Case 1: restAtRuins
Case 2: searchRuins
Case 3: leaveRuins
End Select
End Sub
Sub restAtRuins
fatigue = fatigue - 1
If fatigue < 0 Then fatigue = 0
health = health + 1
If health > 5 Then health = 5
hours = hours + 2
Print "You sleep undisturbed for once, before moving on."
End Sub
Sub searchRuins
hours = hours + 1
Select Case Rnd
Case Is < 0.3
skill = skill + 0.05
Print "You find old inscriptions teaching about the jungle."
Case Is < 0.6
Print "You find gold and diamonds. Not much use right now."
Case Else
Print "You find nothing of interest this time around."
End Select
End Sub
Sub leaveRuins
hours = hours + 1
fatigue = fatigue + 1
distance = distance - 3 ' Not too much, because it's for free.
Print "You march on, emboldened, covering a good distance."
End Sub
Sub reachSwamp
Print "A vast swamp bars your way."
Dim swamp_menu(1 To 2) As String
swamp_menu(1) = "Risk a crossing"
swamp_menu(2) = "Go around it"
Select Case menu&(swamp_menu())
Case 1: crossSwamp
Case 2: avoidSwamp
End Select
End Sub
Sub crossSwamp
If Rnd < skill Then
Print "Somehow you navigate the maze more or less safely."
Else
' Probably too harsh since you get tired either way.
' fatigue++;
health = health - 1
skill = skill + 0.05
Print "Mud pulls at your feet, and you nearly drown once."
Print "Mosquitos besiege you; their bites make you ill."
End If
hours = hours + 1
fatigue = fatigue + 1
distance = distance - 5
Print "It's a scary shortcut to take, but it saves a lot of travel."
End Sub
Sub avoidSwamp
fatigue = fatigue + 1.5 ' Should be bad, but not too bad.
hours = hours + 2
Print "A long, tiresome detour. Safe, but no closer to your goal."
End Sub
Sub triggerPlant
Print "Creeping vines entangle your limbs and drag you down."
Print "Oh no! It's a man-eating mandragore, and it's hungry!"
Dim plant_menu(1 To 3) As String
plant_menu(1) = "Shoot it"
plant_menu(2) = "Wrestle free"
plant_menu(3) = "Cut the vines"
Select Case menu&(plant_menu())
Case 1: shootPlant
Case 2: wrestlePlant
Case 3: cutPlant
End Select
End Sub
Sub shootPlant
If bullets < 1 Then
Print "Click! Click! No more bullets..."
getChewedOn
Else
bullets = bullets - 1
Print "BANG! You hit the plant's smelly flower dead center."
Print "It wilts away with a horrible squelching sound."
End If
End Sub
Sub wrestlePlant
Dim energy
energy = (health - fatigue) * 2 / 10
If Rnd < energy Then
Print "You vigorously pull at the vines, breaking a few."
Print "The plant soon decides to wait for easier prey."
Else
Print "You pull tiredly at the vines. It's not enough."
getChewedOn
End If
fatigue = fatigue + 1
End Sub
Sub cutPlant
fatigue = fatigue + 1
If Rnd < skill Then
Print "You expertly hack at the vines with your knife."
Print "The plant soon decides to wait for easier prey."
Else
skill = skill + 0.05
Print "You clumsily hack at the vines with your knife."
getChewedOn
End If
End Sub
Sub getChewedOn
health = health - 1
Print "The plants chews on you with its toothless maw,";
Print " burning you with digestive juices before you escape."
End Sub
'dim shared encounters(0 to 7) as sub = { _
' @findWater, @findFruit, @huntGame, @fightMonkeys, _
' @itsVenomous, @findRuins, @reachSwamp, @triggerPlant}
Sub pickEncounter
Dim i
For i = 0 To 7
If Rnd < chances(i) Then
chances(i) = chances(i) / 5
Select Case i
Case 0: findWater
Case 1: findFruit
Case 2: huntGame
Case 3: fightMonkeys
Case 4: itsVenomous
Case 5: findRuins
Case 6: reachSwamp
Case 7: triggerPlant
End Select
'return encounters(i)
Else
chances(i) = chances(i) + 0.05
End If
Next
noEncounter
End Sub
Sub playGame
While health > 0 And distance > 0
Dim status1 As String, status2 As String
setStatus status1, status2
Print status1; status2;
pickEncounter
'encounter()
Wend
If health <= 0 Then
Print "You died in the jungle, after ";
Print hours; " hours of struggle."
Print "No more than "; distance; "km away from safety."
If bullets = 6 Then
Print "Without as much as firing a single bullet."
End If
Print "Oh well, better luck next time."
ElseIf distance <= 0 Then
Print "At last, the trees open up. You see a village. Saved!"
Print "Unless it's a hostile tribe? Just kidding. You win!"
Print "(In "; hours; " hours, with ";
Print bullets; " bullets left.)"
Else
Print "Game ended abnormally."
End If
End Sub
Sub help
Print "The goal is to cross the 50Km or so separating you from safety."
Print "The exact distance varies every time you play."
Print
Print "Advance in the game by marching on whenever you get the chance."
Print "But you have to balance your health and fatigue."
Print
Print "The worse your health, the easier you get tired."
Print "It's not possible to die from exhaustion."
Print
Print "But being tired all the time will hold you up,"
Print "allowing more dangers to catch up with you and sap your health."
Print
Print "Hope this helps. Enjoy!"
End Sub
My best game least hours and bullets used was 7 hours and 5 bullets left (I used only 1 on the hungry man eating plant.)
|
|
|
|
| QUEST-A |
|
Posted by: James D Jarvis - 08-16-2023, 06:42 PM - Forum: Programs
- Replies (7)
|
 |
I literally stumbled across this clicking links a half hour ago. It was originally written for use on the SpectraVideo CompuMate, A system that had maybe 2K of RAM. Other than editing the command words I have done no editing of note. I did add the comments. Apparently if the original code was 1 or 2 lines larger it would have been too large for the original editor. This is just a little programming archeology.
Code: (Select All) 'QUEST-A
'BASIC PROGRAMME FOR THE SPECTRAVIDEO CompuMate
'AUTHOR: Graham.J.Percy
'25th September, 1998.
'edited to work in QB but otherwise unchanged
1 Q$ = "+---------+"
2 Print Q$, " QUEST-A", Q$, " BY"
3 Print "GRAHAM PERCY", "1=PLAY"
4 Input C
5 R$ = "[ ]"
6 S$ = "+--- ---+"
7 T$ = " ]"
9 V$ = "+---+-+---+"
10 W$ = "[ O++ ]"
11 Y$ = "1=DOWN 2=RIGHT"
12 Print S$, R$, R$, T$, R$, Q$
13 Print "A BIG ROOM", "1=LEFT 2=UP"
14 Input "ACTION=", B
15 If B = 1 Then GoTo 32
16 If B <> 2 Then GoTo 14
18 If K <> 1 Then Print Q$, W$
20 If K = 1 Then Print Q$, R$
21 Print T$, R$, S$, "LONG HALL"
23 Print "1=LEFT 2=DOWN"
24 If K <> 1 Then Print "3=GET KEY"
25 Input "ACTION=", B
26 If B = 2 Then GoTo 12
27 If B = 1 Then GoTo 48
28 If B <> 3 Then GoTo 25
29 If K = 0 Then Print "YOU GOT KEY"
30 Let K = 1
31 GoTo 18
32 Print S$, R$, "[", Q$, "A DARK HALL"
33 If P = 1 Then GoTo 38
34 G = Int(1 + Rnd * 2): F = Int(1 + Rnd * 3)
35 If G <> 2 Then GoTo 38
36 Print "OGRE HERE", "1=UP 2=RIGHT", "3=FIGHT"
37 GoTo 39
38 Print "1=UP 2=RIGHT"
39 Input "ACTION=", B
40 If B = 3 And G = 2 And F = 3 Then GoTo 96
41 If B = 2 Then GoTo 12
42 If B = 1 Then GoTo 48
43 If B <> 3 Then GoTo 39
44 Print "GOT THE OGREGOT ARMOUR"
45 Let P = 1
46 GoTo 32
48 If D = 1 Then If E = 3 Then GoTo 70
49 If D = 0 Then If E = 3 Then GoTo 77
50 Print V$, R$, "[", R$, S$
51 Print "TROLL, DOOR", Y$, "3=OPEN 4=FIGHT"
52 Input "ACTION=", B
53 If B = 1 Then GoTo 32
54 If B = 2 Then GoTo 18
55 If B = 3 Then If K = 1 Then GoTo 60
56 If B = 3 Then Print "NEED A KEY"
57 If B = 4 Then GoSub 88
59 GoTo 48
60 Print "TROL SAY NO"
61 GoTo 48
70 Print S$, R$, "[", R$, S$, "OPEN DOOR", Y$, "3=UP"
71 Input "ACTION=", B
72 If B = 1 Then GoTo 32
73 If B = 2 Then GoTo 18
74 If B <> 3 Then GoTo 71
75 Print "* * *", " *", "", R$, R$, S$, "YOU,RE FREE"
76 GoTo 97
77 Print V$, R$, "[", R$, S$, "A DOOR", Y$, "3=OPEN DOOR"
79 Input "ACTION=", B
80 If B = 1 Then GoTo 32
81 If B = 2 Then GoTo 18
82 If B = 3 Then If K = 1 Then GoTo 85
83 If B = 3 Then Print "NEED A KEY"
84 GoTo 79
85 Print "YOU OPEN IT"
86 Let D = 1
87 GoTo 70
88 If P = 0 Then Let F = Int(Rnd * 1): E = E + 1
89 If P = 1 Then Let F = Int(Rnd * 14): E = E + 1
90 Print "YOU ATTACK,"
91 If F = 0 Then GoTo 96
92 If E = 3 Then Print "GOT HIM"
93 Return
96 Print "HE GOT YOU"
97 Print "BYE"
|
|
|
|
| Declaring Functions AS TYPEs |
|
Posted by: TerryRitchie - 08-16-2023, 02:26 AM - Forum: General Discussion
- Replies (14)
|
 |
So many times I have wished for this:
TYPE TYPE_VECTOR
x AS SINGLE
y AS SINGLE
END TYPE
FUNCTION AddVector(v1 AS TYPE_VECTOR, v2 AS TYPE_VECTOR) AS TYPE_VECTOR
AddVector.x = v1.x + v2.x
AddVector.y = v1.y + v2.y
END FUNCTION
Or even this would be awesome
DIM v1 AS TYPE_VECTOR
DIM v2 AS TYPE_VECTOR
DIM v3 AS TYPE_VECTOR
v1.x = 10: v1.y = 20
v2.x = 15: v2.y = 15
v3 = v1 + v2
( v3.x now = 25, v3.y now = 35 )
I realize neither of these concepts are in the spirit of QB64, but just imagine.
|
|
|
|
| Detect when mouse leaves program window |
|
Posted by: TerryRitchie - 08-16-2023, 01:11 AM - Forum: Help Me!
- Replies (25)
|
|
I could have swore there was a discussion about this before, either on this forum or previous forums, but my searches have come up empty.
How can I detect when the mouse pointer has left the program window?
I seem to remember someone showing how to use an API call ( @SpriggsySpriggs ?) but I didn't have the foresight to add it to my tool box of goodies.
Any suggestions?
|
|
|
|
| Memory Use Guidelines |
|
Posted by: NakedApe - 08-15-2023, 09:22 PM - Forum: Help Me!
- Replies (5)
|
 |
I'm wondering if there are any practical limits to how many sounds, fonts, images and arrays I can have open in a QB64 program before it starts to bog down. I'm working on a space game on a Mac, and the Activity Monitor tells me I'm using about 150 MB of memory, and with the program running I'm using from 36% to 98% of the CPU. It runs fine right now, just wondering if I need to be very careful with the resources. Thanks.
|
|
|
|
| QBJS Swimming fish with Kelp |
|
Posted by: bplus - 08-15-2023, 02:37 AM - Forum: QBJS, BAM, and Other BASICs
- Replies (22)
|
|
@dbox once again I am stumped trying to get this going on QBJS
Code: (Select All) 'Option _Explicit
'_Title " Fish: press m for more, l for less" 'b+ 2021-12-03
'
Dim Shared sw, sh, LHead$, LBody$, LTail$, RHead$, RBody$, RTail$
sw = 1024: sh = 700
LHead$ = "<*": LBody$ = ")": LTail$ = ">{"
RHead$ = "*>": RBody$ = "(": RTail$ = "}<"
Type fish
As Integer LFish, X, Y, DX
As String fish
As _Unsigned Long Colr
End Type
Screen _NewImage(sw, sh, 32)
Color _RGB32(220), _RGB32(0, 0, 60)
Cls
'_PrintMode _KeepBackground
Dim As Integer i, nFish
Dim k$
nFish = 40
'restart:
ReDim Shared school(1 To nFish) As fish, kelp(sw, sh) As _Unsigned Long
growKelp
For i = 1 To nFish
NewFish i, -1
Next
Do
Cls
k$ = InKey$
'If k$ = "m" Then ' more fish
' nFish = nFish * 2
' If nFish > 300 Then Beep: nFish = 300
' 'GoTo restart
'End If
'If k$ = "l" Then ' less fish
' nFish = nFish / 2
' If nFish < 4 Then Beep: nFish = 4
' 'GoTo restart
'End If
For i = 1 To nFish ' draw fish behind kelp
If _Red32(school(i).Colr) < 160 Then
Color school(i).Colr
_PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
school(i).X = school(i).X + school(i).DX
If school(i).LFish Then
If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
Else
If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
End If
End If
Next
showKelp
For i = 1 To nFish ' draw fish in from of kelp
If _Red32(school(i).Colr) >= 160 Then
Color school(i).Colr
_PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
school(i).X = school(i).X + school(i).DX
If school(i).LFish Then
If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
Else
If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
End If
End If
Next
_Display
_Limit 10
Loop Until _KeyDown(27)
Sub NewFish (i, initTF)
Dim gray
gray = Rnd * 200 + 55
school(i).Colr = _RGB32(gray) ' color
If Rnd > .5 Then
school(i).LFish = -1
school(i).fish = LHead$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, LBody$) + LTail$
Else
school(i).LFish = 0
school(i).fish = RTail$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, RBody$) + RHead$
End If
If initTF Then
school(i).X = _Width * Rnd
Else
If school(i).LFish Then school(i).X = _Width + Rnd * 35 Else school(i).X = -35 * Rnd - Len(school(i).fish) * 8
End If
If gray > 160 Then
If school(i).LFish Then school(i).DX = -18 * Rnd - 3 Else school(i).DX = 18 * Rnd + 3
Else
If school(i).LFish Then school(i).DX = -6 * Rnd - 1 Else school(i).DX = 6 * Rnd + 1
End If
school(i).Y = _Height * Rnd
End Sub
Sub growKelp
Dim kelps, x, y, r
ReDim kelp(sw, sh) As _Unsigned Long
kelps = Int(Rnd * 20) + 20
For x = 1 To kelps
kelp(Int(Rnd * sw / 8), (sh - 16) / 16) = _RGB32(0, Rnd * 128, 0)
Next
For y = sh / 16 To 0 Step -1
For x = 0 To sw / 8
If kelp(x, y + 1) Then
r = Int(Rnd * 23) + 1
Select Case r
Case 1, 2, 3, 18 '1 branch node
If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
Case 4, 5, 6, 7, 8, 9, 21 '1 branch node
kelp(x, y) = kelp(x, y + 1)
Case 10, 11, 12, 20 '1 branch node
If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
Case 13, 14, 15, 16, 17, 19 '2 branch node
If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
End Select
End If
Next
Next
End Sub
Sub showKelp
Dim y, x
For y = 0 To sh / 16
For x = 0 To sw / 8
If kelp(x, y) Then
Color kelp(x, y)
_PrintString (x * 8, y * 16), Mid$("kelp", Int(Rnd * 4) + 1, 1)
End If
Next
Next
End Sub
|
|
|
|
_FULLSCREEN behaves weird in some Linux OS installations... |
|
Posted by: mnrvovrfc - 08-15-2023, 12:09 AM - Forum: General Discussion
- No Replies
|
|
... and combinations of budget computers. This was on Spiral Linux purposely upgraded to "Bookworm". In other words, this was a Debian clone which had v11 "Bullseye" base, and I upgraded it to v12 "Bookworm" base which has been on since mid-June.
This was tried with bplus' program with the fish. See screenshot below.
This is from a 1-1/2-year-old "ewaste" candidate:
Code: (Select All) [~]$ inxi -SCMm -x -I
System:
Host: xxxxxxxx Kernel: 6.1.0-10-amd64 arch: x86_64 bits: 64 compiler: gcc
v: 12.2.0 Desktop: Xfce v: 4.18.1 Distro: Debian GNU/Linux 12 (bookworm)
Machine:
Type: Laptop System: ASUSTeK product: VivoBook_ASUSLaptop E410MAB_E410MA
v: 1.0 serial: <superuser required>
Mobo: ASUSTeK model: E410MAB v: 1.0 serial: <superuser required>
UEFI: American Megatrends v: E410MAB.300 date: 07/23/2021
Memory:
RAM: total: 3.65 GiB used: 961.4 MiB (25.7%)
RAM Report: permissions: Unable to run dmidecode. Root privileges
required.
CPU:
Info: dual core model: Intel Celeron N4020 bits: 64 type: MCP
arch: Goldmont Plus rev: 8 cache: L1: 112 KiB L2: 4 MiB
Speed (MHz): avg: 814 high: 833 min/max: 800/2800 cores: 1: 796 2: 833
bogomips: 4377
Flags: ht lm nx pae sse sse2 sse3 sse4_1 sse4_2 ssse3 vmx
Info:
Processes: 166 Uptime: 28m Init: systemd target: graphical (5) Compilers:
gcc: 12.2.0 Packages: 1834 Shell: Bash v: 5.2.15 inxi: 3.3.26
"ewaste" means do not buy from ASUS, or at least do not buy this particular model because it has a poor battery. This could be the last time I could use this computer, for its possible refusal to deal with the battery if it can't charge it. I had another laptop with SSD crap out on me in this manner but I could still use it without the battery. I cannot use this ASUS computer without the battery because... I have to remove the screws on the bottom of the bulk side of the unit to get to it. :O
![[Image: bplus-fish-n-kelp-bad-fullscreen.png]](https://i.ibb.co/GRfZ7z4/bplus-fish-n-kelp-bad-fullscreen.png)
|
|
|
|
|
