don@BRILLIG.UMD.EDU (Don Hopkins) (08/28/88)
%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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
/PSVisualizerWindow DefaultWindow
dictbegin
/hfrob .3 def
/sfrob .5 def
/bfrob .3 def
/procs 1 def
/maxprocs 10 def
/maxdepth 0 def
/thing rootmenu def
/highmark 10 def
/pp null def
/FrameLabel (The NeWS Pseudo-Scientific Visualizer!) def
/IconLabel (PS Visualizer) def
/IconImage /eye def
dictend
classbegin
/new {
/new super send begin
/maxdepth countdictstack 5 add def
currentdict
end
} def
/destroy { % clean up
drain
pp type /processtype eq {
pp killprocessgroup
/pp null def
/thing null def
} if
/destroy super send
} def
/drain {
maxdepth
/maxdepth 0 def
50 { pause procs 0 eq {exit} if } repeat
/maxdepth exch def
} def
/PaintClient {
{
clear
newprocessgroup
drain
pp null ne {
pp killprocessgroup % why doesn't this kill all of 'em???
} if
/pp currentprocess def
erasepage
random random sqrt random sqrt sethsbcolor
/highmark countdictstack def
/procs 1 def
clippath pathbbox scale pop pop
.5 .5 translate .05 .05 scale
{/thing load visualize} fork waitprocess pop
} fork pop
} 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
/visualize { % obj => -
% count 5 gt {/foo dbgbreak} if
pause
countdictstack maxdepth 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
/obj exch cvlit def
/pieces obj length def
pieces 0 ne {
/step 360 pieces div def
obj {
pause
countdictstack maxdepth 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
/obj exch cvlit def
/pieces obj length def
pieces 0 ne {
/step 360 pieces div def
/i -1 def
obj {
pause
countdictstack maxdepth 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 }
(foo) {
ThisWindow /thing /foo load put }
(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)
(11) (12) (13) (14) (15) (16) (17) (18) (19) (20)]
] [
(Thing...) ThingMenu
(MaxDepth) {
getmenuarg cvi
{ countdictstack add /maxdepth exch def } ThisWindow send }
(ColorFrob...) ColorFrobMenu
(MaxProcs) { ThisWindow /maxprocs getmenuarg cvi put }
] /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
/win framebuffer /new PSVisualizerWindow send def
{
reshapefromuser
map
ClientCanvas /Retained true put
} win send