-
Notifications
You must be signed in to change notification settings - Fork 12
/
lib-props.muf
92 lines (81 loc) · 2.42 KB
/
lib-props.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
@program lib-props
1 99999 d
1 i
( PROPS Library -- Contains useful property handling routines.
setpropstr [dbref propname strval -- ]
sets a property, or removes it if the string is null.
envprop [startdbref propname -- stringval]
searches down the environment tree from the given object, looking for
a property with the given name. Returns it's value, or a null string
if it wasn't found.
envsearch [startdbref propname -- locationdbref]
Also searches down the envtree for the given property, but returns the
dbref of the object it was found on instead of the string value. Returns
#-1 if it cannot find the property.
locate-prop [startdbref propname -- locationdbref]
Given a property name and dbref, finds the property, whether on the dbref
itself, an environment of the dbref, or a proploc of the dbref. If none,
returns #-1.
)
$doccmd @list __PROG__=!@1-20
: setpropstr (dbref propname strval -- )
dup not if
pop remove_prop
else
0 addprop
then
;
: envprop (startdbref propname -- stringvalue)
envpropstr swap pop
;
: envsearch (startdbref propname -- locationdbref)
envpropstr pop
;
: proplocsearch ( startdbref propname -- locationdbref )
over swap ( d d s )
me @ "search" remove_prop
begin over ok? while
over over getpropstr if
me @ "search" remove_prop
pop swap pop exit ( d )
then
over intostr "search/" swap strcat me @ swap getpropstr if
me @ "search" remove_prop
pop pop intostr
"Error: loop in proploc found at #" swap strcat tell
#-1 exit
then
over intostr "search/" swap strcat me @ swap "yes" 0 addprop
swap "_proploc" getpropstr dup if ( d s d' )
atoi dbref swap ( d d' s )
else
pop #-1 swap
then
repeat
me @ "search" remove_prop
pop pop pop #-1 exit
;
: locate-prop ( d s -- d' )
over ok? not over not or if
pop pop #-1 exit
then
over over proplocsearch dup ok? if ( d s d' )
rot rot pop pop exit
then
pop envsearch
;
public envprop $libdef envprop
public envsearch $libdef envsearch
public locate-prop $libdef locate-prop
public setpropstr $libdef setpropstr
.
c
q
@register lib-props=lib/props
@register #me lib-props=tmp/prog1
@set $tmp/prog1=3
@set $tmp/prog1=H
@set $tmp/prog1=L
@set $tmp/prog1=S
@set $tmp/prog1=V
@register #me =tmp