"Beginning installation of cmd-who...
@prog cmd-who
1 99999 d
1 i
( cmd-who: $Date: 2004/03/26 03:06:03 $ $Revision: 1.3 $                                                  )
( Author: Scotfox                                                             )
( --------------------------------------------------------------------------- )
( Shows a list of everybody connected.  By Scotfox.                           )
( Also uses Foxen's cmd-who                                                   )
( --------------------------------------------------------------------------- )
(
  $Log: cmd-who,v $
  Revision 1.3  2004/03/26 03:06:03  feaelin
  Support for the who_hides_dark sysparm added.

)
( --------------------------------------------------------------------------- )

$include $lib/glowstandard
$define notify .wrapnotify $enddef
 
lvar roomstuff
: get-connected-list  ( concount -- namelist total howmanyleft )
    begin dup 0 > while
        dup condbref dup 
        dup "/@/dark" getpropstr .yes? "who_hides_dark" sysparm .yes? and
        swap location me @ location dbcmp or if
          pop swap 1 - swap
        else
          name    
          rot rot              ( namelist newname total howmanyleft )
        then
        1 - 
    repeat pop
    1 sort
;
: glue-together-list  ( namelist gluedstring howmany  -- s)
    begin dup 0 > while
        rot                  ( namelist gluedstring howmany name )
        over 1 = if  "and " swap strcat
            else ", " strcat then
        rot                  ( namelist howmany name gluedstring )
        swap strcat swap     ( namelist gluedstring howmany )
        1 - repeat
    pop
;
: show-connected
    concount dup 1 = if
        me @ "^GREEN^You are the only one connected." notify exit then
    dup get-connected-list
    dup 0 <= if
        pop
        "^GREEN^Everyone is in this room." me @ swap notify exit then
    dup 1 = if
        pop
        "~" "^" subst
        " is the only player connected who's not in this room." strcat
        "^GREEN^" swap strcat
        me @ swap notify exit then
    "" swap glue-together-list
    me @ swap
    "~" "^" subst
    " are awake elsewhere in the game." strcat "^GREEN^" swap strcat notify
;
 
$define MIN_IDLE 3 (minutes) $enddef
 
: do_and
    dup ", " rinstr
    dup if
        1 + strcut "and " swap
        strcat strcat
    else pop
    then
;
  
: idletime (d -- i)
    descriptors
    begin dup 1 > while rot pop 1 - repeat
    not if -1 exit then
    descrcon conidle
;
  
: who-loop (pupstr idlestr asleepstr awakestr dbref -- pupstr idlestr asleepstr awakestr)
    dup #-1 dbcmp if
        pop do_and
        4 rotate do_and
        4 rotate do_and
        4 rotate do_and
        4 rotate exit
    then
  
    dup player? if
        dup awake? if
            dup idletime dup MIN_IDLE 60 * < if
                pop over if
                    swap ", " strcat swap
                then
                dup name rot swap strcat swap
            else
                60 / intostr "[" swap strcat "m]" strcat
                5 pick if
                    5 rotate ", " strcat -5 rotate
                then
                over name swap strcat 5 rotate swap strcat -4 rotate
            then
        else
            dup "DARK" flag? not if
                3 pick if
                    rot ", " strcat rot rot
                then
                dup name 4 rotate swap strcat rot rot
            then
        then
    else
        dup "_listen" propdir?
        over "_listen" getpropstr or
        over "_puppet?" getpropstr tolower "y" 1 strncmp not or
        if
            5 pick if
                5 rotate ", " strcat -5 rotate
            then
            dup name 6 rotate swap strcat -5 rotate
        then
    then
    next who-loop
;
 
: cmd-who
    "me" match me !
    "" "" "" "" me @ location contents who-loop
    dup me @ name strcmp not if
        pop "^CYAN^You are the only one awake in this room."
    else
        "~" "^" subst
        " are awake in this room." strcat "^CYAN^" swap strcat then
    me @ swap notify
    swap
    dup if
        dup ", and " instr not if
            "~" "^" subst
            "^YELLOW^Only " swap strcat
            " is idle here." strcat
        else
            " are idle in this room." strcat "^YELLOW^" swap strcat then
        me @ swap notify
    else pop
    then
    me @ location "DARK" flag? not if
        dup not if
            pop "^PURPLE^There are no sleepers here."
        else
            dup ", and " instr not if
                "^PURPLE^Only " swap strcat
                " is asleep here." strcat
            else
                "~" "^" subst
                "^PURPLE^The sleepers here are " swap strcat
                "." strcat
            then
        then
        me @ swap notify
    else pop
    then
    dup if
        dup ", and " instr not if
            "^BLUE^The only puppet here is " swap strcat
        else
            "~" "^" subst
            "^BLUE^The puppets here are " swap strcat
            "." strcat
        then
        me @ swap notify
    else pop
    then
;
 
: main
    pop
    show-connected
    cmd-who
;
.
c
q
@register cmd-who=cmd/who
@register cmd-who=lib/cmdwho
@register #me cmd-who=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=W3
@set $tmp/prog1=/_defs/.eval-loop:"$desc" match "eval-loop" call
@set $tmp/prog1=/_defs/.format-print:"$desc" match "format-print" call
@set $tmp/prog1=/_defs/.gen-desc:"$desc" match "gen-desc" call
@set $tmp/prog1=/_defs/.get-legal-prop:"$desc" match "get-legal-prop" call
@set $tmp/prog1=/_defs/.split-args:"$desc" match "split-args" call
@set $tmp/prog1=/_defs/.wipe-list:"$desc" match "wipe-list" call
@set $tmp/prog1=/_docs:@list $desc-docs
@set $tmp/prog1=_version:FM$Revision: 1.3 $
@action who=here=tmp/exit1
@link $tmp/exit1=$cmd/who
@set $tmp/exit1=/_/de:@$cmd/who
"Installation of cmd-who complete.