(FILECREATED "15-DEC-82 15:27:44" {PHYLUM}<LISPCORE>COLOR>COLORPOLYGONS.;10 18093
changes to: (FNS COLORPOLYGONS)
(VARS MOTIONMAPCOLORS ONEMAPCOLORS PRETTYCOLORS)
previous date: "13-DEC-82 13:39:08" {PHYLUM}<LISPCORE>COLOR>COLORPOLYGONS.;9)
(PRETTYCOMPRINT COLORPOLYGONSCOMS)
(RPAQQ COLORPOLYGONSCOMS ((FNS BLACKHOLE BLACKHOLE1 BUTLAST COLORCONNECTPOLYS COLORDRAWPOLY1
COLORPOLYDEMO1 COLORPOLYGONS DRAWCOLORPOLYSTEPS LENSE LINETEST MAPIT
MAPIT2 MOTIONIT ONECOLORPOLY)
(VARS (MOTIONMAP)
MOTIONMAPCOLORS
(ONEMAP)
ONEMAPCOLORS
(PRETTYMAP)
PRETTYCOLORS)
(FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
POLYGONS)))
(DEFINEQ
(BLACKHOLE
[LAMBDA (PTLST DS DENSITY PERCENT) (* rrb "11-OCT-82 19:20")
(* maps a list of points onto itself repeatedly until
closure)
(DSPFILL NIL NIL 0 DS)
(BLACKHOLE1 PTLST DS (OR DENSITY 3)
(OR PERCENT 30])
(BLACKHOLE1
[LAMBDA (PTLST DS DENSITY PERCENT) (* rrb "15-OCT-82 15:00")
(* maps a list of points onto itself repeatedly until
closure)
(PROG ((CENTERX (IQUOTIENT (for PT in PTLST sum (fetch (POSITION XCOORD) of PT))
(LENGTH PTLST)))
(CENTERY (IQUOTIENT (for PT in PTLST sum (fetch (POSITION YCOORD) of PT))
(LENGTH PTLST)))
X Y OTHERPTS) (* 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)
(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])
(BUTLAST
[LAMBDA (LST) (* rrb "11-OCT-82 19:05")
(* returns a list of all but the last element.)
(for X on LST when (CDR X) collect (CAR X])
(COLORCONNECTPOLYS
[LAMBDA (FROMS TOS NSTEPS CONNECTEDFLG INCOLOR? FROMCOLOR TOCOLOR TWEENCOLOR DS)
(* rrb "15-OCT-82 15:01")
(* 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 XFROMS 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])
(COLORPOLYDEMO1
[LAMBDA (DS) (* rrb "15-OCT-82 14:56")
(PROG NIL
(COND
((NULL DS)
(SETQ DS (DSPCREATE))
(DSPDESTINATION (COLORSCREENBITMAP)
DS)
(DSPCLIPPINGREGION (QUOTE (0 0 640 480))
DS)))
(COND
((EQ (COLORNUMBERBITSPERPIXEL)
4)
(OR (type? COLORMAPP MOTIONMAP)
(SETQ MOTIONMAP (COLORMAPCREATE MOTIONMAPCOLORS)))
(OR (type? COLORMAPP ONEMAP)
(SETQ ONEMAP (COLORMAPCREATE ONEMAPCOLORS)))
(OR (type? COLORMAPP PRETTYMAP)
(SETQ PRETTYMAP (COLORMAPCREATE PRETTYCOLORS)))
(SETQ WAITTIME 70))
(T [OR (type? 8BITCOLORMAPP MOTIONMAP)
(SETQ MOTIONMAP (COLORMAPCREATE (NCONC (LIST (QUOTE (128 128 128)))
(FOR I FROM 0 TO 255 BY 8
COLLECT (LIST 0 0 I))
(FOR I FROM 1 TO 240
COLLECT (QUOTE (128 128 128]
[OR (type? 8BITCOLORMAPP ONEMAP)
(SETQ ONEMAP (COLORMAPCREATE (CONS (QUOTE (128 128 128))
(for I from 1 to 255
collect (QUOTE (255 0 0]
(OR (type? 8BITCOLORMAPP PRETTYMAP)
(SETQ PRETTYMAP (RAINBOWMAP 8)))
(SETQ WAITTIME 20)))
LP (SCREENCOLORMAP ONEMAP)
(MAPIT2 (RAND 3 5)
DS
(RAND 2 5))
(DISMISS 2000)
(SCREENCOLORMAP MOTIONMAP)
(QUITP 10)
(until (QUITP) do (ROTATECOLORMAP (SCREENCOLORMAP)
1)
(DISMISS WAITTIME))
(SCREENCOLORMAP PRETTYMAP)
(QUITP 20)
(until (QUITP) do (ROTATECOLORMAP (SCREENCOLORMAP)
1)
(DISMISS WAITTIME))
(SCREENCOLORMAP ONEMAP)
(DISMISS 2000)
(GO LP])
(COLORPOLYGONS
[LAMBDA (DS) (* rrb "15-DEC-82 11:31")
(PROG (NPTS)
(COND
((NULL DS)
(SETQ DS (DSPCREATE))
(DSPDESTINATION (COLORSCREENBITMAP)
DS)
(DSPCLIPPINGREGION (QUOTE (0 0 640 480))
DS)))
(COND
((EQ (COLORNUMBERBITSPERPIXEL)
4)
(OR (type? COLORMAPP MOTIONMAP)
(SETQ MOTIONMAP (COLORMAPCREATE MOTIONMAPCOLORS)))
(OR (type? COLORMAPP ONEMAP)
(SETQ ONEMAP (COLORMAPCREATE ONEMAPCOLORS)))
(OR (type? COLORMAPP PRETTYMAP)
(SETQ PRETTYMAP (COLORMAPCREATE PRETTYCOLORS)))
(SETQ WAITTIME 70))
(T [OR (type? 8BITCOLORMAPP MOTIONMAP)
(SETQ MOTIONMAP (COLORMAPCREATE (NCONC (LIST (QUOTE (128 128 128)))
(FOR I FROM 0 TO 255 BY 8
COLLECT (LIST 0 0 I))
(FOR I FROM 1 TO 240
COLLECT (QUOTE (128 128 128]
[OR (type? 8BITCOLORMAPP ONEMAP)
(SETQ ONEMAP (COLORMAPCREATE (CONS (QUOTE (128 128 128))
(for I from 1 to 255
collect (QUOTE (255 0 0]
(OR (type? 8BITCOLORMAPP PRETTYMAP)
(SETQ PRETTYMAP (RAINBOWMAP 8)))
(SETQ WAITTIME 20)))
LP (SCREENCOLORMAP ONEMAP)
(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)
(DISMISS 2000)
(SCREENCOLORMAP MOTIONMAP)
(QUITP 10)
(until (QUITP)
do (ROTATECOLORMAP (SCREENCOLORMAP)
1)
(DISMISS WAITTIME))
(SCREENCOLORMAP PRETTYMAP)
(QUITP 20)
(until (QUITP)
do (ROTATECOLORMAP (SCREENCOLORMAP)
1)
(DISMISS WAITTIME))
(SCREENCOLORMAP ONEMAP)
(DISMISS 2000)
(GO LP])
(DRAWCOLORPOLYSTEPS
[LAMBDA (FROMS TOS NSTEPS CONNECTEDFLG FROMCOLOR MAXCOLOR DS)
(* rrb "15-OCT-82 14:47")
(PROG (DIFFS (XFROMS (COPY FROMS)))
[SETQ DIFFS (for FPT in XFROMS as TPT in TOS collect (create POSITION
XCOORD ←(IDIFFERENCE
(fetch XCOORD of TPT)
(fetch XCOORD of FPT))
YCOORD ←(IDIFFERENCE
(fetch YCOORD of TPT)
(fetch 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 XCOORD of PT with (IPLUS (fetch XCOORD of FROMPT)
(IQUOTIENT (ITIMES (fetch XCOORD
of DIF)
I)
NSTEPS)))
(replace YCOORD of PT with (IPLUS (fetch YCOORD of FROMPT)
(IQUOTIENT (ITIMES (fetch 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) (* rrb "15-OCT-82 15:02")
(* maps a list of points onto itself repeatedly until
closure)
(PROG ((CENTERX (IQUOTIENT (for PT in PTLST sum (fetch (POSITION XCOORD) of PT))
(LENGTH PTLST)))
(CENTERY (IQUOTIENT (for PT in PTLST sum (fetch (POSITION YCOORD) of PT))
(LENGTH PTLST)))
X Y OTHERPTS (MAXCOLOR (MAXIMUMCOLOR))
ENDCOLOR)
(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) (* rrb "15-OCT-82 15:04")
(* 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)
DS])
(MAPIT2
[LAMBDA (N DS DENSITY) (* rrb "15-OCT-82 14:50")
(* create a random list of N points and maps it onto N
others.)
(PROG ((ORGPOINTS (for I from 1 to N collect (RANDOMPT DS)))
(NOWCOLOR 1)
(MAXCOLOR (MAXIMUMCOLOR)))
(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 (DS) (* rrb "11-OCT-82 13:01")
(PROG NIL
LP (SCREENCOLORMAP ONEMAP)
(ONECOLORPOLY (RAND 3 4)
45 T 1 1 15 8 DS)
(DISMISS 2000)
(SCREENCOLORMAP MOTIONMAP)
(QUITP 10)
(until (QUITP) do (ROTATECOLORMAP (SCREENCOLORMAP)
1)
(DISMISS 75))
(SCREENCOLORMAP PRETTYMAP)
(QUITP 20)
(until (QUITP) do (ROTATECOLORMAP (SCREENCOLORMAP)
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])
)
(RPAQQ MOTIONMAP NIL)
(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 ONEMAP NIL)
(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 PRETTYMAP NIL)
(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)))
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
POLYGONS)
(DECLARE: DONTCOPY
(FILEMAP (NIL (705 17100 (BLACKHOLE 715 . 1055) (BLACKHOLE1 1057 . 3468) (BUTLAST 3470 . 3750) (
COLORCONNECTPOLYS 3752 . 4758) (COLORDRAWPOLY1 4760 . 5691) (COLORPOLYDEMO1 5693 . 7490) (
COLORPOLYGONS 7492 . 9458) (DRAWCOLORPOLYSTEPS 9460 . 11088) (LENSE 11090 . 13500) (LINETEST 13502 .
13845) (MAPIT 13847 . 14236) (MAPIT2 14238 . 15765) (MOTIONIT 15767 . 16402) (ONECOLORPOLY 16404 .
17098)))))
STOP