-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathyaro-poseorder.muf
239 lines (221 loc) · 8.65 KB
/
yaro-poseorder.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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
@q
@program yaro-poseorder.muf
1 999999 del
i
$include $lib/yaro
$include $cmd/status
lvar timeout
: get_order ( -- a )
var order
loc @ "poseorder/order" getConfig dup array? if
dup order !
array_vals array_make { swap foreach nip
dup systime swap - timeout @ >= timeout @ -1 != and if pop then
repeat
} array_make SORTTYPE_CASE_ASCEND array_sort { swap foreach nip
order @ swap array_findval 0 array_getitem
dup pmatch dup ok? over get_status nip "I"
stringcmp not and swap location loc @ = and
not if pop then
repeat } array_make
else
0 array_make
then
;
: get_turn ( -- d )
get_order dup if
0 array_getitem pmatch dup ok? not if pop #-1 then
else #-1 then
;
: update_po ( -- )
var order
loc @ "poseorder/timeout" getConfig dup not over int? not or if pop 1800 then timeout !
loc @ "poseorder/order" getConfig dup array? not if
pop { }dict
then
order !
loc @ "_config/poseorder/order" remove_prop
order @ me @ name array_delitem systime swap
me @ name array_insertitem loc @ swap "poseorder/order"
swap setConfig
get_turn dup if dup "poseorder/notify" getConfig if
"^INFO_COLOR^It is now your pose." otell
else pop then else pop then
;
: show_order ( -- )
"^TAG_COLOR_2^^OPEN_TAG^^TAG_COLOR_1^ " "" get_order dup if foreach nip
", " strcat strcat
repeat strcat "," rsplit pop " ^TAG_COLOR_2^^CLOSE_TAG^" strcat
me @ "poseorder/notify" getConfig if
get_turn me @ = if
" ^INFO_COLOR^<-- It is currently your pose." strcat
then
then tell
else
pop pop pop "^INFO_COLOR^There is no established pose order." tell
then
;
: remove_player ( d -- )
var order
loc @ "poseorder/order" getConfig dup array? not if
pop { }dict
then
order !
loc @ "_config/poseorder/order" remove_prop
order @ swap name array_delitem loc @ swap "poseorder/order" swap setConfig
;
: toggle_notify ( -- )
me @ "poseorder/notify" getConfig if
me @ "poseorder/notify" 0 setConfig
"^SUCCESS_COLOR^No longer being notified when it is your pose." tell
else
me @ "poseorder/notify" 1 setConfig
"^SUCCESS_COLOR^Now being notified when it is your pose." tell
then
;
: do_nuke ( -- )
loc @ "_config/poseorder/order" remove_prop
loc @ getPlayers pop pop foreach nip
"^INFO_COLOR^" me @ name strcat " has nuked the pose order!" strcat otell
repeat
;
: show_last ( d -- )
var player_name
name player_name !
loc @ "poseorder/order" getConfig dup array? if
player_name @ array_getitem systime swap -
time_format ":" explode pop atoi dup if
dup 1 = if " hour, " else " hours, " then swap intostr swap strcat
else pop "" then
rot atoi dup if
dup 1 = if " second, " else " seconds, " then swap intostr swap strcat
else pop "" then
rot atoi dup if
dup 1 = if " minute, " else " minutes, " then swap intostr swap strcat
else pop "" then
rot 3 reverse strcat strcat "," rsplit pop
"^INFO_COLOR^" player_name @ strcat " last posed " strcat swap strcat
" ago in " strcat loc @ name strcat "." strcat
player_name @ pmatch dup location loc @ != if
"not present, "
else "" then
over get_status nip "I" stringcmp if
"not in character, "
else "" then
rot awake? not if
"not connected, "
else "" then
strcat strcat dup if
"," rsplit pop "," rsplit dup if
", and" swap strcat strcat
else pop then
" This player is also " swap strcat strcat
"." strcat
else pop then
tell
else
pop "^INFO_COLOR^" player_name @ strcat
" has not posed here before as far as I can tell." strcat tell
then
;
: show_help ( -- )
var command_name
trigger @ name ";" split pop command_name !
me @ command_name @ " Help" strcat 80 boxTitle
me @ { { "^FIELD_COLOR^" command_name @ strcat
"^CONTENT_COLOR^Get current pose order." } array_make
{ "^FIELD_COLOR^" command_name @ strcat " #skip" strcat
"^CONTENT_COLOR^Put yourself on the end of the pose order." } array_make
{ "^FIELD_COLOR^" command_name @ strcat " #drop" strcat
"^CONTENT_COLOR^Take yourself out of the pose order." } array_make
{ "^FIELD_COLOR^" command_name @ strcat " #kick <PLAYER>" strcat
"^CONTENT_COLOR^Kick PLAYER out of the pose order." } array_make
{ "^FIELD_COLOR^" command_name @ strcat " #last-posed <PLAYER>" strcat
"^CONTENT_COLOR^Check when a player last posed in this room." } array_make
{ "^FIELD_COLOR^" command_name @ strcat " #notify" strcat
"^CONTENT_COLOR^Toggle whether to be told when it's your pose." } array_make
{ "^FIELD_COLOR^" command_name @ strcat " #nuke" strcat
"^CONTENT_COLOR^Completely destroy the pose order." } array_make
loc @ me @ control? if
{ "^FIELD_COLOR^" command_name @ strcat " #set-timeout <N>" strcat
"^CONTENT_COLOR^Set how long a player stays in pose order."
" -1 disables timeout. 0 resets to default." strcat } array_make
then
{ "^FIELD_COLOR^" command_name @ strcat " #help" strcat
"^CONTENT_COLOR^Show this box." } array_make } array_make 80 boxinfo
"^BOX_COLOR^" me @ 80 line strcat tell
" " tell
;
: main ( s -- )
strip loc @ "poseorder/timeout" getConfig dup not over int? not or if pop 1800 then timeout !
dup "#" instr 1 = if
dup case
"skip" paramTest when
pop update_po loc @ getPlayers pop pop foreach nip
pop "^INFO_COLOR^" me @ name strcat me @ " has skipped %p pose." pronoun_sub
strcat otell
repeat
exit
end
"drop" paramTest when " " split nip pop me @ remove_player
loc @ getPlayers pop pop foreach nip
"^INFO_COLOR^" me @ name strcat " has dropped from the pose order." strcat otell
repeat
exit end
"kick" paramTest when " " split nip dup if pmatch dup if remove_player else
pop "^ERROR_COLOR^I can't tell who you want to kick." tell
then else
pop "^ERROR_COLOR^Who do you want to kick?" tell
then
exit end
"notify" paramTest when " " split nip pop toggle_notify exit end
"nuke" paramTest when " " split nip pop do_nuke exit end
"last-posed" paramTest when " " split nip pmatch dup ok? if show_last
else
"^ERROR_COLOR^I do not know that player." tell
then exit end
"set-timeout" paramTest when
loc @ me @ control? if
" " split nip dup not if
loc @ "poseorder/timeout" 0 setConfig
"^SUCCESS_COLOR^Reset timeout to default (1800 seconds.)." tell
else
dup number? if
atoi dup -2 > if
dup case
-1 = when
"^SUCCESS_COLOR^Disabled timeout for this location." tell
end
0 = when
"^SUCCESS_COLOR^Reset timeout to default (1800 seconds.)." tell
end
default
intostr "^SUCCESS_COLOR^Set timeout to " swap strcat "." strcat tell
end
endcase
loc @ swap "poseorder/timeout" swap setConfig
else
pop "^ERROR_COLOR^Invalid value for timeout time." tell
then
else
pop "^ERROR_COLOR^Invalid value for timeout time." tell
then
then
else
"^ERROR_COLOR^You do not have authority to change timeout for this location." tell
then
exit
end
"help" paramTest when " " split nip pop show_help exit end
endcase
then
pop show_order
;
public update_po
public get_turn
.
c
q
@reg yaro-poseorder=cmd/poseorder
@set yaro-poseorder=_defs/update_po:"$cmd/poseorder" match "update_po" call
@set yaro-poseorder=_defs/get_turn:"$cmd/poseorder" match "get_turn" call