-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathyaro-where.muf
117 lines (107 loc) · 3.74 KB
/
yaro-where.muf
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
@q
@program yaro-where.muf
1 9999 del
i
$include $lib/yaro
$include $cmd/status
: get_info ( d n -- s s s s s s )
var ref
var c
c !
ref !
ref @ name "^FIELD_COLOR^" swap strcat
ref @ "~sex" getprop dup not if pop "U" then 1 strcut pop
toupper dup case
"M" stringcmp not when "^CYAN^" swap strcat end
"F" stringcmp not when "^PURPLE^" swap strcat end
default pop "^WHITE^" swap strcat end
endcase cleanString "^CONTENT_COLOR^" strcat "^CONTENT_COLOR^" swap strcat
me @ swap process_tags
ref @ "~species" getprop dup not if pop "Unknown" then "^FIELD_COLOR^" swap strcat
ref @ awake? if
me @ ref @ get_status pop "^CONTENT_COLOR^" strcat process_tags
else
"^CONTENT_COLOR^ZZZ"
then "^CONTENT_COLOR^" swap strcat
c @ dup -1 = not if conidle time_format else pop "N/A" then "^FIELD_COLOR^" swap strcat
ref @ location name "^CONTENT_COLOR^" swap strcat
;
: do_ws
var ref
ref !
ref @ name
ref @ "~sex" getprop dup not if pop "U" then 1 strcut pop
toupper dup case
"M" stringcmp not when "^CYAN^" swap strcat end
"F" stringcmp not when "^PURPLE^" swap strcat end
default pop "^WHITE^" swap strcat end
endcase cleanString "^CONTENT_COLOR^" strcat me @ swap process_tags
ref @ "~species" getprop dup not if pop "Unknown" then
ref @ awake? if
me @ ref @ get_status pop "^CONTENT_COLOR^" strcat process_tags
else
"^CONTENT_COLOR^ZZZ"
then
ref @ awake? if
ref @ descrleastidle descrcon conidle time_format
else
"N/A"
then
;
: main
var ref
var p
command @ tolower case
dup "where" swap instr swap "find" swap instr or when
dup if
pmatch dup ok? over player? and if
{ } array_make over array_append
else
0 array_make
then
else
pop #0 online array_make
then
p !
me @ "Player Locations" 80 boxtitle
me @ { "Name" "Sex" "Species" "Status" "Idle" "Room" } array_make
{ p @ array_dedup foreach swap pop ref !
ref @ descriptors array_make dup array_count 0 > if
foreach swap pop
{ swap ref @ swap descrcon get_info } array_make
repeat
else
pop { ref @ -1 get_info } array_make
then
repeat } array_make
SORTTYPE_CASE_ASCEND 0 array_sort_indexed SORTTYPE_CASE_ASCEND 5 array_sort_indexed 80 boxtable
#-1 = if
me @ "unable to find a player with that name." 80 boxcontent
then
me @ concount intostr " players online" strcat 80 boxtitle
" " tell
end
dup "whospecies" swap instr swap "ws" swap instr or when
me @ "Players in " loc @ name strcat 50 boxTitle
me @ { "Name" "Sex" "Species" "Status" "Idle" } array_make
loc @ getplayers swap pop swap { swap array_dedup foreach swap pop
{ swap do_ws } array_make
repeat
} array_make
me @ "where/show_sleepers" getConfig if
swap { swap foreach swap pop
{ swap do_ws } array_make
repeat } array_make array_union
else swap pop then
SORTTYPE_CASE_ASCEND 4 array_sort_indexed 50 boxTable
me @ me @ 50 line box_color tell
end
default
me @ "please tell " prog owner name strcat " that the illegal command "
strcat " has been linked to " prog name strcat "." strcat error_color tell
end
endcase
;
.
c
q