/* --- Copyright University of Sussex 1995. All rights reserved. ----------
 > File:            C.all/lib/objectclass/lib/objclass_example.p
 > Purpose:         Objectclass file
 > Author:          Steve Knight, HP Labs, 1992-1993 (see revisions)
 > Documentation:   HELP OBJECTCLASS
 > Related Files:
 */

;;; testobj.p all the examples from TEACH OBJECTCLASS_EXAMPLE
;;; minus text

uses objectclass;

define :class person;
	slot person_name = undef;
	slot person_age = 0;
	slot person_sex = undef;
enddefine;

vars P, Pname, Page, Psex;
consperson("fred", 5, "male" ) -> P;
	;;; creates person P

P =>

destperson( P ) -> (Pname, Page, Psex);
	;;; extracts the person_, age and sex from a person instance

Pname =>

destperson(P) =>



vars adam = consperson("adam", 24, "male");
adam =>

isperson(adam) =>

newperson() -> P;

P=>

newperson() -> P;

P =>

vars ppp;

instance person;
	person_age = 77;
	person_sex = "male"
endinstance -> ppp;

ppp=>

define :instance xxx:person;
	person_age = 77;
	person_sex = "male"
enddefine;

xxx =>

newperson() -> P;
P =>


person_name( P ) =>

"mary" -> person_name( P );
person_name( P ) =>

16 -> person_age( P );
person_age( P ) =>

"female" -> person_sex( P );
person_sex( P ) =>

P =>

isperson(P) =>

isperson(99)=>

define :method birthday( p:person );
	lvars p, age;
	person_age(p) + 1 -> age;
	age -> person_age(p);
	[Happy birthday ^(person_name(p)) - now aged ^age] =>
enddefine;

vars joe = consperson("joe", 0, "female");
joe =>

birthday(joe);

person_age(joe) =>

birthday(joe);

define :class adult;
	is person;                 ;;; specify superclass
	slot person_spouse = false;      ;;; and additional slot
enddefine;

define :instance adam:adult;
	person_name = "adam";
	person_age = 33;
	person_sex = "male";
enddefine;

define :instance eve:adult;
	person_name = "eve";
	person_age = 35;
	person_sex = "female";
enddefine;

define :instance dot:adult;
	person_name = "dot";
	person_age = 25;
	person_sex = "female";
enddefine;

adam =>
dot=>

isperson(adam) =>

isperson(adam) =>

isadult(adam) =>

define :method print_instance( p:person);
	lvars p;
	pr('<person name:');
	pr(person_name(p));
	pr(' age:');
	pr(person_age(p));
	pr(' sex:');
	pr(person_sex(p));
	if isadult(p) then
		pr(' spouse:');
		pr(person_spouse(p));
	endif;
	pr('>')
enddefine;

instance person; person_name = "fred"; person_sex = "male" endinstance =>

adam =>

eve =>

dot =>

global vars objectclass_print_limit = 2;    ;;; you can change this

define :method print_instance( x:adult );
	lvars x;

	dlocal objectclass_print_limit = objectclass_print_limit - 1;

	if objectclass_print_limit < 0 then
		printf(' ...');
		return();
	else
		call_next_method( x ) ;;; get the inherited default
	endif;

enddefine;

adam =>

vars
	a1 = instance adult person_name = "a1" endinstance,
	a2 = instance adult person_name = "a2" endinstance;

a1 -> person_spouse(a2);
a2 -> person_spouse(a1);

a1 =>

a2 =>

define check_bigamy(p1, p2);
	lvars p1, p2, spouse;
	person_spouse(p1) -> spouse;
	if spouse then
		;;; check p1 is not already married to someone else
		unless spouse == p2 then
			mishap('BIGAMY', [% p1, p2 %]);
		endunless
	endif
enddefine;

define take_spouse(p1, p2);
	lvars p1, p2;
	;;; update my spouse slot
	p2 -> person_spouse(p1);
	;;; take the vows
	[I ^(person_name(p1))
		take thee ^(person_name(p2))
		to be my lawfully wedded
		other] =>
enddefine;

define :method marry( p1:person, p2:person );
	lvars p1, p2, spouse1, spouse2;

	;;; see if p1 and p2 are of the same sex
	if person_sex(p1) == person_sex(p2) then
		[hmm very modern] =>
	endif;

	check_bigamy(p1, p2);
	check_bigamy(p2, p1);

	take_spouse(p1, p2);
	take_spouse(p2, p1);
enddefine;

marry(adam, eve);

person_name(person_spouse(adam)) =>
person_name(person_spouse(eve)) =>

;;; Next one causes a mishap, deliberately
;;;    marry(adam, dot);

person_spouse(person_spouse(adam)) == adam =>

define :method marry( p1:person, p2:person );
	lvars p1, p2, spouse;

	;;; see if p1 and p2 are of the same sex
	if person_sex(p1) == person_sex(p2) then
		[hmm very modern] =>
	endif;

	person_spouse(p1) -> spouse;
	if spouse then
		;;; check p1 is not already married to someone else
		unless spouse == p2 then
			mishap('BIGAMY', [% p1, p2 %]);
		endunless
	else
		;;; not already married. Fix it
		;;; update my spouse slot
		p2 -> person_spouse(p1);
		;;; take the vows
		[I ^(person_name(p1)) take thee ^(person_name(p2))
			to be my lawfully wedded other] =>

		;;; Now make sure the other person does the same
		marry(p2, p1)
	endif
enddefine;


vars
	a1 = instance adult person_name = "a1" endinstance,
	a2 = instance adult person_name = "a2" endinstance;

marry(a1, a2);
marry(a2, a1);

a1 =>
a2 =>

define :method print_instance(a:adult);
	lvars a, spouse;
	person_spouse(a) -> spouse;

	printf(
		'<adult name:%P age:%P sex:%P spouse:%P>',

		[%
			person_name(a),
			person_age(a),
			person_sex(a),
			if spouse then person_name(spouse) else false endif
		%])
enddefine;

adam =>

define :class professor;
	is adult;                  ;;; superclass
	slot telephone_number;           ;;; two new slots
	slot discipline;
enddefine;

vars roger = newprofessor();
"penrose" -> person_name(roger);
telephone_number(roger) =>

discipline(roger) =>

roger =>

define :method print_instance( p:professor ); lvars p;
	pr('<professor '); pr(person_name(p)); pr('>');
enddefine;

roger =>

define :class subject;
	slot subject_name = 'undecided';
enddefine;

define :method write_paper(p:professor, s:subject);
	lvars p, s;
	[^(person_name(p))
		is writing a paper on ^(subject_name(s))] =>
	/* now insert code for a professor to write a paper */
enddefine;

define :method write_paper(p:professor, s:professor);
	lvars p, s;
	[^(person_name(p))
		is writing a paper criticising ^(person_name(s))] =>
	/* now insert code for a professor to write a paper */
enddefine;


vars rel =
	instance subject; subject_name = "relativity" endinstance;

rel =>

write_paper(roger, rel);

write_paper(roger,
	instance professor; person_name = "jones" endinstance );

vars marvin;
consprofessor("marvin", 53, "male", "nina", '(691) 455 554',
	"computers_and_philosophy") -> marvin;

marvin =>

discipline(marvin) =>

birthday(marvin);

person_age(marvin) =>

write_paper(marvin,conssubject("ai"));

write_paper(marvin, roger);

define :class french_professor;
	is professor;
	/* features special to french professors */
enddefine;

/*
;;; generates mishap

define :class french_professor;
	is professor french_person;
	/* features special to french professors that are not true
		of professors in general or french people in general
	*/
enddefine;

*/

define :method birthday(prof:professor);
	lvars prof, age, name = person_name(prof);

	call_next_method(prof);

	person_age(prof) -> age;

	if age >= 65 then
		[^name is now retired] =>
	elseif 65 - age < 5 then
		[^name has only  ^(65 - age) years before retiring] =>
	endif;
enddefine;

define :instance albert:professor;
	person_age = 63;
	person_name = "einstein";
	discipline = "relativity";
enddefine;

albert =>

birthday(albert);

birthday(albert);

birthday(albert);

vars margaret =
	instance person;
		person_name = "margaret";
		person_age = 63
	endinstance;

birthday(margaret);

birthday(margaret);

define :method initialise(p:person);
	'Population increasing' =>
enddefine;

newperson() =>

define :instance martin:professor;
	person_name = "martin";
enddefine;

martin =>

instance professor
	person_name = "isaac";
endinstance =>


define :class dated_person;
	is person;
	slot birthtime = sysdaytime();
enddefine;

vars p1 = newdated_person();
birthtime(p1) =>

vars p2 = newdated_person();
birthtime(p2) =>

define :class dated_person;
	is person;
	slot birthtime;      ;;; No default specified here
enddefine;

define :method initialise(p:dated_person);
	sysdaytime() -> birthtime(p);
enddefine;

vars p3 = newdated_person();
birthtime(p3) =>

vars p4 = newdated_person();
birthtime(p4) =>

define :method get_younger(years, p:person);
	lvars years, p, age = person_age(p);

	age - years -> age;
	age -> person_age(p);

	[^(person_name(p)) now has age ^age] =>
enddefine;

birthday(albert);

get_younger(10, albert);

birthday(albert);

/*
;;;; gets mishap

define :method write_essay(p:professor, s);
	lvars p, s;
	[^(person_name(p))
		is writing a paper criticising ^(person_name(s))] =>
enddefine;
*/

define :method write_essay(s, p:professor);
	lvars p, s;
	[^(person_name(p))
		is writing a paper criticising ^(person_name(s))] =>
enddefine;

/* --- Revision History ---------------------------------------------------
--- Robert John Duncan, Nov 21 1995
		Added: uses objectclass
 */
