(FILECREATED " 3-Sep-86 21:36:32" {ERIS}<LISPCORE>LIBRARY>COLORDEMO.;17 59524
changes to: (FNS COLORDEMO CD.RANDCOLORMAP TILEDEMO CD.INIT.COLORMAPS KINETICDEMO CD.QUITP
WELLDEMO TUNNELDEMO CD.KINETIC VINEDEMO RAINING MODARTDEMO STARBURSTDEMO
COLORPEANODEMO BUBBLEDEMO OVERPAINTDEMO CD.INIT CD.INIT.WINDOWS WALKDEMO
CD.WALKBM CD.DEMOKINETIC COLORBACKGROUND COLORMAPOF CD.CIRKIN CD.INRANGE
CD.PUTDROPS CD.DOCOLORDROP CD.RAININGCOLORMAP CD.STARBURST CD.STARSHINE
CD.BUBBLE CD.INIT.MENU CD.NEXTELEMENT CD.RANDELEMENT CD.CHOOSEDEMO
CD.MINESHAFT CD.POINTTEST CD.SQUARETUNNEL CD.CIRCULARTUNNEL CD.ROTATEIT)
(VARS COLORDEMOCOMS)
previous date: " 3-Sep-86 16:25:44" {ERIS}<ROACH>CML>COLORDEMO.;3)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COLORDEMOCOMS)
(RPAQQ COLORDEMOCOMS
((* * COLORDEMO -- Color demonstration programs. By Richard Burton and Kelly Roach. *)
(COMS (* Color Demo. Stuff needed to run through different demos, but not the individual
demos themselves. *)
(VARS (CD.DEMOS (QUOTE (KINETICDEMO VINEDEMO RAINING MODARTDEMO STARBURSTDEMO
COLORPEANODEMO BUBBLEDEMO OVERPAINTDEMO TILEDEMO
TUNNELDEMO POLYGONSDEMO))))
(INITVARS (CD.NEWDEMO NIL)
(CD.STOPDATE 0)
(CD.TIMECELL NIL)
(CD.WINDOW1 NIL)
(CD.WINDOW2 NIL)
(CD.WINDOW3 NIL)
(CD.WINDOW4 NIL)
(CD.MENU NIL)
(CD.COLORMAPS NIL))
(GLOBALVARS CD.DEMOS CD.NEWDEMO CD.STOPDATE)
(FNS COLORDEMO CD.INIT CD.INIT.COLORMAPS CD.INIT.WINDOWS CD.INIT.MENU CD.NEXTELEMENT
CD.RANDELEMENT CD.CHOOSEDEMO CD.QUITP))
(COMS (* Tunnel demo. *)
(FNS CD.MINESHAFT CD.POINTTEST)
(FNS WELLDEMO TUNNELDEMO CD.SQUARETUNNEL CD.CIRCULARTUNNEL))
(COMS (* Junk fns. *)
(FNS CD.ROTATEIT)
(FNS COLORMAPOF COLORMAPCOPY COLORFILL COLORBACKGROUND COLORFILLAREA))
(COMS (* Walk demos)
(FNS WALKDEMO CD.WALKBM CD.RANDCOLORMAP)
(INITVARS CD.MAXWALK CD.MINWALK CD.RANDCOLORPROB (CD.RANDOM.COLORMAP NIL)
(CD.RAINBOW.COLORMAP NIL)
(CD.8BITBMEXP (LIST (HARRAY 60)))
(CD.4BITBMEXP (LIST (HARRAY 60))))
(GLOBALVARS CD.8BITBMEXP CD.4BITBMEXP CD.RANDOM.COLORMAP CD.RAINBOW.COLORMAP))
(COMS (* Kinetic demos *)
(FNS KINETICDEMO CD.DEMOKINETIC CD.CIRKIN)
(VARS (CD.KINETICWAITTIME 150))
(GLOBALVARS CD.KINETICWAITTIME))
(COMS (* Vine demo *)
(FNS VINEDEMO CD.INRANGE))
(COMS (* Raining demo *)
(FNS RAINING CD.PUTDROPS CD.DOCOLORDROP CD.RAININGCOLORMAP))
(COMS (* Modart demo *)
(FNS MODARTDEMO))
(COMS (* Starburst demo *)
(FNS STARBURSTDEMO CD.STARBURST CD.STARSHINE))
(COMS (* Peano demo *)
(FILES (FROM LISPUSERS)
PEANO)
(FNS COLORPEANODEMO))
(COMS (* Bubble demo *)
(FNS BUBBLEDEMO CD.BUBBLE))
(COMS (* Overpaint demo *)
(FNS OVERPAINTDEMO)
(VARS (CD.OVERPAINTBITMAPS)))
(COMS (* Tile demo *)
(INITVARS (CD.TILEBITMAPS NIL))
(FNS TILEDEMO))
(COMS (* Polygons demo *)
(FILES (FROM LISPUSERS)
COLORPOLYGONS)
(FNS POLYGONSDEMO))
(FILES COLOR)
(COMS (* Color font profile *)
(VARS COLORFONTPROFILE)
(P (FONTPROFILE COLORFONTPROFILE)
(* Create color fonts now instead of later. COLOR should already be LOADed. *)
(for FONTCLASS in (LIST DEFAULTFONT BOLDFONT LITTLEFONT BIGFONT)
do
(FONTCREATE FONTCLASS NIL NIL NIL (QUOTE 8DISPLAY)))
(FONTCREATE (QUOTE TIMESROMAND)
36 NIL NIL NIL (QUOTE 8DISPLAY))))))
(* * COLORDEMO -- Color demonstration programs. By Richard Burton and Kelly Roach. *)
(* Color Demo. Stuff needed to run through different demos, but not the individual demos
themselves. *)
(RPAQQ CD.DEMOS (KINETICDEMO VINEDEMO RAINING MODARTDEMO STARBURSTDEMO COLORPEANODEMO BUBBLEDEMO
OVERPAINTDEMO TILEDEMO TUNNELDEMO POLYGONSDEMO))
(RPAQ? CD.NEWDEMO NIL)
(RPAQ? CD.STOPDATE 0)
(RPAQ? CD.TIMECELL NIL)
(RPAQ? CD.WINDOW1 NIL)
(RPAQ? CD.WINDOW2 NIL)
(RPAQ? CD.WINDOW3 NIL)
(RPAQ? CD.WINDOW4 NIL)
(RPAQ? CD.MENU NIL)
(RPAQ? CD.COLORMAPS NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CD.DEMOS CD.NEWDEMO CD.STOPDATE)
)
(DEFINEQ
(COLORDEMO
(LAMBDA NIL (* kbr: " 3-Sep-86 21:19")
(DECLARE (GLOBALVARS CD.DEMOS CD.NEWDEMO CD.STOPDATE CD.COLORMAPS))
(PROG (WINDOWS WINDOW DEMO BITSPERPIXEL BITMAP)
(COND
((NULL CD.MENU)
(CD.INIT)))
(COND
((NULL (WFROMMENU CD.MENU))
(ADDMENU CD.MENU NIL (GETBOXPOSITION (fetch (MENU IMAGEWIDTH) of CD.MENU)
(fetch (MENU IMAGEHEIGHT) of CD.MENU))))
((NOT (OPENWP (WFROMMENU CD.MENU)))
(OPENW (WFROMMENU CD.MENU))))
(SETQ WINDOWS (LIST CD.WINDOW1 CD.WINDOW2 CD.WINDOW3 CD.WINDOW4))
(do (SETQ WINDOW (CD.NEXTELEMENT WINDOW WINDOWS))
(SETQ DEMO (OR CD.NEWDEMO (CD.NEXTELEMENT DEMO CD.DEMOS)))
(SETQ CD.NEWDEMO NIL)
(COND
((EQ DEMO (QUOTE STOP))
(RETURN)))
(SETQ CD.STOPDATE (IPLUS (IDATE)
60))
(* Each DEMO takes a WAIT argument telling how long to run and an optional
WINDOW argument telling which window to use.
WAIT can be defaulted to NIL. *)
(SCREENCOLORMAP (CD.RANDELEMENT CD.COLORMAPS))
(APPLY* DEMO NIL WINDOW)
(COND
((ILESSP (LENGTH CD.TILEBITMAPS)
10)
(SETQ BITSPERPIXEL (BITSPERPIXEL (COLORSCREENBITMAP)))
(SETQ BITMAP (BITMAPCREATE 100 100 BITSPERPIXEL))
(BITBLT WINDOW NIL NIL BITMAP)
(push CD.TILEBITMAPS BITMAP))))
(CLOSEW (WFROMMENU CD.MENU)))))
(CD.INIT
(LAMBDA NIL (* kbr: " 3-Sep-86 19:06")
(PROG NIL
(CD.INIT.COLORMAPS)
(CD.INIT.WINDOWS)
(CD.INIT.MENU))))
(CD.INIT.COLORMAPS
(LAMBDA NIL (* kbr: " 3-Sep-86 20:39")
(PROG (BITSPERPIXEL MAXCOLOR)
(SETQ BITSPERPIXEL (BITSPERPIXEL (COLORSCREENBITMAP)))
(SETQ MAXCOLOR (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ CD.CMYCOLORMAP (SELECTQ BITSPERPIXEL
(4 (CMYCOLORMAP 2 1 1 4))
(8 (CMYCOLORMAP 3 2 2 8))
NIL))
(SETQ CD.RGBCOLORMAP (SELECTQ BITSPERPIXEL
(4 (CMYCOLORMAP 2 1 1 4))
(8 (RGBCOLORMAP 3 2 2 8))
NIL))
(SETQ CD.RANDOM.COLORMAP (COLORMAPCREATE (for COLOR from 0 to MAXCOLOR
collect (create RGB
RED ← (RAND 0 255)
GREEN ← (RAND 0 255)
BLUE ← (RAND 0 255)))
BITSPERPIXEL))
(PROGN (SETQ CD.RAINBOW.COLORMAP (RAINBOWMAP BITSPERPIXEL))
(for COLOR from (RAND 0 15) to MAXCOLOR by 16
do (SETA CD.RAINBOW.COLORMAP COLOR (create RGB
RED ← (RAND 0 255)
GREEN ← (RAND 0 255)
BLUE ← (RAND 0 255)))))
(SETQ CD.COLORMAPS (LIST CD.CMYCOLORMAP CD.RGBCOLORMAP CD.RANDOM.COLORMAP
CD.RAINBOW.COLORMAP))
(RETURN CD.COLORMAPS))))
(CD.INIT.WINDOWS
(LAMBDA NIL (* kbr: " 3-Sep-86 18:34")
(PROG (CSWIDTH CSHEIGHT TAB NORTHWEST NORTHEAST SOUTHWEST SOUTHEAST NORTH EAST SOUTH WEST WIDTH
HEIGHT)
(SETQ CSWIDTH (BITMAPWIDTH (COLORSCREENBITMAP)))
(SETQ CSHEIGHT (BITMAPHEIGHT (COLORSCREENBITMAP)))
(SETQ TAB 20)
(SETQ WIDTH (IQUOTIENT (IDIFFERENCE CSWIDTH (ITIMES 3 TAB))
2))
(SETQ HEIGHT (IQUOTIENT (IDIFFERENCE CSHEIGHT (ITIMES 3 TAB))
2))
(SETQ NORTHWEST (create POSITION
XCOORD ← TAB
YCOORD ← (IPLUS TAB HEIGHT TAB)))
(SETQ NORTHEAST (create POSITION
XCOORD ← (IPLUS TAB WIDTH TAB)
YCOORD ← (IPLUS TAB HEIGHT TAB)))
(SETQ SOUTHWEST (create POSITION
XCOORD ← TAB
YCOORD ← TAB))
(SETQ SOUTHEAST (create POSITION
XCOORD ← (IPLUS TAB WIDTH TAB)
YCOORD ← TAB))
(SETQ NORTH (create POSITION
XCOORD ← (IQUOTIENT (IDIFFERENCE CSWIDTH WIDTH)
2)
YCOORD ← (IDIFFERENCE CSHEIGHT (IPLUS TAB HEIGHT))))
(SETQ EAST (create POSITION
XCOORD ← (IDIFFERENCE CSWIDTH (IPLUS WIDTH TAB))
YCOORD ← (IQUOTIENT (IDIFFERENCE CSHEIGHT HEIGHT)
2)))
(SETQ SOUTH (create POSITION
XCOORD ← (IQUOTIENT (IDIFFERENCE CSWIDTH WIDTH)
2)
YCOORD ← TAB))
(SETQ WEST (create POSITION
XCOORD ← TAB
YCOORD ← (IQUOTIENT (IDIFFERENCE CSHEIGHT HEIGHT)
2)))
(SETQ CD.WINDOW1 (CREATEW (create SCREENREGION
SCREEN ← (COLORSCREEN)
LEFT ← (fetch (POSITION XCOORD) of NORTHWEST)
BOTTOM ← (fetch (POSITION YCOORD) of NORTHWEST)
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
(QUOTE WINDOW1)))
(SETQ CD.WINDOW2 (CREATEW (create SCREENREGION
SCREEN ← (COLORSCREEN)
LEFT ← (fetch (POSITION XCOORD) of NORTHEAST)
BOTTOM ← (fetch (POSITION YCOORD) of NORTHEAST)
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
(QUOTE WINDOW2)))
(SETQ CD.WINDOW3 (CREATEW (create SCREENREGION
SCREEN ← (COLORSCREEN)
LEFT ← (fetch (POSITION XCOORD) of SOUTHWEST)
BOTTOM ← (fetch (POSITION YCOORD) of SOUTHWEST)
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
(QUOTE WINDOW3)))
(SETQ CD.WINDOW4 (CREATEW (create SCREENREGION
SCREEN ← (COLORSCREEN)
LEFT ← (fetch (POSITION XCOORD) of SOUTHEAST)
BOTTOM ← (fetch (POSITION YCOORD) of SOUTHEAST)
WIDTH ← WIDTH
HEIGHT ← HEIGHT)
(QUOTE WINDOW4))))))
(CD.INIT.MENU
(LAMBDA NIL (* kbr: "11-Aug-85 15:05")
(SETQ CD.MENU (create MENU
TITLE ← "Color Demos"
ITEMS ← (APPEND CD.DEMOS (QUOTE (STOP)))
WHENSELECTEDFN ← (QUOTE CD.CHOOSEDEMO)))))
(CD.NEXTELEMENT
(LAMBDA (ELEMENT LIST) (* kbr: "10-Jul-85 18:12")
(* Pick element after ELEMENT in
rotating LIST. *)
(PROG (TAIL ANSWER)
(SETQ TAIL (FMEMB ELEMENT LIST))
(SETQ ANSWER (COND
((CDR TAIL)
(CADR TAIL))
(T (CAR LIST))))
(RETURN ANSWER))))
(CD.RANDELEMENT
(LAMBDA (LIST) (* kbr: "31-Jan-86 16:24")
(CAR (NTH LIST (RAND 1 (LENGTH LIST))))))
(CD.CHOOSEDEMO
(LAMBDA (NEW)
(DECLARE (GLOBALVARS CD.NEWDEMO)) (* bas: " 5-JUN-82 13:07")
(SETQ CD.NEWDEMO NEW)))
(CD.QUITP
(LAMBDA (N) (* kbr: " 3-Sep-86 20:05")
(DECLARE (GLOBALVARS CD.NEWDEMO CD.STOPDATE))
(BLOCK)
(OR CD.TIMECELL (SETQ CD.TIMECELL (CREATECELL \FIXP)))
(OR CD.NEWDEMO (COND
((FIXP N)
(SETQ CD.STOPDATE (IPLUS (ITIMES N 1000)
(CLOCK 0 CD.TIMECELL)))
NIL)
(T (AND CD.STOPDATE (ILESSP CD.STOPDATE (CLOCK 0 CD.TIMECELL))))))))
)
(* Tunnel demo. *)
(DEFINEQ
(CD.MINESHAFT
(LAMBDA (WINDOW N OUTFLG) (* kbr: "20-Jun-91 11:02")
(* Draws a mineshaft on WINDOW.)
(PROG (COLOR WIDTH HEIGHT MAXCOLOR)
(WINDOWPROP WINDOW (QUOTE TITLE)
(QUOTE CD.MINESHAFT))
(COND
((NULL N)
(SETQ N 1)))
(SETQ COLOR 0)
(SETQ WIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
(SETQ HEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(for LEFT from 0 by (ITIMES N 4) as BOTTOM from 0 by (ITIMES N 3)
to (IQUOTIENT HEIGHT 2) do (BLTSHADE COLOR WINDOW LEFT BOTTOM (IDIFFERENCE WIDTH
(ITIMES LEFT 2))
(IDIFFERENCE HEIGHT (ITIMES BOTTOM 2)))
(COND
(OUTFLG (SETQ COLOR (SUB1 COLOR))
(COND
((ILESSP COLOR 0)
(SETQ COLOR MAXCOLOR))))
(T (SETQ COLOR (ADD1 COLOR))
(COND
((IGREATERP COLOR MAXCOLOR)
(SETQ COLOR 0)))))))))
(CD.POINTTEST
(LAMBDA (WINDOW) (* kbr: " 8-Jul-85 09:44")
(* randomly puts points in a region)
(PROG (MAXX MAXY MAXCOLOR)
(SETQ MAXX (SUB1 (WINDOWPROP WINDOW (QUOTE WIDTH))))
(SETQ MAXY (SUB1 (WINDOWPROP WINDOW (QUOTE HEIGHT))))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(for I from 1 to 100 do (BITMAPBIT WINDOW (RAND 0 MAXX)
(RAND 0 MAXY)
(RAND 0 MAXCOLOR))))))
)
(DEFINEQ
(WELLDEMO
(LAMBDA (WAIT) (* kbr: " 3-Sep-86 20:08")
(PROG (STARTCOLOR THRUCOLOR)
(SETQ STARTCOLOR 1)
(SETQ THRUCOLOR 14)
(CD.SQUARETUNNEL CD.WINDOW1 4 STARTCOLOR THRUCOLOR)
(CD.SQUARETUNNEL CD.WINDOW2 4 THRUCOLOR STARTCOLOR)
(CD.CIRCULARTUNNEL CD.WINDOW3 4 THRUCOLOR STARTCOLOR)
(CD.CIRCULARTUNNEL CD.WINDOW4 4 STARTCOLOR THRUCOLOR)
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (ROTATECOLORMAP STARTCOLOR THRUCOLOR)))))
(TUNNELDEMO
(LAMBDA (WAIT) (* kbr: " 3-Sep-86 20:08")
(PROG (STARTCOLOR THRUCOLOR)
(SETQ STARTCOLOR 1)
(SETQ THRUCOLOR 14)
(CD.SQUARETUNNEL CD.WINDOW1 STARTCOLOR THRUCOLOR)
(CD.SQUARETUNNEL CD.WINDOW2 THRUCOLOR STARTCOLOR)
(CD.CIRCULARTUNNEL CD.WINDOW3 THRUCOLOR STARTCOLOR)
(CD.CIRCULARTUNNEL CD.WINDOW4 STARTCOLOR THRUCOLOR)
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (ROTATECOLORMAP STARTCOLOR THRUCOLOR)))))
(CD.SQUARETUNNEL
(LAMBDA (WINDOW STARTCOLOR THRUCOLOR) (* kbr: "24-Feb-86 12:16")
(* Draws a CD.SQUARETUNNEL on the
WINDOW.)
(PROG (LEFT BOTTOM MAXBOTTOM FACTOR LEFTFACTOR BOTTOMFACTOR INCR DELTA COLOR)
(SETQ LEFT 0.0)
(SETQ BOTTOM 0.0)
(SETQ MAXBOTTOM (FQUOTIENT (BITMAPHEIGHT WINDOW)
2.0))
(SETQ FACTOR .2)
(SETQ LEFTFACTOR (FTIMES 4.0 FACTOR))
(SETQ BOTTOMFACTOR (FTIMES 3.0 FACTOR))
(COND
((IGEQ THRUCOLOR STARTCOLOR)
(SETQ DELTA 1))
(T (SETQ DELTA -1)))
(SETQ COLOR STARTCOLOR)
(do (BLTSHADE COLOR WINDOW (FIX LEFT)
(FIX BOTTOM)
(IDIFFERENCE (BITMAPWIDTH WINDOW)
(FTIMES LEFT 2))
(IDIFFERENCE (BITMAPHEIGHT WINDOW)
(FTIMES BOTTOM 2)))
(SETQ INCR (FPLUS 1.0 (FTIMES .1 (FDIFFERENCE MAXBOTTOM BOTTOM))))
(SETQ LEFT (FPLUS LEFT (FTIMES INCR LEFTFACTOR)))
(SETQ BOTTOM (FPLUS BOTTOM (FTIMES INCR BOTTOMFACTOR)))
(COND
((FGREATERP BOTTOM MAXBOTTOM)
(RETURN)))
(COND
((EQ COLOR THRUCOLOR)
(SETQ COLOR STARTCOLOR))
(T (SETQ COLOR (IPLUS COLOR DELTA))))))))
(CD.CIRCULARTUNNEL
(LAMBDA (WINDOW STARTCOLOR THRUCOLOR) (* kbr: "24-Feb-86 12:23")
(PROG (N WIDTH HEIGHT SIZE DELTA COLOR)
(SETQ N 4)
(SETQ WIDTH (BITMAPWIDTH WINDOW))
(SETQ HEIGHT (BITMAPHEIGHT WINDOW))
(SETQ SIZE (IQUOTIENT (SQRT (IPLUS (ITIMES WIDTH WIDTH)
(ITIMES HEIGHT HEIGHT)))
2))
(COND
((IGEQ THRUCOLOR STARTCOLOR)
(SETQ DELTA 1))
(T (SETQ DELTA -1)))
(SETQ COLOR STARTCOLOR)
(for I from 1 to SIZE by N do
(* Have to make the brush a little bit thicker than the amount by which we are
incrementing the radius to avoid cracks appearing between circles.
*)
(DRAWCIRCLE (IQUOTIENT WIDTH 2)
(IQUOTIENT HEIGHT 2)
I
(LIST (QUOTE ROUND)
(IPLUS N 2)
COLOR)
NIL WINDOW)
(COND
((EQ COLOR THRUCOLOR)
(SETQ COLOR STARTCOLOR))
(T (SETQ COLOR (IPLUS COLOR DELTA))))))))
)
(* Junk fns. *)
(DEFINEQ
(CD.ROTATEIT
(LAMBDA (BEGINCOLOR ENDCOLOR WAIT) (* kbr: "23-Feb-86 17:30")
(PROG NIL
(do (ROTATECOLORMAP BEGINCOLOR ENDCOLOR)
(COND
((NULL WAIT))
((SMALLP WAIT)
(DISMISS WAIT))
(T (GETMOUSESTATE)
(DISMISS (LRSH LASTMOUSEX 3))))))))
)
(DEFINEQ
(COLORMAPOF
(LAMBDA (NEWCM BITSPERPIXEL) (* kbr: " 3-Sep-86 16:24")
(COND
((COLORMAPP NEWCM)
(COND
((EQ BITSPERPIXEL (COLORMAPBITS NEWCM))
NEWCM)
(T (COLORMAPCOPY NEWCM BITSPERPIXEL))))
((EQ NEWCM T)
(COLORMAPCREATE NIL BITSPERPIXEL))
(T (COLORMAPCREATE NEWCM BITSPERPIXEL)))))
(COLORMAPCOPY
(LAMBDA (COLORMAP BITSPERPIXEL) (* rrb "21-OCT-82 18:32")
(* makes a copy of a color map If COLORMAP is not a color map, it returns a new
color map with default values. If the colormaps are different sizes, the first
16 entries will be the same and the rest will be black)
(COLORMAPCREATE (AND (COLORMAPP COLORMAP BITSPERPIXEL)
(INTENSITIESFROMCOLORMAP COLORMAP))
BITSPERPIXEL)))
(COLORFILL
(LAMBDA (REGION COLOR# COLORBM OPERATION) (* rrb "21-DEC-82 20:54")
(* fills a region in a color bitmap
with a color. Calls the standard
BITBLT with a texture.)
(PROG (COLORBM)
(SETQ COLORBM (COND
((TYPENAMEP COLORBM (QUOTE BITMAP))
COLORBM)
((NULL COLORBM)
(COLORSCREENBITMAP))
(T (\ILLEGAL.ARG COLORBM))))
(COND
((NULL REGION)
(COLORFILLAREA 0 0 NIL NIL COLOR# COLORBM OPERATION))
(T (COLORFILLAREA (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
COLOR# COLORBM OPERATION))))))
(COLORBACKGROUND
(LAMBDA (TEXTURE) (* kbr: " 3-Sep-86 16:30")
(CHANGEBACKGROUND TEXTURE (COLORSCREEN))))
(COLORFILLAREA
(LAMBDA (LEFT BOTTOM WIDTH HEIGHT COLOR# COLORBM OPERATION)(* kbr: " 8-Jul-85 08:53")
(* fills an area of a color bitmap
with color.)
(COND
((NULL COLORBM)
(SETQ COLORBM (COLORSCREENBITMAP))))
(BITBLT NIL NIL NIL COLORBM LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
OPERATION COLOR#)))
)
(* Walk demos)
(DEFINEQ
(WALKDEMO
(LAMBDA (WINDOW WAIT SPEED WORD1 WORDS) (* kbr: " 3-Sep-86 18:50")
(DECLARE (GLOBALVARS CD.STOPDATE))
(PROG NIL
(CLEARW WINDOW)
(for I in (COND
(CD.OVERPAINTBITMAPS)
(T (SETQ CD.OVERPAINTBITMAPS (LIST (BITMAPFROMSTRING "Interlisp-D")))))
until (CD.QUITP (OR WAIT 10)) do (CD.WALKBM WINDOW I NIL SPEED)
(OR (CD.QUITP 10)
(CD.WALKBM WINDOW NIL NIL SPEED))))))
(CD.WALKBM
(LAMBDA (WINDOW BM FONT SPEED) (* kbr: " 3-Sep-86 18:52")
(PROG (BITSPERPIXEL EBM SCR MAXX MAXY MAXCOLOR)
(SETQ BITSPERPIXEL (BITSPERPIXEL WINDOW))
(OR SPEED (SETQ SPEED 5))
(SETQ MAXCOLOR (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ EBM (CACHEBITMAP BM FONT BITSPERPIXEL))
(SETQ SCR (BITMAPCOPY EBM))
(SETQ MAXX (IDIFFERENCE (WINDOWPROP WINDOW (QUOTE WIDTH))
(BITMAPWIDTH EBM)))
(SETQ MAXY (IDIFFERENCE (WINDOWPROP WINDOW (QUOTE HEIGHT))
(BITMAPHEIGHT EBM)))
(SCREENCOLORMAP (CD.RANDCOLORMAP))
(bind (X ← -1)
(Y ← -1)
(DX ← 0)
(DY ← 0)
(I ← 1)
(J ← 0)
(COLORCOUNTER ← 0) until (CD.QUITP) do (COND
((EQ I MAXCOLOR)
(SETQ I 1))
(T (SETQ I (ADD1 I))))
(add X DX)
(add Y DY)
(COND
((OR (ILEQ J 0)
(ILESSP X 0)
(IGEQ X MAXX)
(ILESSP Y 0)
(IGEQ Y MAXY))
(SETQ X (RAND 0 MAXX))
(SETQ Y (RAND 0 MAXY))
(SETQ DX (RAND (IMINUS SPEED)
SPEED))
(SETQ DY (RAND (IMINUS SPEED)
SPEED))
(SETQ J (RAND CD.MINWALK CD.MAXWALK)))
(T (SETQ J (SUB1 J))))
(OVERPAINT EBM (COLORSCREENBITMAP)
X Y (COLORTEXTUREFROMCOLOR# I)
SCR)
(COND
((IGREATERP (SETQ COLORCOUNTER (ADD1
COLORCOUNTER
))
300)
(SETQ COLORCOUNTER 0)
(SCREENCOLORMAP (CD.RANDCOLORMAP)))
(T (ROTATECOLORMAP 1 MAXCOLOR)))
(DISMISS 15)))))
(CD.RANDCOLORMAP
(LAMBDA NIL (* kbr: " 3-Sep-86 21:16")
(PROG (MAXCOLOR)
(SETQ MAXCOLOR (BITSPERPIXEL (SCREENCOLORMAP)))
(SELECTQ (RAND 1 2)
(1 (COND
((NULL CD.RANDOM.COLORMAP)
(SETQ CD.RANDOM.COLORMAP (COLORMAPCREATE))
(for COLOR from 0 to MAXCOLOR do (SETA (ELT CD.RANDOM.COLORMAP COLOR)
(create RGB
RED ← (RAND 0 255)
GREEN ← (RAND 0 255)
BLUE ← (RAND 0 255))))))
(RETURN CD.RANDOM.COLORMAP))
(2 (COND
((NULL CD.RAINBOW.COLORMAP)
(SETQ CD.RAINBOW.COLORMAP (RAINBOWMAP (COLORMAPBITS (SCREENCOLORMAP))))
(* make every 16th color random)
(for COLOR from (RAND 0 15) to MAXCOLOR by 16
do (SETA (ELT CD.RAINBOW.COLORMAP COLOR)
(create RGB
RED ← (RAND 0 255)
GREEN ← (RAND 0 255)
BLUE ← (RAND 0 255))))
(RETURN CD.RAINBOW.COLORMAP)))
CD.RAINBOW.COLORMAP)
NIL))))
)
(RPAQ? CD.MAXWALK NIL)
(RPAQ? CD.MINWALK NIL)
(RPAQ? CD.RANDCOLORPROB NIL)
(RPAQ? CD.RANDOM.COLORMAP NIL)
(RPAQ? CD.RAINBOW.COLORMAP NIL)
(RPAQ? CD.8BITBMEXP (LIST (HARRAY 60)))
(RPAQ? CD.4BITBMEXP (LIST (HARRAY 60)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CD.8BITBMEXP CD.4BITBMEXP CD.RANDOM.COLORMAP CD.RAINBOW.COLORMAP)
)
(* Kinetic demos *)
(DEFINEQ
(KINETICDEMO
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:12")
(* test example (KINETICDEMO))
(PROG (MAXCOLOR MAXX MAXY X Y)
(WINDOWPROP WINDOW (QUOTE TITLE)
"KINETIC")
(CLEARW WINDOW)
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ MAXX (SUB1 (BITMAPWIDTH WINDOW)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT WINDOW)))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (SETQ X (RAND 0 MAXX))
(SETQ Y (RAND 0 MAXY))
(BLTSHADE (RAND 0 MAXCOLOR)
WINDOW X Y (RAND 2 (IDIFFERENCE MAXX X))
(RAND 2 (IDIFFERENCE MAXY Y))
(SELECTQ (RAND 0 5)
(0 (QUOTE PAINT))
(1 (QUOTE ERASE))
(2 (QUOTE INVERT))
(QUOTE REPLACE)))))))
(CD.DEMOKINETIC
(LAMBDA (WINDOW FIRSTCOLOR LASTCOLOR) (* kbr: " 3-Sep-86 18:40")
(* test example (CD.DEMOKINETIC))
(PROG (BITSPERPIXEL LEFT RIGHT BOTTOM TOP X Y COLOR# ROTATETIME KINROTATETIME HALFWIDTH
HALFHEIGHT)
(SETQ BITSPERPIXEL (BITSPERPIXEL WINDOW))
(OR (COLORNUMBERP FIRSTCOLOR)
(SETQ FIRSTCOLOR 0))
(OR (COLORNUMBERP LASTCOLOR)
(SETQ LASTCOLOR (MAXIMUMCOLOR BITSPERPIXEL)))
(COND
((IGREATERP FIRSTCOLOR LASTCOLOR)
(swap FIRSTCOLOR LASTCOLOR)))
(SETQ LEFT 0)
(SETQ RIGHT (WINDOWPROP WINDOW (QUOTE WIDTH)))
(SETQ BOTTOM 0)
(SETQ TOP (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(SETQ COLOR# FIRSTCOLOR)
(SETQ ROTATETIME (CLOCK 0))
(SETQ KINROTATETIME (CLOCK 0))
(SETQ HALFWIDTH (IQUOTIENT RIGHT 2))
(SETQ HALFHEIGHT (IQUOTIENT TOP 2))
(BLTSHADE FIRSTCOLOR WINDOW)
BLTLP
(COND
((IGREATERP (CLOCKDIFFERENCE ROTATETIME)
CD.LOGOWAITTIME) (* cycle the colors in the logo)
(ROTATECOLORMAP 1 (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ ROTATETIME (CLOCK0 ROTATETIME))))
(COND
((IGREATERP (CLOCKDIFFERENCE KINROTATETIME)
CD.KINWAITTIME) (* cycle the colors in the logo)
(ROTATECOLORMAP FIRSTCOLOR LASTCOLOR)
(SETQ KINROTATETIME (CLOCK0 KINROTATETIME))))
(SETQ X (RAND LEFT RIGHT))
(SETQ Y (RAND BOTTOM TOP))
(BLTSHADE (COND
((EQ COLOR# LASTCOLOR)
(SETQ COLOR# FIRSTCOLOR))
(T (SETQ COLOR# (ADD1 COLOR#))))
WINDOW X Y (RAND 2 (IMIN (IDIFFERENCE RIGHT X)
HALFWIDTH))
(RAND 2 (IMIN (IDIFFERENCE TOP Y)
HALFHEIGHT))
(QUOTE REPLACE))
MOUSELP
(COND
((MOUSESTATE MIDDLE)
(SELECTQ (CAR (ERSETQ (MENU (PROGN (COND
((NOT (TYPENAMEP CD.KINETICMENU (QUOTE MENU)))
(INIT/COLORDEMO/MENUS)))
CD.KINETICMENU))))
(EditColorMap (EDITCOLORMAP))
(IncreaseLogoSpeed
(SETQ CD.LOGOWAITTIME (FIX (FTIMES CD.LOGOWAITTIME .8))))
(DecreaseLogoSpeed
(SETQ CD.LOGOWAITTIME (FIX (FTIMES CD.LOGOWAITTIME 1.3))))
(IncreaseColorFlip
(SETQ CD.KINWAITTIME (FIX (FTIMES CD.KINWAITTIME .8))))
(DecreaseColorFlip
(SETQ CD.KINWAITTIME (FIX (FTIMES CD.KINWAITTIME 1.3))))
(STOP (RETURN))
NIL))
((MOUSESTATE LEFT) (* on left rotate colormap)
(ROTATECOLORMAP FIRSTCOLOR LASTCOLOR)
(COND
((IGREATERP (CLOCKDIFFERENCE ROTATETIME)
CD.LOGOWAITTIME) (* cycle the colors in the logo)
(ROTATECOLORMAP 1 (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ ROTATETIME (CLOCK0 ROTATETIME))))
(COND
((IGREATERP (CLOCKDIFFERENCE KINROTATETIME)
CD.KINWAITTIME) (* cycle the colors in the logo)
(ROTATECOLORMAP FIRSTCOLOR LASTCOLOR)
(SETQ KINROTATETIME (CLOCK0 KINROTATETIME))))
(DISMISS (IMIN CD.KINETICWAITTIME CD.LOGOWAITTIME))
(GO MOUSELP)))
(GO BLTLP))))
(CD.CIRKIN
(LAMBDA (WINDOW) (* kbr: " 8-Jul-85 15:18")
(PROG (MAXX MAXY MAXRAD MAXCOLOR)
(WINDOWPROP WINDOW (QUOTE TITLE)
(QUOTE CD.CIRKIN))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ MAXX (SUB1 (WINDOWPROP WINDOW (QUOTE WIDTH))))
(SETQ MAXY (SUB1 (WINDOWPROP WINDOW (QUOTE HEIGHT))))
(SETQ MAXRAD (IQUOTIENT (IMIN MAXX MAXY)
3))
LP (for I from 1 to 4 do (FILLCIRCLE (RAND 0 MAXX)
(RAND 0 MAXY)
(RAND 0 MAXRAD)
(RAND 0 MAXCOLOR)
WINDOW))
(DSPOPERATION (SELECTQ (RAND 0 3)
(0 (QUOTE REPLACE))
(1 (QUOTE PAINT))
(2 (QUOTE INVERT))
(QUOTE ERASE))
WINDOW)
(GO LP))))
)
(RPAQQ CD.KINETICWAITTIME 150)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CD.KINETICWAITTIME)
)
(* Vine demo *)
(DEFINEQ
(VINEDEMO
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:12")
(PROG (MAXX MAXY X1 Y1 DX DY X2 Y2 COLOR MAXCOLOR WIDTH MAXWIDTH)
(WINDOWPROP WINDOW (QUOTE TITLE)
"VINE")
(CLEARW WINDOW)
(SETQ MAXX (SUB1 (BITMAPWIDTH WINDOW)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT WINDOW)))
(SETQ X1 (IQUOTIENT MAXX 2))
(SETQ Y1 (IQUOTIENT MAXY 2))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ COLOR (IQUOTIENT MAXCOLOR 2))
(SETQ MAXWIDTH (IQUOTIENT (IMIN MAXX MAXY)
4))
(SETQ WIDTH 10)
(SETQ DX 0)
(SETQ DY 0)
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP NIL)
do (* Update velocity. *)
(SETQ DX (CD.INRANGE (IQUOTIENT (IMINUS X1)
2)
(IQUOTIENT (IDIFFERENCE MAXX X1)
2)
(IPLUS DX (RAND (IQUOTIENT (IMINUS X1)
24)
(IQUOTIENT (IDIFFERENCE MAXX X1)
24)))))
(SETQ DY (CD.INRANGE (IQUOTIENT (IMINUS Y1)
2)
(IQUOTIENT (IDIFFERENCE MAXY Y1)
2)
(IPLUS DY (RAND (IQUOTIENT (IMINUS Y1)
24)
(IQUOTIENT (IDIFFERENCE MAXY Y1)
24)))))
(* Knowing current (X1 Y1) and last WIDTH and COLOR, compute the point we draw
to (X2 Y2) and new WIDTH and COLOR. *)
(SETQ X2 (CD.INRANGE 0 MAXX (IPLUS X1 DX)))
(COND
((OR (EQ X2 0)
(EQ X2 MAXX))
(SETQ DX (IMINUS DX))))
(SETQ Y2 (CD.INRANGE 0 MAXY (IPLUS Y1 DY)))
(COND
((OR (EQ Y2 0)
(EQ Y2 MAXY))
(SETQ DY (IMINUS DY))))
(SETQ WIDTH
(CD.INRANGE 1 MAXWIDTH
(IPLUS WIDTH
(ITIMES (CAR (NTH (QUOTE (-1 0 0 0 0 0 0 1))
(RAND 1 8)))
(ADD1 (IQUOTIENT WIDTH 3))))))
(SETQ COLOR
(IMOD (IPLUS COLOR (CAR (NTH (QUOTE (-1 0 0 0 0 0 0 1))
(RAND 1 8))))
MAXCOLOR)) (* Drawline and update position
(X1 Y1) *)
(DRAWLINE X1 Y1 X2 Y2 WIDTH (QUOTE REPLACE)
WINDOW COLOR)
(SETQ X1 X2)
(SETQ Y1 Y2)))))
(CD.INRANGE
(LAMBDA (MIN MAX VALUE) (* kbr: " 4-Mar-85 14:12")
(IMAX MIN (IMIN MAX VALUE))))
)
(* Raining demo *)
(DEFINEQ
(RAINING
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:12")
(PROG (N MAXCOLOR WIDTH HEIGHT COLOR#)
(WINDOWPROP WINDOW (QUOTE TITLE)
"RAINING")
(CLEARW WINDOW)
(SETQ N 3)
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ WIDTH (BITMAPWIDTH WINDOW))
(SETQ HEIGHT (BITMAPHEIGHT WINDOW))
(SETQ COLOR# (RAND 0 MAXCOLOR))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP NIL) do (SETQ COLOR# (CD.DOCOLORDROP (RAND 10 (IDIFFERENCE WIDTH 10))
(RAND 10 (IDIFFERENCE HEIGHT 10))
N
(ITIMES N 3)
8 COLOR# MAXCOLOR WINDOW))))))
(CD.PUTDROPS
(LAMBDA (WINDOW N) (* kbr: " 8-Jul-85 10:53")
(PROG (POS MAXCOLOR)
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
LP (SETQ POS (GETPOSITION WINDOW))
(COND
((LASTMOUSESTATE RIGHT)
(RETURN)))
(CD.DOCOLORDROP (fetch (POSITION XCOORD) of POS)
(fetch (POSITION YCOORD) of POS)
(OR N 3)
(COND
((LASTMOUSESTATE LEFT)
(RAND 8 15))
(T (RAND 10 20)))
6 0 MAXCOLOR WINDOW)
(GO LP))))
(CD.DOCOLORDROP
(LAMBDA (X Y WIDTH RADIUSINCR NCIRCLES COLOR# MAXCOLOR WINDOW)
(* kbr: " 8-Jul-85 10:32")
(* draws a series of concentric
circles.)
(for I from 1 to NCIRCLES do (DRAWCIRCLE X Y (ITIMES I RADIUSINCR)
(LIST (QUOTE ROUND)
WIDTH
(COND
((ILESSP (SETQ COLOR# (ADD1 COLOR#))
MAXCOLOR)
COLOR#)
(T (SETQ COLOR# 0))))
NIL WINDOW))
COLOR#))
(CD.RAININGCOLORMAP
(LAMBDA (BITSPERPIXEL) (* kbr: " 8-Jul-85 11:13")
(COLORMAPCREATE (SELECTQ BITSPERPIXEL
(4 (NCONC (LIST (QUOTE (0 0 0)))
(for I from 100 to 255 by 50 collect (LIST 0 0 I))
(for I from 0 to 11 collect (QUOTE (0 0 0)))))
(8 (NCONC (LIST (QUOTE (0 0 0)))
(for I from 100 to 255 by 50 collect (LIST 0 0 I))
(for I from 0 to 11 collect (QUOTE (0 0 0)))))
(\ILLEGAL.ARG BITSPERPIXEL))
BITSPERPIXEL)))
)
(* Modart demo *)
(DEFINEQ
(MODARTDEMO
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:12")
(PROG (WIDTH HEIGHT MAXCOLOR W H L B)
(WINDOWPROP WINDOW (QUOTE TITLE)
"MODART")
(CLEARW WINDOW)
(SETQ WIDTH (BITMAPWIDTH WINDOW))
(SETQ HEIGHT (BITMAPHEIGHT WINDOW))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (SETQ W (RAND 0 WIDTH))
(SETQ H (RAND 0 HEIGHT))
(SETQ L (RAND 0 (IDIFFERENCE WIDTH W)))
(SETQ B (RAND 0 (IDIFFERENCE HEIGHT H)))
(BITBLT WINDOW 0 0 WINDOW L B W H (SELECTQ (RAND 0 2)
(0 (QUOTE INPUT))
(1 (QUOTE INVERT))
(QUOTE TEXTURE))
(SELECTQ (RAND 0 3)
(0 (QUOTE REPLACE))
(1 (QUOTE PAINT))
(2 (QUOTE INVERT))
(QUOTE ERASE))
(RAND 0 MAXCOLOR))))))
)
(* Starburst demo *)
(DEFINEQ
(STARBURSTDEMO
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:11")
(PROG (MAXX MAXY MAXCOLOR MAXWIDTH MINWIDTH)
(WINDOWPROP WINDOW (QUOTE TITLE)
"STARBURST")
(CLEARW WINDOW)
(SETQ MAXX (SUB1 (BITMAPWIDTH WINDOW)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT WINDOW)))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ MAXWIDTH (IQUOTIENT (IMIN MAXX MAXY)
2))
(SETQ MINWIDTH (IQUOTIENT MAXWIDTH 6))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (CD.STARBURST MAXX MAXY MINWIDTH MAXWIDTH WINDOW)))))
(CD.STARBURST
(LAMBDA (MAXX MAXY MINWIDTH MAXWIDTH WINDOW) (* kbr: "23-Feb-86 17:15")
(PROG (BITSPERPIXEL NCOLORS RADIUS C S CX1 CY1 COLOR1 DELTA1 CX2 CY2 COLOR2 DELTA2 CX3 CY3 COLOR3
DELTA3) (* Do several starbursts at once to
help minimize calls to COS and SIN
which are slow. *)
(SETQ BITSPERPIXEL (BITSPERPIXEL WINDOW))
(SETQ NCOLORS (ADD1 (MAXIMUMCOLOR BITSPERPIXEL)))
(SETQ RADIUS (RAND MINWIDTH MAXWIDTH))
(PROGN (SETQ CX1 (RAND 0 MAXX))
(SETQ CY1 (RAND 0 MAXY))
(SETQ COLOR1 (RAND 0 (SUB1 NCOLORS)))
(SETQ DELTA1 (EXPT 2 (RAND 0 (SUB1 BITSPERPIXEL)))))
(PROGN (SETQ CX2 (RAND 0 MAXX))
(SETQ CY2 (RAND 0 MAXY))
(SETQ COLOR2 (RAND 0 (SUB1 NCOLORS)))
(SETQ DELTA2 (EXPT 2 (RAND 0 (SUB1 BITSPERPIXEL)))))
(PROGN (SETQ CX3 (RAND 0 MAXX))
(SETQ CY3 (RAND 0 MAXY))
(SETQ COLOR3 (RAND 0 (SUB1 NCOLORS)))
(SETQ DELTA3 (EXPT 2 (RAND 0 (SUB1 BITSPERPIXEL)))))
(for THETA from 0 to 44 by 5 do (SETQ C (FTIMES RADIUS (COS THETA)))
(SETQ S (FTIMES RADIUS (SIN THETA)))
(PROGN (CD.STARSHINE CX1 CY1 C S WINDOW COLOR1)
(SETQ COLOR1 (IMOD (IPLUS COLOR1 DELTA1)
NCOLORS)))
(PROGN (CD.STARSHINE CX2 CY2 C S WINDOW COLOR2)
(SETQ COLOR2 (IMOD (IPLUS COLOR2 DELTA2)
NCOLORS)))
(PROGN (CD.STARSHINE CX3 CY3 C S WINDOW COLOR3)
(SETQ COLOR3 (IMOD (IPLUS COLOR3 DELTA3)
NCOLORS)))))))
(CD.STARSHINE
(LAMBDA (CX1 CY1 C S WINDOW COLOR) (* kbr: "23-Feb-86 16:57")
(PROG NIL
(DRAWLINE (IDIFFERENCE CX1 C)
(IDIFFERENCE CY1 S)
(IPLUS CX1 C)
(IPLUS CY1 S)
1
(QUOTE REPLACE)
WINDOW COLOR)
(DRAWLINE (IDIFFERENCE CX1 C)
(IPLUS CY1 S)
(IPLUS CX1 C)
(IDIFFERENCE CY1 S)
1
(QUOTE REPLACE)
WINDOW COLOR)
(DRAWLINE (IDIFFERENCE CX1 S)
(IPLUS CY1 C)
(IPLUS CX1 S)
(IDIFFERENCE CY1 C)
1
(QUOTE REPLACE)
WINDOW COLOR)
(DRAWLINE (IPLUS CX1 S)
(IPLUS CY1 C)
(IDIFFERENCE CX1 S)
(IDIFFERENCE CY1 C)
1
(QUOTE REPLACE)
WINDOW COLOR))))
)
(* Peano demo *)
(FILESLOAD (FROM LISPUSERS)
PEANO)
(DEFINEQ
(COLORPEANODEMO
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:13")
(PROG (BITSPERPIXEL MAXCOLOR MAXSHADE LEVEL SCALE)
(WINDOWPROP WINDOW (QUOTE TITLE)
"PEANO")
(SETQ BITSPERPIXEL (BITSPERPIXEL WINDOW))
(SETQ MAXCOLOR (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ MAXSHADE (MAXIMUMSHADE BITSPERPIXEL))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (DSPCOLOR (RAND 0 MAXCOLOR)
WINDOW)
(DSPTEXTURE (RAND 0 MAXSHADE)
WINDOW)
(DSPBACKCOLOR (RAND 0 MAXCOLOR)
WINDOW)
(SETQ LEVEL (RAND 4 6))
(SETQ SCALE (IQUOTIENT (IMAX (BITMAPWIDTH WINDOW)
(BITMAPHEIGHT WINDOW))
(EXPT 2 LEVEL)))
(SETQ PEANOWINDOW WINDOW)
(PEANODEMO LEVEL SCALE)))))
)
(* Bubble demo *)
(DEFINEQ
(BUBBLEDEMO
(LAMBDA (WAIT WINDOW) (* kbr: " 3-Sep-86 20:13")
(PROG (MAXX MAXY MAXCOLOR MAXWIDTH MINWIDTH HOLLOW)
(WINDOWPROP WINDOW (QUOTE TITLE)
"BUBBLE")
(CLEARW WINDOW)
(SETQ MAXX (SUB1 (BITMAPWIDTH WINDOW)))
(SETQ MAXY (SUB1 (BITMAPHEIGHT WINDOW)))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(SETQ MAXWIDTH (IQUOTIENT (IMIN MAXX MAXY)
8))
(SETQ MINWIDTH (IQUOTIENT MAXWIDTH 6))
(COND
((EQ (RAND 0 1)
1)
(SETQ HOLLOW T)))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP NIL) do (CD.BUBBLE (RAND 0 MAXX)
(RAND 0 MAXY)
(RAND MINWIDTH MAXWIDTH)
HOLLOW WINDOW)))))
(CD.BUBBLE
(LAMBDA (CENTERX CENTERY RADIUS HOLLOW WINDOW) (* kbr: "29-Jul-85 18:09")
(PROG (MAXCOLOR)
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL WINDOW)))
(FILLCIRCLE CENTERX CENTERY RADIUS (RAND 0 MAXCOLOR)
WINDOW)
(COND
(HOLLOW (FILLCIRCLE CENTERX CENTERY (SUB1 RADIUS)
0 WINDOW))))))
)
(* Overpaint demo *)
(DEFINEQ
(OVERPAINTDEMO
(LAMBDA (WAIT) (* kbr: " 3-Sep-86 20:14")
(PROG (BITMAP BITSPERPIXEL MAXCOLOR WIDTH HEIGHT X Y)
(WINDOWPROP CD.WINDOW1 (QUOTE TITLE)
"MASK")
(WINDOWPROP CD.WINDOW2 (QUOTE TITLE)
"BACKGROUND")
(WINDOWPROP CD.WINDOW3 (QUOTE TITLE)
"INPUT")
(WINDOWPROP CD.WINDOW4 (QUOTE TITLE)
"OUTPUT")
(SETQ BITSPERPIXEL (BITSPERPIXEL CD.WINDOW1))
(SETQ MAXCOLOR (MAXIMUMCOLOR BITSPERPIXEL))
(SETQ WIDTH (BITMAPWIDTH CD.WINDOW1))
(SETQ HEIGHT (BITMAPHEIGHT CD.WINDOW1))
(COND
((NULL CD.OVERPAINTBITMAPS)
(SETQ CD.OVERPAINTBITMAPS (for STRING in (QUOTE ("Interlisp-D" "Xerox" "Color"))
collect (BITMAPFROMSTRING STRING (FONTCREATE (QUOTE
TIMESROMAND
)
36)
BITSPERPIXEL)))))
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (BITBLT CD.WINDOW2 NIL NIL CD.WINDOW4)
(for I from 1 to (RAND 6 20)
do (SETQ BITMAP (CD.NEXTELEMENT BITMAP CD.OVERPAINTBITMAPS))
(SETQ X (RAND 0 (IDIFFERENCE WIDTH (BITMAPWIDTH BITMAP))))
(SETQ Y (RAND 0 (IDIFFERENCE HEIGHT (BITMAPHEIGHT BITMAP))))
(CLEARW CD.WINDOW1)
(BITBLT BITMAP NIL NIL CD.WINDOW1 X Y)
(BLTSHADE (RAND 0 MAXCOLOR)
CD.WINDOW3)
(BITBLT CD.WINDOW1 NIL NIL CD.WINDOW3 NIL NIL NIL NIL
(QUOTE INVERT)
(QUOTE ERASE))
(BITBLT CD.WINDOW1 NIL NIL CD.WINDOW4 NIL NIL NIL NIL
(QUOTE INPUT)
(QUOTE ERASE))
(BITBLT CD.WINDOW3 NIL NIL CD.WINDOW4 NIL NIL NIL NIL
(QUOTE INPUT)
(QUOTE PAINT)))))))
)
(RPAQQ CD.OVERPAINTBITMAPS NIL)
(* Tile demo *)
(RPAQ? CD.TILEBITMAPS NIL)
(DEFINEQ
(TILEDEMO
(LAMBDA (WAIT) (* kbr: " 3-Sep-86 21:19")
(PROG (WINDOWS WINDOW BITSPERPIXEL BITMAP)
(SETQ WINDOWS (LIST CD.WINDOW1 CD.WINDOW2 CD.WINDOW3 CD.WINDOW4))
(COND
((ILESSP (LENGTH CD.TILEBITMAPS)
4)
(SETQ BITSPERPIXEL (BITSPERPIXEL (COLORSCREENBITMAP)))
(for WINDOW in WINDOWS do (SETQ BITMAP (BITMAPCREATE 100 100 BITSPERPIXEL))
(BITBLT WINDOW NIL NIL BITMAP)
(push CD.TILEBITMAPS BITMAP))))
(CHANGEBACKGROUND (CD.RANDELEMENT CD.TILEBITMAPS)
(COLORSCREEN))
(WINDOWPROP CD.WINDOW1 (QUOTE TITLE)
"WINDOW1")
(WINDOWPROP CD.WINDOW2 (QUOTE TITLE)
"WINDOW2")
(WINDOWPROP CD.WINDOW3 (QUOTE TITLE)
"WINDOW3")
(WINDOWPROP CD.WINDOW4 (QUOTE TITLE)
"WINDOW4")
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP) do (SETQ WINDOW (CD.NEXTELEMENT WINDOW WINDOWS))
(SETQ BITMAP (CD.RANDELEMENT CD.TILEBITMAPS))
(TILE BITMAP WINDOW)))))
)
(* Polygons demo *)
(FILESLOAD (FROM LISPUSERS)
COLORPOLYGONS)
(DEFINEQ
(POLYGONSDEMO
(LAMBDA (WAIT) (* kbr: " 6-Jun-86 00:27")
(PROG NIL
(CD.QUITP (OR WAIT 120))
(until (CD.QUITP NIL) do (COLORPOLYGON CD.WINDOW1)
(COLORPOLYGON CD.WINDOW2)
(COLORPOLYGON CD.WINDOW3)
(COLORPOLYGON CD.WINDOW4)
(COLORPOLYGONS.ROTATECOLORMAP)))))
)
(FILESLOAD COLOR)
(* Color font profile *)
(RPAQQ COLORFONTPROFILE ((DEFAULTFONT 1 (GACHA 10)
(GACHA 8)
(TERMINAL 8)
(4DISPLAY (GACHA 10 MRR-WHITE-RED))
(8DISPLAY (GACHA 10 MRR-WHITE-RED))
(24DISPLAY (GACHA 10 MRR-WHITE-RED)))
(BOLDFONT 2 (HELVETICA 10 BRR)
(HELVETICA 8 BRR)
(MODERN 8 BRR)
(4DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))
(8DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA))
(24DISPLAY (HELVETICA 10 BRR-WHITE-MAGENTA)))
(LITTLEFONT 3 (HELVETICA 8)
(HELVETICA 6 MIR)
(MODERN 8 MIR)
(4DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))
(8DISPLAY (HELVETICA 8 MRR-WHITE-GREEN))
(24DISPLAY (HELVETICA 8 MRR-WHITE-GREEN)))
(BIGFONT 4 (HELVETICA 12 BRR)
(HELVETICA 10 BRR)
(MODERN 10 BRR)
(4DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))
(8DISPLAY (HELVETICA 12 BRR-WHITE-BLUE))
(24DISPLAY (HELVETICA 12 BRR-WHITE-BLUE)))
(USERFONT BOLDFONT)
(COMMENTFONT LITTLEFONT)
(LAMBDAFONT BIGFONT)
(SYSTEMFONT)
(CLISPFONT BOLDFONT)
(CHANGEFONT)
(PRETTYCOMFONT BOLDFONT)
(FONT1 DEFAULTFONT)
(FONT2 BOLDFONT)
(FONT3 LITTLEFONT)
(FONT4 BIGFONT)
(FONT5 5 (HELVETICA 10 BIR)
(HELVETICA 8 BIR)
(MODERN 8 BIR))
(FONT6 6 (HELVETICA 10 BRR)
(HELVETICA 8 BRR)
(MODERN 8 BRR))
(FONT7 7 (GACHA 12)
(GACHA 12)
(TERMINAL 12))))
(FONTPROFILE COLORFONTPROFILE)
(* Create color fonts now instead of later. COLOR should already be LOADed. *)
(for FONTCLASS in (LIST DEFAULTFONT BOLDFONT LITTLEFONT BIGFONT)
do
(FONTCREATE FONTCLASS NIL NIL NIL (QUOTE 8DISPLAY)))
(FONTCREATE (QUOTE TIMESROMAND)
36 NIL NIL NIL (QUOTE 8DISPLAY))
(PUTPROPS COLORDEMO COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5128 14880 (COLORDEMO 5138 . 6924) (CD.INIT 6926 . 7146) (CD.INIT.COLORMAPS 7148 . 9003
) (CD.INIT.WINDOWS 9005 . 13127) (CD.INIT.MENU 13129 . 13458) (CD.NEXTELEMENT 13460 . 14003) (
CD.RANDELEMENT 14005 . 14166) (CD.CHOOSEDEMO 14168 . 14330) (CD.QUITP 14332 . 14878)) (14908 17153 (
CD.MINESHAFT 14918 . 16512) (CD.POINTTEST 16514 . 17151)) (17154 21488 (WELLDEMO 17164 . 17758) (
TUNNELDEMO 17760 . 18348) (CD.SQUARETUNNEL 18350 . 19917) (CD.CIRCULARTUNNEL 19919 . 21486)) (21513
21915 (CD.ROTATEIT 21523 . 21913)) (21916 24640 (COLORMAPOF 21926 . 22326) (COLORMAPCOPY 22328 . 22858
) (COLORFILL 22860 . 23996) (COLORBACKGROUND 23998 . 24161) (COLORFILLAREA 24163 . 24638)) (24664
30332 (WALKDEMO 24674 . 25293) (CD.WALKBM 25295 . 28716) (CD.RANDCOLORMAP 28718 . 30330)) (30729 36945
(KINETICDEMO 30739 . 31911) (CD.DEMOKINETIC 31913 . 35878) (CD.CIRKIN 35880 . 36943)) (37075 40482 (
VINEDEMO 37085 . 40333) (CD.INRANGE 40335 . 40480)) (40510 43827 (RAINING 40520 . 41436) (CD.PUTDROPS
41438 . 42110) (CD.DOCOLORDROP 42112 . 43064) (CD.RAININGCOLORMAP 43066 . 43825)) (43854 45278 (
MODARTDEMO 43864 . 45276)) (45308 49308 (STARBURSTDEMO 45318 . 46022) (CD.STARBURST 46024 . 48286) (
CD.STARSHINE 48288 . 49306)) (49376 50561 (COLORPEANODEMO 49386 . 50559)) (50588 51968 (BUBBLEDEMO
50598 . 51560) (CD.BUBBLE 51562 . 51966)) (51998 54683 (OVERPAINTDEMO 52008 . 54681)) (54777 56090 (
TILEDEMO 54787 . 56088)) (56169 56673 (POLYGONSDEMO 56179 . 56671)))))
STOP