@q
@program cmd-@xdig
1 99999 d
i
 
( cmd-@xdig    v1.0    Jessy @ FurryMUCK    3/00
  
  Cmd-@xdig allows users to create a room, an exit leading to the room,
  and a backlink from the newly created room in a single step. It is
  integrated with lib-quota to provide quota control.
  
  INSTALLATION:
  
  Port cmd-@xdig and set it Wizard. Linke a global action named '@xdig'
  to it.
  
  USAGE:
 
    @xdig <room> [=<exit to room> [=<backlink from room>]]
 
  Creates a new room and, optionally, an exit leading from your current
  location to the room, and/or an exit leading from the room to your current
  location. The room is automatically parented to the same position in the
  environment tree as your current location. Creating a room costs 10
  pennies. Creating an exit costs 1 penny. Only a builder may use this
  command. 
  
  Cmd-@xdig may be freely ported. Please comment any changes.
)
  
lvar ourBack
lvar ourRoom
lvar ourString
lvar ourThere
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
$include $lib/quota
 
$define Tell me @ swap notify $enddef 
$define NukeStack begin depth while pop repeat $enddef
 
: DoHelp  (  --  )                                (* show help screen *)
  
  " " Tell
  "@xdig <room> [=<exit to room> [=<backlink from room>]]" Tell " " Tell
  
"Creates a new room and, optionally, an exit leading from your current "
"location to the room, and/or an exit leading from the room to your "
"current location. The room is automatically parented to the same "
"position in the environment tree as your current location. Creating a "
"room costs 10 pennies.  Creating an exit costs 1 penny. Only a builder "
"may use this command. "
  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
;
 
: DoExitQuota  (  --  )
 
  me @ "exits" CheckQuota not if                (* check user's quota *)
    "You are at or over your limit of exits." Tell 0 exit
  then
  me @ "exits" CheckCost not if               (* check user's pennies *)
    "Sorry, you don't have enough $pennies."
    "pennies" sysparm "$pennies" subst Tell 0 exit
  then
  NukeStack 1
;
 
: DoThereExit  (  --  )                    (* create exit to new room *)
  
  "Trying to create exit to $room..."                       (* notify *)
  ourRoom @ name "$room" subst Tell
  
  me @ dup location controls not if               (* check permission *)
    "You may not open an exit here." Tell exit
  then
                                  (* check name; create link if valid *)
  ourThere @ CheckName if 
    DoExitQuota if
      me @ location ourThere @ newexit
      "Exit created with number $dbref."
      over intostr "$dbref" subst Tell
      ourRoom @ setlink
      "Linked to $room." 
      ourRoom @ unparseobj "$room" subst Tell
      me @ Exempt? not if me @ -1 addpennies then
    then
  else
    "That's a silly name for an exit!" Tell
  then
;
 
: DoBackExit  (  --  )                             (* create backlink *)
  
  "Trying to create exit from $room to here..."             (* notify *)
  ourRoom @ name "$room" subst Tell
  
  me @ dup location controls not if               (* check permission *)
    me @ location "L" flag? not if
      "You may not link to $here."
      me @ location name "$here" subst Tell exit
    then
  then
  
  ourBack @ CheckName if          (* check name; create link if valid *)
    DoExitQuota if
      ourRoom @ ourBack @ newexit
      "Exit created with number $dbref."
      over intostr "$dbref" subst Tell
      me @ location setlink
      "Linked to $room." 
      me @ location unparseobj "$room" subst Tell
      me @ Exempt? not if me @ -1 addpennies then
    then
  else
    "That's a silly name for an exit!" Tell
  then
;
 
: DoDigRoom  (  --  )                            (* create a new room *)
  
  DoRoomQuota if
    me @ location location 
    dup not if
      pop #0
    then
    ourRoom @ newroom ourRoom !
    "$name created with room number $dbref."
    ourRoom @ name    "$name" subst
    ourRoom @ intostr "$dbref" subst Tell
  then
   
  me @ Exempt? not if me @ -10 addpennies then
  
  ourThere @ if
    DoThereExit
  then
  
  ourBack @ if
    DoBackExit
  then
;
  
: DoParse   (  --  )                              (* parse arg string *)
  
                                               (* tokenize arg string *)
  ourString @ "=" instr if
    ourString @ dup "=" instr strcut strip ourThere !
    strip dup strlen 1 - strcut pop strip ourRoom !
    ourThere @ "=" instr if
      ourThere @ dup "=" instr strcut strip ourBack !
      strip dup strlen 1 - strcut pop strip ourThere !
    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
    DoParse
  else
    "You must specify a name for the room." Tell
  then
;
.
c
q
@set cmd-@xdig=W