@program iroll.muf
1 9999 d
i
  
( iroll.muf    v1.0    Jessy @ FurryMUCK    1/02
  
  Yet another die-rolling program. This version allows individual die
  rolls within a multi-die roll to be displayed. For example, typing 
  'roll 3d6' would display a result such as 'You roll 3d6 for 11.',
  while typing 'iroll 3d6' would display a result such as 'You roll
  3d6 and get 6 2 3 for 11.'
  
  INSTALLATION:
  
  Create a global action with a name such as 'roll;iroll', and link it
  to the program. The program should be set M2. Iroll.muf requires 
  lib-reflist and a pmatch macro, both of which should already be set up 
  on an established MUCK.
  
  USE:
    
  The syntax is:
    
    <cmd> <numberDice>d<numberSides>[+|-<modifier>] [to <player[s]]
  
  The default roll is 3d6, with no modifier, showing results to all
  players in the room. The string 'percentiles' or any leading portion
  thereof can be used to roll 1d100.
  
  Examples:
    
    roll 
    roll 2d6
    roll 2d8+2
    iroll 3d6
    roll 1d100 to jessy
    iroll 3d8-1 to jessy bob
    iroll 3d6+1 to jessy, bob, and lou.
    roll percentiles
    roll perc
    roll p
  
  Punctuation and the word 'and' are ignored.
  
  CONFIGURATION:
  
  A wizard or the owner of the program can use the #config option to 
  modify formatting.
  
    <cmd> #config prefix=<prefix>
    <cmd> #config postfix=<postfix>
  
  Example: Typing 'roll #config prefix=[OOC]' would cause all output
  generated by iroll.muf to be prepended with '[OOC] '.
  
  The #config option can also be used if you want to use a command
  name different than 'iroll' to display the results for each die.
  For example, if you wanted the command to display combined rolls to be
  'roll' and the command to display individual die rolls to be 'droll',
  you would link a command named 'roll;droll' to the program, and use
  config as follows to set 'droll' to show individual rolls:
    
    roll #config iroll=droll
  
  You can also use #config to set the display name of the 'roll' command:
  for example, 'dice #config roll=dice'. This causes the #help screen to
  display properly, but otherwise has no effect on how the program is
  used.
  
  Iroll.muf may be freely ported, copied, modified, etc. Please comment
  any changes.
)
  
(2345678901234567890123456789012345678901234567890123456789012345678901)
  
$include $lib/reflist
  
$define Tell me @ swap notify $enddef
  
$define DoClearStack begin depth while pop repeat $enddef
  
lvar ourArg                   (* str: cmd line arg... may be modified *)
lvar ourCounter                          (* int: loop control counter *)
lvar ourDice                           (* int: number of dice to roll *)
lvar ourIroll         (* bool: true if we're displaying invidual dice *)
lvar ourIstr       (* str: string holding individual die roll results *)
lvar ourMod                                     (* int: roll modifier *)
lvar ourOpt                                   (* str: command #option *)
lvar ourOtell       (* str: output string formatted for Other players *)
lvar ourPlayers           (* str: names of players to show results to *)
lvar ourRefs  (* str: prop holding reflist of players to show results *)
lvar ourRes                                       (* int: roll result *)
lvar ourSides                         (* int: number of sides per die *)
lvar ourTell    (* str: output string formatted for triggering player *)
  
: DoInit  (  --  )                         (* initialize process vars *)   
  
                                               (* init default values *)
  3 ourDice  !
  0 ourIroll !
  0 ourMod   !
  0 ourRes   !
  6 ourSides !
  
      (* set a bool to true if we need individual die rolls displayed *)
  trig "_config/iroll" getpropstr dup not if
    pop "iroll"
  then
  command @ smatch if
    1 ourIroll !
  then
  
                                  (* clean up and init 'to-tell' list *)
  "_tmp/iroll" ourRefs !
  me @ ourRefs @ remove_prop
  me @ ourRefs @ me @ REF-add
;
  
: DoCleanString  ( s -- s' )  (* remove spaces and punctuation from s *)
  
  strip                                                  (* spaces... *)
  
  dup .pmatch if                 (* leave alone if it's a player name *)
    exit
  then
  
  " " " and " subst
  "" ","   subst
  "" "."   subst
  "" "'s"  subst
  "" "'"   subst
  "" "!"   subst 
  "" ":"   subst
  " " "  " subst
;
  
: DoCapitalize  ( s -- s' )                  (* return s, capitalized *)
  
  1 strcut swap toupper swap strcat 
;
  
: DoHelpConfig  (  --  )    (* display help screen for #config option *)
  
  "A wizard or the owner of the program can use the #config option to "
  "modify formatting."
  strcat Tell " " Tell
  
    "  <cmd> #config prefix=<prefix> " Tell
    "  <cmd> #config postfix=<postfix> " Tell " " Tell
  
  "Example: Typing 'roll #config prefix=[OOC]' would cause all output "
  "generated by iroll.muf to be prepended with '[OOC] '. "
  strcat Tell " " Tell
  
  "The #config option can also be used if you want to use a command "
  "name different than 'iroll' to display the results for each die. "
  "For example, if you wanted the command to display combined rolls to be "
  "'roll' and the command to display individual die rolls to be 'droll', "
  "you would link a command named 'roll;droll' to the program, and use "
  "config as follows to set 'droll' to show individual rolls: "
  strcat strcat strcat strcat strcat Tell " " Tell
    
    "  roll #config iroll=droll " Tell " " Tell
  
  "You can also use #config to set the display name of the 'roll' command: "
  "for example, 'dice #config roll=dice'. This causes the #help screen to "
  "display properly, but otherwise has no effect on how the program is "
  "used. "
  strcat strcat strcat Tell
;
  
: DoHelp  (  --  )                             (* display help screen *)
  
  ourArg @ if
    "#configure" ourArg @ stringpfx if DoHelpConfig exit then
  then
  
  "This command is used to roll an arbitrary number of dice, displaying "
  "the results to everyone in the room or to selected players. To show "
  "individual die results that make up a multi-die roll, use the command "
  "'%icmd'. Otherwise, use '%cmd'."
  strcat strcat strcat
  trig "_config/iroll" getpropstr
  dup not if pop "iroll" then
  "%icmd" subst
  trig "_config/roll"  getpropstr
  dup not if pop "roll"  then
  "%cmd" subst Tell " " Tell
    
    "  <cmd> <numberDice>d<numberSides>[+|-<modifier>] [to <player[s]] "
    Tell " " Tell
  
  "The default roll is 3d6, with no modifier, showing results to all "
  "players in the room. The string 'percentiles' or any leading portion "
  "thereof can be used to roll 1d100. "
  strcat strcat Tell " " Tell
  
  "Examples: " Tell " " Tell
    
    "  roll  " Tell
    "  roll 2d6 " Tell
    "  roll 2d8+2 " Tell
    "  iroll 3d6 " Tell
    "  roll 1d100 to jessy " Tell
    "  iroll 3d8-1 to jessy bob " Tell
    "  iroll 3d6+1 to jessy, bob, and lou. " Tell
    "  roll percentiles " Tell
    "  roll perc " Tell
    "  roll p " Tell
  
  me @ "W" flag?
  prog owner me @ dbcmp or if
    " " Tell
    "See also '%cmd #help #config'." 
    command @ "%cmd" subst Tell
  then
;
  
: DoShowUsage  (  --  )                         (* display usage note *)
  
  ">>  Syntax:   %cmd <numdice>d<numsides>[+|-<mod>] [to <player(s)>]"
  command @ "%cmd" subst Tell
  ">>  Examples: %cmd 2d6"
  command @ "%cmd" subst Tell
  ">>            %cmd 4d8+4"
  command @ "%cmd" subst Tell
  ">>            %cmd 1d12-2 to jessy and bob"
  command @ "%cmd" subst Tell
  ">>  Default:  %cmd 3d6"
  command @ "%cmd" subst Tell
;
  
: DoSetPrefix  ( s --  )                        (* set display prefix *)
  
  pop trig "_config/prefix" rot setprop
  ">>  Prefix set." Tell
;
  
: DoSetPostfix   ( s --  )                     (* set display postfix *)
  
  pop trig "_config/postfix" rot setprop
  ">>  Postfix set." Tell
;
  
: DoSetIroll  ( s --  )                     (* set iroll command name *)
  
  pop trig "_config/iroll" rot setprop
  ">>  Iroll command set." Tell
;
  
: DoSetRoll  ( s --  )                       (* set roll command name *)
  
  pop trig "_config/roll" rot setprop
  ">>  Roll command set." Tell
;
  
: DoConfig  (  --  )                 (* configure command and formats *)
  
  me @ "W" flag?                                  (* check permission *)
  prog owner me @ dbcmp or not if
    ">>  Permission denied." Tell exit
  then
  
  ourArg @ "=" instr dup if                  (* parse param and value *)
    ourArg @ swap strcut
    swap strip dup strlen 1 - strcut pop strip
                                     (* pass to function to set value *)
    "prefix"  over stringpfx if DoSetPrefix  else
    "postfix" over stringpfx if DoSetPostfix else
    "iroll"   over stringpfx if DoSetIroll   else
    "roll"    over stringpfx if DoSetRoll    else
    ">>  Unrecognized parameter." Tell
    ">>  Valid parameters are 'prefix', 'postfix', and 'iroll'." Tell
    ">>  See '%cmd #help #config' for more information."
    command @ "%cmd" subst Tell
    then then then then
  else
    ">>  Usage: %cmd #config <parameter>=<value>"
    command @ "%cmd" subst Tell
    ">>  See '%cmd #help #config' for more information."
    command @ "%cmd" subst Tell
    pop
  then
;
  
: DoParse  (  --  )                             (* parse command line *)
  
  ourArg @ if
  
                                            (* clean punctuation etc. *)
    ourArg @ DoCleanString ourArg !
  
    ourArg @ "to *" smatch if 
      "3d6 " ourArg @ strcat ourArg !
    then
                                        (* get 'to-tell' player names *)
    ourArg @ " to " explode dup 1 = not if
      2 = if
         ourArg ! ourPlayers !
      else
        DoShowUsage pid kill
      then
    else
      pop
    then
                                                      (* get modifier *)
    ourArg @ "+" explode dup 1 = not if
      2 = if
        ourArg ! atoi ourMod !
      else
        DoShowUsage pid kill
      then
    else
      ourArg @ "-" explode dup 1 = not if
        2 = if
          ourArg ! atoi -1 * ourMod !
        else
          DoShowUsage pid kill
        then
      then
    then
    DoClearStack
                                       (* make sure something is left *)
    ourArg @ not if
      DoShowUsage pid kill
    then
                                    (* do it this way for percentiles *)
    "percentiles" ourArg @ stringpfx if
      "1" ourDice ! "100" ourSides !
    else
      ourArg @ "d" explode dup 1 = not if
        2 = if
          ourDice ! ourSides !
        else
          DoShowUsage pid kill
        then
      then
    then
    DoClearStack
  
          (* make sure we've got a positive number of dice and sides *)
    ourDice @ atoi dup 0 <= if
      pop DoShowUsage 
      " " Tell
      ">>  The number of dice must be a positive integer." Tell pid kill
    else
      ourDice !
    then
    
    ourSides @ atoi dup 0 <= if
      pop DoShowUsage
      " " Tell
      ">>  The number of sides per die must be a positive integer." Tell
      pid kill
    else
      ourSides !
    then
  then
                            (* find players to tell; store in reflist *)
  ourPlayers @ if
    ourPlayers @ " " explode
    begin
      dup while
      over .pmatch 
      dup #-1 dbcmp if
        ">>  '%player' is not a player here."
        4 pick DoCapitalize "%player" subst Tell
      else 
        dup #-2 dbcmp if
          ">>  '%player' is ambiguous."
          4 pick DoCapitalize "%player" subst Tell
        else
          dup awake? not if
            ">>  '%player' is not online."
            4 pick DoCapitalize "%player" subst Tell
          else
            me @ ourRefs @ 3 pick REF-add
          then
        then
      then
      pop swap pop 1 -
    repeat
    pop
  then
;
  
: DoRoll  (  --  )        (* make indicated roll; store in var ourRes *)
  
  ourIroll @ if
    "" ourIstr !
  then
  
  ourDice @ ourCounter !
  begin
    ourCounter @ while
    random ourSides @ % 1 + 
    ourIroll @ if
      ourIstr @ " " strcat over intostr strcat ourIstr !
    then
    ourRes @ + ourRes !
    ourCounter @ 1 - ourCounter !
  repeat
  
  ourRes @ ourMod @ + ourRes !
;
  
: DoFormat  (  --  )                         (* format output strings *)
  
                                    (* make base 'tell' format string *)
  trig "_config/prefix" getpropstr
  dup if " " strcat then
  "You roll %numd%sides%mod %irollfor %res."
  ourDice  @ intostr "%num"   subst
  ourSides @ intostr "%sides" subst
  ourRes   @ intostr "%res"   subst
  ourMod @ if
    ourMod @ 0 > if "+" else "-" then
    ourMod @ intostr strcat
  else
    ""
  then
  "%mod" subst 
  trig "_config/postfix" getpropstr
  dup if " " swap strcat then
  strcat strcat 
  ourIroll @ ourDice @ 1 = not and if
    "and get " ourIstr @ strip 
    strcat " for " strcat
    "%iroll" subst
  else
    "" "%iroll" subst
  then
  ourTell !
                                   (* make base 'otell' format string *)
  trig "_config/prefix" getpropstr
  dup if " " strcat then
  "%name rolls %numd%sides%mod %irollfor %res."
  me       @ name    "%name"  subst
  ourDice  @ intostr "%num"   subst
  ourSides @ intostr "%sides" subst
  ourRes   @ intostr "%res"   subst
  ourMod @ if
    ourMod @ 0 > if "+" else "-" then
    ourMod @ intostr strcat
  else
    ""
  then
  "%mod" subst 
  trig "_config/postfix" getpropstr
  dup if " " swap strcat then
  strcat strcat 
  ourIroll @ ourDice @ 1 = not and if
    "and gets " ourIstr @ strip 
    strcat " for " strcat
    "%iroll" subst
  else
    "" "%iroll" subst
  then
  ourOtell !
                                (* append 'to-players' list if needed *)
  DoClearStack ""
  me @ ourRefs @ REF-allrefs
  dup 1 = if
    pop pop pop
  else
    begin
      dup while
      depth 1 - rotate
      dup me @ dbcmp if 
        pop
      else
        name " " strcat
        depth pick swap strcat 
        depth 1 - put
      then
      1 -
    repeat
    pop
    strip 
    ", " " " subst
    dup " " rinstr dup if
      strcut "and " swap strcat strcat
    else
      pop
    then
    strip ")" strcat " (to " swap strcat
    ourTell @  over strcat ourTell  !
    ourOtell @ swap strcat ourOtell !
  then
;    
    
: DoDisplay  (  --  )                              (* display results *)
  
                                    (* this way for a list of players *)
  ourPlayers @ if
    me @ ourRefs @ REF-allrefs
    begin
      dup while
      swap
      dup me @ dbcmp if
        ourTell @
      else
        ourOtell @
      then
      notify
      1 -
    repeat
  else                                 (* this way to tell whole room *)
    me @ location contents
    begin
      dup while
      dup dup me @ dbcmp if
        ourTell @
      else
        ourOtell @
      then
      notify
      next
    repeat
  then
  pop
;
  
: DoExit  (  --  )                              (* clean up temp data *)
  
  me @ ourRefs @ remove_prop
;
  
: main
  
  "me" match me !
  ourArg !
  
  ourArg @ if
    ourArg @ "#*" smatch if
      ourArg @ " " instr dup if
        ourArg @ swap strcut
        strip ourArg !
        strip ourOpt !
      else
        ourArg @ strip ourOpt !
      then
    then
    ourOpt @ if
      "#help"   ourOpt @ stringpfx if DoHelp   exit then
      "#config" ourOpt @ stringpfx if DoConfig exit then
    then
  then
  
  DoInit
  
  DoParse
  
  DoRoll
  
  DoFormat
  
  DoDisplay
  
  DoExit
;
.
c
q