@prog air-name.muf
1 999 d
1 i
: top #17719 ;
: getexitnumber
	swap "down" rmatch "_rexit" rot strcat getpropstr atoi dbref
;
: walkexits
	top swap
	begin dup while
		1 strcut rot rot getexitnumber getlink swap
	loop
	pop
;
: nameroom (room exitstring -- )
	"" explode
	dup 3 = if
		pop
		atoi 1 - rot atoi 1 - rot atoi 1 - rot
		3 pick 3 pick 3 pick
		2 % 3 * swap 3 % + 2 * swap 2 % +
		-4 rotate
		2 / 2 * swap 3 / + 3 * swap 2 / +
		"Air over valley [" rot 1 + intostr strcat ", " strcat
		18 rot - intostr strcat "]" strcat
		setname exit
	then
	dup 2 = if
		pop
		atoi 1 - swap atoi 1 - swap
		over over
		2 % 3 * swap 3 % + 2 *
		-3 rotate
		2 / 2 * swap 3 / + 3 *
		"Air over valley ["
		rot 1 + dup intostr swap 1 + intostr "-" swap strcat strcat
		strcat ", " strcat
		16 rot - dup intostr swap 2 + intostr "-" swap strcat strcat
		strcat "]" strcat
		setname exit
	then
	dup 1 = if
		pop
		atoi 1 -
		dup 2 % 6 * swap 2 / 6 *
		"Air over valley ["
		rot 1 + dup intostr swap 5 + intostr "-" swap strcat strcat
		strcat ", " strcat
		13 rot - dup intostr swap 5 + intostr "-" swap strcat strcat
		strcat "]" strcat
		setname exit
	then
	begin 0 > while swap pop loop pop pop
;
: name-exit (room exit-number new-suffixes -- room)
	";" explode dup 3 + -2 roll "" 4 rotate
	( list room old new N )
	begin dup 0 > while
		1 - ";d@;d-@;down @;down-@;d @;down and @" 6 rotate "@" subst
		rot swap strcat swap
	loop
	pop 1 strcut swap pop
	3 pick rot getexitnumber swap setname
;
: name-exits-13
	"1" "nw;northwest" name-exit
	"2" "ne;northeast" name-exit
	"3" "w;west" name-exit
	"4" "e;east" name-exit
	"5" "sw;southwest" name-exit
	"6" "se;southeast" name-exit
	pop
;
: name-exits-2
	"1" "nw;northwest" name-exit
	"2" "n;north" name-exit
	"3" "ne;northeast" name-exit
	"4" "sw;southwest" name-exit
	"5" "s;south" name-exit
	"6" "se;southeast" name-exit
	pop
;
: main
	1 6 1 for
		intostr
		1 6 1 for
			intostr strcat
			1 6 1 for
				intostr strcat
				dup walkexits over nameroom
				2 strcut pop
			loop
			dup walkexits dup name-exits-13 over nameroom
			1 strcut pop
		loop
		dup walkexits dup name-exits-2 over nameroom
		pop
	loop
	top name-exits-13
	me @ "Done." notify
;
.
c
q