/persistent //nullarray def

/self {
	% -- struct object
	/ParentDictArray where not null if
} def

/class {
	% -- shared_class
	ParentDictArray dup length 1 sub get
} def

/superclasses {
	% -- root *
	class dup /superclasses get [3 -1 roll]
	append
} def

/classes {
	% -- root *
	ParentDictArray dup length collapse 2 {
		2 copy 1 sub get /superclasses get length 1
		add
	} ifelse
	3 -2 roll 2 index sub 3 -1 roll
	getinterval
} def

/understands {
	% name -- boolean
	where not null if
	null ne
} def

/descendantof {
	% name -- boolean
	class /superclass get {
		dup null ne {
			dup /classname get 2 index ne
		} false ifelse
		not {
			exch pop exit
		} if
		/superclass get
	} loop
	null ne
} def

/nm null def


%begin postscript section
/nm persist %end postscript section

/namestr {
	% -- string
	(%\(%\)) [classname nm null ne {nm} {
		//nullstring cvn
	} ifelse
	] sprintf
} def

/rename {
	% name -- boolean
	dup nm eq {
		pop true
	} {
		dup 128 string cvs dup length 1 le {
			pop true
		} {
			0 get 64 ne
		} ifelse
		{
			pop false
		} {
			@parent dup null eq {
				pop /nm exch promote true
			} {
				1 index null ne {
					1 index /understands 2 index send
				} false ifelse
				{
					pop pop false
				} {
					nm null ne {
						dup nm undef /nm unpromote
					} if
					1 index null ne {
						exch dup /nm exch promote self put
					} {
						pop pop
					} ifelse
					true
				} ifelse
			} ifelse
		} ifelse
	} ifelse
} def

/newname0 {
	% object --
	dup null ne {
		{
			(@) random 1000 mul cvi 4 string cvs append
			cvn dup /understands 3 index send
			not {exit} if
			pop
		} loop
		dup /nm exch promote self put
	} {pop} ifelse
} def

/newname {
	% --
	@parent dup null ne {
		nm null ne {
			dup nm undef
		} if
		newname0
	} {pop} ifelse
} def

/find_name {
	% name -- object
	dup where not null if
	null ne {
		[exch cvx exec] 0 get
	} {
		pop null
	} ifelse
} def

/find_path {
	% name * -- object
	dup length 1 le {
		pop self
	} {
		dup 1 get find_name dup null ne {
			exch dup 1 exch length 1 index sub
			GetInterval /find_path 3 -1 roll send
		} {
			pop pop null
		} ifelse
	} ifelse
} def

/find_object {
	% any -- object
	dup truedicttype find_object$SwiTch0 exch
	2 copy known not {
		pop /$deFaUlT
	} if
	get exec
} def

/find_object$SwiTch0 5 dict dup begin
/$deFaUlT {
	pop null
} def
/nametype {find_name} def
/hntype {} def
/arraytype {
	dup length 0 ne {
		dup 0 get find_object dup null ne {
			exch /find_path 3 -1 roll send
		} {
			pop pop null
		} ifelse
	} {
		pop self
	} ifelse
} def
/packedarraytype currentdict /arraytype
get def
end
def

/members //nullarray def


%begin postscript section
/members persist %end postscript section

/parents {
	% -- object *
	ParentDictArray dup 0 3 -1 roll length
	classes length sub getinterval
} def

/@parent {
	% -- object
	parents dup length dup 0 gt {
		1 sub get
	} {
		pop pop null
	} ifelse
} def

/rooted {
	% -- boolean
	ParentDictArray length classes length gt
} def

/reparent {
	% object * --
	dup classes append /ParentDictArray exch
	promote members length 0 ne {
		[self soften] append members {
			exch dup /reparent 4 -1 roll send
		} forall
	} if
	pop @parent nm null ne {
		nm /understands 2 index send
		not
	} false ifelse
	{
		nm self put
	} {newname0} ifelse
} def

/initmember {
	% object --
	parents [self soften] append /reparent
	2 index send
	/oninit exch send
} def

/addmember {
	% object --
	members [2 index] append /members exch
	promote initmember
} def

/newmember {
	% name -- object
	/find_class class_mgr send
	//nullstring //nullstring /new 4 -1 roll
	send
	/new exch send
	dup addmember
} def

/removemember {
	% object --
	members 1 index arrayindex not -1 if
	dup 0 lt {
		pop pop
	} {
		//nullarray /reparent 4 -1 roll send
		members dup length array copy exch
		arraydelete /members exch promote
	} ifelse
} def

/delmember {
	% object --
	dup removemember /destroy exch send
} def

/setscript {
	% string string -- boolean
	/new class /superclass get send
	dup null eq {
		pop false
	} {
		growabledict persistent {
			1 index exch null put
		} forall dup /ParentDictArray null put self
		{
			pop 2 copy known not {
				self exch undef
			} {pop} ifelse
		} forall pop classes dup length 1 sub
		3 -1 roll put oninit true
	} ifelse
} def

/OnInit nullproc def

/oninit {
	% --
	members {
		/oninit exch send
	} forall /OnInit load nullproc ne {
		//nullarray /OnInit self Send
	} if
} def

/promote {
	% name any --
	self 3 -2 roll put
} def

/softpromote {
	% name any --
	1 index unpromote 1 index where not null if
	null eq true {
		1 index load 1 index cmp not
	} ifelse
	{promote} {
		pop pop
	} ifelse
} def

/unpromote {
	% name --
	self exch undef
} def

/promoted {
	% name -- boolean
	self exch known
} def

/scoped {
	% name -- boolean
	where not null if
	dup null eq {
		pop true
	} {
		parents exch arraycontains?
	} ifelse
} def

/destroy {
	% --
	members {
		/destroy exch send
	} forall self cleanoutdict
} def

/obsolete nullproc def


%begin postscript section
/logging persist %end postscript section

/deliver_self {
	% name --
	currentprocess /ErrorDetailLevel 1 put
	logging {
		/log_message cvx stopped pop
	} if
	cvx stopped {
		$error null ne {
			$error /newerror get
		} false ifelse
		{
			/handle_error cvx stopped pop $error
			/newerror false put
		} if
	} if
} def

/deliver_parent {
	% name --
	/deliver @parent send
} def

/deliver {
	% name --
	dup where not null if
	null ne {deliver_self} {deliver_parent}
	ifelse
} def

/doit {
	% any --
	cvx exec
} def