@q
@program cmd-@aconnect
1 99999 d
i
( cmd-@aconnect   v1.1   Jessy @ FurryMUCK   11/99, 1/00
  
  This is an emulated version of the MUSH/MUX @aconnect command.
  
  INSTALLATION:
   
  Create a global action and link it to this program.  Set the program 
  Wizard and Link_OK.
  
  USAGE:
  
    @aconnect <object> = <command-list>
    
  The only meaningful entries for <object> are 'me' and #0.
  
  <command-list> is a semi-colon-separated list of commands to be run
  at connection time.
  
  cmd-@aconnect may be freely ported. Please comment any changes.
)
  
$define Tell me @ swap notify $enddef
  
lvar ourObject
lvar ourString
  
: DoHelp  ( s --  )                               (* show help screen *)
  
  pop
  "This is an emulated version of the MUSH/MUX @aconnect command."
  Tell " " Tell
  
  "Command: @aconnect <object> = <command-list> Tell
  "Property: _prefs/aconnect" Tell " " Tell
 
  "Sets the actions to be taken by a player right after connecting to "
  "the game. If <object> is a player, actions run each time that player "
  "connects. If <object> is Room #0, actions run each time any player "
  "connects. Only wizards may set global aconnects."
  strcat strcat strcat Tell " " Tell
 
  "Example: @aconnect me = +mail;+where" Tell " " Tell
 
  "See also: @adisconnect." Tell
;
  
: DoSetAconnect  ( s --  )                  (* set connection actions *)
  
  dup "=" instr if                                           (* parse *)
    dup "=" instr strcut
    strip ourString !
    strip dup strlen 1 - strcut pop strip ourObject !
  else
    ourObject !
  then
  
  ourObject @ match                                          (* match *)
  dup not if
    "I don't see that here." Tell exit
  then
  dup #-2 dbcmp if
    "I don't know which one you mean!" Tell exit
  then
  ourObject !
  
  me @ ourObject @ controls not if                (* check permission *)
    "Permission denied." Tell exit
  then
  
  ourObject @ player? not if              (* bail for invalid objects *)
    ourObject @ #0 dbcmp not if
      "Set." Tell exit
    then
  then
  
  ourObject @ "_prefs/aconnect" getpropstr if
    ourObject @ "_connect/zaconnect" prog setprop
  else
    ourObject @ "_connect/zaconnect" remove_prop
  then
  
  ourObject @ "_prefs/aconnect" ourString @ setprop            (* set *)
  "Set." Tell
;
 
: DoAconnects  (  --  )                     (* run connection actions *)
  
                                            (* first personal ones... *)
  me @ "_prefs/aconnect" getpropstr dup if
    ";" explode
    begin
      dup while
      me @ rot force
      1 -
    repeat
    pop
  else
    pop
  then
                                              (* ... then the globals *)
  #0 "_prefs/aconnect" getpropstr dup if
    ";" explode
    begin
      dup while
      me @ rot force
      1 -
    repeat
    pop
  else
    pop
  then
;
  
: main
  
  "me" match me !
  trig if
    dup if
      "#help" over stringpfx if
        DoHelp
      else
        DoSetAconnect
      then
    else
      "I don't see that here." Tell
    then
  else
    DoAconnects
  then
;
.
c
q