@prog action-lock.muf
1 999 d
1 i
: say me @ swap notify ;
: get-contents contents ;
: get-actions exits ;
: tellfail
	"Internal failure: this action is not properly set up." say
	"Please tell " trigger @ owner name strcat ": " strcat
	swap strcat "." strcat say
;
(ck interface:
	other-args some-stuff thing N -- other-args some-stuff thing 1/0
 where N is the number of objects in some-stuff, plus 1 [for thing], and the
 return value is 1 if the thing should be stripped or 0 if not.)
: ck-true pop 1 ;
: ck-property pick over swap getpropstr not ;
: stripit (holder get-fn ck-fn prop-suffix -- )
	"" me @ 5 pick exec
	begin dup while
		( holder get-fn ck-fn prop-suffix so-far thing )
		7 5 pick exec
		if
			dup int intostr "." strcat rot strcat swap
		then
		next
	loop
	pop
	( holder get-fn ck-fn prop-suffix prop-val )
	5 pick me @ int intostr 4 rotate strcat 3 pick 0 addprop
	( holder get-fn ck-fn prop-val )
	swap pop swap pop
	"." explode
	( holder s1 s2 ... sN N )
	dup 2 + rotate swap 1 swap 1 for pop
		( s1 s2 ... sN holder )
		over if
			dup 3 pick "-owner" strcat me @ int intostr 0 addprop
			swap atoi dbref over moveto
		else
			swap pop
		then
	loop
	pop
;
: restoreit (holder prop-suffix -- )
	over me @ int intostr rot strcat
	over over getpropstr rot rot remove_prop
	"." explode
	( holder list N )
	dup 2 + rotate swap
	1 swap 1 for pop
		( ... list-el holder )
		swap dup if
			dup "-owner" strcat 3 pick swap getpropstr atoi dbref
			me @ dbcmp if
				atoi dbref
				dup location 3 pick dbcmp if
					dup int intostr "-owner" strcat 3 pick swap remove_prop
					me @ moveto
				else
					pop
				then
			else
				pop
			then
		else
			pop
		then
	loop
	pop
;
: do-strip
	trigger @ "nostrip" getpropstr
	dup if
		over ' get-contents ' ck-property "-contents" stripit
		over ' get-actions ' ck-property "-actions" stripit
		pop
	else
		pop
		dup ' get-contents ' ck-true "-contents" stripit
		dup ' get-actions ' ck-true "-actions" stripit
	then
	pop
;
: do-restore
	dup "-contents" restoreit
	dup "-actions" restoreit
	pop
;
: main
	prog trigger @ int intostr "-ok" strcat getpropstr not if
		trigger @ owner wizard? not if
			pop 0 exit
		then
	then
	trigger @ "holder" getpropstr atoi
	dup if dbref dup room? if 1 else pop 0 then then
	not if "missing or bad holder" tellfail 0 exit then
	trigger @ "action" getpropstr
	dup "strip" strcmp not if pop do-strip 1 exit then
	dup "restore" strcmp not if pop do-restore 1 exit then
	"bad action" tellfail
	0
;
.
c
q