chandice.mrc

;Copyright 2004, 2005, 2008 Alex Walters.
on *:text:!dice help:*:{
  notice $nick !dice <pool> <target> [action] (Botch 1)
  notice $nick !sdice <pool> <target> [action] (10's rerolled, Botch 1)
  notice $nick !xdice <pool> <target> [action] (9's rerolled, Botch 1)
  notice $nick !nwod <pool> [action] (10's rerolled, target 8)
  notice $nick !9nwod <pool> [action] (9's rerolled, target 8)
  notice $nick !8nwod <pool> [action] (8's rerolled, target 8)
  notice $nick !cnwod [action] (10's rerolled, target 10, Botch 1)
}
on *:text:!dice*:*:chandice $$2 $$3 0 1 $iif($target == $me,$nick,$chan) $nick $4-
on *:text:!sdice*:*:chandice $2 $$3 10 1 $iif($target == $me,$nick,$chan) $nick $4- $dbrak(Specialized)
on *:text:!xdice*:*:chandice $$2 $$3 9 1 $iif($target == $me,$nick,$chan) $nick $4- $dbrak(Double Specialized)
on *:text:!nwod*:*:chandice $$2 8 10 0 $iif($target == $me,$nick,$chan) $nick $3-
on *:text:!9nwod*:*:chandice $$2 8 9 0 $iif($target == $me,$nick,$chan) $nick $3- $dbrak(9 Again)
on *:text:!8nwod*:*:chandice $$2 8 8 0 $iif($target == $me,$nick,$chan) $nick $3- $dbrak(8 Again)
on *:text:!cnwod*:*:chandice 1 10 10 1 $iif($target == $me,$nick,$chan) $nick $2- $dbrak(Chance)

alias chandice {
  var %dice = $wdice($1,$2,$3,$4)
  var %roll = $gettok(%dice,1,124)
  var %reroll = $gettok(%dice,2,124)
  var %status = $gettok(%dice,3,124)

  if (%status > 1000) {
    msg $5 6error:14 $wdice(%status).err 
  }
  else {
    describe $5 Rolls14 $1 dice vs.14 $2 for14 $6 $iif($7,to14 $7- $+ )
    describe $5 Rolls: $+(12,$chr(91),06,%roll,12,$chr(93),) $iif(%reroll != 0,Rerolls: $+(12,$chr(91),06,%reroll,12,$chr(93),)) Successes: $+(12,$chr(91),06,%status,12,$chr(93),) $iif(%status == -1,4 $+ $chr(91) $+ BOTCH! $+ $chr(93) $+ )
  }
}

alias wdice {
  if ($prop == err) {
    ;1 = dice pool greater than 20
    ;2 = dice pool 0 or less
    ;4 = dice target grater than 10
    ;8 = dice target 0 or lesss
    ;16 = reroll target grater than 10
    ;32 = botch target grater than 10
    var %err = $calc($1 - 1000)
    var %rpl = $null

    if ($and(%err,1)) {
      var %rpl = %rpl Dice pool greater than 20.   
    }
    if ($and(%err,2)) {
      var %rpl = %rpl Dice pool 0 or less.   
    }
    if ($and(%err,4)) {
      var %rpl = %rpl Dice target grater than 10.   
    }
    if ($and(%err,8)) {
      var %rpl = %rpl Dice target 0 or lesss.   
    }
    if ($and(%err,16)) {
      var %rpl = %rpl Reroll target grater than 10.   
    }
    if ($and(%err,32)) {
      var %rpl = %rpl Botch target grater than 10.   
    }
    return %rpl $chr(40) $+ Code: $1 $+ $chr(41)
  }
  else {
    ;$1 = Dice pool (Number of dice to roll)
    ;$2 = Target Number (use to 8 for New World of darkness)
    ;$3 = Target Number for reroll
    ;$4 = Target Number for botch (1)
    ;Reply:
    ;  (rolls)|(rerolls or 0 if none)|(status code)
    ;Status Codes:
    ;     1 = Success
    ;     0 = Failure
    ;    -1 = botch
    ; 1000+ = Error

    ;Name Attributes as variables
    var %pool = $1
    var %dtarg = $2
    var %rtarg = $3
    var %btarg = $4

    ;Initialize script Variables
    var %_reroll = 0
    var %_roll = 0
    var %succ = 0
    var %botch = 0
    var %status = 0
    var %die = 0
    var %err = 1000

    ;Start Input error check
    if (%pool > 20) {
      var %err = %err + 1
    }
    if (%pool <= 0) {
      var %err = %err + 2
    }
    if (%dtarg > 10) {
      var %err = %err + 4
    }
    if (%dtarg <= 0) {
      var %err = %err + 8
    }
    if (%rtarg > 10) {
      var %err = %err + 16
    }
    if (%btarg > 10) {
      var %err = %err + 32
    }
    if (%err > 1000) {
      var %out = 0 $+ $chr(124) $+ 0 $+ $chr(124) $+ %err
      return %out
      halt
    }
    ;End Input error check


    ;start primary dice loop
    while (%_roll < %pool) {
      ;var %die = $rand(1,10)
      var %die = $rng(10)
      inc %_roll 1
      ;adds roll to dice roll list
      var %rolls = %rolls $+ %die $+ $chr(44)

      ;check for success
      if (%die >= %dtarg) {
        ;check if reroll is set
        if (%rtarg > 0) {
          ;check if qualifies for reroll
          if (%die >= %rtarg) {
            inc %_reroll 1
          }
        }
        inc %succ 1
      }
      ;check if botch set
      elseif (%btarg > 0) {
        ;check if qualifies for botch
        if (%die <= %btarg) {
          inc %botch 1
          dec %_reroll 1
        }

      }
    }
    ;end primary dice loop

    ;start reroll dice loop
    while (%_reroll >= 1) {
      ;var %die = $rand(1,10)
      var %die = $rng(10)
      dec %_reroll 1
      ;adds roll to reroll list
      var %rerolls = %rerolls $+ %die $+ $chr(44)

      ;check for success
      if (%die >= %dtarg) {
        ;check if qualifies for addition reroll
        if (%die >= %rtarg) {
          inc %_reroll 1
        }
        inc %succ 1
      }
      ;check for botch set
      elseif (%btarg > 0) {
        ;check if qualifies for botch
        if (%die <= %btarg) {
          inc %botch 1
        }
      }

    }
    ;end reroll dice loop

    ;remove last coma from (re)roll lists
    var %rolls = $left(%rolls,$calc($len(%rolls)-1))
    var %rerolls = $left(%rerolls,$calc($len(%rerolls)-1))

    ;if no reroll list, add a 0 to create a useable token
    if (!%rerolls) {
      var %rerolls = 0
    }

    ;check for botch
    if (%botch > %succ) {
      var %status = -1
    }
    ;check for fail
    elseif (%succ == 0) {
      var %status = 0
    }
    ;otherwise success
    else {
      var %succ = %succ - %botch
      var %status = %succ
    }

    ;create token
    var %out = %rolls $+ $chr(124) $+ %rerolls $+ $chr(124) $+ %status
    return %out
  }
}
alias dbrak {
  var %string = $$1-
  var %out = $+(4,$chr(40),%string,$chr(41),)
  return %out
}

dice.mrc

;Copyright Alexander Walters 2008, All Rights Reserved

;main trigger
on *:text:!roll *:*:{
  ;check to see if it was PMed or in a channel.
  ;set %chan to the users nick if in PM
  ;set %chan to originating channel if from channel
  if ($target == $me) {
    var %chan = $nick
  }
  elseif ($target ischan) {
    var %chan = $chan
  }
  ;start the script proper
  dice %chan $nick $$2-
}

alias dice {
  ;input %chan %nick %dice %action
  var %chan = $1
  var %nick = $2
  var %test = $3-

  ;help section.  only triggers if help is the first word and ignores all subsiquent words
  if (help* iswm %test) {
    notice %nick !roll [<rolls>#][<[+|-]accept>/][dice]d<sides>[+|-|/|*<math>][r<[+|-]reroll[+|-]>][t<[+|-]target[+|-]>] [roll 2] ... [roll N] [Action]
    notice %nick rolls: How many times to do the following roll.  each roll will be on its own line
    notice %nick accept: Of the dice rolled, how many of them to count into the total.  A positive value here means the highest N dice are counted.  A negitive number means the lowest N dice are counted.
    notice %nick dice: Number of dice in each roll.  Defaults to 1 if not specified.
    notice %nick sides: Number of sides the die rolled have.  this is a number between 2 and 100.
    notice %nick math: Add, Subtract, Multiply, Divide the total by this number.
    notice %nick reroll: Specifies which dice should be rerolled.  A positive number means all dice that are lower than or equal to that number will be rerolled untill there is a result higher. A negitive number indicates dice higher than or equal to that number will be rerolled.
    notice %nick target: To calculate margins of success and failure, specify a target.  A positive number indicates that the resulting total should be higher than the target.  A negitive number indicates successful results are lower than the target.  A positive margin is a success, a negitive one is a failure.
  }
  else {
    ;total number of space delminated values in the test
    var %total = $numtok(%test,32)

    ;looking for the descriptive action in the command.
    ;If there is one, %remainder will be filled with it, else it wont be set
    var %check_index = 1
    while (%check_index <= %total) {
      ;get Nth space deliminated value
      var %die = $gettok(%test,%check_index,32)
      ;check against generic dice
      var %die_parsed = $dice_parse(%die)
      ;check against dice side chain: white wolf
      var %ww_check = $regex(ww_check,%die,%ww_regex)
      ;if it is generic or sidechained dice...
      if (%die_parsed || %ww_check) {
        ;incriment the index, and nothing more
        inc %check_index 1
        continue
      }
      ;if it is not dice, and there has been atleast one actual set of dice...
      elseif (%check_index > 1) {
        ;take current string position, add the "-" symbol, then add the total size...
        var %remain_tok = $+(%check_index,$chr(45),%total)
        ;to tell it to set %remainder to all remaining tokens.
        var %remainder = $gettok(%test,%remain_tok,32)
        ;break the loop
        break
      }
      else {
        ;break the loop incase something unexpected happened and NONE of the above were called
        break
      }
    }



    var %index = 1
    var %ww_regex = ^([w|t|r|b][0-9]+)([w|t|r|b][0-9]+)([w|t|r|b][0-9]+)?([w|t|r|b][0-9]+)?$
    while (%index <= %total) {
      var %die = $gettok(%test,%index,32)
      var %die_parsed = $dice_parse(%die)
      var %ww_test = $regex(ww_test,%die,%ww_regex)
      if (%die_parsed && ($left(%die_parsed,1) != $chr(33))) {
        var %roll = $dice_roll(%die_parsed)
        var %index2 = 1
        var %total2 = $numtok(%roll,124)
        describe %chan Rolls 14 $+ %die $+  for 14 $+ %nick $+  $iif(%remainder,to 14 $+ %remainder)
        while (%index2 <= %total2) {
          describe %chan Rolls $+ $chr(58) 12 $+ $chr(91) $+ 06 $+ $gettok($gettok(%roll,%index2,124),1,58) $+ 12 $+ $chr(93) $+  Total $+ $chr(58) 12 $+ $chr(91) $+ 06 $+ $gettok($gettok(%roll,%index2,124),2,58) $+ 12 $+ $chr(93) $+ 
          inc %index2 1
        }
      }
      elseif (%ww_test) {
        var %ww_dice_rx = ^w([0-9]+)$
        var %ww_targ_rx = ^t([0-9]+)$
        var %ww_rero_rx = ^r([0-9]+)$
        var %ww_botc_rx = ^b([0-9]+)$
        var %ww_totl_rx = $regml(ww_test,0)
        var %ww_dice = 0
        var %ww_targ = 0
        var %ww_rero = 0
        var %ww_botc = 0
        var %n = 1
        while (%n <= %ww_totl_rx) {
          var %test_base = $regml(ww_test,%n)
          if ($regex(dice,%test_base,%ww_dice_rx)) {
            var %ww_dice $regml(dice,1)
          }
          if ($regex(targ,%test_base,%ww_targ_rx)) {
            var %ww_targ $regml(targ,1)
          }
          if ($regex(rero,%test_base,%ww_rero_rx)) {
            var %ww_rero $regml(rero,1)
          }
          if ($regex(botc,%test_base,%ww_botc_rx)) {
            var %ww_botc $regml(botc,1)
          }
          inc %n 1
        }
        chandice %ww_dice %ww_targ %ww_rero %ww_botc %chan %nick $iif(%remainder,%remainder)
      }
      elseif ($left(%die_parsed,1) == $chr(33)) {
        var %tmp_len = $len(%die_parsed)
        var %tmp_len = $calc(%tmp_len -1)
        var %errs = $right(%die_parsed,%tmp_len)
        msg %chan ERROR! $dice_parse(%errs).error
      }
      else {
        break
      }
      inc %index 1
    }
  }
}
alias dice_parse {
  if ($prop = error) {
    var %out = $null
    var %input = $1
    var %err = 1
    var %errors = Too many rolls (>10).;Too many dice in roll (>50).;Accepted dice range higher than total dice rolled.;Too many sides on dice (>100).;Reroll set too high;Reroll set too low.;Target set out of range.
    while (%err <= 7) {
      if ($isbit(%input,%err)) {
        var %out = $addtok(%out,$gettok(%errors,%err,59),32)
      }
      inc %err 1
    }
    return %out
  }
  else {
    var %input = $1
    if (!%input) {
      return $false
    }
    var %main_regx = ^([0-9]+#)?([+|-]?[0-9]+[+|-]?/)?([0-9]+)?(d[0-9]+)([+|\-|\*|/][0-9]+)?(r[+|-]?[0-9]+[+|-]?)?(t[+|-]?[0-9]+[+|-]?)?$
    var %roll_regx = ^([0-9]+)#$
    var %take_regx = ^([+|-]?[0-9]+)([+|-])?/$
    var %dice_regx = ^([0-9]+)$
    var %side_regx = ^d([0-9]+)$
    var %math_regx = ^([+|\-|\*|/][0-9]+)$
    var %rero_regx = ^r([+|-]?[0-9]+)([+|-])?$
    var %targ_regx = ^t([+|-]?[0-9]+)([+|-])?$
    var %roll = 1
    var %take = 0
    var %dice = 1
    var %side = 0
    var %rero = 0
    var %math = 0
    var %targ = 0
    var %first_run = $regex(dice_parse,%input,%main_regx)
    if (%first_run) {
      var %total = $regml(dice_parse,0)
      var %n = 1
      while (%n <= %total) {
        var %test_base = $regml(dice_parse,%n)
        if ($regex(roll,%test_base,%roll_regx)) {
          var %roll $regml(roll,1)
        }
        if ($regex(take,%test_base,%take_regx)) {
          if ($regml(take,0) == 1) {
            var %take = $regml(take,1)
          }
          elseif ($regml(take,0) == 2) {
            var %take = $+($regml(take,2),$regml(take,1))
          }
        }
        if ($regex(dice,%test_base,%dice_regx)) {
          var %dice = $regml(dice,1)
        }
        if ($regex(side,%test_base,%side_regx)) {
          var %side = $regml(side,1)
        }
        if ($regex(math,%test_base,%math_regx)) {
          var %math = $regml(math,1)
        }
        if ($regex(rero,%test_base,%rero_regx)) {
          if ($regml(rero,0) == 1) {
            var %rero = $regml(rero,1)
          }
          elseif ($regml(rero,0) == 2) {
            var %rero = $+($regml(rero,2),$regml(rero,1))
          }
        }
        if ($regex(targ,%test_base,%targ_regx)) {
          if ($regml(targ,0) == 1) {
            var %targ = $regml(targ,1)
          }
          elseif ($regml(targ,0) == 2) {
            var %targ = $+($regml(targ,2),$regml(targ,1))
          }
        }
        inc %n 1
      }
      var %error = 0
      if (%roll > 10) {
        var %error = $biton(%error,1)
      }
      if (%dice > 50) {
        var %error = $biton(%error,2)
      }
      if ($abs(%take) > %dice) {
        var %error = $biton(%error,3)
      }
      if (%side > 100) {
        var %error = $biton(%error,4)
      }
      if (((%rero < 0) && ($abs(%rero) > %side)) || ((%rero > 0) && (%rero > $calc(%side -1)))) {
        var %error = $biton(%error,5)
      }
      if (((%rero > 0) && (%rero < 1)) || ((%rero < 0) && ($abs(%rero) < 2))) {
        var %error = $biton(%error,6)
      }
      if (((%targ > 0) && ((%targ > $calc((%dice * %side)) || (%targ < 1)))) || ((%targ < 0) && ($abs(%targ) < %dice))) {
        var %error = $biton(%error,7)
      }
      ;spit it out
      if (%error) {
        return $chr(33) $+ %error
      }
      else {
        return %roll %take %dice %side %rero %math %targ
      }
    }
    else {
      return $false
    }
  }
}
on 1:start:{
  rng_org_refill
}
alias rng_org_refill {
  set %working $true
  sockopen rnd_org www.random.org 80
  if (!$hget(rng_org_tbl)) {
    hmake rng_org_tbl 100
  }
}
on 1:sockopen:rnd_org:{
  sockwrite -n rnd_org GET /integers/?num=500&min=1&max=100&col=1&base=10&format=plain&rnd=new
  sockwrite -n rnd_org Host: www.random.org
  sockwrite rnd_org $crlf
}
on 1:sockread:rnd_org: {
  if ($sockerr > 0) return
  :nextread
  sockread %rng_data
  if ($sockbr == 0) {
    sockclose rnd_org
    echo -a $hget(rng_org_tbl,0).item Numbers in list
    unset %working
    return
  }
  hadd rng_org_tbl $calc($hget(rng_org_tbl,0).item + 1) %rng_data
  goto nextread
}
alias rng {
  var %sides = $$1
  var %devisor = $calc(%sides / 100)
  var %size = $hget(rng_org_tbl,0).item
  if (%size == 0) {
    var %number = $rand(1,%sides)
    if (!%working) {
      set %working $true
      .timer 1 0 rng_org_refill
    }
  }
  else {
    var %rand_nbr = $hget(rng_org_tbl,%size)
    var  %number = $ceil($calc(%rand_nbr * %devisor))
    hdel rng_org_tbl %size
    ;echo -a $hget(rng_org_tbl,0).item Numbers in list
  }
  return %number
}
alias dice_roll {
  ;Input %roll %take %dice %side %rero %math
  var %input = $1-
  if ($numtok(%input,32) > 1) {
    tokenize 32 %input
  }
  elseif ($numtok(%input,44) > 1) {
    tokenize 44 %input
  }
  var %roll = $round($1,0)
  var %take = $round($2,0)
  var %dice = $round($3,0)
  var %side = $round($4,0)
  var %rero = $round($5,0)
  var %math = $6
  var %targ = $round($7,0)

  var %roll_index = 1
  var %dice_out = $null
  var %dice_string_tok = 44
  var %dice_out_roll_tok = 124
  var %dice_out_sep_tok = 58
  var %rero_string_temp_tok = 59
  var %rero_string_tok = 44
  while (%roll_index <= %roll) {
    var %dice_out_temp = $null
    var %dice_add = $null
    var %dice_string_tmp = $null
    var %dice_string = $null
    var %rero_string = $null
    var %dice_out_temp = $null
    var %dice_out_write_pos = $null
    var %dice_index = 1
    while (%dice_index <= %dice) {
      var %dice_temp = $null
      var %dice_temp = $rng(%side)
      if (%rero != 0) {
        var %rero_string_temp = $null
        var %rero_string_temp = $instok(%rero_string_temp,%dice_temp,1,%rero_string_temp_tok)
        while (((%rero > 0) && (%dice_temp <= %rero)) || ((%rero < 0) && (%dice_temp >= $abs(%rero)))) {
          var %dice_temp = $rng(%side)
          var %rero_string_temp = $instok(%rero_string_temp,%dice_temp,1,%rero_string_temp_tok)
        }
        var %rero_string_write_pos = $calc($numtok(%rero_string,%rero_string_tok) +1)
        var %rero_string = $instok(%rero_string,%rero_string_temp,%rero_string_write_pos,%rero_string_tok)
      }
      var %dice_string_write_pos = $calc($numtok(%dice_string,%dice_string_tok) +1)
      var %dice_string = $instok(%dice_string,%dice_temp,%dice_string_write_pos,%dice_string_tok)
      inc %dice_index 1
    }

    ;need to support negitive takes (take the lesser of the rolls)
    ;aolution: dont invert the sort if the take is less than 0
    var %dice_string_tmp = $sorttok(%dice_string,%dice_string_tok,$iif(%take < 0,n,nr))

    var %dice_add = $iif($abs(%take) > 0,$abs(%take),$numtok(%dice_string_tmp,%dice_string_tok))

    var %dice_add_index = 1
    var %dice_add_temp = 0
    var %dice_sum = 0

    while (%dice_add_index <= %dice_add) {
      var %dice_add_temp = $gettok(%dice_string_tmp,%dice_add_index,%dice_string_tok)
      var %dice_sum = $calc(%dice_sum + %dice_add_temp)
      inc %dice_add_index 1
    }

    if (%math != 0) {
      var %dice_sum = $calc(%dice_sum %math)
    }

    ;add support here for total targets.
    if (%targ != 0) {
      if (%targ > 0) {
        var %margin = $calc(%dice_sum - %targ)
      }
      if (%targ < 0) {
        var %margin = $calc($abs(%targ) - %dice_sum)
      }
      var %dice_sum = %dice_sum $+($chr(40),Margin %margin,$chr(41))
    }

    if (%rero != 0) {
      var %rero_outter_total = $numtok(%rero_string,%rero_string_tok)
      var %rero_outter_index = 1
      while (%rero_outter_index <= %rero_outter_total) {
        var %rero_outter_to_inner = $gettok(%rero_string,%rero_outter_index,%rero_string_tok)
        var %rero_inner_total = $numtok(%rero_outter_to_inner,%rero_string_temp_tok)
        if (1 < %rero_inner_total) {
          var %rero_inner_first = $gettok(%rero_outter_to_inner,1,%rero_string_temp_tok)
          var %rero_inner = $deltok(%rero_outter_to_inner,1,%rero_string_temp_tok)
          var %rero_inner = $+(%rero_inner_first,05,$chr(40),%rero_inner,$chr(41),06)
          var %rero_string = $deltok(%rero_string,%rero_outter_index,%rero_string_tok)
          var %rero_string = $instok(%rero_string,%rero_inner,%rero_outter_index,%rero_string_tok)          
        }
        inc %rero_outter_index 1
      }
    }
    var %dice_out_proc = $iif(%rero != 0,%rero_string,%dice_string)

    if ($abs(%take) > 0) {
      var %take_total = $numtok(%dice_string_tmp,%dice_string_tok)
      var %take_index = $calc($abs(%take) +1)
      while (%take_index <= %take_total) {
        var %take_temp = $gettok(%dice_string_tmp,%take_index,%dice_string_tok)
        var %take_temp_pos = $findtok(%dice_string,%take_temp,1,%dice_string_tok)
        var %take_temp_token = 04 $+ $gettok(%dice_out_proc,%take_temp_pos,%dice_string_tok) $+ 06
        var %dice_out_proc = $deltok(%dice_out_proc,%take_temp_pos,%dice_string_tok)
        var %dice_out_proc = $instok(%dice_out_proc,%take_temp_token,%take_temp_pos,%dice_string_tok)
        inc %take_index 1
      }
    }

    var %dice_out_temp = $instok(%dice_out_temp,$replace(%dice_out_proc,$chr(44),$chr(32)),1,%dice_out_sep_tok)
    var %dice_out_temp = $instok(%dice_out_temp,%dice_sum,2,%dice_out_sep_tok)

    var %dice_out_write_pos = $calc($numtok(%dice_out,%dice_out_roll_tok) +1)
    var %dice_out = $instok(%dice_out,%dice_out_temp,dice_out_write_pos,%dice_out_roll_tok)

    inc %roll_index 1
  }
  return %dice_out
}