# p7fancyclass
#
# Demonstrate how to extend ParentheTcl by evaluating Tcl code
# in the .p7 files.
#
#  This function p7fancyclass is like p7class, but it also
#  generates a constructor (with the same name as the class),
#  getters and setters for each member, and a toList method 
#  that generates a list of values in the object (which is 
#  basically the same as the constructor syntax).

proc p7fancyclass {name members} {

	# generate the class
	p7class $name $members

	# generate a constructor function
	p7proc "($name)$name" $members [

		set body "\n new ($name)z ;\n"
		foreach member $members {
			regexp {^[(](.+)[)]([^()]+)$} $member - type field
			append body " set z($field) \$$field ;\n"
		}
		append body " set z \n"
		set body
	]

	# generate a toList function
	p7proc "(tcl)toList" "($name)this" [

		set body " ::list $name "
		foreach member $members {
			regexp {^[(](.+)[)]([^()]+)$} $member - type field
			append body " \$$field "
		}
		set body
	]

	# generate a function to tell all the members of the class (for reflection)
	p7proc (tcl)typeof ($name)this   " return $name "

	# generate a function to tell all the members of the class (for reflection)
	p7proc (tcl)members ($name)this [

		set body " ::list "
		foreach member $members {
			regexp {^[(](.+)[)]([^()]+)$} $member - type field
			append body " $field "
		}
		set body
	]

	# generate getter functions for each member.
	foreach member $members {

		regexp {^[(](.+)[)]([^()]+)$} $member - type field

		# Unfortunately, the getter must return (tcl) so that 
		# all get_X methods (for any X, for any class) return the same type.

		p7proc (tcl)get_$field ($name)this "set $field "
			
	}

	# generate setter functions for each member
	foreach member $members {

		regexp {^[(](.+)[)]([^()]+)$} $member - type field

		p7proc (void)set_$field [list ($name)this ($type)_value_ ] "set $field \$_value_ "

	}
}