This is a routine that will generate a number based on the dice rolling formula where:
xdy{+/-z}
where x is the number of dice, y is the sides on the dice and +z or -z is a modifier for the final dice roll. E.g.
2d8+1
will roll 2 8 sided dice and add 1 to the result
This code can be cut and pasted directly into DBPro as it includes an example, and it requires 5.4+
PRINT "2d6+2 =";RollDiceFormula("2d6+2")
PRINT "3d4 =";RollDiceFormula("3d4")
PRINT "2d2d3+1=";RollDiceFormula("2d2d3+1")
WAIT KEY
function RollDice(numDice AS INTEGER, sides AS INTEGER)
total AS INTEGER
for lp=1 TO numDice
total=total+RND(sides-1)+1
next lp
endfunction total
function RollDiceFormula(diceString AS STRING)
LOCAL numDice AS INTEGER
LOCAL numSides AS INTEGER
LOCAL modifier AS INTEGER
LOCAL lp AS INTEGER
LOCAL lth AS INTEGER
LOCAL char AS STRING
LOCAL charInt AS INTEGER
LOCAL valid AS INTEGER
LOCAL foundD AS INTEGER
LOCAL foundPlus AS INTEGER
LOCAL foundMinus AS INTEGER
LOCAL result AS INTEGER
LOCAL remainder AS STRING
LOCAL tokenString AS STRING
lth=LEN(diceString)
valid=1
foundD=0
foundPlus=0
foundMinus=0
` first pass of string to validate formula
for lp=1 TO lth
char=MID$(diceString,lp)
if char<>"d" AND char<>"+" AND char<>"-"
charInt=ASC(char)
if charInt<48 OR charInt>57
valid=0
endif
else
if char="d" then foundD=foundD+1
if char="-"
if foundD=1
foundMinus=foundMinus+1
else
valid=0
endif
endif
if char="+"
if foundD=1
foundPlus=foundPlus+1
else
valid=0
endif
endif
endif
next lp
if foundD<>1 then valid=0
if foundMinus>1 then valid=0
if foundPlus>1 then valid=0
if founsPlus=1 AND foundMinus=1 then valid=0
` second pass to pick out num dice, num sides plus any modifier
if valid=1
numDice=VAL(FIRST TOKEN$(diceString,"d"))
remainder=next TOKEN$("d")
tokenString=""
if foundMinus=1 then tokenString="-"
if foundPlus=1 then tokenString="+"
if tokenString<>""
numSides=VAL(FIRST TOKEN$(remainder,tokenString))
modifier=VAL(tokenString+next TOKEN$(tokenString))
else
numSides=VAL(remainder)
modifer=0
endif
result=RollDice(numDice, numSides)+modifier
else
result=-1
endif
endfunction result
Jas
----
"What is this talk of 'release'? Klingons do not'release' software. It escapes leaving a bloody trail of developers and quality assurance people in its wake!"
