zwicky@pterodactyl.cis.ohio-state.edu (Elizabeth D. Zwicky) (10/25/88)
This program colors in a window, picking the color of each point by
calculating the value of a formula in x and y. Unfortunately, you
must specify the formula in PostScript (I wasn't up to writing a small
mathematical language to use to specify the formula in). It is cute in
black and white, and spectacular in colour.
Elizabeth Zwicky (zwicky@cis.ohio-state.edu)
Cut Here====================================================================
#!/usr/NeWS/bin/psh
% Set up LiteItem if nothing else has
systemdict /Item known not { (NeWS/liteitem.ps) run } if
% If I redefine something, I want it redefined!
false setautobind
% Predefinitions
/height null def /width null def
/Red 1 0 0 rgbcolor def
/Blue 0 0 1 rgbcolor def
/Green .2 1 .4 rgbcolor def
/Yellow 1 1 0 rgbcolor def
/Purple .7 0 1 rgbcolor def
/Orange 1 .5 0 rgbcolor def
/colors [Red Blue Green Yellow Purple Orange] def
/startx{1} def /starty{1} def
/div*{ dup 0 eq {pop pop 0}{div}ifelse}def
/magnify 1 def
/x{realx magnify div}def
/y{realy magnify div} def
/detail 1 def
/formula{x cos y mul y sin x mul add} def
/function{ formula detail mul}def
/first true def
/helpwindow null def
% Draw a dot; works with linecap 1 or 2 on NeWS, but only with 1 in standard
/dot{ 0 0 rlineto stroke pause} def
% Draw a row of dots
/line{
width{
gsave
colorcanvas
{colors function cvi 6 mod abs get setcolor dot}
{function cvi 2 mod abs 1 eq {dot} if}
ifelse
grestore
1 0 rmoveto
/realx realx 1 add def
}repeat
}def
% Draw a windowfull of rows
/square{
width 0 rmoveto
height{
width neg 1 rmoveto
/realx startx def
/realy realy 1 add def
line
}repeat
}def
% Create window to draw in
/paperwindow framebuffer /new DefaultWindow send def
{% Set up main window
/PaintClient{ % Clear, reset size, position, color, current point,
% and redraw
erasepage
clipcanvaspath pathbbox /height exch store /width exch store
0 setgray 1 1 moveto
/realx startx def /realy starty def
square
} def
/FrameLabel (Wallpaper) def
/destroy{% Will die even during redraw
PaintProcess null ne
{PaintProcess killprocessgroup}
if
FrameEventMgr null ne
{FrameEventMgr killprocessgroup}
if
} def
/ClientMenu [
(Zoom In)
{/magnify magnify 2 mul store /paint paperwindow send}
(Zoom Out)
{/magnify magnify 2 div store /paint paperwindow send}
(Add Detail)
{/detail detail 2 mul store /paint paperwindow send}
(Remove Detail) {/detail detail 2 div store /paint paperwindow send}
(Move Bottom Left Corner)
{
/xhair /xhair_m paperwindow /ClientCanvas get setstandardcursor
getclick
/starty exch starty add store
/startx exch startx add store
/ptr /ptr_m paperwindow /ClientCanvas get setstandardcursor
/paint paperwindow send
}
(Help) {first {help} if }
]
/new DefaultMenu send def
}paperwindow send
/help {% Put up help file in window
% Make help window
/helpwindow framebuffer /new DefaultWindow send store
(Times-Roman) findfont 14 scalefont setfont
0 0 310 460 /reshape helpwindow send
framebuffer setcanvas
paperwindow /FrameCanvas get getcanvaslocation 570 sub
/move helpwindow send
helpwindow /ClientCanvas get setcanvas
{
/PaintClient{
clippath pathbbox /place exch def pop pop pop
helptext
{
/place place 14 sub def
5 place moveto
show
} forall
} def
/destroy { % Gentle destroy; does not take other things with it
helpwindow /IconCanvas get /Mapped false put
helpwindow /FrameCanvas get /Mapped false put
helpwindow /ClientCanvas get /Mapped false put
helpwindow /FrameEventMgr get killprocess
/first true store
}def
} helpwindow send
/first false store
/map helpwindow send
} def
% Actually put main window up
/reshapefromuser paperwindow send
/map paperwindow send
% Create, position and size formulawindow
/formulawindow framebuffer /new DefaultWindow send def
100 100 300 110 /reshape formulawindow send
paperwindow /FrameCanvas get getcanvaslocation 110 sub /move formulawindow send
% Don't want the string every time it's changed; gonotify really
% does the notification
/formulanotify {} def
/gonotify{/formula itemdict /formulaitem get /ItemValue get dup length string copy cvx store /paint paperwindow send} def
/itemdict dictbegin
/formulaitem (Formula:)(x cos y mul y sin x mul add)
/Right /formulanotify
formulawindow /ClientCanvas get
1500 10 %Plenty long for real complex formulas!
/new TextItem send
dup 0 0 /move 3 index send pop def
/goitem (Press When Formula Is Correct) /gonotify formulawindow /ClientCanvas get 10 40 /new ButtonItem send dup 0 30 /move 3 index send pop def
dictend def
itemdict paintitems itemdict forkitems
{/PaintClient {itemdict paintitems} def
/destroy{paperwindow /PaintProcess get null ne
{paperwindow /PaintProcess get killprocessgroup}
if
paperwindow /FrameEventMgr get null ne
{paperwindow /FrameEventMgr get killprocessgroup} if} def
} formulawindow send
/map formulawindow send
/helptext[
("Wallpaper" was inspired by one of Martin)
(Gardner's Mathematical Recreations columns)
(in the magazine "Scientific American". It)
(colors in a coordinate plane by)
(calculating the value of formula in x and)
(y for the x and y values of that point,)
(and picking a color based on that value.)
(On a color display it uses 6 colors, which)
(are meant to be red, blue, yellow, purple,)
(green and orange. On a monochrome screen)
(it uses only black and white.)
( )
(The formula is specified in the lower)
(window in PostScript. A special function,)
(div*, is available; it is exactly like)
("div" except that if you attempt to divide)
(by zero it returns zero instead of an)
(error.)
( )
(The "Zoom In" and "Zoom Out" menu options)
(change the magnification of the plane by)
(factors of 2; it starts out at device)
(resolution. Similarly, the "Add Detail")
(and "Remove Detail" menu options change a)
(multiplier that is applied to the result)
(of the formula by factors of 2. The)
(multiplier starts at 1. "Move Bottom Left)
(Corner" places the bottom left corner at)
(the point on the plane indicated by your)
(next click (it starts at 0,0).)
]deftoms@NCIFCRF.GOV (10/26/88)
Very nice. Now, I zapped one part of the multipart window, and I find a residue that is sticking around; won't go away, won't respond. What do I do to get rid of this? (I've got a big crunch going in background that I don't want to disturb, so restarting NeWS is out for another day or two...) Tom
zwicky@pterodactyl.cis.ohio-state.edu (Elizabeth D Zwicky) (03/28/89)
This version *really* makes all its windows disappear when you Zap it.
Or at least I sincerely believe so, and it works for me.
The attached NeWS program colors in a window that you give it, basing
the color of each dot on the result of an equation in x and y for that
dots x and y coordinates. On a monochrome screen, it makes the dot black
if the equation's result is odd, and white if it is even; on a color
screen it mods the result by six, and uses that to pick a color.
You can change the portion of the plane you are looking at, zoom in or
zoom out, add and remove detail on the portion you are looking at, and
change the dot size, not to mention being able to specify the equation
it uses. You can't yet get some idea of what you've set any parameter
but the equation to. Yes, if you're sufficiently clever you can do
the Mandelbrot set, but it will take you a ***VERY*** long time.
Elizabeth D. Zwicky (zwicky@cis.ohio-state.edu)
-----------Cut Here---------------------------------------------
#!/usr/NeWS/bin/psh
% Send comments to Elizabeth Zwicky (zwicky@cis.ohio-state.edu)
% Set up LiteItem if nothing else has
systemdict /Item known not { (NeWS/liteitem.ps) run } if
% If I redefine something, I want it redefined!
false setautobind
% Predefinitions
/height null def /width null def
/Red 1 0 0 rgbcolor def
/Blue 0 0 1 rgbcolor def
/Green .2 1 .2 rgbcolor def
/Yellow 1 1 0 rgbcolor def
/Purple .7 0 1 rgbcolor def
/Orange 1 .5 0 rgbcolor def
/colors [Red Orange Yellow Green Blue Purple] def
/startx{1} def /starty{1} def
/div*{ dup 0 eq {pop pop 0}{div}ifelse}def
/magnify 1 def
/scalefactor 1 def
/x{realx magnify div}def
/y{realy magnify div} def
/detail 1 def
/formula{x cos y mul y sin x mul add} def
/function{ formula detail mul}def
/first true def
/helpwindow null def
/called false def
% Draw a dot; works with linecap 1 or 2 on NeWS, but only with 1 in standard
/dot{ 0 0 rlineto stroke pause} def
% Draw a row of dots
/line{
width{
gsave
colorcanvas
{colors function cvi 6 mod abs get setcolor dot}
{function cvi 2 mod abs 1 eq {dot} if}
ifelse
grestore
1 0 rmoveto
/realx realx 1 add def
}repeat
gsave
colorcanvas
{colors function cvi 6 mod abs get setcolor dot}
{function cvi 2 mod abs 1 eq {dot} if}
ifelse
grestore
}def
% Draw a windowfull of rows
/square{
width 0 rmoveto
height{
width neg 1 rmoveto
/realx startx def
/realy realy 1 add def
line
}repeat
}def
% Create window to draw in
/paperwindow framebuffer /new DefaultWindow send def
{% Set up main window
/PaintClient{ % Clear, reset size, position, color, current point,
% and redraw
erasepage
2 setlinecap 1 setlinewidth
scalefactor scalefactor scale
clipcanvaspath pathbbox /height exch store /width exch store
/width width scalefactor div truncate 1 add scalefactor mul store
/height height scalefactor div truncate 1 add scalefactor mul store
0 setgray 0 0 moveto
/realx startx def /realy starty def
square
} def
/FrameLabel (Wallpaper) def
/destroy{
% Kill subwindows
/called true store
/destroy formulawindow send
first not {/destroy helpwindow send} if
% Will die even during redraw
PaintProcess null ne
{
PaintProcess killprocessgroup}
if
FrameEventMgr null ne
{
FrameCanvas /Mapped false put FrameEventMgr killprocessgroup}
if
currentprocess killprocessgroup
} def
/ClientMenu [
(Zoom In)
{/magnify magnify 2 mul store /paint paperwindow send}
(Zoom Out)
{/magnify magnify 2 div store /paint paperwindow send}
(Scale Up)
{/scalefactor scalefactor 2 mul store /paint paperwindow send }
(Scale Down)
{/scalefactor scalefactor 2 div store /paint paperwindow send}
(Add Detail)
{/detail detail 2 mul store /paint paperwindow send}
(Remove Detail) {/detail detail 2 div store /paint paperwindow send}
(Move Bottom Left Corner)
{
/xhair /xhair_m paperwindow /ClientCanvas get setstandardcursor
getclick
/starty exch starty add store
/startx exch startx add store
/ptr /ptr_m paperwindow /ClientCanvas get setstandardcursor
/paint paperwindow send
}
(Help) {first {help} if }
]
/new DefaultMenu send def
}paperwindow send
/help {% Put up help file in window
% Make help window
/helpwindow framebuffer /new DefaultWindow send store
(Times-Roman) findfont 14 scalefont setfont
0 0 310 460 /reshape helpwindow send
framebuffer setcanvas
paperwindow /FrameCanvas get getcanvaslocation 570 sub
/move helpwindow send
helpwindow /ClientCanvas get setcanvas
{
/PaintClient{
clippath pathbbox /place exch def pop pop pop
helptext
{
/place place 14 sub def
5 place moveto
show
} forall
} def
/destroy { % Gentle destroy; does not take other things with it
helpwindow /IconCanvas get /Mapped false put
helpwindow /FrameCanvas get /Mapped false put
helpwindow /ClientCanvas get /Mapped false put
helpwindow /FrameEventMgr get killprocess
/first true store
}def
} helpwindow send
/first false store
/map helpwindow send
} def
% Actually put main window up
/reshapefromuser paperwindow send
/map paperwindow send
% Create, position and size formulawindow
/formulawindow framebuffer /new DefaultWindow send def
100 100 300 110 /reshape formulawindow send
paperwindow /FrameCanvas get getcanvaslocation 110 sub /move formulawindow send
{
/destroy{
/unmap formulawindow send
called not {/destroy paperwindow send} if
} def
} formulawindow send
% Don't want the string every time it's changed; gonotify really
% does the notification
/formulanotify {} def
/gonotify{/formula itemdict /formulaitem get /ItemValue get dup length string copy cvx store /paint paperwindow send} def
/itemdict dictbegin
/formulaitem (Formula:)(x cos y mul y sin x mul add)
/Right /formulanotify
formulawindow /ClientCanvas get
1500 10 %Plenty long for real complex formulas!
/new TextItem send
dup 0 0 /move 3 index send pop def
/goitem (Press When Formula Is Correct) /gonotify formulawindow /ClientCanvas get 10 40 /new ButtonItem send dup 0 30 /move 3 index send pop def
dictend def
itemdict paintitems itemdict forkitems
{/PaintClient {itemdict paintitems} def
} formulawindow send
/map formulawindow send
/helptext[
("Wallpaper" was inspired by one of Martin)
(Gardner's Mathematical Recreations columns)
(in the magazine "Scientific American". It)
(colors in a coordinate plane by)
(calculating the value of formula in x and)
(y for the x and y values of that point,)
(and picking a color based on that value.)
(On a color display it uses 6 colors, which)
(are meant to be red, blue, yellow, purple,)
(green and orange. On a monochrome screen)
(it uses only black and white.)
( )
(The formula is specified in the lower)
(window in PostScript. A special function,)
(div*, is available; it is exactly like)
("div" except that if you attempt to divide)
(by zero it returns zero instead of an)
(error.)
( )
(The "Zoom In" and "Zoom Out" menu options)
(change the magnification of the plane by)
(factors of 2; it starts out at device)
(resolution. Similarly, the "Add Detail")
(and "Remove Detail" menu options change a)
(multiplier that is applied to the result)
(of the formula by factors of 2. The)
(multiplier starts at 1. "Move Bottom Left)
(Corner" places the bottom left corner at)
(the point on the plane indicated by your)
(next click (it starts at 0,0).)
]def