(FILECREATED "24-Sep-85 14:40:52" {ICE}<DENBER>LISP>KAL.;18 10294
changes to: (VARS KALCOMS KALICON)
(FNS KAL KALRESHAPE KALNEWREGION)
previous date: "20-Sep-85 17:09:57" {ICE}<DENBER>LISP>KAL.;17)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT KALCOMS)
(RPAQQ KALCOMS ((RECORDS G)
(VARS (KALOLDINCOLOR)
(KALWINDOW)
(KALMENU)
ROTATEWAIT)
(FNS ADVANCE DOKAL ERASES INCOLORQ KAL KALCONTROL KALNEWREGION KALRESHAPE
ROTATECOLORMAPPROC SPOTS STARTKAL)
(BITMAPS KALICON)))
[DECLARE: EVAL@COMPILE
(RECORD G (A B C PERIODCOUNT PERIOD))
]
(RPAQQ KALOLDINCOLOR NIL)
(RPAQQ KALWINDOW NIL)
(RPAQQ KALMENU NIL)
(RPAQQ ROTATEWAIT 3000)
(DEFINEQ
(ADVANCE
[LAMBDA (STATE) (* MD "20-DEC-83 15:22")
(freplace A of STATE with (LOGAND (LOGXOR (IPLUS (ffetch A of STATE)
(ffetch B of STATE))
(ffetch B of STATE))
32767))
(freplace PERIODCOUNT of STATE with (SUB1 (ffetch PERIODCOUNT of STATE)))
(COND
((EQ (ffetch PERIODCOUNT of STATE)
0)
(freplace B of STATE with (LOGAND (LOGXOR (IPLUS (ffetch B of STATE)
(ffetch C of STATE))
(ffetch C of STATE))
32767))
(freplace PERIODCOUNT of STATE with (ffetch PERIOD of STATE])
(DOKAL
[LAMBDA NIL (* edited: "19-Sep-85 17:35")
(freplace PERIODCOUNT of XSTATEB with PERIOD)
(freplace PERIODCOUNT of YSTATEB with PERIOD)
(SETQ XSTATEE (COPY XSTATEB))
(SETQ YSTATEE (COPY YSTATEB))
(from 1 to PERSISTENCE
do (ADVANCE XSTATEB)
(ADVANCE YSTATEB)
(SPOTS (ffetch A of XSTATEB)
(ffetch A of YSTATEB))
(BLOCK))
(do (ADVANCE XSTATEE)
(ADVANCE YSTATEE)
(ERASES (ffetch A of XSTATEE)
(ffetch A of YSTATEE))
(ADVANCE XSTATEB)
(ADVANCE YSTATEB)
(SPOTS (ffetch A of XSTATEB)
(ffetch A of YSTATEB))
(BLOCK])
(ERASES
[LAMBDA (X Y) (* MD "15-Mar-84 11:45")
(PROG ((X0 (LOGAND (LRSH X 7)
32767))
(Y0 (LOGAND (LRSH Y 7)
32767))
X1 Y1)
(COND
((ILESSP X0 Y0)
(SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE)
X0))
(SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE)
Y0))
(BITMAPBIT KALWINDOW X0 Y0 0)
(BITMAPBIT KALWINDOW Y0 X0 0)
(BITMAPBIT KALWINDOW X1 Y0 0)
(BITMAPBIT KALWINDOW Y0 X1 0)
(BITMAPBIT KALWINDOW X1 Y1 0)
(BITMAPBIT KALWINDOW Y1 X1 0)
(BITMAPBIT KALWINDOW X0 Y1 0)
(BITMAPBIT KALWINDOW Y1 X0 0])
(INCOLORQ
[LAMBDA NIL (* MD " 4-JAN-84 15:19")
(SELECTQ (MACHINETYPE)
((QUOTE DOLPHIN)
(COND
((EQ (LRSH (\DEVICE.INPUT 80)
8)
175)
(printout T "In color?" T)
(MENU (create MENU
ITEMS ←(QUOTE ((Yes T)
(No NIL)))
TITLE ←(QUOTE Color?))
5))
(T NIL)))
((QUOTE DANDELION)
NIL)
((QUOTE DORADO)
(printout T "In color?" T)
(MENU (create MENU
ITEMS ←(QUOTE ((Yes T)
(No NIL)))
TITLE ←(QUOTE Color?))
5))
(printout T "Unknown machine type."])
(KAL
[LAMBDA NIL (* MD "24-Sep-85 14:38")
(SETQ PERIOD 10000)
(SETQ PERSISTENCE 5000)
(SETQ WINDOWSIDE 450)
(SETQ SPOTSHIFT 7)
(SETQ KALINCOLOR (INCOLORQ))
(printout PROMPTWINDOW T "KAL: Use middle button for control menu.")
[OR KALMENU (SETQ KALMENU (create MENU
ITEMS ←(QUOTE (("Suspend" (QUOTE SUSPEND)
"Lets you temporarily stop the program.")
("Resume" (QUOTE RESUME)
"Continues the program after a suspend")
("Stop" (QUOTE STOP)
"Ends the program.")
("Period" (QUOTE PERIOD)
"Lets you change the generator period")
("Persistence" (QUOTE PERSISTENCE)
"Lets you change the draw/erase interval"]
(OR (AND KALWINDOW (EQ KALINCOLOR KALOLDINCOLOR))
(PROG1 [SETQ KALWINDOW
(COND
(KALINCOLOR (COLORSCREENBITMAP))
(T (CREATEW (create REGION
LEFT ← 32
BOTTOM ← 32
WIDTH ← 460
HEIGHT ← 470)
(CONCAT "Kaleidoscope v." "1.2"]
(WINDOWPROP KALWINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION KALCONTROL))
(WINDOWPROP KALWINDOW (QUOTE RESHAPEFN)
(FUNCTION KALRESHAPE))
(WINDOWPROP KALWINDOW (QUOTE NEWREGIONFN)
(FUNCTION KALNEWREGION))
(WINDOWPROP KALWINDOW (QUOTE ICON)
KALICON)))
(SETQ KALOLDINCOLOR KALINCOLOR)
(COND
(KALINCOLOR (COLORDISPLAY T)
(COLORBACKGROUND 0))
(T (CLEARW KALWINDOW)))
(SETQ XSTATEB
(create G
A ← 1
B ← -1849
C ← 3
PERIOD ← PERIOD
PERIODCOUNT ← 1))
(SETQ XSTATEE (create G))
(SETQ YSTATEB
(create G
A ← 1
B ← -1809
C ← 3
PERIOD ← PERIOD
PERIODCOUNT ← 1))
(SETQ YSTATEE (create G))
(ADD.PROCESS (QUOTE (DOKAL)))
(AND KALINCOLOR (MENU (create MENU
ITEMS ←(QUOTE ((Yes T)
(No NIL)))
TITLE ← "Rotate colors?")
5)
(ADD.PROCESS (QUOTE (ROTATECOLORMAPPROC])
(KALCONTROL
[LAMBDA (ACTION) (* edited: "19-Sep-85 17:30")
(SELECTQ (MENU KALMENU)
(SUSPEND (SUSPEND.PROCESS (QUOTE DOKAL)))
(RESUME (WAKE.PROCESS (QUOTE DOKAL)))
(STOP (DEL.PROCESS (QUOTE DOKAL)))
[PERIOD (SETQ PERIOD (CAR (PROCESS.READ PROMPTWINDOW (CONCAT "Set period (currently "
(MKSTRING PERIOD)
") to: "]
[PERSISTENCE (SETQ PERSISTENCE (CAR (PROCESS.READ PROMPTWINDOW (CONCAT
"Set persistence (currently "
(MKSTRING
PERSISTENCE)
") to: "]
(PROGN NIL])
(KALNEWREGION
[LAMBDA (Fixedpoint Movingpoint) (* MD "24-Sep-85 13:45")
(COND
((NOT Movingpoint)
Fixedpoint)
(T (PROG (Dx Dy Max Newdx Newdy (X (fetch (POSITION XCOORD) of Fixedpoint))
(Y (fetch (POSITION YCOORD) of Fixedpoint)))
(SETQ Dx (IDIFFERENCE (fetch (POSITION XCOORD) of Movingpoint)
X))
(SETQ Dy (IDIFFERENCE (fetch (POSITION YCOORD) of Movingpoint)
Y))
[SETQ Max (IMAX (COND
((MINUSP Dx)
(IMINUS Dx))
(T Dx))
(COND
((MINUSP Dy)
(IMINUS Dy))
(T Dy]
(SETQ Newdx (COND
((MINUSP Dx)
(IMINUS Max))
(T Max)))
(SETQ Newdy (COND
((MINUSP Dy)
(IMINUS Max))
(T Max)))
(RETURN (create POSITION
XCOORD ←(IPLUS X Newdx)
YCOORD ←(IPLUS Y Newdy])
(KALRESHAPE
[LAMBDA (WINDOW) (* MD "24-Sep-85 13:53")
(SETQ WINDOWSIDE (WINDOWPROP WINDOW (QUOTE WIDTH])
(ROTATECOLORMAPPROC
[LAMBDA NIL (* rrb "25-Dec-83 15:30")
(PROG NIL
LP (ROTATECOLORMAP (SCREENCOLORMAP)
1)
(DISMISS ROTATEWAIT)
(GO LP])
(SPOTS
[LAMBDA (X Y) (* MD "15-Mar-84 11:45")
(PROG ((X0 (LOGAND (LRSH X 7)
32767))
(Y0 (LOGAND (LRSH Y 7)
32767))
X1 Y1 C)
(DECLARE (LOCALVARS X0 Y0 X1 Y1 C))
(COND
((ILESSP X0 Y0)
(SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE)
X0))
(SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE)
Y0))
[SETQ C (IREMAINDER (ffetch A of XSTATEB)
(COND
(KALINCOLOR (MAXIMUMCOLOR))
(T 2]
(BITMAPBIT KALWINDOW X0 Y0 C)
(BITMAPBIT KALWINDOW Y0 X0 C)
(BITMAPBIT KALWINDOW X1 Y0 C)
(BITMAPBIT KALWINDOW Y0 X1 C)
(BITMAPBIT KALWINDOW X1 Y1 C)
(BITMAPBIT KALWINDOW Y1 X1 C)
(BITMAPBIT KALWINDOW X0 Y1 C)
(BITMAPBIT KALWINDOW Y1 X0 C])
(STARTKAL
[LAMBDA NIL (* MD "19-DEC-83 16:21")
(ADD.PROCESS (QUOTE (DOKAL])
)
(RPAQ KALICON (READBITMAP))
(60 61
"OOOOOOOOOOOOOOO@"
"LDLH@D@@OJ@ACBC@"
"H@D@H@@@@@@@@AA@"
"HN@LBDNG@BDDALI@"
"JNALDANGDH@L@DE@"
"LNCHHCNG@@@D@DC@"
"HNG@@GNGB@@DAHA@"
"JNND@NNGF@@DM@E@"
"OOLCALNGBD@NMLO@"
"HOH@CHNG@A@@@@A@"
"HOLDGONG@@@@@@A@"
"NNN@OONG@FB@@BG@"
"LNOAOONG@@NHIHA@"
"HNGKH@NGOL@@B@A@"
"HNCO@DNGOL@BB@A@"
"HNANF@NGOLF@@DI@"
"H@@@H@@@@@AC@BA@"
"HH@DH@A@H@AB@AA@"
"L@@D@@H@A@@B@@C@"
"H@B@@@D@B@@@D@A@"
"JH@I@A@@@H@I@AE@"
"H@DL@@@@@@@CB@A@"
"HD@@@DH@AB@@@BA@"
"H@@@AA@@@HH@@@A@"
"HAL@@H@F@A@@CHA@"
"HDH@@@@@@@@@ABA@"
"H@D@B@@@@@D@B@A@"
"H@@B@@@@@@@D@@A@"
"LDB@@@D@B@@@DBC@"
"LDB@@@D@B@@@DBC@"
"H@@B@@@@@@@D@@A@"
"H@D@B@@@@@D@B@A@"
"HDH@@@@@@@@@ABA@"
"HAL@@H@F@A@@CHA@"
"H@@@AA@@@HH@@@A@"
"HD@@@DH@AB@@@BA@"
"H@DL@@@@@@@CB@A@"
"JH@I@A@@@H@I@AE@"
"H@B@@@D@B@@@D@A@"
"L@@D@@H@A@@B@@C@"
"HH@DH@A@H@AB@AA@"
"HD@LH@@@@@AC@BA@"
"IB@@F@@@@@F@@DI@"
"H@DD@D@@@B@BB@A@"
"H@D@@@@I@@@@B@A@"
"LAIAGB@@@DNHIHC@"
"ND@@DF@@@FB@@BG@"
"H@@D@@@@@@@B@@A@"
"H@D@@H@F@A@@B@A@"
"OEBC@BE@JD@LDJO@"
"JH@D@@F@F@@B@AE@"
"H@DD@@D@B@@BB@A@"
"LD@@H@@@@@A@@BC@"
"JBDHDABFDHBABDE@"
"I@H@BD@@@BD@A@I@"
"HHD@H@@@@@A@BAA@"
"LDLH@D@@@B@ACBC@"
"JBDLA@@F@@HCBDE@"
"H@@HDJ@@@EBA@@A@"
"HLD@@@@@@@@@BCA@"
"OOOOOOOOOOOOOOO@")
(PUTPROPS KAL COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (769 9014 (ADVANCE 779 . 1498) (DOKAL 1500 . 2277) (ERASES 2279 . 2940) (INCOLORQ 2942
. 3596) (KAL 3598 . 5898) (KALCONTROL 5900 . 6610) (KALNEWREGION 6612 . 7632) (KALRESHAPE 7634 . 7806
) (ROTATECOLORMAPPROC 7808 . 8037) (SPOTS 8039 . 8870) (STARTKAL 8872 . 9012)))))
STOP