@q
@program Ping-Me.muf
1 9999 d
i
( Ping-me.muf  v1.0   Jessy@FurryMUCK    5/96
  
  I made this program because I was working on a computer that allowed 
  only five minutes of idle time. I made a six-line program that sent 
  me a 'ping' every three minutes so I wouldn't time out. This is the 
  same program dressed up for public use; it's longer than six lines.
  
  The time interval and output may be set to whatever the user wants.
  The output will parse MPI, so the program can also be used to trigger
  events that one wants to run automatically at a given interval or 
  when one logs off.
  
  Installation: 
  
  Set the program L. Make a global action if appropriate. The program
  requires Mucker level 3, because of the KILL primitive used to prevent
  players from having multiple ping processes running. It does not use 
  any libraries or macros. 
  
  Putting the program in the _disconnect queue of room #0 will cause
  processes to stop immediately upon log out. Otherwise, they are
  stopped at the next ping.
  
  Use: 
  
  If the program is not global, link an action to the program.
  
  '<action>' or '<action> #on' starts pinging.
  '<action> #on = <string>' sets the message shown each ping.
  '<action> #off' stops pinging.
  '<action> #off = <string>' sets the message shown when process stops.
  '<action> #time = <seconds>' sets the time between pings.
  
  Ping-me.muf may be freely ported. Please comment any modifications.
)
  
lvar counter                            (* loop checking counter, integer *)
lvar ping-time                    (* stores time between pings in seconds *)
                                      (* ping-string is fetched each time 
                                         rather than stored as a variable
                                         to allow MPI parsing.            *)
                                         
: MainName  (  -- s )               (* strips aliases from a trigger name; 
                                       used here to format help screen    *)
                                       
                 (* exit if no aliases; else separate and record how many *)
    trig name ";" explode dup 1 = not if  
        counter !
        else
           pop exit
    then
                                      (* loop, popping an alias each time *)
    begin                                      (* BEGIN NAME-POPPING LOOP *)
        counter @ 1 = if
            break                           (* break, returning main name *)
        then
        swap pop
        counter @ 1 - counter !
    repeat                                       (* END NAME-POPPING LOOP *)
;
   
: Help  (  --  )                                      (* shows helpscreen *)
    
    " " me @ swap notify
    "Ping-me.muf" me @ swap notify
    " " me @ swap notify
    
    "This program sends an automatic 'ping' to your screen periodically, "
    "which can keep you from timing out if your ISP has very short idle "
    "limits. Being pinged does not affect your MUCK idle time. The "
    "interval and message shown can be set to whatever you like. The "
    "output will parse MPI, so the program may also be used to trigger "
    "events you would like to run automatically at a given interval. "
    "Your settings are stored on your character, in propdir _prefs/ping/."
    strcat strcat strcat strcat strcat strcat me @ swap notify
    " " me @ swap notify
    
    MainName dup " or " strcat swap strcat 
    " #on                                                             "
    strcat 24 strcut pop
    "Starts pinging." strcat me @ swap notify
    
    MainName " #on   = <message>                                      "
    strcat 24 strcut pop
    "Sets string shown when pinging \(default 'ping'\)." 
    strcat me @ swap notify
     
    MainName " #off                                                   "
    strcat 24 strcut pop
    "Stops pinging." strcat me @ swap notify
    
    MainName " #off  = <message>                                      "
    strcat 24 strcut pop
    "Sets string shown when process stops \(default 'pong'\)." 
    strcat me @ swap notify
    
    MainName " #time = <seconds>                                      "
    strcat 24 strcut pop
    "Sets time between pings \(default 300\)." strcat me @ swap notify
    
    " " me @ swap notify
;
    
: ParseThis  ( d s -- s )           (* returns d's prop s, parsed for MPI *)
    
    dup 3 pick swap getpropstr 0 parseprop
;
    
: SetProps  ( s --  )     (* record user settings in propdir _prefs/ping/ *)
    
                              (* figure out which prop we will be setting *)
    dup "#on*" smatch if
        "_prefs/ping/ping-string"
        else
            dup "#off*" smatch if
               "_prefs/ping/pong-string"
               else
                   "_prefs/ping/ping-time"
        then
    then
                                                   (* get value to be set *)
    swap "=" explode pop pop strip
                                     (* check: ping-time must be a number *)
    over "_prefs/ping/ping-time" smatch if
       dup number? not if
           ">>  That's not a number." me @ swap notify pop exit
           else
           dup atoi 0 <= if
               ">>  Ping time must be at least 1 second." me @ swap notify
               exit
           then
       then
    then
                                                   (* set prop and notify *)
    me @ rot rot setprop
    ">>  Done." me @ swap notify
;
  
: Stop  (  --  )                                         (* stops pinging *)
    
                                                  (* kill process, notify *)
    prog "_pids/" me @ intostr strcat getprop kill pop
    me @ "_prefs/ping/pong-string" over over
    getpropstr if
        ParseThis me @ swap notify
        else
            pop pop "pong"
            me @ swap notify
    then
;
 
: CheckCon  (  --  )  (* checks if player is awake and does a stop if not *)
    
    me @ awake? not if
        Stop
    then
;
  
: Start  (  --  )                                       (* starts pinging *)
    
                                                     (* put in background *)
    background
                  (* kill any previous process; record pid of new process *)
    prog "_pids/" me @ intostr strcat 
    over over
    getprop kill pop
    pid setprop
                                                (* get time between pings *)
    me @ "_prefs/ping/ping-time" getpropstr dup if
        atoi
        else
            pop 300
    then
    ping-time !
                                     (* send pings from now till whenever *)
    begin                                           (* BEGIN PINGING LOOP *)
        me @ awake? while
                                        (* get ping-string, parse, notify *)
        me @ "_prefs/ping/ping-string" over over
        getpropstr if
            ParseThis me @ swap notify
            else
                pop pop "ping"
                me @ swap notify
        then
        ping-time @ sleep
    repeat                                            (* END PINGING LOOP *)
        
    Stop                                                      (* clean up *)
;
   
: main
                                                  (* stop naughty hackers *)
    "me" match me !
                           (* case checking from here down: find function *)
    dup if
        dup "#h*" smatch if
            Help exit
        then
        dup "#time*" smatch if
            dup "*=*" smatch not if
                pop
                ">>  Usage: " MainName strcat " #time = <seconds>" strcat
                me @ swap notify exit
            then
            SetProps exit
        then
        dup "#on*" smatch if
            dup "*=*" smatch if
                SetProps exit
                else
                    pop Start exit
            then
        then
        dup "#off*" smatch if
            dup "*=*" smatch if
                SetProps exit
                else
                    pop Stop exit
            then
        then
        dup "disconnect" smatch if
            CheckCon exit
        then
        pop
    then
    
    Start
;
.
c
q