-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathcon-census.muf
171 lines (149 loc) · 3.66 KB
/
con-census.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
@prog con-census
1 9999 d
1 i
(Connect time census program by Garth Minette <foxen@netcom.com>)
(Version 1.2)
(Number of users listed in sorted list of most hours online that month)
$def TOP_LIST_COUNT 20
: GetOnTimeProp (player -- dbref propname)
prog "_players/%m/" systime timefmt
rot int intostr strcat
;
: update-record (d s i -- )
3 pick 3 pick getpropval
over < if
"" swap addprop
else
pop pop pop
then
;
: check-max-today
prog "_day/%y/%m/%d" systime timefmt
concount update-record
;
: check-max-record
prog "_most_on_ever"
concount update-record
;
: log-player-login
me @ awake? 1 > if exit then
me @ "@/logintime" "" systime addprop
me @ "@/notedtime" remove_prop
;
: english-delta-time (i -- s)
60 / dup 60 %
dup if intostr " minutes " strcat else pop "" then
swap 60 /
dup if intostr " hours " strcat else pop "" then
swap strcat
;
: get-recorded-time-period ( -- s)
prog timestamps pop pop pop
systime swap - 86400 /
"%d" systime timefmt atoi
over over > if swap then pop
dup not if pop "today" exit then
dup 1 = if pop "in the last day" exit then
intostr " days" strcat
"in the last " swap strcat
;
: announce-usage
me @ GetOnTimeProp getpropval
dup 60 < if pop exit then
"## You have been online for "
swap english-delta-time strcat
get-recorded-time-period strcat
me @ swap notify
;
: login-handler
check-max-today
check-max-record
log-player-login
me @ "_prefs/logintime?" getpropstr
"yes" stringcmp not if announce-usage then
;
: into2digits (i -- s)
dup intostr swap 10 < if "0" swap strcat then
;
: int2time (i -- s)
dup 60 % into2digits swap 60 /
dup 60 % into2digits "." strcat swap 60 /
"0000" swap intostr strcat
dup strlen 4 - strcut swap pop
"." strcat swap strcat swap strcat
;
: update-sorted-moston (dbref oldtime newtime -- )
prog "_mosttime/%m/" systime timefmt
over over 6 rotate int2time strcat over over remove_prop
"-" strcat 6 pick int intostr strcat remove_prop
rot int2time strcat "-" strcat 3 pick int intostr strcat
rot unparseobj
3 pick 3 pick 3 pick 0 addprop
pop 0
begin
dup TOP_LIST_COUNT < while
3 pick 3 pick nextprop
dup not if pop break then
rot pop swap 1 +
repeat
TOP_LIST_COUNT >= if
remove_prop
else
pop pop
then
;
: update-usetime (d -- )
dup "@/notedtime" getpropval
over "@/notedtime" "" systime addprop
over "@/logintime" getpropval
over over < if swap then pop
dup not if pop systime then systime swap -
(d i d s)
over GetOnTimeProp
over over getpropval
(d i d s i)
4 rotate over + swap over
6 rotate rot rot
(d s i d i i)
update-sorted-moston
"" swap addprop
;
: logout-handler
me @ update-usetime
me @ awake? if exit then
me @ "@/logintime" remove_prop
me @ "@/notedtime" remove_prop
;
: startup-handler
60 sleep
begin
600 sleep
#-1 descriptors
begin
0 sleep
dup while 1 - swap
descrcon dup not if pop continue then
condbref update-usetime
repeat
pop
repeat
;
: dispatcher
command @ "Queued event." stringcmp not if
dup "Connect" stringcmp not if pop login-handler exit then
dup "Disconnect" stringcmp not if pop logout-handler exit then
dup "Startup" stringcmp not if pop startup-handler exit then
pop exit
then
announce-usage
pop exit
;
.
c
q
@set con-census=W
@set con-census=A
@set con-census=L
@set con-census=3
@reg #prop #0:_connect con-census=census
@reg #prop #0:_disconnect con-census=census