(FILECREATED "15-Mar-84 14:56:08" {ICE}<DENBER>LISP>KAL.;16 7128
changes to: (VARS KALCOMS)
(FNS DOKAL ERASES KAL SPOTS KALCONTROL)
previous date: "28-Dec-83 21:56:42" {PHYLUM}<LISPUSERS>KAL.;4)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT KALCOMS)
(RPAQQ KALCOMS ((RECORDS G)
(VARS (KALOLDINCOLOR)
(KALWINDOW)
(KALMENU)
ROTATEWAIT)
(FNS ADVANCE DOKAL ERASES INCOLORQ KAL KALCONTROL ROTATECOLORMAPPROC SPOTS STARTKAL)))
[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 (* MD "15-Mar-84 11:40")
(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))
[COND
((MOUSESTATE MIDDLE)
(KALCONTROL (MENU KALMENU]
(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))
(IF (MOUSESTATE MIDDLE)
THEN (KALCONTROL (MENU KALMENU)))
(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 "15-Mar-84 14:00")
(SETQ PERIOD 10000)
(SETQ PERSISTENCE 5000)
(SETQ WINDOWSIDE 450)
(SETQ SPOTSHIFT 7)
(SETQ KALINCOLOR (INCOLORQ))
(PROMPTPRINT "KAL: Use middle button for control menu.")
(TERPRI (WINDOWPROP PROMPTWINDOW (QUOTE DSP)))
[OR KALMENU (SETQ KALMENU (CREATE MENU
ITEMS ←(QUOTE (("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)
"Kaleidoscope V.1.1"]
(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) (* MD "15-Mar-84 14:52")
(COND
((EQ ACTION (QUOTE STOP))
(DEL.PROCESS (QUOTE ROTATECOLORMAPPROC))
(PROCESS.RETURN T))
[(EQ ACTION (QUOTE PERIOD))
(SETQ PERIOD (CAR (PROCESS.READ PROMPTWINDOW (CONCAT "Set period (currently " (MKSTRING
PERIOD)
") to: "]
((EQ ACTION (QUOTE PERSISTENCE))
(SETQ PERSISTENCE (CAR (PROCESS.READ PROMPTWINDOW (CONCAT "Set persistence (currently "
(MKSTRING PERSISTENCE)
") to: "])
(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])
)
(PUTPROPS KAL COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (685 7049 (ADVANCE 695 . 1414) (DOKAL 1416 . 2313) (ERASES 2315 . 2976) (INCOLORQ 2978
. 3632) (KAL 3634 . 5280) (KALCONTROL 5282 . 5841) (ROTATECOLORMAPPROC 5843 . 6072) (SPOTS 6074 .
6905) (STARTKAL 6907 . 7047)))))
STOP