don@BRILLIG.UMD.EDU (Don Hopkins) (03/11/89)
This is a new version of the Pseudo-Scientific Visualizer. It
projects hallucinations of a NeWS molecules onto the screen. (These
things don't really exist, so they're not prohibited by law.) Once
it's done virtualizing the hallucination, there is a shudder, a puff
of smoke comes out of the back of the CPU, and then all the little
bits and pieces are made synesthetically mouse sensative!
Composite objects (arrays and dictionaries) highlight when you point
at them, and their printed name is show in the text item at the bottom
of the window. When you click the point (left) button on a highlighted
object, it is selected (in PrimarySelection). When you click the point
button on the background, it highlights *all* mouse sensative objects.
When you click with the adjust button on a highlighted object, it zoom
into that object. Select the menu item "Thing... Top" to get back to
the original object.) When you change something with the menu, it
takes effect immediatly while it's drawing. If you make changes after
it's finished painting, you should redraw (menu "paint") the window to
see them.
If there is an argument to psh, it executes it and grows a molecule
with the resulting object. Otherwise it just installs its class in
systemdict, for later use.
Use it like this:
psh molecule.ps rootmenu
psh molecule.ps '[ [1 2 3 4] [1 2 3] [1 2] [1] ]'
psh molecule.ps '10 dictbegin /foo LiteMenu def /bar LiteItem def dictend'
-Don
%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% The NeWS Pseudo-Scientific Visualizer
% -- the class browser for the other half of your brain.
% Copyright (C) 1988 by Don Hopkins (don@brillig.umd.edu)
%
% You are free to redistribute this program. Please leave the comments
% intact, add your own views and hallucinations, and pass it on to
% friends! The author is not responsible for any time or brain cells
% wasted with this software. (Has anybody ever actually gotten sued for
% that?)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% We've got to have the classes PieMenu and PulloutPieMenu are defined.
systemdict /PieMenu known not {
(NeWS/piemenu.ps) LoadFile not {
currentcursorlocation
[(Need) (piemenu.ps)] popmsg pop
currentprocess killprocess
} if
} if
systemdict /PulloutPieMenu known not {
(NeWS/pullout.ps) LoadFile not {
currentcursorlocation
[(Need) (pullout.ps)] popmsg pop
currentprocess killprocess
} if
} if
systemdict begin
/PSVisualizerWindow DefaultWindow
dictbegin
/hfrob .3 def
/sfrob .5 def
/bfrob .3 def
/procs 1 def
/maxprocs 10 def
/maxdrawdepth 0 def
/maxtargetdepth 0 def
/thing null def
/highmark 10 def
/pp null def
/FrameLabel (The NeWS Pseudo-Scientific Visualizer!) def
/IconLabel (PS Visualizer) def
/IconImage /eye def
/Canvases null def
/Items null def
/BorderBottom 32 def
/Top null def
dictend
classbegin
/new {
/new super send begin
/Top 1 index def
/thing exch def
/maxdrawdepth countdictstack 3 add def
/maxtargetdepth countdictstack 999 add def
currentdict
end
} def
/destroy { % clean up
drain
pp type /processtype eq {
pp killprocessgroup
/pp null def
/thing null def
} if
Canvases null ne {
Canvases {pop /Interests get
dup length 0 eq {(zip ) [] dbgprintf} if % XXX
{revokeinterest} forall} forall
} if
/destroy super send
} def
/drain {
maxdrawdepth
/maxdrawdepth 0 def
50 { pause procs 0 eq {exit} if } repeat
/maxdrawdepth exch def
} def
/PaintClient {
gsave ClientCanvas setcanvas
{
clear
newprocessgroup
drain
pp null ne {
pp killprocessgroup % why doesn't this kill all of 'em???
} if
/pp currentprocess def
Canvases dup type /dicttype eq {
Canvases { pop
dup /Interests get
dup length 0 eq {(zip ) [] dbgprintf} if % XXX
{revokeinterest} forall
/Mapped false put
} forall
} if
/Canvases 2048 dict def
erasepage
random random random sethsbcolor
/highmark countdictstack def
/procs 1 def
clippath pathbbox scale pop pop
.5 .5 translate .05 .05 scale
{/thing load visualize} fork waitprocess pop
300 { procs 1 le {exit} if .1 sleep } repeat
ClientCanvas setcanvas
[ Canvases { pop
[ PointButton AdjustButton MenuButton /EnterEvent /ExitEvent ]
/target-event null 4 -1 roll eventmgrinterest
} forall
PointButton /point-background null ClientCanvas eventmgrinterest
] forkeventmgr
/pp exch def
} fork pop
grestore
} def
/PaintFrame {
/PaintFrame super send
Items paintitems
} def
/activate {
/Items 10 dict dup begin
/message_item () () /Right
nullproc
FrameCanvas /new MessageItem send
BorderLeft 4 330 0 /reshape 5 index send def
end def
Items forkitems pop
map
ClientCanvas /Retained true put
} def
/reshape {
/reshape super send
Items null ne {
BorderLeft 4 /move Items /message_item get send
} if
} def
/toggle-can {
setcanvas
0 setgray 5 setrasteropcode
clippath fill
} def
/point-background {
gsave
Canvases { pop toggle-can } forall
grestore
} def
/target-event-names 10 dict def
target-event-names begin
PointButton {
CurrentEvent /Action get /DownTransition eq {
Canvases
CurrentEvent /Canvas get get /obj get
select-object
} {
} ifelse
} def
AdjustButton {
CurrentEvent /Action get /DownTransition eq {
Canvases
CurrentEvent /Canvas get get /obj get
/thing exch store
PaintClient
} {
} ifelse
} def
MenuButton {
CurrentEvent /Action get /UpTransition eq {
} {
} ifelse
} def
/EnterEvent {
Canvases
CurrentEvent /Canvas get
dup toggle-can
get /obj get (%) sprintf /printstring Items /message_item get send
} def
/ExitEvent {
CurrentEvent /Canvas get toggle-can
} def
end
/target-event {
gsave
target-event-names CurrentEvent /Name get get exec
grestore
} def
/ignorekeys 20 dict def
ignorekeys begin
/TopCanvas dup def
/BottomCanvas dup def
/CanvasAbove dup def
/Parent dup def
/FrameMenu dup def
/IconMenu dup def
/ParentDict dup def
/ParentDictArray dup def
end
/cvfixed {
16384 mul floor cvi -14 bitshift
} def
/wrap {
dup floor sub cvfixed
} def
% This is useful for finding core leaks ... (Really!)
/context-string { % => (string)
()
currentprocess /DictionaryStack get
dup length 2 sub 2 exch getinterval
{ dup /obj known {
begin i obj 3 -1 roll (%/%:%) sprintf end
} {pop} ifelse
} forall
1 index exch (% = %) sprintf
} def
/make-target {
countdictstack maxtargetdepth lt {
/can ClientCanvas newcanvas def
0 0 1 0 360 arc can reshapecanvas
can /Transparent true put
can /Mapped true put
Canvases can currentdict put
} if
} def
/visualize { % obj => -
% count 5 gt {/foo dbgbreak} if
pause
countdictstack maxdrawdepth ge {
countdictstack highmark gt {
% Uncomment this to hunt for core leaks.
% context-string (High water: %\n) [3 -1 roll] dbgprintf
/highmark countdictstack store
} if
pop
} {
{ gsave
currenthsbcolor
3 -1 roll random hfrob mul add wrap
3 -1 roll random sfrob mul add wrap
sqrt % Crank up the saturation!
3 -1 roll random bfrob mul add wrap
sqrt % Crank up the brightness!
sethsbcolor
dup type {
% /canvastype
/dicttype {
newpath
0 0 1 0 360 arc closepath
0 0 .9 0 360 arc closepath
0 0 .2 0 360 arc closepath
eofill
10 dict begin
make-target
/obj exch cvlit def
/pieces obj length def
pieces 0 ne {
/step 360 pieces div def
obj {
pause
countdictstack maxdrawdepth ge {pop pop exit} if
/thing exch cvlit def
/i exch cvlit def
gsave
2.5 0 translate
.6 .6 scale
i visualize
2.5 0 translate
ignorekeys i known not { thing } { /triangle } ifelse
visualize
grestore
step rotate
} forall
} if
end
}
/arraytype {
newpath
0 0 1 0 360 arc closepath
0 0 .9 0 360 arc closepath
eofill
10 dict begin
make-target
/obj exch cvlit def
/pieces obj length def
pieces 0 ne {
/step 360 pieces div def
/i -1 def
obj {
pause
countdictstack maxdrawdepth ge {pop exit} if
/thing exch cvlit def
/i i 1 add def
gsave
2.5 0 translate
.6 .6 scale
thing visualize
grestore
step rotate
} forall
} if
end
}
/stringtype {
length 1 add
newpath
-.5 -.1 % x y
3 -1 roll 5 div .5 add .2 % x y w h
rectpath
fill
}
/realtype /integertype {
dup 100 div wrap 1 index 10 div wrap 3 -1 roll wrap
setrgbcolor
-.4 -.4 .8 .8 rectpath
fill
}
/eventtype {
pop
-.8 -.8 1.6 1.6 rectpath
-.8 .8 moveto
0 0 lineto
-.8 -.8 lineto
stroke
}
/nulltype {
pop
gsave
-90 rotate
-1 -.3 translate
2 2 scale
newpath % Nick Turner's finger
.2 0 moveto
0 .3 lineto
.1 .5 lineto
.2 .5 lineto
.2 .55 lineto
.3 .6 lineto
.4 .55 lineto
.4 .95 lineto
.5 1 lineto
.6 .95 lineto
.6 .55 lineto
.7 .6 lineto
.8 .55 lineto
.8 .5 lineto
.9 .55 lineto
1 .5 lineto
1 .3 lineto
.8 0 lineto
closepath
fill
grestore
}
/operatortype {
pop
-.2 -.2 .4 .4 rectpath
0 0 .5 0 360 arc
eofill
}
/processtype {
pop
newpath
-.5 -.5 moveto
1 -.4 lineto
1 -.2 lineto
.8 -.2 lineto
1 .4 lineto
1 1 lineto
.5 .3 lineto
-.5 .5 lineto
closepath
eofill
}
% /canvastype {
% -.5 -.5 translate
% imagecanvas
% }
/Default {
pop
newpath
% -.5 -.5 1 1 rectpath
0 -.5 moveto
1 0 lineto
0 .5 lineto
closepath
% stroke
% -.4 -.4 .8 .8 rectpath
eofill
}
} case
grestore } % A verb, Senator Kennedy, we need a verb!
random .6 lt procs maxprocs lt and {
/procs procs 1 add store
{ exec
/procs procs 1 sub store
} fork pop pop pop
} {
exec
} ifelse % mumble frotz ...
} ifelse
} def
% Menu definitions
/ColorFrobMenu [
[(0.0) (0.02) (0.05)
(0.1) (0.2) (0.3) (0.4) (0.5) (0.6) (0.7) (0.8) (0.9) (1.0) (99)]
] [
(HueFrob) { ThisWindow /hfrob getmenuarg cvr put }
(BrightnessFrob) { ThisWindow /bfrob getmenuarg cvr put }
(SaturationFrob) { ThisWindow /sfrob getmenuarg cvr put }
] /new PulloutPieMenu send def
/ThingMenu [
(SendContexts) {
ThisWindow /thing currentprocess /SendContexts get put }
(UI_private) {
ThisWindow /thing UI_private put }
(Top) {
{/thing /Top load def } ThisWindow send }
(rootmenu) {
ThisWindow /thing rootmenu put }
(DefaultMenu) {
ThisWindow /thing DefaultMenu put }
(userdict) {
ThisWindow /thing userdict put }
(bar) {
ThisWindow /thing /bar load put }
(Item) {
ThisWindow /thing Item put }
] /new PieMenu send def
/ClientMenu [
[]
[(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (9999)]
[(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (9999)]
[]
[(1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
(11) (12) (13) (14) (15) (16) (17) (18) (19) (20)]
[]
] [
(Thing...) ThingMenu
(DrawDepth) {
getmenuarg cvi
{ countdictstack add /maxdrawdepth exch def } ThisWindow send }
(TargetDepth) {
getmenuarg cvi
{ countdictstack add /maxtargetdepth exch def } ThisWindow send }
(ColorFrob...) ColorFrobMenu
(MaxProcs) { ThisWindow /maxprocs getmenuarg cvi put }
(paint) { /paint ThisWindow send }
] /new PulloutPieMenu send def
% Hurray for you -- you're reading the source code!
% You can run a psh, and change foo and bar in systemdict to whatever
% you want to look at! (warning: systemdict gets "unregistered" errors!)
% To find core leaks, visualize objects in your application's userdict,
% and look for the infinite regression of circular references.
systemdict /foo ClientMenu put
systemdict /bar UserProfile put
classend def
/select-object { % obj => -
20 dict begin
/ContentsPostScript 1 index def
/ContentsAscii exch (%) sprintf def
/SelectionObjSize 1 def
/SelectionResponder null def
/Canvas currentcanvas def % XXX?
/SelectionHolder currentprocess def % XXX?
currentdict
end
/PrimarySelection setselection
} ?def
/start_visualizer { % thing =>
{ framebuffer setcanvas
newprocessgroup
framebuffer /new PSVisualizerWindow send
/reshapefromuser 1 index send
/activate exch send
} fork pop pop
} def
end % systemdict
% visualize command line args, if any.
{ clear
{ ($1 $2 $3 $4 $5 $6 $7 $8 $9) cvx exec } errored not {
count 0 ne {
start_visualizer
} if
} if
} fork pop