| Welcome, Guest |
You have to register before you can post on our site.
|
| Forum Statistics |
» Members: 499
» Latest member: Blayk
» Forum threads: 2,851
» Forum posts: 26,704
Full Statistics
|
| Latest Threads |
Audio storage, stereo swi...
Forum: Programs
Last Post: Petr
2 hours ago
» Replies: 4
» Views: 310
|
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
5 hours ago
» Replies: 7
» Views: 127
|
_CONSOLEINPUT is blocking
Forum: General Discussion
Last Post: mdijkens
6 hours ago
» Replies: 7
» Views: 113
|
Most efficient way to bui...
Forum: General Discussion
Last Post: ahenry3068
Yesterday, 11:36 PM
» Replies: 9
» Views: 135
|
QBJS - ANSI Draw
Forum: QBJS, BAM, and Other BASICs
Last Post: madscijr
Yesterday, 11:24 PM
» Replies: 4
» Views: 129
|
Fun with Ray Casting
Forum: a740g
Last Post: a740g
Yesterday, 05:50 AM
» Replies: 10
» Views: 247
|
Very basic key mapping de...
Forum: SMcNeill
Last Post: a740g
Yesterday, 02:33 AM
» Replies: 1
» Views: 53
|
Methods in types
Forum: General Discussion
Last Post: bobalooie
Yesterday, 01:02 AM
» Replies: 0
» Views: 61
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
01-16-2025, 10:23 AM
» Replies: 3
» Views: 123
|
Extended KotD #23 and #24...
Forum: Keyword of the Day!
Last Post: SMcNeill
01-16-2025, 09:51 AM
» Replies: 0
» Views: 58
|
|
|
| Scalable List |
|
Posted by: SMcNeill - 08-11-2022, 09:53 AM - Forum: Help Me!
- Replies (2)
|
 |
An example for the Discord channel. This isn't set up with a very intuitive interface, as I cobbled it together in all of about 10 minutes quick work. I doubt anyone will learn anything from this, without popping into discord and actually chatting with me in person so I can help walk through what we're doing and why in a life-time session. It's just easier to share code of this length here, than it is there, but it's easier there to actually discuss it in real time so I can answer questions and such as we go. My apologies to anyone who finds this confusing or a waste of time. ;D
Code: (Select All) Screen _NewImage(640, 640, 32)
$Color:32
ReDim Shared lists(5, 5, 0) As String * 10 'make a resizable list array
Dim Shared As Integer list2use, listcount 'track which list we're using, and how many we have
addDefaultLabels
Do
Cls
m = MBS 'mousebutton status
If m And 8 Then 'left mouse button clicked
X = (_MouseX - 4) \ 127: Y = (_MouseY - 4) \ 127 'in which box was the mouse butoon pressed?
If Y = 4 Then 'we're on the last row, which is always going to be my command row
Select Case X
Case 0 'home
list2use = 0
editMode = 0
Case 1 'edit item
editMode = -1
Case 2 'next list
list2use = list2use + 1
If list2use > listcount Then list2use = 0
editMode = 0
Case 3 'delete list
'not functional for this demo. LOL! I'm just trying to keep things simple..ish.
Case 4 'add list
ReformLists
listcount = listcount + 1
list2use = listcount
addDefaultLabels
editMode = 0
End Select
Else
If editMode Then
Color White, Red
Locate 1, 1: Input "Enter the name for the item you clicked on: "; temp$
lists(X, Y, list2use) = temp$
Color White, Black
editMode = 0
Else
Color White, Red
Locate 1, 1: Print "You clicked on: "; lists(X, Y, list2use)
Print "Which was item "; X; ","; Y; "in list"; list2use
Color White, Black
_Display
Sleep
End If
End If
End If
_Limit 30
DrawBoxes list2use
_Display
Loop Until _KeyDown(27)
Sleep
Sub ReformLists
Dim temp(10, 10, listcount + 1) As String * 10
For z = 0 To listcount
For x = 0 To 4
For y = 0 To 4
temp(x, y, z) = lists(x, y, z) 'make a copy of the old data
Next y, x, z
ReDim lists(x, y, listcount + 1) As String * 10 'notice we're making our lists array larger to hold the new information?
For z = 0 To listcount
For x = 0 To 4
For y = 0 To 4
lists(x, y, z) = temp(x, y, z) 'copy the old data back over
Next y, x, z
'We have to do things this way as REDIM _PRESERVE doesn't work across multi-dimensional arrays
End Sub
Sub addDefaultLabels
lists(4, 4, list2use) = "Add List"
lists(3, 4, list2use) = "Delete List"
lists(2, 4, list2use) = "Next List"
lists(1, 4, list2use) = "Edit Item"
lists(0, 4, list2use) = "Return Home"
End Sub
Sub DrawBoxes (list2use)
For x = 0 To 4
For y = 0 To 4
Line (x * 127 + 4, y * 127 + 4)-Step(120, 120), White, B
_PrintString (x * 127 + 20, y * 127 + 60), lists(x, y, list2use)
Next
Next
End Sub
Function MBS% 'Mouse Button Status
Static StartTimer As _Float
Static ButtonDown As Integer
Static ClickCount As Integer
Const ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
' Down longer counts as a HOLD event.
Shared Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
While _MouseInput 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
Select Case Sgn(_MouseWheel)
Case 1: tempMBS = tempMBS Or 512
Case -1: tempMBS = tempMBS Or 1024
End Select
Wend
If _MouseButton(1) Then tempMBS = tempMBS Or 1
If _MouseButton(2) Then tempMBS = tempMBS Or 2
If _MouseButton(3) Then tempMBS = tempMBS Or 4
If StartTimer = 0 Then
If _MouseButton(1) Then 'If a button is pressed, start the timer to see what it does (click or hold)
ButtonDown = 1: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
ElseIf _MouseButton(2) Then
ButtonDown = 2: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
ElseIf _MouseButton(3) Then
ButtonDown = 3: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
End If
Else
BD = ButtonDown Mod 3
If BD = 0 Then BD = 3
If Timer(0.01) - StartTimer <= ClickLimit Then 'Button was down, then up, within time limit. It's a click
If _MouseButton(BD) = 0 Then tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
Else
If _MouseButton(BD) = 0 Then 'hold event has now ended
tempMBS = 0: ButtonDown = 0: StartTimer = 0
Mouse_EndX = _MouseX: Mouse_EndY = _MouseY
Else 'We've now started the hold event
tempMBS = tempMBS Or 32 * 2 ^ ButtonDown
End If
End If
End If
MBS = tempMBS
End Function
|
|
|
| Wordle Helper #2 |
|
Posted by: bplus - 08-10-2022, 09:06 PM - Forum: Programs
- Replies (2)
|
 |
Just had to see if there was a way to "cheat"!
There is this:
Code: (Select All) Option _Explicit
_Title "Wordle Helper v2" ' b+ 2022-08-09
' use yellow - where letter is NOT
' put in a loop to eliminate as play Wordle
Dim Shared green$, yellow$
Dim nope$, k$
Dim w$(1 To 3145), wLeft$(1 To 3145), bw$
Dim As Long topWL, i, j, flag, top
restart:
Open "5LW.txt" For Input As #1
For i = 1 To 3145
Input #1, w$(i)
Next
Close #1
top = 3145
topWL = 0
Do
' new round
Input " Enter 5 letters Green (* for non green) from newest round "; green$
Input "Enter 5 letters Yellow (* for non yellow) from newest round "; yellow$
Print "If letters appear as green or yellow then they are in word."
Input " Enter letters NOT in word (any length) from newest round "; nope$
For i = 1 To top ' eliminate words that have letters known not to be in word
flag = -1
For j = 1 To Len(nope$)
If InStr(w$(i), Mid$(nope$, j, 1)) Then flag = 0: Exit For
Next
If flag Then 'candidate
topWL = topWL + 1
wLeft$(topWL) = w$(i)
End If
Next
Print "After nope$, number of words left are"; topWL
' now
top = topWL
topWL = 0
For i = 1 To top
w$(i) = wLeft$(i) ' put the words left back into w$()
Next
For i = 1 To top
If match&(w$(i), bw$) Then ' bw$ is the word to check with green matches removed
If m2&(bw$) Then ' check yellow matches
topWL = topWL + 1
wLeft$(topWL) = w$(i)
End If
End If
Next
' now
top = topWL
topWL = 0
For i = 1 To top
w$(i) = wLeft$(i) ' put the words left back into w$()
Next
Print "Word candidates:"; top
For i = 1 To top
Print w$(i); " ";
Next
Print
Print " ...ZZZ press space bar to continue round, x to start over, esc to quit"
While 1
k$ = InKey$
If Len(k$) Then
If Asc(k$) = 27 Then End
If k$ = " " Or k$ = "x" Then Exit While
End If
_Limit 30
Wend
If k$ = "x" Then GoTo restart
_KeyClear
Loop
Function match& (w2$, bw$) ' replace matching greenies with spaces in bw$ and use bw$ for checking yellow
Dim As Long i
bw$ = w2$
For i = 1 To 5
If Mid$(green$, i, 1) <> "*" Then
If Mid$(green$, i, 1) <> Mid$(w2$, i, 1) Then
Exit Function
Else
Mid$(bw$, i, 1) = " "
End If
End If
'else pass the word untouched as bw$
Next
match& = -1
End Function
Function m2& (w$)
Dim bw$, i As Long, p As Long
bw$ = w$
For i = 1 To 5
If Mid$(yellow$, i, 1) <> "*" Then ' there is a letter here we have to find in candidate words but not at i!
p = InStr(bw$, Mid$(yellow$, i, 1))
If p Then ' use the info if letter yellow at spot it is not word it would be green
If p <> i Then Mid$(bw$, p, 1) = " " Else Exit Function
Else ' no p means the letter is not in word so dont pass word
Exit Function
End If
End If
Next
m2& = -1
End Function
Does it work?
Well this was just luck!
This wasn't!
You can get the word file from my Wordle post, I probably renamed it but if it has 3145 5-letter words you're gold.
|
|
|
|
| keyup, keydown,slowkeydown |
|
Posted by: James D Jarvis - 08-10-2022, 09:04 PM - Forum: Utilities
- Replies (8)
|
 |
Three little functions to help in using _keyhit for user input.
keyup only returns the release of a key
keydown only returns key presses and doesn't return negative values when a key is released.
Slowkeydown throttles how quickly entries are returned while holding down a key.
Code: (Select All) _ControlChr Off
Print "press any key, <ESC> to exit"
Do
'edit the comments to see the differences in behavior
' k = keydown
k = keyup
' k = slowkeydown(5)
_KeyClear
Print k 'just the key hit value
If Abs(k) > 0 And Abs(k) < 256 Then Print Chr$(Abs(k)) 'show the ascii value of the key press if it has one
_Limit 60
Loop Until Abs(k) = 27
Function keyup
'only returns negative values when a key is released
'this will keep user from entering mutiple keypresses
Do
k = _KeyHit
_Limit 60
Loop Until k < 0
keyup = k
End Function
Function keydown
'only returns positive values when a key is pressed
Do
k = _KeyHit
_Limit 60
Loop Until k > 0
keydown = k
End Function
Function slowkeydown (r)
'returns positive vlaues when a key is pressed
'the variable r sets the frequency of the do loop , 60 would match the other functions here
'it wouldn't be slow at all if r had a high value but i didn't want to call it speedkeydown or ratekeydown
'this allows for continuous presses if a key is held down but not at machinegun rates
Do
k = _KeyHit
_Limit r
Loop Until k > 0
slowkeydown = k
End Function
|
|
|
|
| Perpetual string math calculator. |
|
Posted by: Pete - 08-10-2022, 05:11 PM - Forum: Works in Progress
- Replies (15)
|
 |
I've seen online calculators that do this:
1 / 3 * 3 = .999...
and this:
1 / 3 * 3 = 1
Obviously, the second one takes into account 1 / 3 as an infinite repetend. So I was wondering if there was some algorithm I could apply to properly round all repetend situations. Well, I punted on that concept, as to identify a repetend that goes over 10,000 digits before repeating the number sequence, simply takes too much calculation time. Not to mention how far can we go? After all, Pi is a transcendental number, so that could take an eternity... or an eternity and a half, if you're using FreeBASIC.
So, I decided to approach this problem by going old-school. Although decimals can never be depended on to divide and multiply back symmetrically, fractions can. So I designed a string math calculator system that works with numerators and denominators, but displays the results in decimal form.
This is roughed out, which means I did not put much thought into variable and line number names, tricks to speed it up, or extensive optimization. Goal #1 for me is to always get it working, and I think this is either close or does meet my first goal...
Code: (Select All) DIM SHARED betatest%
REM betatest% = -1
WIDTH 160, 42
_SCREENMOVE 0, 0
DIM SHARED operator$, stringmatha$, stringmathb$, runningtotal$, limit&&
start:
display_as&& = 15
limit&& = 100
DO
IF sa$ = "" OR LEN(op$) THEN
LINE INPUT "Number: "; n$
IF op$ = "" THEN
sa$ = n$
ELSE
sb$ = n$
GOSUB calculate
op$ = ""
END IF
ELSE
' Input operation.
PRINT "[+-*/]: ";
DO
_LIMIT 30
mykey$ = INKEY$
IF LEN(mykey$) THEN
SELECT CASE mykey$
CASE "+", "="
op$ = "+": EXIT DO
CASE "-", "_"
op$ = "-": EXIT DO
CASE "*", "8"
op$ = "*": EXIT DO
CASE "/", "?"
op$ = "/": EXIT DO
CASE "c", "C"
PRINT: PRINT "Total = 0": CLEAR: GOTO start
CASE CHR$(27)
SYSTEM
END SELECT
END IF
LOOP
PRINT op$
END IF
LOOP
calculate:
SELECT CASE op$
CASE "+", "-"
IF nator_a$ = "" THEN
nator_a$ = sa$: nator_b$ = sb$
dator_a$ = "1": dator_b$ = "1"
ELSE
nator_b$ = sb$: dator_b$ = "1"
END IF
IF INSTR(nator_a$, ".") THEN
n$ = nator_a$
GOSUB convert_to_fraction
nator_a$ = numerator$: dator_a$ = denominator$
END IF
IF INSTR(sb$, ".") THEN
n$ = sb$
GOSUB convert_to_fraction
nator_b$ = numerator$: dator_b$ = denominator$
ELSE
nator_b$ = sb$: dator_b$ = "1"
END IF
' Cross multiply
IF dator_a$ <> datorb$ THEN
stringmatha$ = nator_a$: stringmathb$ = dator_b$: operator$ = "*"
CALL string_math
a$ = runningtotal$
stringmatha$ = dator_a$: stringmathb$ = dator_b$: operator$ = "*"
CALL string_math
dator_c$ = runningtotal$ ' Common denominator.
stringmatha$ = nator_b$: stringmathb$ = dator_a$: operator$ = "*"
CALL string_math
b$ = runningtotal$
stringmatha$ = a$: stringmathb$ = b$: operator$ = op$
CALL string_math
nator_c$ = runningtotal$
END IF
CASE "*"
IF nator_a$ = "" THEN
nator_a$ = sa$: nator_b$ = sb$
dator_a$ = "1": dator_b$ = "1"
ELSE
nator_b$ = sb$: dator_b$ = "1"
END IF
IF INSTR(nator_a$, ".") THEN
n$ = nator_a$
GOSUB convert_to_fraction
nator_a$ = numerator$: dator_a$ = denominator$
END IF
IF INSTR(sb$, ".") THEN
n$ = sb$
GOSUB convert_to_fraction
nator_b$ = numerator$: dator_b$ = denominator$
ELSE
nator_b$ = sb$: dator_b$ = "1"
END IF
stringmatha$ = nator_a$: stringmathb$ = nator_b$: operator$ = "*"
CALL string_math
nator_c$ = runningtotal$
stringmatha$ = dator_a$: stringmathb$ = dator_b$: operator$ = "*"
CALL string_math
dator_c$ = runningtotal$
CASE "/"
IF nator_a$ = "" THEN
nator_a$ = sa$: nator_b$ = sb$
dator_a$ = "1": dator_b$ = "1"
ELSE
nator_b$ = sb$: dator_b$ = "1"
END IF
IF INSTR(nator_a$, ".") THEN
n$ = nator_a$
GOSUB convert_to_fraction
nator_a$ = numerator$: dator_a$ = denominator$
END IF
IF INSTR(sb$, ".") THEN
n$ = sb$
GOSUB convert_to_fraction
nator_b$ = numerator$: dator_b$ = denominator$
ELSE
nator_b$ = sb$: dator_b$ = "1"
END IF
SWAP nator_b$, dator_b$
stringmatha$ = nator_a$: stringmathb$ = nator_b$: operator$ = "*"
CALL string_math
nator_c$ = runningtotal$
stringmatha$ = dator_a$: stringmathb$ = dator_b$: operator$ = "*"
CALL string_math
dator_c$ = runningtotal$
END SELECT
IF betatest% THEN
PRINT "nator_a$: "; nator_a$
PRINT "dator_a$: "; dator_a$
PRINT "nator_b$: "; nator_b$
PRINT "dator_b$: "; dator_b$
PRINT "nator_c$: "; nator_c$
PRINT "dator_c$: "; dator_c$
END IF
a$ = nator_c$: b$ = dator_c$: GOSUB greatest_common_factor
nator_c$ = numerator$: dator_c$ = denominator$
stringmatha$ = nator_c$: stringmathb$ = dator_c$: operator$ = "/"
CALL string_math
sa$ = runningtotal$
COLOR 15, 0: PRINT:
IF LEFT$(sa$, 1) = "-" THEN PRINT "Total: "; sa$ ELSE PRINT "Total: "; sa$
COLOR 7, 0
nator_a$ = nator_c$
dator_a$ = dator_c$
IF betatest% THEN COLOR 2, 0: PRINT: PRINT "nator_a$ ="; nator_a$, "dator_a$ = "; dator_a$: PRINT: COLOR 7, 0
RETURN
'=================================================================================
convert_to_fraction:
i = 0: j = 0: k = 0: msg$ = ""
IF MID$(n$, 1, 1) = "-" THEN j = 3 ELSE j = 2 ' Look for negative sign.
x1$ = MID$(n$, 1, INSTR(n$, ".") - 1)
IF j = 3 THEN x1$ = MID$(x1$, 2)
x2$ = MID$(n$, INSTR(n$, ".") + 1)
b$ = "1" + STRING$(LEN(x2$), "0")
x1$ = x1$ + x2$
DO UNTIL LEFT$(x1$, 1) <> "0"
x1$ = MID$(x1$, 2) ' Strip off any leading zeros
LOOP
IF j = 2 THEN a$ = x1$ ELSE a$ = "-" + x1$
z$ = ""
IF betatest% THEN PRINT "numerator and denomintor: "; a$, b$
numerator$ = a$: denominator$ = b$
RETURN
greatest_common_factor:
' GFC algorithm. -------------------------------------------------------------
gfca$ = a$: gfcb$ = b$
IF betatest% THEN PRINT "PRE GFC "; a$; " / "; b$
' Make both numbers positive.
IF MID$(gfca$, 1, 1) = "-" THEN gfca$ = MID$(gfca$, 2)
IF MID$(gfcb$, 1, 1) = "-" THEN gfcb$ = MID$(gfcb$, 2)
' STRING MATH < or > EVAL NOT NEEDED AS NEG NUMBERS ARE CONVERTED TO POS AND NO CHANCE OF 0 AND < 1 > 0 LIKE 0 AND .1 OCCURRING.
IF gfca$ < gfcb$ THEN SWAP gfca$, gfcb$
' MOD operation in string math.
DO
stringmatha$ = gfca$: stringmathb$ = gfcb$
operator$ = "/": CALL string_math
m1$ = runningtotal$
IF INSTR(m1$, ".") THEN m1$ = MID$(m1$, 1, INSTR(m1$, ".") - 1)
stringmatha$ = m1$
stringmathb$ = gfcb$
operator$ = "*": CALL string_math
m2$ = runningtotal$
stringmatha$ = gfca$: stringmathb$ = m2$
operator$ = "-": CALL string_math
SWAP gfca$, gfcb$: gfcb$ = runningtotal$
IF runningtotal$ = "0" THEN EXIT DO
LOOP
stringmatha$ = a$: stringmathb$ = gfca$
operator$ = "/": CALL string_math
numerator$ = runningtotal$
stringmatha$ = b$: stringmathb$ = gfca$
operator$ = "/": CALL string_math
denominator$ = runningtotal$
IF betatest% THEN COLOR 14, 0: PRINT "GFC "; numerator$; " / "; denominator$: COLOR 7, 0
RETURN
'===============================================================================
SUB string_math
SELECT CASE operator$
CASE "+", "-"
GOTO string_add_subtract
CASE "*"
GOTO string_multiply
CASE "/"
GOTO string_divide
CASE ELSE
PRINT "Error, no operator selected. operator$ = "; operator$
END SELECT
string_divide:
divsign% = 0 '''''''''''''''
divremainder& = 0: divremainder$ = "": divplace& = 0 AND divplace2& = 0: quotient$ = "": divcarry& = 0
operationdivision% = -1
divbuffer& = LEN(stringmathb$) - LEN(stringmatha$)
IF divbuffer& < 0 THEN divbuffer& = 0
d2dividend$ = stringmatha$
d1divisor$ = stringmathb$
IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": divsign% = 0: operationdivision% = 0: EXIT SUB: RETURN '*'
IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
IF LEFT$(d2dividend$, 1) = "-" THEN
IF divsign% THEN
divsign% = 0
ELSE
divsign% = -1
END IF
d2dividend$ = MID$(d2dividend$, 2)
END IF
IF INSTR(d1divisor$, ".") <> 0 THEN
DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
LOOP
divplace& = LEN(d1divisor$) - INSTR(d1divisor$, ".")
d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
DO UNTIL LEFT$(d1divisor$, 1) <> "0"
d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
LOOP
END IF
IF INSTR(d2dividend$, ".") <> 0 THEN
d2dividend$ = d2dividend$ + STRING$(divplace& - LEN(d2dividend$) - INSTR(d2dividend$, "."), "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
divplace2& = INSTR(d2dividend$, ".")
DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
LOOP
d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
ELSE
d2dividend$ = d2dividend$ + STRING$(divplace&, "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
divplace& = 0
END IF
DO
DO
divremainder& = divremainder& + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder&, 1)
IF MID$(d2dividend$, divremainder&, 1) = "" THEN
IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN divflag% = -1: EXIT DO
divcarry& = divcarry& + 1
IF divcarry& = 1 THEN divplace3& = divremainder& - 1
IF divcarry& > limit&& + 1 + divbuffer& THEN
divflag% = -2: EXIT DO
END IF
divremainder$ = divremainder$ + "0" ' No more digits to bring down.
END IF
IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
quotient$ = quotient$ + "0"
LOOP
IF divflag% THEN divflag% = 0: EXIT DO
FOR div_i% = 9 TO 1 STEP -1
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply
tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
DO
IF LEN(tempcutd$) = 1 THEN EXIT DO
IF LEFT$(tempcutd$, 1) = "0" THEN
tempcutd$ = MID$(tempcutd$, 2)
ELSE
EXIT DO
END IF
LOOP
IF LEN(tempcutd$) > LEN(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
NEXT
quotient$ = quotient$ + LTRIM$(STR$(div_i%))
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply
operator$ = "-"
stringmatha$ = divremainder$
stringmathb$ = m_product$
GOSUB string_add_subtract
divremainder$ = stringmatha$
operator$ = "/"
LOOP
IF divplace& = 0 AND divplace2& = 0 THEN divplace& = divplace3&
IF divplace2& THEN divplace& = divplace& + divplace2& - 1
IF quotient$ = "" THEN divplace& = 0 ' dividend is zero.
IF divplace& OR divplace2& THEN
quotient$ = MID$(quotient$, 1, divplace&) + "." + MID$(quotient$, divplace& + 1)
DO UNTIL RIGHT$(quotient$, 1) <> "0"
quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off trailing zeros
LOOP
IF RIGHT$(quotient$, 1) = "." THEN quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off abandoned decimal.
END IF
DO UNTIL LEFT$(quotient$, 1) <> "0"
quotient$ = MID$(quotient$, 2) ' Strip off leading zeros
LOOP
IF quotient$ = "" THEN quotient$ = "0": divsign% = 0
operationdivision% = 0
stringmathb$ = quotient$: quotient$ = ""
'''GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN divsign% = 0: operationdivision% = 0: EXIT SUB: RETURN '*'
'''GOSUB sm_converter
runningtotal$ = stringmathb$: stringmathb$ = ""
IF divsign% THEN runningtotal$ = "-" + runningtotal$
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
operationdivision% = 0 '''''
EXIT SUB ''' or RETURN to select case if goto changed to gosub.
string_multiply:
m_decimal_places& = 0: m_product$ = "" ''''''''''''''''''''''
fac1$ = stringmatha$: fac2$ = stringmathb$ ' Make numbers whole numbers and remove any - sign.
IF LEFT$(fac1$, 1) = "-" THEN fac1$ = MID$(fac1$, 2): m_sign% = -1
IF LEFT$(fac2$, 1) = "-" THEN fac2$ = MID$(fac2$, 2): IF m_sign% THEN m_sign% = 0 ELSE m_sign% = -1
IF INSTR(fac1$, ".") <> 0 THEN m_decimal_places& = LEN(fac1$) - INSTR(fac1$, "."): fac1$ = MID$(fac1$, 1, INSTR(fac1$, ".") - 1) + MID$(fac1$, INSTR(fac1$, ".") + 1)
IF INSTR(fac2$, ".") <> 0 THEN m_decimal_places& = m_decimal_places& + LEN(fac2$) - INSTR(fac2$, "."): fac2$ = MID$(fac2$, 1, INSTR(fac2$, ".") - 1) + MID$(fac2$, INSTR(fac2$, ".") + 1)
FOR m_i& = LEN(fac2$) TO 1 STEP -1 ' Multiply each charter top and bottom.
m_k& = m_l&
m_x2$ = MID$(fac2$, m_i&, 1)
FOR m_j& = LEN(fac1$) TO 1 STEP -1
m_x1$ = MID$(fac1$, m_j&, 1)
IF m_product$ <> "" THEN
m_add$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0")
m_t& = 0: m_xproduct$ = "": m_carry% = 0
DO ' Add multiplied characters together.
m_x3$ = MID$(m_add$, LEN(m_add$) - m_t&, 1)
m_x4$ = MID$(m_product$, LEN(m_product$) - m_t&, 1)
IF m_x3$ = "" AND m_x4$ = "" THEN
IF m_carry% THEN m_xproduct$ = "1" + m_xproduct$
EXIT DO
END IF
m_g% = VAL(m_x3$) + VAL(m_x4$) + m_carry%
IF m_g% >= 10 THEN m_g% = m_g% - 10: m_carry% = 1 ELSE m_carry% = 0
m_xproduct$ = LTRIM$(STR$(m_g%)) + m_xproduct$
m_t& = m_t& + 1
LOOP
m_product$ = m_xproduct$: m_xproduct$ = ""
ELSE
m_product$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0") ' First loop makes variable here.
END IF
m_k& = m_k& + 1 ' Adds trailing zeros multiplication
NEXT
m_l& = m_l& + 1 ' Used to reset value for m_k& adding one trailing zer for each loop.
NEXT
fac1$ = "": fac2$ = "": m_l& = 0: m_k& = 0: m_t& = 0
IF m_decimal_places& > LEN(m_product$) THEN m_product$ = STRING$(m_decimal_places& - LEN(m_product$), "0") + m_product$ ' Add any leading zeros to a decimal. Ex: .02 * .01 is factored as 002. It needs one leading zero before adding the decimal point, .0002.
IF m_decimal_places& AND m_product$ <> "0" THEN ' Replace any decimal point.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - m_decimal_places&) + "." + MID$(m_product$, LEN(m_product$) - m_decimal_places& + 1)
END IF
DO UNTIL LEFT$(m_product$, 1) <> "0" ' Remove leading zeros.
m_product$ = MID$(m_product$, 2)
LOOP
IF m_decimal_places& THEN
DO UNTIL RIGHT$(m_product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1)
LOOP
END IF
IF m_product$ = "" THEN m_product$ = "0": m_sign% = 0
IF RIGHT$(m_product$, 1) = "." THEN m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1) ' Remove decimal from the end of an integer total.
IF operationdivision% THEN m_sign% = 0: RETURN
stringmathb$ = m_product$: m_product$ = ""
'''GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN EXIT SUB: RETURN '*'
'''GOSUB sm_converter
runningtotal$ = stringmathb$: stringmathb$ = ""
IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
EXIT SUB ''' or RETURN to select case if goto changed to gosub.
string_add_subtract:
IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
sumplace& = LEN(stringmatha$) - INSTR(stringmatha$, ".")
stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
END IF
IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
numplace& = LEN(stringmathb$) - INSTR(stringmathb$, ".")
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
END IF
IF sumplace& > numplace& THEN addsubplace& = sumplace& ELSE addsubplace& = numplace&
IF sumplace& > addsubplace& THEN
stringmatha$ = stringmatha$ + STRING$(sumplace& - addsubplace&, "0")
ELSEIF addsubplace& > sumplace& THEN
stringmatha$ = stringmatha$ + STRING$(addsubplace& - sumplace&, "0")
END IF
IF numplace& > addsubplace& THEN
stringmathb$ = stringmathb$ + STRING$(numplace& - addsubplace&, "0")
ELSEIF addsubplace& > numplace& THEN
stringmathb$ = stringmathb$ + STRING$(addsubplace& - numplace&, "0")
END IF ' END Decimal evaluations.
IF LEFT$(stringmatha$, 1) = "-" THEN sign_input$ = "-" ELSE sign_input$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN sign_total$ = "-" ELSE sign_total$ = "+"
addsubsign% = 0
SELECT CASE sign_input$ + operator$ + sign_total$
CASE "+++", "+--"
operator$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
CASE "++-", "+-+"
operator$ = "-"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
CASE "---", "-++"
operator$ = "-"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$ ELSE addsubsign% = -1
CASE "--+", "-+-"
operator$ = "+"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
addsubsign% = -1
END SELECT
IF LEN(stringmatha$) > LEN(stringmathb$) THEN
stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
END IF
addsubx1$ = ""
SELECT CASE operator$
CASE "+", "="
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) + VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
GOSUB replace_decimal
CASE "-"
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) - VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replace_decimal
DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
addsubx1$ = MID$(addsubx1$, 2)
LOOP
IF addsubx1$ = "" THEN
addsubx1$ = "0": addsubsign% = 0
ELSE
IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
END IF
END SELECT
IF addsubsign% THEN
IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
END IF
stringmatha$ = addsubx1$: addsubx1$ = ""
IF operationdivision% THEN RETURN
stringmathb$ = stringmatha$: stringmatha$ = ""
IF LEFT$(stringmathb$, 1) = "-" THEN
stringmathb$ = MID$(stringmathb$, 2)
n2sign$ = "-"
ELSE
n2sign$ = ""
END IF
''' GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB: RETURN '*'
''' GOSUB sm_converter
runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
EXIT SUB ''' or RETURN to select case if goto changed to gosub.
replace_decimal:
IF addsubplace& THEN
addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
addsubplace& = addsubplace& - 1
LOOP
IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
END IF
RETURN
END SUB
Pete
|
|
|
|
| Map Explorer |
|
Posted by: SierraKen - 08-10-2022, 12:22 AM - Forum: Programs
- Replies (33)
|
 |
Today I wanted to make something I haven't made in awhile, a moving background map while you move your guy around. Except this time I wanted to see if I could do it without an already-made graphic file to use it with. So I figured out how to randomly generate a 3000 x 3000 graphic and save the file as a BMP picture file, which after loading and calculating, it deletes the 30 mb file (or so) that it makes. Feel free to add your own graphics to it. I added a lot of comments in the code. It was Felippe that originally posted how to make something like this probably around a year ago or 2. But I haven't seen much use of it. I used it with my Cave Fighter game awhile back, using the already made picture file. This one shows how to make each game or app have a randomly generated map each time you make it so it's different every time. This map generates random sized houses in different locations and round rocks. That's all I have for it so far so I might create a game with it or something later on. Feel free to do what you wish with it of course. Oh, I also made the guy move his arms and legs as he walks and he walks using the arrow keys. This isn't a game since there's nothing to achieve, but it's an example of how to make this. So when you are done just press Esc or the X.
Also, it would probably be best to put this in its own folder since it generates the explorer-map.bmp file and it automatically deletes it after it's done loading it. I got the BMP saving code from the Wiki pages and I added a couple of modification lines to it to show the timer in the Title Bar on how long it will take to finish loading (calculating) it before you can use it.
Note: I just noticed that it uses around 378 MB of RAM, just so you know.
Enjoy!
(Code deleted: Much better code a few pages from this post, without the extra .bmp file or loading time and much less memory RAM.)
|
|
|
|
| How fast is your OSes keyboard input? |
|
Posted by: SMcNeill - 08-09-2022, 05:24 AM - Forum: General Discussion
- Replies (9)
|
|
Inspired by Phil's topic about _KEYHIT (Trying to understand keyhit function (qb64phoenix.com), I couldn't help but become curious myself about how often do we need to poll _KEYHIT? Phil's original routine had a limitless loop polling for key events, which is something that I personally *never* think is a good idea. Unthrottled loops are for processing things inside a program -- not for waiting for the user to complete some interaction! What happens if the user suddenly has someone show up at their door at the moment it enters one of these input-feedback loops? They're not there to actually press a key, so what you're dealing with is basically nothing much more than a DO: LOOP which is going to use 100% CPU power, run your PC hot, kick the fans in, use more electricity, and do *NOTHING* beneficial for you!!
Obviously, there should be some sort of limit in how often we check the keyboard for an input event, so my mind instantly begins to ask, "How many times is enough to keep up with reading the buffer, as much as the OS writes to it?" How often does your keyboard record a keypress, and how often does it report it to you? Does it report those events every 1/10 second? every 1/100th? 1/1000??
Honestly, I don't know!!
So, I wrote this little bit of code below to try and see how often my OS would report key events for me:
Code: (Select All) Do
Do
k = _KeyHit
Loop Until k > 0 'some key is pressed down to start the timer
t## = Timer
count = 0 'reset count between loops
Do
k = _KeyHit
If k > 0 Then count = count + 1 'increase the count rate based on the keyboard repeat/limit cycle
Loop Until Timer > t## + 1
Print count; "in 1 second"
_KeyClear
Loop Until k = 27
We start a loop, wait for a key to be pressed down to start a simple timer. Then we count how many keydown events are reported in that second. Finally, we report that number and clear the buffer to recount the process once again, until the user finally hits the ESC key to end the program.
For me, my keyboard on my laptop has a repeat rate of almost consistently 30 key hits per second. (I get reports of 30 and then 31 and then 30 and then 31.... Which seems to be an artifact of rounding and floating point numbers in my opinion.) I think if I set a DO LOOP like these to _LIMIT 30, there'd be almost no noticeable change in how this program works.
Code: (Select All) Do
Do
k = _KeyHit
_Limit 30
Loop Until k > 0 'some key is pressed down to start the timer
t## = Timer
count = 0 'reset count between loops
Do
k = _KeyHit
If k > 0 Then count = count + 1 'increase the count rate based on the keyboard repeat/limit cycle
_Limit 30
Loop Until Timer > t## + 1
Print count; "in 1 second"
_KeyClear
Loop Until k = 27
Try the first program and see what type of results you get. Try the second, with a _Limit 30 placed inside each loop and see if the performance changes much (if any at all) for you. For me, there's absolutely no difference in performance, leading me to think that if I'm running a program with an endless _KEYHIT loop like these, then there's absolutely no reason for me to run them with anything faster than a _LIMIT 30 in them. On my laptop at least, I don't seem to get keyhit events any faster than 30 times per second, so it really doesn't seem like I'd need to use CPU resources and run my program usage up beyond that point.
What I'm curious about now is other people's computers/OS. How often does your system update and report a keyhit event? Is there anyone who runs much higher with a repeat rate faster than 30 times per second? _Limit 30 works fine for me, but would it be throttling down someone else's system too much??
Honestly, if I was going to code this for a working program, I'd probably just make it a _LIMIT 60, and say "Good enough!!" with it. Twice what mine reports, so I figure that'll handle the majority of PCs out there and still not use an excessive amount of resources. Anyone higher than that, can just sort the code out and tweak it themselves. ;D
|
|
|
|
| Trying to understand keyhit function |
|
Posted by: PhilOfPerth - 08-09-2022, 02:52 AM - Forum: Help Me!
- Replies (3)
|
 |
Trying to get my tiny brain around the _keyhit command... It seems to switch to the negative key value when the key is released, but with this simple piece, it seems to have retained its positive value. Where am I going wrong?
Code: (Select All) Color 0, 15: Cls
Message:
k = 0 ' I need this because _keyhit retains its positive (key pressed) value
Print "Press A or B"
Do Until k > 0 ' do this until _keyhit is positive
k = _KeyHit ' set k to _keyhit value
Loop
' now leave loop with k set at positive value from _keyhit
Select Case k
Case Is = 65, 97 ' "A" pressed
ResponseA
Case Is = 66, 98 ' "B" pressed
ResponseB
Case Else
WrongKey
End Select
Cls
GoTo Message
Sub ResponseA
Print "A pressed"
Sleep 1
End Sub
Sub ResponseB
Print "B pressed"
Sleep 1
End Sub
Sub WrongKey
Print "Wrong Key!"
Sleep 1
End Sub
|
|
|
|
| Game Tutorial Updated |
|
Posted by: TerryRitchie - 08-08-2022, 08:16 PM - Forum: Learning Resources and Archives
- Replies (22)
|
 |
I updated the game tutorial to now reflect links that point to qb64phoenix.com
All links on the home page have been updated. All images, links, and directions have been updated in Task 1 to reflect using the Phoenix site and resources to install QB64 and the tutorial asset files.
I need to go through all the other tasks and update the Wiki links to point to the phoenix Wiki as well.
I'm currently looking into using something like WordPress to bring this tutorial into the modern era. I currently use Notepad and Kompozer which is a big pain in the ASCII to use when it comes to updating things. I've never been great at HTML and a WYSIWYG solution would be ideal. I've looked at WordPress and Wix. Any thoughts?
Perhaps the tutorial could somehow be incorporated into the Phoenix Wiki?
|
|
|
|
| Gamma Eats |
|
Posted by: James D Jarvis - 08-08-2022, 04:53 PM - Forum: Programs
- No Replies
|
|
Along with being a hobbyist programmer I've been a tabletop RPG fan for over 40 years now. this program was written as a simple utility for my own home RPG campaign. The output will be amusing and baffling if you have no idea what this is all for. WhatI really want to share here is how I generate the lists using data reads and tags inside the data to build the lists.
The buildlist sub does most of the work. I keep fiddling with the data for lists like this so working up this sub to work as it does was the simplest approach for me. I could get fancy and make it work when reading from a data file but I haven't had the need to do that yet. I had an older method that restored to specific blocks of data but tracking the locations is very cumbersome in a more dymanic program model (can't keep labels in strings all by themselves).
I use a simple trick to randomly select an entry from each list (which are each string arrays). I record the upper bound when the list is read and shove it into element 0 for recalling later. I could probably just do the Ubound call but I have another utility that uses similar lists where I use a more complicated dice roller algorithm that stores the dice range in that position so I'm keeping the general method consistent across programs.
The output goes to a console window so I can copy and paste the output into another document with ease and don't have to worry about tracking data files and then just copying and pasting into my game documents later.
I could have created a boringly generic example to share, but that's just not much fun.
Code: (Select All) 'gamma eats
'generate specific dishes available in Gamma World shelters, hovels, and roadside diners
'Some of data here comes from the 1st edition of the GammaWorld RPG orignally published by TSR games and is used without explict permission as fan support materials
$ScreenHide
'$dynamic
Randomize Timer
$Console
_Console On
_Dest _Console
_ScreenHide
Dim Shared critter$(999), bug$(999), egg$(999), larva$(999), milk$(999)
Dim Shared vegimal$(999), vegipart$(999), broth$(999), meatprep$(999), meatpart$(999)
Dim Shared eggprep$(999), cereal$(999), Baked$(999), pasta$(999), dairy$(999), vegprep$(999)
Dim Shared mixedmeal$(999), sauce$(999), oldfoodflavor$(999), oldfoodform$(999), oldcontainer$(999)
buildlist "/start:critter", critter$()
buildlist "/start:bug", bug$()
buildlist "/start:egg", egg$()
buildlist "/start:larva", larva$()
buildlist "/start:milk", milk$()
buildlist "/start:vegimal", vegimal$()
buildlist "/start:vegipart", vegipart$()
buildlist "/start:broth", broth$()
buildlist "/start:meatprep", meatprep$()
buildlist "/start:meatpart", meatpart$()
buildlist "/start:eggprep", eggprep$()
buildlist "/start:cereal", cereal$()
buildlist "/start:baked", Baked$()
buildlist "/start:pasta", pasta$()
buildlist "/start:dairy", dairy$()
buildlist "/start:mixedmeal", mixedmeal$()
buildlist "/start:vegprep", vegprep$()
buildlist "/start:sauce", sauce$()
buildlist "/start:oldfoodflavor", oldfoodflavor$()
buildlist "/start:oldfoodform", oldfoodform$()
buildlist "/start:oldcontainer", oldcontainer$()
For reps = 1 To 20
pick = Int(1 + Rnd * 16)
Select Case pick
Case 1, 2
DD$ = "Salad of "
a$ = vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
If Rnd * 6 < 4.2 Then a$ = vegprep$(1 + Int(Rnd * 5)) + " " + a$
b$ = vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
If a$ = b$ Then b$ = meatprep$(1 + Int(Rnd * 3)) + " " + vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
DD$ = DD$ + a$ + " and " + b$
Case 3
DD$ = vegimal$(1 + Int(Rnd * 8)) + " " + cereal$(1 + Int(Rnd * 4))
Case 4
a$ = eggprep$(1 + Int(Rnd * 9))
b$ = " " + egg$(1 + Int(Rnd * 10)) + " eggs"
C$ = " "
If a$ = "Omelette" Then
a$ = "Omelette of"
C$ = " with " + vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
End If
If Rnd * 6 < 4 Then
DD$ = a$ + b$ + C$
Else
DD$ = a$ + b$ + C$ + " and " + Baked$(1 + Int(Rnd * 6))
End If
Case 4, 5, 6
a$ = meatprep$(1 + Int(Rnd * Val(meatprep$(0))))
b$ = critter$(1 + Int(Rnd * Val(critter$(0))))
DD$ = a$ + " " + b$
Select Case Int(1 + Rnd * 10)
Case 1
DD$ = DD$ + " smothered in " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce"
Case 2
DD$ = DD$ + " drizzled with " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce"
Case 3
DD$ = DD$ + " served in a puddle of " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce"
Case 4
DD$ = DD$ + " in red-eyed gravy"
Case 5
DD$ = DD$ + " with a generous portion of seasoned pan-drippings"
Case 6
DD$ = DD$ + " with a thin sauce of drippings"
Case 7, 8
DD$ = DD$ + " with some " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce on the side"
Case 9, 10
End Select
Case 7, 8
a$ = pasta$(1 + Int(Rnd * Val(pasta$(0))))
b$ = sauce$(1 + Int(Rnd * Val(sauce$(0))))
C$ = milk$(1 + Int(Rnd * Val(milk$(0)))) + " cheese"
Select Case Int(1 + Rnd * 12)
Case 1, 2
DD$ = a$ + " served with a " + b$ + " sauce"
Case 3, 4
DD$ = a$ + " mixed with a " + b$ + " sauce"
Case 5, 6
DD$ = a$ + " and " + C$
Case 7, 8, 9
DD$ = a$ + " served in a thin broth"
Case 10
DD$ = a$ + " served with a " + b$ + " sauce and " + C$
Case 11
DD$ = "Plain " + a$
Case 12
DD$ = "Plain" + a$ + " and a bottle of ketchup"
End Select
Case 9
Select Case Int(1 + Rnd * 9)
Case 1, 2, 3, 4
a$ = critter$(1 + Int(Rnd * Val(critter$(0))))
Case 5, 6
a$ = bug$(1 + Int(Rnd * Val(bug$(0))))
Case 7, 8, 9
a$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0))))
End Select
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3
b$ = "burger"
Case 4, 5
b$ = "slider"
Case 6
b$ = "patties"
End Select
Select Case Int(1 + Rnd * 8)
Case 1, 2, 3
C$ = "with a melted slice of " + milk$(1 + Int(Rnd * Val(milk$(0)))) + " cheese"
Case 4
C$ = "smothered in " + milk$(1 + Int(Rnd * Val(milk$(0)))) + " cheese"
Case 5, 6
C$ = " with an ancient slice of processed cheese-food"
Case 7, 8
C$ = "plain"
End Select
Select Case Int(1 + Rnd * 6)
Case 1, 2
d$ = " on a toasted bun"
Case 3
d$ = " on a stale bun"
Case 4
d$ = " on toasted bread"
Case 5, 6
d$ = " on soggy bread"
End Select
If C$ = "plain" Then
DD$ = a$ + " " + b$ + d$
Else
DD$ = a$ + " " + b$ + " " + C$ + d$
End If
Case 10 'full gamma breakfast
a$ = eggprep$(1 + Int(Rnd * Val(eggprep$(0)))) + " " + egg$(1 + Int(Rnd * Val(egg$(0)))) + " eggs "
b$ = meatprep$(1 + Int(Rnd * Val(meatprep$(0)))) + " " + critter$(1 + Int(Rnd * Val(critter$(0))))
If Int(Rnd * 6) < 3.5 Then
b$ = b$ + "," + Str$(2 + Int(Rnd * 3)) + " slices of CRAM"
End If
C$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0)))) + " " + cereal$(1 + Int(Rnd * Val(cereal$(0))))
d$ = vegprep$(1 + Int(Rnd * Val(vegprep$(0)))) + " " + vegimal$(1 + Int(Rnd * Val(vegimal$(0)))) + " " + vegipart$(1 + Int(Rnd * Val(vegipart$(0))))
e$ = Baked$(1 + Int(Rnd * Val(Baked$(0))))
Select Case Int(1 + Rnd * 12)
Case 1, 2
e$ = " a warm " + e$
Case 3
e$ = " rock hard " + e$
Case 4
e$ = " stale " + e$
Case 5, 6
e$ = " toasted " + e$
Case 7
e$ = " crumbling " + e$
Case 8
e$ = " soggy " + e$
Case 9, 10, 11, 12
e$ = e$
End Select
DD$ = a$ + ", " + b$ + ", " + C$ + ", " + d$ + " and " + e$
Case 11, 12, 13
Select Case Int(1 + Rnd * 10)
Case 1, 2, 3
a$ = critter$(1 + Int(Rnd * Val(critter$(0))))
Case 5, 6
a$ = bug$(1 + Int(Rnd * Val(bug$(0))))
Case 7, 8, 9, 10
a$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0))))
End Select
b$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0)))) + " " + vegipart$(1 + Int(Rnd * Val(vegipart$(0))))
C$ = broth$(1 + Int(Rnd * Val(broth$(0))))
Select Case Int(1 + Rnd * 12)
Case 1, 2, 3
t$ = "A warm bowl of "
Case 4, 5, 6
t$ = "A piping hot bowl of "
Case 7
t$ = "A cold bowl of "
Case 8, 9
t$ = "A tepid cup of "
Case 10, 11, 12
t$ = "A warm cup of "
End Select
DD$ = t$ + a$ + " and " + b$ + " " + C$
Case 14, 15, 16
a$ = oldfoodflavor$(1 + Int(Rnd * Val(oldfoodflavor$(0))))
b$ = oldfoodform$(1 + Int(Rnd * Val(oldfoodform$(0))))
C$ = oldcontainer$(1 + Int(Rnd * Val(oldcontainer$(0))))
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3
C$ = "A freshly opened " + C$ + " of"
Case 4, 5
C$ = "Half a " + C$ + " of"
Case 6
C$ = "Some"
End Select
DD$ = C$ + " " + a$ + " " + b$
If Rnd * 6 < 4.5 Then
Select Case Int(1 + Rnd * 8)
Case 1, 2
DD$ = DD$ + ", stale"
Case 3, 4
DD$ = DD$ + ", has a chemical aftertaste"
Case 5
DD$ = DD$ + ", surpirsingly tasty"
Case 6
DD$ = DD$ + ", bland"
Case 7
DD$ = DD$ + ", it smells a bit off"
Case 8
DD$ = DD$ + ", it smells a bit off but tastes fine"
End Select
End If
Case 17, 18
a$ = mixedmeal$(1 + Int(Rnd * Val(mixed$(0))))
Select Case Int(1 + Rnd * 4)
Case 1
b$ = critter$(1 + Int(Rnd * Val(critter$(0))))
Case 2
b$ = bug$(1 + Int(Rnd * Val(bug$(0))))
Case 3, 4
b$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0))))
End Select
C$ = oldfoodflavor$(1 + Int(Rnd * Val(oldfoodflavor$(0)))) + " " + oldfoodform$(1 + Int(Rnd * Val(oldfoodform$(0))))
If Rnd * 8 < 5 Then
C$ = C$ + ", " + oldfoodflavor$(1 + Int(Rnd * Val(oldfoodflavor$(0)))) + " " + oldfoodform$(1 + Int(Rnd * Val(oldfoodform$(0))))
End If
d$ = sauce$(1 + Int(Rnd * Val(sauce$(0))))
DD$ = a$ + " of " + b$ + "," + C$ + " with a " + d$ + " sauce "
If Rnd * 8 < 4 Then
DD$ = DD$ + "and " + milk$(1 + Int(Rnd * Val(milk$(0)))) + dairy$(1 + Int(Rnd * Val(dairy$(0))))
End If
End Select
If reps < 10 Then Print " ";
If reps > 9 And reps < 100 Then Print " ";
Print _Trim$(Str$(reps)); "." + " " + _Trim$(DD$)
Next reps
'eatbale critters
Data "/start:critter","Barl Nep","Blight","Brutorz","Centisteed","Cren Tosh","Ert","Fleshin","Herkel","Hopper"
Data "Keeshin","Podog","Rakox","Sep","Terl","Zarn","Rat","/END"
'edible bugs
Data "/start:bug","Arn","Blaash","Herp","Parn","Soul Besh","Locust","Roach","Ant","/END"
'critter eggs
Data "/start:egg","Arn","Barl Nep","Blassh","Blight","Cal Then","Ert Telden","Fleshin","Herp","Terl","Ant","/END"
'critter larva
Data "/start:larva","Arn","Blash","Blight","Cal Then","Herp","Parn","Soul Besh","Ant","/END"
'critter milk
Data "/start:milk","Brutorz","Hopper","Centisteed","Rakox","/END"
'vegimals
Data "/start:vegimal","Crep Plant","Horl Choo","Kai Lin","Kep","Narl Ep","Pineto","Seroon Lou","Zeeth","/END"
'vegparts
Data "/start:vegipart","Fronds","Shoots","Seeds","Roots","Starch","Leaves","Pulp","Stalk","Sprouts","/END"
'broths
Data "/start:broth","Broth","Stew","Soup","Chowder","Bisque","Goulash","Gumbo","/END"
'meatprep
Data "/start:meatprep","Dried","Pickled","Roasted","Salted","Jerked","Smoked","Corned","Minced","Shredded","Cured"
Data "Jellied","Deep-Fried","Seared","Fried","Baked","Boiled","/END"
'meatparts
Data "/start:meatpart","Brain","Tongue","Belly","Shank","Liver","Kidney","Foot","Ear","Chitlins","Offal","/END"
'eggprep
Data "/start:eggprep","Boiled","Fried","Scrambled","Poached","Omelette","Shirred","Basted","Pickled","Scotched","/END"
'mixedmeal
Data "/start:mixedmeal","Casserole","Dumplings","Pie","Turnovers","Jambalya","Scramble","Hash","/END"
'cereals
Data "/start:cereal","Porridge","Gruel","Mush","Mash","/END"
'bakedgoods
Data "/start:baked","Bread","Flatbread","Cake","Biscuit","Cracker","Muffin","/END"
'pasta
Data "/start:pasta","Noodles","Raviolli","Spaghetti","Couscous","Lasagna","/END"
'dairy
Data "/start:dairy","Milk","Cheese","Yogurt","Cream","Curds","Butter","Cottage Cheese","/END"
'vegprep
Data "/start:vegprep","Fresh","Dried","Sun-dried","Pickled","Fermented","Blanched","Seared","Roasted","/END"
'sauces
Data "/start:sauce","Garlic","Thin","Zesty","Fruity","Peppery","Spicy","Piquant","Tangy","Bar-B-Q","Bitter","Savory","Creamy","Green","Red","Cheese","/END"
Data "/start:oldfoodflavor","Cheez","Vega","Vegi","Vegamax","Krilla","Bean","Oat","Soy","Fruity","Choco","Berry","Baaf"
Data "Chucken","Tarkey","Fush","Lomb","Loobster","Crob","Clum","Chom","Nilla","Wheati","Graino","Corn"
Data "Tatter","Potato","Beef","Chicken","Turkey","Fish","Lamb","Soylent","Prawn","Mussel","Mackrel","Tuna"
Data "Pork","Pirk","Melom","Nut","Seed","Peanut","Ginger","Bar-B-Q","Nutri","Nutra","Nutria","Sugar"
Data "Sweet","Honey","Hunee","Coffee","Protien","Prolean","Simulean","Maxilean","Leano","Mushroom","Mashroom","Beefalo","/END"
Data "/start:oldfoodform","Paste","Chews","Tubes","Dumplings","Pockets","Loaf","Biscuits","Crackers","Wafers","Flakes"
Data "Powder","Jelly","Sauce","Curry","Soup","Stew","Broth","Chowder","Crisps","Sausage"
Data "Chili","Steak","Leather","Sticks","Jerky","Milk","Syrup","Nectar","Water","Spread","Puffs"
Data "Butter","Borritos","Wraps","Cubes","Mash","Drink","Granola","Cake","Pie","Muffin","/END"
Data "/start:oldcontainer","Can","Packet","Cup","Readi-Bowl","Insta-cup","Lunch-Pack","Box","Bottle","Jar","Pouch","/END"
Sub buildlist (flag$, list$())
Restore
n = 0
flagfound = 0
Do
Read d$
If flagfound = 1 And d$ <> "/END" Then
n = n + 1
list$(n) = d$
End If
' Print d$
If d$ = flag$ Then flagfound = 1
Loop Until d$ = "/END" And flagfound = 1
ReDim _Preserve list$(n)
top$ = Str$(UBound(list$))
list$(0) = _Trim$(top$)
'Input check$
End Sub
|
|
|
|
|
![[Image: lunar-lander-bloatware-v0-81.png]](https://i.ibb.co/zH0p3f3/lunar-lander-bloatware-v0-81.png)
