@prog random-desc.muf
1 999 d
1 i
( Random description program.  Picks one of a set of descriptions randomly,
  possibly with unequal probability.

  Usage: give it a string that's a prefix for property names.  The property
  name prefix will have numbers from 1 upward appended to it.  The resulting
  properties hold the descriptions.  To change the relative probabilities,
  append "-prob" to a description probability name and give a number as the
  value of the resulting property.  Descriptions with no probability given
  are treated as though 100 were given for them; the probabilities are all
  relative to the sum of all probability values.

  If the property name prefix string is omitted, it defaults to "_rdsc".

  Example.  Given an object that uses this program, with the following
  properties:

	_rdsc1: A plain cardboard box.
	_rdsc2: A plain cardboard box.  You notice a small hole near one corner.
	_rdsc2-prob: 5

  then the first description will be used 100/105ths of the time, with the
  other one being used the other 5/105ths of the time.

  Another example:

	_rdsc1: The die shows `1'.
	_rdsc2: The die shows `2'.
	_rdsc3: The die shows `3'.
	_rdsc4: The die shows `4'.
	_rdsc5: The die shows `5'.
	_rdsc6: The die shows `6'.
	_rdsc7: The die is teetering precariously on one corner.
	_rdsc7-prob: 1

  Someone looking at the object will see one of the first six descriptions
  almost all the time [each one with equal probability]; 1/601 of the time,
  the seventh description will be printed.

  Descriptions listed as having probability less than 1 are ignored.  If all
  descriptions listed are ignored, nothing happens.

  Description lines can be messages, which are simply printed, or programs
  to run, which work as normal.
)
: get-prob (pfx n -- prob)
	(this word returns 0 for bad properties and 100 for missing ones.)
	intostr strcat "-prob" strcat trigger @ swap
	over over prop-exists? if
		getpropstr atoi dup 0 < if pop 0 then
	else
		pop pop 100
	then
;
: is-program-reference?
	dup "@" 1 strncmp if pop 0 exit then
	1 strcut swap pop
	dup atoi dup dbref program? not if pop pop 0 exit then
	intostr strcmp not
;
: say me @ swap notify ;
: run-or-say
	dup " " instr dup if
		1 - strcut 1 strcut swap pop
		over is-program-reference? if
			swap 1 strcut swap pop atoi dbref call
		else
			" " swap strcat strcat say
		then
	else
		pop
		dup is-program-reference? if
			1 strcut swap pop atoi dbref "" swap call
		else
			say
		then
	then
;
: main
( Compatability...
	dup not if pop "_rdsc" then
)
	dup not if pop trigger @ "_rdsc1" prop-exists? if "_rdsc" else "rdsc" then then
	-1 0
	1
	begin
		( pfx choice probsum n )
		4 pick over intostr strcat trigger @ swap prop-exists?
	while
		4 pick over get-prob 3 pick +
		( pfx choice probsum n newsum )
		dup if
			random over %
			( pfx choice probsum n newsum rv )
			4 pick >= if over 4 put then
		then
		rot pop swap
		1 +
	loop
	( pfx choice probsum n )
	pop pop intostr strcat trigger @ swap getpropstr
	run-or-say
;
.
c
q