@prog tess-world-shift.muf
1 999 d
1 i
(
For shifting worlds in tess, for shifts that should not bring objects
along - sleep/wake and read/stop.  Link the sleep/read exit to this
program [presumably among other things] and set it [the exit] _tess:enter.
When the exit is taken, two things happen: [1] any objects in the player's
inventory whose backlinks include exits whose names begin with
)
$def tess-reset-prefix ".tess-reset-"
(
are stashed in the room whose dbref is in the
)
$def tess-storage-prop "_storage-room"
(
property on the triggering exit, and [2] the exit whose dbref is in the
)
$def tess-exit-prop "_tess-exit-dbref"
(
property on the triggering exit [the wake/stop exit] gets relinked to
me @ location.

For the shift back again, set the wake/stop exit's @drop to run this
program and set it _tess:leave.  The exit will be linked correctly
because of [2] when entering; the program will move everything from
the storage room into the player's inventory, assuming they got there
via [1] when entering.

Security checks: all moved objects, affected exits, and the storage room
must be owned by the owner of the triggering exit.  Otherwise, the
relevant effects don't happen.  The effective player must be able to
perform all the underlying operations [unlink, addlink, moveto], which
probably means using flags like SetUID or TrigUID.

The _tess: property above is actually the property named
)
$def action-key-prop "_tess"
(
and the "enter" and "leave" strings are
)
$def action-enter "enter"
$def action-leave "leave"
(
)
: ok-owner? ( dbref -- bool )
	owner trigger @ owner dbcmp
;
: relink-leave-exit
	trigger @ tess-exit-prop getpropstr atoi dbref
	dup ok-owner? if
		dup unlink me @ location addlink
	else
		pop
	then
;
: storage-room ( -- dbref )
	trigger @ tess-storage-prop getpropstr dup if
		atoi dbref
	else
		pop #-1
	then
;
: stash-inventory
	storage-room
	dup room? not if pop exit then
	dup ok-owner? not if pop exit then
	0 swap
	me @ contents
	begin dup while
		( o1 ... oM M storage obj )
		dup ok-owner? if
			( o1 ... oM M storage obj )
			dup backlinks
			( o1 ... oM M storage obj bl1 ... blN N )
			dup if
				0 swap 1 -1 for
					pop swap
					( ... blI-1 found blI )
					dup exit? if
						( ... blI-1 found blI )
						name tess-reset-prefix
						dup strlen rot swap 0 swap
						substr strcmp not or
						( ... blI-1 found )
					else
						( ... blI-1 found blI )
						pop
					then
				loop
			then
			( o1 ... oM M storage obj found )
			if
				-rot swap 1 + swap 3 pick
			then
		then
		next
	loop
	( o1 ... oM M storage #-1 )
	pop swap dup if 1 -1 for
		( ... oI storage I )
		pop swap over moveto
	loop else pop then pop
;
: restore-inventory
	storage-room
	dup room? not if pop exit then
	dup ok-owner? not if pop exit then
	0 swap contents
	begin dup while
		dup ok-owner? if swap 1 + over then
		next
	loop
	pop dup if 1 -1 for pop me @ moveto loop else pop then
;
: do-enter
	relink-leave-exit
	stash-inventory
;
: do-leave
	restore-inventory
;
: main
	trigger @ action-key-prop getpropstr
	dup action-enter strcmp not if pop do-enter exit then
	dup action-leave strcmp not if pop do-leave exit then
	pop
;
.
c
q