A dice parser

[James D Jarvis]

A dice parser to return a score from a string that describes a dice roll. 
roll("2d6") would return a score from 2 to 12
These routines are part of a Role Playing Game related program and mat be useful to others.

This sample program demonstrates 12 different string and the results generated.

Code: (Select All)

'dice parser  july 2023
'by James D. Jarvis
'a simpe dice parser for an RPG game that will evalute a string and generate the roll described
' d = dice,standard equal distribution range
' s = short dice, trends to generate low value in range
' f = fat dice, trends to generate median value in range
' t = tall dice, trend to generate higher values in range
' e = exploding die
'******************************************************
'Include these in nay program using the routines here
'$dynamic
Randomize Timer
Dim Shared de$(0) 'dice experssion
Dim Shared drf$(0) 'dice function
Dim Shared dn
Dim Shared ds
'*******************************************************

'setting up  sample rolls to demonstarte routines
Dim r$(12)
r$(1) = "1d6"
r$(2) = "2d6"
r$(3) = "1s8"
r$(4) = "1e8"
r$(5) = "2t10"
r$(6) = "1d6+1d3"
r$(7) = "1d12+1s4"
r$(8) = "-2t100"
r$(9) = "1d4+1d6+1d8"
r$(10) = "1s20+1f5"
r$(11) = "1d10000/1s4"
r$(12) = "1t200-1s200"

Do
    For x = 1 To 12
        rr = roll(r$(x))
        Print r$(x); "= "; rr
    Next x
    Print
    Print "Press any key for more rolls, <esc> to exit"
    Do
        _Limit 60
        kk$ = InKey$
    Loop Until kk$ <> ""
    Cls
Loop Until kk$ = Chr$(27)
'roll dice
Function rolld (num, sides)
    score = 0
    For n = 1 To num
        score = score + Int(1 + Rnd * sides)
    Next n
    rolld = score
End Function
'roll short dice
Function rolls (num, sides)
    score = 0
    For n = 1 To num
        A = Int(1 + Rnd * sides)
        B = Int(1 + Rnd * sides)
        C = Int(1 + Rnd * sides)
        add = A
        If add > B Then add = B
        If add > C Then add = C
        score = score + add
    Next n
    rolls = score
End Function
'roll tall dice
Function rollt (num, sides)
    score = 0
    For n = 1 To num
        A = Int(1 + Rnd * sides)
        B = Int(1 + Rnd * sides)
        C = Int(1 + Rnd * sides)
        add = A
        If B > add Then add = B
        If C > add Then add = C
        score = score + add
    Next n
    rollt = score
End Function
'roll fat dice
Function rollf (num, sides)
    score = 0
    For n = 1 To num * 3
        score = score + Int(1 + Rnd * sides)
    Next n
    rollf = Int(score / 3)
End Function
'roll exploding die
Function rolle (num, sides)
    score = 0
    b = 0
    For n = 1 To num
        a = Int(1 + Rnd * sides)
        score = score + a
        If a = sides Then
            Do
                b = Int(1 + Rnd * sides)
                score = score + b
            Loop Until b < sides
        End If
    Next n
    rolle = score
End Function
'break out the individual rolls
Sub find_rolls (idd$)
    c = 0
    w$ = ""
    xc = 0
    dd$ = idd$ + "#" 'okay I'm lazy i added a termination symbol to the string
    last$ = "+"
    Do
        c = c + 1
        A$ = Mid$(dd$, c, 1)
        Select Case A$
            Case "+", "-", "/", "*", "#"
                xc = xc + 1
                ReDim _Preserve de$(xc)
                ReDim _Preserve drf$(xc)
                de$(xc) = w$
                drf$(xc) = last$
                w$ = ""
                last$ = A$
            Case Else
                w$ = w$ + A$
        End Select
    Loop Until c >= Len(dd$)
End Sub
'the main fuction that is called to return a rolled value from the described dice roll
Function roll (idd$)
    find_rolls idd$
    dn = UBound(de$)
    Dim ss(dn)
    score = 0
    For n = 1 To dn
        dit$ = doroll$(de$(n))
        Select Case doroll$(de$(n))
            Case "d"
                ss(n) = rolld(finddn(de$(n), dit$), findds(de$(n), dit$))
            Case "s"
                ss(n) = rolls(finddn(de$(n), dit$), findds(de$(n), dit$))
            Case "t"
                ss(n) = rollt(finddn(de$(n), dit$), findds(de$(n), dit$))
            Case "f"
                ss(n) = rollf(finddn(de$(n), dit$), findds(de$(n), dit$))
            Case "e"
                ss(n) = rolle(finddn(de$(n), dit$), findds(de$(n), dit$))
            Case "V"
                ss(n) = Val(de$(n))
        End Select
        Select Case drf$(n)
            Case "+"
                score = score + ss(n)
            Case "-"
                score = score - ss(n)
            Case "/" 'divides the previolsy generated score
                score = score / ss(n)
            Case "*" 'multiplies the previolsy generated score
                score = score * ss(n)
        End Select
    Next n
    roll = score
End Function
Function doroll$ (dd$)
    c = 1
    Dim a$(6)
    a$(1) = "d": a$(2) = "s": a$(3) = "f": a$(4) = "t": a$(5) = "e": a$(6) = "V"
    d$ = "V"
    Do
        If InStr(dd$, a$(c)) > 0 Then
            d$ = a$(c)
            c = 6
        End If
        c = c + 1
    Loop Until c > 6
    doroll$ = d$
End Function
Function finddn (dd$, r$)
    rp = InStr(dd$, r$)
    a = Val(Left$(dd$, rp - 1))
    finddn = a
End Function
Function findds (dd$, r$)
    rp = InStr(dd$, r$)
    a = Val(Right$(dd$, Len(dd$) - rp))
    findds = a
End Function

[SMcNeill]

https://qb64phoenix.com/forum/showthread...28#pid1028 -- There's my dice rolling routine.  It works with any sort of requirements which you'd ever need for any type of table-top RPG you'll ever encounter.

[OldMoses]

I stripped this little tidbit out of my Runequest character generator. Change the R$ to whatever quantity, type of dice, and modifier that you need.

Code: (Select All)

RANDOMIZE TIMER
R$ = "2d6"
Build_Dice R$, a%
PRINT a%
END

FUNCTION DiceRoll% (quan AS INTEGER, dice AS INTEGER, plus AS INTEGER)
    'Rolls any number of dice of any number of sides and adds modifiers
    'syntax usage: DiceRoll% (number of dice rolled, number of sides, any modifier)
    DIM t%, x%
    t% = plus '                                                 add modifier
    FOR x% = 1 TO quan '                                        roll die <quan>tity of times
        t% = t% + INT(RND * dice) + 1 '                        total up results
    NEXT x%
    DiceRoll% = t%
END FUNCTION 'DiceRoll%

SUB Build_Dice (roll AS STRING, result AS INTEGER)
    'Parse a dice roll string and roll it, return in result
    roll = UCASE$(roll)
    dpos% = INSTR(roll, "D")
    qn% = -VAL(MID$(roll, 1, dpos% - 1)) * (dpos% > 1) - (dpos% = 1)
    p% = INSTR(roll, "+")
    n% = INSTR(roll, "-")
    IF p% <> 0 THEN md% = VAL(MID$(roll, p%)): dc% = VAL(MID$(roll, dpos% + 1, p% - dpos% + 1))
    IF n% <> 0 THEN md% = VAL(MID$(roll, n%)): dc% = VAL(MID$(roll, dpos% + 1, n% - dpos% + 1))
    IF p% = 0 AND n% = 0 THEN md% = 0: dc% = VAL(MID$(roll, dpos% + 1))
    result = DiceRoll%(qn%, dc%, md%)
END SUB 'Build_Dice