@prog party.muf
1 999 d
1 i
(
  Program for creating things and destroying them.  Designed for food, but
  usable for other things.

  Setup: create an object.  Put an exit on it, linked to this program.
  Put a property _action:serve on the exit.  Properties on the object then
  control the created objects:
	_portion-name:string
  makes the created objects be named "string".
	_portion-desc:string
  puts "string" into the @desc of the created objects.
	_portion-prop-1:foo:bar
	_portion-prop-2:...
  specifies properties to put on the created objects.
	_eat-name:string
  specifies the name of the consume exit placed on created objects.  This
  can and probably should have multiple names separated by ;s, just like
  any exit.
	_eat-succ:string
  sets the @succ for the consume exit to "string".
	_eat-osucc:string
  sets the @osucc for the consume exit to "string".

  The program requires that the exit and the object it's attached to be
  owned by the same player, unless the exit is wiz-owned.  Created objects
  and their exits will be owned by the owner of the "serve" exit.
)
: say me @ swap notify ;
: trigloc trigger @ location ;
: doserve
	pop
	trigloc "_portion-name" getpropstr 1 create
	dup trigloc "_portion-desc" getpropstr setdesc
	1
	begin
		"_portion-prop-" over intostr strcat trigloc swap
		over over prop-exists?
	while
		getpropstr dup ":" instr dup if
			1 - strcut 1 strcut swap pop
			4 pick rot rot 0 addprop
		else
			pop pop
		then
	loop
	pop pop pop
	trigloc "_eat-name" getpropstr over open
	dup prog addlink
	dup "_action" "eat" 0 addprop
	dup trigloc "_eat-succ" getpropstr setsucc
	dup trigloc "_eat-osucc" getpropstr setosucc
	dup trigger @ owner chown
	pop
	dup trigger @ owner chown
	dup me @ moveto
	pop
;
: doeat
	pop
	trigger @ location recycle
;
: main
	trigger @ owner dup wizard? if
		pop 1
	else
		trigger @ location owner dbcmp
	then
	not if "Permission denied." say exit then
	trigger @ "_action" getpropstr
	dup "serve" strcmp not if pop doserve exit then
	dup "eat" strcmp not if pop doeat exit then
;
.
c
q