@prog cmd-logmeoff
1 9999 d
1 i
$include $lib/strings
$include $lib/match
$include $lib/stackrng
  
: do-help
  me @ "logmeoff in <number> <seconds|minutes|hours|days|weeks>" notify
  me @ "logmeoff for <number> <seconds|minutes|hours|days|weeks>" notify
  me @ "logmeoff now" notify
  me @ "logmeoff clear <playername>     (Wizard only)" notify
;
  
: boot-player (dbref message -- )
  over swap notify
  concount begin
    dup while
    dup condbref 3 pick dbcmp if dup conboot then
    1 -
  repeat
  pop
;
  
: set-keepofftime ( timeint -- )
  me @ "@KeepOffUntil"
  3 pick if
    "" 4 pick addprop
    "You will not be able to connect again until %r on %x %Z"
    swap timefmt me @ swap notify
  else
    remove_prop
  then
;
  
: banned? ( -- i)
  me @ "@KeepOffUntil" getpropval
  dup systime <= if pop 0 then
;

: parse-relative-time ( timestr -- secondsint)
  " " .split strip swap strip
  dup "{a|an}" smatch if pop "1" then
  dup number? not if pop pop 0 exit then
  atoi swap tolower strip
  dup "{months|month}"   smatch if pop 31 * "days" then
  dup "{weeks|week}"     smatch if pop 7 * "days" then
  dup "{days|day}"       smatch if pop 24 * "hours" then
  dup "{hours|hour}"     smatch if pop 60 * "minutes" then
  dup "{minutes|minute}" smatch if pop 60 * "seconds" then
  "{seconds|second}" smatch not if pop 0 then
;
  
$define parse-reltime
  parse-relative-time
  dup 0 < if
    pop "I can't do time travel, you know!"
    me @ swap notify exit
  then
  dup not if
    pop "I don't understand the relative time value you gave me."
    me @ swap notify exit
  then
$enddef
  
: set-keepoff-relative ( timestr -- )
  parse-reltime systime + set-keepofftime
;
  
: choose-random (sn..s1 i -- s)
  random 256 / over % 2 + pick
  over 2 + -1 * rotate popn
;
  
: random-furry (s -- s)
  "*** "
  "An apparition" "An illusion" "A hologram"
  3 choose-random strcat " of " strcat
  
  "a young" "a beautiful" "a motherly looking " "an elderly"
  4 choose-random strcat " " strcat
  
  "woman"   "vixen"   "feline"   "wolf 'morph"   "keshant vixen"
  "avian"   "ermine"  "otter"    "tigress"       "panda"
  "dragon"  "mink"    "lynx"     "doe"           "unicorn 'morph" 
  15 choose-random strcat " " strcat
  
  "appears quietly"  "fades into view"  "shimmers into being"
  "shimmers"         "appears"          "coalesces"
  6 choose-random strcat " " strcat
  
  "before" "in front of" "beside" "near" "next to"
  5 choose-random strcat " " strcat me @ name strcat " and " strcat
  
  "adresses" "speaks to" "talks to" "bows to" "nods to"
  5 choose-random strcat me @ " %o.  " pronoun_sub strcat
  
  "\"My appologies for interrupting, but "
  "\"I'm sorry, but "
  "\"Please accept my appologies.. "
  "\"I regret that "
  "\"Terribly sorry, but "
  5 choose-random strcat swap strcat "\"  " strcat
  
  "The image"  "The apparition"  "The vision"
  3 choose-random strcat " then " strcat
  
  "fades" "dissolves" "blurs and fades" "shimmers out" "slowly disappears"
  5 choose-random strcat "." strcat
  
  me @ location #-1 rot notify_except
;
  
  
: classy-logoff ( -- )
  "you need to be leaving now."
  "you must be going now."
  "you really should be leaving now."
  3 choose-random "  " strcat
  
  "You requested to be logged off at this time."
  "You asked to be disconnected at this time."
  "It was at this time that you asked to be logged off."
  "You requested that we should disconnect you at this time."
  4 choose-random strcat
  
  random-furry
  me @ "You have been disconnected." boot-player
;
  
  
  
: classy-message (s -- )
  "I must inform you"
  "I must tell you"
  "I must warn you"
  3 choose-random
  " that you only have " strcat
  swap strcat " " strcat
  "left " "remaining " ""
  3 choose-random strcat
  "before the time that you " strcat
  "requested" "asked" "authorized"
  3 choose-random strcat " us to " strcat
  "log you off." "disconnect you." "@boot you."
  3 choose-random strcat
  random-furry
;
  
  
  
: sleepto (i i s -- i)
  rot rot over over <= if pop swap pop exit then
  swap over - sleep (sleep until the appropos time)
  swap classy-message
;
  
  
  
: timed-logoff-sequence ( i -- )
  1800 "half an hour" sleepto
  600 "ten minutes" sleepto
  60 "a minute" sleepto
  dup 0 > if sleep 0 then
  pop classy-logoff
  systime 900 + set-keepofftime
;
  
  
: kill-prev-timed-logoff ( -- )
  me @ "@TimedLogoffPID" getpropval
  dup if kill then pop
  me @ "@TimedLogoffPID" remove_prop
;
  
: init-timed-logoff (i -- )
  kill-prev-timed-logoff
  me @ "@TimedLogoffPID" "" pid addprop
  "I will now log you off at %r on %x %Z." over systime + timefmt
  me @ swap notify
  timed-logoff-sequence
;
  
  
: set-keepoff-absolute ( timestr -- )
  "" pop  (WORK)
;
  
  
: set-leavetime-relative (timestr -- )
  parse-reltime init-timed-logoff
;
  
  
: set-leavetime-absolute (timestr -- )
  "" pop  (WORK)
;
  
  
: do-connectcheck ( -- )
  banned? dup if
    me @ "Sorry, but you aren't allowed back on until %r on %x %Z."
    rot timefmt notify
    me @ "@LastConnected" getpropval systime swap -
    me @ "@LastConnected" "" systime addprop
    900 > if
      "You will be allowed five minutes to check page-mail, however." .tell
      "5 minutes" set-leavetime-relative exit
    then
    "Sorry, but you cannot reconnect so soon.  Try again in 15 minutes."
    me @ swap boot-player
  then
  pop 0 set-keepofftime
;
  

: handle-clearing (playername -- )
  me @ "wizard" flag? not if
    "Permission denied." .tell
    pop exit
  then
  .noisy_pmatch
  dup not if pop exit then
  "@KeepOffUntil" remove_prop
  "Cleared." .tell
;
  
  
: dispatcher
  command @ "Queued event." stringcmp not if
    dup "Disconnect" stringcmp not if pop kill-prev-timed-logoff exit then
    "Connect" stringcmp not if do-connectcheck exit then
  then
  strip tolower
  
  dup "now" stringcmp not if
    me @ "You have logged yourself off the game." boot-player exit
  then
  
  dup not if pop do-help exit then
  " " .split strip swap
  over not if pop pop do-help exit then
  
  banned? if
    "Sorry, but I can't let you do that.  Ask a wizard for assistance."
    .tell exit
  then

  dup "at" stringcmp not if pop set-leavetime-absolute exit then
  dup "in" stringcmp not if pop set-leavetime-relative exit then
  dup "for" stringcmp not if pop set-keepoff-relative exit then
  dup "until" stringcmp not if pop set-keepoff-absolute exit then
  dup "clear" stringcmp not if pop handle-clearing exit then
  pop pop do-help
;
: main dispatcher "done" pop ;
.
c
q
#ifdef NEW
@action logmeoff=#0=tmp/exit1
@link $tmp/exit1=cmd-logmeoff
#endif
