File psl-1983/3-1/glisp/gevdemo.old from the latest check-in


(FILECREATED " 8-NOV-82 09:44:50" {DSK}GEVDEMO.LSP;22 10081  

      changes to:  (FNS GEVDEMO-INIT)
		   (VARS GEVDEMOCOMS)

      previous date: "26-OCT-82 16:10:02" {DSK}GEVDEMO.LSP;20)


(PRETTYCOMPRINT GEVDEMOCOMS)

(RPAQQ GEVDEMOCOMS ((GLISPOBJECTS PROJECT CONTRACT AGENCY PERSON BUDGET ADDRESS PHONE-NUMBER DATE 
				  PICTURE CAMPUS-ADDRESS BUILDING CIRCLE VECTOR RADIANS DEGREES 
				  RVECTOR)
	(FNS GEVDEMO-INIT TODAYS-DATE TOTAL-BUDGET)
	(PROP GLRESULTTYPE TODAYS-DATE)
	(P (GEVDEMO-INIT))))


[GLISPOBJECTS


(PROJECT

   [ATOM (PROPLIST (TITLE STRING)
		   (ABBREVIATION ATOM)
		   (ADMINISTRATOR PERSON)
		   (CONTRACTS (LISTOF CONTRACT))
		   (EXECUTIVES (LISTOF PERSON]

   PROP   ((SHORTVALUE (ABBREVIATION))
	   (DISPLAYPROPS (T))
	   (BUDGET TOTAL-BUDGET))  )

(CONTRACT

   (ATOM (PROPLIST (TITLE STRING)
		   (LEADER PERSON)
		   (SPONSOR AGENCY)
		   (BUDGET BUDGET)))

   PROP   ((SHORTVALUE (TITLE)))  )

(AGENCY

   (ATOM (PROPLIST (NAME STRING)
		   (ABBREVIATION ATOM)
		   (ADDRESS ADDRESS)
		   (PHONE PHONE-NUMBER)))

   PROP   ((SHORTVALUE (ABBREVIATION)))  )

(PERSON

   (ATOM (PROPLIST (NAME STRING)
		   (INITIALS ATOM)
		   (TITLE ATOM)
		   (PROJECT PROJECT)
		   (SALARY REAL)
		   (SSNO INTEGER)
		   (BIRTHDATE DATE)
		   (PHONE PHONE-NUMBER)
		   (OFFICE CAMPUS-ADDRESS)
		   (HOME-ADDRESS ADDRESS)
		   (HOME-PHONE PHONE-NUMBER)
		   (PICTURE PICTURE)))

   PROP   ((SHORTVALUE (INITIALS))
	   (CONTRACTS ((THOSE CONTRACTS OF PROJECT WITH LEADER=self)))
	   (AGE ((THE YEAR OF (TODAYS-DATE))
		 - BIRTHDATE:YEAR))
	   (MONTHLY-SALARY (SALARY/12))
	   (DISPLAYPROPS (T)))

   ADJ    [(FACULTY ((MEMB TITLE (QUOTE (PROF ASSOC-PROF ASST-PROF]  )

(BUDGET

   (LIST (LABOR REAL)
	 (COMPUTER REAL))

   PROP   ((OVERHEAD (LABOR*0.59))
	   (TOTAL (LABOR+OVERHEAD+COMPUTER))
	   (SHORTVALUE (TOTAL))
	   (DISPLAYPROPS (T)))  )

(ADDRESS

   (LIST (STREET STRING)
	 (CITY STRING)
	 (STATE ATOM)
	 (ZIP INTEGER))

   PROP   [(SHORTVALUE ((CONCAT CITY ", " STATE]  )

(PHONE-NUMBER

   (LIST (AREA INTEGER)
	 (NUMBER INTEGER))

   PROP   [(SHORTVALUE ((CONCAT "(" AREA ") " (SUBSTRING NUMBER 1 3)
				"-"
				(SUBSTRING NUMBER 4 7]

   ADJ    ((LOCAL (AREA=415 OR AREA=408)))  )

(DATE

   (LIST (MONTH INTEGER)
	 (DAY INTEGER)
	 (SHORTYEAR INTEGER))

   PROP   [[MONTHNAME ((CAR (NTH (QUOTE (January February March April May June July August September 
						 October November December))
				 MONTH]
	   (YEAR (SHORTYEAR + 1900))
	   (SHORTVALUE ((CONCAT MONTHNAME " " DAY ", " YEAR]  )

(PICTURE

   ANYTHING

   MSG    ((EDIT PAINTW)
	   (GEVDISPLAY PICTURE-GEVDISPLAY))  )

(CAMPUS-ADDRESS

   (LIST (BUILDING BUILDING)
	 (ROOM ATOM))

   PROP   [(SHORTVALUE ((CONCAT BUILDING:ABBREVIATION " " ROOM]  )

(BUILDING

   (ATOM (PROPLIST (ABBREVIATION ATOM)
		   (NAME STRING)
		   (NUMBER INTEGER)))

   PROP   ((SHORTVALUE (NAME)))  )

(CIRCLE

   (LIST (START VECTOR)
	 (RADIUS REAL))

   PROP   [(PI (3.141593))
	   (DIAMETER (RADIUS*2))
	   (CIRCUMFERENCE (PI*DIAMETER))
	   (AREA (PI*RADIUS^2))
	   (SQUARESIDE ((SQRT AREA)))
	   (DISPLAYPROPS ((QUOTE (DIAMETER CIRCUMFERENCE AREA]

   MSG    ((GROW (AREA_+100))
	   (SHRINK (AREA_AREA/2))
	   (STANDARD (AREA_100.0)))

   ADJ    ((BIG (AREA>100))
	   (SMALL (AREA<80)))  )

(VECTOR

   (LIST (X INTEGER)
	 (Y INTEGER))

   PROP   [(MAGNITUDE ((SQRT X^2 + Y^2)))
	   (ANGLE ((ARCTAN2 Y X T))
		  RESULT RADIANS)
	   (UNITVECTOR ((A RVECTOR WITH X = X/MAGNITUDE , Y = Y/MAGNITUDE]

   ADJ    ((ZERO (X IS ZERO AND Y IS ZERO))
	   (NORMALIZED (MAGNITUDE = 1.0)))

   MSG    [(PRIN1 ((PRIN1 "(")
		   (PRIN1 X)
		   (PRIN1 ",")
		   (PRIN1 Y)
		   (PRIN1 ")")))
	   (PRINT ((_ self PRIN1)
		   (TERPRI]  )

(RADIANS

   REAL

   PROP   ((DEGREES (self* (180.0/3.1415926))
		    RESULT DEGREES)
	   (DISPLAYPROPS (T)))  )

(DEGREES

   REAL

   PROP   ((RADIANS (self* (3.1415926/180.0))
		    RESULT RADIANS)
	   (DISPLAYPROPS (T)))  )

(RVECTOR

   (LIST (X REAL)
	 (Y REAL))

   SUPERS (VECTOR)  )
]

(DEFINEQ

(GEVDEMO-INIT
  [GLAMBDA NIL                                               (* edited: " 6-NOV-82 14:41")
                                                             (* Initialize data structures for GEV demo.)
	   (PROG NIL
	         (HPP _(A PROJECT WITH TITLE = "Heuristic Programming Project" , ABBREVIATION =(QUOTE
			    HPP)))
	         (MJH _(A BUILDING WITH ABBREVIATION =(QUOTE MJH)
			  , NAME = "Margaret Jacks Hall" , NUMBER = 460))
	         (ARPA _(AN AGENCY WITH NAME = "Defense Advanced Research Projects Agency" , 
			    ABBREVIATION =(QUOTE ARPA)
			    , ADDRESS =(AN ADDRESS WITH STREET = "1400 Wilson Blvd." , CITY = 
					   "Arlington"
					   , STATE =(QUOTE VA)
					   , ZIP = 22209)
			    , PHONE =(A PHONE-NUMBER WITH AREA = 202 , NUMBER = 6944349)))
	         (NSF _(AN AGENCY WITH NAME = "National Science Foundation" , ABBREVIATION =(QUOTE
			     NSF)
			   , ADDRESS =(AN ADDRESS WITH STREET = "1800 G STREET N.W." , CITY = 
					  "Washington"
					  , STATE =(QUOTE DC)
					  , ZIP = 20550)
			   , PHONE =(A PHONE-NUMBER WITH AREA = 202 , NUMBER = 6327346)))
	         (NIH _(AN AGENCY WITH NAME = "National Institutes of Health" , ABBREVIATION =(QUOTE
			     NIH)
			   , ADDRESS =(AN ADDRESS WITH STREET = "9000 Rockville Pike" , CITY = 
					  "Bethesda"
					  , STATE =(QUOTE MD)
					  , ZIP = 20001)
			   , PHONE =(A PHONE-NUMBER WITH AREA = 301 , NUMBER = 4964000)))
	         (GSN _(A PERSON WITH NAME = "Gordon S. Novak Jr." , INITIALS =(QUOTE GSN)
			  , TITLE =(QUOTE VISITOR)
			  , PROJECT = HPP , SALARY = 30000.0 , SSNO = 455827977 , BIRTHDATE =(A
			    DATE WITH DAY = 21 , MONTH = 7 , SHORTYEAR = 47)
			  , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4974532)
			  , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 244)
			  , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4935807)
			  , HOME-ADDRESS =(AN ADDRESS WITH STREET = "3857 Ross Road" , CITY = 
					      "Palo Alto"
					      , STATE =(QUOTE CA)
					      , ZIP = 94303)))
	         (TCR _(A PERSON WITH NAME = "Tom C. Rindfleisch" , INITIALS =(QUOTE TCR)
			  , TITLE =(QUOTE ADMINISTRATOR)
			  , PROJECT = HPP , SALARY = 30000.0 , SSNO = 452123477 , BIRTHDATE =(A
			    DATE WITH DAY = 2 , MONTH = 1 , SHORTYEAR = 47)
			  , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4972780)
			  , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4324321)
			  , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 236)
			  , HOME-ADDRESS =(AN ADDRESS)))
	         (EAF _(A PERSON WITH NAME = "Edward A. Feigenbaum" , INITIALS =(QUOTE EAF)
			  , TITLE =(QUOTE PROF)
			  , PROJECT = HPP , SALARY = 99999.0 , SSNO = 123123477 , BIRTHDATE =(A
			    DATE WITH DAY = 2 , MONTH = 1 , SHORTYEAR = 37)
			  , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4974878)
			  , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 226)
			  , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4931234)
			  , HOME-ADDRESS =(AN ADDRESS WITH STREET = " " , CITY = "Stanford" , STATE =(
						QUOTE CA)
					      , ZIP = 94305)))
	         (MRG _(A PERSON WITH NAME = "Michael R. Genesereth" , INITIALS =(QUOTE MRG)
			  , TITLE =(QUOTE ASST-PROF)
			  , PROJECT = HPP , SALARY = 31234.0 , SSNO = 123123477 , BIRTHDATE =(A
			    DATE WITH DAY = 2 , MONTH = 1 , SHORTYEAR = 50)
			  , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4970324)
			  , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 234)
			  , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4324321)
			  , HOME-ADDRESS =(AN ADDRESS)))
	         (J5 _(A CONTRACT WITH TITLE = "Advanced A.I. Architectures" , LEADER = EAF , SPONSOR 
			 = ARPA , BUDGET =(A BUDGET WITH LABOR = 50000.0 , COMPUTER = 10000.0)))
	         (IA _(A CONTRACT WITH TITLE = "Intelligent Agents" , LEADER = MRG , SPONSOR = ARPA , 
			 BUDGET =(A BUDGET WITH LABOR = 70000.0 , COMPUTER = 50000.0)))
	         (DART _(A CONTRACT WITH TITLE = "Diagnosis and Repair Techniques" , LEADER = MRG , 
			   SPONSOR = ARPA , BUDGET =(A BUDGET WITH LABOR = 100000.0 , COMPUTER = 
						       150000.0)))
	         (GLISP _(A CONTRACT WITH TITLE = "GLISP" , LEADER = GSN , SPONSOR = ARPA , BUDGET =(
			      A BUDGET WITH LABOR = 50000.0 , COMPUTER = 20000.0)))
	         (CMPICTURE _(CREATEW (create REGION
					      LEFT _ 0
					      BOTTOM _ 0
					      WIDTH _ 100
					      HEIGHT _ 100)))
	         (CM _(A PERSON WITH NAME = "Cookie Monster" , INITIALS =(QUOTE CM)
			 , TITLE =(QUOTE MONSTER)
			 , PROJECT = HPP , SALARY = 1.0 , SSNO = 123456789 , BIRTHDATE =(A DATE WITH 
											   MONTH = 4 
											   , DAY = 1 
											   , 
											SHORTYEAR = 
											   65)
			 , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4971234)
			 , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 252)
			 , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4561234)
			 , HOME-ADDRESS =(AN ADDRESS WITH STREET = "123 Sesame Street" , CITY = 
					     "Palo Alto"
					     , STATE =(QUOTE CA)
					     , ZIP = 94303)
			 , PICTURE = CMPICTURE))
	         (CARBM _(A CONTRACT WITH TITLE = "Carbohydrate Metabolism in Atypical Hominids" , 
			    LEADER = CM , SPONSOR = NIH , BUDGET =(A BUDGET WITH LABOR = 1.39 , 
								     COMPUTER = 5.0)))
	         (HPP:ADMINISTRATOR _ TCR)
	         (HPP:CONTRACTS _(LIST J5 IA DART GLISP CARBM))
	         (HPP:EXECUTIVES _(LIST EAF MRG GSN TCR))
	         (C _(A CIRCLE WITH START =(A VECTOR WITH X = 1 , Y = 1)
			, RADIUS = 5.0])

(TODAYS-DATE
  (GLAMBDA NIL                                               (* edited: "22-OCT-82 16:54")
	   (A DATE WITH MONTH = 10 , DAY = 15 , SHORTYEAR = 82)))

(TOTAL-BUDGET
  (GLAMBDA (P:PROJECT)                                       (* edited: "22-OCT-82 17:13")
	   (PROG (SUM)
	         (SUM_0.0)
	         (FOR EACH CONTRACT SUM_+BUDGET:TOTAL)
	         (RETURN SUM))))
)

(PUTPROPS TODAYS-DATE GLRESULTTYPE DATE)
(GEVDEMO-INIT)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (4061 9998 (GEVDEMO-INIT 4071 . 9592) (TODAYS-DATE 9594 . 9764) (TOTAL-BUDGET 9766 . 
9996)))))
STOP


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]