@prog apt-checkout.muf
1 999 d
1 i
: apt-parent #461 ;
: apt-lobby #15 ;
: say me @ swap notify ;
: merge over 4 pick + -4 rotate begin over 4 pick and while over 4 pick + 4 +
  pick 3 pick 5 + pick 3 pick exec if rot 1 - -3 rotate else over 4 + rotate 4
  pick 4 pick + 4 + -1 * rotate swap 1 - swap then loop pop pop pop ;
: sort (x1 ... xN N fn -- x1 ... xN N)
(fn is x1 x2 -- i and returns true if the things are correctly ordered.)
  over 2 < if pop exit then over 2 / rot over - over 3 + -1 * rotate over over
  3 + -1 * rotate swap sort dup 2 + pick over 4 + pick 3 pick + 4 + 3 pick 2 +
  roll sort dup 3 + rotate swap dup 3 + rotate merge ;
: dbref-name dup name "(#" strcat over int intostr strcat swap flagstr strcat ")" strcat ;
: cmp-dbref int swap int < ;
: findit (list N el -- list N inx [inx==0 means not found])
	over 3 + 4 -1 for
		dup pick 3 pick dbcmp if swap pop 3 - exit then pop
	loop
	pop 0
;
: dellist ( list N x el )
	swap 3 pick 3 + -1 * rotate
	( x list N el )
	dup 3 pick 3 + -1 * rotate
	( x el list N el )
	findit
	dup if
		( x el list N inx )
		1 + rotate pop 1 - dup 2 + rotate
		pop
	else
		pop dup 2 + rotate
		"#" over int intostr strcat over flagstr strcat
		" isn't parented to #" strcat apt-parent int intostr strcat
		say
		pop
	then
	( x list N )
	dup 2 + rotate
;
: scan-floor
	1 begin over over intostr rmatch exit? while 1 + loop
	1 - 1 -1 for
		over swap intostr rmatch getlink dellist
	loop
	pop
;
: scan-floors
	1 begin apt-lobby over intostr prop-exists? while 1 + loop
	1 - 1 -1 for
		apt-lobby swap intostr getpropstr atoi dbref scan-floor
	loop
;
: find-contents
	0 apt-parent contents
	begin dup while swap 1 + over next loop
	pop
;
: dump-list
	1 -1 for pop
		"[" over owner dbref-name strcat "] " strcat
		swap dbref-name strcat say
	loop
;
: main
	find-contents
	"[listed]" say
	' cmp-dbref sort
	"[sorted]" say
	scan-floors
	dump-list
;
.
c
q