@q
@program cmd-@dig
1 99999 d
i
  
( cmd-@dig    v1.0    Jessy @ FurryMUCK    3/00
  
  Cmd-@dig emulates the standard @dig command and incorporates
  quota control.
  
  INSTALLATION:
  
  Port cmd-@dig and set it Wizard. Link a global action named '@dig'
  to it.
  
  Cmd-@dig requires lib-quota, which should be available at the MUCK
  or website where you obtained this program.
  
  Cmd-@dig may be freely ported. Please comment any changes.
)
 
lvar ourString
lvar ourCounter
lvar ourRoom
lvar ourParent
lvar ourRegname
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
$include $lib/quota
 
$define Tell me @ swap notify $enddef 
$define NukeStack begin depth while pop repeat $enddef
 
: DoHelp  (  --  )                                (* show help screen *)
  
  " " Tell
  "@dig <room> [=<parent> [=<regname>]]" Tell " " Tell
  
"Creates a new room, sets its parent, and gives it a personal registered "
"name. If no parent is given, it defaults to the first ABODE room down "
"the environment tree from the current room. If it fails to find one, it "
"sets the parent to the global environment, which is typically room #0. "
"If no regname is given, then it doesn't register the object. If one is "
"given, then the object's dbref is recorded in the player's "
"_reg/<regname> property, so that they can refer to the object later as "
"$<regname>. Digging a room costs 10 pennies, and you must be able to "
"link to the parent room if specified. Only a builder may use this command."
  strcat strcat strcat strcat strcat strcat strcat strcat Tell
;
 
: DoRoomQuota  (  --  )
 
  me @ "rooms" CheckQuota not if                (* check user's quota *)
    "You are at or over your limit of rooms." Tell 0 exit 
  then
  me @ "rooms" CheckCost not if               (* check user's pennies *)
    "Sorry, you don't have enough $pennies."
    "pennies" sysparm "$pennies" subst Tell 0 exit 
  then
  NukeStack 1
;
 
: DoDigRoom  (  --  )                            (* create a new room *)
  
  me @ location location                               (* create room *)
  dup not if
    pop #0
  then
  ourRoom @ newroom ourRoom !
  "$name created with room number $dbref."
  ourRoom @ name    "$name" subst
  ourRoom @ intostr "$dbref" subst Tell
   
  ourParent @ if                          (* set parent if applicable *)
    "Trying to set parent..." Tell
    ourParent @ match
    dup #-1  dbcmp
    over #-2 dbcmp or if
      "I don't see that here." Tell
      "Parent set to default." Tell
    else
      ourParent !
      ourParent @ room? if
        me @ ourParent @ controls 
        ourParent @ "A" flag? or if
          ourRoom @ ourParent @ moveto
          "Parent set to $parent."
          ourParent @ unparseobj "$parent" subst Tell
        else
          "Permission denied.  Parent set to default." Tell
        then
      else
        "Permission denied.  Parent set to default." Tell
      then
    then
  then
                                            (* register if applicable *)
  ourRegname @ if
    ourRoom @ ourRegname @ RegisterObject
  then
                                              (* charge if applicable *)
  me @ Exempt? not if me @ -10 addpennies then
;
  
: DoParse   (  --  )                              (* parse arg string *)
  
                                               (* tokenize arg string *)
  ourString @ "=" instr if
    ourString @ dup "=" instr strcut strip ourParent !
    strip dup strlen 1 - strcut pop strip ourRoom !
    ourParent @ "=" instr if
      ourParent @ dup "=" instr strcut strip ourRegname !
      strip dup strlen 1 - strcut pop strip ourParent !
    then
  else
    ourString @ ourRoom !
  then
   
  ourRoom @ CheckName if
    DoDigRoom
  else
    "That's a silly name for a room!" Tell
  then
;
 
: main
  
  "me" match me !
  
  me @ "B" flag? not if
    "That command is restricted to authorized builders." Tell exit
  then 
   
  dup if
    ourString !
    "#help" ourString @ stringpfx if DoHelp exit then
    DoRoomQuota not if exit then                        (* check cost *)
    DoParse
  else
    "You must specify a name for the room." Tell
  then
;
.
c
q
@set cmd-@dig=W