@prog apt.dir.muf
1 9999 d
1 i
: say me @ swap notify ;
: vacant-owner trigger @ location owner ;
: tns "dir" strcat ;
: is-# dup atoi intostr strcmp not ;
(ck arg pattern:
	other-args did-hdg ckfxn hallway floor # so-far apt --
	other-args did-hdg ckfxn hallway floor # so-far apt 0/1
)
: ck-true 1 ;
: ck-owned dup ok? if dup owner 9 pick dbcmp else 0 then ;
: show-heading
	"Apt. #   Resident            Description" say
	"------   --------            -----------" say
;
: do-dir-line (did-hdg ckfxn hallway floor # -- did-hdg ckfxn hallway floor #)
	"     " 3 pick strcat "-" strcat over strcat
	dup strlen 5 - strcut swap pop "    " strcat
	( did-hdg ckfxn hallway floor # so-far )
	4 pick 3 pick rmatch
	dup exit? if
		dup linkcount 1 >= if
			getlink
			( did-hdg ckfxn hallway floor # so-far apt )
			6 pick exec not if pop pop exit then
			dup owner vacant-owner dbcmp if
				pop "-vacant-" "-available-" 1
			else
				dup owner name swap name 1
			then
		else
			( did-hdg ckfxn hallway floor # so-far exit )
			pop #-1 6 pick exec not if pop pop exit then pop 0
		then
	else
		( did-hdg ckfxn hallway floor # so-far exit )
		pop #-1 6 pick exec not if pop pop exit then pop 0
	then
	( hallway floor # so-far [ 0  /  owner name 1 ] )
	if
		swap "                    " strcat 20 strcut pop
		swap strcat strcat
	else
		"- - - - - Missing - - - - -" strcat
	then
	77 strcut pop
	( did-hdg ckfxn hallway floor # line )
	6 pick not if
		show-heading
		6 rotate pop 1
		6 rotate 6 rotate 6 rotate 6 rotate 6 rotate
	then
	say
;
: do-dir (did-heading hallway floor-#-str check-fxn -- did-heading)
	rot rot
	1
	begin
		3 pick over intostr rmatch
	while
		intostr do-dir-line atoi
		1 +
	loop
	pop pop pop pop
;
: dir-of-floor
	0 swap dup "_floor" getpropstr ' ck-true do-dir
;
: dir-of-player
	dup "-vacant-" strcmp if
		"*" over strcat match
		dup vacant-owner dbcmp if
			trigger @ "_lobby" getpropstr dup if
				atoi dbref "_penthouse" getpropstr dup if
					show-heading
					"Penth.   " vacant-owner name
					"                    " strcat
					20 strcut pop strcat
					swap strcat say
					pop
					exit
				then
			else
				pop
			then
		then
	else
		pop "" vacant-owner
	then
	dup not if
		pop pop
		"No-one by that name resides here." say exit
	then
	swap pop
	trigger @ "_lobby" getpropstr
	dup if
		atoi dbref
		dup room?
	else
		0
	then
	not if
		pop pop
		"Directory program out of order, directory by player unavailable." say exit
	then
	( player lobby )
	0 1
	begin
		( player lobby did-heading floor-# )
		"_" over intostr strcat 4 pick swap getpropstr dup
	while
		( player lobby did-heading floor-# floor-dbref-str )
		atoi dbref dup room? if
			( player lobby did-heading floor-# hallway )
			5 pick 4 rotate rot 4 pick intostr ' ck-owned do-dir
			( player lobby floor-# player did-heading )
			swap pop swap
		else
			pop
		then
		( player lobby did-heading floor-# )
		1 +
	loop
	pop pop
	not if
		over vacant-owner dbcmp if
			"No apartments in this building are vacant."
		else
			"No-one by that name resides here."
		then
		say
	then
	pop pop
;
: main
	dup not if
		pop
		trigger @ location dup room? if
			(being called from a floor)
			loc @ dir-of-floor
		else
			(in the lobby)
			"Include the number of the floor you wish a directory of, please." say
			"For example: '" tns
			" 1', '" strcat tns
			" 2', etc." strcat say
			"Or, give the name of the person you're interested in." say
			"For a list of vacant apartments, '" tns
			" -vacant-'." strcat say
		then
		exit
	then
	trigger @ location dup room? if
		(from a floor)
		(only allowable arg is player name, or this floor #)
		over is-# if
			over atoi over "_floor" getpropstr atoi = not if
				pop pop "You're not on that floor!" say exit
			then
			swap pop dir-of-floor exit
		else
			over "-vacant-" strcmp not if
				pop pop "You must use the lobby computer for that." say exit
			then
		then
		pop
		dir-of-player
	else
		(in the lobby)
		(arg may be floor # or player name)
		location
		( arg room )
		over dup is-# if
			"_" swap strcat getpropstr
			( arg floor-hallway-# )
			atoi dbref dup ok? if
				dup "_floor" getpropstr 3 pick strcmp if
					pop 0
				else
					swap pop 1
				then
			else
				pop 0
			then
			if
				1
			else
				"No floor " swap strcat " exists." strcat say
				exit
			then
		else
			pop pop 0
		then
		( player-name 0  /  floor-hallway-room 1 )
		if dir-of-floor else dir-of-player then
	then
;
.
c
q