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:
'The next lines are only needed for manual testing
DIM DiceToRoll
AS DiceRoller_Type
'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 "PRESS <ANY KEY> TO CONTINUE"
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 "PRESS <ANY KEY> TO CONTINUE"
Brief = 1
PRINT "SEMI-BRIEF OUTPUT:" PRINT "'6s; 4d6 kh3' -- Roll 6 sets of 4 six-sided dice, keep the three highest" PRINT "PRESS <ANY KEY> TO CONTINUE"
Brief = 2
PRINT "MOST BRIEF OUTPUT:" PRINT "'6s; 4d6 kh3' -- Roll 6 sets of 4 six-sided dice, keep the three highest" PRINT "PRESS <ANY KEY> TO CONTINUE"
'PRINT "Stripping number"; m$
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
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
SetCount = 0
FOR j
= 1 TO DiceToRoll.Set
ReRollSet:
SetTotal = 0
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 ParseDiceOption
(roll
, DiceToRoll.DiceOpenRoll
) THEN DiceOK = 0
DiceTotal = DiceTotal + roll + DiceToRoll.DiceMod
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
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 i
< DiceToRoll.NumberOfDice
THEN 'more dice to roll in this set
IF rollcount
> 0 THEN Sort rolls
() 'No need to try and sort only 1 dice.
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 IF DiceToRoll.DiceKeepLow
THEN FOR i
= 0 TO DiceToRoll.DiceKeepLow
- 1 IF i
< rollcount
THEN keep
(i
) = -1 ELSEIF DiceToRoll.DiceDiscardHigh
OR DiceToRoll.DiceDiscardLow
THEN keep(i) = -1
IF DiceToRoll.DiceDiscardHigh
THEN FOR i
= DiceToRoll.DiceDiscardHigh
- 1 TO 0 STEP -1 IF i
< rollcount
THEN keep
(rollcount
- i
) = 0 IF DiceToRoll.DiceDiscardLow
THEN FOR i
= 0 TO DiceToRoll.DiceDiscardLow
- 1 IF i
< rollcount
THEN keep
(i
) = 0 keep(i) = -1
KeepTotal = 0
kept = 0
kept = kept + 1
KeepTotal = KeepTotal + rolls(i)
IF ParseDiceOption
(KeepTotal
, DiceToRoll.SetReRoll
) THEN
IF ParseDiceOption
(KeepTotal
, DiceToRoll.SetOpenRoll
) THEN SetTotal = SetTotal + KeepTotal + DiceToRoll.SetMod
SetCount = SetCount + 1
SetRolls(SetCount) = SetTotal
GrandTotal = GrandTotal + SetTotal
SetTotal = SetTotal + KeepTotal + DiceToRoll.SetMod
SetCount = SetCount + 1
SetRolls(SetCount) = SetTotal
GrandTotal = GrandTotal + SetTotal
GrandTotal = GrandTotal + DiceToRoll.TotalMod
Sort SetRolls()
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 FOR i
= 0 TO DiceToRoll.SetKeepLow
- 1 IF i
< SetCount
THEN keep
(i
) = -1 ELSEIF DiceToRoll.SetDiscardHigh
OR DiceToRoll.SetDiscardLow
THEN keep(i) = -1
IF DiceToRoll.SetDiscardHigh
THEN FOR i
= DiceToRoll.SetDiscardHigh
- 1 TO 0 STEP -1 IF i
< SetCount
THEN keep
(SetCount
- i
) = 0 IF DiceToRoll.SetDiscardLow
THEN FOR i
= 0 TO DiceToRoll.SetDiscardLow
- 1 IF i
< SetCount
THEN keep
(i
) = 0 keep(i) = -1
KeepTotal = 0
keep = 0
keep = keep + 1
KeepTotal = KeepTotal + SetRolls(i)
KeepTotal = KeepTotal + DiceToRoll.TotalMod
temp$
= MID$(temp$
, f
+ 1)
'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. ;)
gap = rollcount
gap = 10 * gap \ 13
i = 0
swapped = 0
o = m.OFFSET + i * 4
o1 = m.OFFSET + (i + gap) * 4
swapped = -1
i = i + 1
FOR i
= 1 TO LEN(text1$
) 'check for invalid characters 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 'invalid
'IF DiagRollEM THEN PRINT "Verified: "; text$
IF text$
= "" THEN EXIT SUB 'can't do nothing with an empty string ClearDice
semicolon
= INSTR(text$
, ";") l$
= LEFT$(text$
, semicolon
- 1) text$
= MID$(text$
, semicolon
+ 1) l$ = text$
'IF DiagRollEM THEN PRINT "PROCESSING: "; l$
found = 0
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 DiagRollEm
THEN PRINT "Number of Sets = "; DiceToRoll.Set
pass = 0
pass = pass + 1
'IF DiagRollEM THEN PRINT "SUBPROC "; m$
IF v
> 0 THEN DiceToRoll.SetMod
= v
IF v
> 0 THEN DiceToRoll.SetMod
= -v
IF v
> 0 THEN DiceToRoll.SetKeepHigh
= v
IF DiagRollEm
THEN PRINT "Keep the Highest"; v;
" Sets" IF v
> 0 THEN DiceToRoll.SetKeepLow
= v
IF v
> 0 THEN DiceToRoll.SetDiscardHigh
= v
IF DiagRollEm
THEN PRINT "Discard the Highest"; v;
" Sets" 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
innerpass = innerpass + 1
IF v
<> 0 THEN 'it's an o/r followed by a number CASE ELSE 'a character not a number, or =<>, finished = -1
StripNumber m$
DiceToRoll.SetReRoll = t$
IF DiagRollEm
THEN PRINT "Reroll Sets "; DiceToRoll.SetReRoll
DiceToRoll.SetOpenRoll = t$
IF DiagRollEm
THEN PRINT "Openroll Sets "; DiceToRoll.SetOpenRoll
StripNumber m$
CASE "K", "D", "R", "O", "+", "-" 'see if it's another command without a comma
IF v
< 1 THEN DiceToRoll.NumberOfDice
= 1 ELSE DiceToRoll.NumberOfDice
= v
IF DiagRollEm
THEN PRINT "Number of Dice To Roll = "; DiceToRoll.NumberOfDice
IF v
> 0 THEN DiceToRoll.DiceSides
= v
StripNumber m$
IF DiagRollEm
THEN PRINT "Dice Sides = "; DiceToRoll.DiceSides
pass = 0
pass = pass + 1
'IF DiagRollEM THEN PRINT "SUBPROC "; m$
IF v
> 0 THEN DiceToRoll.DiceMod
= v
IF v
> 0 THEN DiceToRoll.DiceMod
= -v
IF v
> 0 THEN DiceToRoll.DiceKeepHigh
= v
IF v
> 0 THEN DiceToRoll.DiceKeepLow
= v
IF v
> 0 THEN DiceToRollDiceDiscardHigh
= v
IF v
> 0 THEN DiceToRoll.DiceDiscardLow
= v
CASE "R", "O" 'reroll or open roll finished = 0: t$ = "": innerpass = 0
innerpass = innerpass + 1
IF v
<> 0 THEN 'it's an o/r followed by a number CASE ELSE 'a character not a number, or =<>, finished = -1
StripNumber m$
DiceToRoll.DiceReroll = t$
DiceToRoll.DiceOpenRoll = t$
IF DiagRollEm
THEN PRINT "DO: "; DiceToRoll.DiceOpenRoll
StripNumber m$
CASE "K", "D", "R", "O", "+", "-" 'see if it's another command without a comma
DiceToRoll.TotalMod
= VAL(MID$(l$
, 2)) IF DiagRollEm
THEN PRINT "Dice Total Modifier = "; DiceToRoll.TotalMod
IF DiagRollEm
THEN PRINT "Roll Information Displayed: ";
RollEm$ = DiceRoll$
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
stuffO + stuff-- Openroll according
to stuffstuff -- 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...
