I know QBPE is a compiler, which makes it great, but I end up with MANY *.exe files that accumulate that I don't want. Can I choose to have a "temp.exe" for example that would overwrite the previous version?
Working (playing) with the "PSET hat" program, I wanted to see some math functions. So another QB64 program was needed.
I know there are online function plotting and other QBPE programs, but I like simplicity, and I like my own. So here is what I use for plotting functions. Since you have to compile it to put in your functions, I put in comments to document the use of it. I hope it is clear. This version has a variety of functions for demonstration. I reserve the right to edit this to later versions.
Code: (Select All)
_Title "FunctionPlot" ' V1.0 dcromley 2022
Option _Explicit
DefSng A-Z: DefInt I-N: DefStr S
Screen _NewImage(1000, 750, 256)
Cls 0, 15: Color 0, 15
Dim Shared ulo, uhi, vlo, vhi, xlo, xhi, ylo, yhi
Dim Shared u, v, x, y, c, nfunc, xold, yold
ulo = 10: uhi = 989: vlo = 739: vhi = 10 ' screen limits
xyinit -8, 8, 1, -6, 6, 1 ' xlo xhi xdel; ylo yhi ydel =#= world limits
' the above line means x from -8 to +8 and grid lines every 1; 0 would be no grid lines
For nfunc = 1 To 9
c = 0 ' default color
For u = ulo To uhi: x = zxu(u) ' x
If nfunc = 1 Then y = 1 - x ^ 2 / 2
If nfunc = 2 Then y = Cos(x)
If nfunc = 3 Then c = 2: y = Sin(x)
If nfunc = 4 Then GoTo continue1 ' skip
If nfunc = 5 Then y = func5(x)
If nfunc = 6 Then y = func6(x, 1)
If nfunc = 7 Then GoTo continue1
If nfunc = 8 Then GoTo continue1
If nfunc = 9 Then GoTo continue1
If u > ulo Then zline xold, yold, x, y, c ' the plot lines
xold = x: yold = y
continue1:
Next u
Next nfunc
zSystem ' end
Function func5 (x) '
If x < 0 Then func5 = 0: Exit Function
c = 1 ' blue
Dim t: t = Sqr(x)
func5 = Sqr(x) ' Sin(t) + .4 * Sin(3 * x)
End Function
Function func6 (x, N) ' 2 options in this function
c = 4 ' red
If N = 1 Then func6 = 8 * (1 / 2 * Cos(x) - 1 / 7 * Cos(3 * x) + 1 / 8 * Cos(5 * x))
If N = 2 Then func6 = 8 * (.5 * Cos(x) - .125 * Cos(3 * x) + .07 * Cos(5 * x))
End Function
Sub xyinit (xxlo, xxhi, xdel, yylo, yyhi, ydel)
xlo = xxlo: xhi = xxhi: ylo = yylo: yhi = yyhi ' save to globals
If xdel > 0 Then ' vertial grid lines
zline 0, ylo, 0, yhi, c ' y axis
For x = xdel To zMax(Abs(xlo), Abs(xhi)) Step xdel ' other
If zBetween(x, xlo, xhi) Then zline x, ylo, x, yhi, 7
If zBetween(-x, xlo, xhi) Then zline -x, ylo, -x, yhi, 7
Next x
End If
If ydel > 0 Then ' horizontal grid lines
zline xlo, 0, xhi, 0, c ' x axis
For y = ydel To zMax(Abs(ylo), Abs(yhi)) Step ydel ' other
If zBetween(y, ylo, yhi) Then zline xlo, y, xhi, y, 7
If zBetween(-y, ylo, yhi) Then zline xlo, -y, xhi, -y, 7
Next y
End If
End Sub
Sub zline (x1, y1, x2, y2, c)
Line (zux(x1), zvy(y1))-(zux(x2), zvy(y2)), c
End Sub
Function zux (x)
zux = zLerplh(ulo, uhi, x, xlo, xhi)
End Function
Function zvy (y)
zvy = zLerplh(vlo, vhi, y, ylo, yhi)
End Function
Function zxu (u)
zxu = zLerplh(xlo, xhi, u, ulo, uhi)
End Function
Function zyv (y)
zyv = zLerplh(ylo, yhi, v, vlo, vhi)
End Function
Function zLerplh (ylo, yhi, x, xlo, xhi)
zLerplh = ylo + (x - xlo) / (xhi - xlo) * (yhi - ylo)
End Function
Function zBetween (x, a, b)
If x >= a And x <= b Then zBetween = 1
End Function
Function zMax (a, b)
If a > b Then zMax = a Else zMax = b
End Function
Function zMin (a, b)
If a < b Then zMin = a Else zMin = b
End Function
Sub zSystem
While InKey$ = "": _Limit 60: Wend
System
End Sub
Since QB64 Phoenix Edition is a newly created offshoot of QB64, people have had various questions about who we are, what we're doing, and what ties we have with QB64 -- and they want to know what's up with our new releases. Let me address those things one at a time for everyone:
Since Fellippe just walked away from the QB64 Team, things turned into a mess almost overnight with the new CEO. Issues arose on the Discord, and I'm not going into any details over those things here as it'd just be rehashing the same old news over and over by now. In the end, QB64 as it existed previously was destroyed. The old team was completely removed from the repo, with all rights to push, pull, merge, or do releases taken from them. The forums were shut down. The wiki was taken offline. QB64 was burnt to the ground.
Until we stepped in. The Phoenix Edition worked hard to get the first editable wiki back up on the internet, from an old off-line that had been preserved, so people could have a working reference for the QB64 commands. We worked to get up a new set of forums so the community could regather and not fragment into a thousand broken pieces. We've worked hard on gathering up and making all the old resources as available to the public as we possibly can, and hosting as much old information on our servers as we can possibly find and share such as the old Podcasts and transcripts from those.
Most importantly, we've cloned the old repo and have been working fairly fervently to update the source to bring QB64 once again up to a stable version. If you look at our repo, we've already had 54 commits pushed into it, showing there's been a LOT of activity by the recent team working on things. We're the new team working hard so that QB64 doesn't die, as the new CEO obviously intended for it to do!
Now, as to who we are, let me reassure the folks that are out there worrying -- we're not some random strangers who just popped up overnight and decided to steal QB64 for our own nefarious gains. I've personally been with QB64 since about version 0.5, and I've been pushing code into the source and developing QB64 for about 10 years now. For the folks who don't believe it (there's always a few naysayers out there), here's a simple test you can use to check the verity of my words: Open the oldest version of QB64.bas that you can find, and simply do a search for "Steve". Almost instantly you'll see multiple places like " '### STEVE EDIT FOR CONST EXPANSION 10/11/2013" in the source.
That goes all the way back and predates the "QB64 Team" by several years!
And I'm not the only member of The Phoenix Edition who has been working and pushing changes into QB64 since about forever!
As you can see from the above, it's a screenshot taken from the github commit history with Galleon (the original creator of QB64), me, and DSMan all working on pushing changes and enhancements into QB64. DSMan (Matt) is now back and rejoined The Phoenix Edition, and is working to help us restore QB64 back to a fully stable, working version, once again. Just like me, he's been around forever and ever, and he's always been one of the people most welcome to help develop the language.
As for the rest of our team -- Spriggsy, Cobalt, and Maxine, they're a little newer on the QB64 development history than we are, but you'll find their contributions in the old team's source as well. None of us are "new" to QB64, and all of us have deep ties to the old QB64 Team, and we've worked on the language for ages.
So if we were part of the QB64 team, why aren't we now? Why did we migrate over to become "The Phoenix Edition"?
As you can see from the two screenshots above, before RC Cola burned down all the old QB64 content -- the forums, wiki, twitter, youtube, podcasts, and all else he could destroy -- he made a point of kicking and removing everyone from the project. With the old sites and repo no longer available for us, we had to move on to somewhere, and the domain name and such for qb64phoenix.com was available, so why not it? QB64.com as a domain name was for sell for close to $2000. qb64phoenix.com cost $15.00, or so. Since we were trying to rise up out of the ashes that RC Cola had left us in, it seemed like a fitting new name for the project moving forward.
So, why didn't we just stick with the plain old "QB64" that everyone is used to and knew? Several reasons.
First -- to distance ourselves from that drama. QB64 Team was burned to the ground and destroyed by its CEO. Who wants to be associated with such an act, and actor?
Second -- so that people won't think they're supporting us if they donate to the "QB64 Team". If you're sending money to their patreon, buying cups or mugs with the old logo on them, you're not supporting us one bit. Several people have offered to help donate and pay to help get the new project up and going, but that's not neccessary. We're hobbyists, and this is our hobby. We do what we do out of love for the language, and for the fun of expanding upon a language we love, and we don't do it for money. Nobody is earning a cent anywhere to work for us, and help develop the Phoenix Edition. Our overhead costs are just what it costs us to host the server and such, and that's all covered here: Forum Costs and Donations (qb64phoenix.com)
Third -- Even though RC Cola thoroughly kicked and destroyed the old team, he's still the CEO of "Team QB64". Unlike Galleon, who walked away and passed over the reigns to a new team of developers with his blessing, RC Cola left things in as messy of a state as he possibly could. His last post on the patreon ended with:
Quote:We will keep the Github Repo up and if their is enough people wanting to keep it alive please keep developing and we may come back.
...we may come back.
So there you have it! What's the future on that? MAY??
If we were to just pick up and continue to develop under the plain QB64 banner as before, and RC Cola suddenly decides to come back with a new team in the year or two, where would we be left standing? How much confusion would that generate for the public?
"Hey Frank, what version of QB64 did you compile your code under?"
"Version 2.7."
"2.7?? But I'm compiling under version 3.2!"
"OH.. You must have that other QB64..."
No thanks. Not interested in even thinking about that type scenario.
RC Cola hasn't passed on "QB64" to anyone, and in an attempt to prevent any issues before they could ever arise from that, we're calling ourselves "QB64 Phoenix Edition" or "QBPE" for short.
(04-28-2022, 10:16 AM)Coolman Wrote: thank you for your work. is this version based on qb64 2.01?
To address this concern, let me say, "It absolutely is." In fact, our version 0.5 picks directly up from the last version of the QB64 team and builds upon it from there. We're not officially ready to say we're at a version 1.0 (which should tend to state it's a fully stable version), but we're working our way towards that end goal. When we cloned the repo, we chose to continue work off the development branch, rather than the stable branch. We didn't want to lose anyone's contributions to the language since v2.02, as the team was moving closer to a version 2.1 release later this year.
Unfortunately though, some of the people who were developing for v2.1 have walked away from the project for good, like Fellippe. Before we feel confident in saying everything is 100% stable and glitch free, we need some time to go over what those missing developers were attempting to work on and push into the language. We need to hunt down anything that connects to the old site and remove dead links, html calls, and all that good stuff. The QB64 source code has a LOT of lines to sort through, and we're not 100% confident that we've purged all those old, dead, references and such, and we're not 100% certain that all the old works in development are glitch free, so we're not confident about saying we're at version 1.0
IF we'd continued on as just QB64, our version number would probably now be version 2.0.5, but as things stand with the uncertainty about what RC Cola plans to do with the "Team QB64" which he now solely controls, we instead are calling this QB64 Phoenix Edition v0.5.
You can think, in many ways, of "Phoenix Edition" being 2.0, if you like.
(04-28-2022, 10:44 AM)PhilOfPerth Wrote: Pardon my ignorance, but what's the simplest way to transition from the old tQB64 to the new one? Will I need to move my "home-grown" files, or anything else, into a new directory?
Simplest way is the same as always -- just download and extract the new version from our github. If you have your own files saved in a different directory, just be certain to check the option under "RUN" in the IDE for "Export EXE to source folder", so that your EXE will be placed in the proper folders of your choosing.
Feel free to ask any and all questions and concerns that you guys might have, and I'll be happy to answer them to the best of my ability here for everyone.
Another step forward in making our first version "1.0" as the new team working on QB64. This release (version 0.5) now:
Has swapped out the mingw compilers to updated versions for Windows users.
Reduced the size of the repo considerably for those who wish to download direct and setup QB64 manually, for whatever reason.
Prepacked Linux and max versions of QB64, which come in at less than 10MB each now.
We've swapped out all the references to the now defunct .net and .org sites that we could find, and replaced them to proper, working links which now connect to our new wiki, forum, and all at qb64phoenix.com.
$Color:0 and $Color:32 has now been tweaked to work with $NoPrefix. Color names will remain the same in all cases, if $Color is used without $NoPrefix. When $Color is used in conjunction with $NoPrefix, the colors of Red, Green, and Blue which would normally conflict with the now underscoreless commands of _Red, _Green, _Blue, have been altered to have NP_appended to them (for No Prefix). Example: Color NP_Red, Orange for a red on orange color.
Click on the big title above to go directly to the release page and grab yourself a copy of the latest version for all your QB64 needs!
Here's a little something I wrote and posted on FidoNet back in 1997. It's just an illustration of some of the styles of line that you can have when you use the LINE command. If nothing else grab one or more of the included constants at the top of the code. When run you will get a small window that shows the linestyles (maybe too small for anything larger than full HD).
Code: (Select All)
'===========================================================================
' Subject: DIFFERENT LINE STYLES Date: 12-22-97 (12:06)
' Author: TarotRedhand Code: QB
'===========================================================================
'Just for a change I am posting a small program that illustrates what
'is probably an underused parameter of a well known command, LINE. If
'you check out either the manual or the help system, you will see that
'the final (optional) parameter that can be passed to the LINE
'statement is one called linestyle. In order to show what this
'parameter can produce when properly used here are 13 (12a? <g>)
'constants, for you to use, that are part of the following small
'program.
This is a dynamic array that resizes itself as you add to or remove from it.
each entry has 2 properties: whichType and Content.
whichType tells what kind of variable is stored, and Content is what the variable contains.
whichType is a _byte and content is always a string. variables are converted to/from strings by the subs/functions.
here is the code, maybe it might be useful:
Code: (Select All)
Option _Explicit
Type Limits
Minimum As _Byte
Maximum As _Unsigned _Integer64
Current As _Unsigned _Integer64
End Type
Type Entry 'global array
whichType As _Byte
Content As String
End Type
Dim Shared theLimit As Limits
ReDim Shared theBase(theLimit.Minimum) As Entry
'
theLimit.Minimum = 0
theLimit.Maximum = 0 - 1
'
theLimit.Current = theLimit.Minimum
' End Declarations
Dim test1%%
Dim test2&&
Dim test3~&&
Dim test4##
Dim test5$
Function trim$ (theInput As String)
trim = LTrim$(RTrim$(theInput))
End Function
Sub add_byte (theInput As _Byte)
add_Item
theBase(theLimit.Current).Content = trim$(Chr$(theInput))
theBase(theLimit.Current).whichType = 1
End Sub
Sub add_int (theInput As _Integer64)
add_Item
theBase(theLimit.Current).Content = trim$(_MK$(_Integer64, theInput))
theBase(theLimit.Current).whichType = 2
End Sub
Sub add_uint (theInput As _Unsigned _Integer64)
add_Item
theBase(theLimit.Current).Content = trim$(_MK$(_Unsigned _Integer64, theInput))
theBase(theLimit.Current).whichType = 3
End Sub
Sub add_float (theInput As _Float)
add_Item
theBase(theLimit.Current).Content = trim$(_MK$(_Float, theInput))
theBase(theLimit.Current).whichType = 5
End Sub
Sub add_str (theInput As String)
add_Item
theBase(theLimit.Current).Content = trim$(theInput)
theBase(theLimit.Current).whichType = 7
End Sub
Sub add_Item
theLimit.Current = theLimit.Current + 1
ReDim _Preserve theBase(theLimit.Current) As Entry
End Sub
Function get_byte%% (Selector As _Unsigned _Integer64)
get_byte = Asc(theBase(Selector).Content)
End Function
Function get_int&& (Selector As _Unsigned _Integer64)
get_int = _CV(_Integer64, theBase(Selector).Content)
End Function
Function get_uint~&& (Selector As _Unsigned _Integer64)
get_uint = _CV(_Unsigned _Integer64, theBase(Selector).Content)
End Function
Function get_float## (Selector As _Unsigned _Integer64)
get_float = _CV(_Float, theBase(Selector).Content)
End Function
Function get_str$ (Selector As _Unsigned _Integer64)
get_str = trim$(theBase(Selector).Content)
End Function
Sub rm_byte (Selector As _Unsigned _Integer64)
theBase(Selector).whichType = 0
theBase(Selector).Content = ""
Dim rm_global_B_inc
For rm_global_B_inc = Selector To theLimit.Current - 1
theBase(rm_global_B_inc).whichType = theBase(rm_global_B_inc + 1).whichType
theBase(rm_global_B_inc).Content = theBase(rm_global_B_inc + 1).Content
Next rm_global_B_inc
rm_Item
End Sub
Sub rm_int (Selector As _Unsigned _Integer64)
theBase(Selector).whichType = 0
theBase(Selector).Content = ""
Dim rm_global_I_inc
For rm_global_I_inc = Selector To theLimit.Current - 1
theBase(rm_global_I_inc).whichType = theBase(rm_global_I_inc + 1).whichType
theBase(rm_global_I_inc).Content = theBase(rm_global_I_inc + 1).Content
Next rm_global_I_inc
rm_Item
End Sub
Sub rm_uint (Selector As _Unsigned _Integer64)
theBase(Selector).whichType = 0
theBase(Selector).Content = ""
Dim rm_global_UI_inc
For rm_global_UI_inc = Selector To theLimit.Current - 1
theBase(rm_global_UI_inc).whichType = theBase(rm_global_UI_inc + 1).whichType
theBase(rm_global_UI_inc).Content = theBase(rm_global_UI_inc + 1).Content
Next rm_global_UI_inc
rm_Item
End Sub
Sub rm_float (Selector As _Unsigned _Integer64)
theBase(Selector).whichType = 0
theBase(Selector).Content = ""
Dim rm_global_F_inc
For rm_global_F_inc = Selector To theLimit.Current - 1
theBase(rm_global_F_inc).whichType = theBase(rm_global_F_inc + 1).whichType
theBase(rm_global_F_inc).Content = theBase(rm_global_F_inc + 1).Content
Next rm_global_F_inc
rm_Item
End Sub
Sub rm_str (Selector As _Unsigned _Integer64)
theBase(Selector).whichType = 0
theBase(Selector).Content = ""
Dim rm_global_S_inc
For rm_global_S_inc = Selector To theLimit.Current - 1
theBase(rm_global_S_inc).whichType = theBase(rm_global_S_inc + 1).whichType
theBase(rm_global_S_inc).Content = theBase(rm_global_S_inc + 1).Content
Next rm_global_S_inc
rm_Item
End Sub
Sub rm_Item
theLimit.Current = theLimit.Current - 1
ReDim _Preserve theBase(theLimit.Current) As Entry
End Sub
Brief = 0
PRINT "NON-BRIEF OUTPUT:"
PRINT "'6s; 4d6 kh3' -- Roll 6 sets of 4 six-sided dice, keep the three highest"
PRINT DiceRoll$
PRINT
PRINT "PRESS <ANY KEY> TO CONTINUE"
SLEEP
PRINT
Brief = 1
PRINT "SEMI-BRIEF OUTPUT:"
PRINT "'6s; 4d6 kh3' -- Roll 6 sets of 4 six-sided dice, keep the three highest"
PRINT DiceRoll$
PRINT
PRINT "PRESS <ANY KEY> TO CONTINUE"
SLEEP
PRINT
Brief = 2
PRINT "MOST BRIEF OUTPUT:"
PRINT "'6s; 4d6 kh3' -- Roll 6 sets of 4 six-sided dice, keep the three highest"
PRINT DiceRoll$
PRINT
PRINT "PRESS <ANY KEY> TO CONTINUE"
SLEEP
PRINT
TYPE DiceRoller_Type
Set AS LONG
SetMod AS LONG
SetReRoll AS STRING * 100
SetOpenRoll AS STRING * 100
SetKeepHigh AS LONG
SetKeepLow AS LONG
SetDiscardHigh AS LONG
SetDiscardLow AS LONG
NumberOfDice AS LONG
DiceSides AS LONG
DiceMod AS LONG
DiceReroll AS STRING * 100
DiceOpenRoll AS STRING * 100
DiceKeepHigh AS LONG
DiceKeepLow AS LONG
DiceDiscardHigh AS LONG
DiceDiscardLow AS LONG
TotalMod AS LONG
END TYPE
SUB StripNumber (m$)
v = VAL(m$)
DO UNTIL v = 0
'PRINT "Stripping number"; m$
m$ = MID$(m$, 2)
v = VAL(m$)
LOOP
DO UNTIL LEFT$(m$, 1) <> "0" 'strip any zeros
m$ = MID$(m$, 2)
LOOP
END SUB
FUNCTION DiceRoll$
SHARED Brief AS LONG
SHARED DiceToRoll AS DiceRoller_Type
IF DiceToRoll.DiceKeepHigh OR DiceToRoll.DiceKeepLow THEN
IF DiceToRoll.DiceDiscardHigh OR DiceToRoll.DiceDiscardLow THEN DiceRoll$ = "Error - Can not keep and discard at the same time.": EXIT FUNCTION
END IF
IF DiceToRoll.NumberOfDice < 1 THEN DiceRoll$ = "Error - No dice to roll!": EXIT FUNCTION
RANDOMIZE TIMER
SHARED DiceToRoll AS DiceRoller_Type
REDIM rolls(0) AS LONG
REDIM SetRolls(0) AS LONG
SetCount = 0
IF Brief = 2 THEN out$ = "("
FOR j = 1 TO DiceToRoll.Set
ReRollSet:
SetTotal = 0
IF Brief = 0 THEN
out$ = out$ + "RAW: ("
ELSEIF Brief = 1 THEN
out$ = out$ + "("
END IF
rollcount = -1
FOR i = 1 TO DiceToRoll.NumberOfDice
ReRollDice:
roll = INT(RND(1) * DiceToRoll.DiceSides) + 1
IF ParseDiceOption(roll, DiceToRoll.DiceReroll) THEN
DiceOK = 0
IF Brief = 0 THEN out$ = out$ + "r" + _TRIM$(STR$(roll)) + ", "
GOTO ReRollDice
END IF
IF ParseDiceOption(roll, DiceToRoll.DiceOpenRoll) THEN
DiceOK = 0
DiceTotal = DiceTotal + roll + DiceToRoll.DiceMod
IF Brief = 0 THEN
out$ = out$ + _TRIM$(STR$(roll)) + "o"
IF DiceToRoll.DiceMod THEN out$ = out$ + " + " + _TRIM$(STR$(DiceToRoll.DiceMod))
out$ = out$ + ","
END IF
rollcount = rollcount + 1
REDIM _PRESERVE rolls(rollcount) AS LONG 'make certain we dont get out of bound errors for crazy reroll scenarios
rolls(rollcount) = roll + DiceToRoll.DiceMod
GOTO ReRollDice
END IF
rollcount = rollcount + 1
REDIM _PRESERVE rolls(rollcount) AS LONG 'make certain we dont get out of bound errors for crazy reroll scenarios
rolls(rollcount) = roll + DiceToRoll.DiceMod
DiceTotal = DiceTotal + roll + DiceToRoll.DiceMod
IF Brief = 0 THEN
out$ = out$ + _TRIM$(STR$(roll))
IF DiceToRoll.DiceMod THEN out$ = out$ + " + " + _TRIM$(STR$(DiceToRoll.DiceMod))
IF i < DiceToRoll.NumberOfDice THEN 'more dice to roll in this set
out$ = out$ + ", "
ELSE 'we're finished
out$ = out$ + ")"
END IF
END IF
NEXT
IF rollcount > 0 THEN Sort rolls() 'No need to try and sort only 1 dice.
IF Brief = 0 THEN
out$ = out$ + "; SORTED: ("
FOR i = 0 TO rollcount
out$ = out$ + _TRIM$(STR$(rolls(i)))
IF i < rollcount THEN out$ = out$ + ", " ELSE out$ = out$ + ")"
NEXT
END IF
REDIM keep(rollcount) AS LONG
IF DiceToRoll.DiceKeepHigh OR DiceToRoll.DiceKeepLow THEN
IF DiceToRoll.DiceKeepHigh THEN
FOR i = DiceToRoll.DiceKeepHigh - 1 TO 0 STEP -1
IF i < rollcount THEN keep(rollcount - i) = -1
NEXT
END IF
IF DiceToRoll.DiceKeepLow THEN
FOR i = 0 TO DiceToRoll.DiceKeepLow - 1
IF i < rollcount THEN keep(i) = -1
NEXT
END IF
ELSEIF DiceToRoll.DiceDiscardHigh OR DiceToRoll.DiceDiscardLow THEN
FOR i = 0 TO rollcount
keep(i) = -1
NEXT
IF DiceToRoll.DiceDiscardHigh THEN
FOR i = DiceToRoll.DiceDiscardHigh - 1 TO 0 STEP -1
IF i < rollcount THEN keep(rollcount - i) = 0
NEXT
END IF
IF DiceToRoll.DiceDiscardLow THEN
FOR i = 0 TO DiceToRoll.DiceDiscardLow - 1
IF i < rollcount THEN keep(i) = 0
NEXT
END IF
ELSE
FOR i = 0 TO rollcount
keep(i) = -1
NEXT
END IF
IF Brief = 0 THEN out$ = out$ + "; KEEP: ("
KeepTotal = 0
kept = 0
FOR i = 0 TO rollcount
IF keep(i) THEN
kept = kept + 1
IF Brief < 2 THEN
IF kept > 1 THEN out$ = out$ + ", "
out$ = out$ + _TRIM$(STR$(rolls(i)))
END IF
KeepTotal = KeepTotal + rolls(i)
END IF
NEXT
IF Brief < 2 THEN out$ = out$ + ") = " + _TRIM$(STR$(KeepTotal))
IF ParseDiceOption(KeepTotal, DiceToRoll.SetReRoll) THEN
IF Brief < 2 THEN out$ = out$ + "r" + CHR$(13)
GOTO ReRollSet
END IF
IF ParseDiceOption(KeepTotal, DiceToRoll.SetOpenRoll) THEN
SetTotal = SetTotal + KeepTotal + DiceToRoll.SetMod
SetCount = SetCount + 1
REDIM _PRESERVE SetRolls(SetCount) AS LONG
SetRolls(SetCount) = SetTotal
GrandTotal = GrandTotal + SetTotal
IF Brief = 2 THEN out$ = out$ + _TRIM$(STR$(SetTotal))
out$ = out$ + "o"
IF Brief < 2 THEN
IF DiceToRoll.SetMod THEN out$ = out$ + " + " + _TRIM$(STR$(DiceToRoll.SetMod))
out$ = out$ + " = " + _TRIM$(STR$(SetTotal))
out$ = out$ + CHR$(13)
ELSE
out$ = out$ + ", "
END IF
Sort SetRolls()
IF Brief = 0 THEN
out$ = out$ + CHR$(13) + CHR$(13) + "Sorted Set: ("
FOR i = 1 TO SetCount
out$ = out$ + _TRIM$(STR$(SetRolls(i)))
IF i < SetCount THEN out$ = out$ + ", " ELSE out$ = out$ + ")"
NEXT
END IF
REDIM keep(SetCount) AS LONG
IF DiceToRoll.SetKeepHigh OR DiceToRoll.SetKeepLow THEN
IF DiceToRoll.SetKeepHigh THEN
FOR i = DiceToRoll.SetKeepHigh - 1 TO 0 STEP -1
IF i < SetCount THEN keep(SetCount - i) = -1
NEXT
END IF
IF DiceToRoll.SetKeepLow THEN
FOR i = 0 TO DiceToRoll.SetKeepLow - 1
IF i < SetCount THEN keep(i) = -1
NEXT
END IF
ELSEIF DiceToRoll.SetDiscardHigh OR DiceToRoll.SetDiscardLow THEN
FOR i = 0 TO SetCount
keep(i) = -1
NEXT
IF DiceToRoll.SetDiscardHigh THEN
FOR i = DiceToRoll.SetDiscardHigh - 1 TO 0 STEP -1
IF i < SetCount THEN keep(SetCount - i) = 0
NEXT
END IF
IF DiceToRoll.SetDiscardLow THEN
FOR i = 0 TO DiceToRoll.SetDiscardLow - 1
IF i < SetCount THEN keep(i) = 0
NEXT
END IF
ELSE
FOR i = 0 TO SetCount
keep(i) = -1
NEXT
END IF
out$ = out$ + CHR$(13) + "Set Kept: ("
IF Brief = 2 THEN out$ = "("
KeepTotal = 0
keep = 0
FOR i = 1 TO SetCount
IF keep(i) THEN
keep = keep + 1
IF keep > 1 THEN out$ = out$ + ", "
out$ = out$ + _TRIM$(STR$(SetRolls(i)))
KeepTotal = KeepTotal + SetRolls(i)
END IF
NEXT
KeepTotal = KeepTotal + DiceToRoll.TotalMod
out$ = out$ + ") = " + _TRIM$(STR$(KeepTotal))
DiceRoll$ = out$
END FUNCTION
FUNCTION ParseDiceOption (num, t_temp$)
SHARED DiceToRoll AS DiceRoller_Type
temp$ = _TRIM$(t_temp$)
IF temp$ = "" THEN EXIT FUNCTION
IF RIGHT$(temp$, 1) <> "," THEN temp$ = temp$ + ","
DO
f = INSTR(temp$, ",")
IF f THEN
o$ = LEFT$(temp$, f - 1)
temp$ = MID$(temp$, f + 1)
o = VAL(MID$(o$, 2))
o$ = LEFT$(o$, 1)
SELECT CASE o$
CASE "=": IF num = o THEN ParseDiceOption = -1: EXIT FUNCTION
CASE "<": IF num < o THEN ParseDiceOption = -1: EXIT FUNCTION
CASE ">": IF num > o THEN ParseDiceOption = -1: EXIT FUNCTION
END SELECT
END IF
LOOP UNTIL f = 0 OR temp$ = ""
END FUNCTION
SUB Sort (Array() AS LONG)
'The dice sorting routine, optimized to use _MEM and a comb sort algorithm.
'It's more than fast enough for our needs here I think. ;)
DIM m AS _MEM
DIM o AS _OFFSET, o1 AS _OFFSET
DIM t AS LONG, t1 AS LONG
m = _MEM(Array())
$CHECKING:OFF
gap = rollcount
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 4
o1 = m.OFFSET + (i + gap) * 4
IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
_MEMGET m, o1, t1
_MEMGET m, o, t
_MEMPUT m, o1, t
_MEMPUT m, o, t1
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > UBOUND(Array)
LOOP UNTIL swapped = 0 AND gap = 1
$CHECKING:ON
_MEMFREE m
END SUB
FUNCTION RollEm$ (temp$)
SHARED DiceToRoll AS DiceRoller_Type
text1$ = UCASE$(temp$)
FOR i = 1 TO LEN(text1$) 'check for invalid characters
m$ = MID$(text1$, i, 1)
SELECT CASE m$
CASE "0" TO "9", "+", "-", "D", "K", "H", "L", "S", "T", ";", "=", "<", ">", ",", "R", "O", "B"
text$ = text$ + m$ 'add valid characters to make text$
CASE " " 'do nothing to a space
CASE ELSE
'invalid
END SELECT
NEXT
'IF DiagRollEM THEN PRINT "Verified: "; text$
IF text$ = "" THEN EXIT SUB 'can't do nothing with an empty string
ClearDice
DO
semicolon = INSTR(text$, ";")
IF semicolon THEN
l$ = LEFT$(text$, semicolon - 1)
text$ = MID$(text$, semicolon + 1)
ELSE
l$ = text$
END IF
'IF DiagRollEM THEN PRINT "PROCESSING: "; l$
found = 0
s = INSTR(l$, "S"): IF s THEN found = found + 1
d = INSTR(l$, "D"): IF d THEN found = found + 1
t = INSTR(l$, "T"): IF t THEN found = found + 1
b = INSTR(l$, "B"): IF b THEN found = found + 1
IF found <> 1 THEN EXIT SUB 'we should only find ONE element each pass, and there should always be one. IF not, somebody screwed up.
IF s THEN
DiceToRoll.Set = VAL(LEFT$(l$, s - 1))
IF DiagRollEm THEN PRINT "Number of Sets = "; DiceToRoll.Set
m$ = MID$(l$, s + 1)
pass = 0
DO UNTIL m$ = ""
pass = pass + 1
'IF DiagRollEM THEN PRINT "SUBPROC "; m$
n$ = LEFT$(m$, 1)
IF n$ = "K" OR n$ = "D" THEN n$ = LEFT$(m$, 2)
m$ = MID$(m$, LEN(n$) + 1)
v = VAL(m$)
SELECT CASE n$
CASE "+" '+ set mod
IF v > 0 THEN DiceToRoll.SetMod = v
IF DiagRollEm THEN PRINT "Set Mod"; v
CASE "-" ' - set mod
IF v > 0 THEN DiceToRoll.SetMod = -v
IF DiagRollEm THEN PRINT "Set Mod"; v
CASE "KH" 'keep high
IF v > 0 THEN DiceToRoll.SetKeepHigh = v
IF DiagRollEm THEN PRINT "Keep the Highest"; v; " Sets"
CASE "KL"
IF v > 0 THEN DiceToRoll.SetKeepLow = v
IF DiagRollEm THEN PRINT "Keep the Lowest"; v; " Sets"
CASE "DH"
IF v > 0 THEN DiceToRoll.SetDiscardHigh = v
IF DiagRollEm THEN PRINT "Discard the Highest"; v; " Sets"
CASE "DL"
IF v > 0 THEN DiceToRoll.SetDiscardLow = v
IF DiagRollEm THEN PRINT "Discard the Lowest"; v; " Sets"
CASE "R", "O" 'reroll or open roll
finished = 0: t$ = "": innerpass = 0
DO UNTIL finished
innerpass = innerpass + 1
v = VAL(m$)
IF v <> 0 THEN 'it's an o/r followed by a number
t$ = t$ + "=" + _TRIM$(STR$(v)) + ","
ELSE
n1$ = LEFT$(m$, 1)
SELECT CASE n1$
CASE "="
m$ = MID$(m$, 2)
v = VAL(m$)
t$ = t$ + "=" + _TRIM$(STR$(v)) + ","
CASE "<"
m$ = MID$(m$, 2)
v = VAL(m$)
t$ = t$ + "<" + _TRIM$(STR$(v)) + ","
CASE ">"
m$ = MID$(m$, 2)
v = VAL(m$)
t$ = t$ + ">" + _TRIM$(STR$(v)) + ","
CASE ","
m$ = MID$(m$, 2)
CASE ELSE 'a character not a number, or =<>,
finished = -1
END SELECT
END IF
StripNumber m$
IF n$ = "R" THEN
DiceToRoll.SetReRoll = t$
IF DiagRollEm THEN PRINT "Reroll Sets "; DiceToRoll.SetReRoll
ELSE
DiceToRoll.SetOpenRoll = t$
IF DiagRollEm THEN PRINT "Openroll Sets "; DiceToRoll.SetOpenRoll
END IF
IF m$ = "" THEN finished = -1
IF innerpass > 255 THEN IF DiagRollEm THEN PRINT "Error -- Too many loops processing Set ReRoll or OpenRoll": EXIT FUNCTION
LOOP
END SELECT
StripNumber m$
n$ = LEFT$(m$, 1)
SELECT CASE n$
CASE "K", "D", "R", "O", "+", "-" 'see if it's another command without a comma
CASE ELSE
comma = INSTR(m$, ",")
IF comma THEN m$ = MID$(m$, comma + 1)
END SELECT
IF pass > 100 THEN IF DiagRollEm THEN PRINT "Error - endless processing loop deciphering SET information": EXIT FUNCTION
LOOP
END IF
IF d THEN
v = VAL(LEFT$(l$, d))
IF v < 1 THEN DiceToRoll.NumberOfDice = 1 ELSE DiceToRoll.NumberOfDice = v
IF DiagRollEm THEN PRINT "Number of Dice To Roll = "; DiceToRoll.NumberOfDice
m$ = MID$(l$, d + 1)
v = VAL(m$)
IF v > 0 THEN DiceToRoll.DiceSides = v
StripNumber m$
IF DiagRollEm THEN PRINT "Dice Sides = "; DiceToRoll.DiceSides
pass = 0
DO UNTIL m$ = ""
pass = pass + 1
'IF DiagRollEM THEN PRINT "SUBPROC "; m$
n$ = LEFT$(m$, 1)
IF n$ = "K" OR n$ = "D" THEN n$ = LEFT$(m$, 2)
m$ = MID$(m$, LEN(n$) + 1)
v = VAL(m$)
SELECT CASE n$
CASE "+" '+ set mod
IF v > 0 THEN DiceToRoll.DiceMod = v
IF DiagRollEm THEN PRINT "DM"; v
CASE "-" ' - set mod
IF v > 0 THEN DiceToRoll.DiceMod = -v
IF DiagRollEm THEN PRINT "DM"; v
CASE "KH" 'keep high
IF v > 0 THEN DiceToRoll.DiceKeepHigh = v
IF DiagRollEm THEN PRINT "DKH"; v
CASE "KL"
IF v > 0 THEN DiceToRoll.DiceKeepLow = v
IF DiagRollEm THEN PRINT "DKL"; v
CASE "DH"
IF v > 0 THEN DiceToRollDiceDiscardHigh = v
IF DiagRollEm THEN PRINT "DDH"; v
CASE "DL"
IF v > 0 THEN DiceToRoll.DiceDiscardLow = v
IF DiagRollEm THEN PRINT "DDL"; v
CASE "R", "O" 'reroll or open roll
finished = 0: t$ = "": innerpass = 0
DO UNTIL finished
innerpass = innerpass + 1
v = VAL(m$)
IF v <> 0 THEN 'it's an o/r followed by a number
t$ = t$ + "=" + _TRIM$(STR$(v)) + ","
ELSE
n1$ = LEFT$(m$, 1)
SELECT CASE n1$
CASE "="
m$ = MID$(m$, 2)
v = VAL(m$)
t$ = t$ + "=" + _TRIM$(STR$(v)) + ","
CASE "<"
m$ = MID$(m$, 2)
v = VAL(m$)
t$ = t$ + "<" + _TRIM$(STR$(v)) + ","
CASE ">"
m$ = MID$(m$, 2)
v = VAL(m$)
t$ = t$ + ">" + _TRIM$(STR$(v)) + ","
CASE ","
m$ = MID$(m$, 2)
CASE ELSE 'a character not a number, or =<>,
finished = -1
END SELECT
END IF
StripNumber m$
IF n$ = "R" THEN
DiceToRoll.DiceReroll = t$
IF DiagRollEm THEN PRINT "DR: "; DiceToRoll.DiceReroll
ELSE
DiceToRoll.DiceOpenRoll = t$
IF DiagRollEm THEN PRINT "DO: "; DiceToRoll.DiceOpenRoll
END IF
IF m$ = "" THEN finished = -1
IF innerpass > 255 THEN IF DiagRollEm THEN PRINT "Error -- Too many loops processing Dice ReRoll or OpenRoll": EXIT FUNCTION
LOOP
END SELECT
StripNumber m$
n$ = LEFT$(m$, 1)
SELECT CASE n$
CASE "K", "D", "R", "O", "+", "-" 'see if it's another command without a comma
CASE ELSE
comma = INSTR(m$, ",")
IF comma THEN m$ = MID$(m$, comma + 1)
END SELECT
IF pass > 100 THEN IF DiagRollEm THEN PRINT "Error - endless processing loop deciphering SET information": EXIT FUNCTION
LOOP
END IF
IF t THEN
DiceToRoll.TotalMod = VAL(MID$(l$, 2))
IF DiagRollEm THEN PRINT "Dice Total Modifier = "; DiceToRoll.TotalMod
END IF
IF b THEN
Brief = VAL(MID$(l$, 2))
IF DiagRollEm THEN PRINT "Roll Information Displayed: ";
SELECT CASE Brief
CASE 0: IF DiagRollEm THEN PRINT "Full"
CASE 1: IF DiagRollEm THEN PRINT "Reduced"
CASE 2: IF DiagRollEm THEN PRINT "Final Results Only"
END SELECT
END IF
LOOP UNTIL l$ = text$
RollEm$ = DiceRoll$
END FUNCTION
If you want to make this a library for your own usage, just strip it out at line 70 or so, and save it as whatever library name you want. "DiceRoller.BM" works for me, but make it whatever you'd like...
At that point, usage is rather simple:
'$INCLUDE:'whatever_you_named_your_library.BM" would go at the bottom of your code, and then you can simply use:
result$ = RollEm$(whatever_to_roll$)
This little library is able to do just about anything you'd need it to do, as far as dice rolling for RPGs go, as long as you follow the basic syntax and send it a proper string.
[b]First Concept of Library:[/b] Our "dice rolling formula" is broken down into segments seperated by a semicolon.
[b]Our 4 basic segments are:[/b] Sets Dice Total mod Brief output
[b]For Sets, the syntax is:[/b] ##S -- the number of sets, followed by S
[b]For Dice, the syntax is:[/b] ##D## -- the number of dice, followed by D, followed by the sides on the dice. NOTE: the first set of numbers are optional, so you could simply use D6 to roll a single six sided dice.
[b]For Total modifed, the syntax is:[/b] T## -- T followed by the total to add or subtract to the total dice roll
[b]For Brief output, the syntax is:[/b] ##B -- the number to represent how little output we want, followed by B 0 = full output 1 = reduced output 2 = minimal output (basically only the final results)
[b]Second Concept of Library:[/b] Our segments can be further limited by optional parameters
[b]+## (or -##)[/b] -- add (or subtract) number to segment
[b]KH## [/b]-- Keep the Highest number of "segment" [b]KL## [/b]-- Keep the Lowest number of "segment" [b]DH## [/b]-- Discard the Highest number of "segment" [b]DL## [/b]-- Discard the Lowest number of "segment"
[b]R + [i]stuff[/i][/b] -- Reroll according to [i]stuff[/i] [b]O + [i]stuff[/i][/b]-- Openroll according [i]to stuff[/i]
[i]stuff[/i] -- A string composed of numbers, operators, and commas, to represent what to reroll or openroll. It sounds complex, but its not.
R1 -- Reroll all 1's R=2,=3 -- Reroll all rolls that are equal to 2 and equal to 3 R<4 -- Reroll all rolls that are less than 4
O1<2>3 -- (a silly rule set, but hey, it's an example)... Openroll all 1's, all numbers less than two, and all numbers greater than 3
[b]Putting it all together:[/b]
In the end, what we end up with is formulas which look like the following:
3S;2D10 -- Roll 3 sets; of 2 10-sided dice.
6S;4D6KH3 -- Roll 6 sets; of 4 6-sided dice, keeping the 3 highest rolls
10SKH1KL1;2D10+2 -- Roll 10 sets of dice and only keep the highest set and the lowest set; of 2 10-sided dice, and add 2 to each dice.
Depending on what you want, you can generate some rather impressive formulas and take all the bite out of the dice rolling process completely for your games.
NOTE: Spaces are optional, so if they help you understand your "dice rolling formulas" better, feel free to use them:
4S; 3D10 KH2 O20 R2 ; T1; B2 -- Roll 4 sets of; 3 10-sided dice, keeping the 2 highest dice, and openrolling if the dice total to 20, and rerolling if the dice total to 2; then add 1 to the final total; and all we want to see are the final results...
I turned the powershell stuff into a simple little library for people to make use of in their projects, and here it is:
Code: (Select All)
_Title "Steve's Powershell Speech Library"
Speech_IoR 'initialize or reset speech options
Speech_SaP "Hello World, This is a normal speed demo of David's voice" 'speak and print
_Delay 2
Speech_Speaker "Ziva"
Speech_Say "Hello again. This is a normal speed demo of Ziva's voice." 'just speak this one
_Delay 2
Speech_Speaker "David"
Speech_Speed -10
Speech_SaP "And now I'm speaking as David, but I'm speaking veeery slow."
_Delay 2
Speech_Speaker "Ziva"
Speech_Speed 5
Speech_SaP "And now I'm a very hyper Ziva!"
_Delay 2
Speech_Speed 0
Speech_Volume 30
Speech_SaP "And now I'm whispering to you that I'm done with my demo!"
'$INCLUDE:'TextToSpeech.BM'
As you can see, all the commands are preceeded by "Speech_", to try and help keep the sub names unique, associative, and not interfere with any user variable names and such.
Routines in this little package are:
Speech_IoR -- Init or Reset. Call this first to initialize the settings (and turn volume up to 100, or else you'll be speaking on a MUTE channel)
Speech_Speaker -- Change the default speaker. Currently I only support "David" and "Ziva", but feel free to change or add to this if your system has other voices installed via language/voice packs.
Speech_Speed -- Set a value from -10 to 10 to adjust the speed of the speaker. 0 id default, -10 is sloooow, and 10 is faaaast.
Speech_Volume -- Set a value from 0 to 100 to adjust how loud you're going to be speaking with the voices.
Speech_OutTo -- Use this to change where you want the speech to go. Only options now are your speakers or a file. Since it's not currently in the demo, as I didn't want to randomly save junk to folks drives, an example looks like:
Speech_OutTo "MyTextToFile.wav" Speech_OutTo "Speaker" Speech_OutTo "" 'defaults/resets to speaker
Speech_Say -- Just says the text you specify with the settings you gave it previously.
Speech_SaP -- Says and Prints the text you specify to the screen as a quick print and speak shortcut. Uses previous settings.
Speech_ToWav -- Converts text to a wav file and saves it to the disk where you specify. Since it's not in the short demo above, usage would be as:
Speech_ToWav "Hello World. This is the text I'm saving to a file!", "MyFile.wav"
speak -- This is the master command with all the options built into it. You can skip everything else, if you want to use this as a stand alone command to do everything all at once. Everything else ends up calling this command at the end of the day, so you can bypass some processes if you call this directly.
And that's basically it for now. Windows Speech Synthesizer is quite a powerful little tool, with a ton of options which we can utilize with it, but I figure this is the basics of what someone would need to be able to do with it for a program. It seems to handle what I need from it for now.
If you guys need it to do more, feel free to ask and I'll see about adding extra functionality as people need it. Or, feel free to make the changes necessary yourself and then share them here with us so everybody else can enjoy any extra tweaks you guys add into the code.
To make use of this:
1) Download the library from the attachment below. 2) Move it to your QB64 folder. 3) '$INCLUDE:'TextToSpeech.BM' at the end of your program. 4) Speech_IoR inside your code to initialize everything 5) Call the other subs as you want to make use of them and alter the settings to your specific needs.
Posted by: Pete - 04-27-2022, 08:51 PM - Forum: TheBOB
- No Replies
Abacus.bas by Bob Seguin. Description: Ancient Japanese calculator. Use the mouse to move the beads.
Download: Download the zip file below. Unzip to either your QB64 folder, or for better organization, to a folder you create like "TheBOB-Abacus".
Install: Compile Abacus.bas with QB64 v1.3 or above, and make sure the compiler output is set to create the .exe file in the same folder. See the option in the QB64 IDE RUN menu and check the RUN option: "Output EXE to Source Folder".
![[Image: Git-History.png]](https://i.ibb.co/d5mL8Z5/Git-History.png)
![[Image: image.png]](https://i.ibb.co/rpm4tpH/image.png)
![[Image: image.png]](https://i.ibb.co/6tKVT9P/image.png)
![[Image: AH-Light.png]](https://i.ibb.co/wSFc15Z/AH-Light.png)
![[Image: Screenshot-657.png]](https://i.ibb.co/bJF3f1g/Screenshot-657.png)
