Friday, April 08, 2005 11:48 AM
RichardM
Source code for DiceRoller Addin
Imports
System
Imports
System.Collections
Imports
System.Collections.Specialized
Imports
System.Data.SqlClient
Imports
System.Web
Imports
System.IO
Imports
System.Text.RegularExpressions
Imports
System.Text
Imports
System.Math
Public
Class diceroller
Shared oRnd As New Random(CInt(Now.Ticks And Integer.MaxValue))
Public Shared Function parsetext(ByVal thebody As String) As String
Dim options As RegexOptions = RegexOptions.IgnoreCase And RegexOptions.Compiled
Dim regexp As New Regex("\[dice type=((.|\n)*?)(?:\s*)\]((.|\n)*?)\[/dice(?:\s*)\]")
Dim matches As MatchCollection
matches = regexp.Matches(thebody)
For Each amatch As Match In matches
thebody = Replace(thebody, amatch.Value, GetResults(amatch.Groups(1).Value, amatch.Groups(3).Value), , 1)
Next
regexp =
New Regex("\[dice(?:\s*)\]((.|\n)*?)\[/dice(?:\s*)\]")
matches = regexp.Matches(thebody)
For Each amatch As Match In matches
thebody = Replace(thebody, amatch.Value, GetResults("d20", amatch.Groups(1).Value), , 1)
Next
Return thebody
End Function
Public Shared Function GetResults(ByVal thetype As String, ByVal thecode As String)
Dim strResult As String
Dim strdicerolled As String
Dim strtempresult As String
Select Case thetype
Case "d20"
Dim objdieroll As DieRoll
objdieroll = GetD20Result(thecode)
strResult = "<span class='diceresult'><a href='#' title='Equation: " & thecode & " Dice results: " & objdieroll.dicerolled & "'>" & objdieroll.dieresult & "</a></span>"
Case "ww", "pool"
strResult = "<span class='diceresult'><a href='#' title='Equation: " & thecode & "'>" & GetWhiteWolfResult(thecode) & "</a></span>"
End Select
Return strResult
End Function
Public Shared Function GetD20Result(ByVal thecode As String, Optional ByVal minimumvalue As Integer = 1) As DieRoll
'example code
'20d6+1
'4d4+1
Dim objDieRoll As New DieRoll
Dim thedicerolled As String
Dim strResult As String
Dim intCurrentResult As Integer
Dim pluses As String() = thecode.Split("+")
Dim minuses As String()
Dim currentlyplus As Boolean = True
Dim diceequation As String()
Dim strDiceRolled As String
Dim intCurrentDie As Integer
For Each plus As String In pluses
minuses = plus.Split("-")
currentlyplus =
True
intCurrentResult = 0
For Each minus As String In minuses
If minus.IndexOf("d") = -1 Then
intCurrentResult = minus
Else
diceequation = minus.Split("d")
For x As Integer = 1 To diceequation(0)
'just got a die result
intCurrentDie = GetRandom(1, diceequation(1))
If intCurrentDie < minimumvalue Then
intCurrentDie = minimumvalue
End If
intCurrentResult += intCurrentDie
If strDiceRolled = "" Then
strDiceRolled = intCurrentDie
Else
strDiceRolled &= ", " & intCurrentDie
End If
Next
End If
If currentlyplus Then
strResult += intCurrentResult
Else
strResult -= intCurrentResult
End If
If currentlyplus = True Then
currentlyplus =
False
End If
Next
Next
objDieRoll.dicerolled = strDiceRolled
objDieRoll.dieresult = strResult
Return objDieRoll
End Function
Public Shared Function GetWhiteWolfResult(ByVal thecode As String) As String
Dim strResult As String
Dim intCurrentResult As Integer
Dim numdice As Integer
Dim numsides As Integer
Dim split As String()
If thecode.IndexOf("d") <> -1 Then
split = thecode.Split("d")
numdice = split(0)
numsides = split(1)
Else
numdice = thecode
numsides = 10
End If
Dim i As Integer
For i = 1 To numdice
If strResult = "" Then
intCurrentResult = GetRandom(1, numsides)
strResult = intCurrentResult
Else
intCurrentResult = GetRandom(1, numsides)
strResult &= ", " & intCurrentResult
End If
While intCurrentResult = numsides
intCurrentResult = GetRandom(1, numsides)
strResult &= ", <span class='reroll'>reroll: " & intCurrentResult & "</span>"
End While
Next
Return strResult
End Function
Public Shared Function GetRandom(ByVal low As Integer, ByVal high As Integer) As Integer
Dim ivalue As Int32 = oRnd.Next(low, high + 1)
If ivalue < low Then
ivalue = low
End If
Return ivalue
End Function
End
Class
Public
Class DieRoll
Public dieresult As String
Public dicerolled As String
End
Class