@prog proplock.muf
1 999 d
1 i
(
 This can be used to make actions that set/clear properties on the player
 invoking the action.  It can also be used to make an exit that tests
 properties on the player attempting to take the exit.  In all cases, lock
 the exit to this program.  Then put properties on the exit describing what
 you wish to do.  These take the form of prop-action-<n> properties, where
 <n> starts at 1 and increases until a nonexistent property is found; their
 values describe the actions to be taken.  Properties specifying unknown
 actions are ignored.  The actions are:
 	add:<property>:<value>
 		This adds a property called <property> to the player,
 		with value <value>.
 	remove:<property>
 		This removes a property <property> from the player.
 	check:<property>
 	check:!<property>
 		This checks that the specified property is present on the
 		player.  If not, the lock fails without performing any more
 		actions.  A leading ! on the property name negates
 		the sense of the test.
)
: splitfirst (s1 s2 -- s3 s4)
	( splits s1 at first occurrence of s2 )
	( if s1 contains s2, s3 s2 s4 strcat strcat == s1 )
	( if not, s3 == s1, s4 == "" )
	over over instr dup if
		rot swap 1 - strcut rot strlen strcut swap pop
	else
		pop pop ""
	then
;
forward setprop
: setprop
	dup "" strcmp if 0 addprop else pop remove_prop then
;
: do-add
	me @ swap ":" splitfirst setprop
;
: do-remove
	me @ swap remove_prop
;
: do-check
	me @ swap
	dup 1 strcut swap "!" strcmp if
		pop getpropstr not
	else
		swap pop getpropstr
	then
;
: do-cmd
		":" splitfirst swap
		dup "add" strcmp not if pop do-add 0 exit then
		dup "remove" strcmp not if pop do-remove 0 exit then
		dup "check" strcmp not if pop do-check exit then
;
: main
	1
	begin
		trigger @ "prop-action-" 3 pick intostr strcat getpropstr dup
	while
		do-cmd if pop pop 0 exit then
		1 +
	loop
	pop pop pop 1
;
.
c
q