Artifact 0822a2efe85829a5f91d39d7bd982e127353c46b05d5e11b6f751df071974ece:
- File
psl-1983/3-1/glisp/gltest
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 6529) [annotate] [blame] [check-ins using] [more...]
- File
psl-1983/glisp/gltest
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 6529) [annotate] [blame] [check-ins using]
% GLTEST.PSL.2 22 OCTOBER 82
% GLISP TEST FUNCTIONS, PSL VERSION. GSN 22 OCTOBER 82
(DE GIVE-RAISE
(:COMPANY)
(FOR EACH ELECTRICIAN WHO IS NOT A TRAINEE
DO (SALARY _+(IF SENIORITY > 1
THEN 2.5
ELSE 1.5))
(PRINT (THE NAME OF THE ELECTRICIAN))
(PRINT (THE PRETTYFORM OF DATE-HIRED))
(PRINT MONTHLY-SALARY) ))
(DE CURRENTDATE ()
(A DATE WITH YEAR = 1981 !, MONTH = 11 !, DAY = 30))
(PUTPROP 'CURRENTDATE 'GLRESULTTYPE 'DATE)
(GLISPOBJECTS
(EMPLOYEE
(LIST (NAME STRING)
(DATE-HIRED (A DATE))
(SALARY REAL)
(JOBTITLE ATOM)
(TRAINEE BOOLEAN))
PROP ((SENIORITY ((THE YEAR OF (CURRENTDATE))
-
(THE YEAR OF DATE-HIRED)))
(MONTHLY-SALARY (SALARY * 174)))
ADJ ((HIGH-PAID (MONTHLY-SALARY > 2000)))
ISA ((TRAINEE (TRAINEE))
(GREENHORN (TRAINEE AND SENIORITY < 2)))
MSG ((YOURE-FIRED (SALARY _ 0))) )
(DATE
(LIST (MONTH INTEGER)
(DAY INTEGER)
(YEAR INTEGER))
PROP ((MONTHNAME ((NTH
' (JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER
OCTOBER NOVEMBER DECEMBER)
MONTH)))
(PRETTYFORM ((LIST DAY MONTHNAME YEAR)))
(SHORTYEAR (YEAR - 1900))) )
(COMPANY
(ATOM (PROPLIST (PRESIDENT (AN EMPLOYEE))
(EMPLOYEES (LISTOF EMPLOYEE) )))
PROP ((ELECTRICIANS ((THOSE EMPLOYEES WITH JOBTITLE='ELECTRICIAN)))) )
)
(PUTPROP 'COMPANY1 'PRESIDENT
'("OSCAR THE GROUCH" (3 15 1907) 88.0 PRESIDENT NIL) )
(PUTPROP 'COMPANY1 'EMPLOYEES
'(("COOKIE MONSTER" (7 21 1947) 12.5 ELECTRICIAN NIL)
("BETTY LOU" (5 14 1980) 9.0 ELECTRICIAN NIL)
("GROVER" (6 13 1978) 3.0 ELECTRICIAN T)) )
(GLISPOBJECTS
(VECTOR
(LIST (X INTEGER)
(Y INTEGER))
PROP ((MAGNITUDE ((SQRT X^2 + Y^2))))
ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
(NORMALIZED (MAGNITUDE = 1.0)))
MSG ((+ VECTORPLUS OPEN T)
(- VECTORDIFF OPEN T)
(* VECTORTIMES OPEN T)
(/ VECTORQUOTIENT OPEN T)
(_+ VECTORMOVE OPEN T)
(PRIN1 ((PRIN1 "(")
(PRIN1 X)
(PRIN1 ",")
(PRIN1 Y)
(PRIN1 ")")))
(PRINT ((_ SELF PRIN1)
(TERPRI))) ) )
(GRAPHICSOBJECT
(LIST (SHAPE ATOM)
(START VECTOR)
(SIZE VECTOR))
PROP ((LEFT (START:X))
(BOTTOM (START:Y))
(RIGHT (LEFT+WIDTH))
(TOP (BOTTOM+HEIGHT))
(WIDTH (SIZE:X))
(HEIGHT (SIZE:Y))
(CENTER (START+SIZE/2))
(AREA (WIDTH*HEIGHT)))
MSG ((DRAW ((APPLY (GET SHAPE 'DRAWFN)
(LIST SELF
(QUOTE PAINT)))))
(ERASE ((APPLY (GET SHAPE 'DRAWFN)
(LIST SELF
(QUOTE ERASE)))))
(MOVE GRAPHICSOBJECTMOVE OPEN T)) )
(MOVINGGRAPHICSOBJECT
(LIST (TRANSPARENT GRAPHICSOBJECT)
(VELOCITY VECTOR))
MSG ((ACCELERATE MGO-ACCELERATE OPEN T)
(STEP ((_ SELF MOVE VELOCITY)))) )
)
(DE VECTORPLUS
(V1!,V2:VECTOR)
(A VECTOR WITH X = V1:X + V2:X !, Y = V1:Y + V2:Y))
(DE VECTORDIFF
(V1!,V2:VECTOR)
(A VECTOR WITH X = V1:X - V2:X !, Y = V1:Y - V2:Y))
(DE VECTORTIMES
(V:VECTOR N:NUMBER)
(A VECTOR WITH X = X*N !, Y = Y*N))
(DE VECTORQUOTIENT
(V:VECTOR N:NUMBER)
(A VECTOR WITH X = X/N !, Y = Y/N))
(DE VECTORMOVE
(V!,DELTA:VECTOR)
(V:X _+
DELTA:X)
(V:Y _+
DELTA:Y))
(DE GRAPHICSOBJECTMOVE
(SELF:GRAPHICSOBJECT DELTA:VECTOR)
(_ SELF ERASE)
(START _+
DELTA)
(_ SELF DRAW))
(DE MGO-ACCELERATE
(SELF: MOVINGGRAPHICSOBJECT ACCELERATION: VECTOR)
VELOCITY _+
ACCELERATION)
(DE TESTFN1 ()
(PROG (MGO N)
(MGO _(A MOVINGGRAPHICSOBJECT WITH SHAPE =(QUOTE
RECTANGLE)
!, SIZE =(A VECTOR WITH X = 4 !, Y = 3)
!, VELOCITY =(A VECTOR WITH X = 3 !, Y = 4)))
(N _ 0)
(WHILE (N_+1)
<100 (_ MGO STEP))
(_(THE START OF MGO)
PRINT)))
(DE TESTFN2
(:GRAPHICSOBJECT)
(LIST SHAPE
START
SIZE
LEFT
BOTTOM
RIGHT
TOP
WIDTH
HEIGHT
CENTER
AREA
))
(DE DRAWRECT
(SELF:GRAPHICSOBJECT DSPOP:ATOM)
(PROG (OLDDS)
(OLDDS _(CURRENTDISPLAYSTREAM DSPS))
(DSPOPERATION DSPOP)
(MOVETO LEFT BOTTOM)
(DRAWTO LEFT TOP)
(DRAWTO RIGHT TOP)
(DRAWTO RIGHT BOTTOM)
(DRAWTO LEFT BOTTOM)
(CURRENTDISPLAYSTREAM OLDDS))))
)
(GLISPOBJECTS
(LISPTREE
(CONS (CAR LISPTREE)
(CDR LISPTREE))
PROP ((LEFTSON ((IF SELF IS ATOMIC THEN NIL ELSE CAR)))
(RIGHTSON ((IF SELF IS ATOMIC THEN NIL ELSE CDR))))
ADJ ((EMPTY (~SELF))) )
(PREORDERSEARCHRECORD
(CONS (NODE LISPTREE)
(PREVIOUSNODES (LISTOF LISPTREE)))
MSG ((NEXT ((PROG (TMP)
(IF TMP_NODE:LEFTSON THEN
(IF NODE:RIGHTSON THEN PREVIOUSNODES+_NODE)
NODE_TMP ELSE TMP-_PREVIOUSNODES NODE_TMP:RIGHTSON))))) )
)
(DE TP
(:LISPTREE)
(PROG (PSR)
(PSR _(A PREORDERSEARCHRECORD WITH NODE =(THE LISPTREE)))
(WHILE NODE (IF NODE IS ATOMIC (PRINT NODE))
(_ PSR NEXT))))
(GLISPOBJECTS
(ARITHMETICOPERATOR
(SELF ATOM)
PROP ((PRECEDENCE OPERATORPRECEDENCEFN RESULT INTEGER)
(PRINTFORM ((GET SELF (QUOTE PRINTFORM))
OR SELF)))
MSG ((PRIN1 ((PRIN1 THE PRINTFORM)))) )
(INTEGERMOD7
(SELF INTEGER)
PROP ((MODULUS (7))
(INVERSE ((IF SELF IS ZERO THEN 0 ELSE (MODULUS - SELF)))))
ADJ ((EVEN ((ZEROP (LOGAND SELF 1))))
(ODD (NOT EVEN)))
ISA ((PRIME PRIMETESTFN))
MSG ((+ IMOD7PLUS OPEN T RESULT INTEGERMOD7)
(_ IMOD7STORE OPEN T RESULT INTEGERMOD7)) )
)
(DE IMOD7STORE
(LHS:INTEGERMOD7 RHS:INTEGER)
(LHS:SELF __(IREMAINDER RHS MODULUS)))
(DE IMOD7PLUS
(X!,Y:INTEGERMOD7)
(IREMAINDER (X:SELF + Y:SELF)
X:MODULUS))
(DE SA
(:ARITHMETICOPERATOR)
(IF PRECEDENCE>5 (_ (THE ARITHMETICOPERATOR)
PRIN1)))
(DE SB
(X:INTEGERMOD7)
(PROG (Y)
(LIST MODULUS INVERSE)
(IF X IS ODD OR X IS EVEN OR X IS A PRIME THEN (Y _ 5)
(X _ 12)
(X _+5))))
(GLISPOBJECTS
(CIRCLE (LIST (START VECTOR) (RADIUS REAL))
PROP ((PI (3.1415926))
(DIAMETER (RADIUS*2))
(CIRCUMFERENCE (PI*DIAMETER))
(AREA (PI*RADIUS^2)) ) ))
% EXAMPLE OF ASSIGNMENT TO COMPUTED PROPERTY
(DE GROWCIRCLE (C:CIRCLE)
(C:AREA_+100)
(PRINT RADIUS) )
(SETQ MYCIRCLE '((0 0) 0.0))
% EXAMPLE OF ELIMINATION OF COMPILE-TIME CONSTANTS
(DE SQUASH ()
(IF 1>3 THEN 'AMAZING
ELSEIF 6<2 THEN 'INCREDIBLE
ELSEIF 2 + 2 = 4 THEN 'OKAY
ELSE 'JEEZ))