(FILECREATED "23-Feb-86 16:20:47" {ERIS}<LISPUSERS>LISPCORE>MANDELBROT.;2 11810
changes to: (VARS MANDELBROTCOMS)
(FNS MANDELBROT MANDELBROT.KOUNT MANDELBROT.DORADO.KOUNT)
previous date: "21-Aug-85 13:21:38" {ERIS}<LISPUSERS>LISPCORE>MANDELBROT.;1)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MANDELBROTCOMS)
(RPAQQ MANDELBROTCOMS ((INITVARS (MANDELBROT.WINDOW NIL)
(MANDELBROT.LIMIT 32))
(FNS MANDELBROT MANDELBROT.BUTTONEVENTFN MANDELBROT.KOUNT
MANDELBROT.DORADO.KOUNT MANDELBROT.COLOR GRADCOLORMAP)
(P (COND ((NOT (EQ (MACHINETYPE)
(QUOTE DANDELION)))
(MOVD (QUOTE MANDELBROT.DORADO.KOUNT)
(QUOTE MANDELBROT.KOUNT)))))))
(RPAQ? MANDELBROT.WINDOW NIL)
(RPAQ? MANDELBROT.LIMIT 32)
(DEFINEQ
(MANDELBROT
(LAMBDA (REGION WINDOW) (* kbr:
"23-Feb-86 16:02")
(PROG (MAXX MAXY MAXCOLOR RCORNER ICORNER GAP RC IC KOUNT COLOR)
(COND
((NULL REGION)
(SETQ REGION (create REGION
LEFT ← -1.5
BOTTOM ← -1.0
WIDTH ← 3.0
HEIGHT ← 2.0))))
(COND
((NULL WINDOW)
(COND
((NULL MANDELBROT.WINDOW)
(SETQ MANDELBROT.WINDOW (CREATEW NIL "MANDELBROT"))))
(SETQ WINDOW MANDELBROT.WINDOW)))
(SETQ MAXX (SUB1 (BITMAPWIDTH WINDOW)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT WINDOW)))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ RCORNER (fetch (REGION LEFT) of REGION))
(SETQ ICORNER (fetch (REGION BOTTOM) of REGION))
(SETQ GAP (FMAX (FQUOTIENT (fetch (REGION WIDTH) of REGION)
MAXX)
(FQUOTIENT (fetch (REGION HEIGHT) of REGION)
MAXY)))
(COND
((WINDOWP WINDOW)
(WINDOWPROP WINDOW (QUOTE RCORNER)
RCORNER)
(WINDOWPROP WINDOW (QUOTE ICORNER)
ICORNER)
(WINDOWPROP WINDOW (QUOTE GAP)
GAP)
(WINDOWPROP WINDOW (QUOTE TITLE)
(create REGION
LEFT ← RCORNER
BOTTOM ← ICORNER
WIDTH ←(FTIMES MAXX GAP)
HEIGHT ←(FTIMES MAXY GAP)))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION MANDELBROT.BUTTONEVENTFN))))
(for Y from MAXY to 0 by -1
do (SETQ IC (FPLUS ICORNER (FTIMES Y GAP)))
(for X from 0 to MAXX do (SETQ RC (FPLUS RCORNER (FTIMES X GAP)))
(SETQ KOUNT (MANDELBROT.KOUNT RC IC))
(SETQ COLOR (MANDELBROT.COLOR KOUNT
MAXCOLOR))
(BITMAPBIT WINDOW X Y COLOR))))))
(MANDELBROT.BUTTONEVENTFN
(LAMBDA (WINDOW) (* kbr: "27-Jul-85 15:31")
(PROG (REGION RCORNER ICORNER GAP NEWRCORNER NEWICORNER NEWREGION)
(SETQ REGION (GETREGION))
(SETQ RCORNER (WINDOWPROP WINDOW (QUOTE RCORNER)))
(SETQ ICORNER (WINDOWPROP WINDOW (QUOTE ICORNER)))
(SETQ GAP (WINDOWPROP WINDOW (QUOTE GAP)))
(SETQ NEWRCORNER (FPLUS RCORNER (FTIMES (IDIFFERENCE (fetch (REGION LEFT) of REGION)
(DSPXOFFSET NIL WINDOW))
GAP)))
(SETQ NEWICORNER (FPLUS ICORNER (FTIMES (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
(DSPYOFFSET NIL WINDOW))
GAP)))
(SETQ NEWREGION (create REGION
LEFT ← NEWRCORNER
BOTTOM ← NEWICORNER
WIDTH ← (FTIMES (fetch (REGION WIDTH) of REGION)
GAP)
HEIGHT ← (FTIMES (fetch (REGION HEIGHT) of REGION)
GAP)))
(MANDELBROT NEWREGION WINDOW))))
(MANDELBROT.KOUNT
(LAMBDA (RC IC) (* kbr:
"23-Feb-86 16:13")
(* Calculate KOUNT for
imaginary number
C=RC+ICi. *)
(PROG (LOCALRC LOCALIC RZ IZ RZ2 IZ2 NEWRZ KOUNT)
(DECLARE (TYPE FLOATP RC IC LOCALRC LOCALIC RZ IZ RZ2 IZ2 NEWRZ))
(* Unbox now instead
of in loop. *)
(SETQ LOCALRC RC)
(SETQ LOCALIC IC) (* Z=RZ+IZ.
RZ2=RZ↑2. IZ2=IZ↑2.
Initially, Z=0.
*)
(SETQ RZ 0.0)
(SETQ IZ 0.0)
(SETQ RZ2 0.0)
(SETQ IZ2 0.0)
(* Keep setting Z:=Z↑2+C until absolute value of Z exceeds 2.0 KOUNTing
number of times this takes. If KOUNT would reach infinity, then C is in
the Mandelbrot set. We assume C is in the Mandelbrot set if C reaches
MANDELBROT.LIMIT *)
(SETQ KOUNT (for KOUNT from 1 to (SUB1 MANDELBROT.LIMIT)
do (* AR4125: FMINUS does
not compile as UFNEGATE.
So we use FDIFFERENCE
instead. *)
(SETQ NEWRZ (FPLUS (FDIFFERENCE RZ2 IZ2)
LOCALRC))
(SETQ IZ (FPLUS (FTIMES 2.0 IZ RZ)
LOCALIC))
(SETQ RZ NEWRZ)
(SETQ RZ2 (FTIMES RZ RZ))
(SETQ IZ2 (FTIMES IZ IZ))
(COND
((UFGREATERP2 (FPLUS RZ2 IZ2)
4.0)
(RETURN KOUNT))) finally (RETURN MANDELBROT.LIMIT)))
(RETURN KOUNT))))
(MANDELBROT.DORADO.KOUNT
(LAMBDA (RC IC) (* kbr:
"23-Feb-86 16:15")
(* Calculate KOUNT for
imaginary number
C=RC+ICi. *)
(PROG (LOCALRC LOCALIC RZ IZ RZ2 IZ2 NEWRZ KOUNT) (* Unbox now instead
of in loop. *)
(SETQ LOCALRC RC)
(SETQ LOCALIC IC) (* Z=RZ+IZ.
RZ2=RZ↑2. IZ2=IZ↑2.
Initially, Z=0.
*)
(SETQ RZ 0.0)
(SETQ IZ 0.0)
(SETQ RZ2 0.0)
(SETQ IZ2 0.0)
(* Keep setting Z:=Z↑2+C until absolute value of Z exceeds 2.0 KOUNTing
number of times this takes. If KOUNT would reach infinity, then C is in
the Mandelbrot set. We assume C is in the Mandelbrot set if C reaches
MANDELBROT.LIMIT *)
(SETQ KOUNT (for KOUNT from 1 to (SUB1 MANDELBROT.LIMIT)
do (* AR4125: FMINUS does
not compile as UFNEGATE.
So we use FDIFFERENCE
instead. *)
(SETQ NEWRZ (FPLUS (FDIFFERENCE RZ2 IZ2)
LOCALRC))
(SETQ IZ (FPLUS (FTIMES 2.0 IZ RZ)
LOCALIC))
(SETQ RZ NEWRZ)
(SETQ RZ2 (FTIMES RZ RZ))
(SETQ IZ2 (FTIMES IZ IZ))
(COND
((FGREATERP (FPLUS RZ2 IZ2)
4.0)
(RETURN KOUNT))) finally (RETURN MANDELBROT.LIMIT)))
(RETURN KOUNT))))
(MANDELBROT.COLOR
(LAMBDA (KOUNT MAXCOLOR) (* kbr: "21-Aug-85 13:14")
(* Choose appropriate color for this KOUNT.
*)
(COND
((EQ KOUNT MANDELBROT.LIMIT)
MAXCOLOR)
(T (IMOD KOUNT MAXCOLOR)))))
(GRADCOLORMAP
(LAMBDA (BITSPERPIXEL) (* kbr: "23-Jul-85 19:52")
(PROG (MAXCOLOR COLORMAP M V)
(SETQ MAXCOLOR (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ COLORMAP (COLORMAPCREATE NIL BITSPERPIXEL))
(SETQ M (IQUOTIENT MAXCOLOR 6))
(for I from 0 to M
do (SETQ V (IQUOTIENT (ITIMES 255 I)
(SUB1 M)))
(SETA COLORMAP I (LIST 0 0 V))
(SETA COLORMAP (IDIFFERENCE (ITIMES 2 M)
I)
(LIST 0 0 V))
(SETA COLORMAP (IPLUS (ITIMES 2 M)
I)
(LIST 0 V 0))
(SETA COLORMAP (IDIFFERENCE (ITIMES 4 M)
I)
(LIST 0 V 0))
(SETA COLORMAP (IPLUS (ITIMES 4 M)
I)
(LIST V 0 0))
(SETA COLORMAP (IDIFFERENCE (ITIMES 6 M)
I)
(LIST V 0 0)))
(for I from (ADD1 (ITIMES 6 M)) to MAXCOLOR do (SETA COLORMAP I (ELT COLORMAP
(ITIMES 6 M))))
(RETURN COLORMAP))))
)
(COND ((NOT (EQ (MACHINETYPE)
(QUOTE DANDELION)))
(MOVD (QUOTE MANDELBROT.DORADO.KOUNT)
(QUOTE MANDELBROT.KOUNT))))
(PUTPROPS MANDELBROT COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1033 11572 (MANDELBROT 1043 . 3622) (MANDELBROT.BUTTONEVENTFN 3624 . 4742) (
MANDELBROT.KOUNT 4744 . 7476) (MANDELBROT.DORADO.KOUNT 7478 . 10081) (MANDELBROT.COLOR 10083 . 10427)
(GRADCOLORMAP 10429 . 11570)))))
STOP