Print Page - Steve's Ole Dice Roller

Active Forums => Programs => Topic started by: SMcNeill on January 16, 2019, 12:57:08 am

Title: Steve's Ole Dice Roller
Post by: SMcNeill on January 16, 2019, 12:57:08 am

Having a little free time once again, (by avoiding my writing commitment like a lazy bum), I decided to play around and create a little dice rolling routine for fun, and this is what I've got so far. ;)

At this point, it doesn't actually do *anything* much, except highlight the selection process I'm going to be using for user interactions. I wanted something a little different than the standard keyboard entry routines, so I came up with this little process for user input. Test it out if you guys get a chance and tell me if it seems intuitive enough for ease of selection/use. If there's any issues, I'd like to address them ASAP, before things get more complicated once I start adding modifiers into the process. ;)

NOTE: You'll probably need one of the latest development builds for this to work properly as it relies upon the fixes to the precompiler and the _TRIM$ keyword.

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: johnno56 on January 16, 2019, 02:19:16 am

That's quite a collection of colours. May I ask where you got the info? I hope you did a cut-n-paste otherwise that's a set of sore fingers right there...

Hmm... issues...

Although I am a big fan of 'Old English' text, I do not happen to have it installed, but after a short search the font was found.

The 'sets', 'number', and 'sides' worked just fine. My screen capture looks a bit weird but I'm going to guess it was probably the font I used. But attached it anyway so you can see that it works...

[ This attachment cannot be displayed inline in 'Print Page' view ]

J
ps: I'm also using qb64-dev

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: Qwerkey on January 16, 2019, 05:04:31 am

Quote from: SMcNeill on January 16, 2019, 12:57:08 am

Test it out if you guys get a chance and tell me if it seems intuitive enough for ease of selection/use.

Yep. That's intuitive all right.

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: Pete on January 16, 2019, 10:58:46 am

I left my Old English fonts on my Windows King George III computer. Sorry.

Pete :(

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 16, 2019, 11:07:54 am

So apparently I’ll need to package (or embed) the fonts with the final version... And here I was thinking OldEnglish fonts were standard with most systems. O_o!

At least that’s one issue found, before I get any further. Thanks for the feedback, guys.

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 16, 2019, 12:58:59 pm

Added a screenshot of how the screen should actually look for folks, once the proper fonts and all have been found and loaded with the program. I'll package everything needed up into a nice zip/7z archive as progress on the project progresses. but for now a screenshot is all the updated progress you get while I add in a few bells and whistles. :)

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: Pete on January 16, 2019, 01:37:11 pm

I went back to QBF to look up some old dice routines. I found this neat 3400+ line QBasic Yahtzee contribution by Myst It's a pain to copy but once you have it on the clipboard, it pastes and runs perfectly in QB64. I couldn't find the custom made 3-D dice roll simulation TheBob made. I'll have to ask him if he remembers where he posted them. Bob made some kind of comment about one of my dice routines; something about my results would only be valid if I was rolling dice on Mars. I told him I could try rolling the same dice on Uranus, but it would probably just keep coming out craps. I'll be sure to forego that story when I ask him where he's hiding his dice.

Pete

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 16, 2019, 02:00:51 pm

What I’m shooting for is (once again) an over-engineered RPG dice roller which can handle anything we want from it....

Options will include:

Rolling sets of multiple dice of various sides. 3 sets of 2d10 would result in 3 numbers generated by rolling two different 10-sided dice. (Not 3 sets of INT(RND *19) + 2 to generate values of 2 to 20, but 3 sets of 2 rolls of INT(RND * 10) + 1... The two may generate the same values, but at a distinctly different probability curve.)

Modifiers per dice: +1 per dice, for example, so 2D6+1 will generate 2 numbers from 2 to 7, add them together for a total of 4 to 14.

Modifiers per set: (3S2D6)+1 would be 3 sets of 2D6, with 1 added to each set. Rolls might be:
(1,3) + 1 = 5
(2,3) + 1 = 6
(4,5) + 1 = 10

Modifiers to total roll: 3S2D6T+1... much like above, 3 sets of 2D6, with 1 added to the total sum:
(1,3) = 4
(2,3) = 5
(4,5) = 9
—————-
+1 = 19

Ability to keep/discard dice: 4D6K3h — roll 4 6-sided dice, keep the three highest:
(1, 2, 5, 5) = 12

Ability to reroll edge cases: 2D6R1R6 — roll 2 6-sided dice, reroll 1’s, reroll 6,s:
(1, 2, 4) = 6 <— in this case, the one got rerolled.

Ability to use “open dice”: 2D6O6 — roll 2 6-sided dice, open roll 6’s:
(3, 6, 4) = 13 <— a 6 was rolled, roll another dice (which was the 4)

And most of these “dice rules” will apply to sets as well, so we can:
Roll 10 sets of 2D10, and drop the lowest set, for 9 numbers from 2-20...

And so on, with every customizable option I can imagine from all my years playing various pen-and-paper RPGs.

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: Pete on January 16, 2019, 02:17:19 pm

RPGs, I gave that stuff up years ago, but I I recall that they usually require die with more sides than the standard 6-sides used in casino games. I threw one of those once on a craps table in Vegas and the casino boss threatened to have me removed. I told him he couldn't throw me out, because I was a level 5 elf master; so instead, he shoved me in a hollow tree and had me bake cookies for the entire crew. Not the kind of chips I was hoping to come away with.

Pete

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: Pete on January 16, 2019, 09:52:59 pm

Ah, Bob just reposted it here: https://www.tapatalk.com/groups/qbasic/bob-do-you-remember-that-3-d-dice-roll-simulation--t39421.html#p212448

It's very compact code that creates a 3-D look to the dice, but not true 3-D, spinning on an axis, etc. Still, for a dice game, they are perfect to add the visual effects to give the game a nice polished appearance.

For RPG dice, it would be more of a design challenge, for sure.

Pete

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 16, 2019, 10:47:11 pm

v0.5 is available for testing/breaking...

Packaged it all up together in a 7z file which I attached to the bottom of the first post, and it's beginning to take on the pretty little look of a decent project.

I think the selection process is more or less finished, with the exception of a few pop-ups so the user can choose modifiers as I was speaking about earlier to apply to their dice rolls, but those should be a breeze to implement now that I've gotten everything else up to this point in the process... And all that'll be left after that is to actually just roll the dice and obey the ruleset the user creates. :)

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: Pete on January 16, 2019, 11:15:56 pm

So right now it has a hover feature to pick the elements to test. Anything else besides making those input selections?

Pete

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 16, 2019, 11:35:37 pm

Quote from: Pete on January 16, 2019, 11:15:56 pm

So right now it has a hover feature to pick the elements to test. Anything else besides making those input selections?

Pete

It should now have 3 extra areas with 19 selectable/clickable lines.

The next stage is to display a pop-up when the user clicks on one of those lines, with the available options you can set for each area, such as:

Click the DICE list from 1 to 19, generate a pop up for:
Keep ### of Highest Rolls
Keep ### of Lowest Rolls
Discard ### of Highest Rolls
Discard ### of Lowest Rolls
Add ### to each Roll
Subtract ### from each Roll
Reroll any ###’s
Open roll with ###’s
(Other options as I think of them)

Then you create the rule you wish and it fills the spot you chose...

After that it’s just rolling and obeying the set rules. The framework is all laid out and the hard part is done (which is why I’d call it v0.5 as it’s about half finished). Now it’s just a case of taking advantage of the routines available and tying it all together to finish. ;)

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: STxAxTIC on January 17, 2019, 09:20:07 am

A few questions -

Are the source files within the ZIP being updated? (I'm getting the same behavior now that I was getting last time I checked and the download count didn't seem to reset.)

Is Linkedlist.bas supposed to compile? (I'm not running the dev version.)

Have you considered separating the mechanism from the interface, so that the roller calculations may be attached elsewhere? Every special font or graphic will significantly shave down the number of compatible systems out in the future. You probably want a screen-0 brain back there, no?

How tightly thought-out is the math behind re-rolling? You had my interest at "probability curve". And also the mechanics of re-rolling... if we want to roll a six-sided dice and promptly throw away all "2" results it lands on, may I think of this as a 5-sided dice that is missing the 2?

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 17, 2019, 09:46:14 am

Quote from: STxAxTIC on January 17, 2019, 09:20:07 am

A few questions -

Are the source files within the ZIP being updated? (I'm getting the same behavior now that I was getting last time I checked and the download count didn't seem to reset.)

Is Linkedlist.bas supposed to compile? (I'm not running the dev version.)

Have you considered separating the mechanism from the interface, so that the roller calculations may be attached elsewhere? Every special font or graphic will significantly shave down the number of compatible systems out in the future. You probably want a screen-0 brain back there, no?

How tightly thought-out is the math behind re-rolling? You had my interest at "probability curve". And also the mechanics of re-rolling... if we want to roll a six-sided dice and promptly throw away all "2" results it lands on, may I think of this as a 5-sided dice that is missing the 2?

Only one zip uploaded so far, so if you downloaded it once, I haven't updated it since then. ;)

When I get to the dice rolling routine, the core mechanic behind it is going to be a formula based processing routine, much like I described to Pete previously. Send it a formula, it'll send you a plain text array of results which you can work with.

So send it "2D6", it'll send you an array of:
"(1,3) = 4"

Send it "3S4D6+1K3H", it'll obey the ruleset you told it -- roll 3 sets of 2D6, add 1 to each dice, and keep the 3 highest, for a return of:
"(2, 3, 7, 4) = 14"
"(3, 3, 3, 5) = 11"
"(2, 5, 6, 7) = 18"

The idea is to have the main interface just be a pretty little UI which keeps things simple for people to use and interact with, but the core rolling routine is going to be able to process a custom format dice rolling formula.

For an idea of how the core will work, take a moment to look at my old dice rolling routine, which I reshared here: https://www.qb64.org/forum/index.php?topic=981.0 It's been around since November of 2013, so it just seems like it's time to give it an updated UI and expandable features, thus the birth of this little project. ;)

Title: Re: Steve's Ole Dice Roller (work in progress)
Post by: SMcNeill on January 19, 2019, 04:37:03 am

The engine for the new dice roller:

Code: QB64: [Select]

DIM SHARED DiceToRoll AS DiceRoller_Type 'for testing
DiceToRoll.NumberOfDice = 4
DiceToRoll.DiceSides = 6 '10
'DiceToRoll.DiceReroll = "=1,=3"
'DiceToRoll.DiceOpenRoll = "=10"
'DiceToRoll.DiceMod = 2
DiceToRoll.DiceKeepHigh = 3
'DiceToRoll.DiceDiscardLow = 1
 
DiceToRoll.Set = 6
'DiceToRoll.SetMod = 10
'DiceToRoll.TotalMod = 27
 
DIM SHARED Brief
 
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
SLEEP
 
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
SLEEP
 
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
SLEEP
 
 
 
 
 
 
 
 
TYPE DiceRoller_Type
    Set AS LONG
    SetMod 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 ClearDice
    DiceToRoll.Set = 0
    DiceToRoll.SetMod = 0
    DiceToRoll.NumberOfDice = 0
    DiceToRoll.DiceSides = 0
    DiceToRoll.DiceMod = 0
    DiceToRoll.DiceReroll = ""
    DiceToRoll.DiceOpenRoll = ""
    DiceToRoll.DiceKeepHigh = 0
    DiceToRoll.DiceKeepLow = 0
    DiceToRoll.DiceDiscardHigh = 0
    DiceToRoll.DiceDiscardLow = 0
    DiceToRoll.TotalMod = 0
END SUB
 
FUNCTION DiceRoll$
    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
 
    RANDOMIZE TIMER
    SHARED DiceToRoll AS DiceRoller_Type
    REDIM rolls(0) AS LONG
    SetTotal = 0
    IF Brief = 2 THEN out$ = "("
    FOR j = 1 TO DiceToRoll.Set
        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
            eval = ParseDiceOption(roll, DiceToRoll.DiceReroll)
            IF eval 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
 
 
 
        '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.  ;)
 
        IF rollcount > 0 THEN 'No need to try and sort only 1 dice.
            DIM m AS _MEM
            DIM o AS _OFFSET, o1 AS _OFFSET
            DIM t AS LONG, t1 AS LONG
            m = _MEM(rolls())
            $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(Rolls)
            LOOP UNTIL swapped = 0 AND gap = 1
            $CHECKING:ON
            _MEMFREE m
        END IF
 
        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 DiceToRoll.SetMod THEN
            KeepTotal = KeepTotal + DiceToRoll.SetMod
            IF Brief < 2 THEN
                out$ = out$ + ") + " + _TRIM$(STR$(DiceToRoll.SetMod))
                out$ = out$ + " = " + _TRIM$(STR$(KeepTotal))
            ELSE
                out$ = out$ + _TRIM$(STR$(KeepTotal))
            END IF
        ELSE
            IF Brief < 2 THEN
                out$ = out$ + ") = " + _TRIM$(STR$(KeepTotal))
            ELSE
                out$ = out$ + _TRIM$(STR$(KeepTotal))
            END IF
        END IF
        IF j < DiceToRoll.Set THEN
            IF Brief = 2 THEN out$ = out$ + " + "
            IF Brief < 2 THEN out$ = out$ + CHR$(13)
            'IF Brief = 0 THEN out$ = out$ + CHR$(13)
        END IF
        SetTotal = SetTotal + KeepTotal
    NEXT
    IF j > 2 THEN
        IF Brief < 2 THEN
            out$ = out$ + CHR$(13) + "SET TOTAL:" + STR$(SetTotal)
        ELSE
            out$ = out$ + ") =" + STR$(SetTotal)
        END IF
    END IF
    DiceRoll$ = out$
END FUNCTION
 
 
FUNCTION ParseDiceOption (num, t_temp$)
    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
 

All it needs now is for me to add a parser to parse a string of user input for the roller, which should be simple enough to do, and then turn it into the necessary pieces for calculations.

If it you this little demo, it doesn't have any of the fancy little UI interactions, and you'll have to manually set the values for the roller itself, but this does highlight the various strings which the roller will send back to us for processing.

For paranoid rollers who want to follow the whole process through, we can get a VERY detailed breakdown of all the rolls and modifications by setting BRIEF to 0. I have met some gamers who want to know exactly HOW they got the rolls they got, or else they claim "something is wrong" when the dice don't generate the values they want. Complete openness is good for these type of people.

For those who are just interested in the rolls generated and totals, we can set BRIEF to 1.

And, for those folks who just want the basic results, we can set BRIEF to 2.

The '4d6 kh3' ruleset was chosen for the little demo as it's what used to be common for character creation for Advanced Dungeons & Dragons during the first few editions of the game. Roll 6 sets of 4d6 for stats, and keep the 3 highest rolls...

Feel free to play around with the other options and see what you can generate with it...

(And, for those curious, I also plan to offer the ability to get back the results via an array as the old dice roller used to do things. This time, there'll be a choice between getting the string results and getting an array of numbers to work with, without needing to parse the output first.)

Title: Re: Steve's Ole Dice Roller
Post by: SMcNeill on January 24, 2019, 08:08:42 am

The finished engine for the routine, and all I'll be bothering to share on the forums here. The GUI makes use of "The LIBRARY WHICH SHALL NOT BE NAMED", and it seems as if its name offends people, so in an attempt to appease them, the UI which was showcased earlier will NOT be included for public viewing.

What is available for the public to make use of is the following:

Code: QB64: [Select]

SCREEN _NEWIMAGE(1024, 720, 32)
_SCREENMOVE _MIDDLE
 
CONST DiagRollEm = -1
 
'The next lines are only needed for manual testing
DIM DiceToRoll AS DiceRoller_Type
DIM SHARED Brief AS LONG
 
'Feel free to change options as wanted for your program
'DiceToRoll.NumberOfDice = 2
'DiceToRoll.DiceSides = 10
'DiceToRoll.DiceReroll = "=1"
'DiceToRoll.DiceOpenRoll = "=10"
'DiceToRoll.DiceMod = 2
'DiceToRoll.DiceKeepHigh = 1
'DiceToRoll.DiceKeepLow = 1
 
'DiceToRoll.Set = 10
'DiceToRoll.SetMod = 1
'DiceToRoll.SetReRoll = "<6"
'DiceToRoll.SetOpenRoll = ">10"
'DiceToRoll.TotalMod = 27
 
'DiceToRoll.SetKeepHigh = 9
 
 
PRINT RollEm$("10skh9r2;2d10o20;t2;b2")
 
PRINT
PRINT "PRESS <ANY KEY> TO CONTINUE"
SLEEP
PRINT
 
ClearDice
DiceToRoll.Set = 6
DiceToRoll.NumberOfDice = 4
DiceToRoll.DiceSides = 6
DiceToRoll.DiceKeepHigh = 3
 
 
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
 
 
SUB ClearDice
    SHARED DiceToRoll AS DiceRoller_Type
    DiceToRoll.Set = 0
    DiceToRoll.SetMod = 0
    DiceToRoll.SetReRoll = ""
    DiceToRoll.NumberOfDice = 0
    DiceToRoll.DiceSides = 0
    DiceToRoll.DiceMod = 0
    DiceToRoll.DiceReroll = ""
    DiceToRoll.DiceOpenRoll = ""
    DiceToRoll.DiceKeepHigh = 0
    DiceToRoll.DiceKeepLow = 0
    DiceToRoll.DiceDiscardHigh = 0
    DiceToRoll.DiceDiscardLow = 0
    DiceToRoll.TotalMod = 0
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
 
            GOTO ReRollSet
        END IF
 
        SetTotal = SetTotal + KeepTotal + DiceToRoll.SetMod
        SetCount = SetCount + 1
        REDIM _PRESERVE SetRolls(SetCount) AS LONG
        SetRolls(SetCount) = SetTotal
        GrandTotal = GrandTotal + SetTotal
 
        IF Brief < 2 THEN
            IF DiceToRoll.SetMod THEN
                out$ = out$ + " + " + _TRIM$(STR$(DiceToRoll.SetMod))
                out$ = out$ + " = " + _TRIM$(STR$(SetTotal))
            END IF
            out$ = out$ + CHR$(13)
        ELSE
            out$ = out$ + _TRIM$(STR$(SetTotal))
            IF j < DiceToRoll.Set THEN out$ = out$ + ", " ELSE out$ = out$ + ")"
        END IF
 
 
    NEXT
    IF Brief < 2 THEN out$ = out$ + CHR$(13) + "GRAND TOTAL:"
 
    IF DiceToRoll.TotalMod THEN
        IF Brief < 2 THEN out$ = out$ + STR$(GrandTotal) + " +" + STR$(DiceToRoll.TotalMod)
    END IF
 
    GrandTotal = GrandTotal + DiceToRoll.TotalMod
    out$ = out$ + " =" + STR$(GrandTotal)
 
    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 apparently my naming sense sucks...

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.

First Concept of Library: Our "dice rolling formula" is broken down into segments seperated by a semicolon.

Our 4 basic segments are:
Sets
Dice
Total mod
Brief output

For Sets, the syntax is:
##S -- the number of sets, followed by S

For Dice, the syntax is:
##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.

For Total modifed, the syntax is:
T## -- T followed by the total to add or subtract to the total dice roll

For Brief output, the syntax is:
##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)

Second Concept of Library: Our segments can be further limited by optional parameters

+## (or -##) -- add (or subtract) number to segment

KH## -- Keep the Highest number of "segment"
KL## -- Keep the Lowest number of "segment"
DH## -- Discard the Highest number of "segment"
DL## -- Discard the Lowest number of "segment"

R + stuff -- Reroll according to stuff
O + stuff-- Openroll according to stuff

stuff -- 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

Putting it all together:

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...

Title: Re: Steve's Ole Dice Roller
Post by: STxAxTIC on February 01, 2019, 09:08:55 am

Quote

The GUI makes use of "The LIBRARY WHICH SHALL NOT BE NAMED", and it seems as if its name offends people

I have no idea who those "people" are who would get offended by the existence a properly-named library. Sheesh, I'd love to meet them!

I hope the re-roll mechanism doesn't offend those same people. Below they can prove that re-rolling a number is equivalent to simply not having that number in the first place. (I'm saying there's a ton of potential to fix up your re-roll feature if you insist on keeping it in place of trivial remapping.)

Title: Re: Steve's Ole Dice Roller
Post by: SMcNeill on February 01, 2019, 09:39:12 am

Quote from: STxAxTIC on February 01, 2019, 09:08:55 am

Quote
The GUI makes use of "The LIBRARY WHICH SHALL NOT BE NAMED", and it seems as if its name offends people
I have no idea who those "people" are who would get offended by the existence a properly-named library. Sheesh, I'd love to meet them!

I hope the re-roll mechanism doesn't offend those same people. Below they can prove that re-rolling a number is equivalent to simply not having that number in the first place. (I'm saying there's a ton of potential to fix up your re-roll feature if you insist on keeping it in place of trivial remapping.)

Remapping is fine, if all you want to do is change the dice themselves... But, what do you do when you want to reroll the total of a set of dice?

I'll keep it the way it is, for my personal use. Use it or not, the choice is yours.

It's open source; feel free to download a copy and make whatever changes you think are necessary so it'll run better for your personal programming experience. If you can make it better, then more power to ya! ;D

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SMcNeill on January 16, 2019, 12:57:08 am