(FILECREATED " 3-Sep-86 22:07:11" {ERIS}<LISPCORE>LIBRARY>COLORPOLYGONS.;4 27440
changes to: (FNS MOTIONIT COLORPOLYGONS.ROTATECOLORMAP)
previous date: " 6-Jun-86 00:35:47" {ERIS}<LISPCORE>LIBRARY>COLORPOLYGONS.;2)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COLORPOLYGONSCOMS)
(RPAQQ COLORPOLYGONSCOMS ((FNS COLORPOLYGONS COLORPOLYGON COLORPOLYGONS.ROTATECOLORMAP)
(FNS BLACKHOLE BLACKHOLE1 COLORCONNECTPOLYS COLORDRAWPOLY1
DRAWCOLORPOLYSTEPS LENSE LINETEST MAPIT MAPIT2 MOTIONIT ONECOLORPOLY
RANDOMPT)
(INITVARS (MOTIONMAP)
(ONEMAP)
(PRETTYMAP))
(VARS MOTIONMAPCOLORS ONEMAPCOLORS PRETTYCOLORS)))
(DEFINEQ
(COLORPOLYGONS
(LAMBDA (DS) (* kbr: " 6-Jun-86 00:16")
(PROG (BITSPERPIXEL NPTS)
(COND
((NULL DS)
(SETQ DS (DSPCREATE (COLORSCREENBITMAP)))
(DSPCLIPPINGREGION (LIST 0 0 (BITMAPWIDTH (COLORSCREENBITMAP))
(BITMAPHEIGHT (COLORSCREENBITMAP)))
DS)))
LP (COLORPOLYGON DS)
(COLORPOLYGONS.ROTATECOLORMAP)
(GO LP))))
(COLORPOLYGON
(LAMBDA (DS) (* kbr: " 6-Jun-86 00:10")
(PROG (NPTS)
(COLORCONNECTPOLYS (for I from 1 to (SETQ NPTS (RAND 3 8)) collect (RANDOMPT DS))
(for I from 1 to NPTS collect (RANDOMPT DS))
(ITIMES 15 (RAND 3 4))
T 1 1 15 8 DS))))
(COLORPOLYGONS.ROTATECOLORMAP
(LAMBDA NIL (* kbr: " 3-Sep-86 21:31")
(PROG (BITSPERPIXEL)
(SETQ BITSPERPIXEL (BITSPERPIXEL (COLORSCREENBITMAP)))
(COND
((EQ BITSPERPIXEL 4)
(OR MOTIONMAP (SETQ MOTIONMAP (COLORMAPCREATE MOTIONMAPCOLORS BITSPERPIXEL)))
(OR PRETTYMAP (SETQ PRETTYMAP (COLORMAPCREATE PRETTYCOLORS BITSPERPIXEL)))
(SETQ WAITTIME 70))
(T (OR MOTIONMAP
(SETQ MOTIONMAP
(COLORMAPCREATE (for I from 1 to 8
join (NCONC (for J from 0 to 255 by 8
collect (LIST 0 0 J))
(for J from 1 to 8
collect (QUOTE (128 128 128)))))
BITSPERPIXEL)))
(OR PRETTYMAP (SETQ PRETTYMAP (RAINBOWMAP 8)))
(SETQ WAITTIME 20)))
(SCREENCOLORMAP MOTIONMAP)
(CD.QUITP 40)
(until (CD.QUITP) do (ROTATECOLORMAP 1))
(SCREENCOLORMAP PRETTYMAP)
(CD.QUITP 40)
(until (CD.QUITP) do (ROTATECOLORMAP 1)
(DISMISS WAITTIME)))))
)
(DEFINEQ
(BLACKHOLE
(LAMBDA (PTLST DS DENSITY PERCENT) (* kbr: " 5-Jun-86 23:45")
(* maps a list of points onto itself
repeatedly until closure)
(PROG NIL
(DSPFILL NIL NIL 0 DS)
(BLACKHOLE1 PTLST DS (OR DENSITY 3)
(OR PERCENT 30)))))
(BLACKHOLE1
(LAMBDA (PTLST DS DENSITY PERCENT) (* kbr: " 5-Jun-86 23:46")
(* maps a list of points onto itself
repeatedly until closure)
(PROG (CENTERX CENTERY X Y OTHERPTS)
(SETQ CENTERX (IQUOTIENT (for PT in PTLST sum (fetch (POSITION XCOORD) of PT))
(LENGTH PTLST)))
(SETQ CENTERY (IQUOTIENT (for PT in PTLST sum (fetch (POSITION YCOORD) of PT))
(LENGTH PTLST))) (* make another polygon that is 80%%
of the way to the edge.)
(SETQ OTHERPTS (for PT in PTLST
collect (create POSITION
XCOORD ← (COND
((IGREATERP (SETQ X (fetch (POSITION XCOORD)
of PT))
CENTERX)
(IPLUS CENTERX (IQUOTIENT (ITIMES
PERCENT
(IDIFFERENCE
X CENTERX))
100)))
(T (IDIFFERENCE CENTERX
(IQUOTIENT (ITIMES PERCENT
(IDIFFERENCE
CENTERX X))
100))))
YCOORD ← (COND
((IGREATERP (SETQ Y (fetch (POSITION YCOORD)
of PT))
CENTERY)
(IPLUS CENTERY (IQUOTIENT (ITIMES
PERCENT
(IDIFFERENCE
Y CENTERY))
100)))
(T (IDIFFERENCE CENTERY
(IQUOTIENT (ITIMES PERCENT
(IDIFFERENCE
CENTERY Y))
100)))))))
(* make sure the number of steps is
integral to number of colors.)
(* draw from the outer one into the
inner one, shifted by one)
(DRAWCOLORPOLYSTEPS PTLST (SETQ OTHERPTS (APPEND (CDR OTHERPTS)
(LIST (CAR OTHERPTS))))
(ITIMES (OR DENSITY 3)
15)
T 1 (MAXIMUMCOLOR)
DS)
(COND
((AND (for PT in OTHERPTS thereis (IGREATERP (ABS (IDIFFERENCE CENTERX
(fetch (POSITION XCOORD)
of PT)))
20))
(for PT in OTHERPTS thereis (IGREATERP (ABS (IDIFFERENCE CENTERY
(fetch (POSITION YCOORD)
of PT)))
20)))
(BLACKHOLE1 OTHERPTS DS (ADD1 DENSITY)
PERCENT))))))
(COLORCONNECTPOLYS
(LAMBDA (FROMS TOS NSTEPS CONNECTEDFLG INCOLOR? FROMCOLOR TOCOLOR TWEENCOLOR DS)
(* kbr: " 6-Jun-86 00:03")
(* draws the source and destination
polygons and shows the track taken by
the sides; then leaves the trace of
the polygon in tranformation)
(SETQ LASTPOLYGONFROMS FROMS)
(SETQ LASTPOLYGONTOS TOS)
(ERSETQ (PROG NIL
(DSPFILL NIL NIL NIL DS)
(COLORDRAWPOLY1 FROMS 1 CONNECTEDFLG (OR FROMCOLOR INCOLOR?)
DS)
(COLORDRAWPOLY1 TOS 1 CONNECTEDFLG (OR TOCOLOR INCOLOR?)
DS)
(SETQ DIFFS (for FPT in FROMS as TPT in TOS
do (DRAWBETWEEN FPT TPT 1 NIL DS (OR TWEENCOLOR 15))))
(DISMISS 1500)
(DSPFILL NIL NIL NIL DS)
(DRAWCOLORPOLYSTEPS FROMS TOS NSTEPS CONNECTEDFLG INCOLOR? TOCOLOR DS)))))
(COLORDRAWPOLY1
(LAMBDA (PTLIST WIDTH CONNECT? COLOR DS) (* rrb "11-OCT-82 11:43")
(* draws a closed polygon of the
points given)
(COND
(PTLIST (for PTA in PTLIST as PTB in (CDR PTLIST)
do (DRAWBETWEEN PTA PTB WIDTH (DSPOPERATION NIL DS)
DS
(COND
((LISTP COLOR) (* COLOR can be a list of colors for
each side.)
(PROG1 (CAR COLOR)
(SETQ COLOR (COND
((CDR COLOR))
(T (CAR COLOR))))))
(T COLOR)))
finally (AND CONNECT? (DRAWBETWEEN (CAR (LAST PTLIST))
(CAR PTLIST)
WIDTH
(DSPOPERATION NIL DS)
DS
(COND
((LISTP COLOR)
(PROG1 (CAR COLOR)
(SETQ COLOR (COND
((CDR COLOR))
(T (CAR COLOR))))))
(T COLOR)))
DS))))
(BLOCK)))
(DRAWCOLORPOLYSTEPS
(LAMBDA (FROMS TOS NSTEPS CONNECTEDFLG FROMCOLOR MAXCOLOR DS)
(* rrb "15-OCT-82 14:47")
(PROG (DIFFS XFROMS)
(SETQ XFROMS (COPY FROMS))
(SETQ DIFFS (for FPT in XFROMS as TPT in TOS collect (create POSITION
XCOORD ←
(IDIFFERENCE
(fetch (POSITION XCOORD)
of TPT)
(fetch (POSITION XCOORD)
of FPT))
YCOORD ←
(IDIFFERENCE
(fetch (POSITION YCOORD)
of TPT)
(fetch (POSITION YCOORD)
of FPT)))))
(for I from 1 to NSTEPS
do (COLORDRAWPOLY1 XFROMS 1 CONNECTEDFLG (COND
((FIXP FROMCOLOR)
(COND
((IGREATERP FROMCOLOR MAXCOLOR)
(SETQ FROMCOLOR 1)))
(PROG1 FROMCOLOR (SETQ FROMCOLOR
(ADD1 FROMCOLOR))))
(T FROMCOLOR))
DS)
(for PT in XFROMS as DIF in DIFFS as FROMPT in FROMS
do (replace (POSITION XCOORD) of PT
with (IPLUS (fetch (POSITION XCOORD) of FROMPT)
(IQUOTIENT (ITIMES (fetch (POSITION XCOORD) of DIF)
I)
NSTEPS)))
(replace (POSITION YCOORD) of PT
with (IPLUS (fetch (POSITION YCOORD) of FROMPT)
(IQUOTIENT (ITIMES (fetch (POSITION YCOORD) of DIF)
I)
NSTEPS)))) finally (COLORDRAWPOLY1
XFROMS 1 CONNECTEDFLG
(COND
((FIXP FROMCOLOR)
(COND
((IGREATERP FROMCOLOR MAXCOLOR
)
(SETQ FROMCOLOR 1)))
(PROG1 FROMCOLOR (SETQ FROMCOLOR
(ADD1 FROMCOLOR
))))
(T FROMCOLOR))
DS))
(RETURN FROMCOLOR))))
(LENSE
(LAMBDA (PTLST DS DENSITY PERCENT OUTTOOFLG) (* kbr: " 5-Jun-86 23:52")
(* maps a list of points onto itself
repeatedly until closure)
(PROG (CENTERX CENTERY X Y OTHERPTS MAXCOLOR ENDCOLOR)
(SETQ CENTERX (IQUOTIENT (for PT in PTLST sum (fetch (POSITION XCOORD) of PT))
(LENGTH PTLST)))
(SETQ CENTERY (IQUOTIENT (for PT in PTLST sum (fetch (POSITION YCOORD) of PT))
(LENGTH PTLST)))
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL (COLORSCREENBITMAP))))
(DSPFILL NIL NIL NIL DS) (* make another polygon that is 80%%
of the way to the edge.)
(SETQ OTHERPTS (for PT in PTLST
collect (create POSITION
XCOORD ← (COND
((IGREATERP (SETQ X (fetch (POSITION XCOORD)
of PT))
CENTERX)
(IPLUS CENTERX (IQUOTIENT (ITIMES
PERCENT
(IDIFFERENCE
X CENTERX))
100)))
(T (IDIFFERENCE CENTERX
(IQUOTIENT (ITIMES PERCENT
(IDIFFERENCE
CENTERX X))
100))))
YCOORD ← (COND
((IGREATERP (SETQ Y (fetch (POSITION YCOORD)
of PT))
CENTERY)
(IPLUS CENTERY (IQUOTIENT (ITIMES
PERCENT
(IDIFFERENCE
Y CENTERY))
100)))
(T (IDIFFERENCE CENTERY
(IQUOTIENT (ITIMES PERCENT
(IDIFFERENCE
CENTERY Y))
100)))))))
(* make sure the number of steps is
integral to number of colors.)
(* draw from the outer one into the
inner one, shifted by one)
(SETQ ENDCOLOR (DRAWCOLORPOLYSTEPS PTLST (CONS (CAR (LAST OTHERPTS))
(BUTLAST OTHERPTS))
(ITIMES (OR DENSITY 3)
15)
T 1 MAXCOLOR DS)) (* draw from the inner polygon to the
outer one shifted by two sides)
(AND OUTTOOFLG (DRAWCOLORPOLYSTEPS (APPEND (CDR OTHERPTS)
(LIST (CAR OTHERPTS)))
PTLST
(ITIMES (OR DENSITY 3)
15)
T ENDCOLOR MAXCOLOR DS)))))
(LINETEST
(LAMBDA (DS)
(for Y from 100 to 400 by 300 do (for I from 100 to 400 by 20
do (DRAWLINE 250 250 I Y 1 NIL DS (RAND 1 15))))
(for X from 100 to 400 by 300 do (for I from 100 to 400 by 20
do (DRAWLINE 250 250 X I 1 NIL DS (RAND 1 15))))))
(MAPIT
(LAMBDA (PTLST DS DENSITY) (* kbr: " 5-Jun-86 23:52")
(* maps a list of points onto itself)
(DSPFILL NIL NIL NIL DS)
(DRAWCOLORPOLYSTEPS PTLST (SETQ PTLST (APPEND (CDR PTLST)
(CONS (CAR PTLST))))
(ITIMES (OR DENSITY 3)
15)
T 1 (MAXIMUMCOLOR (BITSPERPIXEL (COLORSCREENBITMAP)))
DS)))
(MAPIT2
(LAMBDA (N DS DENSITY) (* kbr: " 5-Jun-86 23:53")
(* create a random list of N points
and maps it onto N others.)
(PROG (ORGPOINTS NOWCOLOR MAXCOLOR)
(SETQ ORGPOINTS (for I from 1 to N collect (RANDOMPT DS)))
(SETQ NOWCOLOR 1)
(SETQ MAXCOLOR (MAXIMUMCOLOR (BITSPERPIXEL (COLORSCREENBITMAP))))
(DSPFILL NIL NIL NIL DS)
(SETQ STARTPTS ORGPOINTS) (* make sure the number of steps is
integral to number of colors.)
(for COUNTER from 1 to N
do (* make the first pt of the new set
the same as the last pt of the
previous one.)
(SETQ NEWPTS (COND
((EQ COUNTER N) (* for the past group, return to the
starting points.)
ORGPOINTS)
(T (CONS (CAR (LAST STARTPTS))
(COND
((EQ COUNTER (SUB1 N))
(* for next to last group make the
last point the same as the start.)
(NCONC1 (for I from 1 to (IDIFFERENCE N 2)
collect (RANDOMPT DS))
(CAR ORGPOINTS)))
(T (for I from 1 to (SUB1 N) collect (RANDOMPT DS))))))))
(SETQ NOWCOLOR (DRAWCOLORPOLYSTEPS STARTPTS NEWPTS (ITIMES (OR DENSITY 3)
15)
NIL NOWCOLOR MAXCOLOR DS))
(SETQ STARTPTS NEWPTS)))))
(MOTIONIT
(LAMBDA (WINDOW) (* kbr: " 3-Sep-86 22:06")
(PROG NIL
LP (SCREENCOLORMAP ONEMAP)
(ONECOLORPOLY (RAND 3 4)
45 T 1 1 15 8 WINDOW)
(DISMISS 2000)
(SCREENCOLORMAP MOTIONMAP)
(CD.QUITP 10)
(until (CD.QUITP) do (ROTATECOLORMAP 1)
(DISMISS 75))
(SCREENCOLORMAP PRETTYMAP)
(CD.QUITP 20)
(until (CD.QUITP) do (ROTATECOLORMAP 1)
(DISMISS 75))
(SCREENCOLORMAP ONEMAP)
(DISMISS 2000)
(GO LP))))
(ONECOLORPOLY
(LAMBDA (NPOINTS NSTEPS CONNECTED? INCOLOR? FROMCOLOR TOCOLOR TWEENCOLOR DS)
(* rrb "11-OCT-82 11:41")
(* draws a polygon figure on the display stream DS.
INCOLOR? can be NIL for black and white case, a color number for the increment
each polygons case, or a list of color numbers to be used for each edge of the
polygons.)
(COLORCONNECTPOLYS (for I from 1 to NPOINTS collect (RANDOMPT DS))
(for I from 1 to NPOINTS collect (RANDOMPT DS))
(OR NSTEPS POLYGONSTEPS)
CONNECTED? INCOLOR? TOCOLOR FROMCOLOR TWEENCOLOR DS)))
(RANDOMPT
(LAMBDA (DS) (* kbr: " 6-Jun-86 00:01")
(PROG (REG)
(SETQ REG (DSPCLIPPINGREGION NIL DS))
(RETURN (create POSITION
XCOORD ← (RAND (fetch (REGION LEFT) of REG)
(fetch (REGION RIGHT) of REG))
YCOORD ← (RAND (fetch (REGION BOTTOM) of REG)
(fetch (REGION TOP) of REG)))))))
)
(RPAQ? MOTIONMAP )
(RPAQ? ONEMAP )
(RPAQ? PRETTYMAP )
(RPAQQ MOTIONMAPCOLORS ((0 0 0)
(0 0 0)
(0 0 0)
(0 0 0)
(0 0 0)
(0 0 0)
(0 0 0)
(0 0 79)
(0 0 126)
(0 0 168)
(0 0 199)
(0 0 255)
(0 0 0)
(0 0 0)
(0 0 0)
(0 0 0)))
(RPAQQ ONEMAPCOLORS ((100 100 100)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)
(255 0 0)))
(RPAQQ PRETTYCOLORS ((0 0 0)
(255 0 0)
(255 206 0)
(255 255 0)
(128 255 0)
(0 255 0)
(0 255 128)
(0 255 255)
(0 128 255)
(0 0 255)
(128 0 255)
(255 0 255)
(255 128 255)
(217 210 195)
(160 172 180)
(203 161 75)))
(PUTPROPS COLORPOLYGONS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (876 3221 (COLORPOLYGONS 886 . 1403) (COLORPOLYGON 1405 . 1808) (
COLORPOLYGONS.ROTATECOLORMAP 1810 . 3219)) (3222 25720 (BLACKHOLE 3232 . 3670) (BLACKHOLE1 3672 . 8507
) (COLORCONNECTPOLYS 8509 . 9805) (COLORDRAWPOLY1 9807 . 11661) (DRAWCOLORPOLYSTEPS 11663 . 15717) (
LENSE 15719 . 20419) (LINETEST 20421 . 20841) (MAPIT 20843 . 21355) (MAPIT2 21357 . 23757) (MOTIONIT
23759 . 24427) (ONECOLORPOLY 24429 . 25187) (RANDOMPT 25189 . 25718)))))
STOP