@prog free-apt.muf
1 999 d
1 i
(configuration: flag bits)
: keep "k" ;
: chown-ok "o" ;
: abode "a" ;
: flags-to-reset "abodhjlnsv" ; (no need to put k in this list)
: flags-cannot-reset "gquc" ;
(code)
: say me @ swap notify ;
: byhand
	me @ wizard? if
		"Fix by hand -- "
	else
		"Can't free apartment -- "
	then
	swap strcat say
	depth 1 swap 1 for pop pop loop
;
: flag-not-reset (obj x flag -- obj x)
	" flag not reset on " strcat 3 pick me @ unparse_object strcat say
;
: clear-all-flags
	flags-to-reset begin dup while
		1 strcut 3 pick "!" 4 rotate strcat set
	loop
	pop
	flags-cannot-reset begin dup while
		1 strcut swap 3 pick over flag? if
			toupper flag-not-reset
		else
			pop
		then
	loop
	pop pop
;
: clear-all-props
	begin
		dup propfirst
	while
		swap pop over swap remove_prop
	loop pop
;
: clear-msgs
	dup "" setdesc
	dup "" setsucc
	dup "" setfail
	dup "" setdrop
	dup "" setosucc
	dup "" setofail
	dup "" setodrop
	pop
;
: not-wiz-or-owner? (obj -- 0/1)
	me @ wizard? if pop 0 exit then
	owner me @ dbcmp not
;
: main
	"me" match me !
	dup not if pop "here" then match
	( room )
	dup ok? not if
		dup #-1 dbcmp if pop "I don't see that here."
		else dup #-2 dbcmp eif pop "I don't know which one you mean!"
		else dup #-3 dbcmp eif pop "Can't use \"home\" with this command."
		else pop "That's not an object!"
		then
		say exit
	then
	dup not-wiz-or-owner? if pop "Permission denied." say exit then
	me @ wizard? not if dup me @ getlink dbcmp if
		pop "You must set your home somewhere else first." say exit
	then then
	dup room? not if pop "That's not a room!" say exit then
	dup exits
	dup not if "room has no exits" byhand exit then
	dup next if "room has multiple exits" byhand exit then
	( room exit )
	dup not-wiz-or-owner? if
		pop pop "You don't own the exit!" say exit
	then
	dup linkcount 1 = not if "exit has multiple links" byhand exit then
	dup getlink
	( room exit hallway )
	dup exits
	begin
		( room exit hallway exit )
		dup if
			dup getlink 5 pick dbcmp not
		else
			0
		then
	while
		next
	loop
	dup not if "no entrance found" byhand exit then
	( room exit hallway exit )
	dup not-wiz-or-owner? if
		pop pop pop pop "You don't own the entrance!" say exit
	then
	dup linkcount 1 = not if "entrance has multiple links" byhand exit then
	over location 5 pick location dbcmp not if
		"room and hallway have different parents" byhand exit
	then
	over location name "Parent" instr not if
		"room/hallway parent name doesn't contain \"Parent\"" byhand exit
	then
	over "_floor" prop-exists? not if
		over "floor" prop-exists? if
			"[warning: fixing hallway floor number]" say
			over dup "floor" getpropstr over "floor" remove_prop
			"_floor" swap addprop
		then
	else
		over "floor" prop-exists? if
			over dup "floor" getpropstr over "_floor" getpropstr
			strcmp if
				"[warning: hallway floor properties differ]"
				say pop
			else
				"[removing stray floor: prop on hallway]"
				say "floor" remove_prop
			then
		then
	then
	over "_floor" getpropstr atoi
	dup dup 1 < swap 10 > or if
		"hallway has invalid floor number" byhand exit
	then
	( room exit hallway exit floor-# )
	over name ";" explode dup 1 > if
		1 - 1 swap 1 for pop swap pop loop
	else
		pop
	then
	atoi
	dup dup 1 < swap 20 > or if
		"entrance has bad number" byhand exit
	then
	( room exit hallway entrance floor-# room-# )
	intostr swap intostr swap
	"Freeing: room #" 7 pick int intostr strcat
	", entrance #" strcat 4 pick int intostr strcat
	", exit #" strcat 6 pick int intostr strcat
	say
	6 rotate
	dup "Apartment " 5 pick strcat "-" strcat 4 pick strcat
	over location name swap "Parent" subst
	setname
	dup dup location owner chown
	dup clear-all-flags
	dup clear-all-props
	dup chown-ok set dup abode set dup keep set
	dup clear-msgs
	dup unlock
	dup "_residence" "yes" 0 addprop
	dup "@576" setdesc
	pop
	( exit hallway entrance floor-# room-# )
	5 rotate
	dup "exit;out;o;leave" setname
	dup 6 pick location owner chown
	dup clear-all-flags
	dup clear-all-props
	dup chown-ok set dup keep set
	dup clear-msgs
	dup unlock
	pop
	( hallway entrance floor-# room-# )
	4 rotate pop
	( entrance floor-# room-# )
	rot
	dup 3 pick setname
	dup dup location location owner chown
	dup clear-all-flags
	dup clear-all-props
	dup chown-ok set dup keep set
	dup clear-msgs
	dup unlock
	pop
	( floor-# room-# )
	pop pop
;
.
c
q