@q
@program cmd-@open
1 99999 d
i
  
( cmd-@open    v1.0    Jessy @ FurryMUCK    3/00
  
  Cmd-@open emulates the standard @open command and incorporates
  quota control. The current version does not do multi-links. If
  there is any demand, this feature will be added to a future 
  version. It does, however, allow backlinks to be created at the
  time an exit is opened.
  
  INSTALLATION:
  
  Port cmd-@open and set it Wizard. Link a global action named '@open'
  to it.
  
  Cmd-@open requires lib-quota, which should be available at the MUCK
  or website where you obtained this program.
  
  Cmd-@open may be freely ported. Please comment any changes.
)
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
lvar ourBacklink
lvar ourDest
lvar ourExit
lvar ourRegname
lvar ourString
 
$include $lib/quota
 
$define Tell me @ swap notify $enddef 
$define NukeStack begin depth while pop repeat $enddef
 
: DoHelp  (  --  )                                (* show help screen *)
  
  " " Tell
  "@open <exit> [=<dest object> [,<backlink name> [=<regname>]]]"
  Tell " " Tell
  
"Opens an exit in the current room, optionally attempting to link it "
"simultaneously. If a <regname> is specified, then the _reg/<regname> "
"property on the player is set to the dbref of the new object. This lets "
"players refer to the object as $<regname> (ie: $mybutton) in @locks, "
"@sets, etc. Opening an exit costs a penny, and an extra penny to link "
"it, and you must control the room where it is being opened. "
  strcat strcat strcat strcat strcat Tell
;
 
: 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
;
 
: DoOpenExit  (  --  )                             (* open exit, link *)
  
  me @ location ourExit @ newexit ourExit !            (* create exit *)
  "Exit opened with number $dbref."
  ourExit @ intostr "$dbref" subst Tell
  
  ourDest @ if                                    (* find destination *)
    ourDest @ match
    dup  #-1 dbcmp
    over #-2 dbcmp or if
      "I couldn't find '$link'."
      ourDest @ "$link" subst Tell 
    else                                            (* if found, link *)
      ourDest !
      ourDest @ #-3 dbcmp if
        me @ getlink ourDest !
        ourExit @ ourDest @ setlink
        "Linked to $link." 
				ourDest @ name "$link" subst Tell
      else
        me @ ourDest @ controls not if
          ourDest @ "L" flag? not if
            "You may not link to $link." 
            ourDest @ name "$link" subst Tell
          else
            ourExit @ ourDest @ setlink
            "Linked to $link."
            ourDest @ unparseobj "$link" subst Tell
          then
        else
          ourExit @ ourDest @ setlink
          "Linked to $link."
          ourDest @ unparseobj "$link" subst Tell
        then
      then
    then
  then
  
  ourBacklink @ if                    (* create backlink if specified *)
    "Trying to create backlink..." Tell
    ourBacklink @ CheckName if
      ourDest @ ourBacklink @ newexit
      "Backlink created with number $dbref."
      over intostr "$dbref" subst Tell
      me @ location setlink
      me @ Exempt? not if me @ -1 addpennies then
    else
      "That's a silly name for an exit!" Tell
    then
  then
  
  ourRegname @ if
    ourExit @ ourRegname @ RegisterObject
  then
   
  me @ Exempt? not if me @ -1 addpennies then
;
 
: DoParse  (  --  )                         (* parse command and args *)
  
  ourString @ dup "=" instr if                               (* parse *)
    dup "=" instr strcut strip ourDest ! 
    dup strlen 1 - strcut pop strip ourExit !
    ourDest @ "=" instr if
      ourDest @ dup "=" instr strcut strip ourRegname !
      dup strlen 1 - strcut pop strip ourDest !
    then
    ourDest @ "," instr if
      ourDest @ dup "," instr strcut strip ourBacklink !
      dup strlen 1 - strcut pop strip ourDest !
    then
    ourExit @ not if
      "You must specify a direction or action name to open." 
      Tell NukeStack exit
    then
  else
    ourExit !
  then
                                                  (* check permission *)
  me @ dup location controls not if
    "Permission denied." Tell exit
  then
   
  ourExit @ CheckName if
    DoOpenExit
  else
    "That's a silly name for an exit!" 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
    DoExitQuota not if exit then                        (* check cost *)
    DoParse
  else
    "You must specify a direction or action name to open." Tell
  then
;
.
c
q
@set cmd-@open=W