@q
@program cmd-@action
1 99999 d
i
  
( cmd-@action    v1.0    Jessy @ FurryMUCK    3/00
  
  Cmd-@action emulates the standard @action command and incorporates
  quota control. Like the @action command provided by the standard
  cmd-quota program, it also allows the action to be linked at the 
  time it is created.
  
  INSTALLATION:
  
  Port cmd-@action and set it Wizard. Link a global action named 
	'@action;@act' to it.
  
  Cmd-@action requires lib-quota, which should be available at the MUCK
  or website where you obtained this program.
  
  Cmd-@action may be freely ported. Please comment any changes.
)
  
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
lvar ourDest
lvar ourExit
lvar ourRegname
lvar ourSource
lvar ourString
 
$include $lib/quota
 
$define Tell me @ swap notify $enddef 
$define NukeStack begin depth while pop repeat $enddef
 
: DoHelp  (  --  )                                (* show help screen *)
  
  " " Tell
  "@action <name>=<source>[,<destination>] [=<regname>]" Tell " " Tell
  
"Creates a new action and attaches it to the thing, room, or player "
"specified. 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. "
"You may only attach actions you control to things you control. Creating "
"an action costs 1 penny. The action can then be linked with the command "
"@LINK. "
  strcat 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
;
 
: DoCreateAction  (  --  )             (* create action, attach, link *)
  
  ourSource @ ourExit @ newexit ourExit !            (* create action *)
  "Action created with number $dbref and attached."
  ourExit @ intostr "$dbref" subst Tell
  
  ourDest @ if                     (* link if a destination was given *)
    "Trying to link..." Tell               (* try to find destination *)
    ourDest @ match
    dup  #-1 dbcmp 
    over #-2 dbcmp or if
      "I couldn't find '$dest'."
      ourDest @ "$dest" subst Tell pop
    else                      (* ... if so, check permission and link *)
      ourDest !
      me @ ourDest @ controls not if
        ourDest @ "A" flag? not if
          "You can't link to $dest." 
          ourDest @ name "$dest" subst Tell
        else
          ourExit @ ourDest @ setlink
          "Linked to $dest."
          ourDest @ unparseobj "$dest" subst Tell
        then
      else
        ourExit @ ourDest @ setlink
        "Linked to $dest."
        ourDest @ unparseobj "$dest" subst Tell
      then
    then
  then
                                          (* set regname if specified *)
  ourRegname @ if
    ourExit @ ourRegname @ RegisterObject
  then
                                        (* charge cost if appropriate *)
  me @ Exempt? not if me @ -1 addpennies then
;
 
: DoParse  (  --  )                         (* parse command and args *)
  
  ourString @ dup "=" instr if                               (* parse *)
    dup "=" instr strcut strip ourSource ! 
    dup strlen 1 - strcut pop strip ourExit !
    ourSource @ "=" instr if
      ourSource @ dup "=" instr strcut strip ourRegname !
      dup strlen 1 - strcut pop strip ourSource !
    then
    ourSource @ "," instr if
      ourSource @ dup "," instr strcut strip ourDest !
      dup strlen 1 - strcut pop strip ourSource !
    then
    ourSource @ not if
      "You must specify an action name and a source object." 
      Tell NukeStack exit
    then
  else
    "You must specify an action name and a source object." 
    Tell NukeStack exit
  then
                                              (* locate source object *)
  ourSource @ match
  dup  #-1 dbcmp 
  over #-2 dbcmp or if
    "I don't see that here." Tell exit
  then
  me @ over controls not if
    "Permission denied." Tell exit
  then
  dup program? if
    "You can't attach an action to a program." Tell exit
  then
  ourSource !
 
  ourExit @ CheckName if
    DoCreateAction
  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 an action name and a source object." Tell
  then
;
.
c
q
@set cmd-@action=W