From don Thu Nov 23 00:53:53 1989 Date: Thu, 23 Nov 89 00:53:53 -0500 To: NeWS-makers@brillig.umd.edu Subject: PostScript Interactive Bug Eradication Routines From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) Here is the text of the paper that I presented at the Usenix Monterey Graphics Workshop, "The Shape of PSIBER Space: PostScript Interactive Bug Eradication Routines". I will send the illustrations on request. They are about 2 meg of PostScript. The entire mass is available via anonymous ftp from "tumtum.cs.umd.edu". The paper and the illustrations are included in the "documents/psiber" directory of the "NeWS/news-tape.tar.Z" collection, and in "NeWS/psiber.tar.Z". The software described in the paper is in the "utilities/cyber" directory of "NeWS/news-tape.tar.Z", and in "NeWS/cyber.shar.Z". In this message is the text of the paper, then there will be three more messages with three illustrations (the smaller of the 10 illustrations from the paper). After that comes the software, consisting of an introductory message, and 8 split up shar file, "cyber.shar.splita[a-h]". It has been tested under NeWS 1.1 and Open Windows Version 1.0 (X11/NeWS FCS), and it works for me. This software and documentation is Copyright (C) 1989 by Don Hopkins, and you can have it for free, to do whatever you want with, just don't remove the credits or blame me for anything that goes wrong. -Don The Shape of PSIBER Space: PostScript Interactive Bug Eradication Routines Don Hopkins don@brillig.umd.edu University of Maryland Human-Computer Interaction Lab Computer Science Department College Park, Maryland 20742 ABSTRACT The PSIBER Space Deck is an interactive visual user interface to a graphical programming environment, the NeWS window system. It lets you display, manipulate, and navigate the data structures, programs, and processes living in the virtual memory space of NeWS. It is use- ful as a debugging tool, and as a hands on way to learn about program- ming in PostScript and NeWS. 1. INTRODUCTION "Cyberspace. A consensual hallucination experienced daily by billions of legitimate operators, in every nation, by children being taught mathematical concepts ... A graphic representation of data abstracted from the banks of every computer in the human system. Unthinkable com- plexity. Lines of light ranged in the nonspace of the mind, clusters and constellations of data. Like city lights, receding ...." [Gibson, Neuromancer] The PSIBER Space Deck is a programming tool that lets you graphically display, manipulate, and navigate the many PostScript data structures, pro- grams, and processes living in the virtual memory space of NeWS. The Network extensible Window System (NeWS) is a multitasking object oriented PostScript programming environment. NeWS programs and data struc- tures make up the window system kernel, the user interface toolkit, and even entire applications. The PSIBER Space Deck is one such application, written entirely in PostScript, the result of an experiment in using a graphical programming environment to construct an interactive visual user interface to itself. It displays views of structured data objects in overlapping windows that can be moved around on the screen, and manipulated with the mouse: you can copy and paste data structures from place to place, execute them, edit them, - 1 - open up compound objects to see their internal structure, adjust the scale to shrink or magnify parts of the display, and pop up menus of other useful com- mands. Deep or complex data structures can be more easily grasped by applying various views to them. There is a text window onto a NeWS process, a PostScript interpreter with which you can interact (as with an "executive"). PostScript is a stack based language, so the window has a spike sticking up out of it, representing the process's operand stack. Objects on the process's stack are displayed in win- dows with their tabs pinned on the spike. (See figure 1) You can feed PostScript expressions to the interpreter by typing them with the keyboard, or pointing and clicking at them with the mouse, and the stack display will be dynamically updated to show the results. Not only can you examine and manipulate the objects on the stack, but you can also manipulate the stack directly with the mouse. You can drag the objects up and down the spike to change their order on the stack, and drag them on and off the spike to push and pop them; you can take objects off the spike and set them aside to refer to later, or close them into icons so they don't take up as much screen space. NeWS processes running in the same window server can be debugged using the existing NeWS debug commands in harmony with the graphical stack and object display. The PSIBER Space Deck can be used as a hands on way to learn about pro- gramming in PostScript and NeWS. You can try out examples from cookbooks and manuals, and explore and enrich your understanding of the environment with the help of the interactive data structure display. 2. INTERACTING WITH DATA A PostScript object is a reference to any piece of data, that you can push onto the stack. (The word "object" is used here in a more general sense than in "object oriented programming." The words "class" and "instance" are used for those concepts.) Each object has a type, some attributes, and a value. PostScript objects are dynamically typed, like Lisp objects, not stati- cally typed, like C variables. Each object is either literal or executable. This attribute effects whether the interpreter treats it as data or instruc- tions. Compound objects, such as arrays and dictionaries, can contain refer- ences to other objects of any type. [Adobe, Red, Green, and Blue books] [Sun, NeWS 1.1 Manual] [Gosling, The NeWS Book] 2.1. Viewing Data Objects on the PSIBER Space Deck appear in overlapping windows, with labeled tabs sticking out of them. Each object has a label, denoting its type and value, i.e. "integer 42". Each window tab shows the type of the object directly contained in the window. Objects nested within other objects have their type displayed to the left of their value. The labels of executable objects are displayed in italics. - 2 - 2.1.1. Simple Objects Figure 1 shows some simple objects: an integer, a boolean, a literal string, an executable string, a literal name, and an executable name -- the results of executing the string "42 false (flamingo) (45 cos 60 mul) cvx /foobar /executive cvx". Strings are delimited by parenthesis: "string (flamingo)". Literal names are displayed with a slash before them: "name /foobar". Executable names are displayed in italics, without a leading slash: "name executive". Names are most often used as keys in dictionaries, associated with the values of vari- ables and procedures. 2.1.2. Compound Objects Compound objects, which contain other objects, can be displayed closed or opened. The two basic kinds of compound objects are arrays and dictionaries. Arrays are indexed by integers, and dictionaries are indexed by keys. Figure 2 shows a literal array, an executable array, and a dictionary. An opened compound object is drawn with lines fanning out to the right, leading from the object to its elements, which are labeled as "index: type value", in a smaller point size. Literal arrays are displayed with their length enclosed in square brack- ets: "array [6]". Executable arrays (procedures) are displayed in italics, with their length enclosed in braces: "array {37}". The lines fanning out from an opened array to its elements are graphically embraced, so they resem- ble the square brackets or braces in the label of a literal or executable array. PostScript arrays are polymorphic: Each array element can be an object of any type. A PostScript procedure is just an executable array of other objects, to be interpreted one after the other. The label of a dictionary shows the number of keys it contains, a slash, and the maximum size of the dictionary, enclosed in angled brackets: "dict <5/10>". The lines that fan out from opened dictionaries resemble the angled brackets appearing in their labels. Dictionaries associate keys with values. The key (an index into a dic- tionary) can be an object of any type (except null), but is usually a name. The value can be anything at all. Dictionaries are used to hold the values of variables and function definitions, and as local frames, structures, lookup tables, classes, instances, and lots of other things -- they're very useful! The dictionary stack defines the scope of a PostScript process. Whenever a name is executed or loaded, the dictionaries on the dictionary stack are searched, in top to bottom order. - 3 - 2.1.3. Classes, Instances, and Magic Dictionaries NeWS uses an object oriented PostScript programming package, which represents classes and instances with dictionaries. [Densmore, Object Oriented Programming in NeWS] [Gosling, The NeWS Book] When a class dictionary is displayed, the class name is shown, instead of the "dict" type: "Object <10/200>". When an instance dictionary is displayed, its type is shown as a period followed by its class name: ".SoftMenu <31/200>". Figure 3 shows the class dictionary of Object, and the instance diction- ary of the NeWS root menu. Magic dictionaries are certain types of NeWS objects, such as processes, canvases, and events, that act as if they were dictionaries, but have some special internal representation. They have a fixed set of keys with special meanings (such as a process's "/OperandStack", or a canvas's "/TopChild"), that can be accessed with normal dictionary operations. Special things may happen when you read or write the values of the keys (for example, setting the "/Mapped" key of a canvas to false makes it immediately disappear from the screen). [Sun, NeWS 1.1 Manual] [Gosling, The NeWS Book] Figure 4 shows a canvas magic dictionary (the framebuffer), and a process magic dictionary, with some interesting keys opened. 2.1.4. View Characteristics The views of the objects can be adjusted in various ways. The point size can be changed, and well as the shrink factor by which the point size is mul- tiplied as the structure gets deeper. The point size is not allowed to shrink smaller than 1, so that labels will never have zero area, and it will always be possible to select them with the mouse. If the shrink factor is greater than 1.0, the point size increases with depth. The nested elements of a compound object can be drawn either to the right of the object label, or indented below it. When the elements are drawn indented below the label, it is not as visually obvious which elements are nested inside of which object, but it takes up a lot less screen space than drawing the elements to the right of the label does. Any of the view characteristics can be set for a whole window, or for any nested object and its children within that window. Figure 5 shows some nested structures with various point sizes and shrink factors, with elements opened to the right and below. 2.2. Editing Data There are many ways to edit the objects displayed on the screen. There are functions on menus for converting from type to type, and for changing the object's attributes and value. You can replace an element of a compound object by selecting another object, and pasting it into the element's slot. There are also a bunch of array manipulation functions, for appending together - 4 - arrays, breaking them apart, rearranging them, and using them as stacks. You must be careful which objects you edit, because if you accidentally scramble a crucial system function, the whole window system could crash. 2.3. Peripheral Controls Peripheral controls are associated views that you can attach to an object, which are not directly contained within that object. They are visu- ally distinct from the elements of a compound object, and can be used to attach editor buttons, computed views, and related objects. Several useful peripheral views have been implemented for manipulating various data types. There are three types of numeric editors: the step editor, the shift edi- tor, and the digit editor. The step editor has "++" and "--" buttons to increment and decrement the number it's attached to, by the parameter "Step". The shift editor has "**" and "//" buttons to multiply and divide the number it's attached to, by the parameter "Shift". The "Step" and "Shift" parameters appear in the peripheral views as normal editable numbers, to which you can attach other numeric editors, nested as deep as you like. The digit editor behaves like a numeric keypad, with buttons for the digits 0 through 9, "Rubout", "Clear", and "+-". The boolean editor has "True", "False", and "Not" buttons that do the obvious things, and a "Random" button, that sets the boolean value randomly. Since the button functions are just normal data, you can open up the "Random" button and edit the probability embedded in the function "{random 0.5 lt}". You can open up a definition editor on a name, to get editable references to every definition of the name on the dictionary stack (or in the context to which the enclosing class editor is attached). The scroller editor allows you to view a reasonably sized part of a large array or dictionary. The peripheral controls include a status line telling the size of the object and how much of it is shown in the view, "Back" and "Next" buttons for scrolling the view, and a "Size" parameter that controls the number of elements in the view. You can edit the "Size" parameter of the scrolling view by attaching a numeric editor to it, or dropping another number into its slot, and it will take effect next time you scroll the view. When you open a class editor, it attaches the following peripheral views: "ClassDicts", an array of the class dictionaries, "SubClasses", an array of a class's subclasses, "InstanceVars", an array of instance variable names, "ClassVars", an array class variable names, and "Methods", an array of method names. You can open up scrolling views on the arrays, and open up definition editors on the names, and you will be able to examine and edit the definitions in the class. The canvas editor gives you a graphical view of the canvas's relation to its parent, and an array of the canvas's children. You can grab the graphical view of the canvas with the mouse and move the canvas itself around. You can open up the array of child canvases (with a scroller editor if you like), and attach canvas views to them, too. - 5 - Figure 6 shows some digit editors, step editors, shift editors, a boolean editor, and a canvas editor. Figure 7 shows a class editor, some scroller editors, name editors, and digit editors. 2.4. Printing Distilled PostScript The data structure displays (including those of the Pseudo Scientific Visualizer, described below) can be printed on a PostScript printer by captur- ing the drawing commands in a file. Glenn Reid's "Distillery" program is a PostScript optimizer, that exe- cutes a page description, and (in most cases) produces another smaller, more efficient PostScript program, that prints the same image. [Reid, The Distil- lery] The trick is to redefine the path consuming operators, like fill, stroke, and show, so they write out the path in device space, and incremental changes to the graphics state. Even though the program that computes the display may be quite complicated, the distilled graphical output is very sim- ple and low level, with all the loops unrolled. The NeWS distillery uses the same basic technique as Glenn Reid's Distil- lery, but it is much simpler, does not optimize as much, and is not as com- plete. 3. INTERACTING WITH THE INTERPRETER In PostScript, as in Lisp, instructions and data are made out of the same stuff. One of the many interesting implications is that tools for manipulating data structures can be used on programs as well. 3.1. Using the Keyboard You can type PostScript expressions into a scrolling text window, and interact with the traditional PostScript "executive," as you can with "psh" to NeWS or "tip" to a laser printer. Certain function keys and control charac- ters do things immediately when you type them, such as input editing, select- ing the input, pushing or executing the selection, and completing names over the dictionary stack (like "tcsh" file name completion). 3.2. Using the Mouse The mouse can be used to select data, push it on the stack, execute it, and manipulate it in many ways. Pointing the cursor at an object and clicking the "Menu" button pops up a menu of operations that can be performed on it. All data types have the same top level pop-up menu (for uniformity), with a type specific submenu (for diversity). There are lots of commands for manipulating the object and the view available via pop-up menus. You can select any object by clicking the "Point" button on it. A printed representation of the current selection is always displayed in a field at the top of the scrolling text window. If you click the Point button over an object whose label is too small to read, it will appear in the selection field, in a comfortable font. - 6 - Each object has its own button handler function that is called when you click the "Adjust" button on it. The default "Adjust" handler implements "drag'n'dropping". If you drop an object onto itself, its view toggles open or closed. If you drop it on top of a compound object element, it is stored into that memory location. If you drop it over an unoccupied spot, a new win- dow viewing the object appears on the deck. Another useful "Adjust" handler simply executes the object that was clicked on. This can be used to make buttons out of executable names, arrays, and strings. 3.3. Using Dictionaries as Command Pallets A PostScript dictionary can be used as a pallet of commands, by defining a bunch of useful functions in a dictionary, opening it up, and executing the functions with the mouse. You can open up the functions to see their instruc- tions, and even edit them! 3.4. Using a Text Editor It is very helpful to be running a text editor on the source code of a PostScript program, while you are debugging it. You can select chunks of source from the text editor, and execute them in the PSIBER Space Deck (in the appropriate context). This is especially useful for redefining functions of a running program in memory, as bugs are discovered and fixed in the source code. It saves you from having to kill and restart your application every time you find a trivial bug. 4. DEBUGGING PROGRAMS The NeWS debugger lets you take on and examine the state of a broken pro- cess. [Sun, NeWS 1.1 Manual] [Gosling, The NeWS Book] The debugger is a PostScript program originally written for use with "psh" from a terminal emu- lator. It is notorious for being difficult to use, but quite powerful. How- ever, the debugger is much nicer in conjunction with the graphical stack, the object display, and a pallet of handy debugging commands, that you can invoke with the mouse. When you enter a broken process with the debugger, you get a copy of its operand and dictionary stacks. You can examine and manipulate the objects on the stack, look at the definitions of functions and variables, and execute instructions in the scope of the broken process. You can change the stack, copy it back, and continue the process, or just kill it. You can push onto the spike the broken process, its dictionary stack, and its execution stack, and open them up to examine the process's state. I use the debugger extensively in developing the PSIBER Space Deck, both from a terminal emulator and from the deck itself. Using the deck to debug itself is an interesting experience. One of the most common uses is to rede- fine a function by selecting some text in from Emacs and executing it. But it's still easy to make a mistake and crash it. - 7 - 5. THE USER INTERFACE 5.1. Pie Menus The mouse button functions and menu layouts were designed to facilitate gestural interaction, to simulate the feel of tweaking and poking at real live data structures. There are several "pull out" pie menus, that use the cursor distance from the menu center as an argument to the selection. The pie menu that pops up over data objects has the commonly used func- tions "Push," "Exec," and "Paste" positioned in easily selected directions (up, down, and left). Once you are familiar enough with the interface to "mouse ahead" into the menus, with quick strokes of the mouse in the appropri- ate direction, interaction can be very swift. [Callahan, A Comparative Analysis of Pie Menu Performance] [Hopkins, A Pie Menu Cookbook] When you mouse ahead through a pie menu selection quickly enough, the menu is not displayed, and the shape of a pac-man briefly flashes on the screen, with its mouth pointing in the direction of the selected menu item. This "mouse ahead display suppression" speeds up interaction considerably by avoiding unnecessary menu display, and makes it practically impossible for the casual observer to follow what is going on. The flashing pac-man effect gives you some computationally inexpensive feedback of the menu selection, and reas- sures observers that you are racking up lots of points. 5.2. Tab Windows The objects on the deck are displayed in windows with labeled tabs stick- ing out of them, showing the data type of the object. You can move an object around by grabbing its tab with the mouse and dragging it. You can perform direct stack manipulation, pushing it onto stack by dragging its tab onto the spike, and changing its place on the stack by dragging it up and down the spike. It implements a mutant form of "Snap-dragging", that constrains non- vertical movement when an object is snapped onto the stack, but allows you to pop it off by pulling it far enough away or lifting it off the top. [Bier, Snap-dragging] The menu that pops up over the tab lets you do things to the whole window, like changing view characteristics, moving the tab around, repainting or recomputing the layout, and printing the view. 6. THE METACIRCULAR POSTSCRIPT INTERPRETER A program that interprets the language it is written in is said to be "metacircular". [Abelson, Structure and Interpretation of Computer Programs] Since PostScript, like Scheme, is a simple yet powerful language, with pro- cedures as first class data structures, implementing "ps.ps", a metacircular PostScript interpreter, turned out to be straightforward (or drawrofthgiarts, with respect to the syntax). A metacircular PostScript interpreter should be compatible with the "exec" operator (modulo bugs and limitations). Some of the key ideas came from Crispin Goswell's PostScript implementation. [Gos- well, An Implementation of PostScript] - 8 - The metacircular interpreter can be used as a debugging tool, to trace and single step through the execution of PostScript instructions. It calls a trace function before each instruction, that you can redefine to trace the execution in any way. One useful trace function animates the graphical stack on the PSIBER Space Deck step by step. The meta-execution stack is a PostScript array, into which the metacircu- lar interpreter pushes continuations for control structures. (forall, loop, stopped, etc...) A continuation is represented as a dictionary in which the state needed by the control structure is stored (plus some other information to help with debugging). It is written in such a way that it can interpret itself: It has its own meta-execution stack to store the program's state, and it stashes its own state on the execution stack of the interpreter that's interpreting it, so the meta-interpreter's state does not get in the way of the program it's inter- preting. It is possible to experiment with modifications and extensions to PostScript, by revectoring functions and operators, and modifying the metacir- cular interpreter. The metacircular interpreter can serve as a basis for PostScript algo- rithm animation. One very simple animation is a two dimensional plot of the operand stack depth (x), against the execution stack depth (y), over time. 7. THE PSEUDO SCIENTIFIC VISUALIZER "Darkness fell in from every side, a sphere of singing black, pressure on the extended crystal nerves of the universe of data he had nearly become... And when he was nothing, compressed at the heart of all that dark, there came a point where the dark could be no more, and something tore. The Kuang program spurted from tarnished cloud, Case's consciousness divided like beads of mercury, arcing above an endless beach the color of the dark silver clouds. His vision was spherical, as though a single retina lined the inner surface of a globe that contained all things, if all things could be counted. " [Gibson, Neuromancer] The Pseudo Scientific Visualizer is the object browser for the other half of your brain, a fish-eye lens for the macroscopic examination of data. It can display arbitrarily large, arbitrarily deep structures, in a fixed amount of space. It shows form, texture, density, depth, fan out, and complexity. It draws a compound object as a circle, then recursively draws its ele- ments, scaled smaller, in an evenly spaced ring, rotated around the circle. The deeper an object, the smaller it is. It will only draw to a certain depth, which you can change while the drawing is in progress. It has simple graphical icons for different data types. An array is a circle, and a dictionary is a circle with a dot. The icon for a string is a line, whose length depends on the length of the string. A name is a triangle. - 9 - A boolean is a peace sign or an international no sign. An event is an envelope. A process is a Porsche. It randomly forks off several light weight processes, to draw different parts of the display, so there is lots of drawing going on in different places at once, and the overlapping is less regular. After the drawing is complete, the circular compound objects become mouse sensitive, selectable targets. The targets are implemented as round tran- sparent NeWS canvases. When you move the cursor over one, it highlights, and you can click on it to zoom in, pop up a description of it, open up another view of it, or select it, and then push it onto the stack of the PSIBER Space Deck. Figure 8 shows a Pseudo Scientific visualization of the NeWS rootmenu instance dictionary, also shown in figure 3 and figure 7. Figure 9 shows two views of a map of the ARPAnet. Figure 10 shows two views of a map of Adven- ture. 8. REFERENCES Abelson, Harold; Sussman, Gerald Structure and Interpretation of Computer Programs; 1985; The MIT Press, Cambridge, Mass. and McGraw Hill, New York Adobe Systems PostScript Language Tutorial and Cookbook (The Blue Book); 1985; Addison-Wesley Publishing Company, Inc., Reading, Mass. PostScript Language Reference Manual (The Red Book); 1985; Addison-Wesley Publishing Company, Inc., Reading, Mass. Adobe Systems; Reid, Glenn C. PostScript Language Program Design (The Green Book); 1988; Addison-Wesley Publishing Company, Inc., Reading, Mass. Bier, Eric A.; Stone, Maureen Snap-dragging; SIGGRAPH'86 Proceedings; Page 233-240; 1986; ACM, New York Callahan, Jack; Hopkins, Don; Weiser, Mark; Shneiderman, Ben A Comparative Analysis of Pie Menu Performance; Proc. CHI'88 conference, Washington D.C.; 1988; ACM, New York Densmore, Owen Object Oriented Programming in NeWS; November 1986; USENIX Monterey Com- puter Graphics Workshop; Usenix Association Gibson, William Neuromancer; 1984; ACE Science Fiction Books; The Berkley Publishing Group, New York Gosling, James; Rosenthal, David S.H.; Arden, Michelle The NeWS Book; 1989; Springer-Verlag, New York - 10 - Goswell, Crispin "An Implementation of PostScript", in Workstations and Publication Sys- tems; Rae A. Earnshaw, Editor; 1987; Springer-Verlag, New York Hopkins, Don "Directional Selection is Easy as Pie Menus!", in ;login: The USENIX Association Newsletter; Volume 12, Number 5; September/October 1987; Page 31 A Pie Menu Cookbook: Techniques for the Design of Circular Menus; (Paper in preparation. Draft available from author.) Hopkins, Don; Callahan, Jack; Weiser, Mark Pies: Implementation, Evaluation, and Application of Circular Menus; (Paper in preparation. Draft available from authors.) Reid, Glenn The Distillery (program); available from ps-file-server@adobe.com Shu, Nan C. Visual Programming; 1988; Van Nostrand Reinhold; New York Sun Microsystems NeWS 1.1 Manual; 1987; Sun Microsystems; Mountain View, California 9. ACKNOWLEDGMENTS This work could not have been done without the greatly appreciated sup- port of the University of Maryland Human-Computer Interaction Lab, Grasshopper Group, Sun Microsystems, and NCR Corporation. Many thanks to Owen Densmore, Hugh Daniel, Mike Gallaher, John Gilmore, James Gosling, Marja Koivunen, David LaVallee, Julia Menapace, Rehmi Post, Brian Raymor, Glenn Reid, David Rosenthal, Robin Schaufler, Ben Shneiderman, Josh Siegel, Stan Switzer, and Martha Zimet, people who gave me much valuable advice, encouragement, feedback, and lots of neat ideas. - 11 - From don Thu Nov 23 00:54:22 1989 Date: Thu, 23 Nov 89 00:54:22 -0500 To: NeWS-makers@brillig.umd.edu Subject: Shape of PSIBER Space, figure 4 From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) Here is one of the smaller figures, number 4. %! /label (Figure 4: Magic Dictionaries) def /family /Times-Bold def /size 24 def %clippath pathbbox 14.16 7.92 597.6 784.32 /top exch def /right exch def /bottom exch def /left exch def /margin 30 def newpath left margin add bottom margin add moveto right margin sub bottom margin add lineto right margin sub top margin sub lineto left margin add top margin sub lineto closepath gsave 0 setgray 0 setlinewidth stroke grestore clip newpath gsave family findfont size scalefont setfont /w label stringwidth pop def left right add 2 div w 2 div sub % x top margin sub size 1.5 mul sub % x y moveto 0 setgray label show grestore 100 dict begin /m /moveto load def /l /lineto load def /c /curveto load def /p /closepath load def /k /controlpoint where { /controlpoint get } { { pop lineto } } ifelse def /f /fill load def /e /eofill load def /s /stroke load def /t /show load def /x /newpath load def /n /setfont load def /gs /gsave load def /gr /grestore load def /sg /setgray load def /sh /sethsbcolor load def /sc /setlinecap load def /sj /setlinejoin load def /sw /setlinewidth load def /sm /setmiterlimit load def /sd /setdash load def gs 40 340 translate .3 .3 scale 30 1182 m 30 1217 l 98.266 1217 l 98.266 1182 l p /Courier-Bold findfont 1 scalefont dup /_f0 exch def n 1 sg 0 sc 0 sj 10 sm 0 sw f 30 1182 m 30 1217 l 98.266 1217 l 98.266 1182 l p 32 1184 m 32 1215 l 96.266 1215 l 96.266 1184 l p 0 sg e 30 30 m 30 1192 l 1720.546 1192 l 1720.546 30 l p 1 sg f 30 30 m 30 1192 l 1720.546 1192 l 1720.546 30 l p 32 32 m 32 1190 l 1718.546 1190 l 1718.546 32 l p 0 sg e /Helvetica-Bold findfont 14 scalefont dup /_f1 exch def n 36 1200 m (canvas \267)t /Courier-Bold findfont 32 scalefont dup /_f2 exch def n 39 602.75 m (can(0,0,1152,900))t 371.395 611 m 401.395 1183 l 416.395 1183 l s 371.395 611 m 401.395 1160.5 l 407.395 1160.5 l s 371.395 611 m 401.395 1138 l 407.395 1138 l s 371.395 611 m 401.395 1115.5 l 407.395 1115.5 l s 371.395 611 m 401.395 1093 l 407.395 1093 l s 371.395 611 m 401.395 1070.5 l 407.395 1070.5 l s 371.395 611 m 401.395 196.5 l 407.395 196.5 l s 371.395 611 m 401.395 174 l 407.395 174 l s 371.395 611 m 401.395 151.5 l 407.395 151.5 l s 371.395 611 m 401.395 129 l 407.395 129 l s 371.395 611 m 401.395 106.5 l 407.395 106.5 l s 371.395 611 m 401.395 84 l 407.395 84 l s 371.395 611 m 401.395 61.5 l 407.395 61.5 l s 371.395 611 m 401.395 39 l 416.395 39 l s 371.395 611 m 368.395 611 l s /Courier-Bold findfont 28.8 scalefont dup /_f3 exch def n 404.395 1165.5 m (/BottomCanvas : canvas can(0,0,1152,900))t 404.395 1143 m (/CanvasAbove : null null)t 404.395 1120.5 m (/CanvasBelow : null null)t 404.395 1098 m (/Color : boolean false)t 404.395 1075.5 m (/EventsConsumed : name /AllEvents)t 404.395 627.25 m (/Interests : array [2])t 820.547 1067.5 m 790.547 1067.5 l 790.547 202.5 l 820.547 202.5 l s 790.547 635 m 820.547 1067.5 l 835.547 1067.5 l s 790.547 635 m 820.547 636 l 826.547 636 l s 790.547 635 m 820.547 202.5 l 835.547 202.5 l s 790.547 635 m 787.547 635 l s /Courier-Bold findfont 25.92 scalefont dup /_f4 exch def n 823.547 1050 m (0 : event interest(/Damaged))t 833.547 840.5 m 863.547 1042 l 878.547 1042 l s 833.547 840.5 m 863.547 1024.5 l 869.547 1024.5 l s 833.547 840.5 m 863.547 1007 l 869.547 1007 l s 833.547 840.5 m 863.547 866.5 l 869.547 866.5 l s 833.547 840.5 m 863.547 849 l 869.547 849 l s 833.547 840.5 m 863.547 831.5 l 869.547 831.5 l s 833.547 840.5 m 863.547 814 l 869.547 814 l s 833.547 840.5 m 863.547 796.5 l 869.547 796.5 l s 833.547 840.5 m 863.547 779 l 869.547 779 l s 833.547 840.5 m 863.547 761.5 l 869.547 761.5 l s 833.547 840.5 m 863.547 744 l 869.547 744 l s 833.547 840.5 m 863.547 726.5 l 869.547 726.5 l s 833.547 840.5 m 863.547 709 l 869.547 709 l s 833.547 840.5 m 863.547 691.5 l 869.547 691.5 l s 833.547 840.5 m 863.547 674 l 869.547 674 l s 833.547 840.5 m 863.547 656.5 l 869.547 656.5 l s 833.547 840.5 m 863.547 639 l 878.547 639 l s 833.547 840.5 m 830.547 840.5 l 830.547 1045 l s /Courier-Bold findfont 23.328 scalefont dup /_f5 exch def n 866.547 1028.5 m (/Action : null null)t 866.547 1011 m (/Canvas : canvas can(0,0,1152,900))t 866.547 993.5 m (/ClientData : dict <1/10>)t 876.547 925 m 906.547 983.5 l 921.547 983.5 l s 876.547 925 m 906.547 866.5 l 921.547 866.5 l s 876.547 925 m 873.547 925 l 873.547 989.5 l s /Courier-BoldOblique findfont 20.995 scalefont dup /_f6 exch def n 909.547 922.25 m (/CallBack : array {6})t 1210.075 983.5 m 1180.075 955.75 l 1187.575 941.875 l 1210.075 872.5 m 1180.075 900.25 l 1187.575 914.125 l s 1180.075 928 m 1210.075 983.5 l 1225.075 983.5 l s 1180.075 928 m 1210.075 965 l 1216.075 965 l s 1180.075 928 m 1210.075 946.5 l 1216.075 946.5 l s 1180.075 928 m 1210.075 928 l 1216.075 928 l s 1180.075 928 m 1210.075 909.5 l 1216.075 909.5 l s 1180.075 928 m 1210.075 891 l 1216.075 891 l s 1180.075 928 m 1210.075 872.5 l 1225.075 872.5 l s 1180.075 928 m 1177.075 928 l s /Courier-BoldOblique findfont 18.895 scalefont dup /_f7 exch def n 1213.075 970 m (0 : operator `newprocessgroup')t 1213.075 951.5 m (1 : operator `damagepath')t 1213.075 933 m (2 : operator `clipcanvas')t 1213.075 914.5 m (3 : name PaintRoot)t 1213.075 896 m (4 : operator 'newpath')t 1213.075 877.5 m (5 : operator `clipcanvas')t _f5 n 866.547 853 m (/Exclusivity : boolean false)t 866.547 835.5 m (/Interest : null null)t 866.547 818 m (/IsInterest : boolean true)t 866.547 800.5 m (/IsQueued : boolean false)t 866.547 783 m (/KeyState : array [0])t 866.547 765.5 m (/Name : name /Damaged)t 866.547 748 m (/Priority : integer 0)t 866.547 730.5 m (/Process : process proc(input_wait,'awaitevent'))t 866.547 713 m (/Serial : real 0.1621)t 866.547 695.5 m (/TimeStamp : integer 0)t 866.547 678 m (/Timestamp : real 0.275)t 866.547 660.5 m (/XLocation : integer -183)t 866.547 643 m (/YLocation : integer 172)t _f4 n 823.547 618.5 m (1 : event interest(/RightMouseButton))t 833.547 408 m 863.547 610.5 l 878.547 610.5 l s 833.547 408 m 863.547 593 l 869.547 593 l s 833.547 408 m 863.547 575.5 l 869.547 575.5 l s 833.547 408 m 863.547 433 l 869.547 433 l s 833.547 408 m 863.547 415.5 l 869.547 415.5 l s 833.547 408 m 863.547 398 l 869.547 398 l s 833.547 408 m 863.547 380.5 l 869.547 380.5 l s 833.547 408 m 863.547 363 l 869.547 363 l s 833.547 408 m 863.547 345.5 l 869.547 345.5 l s 833.547 408 m 863.547 328 l 869.547 328 l s 833.547 408 m 863.547 310.5 l 869.547 310.5 l s 833.547 408 m 863.547 293 l 869.547 293 l s 833.547 408 m 863.547 275.5 l 869.547 275.5 l s 833.547 408 m 863.547 258 l 869.547 258 l s 833.547 408 m 863.547 240.5 l 869.547 240.5 l s 833.547 408 m 863.547 223 l 869.547 223 l s 833.547 408 m 863.547 205.5 l 878.547 205.5 l s 833.547 408 m 830.547 408 l 830.547 613.5 l s _f5 n 866.547 597 m (/Action : name /DownTransition)t 866.547 579.5 m (/Canvas : canvas can(0,0,1152,900))t 866.547 562 m (/ClientData : dict <1/10>)t 876.547 492.5 m 906.547 552 l 921.547 552 l s 876.547 492.5 m 906.547 433 l 921.547 433 l s 876.547 492.5 m 873.547 492.5 l 873.547 558 l s _f6 n 909.547 489.75 m (/CallBack : array {3})t 1210.075 549 m 1180.075 520.75 l 1187.575 506.625 l 1210.075 436 m 1180.075 464.25 l 1187.575 478.375 l s 1180.075 492.5 m 1210.075 549 l 1225.075 549 l s 1180.075 492.5 m 1210.075 473 l 1216.075 473 l s 1180.075 492.5 m 1210.075 454.5 l 1216.075 454.5 l s 1180.075 492.5 m 1210.075 436 l 1225.075 436 l s 1180.075 492.5 m 1177.075 492.5 l s _f7 n 1213.075 508.25 m (0 : array {4})t 1396.454 549 m 1366.454 531.5 l 1373.954 522.75 l 1396.454 479 m 1366.454 496.5 l 1373.954 505.25 l s 1366.454 514 m 1396.454 549 l 1411.454 549 l s 1366.454 514 m 1396.454 531.5 l 1402.454 531.5 l s 1366.454 514 m 1396.454 514 l 1402.454 514 l s 1366.454 514 m 1396.454 496.5 l 1402.454 496.5 l s 1366.454 514 m 1396.454 479 l 1411.454 479 l s 1366.454 514 m 1363.454 514 l s /Courier-BoldOblique findfont 17.0054 scalefont dup /_f8 exch def n 1399.454 536.5 m (0 : operator `newprocessgroup')t /Courier-Bold findfont 17.0054 scalefont dup /_f9 exch def n 1399.454 519 m (1 : name /showat)t _f8 n 1399.454 501.5 m (2 : name rootmenu)t 1399.454 484 m (3 : operator `send')t _f7 n 1213.075 459.5 m (1 : operator 'fork')t 1213.075 441 m (2 : operator 'pop')t _f5 n 866.547 419.5 m (/Exclusivity : boolean false)t 866.547 402 m (/Interest : null null)t 866.547 384.5 m (/IsInterest : boolean true)t 866.547 367 m (/IsQueued : boolean false)t 866.547 349.5 m (/KeyState : array [0])t 866.547 332 m (/Name : name /RightMouseButton)t 866.547 314.5 m (/Priority : integer 0)t 866.547 297 m (/Process : process proc(input_wait,'awaitevent'))t 866.547 279.5 m (/Serial : real 0.071)t 866.547 262 m (/TimeStamp : integer 0)t 866.547 244.5 m (/Timestamp : real 0.275)t 866.547 227 m (/XLocation : integer -183)t 866.547 209.5 m (/YLocation : integer 172)t _f3 n 404.395 179 m (/Mapped : boolean true)t 404.395 156.5 m (/Parent : null null)t 404.395 134 m (/Retained : boolean false)t 404.395 111.5 m (/SaveBehind : boolean false)t 404.395 89 m (/TopCanvas : canvas can(84,682,207,207))t 404.395 66.5 m (/TopChild : canvas can(84,682,207,207))t 404.395 44 m (/Transparent : boolean false)t gr gs 40 40 translate .4 .4 scale 30 692.5 m 30 718.5 l 113.482 718.5 l 113.482 692.5 l p /Courier-Bold findfont 1 scalefont dup /_f0 exch def n 1 sg 0 sc 0 sj 10 sm 0 sw f 30 692.5 m 30 718.5 l 113.482 718.5 l 113.482 692.5 l p 32 694.5 m 32 716.5 l 111.482 716.5 l 111.482 694.5 l p 0 sg e 103.482 30 m 103.482 718.5 l 1281.3881 718.5 l 1281.3881 30 l p 1 sg f 103.482 30 m 103.482 718.5 l 1281.3881 718.5 l 1281.3881 30 l p 105.482 32 m 105.482 716.5 l 1279.3881 716.5 l 1279.3881 32 l p 0 sg e /Helvetica-Bold findfont 14 scalefont dup /_f1 exch def n 36 701.5 m (process \267)t /Courier-Bold findfont 32 scalefont dup /_f2 exch def n 112.482 689 m (proc(input_wait,'awaitevent'))t 122.482 354.5 m 152.482 673 l 167.482 673 l s 122.482 354.5 m 152.482 509.5 l 158.482 509.5 l s 122.482 354.5 m 152.482 487 l 158.482 487 l s 122.482 354.5 m 152.482 464.5 l 158.482 464.5 l s 122.482 354.5 m 152.482 442 l 158.482 442 l s 122.482 354.5 m 152.482 166.5 l 158.482 166.5 l s 122.482 354.5 m 152.482 135 l 158.482 135 l s 122.482 354.5 m 152.482 81 l 158.482 81 l s 122.482 354.5 m 152.482 58.5 l 158.482 58.5 l s 122.482 354.5 m 152.482 36 l 167.482 36 l s 122.482 354.5 m 119.482 354.5 l 119.482 679 l s /Courier-Bold findfont 28.8 scalefont dup /_f3 exch def n 155.482 586.5 m (/DictionaryStack : array [8])t 675.311 673 m 645.311 673 l 645.311 515.5 l 675.311 515.5 l s 645.311 594.25 m 675.311 673 l 690.311 673 l s 645.311 594.25 m 675.311 650.5 l 681.311 650.5 l s 645.311 594.25 m 675.311 628 l 681.311 628 l s 645.311 594.25 m 675.311 605.5 l 681.311 605.5 l s 645.311 594.25 m 675.311 583 l 681.311 583 l s 645.311 594.25 m 675.311 560.5 l 681.311 560.5 l s 645.311 594.25 m 675.311 538 l 681.311 538 l s 645.311 594.25 m 675.311 515.5 l 690.311 515.5 l s 645.311 594.25 m 642.311 594.25 l s /Courier-Bold findfont 25.92 scalefont dup /_f4 exch def n 678.311 655.5 m (0 : dict <910/2000>)t 678.311 633 m (1 : dict <100/200>)t 678.311 610.5 m (2 : Object <10/200>)t 678.311 588 m (3 : Item <41/200>)t 678.311 565.5 m (4 : LabeledItem <16/200>)t 678.311 543 m (5 : StructItem <194/200>)t 678.311 520.5 m (6 : .StructItem <69/200>)t _f3 n 155.482 492 m (/ErrorCode : name /none)t 155.482 469.5 m (/ErrorDetailLevel : integer 1)t /Courier-BoldOblique findfont 28.8 scalefont dup /_f5 exch def n 155.482 447 m (/Execee : operator 'awaitevent')t _f3 n 155.482 298 m (/ExecutionStack : array [10])t 675.311 439 m 645.311 439 l 645.311 172.5 l 675.311 172.5 l s 645.311 305.75 m 675.311 439 l 690.311 439 l s 645.311 305.75 m 675.311 416.5 l 681.311 416.5 l s 645.311 305.75 m 675.311 394 l 681.311 394 l s 645.311 305.75 m 675.311 371.5 l 681.311 371.5 l s 645.311 305.75 m 675.311 349 l 681.311 349 l s 645.311 305.75 m 675.311 317.5 l 681.311 317.5 l s 645.311 305.75 m 675.311 295 l 681.311 295 l s 645.311 305.75 m 675.311 249 l 681.311 249 l s 645.311 305.75 m 675.311 226.5 l 681.311 226.5 l s 645.311 305.75 m 675.311 195 l 681.311 195 l s 645.311 305.75 m 675.311 172.5 l 690.311 172.5 l s 645.311 305.75 m 642.311 305.75 l s /Courier-BoldOblique findfont 25.92 scalefont dup /_f6 exch def n 678.311 421.5 m (0 : array {66})t _f4 n 678.311 399 m (1 : integer 64)t _f6 n 678.311 376.5 m (2 : array {10})t _f4 n 678.311 354 m (3 : integer 4)t _f6 n 678.311 327 m (4 : array {1})t 916.481 346 m 886.481 341.375 l 893.981 339.063 l 916.481 327.5 m 886.481 332.125 l 893.981 334.438 l s 886.481 336.75 m 916.481 346 l 931.481 346 l s 886.481 336.75 m 916.481 327.5 l 931.481 327.5 l s 886.481 336.75 m 883.481 336.75 l s /Courier-BoldOblique findfont 23.328 scalefont dup /_f7 exch def n 919.481 332.5 m (0 : name eventloop)t _f4 n 678.311 300 m (5 : integer 1)t _f6 n 678.311 265.75 m (6 : array {2})t 916.481 292 m 886.481 282.75 l 893.981 278.125 l 916.481 255 m 886.481 264.25 l 893.981 268.875 l s 886.481 273.5 m 916.481 292 l 931.481 292 l s 886.481 273.5 m 916.481 273.5 l 922.481 273.5 l s 886.481 273.5 m 916.481 255 l 931.481 255 l s 886.481 273.5 m 883.481 273.5 l s _f7 n 919.481 278.5 m (0 : array {1})t 919.481 260 m (1 : operator 'loop')t _f4 n 678.311 231.5 m (7 : integer 2)t _f6 n 678.311 204.5 m (8 : array {1})t 916.481 223.5 m 886.481 218.875 l 893.981 216.563 l 916.481 205 m 886.481 209.625 l 893.981 211.938 l s 886.481 214.25 m 916.481 223.5 l 931.481 223.5 l s 886.481 214.25 m 916.481 205 l 931.481 205 l s 886.481 214.25 m 883.481 214.25 l s _f7 n 919.481 210 m (0 : operator 'awaitevent')t _f4 n 678.311 177.5 m (9 : integer 1)t _f3 n 155.482 144.5 m (/Interests : array [1])t 571.6331 163.5 m 541.6331 163.5 l 541.6331 141 l 571.6331 141 l s 541.6331 152.25 m 571.6331 163.5 l 586.6331 163.5 l s 541.6331 152.25 m 571.6331 141 l 586.6331 141 l s 541.6331 152.25 m 538.6331 152.25 l s _f4 n 574.6331 146 m (0 : event interest(<3/20>))t _f3 n 155.482 101.75 m (/OperandStack : array [2])t 623.472 132 m 593.472 132 l 593.472 87 l 623.472 87 l s 593.472 109.5 m 623.472 132 l 638.472 132 l s 593.472 109.5 m 623.472 109.5 l 629.472 109.5 l s 593.472 109.5 m 623.472 87 l 638.472 87 l s 593.472 109.5 m 590.472 109.5 l s _f4 n 626.472 114.5 m (0 : .StructItem <69/200>)t 626.472 92 m (1 : process proc(input_wait,'awaitevent'))t _f3 n 155.482 63.5 m (/SendContexts : array [0])t 155.482 41 m (/State : name /input_wait)t gr end % StillHeaderDict showpage From don Thu Nov 23 00:54:51 1989 Date: Thu, 23 Nov 89 00:54:51 -0500 To: NeWS-makers@brillig.umd.edu Subject: The Shape of PSIBER Space, figure 5. From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) Here is another one of the smaller illustrations, figure 5. %! /label (Figure 5: View Characteristics) def /family /Times-Bold def /size 24 def %clippath pathbbox 14.16 7.92 597.6 784.32 /top exch def /right exch def /bottom exch def /left exch def /margin 30 def newpath left margin add bottom margin add moveto right margin sub bottom margin add lineto right margin sub top margin sub lineto left margin add top margin sub lineto closepath gsave 0 setgray 0 setlinewidth stroke grestore clip newpath gsave family findfont size scalefont setfont /w label stringwidth pop def left right add 2 div w 2 div sub % x top margin sub size 1.5 mul sub % x y moveto 0 setgray label show grestore 100 dict begin /m /moveto load def /l /lineto load def /c /curveto load def /p /closepath load def /k /controlpoint where { /controlpoint get } { { pop lineto } } ifelse def /f /fill load def /e /eofill load def /s /stroke load def /t /show load def /x /newpath load def /n /setfont load def /gs /gsave load def /gr /grestore load def /sg /setgray load def /sh /sethsbcolor load def /sc /setlinecap load def /sj /setlinejoin load def /sw /setlinewidth load def /sm /setmiterlimit load def /sd /setdash load def gs 60 35 translate .4 .4 scale 30 1657 m 30 1683 l 94.036 1683 l 94.036 1657 l p /Courier-Bold findfont 1 scalefont dup /_f0 exch def n 1 sg 0 sc 0 sj 10 sm 0 sw f 30 1657 m 30 1683 l 94.036 1683 l 94.036 1657 l p 32 1659 m 32 1681 l 92.036 1681 l 92.036 1659 l p 0 sg e 84.036 30 m 84.036 1683 l 1159.864 1683 l 1159.864 30 l p 1 sg f 84.036 30 m 84.036 1683 l 1159.864 1683 l 1159.864 30 l p 86.036 32 m 86.036 1681 l 1157.864 1681 l 1157.864 32 l p 0 sg e /Helvetica-Bold findfont 14 scalefont dup /_f1 exch def n 36 1666 m (array \267)t /Courier-BoldOblique findfont 24 scalefont dup /_f2 exch def n 93.036 1659.5 m ({4})t 133.036 1648.5 m 103.036 1245.375 l 110.536 1043.813 l 133.036 36 m 103.036 439.125 l 110.536 640.688 l s 103.036 842.25 m 133.036 1648.5 l 148.036 1648.5 l s 103.036 842.25 m 133.036 1385 l 139.036 1385 l s 103.036 842.25 m 133.036 1025.5 l 139.036 1025.5 l s 103.036 842.25 m 133.036 616 l 139.036 616 l s 103.036 842.25 m 133.036 36 l 148.036 36 l s 103.036 842.25 m 100.036 842.25 l 100.036 1654.5 l s /Courier-Bold findfont 21.6 scalefont dup /_f3 exch def n 136.036 1513.5 m (0 : array [3])t 340.512 1645.5 m 310.512 1645.5 l 310.512 1388 l 340.512 1388 l s 310.512 1516.75 m 340.512 1645.5 l 355.512 1645.5 l s 310.512 1516.75 m 340.512 1587 l 346.512 1587 l s 310.512 1516.75 m 340.512 1525.5 l 346.512 1525.5 l s 310.512 1516.75 m 340.512 1388 l 355.512 1388 l s 310.512 1516.75 m 307.512 1516.75 l s /Courier-BoldOblique findfont 19.44 scalefont dup /_f4 exch def n 343.512 1613.5 m (0 : array {3})t 531.1392 1645.5 m 501.1392 1632.375 l 508.6392 1625.813 l 531.1392 1593 m 501.1392 1606.125 l 508.6392 1612.688 l s 501.1392 1619.25 m 531.1392 1645.5 l 546.1392 1645.5 l s 501.1392 1619.25 m 531.1392 1628 l 537.1392 1628 l s 501.1392 1619.25 m 531.1392 1610.5 l 537.1392 1610.5 l s 501.1392 1619.25 m 531.1392 1593 l 546.1392 1593 l s 501.1392 1619.25 m 498.1392 1619.25 l s /Courier-Bold findfont 17.496 scalefont dup /_f5 exch def n 534.1392 1633 m (0 : integer 1)t 534.1392 1615.5 m (1 : integer 2)t 534.1392 1598 m (2 : integer 3)t _f4 n 343.512 1552 m (1 : array {3})t 531.1392 1584 m 501.1392 1570.875 l 508.6392 1564.313 l 531.1392 1531.5 m 501.1392 1544.625 l 508.6392 1551.188 l s 501.1392 1557.75 m 531.1392 1584 l 546.1392 1584 l s 501.1392 1557.75 m 531.1392 1566.5 l 537.1392 1566.5 l s 501.1392 1557.75 m 531.1392 1549 l 537.1392 1549 l s 501.1392 1557.75 m 531.1392 1531.5 l 546.1392 1531.5 l s 501.1392 1557.75 m 498.1392 1557.75 l s /Courier-BoldOblique findfont 17.496 scalefont dup /_f6 exch def n 534.1392 1571.5 m (0 : name a)t 534.1392 1554 m (1 : name b)t 534.1392 1536.5 m (2 : name c)t _f4 n 343.512 1452.5 m (2 : array {3})t 531.1392 1522.5 m 501.1392 1490.375 l 508.6392 1474.313 l 531.1392 1394 m 501.1392 1426.125 l 508.6392 1442.188 l s 501.1392 1458.25 m 531.1392 1522.5 l 546.1392 1522.5 l s 501.1392 1458.25 m 531.1392 1505 l 537.1392 1505 l s 501.1392 1458.25 m 531.1392 1411.5 l 537.1392 1411.5 l s 501.1392 1458.25 m 531.1392 1394 l 546.1392 1394 l s 501.1392 1458.25 m 498.1392 1458.25 l s _f6 n 534.1392 1510 m (0 : name circular)t 534.1392 1454.5 m (1 : array {3})t 706.603 1502 m 676.603 1480.875 l 684.103 1470.313 l 706.603 1417.5 m 676.603 1438.625 l 684.103 1449.188 l s 676.603 1459.75 m 706.603 1502 l 721.603 1502 l s 676.603 1459.75 m 706.603 1484.5 l 712.603 1484.5 l s 676.603 1459.75 m 706.603 1435 l 712.603 1435 l s 676.603 1459.75 m 706.603 1417.5 l 721.603 1417.5 l s 676.603 1459.75 m 673.603 1459.75 l s /Courier-BoldOblique findfont 15.746 scalefont dup /_f7 exch def n 709.603 1489.5 m (0 : name circular)t 709.603 1456 m (1 : array {3})t 868.4193 1481.5 m 838.4193 1471.375 l 845.9193 1466.313 l 868.4193 1441 m 838.4193 1451.125 l 845.9193 1456.188 l s 838.4193 1461.25 m 868.4193 1481.5 l 883.4193 1481.5 l s 838.4193 1461.25 m 868.4193 1468 l 874.4193 1468 l s 838.4193 1461.25 m 868.4193 1454.5 l 874.4193 1454.5 l s 838.4193 1461.25 m 868.4193 1441 l 883.4193 1441 l s 838.4193 1461.25 m 835.4193 1461.25 l s /Courier-BoldOblique findfont 14.1712 scalefont dup /_f8 exch def n 871.4193 1471 m (0 : name circular)t 871.4193 1457.5 m (1 : array {3})t 871.4193 1444 m (2 : name structure)t _f7 n 709.603 1422.5 m (2 : name structure)t _f6 n 534.1392 1399 m (2 : name structure)t _f3 n 136.036 1371.5 m (1 : array [3])t 176.036 1364.5 m 146.036 1364.5 l 146.036 1028.5 l 176.036 1028.5 l s 146.036 1196.5 m 176.036 1364.5 l 191.036 1364.5 l s 146.036 1196.5 m 176.036 1287.5 l 182.036 1287.5 l s 146.036 1196.5 m 176.036 1210.5 l 182.036 1210.5 l s 146.036 1196.5 m 176.036 1028.5 l 191.036 1028.5 l s 146.036 1196.5 m 143.036 1196.5 l 143.036 1367.5 l s _f4 n 179.036 1351 m (0 : array {3})t 219.036 1343 m 189.036 1329.875 l 196.536 1323.313 l 219.036 1290.5 m 189.036 1303.625 l 196.536 1310.188 l s 189.036 1316.75 m 219.036 1343 l 234.036 1343 l s 189.036 1316.75 m 219.036 1325.5 l 225.036 1325.5 l s 189.036 1316.75 m 219.036 1308 l 225.036 1308 l s 189.036 1316.75 m 219.036 1290.5 l 234.036 1290.5 l s 189.036 1316.75 m 186.036 1316.75 l 186.036 1346 l s _f5 n 222.036 1330.5 m (0 : integer 1)t 222.036 1313 m (1 : integer 2)t 222.036 1295.5 m (2 : integer 3)t _f4 n 179.036 1274 m (1 : array {3})t 219.036 1266 m 189.036 1252.875 l 196.536 1246.313 l 219.036 1213.5 m 189.036 1226.625 l 196.536 1233.188 l s 189.036 1239.75 m 219.036 1266 l 234.036 1266 l s 189.036 1239.75 m 219.036 1248.5 l 225.036 1248.5 l s 189.036 1239.75 m 219.036 1231 l 225.036 1231 l s 189.036 1239.75 m 219.036 1213.5 l 234.036 1213.5 l s 189.036 1239.75 m 186.036 1239.75 l 186.036 1269 l s _f6 n 222.036 1253.5 m (0 : name a)t 222.036 1236 m (1 : name b)t 222.036 1218.5 m (2 : name c)t _f4 n 179.036 1197 m (2 : array {3})t 219.036 1189 m 189.036 1149.625 l 196.536 1129.938 l 219.036 1031.5 m 189.036 1070.875 l 196.536 1090.563 l s 189.036 1110.25 m 219.036 1189 l 234.036 1189 l s 189.036 1110.25 m 219.036 1171.5 l 225.036 1171.5 l s 189.036 1110.25 m 219.036 1049 l 225.036 1049 l s 189.036 1110.25 m 219.036 1031.5 l 234.036 1031.5 l s 189.036 1110.25 m 186.036 1110.25 l 186.036 1192 l s _f6 n 222.036 1176.5 m (0 : name circular)t 222.036 1159 m (1 : array {3})t 262.036 1151 m 232.036 1126.25 l 239.536 1113.875 l 262.036 1052 m 232.036 1076.75 l 239.536 1089.125 l s 232.036 1101.5 m 262.036 1151 l 277.036 1151 l s 232.036 1101.5 m 262.036 1133.5 l 268.036 1133.5 l s 232.036 1101.5 m 262.036 1069.5 l 268.036 1069.5 l s 232.036 1101.5 m 262.036 1052 l 277.036 1052 l s 232.036 1101.5 m 229.036 1101.5 l 229.036 1154 l s _f7 n 265.036 1138.5 m (0 : name circular)t 265.036 1121 m (1 : array {3})t 305.036 1113 m 275.036 1102.875 l 282.536 1097.813 l 305.036 1072.5 m 275.036 1082.625 l 282.536 1087.688 l s 275.036 1092.75 m 305.036 1113 l 320.036 1113 l s 275.036 1092.75 m 305.036 1099.5 l 311.036 1099.5 l s 275.036 1092.75 m 305.036 1086 l 311.036 1086 l s 275.036 1092.75 m 305.036 1072.5 l 320.036 1072.5 l s 275.036 1092.75 m 272.036 1092.75 l 272.036 1116 l s _f8 n 308.036 1102.5 m (0 : name circular)t 308.036 1089 m (1 : array {3})t 308.036 1075.5 m (2 : name structure)t _f7 n 265.036 1057 m (2 : name structure)t _f6 n 222.036 1036.5 m (2 : name structure)t _f3 n 136.036 1012 m (2 : array [3])t 176.036 1005 m 146.036 1005 l 146.036 619 l 176.036 619 l s 146.036 812 m 176.036 1005 l 191.036 1005 l s 146.036 812 m 176.036 928 l 182.036 928 l s 146.036 812 m 176.036 890 l 182.036 890 l s 146.036 812 m 176.036 619 l 191.036 619 l s 146.036 812 m 143.036 812 l 143.036 1008 l s /Courier-BoldOblique findfont 22 scalefont dup /_f9 exch def n 179.036 991.5 m (0 : array {3})t 219.036 983.5 m 189.036 970.375 l 196.536 963.813 l 219.036 931 m 189.036 944.125 l 196.536 950.688 l s 189.036 957.25 m 219.036 983.5 l 234.036 983.5 l s 189.036 957.25 m 219.036 966 l 225.036 966 l s 189.036 957.25 m 219.036 948.5 l 225.036 948.5 l s 189.036 957.25 m 219.036 931 l 234.036 931 l s 189.036 957.25 m 186.036 957.25 l 186.036 986.5 l s /Courier-Bold findfont 19.8 scalefont dup /_f10 exch def n 222.036 970 m (0 : integer 1)t 222.036 952.5 m (1 : integer 2)t 222.036 935 m (2 : integer 3)t /Courier findfont 8 scalefont dup /_f11 exch def n 179.036 921.5 m (1 : array {3})t 219.036 915.5 m 189.036 909.875 l 196.536 907.063 l 219.036 893 m 189.036 898.625 l 196.536 901.438 l s 189.036 904.25 m 219.036 915.5 l 234.036 915.5 l s 189.036 904.25 m 219.036 908 l 225.036 908 l s 189.036 904.25 m 219.036 900.5 l 225.036 900.5 l s 189.036 904.25 m 219.036 893 l 234.036 893 l s 189.036 904.25 m 186.036 904.25 l 186.036 918.5 l s /Courier findfont 7.2 scalefont dup /_f12 exch def n 222.036 909 m (0 : name a)t 222.036 901.5 m (1 : name b)t 222.036 894 m (2 : name c)t _f4 n 179.036 876.5 m (2 : array {3})t 219.036 868.5 m 189.036 806.875 l 196.536 776.063 l 219.036 622 m 189.036 683.625 l 196.536 714.438 l s 189.036 745.25 m 219.036 868.5 l 234.036 868.5 l s 189.036 745.25 m 219.036 867 l 225.036 867 l s 189.036 745.25 m 219.036 639.5 l 225.036 639.5 l s 189.036 745.25 m 219.036 622 l 234.036 622 l s 189.036 745.25 m 186.036 745.25 l 186.036 871.5 l s /Courier findfont 1 scalefont dup /_f13 exch def n 222.036 867 m (0 : name circular)t _f6 n 222.036 854.5 m (1 : array {3})t 262.036 846.5 m 232.036 795.5 l 239.536 770 l 262.036 642.5 m 232.036 693.5 l 239.536 719 l s 232.036 744.5 m 262.036 846.5 l 277.036 846.5 l s 232.036 744.5 m 262.036 839 l 268.036 839 l s 232.036 744.5 m 262.036 660 l 268.036 660 l s 232.036 744.5 m 262.036 642.5 l 277.036 642.5 l s 232.036 744.5 m 229.036 744.5 l 229.036 849.5 l s /Courier findfont 6 scalefont dup /_f14 exch def n 265.036 842 m (0 : name circular)t _f7 n 265.036 826.5 m (1 : array {3})t 305.036 818.5 m 275.036 779.625 l 282.536 760.188 l 305.036 663 m 275.036 701.875 l 282.536 721.313 l s 275.036 740.75 m 305.036 818.5 l 320.036 818.5 l s 275.036 740.75 m 305.036 801 l 311.036 801 l s 275.036 740.75 m 305.036 676.5 l 311.036 676.5 l s 275.036 740.75 m 305.036 663 l 320.036 663 l s 275.036 740.75 m 272.036 740.75 l 272.036 821.5 l s /Courier-BoldOblique findfont 16 scalefont dup /_f15 exch def n 308.036 806 m (0 : name circular)t _f8 n 308.036 790.5 m (1 : array {3})t 348.036 784.5 m 318.036 758.25 l 325.536 745.125 l 348.036 679.5 m 318.036 705.75 l 325.536 718.875 l s 318.036 732 m 348.036 784.5 l 363.036 784.5 l s 318.036 732 m 348.036 771 l 354.036 771 l s 318.036 732 m 348.036 693 l 354.036 693 l s 318.036 732 m 348.036 679.5 l 363.036 679.5 l s 318.036 732 m 315.036 732 l 315.036 787.5 l s /Courier-BoldOblique findfont 12.754 scalefont dup /_f16 exch def n 351.036 774 m (0 : name circular)t 351.036 760.5 m (1 : array {3})t 391.036 754.5 m 361.036 739.875 l 368.536 732.563 l 391.036 696 m 361.036 710.625 l 368.536 717.938 l s 361.036 725.25 m 391.036 754.5 l 406.036 754.5 l s 361.036 725.25 m 391.036 721 l 397.036 721 l s 361.036 725.25 m 391.036 708.5 l 397.036 708.5 l s 361.036 725.25 m 391.036 696 l 406.036 696 l s 361.036 725.25 m 358.036 725.25 l 358.036 757.5 l s /Courier-BoldOblique findfont 32 scalefont dup /_f17 exch def n 394.036 731 m (0 : name circular)t /Courier-BoldOblique findfont 11.479 scalefont dup /_f18 exch def n 394.036 711.5 m (1 : array {3})t 394.036 699 m (2 : name structure)t _f16 n 351.036 682.5 m (2 : name structure)t _f8 n 308.036 666 m (2 : name structure)t _f7 n 265.036 647.5 m (2 : name structure)t _f6 n 222.036 627 m (2 : name structure)t _f3 n 136.036 602.5 m (3 : array [3])t 176.036 595.5 m 146.036 595.5 l 146.036 39 l 176.036 39 l s 146.036 317.25 m 176.036 595.5 l 191.036 595.5 l s 146.036 317.25 m 176.036 533.5 l 182.036 533.5 l s 146.036 317.25 m 176.036 441.5 l 182.036 441.5 l s 146.036 317.25 m 176.036 39 l 191.036 39 l s 146.036 317.25 m 143.036 317.25 l 143.036 598.5 l s _f4 n 179.036 582 m (0 : array {3})t 219.036 574 m 189.036 564.625 l 196.536 559.938 l 219.036 536.5 m 189.036 545.875 l 196.536 550.563 l s 189.036 555.25 m 219.036 574 l 234.036 574 l s 189.036 555.25 m 219.036 561.5 l 225.036 561.5 l s 189.036 555.25 m 219.036 549 l 225.036 549 l s 189.036 555.25 m 219.036 536.5 l 234.036 536.5 l s 189.036 555.25 m 186.036 555.25 l 186.036 577 l s /Courier findfont 9.72 scalefont dup /_f19 exch def n 222.036 564.5 m (0 : integer 1)t 222.036 552 m (1 : integer 2)t 222.036 539.5 m (2 : integer 3)t _f4 n 179.036 520 m (1 : array {3})t 219.036 512 m 189.036 495.125 l 196.536 486.688 l 219.036 444.5 m 189.036 461.375 l 196.536 469.813 l s 189.036 478.25 m 219.036 512 l 234.036 512 l s 189.036 478.25 m 219.036 489.5 l 225.036 489.5 l s 189.036 478.25 m 219.036 467 l 225.036 467 l s 189.036 478.25 m 219.036 444.5 l 234.036 444.5 l s 189.036 478.25 m 186.036 478.25 l 186.036 515 l s /Courier-BoldOblique findfont 30.1313 scalefont dup /_f20 exch def n 222.036 494.5 m (0 : name a)t 222.036 472 m (1 : name b)t 222.036 449.5 m (2 : name c)t _f4 n 179.036 428 m (2 : array {3})t 219.036 420 m 189.036 325.5 l 196.536 278.25 l 219.036 42 m 189.036 136.5 l 196.536 183.75 l s 189.036 231 m 219.036 420 l 234.036 420 l s 189.036 231 m 219.036 401.5 l 225.036 401.5 l s 189.036 231 m 219.036 60.5 l 225.036 60.5 l s 189.036 231 m 219.036 42 l 234.036 42 l s 189.036 231 m 186.036 231 l 186.036 423 l s 222.036 406.5 m (0 : name circular)t 222.036 388 m (1 : array {3})t 262.036 380 m 232.036 300.875 l 239.536 261.313 l 262.036 63.5 m 232.036 142.625 l 239.536 182.188 l s 232.036 221.75 m 262.036 380 l 277.036 380 l s 232.036 221.75 m 262.036 361.5 l 268.036 361.5 l s 232.036 221.75 m 262.036 82 l 268.036 82 l s 232.036 221.75 m 262.036 63.5 l 277.036 63.5 l s 232.036 221.75 m 229.036 221.75 l 229.036 383 l s 265.036 366.5 m (0 : name circular)t 265.036 217.5 m (1 : array {3})t 452.6631 358.5 m 422.6631 290.875 l 430.1631 257.063 l 452.6631 88 m 422.6631 155.625 l 430.1631 189.438 l s 422.6631 223.25 m 452.6631 358.5 l 467.6631 358.5 l s 422.6631 223.25 m 452.6631 340 l 458.6631 340 l s 422.6631 223.25 m 452.6631 106.5 l 458.6631 106.5 l s 422.6631 223.25 m 452.6631 88 l 467.6631 88 l s 422.6631 223.25 m 419.6631 223.25 l s 455.6631 345 m (0 : name circular)t 455.6631 326.5 m (1 : array {3})t 495.6631 318.5 m 465.6631 266.25 l 473.1631 240.125 l 495.6631 109.5 m 465.6631 161.75 l 473.1631 187.875 l s 465.6631 214 m 495.6631 318.5 l 510.6631 318.5 l s 465.6631 214 m 495.6631 300 l 501.6631 300 l s 465.6631 214 m 495.6631 128 l 501.6631 128 l s 465.6631 214 m 495.6631 109.5 l 510.6631 109.5 l s 465.6631 214 m 462.6631 214 l 462.6631 321.5 l s 498.6631 305 m (0 : name circular)t 498.6631 209.75 m (1 : array {3})t 686.291 297 m 656.291 256.25 l 663.791 235.875 l 686.291 134 m 656.291 174.75 l 663.791 195.125 l s 656.291 215.5 m 686.291 297 l 701.291 297 l s 656.291 215.5 m 686.291 278.5 l 692.291 278.5 l s 656.291 215.5 m 686.291 152.5 l 692.291 152.5 l s 656.291 215.5 m 686.291 134 l 701.291 134 l s 656.291 215.5 m 653.291 215.5 l s 689.291 283.5 m (0 : name circular)t 689.291 265 m (1 : array {3})t 729.291 257 m 699.291 231.625 l 706.791 218.938 l 729.291 155.5 m 699.291 180.875 l 706.791 193.563 l s 699.291 206.25 m 729.291 257 l 744.291 257 l s 699.291 206.25 m 729.291 238.5 l 735.291 238.5 l s 699.291 206.25 m 729.291 174 l 735.291 174 l s 699.291 206.25 m 729.291 155.5 l 744.291 155.5 l s 699.291 206.25 m 696.291 206.25 l 696.291 260 l s 732.291 243.5 m (0 : name circular)t 732.291 202 m (1 : array {3})t 919.918 235.5 m 889.918 221.625 l 897.418 214.688 l 919.918 180 m 889.918 193.875 l 897.418 200.813 l s 889.918 207.75 m 919.918 235.5 l 934.918 235.5 l s 889.918 207.75 m 919.918 217 l 925.918 217 l s 889.918 207.75 m 919.918 198.5 l 925.918 198.5 l s 889.918 207.75 m 919.918 180 l 934.918 180 l s 889.918 207.75 m 886.918 207.75 l s 922.918 222 m (0 : name circular)t 922.918 203.5 m (1 : array {3})t 922.918 185 m (2 : name structure)t 732.291 160.5 m (2 : name structure)t 689.291 139 m (2 : name structure)t 498.6631 114.5 m (2 : name structure)t 455.6631 93 m (2 : name structure)t 265.036 68.5 m (2 : name structure)t 222.036 47 m (2 : name structure)t gr end % StillHeaderDict showpage From don Thu Nov 23 00:55:19 1989 Date: Thu, 23 Nov 89 00:55:19 -0500 To: NeWS-makers@brillig.umd.edu Subject: The Shape of PSIBER Space, figure 7. From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) And here is the other figure less than 100k, figure 7. (The others are screen dumps or extremely complicated PostScript drawings.) %! /label (Figure 7: Class Editor: rootmenu) def /family /Times-Bold def /size 24 def %clippath pathbbox 14.16 7.92 597.6 784.32 /top exch def /right exch def /bottom exch def /left exch def /margin 30 def newpath left margin add bottom margin add moveto right margin sub bottom margin add lineto right margin sub top margin sub lineto left margin add top margin sub lineto closepath gsave 0 setgray 0 setlinewidth stroke grestore clip newpath gsave family findfont size scalefont setfont /w label stringwidth pop def left right add 2 div w 2 div sub % x top margin sub size 1.5 mul sub % x y moveto 0 setgray label show grestore 100 dict begin /m /moveto load def /l /lineto load def /c /curveto load def /p /closepath load def /k /controlpoint where { /controlpoint get } { { pop lineto } } ifelse def /f /fill load def /e /eofill load def /s /stroke load def /t /show load def /x /newpath load def /n /setfont load def /gs /gsave load def /gr /grestore load def /sg /setgray load def /sh /sethsbcolor load def /sc /setlinecap load def /sj /setlinejoin load def /sw /setlinewidth load def /sm /setmiterlimit load def /sd /setdash load def gs 45 40 translate .38 .38 scale 30 1707.5 m 30 1733.5 l 127.4531 1733.5 l 127.4531 1707.5 l p /Courier-Bold findfont 1 scalefont dup /_f0 exch def n 1 sg 0 sc 0 sj 10 sm 0 sw f 30 1707.5 m 30 1733.5 l 127.4531 1733.5 l 127.4531 1707.5 l p 32 1709.5 m 32 1731.5 l 125.4531 1731.5 l 125.4531 1709.5 l p 0 sg e 117.4531 30 m 117.4531 1733.5 l 1313.5271 1733.5 l 1313.5271 30 l p 1 sg f 117.4531 30 m 117.4531 1733.5 l 1313.5271 1733.5 l 1313.5271 30 l p 119.4531 32 m 119.4531 1731.5 l 1311.5271 1731.5 l 1311.5271 32 l p 0 sg e /Helvetica-Bold findfont 14 scalefont dup /_f1 exch def n 36 1716.5 m (.SoftMenu \267)t /Courier-Bold findfont 28 scalefont dup /_f2 exch def n 126.4531 1710 m (<37/200>)t 133.4531 36 m 133.4531 1705 l s /Courier-Bold findfont 25.2 scalefont dup /_f3 exch def n 136.4531 1535 m (/ClassDicts : array [5])t 520.2052 1699 m 490.2052 1699 l 490.2052 1386.5 l 520.2052 1386.5 l s 490.2052 1542.75 m 520.2052 1699 l 535.2052 1699 l s 490.2052 1542.75 m 520.2052 1456.5 l 526.2052 1456.5 l s 490.2052 1542.75 m 520.2052 1439 l 526.2052 1439 l s 490.2052 1542.75 m 520.2052 1421.5 l 526.2052 1421.5 l s 490.2052 1542.75 m 520.2052 1404 l 526.2052 1404 l s 490.2052 1542.75 m 520.2052 1386.5 l 535.2052 1386.5 l s 490.2052 1542.75 m 487.2052 1542.75 l s /Courier-Bold findfont 22.68 scalefont dup /_f4 exch def n 523.2052 1685.5 m (0 : Object <10/200>)t 530.2052 1459.5 m 530.2052 1681.5 l s /Courier-Bold findfont 20.412 scalefont dup /_f5 exch def n 533.2052 1665 m (/ClassDicts : array [1])t 533.2052 1581.75 m (/SubClasses : array [8])t 850.881 1658 m 820.881 1658 l 820.881 1518 l 850.881 1518 l s 820.881 1588 m 850.881 1658 l 865.881 1658 l s 820.881 1588 m 850.881 1640.5 l 856.881 1640.5 l s 820.881 1588 m 850.881 1623 l 856.881 1623 l s 820.881 1588 m 850.881 1605.5 l 856.881 1605.5 l s 820.881 1588 m 850.881 1588 l 856.881 1588 l s 820.881 1588 m 850.881 1570.5 l 856.881 1570.5 l s 820.881 1588 m 850.881 1553 l 856.881 1553 l s 820.881 1588 m 850.881 1535.5 l 856.881 1535.5 l s 820.881 1588 m 850.881 1518 l 865.881 1518 l s 820.881 1588 m 817.881 1588 l s /Courier-Bold findfont 18.3702 scalefont dup /_f6 exch def n 853.881 1644.5 m (0 : name /EmacsFrame)t 853.881 1627 m (1 : name /EmacsSounder)t 853.881 1609.5 m (2 : name /EmacsTrm)t 853.881 1592 m (3 : Item <41/200>)t 853.881 1574.5 m (4 : LiteMenu <50/200>)t 853.881 1557 m (5 : LiteText <24/200>)t 853.881 1539.5 m (6 : LiteWindow <98/200>)t 853.881 1522 m (7 : TextCanvas <78/200>)t _f5 n 533.2052 1498.5 m (/InstanceVars : array [0])t 533.2052 1481 m (/ClassVars : array [7])t 533.2052 1463.5 m (/Methods : array [3])t _f4 n 523.2052 1443 m (1 : LiteMenu <50/200>)t 523.2052 1425.5 m (2 : SimplePieMenu <57/200>)t 523.2052 1408 m (3 : SoftMenu <24/200>)t 523.2052 1390.5 m (4 : .SoftMenu <37/200>)t _f3 n 136.4531 1323 m (/InstanceVars : array [32])t 565.5642 1377.5 m 535.5642 1377.5 l 535.5642 1284 l 565.5642 1284 l s 535.5642 1330.75 m 565.5642 1377.5 l 580.5642 1377.5 l s 535.5642 1330.75 m 565.5642 1360 l 571.5642 1360 l s 535.5642 1330.75 m 565.5642 1319 l 571.5642 1319 l s 535.5642 1330.75 m 565.5642 1301.5 l 571.5642 1301.5 l s 535.5642 1330.75 m 565.5642 1284 l 580.5642 1284 l s 535.5642 1330.75 m 532.5642 1330.75 l s _f4 n 568.5642 1364 m (14 : name /MenuEventMgr)t 568.5642 1346.5 m (15 : name /MenuHeight)t 575.5642 1322 m 575.5642 1342.5 l s _f5 n 578.5642 1326 m (.SoftMenu <37/200> /MenuHeight : integer 276)t _f4 n 568.5642 1305.5 m (16 : name /MenuItems)t 568.5642 1288 m (17 : name /MenuKeys)t 143.4531 1142.5 m 143.4531 1318 l _f3 n s _f4 n 146.4531 1261.5 m (/Scroll : string (/InstanceVars : array [32] : 14..17 of 32, 44%))t x 143.4531 1240 m 228.099 1240 l 231.099 1243 l 231.099 1254.5 l 228.099 1257.5 l 143.4531 1257.5 l _f3 n s /Courier-BoldOblique findfont 22.68 scalefont dup /_f7 exch def n 146.4531 1244 m ( Back )t x 143.4531 1221.5 m 228.099 1221.5 l 231.099 1224.5 l 231.099 1236 l 228.099 1239 l 143.4531 1239 l _f3 n s _f7 n 146.4531 1225.5 m ( Next )t _f4 n 146.4531 1207 m (/Size : integer 4)t 153.4531 1145.5 m 153.4531 1203 l s x 153.4531 1182.5 m 205.4401 1182.5 l 208.4401 1185.5 l 208.4401 1197 l 205.4401 1200 l 153.4531 1200 l s /Courier-BoldOblique findfont 20.412 scalefont dup /_f8 exch def n 156.4531 1186.5 m ( ++ )t x 153.4531 1164 m 205.4401 1164 l 208.4401 1167 l 208.4401 1178.5 l 205.4401 1181.5 l 153.4531 1181.5 l _f4 n s _f8 n 156.4531 1168 m ( -- )t _f5 n 156.4531 1149.5 m (/Step : integer 1)t _f3 n 136.4531 1061.5 m (/ClassVars : array [44])t 520.2052 1136.5 m 490.2052 1136.5 l 490.2052 1002 l 520.2052 1002 l s 490.2052 1069.25 m 520.2052 1136.5 l 535.2052 1136.5 l s 490.2052 1069.25 m 520.2052 1095.5 l 526.2052 1095.5 l s 490.2052 1069.25 m 520.2052 1037 l 526.2052 1037 l s 490.2052 1069.25 m 520.2052 1019.5 l 526.2052 1019.5 l s 490.2052 1069.25 m 520.2052 1002 l 535.2052 1002 l s 490.2052 1069.25 m 487.2052 1069.25 l s _f4 n 523.2052 1123 m (18 : name /MenuFillColor)t 530.2052 1098.5 m 530.2052 1119 l s _f5 n 533.2052 1102.5 m (LiteMenu <50/200> /MenuFillColor : color color(1,1,1))t _f4 n 523.2052 1082 m (19 : name /MenuFont)t 530.2052 1040 m 530.2052 1078 l s _f5 n 533.2052 1061.5 m (LiteMenu <50/200> /MenuFont : font font(Times-Roman14))t 533.2052 1044 m (SimplePieMenu <57/200> /MenuFont : font font(Helvetica-Bold12))t _f4 n 523.2052 1023.5 m (20 : name /MenuInterests)t 523.2052 1006 m (21 : name /MenuItemSize)t 143.4531 860.5 m 143.4531 1056.5 l _f3 n s _f4 n 146.4531 979.5 m (/Scroll : string (/ClassVars : array [44] : 18..21 of 44, 41%))t x 143.4531 958 m 228.099 958 l 231.099 961 l 231.099 972.5 l 228.099 975.5 l 143.4531 975.5 l _f3 n s _f7 n 146.4531 962 m ( Back )t x 143.4531 939.5 m 228.099 939.5 l 231.099 942.5 l 231.099 954 l 228.099 957 l 143.4531 957 l _f3 n s _f7 n 146.4531 943.5 m ( Next )t _f4 n 146.4531 925 m (/Size : integer 4)t 153.4531 863.5 m 153.4531 921 l s x 153.4531 900.5 m 205.4401 900.5 l 208.4401 903.5 l 208.4401 915 l 205.4401 918 l 153.4531 918 l s _f8 n 156.4531 904.5 m ( ++ )t x 153.4531 882 m 205.4401 882 l 208.4401 885 l 208.4401 896.5 l 205.4401 899.5 l 153.4531 899.5 l _f4 n s _f8 n 156.4531 886 m ( -- )t _f5 n 156.4531 867.5 m (/Step : integer 1)t _f3 n 136.4531 509.75 m (/Methods : array [52])t 489.966 854.5 m 459.966 854.5 l 459.966 180.5 l 489.966 180.5 l s 459.966 517.5 m 489.966 854.5 l 504.966 854.5 l s 459.966 517.5 m 489.966 837 l 495.966 837 l s 459.966 517.5 m 489.966 819.5 l 495.966 819.5 l s 459.966 517.5 m 489.966 303 l 495.966 303 l s 459.966 517.5 m 489.966 285.5 l 495.966 285.5 l s 459.966 517.5 m 489.966 268 l 495.966 268 l s 459.966 517.5 m 489.966 250.5 l 495.966 250.5 l s 459.966 517.5 m 489.966 233 l 495.966 233 l s 459.966 517.5 m 489.966 215.5 l 495.966 215.5 l s 459.966 517.5 m 489.966 198 l 495.966 198 l s 459.966 517.5 m 489.966 180.5 l 504.966 180.5 l s 459.966 517.5 m 456.966 517.5 l s _f4 n 492.966 841 m (40 : name /leafmenu)t 492.966 823.5 m (41 : name /makeinterests)t 492.966 806 m (42 : name /new)t 499.966 306 m 499.966 802 l s _f8 n 502.966 785.5 m (Object <10/200> /new : array {26})t 502.966 767 m (LiteMenu <50/200> /new : array {35})t 542.966 759 m 512.966 713.25 l 520.466 690.375 l 542.966 576 m 512.966 621.75 l 520.466 644.625 l s 512.966 667.5 m 542.966 759 l 557.966 759 l s 512.966 667.5 m 542.966 741.5 l 548.966 741.5 l s 512.966 667.5 m 542.966 723 l 548.966 723 l s 512.966 667.5 m 542.966 704.5 l 548.966 704.5 l s 512.966 667.5 m 542.966 686 l 548.966 686 l s 512.966 667.5 m 542.966 667.5 l 548.966 667.5 l s 512.966 667.5 m 542.966 649 l 548.966 649 l s 512.966 667.5 m 542.966 631.5 l 548.966 631.5 l s 512.966 667.5 m 542.966 613 l 548.966 613 l s 512.966 667.5 m 542.966 594.5 l 548.966 594.5 l s 512.966 667.5 m 542.966 576 l 557.966 576 l s 512.966 667.5 m 509.966 667.5 l 509.966 762 l s _f6 n 545.966 745.5 m (0 : name /new)t /Courier-BoldOblique findfont 18.3702 scalefont dup /_f9 exch def n 545.966 728 m (1 : name Object)t 545.966 709.5 m (2 : name supersend)t 545.966 691 m (3 : operator 'begin')t 545.966 672.5 m (4 : operator 'gsave')t 545.966 654 m (5 : operator 'dup')t _f6 n 545.966 635.5 m (6 : integer 0)t _f9 n 545.966 618 m (7 : operator 'get')t 545.966 599.5 m (8 : operator 'dup')t 545.966 581 m (9 : operator `xcheck')t 509.966 498 m 509.966 762 l _f8 n s _f6 n 512.966 556.5 m (/Scroll : string (LiteMenu <50/200> /new : array {35} : 0..9 of 35, 0%))t x 509.966 535 m 579.098 535 l 582.098 538 l 582.098 549.5 l 579.098 552.5 l 509.966 552.5 l _f8 n s _f9 n 512.966 539 m ( Back )t x 509.966 516.5 m 579.098 516.5 l 582.098 519.5 l 582.098 531 l 579.098 534 l 509.966 534 l _f8 n s _f9 n 512.966 520.5 m ( Next )t _f6 n 512.966 502 m (/Size : integer 10)t _f8 n 502.966 481.5 m (SoftMenu <24/200> /new : array {9})t 542.966 473.5 m 512.966 432.375 l 520.466 411.813 l 542.966 309 m 512.966 350.125 l 520.466 370.688 l s 512.966 391.25 m 542.966 473.5 l 557.966 473.5 l s 512.966 391.25 m 542.966 456 l 548.966 456 l s 512.966 391.25 m 542.966 437.5 l 548.966 437.5 l s 512.966 391.25 m 542.966 419 l 548.966 419 l s 512.966 391.25 m 542.966 400.5 l 548.966 400.5 l s 512.966 391.25 m 542.966 383 l 548.966 383 l s 512.966 391.25 m 542.966 364.5 l 548.966 364.5 l s 512.966 391.25 m 542.966 346 l 548.966 346 l s 512.966 391.25 m 542.966 327.5 l 548.966 327.5 l s 512.966 391.25 m 542.966 309 l 557.966 309 l s 512.966 391.25 m 509.966 391.25 l 509.966 476.5 l s _f6 n 545.966 460 m (0 : name /new)t _f9 n 545.966 442.5 m (1 : name SimplePieMenu)t 545.966 424 m (2 : name supersend)t 545.966 405.5 m (3 : operator 'begin')t _f6 n 545.966 387 m (4 : name /MenuLock)t _f9 n 545.966 369.5 m (5 : operator `createmonitor')t 545.966 351 m (6 : operator 'def')t 545.966 332.5 m (7 : operator 'currentdict')t 545.966 314 m (8 : operator 'end')t _f4 n 492.966 289.5 m (43 : name /paint)t 492.966 272 m (44 : name /popdown)t 492.966 254.5 m (45 : name /popup)t 492.966 237 m (46 : name /reshape)t 492.966 219.5 m (47 : name /searchaction)t 492.966 202 m (48 : name /searchitem)t 492.966 184.5 m (49 : name /searchkey)t 143.4531 39 m 143.4531 504.75 l _f3 n s _f4 n 146.4531 158 m (/Scroll : string (/Methods : array [52] : 40..49 of 52, 77%))t x 143.4531 136.5 m 228.099 136.5 l 231.099 139.5 l 231.099 151 l 228.099 154 l 143.4531 154 l _f3 n s _f7 n 146.4531 140.5 m ( Back )t x 143.4531 118 m 228.099 118 l 231.099 121 l 231.099 132.5 l 228.099 135.5 l 143.4531 135.5 l _f3 n s _f7 n 146.4531 122 m ( Next )t _f4 n 146.4531 103.5 m (/Size : integer 10)t 153.4531 42 m 153.4531 99.5 l s x 153.4531 79 m 205.4401 79 l 208.4401 82 l 208.4401 93.5 l 205.4401 96.5 l 153.4531 96.5 l s _f8 n 156.4531 83 m ( ++ )t x 153.4531 60.5 m 205.4401 60.5 l 208.4401 63.5 l 208.4401 75 l 205.4401 78 l 153.4531 78 l _f4 n s _f8 n 156.4531 64.5 m ( -- )t _f5 n 156.4531 46 m (/Step : integer 1)t gr end % StillHeaderDict showpage From don Thu Nov 23 01:00:49 1989 Date: Thu, 23 Nov 89 01:00:49 -0500 To: NeWS-makers@brillig.umd.edu Subject: Cyber Space Deck source code From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) This is the source to the software described in "The Shape of PSIBER Space: PostScript Interactive Bug Eradication Routines". It is a NeWS debugger, visual data structure editor, bla bla bla etc etc etc. The following 7 messages contain a split shar file. You should strip the headers and the trailers of the messages (so the files end with a newline, but don't have any extra leading or trailing empty lines), cat them together into cyber.shar, and type "sh cyber.shar" to unpack the files contained therein. Included is a typescript showing the vital statistics so you can verify that you have a good copy. This work could not have been done without the greatly appreciated support of the University of Maryland Human-Computer Interaction Lab, Grasshopper Group, Sun Microsystems, and NCR Corporation. -Don Script started on Wed Nov 22 23:33:41 1989 [tumtum:/tumtum/don/cyber/dist 1] l cyber* -rw-r--r-- 1 don 556240 Nov 22 23:28 cyber.shar -rw-rw-r-- 1 don 81269 Nov 22 23:32 cyber.shar.splitaa -rw-rw-r-- 1 don 93213 Nov 22 23:32 cyber.shar.splitab -rw-rw-r-- 1 don 60809 Nov 22 23:32 cyber.shar.splitac -rw-rw-r-- 1 don 62254 Nov 22 23:32 cyber.shar.splitad -rw-rw-r-- 1 don 63146 Nov 22 23:32 cyber.shar.splitae -rw-rw-r-- 1 don 60929 Nov 22 23:32 cyber.shar.splitaf -rw-rw-r-- 1 don 69273 Nov 22 23:32 cyber.shar.splitag -rw-rw-r-- 1 don 65347 Nov 22 23:32 cyber.shar.splitah [tumtum:/tumtum/don/cyber/dist 2] wc cyber* 19722 94959 556240 cyber.shar 2500 13299 81269 cyber.shar.splitaa 2500 14080 93213 cyber.shar.splitab 2500 10100 60809 cyber.shar.splitac 2500 11349 62254 cyber.shar.splitad 2500 11304 63146 cyber.shar.splitae 2500 10724 60929 cyber.shar.splitaf 2500 11646 69273 cyber.shar.splitag 2222 12457 65347 cyber.shar.splitah 39444 189918 1112480 total [tumtum:/tumtum/don/cyber/dist 3] sum cyber* 48052 544 cyber.shar 51348 80 cyber.shar.splitaa 18491 92 cyber.shar.splitab 19567 60 cyber.shar.splitac 30294 61 cyber.shar.splitad 62719 62 cyber.shar.splitae 08142 60 cyber.shar.splitaf 19856 68 cyber.shar.splitag 57381 64 cyber.shar.splitah [tumtum:/tumtum/don/cyber/dist 4] mkdir cyber [tumtum:/tumtum/don/cyber/dist 5] cd cyber [tumtum:/tumtum/don/cyber/dist/cyber 6] sh ../cyber.shar Extracting README -rw-r--r-- 1 don 725 Nov 22 23:34 README Extracting introduction -rw-r--r-- 1 don 30173 Nov 22 23:34 introduction Extracting piemenu.ps -rw-rw-r-- 1 don 34084 Nov 22 23:34 piemenu.ps Extracting pullout.ps -rw-rw-r-- 1 don 5590 Nov 22 23:34 pullout.ps Extracting quickwin.ps -rw-r--r-- 1 don 7663 Nov 22 23:34 quickwin.ps Extracting textcan.ps -rw-rw-r-- 1 don 83120 Nov 22 23:34 textcan.ps Extracting overlay.ps -rw-rw-r-- 1 don 14187 Nov 22 23:34 overlay.ps Extracting pointer.ps -rw-rw-r-- 1 don 12978 Nov 22 23:35 pointer.ps Extracting mics.ps -rw-rw-r-- 1 don 27330 Nov 22 23:35 mics.ps Extracting cyber.ps -rw-r--r-- 1 don 166395 Nov 22 23:35 cyber.ps Extracting distill.ps -rw-rw-r-- 1 don 9959 Nov 22 23:35 distill.ps Extracting ps.ps -rw-rw-r-- 1 don 17287 Nov 22 23:35 ps.ps Extracting scrap.ps -rw-rw-r-- 1 don 34241 Nov 22 23:35 scrap.ps Extracting cond.ps -rw-rw-r-- 1 don 1749 Nov 22 23:35 cond.ps Extracting trace.ps -rw-rw-r-- 1 don 27159 Nov 22 23:35 trace.ps Extracting doc.ps -rw-r--r-- 1 don 12549 Nov 22 23:35 doc.ps Extracting cyber -rwxrwxr-x 1 don 73 Nov 22 23:35 cyber Extracting arpa.map -rw-r--r-- 1 don 6964 Nov 22 23:35 arpa.map Extracting advent.map -rw-r--r-- 1 don 38413 Nov 22 23:35 advent.map [tumtum:/tumtum/don/cyber/dist/cyber 7] l total 542 drwxrwxr-x 2 don 512 Nov 22 23:35 ./ drwxrwxr-x 3 don 512 Nov 22 23:34 ../ -rw-r--r-- 1 don 725 Nov 22 23:34 README -rw-r--r-- 1 don 38413 Nov 22 23:35 advent.map -rw-r--r-- 1 don 6964 Nov 22 23:35 arpa.map -rw-rw-r-- 1 don 1749 Nov 22 23:35 cond.ps -rwxrwxr-x 1 don 73 Nov 22 23:35 cyber* -rw-r--r-- 1 don 166395 Nov 22 23:35 cyber.ps -rw-rw-r-- 1 don 9959 Nov 22 23:35 distill.ps -rw-r--r-- 1 don 12549 Nov 22 23:35 doc.ps -rw-r--r-- 1 don 30173 Nov 22 23:34 introduction -rw-rw-r-- 1 don 27330 Nov 22 23:35 mics.ps -rw-rw-r-- 1 don 14187 Nov 22 23:34 overlay.ps -rw-rw-r-- 1 don 34084 Nov 22 23:34 piemenu.ps -rw-rw-r-- 1 don 12978 Nov 22 23:35 pointer.ps -rw-rw-r-- 1 don 17287 Nov 22 23:35 ps.ps -rw-rw-r-- 1 don 5590 Nov 22 23:34 pullout.ps -rw-r--r-- 1 don 7663 Nov 22 23:34 quickwin.ps -rw-rw-r-- 1 don 34241 Nov 22 23:35 scrap.ps -rw-rw-r-- 1 don 83120 Nov 22 23:34 textcan.ps -rw-rw-r-- 1 don 27159 Nov 22 23:35 trace.ps [tumtum:/tumtum/don/cyber/dist/cyber 8] wc * 29 105 725 README 1265 7603 38413 advent.map 382 1028 6964 arpa.map 52 317 1749 cond.ps 3 11 73 cyber 6876 25039 166395 cyber.ps 435 1335 9959 distill.ps 379 1508 12549 doc.ps 818 4391 30173 introduction 1245 3714 27330 mics.ps 578 1807 14187 overlay.ps 1120 5048 34084 piemenu.ps 515 1901 12978 pointer.ps 805 2752 17287 ps.ps 222 806 5590 pullout.ps 281 933 7663 quickwin.ps 1266 4806 34241 scrap.ps 2239 11037 83120 textcan.ps 939 4097 27159 trace.ps 19449 78238 530639 total [tumtum:/tumtum/don/cyber/dist/cyber 9] sum * 21889 1 README 47574 38 advent.map 52241 7 arpa.map 35915 2 cond.ps 32561 1 cyber 06530 163 cyber.ps 20066 10 distill.ps 63139 13 doc.ps 55896 30 introduction 36978 27 mics.ps 60565 14 overlay.ps 19038 34 piemenu.ps 10901 13 pointer.ps 52390 17 ps.ps 27496 6 pullout.ps 24792 8 quickwin.ps 60370 34 scrap.ps 65163 82 textcan.ps 33518 27 trace.ps [tumtum:/tumtum/don/cyber/dist/cyber 10] exit [tumtum:/tumtum/don/cyber/dist/cyber 11] script done on Wed Nov 22 23:36:09 1989 From don Thu Nov 23 01:44:10 1989 Date: Thu, 23 Nov 89 01:44:10 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitaa From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitaa ======== : Run this shell script with "sh" not "csh" PATH=/bin:/usr/bin:/usr/ucb:/etc:$PATH export PATH all=false if [ x$1 = x-a ]; then all=true fi echo Extracting README sed 's/^X//' <<'//go.sysin dd *' >README XInstructions: X XIn a directory containing the files the CyberSpace Deck was distributed Xwith, just type "cyber". X XOr put the .ps files into your NeWS directory (under the directory where Xyou run NeWS), and "psh cyber.ps" to load them all automatically. X XOr load them in the following order: X Xecho "(debug.ps) LoadFile pop" | psh Xpsh textcan.ps Xpsh piemenu.ps Xpsh pullout.ps Xpsh quickwin.ps Xpsh overlay.ps Xpsh pointer.ps Xpsh distill.ps Xpsh mics.ps Xpsh cyber.ps X XLook at the file "introduction" for instructions. X XThe files "arpa.map", and "advent.map" all contain PostScript code Xthat defined interesting-to-look-at data structures. These are especially Xfun to visualize as Molecules in CyberSpace. ("etc... molecule") X X -Don X //go.sysin dd * if [ `wc -c < README` != 725 ]; then made=false echo error transmitting README -- echo length should be 725, not `wc -c < README` else made=true fi if $made; then chmod 644 README echo -n ' '; ls -ld README fi echo Extracting introduction sed 's/^X//' <<'//go.sysin dd *' >introduction X======================================================================== X XThe CyberSpace Deck Manual X X Don Hopkins Grasshopper Group Last update X don@brillig.umd.edu grass@toad.com 22 July 89 X X======================================================================== X XIntroduction X XThe CyberSpace deck lets you graphically display and manipulate the many XPostScript data strutures, programs, and processes living in the virtual Xmemory space of NeWS. X XThe Network extensible Window System (NeWS) is a multitasking object Xoriented PostScript programming environment. NeWS programs and data Xstructures make up the window system kernel, the user interface Xtoolkit, and even entire applications. X XThe CyberSpace deck is one such application, written entirely in XPostScript, the result of an experiment in using a graphical programming Xenvironment to construct a interactive visual user interface to itself. X XIt displays views of structured data objects in overlapping windows that Xcan be moved around on the screen, and manipulated with the mouse: you Xcan copy and paste data structures from place to place, execute them, Xedit them, open their substructures up to any depth, adjust the scale to Xshrink and magnify parts of the display, and pop up menus of other useful Xcommands. Deep or complex data structures can be more easily grasped by Xapplying various views to them. X XThere is a window onto a NeWS process, a PostScript interpreter with Xwhich you can interact (as with an "executive"). PostScript is a stack Xbased language, so the window has a spike sticking up out of it, Xrepresenting the process's operand stack. Objects on the process's stack Xare displayed in windows with their tabs pinned on the spike. (Figure Xxxx) You can feed PostScript expressions to the interpreter by typing Xthem with the keyboard, or pointing and clicking at them with the mouse, Xand the stack display will be dynamically updated to show the results. X XNot only can you examine and manipulate the objects on the stack, but you Xcan also manipulate the stack directly with the mouse. You can drag the Xobjects up and down the spike to change their order on the stack, and Xdrag them on and off the spike to push and pop them; you can take objects Xoff the spike and set them aside to refer to later, and close them into Xicons so they don't take up as much screen space. X XNeWS processes running in the same window server can be debugged using Xthe existing NeWS debug commands in harmony with the graphical stack Xand object display. X XThe CyberSpace deck can be used as a "hands on" way to learn about Xprogramming in PostScript and NeWS. You can try out examples from Xcookbooks and manuals, and explore and enrich your understanding of Xthe environment with the help of the interactive data structure Xdisplay. X X======================================================================== X======================================================================== X XConcepts X XThis section describes some concepts that you should be familiar with Xwhen using the CyberSpace Deck. It describes the most important types of XPostScript data structures, and tells you how they look displayed on the Xscreen. X XIt also gives references to sections of other manuals that explain the Xconcepts in more detail (Delimited by ~tildes~.) X X Referenced Manuals X X ~Blue: Adobe PostScript Language Tutorial and Cookbook~ X ~Red: Adobe PostScript Language Reference Manual~ X ~Green: Adobe PostScript Language Design~ X ~NeWS: NeWS 1.1 Manual~ X X Object X X ~Blue 2: Stack and Arithmetic~ X ~Blue 2.1: The PostScript Stack~ X ~Red 3.2: Interpreter~ X ~Green 2.3: The Operand Stack; Objects in the PostScript Language~ X X An object is any NeWS data structure that you can push onto the X stack or refer to in other objects. Each object has a type, some X attributes, and a value. X ~Red 3.4: Data Types and Objects~ X X (The word "object" is used here in a more general sense than in X "object oriented programming." The more specific words "class" X and "instance" are used instead.) X ~NeWS 6: Classes~ X X When an object is displayed in a window, its type is displayed X in the window tab. An object's type precedes its value when X its displayed inside another object. Examples: "array [6]", X "integer 100" (Figure xxx) X X Composite objects, such as arrays, strings, and dictionaries, which X can be pushed on the stack or referenced by other objects, are X represented internally as pointers to their bodies. So there can be X multiple references to any composite object, and its body doesn't X get moved around in memory whenever the references are moved or X copied. X ~Blue 8.1: PostScript Arrays~ X ~Red 3.4: Data Types and Objects; Simple and Composite Objects~ X X A reference count is maintained in the body of each composite X object. Once there are no longer any remaining references to an X object, its body is automatically garbage collected and its storage X is reclaimed. X ~NeWS 11.8: Object Cleanup~ X X Executable/Literal X X ~Blue 4.2: Defining Procedures and Variables~ X ~Red 3.4: Data Types and Objects; Attributes of Objects~ X ~Green 2.3: The Operand Stack; Objects in the PostScript Language~ X ~Green 2.7: Procedures~ X X Each object has an attribute that makes it either executable or X literal. This affects how the PostScript interpreter deals with it X (whether it's used as code or data). Each reference to an object X has its own executable/literal bit, so you can have an executable X and a literal reference to the same object at once. X X Executable objects are displayed in an italic font, and literal X objects are displayed in a non-italic font. (Figure xxx) X X String X X ~Blue 5.0: Printing Text; Introduction~ X ~Red 3.3: Syntax; Strings~ X ~Red 3.4: Data Types and Objects; String~ X ~Green 2.6: The Interpreter and the Scanner~ X X Strings are delimited by parenthesis: "string (foobar)" The X parenthesis inside the string do not have to be quoted if they X balance: "string (Copyright (C) 1989)" If a string is longer X than 80 characters, then only the first 80 are displayed, X followed by an elipse: "string (blablabla...bla)..." X X Name X X ~Blue 4: Procedures and Variables~ X ~Red 3.3: Syntax; Names" X ~Red 3.4: Data Types and Objects; Name~ X ~Green 2.5: Operators and Name Lookup~ X X Names are used as keys in dictionaries, to refer to the values X of variables and procedures. X X Executable names are displayed in italics, without a leading X slash: "name foo" X Literal names are displayed with a slash before them: "name /foo" X X Array X X ~Blue 7: Loops and Conditionals~ X ~Blue 8: Arrays~ X ~Red 3.3: Syntax; Arrays, Procedures~ X ~Red 3.4: Data Types and Objects; Array~ X ~Red 3.6: Execution: Execution of Specific Types~ X ~Green 2.7: Procedures~ X X PostScript arrays are polymorphic: Each array element can be an X object of any type. A PostScript procedure is just an executable X array of other objects, to be interpreted one after the other. X X Executable arrays (i.e. procedures) are displayed in italics, with X their length enclosed in braces: "array {37}" Literal arrays are X displayed with their length enclosed in square brackets: X "array [6]" X X When you open up an array, lines are drawn fanning out to the X right, leading from the array to its elements, which are X displayed as "index: type value", in a smaller point size. X X Dictionary X X ~Blue 4: Procedures and Variables~ X ~Red 3.4: Data Types and Objects; Dictionary~ X ~Green 2.4: The Dictionary Stack~ X ~Green 2.5: Operators and Name Lookup~ X X Dictionaries associate keys with values. The key (an index into a X dictionary) can be an object of any type (except null), but is X usually a name. The value can be anything at all. Dictionaries X are used to hold the values of variables, functions and X arguments, as records, lookup tables, classes, instances, and X other things -- they're very useful! X X The dictionary stack defines the context of a PostScript process. X Whenever the value of a name is needed, it is looked up in the X dictionaries on the dictionary stack, in top to bottom order. X X A dictionary is displayed by showing the number of keys it X contains, a slash, and the maximum size of the dictionary, X enclosed in angled brackets: "dict <31/200>" X X When you open up a dictionary, lines are drawn fanning out to X the right, leading from the dictionary to its elements, X which are displayed as "key : type value" in a smaller point X size: "/FirstName : string (don)" X X Class X X ~NeWS 6: Classes~ X X NeWS uses an object oriented programming package, which X uses dictionaries to represent classes and instances. X X When a class dictionary is displayed, its class name is X displayed, instead of its actual type "dict": X "MessageItem <10/200>" X X Instance X X ~NeWS 6: Classes~ X X When an instance dictionary is displayed, its type is displayed X as a period followed by its class name: ".MessageItem <31/200>" X X Magic Dictionary X X ~NeWS 11: NeWS Type Extensions~ X ~NeWS 11.2: NeWS Type Extensions; Objects as Dictionaries~ X X Magic dictionaries are certain types of NeWS objects, such as X processes, canvases, and events, that appear to be dictionaries, X but are really special data types. They have a fixed set of keys X with special meanings (such as a process's /OperandStack, or a X canvas's /TopChild), but otherwise, you can treat them just X like regular dictionaries. Special things may happen when you X read or change the values of the keys (for example, setting the X /Mapped key of a canvas to false makes it immediately disappear X from the screen). X X Selection X X ~Red 3.4: Data Types and Objects~ X ~NeWS 5: The Extended Input System~ X ~NeWS 5.4: The Extended Input System; X Selection Overview and Data Structures~ X X A selection is a piece of data, such as text from a terminal X window, that can be copied and pasted from window to window. X Selections are used to move data between separate window system X applications. There are several different ranks of selections X that you can make, but the most frequently used one is called the X "primary selection". The CyberSpace deck displays the current X primary selection in the field at the top of the scrolling text X window. (figure xxx) Selections also come in different types, X and the following types are currently recognized: X X text X X A string of ASCII text, selected from something like a X terminal emulator, text canvas, text editor. X X object X X A single PostScript object, of any type. X X pointer X X PostScript does not have an explicit notion of a "pointer", X but if we consider the meaning, "a way to reference or X replace an object in memory," the term "pointer" means a X *pair* of PostScript objects: a container and an index, that X specify the location of another PostScript object. The X container (usually an array or dictionary) holds the object, X and the index into the container (usually an integer or name) X tells which element of the container the object is. X X The PostScript operators "get" and "put" take pointers as X arguments. X ~Red 6.3: get, put~ X X The advantage of selecting a pointer to an object, rather X than the object itself, is that whoever uses the selection is X able to tell where the object came from, and/or can replace X the selection with a new value. X X interval X X A subsequence of an array or string, a contiguous subset of X the original elements, sharing the same storage. X ~Red 6.3: getinterval, putinterval~ X X Process X X ~Red 3.5: Stacks~ X ~NeWS 2.1: NeWS Extensions Overview; The Lightweight Process Mechanism~ X ~NeWS 11.6: NeWS Type Extensions; Processes as Dictionaries~ X X Canvas X X ~NeWS 1.3: Introduction; Canvases~ X ~NeWS 2.2: NeWS Extensions Overview; Canvases and Shapes~ X ~NeWS 11.3: NeWS Type Extensions; Canvases as Dictionaries~ X X Event X X ~NeWS 1.4: Introduction; User Interaction -- Input~ X ~NeWS 3: Input~ X ~NeWS 11.4: NeWS Type Extensions; Events as Dictionaries~ X X======================================================================== X======================================================================== X XHow to Get Started X XFirst, you have to be running NeWS. If you don't have a NeWS handy, Xyou can skip to the next section. X XThe CyberSpace deck currently runs under NeWS 1.1, and walks under XX11/NeWS Beta 2. (One day it will fly!) X XTake a look at the file "README" which should be supplied with the XCyberSpace deck. It should contain the latest instructions for loading Xall the files you need to run it. X XIn a directory containing the files the CyberSpace Deck was distributed Xwith, just type "cyber". X XOr put the .ps files into your NeWS directory (under the directory where Xyou run NeWS), and "psh cyber.ps" to load them all automatically. X XOr load them in the following order: X Xecho "(debug.ps) LoadFile pop" | psh Xpsh textcan.ps Xpsh piemenu.ps Xpsh pullout.ps Xpsh quickwin.ps Xpsh overlay.ps Xpsh pointer.ps Xpsh distill.ps Xpsh mics.ps Xpsh cyber.ps X X======================================================================== X======================================================================== X XNavigating in CyberSpace X XThere are several ways of giving commands to the CyberSpace Deck. The Xnumber of "*"'s to the right of the title of a section tell how important Xsomething is if you are learning to use the CyberSpace deck. (The more Xsplats, the more interesting.) X X Clicking with the Mouse ***** X X The most commonly used functions can be performed directly by X clicking on things with the mouse buttons. What a mouse button X does depends exactly on what was underneath the cursor when you X clicked the button. For example, the exact word you are on when X you bring up a menu is often what the menu will affect. (This X differs from most applications where all that matters is what X window you are in.) X X Selecting from Menus **** X X There are a lot of commands available via pop-up menus, that you X can get by clicking the "Menu" button (usually the right button). X The menu that pops up applies to whatever was underneath the X cursor when you first pressed down on the menu button. X X Typing PostScript Expressions *** X X You can type into the scrolling text window (or anywhere else in X the CyberSpace Deck window). What you type is interpreted as a X PostScript expression, and you can interact with the PostScript X interpreter "executive", as you normally can with an "psh" (or X "tip" to a laser printer). X X Pressing Function Keys and Control Characters ** X X Certain function keys and control characters invoke functions X immediately when you type them. X X There are several different regions on the screen to interact with... X X The Scrolling Text Window ***** X X The scrolling text window presents a view of a NeWS process. X There is a spike sticking out of the top of the window which X represents the process's stack. Text that the process prints X to its standard output is put into the text window, and text X that you type anywhere in the CyberSpace Deck window is fed X into the standard input of the process. X X At the top of the text window is a banner displaying the current X primary selection. Text that you select from a text window, X terminal emulator, or other applications goes into the primary X selection, along with the objects you select from the deck. X X Text Window Tab ** X X You can move the text window around by pressing the Point X button (left) down over the tab sticking out of the edge, X dragging it to where you want, and releasing. X X Clicking the Menu button in the text window tab pops up a pie X menu of commands affecting the process and text window, as well X as a few commands for internal debugging and introspection. X X Text Display **** X X You can type commands into the text window, to be interpreted X by NeWS. You can edit the text as you type it in, using the X Delete or Backspace key to erase characters, and Control-X or X Control-U to erase the whole line. There are a lot of other X functions bound to control characters and function keys, which X you can get a list of by pressing Help, Alternate, or Meta-?. X (Todo: define a function called "help" in the initial X userdict.) (To type in a "Meta" character on a Sun keyboard, X hold down the "Left" key.) One of the most useful keyboard X commands is Meta-Esc (or L9), which displays all the keys on X the dictionary stack that match the partially typed name in the X text window. X X The scroll bar on the left edge of the text window can be X used to scroll through the lines of text that have been typed X out in the window. (You'll need to use it to look at the X list of key bindings.) X X Clicking and dragging the Point and Adjust buttons (left X and middle) over the characters in the text window selects X the text as the primary selection. X X Clicking the Menu button (right) inside of the text window X pops up a menu of commands that operate on the Primary X selection. X X The Background Menu **** X X If you click the Menu button (right) on the white background of X the CyberSpace Deck window, the background menu will pop up. X This is a menu of functions that push interesting things onto the X stack for you to look at and play with. X X Pallets... *** X X A pallet is a dictionary or array of useful functions, that X you can open up and execute with the mouse (below). X Selecting the name of a pallet from the "Pallets..." submenu X pushes a pallet of related functions onto the stack. You can X open up a pallet and make its click action click-exec, from X the tab menu. (todo: make automatic) The "Debug" pallet is X a handy interface to the NeWS debugger (debug.ps). X X Processes *** X X This pushes an array of arrays of NeWS processes onto the X stack. Each subarray contains all the processes in one X process group. (This only works in X11/NeWS.) X X Framebuffer *** X X This pushes the framebuffer, the root of the canvas hierarchy, X onto the stack. You can open up a canvas editor on the X framebuffer to see an array of its children (from the X structure "type...canvas editor" submenu) and open up a X scroller editor on the array (also from the structure X "type...scroller editor" submenu). (todo: make automatic) X X Windows **** X X This pushes on the stack a dictionary of every LiteWindow that X has an active event manager listening for /DoIt events. The X keys of the dictionary are the event managers, and the values X are the windows they are managing. X X Canvases **** X X This lets you click at a place on the screen, and pushes on X the stack an array of the canvases underneath the cursor where X you clicked. It draws an "X" shape at the cursor to prompt X you to click somewhere. X X Object **** X X This pushes the class Object, the root of all other classes, X onto the stack. You can open up an class editor on class X Object (from the structure "type...class editor" submenu). X (todo: make automatic) You can open up Object's arrays of X SubClasses and ClassDicts, and open class editors on classes X in them, too. You can enter the context of the class or X instance (from the structure "type...enter" submenu), and open X up scroller editors (from the "type...scroller editor" X submenu) on the class editor's arrays of InstanceVars, X ClassVars, and Methods, and open up name editors on the names X contained therein. (todo: make it open up collections of X actual pointers to the objects, so you don't need to enter the X object's context, and you can open them up and edit them.) X X The Data Structure Views ***** X X Views of PostScript data structures are displayed in windows with X tabs sticking out of them. The tabs display the type of data X structure being viewed in the window. X X View Window Tab ***** X X Moving the View Window ***** X X You can press the Point button (left) down on a tab, and drag X the window around on the screen. When you release the button, X the window will stay where it is (usually). If you place it X so the tab overlaps the pin sticking out of the top of the X scrolling text window, it will be pushed onto the stack. You X can move objects around on the stack by dragging them up and X down the spike by the tabs. X X Iconifying the View Window ** X X If you press the middle button over a structure window tab, it X will iconify the window, so it displays only the first level X of the data structure, with a rounded line drawn around the X inside border. This isn't particularly useful for windows X that are only displaying one level of data structure in the X first place, but it sure is handy for big deep ones. X X View Window Tab Menu ***** X X Pressing the menu button over the tab of a structure window X pops up a menu of operations on that whole window. X X Layout * X X Recompute the layout of the structure. Updates the X display if the structure has changed. X X Paint ** X X Redraw the structure. X X Zap ***** X X Destroy the view of the data structure. If the window X is on the stack, then the object is popped. Zapping a X view window does not destroy the displayed data X structure itself, unless there are no other references X to it, in which case it gets garbage collected X automatically. X X Print * X X Write out a PostScript program to print out the X structure display. This is presently broken, but at X least it doesn't seem to crash. X X Tab... ** X X Submenu to move the tab to different places around the X window. Ignore the names, just select the direction in X which you want the tab moved. X X View... ***** X X Menu of functions that affect the view of the X structure in the window. The attributes you set X with this menu can be overridden locally in the X individual pieces of structure, with the structure X view menu. X X point size ***** X X Change the point size at which the top level piece X of structure is displayed. Pull out further to get X a bigger point size. The size you have selected is X displayed in the menu center. X X shrink *** X X Change the factor by which the point size X diminishes with depth. Pull out further to get a X bigger shrink factor. (If it's more than one then X it's a grow factor!) The factor you have selected X is displayed in the menu center. X X open *** X X Open the structure to a certain depth. Pull out X further to open it deeper. The depth to which X the structure will be opened is displayed in the X menu center. Be careful about opening big X structures deeper than one or two levels at once, X unless you have a lot of time to wait! X X click proc... * X X Sets the function to call when you click the Adjust X (middle) button on a piece of structure in that X window. These are described later, but the most X useful one for pallets of functions is "click-exec". X An object whose click action is click-exec will be X executed when you click the Adjust button on it. X X Structure View ***** X X A mouse sensative structural view of PostScript data is X displayed inside the view window. You can use the mouse to X point at a piece of structure in the display, inspect and X manipulate it. No matter how small something is displayed X (even in unreadable 1-point text), it is still mouse sensative! X (It won't shrink any smaller than a pixel, so you can always X point to it.) X X Selecting Data Structures ***** X X Clicking once on an object with the Point button (left) X will select the object. This actually selects a "pointer" X to the object (see above), and you will see it as the X current primary selection, displayed in the line labeled X "Selected:" at the top of the scrolling text window. X X You can hold the Point button down and drag the cursor up X and down to select other pieces of structure in the same X container. The currently selected structure will be X displayed in the banner at the top of the scrolling text X window. X X If you hold the shift key down while making a data X structure selection, the results you get will depend X on the type of the container from which you're X selecting. If it's a dictionary, you can select one X of its keys. If it's an array, you can drag the X cursor up and down to select an array subinterval. X X Executing Data Structures **** X X Double clicking the Point button on an object selects it, X makes it executable, and executes it. This is useful for X calling functions that are displayed on the screen, and X for using strings of text, such as previously typed X commands selected from a text window, as command buttons. X X Doing Other Stuff to Data Structures ***** X X Clicking the Adjust button (middle) on a structure calls X the structure's click action, or the default click action X of the structure window if the particular piece of X substructure does not have its own. There are several X different click actions, such as click-exec, click-push, X and click-select, but click-transfer is the default. X X The Default Click Action ***** X X Here are the three ways to use "click-transfer": X X Open/Close Structure ***** X X Press and release the Adjust (middle) button over X a composite object like a dictionary, an array, X canvas, or process. The structure will open up X one level deep (or close if it was already X opened). X X Transfer to Background ***** X X Press the Adjust button over an object, and X holding it down, drag the object out over the X background. When you release the button, a new X view window will appear on the background. It X will contain a copy of the object you just dragged X out. X X Transfer to Structure ***** X X If you drag an object over to another structure X window (or to the same one, but over a different X piece of substructure), and release the button, X the object will be pasted into the structure X underneath the cursor when you released the X button. Now you are actually editing PostScript X data structures! Be careful! You can severly X hose your NeWS server if you start pasting things X into system data structures or functions. Make a X few of your own dictionaries and arrays to play X around with! X X Structure Menu ***** X X If you click the Menu button (right) over a piece of X structure, you will pop up a structure menu with lots of X functions which operate on the object under the cursor at X the time you pressed the Menu button. X X push ***** X X Push the object onto the stack. X X exec ***** X X Make the object executable, and execute it. X X paste ***** X X Paste the primary selection into the place of the X object under the cursor. This actually edits X PostScript data structures! See the above warning in X the description of click-transfer! X X open... **** X X Submenu of functions to open up an object in different X ways. Pull out further to open it deeper. The depth X to which the structure will be opened is displayed in X the menu center. X X change... *** X X Submenu of functions that perform type conversions on X the object (or at least they try). X X view... **** X X Submenu of functions that affect the local view of X the piece of structure. Similar to the view submenu X on the structure window tab, except that these X functions apply just to the piece of structure under X the cursor and its children, not all pieces of X structure in the window. X X etc... ** X X Submenu of random but useful functions that wouldn't X fit anywhere else. The "Molecule" function pops up X a pseudo-scientific visualizer view of the X PostScript data structure under the cursor. X X type... ***** X X Pops up a type-specific submenu of functions that X apply to the object under the cursor at the time you X popped up the structure menu. Which menu you get X depends on the type of the object. X X======================================================================== X X======================================================================== X XType Specific Functions X X======================================================================== X XEditors X X boolean X X canvas X X class X X definitions X X digit X X element X X filter X X scroller X X shift X X step X X user X X======================================================================== X XPallets X X Window X X Debug X X======================================================================== X XDebugging X X break-cont X X break-copy&cont X X break-enter X X break-exit X X break-kill X X break-list X X clear X X enter-it X X exit X X fix-typo X X push-dictstack X X push-execstack X X push-process X X show-dictstack X X show-execstack X X======================================================================== //go.sysin dd * if [ `wc -c < introduction` != 30173 ]; then made=false echo error transmitting introduction -- echo length should be 30173, not `wc -c < introduction` else made=true fi if $made; then chmod 644 introduction echo -n ' '; ls -ld introduction fi echo Extracting piemenu.ps sed 's/^X//' <<'//go.sysin dd *' >piemenu.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% @(#)piemenu.ps X% X% Pie menu class implementation. X% Copyright (C) 1987. X% By Don Hopkins. X% All rights reserved. X% X% Simple Simon popped a Pie Men- X% u upon the screen; X% With directional selection, X% all is peachy keen! X% X% Pie Menus are provided for UNRESTRICTED use provided that this X% copyright message is preserved on all copies and derivative works. X% This is provided without any warranty. No author or distributor X% accepts any responsibility whatsoever to any person or any entity X% with respect to any loss or damage caused or alleged to be caused X% directly or indirectly by this program. This includes, but is not X% limited to, any interruption of service, loss of business, loss of X% information, loss of anticipated profits, core dumps, abuses of the X% virtual memory system, or any consequential or incidental damages X% resulting from the use of this program. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% May 28 1987 Don Hopkins X% First cut, based on LitePullRightMenu. X% X% May 30 1987 Don Hopkins X% Uses "Thing"s from liteitem.ps for key labels. A thing can be a X% string, or a keyword. The string is shown in MenuFont. The X% keyword can be either the name of an icon in icondict, or bound X% on the dict stack to an executable function. The function takes X% a boolean as input; if true, it draws itsself; if false, it X% returns its width and height. X% NOTE: in NeWS 1.1, a Thing is either: a string, a keyword (icon X% name only), an executable array (taking /draw or /size as X% input), or an Object dict (sent a /draw and /size messages). X% See the colornames demo! X% Better label positioning scheme: top or bottom justify labels at X% at the very bottom or top of the menu, and left or right justify X% labels on the right or left sides of the menu. The points X% relative to which the labels are justified are positioned at X% evenly spaced angles in a circle around the menu center. The X% instance variable PieInitialAngle is the angle of the first X% point. LabelRadius is the distance from the menu center to each X% point, calculated as: X% LabelMinRadius + LabelRadiusPerKey * X% NOTE: LabelRadiusPerKey is obsolete now. LabelRadius is automatically X% pushed out until no labels overlap. X% If the menu can't be centered on the location of the button X% event that invoked it, then warp the cursor to the menu center X% plus how much it has moved since the button down event, so that X% pop up menus near the screen edge and static menus work X% correctly. But ARRRGH FOO: setcursorlocation is broken!!! It X% moves the cursor, but next time you move the mouse, the cursor X% pops back to where it used to be! The Sun X server used to have X% the same problem with XWarpMouse. Makes you wonder. Well, X% anyway, I commented it out, because it's more confusing with X% setcursorlocation broken than it is not warping at all. X% NOTE: It's fixed now, so it works right! X% X% July 13 1987 Don Hopkins X% Fixed up handling of retained canvases. Changed SliceLines to X% SliceWedges, and made it draw wedges inside of LabelRadius. X% Put in MoveMenu, which moves the menu, making sure that it's X% completely on the screen, and the mouse is in the menu center. X% (The latter part should be uncommented when setcursorlocation X% is fixed.) Changed slice highlighting. X% Implemented an oops function. Pressing the adjust button moves X% the top menu so the cursor's back in its center. (Well, X% setcursorlocation is still broken ...) If the mouse is already X% in the menu center, then the menu is popped down and the X% one below it is moved so its center is at the cursor. X% NOTE: Oops works much better now that setcursorlocation is fixed! X% On AdjustButton Down (Ker), the cursor moves to the menu center. X% On AdjustButtonUp (Chunk), if the cursor is still in the menu X% center, the menu is popped down, leaving you in the previous X% menu (if any), at the location you invoked this menu from. X% X% July 24 1987 Don Hopkins X% Changed to work with NeWS 1.1 litemenu.ps ... (just in time for SIGGRAPH!) X% X% August 20, 1987 Don Hopkins X% Uncommented out and fixed the mouse warping code. Added display X% interruption, so that if the events that would make the menu X% selection are already in the event queue, then the menu is not X% displayed. I'm not sure if the way I'm doing it is the best way, X% but it seems to work. I'm still not sure that the way mouse warping X% near the screen edge and display interruption are interacting is X% really correct. It should not warp the mouse if the events are X% already in the queue, so maybe warping should be defered, as well. X% There was also a problem with /Damaged events generated when the X% canvas is reshaped, being put into the queue before the /MapMenu X% event is. This was causing the menu to be painted before the X% defered mapping took place, which is not the way I think it should X% work. So I kludged around it. There's got to be a safer way to X% make it work right. X% NOTE: This kludge has been flushed in favor of drawing the menu X% before it's mapped. X% A delay has been added to the map event, to facilitate mouse-ahead X% display suppression. If you click down and up, without moving out X% of the menu center, you will get the menu as soon you let up, but X% if you click down and move, without letting up, there will be a X% delay before it is mapped, during which time if you let up in an X% active slice region, the mapping of the menu will be suppressed X% (unless there is a submenu), and the selection you have chosen X% acted upon immediatly. The submenu delay is shorter than the delay X% of a menu with no parent, so that when you mouse-ahead quickly X% into a submenu, you will see the submenu mapped first. (Because X% the parent menu is less important than the active submenu, now X% that you've already made the selection.) This may sound quite X% bizarre, but it seems to work pretty nicely for me. X% X% March 29, 1988 Don Hopkins X% Lots of changes have been made, too many to go into excruciating X% detail, but I've put notes in the above comments to bring them X% somewhat up to date. Please destroy any evil old copies of X% piemenu.ps and replace them with this!!! X% X% August 28, 1988 Don Hopkins X% Fixed "go!" so the framebuffer's event manager would not end up X% with the currentcanvas of the process from which it was invoked. X% (This was causing damage on the framebuffer not to be repainted X% if piemenu.ps was run from a menu.) X% Added the DontSetDefaultMenu flag. X% X% February 17 1989 Don Hopkins X% Changed MapMenuEvent handler so that mapping is defered until X% the mouse stops moving around. X% X% March 7 1989 Don Hopkins X% Finally figure out some sort of light-weight feedback to use with X% mouse-ahead display suppression, short of mapping the menu. When X% popping down a menu whose display was supressed, draw a circle X% where the menu would have been, with the selected slice cut out. X% (Direct Pac-Manipulation feedback.) X% X% November 20 1989 Don Hopkins X% Fixed it to work with X11/NeWS Version 1.0 (FCS). X% Don't set DefaultMenu if xnews. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Things to do: X% X% Teach it to use items as menu keys. Create PieItems like buttons, X% cycles, sliders and pull-out menus based on the distance, X% etc... (Use Things that are Objects!) X% X% Make each slice a canvas, and map just the choosen slices. Leave X% a trail of wedges to the current active submenu. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xsystemdict begin X Xsystemdict /XNeWS? known not { X /XNeWS? false def X} if X Xsystemdict /Item known not { X (NeWS/liteitem.ps) LoadFile not { X (Can't load liteitem.ps!\n) print X } if X} if X Xsystemdict /LiteMenu known not { X (NeWS/litemenu.ps) LoadFile not { X (Can't load litemenu.ps!\n) print X } if X} if X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Utilities X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X% XNeWS is missing these functions so make dummies if they're not defined. X% XXX: Can all the calls to these be eliminted in NeWS 1.1? X X/overlaydraw nullproc ?def X/overlayerase nullproc ?def X X% Replace the go! function with one that starts a root event manager X% that listens for (and ignores) menu button up events. This is so they X% don't get dropped on the floor before a pie menu can express interest X% in them. (Crucial for effective mouse-ahead!) X/go! { X verbose? { (Starting root eventmgr\n) print } if X /rooteventmgr where { pop X rooteventmgr type /processtype eq { X rooteventmgr killprocess X } if X } if X { X countdictstack 1 sub {end} repeat X framebuffer setcanvas X /rooteventmgr [ X /rootmenu where { pop X MenuButton X { {newprocessgroup /showat rootmenu send} fork pop } X /DownTransition framebuffer eventmgrinterest X MenuButton X { CurrentEvent redistributeevent } null null eventmgrinterest X dup /Priority -5 put X AdjustButton X { CurrentEvent redistributeevent } null null eventmgrinterest X dup /Priority -5 put X } if X X /Damaged X {newprocessgroup damagepath clipcanvas PaintRoot newpath clipcanvas} X null framebuffer eventmgrinterest X ] forkeventmgr def X } fork pop X} def X X X/rooteventmgr where { pop X XNeWS? not X systemdict /DontSetDefaultMenu known not and X rooteventmgr type /processtype eq and { X go! X } if X} if X X% Coerce an angle to be >=0 and <360. X% Note: mod returns integers, so's no good. X/NormalAngle { % angle => angle X dup 0 lt { X dup 360 sub 360 idiv 360 mul sub X } if X dup 360 ge { X dup 360 idiv 360 mul sub X } if X} def X X% From demomenu.ps X X% Fake method to send to a menu that returns a copy of the menu in the X% new menu style. Recursivly changes all sub-menus. One thing to look X% out for is that it does not change variables bound to the sub-menus X% that were changed, so setting /rootmenu to the result of sending X% /flipstyle to rootmenu will give you a new root menu, with a new X% terminal sub-menu, but /terminalmenu will still be bound to the old X% one, so sending messages to terminalmenu will not change the X% terminal menu you get under the new rootmenu. But sending /flipstyle X% to terminalwindow would not update the terminal menu under rootmenu. X% So get your changes in before you flip styles! Or use /searchkey to X% find the new menu, and re-def it in systemdict. X X/flipstyle { % - => newmenu X 0 1 MenuActions length 1 sub { X dup getmenuaction % fixed to use getmenuaction! X dup type /dicttype eq { X /flipstyle exch send % i menu' X MenuActions 3 1 roll put % - X } {pop pop} ifelse X } for X MenuKeys MenuActions /new DefaultMenu send X} def X X X% Override flipdefaultmenustyle, a function invoked from the user X% interface menu. X X/flipdefaultmenustyle { % - => - (Flips default menu style) X /DefaultMenu X DefaultMenu SunViewMenu eq {PieMenu} {SunViewMenu} ifelse X store X} def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% SimplePieMenu class X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X/SimplePieMenu LiteMenu X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Instance variables X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xdictbegin X% The slice currently painted. X /PaintedValue null def X% Inner radius around which labels are positioned. Based LabelMinRadius, X% LabelRadiusPerKey, and the length of MenuKeys. X /LabelRadius null def X% Pie menu outer radius. Based on LabelRadius and the bounding boxes of X% the Key Things. X /PieRadius null def X% The number of degrees a slice takes up. Based on length of MenuKeys. X /PieSliceWidth null def X% The current direction in degrees from the menu center to the cursor. X /PieDirection null def X% The current distance from the menu center to the cursor. X /PieDistance null def X% Angle used in loops. X /ThisAngle null def X% Amount to move the menu so that it fits entirely on the screen. X /DeltaX null def X /DeltaY null def X% Flag to remember if we've gotten a menu button down event before. X /GotDown false def X% Interruptable display event X /MapMenuEvent null def X /CurX 0 def X /CurY 0 def Xdictend X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Class variables X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xclassbegin X% Highlight: true strokes, false fills. X /StrokeSelection false def X% Width of border just inside PieRadius perimiter. X /Border 3 def X% Gap between outermost label edge and border. X /Gap 9 def X% Radius of numb hole in menu center that makes no menu selection. X /NumbRadius 14 def X% Fudge factors for menu positioning. X /MouseXDelta 0 def X /MouseYDelta -3 def X% Draw lines delimiting slices. X /SliceWedges true def X% Draw arrows in the directions of slices. X /SliceArrows false def X% Drill a hole through the menu center, as big as NumbRadius. X /NumbHole false def X% Save the bits so pop-up is fast. X% /RetainCanvas? true def X /RetainCanvas? false def X% Nice menu font... X /MenuFont /Helvetica-Bold findfont 12 scalefont def X% Draw arrow pointing to current selection? X /HiLiteWithArrow? true def X% Menu line attributes X /MenuLineWidth 0 def X /MenuLineCap 1 def X /MenuArrowWidth 1 def X /MenuArrowCap 1 def X% Minimum radius for label positioning. X /LabelMinRadius 25 def X% Radius to step by when sizing menu X /LabelRadiusStep 5 def X% Extra radius to add when sizing menu X /LabelRadiusExtra 10 def X% Direction in which the keys are laid out around the circle. X /Clockwise true def X% The angle at which the first key is placed. X /PieInitialAngle 90 def % up X% Don't ask. X /SplatFactor 0 def X% Delays to use before mapping, if a button up has not happened yet. X /MapLongDelay .6 60 div def % root menu popup delay X /MapShortDelay .25 60 div def % submenu popup delay X /NoMapDist 10 def X% Direct Pac-Manupulation Feedback X /Wocka true def X /WockaTime .05 60 div def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Class methods X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X% Calculate and set the menu X% LabelRadius, PieRadius, MenuWidth, and MenuHeight. Shape the canvas X% and set the cursor. X X /layout { X gsave MenuFont setfont initmatrix X X /PieSliceWidth 360 MenuKeys length 1 max div store X X % Get the size of all the keys, and point them in the right direction X /ThisAngle PieInitialAngle store X MenuItems { X begin X w null eq X {/Key load ThingSize /h exch def /w exch def} if X /ang ThisAngle def X /dx ang cos def X /dy ang sin def X dx abs .05 lt { % top or bottom X /xoffset w -.5 mul def X /yoffset ang 180 gt {h neg} {0} ifelse def X } { % left or right X /xoffset ang 90 gt ang 270 lt and {w neg} {0} ifelse def X /yoffset h -.5 mul def X } ifelse X /ThisAngle ThisAngle PieSliceWidth X Clockwise {sub} {add} ifelse X NormalAngle store X end X } forall X X % Push the keys out so none of them overlap X /LabelRadius LabelMinRadius def X MenuItems length 1 gt { X 0 1 MenuItems length 1 sub { X /i exch def X /nexti i 1 add MenuItems length mod def X { X i calcrect X nexti calcrect X rectsoverlap not {exit} if X /LabelRadius LabelRadius LabelRadiusStep add def X } loop X } for X } if X /LabelRadius LabelRadius LabelRadiusExtra add def X X /PieRadius LabelRadius dup mul def X MenuItems { X begin X /x dx LabelRadius cvr mul def % XXX: cvr is for NeWS math bug X /y dy LabelRadius cvr mul def X X /X x xoffset add def X /Y y yoffset add def X X dx abs .05 lt { % top or bottom X x abs w 2 div add dup mul y abs h add dup mul add X } { % left or right X x abs w add dup mul y abs h 2 div add dup mul add X } ifelse X PieRadius max /PieRadius exch store X end X } forall X /PieRadius PieRadius sqrt Gap add Border add round store X X /MenuWidth X PieRadius dup add store X /MenuHeight X MenuWidth store X X grestore X } def X X /calcrect { % item_number => x y w h X MenuItems exch get begin X LabelRadius dx mul xoffset add X LabelRadius dy mul yoffset add X w h X end X } def X X /reshape { X MenuGSave X framebuffer setcanvas X newpath X PieRadius dup dup 0 360 arc X closepath X NumbHole { X PieRadius dup NumbRadius 1 sub 360 0 arcn closepath } if X SplatFactor { 6 { PieRadius dup add random mul } repeat X curveto } repeat X MenuCanvas eoreshapecanvas X /beye /beye_m MenuCanvas setstandardcursor X % So retained canvases don't have their old image upon popup: X RetainCanvas? { X MenuCanvas setcanvas X MenuFillColor fillcanvas X } if X grestore X } def X X% Make sure nothing's highlighted if there's a retained canvas. X% Layout the menu, make the canvas, and reshape it, as needed. Try to X% center the menu on (XLocation, YLocation) (the location of the event X% or the (X, Y) arguments), but if needed, move it so that it's X% completely on the screen, remembering the distance moved in (DeltaX, X% DeltaY), for repositioning the mouse later. Set up the canvas. Send X% out a MapMenuEvent with a delay, so that we can supress the mapping X% if we receive the events that complete the selection right away. X% (This is mouse-ahead display suppression.) (Submenus have a shorter X% delay than parentless menus, because if you mouse quickly into a X% submenu, then wait, you're more immediatly interested in seeing the X% submenu than the parent.) Finally, reset the menu value, and X% activate the menu event manager. X X /showat { % event => - X X PaintedValue null ne MenuCanvas null ne and MenuWidth null ne and { X MenuGSave X PaintedValue PaintSlice X grestore X } if X /PaintedValue null store X X MenuEventMgr null ne {MenuEventMgr waitprocess pop} if X X MenuWidth null eq { X /layout self send X MenuCanvas null ne {/reshape self send} if X } if X X MenuCanvas null eq { X /MenuCanvas ParentCanvas newcanvas def X MenuCanvas /Retained RetainCanvas? put X MenuCanvas /SaveBehind ColorDisplay? put X% MenuCanvas /SaveBehind true put X /reshape self send X } if X X MapMenuEvent null eq { X /MapMenuEvent createevent def X MapMenuEvent begin X /Name /MapMenu def X end % MapMenuEvent X } if X MapMenuEvent /Canvas MenuCanvas put X X gsave X framebuffer setcanvas X dup type /eventtype eq { X begin XLocation YLocation end X } if X PieRadius sub MouseYDelta add /MenuY exch def X PieRadius sub MouseXDelta add /MenuX exch def X X currentcursorlocation /CurY exch def /CurX exch def X X clippath pathbbox /DeltaY exch def /DeltaX exch def pop pop X X /DeltaY X MenuY MenuHeight add X dup DeltaY ge { X DeltaY exch sub X } { X dup MenuHeight lt { X MenuHeight exch sub X } { pop 0 } ifelse X } ifelse X def X X /DeltaX X MenuX MenuWidth add X dup DeltaX ge { X DeltaX exch sub X } { X dup MenuWidth lt { X MenuWidth exch sub X } { pop 0 } ifelse X } ifelse X def X X /MenuX MenuX DeltaX add store X /MenuY MenuY DeltaY add store X X% MenuCanvas savebehindcanvas X MenuCanvas setcanvas MenuX MenuY movecanvas X MenuCanvas canvastotop X X grestore X X% Defer the mapping till events already in the input queue X% have been processed. X X MapMenuEvent recallevent X X % So active submenu pops up before already choosen parent! X MapMenuEvent /TimeStamp currenttime MapShortDelay add put X X MapMenuEvent sendevent X X /MenuValue null def X /GotDown false def X X /activate self send X } def X X /paint { X MenuGSave X PaintMenuFrame X PaintMenuItems X grestore X } def X X /PaintMenuFrame { X MenuGSave X X MenuFillColor fillcanvas X X PieRadius dup translate X X newpath X 0 0 PieRadius 0 360 arc closepath X 0 0 PieRadius Border sub 0 360 arc closepath X% 0 0 NumbRadius 0 360 arc closepath X MenuBorderColor setcolor eofill X grestore X } def X X /PaintMenuItems { X MenuGSave X false setprintermatch X PieRadius dup translate X X MenuItems { % item X begin X MenuTextColor setcolor X /Key load X Y ShowThing X X% There seems to be a NeWS line clipping bug with lines with one X% endpoint the right of the hole in the center of the menu ... X X 2 setlinequality % Solves SOME of the line glitches ... X MenuLineWidth setlinewidth X MenuLineCap setlinecap X X SliceWedges { X gsave X newpath X ang PieSliceWidth 2 div sub rotate X NumbRadius 0 moveto X LabelRadius Gap sub 0 lineto X MenuBorderColor setcolor X stroke X grestore X } if X X SliceArrows { X gsave X MenuArrowWidth setlinewidth X MenuArrowCap setlinecap X newpath X ang rotate X NumbRadius 0 moveto X LabelRadius .5 mul 0 lineto X currentpoint X LabelRadius .4 mul LabelRadius .04 mul lineto X moveto X LabelRadius .4 mul LabelRadius -.04 mul lineto X MenuBorderColor setcolor X stroke X grestore X } if X end X } forall X grestore X } def X X% Handle drag events. If there's not a child menu up, then track the X% mouse movement, updating the menu value according the the event X% location; if it has changed, then update the highlighting. X X /DragProc { X ChildMenu null eq { X MenuGSave X PieRadius dup translate X CurrentEvent begin X XLocation DeltaX add X YLocation DeltaY add X end X SetMenuValue X X MenuValue PaintedValue ne { X PaintMenuValue X } if X grestore X } if X } def X X% Handle enter canvas events. Just call DragProc to keep the menu X% value updated. X X /EnterProc { X DragProc X } def X X% Handle exit canvas events. Same as above. Here we keep tracking even X% when you're off the menu edge (due to expressing interest in events X% on the null canvas). But if it really turns you on, going off the X% edge could mean no selection (like when you're within the numb X% radius - look at SetMenuValue), or select the slice, or pop up a X% submenu, or drag the menu around, or give more info about the slice, X% or whatever. X X /ExitProc { X DragProc X } def X X % Pop back to the center of the menu. X /KerProc { X MenuGSave X DragProc X framebuffer setcanvas X MenuX PieRadius add MouseXDelta sub X MenuY PieRadius add MouseYDelta sub X setcursorlocation X grestore X } def X X % Pop back to the previous menu, if we're in this menu's center. X /ChunkProc { X MenuGSave X DragProc X MenuValue null eq { X popdown X } if X grestore X } def X X% Map the menu on the screen. This is invoked when we get a /MapMenu X% event, so that we can interrupt the display of the menu (by X% recalling the event) if the events that would complete the selection X% are already in the input queue. X X /MapMenu { X gsave X DeltaX 0 ne DeltaY 0 ne or { X framebuffer setcanvas X currentcursorlocation X exch DeltaX add X exch DeltaY add X setcursorlocation X /DeltaX 0 def /DeltaY 0 def X } if X X% MenuCanvas /SaveBehind ChildMenu null eq put X MenuCanvas /Mapped true put X grestore X } def X X /MaybeMapMenu { X gsave X framebuffer setcanvas X CurX CurY X currentcursorlocation /CurY exch def /CurX exch def X CurY sub dup mul exch CurX sub dup mul add X NoMapDist gt { X MapMenuEvent /TimeStamp currenttime X ChildMenu null eq MapShortDelay MapLongDelay ifelse add put X MapMenuEvent sendevent X } { X MapMenu X } ifelse X grestore X } def X X /popdown { X X % Direct Pac-Manipulation Feedback X Wocka MenuCanvas /Mapped get not and { X MenuValue null ne { X gsave X MenuItems MenuValue get begin X fboverlay setcanvas X overlayerase erasepage X 0 setgray X MenuX PieRadius add MenuY PieRadius add translate X ang rotate X 0 0 moveto X 0 0 PieRadius % x y r X PieSliceWidth 2 div dup neg arc X closepath X fill X CurrentEvent /TimeStamp get WockaTime add X { pause X dup currenttime lt { exit } if X } loop pop X overlayerase erasepage X end % Item X grestore X } if X } if X X MapMenuEvent recallevent X X MenuCanvas null ne {MenuCanvas unmapcanvas} if % spin needs this?? X X RetainCanvas? not { X /MenuCanvas null store X /MenuInterests null store X% /MenuWidth null store X } if % framebuffer setcanvas? X X ChildMenu null ne { X /popdown ChildMenu send X } if X X ParentMenu null ne { X ParentMenu /ChildMenu null put X /ParentMenu null store X } if X X MenuEventMgr null ne { X MenuEventMgr /MenuEventMgr null store killprocess X } if X X } def X X% Calculate and set the menu value from the cursor x y location. X% Updates /PieDistance and /PieDirection instance variables. X X /SetMenuValue { % x y => - (Sets /MenuValue) X /PieDistance X 2 index cvr dup mul 2 index cvr dup mul add sqrt round cvi def X PieDistance 0 eq { pop pop 0 } { exch atan } ifelse X /PieDirection exch round cvi def X /MenuValue X PieDistance NumbRadius le X% It could be that when the cursor is out past the menu radius, X% nothing is selected. But I don't do it that way, because it wins X% to be able to get arbitrarily more precision by moving out further. X% PieDistance PieRadius gt or X { null } X { PieSliceWidth 2 div PieInitialAngle X Clockwise { add PieDirection sub } { sub PieDirection add } ifelse X NormalAngle X PieSliceWidth idiv } ifelse X def X } def X X% Update the highlighted slice to show the current menu value. X X /PaintMenuValue { % - => - (Hilite current item, un-hilite prev one.) X PaintedValue PaintSlice X MenuValue PaintSlice X /PaintedValue MenuValue store X } def X X% Paint highlighting on a menu slice. If it's null, then do nothing. X% Draw an arrow, and a box around the key. X X /PaintSlice { % key => - X dup null ne { % key X MenuGSave X PieRadius dup translate X X% Draw an arrow pointing out in the direction of the slice. X MenuItems exch get begin X X% overlayerase X MenuBorderColor setcolor X 5 setrasteropcode X X HiLiteWithArrow? { X gsave X ang rotate X newpath X NumbRadius 0 moveto X LabelRadius Gap sub % r X dup .6 mul dup PieSliceWidth 3 div sin mul lineto X dup .9 mul 0 lineto X .6 mul dup PieSliceWidth -3 div sin mul lineto % X closepath X StrokeSelection {stroke} {fill} ifelse X grestore X } if X X% Highlight the key Thing. X -4 2 X Y w h insetrrect rrectpath X StrokeSelection {stroke} {fill} ifelse X end X grestore X } {pop} ifelse % X } def X X% Handle button up events. If we have children, then let the leaf X% child menu handle the button up event. Otherwise, we handle it: If X% it's a menu dictionary, then make it the child menu and show it. X% Otherwise, execute the associated menu action, and send a /popdown X% message to the root parent menu. X X /UpProc { X DragProc X MenuValue getmenuaction dup type /dicttype eq { X /DeltaX 0 def /DeltaY 0 def % selection already made -- don't warp! X /ChildMenu exch def X ChildMenu /ParentMenu self put X CurrentEvent /showat ChildMenu send X } { X pop X % Ignore first mouse up if we're still in center of first menu X ParentMenu null ne MenuValue null ne GotDown or or { X /DeltaX 0 def /DeltaY 0 def % don't warp! X { X % Find the parent menu X self { X dup /ParentMenu get dup null eq X { pop exit } X { exch pop } ifelse X } loop X % ^?^? (toodles [tm]!) X /popdown exch send X domenu X } fork waitprocess % doesn't return X } { X % If we are still in menu center then map immediatly! X MapMenuEvent recallevent X MapMenu X } ifelse X } ifelse X } def X X% Handle menu button down events. X X /DownProc { X /GotDown true store X DragProc X } def X X% Handle damage events. Gotta make sure the highlighted slice is X% re-highlighted. X X /DamageProc { X MenuGSave X damagepath clipcanvas X /paint self send X PaintedValue PaintSlice X newpath clipcanvas X grestore X } def X X% Construct menu event interests. Use exclusivity so only the X% top-most menu sees the events. X X /makeinterests { X /MenuInterests [ X% MenuButton /UpProc UpTransition null eventmgrinterest % X11/NeWS X MenuButton {UpProc pop} UpTransition null eventmgrinterest X dup /Exclusivity true put X dup /Priority 5 put X% MenuButton /DownProc DownTransition null eventmgrinterest X MenuButton {DownProc pop} DownTransition null eventmgrinterest X dup /Exclusivity true put X% MouseDragged /DragProc null null eventmgrinterest X MouseDragged {DragProc pop} null null eventmgrinterest X dup /Exclusivity true put X% /EnterEvent /EnterProc null MenuCanvas eventmgrinterest X /EnterEvent {EnterProc pop} null MenuCanvas eventmgrinterest X dup /Exclusivity true put X% /ExitEvent /ExitProc null MenuCanvas eventmgrinterest X /ExitEvent {ExitProc pop} null MenuCanvas eventmgrinterest X dup /Exclusivity true put X% /Damaged /DamageProc null MenuCanvas eventmgrinterest X /Damaged {DamageProc pop} null MenuCanvas eventmgrinterest X dup /Exclusivity true put X dup /Priority -5 put X% AdjustButton /KerProc DownTransition null eventmgrinterest X AdjustButton {KerProc pop} DownTransition null eventmgrinterest X dup /Exclusivity true put X% AdjustButton /ChunkProc UpTransition null eventmgrinterest X AdjustButton {ChunkProc pop} UpTransition null eventmgrinterest X dup /Exclusivity true put X% Kludge to refresh messed up retained menu canvases. Ssssh! Don't tell anyone. X PointButton {} DownTransition null eventmgrinterest X% PointButton /DamageProc UpTransition MenuCanvas eventmgrinterest X PointButton {DamageProc pop} UpTransition MenuCanvas X eventmgrinterest X% /MapMenu /MaybeMapMenu null MenuCanvas eventmgrinterest X /MapMenu {MaybeMapMenu pop} null MenuCanvas eventmgrinterest X dup /Priority -5 put X ] def X } def X X /getmenuaction { % index => action X dup null ne { X MenuActions 1 index MenuActions length 1 sub min get X% Execute actions that are names! (This is so we can have references X% to submenus (executable names) as actions, as opposed to having the X% submenu object dict itsself!) X dup type /nametype eq { exec } if X } {nullproc} ifelse X exch pop X } def X Xclassend def X X/PieMenu SimplePieMenu def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X/LayeredPieMenu SimplePieMenu Xdictbegin X /MenuArgs [] def X /MenuArg null def X /PaintedArg null def Xdictend Xclassbegin X % Need to make flipstyle a no-op because /new takes a different number X % of args, and actions might depend on MenuArg! Scratch that. X % Instead, let's just make a new instance of ourselves, of X % the same class. X /flipstyle { X 0 1 MenuActions length 1 sub { X dup getmenuaction % fixed to use getmenuaction! X dup type /dicttype eq { X /flipstyle exch send % i menu' X MenuActions 3 1 roll put % - X } {pop pop} ifelse X } for X MenuArgs MenuKeys MenuActions /new ClassName load send X dup /LabelMinRadius LabelMinRadius put % hack X } def X X /new { % args keys actions => menu X % -or- args keys/actions (one array) => menu X /new super send begin X /MenuArgs exch def X currentdict end X } def X X /showat { X /MenuArg null def X PaintedArg null ne MenuCanvas null ne and MenuWidth null ne and { X MenuGSave X PaintedArg PaintMenuArg X grestore X } if X /PaintedArg null store X /showat super send X } def X X /DragProc { X ChildMenu null eq { X MenuGSave X PieRadius dup translate X CurrentEvent begin X XLocation DeltaX add X YLocation DeltaY add X end X SetMenuValue X X MenuValue PaintedValue ne { X PaintMenuValue X } if X MenuArg PaintedArg ne { X PaintMenuArg X } if X grestore X } if X } def X X /DamageProc { X MenuGSave X damagepath clipcanvas X /paint self send X PaintedValue PaintSlice X PaintedArg PaintArg X newpath clipcanvas X grestore X } def X X /PaintMenuArg { X PaintedArg PaintArg X MenuArg PaintArg X /PaintedArg MenuArg store X } def X X /PaintArg { X dup null ne { X MenuGSave X PieRadius dup translate X MenuBorderColor setcolor X 5 setrasteropcode X 100 string cvs X dup stringbbox points2rect X -.5 mul exch -.5 mul exch moveto X pop pop X show X grestore X } if X } def X X /SetMenuValue { % x y => - X /SetMenuValue super send X /MenuArg X MenuValue null eq X MenuArgs length 0 eq or { X null X } { X PieDistance PieRadius 1 sub min NumbRadius sub X PieRadius NumbRadius sub div MenuArgs length mul floor X MenuArgs exch get X } ifelse X def X } def X X /getmenuarg { X MenuArg X } def Xclassend def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X/setdefaultmenu { % class => - X /DefaultMenu exch store X systemdict /rootmenu known { X %/rootmenu /flipstyle rootmenu send store X } if X} def X XXNeWS? not Xsystemdict /DontSetDefaultMenu known not and { X % Death to pulldown menus! X PieMenu setdefaultmenu X} if X Xend X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% //go.sysin dd * if [ `wc -c < piemenu.ps` != 34084 ]; then made=false echo error transmitting piemenu.ps -- echo length should be 34084, not `wc -c < piemenu.ps` else made=true fi if $made; then chmod 664 piemenu.ps echo -n ' '; ls -ld piemenu.ps fi echo Extracting pullout.ps sed 's/^X//' <<'//go.sysin dd *' >pullout.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Class PulloutPieMenu X% Copyright (C) 1988 by Don Hopkins (don@brillig.umd.edu) X% X% This program is provided free for unrestricted use and redistribution, X% provided that the headers remain intact. No author or distributor X% accepts any responsibility for any problems with this software. X% X% PulloutPieMenu is a subclass of PieMenu that uses cursor distance X% from the menu center to specify an argument to the menu selection. X% Each menu key has an array of possible arguments, from which the X% cursor distance selects the argument value. The values in the X% arrays are "Things" (cf. litemenu.ps & colordemo) that are painted X% in the menu center as feedback. The /new method of class X% PulloutPieMenu takes the same arguments that regular menus do, plus X% an additional array of argument arrays. Each argument array X% corresponds to a menu key. If you give just one argument array, it X% is used for all the keys, the same as with the array of actions. X% You can use getmenuarg and getmenuargindex in your menu actions to X% retrieve the argument displayed when the key was selected. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xsystemdict begin X X% ------------------------------------ % X% PulloutPieMenu X X/PulloutPieMenu PieMenu Xdictbegin X /SliceWedges false def X /HiLiteWithArrow? false def X /PrinterMatch? false def X /ArgBorder 2 def X /EraseArgs? true def X /MenuArgs null def X /MenuArg null def X /MenuArgIndex null def X /PaintedArg null def Xdictend Xclassbegin X X % [[args...]...] [keys...] [actions...] => menu X /new { X /new super send begin X dup length MenuKeys length lt { X [ exch aload pop % pad out args w/ last arg X counttomark MenuKeys length exch sub {dup} repeat ] X } if X /MenuArgs exch def X currentdict X end X } def X X % Need to make flipstyle a no-op because /new takes a different number X % of args, and actions might depend on MenuArg! Scratch that. X % Instead, let's just make a new instance of ourselves, of X % the same class. X /flipstyle { X 0 1 MenuActions length 1 sub { X dup getmenuaction % fixed to use getmenuaction! X dup type /dicttype eq { X /flipstyle exch send % i menu' X MenuActions 3 1 roll put % - X } {pop pop} ifelse X } for X MenuArgs MenuKeys MenuActions /new ClassName load send X dup /LabelMinRadius LabelMinRadius put % hack X } def X X /MenuGSave { X /MenuGSave super send X PrinterMatch? setprintermatch X } def X X /DragProc { X ChildMenu null eq { X MenuGSave X PieRadius dup translate X CurrentEvent begin X XLocation DeltaX add X YLocation DeltaY add X end X SetMenuValue X X MenuValue PaintedValue ne { X PaintMenuValue X } if X getmenuarg /PaintedArg load ne { X PaintMenuArg X } if X grestore X } if X } def X X framebuffer /GLCanvas known { % SGI 4Sight? X % Paint menus on the overlay plane X /paint { X /paint super send X /PaintedArg load /PaintArg self send X } def X } { X /DamageProc { X MenuGSave X damagepath clipcanvas X /paint self send X PaintedValue PaintSlice X /PaintedArg load PaintArg X newpath clipcanvas X grestore X } def X } ifelse X X /PaintMenuArg { X getmenuarg X dup null eq /PaintedArg load null eq EraseArgs? or or { X % The null...pop is to get around the fact that 4Sight's ThingSize X % recognizes [(string) /name] as a special case, and eats both, X % which hoses us if we call it with just a /name, but with a X % (string) on the stack before that. X null /PaintedArg load EraseArg pop X } if X dup PaintArg X /PaintedArg exch store X } def X X /EraseArg { % thing => - X MenuGSave X dup null eq { X pop X PieRadius dup translate X MenuFillColor setcolor X 0 0 LabelRadius Gap sub 3 sub 0 360 arc X fill X } { X PieRadius dup translate X MenuFillColor setcolor X% dup /toggle3 eq {/foo dbgbreak} if X ThingSize X 2 copy X -.5 mul exch -.5 mul exch X 4 -2 roll X ArgBorder neg 5 1 roll insetrect % Some extra padding... X rectpath fill X } ifelse X grestore X } def X X /PaintArg { % thing => - X MenuGSave X dup null eq { X pop X PieRadius dup translate X MenuBorderColor setcolor X MenuLineWidth setlinewidth X MenuLineCap setlinecap X MenuItems { X begin X gsave X newpath X ang PieSliceWidth 2 div sub rotate X NumbRadius 0 moveto X LabelRadius Gap sub 4 sub 0 lineto X MenuBorderColor setcolor X stroke X grestore X end X } forall X } { X PieRadius dup translate X MenuTextColor setcolor X dup ThingSize X -.5 mul exch -.5 mul exch X ShowThing X } ifelse X grestore X } def X X /showat { X PaintedArg null ne PaintedValue null ne and X MenuCanvas null ne and MenuWidth null ne and { X MenuGSave X /PaintedArg load EraseArg X /PaintedArg null store X null PaintArg X grestore X } if X /MenuArg null def X /MenuArgIndex null def X /showat super send X } def X X /SetMenuValue { % x y => - X /SetMenuValue super send X /MenuArg X MenuValue null eq X {null true} X {MenuArgs MenuValue get dup length 0 eq} ifelse { X pop null X /MenuArgIndex null def X } { X PieDistance PieRadius 1 sub min NumbRadius sub X PieRadius NumbRadius sub div 1 index length mul floor X /MenuArgIndex 1 index def X get X } ifelse X def X } def X X /getmenuargindex { % - => index X MenuArgIndex X } def X X /getmenuarg { % - => Thing X /MenuArg load X } def X Xclassend def X Xend % systemdict //go.sysin dd * if [ `wc -c < pullout.ps` != 5590 ]; then made=false echo error transmitting pullout.ps -- echo length should be 5590, not `wc -c < pullout.ps` else made=true fi if $made; then chmod 664 pullout.ps echo -n ' '; ls -ld pullout.ps fi echo Extracting quickwin.ps sed 's/^X//' <<'//go.sysin dd *' >quickwin.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% @(#)quickwin.ps X% X% QuickWindow Class pie menu based window manager X% Copyright (C) 1988. X% By Don Hopkins. X% All rights reserved. X% X% This program is provided for UNRESTRICTED use provided that this X% copyright message is preserved on all copies and derivative works. X% This is provided without any warranty. No author or distributor X% accepts any responsibility whatsoever to any person or any entity X% with respect to any loss or damage caused or alleged to be caused X% directly or indirectly by this program. This includes, but is not X% limited to, any interruption of service, loss of business, loss of X% information, loss of anticipated profits, core dumps, abuses of the X% virtual memory system, or any consequential or incidental damages X% resulting from the use of this program. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% August 28, 1988 Don Hopkins X% Made the menus shared by all instances of the class. X% Put in a kludge to keep "spin" from trashing everybody's frame menu. X% (If you want to learn how to write good NeWS code, don't look at spin.) X% Added the DontSetDefaultWindow flag. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Xsystemdict begin X Xsystemdict /PieMenu known not { X (NeWS/piemenu.ps) LoadFile pop X} if X X/QuickWindow LiteWindow Xdictbegin X /Retained? framebuffer newcanvas /Retained get def X /CheapIcon? true def Xdictend Xclassbegin X X /stretchtopright { X non-iconic X FrameX FrameY X BBoxFromUser reshape X } def X X /stretchtopleft { X non-iconic X FrameX FrameWidth add FrameY X BBoxFromUser reshape X } def X X /stretchbottomright { X non-iconic X FrameX FrameY FrameHeight add X BBoxFromUser reshape X } def X X /stretchbottomleft { X non-iconic X FrameX FrameWidth add FrameY FrameHeight add X BBoxFromUser reshape X } def X X /stretchtop { X non-iconic X /GA_value FrameX def X /GA_constraint 0 def X FrameX FrameWidth add FrameY X BBoxFromUser reshape X } def X X /stretchbottom { X non-iconic X /GA_value FrameX def X /GA_constraint 0 def X FrameX FrameWidth add FrameY FrameHeight add X BBoxFromUser reshape X } def X X /stretchleft { X non-iconic X /GA_value FrameY def X /GA_constraint 1 def X FrameX FrameWidth add FrameY FrameHeight add X BBoxFromUser reshape X } def X X /stretchright { X non-iconic X /GA_value FrameY def X /GA_constraint 1 def X FrameX FrameY FrameHeight add X BBoxFromUser reshape X } def X X /movevertical { X /GA_constraint 0 def X slide X } def X X /movehorizontal { X /GA_constraint 1 def X slide X } def X X /flipmove { X gsave X framebuffer setcanvas X CurrentEvent begin XLocation YLocation end X unmap X Iconic? { X exch FrameWidth 2 div sub exch FrameHeight 2 div sub X /FrameX 2 index def /FrameY 1 index def X FrameCanvas X } { X exch IconWidth 2 div sub exch IconHeight 2 div sub X /IconX 2 index def /IconY 1 index def X IconCanvas X } ifelse X setcanvas matrix defaultmatrix setmatrix 2 copy movecanvas X flipiconic X move X slide X grestore X } def X X /non-iconic { X Iconic? { flipiconic } if X } def X X /reshapefromuser-open { X non-iconic X reshapefromuser X } def X X /flipiconic { X % Don't retain the frame canvas when iconic! X Retained? CheapIcon? and { X IconCanvas /Retained Iconic? not put X FrameCanvas /Retained Iconic? put X } if X /flipiconic super send X } def X X /CreateFrameCanvas { X /CreateFrameCanvas super send X /Retained? FrameCanvas /Retained get def X } def X X /CreateFrameMenu { % - => - (Create frame menu) X % Note: Store menu in class to share menus, especially if retained. X /FrameMenu ClassFrameMenu def X } def X X /CreateIconMenu { % - => - (Create icon menu) X % Note: Store menu in class to share menus, especially if retained. X /IconMenu {FrameMenu} def X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X% The menus shared by all instances of the class: X X /MenuFont /Courier findfont 12 scalefont def X X /FrameDebugMenu [ X (userdict) { X { clear X ParentDictArray length 1 add {end} repeat X /OllieNorthIsAHero dbgbreak X } fork pop X } X X (ThisWindow) { X { clear X { /CatsupIsAVegetable dbgbreak } ThisWindow send X } fork pop X } X X ] /new PieMenu send def X FrameDebugMenu /MenuFont MenuFont put X FrameDebugMenu /flipstyle {currentdict} put X FrameDebugMenu /LabelMinRadius 5 put X X /FrameEtcMenu [ X (zap) {/destroy ThisWindow send} X (debug) FrameDebugMenu X ] /new PieMenu send def X FrameEtcMenu /MenuFont MenuFont put X FrameEtcMenu /flipstyle {currentdict} put X FrameEtcMenu /LabelMinRadius 5 put X X /FrameMoveMenu [ X /move_v {/movevertical ThisWindow send} X /move {/slide ThisWindow send} X /eye {/flipmove ThisWindow send} X /move_h {/movehorizontal ThisWindow send} X ] /new PieMenu send def X FrameMoveMenu /flipstyle {currentdict} put X FrameMoveMenu /LabelMinRadius 15 put X FrameMoveMenu /LabelRadiusExtra 0 put X FrameMoveMenu /SliceWedges false put X FrameMoveMenu /HiLiteWithArrow? false put X X /FrameStretchMenu [ X /stretch_h {/stretchtop ThisWindow send} X /stretchNE {/stretchtopright ThisWindow send} X [/stretch_v 4 0] {/stretchright ThisWindow send} X /stretchSE {/stretchbottomright ThisWindow send} X /stretch_h {/stretchbottom ThisWindow send} X /stretchSW {/stretchbottomleft ThisWindow send} X [/stretch_v 4 0] {/stretchleft ThisWindow send} X /stretchNW {/stretchtopleft ThisWindow send} X ] /new PieMenu send def X FrameStretchMenu /flipstyle {currentdict} put X FrameStretchMenu /LabelMinRadius 5 put X FrameStretchMenu /LabelRadiusExtra 0 put X FrameStretchMenu /SliceWedges false put X FrameStretchMenu /HiLiteWithArrow? false put X X /ClassFrameMenu [ X [(\255) /Symbol findfont 12 scalefont] X {/totop ThisWindow send} X (Paint!) X {/paint ThisWindow send} X (Move\274) X FrameMoveMenu X (Etc\274) FrameEtcMenu X [(\257) /Symbol findfont 12 scalefont] X {/tobottom ThisWindow send} X (Shape!) {/reshapefromuser-open ThisWindow send} X (Grab\274) X FrameStretchMenu X /eye {/flipiconic ThisWindow send} X ] /new PieMenu send def X ClassFrameMenu /MenuFont MenuFont put X ClassFrameMenu /LabelMinRadius 10 put X ClassFrameMenu /LabelRadiusExtra 10 put X X X % Make a copy of ourselves if somebody tries to change us! X % (Yes this is a hack, but otherwise "spin" messes up everybody ======== END OF cyber.shar.splitaa ======== From don Thu Nov 23 01:55:43 1989 Date: Thu, 23 Nov 89 01:55:43 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitab From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitab ======== X % else's frame menu, and if you mess with the frame menu you're X % asking for trouble anyway.) X { /clone&forward { % /msg => - X /flipstyle self send X ThisWindow dup null eq { X pop /win where {pop win} { % Foo on spin... X /window where {pop window} { % Foo on othello... X /dont-mess-with-the-frame-menu dbgbreak X } ifelse X } ifelse X } if X /FrameMenu X 2 index put X send X } def X /insertitem { /insertitem clone&forward } def X /deleteitem { /deleteitem clone&forward } def X /changeitem { /changeitem clone&forward } def X } ClassFrameMenu send X Xclassend def X Xsystemdict /DontSetDefaultWindow known not { X /DefaultWindow QuickWindow def X X % Hack to make ScrollWindow a subclass of QuickWindow. (gross) X /ScrollWindow load type /arraytype eq { X 10 dict begin X /LiteWindow DefaultWindow def X ScrollWindow pop X end X } if X} if X Xend % systemdict //go.sysin dd * if [ `wc -c < quickwin.ps` != 7663 ]; then made=false echo error transmitting quickwin.ps -- echo length should be 7663, not `wc -c < quickwin.ps` else made=true fi if $made; then chmod 644 quickwin.ps echo -n ' '; ls -ld quickwin.ps fi echo Extracting textcan.ps sed 's/^X//' <<'//go.sysin dd *' >textcan.ps X% X% This file is a product of Sun Microsystems, Inc. and is provided for X% unrestricted use provided that this legend is included on all tape X% media and as a part of the software program in whole or part. Users X% may copy or modify this file without charge, but are not authorized to X% license or distribute it to anyone else except as part of a product X% or program developed by the user. X% X% THIS FILE IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE X% WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR X% PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. X% X% This file is provided with no support and without any obligation on the X% part of Sun Microsystems, Inc. to assist in its use, correction, X% modification or enhancement. X% X% SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE X% INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS FILE X% OR ANY PART THEREOF. X% X% In no event will Sun Microsystems, Inc. be liable for any lost revenue X% or profits or other special, indirect and consequential damages, even X% if Sun has been advised of the possibility of such damages. X% X% Sun Microsystems, Inc. X% 2550 Garcia Avenue X% Mountain View, California 94043 X% X% X% textcan.ps 1.10 89/03/07 X% X%------------------------------ TextCanvas -------------------------------- X% X% Copyright (c) 1987 by Sun Microsystems, Inc. X% Steve Isaac 12/18/87 X% X% TextCanvas User's Guide X% ----------------------- X% Description: X% TextCanvas is a NeWS class that provides a generic text storage and X% display facility NeWS server. It has the following features: X% . Scrolling X% . Text caret X% . Selections (integrated with system selections) X% . Text may be larger than the display canvas X% . Display canvas can be positioned anywhere over the stored text X% . Font and point size may be changed dynamically X% . Colors may be changed dynamically X% . No limitations on width of text X% . Fixed number of lines of text, specified at creation time X% . Currently limited to fixed-width fonts X% X% The TextCanvas allows text-based applications (terminal emulators, X% text editors, text widgets) to be easily written. It is a start at X% a common platform for NeWS text-oriented applications. X% X% The following things need to be done to TextCanvas in order to fully X% achieve this goal: X% X% . Support for variable width fonts and simultaneous multiple fonts X% (maybe a subclass if this causes too big a performance hit) X% . Text attributes (ie. reversed, blinking, bold, etc). X% . Separation of Text array and TextCanvas (to allow multiple X% views onto the same text) X% . Completion of selection service (multiple clicks, etc) X% . Dynamic changing of the number of lines of text X% . The caret should be a seperate class X% . The terminal emulation specifics (coordinate system, scrolling) X% should be a seperate subclass X% . Continuing performance improvements X% X% Overview: X% The TextCanvas can be viewed as a NeWS canvas that understands a set X% of messages relating to text manipulation (eg. inserting a string, X% deleting some lines, moving the caret). Basic canvas operations X% (eg. shaping, resizing, moving) are done via standard NeWS primitives. X% All canvas operations can be freely performed, however, the TextCanvas X% must be informed if the canvas is resized, damaged, or destroyed. X% X% A TextCanvas has an underlying fixed-size text array that contains X% arbitrarily long strings. The canvas is essentially a viewport into this X% array; this viewport may be moved around to display different parts of X% the text aray. It cannot be moved outside the boundries of the X% text array, however. X% X% An instance of TextCanvas is created by specifying an existing canvas X% and the number of lines that the Text array will store. This canvas X% could be the client canvas of a window, which is how the TextCanvas X% typically interfaces to the LiteWindow package. X% X% Coordinates: X% The TextCanvas presents an integer coordinate system that addresses each X% possible chararcter position in the Text array. It is laid out as follows: X% X% 1,-N ------------------ W,-N <------+ X% | | | X% | | | X% | | | X% | | | X% | | | X% 1,-1 W,-1 +-- NumLines X% 1,0 W,0 | X% 1,1 ------------------- W,1 | X% 1,2 W,2 | X% | | | X% | | | X% | | | X% 1,H ------------------- W,H <------+ X% X% where: W is the largest width of any string in the text array, X% H is the number of lines that fit in the viewport canvas, X% NumLines is the number of lines in the text array, X% N is: NumLines - H - 1. X% X% This means that the lines of the Text array under the original viewport X% postion are addressed starting at 1, with increasing line numbers going X% down the viewport. X% X% Note that W is always changing as new lines of text are written X% into the Text canvas. The coordinate system will change if the X% viewport canvas is resized. X% X% Scrolling: X% Text which is written at line number H+1 or greater will cause X% the entire Text array to scroll up so that the last line written X% is at line H. Lines 0 through -N are therefore a transcript of X% what was displayed in the viewport. Upwards scrolling can also be caused X% by cursor movement (movecursordelta). X% X% Downwards scrolling is limited to the original viewport area only. It is X% caused by cursor movement (movecursordelta). X% X% Scrolling can be limited to a portion of the text array (via X% setscrollinglimits). X% X% Moving the viewport: X% The viewport can be moved to display non-visible portions of the text X% arrray. Note that the coordinate system does not change if the viewport X% is moved. It remains relative to the original viewport position. Movement X% is requested via the moveviewport message. X% X% Caret: X% The TextCanvas contains a built-in text caret that can be turned X% on or off, be any color, be any shape that can be expressed as a X% PostScript path, made to blink at a user-defined speed and duty X% cycle, and moved to any coordinate location. The caret is positioned X% just to the left and below the location it is on. X% X% Writing text: X% Text is put into the text array via the writelines, and writeatcaret X% messages. They allow large blocks of text to be written in a single X% message. There is a big performance win for writing as large X% a block as possible. Text must consist of printable chararacters (ASCII X% codes 0x20-0x7E) only. Non-printable characters will cause erroneous X% selections. There is no special interpretation for control characters. X% X% Selections: X% The TextCanvas provides a MacIntosh-like selection mechanism. X% Left mouse button down sets the selection start point. Dragging the X% mouse with the left button down drags out a selection. Left mouse X% button up completes the selection. The middle mouse button allows X% the current selection to be extended, either by clicking or by dragging. X% X% The selected text is made the PrimarySelection in the system selection X% dictionary. Any previous primary selection is cleared. The selected text X% can be accessed via the standard system selection call (getselection). X% If LiteUI is running then the "Put" function key will put the selection X% on the shelf. X% X% Input Handling and Callback Routines: X% The TextCanvas expresses interest in keyboard events. An optional X% user-supplied callback routine (KeyHitCallback) is called whenever a X% keystroke is detected. Similarly, another callback routine X% (InsertValueCallback) is called when a selection /InsertValue X% event is detected. X% X% A callback routine for when the number of rows and columns in the X% viewport changes (ResizeCallback) is provided. Callbacks for mouse button X% events (LeftMouseDownCallback, LeftMouseUpCallback, X% MiddleMouseDownCallback, MiddleMouseUpCallback) are also provided. Other X% callbacks may be added by subclassing the text canvas. X% X% These callback routines make it very easy to write short routines X% do things like echo what the user has typed or move the caret to where X% the mouse was clicked. X% X% The callback routine will be executed within the context of the the X% TextCanvas instance. You may access all TextCanvas instance or class X% variables, or invoke methods by simply calling them as procedures. X% X% TextCanvas Interface Definition X% ------------------------------- X% The messages and callback routines that class TextCanvas provides are: X% X% /changefont { % fname fheight - => - X% --- Change the font and point size for all text. Either fname or fheight X% may be null, in which case they are ignored. X% X% /writelines { % arrayofstrings col row => - X% --- Write an array of strings, starting the first string at col,row X% with subsequent strings going at 1,row+1 1,row+2 etc. X% X% /writeatcaret { % arrayofstrings => - X% --- Similar to writelines, except start at the current caret location. The X% caret is moved to the next available character position when the X% write is done. X% X% /deletestring { % length col row => - X% --- Delete a string starting at col,row for length characters. X% length must be 0 or a positive integer. X% X% /insertline { % numlines row => - X% --- Insert numlines blank lines, starting at line row. X% numlines must be 0 or a positive integer X% X% /deleteline { % numlines row => - X% --- Delete numlines lines, starting at line row. X% numlines must be 0 or a positive integer X% X% /setscrollinglimits { % toprow bottomrow => - X% --- Sets the scrolling limits for the TextCanvas. All up or down scrolling X% will be limited to this region instead of affecting the entire Text X% canvas. When scrolling limits are set, those methods which can X% trigger scrolling (writelines, writeatcaret, movecaretdelta) will X% only cause scrolling if they affect lines within the scrolling region. X% Any scrolling that is initiated will only move lines within the X% scrolling limits. X% X% /removescrollinglimits { % - => - X% --- Removes any scrolling bounds set by setscrollinglimits. X% X% /clearviewport { % - => - X% --- Clear the text and screen area of the viewport X% X% /flashviewport { % - => - X% --- Flash the contents of the viewport (visible bell) X% X% /moveviewport { % x y => - X% --- Move the viewport to another part of the underlying Text array. X% x and y must be between 0 and 1. This represents a percentage of the X% current total width or height of the Text array. Either argument X% can be null, in which case it is ignored. X% X% /getviewportsize { % - => col rows xpixels ypixels X% --- Return the number of columns, rows, pixel height and width of X% the viewport. X% X% /getlinelength { % row => length X% --- Return the current length of the line at row. X% X% /calcarea { % pixwidth pixheight => numcols numrows X% --- Returns the number of rows and columns that will fit into the pixel X% area specified by pixwidth and pixheight, given the current Font and X% point size. X% X% /calcpixarea { % numcols numrows => pixwidth pixheight X% --- Returns the minimum pixel area required to display numrows and numcols, X% given the current Font and point size. X% X% /oncaret { % - => - X% --- Turn the caret on. X% X% /offcaret { % - => - X% --- Turn the caret off. X% X% /movecaret { % col row => - X% --- Move the caret to an absolute position. col and row are integers. Scrolling is X% never triggered. X% X% /movecaretdelta { % deltax deltay => - X% --- Move the caret relative to its current position. deltax and deltay must be X% integers (negatives allowed). Scrolling is triggered if deltay moves the caret X% outside of the scrolling limits. If no scrolling limits are set, scrolling is X% triggered if deltay moves the caret outside of the original viewport region. X% X% /setcaretblink { % blink-rate duty-cycle => - X% --- Set the caret blink rate and the blink duty cycle. blink-rate is X% in seconds and represents a complete on/off cycle. duty-cycle is X% between 0 and 1, and represents the percentage of on time. X% X% /setcaretcolor { % color => - X% --- Set the current caret color. color is a color object. X% X% /setcaretshape { % shapename => successful? X% --- Set the caret shape. shapename is an entry in the CaretShapeDict. X% Return a boolean that tells whether shapename was found. X% X% /getcaretpos { % - => col row X% --- Return the current caret position X% X% /setbgcolor { % color => - X% --- Set the current canvas background color X% X% /setfgcolor { % color => - X% --- Set the current text color X% X% /fixdamage { % - => - X% --- Damage handler; goes in the PaintClient window callback routine X% X% /new { % numrows can => object X% --- Create a new instance of the TextCanvas. numrows is the number X% of lines to be allocated in the Text array; it is fixed for X% the life of the instance. can is the viewport canvas. X% X% /reshape { % - => - X% --- This method must be called whenever the viewport canvas has changed X% size. It updates the number of rows and columns in the TextCanvas, X% repositions the caret to be as close to its old position as possible, X% resets the scrolling region, and moves the viewport to its original X% position. X% X% /destroy { % - => - X% --- Destroy the TextCanvas. This must be called if the viewport canvas X% is ever destroyed. X% X% --- Client callback routines. X% /ResizeCallback nullproc def % { - => - X% --- ResizeCallback is called whenever the number of rows and columns X% changes. X% /KeyHitCallback nullproc def % { keyvalue - => - X% --- KeyHitCallback is called whenever a keyboard input event happens X% /InsertValueCallback nullproc def % { insertstring => - X% --- InsertValueCallback is called whenever an InsertValue event happens X% /LeftMouseDownCallback nullproc def % { col row => - X% --- LeftMouseDownCallback is called when the left mouse button goes down. X% /LeftMouseUpCallback nullproc def % { col row => - X% --- LeftMouseUpCallback is called when the left mouse button goes up. X% /MiddleMouseDownCallback nullproc def % { col row => - X% --- MiddleMouseDownCallback is called when the middle button goes down. X% /MiddleMouseUpCallback nullproc def % { col row => - X% --- MiddleMouseUpCallback is called when the middle button goes up. X% X% Implementation Details X% ---------------------- X% Coordinates: X% The text canvas has an internal coordinate system as follows: X% X% 1,1 --------- TextWidth,1 X% | | X% | | X% 1,TextHeight TextWidth,TextHeight X% X% The Can canvas is essentially a viewport on this coordinate system. The X% TM tranformation matrix reflects this coordinate system, and is used for X% computing caret or text movement on Can. The base window lives in the X% lower left hand corner of the text canvas, the original location of the X% viewport. It is the same size as the Can canvas. External caret X% coordinates are relative to the base window; the internal caret X% coordinates (CaretX, CaretY) are relative to the internal coordinate X% system. The text array is laid out in a similar fashion to the internal X% coordinate system; however, indices are 0 based. The Xindex and Yindex X% functions map coordinate values to array indices. Text scrolling is X% handled by manipulating this mapping. X% X X%systemdict /TextCanvas known not { Xsystemdict begin X/TextCanvas Object Xdictbegin X /DEBUG false def % Turn on debugging output X /Text null def % Main text array X /TextWidth 0 def % Number of text columns (changes X % dynamically) X /TextHeight 0 def % Number of text rows (specified X % at initialization) X /Can null def % The main canvas X /SelectionCan null def % Visible selection feedback canvas X /SelDragCan null def % Transparent selection drag canvas X /Caret null def % The caret canvas X X /CanPixWidth 0 def % Canvas width (pixels) X /CanPixHeight 0 def % Canvas height (pixels) X /CanPixX 0 def % Canvas X origin (pixels) X /CanPixY 0 def % Canvas Y origin (pixels) X /CanX 0 def % Canvas X origin (Text coordinates) X /CanY 0 def % Canvas Y origin (Text coordinates) X /CanWidth 0 def % Number of columns in canvas X /CanHeight 0 def % Number of rows in canvas X X % --- Caret variables. X /CaretOn? false def % Is the caret on? X /CaretInactive? false def % Is the caret inactive (shaded, X % no blink)? X /CaretSupressed? false def % Is the caret supressed X % (temporarily off)? X /NextMoveTime 0 def % Time at which to do the next X % caret move X /DelayedMoveProc null def % Delayed caret move timer process X /CaretX 1 def % Caret column in canvas X /CaretY 1 def % Caret row in canvas X /CaretShape /TrianglePlus def % Current caret shape (from X % CaretShapeDict) X /CaretColor null def % Current caret color X /CaretBlinkEnabled? true def % Are we blinking? X /CaretBlinkTime 1.0 def % Seconds X /CaretDutyCycle 0.8 def % Percentage on X /CaretDelayTime .06 def % Caret move delay time (seconds) X X /EventMgr null def % The main event manager X /Interests null def % Main event manager interests X /MouseDragEventMgr null def % Event manager for mouse dragging X /DragInterests null def % Drag event manager interests X /KeyboardEventMgr null def % Keyboard/Insert_Value event mgr X X % --- Selection variables. X /MouseDownX 0 def % Where MouseDown actually happened X /MouseDownY 0 def X /SelectionX 1 def % Current initial selection point X /SelectionY 1 def X /SelectionX1 1 def % Current ending selection point X /SelectionY1 1 def X /SelExtendTop? false def % Extend the top of the selection X /SelectionOn? false def % Is the selection visible? X /SelectionPath null def % Current path of the visible X % selection X X /SelectionDict 10 dict dup begin % Dictionary for i/f to system X % selections X /ContentsAscii null def X /SelectionObjSize 1 def X /SelectionResponder null def X end def X X /ViewportXdelta 0 def % Viewport offset adjustment X /ViewportYdelta 0 def % Viewport offset adjustment X /WriteInProgress? false def % Is there text output happening? X /BotScrollLimit 0 def % Scrolling limit for bottom of screen X /TopScrollLimit 0 def % Scrolling limit for top of screen X /ScrollRegionLength 0 def % Number of lines in scrolling region X /ScrollLimitOn? false def % Are scrolling limits in effect? X /BaseY 0 def % Base window Y position in Text X /PixColWidth 0 def % Row width (pixels) X /PixRowHeight 0 def % Column height (pixels) X /TM null def % Position tranform matrix X /Font null def % Current font X /FontDescentTM null def % TM plus font descent X /MapOffset 0 def % Y array index offset X /InputBuffer null def % Input line buffer. X /InputBufferLine 0 def % Line that input buffer is on X /InputBufferLength 0 def % Number of characters in the buffer X /BgColor 1 1 1 rgbcolor def % Current background color X /FgColor 0 0 0 rgbcolor def % Current foreground color X /KeyboardInterest null def % Need to keep this so we can revoke X % it at destroy time to free memory X /MoreInterests null def % But wait, there's more! X % --- Client callback routines. X % --- ResizeCallback is called whenever the number of rows and columns X % changes. X /ResizeCallback nullproc def % { - => - X % --- KeyHitCallback is called whenever a keyboard input event happens X /KeyHitCallback nullproc def % { keyvalue - => - X % --- InsertValueCallback is called whenever an InsertValue event happens X /InsertValueCallback nullproc def % { insertstring => - X % --- LeftMouseDownCallback is called when the left mouse button goes down. X /LeftMouseDownCallback nullproc def % { col row => - X % --- LeftMouseUpCallback is called when the left mouse button goes up. X /LeftMouseUpCallback nullproc def % { col row => - X % --- MiddleMouseDownCallback is called when the middle button goes down. X /MiddleMouseDownCallback nullproc def % { col row => - X % --- MiddleMouseUpCallback is called when the middle button goes up. X /MiddleMouseUpCallback nullproc def % { col row => - Xdictend Xclassbegin X /LF 10 def X /CR 13 def X /BLANK 32 def X X /FontName /Screen def X /FontHeight 14 def X X /DefaultColorCaret 1 0 0 rgbcolor def X /DefaultMonoCaret 0 0 0 rgbcolor def X /DefaultInactiveColor ColorDisplay? X {.75 .75 .75 rgbcolor} X {.5 .5 .5 rgbcolor} X ifelse def X X%-------------------------------- Utilities ------------------------------------ X X /?def { X currentdict 2 index known { X pop pop X }{ X def X } ifelse X } def X X /LoadCaretShapeDict { X systemdict /CaretShapeDict known not { X systemdict begin /CaretShapeDict dictbegin dictend def end X } if X CaretShapeDict begin % --- Caret Shape dictionary X /HLine { % xscale yscale => {path} X matrix currentmatrix 3 1 roll X dup scale X pop X 0 0 moveto X 0 .8 transform round exch round exch itransform rlineto X -0.3 0 transform round exch round exch itransform rlineto X 0 -1 transform round exch round exch itransform rlineto X setmatrix X } ?def X X /Diamond { % xscale yscale => {path} X matrix currentmatrix 3 1 roll X dup scale X pop X 0 0 moveto 0.25 0 rmoveto 0.25 0.25 rlineto X -0.25 0.25 rlineto -0.25 -0.25 rlineto closepath X setmatrix X } ?def X X /TrianglePlus { % xscale yscale => {path} X matrix currentmatrix 3 1 roll X dup scale X pop X 0 0 moveto X 0 .8 transform round exch round exch itransform rlineto X -0.1 0 transform round exch round exch itransform rlineto X 0 -.8 transform round exch round exch itransform rlineto X -0.35 -0.4 transform round exch round exch itransform rlineto X .35 0 transform round exch round exch itransform rlineto X .1 0 transform round exch round exch itransform rlineto X .35 0 transform round exch round exch itransform rlineto X closepath X setmatrix X } ?def X X /Triangle { % xscale yscale => {path} X matrix currentmatrix 3 1 roll X dup scale X pop X 0 0 moveto X -0.3 -0.6 transform round exch round exch itransform rlineto X .6 0 transform round exch round exch itransform rlineto X -0.3 0.6 transform round exch round exch itransform rlineto X setmatrix X } ?def X X /Box { % xscale yscale => {path} X matrix currentmatrix 3 1 roll X scale X 0 0 moveto X 0 1 rlineto X 1 0 rlineto X 0 -1 rlineto X -1 0 rlineto X -.1 -.1 rmoveto X 0 1.2 rlineto X 1.2 0 rlineto X 0 -1.2 rlineto X closepath X setmatrix X } ?def X end X } def X X /Xindex { % col => x-index X % --- Convert a column coordinate into a Text array index X 1 sub X } def X X /Yindex { % row => y-index X % --- Convert a row coordinate into a Text array index X % Text array X 1 sub MapOffset add TextHeight mod X } def X X /CreateInterests { % - => - X % --- Main event handler interests X /Interests dictbegin X X /CaretDamageEvent X /Damaged X {pop gsave X Caret setcanvas X CaretInactive? { X DefaultInactiveColor fillcanvas X }{ X CaretColor fillcanvas X } ifelse X grestore } X null Caret eventmgrinterest X def X X /CaretTimerEvent X % --- Caret blink events. Send this event out again with the time X % of the next blink X /CaretTimer X {/e exch def X e begin X Caret /Mapped get { X CaretBlinkEnabled? CaretOn? CaretInactive? not CaretSupressed? not X and and and { X UnMapCaret X /TimeStamp X % --- When to turn caret back on X CaretBlinkTime 60 div 1 CaretDutyCycle X sub mul currenttime add X def X }{ X % --- If the caret is disabled, keep the timer event X % circulating at a 2 second rate X /TimeStamp currenttime 1 30 div add def X } ifelse X }{ X CaretBlinkEnabled? CaretOn? CaretInactive? not CaretSupressed? not X and and and { X MapCaret X /TimeStamp X % --- When to turn caret back off X CaretBlinkTime 60 div CaretDutyCycle mul X currenttime add X def X }{ X % --- If the caret is disabled, keep the timer event X % circulating at a 2 second rate X /TimeStamp currenttime 1 30 div add def X } ifelse X } ifelse X e sendevent X end} X null Caret eventmgrinterest X def X X /LeftMouseDownEvent X /LeftMouseButton X {begin X InactivateCaret X % --- Clear anyone else's primary selection X SendClearSelection X % --- Synchronously clear my primary selection X ClearMySelection X Can setcanvas X TM setmatrix X /MouseDownX XLocation 1 max round store X /SelectionX MouseDownX store X /SelectionX1 SelectionX store X /MouseDownY YLocation TextHeight min CanY max round store X /SelectionY MouseDownY store X /SelectionY1 SelectionY store X /len Text SelectionY Yindex get length store X SelectionX len 2 add gt { X /SelectionX len 2 add store X } if X /SelExtendTop? false def X /MouseDragEventMgr X DragInterests forkeventmgr X store X MouseDownX MouseDownY BaseY sub LeftMouseDownCallback X end } X /DownTransition Can eventmgrinterest X def X X /MiddleMouseDownEvent X /MiddleMouseButton X {begin X InactivateCaret X % --- Clear anyone else's primary selection X SendClearSelection X % --- Remove any visual feedback for my selection, but leave X % the selection path intact so we can extend it. X false DrawSelection X SelDragCan setcanvas X TM setmatrix X YLocation SelectionY sub abs dup mul X XLocation SelectionX sub abs dup mul add X YLocation SelectionY1 sub abs dup mul X XLocation SelectionX1 sub abs dup mul add lt { X /SelectionX XLocation 1 max round store X /SelectionY YLocation TextHeight min CanY max round store X /SelExtendTop? true store X }{ X /SelectionX1 XLocation 1 max round store X /SelectionY1 YLocation TextHeight min CanY max round store X /SelExtendTop? false store X } ifelse X ExtendSelection X /MouseDragEventMgr X DragInterests forkeventmgr X store X XLocation 1 max round YLocation TextHeight min CanY max round BaseY sub X MiddleMouseDownCallback X end} X /DownTransition Can eventmgrinterest X def X X dictend store % Interests X } def X X /CreateDragInterests { % - => - X % --- Interests for mouse drag event manager X /DragInterests dictbegin X /MouseDragEvent X /MouseDragged X { begin X SelDragCan setcanvas X TM setmatrix X SelExtendTop? { X /SelectionX XLocation 1 max round store X /SelectionY YLocation TextHeight min CanY max round store X }{ X /SelectionX1 XLocation 1 max round store X /SelectionY1 YLocation TextHeight min CanY max round store X } ifelse X erasepage X ExtendSelection X end} X null Can eventmgrinterest X def X X /LeftMouseUpEvent X /LeftMouseButton X {begin X SelDragCan setcanvas X erasepage X Can setcanvas X TM setmatrix X % --- If we are at the same location as LeftButton down, then X % remove any selection on our canvas. Otherwise, make the selected X % area the primary selection. X MouseDownX XLocation 1 max round eq X MouseDownY YLocation TextHeight min CanY max round eq and { X false DrawSelection X /SelectionPath null store X }{ X % --- SelectionX,Y must always be lower than SelectionX1,Y1 X SelectionY1 SelectionY lt SelectionY1 SelectionY eq X SelectionX1 SelectionX lt and or { X SelectionX SelectionY X /SelectionX SelectionX1 store X /SelectionY SelectionY1 store X /SelectionY1 exch store X /SelectionX1 exch store X } if X SelectionDict /ContentsAscii GetSelection put X SelectionDict /Canvas Can put X SelectionDict /SelectionHolder KeyboardEventMgr put X SelectionDict /PrimarySelection setselection X true DrawSelection X } ifelse X ReactivateCaret X XLocation 1 max round YLocation TextHeight min CanY max round BaseY sub XLeftMouseUpCallback X MouseDragEventMgr killprocess X end} X /UpTransition null eventmgrinterest X def X X /MiddleMouseUpEvent X /MiddleMouseButton X {begin X SelDragCan setcanvas X TM setmatrix X erasepage X % --- SelectionX,Y must always be lower than SelectionX1,Y1 X SelectionY1 SelectionY lt SelectionY1 SelectionY eq X SelectionX1 SelectionX lt and or { X SelectionX SelectionY X /SelectionX SelectionX1 store X /SelectionY SelectionY1 store X /SelectionY1 exch store X /SelectionX1 exch store X } if X SelectionDict /ContentsAscii GetSelection put X SelectionDict /Canvas Can put X SelectionDict /SelectionHolder KeyboardEventMgr put X SelectionDict /PrimarySelection setselection X true DrawSelection X ReactivateCaret X XLocation round YLocation TextHeight min CanY max round BaseY sub MiddleMouseUpCallback X MouseDragEventMgr killprocess X end} X /UpTransition null eventmgrinterest X def X dictend store X } def X X /KeyboardHandler { % - => - X % --- Handler for keyboard, InsertValue, and Deselect events X /KeyboardInterest Can addkbdinterests def X /MoreInterests [ X Can addselectioninterests aload pop X revokeinterest % Get rid of mouse interests X Can addfunctionstringsinterest X ] def X { awaitevent begin X Name type /integertype eq { X Name /KeyHitCallback self send X } if X Name /DeSelect eq { X false DrawSelection X /SelectionPath null store X } if X Name /LoseFocus eq { X InactivateCaret X } if X Name /RestoreFocus eq { X ReactivateCaret X } if X Name /InsertValue eq { X Action /InsertValueCallback self send X } if X Name /Ignore eq { X } if X end X } loop X } def X X /InitFont { % - => - X % --- Initialize the current font and font metrics X 10 dict begin X /Font FontName findfont FontHeight scalefont store X gsave X false setprintermatch X Font setfont (m) stringwidth pop /PixColWidth exch store X grestore X /PixRowHeight Font fontheight store X end X } def X X /Reshape { % firsttime? => - X % --- Reshape the TextCanvas. This is where all initialization happens. X % firsttime is true the first time the TextCanvas is reshaped; X % false otherwise. X % X % --- Note: we are not enclosing this proc in a '10 dict begin end' X % because the event handlers must be started with the class dict X % being first on the dictionary stack. This results in firsttime? X % being put into the instance dictionary. X /firsttime? exch def X % --- Take down the caret and clear any selection that is up X firsttime? { X LoadCaretShapeDict X InactivateCaret X /InputBuffer 1024 string def % Set input line buffer string to a X % reasonable size. The buffer will X % be grown dynamically if needed X }{ X SupressCaret X } ifelse X ClearMySelection X gsave X Can setcanvas X% Can /Parent get setcanvas X% 6 array identmatrix setmatrix % X11/NeWS X 6 array defaultmatrix setmatrix X % --- Set up transformation matrix with font descent at the baseline X 0 TextHeight PixRowHeight mul X Font fontascent add Font fontdescent sub X translate X PixColWidth PixRowHeight neg scale X /FontDescentTM 6 array currentmatrix store X % --- Set up transformation matrix for direct mapping of Text coords X% 6 array identmatrix setmatrix % X11/NeWS X 6 array defaultmatrix setmatrix X 0 TextHeight PixRowHeight mul X Font fontascent add X translate X PixColWidth PixRowHeight neg scale X /TM 6 array currentmatrix store X grestore X % --- Initialize the viewport and caret positions. Set the caret to X % 1,1 the first time around, try to maintain previous caret X % position subsequently X firsttime? { X % --- Determine the number of rows and columns in this canvas X /CanWidth CanPixWidth PixColWidth idiv 1 sub store X /CanHeight CanPixHeight PixRowHeight idiv 1 sub store X % --- Initialize the position of the canvas viewport and the caret X /CanX 1 store X /CanY TextHeight CanHeight sub 1 add store X /BaseY CanY 1 sub store X /CaretX CanX store X /CaretY CanY store X }{ X /CaretX CaretX ViewportXdelta add store X /CaretY CaretY ViewportYdelta add store X /ViewportXdelta 0 store X /ViewportYdelta 0 store X % --- Remove any scrolling offset from caret position X /CaretX CanX 1 sub CaretX add store X /CaretY CanY TextHeight CanHeight sub 1 add sub CaretY add store X % --- Determine the number of rows and columns in this canvas X /CanWidth CanPixWidth PixColWidth idiv 1 sub store X /CanHeight CanPixHeight PixRowHeight idiv 1 sub store X % --- Initialize the position of the canvas viewport and the caret X /CanX 1 store X /CanY TextHeight CanHeight sub 1 add store X /BaseY CanY 1 sub store X % --- Check if the caret is out of bounds X CaretY CanY lt { X /CaretY CanY store X } if X CaretX CanWidth gt { X /CaretX CanWidth store X } if X } ifelse X % --- Reset scrolling limits X /BotScrollLimit TextHeight store X /TopScrollLimit CanY store X /ScrollRegionLength BotScrollLimit TopScrollLimit sub 1 add def X /ScrollLimitOn? false store X % --- Set up the text arrays X firsttime? { X /Text TextHeight array store X % --- Initialize Text array to empty strings X 0 1 TextHeight 1 sub { X Text exch () put X } for X % --- Initialize the input buffer to blanks X 0 1 InputBuffer length 1 sub { X InputBuffer exch BLANK put X } for X } if X % --- Create the caret if needed X Caret null eq { X CreateCaret X % --- Kick off first blink event X createevent begin X /Canvas Caret def X /Name /CaretTimer def X /Action null def X /TimeStamp X CaretBlinkTime 60 div CaretDutyCycle mul currenttime add X def X currentdict X end X sendevent X } if X % --- Create interests and event managers if they aren't running. X % Note: this must be done with the class instance variable being X % the first thing on the dictionary stack; otherwise the event X % managers won't share the class' instance variables! X EventMgr null eq { X CreateInterests X CreateDragInterests X /EventMgr Interests forkeventmgr def X /KeyboardEventMgr {KeyboardHandler} fork def X } if X %SelectionCan null eq { X % --- Create the selection feedback canvas X % XXX - Not using the selection canvas yet; still doing xor X %/SelectionCan Can newcanvas store X %SelectionCan begin X % /Transparent false def X % /EventsConsumed /NoEvents def X %end X %} if X % --- Shape the viewport canvas X gsave X Can setcanvas X % --- Clear the canvas X BgColor fillcanvas X % --- Make the canvas size be an even number of rows and cols X Can /Parent get setcanvas X% CanPixX CanPixY X Can getcanvaslocation X translate X 0 0 X CanWidth PixColWidth mul PixColWidth add X CanHeight PixRowHeight mul PixRowHeight add X Font fontdescent 2 mul sub X rectpath X % --- Set the default matrix for the canvas to the identity matrix X% 6 array identmatrix setmatrix % X11/NeWS XCan setcanvas clippath X 6 array defaultmatrix setmatrix X Can reshapecanvas X % --- Create the outline selection drag canvas X /SelDragCan Can createoverlay store X grestore X /SelectionOn? false def X /SelectionPath null def X UnSupressCaret X MoveCaret X } def X X /ClearScreenArea { % x y width height => - X % --- Fill the designated area with the background color X gsave X Can setcanvas X FontDescentTM setmatrix X 4 -2 roll % width height x y X 1 sub % width height x y-1 X 4 2 roll % x y-1 width height X rectpath X BgColor setcolor fill X grestore X } def X X /MoveScreenArea { % numlines x y width height => - X % --- Move a given area of the screen numlines X % numlines < 0 - move down X % " > 0 - move up X 10 dict begin X /height exch def X /width exch def X /y exch def X /x exch def X /numlines exch def X gsave X Can setcanvas X FontDescentTM setmatrix X x y 1 sub width height rectpath X 0 numlines neg copyarea X grestore X end X } def X X /FlushInputBuffer { % - => - X % --- Flush the InputBuffer to Text array if it is in use X InputBufferLine 0 ne { X % --- Create a standalone string for this line in the Text array X Text InputBufferLine Yindex X Text InputBufferLine Yindex get InputBufferLength string copy X put X % --- Blank fill the previously used part of InputBuffer X 0 1 InputBufferLength { X InputBuffer exch BLANK put X } for X /InputBufferLine 0 store X /InputBufferLength 0 store X } if X } def X X /ScrollUp { % numlines beginrow endrow => - X % --- Scroll up numlines from a given line to another line X 10 dict begin X /endrow exch def X /beginrow exch def X /numlines exch def X FlushInputBuffer X ClearMySelection X /len endrow beginrow sub 1 add def X /numlines numlines len min def X /inset beginrow numlines add def X % --- Move the text X beginrow Yindex endrow Yindex le { X % --- We can do a fast move if the scroll region doesn't X % wrap around the end of the physical array X Text X beginrow Yindex Text inset Yindex endrow inset sub 1 add X getinterval putinterval X }{ X % XXX This should be done as two getinterval/putintervals X beginrow numlines add 1 endrow { X /i exch def X Text i numlines sub Yindex Text i Yindex get put X } for X } ifelse X endrow numlines sub 1 add 1 endrow { X Text exch Yindex () put X } for X numlines 1 beginrow numlines add TextWidth len numlines sub MoveScreenArea X 1 endrow numlines sub 1 add TextWidth numlines ClearScreenArea X end X } def X X /ScrollDown { % numlines beginrow endrow => - X % --- Scroll down numlines from a given line to another line X 10 dict begin X /endrow exch def X /beginrow exch def X /numlines exch def X FlushInputBuffer X ClearMySelection X /len endrow beginrow sub 1 add def X /numlines numlines len min def X /inset endrow numlines sub def X beginrow Yindex endrow Yindex le { X % --- We can do a fast move if the scroll region doesn't X % wrap around the end of the physical array X Text X beginrow numlines add Yindex Text beginrow Yindex X inset beginrow sub 1 add getinterval putinterval X }{ X % XXX This should be done as two getinterval/putintervals X endrow -1 beginrow numlines add { X /i exch def X Text i Yindex Text i numlines sub Yindex get put X } for X } ifelse X beginrow 1 beginrow numlines add 1 sub { X Text exch Yindex () put X } for X numlines neg 1 beginrow TextWidth len numlines sub MoveScreenArea X 1 beginrow TextWidth numlines ClearScreenArea X end X } def X X /RollAllTextUp { % numlines => - X % --- Scroll the entire Text Array up numlines, adding blank lines at the X % bottom X 10 dict begin X /numlines exch def X FlushInputBuffer X ClearMySelection X 1 1 numlines { pop X /MapOffset MapOffset 1 add TextHeight mod store X Text MapOffset () put X } for X end X } def X X /DrawText { % x y w h => - X % --- Draw the text within the specified rectangle X 10 dict begin X /h exch def X /w exch def X /y exch def X /x exch def X gsave X false setprintermatch X Can setcanvas X TM setmatrix X Font setfont X FgColor setcolor X % --- Use the clip path to get x clipping X x CanY 1 sub w CanHeight 1 add rectpath clip newpath X y 1 y h add 1 sub { X /i exch def X 1 i moveto X% 6 array identmatrix setmatrix % X11/NeWS X 6 array defaultmatrix setmatrix X Text i Yindex get show X TM setmatrix X } for X grestore X end X } def X X /WriteLines { % stringarray insertmode? col row => - newcol newrow X % Put lines into the text buffer and display them on screen. X % stringarray is an array of lines to be displayed. Lines must X % contain printable characters only. col,row specify the starting point X % of the lines. The col,row of the next available text position are X % returned. insertmode? specifies whether to overwrite existing text X % or to insert each new line into the existing text. X 10 dict begin X /row exch def X /col exch def X /insertmode? exch def X /lines exch def X X DEBUG { X console (WriteLines: row: % col: % numlines: %\n) [row col lines length] fprintf X 0 1 lines length 1 sub { /i exch def X console (%\n) [lines i get] fprintf X } for X console flushfile X } if X SupressCaret X /WriteInProgress? true store X /numlines lines length def X % --- Clear the current selection X % XXX This should be more selective; only clear if overwriting X ClearMySelection X % --- Do one line case as fast as possible X numlines 1 eq { X lines col row WriteOneLine X }{ X % --- Do any text throw-away required, either due to scrolling X % region or exceeding the basic capacity of the Text array. X ScrollLimitOn? { X /numscroll 0 def X % --- Note: No need to do anything if we are completely above X % the scrolling region. X X % --- Are we starting within the scrolling region? X row TopScrollLimit ge row BotScrollLimit le and { X % --- Get rid of everything that won't fit in the scroll region X numlines ScrollRegionLength gt { X /lines lines numlines ScrollRegionLength sub X ScrollRegionLength getinterval def X /numlines ScrollRegionLength def X /col 1 def X } if X % --- Determine number of lines to scroll X /numscroll numlines BotScrollLimit row sub sub 1 sub def X % --- Adjust the starting row, if needed X row numlines add 1 sub BotScrollLimit gt { X /row BotScrollLimit numlines 1 sub sub def X } if X }{ X % --- Are we starting above the scrolling region and extending X % into it? X row TopScrollLimit lt X row numlines add TopScrollLimit gt and { X % --- Write out the portion of the text that is above the X % scrolling region by recursively calling WriteLines. X /abovescroll TopScrollLimit row sub def X lines 0 abovescroll getinterval insertmode? col row WriteLines X % --- Get rid of what we just wrote out. This will make us X % eligable for the "starting within the scrolling region" X % case. X /lines lines abovescroll numlines abovescroll sub X getinterval def X /row TopScrollLimit def X /col 1 def X /numlines lines length def X } if X % --- Are we starting below the scrolling region? X row BotScrollLimit gt { X % --- Get rid of everything but the last line X /lines lines numlines 1 sub 1 getinterval def X numlines 1 ne { X /col 1 def X } if X /numscroll numlines 1 sub def X /numlines 1 def X } if X } ifelse X % --- Move existing text up, if necessary X numscroll 0 gt { X numscroll TopScrollLimit BotScrollLimit ScrollUp X } if X }{ % --- No scrolling limits set X % --- We can handle a max of TextHeight lines. Throw everything X % else away. X numlines TextHeight gt { X /lines lines numlines TextHeight sub X TextHeight getinterval def X /numlines TextHeight def X } if X % --- Scroll up the text array, if needed X /numscroll numlines TextHeight row sub sub 1 sub def X numscroll 0 gt { X numscroll RollAllTextUp X /row row numscroll sub def X numscroll 1 1 TextWidth TextHeight MoveScreenArea X col ViewportXdelta sub row ViewportYdelta sub TextWidth X numscroll 1 add ClearScreenArea X % --- If the viewport is off its original position, fill in text X ViewportYdelta 0 ne { X col ViewportXdelta sub row ViewportYdelta sub TextWidth X numscroll 1 add DrawText X % --- Clear out any partial rows or columns X 1 CanY CanHeight add TextWidth 1 ClearScreenArea X CanX 1 sub CanY 1 TextHeight ClearScreenArea X } if X } if X } ifelse X col 1 ne { X lines 0 1 getinterval col row WriteOneLine /row exch def pop X lines 1 numlines 1 sub getinterval row 1 add WriteManyLines X }{ X lines row WriteManyLines X } ifelse X } ifelse X /WriteInProgress? false store X % --- Make sure that the newrow return value is within the scrolling limits, X % if appropriate X ScrollLimitOn? row BotScrollLimit le and { X BotScrollLimit min X } if X end X DelayedCaretMove % --- Must be called outside of this proc's temp dict X } def X X /WriteOneLine { % stringarray col row => - newcol newrow X % Put one line into the text buffer and display it on screen. X % stringarray is an array containing a single line of text. X % WriteOneLine makes use of the InputBuffer optimization. X % col,row specify the starting point of the lines. The col,row X % of the next available text position are returned. X 10 dict begin X /row exch def X /col exch def X /s exch 0 get def X X DEBUG { X console (WriteOneLine row: % col: % slen: %\n) [row col s length] fprintf X console (%\n) [s] fprintf X console flushfile X } if X /slen s length def X % --- Set the input buffer to this line if it isn't already there X row InputBufferLine ne { X FlushInputBuffer X % --- Copy the existing Text string into InputBuffer X /oldline Text row Yindex get def X oldline InputBuffer copy pop X /InputBufferLength oldline length store X /InputBufferLine row store X } if X insertmode? { X % --- Make sure we aren't exceeding the size of the input buffer X slen col add slen InputBufferLength add max InputBuffer length gt { X % --- If we are too big, simply grow the input buffer to accomodate! X % Ain't automatic garbage collection wonderful... X /InputBuffer slen col add string store X Text row Yindex get InputBuffer copy pop X } if X % --- Move old Text over if necessary X col InputBufferLength le { X InputBuffer col slen add Xindex X InputBuffer col Xindex InputBufferLength col sub 1 add getinterval X putinterval X /InputBufferLength InputBufferLength slen add store X }{ X /InputBufferLength col slen add 1 sub store X } ifelse X InputBufferLength TextWidth gt { X /TextWidth InputBufferLength store X } if X % --- Put insert string in X InputBuffer col Xindex s putinterval X }{ X % --- Make sure we aren't exceeding the size of the input buffer X slen col add InputBuffer length gt { X % --- If we are too big, simply grow the input buffer to accomodate! X % Ain't automatic garbage collection wonderful... X /InputBuffer slen col add string store X Text row Yindex get InputBuffer copy pop X } if X % --- Slam the new text into the InputBuffer X InputBuffer col Xindex s putinterval X /InputBufferLength InputBufferLength col slen add 1 sub max store X } ifelse X % --- Update the text array with a substring of InputBuffer X Text row Yindex InputBuffer 0 InputBufferLength getinterval put X InputBufferLength TextWidth gt { X /TextWidth InputBufferLength store X } if X % --- Paint the screen X insertmode? { X col row InputBufferLength 1 ClearScreenArea X col row InputBufferLength 1 DrawText X }{ X col row slen 1 ClearScreenArea X col row slen 1 DrawText X } ifelse X % --- Remove any partial rows or columns X ViewportXdelta 0 ne ViewportYdelta 0 ne or { X 1 CanY CanHeight add TextWidth 1 ClearScreenArea X CanX 1 sub CanY 1 TextHeight ClearScreenArea X } if X % --- Return new row,col X col slen add row X end X } def X X /WriteManyLines { % stringarray row => - newcol newrow X % Put one line into the text buffer and display it on screen. X % stringarray is an array containing a single line of text. X % row specifies the starting point of the lines. The col,row X % of the next available text position are returned. X 20 dict begin X /row exch def X /lines exch def X X DEBUG { X console (WriteManyLines: row: % col: % numlines: %\n) [row col lines length] fprintf X 0 1 lines length 1 sub { /i exch def X console (%\n) [lines i get] fprintf X } for X console flushfile X } if X FlushInputBuffer X /endrow row def X lines { X /s exch def X /slen s length def X /oldline Text endrow Yindex get def X /oldlen oldline length def X slen TextWidth gt { X /TextWidth slen store X } if X insertmode? { X oldlen 0 eq { X Text endrow Yindex s put X }{ X Text endrow Yindex s oldline append put X } ifelse X }{ X slen oldlen ge { X Text endrow Yindex s put X }{ X oldline 0 s putinterval X } ifelse X } ifelse X /endrow endrow 1 add def X /col slen 1 add def X } forall X % --- Clear the changed screen area and draw the new text X 1 row TextWidth endrow row sub 1 add ClearScreenArea X 1 row TextWidth endrow row sub 1 add DrawText X % --- Remove any partial rows or columns X ViewportXdelta 0 ne ViewportYdelta 0 ne or { X 1 CanY CanHeight add TextWidth 1 ClearScreenArea X CanX 1 sub CanY 1 TextHeight ClearScreenArea X } if X % --- Return values X col endrow 1 sub X end X } def X X /CreateCaret { % - => - X % --- Create, shape, and color the caret canvas X CaretColor null eq { X ColorDisplay? X {/CaretColor DefaultColorCaret store} X {/CaretColor DefaultMonoCaret store} ifelse X } if X gsave X Can setcanvas X /Caret Can newcanvas store X Caret begin X /Transparent false def X Can /Retained get { X% REMIND: X% There doesn't seem to be any reason to make the cursor retained. X% Let's try taking this out some time... X% /Retained true def X% HURRAY! IT WORKED! It even made the 386i X11/NeWS beta 2 server stop dumping! X /Retained false def X }{ X /SaveBehind true def X } ifelse X /EventsConsumed /MatchedEvents def X end X ShapeCaret X grestore X } def X X /ShapeCaret { % - => - X % --- Shape the caret canvas from a proc in the CaretShapeDict X gsave X% framebuffer setcanvas % ??? X% matrix defaultmatrix setmatrix % ??? X Can setcanvas X % ---Set up x,y arguments to caret shape proc X PixColWidth PixRowHeight X % ---Get the caret shape proc and execute it X CaretShapeDict CaretShape get exec X PixColWidth PixRowHeight neg scale X 0 1 translate X Caret reshapecanvas X grestore X } def X X /MapCaret { % - => - X % --- Make the caret visible and color it X gsave X Caret mapcanvas X Caret setcanvas X CaretInactive? { X% /mapcaret dbgbreak X% CORE DUMPS X11/NeWS beta 2 386i: X DefaultInactiveColor fillcanvas X }{ X CaretColor fillcanvas X } ifelse X grestore X } def X X /UnMapCaret { % - => - X % --- Make the caret invisible X Caret unmapcanvas X } def X X /MoveCaret { % - => - X gsave X Caret unmapcanvas X Caret setcanvas X CaretX ViewportXdelta add CaretY ViewportYdelta add X movecanvas X Caret mapcanvas X grestore X } def X X /InactivateCaret { % - => - X % --- Shade the caret with the inactive color and stop any blinking X 10 dict begin X /CaretInactive? true store X CaretOn? { X gsave X Caret mapcanvas X Caret setcanvas X% Bombs X11/NeWS beta 2 on 386i: (sh_386_fill_shape, fillscans) X DefaultInactiveColor fillcanvas X grestore X } if X end X } def X X /ReactivateCaret { % - => - X % --- Set caret back to normal X 10 dict begin X /CaretInactive? false store X CaretOn? { X gsave X Caret mapcanvas X Caret setcanvas X CaretColor fillcanvas X grestore X } if X end X } def X X /SupressCaret { % - => - X % --- Temporarily turn the caret off X 10 dict begin X CaretOn? { X /CaretSupressed? true store X UnMapCaret X } if X end X } def X X /UnSupressCaret { % - => - X % --- Turn the caret back on X 10 dict begin X CaretOn? { X /CaretSupressed? false store X MapCaret X } if X end X } def X X /DelayedCaretMove { % - => - X % --- Move the caret after waiting CaretDelayTime seconds, X % but only if a write or another delayed caret move is X % not in progress X % Note: This proc must be called with the class instance dictionary X % being the first thing on the dict stack, since it forks a process X % that change instance variables. X CaretOn? { X % --- Update the time that the caret move will actually be done X /NextMoveTime currenttime 1 60 div CaretDelayTime mul add store X % --- Only fork a timer if one isn't already going X DelayedMoveProc null eq { X % --- Fork the move timer X /DelayedMoveProc { X % Go to sleep, checking NextMoveTime each time we awaken X { X NextMoveTime currenttime sub sleep X NextMoveTime currenttime le { X exit X } if X } loop X % --- If there is no write in progress then move the caret and X % turn it on X WriteInProgress? not { X /CaretSupressed? false store X MoveCaret X MapCaret X } if X /DelayedMoveProc null store X } fork store X } if X } if X } def X X% /DrawSelectionText { % x y y1 => - X% % --- Draw text onto the selection canvas X% 10 dict begin X% /y1 exch def X% /y exch def X% /x exch def X% gsave X% false setprintermatch X% SelectionCan setcanvas X% FgColor fillcanvas X% FontDescentTM setmatrix X% x 1 sub neg TextHeight y1 sub translate X% /SelectTM 6 array currentmatrix def X% Font setfont X% BgColor setcolor X% /j 1 def X% y 1 y1 { X% /i exch def X% 1 i moveto X% 6 array identmatrix setmatrix X% Text i Yindex get show X% SelectTM setmatrix X% /j j 1 add def X% } for X% grestore X% end X% } def X X /DrawSelection { % state => - X % --- Make the selection area visible or invisible, depending on state. X 10 dict begin X /state exch def X %state { X % SelectionPath null ne { X % gsave X % 6 array identmatrix setmatrix X % SelectionPath setpath X % SelectionCan reshapecanvas X % SelectionY SelectionY1 lt { X % 1 SelectionY SelectionY1 DrawSelectionText X % } if X % SelectionY SelectionY1 gt { X % 1 SelectionY1 SelectionY DrawSelectionText X % } if X % SelectionY SelectionY1 eq { X % SelectionX SelectionY1 SelectionY DrawSelectionText X % } if X % SelectionCan mapcanvas X % /SelectionOn? true store X % grestore X % } if X %}{ % --- state = off X % SelectionCan unmapcanvas X % /SelectionOn? false store X %} ifelse X % --- XXX Use xor for now; SelectionCanvas in the future... X gsave X SelectionPath null ne SelectionOn? state xor and { X Can setcanvas X TM setmatrix X 5 setrasteropcode X SelectionPath setpath X fill X /SelectionOn? state store X } if X grestore X end X } def X X /ClearMySelection { % - => - X % --- Clear any selection I might have in the system selection mechanism X % and on my screen. X 10 dict begin X SelectionOn? { X false DrawSelection X /SelectionPath null store X } if X /seldict /PrimarySelection getselection def X seldict null ne { X seldict XNeWS? /Holder /Canvas ifelse % not defined in X11/NeWS X get Can eq { X% Selections /PrimarySelection null put % broke in X11/NeWS X /PrimarySelection clearselection X } if X } if X end X } def X X /SendClearSelection { % - => - X % --- Clear anyone else's Primary selection X 10 dict begin X /seldict /PrimarySelection getselection def X seldict null ne { X seldict XNeWS? /Holder /Canvas ifelse % not defined in X11/NeWS X get Can ne { X /PrimarySelection clearselection X } if X } if X end X } def X X /ExtendSelection { % - => - X % --- Draw the selection bounding outline X 10 dict begin X gsave X FontDescentTM setmatrix X /l Text SelectionY1 Yindex get length 2 add def X SelectionX1 l gt { X /SelectionX1 l def X } if X SelectionY SelectionY1 eq { X SelectionX SelectionY SelectionX1 SelectionY1 1 sub X points2rect rectpath X }{ X SelectionY SelectionY1 gt { X /y SelectionY1 def /x SelectionX1 def X /y1 SelectionY def /x1 SelectionX def X }{ X /y SelectionY def /x SelectionX def X /y1 SelectionY1 def /x1 SelectionX1 def X } ifelse X 1 y moveto X x y lineto X 0 -1 rlineto X /l Text y Yindex get length 2 add def X l y 1 sub lineto X 0 1 rlineto X /y y 1 add def X y 1 y1 1 sub { X /i exch def X /l Text i Yindex get length 2 add def X l i 1 sub lineto X l i lineto X } for X x1 y1 1 sub lineto X x1 y1 lineto X 1 y1 lineto X closepath X } ifelse X /SelectionPath currentpath store X 0 setlinewidth % Thick lines look funky with xor, but it's a bug... X stroke X grestore X end X } def X X /GetSelection { % - => string X % --- Returns the text of the current selection X 10 dict begin X SelectionPath null eq { X () X }{ X % --- We always want y <= y1, no matter what direction the selection X % was done in X SelectionY SelectionY1 lt { X /y SelectionY def /x SelectionX def X /y1 SelectionY1 def /x1 SelectionX1 1 sub def X } if X SelectionY SelectionY1 gt { X /y SelectionY1 def /x SelectionX1 def X /y1 SelectionY def /x1 SelectionX 1 sub def X } if X SelectionY SelectionY1 eq { X /y SelectionY def /x SelectionX def X /y1 SelectionY1 def /x1 SelectionX1 1 sub def X % --- If we are on the same line, we want x <= x1 X x x1 gt { X x X /x x1 1 add def X /x1 exch 1 sub def X } if X } if X % --- Make a string that is at least the right size X /slen 0 def X y 1 y1 {/i exch def /slen Text i Yindex get length slen add 1 add def} for X /s slen string def X /sptr 0 def X % --- Get the first line of the selection text X /s1 Text y Yindex get def X /l s1 length def X % --- Index into it by x (add a LF if x > linelength) X x l gt { X s sptr LF put X /sptr sptr 1 add def X }{ X /s1 s1 x Xindex l x sub 1 add getinterval def X s sptr s1 putinterval X /sptr sptr s1 length add def X } ifelse X % --- Check for a single line selection X y y1 eq { X % --- Clip the line at x1 (add a LF if x1 > linelength) X x1 l gt { X % --- Make sure we don't put in two LF's X x l le { X s sptr LF put X /sptr sptr 1 add def X } if X }{ X /sptr x1 x sub 1 add def X } ifelse X }{ % --- Multi-line selection X % --- Put LF after first line if needed X x l le { X s sptr LF put X /sptr sptr 1 add def X } if X y 1 add 1 y1 { X /i exch def X % --- Get the i'th line X /l Text i Yindex get length def X /s1 Text i Yindex get def X % --- Check if this is the last line X i y1 eq { X x1 l gt { X s sptr s1 putinterval X /sptr sptr l add def X s sptr LF put X /sptr sptr 1 add def X }{ X /s1 s1 0 x1 getinterval def X s sptr s1 putinterval X /sptr sptr s1 length add def X } ifelse X }{ X s sptr s1 putinterval X /sptr sptr l add def X s sptr LF put X /sptr sptr 1 add def X } ifelse X } for X } ifelse X s 0 sptr getinterval X } ifelse X } def X X% ----------------------------- New Methods ----------------------------------- X X /changefont { % fname fheight - => - X % --- Change the current font and point size. Either fname or fheight X % may be null, in which case they are ignored. X 10 dict begin X /fheight exch def X /fname exch def X fheight null ne { X /FontHeight fheight store X % --- Check for minimum visibility X FontHeight 6 lt { X /FontHeight 6 store X } def X } if X fname null ne { X /FontName fname store X } if X InitFont X false Reshape X 1 1 TextWidth TextHeight DrawText X CaretOn? { X ShapeCaret X MapCaret X MoveCaret X } if X /ResizeCallback self send X end X } def X X /writelines { % arrayofstrings insertmode? col row => - X % --- Write an array of strings, starting the first string at col,row X % with subsequent strings going at 1,row+1 1,row+2 etc. insertmode? X % specifies whether the new lines will overwrite existing text or X % be inserted at the specified location. X BaseY add X WriteLines pop pop X pause X } def X X /writeatcaret { % arrayofstrings insertmode? => - X % --- Similar to writelines, except start at the current caret location. The X % caret is moved to the next available character position when the write is X % done. X CaretX CaretY WriteLines X /CaretY exch store X /CaretX exch store X pause X } def X X /deletestring { % length col row => - X % --- Delete a string starting at col,row for length characters. X % length must be 0 or a positive integer. X BaseY add X 10 dict begin X /row exch def X /col exch def X /len exch def X X % --- Set the input buffer to this line if it isn't already there X row InputBufferLine ne { X FlushInputBuffer X % --- Copy the existing Text string into InputBuffer X /oldline Text row Yindex get def X /oldlength oldline length def X oldline InputBuffer copy pop X /InputBufferLine row store X /InputBufferLength oldlength store X }{ X /oldlength InputBufferLength def X } ifelse X col InputBufferLength le { X % --- Move old text over X InputBuffer col Xindex X InputBuffer col len add Xindex InputBufferLength len add getinterval X putinterval X % --- Update line length X /InputBufferLength InputBufferLength len sub col 1 sub max store X } if X % --- Update the Text array X Text row Yindex InputBuffer 0 InputBufferLength getinterval put X % --- Update display X col row oldlength 1 ClearScreenArea X col row oldlength 1 DrawText X end X } def X X /insertline { % numlines row => - X % --- Insert numlines blank lines, starting at line row. X % numlines must be 0 or a positive integer X BaseY add X 10 dict begin X /row exch def X /numlines exch def X numlines row TextHeight ScrollDown X end X } def X X /deleteline { % numlines row => - X % --- Delete numlines lines, starting at line row. X % numlines must be 0 or a positive integer X BaseY add X 10 dict begin X /row exch def X /numlines exch def X numlines row TextHeight ScrollUp X end X } def X X /setscrollinglimits { % toprow bottomrow => - X % --- Sets the scrolling limits for the TextCanvas. All up or down scrolling X % will be limited to this region instead of affecting the entire Text X % canvas. When scrolling limits are set, those methods which can X % trigger scrolling (writelines, writeatcaret, movecaretdelta) will X % only cause scrolling if they affect lines within the scrolling region. X % Any scrolling that is initiated will only move lines within the X % scrolling region. X /BotScrollLimit exch BaseY add def X /TopScrollLimit exch BaseY add def X /ScrollRegionLength BotScrollLimit TopScrollLimit sub 1 add def X /ScrollLimitOn? true def X } def X X /removescrollinglimits { % - => - X % --- Removes any scrolling bounds set by setscrollinglimits. X /BotScrollLimit TextHeight def X /TopScrollLimit CanY def X /ScrollRegionLength BotScrollLimit TopScrollLimit sub 1 add def X /ScrollLimitOn? false def X } def X X /clearviewport { % - => - X % --- Clear the text and screen area of the base viewport X ScrollLimitOn? { X CanHeight BaseY 1 add BaseY CanHeight add ScrollUp X }{ X CanHeight RollAllTextUp X 1 BaseY 1 add TextWidth CanHeight ClearScreenArea X } ifelse X } def X X /flashviewport { % - => - X % --- Flash the contents of the viewport (visible bell) X gsave X Can setcanvas X initclip X clipcanvaspath X 5 setrasteropcode X fill X clipcanvaspath X fill X grestore X } def X X /moveviewport { %x y => - X % --- Move the viewport to another part of the underlying Text array. X % x and y must be between 0 and 1. This represents a percentage of the X % current total width or height of the Text array. Either argument X % can be null, in which case it is ignored. X 10 dict begin X SupressCaret X dup null ne { X /newY exch TextHeight CanHeight sub mul 1 add round def X newY 1 lt { X /newY 1 def X } if X /ydelta CanY newY sub def X ClearMySelection X }{ X /newY exch def X /ydelta 0 def X } ifelse X dup null ne { X /newX exch TextWidth CanWidth sub mul 1 add round def X newX 1 lt { X /newX 1 def X } if X /xdelta CanX newX sub def X ClearMySelection X }{ X /newX exch def X /xdelta 0 def X } ifelse X gsave X Can setcanvas X FontDescentTM setmatrix X CanX CanY 1 sub CanWidth CanHeight 1 add rectpath X xdelta ydelta copyarea X xdelta ydelta translate X /FontDescentTM 6 array currentmatrix store X % --- XXX translate doesn't work with a matrix operand yet X TM setmatrix X xdelta ydelta translate X /TM 6 array currentmatrix store X grestore X xdelta 0 ne { X /CanX newX store X xdelta 0 gt { X CanX CanY xdelta CanHeight ClearScreenArea X CanX CanY xdelta CanHeight DrawText X }{ X CanX CanWidth add xdelta add CanY X xdelta neg CanHeight ClearScreenArea X CanX CanWidth add xdelta add CanY X xdelta neg CanHeight DrawText X % --- Clear out column 0 X CanX 1 sub CanY 1 TextHeight ClearScreenArea X } ifelse X } if X ydelta 0 ne { X /CanY newY store X ydelta 0 gt { X CanX CanY CanWidth ydelta 1 add ClearScreenArea X CanX CanY CanWidth ydelta 1 add DrawText X }{ X CanX CanY CanHeight add ydelta add X CanWidth ydelta neg ClearScreenArea X CanX CanY CanHeight add ydelta add X CanWidth ydelta neg DrawText X } ifelse X } if X CanX CanY CanHeight add CanWidth 1 ClearScreenArea X /ViewportXdelta ViewportXdelta xdelta add store X /ViewportYdelta ViewportYdelta ydelta add store X MoveCaret X UnSupressCaret X end X } def X X /getviewportsize { % - => col rows xpixels ypixels X % --- Return the number of columns, rows, pixel height and width of X % the viewport. X CanWidth CanHeight CanPixWidth CanPixHeight X } def X X /getlinelength { % row => length X % --- Return the current length of the line at row. X BaseY add X Text exch Yindex get X length X } def X X /calcarea { % pixwidth pixheight => numcols numrows X % --- Returns the number of rows and columns that will fit into the pixel X % area specified by pixwidth and pixheight, given the current Font and X % point size. X 10 dict begin X /pixheight exch def X /pixwidth exch def X % --- Compute numcols X pixwidth PixColWidth idiv X % --- Compute numrows X pixheight PixRowHeight idiv 1 add X end X } def X X /calcpixarea { % numcols numrows => pixwidth pixheight X % --- Returns the minimum pixel area required to display numrows and numcols, X % given the current Font and point size. X 10 dict begin X /numcols exch def X /numrows exch def X % --- Compute pixwidth X numcols PixColWidth mul X % --- Compute pixheight X numrows PixRowHeight mul 1 sub X end X } def X X /oncaret { % - => - X % --- Turn the caret on. X /CaretOn? true def X MapCaret X MoveCaret X } def X X /offcaret { % - => - X % --- Turn the caret off. X UnMapCaret X /CaretOn? false def X } def X X /movecaret { % col row => - X % --- Move the caret to an absolute position. col and row are integers. Scrolling is X % never triggered. X /CaretY exch BaseY add def X /CaretX exch def X CaretX TextWidth gt {/TextWidth CaretX store} if X MoveCaret X } def X X /movecaretdelta { % deltax deltay => - X % --- Move the caret relative to its current position. deltax and deltay must be X % integers (negatives allowed). Scrolling is triggered if deltay moves the caret X % outside of the scrolling limits. If no scrolling limits are set, scrolling is X % triggered if deltay moves the caret outside of the original viewport region. X 10 dict begin X /deltay exch def X /deltax exch def X /CaretY CaretY deltay add store X /CaretX CaretX deltax add store X CaretY TopScrollLimit lt { X TopScrollLimit CaretY sub TopScrollLimit BotScrollLimit ScrollDown X /CaretY TopScrollLimit store X } if X CaretY BotScrollLimit gt { X CaretY BotScrollLimit sub TopScrollLimit BotScrollLimit ScrollUp X /CaretY TextHeight store X } if X CaretX 1 lt {/CaretX 1 store} if X CaretX TextWidth gt {/TextWidth CaretX store} if X MoveCaret X end X } def X X /setcaretblink { % blink-rate duty-cycle => - X % --- Set the caret blink rate and the blink duty cycle. blink-rate is X % in seconds and represents a complete on/off cycle. duty-cycle is X % between 0 and 1, and represents the percentage of on time. X dup null ne { X /CaretDutyCycle exch def X }{ X pop X } ifelse X dup null ne { X dup 0 ne { X /CaretBlinkTime exch def X /CaretBlinkEnabled? true def X }{ X % --- Disable caret, but keep blink events going at a X % 2 second rate X pop X /CaretBlinkTime 2 def X /CaretBlinkEnabled? false def X CaretOn? {MapCaret} if X } ifelse X }{ X pop X } ifelse X } def X X /setcaretcolor { % color => - X % --- Set the current caret color. color is a color object. X /CaretColor exch def X CaretOn? {MapCaret} if X } def X X /setcaretshape { % shapename => successful? X % --- Set the caret shape. shapename should be an entry in the CaretShapeDict. X % Return a boolean that tells whether shapename was found. X dup CaretShapeDict exch known { X /CaretShape exch def X Caret null ne {ShapeCaret MoveCaret} if X true X } { X pop pop X false X } ifelse X } def X X /getcaretpos { % - => col row X % --- Return the current caret position X CaretX X CaretY BaseY sub X } def X X /setbgcolor { % color => - X % --- Set the current canvas background color X ClearMySelection X /BgColor exch def X } def X X /setfgcolor { % color => - X % --- Set the current text color X ClearMySelection X /FgColor exch def X } def X X /fixdamage { % - => - X % --- Damage handler; goes in the PaintClient window callback routine X BgColor fillcanvas X CanX CanY CanWidth CanHeight DrawText X } def X X /new { % numrows can => object X % --- Create a new instance of the TextCanvas. numrows is the number X % of lines to be allocated in the Text array; it is fixed for X % the life of the instance. can is the viewport canvas. X /new super send begin X /Can exch def X /TextHeight exch def X% Here's an attempt to keep the 386i X11/NeWS beta 2 server from core dumping. X%Can /Transparent false put X Can /Retained true put % XXX - Non-retained will work, but NeWS sometimes X % reports more damage than has actually occurred, X % so going non-retained can be very costly X gsave X % --- Determine canvas pixel width and height X Can setcanvas X initclip clipcanvaspath pathbbox % llx lly urx ury X points2rect % x y w h X grestore X /CanPixHeight exch def X /CanPixWidth exch def X /CanPixY exch def X /CanPixX exch def X InitFont X true Reshape X currentdict X end X } def X X /reshape { % - => - X % --- This method must be called whenever the viewport canvas has changed X % size. It updates the number of rows and columns in the TextCanvas, X % repositions the caret to be as close to its old position as possible, X % resets the scrolling region, and moves the viewport to its base position. X gsave X % --- Determine the new pixel width and height X Can setcanvas X initclip clipcanvaspath pathbbox % llx lly urx ury X points2rect % x y w h X grestore X /CanPixHeight exch def X /CanPixWidth exch def X /CanPixY exch def X /CanPixX exch def X false Reshape X /ResizeCallback self send X } def X X /destroy { % - => - X mark { X KeyboardInterest Can revokekbdinterests X MoreInterests { revokeinterest } forall X } stopped cleartomark X EventMgr null ne { X EventMgr killprocess X } if X MouseDragEventMgr null ne { X MouseDragEventMgr killprocess X } if X } def X Xclassend def Xend % systemdict X%} if % /TextCanvas known not... X //go.sysin dd * if [ `wc -c < textcan.ps` != 83120 ]; then made=false echo error transmitting textcan.ps -- echo length should be 83120, not `wc -c < textcan.ps` else made=true fi if $made; then chmod 664 textcan.ps echo -n ' '; ls -ld textcan.ps fi echo Extracting overlay.ps sed 's/^X//' <<'//go.sysin dd *' >overlay.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Class OverlayWindow X% Copyright (C) 1989. X% By Don Hopkins. (don@brillig.umd.edu) X% All rights reserved. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% This program is provided for UNRESTRICTED use provided that this X% copyright message is preserved on all copies and derivative works. X% This is provided without any warranty. No author or distributor X% accepts any responsibility whatsoever to any person or any entity X% with respect to any loss or damage caused or alleged to be caused X% directly or indirectly by this program. This includes, but is not X% limited to, any interruption of service, loss of business, loss of X% information, loss of anticipated profits, core dumps, abuses of the X% virtual memory system, or any consequential or incidental damages X% resulting from the use of this program. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Overlay plane compatibility hack for cg4 frame buffer. X% This is a nebulous layer abstracted from a messy program, to make it run X% on generic NeWS servers. It should be rethought and rewritten. Repent! X% X% Requires the devices /dev/cgfour0, /dev/cgfour0_ovl, and /dev/cgfour0_ove X% (which can all be major 39 minor 0, or whatever), and the following patch X% to the NeWS 1.1 server sources (but X11/NeWS doesn't need to be patched!), X% in order to take advantage of a cg4 under NeWS 1.1 (Otherwise it falls back X% to using exclusive-or). X% X% Put the flag -DCG4_ENABLE_HACK into COPTS in the top level server Makefile. X% Make the following patch to the file SUN/src/server/dev/sunw/pixrectint.c: X% In function cg4_make: X% Replace the block starting with the following comment: X% /* set up pixrect initial state */ X% { X% #ifdef CG4_ENABLE_HACK X% int initplanes, initfb = CG4_INITFB; X% extern char *sun_fb_name; X% char *index(); X% int len = strlen (sun_fb_name); X% X% /* Special file names get overlay and enable planes */ X% if (index(sun_fb_name, '_') != NULL) { X% if (sun_fb_name[len-1] == 'l') /* cgfour0_ovl */ X% initfb = 0; /* overlay plane */ X% else if (sun_fb_name[len-1] == 'e') /* cgfour0_ove */ X% initfb = 1; /* enable plane */ X% else initfb = 2; /* color plane */ X% } X% X% initplanes = X% PIX_GROUP(fbdesc[initfb].group) | X% fbdesc[initfb].allplanes; X% #else !CG4_ENABLE_HACK X% int initplanes = X% PIX_GROUP(fbdesc[CG4_INITFB].group) | X% fbdesc[CG4_INITFB].allplanes; X% #endif !CG4_ENABLE_HACK X% X% (void) cg4_putattributes(pr, &initplanes); X% } X% X% Damn damn damn! X11/NeWS Version 1.0 FCS on a cg4 can open up the X% enable plane, but there's a bug that trashes the enable plane color map, X% so we can draw in gray scales but we can't draw in white (black?). X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xsystemdict begin X Xsystemdict /XNeWS? known not { X systemdict /XNeWS? false put X} if X X/overlay-dev (/dev/cgfour0_ovl) def X/enable-dev (/dev/cgfour0_ove) def X/color-dev (/dev/cgfour0) def X Xmark Xsystemdict /fb_overlay known not { X /fb_overlay null def /fb_enable null def /fb_color null def X /mono? framebuffer /Color get not def X systemdict /no_funny_stuff known X XNeWS? or % disabled, because of pre-fsc X11/NeWS... X { true } { X { X /fb_overlay overlay-dev createdevice store X %fb_overlay /Retained true put X /fb_enable enable-dev createdevice store X XNeWS? { X% this-is-currently-disabled % delete this line to re-enable, but it don't work X % Attempt to work around bug with X11/NeWS pre-fcs: X % The color map of the enable plane is bogus. X % 1 setgray results in black instead of white. X % All other setgrays < 1 come out the right color. X /fb_enable fb_enable X{ X fb_overlay begin X Visual Colormap X end X} pop X newcanvas store X framebuffer setcanvas X clippath fb_enable reshapecanvas X fb_enable /Transparent false put X fb_enable /Mapped true put X } if X fb_enable /Retained true put % is there any damage? X % if so, have event mgr clean it up instead of retaining? X /fb_color color-dev createdevice store X % createdevice bug: ignores file name (MacNeWS) X fb_enable /Color get not fb_color /Color get and { X gsave X fb_enable setcanvas X mono? 0 1 ifelse fillcanvas X grestore X } { X /fb_overlay null store X /fb_enable null store X /fb_color null store X that-aint-no-overlay-plane! X } ifelse X } errored X } ifelse X /cg4? exch not def X cg4? not { X systemdict /fb_overlay undef X systemdict /fb_enable undef X systemdict /fb_color undef X } if X} if Xcleartomark X X/OverlayWindow DefaultWindow Xdictbegin X /EnableCanvas null def X /EnableOverlay null def X /OverlayCanvas null def X /ColorCanvas null def X /TrackCanvas null def X /OtherCanvas null def X /HiliteCanvas null def X /SpriteCanvas null def X /SpriteMaskCanvas null def X /BubbleRadius 32 def X /LastX 0 def /LastY 0 def X /LastW 0 def /LastH 0 def X /InitialOverlayGray 0 def X /InitialEnableGray 1 def Xdictend Xclassbegin X Xcg4? { % cg4 X X /ShapeClientCanvas { X /ShapeClientCanvas super send X gsave X ClientCanvas setcanvas X /nouse /nouse_m ClientCanvas setstandardcursor X clippath OverlayCanvas reshapecanvas X clippath EnableCanvas reshapecanvas X EnableCanvas setcanvas X InitialEnableGray fillcanvas X OverlayCanvas setcanvas X InitialOverlayGray fillcanvas X ClientCanvas setcanvas X ClientWidth 2 div ClientHeight 2 div X SpriteShape X SpriteMaskCanvas reshapecanvas X grestore X DrawSpriteMask X } def X X /UpdateSprite { % x y => - X gsave X SpriteMaskCanvas setcanvas X XNeWS? not { X SpriteHotY X dup add sub X } if % ARGH! X movecanvas X SpriteMaskCanvas /Mapped true put X grestore X } def X X /HideSprite { X SpriteCanvas /Mapped false put X SpriteMaskCanvas /Mapped false put X } def X X /SpriteShape { % x y => - X translate X SpriteHotX neg SpriteHotY neg translate X 0 0 BubbleRadius 0 360 arc ======== END OF cyber.shar.splitab ======== From don Thu Nov 23 01:56:15 1989 Date: Thu, 23 Nov 89 01:56:15 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitac From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitac ======== X closepath X } def X X /SpriteHotX { X BubbleRadius X } def X X /SpriteHotY { X BubbleRadius X } def X X /DrawSprite { X gsave X SpriteCanvas setcanvas X clippath X gsave 0 setgray fill grestore X BubbleRadius dup dup 3 sub 0 360 arc X 1 setgray eofill X X% 0 BubbleRadius moveto X% BubbleRadius dup add 0 rlineto X% BubbleRadius 0 moveto X% 0 BubbleRadius dup add rlineto X% 0 setlinewidth X% 0 setgray stroke X grestore X } def X X /DrawSpriteMask { X gsave X SpriteMaskCanvas setcanvas X .5 fillcanvas X X 4 { X 0 0 moveto X 0 BubbleRadius lineto X 90 rotate X } repeat X 0 setlinewidth X 1 setgray stroke X grestore X } def X X /move { X /move super send X gsave X framebuffer setcanvas X TrackCanvas getcanvaslocation X OtherCanvas setcanvas X 2 copy movecanvas X EnableCanvas setcanvas movecanvas X grestore X } def X X /map { X /map super send X Iconic? not { X OtherCanvas /Mapped true put X EnableCanvas /Mapped true put X } if X } def X X /unmap { X /unmap super send X Iconic? not { X ColorCanvas /Mapped false put X EnableCanvas /Mapped false put X } if X } def X X /totop { X /totop super send X EnableCanvas canvastotop X ColorCanvas canvastotop X } def X X /tobottom { X /tobottom super send X EnableCanvas canvastobottom X ColorCanvas canvastobottom X } def X X /ForkFrameEventMgr { X ClientMenu null ne { X FrameInterests /ClientMenuEvent X MenuButton {/showat ClientMenu send} X DownTransition TrackCanvas eventmgrinterest put X } if X /FrameEventMgr FrameInterests forkeventmgr def X } def X X /PaintFocus { X /PaintFocus super send X gsave X EnableCanvas setcanvas X KeyFocus? KeyFocusFill 1 ifelse X fillcanvas X grestore X } def X X /destroy { X framebuffer setcanvas X OverlayCanvas /Retained false put X OverlayCanvas /Mapped false put X EnableCanvas /Retained false put X EnableCanvas /Mapped false put X ColorCanvas /Retained false put X ColorCanvas /Mapped false put X FrameCanvas /Retained false put X FrameCanvas /Mapped false put X SpriteCanvas /Retained false put X SpriteCanvas /Mapped false put X SpriteMaskCanvas /Retained false put X SpriteMaskCanvas /Mapped false put X /destroy super send X } def X X /FullColor { X gsave X EnableCanvas setcanvas 1 fillcanvas X grestore X DrawSpriteMask X } def X X /FullOverlay { X gsave X EnableCanvas setcanvas 0 fillcanvas X grestore X } def X X /BlackOverlay { X gsave X OverlayCanvas setcanvas 0 fillcanvas X grestore X } def X X /WhiteOverlay { X gsave X OverlayCanvas setcanvas 1 fillcanvas X grestore X } def X X /TrackSprite { % event => - X gsave begin X ClientCanvas setcanvas X XLocation YLocation X end X UpdateSprite X grestore X } def X X /DarkColor { X gsave X OverlayCanvas setcanvas 0 fillcanvas X EnableCanvas setcanvas .5 fillcanvas X grestore X DrawSpriteMask X } def X X mono? { % cg4 and mono X X /KeyFocusFill .85 def X X /CreateClientCanvas { X /CreateClientCanvas super send X /TrackCanvas ClientCanvas def X /OverlayCanvas ClientCanvas def X /ColorCanvas fb_color newcanvas def X /OtherCanvas ColorCanvas def X ColorCanvas /Mapped true put X ColorCanvas /Transparent false put X ColorCanvas /Retained true put X X /EnableCanvas fb_enable newcanvas def X /EnableOverlay EnableCanvas createoverlay def X EnableCanvas /Mapped true put X EnableCanvas /Transparent false put X EnableCanvas /Retained true put X /ClientCanvas ColorCanvas def X X /SpriteCanvas OverlayCanvas newcanvas def X SpriteCanvas /Transparent false put X SpriteCanvas /Retained true put X /SpriteMaskCanvas EnableCanvas newcanvas def X SpriteMaskCanvas /Transparent false put X SpriteMaskCanvas /Retained true put X X % ARRGH! I'm getting damage on the retained opeque FrameCanvas X % when mapping transparent children of the transparent ClientCanvas! X XNeWS? { X OverlayCanvas /Transparent false put X OverlayCanvas /Retained true put X } if X } def X X /KindaColor { X gsave X EnableCanvas setcanvas .5 fillcanvas X grestore X } def X X /HiliteCan { % gray can => - X dup null eq { pop pop } { X gsave X setcanvas clippath X setgray fill X grestore X } ifelse X } def X X /ShimmerCan { % gray can => - X gsave X setcanvas clippath X setgray fill X grestore X } def X X /LoliteCan { % can => - X 0 exch HiliteCan X } def X X } { % else cg4 and not mono X X /KeyFocusFill 1 def X X /CreateClientCanvas { % Monochrome cg4 X /CreateClientCanvas super send X /TrackCanvas ClientCanvas def X /ColorCanvas ClientCanvas def X /OverlayCanvas fb_overlay newcanvas def X /OtherCanvas OverlayCanvas def X OverlayCanvas /Mapped true put X OverlayCanvas /Transparent false put X OverlayCanvas /Retained true put X FrameCanvas /Retained true put X X /EnableCanvas fb_enable newcanvas def X /EnableOverlay EnableCanvas createoverlay def X EnableCanvas /Mapped true put X EnableCanvas /Transparent false put X EnableCanvas /Retained true put X /ClientCanvas ColorCanvas def X X /SpriteCanvas OverlayCanvas newcanvas def X SpriteCanvas /Transparent false put X SpriteCanvas /Retained true put X /SpriteMaskCanvas EnableCanvas newcanvas def X SpriteMaskCanvas /Transparent false put X SpriteMaskCanvas /Retained true put X X /HiliteCanvas OverlayCanvas newcanvas store X HiliteCanvas /Transparent true put X HiliteCanvas /Mapped true put X X % ARRGH! I'm getting damage on the retained opeque FrameCanvas X % when mapping transparent children of the transparent ClientCanvas! X XNeWS? { X ColorCanvas /Transparent false put X ColorCanvas /Retained true put X } if X } def X X /KindaColor { X FullColor X } def X X /HiliteCan { % gray can => - X gsave X setcanvas clippath X HiliteCanvas reshapecanvas X HiliteCanvas setcanvas X clippath X setgray fill X grestore X } def X X /LoliteCan { X 0 exch HiliteCan X } def X X /ShimmerCan { % gray can => - X gsave X setcanvas clippath X HiliteCanvas reshapecanvas X HiliteCanvas setcanvas X clippath X setgray fill X grestore X } def X X } ifelse X X} { % else not cg4 X X /KeyFocusFill .85 def X X /CreateClientCanvas { % Monochrome cg4 X /CreateClientCanvas super send X /TrackCanvas ClientCanvas def X /OverlayCanvas ClientCanvas def X /ColorCanvas ClientCanvas def X /EnableCanvas ClientCanvas def X /EnableOverlay EnableCanvas createoverlay def X /OtherCanvas ClientCanvas def X FrameCanvas /Retained true put X% Fucks up damage distribution in X11/NeWS! X% If the FrameCanvas is retained, and the ClientCanvas is transparent, X% then creating transparent children of the ClientCanvas causes damage X% to happen on the FrameCanvas! X% So we have to make the ClientCanvas retained too (because if we make X% just the ClientCanvas but not the FrameCanvas retained, damage on the X% frame causes repainting of the ClientCanvas! Argh! X XNeWS? { X ClientCanvas /Transparent false put X ClientCanvas /Retained true put X } if X } def X X /destroy { X framebuffer setcanvas X ClientCanvas /Retained false put X ClientCanvas /Mapped false put X FrameCanvas /Retained false put X FrameCanvas /Mapped false put X /destroy super send X } def X X /FullColor { X } def X X /FullOverlay { X } def X X /FullColorCursor { % can event => - X pop pop X } def X X /TrackSprite { X pop X } def X X /HideSprite { X } def X X /BlackOverlay { X } def X X /WhiteOverlay { X } def X X /DarkColor { X } def X X /KindaColor { X } def X X /HiliteCan { % gray can => - X dup null eq { pop pop } { X gsave X setcanvas X pop X 5 setrasteropcode X clippath fill X grestore X } ifelse X } def X X /LoliteCan { % can => - X 0 exch HiliteCan X } def X X /ShimmerCan { % gray can => - X 2 copy HiliteCan HiliteCan X } def X X} ifelse % cg4 X Xclassend def X Xend % systemdict //go.sysin dd * if [ `wc -c < overlay.ps` != 14187 ]; then made=false echo error transmitting overlay.ps -- echo length should be 14187, not `wc -c < overlay.ps` else made=true fi if $made; then chmod 664 overlay.ps echo -n ' '; ls -ld overlay.ps fi echo Extracting pointer.ps sed 's/^X//' <<'//go.sysin dd *' >pointer.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% @(#)handy.ps X% X% Handy Pointer X% Copyright (C) 1989. X% By Don Hopkins. (don@brillig.umd.edu) X% All rights reserved. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% This program is provided for UNRESTRICTED use provided that this X% copyright message is preserved on all copies and derivative works. X% This is provided without any warranty. No author or distributor X% accepts any responsibility whatsoever to any person or any entity X% with respect to any loss or damage caused or alleged to be caused X% directly or indirectly by this program. This includes, but is not X% limited to, any interruption of service, loss of business, loss of X% information, loss of anticipated profits, core dumps, abuses of the X% virtual memory system, or any consequential or incidental damages X% resulting from the use of this program. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xsystemdict begin X Xsystemdict /XNeWS? known not { X systemdict /XNeWS? false put X} if X XXNeWS? { X /controlpoint { X pop lineto X } def X} if X X/pointing-hand { X0 0.0674 moveto Xopen-pointing-hand Xclosepath X} def X X/open-pointing-hand { X0 0.528 .5 controlpoint X0.008 0.535 .5 controlpoint X0.0292 0.553 .5 controlpoint X0.096 0.618 .5 controlpoint X0.1553 0.694 .5 controlpoint X0.208 0.753 .5 controlpoint X0.241 0.7773 .5 controlpoint X0.264 0.7883 .5 controlpoint X0.28 0.798 .5 controlpoint X0.3224 0.824 .5 controlpoint X0.368 0.8651 .5 controlpoint X0.3952 0.898 .5 controlpoint X0.424 0.933 .5 controlpoint X0.443 0.975 .5 controlpoint X0.456 1 .5 controlpoint X0.482 0.9862 .5 controlpoint X0.496 0.933 .5 controlpoint X0.499 0.8721 .5 controlpoint X0.488 0.8202 .5 controlpoint X0.475 0.78 .5 controlpoint X0.467 0.753 .5 controlpoint X0.448 0.708 .5 controlpoint X0.408 0.673 .5 controlpoint X0.384 0.663 .5 controlpoint X0.408 0.652 .5 controlpoint X0.4212 0.652 .5 controlpoint X0.448 0.652 .5 controlpoint X0.465 0.652 .5 controlpoint X0.4934 0.652 .5 controlpoint X0.5121 0.652 .5 controlpoint X0.5334 0.652 .5 controlpoint X0.5574 0.652 .5 controlpoint X0.584 0.652 .5 controlpoint X0.6331 0.653 .5 controlpoint X0.679 0.6502 .5 controlpoint X0.744 0.6404 .5 controlpoint X0.8094 0.635 .5 controlpoint X0.888 0.618 .5 controlpoint X0.9064 0.6132 .5 controlpoint X0.929 0.608 .5 controlpoint X0.968 0.596 .5 controlpoint X0.991 0.5731 .5 controlpoint X1 0.551 .5 controlpoint X0.9854 0.5021 .5 controlpoint X0.968 0.4831 .5 controlpoint X0.926 0.481 .5 controlpoint X0.88 0.472 .5 controlpoint X0.853 0.4744 .5 controlpoint X0.8351 0.476 .5 controlpoint X0.8162 0.478 .5 controlpoint X0.76 0.4831 .5 controlpoint X0.741 0.4823 .5 controlpoint X0.718 0.4831 .5 controlpoint X0.696 0.484 .5 controlpoint X0.68 0.4831 .5 controlpoint X0.69 0.481 .5 controlpoint X0.72 0.461 .5 controlpoint X0.742 0.448 .5 controlpoint X0.752 0.427 .5 controlpoint X0.752 0.406 .5 controlpoint X0.752 0.382 .5 controlpoint X0.736 0.3483 .5 controlpoint X0.721 0.334 .5 controlpoint X0.704 0.326 .5 controlpoint X0.688 0.326 .5 controlpoint X0.6964 0.325 .5 controlpoint X0.72 0.2921 .5 controlpoint X0.7164 0.255 .5 controlpoint X0.704 0.2134 .5 controlpoint X0.6654 0.1972 .5 controlpoint X0.632 0.191 .5 controlpoint X0.608 0.191 .5 controlpoint X0.6152 0.166 .5 controlpoint X0.624 0.124 .5 controlpoint X0.6 0.09 .5 controlpoint X0.568 0.0561 .5 controlpoint X0.55 0.059 .5 controlpoint X0.525 0.0582 .5 controlpoint X0.502 0.057 .5 controlpoint X0.488 0.0561 .5 controlpoint X0.4761 0.057 .5 controlpoint X0.4564 0.0512 .5 controlpoint X0.416 0.034 .5 controlpoint X0.349 0.013 .5 controlpoint X0.288 0 .5 controlpoint X0.2224 0.007 .5 controlpoint X0.202 0.008 .5 controlpoint X0.183 0.009 .5 controlpoint X0.16 0.0112 .5 controlpoint X0.1222 0.0291 .5 controlpoint X0.08 0.045 .5 controlpoint X0.041 0.0593 .5 controlpoint X0 0.0674 .5 controlpoint X} def X X/pointing-fingers { X X0.408 0.9101 moveto X0.414 0.9104 .5 controlpoint X0.432 0.9213 .5 controlpoint X0.456 0.955 .5 controlpoint X0.464 0.989 .5 controlpoint X0.464 1 .5 controlpoint X X0.68 0.4831 moveto X0.657 0.484 .5 controlpoint X0.638 0.4841 .5 controlpoint X0.624 0.4831 .5 controlpoint X0.6054 0.4801 .5 controlpoint X0.5864 0.4764 .5 controlpoint X0.5682 0.4732 .5 controlpoint X0.552 0.472 .5 controlpoint X0.535 0.477 .5 controlpoint X0.5144 0.482 .5 controlpoint X0.4951 0.4844 .5 controlpoint X0.48 0.4831 .5 controlpoint X0.456 0.4382 .5 controlpoint X0.4604 0.409 .5 controlpoint X0.48 0.382 .5 controlpoint X0.51 0.37 .5 controlpoint X0.5281 0.3704 .5 controlpoint X0.544 0.371 .5 controlpoint X0.5734 0.3574 .5 controlpoint X0.6 0.3483 .5 controlpoint X0.6254 0.341 .5 controlpoint X0.648 0.337 .5 controlpoint X0.675 0.3303 .5 controlpoint X0.688 0.326 .5 controlpoint X X0.472 0.472 moveto X0.48 0.472 .5 controlpoint X0.4954 0.472 .5 controlpoint X0.52 0.472 .5 controlpoint X0.537 0.453 .5 controlpoint X0.544 0.427 .5 controlpoint X0.512 0.382 .5 controlpoint X0.487 0.388 .5 controlpoint X0.472 0.3932 .5 controlpoint X X0.528 0.371 moveto X0.5164 0.3683 .5 controlpoint X0.496 0.36 .5 controlpoint X0.4782 0.358 .5 controlpoint X0.464 0.3483 .5 controlpoint X0.452 0.311 .5 controlpoint X0.464 0.27 .5 controlpoint X0.483 0.25 .5 controlpoint X0.512 0.236 .5 controlpoint X0.5432 0.217 .5 controlpoint X0.576 0.2022 .5 controlpoint X0.596 0.195 .5 controlpoint X0.608 0.191 .5 controlpoint X X0.464 0.27 moveto X0.488 0.27 .5 controlpoint X0.505 0.2643 .5 controlpoint X0.52 0.27 .5 controlpoint X0.536 0.2921 .5 controlpoint X0.5294 0.314 .5 controlpoint X0.52 0.337 .5 controlpoint X0.5062 0.349 .5 controlpoint X0.488 0.3483 .5 controlpoint X0.464 0.3483 .5 controlpoint X X0.52 0.225 moveto X0.496 0.236 .5 controlpoint X0.47 0.2334 .5 controlpoint X0.448 0.225 .5 controlpoint X0.432 0.191 .5 controlpoint X0.442 0.164 .5 controlpoint X0.464 0.135 .5 controlpoint X0.48 0.124 .5 controlpoint X0.496 0.1123 .5 controlpoint X0.5192 0.1042 .5 controlpoint X0.544 0.09 .5 controlpoint X0.552 0.09 .5 controlpoint X X0.472 0.225 moveto X0.488 0.225 .5 controlpoint X0.512 0.2022 .5 controlpoint X0.512 0.169 .5 controlpoint X0.496 0.157 .5 controlpoint X0.472 0.1573 .5 controlpoint X0.45 0.162 .5 controlpoint X0.44 0.169 .5 controlpoint X X0.392 0.652 moveto X0.3811 0.6531 .5 controlpoint X0.36 0.6404 .5 controlpoint X0.328 0.5842 .5 controlpoint X X} def X X/fingertip-y .551 def % finger tip @ (1, fingertip-y) X X/pointer-path { % fx fy tx ty size fingers? => - X 10 dict begin X /fingers? exch def /size exch def X /ty exch def /tx exch def /fy exch def /fx exch def X /dx tx fx sub def /dy ty fy sub def X /ang X dy dx X 2 copy 0 eq exch 0 eq and { pop pop 0 } { atan } ifelse X def X /mat matrix currentmatrix def X fx fy moveto X tx ty translate X ang rotate X size dup .75 mul scale X -1 fingertip-y neg translate % finger tip to 0,0 X open-pointing-hand X closepath X fingers? { pointing-fingers } if X mat setmatrix X end % localdict X} def X X/get-pointer { % - => FromX FromY ToX ToY X fboverlay setcanvas X getclick X /FromY exch def /FromX exch def X FromX FromY X { x0 y0 x y 64 false pointer-path stroke } X getanimated X waitprocess aload pop X /ToY exch def /ToX exch def X FromX FromY ToX ToY X} def X X/get-pointer-to { % ToX ToY - => ToX ToY Direction Distance X fboverlay setcanvas X /ToY exch def /ToX exch def X ToX ToY X { pop pop x y x0 y0 64 false pointer-path stroke } X getanimated X waitprocess aload pop X /FromY exch def /FromX exch def X ToX ToY X ToY FromY sub ToX FromX sub X 2 copy X 2 copy 0 eq exch 0 eq and { pop pop 0 } { atan } ifelse X 3 1 roll X dup mul exch dup mul add sqrt X} def X X/UseOverlay? systemdict /OverlayWindow known def X X/PointWindow XUseOverlay? { OverlayWindow } { DefaultWindow } ifelse Xdictbegin X UseOverlay? framebuffer /Color get not or { X /HandColor .75 .75 .75 rgbcolor def X /BackgroundColor 1 1 1 rgbcolor def X /FrameBorderColor 0 0 0 rgbcolor def X /TextColor 0 0 0 rgbcolor def X } { X /HandColor ColorDict /Tan get def X /BackgroundColor ColorDict /LightSteelBlue get def X /FrameBorderColor ColorDict /DarkSlateBlue get def X /TextColor ColorDict /Coral get def X } ifelse X /Strings [(That)] def X /Font /Helvetica-Bold findfont 16 scalefont def X /LineHeight 20 def X /Margin 8 def X /Distance 0 def X /Angle 0 def X /TipX 0 def X /TipY 0 def X /EndX 0 def X /EndY 0 def X /X null def X /Y null def X /Width null def X /Height null def X /FrameRadius 6 def X /BorderTop 4 def X /BorderBottom 4 def X /BorderLeft 4 def X /BorderRight 4 def X /Hand? true def Xdictend Xclassbegin X X UseOverlay? not { X /FullColor {} def X } { X /FullColor { X gsave X EnableCanvas setcanvas 0 fillcanvas X grestore X } def X /CreateClientCanvas { X /CreateClientCanvas super send X ColorCanvas /Retained false put X ColorCanvas /Transparent true put X framebuffer /Color get { X FrameCanvas /Retained false put X% FrameCanvas /Transparent true put X } if X } def X } ifelse X X /HandHeight 64 def X /HandWidth 80 def X X /setmessage { % str | [str str ...] => - X dup type /arraytype ne { X [ exch ] X } if X /Strings exch store X } def X X /minsize { % - => w h X gsave X framebuffer setcanvas X Font setfont X 0 Strings { X stringwidth pop max X } forall X Margin dup add add BorderLeft add BorderRight add X Strings length LineHeight mul X Margin dup add add BorderTop add BorderBottom add X grestore X } def X X /reshape { % x y w h => - X /FrameHeight exch def /FrameWidth exch def X /FrameY exch def /FrameX exch def X /EndX FrameX FrameWidth 2 div add def X /EndY FrameY FrameHeight 2 div add def X FrameX FrameY FrameWidth FrameHeight /reshape super send X gsave X framebuffer setcanvas FrameCanvas getcanvaslocation X /dy exch FrameY sub def X /dx exch FrameX sub def X%(X % Y % dx % dy %\n) [FrameX FrameY dx dy] dbgprintf X grestore X } def X X /slide { X /Hand? false def X FrameX FrameY FrameWidth FrameHeight reshape X /slide super send X } def X X /slideconstrained { X /Hand? false def X FrameX FrameY FrameWidth FrameHeight reshape X /slideconstrained super send X } def X X /FramePath { X FrameRadius 5 1 roll % r x y w h X 3 -1 roll 1 index add 3 1 roll neg % r x y+h w -h X rrectpath % X11/NeWS: This makes inside-out corners! Fix! X Hand? { X EndX FrameX sub EndY FrameY sub X TipX FrameX sub TipY FrameY sub X HandHeight false pointer-path X closepath X } if X } def X X /ClientPath { % - => - ([Re]set client canvas' shape) X FrameCanvas setcanvas clippath X } def X X /PaintFrame { X% ClientCanvas setcanvas X UseOverlay? { X EnableCanvas setcanvas 0 fillcanvas X OverlayCanvas setcanvas X } if X Hand? { X HandColor fillcanvas X newpath X EndX FrameX sub EndY FrameY sub X TipX FrameX sub TipY FrameY sub X HandHeight true pointer-path X closepath X FrameBorderColor setcolor X stroke X } if X FrameRadius 0 0 FrameWidth FrameHeight rrectpath X FrameRadius BorderLeft BorderBottom X FrameWidth BorderLeft sub BorderRight sub X FrameHeight BorderBottom sub BorderTop sub rrectpath X FrameBorderColor setcolor eofill X FrameRadius BorderLeft BorderBottom X FrameWidth BorderLeft sub BorderRight sub X FrameHeight BorderBottom sub BorderTop sub rrectpath X BackgroundColor setcolor X fill X } def X X /PaintClient { X gsave X UseOverlay? { X FullOverlay X OverlayCanvas setcanvas X } if X Margin ClientHeight Margin 2 div sub translate X TextColor setcolor X Font setfont X Strings { X 0 LineHeight neg translate X 0 0 moveto X show X } forall X grestore X } def X X /PaintFocus {} def X X /point { % tipx tipy angle distance => - X /Distance exch def X /Angle exch def X /TipY exch def X /TipX exch def X X % Back off a couple points so you can see what I'm pointing at, X % and so the cursor is still in the same canvas. X /dx Angle cos neg def /dy Angle sin neg def X /TipX TipX dx dup add sub def X /TipY TipY dy dup add sub def X X minsize % w h X /Height exch def /Width exch def X X% /Distance Height Width max 2 div Distance add def X X% /EndX TipX Distance Width add dx mul add def X% /EndY TipY Distance Height add dy mul add def X /EndX TipX Distance dx mul add def X /EndY TipY Distance dy mul add def X X /X EndX Width 2 div sub def X /Y EndY Height 2 div sub def X X X Y Width Height reshape X X } def X X /PaintLabel { X } def X X /move { X /Hand? true def X FrameWidth FrameHeight reshape X } def X Xclassend def X X/pointmsg { % tipx tipy ang dist strings => process X { 10 dict begin X newprocessgroup X /win framebuffer /new PointWindow send def X /setmessage win send X /point win send X /map win send X end } fork X 5 1 roll 5 { pop } repeat X} def X Xend % systemdict X X%get-pointer X%FromX FromY (From) popmsg pop X%ToX ToY (To) popmsg pop X //go.sysin dd * if [ `wc -c < pointer.ps` != 12978 ]; then made=false echo error transmitting pointer.ps -- echo length should be 12978, not `wc -c < pointer.ps` else made=true fi if $made; then chmod 664 pointer.ps echo -n ' '; ls -ld pointer.ps fi echo Extracting mics.ps sed 's/^X//' <<'//go.sysin dd *' >mics.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% @(#)MiCS.ps X% Molecules in Cyber Space X% Copyright (C) 1989. X% By Don Hopkins. (don@brillig.umd.edu) X% All rights reserved. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% You are free to redistribute this program. Please leave the comments X% intact, add your own interpretations, views, hallucinations, navagation X% aids, and pass it on to friends! The author is not responsible for any X% time or brain cells wasted with this software. X% X% This is an almost totally rewritten version of the Pseudo Scientific X% Visualizer (the browser for the other half of your brain). X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X% We've got to have various classes defined... X Xsystemdict /PieMenu known not { X (NeWS/piemenu.ps) LoadFile not { X currentcursorlocation X [(Need) (piemenu.ps)] popmsg pop X currentprocess killprocess X } if X} if X Xsystemdict /PulloutPieMenu known not { X (NeWS/pullout.ps) LoadFile not { X currentcursorlocation X [(Need) (pullout.ps)] popmsg pop X currentprocess killprocess X } if X} if X Xsystemdict /OverlayWindow known not { X (NeWS/overlay.ps) LoadFile not { X currentcursorlocation X [(Need) (overlay.ps)] popmsg pop X currentprocess killprocess X } if X} if X Xsystemdict /pointing-hand known not { X (NeWS/pointer.ps) LoadFile not { X currentcursorlocation X [(Need) (pointer.ps)] popmsg pop X currentprocess killprocess X } if X} if X Xsystemdict /StillDict known not { X (NeWS/distill.ps) LoadFile not { X currentcursorlocation X [(Need) (distill.ps)] popmsg pop X currentprocess killprocess X } if X} if X Xsystemdict begin X Xsystemdict /growabledict known not { X /growabledict { 5000 dict } def X} if X X/MoleculeDict 200 dict def XMoleculeDict begin X X /ColorHueFrob .3 def X /ColorSaturationFrob .5 def X /ColorBrightnessFrob .3 def X X /ScaleX .065 def X /ScaleY {ScaleX} def X X /ShrinkX .55 def X /ShrinkY {ShrinkX} def X X /ArraySpread 2.1 def X /DictKeySpread 2.1 def X /DictValueSpread 2.1 def % translate happens *after* scaling down X X /ProcessMax 10 def X /ForkProb .8 def X X /DepthDraw 3 def X /DepthTarget 999 def X X /Drain? false def X X /DoLines false def X X /Interesting? true def X X /Selective? true def X X X X /_Leaf_ { /DepthDraw MyDepth def } def X X /MagicKeys 50 dict def X MagicKeys begin X /TopCanvas //_Leaf_ def X /BottomCanvas //_Leaf_ def X /CanvasAbove //_Leaf_ def X /Parent //_Leaf_ def X /FrameMenu //_Leaf_ def X /IconMenu //_Leaf_ def X /ParentDict //_Leaf_ def X /ParentDictArray //_Leaf_ def X end X X /Types { X nulltype integertype realtype booleantype colortype marktype X operatortype nametype stringtype shapetype monitortype X graphicsstatetype cursortype filetype arraytype dicttype X fonttype canvastype processtype eventtype X% X11/NeWS: X savetype packedarraytype colormapentrytype environmenttype X colormaptype pathtype visualtype vmtype X } def X X /defaulttype { X pop X gsave X _newpath X -90 rotate X 0 setlinecap X .1 setlinewidth X 0 -.8 .2 0 360 arc closepath _fill X 0 -.5 moveto X 0 .5 .5 -90 120 arc X _stroke X grestore X } def X X /nulltype { X pop X gsave X _newpath X -90 rotate X -1 -1 2 .7 rectpath X 0 -.5 .6 180 0 arcn closepath X _fill X grestore X } def X X /integertype { X gsave X _newpath X abs 1 add ln dup 10000 mul cos 1 add 2 div cvfixed X exch dup 1000 mul sin 1 add 2 div cvfixed X exch 100 mul 10 add cos 1 add 2 div cvfixed X setrgbcolor X -.6 -.6 1.2 1.2 rectpath X _fill X grestore X } def X X /realtype { X integertype X } def X X /booleantype { X gsave X _newpath X .1 setlinewidth X 0 setlinecap X -90 rotate X 0 0 .9 0 360 arc closepath X { X 0 -.9 moveto X 0 .9 lineto X -45 rotate X 0 -.9 moveto X 0 0 lineto X .9 0 lineto X } { X -45 rotate X 0 -.9 moveto X 0 .9 lineto X } ifelse X _stroke X grestore X } def X X /colortype { X gsave X _newpath X 0 0 .9 0 360 arc closepath X gsave .1 setlinewidth 0 setgray _stroke grestore X setcolor _fill X grestore X } def X X /marktype { X pop X gsave X _newpath X -90 rotate X -1 -.3 translate X 2 2 scale X .2 0 moveto % Nick Turner's finger X 0 .3 lineto X .1 .5 lineto X .2 .5 lineto X .2 .55 lineto X .3 .6 lineto X .4 .55 lineto X .4 .95 lineto X .5 1 lineto X .6 .95 lineto X .6 .55 lineto X .7 .6 lineto X .8 .55 lineto X .8 .5 lineto X .9 .55 lineto X 1 .5 lineto X 1 .3 lineto X .8 0 lineto X closepath X _fill X grestore X } def X X /operatortype { X pop X _newpath X -.2 -.2 .4 .4 rectpath X 0 0 .5 0 360 arc closepath X _eofill X } def X X /nametype { X pop X _newpath X 0 -.5 moveto X 1 0 lineto X 0 .5 lineto X closepath X _eofill X } def X X /stringtype { X length 1 add X _newpath X -.5 -.1 % x y X 3 -1 roll 5 div .5 add .2 % x y w h X rectpath X _fill X } def X X /shapetype { X defaulttype X } def X X /monitortype { X gsave X _newpath X -.8 -1 1.2 1 rectpath X _fill X 0 setlinecap X .1 setlinewidth X .7 1 moveto X 0 X exch monitorlocked 1.2 1.6 ifelse X .7 0 180 arc closepath X _stroke X grestore X } def X X /graphicsstatetype { X pop X _newpath X -.5 -.5 moveto X 1 -.4 lineto X 1 -.2 lineto X .8 -.2 lineto X 1 .4 lineto X 1 1 lineto X .5 .3 lineto X -.5 .5 lineto X closepath X _eofill X } def X X /cursortype { X defaulttype X } def X X /filetype { X pop X gsave X _newpath X 90 rotate X -.9 -.9 1.8 .4 ovalpath X -.9 .5 1.8 .4 ovalpath X -.9 -.7 moveto X -.9 .7 lineto X .9 -.7 moveto X .9 .7 lineto X _stroke X grestore X } def X X % Compound objects X X /OpenArrays? true def X X /arraytype { X gsave X _newpath X dup length 0 ne DoLines and { X .05 setlinewidth X 360 1 index length div X dup -2 div rotate X 1 index length { X 0 0 moveto X ArraySpread 0 lineto X dup rotate X _stroke X } repeat X pop X } if X 0 0 1 0 360 arc closepath X 0 0 .6 0 360 arc closepath X _eofill X grestore X OpenArrays? { compoundtype } if X } def X X /compoundtype { X 20 dict begin gsave X make-target X /obj exch def X MyDepth DepthDraw lt { X /pieces /obj load length def X pieces 0 ne { X /step 360 pieces div def X step -2 div rotate X /i -1 def X /obj load { % element X pause X BailOut? {pop exit} if X /i i 1 add def X gsave X ArraySpread 0 translate X ShrinkX ShrinkY scale X _begingroup X visualize X _endgroup X grestore X step rotate X } forall X } if X } if X end grestore X } def X X /OpenDicts? true def X X /dicttype { X gsave X _newpath X dup length 0 ne DoLines and { X .05 setlinewidth X 360 1 index length div X dup -2 div rotate X 1 index length { X 0 0 moveto X DictKeySpread 0 lineto X dup rotate X _stroke X } repeat X pop X } if X 0 0 1 0 360 arc closepath X 0 0 .7 0 360 arc closepath X 0 0 .3 0 360 arc closepath X _eofill X grestore X OpenDicts? { dictoidtype } { pop } ifelse X } def X X /dictoidtype { X 20 dict begin gsave X make-target X /obj exch def X MyDepth DepthDraw lt { X /pieces /obj load length def X pieces 0 ne { X /step 360 pieces div def X step -2 div rotate X /obj load { % element X pause X BailOut? {pop pop exit} if X gsave X DictKeySpread 0 translate X ShrinkX ShrinkY scale X _begingroup X 1 index visualize X _endgroup X DictValueSpread 0 translate X _begingroup X exch MagicKeys 1 index known { X 10 dict begin X MagicKeys exch get exec X visualize X end X } { X pop visualize X } ifelse X _endgroup X grestore X step rotate X } forall X } if X } if X end grestore X } def X X % Bill Meine's Sunlogo: X /Uchar { X -.1 0 moveto X 0 0 .1 180 360 arc X 0 2.9 rlineto X .8 0 rlineto X 0 -2.9 rlineto X 0 0 .9 0 180 arcn X 0 2.9 rlineto X .8 0 rlineto X closepath X } def X /2Uchar { X Uchar matrix currentmatrix X 4 4 translate Uchar setmatrix X } def X /Sunlogo { % xcenter ycenter s = - X 3 1 roll % s xcenter ycenter X matrix currentmatrix 4 1 roll % matrix s xcenter ycenter X translate % matrix s X 16 dup mul 2 div sqrt div % s will now represent total height X dup scale % matrix X 0 3 dup mul 2 mul sqrt neg translate % new starting point from center X 45 rotate X 4 { 2Uchar 6 0 translate 90 rotate } repeat X setmatrix % restore original CTM X } def X X /fonttype { X pop X _newpath X 0 0 2 Sunlogo X _fill X } def X X /OpenAllCanvases? false def X X /OpenCanvases? { X OpenAllCanvases? true { X dup /ParentDictArray known X } ifelse X } def X X /canvastype { X gsave X _newpath X -.8 -.8 translate X 2 { X 0 0 moveto X 1.8 0 rlineto X currentpoint X -.2 -.2 rlineto X moveto X -.2 .2 rlineto X 90 rotate X } repeat X _stroke X grestore X OpenCanvases? { dictoidtype } { pop } ifelse X } def X X /OpenProcesses? false def X X /processtype { X gsave X _newpath X 90 rotate X -1 -1 translate X 2 1.8 scale X 0.634 0.83 moveto X 0.634 0.83 0.5 controlpoint X 0.6762 0.836 0.5 controlpoint X 0.7723 0.8271 0.5 controlpoint X 0.8313 0.819 0.5 controlpoint X 0.847 0.8101 0.5 controlpoint X 0.86 0.7903 0.5 controlpoint X 0.867 0.748 0.5 controlpoint X 0.8684 0.737 0.5 controlpoint X 0.8684 0.737 0.5 controlpoint X 0.882 0.7393 0.5 controlpoint X 0.894 0.734 0.5 controlpoint X 0.9021 0.7252 0.5 controlpoint X 0.916 0.711 0.5 controlpoint X 0.9173 0.7 0.5 controlpoint X 0.938 0.683 0.5 controlpoint X 0.96 0.652 0.5 controlpoint X 0.978 0.612 0.5 controlpoint X 0.9831 0.584 0.5 controlpoint X 0.9831 0.5523 0.5 controlpoint X 0.973 0.53 0.5 controlpoint X 0.96 0.5212 0.5 controlpoint X 0.948 0.5212 0.5 controlpoint X 0.948 0.5212 0.5 controlpoint X 0.9443 0.4674 0.5 controlpoint X 0.933 0.448 0.5 controlpoint X 0.9123 0.442 0.5 controlpoint X 0.889 0.4334 0.5 controlpoint X 0.8583 0.431 0.5 controlpoint X 0.8532 0.448 0.5 controlpoint X 0.857 0.462 0.5 controlpoint X 0.857 0.462 0.5 controlpoint X 0.84 0.462 0.5 controlpoint X 0.84 0.462 0.5 controlpoint X 0.835 0.422 0.5 controlpoint X 0.828 0.408 0.5 controlpoint X 0.8043 0.371 0.5 controlpoint X 0.7723 0.3512 0.5 controlpoint X 0.7504 0.3512 0.5 controlpoint X 0.732 0.357 0.5 controlpoint X 0.712 0.377 0.5 controlpoint X 0.693 0.4022 0.5 controlpoint X 0.678 0.439 0.5 controlpoint X 0.673 0.4674 0.5 controlpoint X 0.673 0.4674 0.5 controlpoint X 0.653 0.476 0.5 controlpoint X 0.653 0.476 0.5 controlpoint X 0.646 0.442 0.5 controlpoint X 0.646 0.442 0.5 controlpoint X 0.5581 0.456 0.5 controlpoint X 0.422 0.456 0.5 controlpoint X 0.361 0.4674 0.5 controlpoint X 0.302 0.456 0.5 controlpoint X 0.287 0.456 0.5 controlpoint X 0.2782 0.456 0.5 controlpoint X 0.2664 0.482 0.5 controlpoint X 0.245 0.4362 0.5 controlpoint X 0.216 0.3852 0.5 controlpoint X 0.167 0.3852 0.5 controlpoint X 0.135 0.439 0.5 controlpoint X 0.115 0.4872 0.5 controlpoint X 0.105 0.5184 0.5 controlpoint X 0.105 0.578 0.5 controlpoint X 0.091 0.513 0.5 controlpoint X 0.0573 0.51 0.5 controlpoint X 0.039 0.541 0.5 controlpoint X 0.024 0.561 0.5 controlpoint X 0.0134 0.5722 0.5 controlpoint X 0.024 0.6232 0.5 controlpoint X 0.054 0.68 0.5 controlpoint X 0.088 0.7252 0.5 controlpoint X 0.088 0.731 0.5 controlpoint X 0.054 0.765 0.5 controlpoint X 0.037 0.771 0.5 controlpoint X 0.039 0.8271 0.5 controlpoint X 0.0573 0.839 0.5 controlpoint X 0.1483 0.8441 0.5 controlpoint X 0.1483 0.836 0.5 controlpoint X 0.1483 0.819 0.5 controlpoint X 0.1483 0.796 0.5 controlpoint X 0.162 0.7903 0.5 controlpoint X 0.1652 0.819 0.5 controlpoint X 0.179 0.839 0.5 controlpoint X 0.2023 0.85 0.5 controlpoint X 0.206 0.8271 0.5 controlpoint X 0.216 0.8243 0.5 controlpoint X 0.221 0.8441 0.5 controlpoint X 0.26 0.898 0.5 controlpoint X 0.2934 0.9121 0.5 controlpoint X 0.336 0.932 0.5 controlpoint X 0.4114 0.952 0.5 controlpoint X 0.4603 0.9603 0.5 controlpoint X 0.508 0.9603 0.5 controlpoint X 0.528 0.958 0.5 controlpoint X 0.543 0.941 0.5 controlpoint X 0.597 0.881 0.5 controlpoint X 0.624 0.85 0.5 controlpoint X closepath X _fill X grestore X OpenProcesses? { dictoidtype } { pop } ifelse X } def X X /OpenAllEvents? true def X X /OpenEvents? { X OpenAllEvents? true { X dup /ParentDictArray known X } ifelse X } def X X /eventtype { X _newpath X -.8 -.8 1.6 1.6 rectpath X -.8 .8 moveto X 0 0 lineto X -.8 -.8 lineto X _stroke X OpenEvents? { dictoidtype } { pop } ifelse X } def X X /savetype { X defaulttype X } def X X /packedarraytype { X arraytype X } def X X /OpenColorMapEntries? false def X X /colormapentrytype { X dup defaulttype X OpenColormapEntries? { dictoidtype } { pop } ifelse X } def X X /OpenEnvironments? false def X X /environmenttype { X dup defaulttype X OpenEnvironments? { dictoidtype } { pop } ifelse X } def X X /OpenColormaps? false def X X /colormaptype { X dup defaulttype X OpenColormaps? { dictoidtype } { pop } ifelse X } def X X /pathtype { X defaulttype X } def X X /OpenVisuals? false def X X /visualtype { X dup defaulttype X OpenVisuals? { dictoidtype } { pop } ifelse X } def X X /vmtype { X defaulttype X } def X Xend % MoleculeDict X X/PSVisualizerWindow OverlayWindow Xdictbegin X /FrameLabel (The NeWS Pseudo-Scientific Visualizer!) def X /IconLabel (PS Visualizer) def X /IconImage /eye def X X /MyProcesses null def X /MyThing null def X /MyTop null def X X /EventMgr null def X X /Canvases null def X X /CheapIcon? false def % quickwin mod X /Retained? true def X X /BorderLeft 8 def X /BorderRight 8 def X /BorderTop 8 def X /BorderBottom 8 def X X /FrameFillColor .25 .25 .25 rgbcolor def X systemdict /fb_color known { fb_color /Color get } X { framebuffer /Color get } ifelse { X /SpaceColor ColorDict /MediumTurquoise get def X } { X /SpaceColor 0 0 0 rgbcolor def X } ifelse X /MoleculeColor {random random .3 max sqrt random .3 max sqrt hsbcolor} def X X /HilitedCan null def X X /SpotRadius 28 def X X /ForkPaintClient? true def X %/ForkPaintClient? false def X X /HiliteDelay .2 60 div def X /LoliteDelay .4 60 div def X /DelayedHiliteProc null def X X /DictBase null def X Xdictend Xclassbegin X X /FramePath { ovalpath } def X X /PaintFrame { X FrameFillColor fillcanvas X } def X X /PaintFocus { X } def X X /ExitFrame { X HideSprite X DelayedHiliteProc null ne { X DelayedHiliteProc killprocess X /DelayedHiliteProc null def X } if X /DelayedHiliteProc { X LoliteDelay sleep X KindaColor X /ExitFrame super send X /DelayedHiliteProc null def X } fork def X } def X X /EnterFrame { X CurrentEvent TrackSprite X DelayedHiliteProc null ne { X DelayedHiliteProc killprocess X /DelayedHiliteProc null def X } if X /DelayedHiliteProc { X HiliteDelay sleep X InteractionLock { X FullColor X /EnterFrame super send X /DelayedHiliteProc null def X } monitor X } fork def X } def X X /MyDepth { X countdictstack DictBase sub X } def X X /new { X /new super send begin X /MyThing exch def X /MyTop /MyThing load def X /MyProcesses 100 dict def X currentdict X end X } def X X /destroy { % clean up X zap-processes X /MyThing null store X /MyTop null store X zap-canvases X /destroy super send X } def X X /zap-processes { X EventMgr type /processtype eq { X EventMgr killprocess X } if X MyProcesses { X dup currentprocess ne { killprocess } { X % No owch! X } ifelse X MyProcesses exch undef X } forall X } def X X /zap-canvases { X /HilitedCan null store X Canvases null ne { X Canvases { X /obj undef X Canvases 1 index undef X% /Interests get X% % Careful not to zap the global keyboard manager! X% { dup /Process get dup null eq { pop } { X% dup currentprocess eq { pop } { killprocess } ifelse X% } ifelse X% %{ revokeinterest } errored {pop} if X% pop X% } forall X pop X } forall X } if X } def X X /drain { X MoleculeDict /Drain? true put X fart-around X MoleculeDict /Drain? false put X } def X X /fart-around { X { MyProcesses length 0 eq { exit } if X MyProcesses { pop exit } forall % Grab one process X waitprocess pop X } loop X } def X X /PaintClient { X gsave X FrameCanvas setcanvas X damagepath clipcanvas X newpath clipcanvas X repaint X grestore X } def X X /repaint { X FullColor X BlackOverlay X ColorCanvas setcanvas X EventMgr null ne { X EventMgr killprocess X /EventMgr null store X } if X { X clear X newprocessgroup X drain X zap-processes X zap-canvases X /Canvases growabledict store X SpaceColor fillcanvas X MoleculeColor setcolor X StillDict begin _stillbegin X MoleculeDict begin X /DictBase countdictstack store X clippath pathbbox scale pop pop X .5 .5 translate ScaleX ScaleY scale X { /MyThing load X _begingroup visualize _endgroup X MyProcesses currentprocess undef X } fork MyProcesses exch dup put X fart-around X ColorCanvas setcanvas X EventMgr dup null ne exch currentprocess ne and { X EventMgr killprocess X % this is a futile attempt to get a new event manager process X % corpus, so we don't get any events destined for the old one. X % (see sjs's blankscreen comments) X { clear .1 sleep } fork pop X } if X [ Canvases { pop X [ /EnterEvent /ExitEvent PointButton AdjustButton MenuButton ] X /target-event null 4 -1 roll eventmgrinterest X } forall X PointButton /point-background null TrackCanvas eventmgrinterest X /MouseDragged /drag-background null TrackCanvas eventmgrinterest X ] forkeventmgr X end % MoleculeDict X _stillend end % StillDict X /EventMgr exch store X clear X } fork pop X newpath clipcanvas X .5 60 div sleep fart-around X } def X X /activate { X map X } def X X /reshape { X /reshape super send X } def X X /hilite-can { % can => - X lolite-hilited-can X /HilitedCan 1 index def X 1 exch HiliteCan X } def X X /lolite-hilited-can { X HilitedCan null ne { X HilitedCan LoliteCan X /HilitedCan null def X } if X } def X X /shimmer-hilited-can { X HilitedCan ShimmerCan X } def X X /drag-background { % event => - X DelayedHiliteProc null eq { X CurrentEvent TrackSprite X HilitedCan null ne { X random shimmer-hilited-can X } if X } if X pop X } def X X /point-background { % - => event X { X gsave X CurrentEvent /Action get /DownTransition eq { X DarkColor X Canvases { % can dict X begin X Interesting? { X random X dup .4 lt { pause } if X 2 div .5 add exch HiliteCan X } { pop } ifelse X end X } forall X } { X% FullColor X } ifelse X grestore X } fork pop pause pause X pop X } def X X /smart-name where { pop } { % see if smart-name from cyber is defined X % otherwise just be dumb X /smart-name { % obj => name X dup type (% %) sprintf X } def X } ifelse X X /quicksort where { pop } { % see if quicksort is defined (cyber or xnews) X % otherwise just be out of sorts X /quicksort { % array compare => array X pop X } def X } ifelse X X /target-event-names 10 dict def X target-event-names begin X PointButton { X CurrentEvent /Action get /DownTransition eq { X Canvases X% CurrentEvent /Canvas get get /obj get X CurrentEvent /Interest get /Canvas get get /obj get X select-object X } { X Canvases X% CurrentEvent /Canvas get get /obj get X CurrentEvent /Interest get /Canvas get get /obj get X dup length 20 le { X [ exch X dup smart-name (%:) sprintf exch X dup type dup /arraytype eq exch /packedarraytype eq or { X 0 exch { X smart-name 1 index ( %: %) sprintf exch 1 add X } forall X pop X } { X [ exch X { smart-name exch ( %: %) sprintf } forall X ] /gt load quicksort X aload pop X } ifelse X ] X } { X smart-name X } ifelse X gsave X DarkColor X framebuffer setcanvas X currentcursorlocation X get-pointer-to X 5 -1 roll X pointmsg pop X grestore X } ifelse X } def X X AdjustButton { X CurrentEvent /Action get /DownTransition eq { X Canvases X CurrentEvent /Interest get /Canvas get get /obj get X /MyThing exch store X { repaint } fork pop X } { X } ifelse X } def X X MenuButton { X CurrentEvent /Action get /UpTransition eq { X Canvases X CurrentEvent /Interest get /Canvas get get /obj get X KindaColor % Make overlay visible for /reshapefromuser X CurrentEvent recallevent X start_visualizer X } { X } ifelse X } def X X /EnterEvent { X CurrentEvent /Interest get /Canvas get X dup hilite-can X CurrentEvent /KeyState get length 0 ne { X Canvases 1 index get /obj get select-object X } if X% canvastotop X pop X pause X } def X X /ExitEvent { X CurrentEvent /Interest get /Canvas get X HilitedCan null eq { pop } { X HilitedCan X lolite-hilited-can X pause X canvastobottom X } ifelse X } def X X end X X /target-event { % event => - X gsave X target-event-names CurrentEvent /Name get get exec X grestore X pop X } def X X /maxint .5 minim div 1 sub def X XXNeWS? { X /cvfixed {} def X} { X /cvfixed { X 1024 mul floor maxint min cvi -10 bitshift X } def X} ifelse X X /wrap { X dup floor sub cvfixed X } def X X % This is useful for finding core leaks ... (Really!) X /context-string { % => (string) X () X currentprocess /DictionaryStack get X dup length 2 sub 2 exch getinterval X { dup /obj known { X begin i /obj load 3 -1 roll (%/%:%) sprintf end X } {pop} ifelse X } forall X 1 index exch (% = %) sprintf X } def X X /make-target { X MyDepth DepthTarget le { X Canvases dup length exch maxlength 10 sub ge { X Canvases dup maxlength 1.5 mul floor exch extend pop X } if X /can TrackCanvas newcanvas def X 0 0 1 0 360 arc can reshapecanvas X can /Retained false put X can /Transparent true put X can /Mapped true put X Canvases can currentdict put X } if X } def X X /BailOut? { X MyDepth DepthDraw gt X Drain? or X } def X X /visualize { % obj => - X pause X BailOut? { pop } { X { gsave X currenthsbcolor X 3 -1 roll random ColorHueFrob mul sub wrap X 3 -1 roll random ColorSaturationFrob mul sub wrap X .3 max X sqrt % Crank up the saturation! X 3 -1 roll random ColorBrightnessFrob mul sub wrap X .3 max X sqrt % Crank up the brightness! X sethsbcolor X dup type cvx exec X grestore X } X MyProcesses length ProcessMax lt X random ForkProb lt and not { exec } { X { exec X MyProcesses currentprocess X undef X } fork X MyProcesses exch dup put X pop pop X } ifelse X } ifelse X } def X X X% Menu definitions X X /ColorFrobMenu [ X [(0.0) (0.02) (0.05) X (0.1) (0.2) (0.3) (0.4) (0.5) (0.6) (0.7) (0.8) (0.9) (1.0) (99)] X ] [ X (HueFrob) { MoleculeDict /ColorHueFrob getmenuarg cvr put } X (BrightnessFrob) { MoleculeDict /ColorBrightnessFrob getmenuarg cvr put } X (SaturationFrob) { MoleculeDict /ColorSaturationFrob getmenuarg cvr put } X ] /new PulloutPieMenu send def X X /ThingMenu [ X (Top) { X {/MyThing /MyTop load store } ThisWindow send } X (SendContexts) { X ThisWindow /MyThing currentprocess /SendContexts get put } X (Object) { X ThisWindow /MyThing Object put } X (rootmenu) { X ThisWindow /MyThing rootmenu put } X (DefaultMenu) { X ThisWindow /MyThing DefaultMenu put } X (userdict) { X ThisWindow /MyThing userdict put } X (PrimarySelection) { X ThisWindow /MyThing /PrimarySelection getselection put } X (self) { X ThisWindow /MyThing self put } X (PSVisualizerWindow) { X ThisWindow /MyThing PSVisualizerWindow put } X (MoleculeDict) { X ThisWindow /MyThing MoleculeDict put } X ] /new PieMenu send def X X /FlagsMenu [ X (Lines On) {MoleculeDict /DoLines true put} X (Distill On) {StillDict /_out? true put} X (Lines Off) {MoleculeDict /DoLines false put} X (Distill Off) {StillDict /_out? false put} X ] /new PieMenu send def X X /ClientMenu [ X [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) X (11) (12) (13) (14) (15) (16) (17) (18) (19) (20)] X [] X [(0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (9999)] X [] X [] X [] X [(0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (9999)] X [] X ] [ X (MaxProcs) X { MoleculeDict /ProcessMax getmenuarg cvi put } X (Flags...) FlagsMenu X (DrawDepth) X { MoleculeDict /DepthDraw getmenuarg cvi put } X (ColorFrob...) ColorFrobMenu X(---) {} X (Thing...) ThingMenu X (TargetDepth) X { MoleculeDict /DepthTarget getmenuarg cvi put } X (visualize) { /repaint ThisWindow send } X ] /new PulloutPieMenu send def X X % Hurray for you -- you're reading the source code! X % To find core leaks, visualize objects in your application's userdict, X % and look for the infinite regression of circular references. X % (warning: magic dicts in systemdict get "unregistered" errors!) X Xclassend def X X/select-object { % obj => - X 20 dict begin X /SelectionType /object def X /ContentsPostScript 1 index def X /ContentsAscii exch (%) sprintf def X /SelectionObjSize 1 def X /SelectionResponder null def X /Canvas currentcanvas def % XXX? X /SelectionHolder currentprocess def % XXX? X currentdict X end X /PrimarySelection setselection X} ?def X X/start_visualizer { % thing => X { X InteractionLock { X framebuffer setcanvas X newprocessgroup X framebuffer /new PSVisualizerWindow send X fboverlay setcanvas X currentcursorlocation X { 2 copy lineto 16 0 rmoveto 16 0 360 arc stroke } X getanimated X waitprocess aload pop % centerx centery X 2 copy X { newpath % x y X y0 sub dup mul exch x0 sub dup mul add sqrt % r X 16 max X x0 y0 3 -1 roll 0 360 arc X } getanimated X waitprocess aload pop % centerx centery edgex edgey X 10 dict begin X /ey exch def /ex exch def /cy exch def /cx exch def X /r cx ex sub dup mul cy ey sub dup mul add sqrt 16 max def X cx r sub cy r sub r dup add dup % x y w h X end X /reshape 5 index send X /SpaceColor where { X pop X gsave X SpaceColor setcolor X currenthsbcolor X 3 -1 roll random ColorHueFrob mul add wrap X 3 1 roll hsbcolor X 1 index exch % win win color X /SpaceColor exch put % win X grestore X } if X } monitor X /activate exch send X } fork pop pop X} def X Xend % systemdict X X% visualize command line args, if any. X{ clear X { ($1 $2 $3 $4 $5 $6 $7 $8 $9) cvx exec } errored not { X count 0 ne { X start_visualizer X } if X } if X} fork pop //go.sysin dd * if [ `wc -c < mics.ps` != 27330 ]; then made=false echo error transmitting mics.ps -- echo length should be 27330, not `wc -c < mics.ps` else made=true fi if $made; then chmod 664 mics.ps echo -n ' '; ls -ld mics.ps fi echo Extracting cyber.ps sed 's/^X//' <<'//go.sysin dd *' >cyber.ps X#!/usr/NeWS/bin/psh X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% Cyber Space Deck X% Copyright (C) 1989. X% By Don Hopkins. (don@brillig.umd.edu) X% All rights reserved. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% This program is provided for UNRESTRICTED use provided that this X% copyright message is preserved on all copies and derivative works. X% This is provided without any warranty. No author or distributor X% accepts any responsibility whatsoever to any person or any entity X% with respect to any loss or damage caused or alleged to be caused X% directly or indirectly by this program. This includes, but is not X% limited to, any interruption of service, loss of business, loss of X% information, loss of anticipated profits, core dumps, abuses of the X% virtual memory system, or any consequential or incidental damages X% resulting from the use of this program. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% WARNING WARNING! DANGER! DANGER WILL ROBINSON! DANGER! X% This is *gross* code. I mean UUUUUGLY! (And it used to be X% even more contorted, if you can believe that.) X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% This version works with NeWS 1.1, X11/NeWS beta 2, and X11/NeWS pre-fcs X Xsystemdict /XNeWS? known not { X systemdict /XNeWS? false put X} if X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Load necessary stuff X X% I want to know the name of the directory in which to look for all the X% files I'm going to want to suck in. Here are three ways for you to tell X% me, any of which you can select and paste into a terminal emulator. X% You can put the directory name in the systemdict variable /CyberDir: X% echo "/CyberDir (`pwd`) def" | psh ; psh cyber.ps X% Or set the environmment variable CYBERDIR: X% echo "(CYBERDIR) (`pwd`) putenv" | psh ; psh cyber.ps X% Or pass it in as an argument to psh (NeWS 1.1): X% psh cyber.ps `pwd` X Xsystemdict begin X X/CyberDir where { X pop X /CyberDir CyberDir (/) append def X} { X { (CYBERDIR) getenv } errored { X pop X % Warning: X % X11/NeWS psh does not support the undocumented $1 $2 $3 feature. X ($1/) dup 0 get 36 eq { X pop X /CyberDir () def X } { X /CyberDir exch (/) append def X } ifelse X } { X /CyberDir exch (/) append def X } ifelse X} ifelse X Xend % systemdict X Xsystemdict /DontSetDefaultMenu true put X X[ X /Item (liteitem.ps) X /dbgstart (debug.ps) X /TextCanvas (textcan.ps) X /PieMenu (piemenu.ps) X /PulloutPieMenu (pullout.ps) X /OverlayWindow (overlay.ps) X /pointing-hand (pointer.ps) X /StillDict (distill.ps) X /start_visualizer (mics.ps) X] { X dup type /nametype eq { X systemdict exch known not X } { X exch { X (Loading ) print dup print (\n) print flush X pause pause pause X CyberDir 1 index append X LoadFile { X pop X } { X dup LoadFile { X pop X } { X dup (NeWS/) exch append X LoadFile { X pop X } { X (Can't find the file ") print print ("!\n) print X } ifelse X } ifelse X } ifelse X } { X pop X } ifelse X } ifelse X} forall X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Brute force debugging hacks X% Ignore this stuff. It was written when I was very frustrated. X X X(% ifdef PISSEDOFF Xsystemdict begin X /s 32 string def X false setautobind Xsystemdict /logfile known not { X /logfile (log.out) (w) file def X %/logfile ($1) (w) file def X %/logfile (/j/don/foo) (w) file def X /def { X 2 copy exch X logfile (def: ) writestring X logfile exch //s cvs writestring X logfile ( = ) writestring X logfile exch //s cvs writestring X logfile (\n) writestring X logfile flushfile X //def X } def X /store { X 2 copy exch X logfile (store: ) writestring X logfile exch //s cvs writestring X logfile ( = ) writestring X logfile exch //s cvs writestring X logfile (\n) writestring X logfile flushfile X //store X } def X /put { X 3 copy exch 3 -1 roll X logfile (put: ) writestring X logfile exch //s cvs writestring X logfile ( ) writestring X logfile exch //s cvs writestring X logfile ( = ) writestring X logfile exch //s cvs writestring X logfile (\n) writestring X logfile flushfile X //put X } def X /get { X 2 copy exch X logfile (get: ) writestring X logfile exch //s cvs writestring X logfile ( ) writestring X logfile exch //s cvs writestring X logfile ( = ) writestring X //get X logfile 1 index //s cvs writestring X logfile (\n) writestring X logfile flushfile X } def X /send { X logfile (send: ) writestring X logfile 2 index //s cvs writestring X logfile ( ) writestring X logfile 1 index /ClassName exch //send //s cvs writestring X logfile (\n) writestring X logfile flushfile X //send X } def X} if Xsystemdict /s undef Xend % systemdict X) % endif PISSEDOFF X%cvx exec Xpop X X% For use when mildly irritated: X X% XXX: Uncomment to find mismatched parens: X%/def {1 index = //def} def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% And now for something completely different X Xstatusdict begin X 0 setjobtimeout Xend X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X11/NeWS Compatibility X X% This is nasty evil vile implementation dependant hackery. X XXNeWS? { X Xsystemdict begin X X% not defined in X11/NeWS beta 2 X /PutInEventMgrInterest { % interest key value => - X 3 -1 roll dup /ClientData get % key val int CD X dup null ne { exch pop } { % key val int null X pop dup /ClientData 20 dict put X /ClientData get X } ifelse X 3 1 roll put X } def X X% not defined in X11/NeWS beta 2 X /GetFromCurrentEvent { % key => value X CurrentEvent /Interest get /ClientData get exch get X } def X X% not defined in X11/NeWS beta 2 X /removefocusinterest { X pop X } def X X% not defined in X11/NeWS beta 2 class.ps X Object /InstanceVarDict { InstanceVars } put X X% not defined in X11/NeWS beta 2 X /overlayerase {} def % beta2 X X% not defined in X11/NeWS beta 2 X /overlaydraw {} def % beta2 X X% Make it so the debugger /printf's in MessageItem context don't hose us! X MessageItem /printf undef X X% The rest of this crud is for beta 2 bugs that were fixed in pre-fcs. Xversion (1.0) eq { % beta 2 (not pre-fcs) X X% Fixes fatal debugger bug: X /executive { % - => - (Execute current file) X countdictstack 1 eq {200 dict begin} if % make sure there is a userdict X currentprocess /ErrorDetailLevel 1 put X /execfile currentfile dup null eq {pop (%stdin) (r) file} if def X X (Welcome to %NeWS Version %\n) [XNeWS?{(X11/)} {()} ifelse version] printf X { % restart loop for errors. X% Removed references to execfile (screws up debugger). X% { execfile cvx exec } stopped pop X% execfile status not { quit } if % quit if file closed X { currentprocess /Stdout get cvx exec } stopped pop X currentprocess /Stdout get status not { quit } if % quit if file closed X ExecutiveErrorHandler X } loop X } def X X% Another patch for the debugger bug just in case: X /execfile { currentprocess /Stdout get } def X X% Keep killprocess "errors" from being caught by the debugger. X% (assuming debug.ps is already loaded.) X X% DbgErrorDict /killprocess undef X X { % send to LiteMenu: X X% Beta 2 bug, litemenu.ps, class LiteMenu X /&ShowThingDict 20 dict dup begin X /fonttype {setfont dup truetype exec} def X /colortype {setcolor dup truetype exec} def X /integertype {rmoveto dup truetype exec} def X /realtype {rmoveto dup truetype exec} def X /stringtype {0 currentfont fontdescent rmoveto show} def X /nametype {iconfont setfont IconString show} def X /arraytype { X dup xcheck {/paint exch exec} {aload pop dup truetype exec} ifelse X } def X /packedarraytype /arraytype load def X /dicttype {/paint exch send} def X end def X /&ThingSizeDict 20 dict dup begin X /fonttype {setfont dup truetype exec} def X /colortype {setcolor dup truetype exec} def X /integertype {pop pop dup truetype exec} def X /realtype {pop pop dup truetype exec} def X X /stringtype {stringwidth pop currentfont fontheight} def X /nametype {iconfont setfont IconString stringbbox 4 2 roll pop pop} def X /arraytype { X dup xcheck {/size exch exec} {aload pop dup truetype exec} ifelse X } def X /packedarraytype /arraytype load def X /dicttype {/size exch send} def X end def X X% Beta 2 bug, litemenu.ps, class LiteMenu X(% This is a string so //&ThingSizeDict is scanned at the right time. X /ThingSize { % thing => width height X //&ThingSizeDict begin X gsave X dup truetype exec X grestore X end X } def X) cvx exec X X% Beta 2 bug, litemenu.ps, class LiteMenu X(% This is a string so //&ShowThingDict is scanned at the right time. X /ShowThing { % thing x y => - X //&ShowThingDict begin X gsave X moveto dup truetype exec X grestore X end X } def X) cvx exec ======== END OF cyber.shar.splitac ======== From don Thu Nov 23 01:59:11 1989 Date: Thu, 23 Nov 89 01:59:11 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitad From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitad ======== X X } LiteMenu send X X { % send to Item: X X% Beta 2 bug, liteitem.ps, class Item X /ThingSize { % thing textfont => width height X gsave X setfont X% dup type { % X11/NeWS font type = dicttype, so use 'truetype' X dup truetype { X /stringtype {stringwidth pop currentfont fontheight} X /nametype { X dup { load } stopped pop xcheck { X false exch cvx exec X } { X iconfont setfont iconstring stringbbox 4 2 roll pop pop X } ifelse X } X /nulltype {0 0} X /Default {0 0} X } case X grestore X } def X X% Beta 2 bug, liteitem.ps, class Item X /ShowThing { % thing color x y textfont => - X gsave X setfont translate setcolor X 0 0 moveto % moveto establishs current pt. X% dup type { % X11/NeWS font type = dicttype, so use 'truetype' X dup truetype { X /stringtype {0 currentfont fontdescent rmoveto show} X /nametype { X dup { load } stopped pop xcheck { X true exch cvx exec X } { X iconfont setfont iconstring show X } ifelse X } X /nulltype {pop} X /Default {pop} X } case X grestore X } def X X% Beta 2 bug, liteitem.ps, class Item X /EraseThing { % thing color x y textfont => - X gsave X% X11/NeWS: {load} stopped => ... `load` true, but {load} errored => ... true X% 4 index dup type /nametype eq exch { load } stopped pop xcheck and { X 4 index dup type /nametype eq exch { load } errored pop xcheck and { X 5 -1 roll exch ThingSize rectpath setcolor fill X } { X ShowThing X } ifelse X grestore X } def X X } Item send X X { % send to SimpleScrollbar: X X% Beta 2 bug, liteitem.ps, class SimpleScrollbar X% /ScrollDownArrow 16 16 1 { } { < % X11/NeWS: matrix arg isn't ignored! X% > } buildimage def X /ScrollDownArrow 16 16 1 [16 0 0 -16 0 16] { < X 07F8 0FF8 0818 0818 0818 0818 781F F81F X 8002 4004 2008 1010 0820 0440 0280 0100 X > } buildimage def X X% Arrgh, it's still hosing me! I'm mad now! X /PaintArrow { X gsave X translate scale setshade X .5 .1 moveto X .1 .9 lineto X .5 .6 lineto X .9 .9 lineto X closepath X fill X grestore X } def X X } SimpleScrollbar send X X} if % version 1.0 (beta 2 bugs) X Xend % systemdict X X% end of X11/NeWS compatibility crud X X} { % else if not X11/NeWS (install NeWS 1.1 compatibility stuff) X systemdict begin X X /truetype { type } ?def X /RootUserDict 10 dict def X X end % systemdict X} ifelse X X% End of compatibility crud. You can empty your barf bag now. X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Icky system globals and merciless kludges X Xsystemdict begin X X/array? { % obj => bool X type dup /arraytype eq exch /packedarraytype eq or X} def X X/comment { pop } def X X% Reap dead debuggers X/rd { X systemdict /DbgDicts known { X [ DbgDicts {pop} forall ] { X dup /State get /zombie eq { X dup killprocess X DbgDicts exch undef X } { pop } ifelse X } forall X } if X} def X Xrd X X/_ViewCanvas null def X X/_SendUpdateStack { X count array astore aload X null /UpdateStack _SendViewEvent X% { flush } errored { X% { dbgstop } errored quit X% } if X} def X X/_SendViewEvent { % ClientData Action Name => - X createevent begin X /Name exch def X /Action exch def X /ClientData exch def X /Canvas X currentprocess /Interests get 0 get % event X /ClientData get /ViewCanvas get % can X def X currentdict end sendevent X} def X X/_ReadyProcess { X { X currentprocess X XNeWS? { X dup /ProcessName (Spike) put X } if X createevent begin X /Canvas _ViewCanvas def X /Name /ProcessReady def X /Action currentprocess def X count array astore aload X /ClientData exch def X currentdict end sendevent X createevent begin X /Name 20 dict def X Name begin X /ExecIt { X /ClientData get X exec X _SendUpdateStack X } def X /ReplaceStack { X dup /Action get dup type /stringtype ne { pop } { X { print flush } errored { X { dbgstop } errored X clear currentprocess killprocessgroup X } if X } ifelse X /ClientData get X count 1 roll X count 1 sub {pop} repeat X aload pop X } def X /DropDead { X { dbgstop } errored X { (Ayyyeee!\n) print flush } errored X clear currentprocess killprocessgroup X } def X end % Name X /ClientData 20 dict def X ClientData begin X /ViewCanvas _ViewCanvas def % Stash! X end % ClientData X currentdict end expressinterest X X% The /execfile kludge is to get around the fact that /execfile is a X% function defined in systemdict in X11/NeWS pre fcs, instead of being X% a file defined in userdict by executive, as in earlier versions. X% The problem is that "dbgstart" checks for /execfile in userdict to X% tell if an executive has already been started, and if it's not (or X% even if it is, in our case), it starts one. (and executive doesn't X% return, so we've lost control!) (Supposedly a call to "executive" X% occurs right before "_ReadyProcess" on the input stream.) So until X% such a time as "dbgstart" knows how to tell an executive has already X% been started, we must fool it... X /execfile dup load def X X dbgstart X X 256 { X rd % reap dead rebuggers X dstack { eventloop } stopped { X (\nI'm confused...\n) print X pause pause X ExecutiveErrorHandler X pause pause X } if X (\nTry again...\n) print X pause pause X } repeat X (\nGame over, man!\n) print X } fork X createevent begin X /Name /ExecIt def X /Process exch def X currentdict X end X { currentfile dup null eq { clear exit } if X token { X 1 index createevent copy % ev1 ob ev2 X dup /ClientData 4 -1 roll % ev1 ev2 /CD obj X [ exch ] cvx X put % ev1 ev2 X sendevent X } { X clear exit X } ifelse X } loop X} def X X/eventloop { X { awaitevent } loop X} def X X/dstack { X currentprocess /DictionaryStack get X dup length (dstack[%]: ) printf X { X smart-name print ( ) print X } forall X (\n) print X} def X X/enter-eventloop { X dstack eventloop X} def X X% This does not exit when you type "exit"...(invalidexit error) X/enter-executive { X { dstack executive exit } loop X} def X X/enter { X currentprocess /Interests get length 0 eq X /enter-executive /enter-eventloop ifelse X exch send X dstack X} def X X% Debugger Aliases X/dbe {dbgbreakenter} def X/dbx {dbgbreakexit} def X/dc {dbgcontinue} def X/dcb {dbgcontinuebreak} def X/dcc {dbgcopystack dbgcontinue} def X/dcs {dbgcopystack} def X/de {dbgenter} def X/deb {dbgenterbreak} def X/dgb {dbggetbreak} def X/dk {dbgkill} def X/dkb {dbgkillbreak} def X/dlb {dbglistbreaks} def X/dmp {dbgmodifyproc} def X/dp {dbgpatch} def X/dpe {dbgprintfenter} def X/dpx {dbgprintfexit} def X/dw {dbgwhere} def X/dwb {dbgwherebreak} def X/dx {dbgexit} def X X% Useful aliases X/fb {framebuffer} def X/ls {[currentdict {pop} forall] ==} def X XXNeWS? not { % XXX? X /revokekbdinterests { % [ int1 int2 ... intn ] can => - X removefocusinterest X % aload pop revokeinterest revokeinterest revokeinterest X {{revokeinterest} errored {pop} if} forall X } store X} if X X{ X /getmenuaction { % index => action X dup null ne { X MenuActions 1 index MenuActions length 1 sub min get X % Execute actions that are names! (This is so we can have the executable X % name of a submenu, or a functions to compute the menu action!) X dup type /nametype eq { exec } if X } {nullproc} ifelse X exch pop X } def X} LiteMenu send X XXNeWS? { X % ick! X /Primary dup framebuffer /new ClassSelection send X exch setselection X} if X Xsystemdict /old-setselection known not { X /old-setselection /setselection load def X /setselection { % dict rank X 2 copy old-setselection X createevent begin X /Name /SelectionChanged def X /Action exch def X /ClientData exch def X currentdict end sendevent X } def X} if X X/select-object { % obj => - X 20 dict begin X /SelectionType /object def X /ContentsPostScript 1 index def X /ContentsAscii exch (%) sprintf def X /SelectionObjSize 1 def X /SelectionResponder null def X /Canvas currentcanvas def % XXX? X /SelectionHolder currentprocess def % XXX? X currentdict X end X /PrimarySelection setselection X} def X X/select-pointer { % obj index => - X 20 dict begin X /SelectionType /pointer def X /SelectionStartIndex exch def X /ContentsPostScript exch def X /ContentsAscii X /ContentsPostScript load X /SelectionStartIndex load get X (%) sprintf X def X /SelectionObjSize 1 def X /SelectionResponder null def X /Canvas currentcanvas def % XXX? X /SelectionHolder currentprocess def % XXX? X currentdict X end X /PrimarySelection setselection X} def X X/select-interval { % obj start len => - X 20 dict begin X /SelectionType /interval def X /SelectionObjSize exch def X /SelectionStartIndex exch def X /SelectionLastIndex X SelectionStartIndex SelectionObjSize add 1 sub X def X /ContentsPostScript exch def X /ContentsAscii X /ContentsPostScript load X SelectionStartIndex SelectionObjSize getinterval X (%) sprintf X def X /SelectionResponder null def X /Canvas currentcanvas def % XXX? X /SelectionHolder currentprocess def % XXX? X currentdict X end X /PrimarySelection setselection X} def X X/dissect-selection { % seldict => obj X dup selection-type { X /empty { X pop null % null X } X /unknown { X % seldict X } X /text { X /ContentsAscii get % string X } X /object { X /ContentsPostScript get % obj X } X /pointer { X dup /ContentsPostScript get % seldict container X exch /SelectionStartIndex get % container index X 1 index type /dicttype eq { X 2 copy known X } true ifelse { X get % obj X } { X pop pop null % null X } ifelse X } X /interval { X dup /ContentsPostScript get % seldict container X exch dup /SelectionStartIndex get % container seldict start X exch /SelectionLastIndex get % container start last X 1 index sub 1 add % container start len X getinterval % obj X } X /Default { X % seldict X } X } case X} def X X/selection-type { % seldict => name X dup null ne { X dup /SelectionType known { X dup /SelectionType get dup null ne exch /UnknownRequest ne and X } false ifelse { X /SelectionType get X } { X dup /ContentsAscii known { X pop /text X } { X pop /unknown X } ifelse X } ifelse X } { X pop /empty X } ifelse X} def X X/interesting-keys [ X /SelectionType X /ContentsAscii /ContentsPostScript X /SelectionStartIndex /SelectionLastIndex X] def X XXNeWS? { X /request-selection { % rank => seldict X 10 dict begin X interesting-keys { null def } forall X currentdict X end X exch selectionrequest X } def X} { X /request-selection { % rank => seldict X dup getselection dup null ne { X exch pop X } { X pop X 10 dict begin X interesting-keys { null def } forall X currentdict X end X exch selectionrequest X } ifelse X } def X} ifelse X/selected-object { % - => obj X /PrimarySelection request-selection X dissect-selection X} def X X/selected-pointer? { % - => false / collection index true X /PrimarySelection request-selection X dup selection-type /pointer eq { X dup /ContentsPostScript get exch /SelectionStartIndex get X true X 2 index type /dicttype eq { X 3 copy pop known not { % invalid pointer X pop pop pop false X } if X } if X } { X pop false X } ifelse X} def X X/selected-interval? { % - => false / collection start last true X /PrimarySelection request-selection X dup selection-type /interval eq { X dup /ContentsPostScript get X exch dup /SelectionStartIndex get X exch /SelectionLastIndex get true X } { X pop false X } ifelse X} def X X/selected-pointer-or-interval? { % - => false / collection first last true X /PrimarySelection request-selection dup selection-type { X /interval { X dup /ContentsPostScript get exch X dup /SelectionStartIndex get exch X /SelectionLastIndex get X true X } X /pointer { X dup /ContentsPostScript get exch X /SelectionStartIndex get dup X true X 2 index type /dicttype eq { X 3 copy pop known not { % invalid pointer X pop pop pop false X } if X } if X } X /Default { X pop false X } X } case X} def X X% NeWS-print 0.996 X% Written by Josh Siegel X% Munged by Don Hopkins X X/Externals 512 dict def X/ExternalsBack 512 dict def XExternals /Count 0 put X X/string-magic X dictbegin X (\b) 0 get (\\b) def X (\f) 0 get (\\f) def X (\n) 0 get (\\n) def X (\r) 0 get (\\r) def X (\t) 0 get (\\t) def X (\() 0 get (\\\() def X (\)) 0 get (\\\)) def X (\\) 0 get (\\\\) def X dictend Xdef X X/fixstring { X 10 dict X begin X /len 0 def X /out 1 index length 3 mul string def X { X dup string-magic exch known { X string-magic exch get X } { X cvis X } ifelse X out len 2 index putinterval X /len exch length len add def X } forall X out 0 len getinterval dup length string copy X end X} def X X/stringer { % proc => string X dup type cvlit X { X /arraytype { X pause X /arraylvl arraylvl 1 add store X dup xcheck { X /the_string the_string ( {\n) append store X { X stringer X } forall X /the_string the_string ( }\n) append store X } { X /the_string the_string ( [\n) append store X { X stringer X } forall X /the_string the_string ( ]\n) append store X } ifelse X /arraylvl arraylvl 1 sub store X } X /nametype { X dup xcheck { X the_string X arraylvl 0 eq (% /% cvx ) (% %) ifelse X sprintf X /the_string exch store X } { X the_string (% /%) sprintf X /the_string exch store X } ifelse X } X /operatortype { X 255 string cvs dup length 2 sub 1 exch getinterval X the_string X arraylvl 0 eq (% /% cvx ) (% %) ifelse X sprintf X /the_string exch store X } X /stringtype { X fixstring X the_string (% \(%\)) sprintf X /the_string exch store X } X /marktype { X (mark ) % [ DANGER! ] X } X /booleantype /integertype /realtype /nulltype { X the_string (% %) sprintf X /the_string exch store X } X /Default { X dup type /dicttype ne dictlvl 0 ne or arraylvl 0 ne or { X ExternalsBack 1 index known { X ExternalsBack exch get % name X } { X Externals begin Count /Count Count 1 add def end % obj count X 1 index type (&%_%) sprintf % obj name X Externals 1 index 3 index put % obj name X ExternalsBack 3 -1 roll 2 index put % name X } ifelse X the_string ( //) append exch append /the_string exch store X } { X /dictlvl dictlvl 1 add store X /the_string the_string ( dictbegin\n) append store X { pause X /the_string the_string (\t) append store X exch stringer stringer X /the_string the_string ( def\n) append store X } forall X /the_string the_string ( dictend \n) append store X /dictlvl dictlvl 1 sub store X } ifelse X } def X } case X} def X X/tokeout { % obj => string X 10 dict X begin X /cnt Externals /Count get def X /dictlvl 0 def X /arraylvl 0 def X /the_string () def X stringer the_string X cnt Externals /Count get ne { X (Externals begin\n%\nend\n) sprintf X } def X end X} def X X% Short readable names X X /ShortNameDict 40 dict def X X ShortNameDict begin X /nametype { X dup xcheck (%) (/%) ifelse X sprintf X } def X /dicttype { X dup maxlength exch length (<%/%>) X sprintf X } def X /arraytype { X dup length exch xcheck ({%}) ([%]) ifelse X sprintf X } def X /packedarraytype /arraytype load def X /stringtype { X dup length 80 gt { 0 80 getinterval ((%)...) } ((%)) ifelse X sprintf X } def X /marktype { X pop (mark) X } def X /eventtype { X dup /Name get short-name X exch /IsInterest get X (interest(%)) (event(%)) ifelse X sprintf X } def X /canvastype { X gsave X dup setcanvas X clippath pathbbox points2rect 4 2 roll pop pop exch % h w X framebuffer setcanvas X 3 -1 roll X dup /Parent get null eq { X pop (can(%,%)) sprintf X } { X getcanvaslocation exch X (can(%,%,%,%)) sprintf X } ifelse X grestore X } def XXNeWS? { X /processtype { X dup /Execee get exch X dup /State get exch X dup /ProcessName known { /ProcessName get } (anonymous) ifelse X (proc('%',%,%)) sprintf X } def X} { % not XNeWS? X /processtype { X% One or more of these is causing a core dump some of the time... (NeWS 1.1) X% dup /Interests get length exch X% dup /ExecutionStack get length exch % CORE DUMP X% dup /DictionaryStack get length exch X% dup /OperandStack get length exch X% dup /Execee get exch X% /State get X% (proc(%,%,o%,d%,e%,i%)) sprintf X dup /Execee get exch X /State get X (proc(%,%)) sprintf X } def X} ifelse % XNeWS? X end % ShortNameDict X X /short-name { X dup type ShortNameDict 1 index known { X ShortNameDict exch get exec X } { X pop 80 string cvs X } ifelse X } def X X /smart-name { X dup smart-type ( ) append exch short-name append X } def X X /SmartTypeDict 40 dict def X X SmartTypeDict begin X X /dicttype { X dup systemdict eq { X pop (systemdict) X } { X % TODO: Detect the process's userdict ... X magic-type X } ifelse X } def X X /canvastype { X% dup framebuffer eq { X% pop (framebuffer) X% } { X% magic-type X% } ifelse X magic-type X } def X X /eventtype { X magic-type X } def X X /processtype { X magic-type X } def X X /fonttype { X magic-type X } def X X /integertype { X dup floor sub 0 eq X (integer) (real) ifelse X } def X X end % SmartTypeDict X X /smart-type { % obj => str X dup truetype % obj type X SmartTypeDict 1 index known { X SmartTypeDict exch get exec % str X } { % obj type X pop short-type % str X } ifelse X } def X X /magic-type { X dup /ParentDictArray known X { dup /ParentDictArray get type /nametype ne } % Detect bogus classes! X false ifelse { X dup /ClassName known { % class X /ClassName get 64 string cvs X } { % instance X % ugly ugly! X /ClassName exch send X 64 string cvs (.) exch append X } ifelse X } { X short-type X } ifelse X } def X X /short-type { % obj => str X truetype 20 string cvs X 0 1 index length 4 sub getinterval X } def X Xsystemdict /quicksort known not { X X% X% quicksort by Don Woods at Sun Microsystems, Inc. X% X/quicksort { % array proc => array (sorted, reuses same storage) X10 dict begin X /Bigger? exch cvx def % a b bigger? => t if a -- sorts array in place, using Bigger? for comparisons X dup length dup 2 gt { % A N X % the next lines (until but not incl /Key...) subsort three elements X % so we can use the median as the partitioning element; this improves X % performance for the case where the array is initially nearly sorted, X % but is not strictly necessary for the algorithm to work (it does X % seem to improve average runtime by about 10%) X 2 copy 1 sub 2 copy 2 idiv 1 index 0 % A N A N-1 A (N-1)/2 A 0 X 6 copy get 5 1 roll get 3 1 roll get % above & A[N-1] A[(N-1)/2] A[0] X 2 copy Bigger? {exch} if % subsort for three elements X 3 1 roll 2 copy Bigger? {exch} if % ... (call them min mid max) X 3 -1 roll 2 copy Bigger? {exch} if % ... subsort finished X 9 index % A N A N-1 A (N-1)/2 A 0 min mid max N X 3 eq { X 5 2 roll put 4 1 roll put put % store min/mid/max back X pop pop % pop A & N X } { % else store mid at 0, max at N-1, min at (N-1)/2, then partition X 3 -1 roll 5 2 roll put exch 4 1 roll put put % A N X /Key 2 index 0 get def % partitioning value X 0 % A N 0, also known as A j i X { % main partitioning loop X % incr i until i=j or A[i]>=A[0]; note A[j] is rangecheck X { 1 add 2 copy gt { % i++; A j i j>i? X dup 3 index exch get % A j i A[i] X Key exch Bigger? not {exit} if X } {exit} ifelse X } loop X % decr j until A[j]<=A[0]; happens at j=i-1 if not sooner X exch { % A i j X 1 sub dup 3 index exch get % A i j A[j] X Key Bigger? not {exit} if X } loop X 2 copy gt {exit} if % if i>=j, finished partition X % swap A[j] & A[i]; stack has: A i j X 2 index 4 copy exch get % A i j A A i A[j] X 4 1 roll get % A i j A[j] A A[i] X 3 index exch put % A i j A[j] X 4 copy exch pop put pop exch % A j i X } loop X % finish partition by exchanging A[j] with A[0]; stack has: A i j X exch pop 2 copy 4 copy get % A j A j A j A[j] X exch pop 0 exch put Key put % A j X % now recur on A[0..j-1] and A[j+1..N-1] X 2 copy 1 add 1 index length 1 index sub % A j A j+1 N-1 X getinterval 3 1 roll 0 exch getinterval % A[j+1..N-1] A[0..j-1] X 2 copy length exch length gt {exch} if % put smaller on top X quickrecur quickrecur % tail recursion avoids deep stack X } ifelse % =3 or >3 elements X } { % handle 1- and 2-element cases specially for efficiency X 2 eq { X dup aload pop Bigger? {aload 3 1 roll exch 3 -1 roll astore} if X } if X pop % pop the array X } ifelse X} def % quickrecur X X% end of quicksort X X} if % quicksort not known X X% This function in systemdict makes sure ClassName is always in a X% dictionary on the dict stack. Objects all have their own class X% name. This function provides names for /systemdict and /userdict. X% It returns the dictionary itself for other dictionaries. X% X% The use of this is a little bad and hacky because /ClassName is used X% as a method for any object (including classes themselves), even though X% it is not an advertised method in class Object. X% X/ClassName { % - => name | dict X currentdict X dup userdict eq {pop /userdict} if X dup systemdict eq {pop /systemdict} if X} ?def X Xend % systemdict X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Userdict Utilities X X/shift-names 10 dict def Xshift-names begin X /Meta false def X /Shift false def X /Control false def Xend % shift-names X X/update-shifts { X shift-names {store} forall X /KeyState get { X shift-names 1 index known { true store } { pop } ifelse X } forall X} def X X/key-names 40 dict def Xkey-names begin X 8 (Backspace) def X 9 (Tab) def X 10 (Newline) def X 13 (Return) def X 27 (Escape) def X 32 (Space) def X 127 (Delete) def Xend % key-names X X/key-name { % key => string X dup type /integertype eq { X dup 127 and X key-names 1 index known { X key-names exch get X } { X dup 32 lt { X 64 add cvis (^%) sprintf X } { X cvis X } ifelse X } ifelse X exch 128 ge { X (Meta-%) sprintf X } if X } { X (%) sprintf X } ifelse X} def X X/comment-string { % obj => string X dup array? { X dup length 2 ge { X dup 1 get /comment eq { X 0 get X } if X } if X } if X (%) sprintf X} def X X/destroy { % dummy destroy method for items X} def X X% Forward messages on to stack X/prompt { X {} execute-it X} def X X/execute-it { X /execute-it dialog-item send X} def X X/exec-it { X /exec-it dialog-item send X} def X X/push-it { X /push-it dialog-item send X} def X X/kbd-select-object { X gsave X can setcanvas X select-object X grestore X} def X X/kbd-select-pointer { X gsave X can setcanvas X select-pointer X grestore X} def X X/kbd-select-interval { X gsave X can setcanvas X select-interval X grestore X} def X X% This is here because the scanner doesn't believe that \r's end comments! X/remove-returns { % str => str' X dup (\r) search not { pop } { % str rest \r pre X length 1 add exch pop % str rest len X 3 -1 roll dup length string copy % rest len str' X 3 1 roll { % str' rest len X 2 index 1 index 1 sub 10 put X exch (\r) search { % str' len rest \r pre X length 1 add exch pop % str' len rest len X 3 -1 roll add % str' rest len X } { % str' len rest X pop pop exit X } ifelse X } loop X } ifelse X} def X X% Quantize the font size to a multiple of .5 so we don't blow up the X% font cache. (This is mainly for X11/NeWS.) X/scalefontquant { % font size => font X 2 mul round 2 div scalefont X} def X X% Stolen from: X% stickem version 1.0 X% Written by Josh Siegel (Wed Jun 29 1988) X XXNeWS? { X X /find_canvas { % x y => [canvases] X canvasesunderpoint X } def X X} { % NeWS 1.1 X X % getxyloc returns the position of the next left-button X % mouse up event. It passes all other events. X X /getxyloc { % => x y X gsave % ??? X framebuffer setcanvas % ??? X 10 dict X begin X createevent X dup /Priority 20 put X dup /Name /LeftMouseButton put X dup /Action /UpTransition put X /foobar exch def X foobar expressinterest X { X awaitevent X dup /Name get /LeftMouseButton eq { X exit X } if X redistributeevent X } loop X foobar revokeinterest X dup /XLocation get X exch /YLocation get X end X grestore % ??? X } def X X % find_tree traverses the canvas tree passed to it and calls X % check_canvas to check to see if the point is in the X % canvas. It is also a example of a recursive NeWS routine. X X /find_tree { % canvas => found? X dup null eq { X pop false X } { X dup /Mapped get { X dup check_canvas { X dup [ exch ] answer exch append /answer exch def X /TopChild get X { dup null eq { X pop true exit X } if X dup find_tree { pop true exit } if X /CanvasBelow get X } loop X } { X pop false X } ifelse X } { X pop false X } ifelse X } ifelse X } def X X % Check canvas checks to see if the point is inside of the X % clipping path of the canvas. This is VERY important for things X % like the clock where the clipping path is round. X % X X /check_canvas { % canvas => boolean X framebuffer setcanvas % ??? X dup getcanvaslocation % can xwin ywin X ypnt exch sub % can xwin ypnt-ywin X exch xpnt exch sub exch % can xpnt-xwin ypnt-ywin X 3 -1 roll setcanvas clipcanvaspath pointinpath % boolean X framebuffer setcanvas X } def X X % find_canvas is a convient front end to the whole system. X % I use a local dictionary to help in garbage collected in case X % this routine is later used as part of a larger piece of code. X X /find_canvas { % x y => [canvas] X gsave % ??? X framebuffer setcanvas % ??? X 10 dict X begin X /answer [ ] def X /ypnt exch def X /xpnt exch def X framebuffer find_tree X answer X end X grestore % ??? X } def X X} ifelse X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% CyberMenu class definition X X/CyberMenu X systemdict /SoftMenu known { SoftMenu } { PieMenu } ifelse Xdef X X/PulloutCyberMenu X PulloutPieMenu Xdef X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% NeWSScrollBar item definition X Xsystemdict begin % this is for textcan.ps X X/NeWSScrollbar SimpleScrollbar [] Xclassbegin X /setbgcolor { % color - => - X /BoxFillColor exch def X /ButtonFillColor BoxFillColor def X } def Xclassend def X Xend % systemdict X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% StructItem class definition X X% This huge blob implements the data doo-dads. X% It just kept getting bigger and bigger, before I realized what X% was happening. This class should be factored out into several X% classes... (I'll probably just reimplement it in NDE from X% scratch.) X X/StructItem LabeledItem Xdictbegin X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Instance variables X X /Shrink .9 def X /Pad 3 def X /Point null def X /x 0 def X /y 0 def X /Levels 0 def X /DL null def X /ItemFrame 2 def X /ItemRadius 5 def X /ItemBorder 6 def X /ItemButton [PointButton AdjustButton MenuButton] def X /StackI null def X /LayoutLock null def X /LastX 0 def X /LastY 0 def X /LastTime 0 def X /Clicks 1 def X /TrackProc null def X /DX 0 def /DY 0 def X /TabX 0 def X /TabY 0 def X /TabWidth 0 def X /TabHeight 0 def X /PinX 0 def X /StartIndex 0 def X /LastIndex 0 def X /OldIndex 0 def X /MySiblings null def X /layout-proc /layout-struct def X /click-proc /click-transfer def X /transfer-proc /paste-obj def X /display-proc /display-tree-struct def X /erase-proc /erase-label def X /label-proc /object-label def X /lw null def X /lh null def X /lx null def X /ly null def X /BigWidth 64 def X /BigHeight 64 def X /Filter? false def X /OpenToRight? false def X /ShowFan? true def Xdictend Xclassbegin X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Class variables X X /StartPoint 18 def X /DoubleClickTime 2 60 div def X /DoubleClickDistanceSquared 8 dup mul def X /CanvasYFudge 2 store X /Sort? true def X /SubStructureIndent 10 def X /LineGap 30 def X /Icon? false def X /SortBy /by-name def X /ItemLabelFont /Helvetica-Bold findfont 14 scalefontquant def XXNeWS? { % How about something sexy... X% /ItemFont /AvantGarde-Book findfont def % Normal font X% /ItemXFont /AvantGarde-BookOblique findfont def % Executable font X% /ItemSFont /AvantGarde-Book findfont def % Small font X% /ItemFont /GillSans findfont def % Normal font X% /ItemXFont /GillSans-Italic findfont def % Executable font X% /ItemSFont /GillSans findfont def % Small font X /ItemFont /LucidaSans findfont def % Normal font X /ItemXFont /LucidaSans-Italic findfont def % Executable font X /ItemSFont /LucidaSans findfont def % Small font X /SmallPointSize 7 def % Use small font when smaller than this. X} { % NeWS 1.1 X /ItemFont /Courier-Bold findfont def % Normal font X /ItemXFont /Courier-BoldOblique findfont def % Executable font X /ItemSFont /Courier findfont def % Small font X /SmallPointSize 10 def % Use small font when smaller than this. X} ifelse X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Initialization stuff X X /new { % Collection Index notifyproc parentcanvas => instance X 4 2 roll 2 copy get type (% \267) sprintf % notify parent cont ind label X 5 1 roll 2 array astore % label notify parent object X 3 1 roll /Right % label object notify parent loc X 3 1 roll % label object loc notify parent X /new super send begin X ItemCanvas /Transparent false put X% ItemCanvas /Transparent true put X ItemCanvas /Retained true put X /LayoutLock createmonitor def X /xhair /xhair_m ItemCanvas setstandardcursor X currentdict end X } def X X /ensure-DL { X DL null eq { X Collection Index Levels grow-struct X /DL exch store X /ObjectWidth 0 store X } if X ObjectWidth 0 eq ObjectHeight 0 eq or { X perform-layout X } if X } def X X /makestartinterests { X /makestartinterests super send X [ exch aload pop X /DoTransfer {/DoTransfer /Self GetFromCurrentEvent send} X null ItemCanvas eventmgrinterest X dup /Exclusivity true put X dup /Self self PutInEventMgrInterest X ] X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Event handlers X X /DoTransfer { % event => - X ItemBegin X /it self store X CurrentEvent update-shifts X do-search X ob null eq { X % pththth X } { X % Are we transfering something to where it already is? X CurrentEvent /ClientData get ob eq { X % Transfering an object into itsself toggles its opened/closed state X click-open X } { X % Beam me up, Scotty! X ob begin /transfer-proc load end X cvx { exec } fork pop pop X } ifelse X } ifelse X ItemEnd X pop % XXX? X } def X X /ClientDown { X ItemBegin X /it self store X currenttime LastTime sub DoubleClickTime lt X CurrentEvent begin X LastX XLocation sub dup mul LastY YLocation sub dup mul add X /LastX XLocation store /LastY YLocation store X end X DoubleClickDistanceSquared lt X and { X /Clicks Clicks 1 add store X } { X /Clicks 1 store X } ifelse X /LastTime currenttime store X CurrentEvent update-shifts X CurrentEvent /Name get MenuButton eq { X event-in-tab? { X show-tab-menu X } { X show-struct-menu X } ifelse X } { X CurrentEvent /Name get PointButton eq { X% CurrentEvent recallevent X event-in-tab? { X items FillColor self slideitem X } { X do-search X ob null eq { X items FillColor self slideitem X } { X Clicks 1 eq { X make-selection X } { X TrackProc null ne { TrackProc killprocess } if X click-exec X } ifelse X } ifelse X } ifelse X } { X CurrentEvent /Name get AdjustButton eq { X event-in-tab? { X toggle-icon X } { X do-search X ob null eq { X } { X NotifyUser X } ifelse X } ifelse X } if X } ifelse X } ifelse X ItemEnd X } def X X /make-selection { X TrackProc null ne { TrackProc killprocess } if X 2 60 div blockinputqueue X /TrackProc { X unblockinputqueue X /OldIndex null store X obs length 1 le { X /MySiblings [ob] store X /TipX null def /TipY null def X /Multiple? false def X } { X obs dup length 2 sub get X /MySiblings X 1 index /Branches get dup null eq { pop nullarray } if X 2 index /Controls get dup null eq { pop } { append } ifelse X store X /Pointers? false def X /TipX 1 index /TipX get def X /TipY exch /TipY get def X /Multiple? X ob /C get array-or-string? X Shift and X def X } ifelse X /StartIndex X 0 MySiblings { X /I get ob /I get eq { exit } if X 1 add X } forall X store X /LastIndex StartIndex store X ItemCanvas createoverlay setcanvas X ObjectX ObjectY ObjectHeight add translate X currentcursorlocation X { newpath pop pop X /LastIndex X 0 MySiblings { X /Y get y le { X exit X } if X 1 add X } forall X MySiblings length 1 sub min X store X Multiple? not { X /StartIndex LastIndex store X } if X TipX null ne { X% TipX TipY moveto X TipX 1 add TipY moveto X MySiblings StartIndex LastIndex min get begin X% X Y H add lineto X X Y H add 1 sub lineto X end X MySiblings StartIndex LastIndex max get begin X% X Y lineto X X Y 1 add lineto X end X closepath X fill X } if X MySiblings StartIndex LastIndex min get begin X X 1 sub Y H add moveto X end X StartIndex LastIndex min 1 StartIndex LastIndex max { X MySiblings exch get begin X X W add dup Y H add lineto X Y lineto X end X } for X MySiblings StartIndex LastIndex max get begin X X 1 sub Y lineto X end X closepath X Shift { stroke } { fill } ifelse X X OldIndex LastIndex ne { X /OldIndex LastIndex store X Multiple? { X % Don't select part of control panel X MySiblings StartIndex get /C get X MySiblings LastIndex get /C get eq { X MySiblings StartIndex get /C get X StartIndex LastIndex 2 copy gt {exch} if X MySiblings exch get /I get exch X MySiblings exch get /I get exch X 1 index sub 1 add X kbd-select-interval X } if X } { X MySiblings LastIndex get X Shift { % Shift to select array index X /I get kbd-select-object X } { X dup /C get exch /I get kbd-select-pointer X } ifelse X } ifelse X } if X X } getanimated waitprocess X /MySiblings null store X /TrackProc null store X } fork store X } def X X /show-tab-menu { X userdict /it self put X CurrentEvent /showat TabMenu send X } def X X /show-struct-menu { X ItemBegin X do-search X ob null eq { /ob DL store } if X ob null ne { X CurrentEvent /showat StructMenu send X } if X ItemEnd X } def X X /ClientUp { X StopItem X } def X X /click-exec { X Shift { click-step } { X ob /Obj get exec-it X } ifelse X } def X X /click-transfer { X 2 60 div blockinputqueue X { X unblockinputqueue X % (Aaah, that feels much better -- thanks Stan!) X gsave 10 dict begin X Shift { % Shift to select the index X ob /I get X } { X ob /Obj get X } ifelse X /thing exch def X /thing load kbd-select-object X /str /thing load smart-name def X ItemLabelFont setfont X fboverlay setcanvas X currentcursorlocation X { lineto str show } getanimated waitprocess aload pop % x y X createevent begin X /Name /DoTransfer def X /YLocation exch def /XLocation exch def X /Action 1 dict def X Action begin X /Source /thing load def X end X % We're sneaking this in so DoTransfer can tell if we're transfering X % something to where it already is, in which case we just do a X % click-open, to open or close the object's internal structure. X /ClientData ob def X currentdict sendevent X end X grestore X } fork pop X } def X X /click-magic { X % Invoke magic editing function... X obs length 1 gt { X { ob /C get dup array-or-string? { pop currentdict } if X begin X ob /Obj get X use-parent-obj X cvx exec X end X } fork pop pause X } if X } def X X /click-edit { X % Invoke magic editing function... X obs length 1 gt { X { ob /C get dup array-or-string? { pop currentdict } if X begin X ob /Obj get cvx change-parent-obj X end X } fork pop pause X } if X } def X X /click-push { X push-obj X } def X X /old-click-step { X [ ob /Obj get ] cvx exec-it X } def X X /click-step { X gsave X ItemCanvas createoverlay setcanvas X ObjectX ObjectY ObjectHeight add translate X ob dup begin X X Y W H rectpath X end X [ exch /Obj get X /gsave load % Whip me beat me make me check bad writes! X currentstate /setstate load /erasepage load X /grestore load X ] cvx fill exec-it X X obs length 1 le { X /MySiblings [ob] store X }{ X obs dup length 2 sub get X /MySiblings X 1 index /Branches get dup null eq { pop nullarray } if X store X } ifelse X /StartIndex X 0 MySiblings { X /I get ob /I get eq { exit } if X 1 add X } forall X store X /LastIndex StartIndex store X currentcursorlocation X { newpath pop pop X /LastIndex X 0 MySiblings { X /Y get y le { X exit X } if X 1 add X } forall X MySiblings length 1 sub min X store X { StartIndex LastIndex ge { exit } if X /StartIndex StartIndex 1 add store X X MySiblings StartIndex get dup begin X newpath X Y W H rectpath X end X [ exch /Obj get X /gsave load % Whip me beat me make me check bad writes! X currentstate /setstate load /erasepage load X /grestore load X ] cvx fill exec-it X } loop X } getanimated waitprocess X /MySiblings null store X grestore X } def X X /click-type-dict 100 dict def X click-type-dict begin X /integertype { X Shift 1 -1 ifelse add X } def X /realtype { X Shift -1 1 ifelse add X } def X /booleantype { X not X } def X end % click-type-dict X X /click-type { X ob /Obj get dup type X click-type-dict 1 index known { X click-type-dict exch get X cvx exec X replace-obj X } { X pop pop %%% /click-proc load cvx exec X } ifelse X } def X X /click-dragcanvas { X { ob /C get ob /I get get X dup /Parent get null eq { pop } { X gsave X setcanvas false dragcanvas X grestore X obs { begin } forall X ItemTextColor setcolor X ObjectX ObjectY ObjectHeight add translate X currentdict end draw-struct X obs length 1 sub { end } repeat X } ifelse X } fork pop X } def X X /click-dragimage { X { ob /C get ob /I get get % % can X gsave X dup createoverlay setcanvas X ob /C get % EditorDict X begin % EditorDict X currentcursorlocation X { 2 copy X y0 sub ViewY exch sub /ViewY exch store X x0 sub ViewX exch sub /ViewX exch store X /y0 exch store /x0 x store X ViewX ViewY ViewWidth ViewHeight rectpath X } getanimated waitprocess pop X end % EditorDict X obs { begin } forall X ItemCanvas setcanvas X ItemTextColor setcolor X ObjectX ObjectY ObjectHeight add translate X currentdict end draw-struct X obs length 1 sub { end } repeat X grestore X } fork pop X } def X X /handle-click { % - => - X ob null ne { X% obs /begin load forall X ob begin X /click-proc load X end % ob X% obs length /end load repeat X cvx exec X } if X% pop % ??? the notifyproc should not pop the event X } def X X /open-icon { X Icon? { X /ObjectWidth OW store X /ObjectHeight OH store X currentdict /Icon? undef X redo-shape X } if X } def X X /close-icon { X Icon? not { X gsave X /OW ObjectWidth def X /OH ObjectHeight def X Font setfont Str stringbbox points2rect X /IconH exch def /IconW exch def X pop pop X /ObjectWidth IconW store X /ObjectHeight IconH store X grestore X /Icon? true def X redo-shape X } if X } def X X /toggle-icon { X DL begin X Icon? { open-icon } { close-icon } ifelse X end X /LastTime 0 store X } def X X /click-select { X Clicks 1 eq { X % first click X ob null ne { X Shift { % Shift to select the index X ob /I get X } { X ob /Obj get X } ifelse X Control { X exec-it X /LastTime 0 store X } { X kbd-select-object X } ifelse X } if X } { X click-open X } ifelse X } def X X /click-open { X ob null ne { X DL begin Icon? end { X toggle-icon X } { X Shift { X ob /L get 1 add open-struct X } { X ob /L get 0 eq { X 1 open-struct X } { X close-struct X } ifelse X } ifelse X } ifelse X } if X } def X X /event-in-tab? { X ItemBegin X newpath label-bbox rectpath X CurrentEvent begin XLocation YLocation end pointinpath X ItemEnd X } def X X /ClientExit { X StopItem X } def X X /Silent? { % - => bool X Meta Control Shift or and X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Menu callbacks X X /push-array-obj { X ob /Obj get % [stack] X selected-object % [stack] top X 1 index type /stringtype eq 1 index type /integertype ne and { X pop pop X } { X 1 index type /stringtype eq { X cvis X } { X [ exch ] X } ifelse % [stack] [top] X 1 index exch append % [stack] [stack top] X exch xcheck { cvx } if X replace-obj X } ifelse X } def X X /pop-array-obj { X ob /Obj get X dup length 0 eq { pop } { X dup dup length 1 sub get kbd-select-object X 0 1 index length 1 sub getinterval X replace-obj X } ifelse X } def X X /prepend-to-array-obj { X selected-object dup array-or-string? not { pop } { % [sel] X ob /Obj get % [sel] {obj} X dup type /stringtype eq % [sel] {obj} objstring? X 1 index type /stringtype eq xor { % [sel] {obj} X % incompatible types X pop pop % X } { % [sel] {obj} X exch 1 index % {obj} [sel] {obj} X append % {obj} [sel obj] X exch xcheck { cvx } if % {sel obj} X replace-obj % X } ifelse X } ifelse X } def X X /append-to-array-obj { X selected-object dup array-or-string? not { pop } { % [sel] X ob /Obj get % [sel] {obj} X dup type /stringtype eq % [sel] {obj} objstring? X 1 index type /stringtype eq xor { % [sel] {obj} X % incompatible types X pop pop % X } { % [sel] {obj} X dup 3 -1 roll % {obj} {obj} [sel] X append % {obj} [obj sel] X exch xcheck { cvx } if % {obj sel} X replace-obj % X } ifelse X } ifelse X } def X X /top-array-obj { X selected-pointer-or-interval? { % collection start last X 2 index ob /Obj get ne { X pop pop pop X % error: first select part of this array X } { X 10 dict begin X /Last exch def /Start exch def /Len exch length def X [ ob /Obj get {} forall X Len Start neg roll X Start Len Last sub 1 sub add Start roll X ] ob /Obj get X dup type /stringtype eq { % [65 66 67] (abc) X exch 0 exch { % (abc) 0 65 X 3 copy put pop 1 add X } forall X pop pop X } { X copy pop X } ifelse X end X ob /Obj get replace-obj X } ifelse X } if X } def X X /bottom-array-obj { X selected-pointer-or-interval? { % collection start last X 2 index ob /Obj get ne { X pop pop pop X % error: first select a part of this array X } { X 10 dict begin X /Last exch def /Start exch def /Len exch length def X [ ob /Obj get {} forall X Len Start sub X Len Last sub 1 sub roll X ] ob /Obj get X dup type /stringtype eq { % [65 66 67] (abc) X exch 0 exch { % (abc) 0 65 X 3 copy put pop 1 add X } forall X pop pop X } { X copy pop X } ifelse X end X ob /Obj get replace-obj X } ifelse X } if X } def X X /delete-array-obj { X selected-pointer-or-interval? { % collection start last X 2 index ob /Obj get ne { X pop pop pop X % error: first select a part of this array X } { X 10 dict begin X /Last exch def /Start exch def /Cont exch cvlit def X /Len Cont length def X Cont 0 Start getinterval cvlit X Cont Last 1 add Len Last 1 add sub getinterval cvlit X append X% [ ob /Obj get aload pop X% Len Start sub X% Len Last sub 1 sub roll X% Last Start sub 1 add {pop} repeat X% ] X end X ob /Obj get xcheck {cvx} if X replace-obj X } ifelse X } if X } def X X /splice-array-obj { X selected-interval? { % collection start last X 2 copy get dup array? { X 2 index ob /Obj get eq { X 10 dict begin X /Last exch def /Start exch def /Len exch length def X [ ob /Obj get 0 Start getinterval aload pop X ob /Obj get Start Last Start sub 1 add getinterval X ob /Obj get xcheck {cvx} if X ob /Obj get Last 1 add Len Last sub 1 sub getinterval aload pop X ] X end X ob /Obj get xcheck {cvx} if X replace-obj X } { X pop pop pop X % error: select an array or an interval of this array X } ifelse X } { X pop pop pop X % error: can't do that to strings! X } ifelse X } { X selected-pointer? { % collection index X 2 copy get dup array? { % collection index array X 2 index ob /Obj get eq { X 10 dict begin X /Arr exch cvlit def /Start exch def /Len exch length def X [ ob /Obj get 0 Start getinterval aload pop X Arr aload pop X ob /Obj get Start 1 add Len Start sub 1 sub X getinterval aload pop X ] X end X ob /Obj get xcheck {cvx} if X replace-obj X } { X pop pop pop X % error: select an array or an interval of this array X } ifelse X } { X pop pop pop X % error: select an array or an interval of this array X } ifelse X } if X } ifelse X } def X X /def-in-dict-obj { X selected-pointer? { % collection index X exch 1 index get % index obj X true X } { X selected-object dup null eq { pop false } { % index X dup type /stringtype eq { cvn } if X null % index object X true X } ifelse X } ifelse X { % index obj X ob /Obj get 3 copy pop put % index obj X pop ob /Obj get exch % dict index X ob /Branches get null eq { pop pop } { % dict index X 0 grow-struct % DL X ob begin X /Branches [ % DL mark X Branches { % DL mark branch X dup /I get X counttomark 2 add index /I get X eq {pop} if X } forall X counttomark 3 add -1 roll % mark branches... DL X ] Sort? {SortBy quicksort} if def % X end X } ifelse % X redo-layout X } if X } def X X /undef-in-dict-obj { X selected-pointer? { % collection index X exch pop ob /Obj get exch % dict index X true X } { X selected-object null eq { pop false } { X ob /Obj get exch % dict index X dup type /stringtype eq { cvn } if % XXX: NeWS BUG in undef!! (Marja) X true X } ifelse X } ifelse X { % dict index X ob /Obj get 1 index known not { pop } { % index X ob /Obj get exch % dict index X 2 copy get kbd-select-object X undef % X ob begin X Branches null ne { X /Branches [ X Branches { X begin /C load /I load known { currentdict } if end X } forall X ] def X } if X end X redo-layout X } ifelse % X } if X } def X X /break-obj { X { clear X ob /Obj get dup type /dicttype eq { X dup /ParentDict known { X { { ClassName dbgbreak } exch send } X } { X { countdictstack 1 sub { end } repeat X dup begin currentdict 30 string cvs cvn dbgbreak } X } ifelse X } { X { dup type dbgbreak } X } ifelse X { exec } fork pop pop X } fork pop X } def X X /begin-obj { X ob /Obj get begin-it X } def X X /enter-obj { X ob /Obj get enter-it X } def X X /change-obj { % func => - X { { count 1 roll X count 1 sub { pop } repeat X ob /Obj get exch exec } errored pop X } fork X exch pop waitprocess X modify-obj X } def X X % Execute token with Externals on the dict stack, so externalized X % //&type_123 object references are resolved. X /tokein-obj { X ob /Obj get type /stringtype eq { X { clear Externals begin X ob /Obj get remove-returns X { { token { exch } { exit } ifelse X } loop X } errored { X clear ob /Obj get X } { X count array astore cvx X } ifelse X end X } fork waitprocess X kbd-select-object X } if X } def X X /cvx-obj { X { ob /Obj get cvx } errored {pop} { X% replace-obj X kbd-select-object X } ifelse X } def X X /cvn-obj { X { ob /Obj get cvn } errored {pop} { X% replace-obj X kbd-select-object X } ifelse X } def X X /cvs-obj { X { ob /Obj get 256 string cvs } errored {pop} { X% replace-obj X kbd-select-object X } ifelse X } def X X /tokeout-obj { X ob /Obj get tokeout X kbd-select-object X } def X X /cvlit-obj { X { ob /Obj get cvlit } errored {pop} { X% replace-obj X kbd-select-object X } ifelse X } def X X /cvi-obj { X { ob /Obj get cvi } errored {pop} { X% replace-obj X kbd-select-object X } ifelse X } def X X /cvr-obj { X { ob /Obj get cvr } errored {pop} { X% replace-obj X kbd-select-object X } ifelse X } def X X /load&push-obj { X ob /Obj get load&push-it X } def X X /load&push-it { % X [ exch cvlit {dup load} /errored cvx X { pop smart-name (%% ) (%Load: % is not defined!\n) printf } X { exch smart-name 1 index smart-name exch X (%% ) (%Load: % Push: %\n) printf } X /ifelse cvx ] cvx X execute-it X } def X X /load-obj { X ob Shift /I /Obj ifelse get load-it X } def X X /load-it { % X [ exch cvlit {dup load} /errored cvx X { pop smart-name (%% ) (%Load: % is not defined!\n) printf } X { exch smart-name 1 index smart-name exch X (%% ) (%Load: % Select: %\n) printf X select-object } /ifelse cvx ] cvx X execute-it X } def X X /pointsize-obj { % point => - X dup /Default eq { X pop ob /Point undef X } { X ob exch /Point exch put X } ifelse X redo-layout X } def X X /shrink-obj { % shrink => - X dup /Default eq { X pop ob /Shrink undef X } { X ob exch /Shrink exch put X } ifelse X redo-layout X } def X X /update-obj { X % ... X } def X X /open-obj { % levels => - X dup 0 eq { pop close-struct } { open-struct } ifelse X } def X X /set-open-direction { % bool => - X { /Right { X ob /OpenToRight? true put X } X /Below { X ob /OpenToRight? false put X } X /Default { X ob /OpenToRight? undef X } X } case X } def X X /open-right-obj { % levels => - X /Right set-open-direction open-obj X } def X X /open-below-obj { % levels => - X /Below set-open-direction open-obj X } def X X /set-show-fan { % bool => - X dup { X true false { ob exch /ShowFan? exch put } X /Default { pop ob /ShowFan? undef } X } case X } def X X /push-obj { X ob Shift /I /Obj ifelse get push-it X } def X X /push-it { X [ exch [ exch ] 0 /get cvx X /dup cvx /smart-name cvx (%% ) (%Push: %\n) /printf cvx ] cvx X execute-it X } def X X /begin-it { X [ exch [ exch ] 0 /get cvx X /dup cvx /smart-name cvx (%% ) (%Begin: %\n) /printf cvx X /begin cvx /dstack cvx X ] cvx X execute-it X } def X X /enter-it { X [ exch [ exch ] 0 /get cvx X /dup cvx /smart-name cvx (%% ) (%Enter: %\n) /printf cvx X /enter cvx X ] cvx X execute-it X } def X X /insert-before-obj { X } def X X /insert-after-obj { X } def X X /molecule-obj { X ob /Obj get start_visualizer X } def X X % construct a reference to a piece of substructure relative to the X % top level object X /reference-obj { X obs length 2 lt { {} } { X [ obs dup 1 exch length 1 sub getinterval { X /I get cvlit /get cvx X } forall X ] cvx kbd-select-object X } ifelse X } def X X /exec-obj { X ob /Obj get Shift {[exch]cvx} if exec-it X } def X X /exec-it { % obj => - X { [ exch cvlit /cvx cvx X /dup cvx /smart-name cvx (%% ) (%Exec: %\n) /printf cvx X cvx /exec cvx ] cvx X execute-it X } fork pop pop pause X } def X X /paste-obj { X selected-object X replace-obj X } def X X /replace-obj { % obj => - X ob begin X replace-struct X end X Silent? not { redo-layout } if X ob DL eq StackI null ne and { % Tell processes if we changed its stack. X /ReplaceStack items StackI get send X } if X } def X X /modify-obj { % obj => - X LayoutLock { X ob begin X gsave X ItemCanvas setcanvas X ObjectX ObjectY ObjectHeight add translate X /erase-proc load cvx exec X C I 3 -1 roll put X make-label change-label X grestore X end X } monitor X ob DL eq StackI null ne and { % Tell processes if we changed its stack. X /ReplaceStack items StackI get send X } if X } def X X /make-label { % - => str X /Obj /C load /I load get def X % get default if not defined (don't use parent's) X currentdict /label-proc known { X /label-proc load X } { X self /label-proc get X } ifelse X cvx exec X } def X X X % func is passed the object, and the object is replaced by X % whatever's left on the top of stack. X /transform-obj { % func => - X LayoutLock { X ob begin X gsave X ItemCanvas setcanvas X ObjectX ObjectY ObjectHeight add translate X /erase-proc load cvx exec X C I 2 copy get 4 -1 roll {errored pop} fork waitprocess X exch pop exch pop put X pop pop X make-label change-label X grestore X end X } monitor X ob DL eq StackI null ne and { % Tell processes if we changed its stack. X /ReplaceStack items StackI get send X } if X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Moving and shaping X X /just-reshape { X% Core dumps X11/NeWS beta 1: X ItemCanvas null ne { ItemCanvas /Mapped false put } if X X /ItemHeight exch store /ItemWidth exch store X X ItemWidth 0 eq ItemHeight 0 eq or { X /DL null store X } if X ensure-DL X X adjust-geometry X X ItemWidth ItemHeight /reshape super send X gsave ItemCanvas setcanvas ItemFillColor fillcanvas grestore X X ItemCanvas /Mapped true put X } def X X /reshape { % x y w h => - X just-reshape X location move X } def X X /just-move { % x y => - X /move super send X } def X X /move { % x y => - X label-bbox /lh exch store /lw exch store % x y lx ly X 2 index add /ly exch store % x y lx X 2 index add /lx exch store % x y X ly 0 max /ClientHeight win send lh sub min ly sub add exch X lx 0 max /ClientWidth win send lw sub min lx sub add exch X cvi exch cvi exch /move super send X snaps-here? pop X Index ThisI eq { X /paint-hilite win send X } if X StackI null ne StackI Index ne and { X /MoveMe TellStack X } if X } def X X /redo-layout { X gsave X ItemCanvas setcanvas X ObjectX ObjectY ObjectHeight add translate X perform-layout X redo-shape X grestore X } def X X /redo-shape { X %location 10 10 just-reshape X location 10 10 reshape X damage-view X } def X X /label-bbox { % x y w h X TabX TabY TabWidth TabHeight X } def X X /tab-top { % - => y X location TabY add TabHeight add exch pop X } def X X /tab-bottom { % - => y X location TabY add exch pop X } def X X /label-rect { % X Y w h X location TabY add exch TabX add exch TabWidth TabHeight X } def X X /object-bbox { % x y w h X ObjectX ItemBorder sub ObjectY ItemBorder sub % x y X ObjectWidth ItemBorder dup add add % w X ObjectHeight ItemBorder dup add add % h X } def X X /ItemPath { X ItemRadius label-bbox rrectpath X ItemRadius object-bbox rrectpath X } def X X /AdjustItemSize { % - => - [uses item context] X ObjectLoc { X /Right /Left /RightBelow /RightAbove /LeftBelow /LeftAbove { X /ItemWidth ItemBorder 3 mul ItemGap add X LabelWidth add ObjectWidth add store X /ItemHeight ItemBorder 2 mul LabelHeight X ObjectHeight max add store X } X /Top /Bottom /AboveLeft /AboveRight /BelowLeft /BelowRight { X /ItemWidth ItemBorder 2 mul LabelWidth ObjectWidth max add store X /ItemHeight ItemBorder 3 mul ItemGap add X LabelHeight add ObjectHeight add store X } X } case X } def X X /CalcObj&LabelXY { % - => - [uses item context] X ObjectLoc { X /RightAbove { X /LabelX ItemBorder def /LabelY ItemBorder store X /ObjectX ItemBorder dup add LabelWidth add ItemGap add store X /ObjectY ItemHeight ObjectHeight sub 2 div store X /TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub store X /TabWidth X ItemBorder LabelWidth add ItemGap add ItemRadius dup add add store X /TabHeight LabelHeight ItemBorder dup add add def } X /RightBelow /Right { X /LabelX ItemBorder store X /LabelY ItemHeight ItemBorder sub LabelHeight sub store X /ObjectX ItemBorder dup add LabelWidth add ItemGap add store X /ObjectY ItemHeight ObjectHeight sub 2 div store X /TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub store X /TabWidth X ItemBorder LabelWidth add ItemGap add ItemRadius dup add add store X /TabHeight LabelHeight ItemBorder dup add add def } X /LeftAbove { X /LabelX ItemBorder dup add ItemGap add ObjectWidth add store X /LabelY ItemBorder store X /ObjectX ItemBorder store X /ObjectY ItemHeight ObjectHeight sub 2 div store X /TabX LabelX ItemGap sub ItemRadius dup add sub store X /TabY LabelY ItemBorder sub store X /TabWidth X ItemRadius dup add ItemGap add LabelWidth add ItemBorder add store X /TabHeight LabelHeight ItemBorder dup add add def } X /LeftBelow /Left { X /LabelX ItemBorder dup add ItemGap add ObjectWidth add store X /LabelY ItemHeight ItemBorder sub LabelHeight sub store X /ObjectX ItemBorder store X /ObjectY ItemHeight ObjectHeight sub 2 div store X /TabX LabelX ItemGap sub ItemRadius dup add sub store X /TabY LabelY ItemBorder sub store X /TabWidth X ItemRadius dup add ItemGap add LabelWidth add ItemBorder add store X /TabHeight LabelHeight ItemBorder dup add add def } X /AboveRight /Top { X /LabelX ItemBorder def /LabelY ItemBorder store X /ObjectX ItemWidth ObjectWidth sub 2 div store X /ObjectY ItemBorder dup add LabelHeight add ItemGap add store X /TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub store X /TabWidth LabelWidth ItemBorder dup add add store X /TabHeight X ItemBorder LabelHeight add ItemGap add ItemRadius dup add add X def } X /AboveLeft { X /LabelX ItemWidth ItemBorder sub LabelWidth sub store X /LabelY ItemBorder store X /ObjectX ItemWidth ObjectWidth sub 2 div store X /ObjectY ItemBorder dup add LabelHeight add ItemGap add store X /TabX LabelX ItemBorder sub def /TabY LabelY ItemBorder sub store X /TabWidth LabelWidth ItemBorder dup add add store X /TabHeight X ItemBorder LabelHeight add ItemGap add ItemRadius dup add add X def } X /BelowRight /Bottom { X /LabelX ItemBorder store X /LabelY ItemBorder dup add ObjectHeight add ItemGap add store X /ObjectX ItemWidth ObjectWidth sub 2 div store X /ObjectY ItemBorder store X /TabX LabelX ItemBorder sub store X /TabY LabelY ItemGap sub ItemRadius dup add sub store X /TabWidth LabelWidth ItemBorder dup add add store X /TabHeight X ItemRadius dup add ItemGap add LabelHeight add ItemBorder add X def } X /BelowLeft { X /LabelX ItemWidth ItemBorder sub LabelWidth sub store X /LabelY ItemBorder dup add ObjectHeight add ItemGap add store X /ObjectX ItemWidth ObjectWidth sub 2 div store ======== END OF cyber.shar.splitad ======== From don Thu Nov 23 01:59:46 1989 Date: Thu, 23 Nov 89 01:59:46 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitae From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitae ======== X /ObjectY ItemBorder store X /TabX LabelX ItemBorder sub store X /TabY LabelY ItemGap sub ItemRadius dup add sub store X /TabWidth LabelWidth ItemBorder dup add add store X /TabHeight X ItemRadius dup add ItemGap add LabelHeight add ItemBorder add X def } X } case X /PinX LabelX LabelWidth add 2 sub store X } def X X /adjust-geometry { X /ItemLabel nice-item-label store X LabelSize /LabelHeight exch def /LabelWidth exch def X AdjustItemSize X CalcObj&LabelXY X } def X X /nice-item-label { X Collection Index get X smart-type X (% \267) sprintf X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Display X X /PaintItem { X LayoutLock { X ItemRadius label-bbox rrectpath X ItemFillColor setcolor fill X ItemFrame 0 gt { X ItemFrame ItemRadius label-bbox rrectframe X ItemBorderColor setcolor eofill X } if X ItemRadius object-bbox rrectpath X ItemFillColor setcolor fill X ItemFrame 0 gt { X ItemFrame ItemRadius object-bbox rrectframe X ItemBorderColor setcolor eofill X } if X ShowLabel X paint-struct X } monitor X } def X X /paint-struct { X %{ X gsave X ensure-DL X ItemTextColor setcolor X ObjectX ObjectY ObjectHeight add translate X DL draw-struct X grestore X %} fork waitprocess pop X } def X X /damage-view { X gsave X %ItemParent setcanvas bbox rectpath extenddamage X paint X grestore X } def X X % distillery display stubs X /_fill {fill} def X /_eofill {eofill} def X /_stroke {stroke} def X /_show {show} def X /_newpath {newpath} def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Accessers X X /Collection { X ItemObject 0 get cvlit X } def X X /Index { X ItemObject 1 get cvlit X } def X X /array? { % obj => bool X type dup /arraytype eq exch /packedarraytype eq or X } def X X /array-or-string-dict 5 dict def X array-or-string-dict begin X /arraytype dup def X /packedarraytype dup def X /stringtype dup def X end % array-or-string-dict X X /array-or-string? { % obj => bool X type //array-or-string-dict exch known X } def X X currentdict /array-or-string-dict undef X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Structure stuff X X /do-search { X /it self store X DL begin Icon? end { X /obs [ DL ] store X /ob DL store X } { X gsave X ObjectX ObjectY ObjectHeight add translate X DL X CurrentEvent begin XLocation YLocation end X search-struct X /obs exch store X obs length 0 eq { null } { X obs dup length 1 sub get X } ifelse X /ob exch store X grestore X } ifelse X } def X X% Return the path down the display list to the substructure enclosing (x,y). X /search-struct { % dict x y => [ dl1 dl2 ... dln ] X { % keep return stack from overflowing X 10 dict begin X /ssy exch def /ssx exch def X [ exch X { do-search-struct X % unsucessful search X exit X } loop % catch possible exit X dup true eq { pop } if X ] X end X } fork % dict x y process X 4 1 roll pop pop pop X waitprocess X } def X X% This keeps overflowing the fucking execution stack in NeWS 1.1! X /do-search-struct { % dl => dl dl' dl'' dl''' ... X begin X%gsave X Y W H rectpath 0 setgray 5 setrasteropcode fill grestore X%pause pause X%gsave X Y W H rectpath 0 setgray 5 setrasteropcode fill grestore X ssx X ge { X ssy Y ge { X ssx X W add le { X ssy Y H add le { X currentdict end % dl X dup /Controls get % dl controls X dup null eq { pop } { X { do-search-struct } forall % dl .. dn mark | dl X dup true eq { exit } if % exit if something found X } ifelse % dl X dup /Branches get % dl branches X dup null eq { pop } { X { do-search-struct } forall % dl ... dn mark | dl X dup true eq { exit } if % exit if something found X } ifelse X % We were found, but none of our children, leave true on X % top of stack to unwind search. X true exit X } if X } if X } if X } if X end X } def X X /do-search-struct { % dl => dl dl' dl'' dl''' ... X begin X%gsave X Y W H rectpath 0 setgray 5 setrasteropcode fill grestore X%pause pause X%gsave X Y W H rectpath 0 setgray 5 setrasteropcode fill grestore X ssx X ge { X ssy Y ge { X ssx X W add le { X ssy Y H add le { X currentdict end % dl X dup /Controls get % dl controls X dup null eq { pop } { X { do-search-struct } forall % dl .. dn mark | dl X dup true eq { exit } if % exit if something found X } ifelse % dl X dup /Branches get % dl branches X dup null eq { pop } { X { do-search-struct } forall % dl ... dn mark | dl X dup true eq { exit } if % exit if something found X } ifelse X % We were found, but none of our children, leave true on X % top of stack to unwind search. X true exit X } if X } if X } if X } if X end X } def X X /close-struct { X DL /Icon? undef X ob /L 0 put X ob /Branches null put X ob /Controls null put X Silent? not { redo-layout } if X } def X X% TODO: Open up special editors on different object types. X% Numberic keypad X% Boolean toggle X% Color sliders X% Font finder X% Canvas view X% Visual graphics state editors X% String editor X% CyberSpace projection X X% Event's XLocation YLocation should be relative to the event's Canvas, or X% framebuffer if null. X X /use-parent-obj { X obs length 1 gt { X /obs obs 0 1 index length 1 sub getinterval store X /ob obs dup length 1 sub get store X } if X } def X X /change-parent-obj { % func X use-parent-obj change-obj X } def X X /make-button { % dl => dl X dup /label-proc /button-label put X dup /display-proc /display-button put X } def X X /make-edit-button { % dl => dl X make-button X dup /click-proc /click-edit put X } def X X /make-magic-button { % dl => dl X make-button X dup /click-proc /click-magic put X } def X X /struct-editors 50 dict def X struct-editors begin X X% ------------------------------------------------------------------------ X X /step { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin X % Make fresh copies so user can change scalars X /++ {Step add} def X currentdict /++ cvx 0 grow-struct X make-edit-button X /-- {Step sub} def X currentdict /-- cvx 0 grow-struct X make-edit-button X /Step 1 def X currentdict /Step cvx 0 grow-struct X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } def X X /shift { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin X % Make fresh copies so user can change scalars X (**) {Shift mul} def X currentdict (**) cvn cvx 0 grow-struct X make-edit-button X (//) {Shift div} def X currentdict (//) cvn cvx 0 grow-struct X make-edit-button X /Shift 10 def X currentdict /Shift cvx 0 grow-struct X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } def X X /digit { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin X Controls null ne { Controls aload pop } if X X % Make fresh copies so user can change scalars X X 0 1 9 { X dup [ /floor load 10 /mul load 5 index /add load ] cvx def X currentdict exch 0 grow-struct X make-edit-button X } for X X /Rubout [ 10 /div load /floor load ] cvx def X currentdict /Rubout 0 grow-struct X make-edit-button X X /Clear [ /pop load 0 ] cvx def X currentdict /Clear 0 grow-struct X make-edit-button X X /+- /neg load def X currentdict /+- cvx 0 grow-struct X make-edit-button X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } def X X /boolean { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin X Controls null ne { Control aload pop } if X /True true def X currentdict /True 0 grow-struct X make-edit-button X /False false def X currentdict /False 0 grow-struct X make-edit-button X /Not /not load def X currentdict /Not 0 grow-struct X make-edit-button X /Random [/random cvx .5 /lt cvx] cvx def X currentdict /Random 0 grow-struct X make-edit-button X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } def X X /element { X open-obj-branches X Silent? not { /redo-layout null self exch pop send } if X } def X X /filter { X Branches null eq { X /Branches X C I 1 grow-struct X 1 index get def X } if X X /Controls [ X % XXX: Will this work? X Controls null ne { X Controls aload pop X } if X 20 dict begin X X /Recompute { X ob begin X /Obj /C load /I load get def X end X ContainerRef 0 ob /Obj get put X ob /Branches [ X Container array-or-string? { X IndexRef 0 0 put X } if X Container { X ObjectRef exch 0 exch put X Container array-or-string? { X IndexRef 0 2 copy get 1 add put X } { X IndexRef exch 0 exch put X } ifelse X mark false X /Filter load cvx { exec } errored { cleartomark } { X dup type /booleantype ne { pop false } if X { cleartomark Container Index 0 grow-struct } X { cleartomark } ifelse X } ifelse X } forall X ] Order put X ObjectRef 0 null put X ContainerRef 0 null put X IndexRef 0 null put X Silent? not { /redo-layout null self exch pop send } if X } def X currentdict /Recompute 0 grow-struct X make-magic-button X X /ObjectRef [ null ] def X /Object ObjectRef cvx def X /ContainerRef [ null ] def X /Container ContainerRef cvx def X /IndexRef [ null ] def X /Index IndexRef cvx def X X % Filters may call: Container Index Object X /Filter % - => interesting? X false X def X currentdict /Filter 0 grow-struct X X /Keys 100 dict def X currentdict /Keys 1 grow-struct X X /Order [ X /Obj load array-or-string? /by-value /by-name ifelse X /quicksort cvx X ] cvx def X currentdict /Order 0 grow-struct X X% /View null def X% currentdict /View 0 grow-struct X% counttomark 1 sub /ViewIndex exch def X X ] currentdict end 3 1 roll def X X begin Recompute end X } def X X /scroller { X Branches null eq { X /Branches X C I 1 grow-struct X 1 index get def X } if X X% currentdict /AllBranches known not { X /AllBranches Branches def X% } if X X /Controls [ X % XXX: Will this work? X Controls null ne { X Controls aload pop X } if X 20 dict begin X X /Recompute { X /Offset X Offset X ob /Obj get length 1 sub min X 0 max X def X ob /Branches X ob /AllBranches get Offset 1 index length 1 index sub Size min X getinterval X put X /Scroll X (% : %..% of %, %) [ X ob /Str get X Offset X Offset ob /Branches get length add 1 sub X ob /AllBranches get length X 2 index 1 index div X 100 mul round 5 string cvs (%) append X ] sprintf X def X Silent? not { /redo-layout null self exch pop send } if X } def X X /Scroll (nothingness) def X currentdict /Scroll 0 grow-struct X X% /Top { X% /Offset 0 def X% Recompute X% } def X% currentdict /Top 0 grow-struct X% dup /click-proc /click-magic put X% X% /Bottom { X% /Offset ob /Obj get length Size sub def X% Recompute X% } def X% currentdict /Bottom 0 grow-struct X% dup /click-proc /click-magic put X X /Back { X /Offset Offset Size sub def X Recompute X } def X currentdict /Back 0 grow-struct X make-magic-button X X /Next { X /Offset Offset Size add def X Recompute X } def X currentdict /Next 0 grow-struct X make-magic-button X X /Offset 0 def X% currentdict /Offset 0 grow-struct X X /Size 10 def X currentdict /Size 0 grow-struct X X Controls null ne { X Controls aload pop X } if X X ] currentdict end 3 1 roll def X X begin Recompute end X } def X X /user { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin X /User {} def X currentdict /User 0 grow-struct X make-edit-button X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } def X X % Pop open pointers to instances of this name on the dictionary stack. X /definitions { X /Controls [ X Controls null ne { X Controls aload pop X } if X mark X obs aload pop X { dup mark eq { X pop X /getdictstack dialog-item send X exit X } { X dup /ClassEditor known { X begin cleartomark /C load end % ClassEditorDict X /ClassDicts get X /getdictstack dialog-item send append X exit X } { X pop X } ifelse X } ifelse X } loop X % Remove redundant dictionaries X 100 dict begin X dup {null def} forall X [ exch { % dict X currentdict 1 index known { X currentdict 1 index undef % dict X } { X pop % X } ifelse X } forall X ] X end X X { dup ob /Obj get known { X ob /Obj get 0 grow-struct X dup /label-proc /reference-label put X } { pop } ifelse X } forall X ] dup length 0 eq { pop pop } { def } ifelse X Silent? not { /redo-layout null self exch pop send } if X } def X XXNeWS? { X /class { X ob /C get ob /I get get dup /ParentDictArray known not {pop} { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin % ClassEditorDict X /Obj ob /C get ob /I get get def X /Instance? Obj /ClassName known not def X /Class Obj Instance? { /ParentDictArray get } if def X /ClassDicts [ Class /ParentDictArray get aload pop X Class Instance? { Obj } if ] def X /MethodDict 1000 dict def X /ClassVarDict 1000 dict def X X /Name dup Obj send def X currentdict /Name 0 grow-struct X X ClassDicts { X { Class /InstanceVars get 2 index known not { X dup xcheck 1 index array? and { X MethodDict 2 index dup put X } { X ClassVarDict 2 index dup put X } ifelse X } if X pop pop X } forall X pause pause X } forall X X currentdict /ClassDicts 0 grow-struct X X Instance? not { X /SubClasses dup Class send def X currentdict /SubClasses 0 grow-struct X pause pause X } if X X /InstanceVars [ X Class /InstanceVars get { pop (%) sprintf } forall X ] {gt} quicksort [ exch { cvn } forall ] def X currentdict /InstanceVars 0 grow-struct X dup /ClassEditor true put X pause pause X X /ClassVars [ X ClassVarDict { pop 80 string cvs } forall X ] {gt} quicksort [ exch { cvn } forall ] def X currentdict /ClassVars 0 grow-struct X dup /ClassEditor true put X pause pause X X /Methods [ X MethodDict { pop 80 string cvs } forall X ] {gt} quicksort [ exch { cvn } forall ] def X currentdict /Methods 0 grow-struct X dup /ClassEditor true put X pause pause X X /Obj null def X /Class null def X /MethodDict null def X /ClassVarDict null def X end % ClassEditorDict X ] def X Silent? not { /redo-layout null self exch pop send } if X } ifelse X } def X} { X /class { X ob /C get ob /I get get dup /ParentDict known not {pop} { X /Controls [ X Controls null ne { X Controls aload pop X } if X 20 dict begin X /Obj ob /C get ob /I get get def X /Instance? Obj /ClassName known not def X /Class Obj Instance? { /ParentDict get } if def X /ClassDicts [ Obj /ParentDictArray get aload pop Obj ] def X /MethodDict 1000 dict def X /ClassVarDict 1000 dict def X ClassDicts { X { Class /InstanceVarDict get 2 index known not { X dup xcheck 1 index array? and { X MethodDict 2 index dup put X } { X ClassVarDict 2 index dup put X } ifelse X } if X pop pop X } forall X pause pause X } forall X X currentdict /ClassDicts 0 grow-struct X X Instance? not { X /SubClasses [ X /SubClasses Class send { (%) sprintf } forall X ] {gt} quicksort [ X exch { X cvn dup where { exch get } if X } forall X ] def X currentdict /SubClasses 0 grow-struct X pause pause X } if X X /InstanceVars [ X Class /InstanceVarDict get { pop (%) sprintf } forall X ] {gt} quicksort [ exch { cvn } forall ] def X currentdict /InstanceVars 0 grow-struct X dup /ClassEditor true put X pause pause X X /ClassVars [ X ClassVarDict { pop 80 string cvs } forall X ] {gt} quicksort [ exch { cvn } forall ] def X currentdict /ClassVars 0 grow-struct X dup /ClassEditor true put X pause pause X X /Methods [ X MethodDict { pop 80 string cvs } forall X ] {gt} quicksort [ exch { cvn } forall ] def X currentdict /Methods 0 grow-struct X dup /ClassEditor true put X pause pause X X /Obj null def X /Class null def X /MethodDict null def X /ClassVarDict null def X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } ifelse X } def X} ifelse X X /canvas { X ob /C get ob /I get get type /canvastype ne {pop} { X /Controls [ X Controls null ne { X Controls aload pop X } if X 10 dict begin X X /CanvasBBoxView ob /C get ob /I get get def X currentdict /CanvasBBoxView 0 grow-struct X dup begin X /layout-proc /layout-canvasbbox def X /display-proc /display-canvasbbox def X /erase-proc /erase-nothing def X /click-proc /click-dragcanvas def X /transfer-proc /transfer-reparent def X end X X% This needs to be fixed to work under X11/NeWS. X% But it uses too much space anyway... Needs to be its own type of editor. X% /CanvasImageView ob /C get ob /I get get def X% currentdict /CanvasImageView 0 grow-struct X% dup begin X% /layout-proc /layout-canvasimage def X% /display-proc /display-canvasimage def X% /erase-proc /erase-nothing def X% /click-proc /click-dragimage def X% /transfer-proc /transfer-reparent def X% end X% X% /ViewX 0 def X% /ViewY 0 def X% X% CanvasImageView canvas-rect % x y w h X% 4 2 roll pop pop % w h X% BigHeight min exch BigWidth min exch X% X% /ViewHeight exch def X% /ViewWidth exch def X% currentdict /ViewWidth 0 grow-struct X% currentdict /ViewHeight 0 grow-struct X X /Children [ X ob /C get ob /I get get /TopChild get { X dup null eq { pop exit } if X dup /CanvasBelow get X } loop X ] def X currentdict /Children 0 grow-struct X end X ] def X Silent? not { /redo-layout null self exch pop send } if X } ifelse X } def X X% ------------------------------------------------------------------------ X X end % struct-editors X X /open-editor { % name => - X struct-editors 1 index known not { pop nhh } { X gsave X DL /Icon? undef X ItemCanvas setcanvas X ObjectX ObjectY ObjectHeight add translate X ob begin X struct-editors exch get exec X end X grestore X } ifelse X } def X X /open-struct-editor { % - => - X gsave X DL /Icon? undef X ItemCanvas setcanvas X ObjectX ObjectY ObjectHeight add translate X ob begin X C I get dup type dup struct-editors exch known not { pop pop } { X struct-editors exch get exec X } ifelse X end X% Silent? not { redo-layout } if X grestore X } def X X /open-struct { % levels => - X gsave X DL /Icon? undef X ItemCanvas setcanvas X ObjectX ObjectY ObjectHeight add translate X ob begin X grow-substruct X end X Silent? not { redo-layout } if X grestore X } def X X % (dl on dictstack) X /replace-struct { % obj => - X % Oh, lordy, lordy, lordy! X mark exch C I 3 -1 roll X { put } errored { cleartomark } { X cleartomark X C I L grow-struct X begin X /Branches Branches X% /Controls Controls X /C dup load /I dup load % /L L X /Obj dup load /Str Str X /X X /Y Y /W W /H H X /Font Font X end X def def def def def def def def def def def % def X } ifelse X } def X X % DL on dict stack X /grow-substruct { % l => - X /L exch def X /Branches X C I L grow-struct X 1 index get def X } def X X /composite-type-dict 30 dict def X composite-type-dict begin X { /arraytype /dicttype /canvastype /processtype /eventtype /fonttype X /stringtype % use special string editor X% X11/NeWS: X /packedarraytype /colormapentrytype /environmenttype X /colormaptype % X11/NeWS pre-fcs bug causes panic when we open these! X /visualtype /cursortype X } { true def } forall X end % composite-type-dict X X /composite? { % obj => bool X type //composite-type-dict exch known X } def X X /forbidden-dict 50 dict def X forbidden-dict begin X /Interests null def X /Process null def X /BuildChar null def X /Encoding null def X /WidthArray null def X /ParentDictArray null def X /ParentDict null def X /TopCanvas null def X /BottomCanvas null def X /TopChild null def X /CanvasAbove null def X /CanvasBelow null def X /Parent null def X end % forbidden-dict X X /forbidden? { X forbidden-dict exch known Filter? and X } def X X % Collection Index Levels => dict X /grow-struct { X /xcurs /xcurs_m ItemCanvas setstandardcursor X LayoutLock { X /hourg /hourg_m ItemCanvas setstandardcursor X do-grow-struct X } monitor X /xhair /xhair_m ItemCanvas setstandardcursor X } def X X /object-label { % - => str X /Obj load X% short-name X currentdict DL eq { X short-name X } { X smart-name X I short-name ( : ) append exch append X } ifelse X } def X X /button-label { X Branches null eq { X I 80 string cvs X % Insert spaces to make button easier to press, and so round X % caps don't overlap label. X ( % ) sprintf X } { X object-label X } ifelse X } def X X /reference-label { % - => str X /C load smart-name ( ) append X /I load short-name append ( : ) append X /Obj load smart-name append X } def X X /do-grow-struct { % Container Index Levels => DL X pause X 32 dict begin X /L exch def X cvlit /I exch def cvlit /C exch def X /Obj null def X /Str make-label def % updates /Obj X /X 0 def X /Y 0 def X /W 0 def X /H 0 def X /StrY 0 def X /TipX null def X /TipY null def X L 0 gt { X I forbidden? not { X /Obj load dup type /stringtype ne { X composite? X } {pop false} ifelse X } false ifelse X } false ifelse { X open-obj-branches X currentdict /Controls known not { X /Controls null def X } if X } { X /Branches null def X /Controls null def X } ifelse X currentdict end X } def X X /open-obj-branches { X /Obj load dup array-or-string? { X /Branches exch [ exch X { pop /Obj load counttomark 1 sub L 1 sub do-grow-struct } forall X ] def X } { X /Branches exch [ exch X { pop /Obj load exch L 1 sub do-grow-struct } forall X ] Sort? {SortBy quicksort} if def X } ifelse X } def X X % /SortBy default: X /by-name { X /Str get exch /Str get lt X } def X X /by-value { X /Str get cvr exch /Str get cvr lt X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Layout X X /perform-layout { X /xcurs /xcurs_m ItemCanvas setstandardcursor X LayoutLock { X { X /hourg /hourg_m ItemCanvas setstandardcursor X /ItemLabel nice-item-label store X init-format DL do-layout X /ObjectHeight DL /H get store X adjust-geometry X } fork waitprocess pop X } monitor X /xhair /xhair_m ItemCanvas setstandardcursor X } def X X /init-format { X /Point StartPoint def X /x 0 def X /y 0 def X /ObjectWidth 0 def X /ObjectHeight 0 def X } def X X% /LineHeight { X% Font fontheight 1 add X% } def X X /do-layout { % dict => - X begin X /layout-proc load cvx exec X end X pause X } def X X% /old-layout-struct { % - => - X% /Str make-label def X% /Obj load xcheck Point SmallPointSize gt and { X% /Font ItemXFont Point scalefontquant def X% } { X% /Font Point SmallPointSize le X% ItemSFont ItemFont ifelse Point scalefontquant def X% } ifelse X% Font setfont X% /X x def X% /Y y def X% /W Str stringwidth pop LineGap add def X% Branches null eq { % Icon? or X% /H LineHeight def X% } { X% /x x W add store X% Point X% /Point Point Shrink mul store X% Branches { X% do-layout X% } forall X% /Point exch store X% /x x W sub store X% 0 0 % w h X% Branches { X% begin X% exch W max X% exch H add X% end X% } forall % W H X% LineHeight max 1 max /H exch def X% /TipX X W add LineGap sub def X% /TipY Y H 2 div sub def X% W add /W exch def X% } ifelse X% /Y Y H sub def X% /StrY Y Font fontdescent add H LineHeight sub 2 div add def X% /y Y store X% /ObjectWidth ObjectWidth x W add LineGap sub max store X% } def X X % layout-proc X /layout-struct { % - => - X /Str make-label def X /Obj load xcheck Point SmallPointSize gt and { X /Font ItemXFont Point scalefontquant def X /LineHeight Font fontheight .5 add 1 max def X } { X /Font X Point SmallPointSize le ItemSFont ItemFont ifelse X Point scalefontquant def X /LineHeight Font fontheight .5 add 1 max def X } ifelse X Font setfont X /X x def X /Y y def X /W Str stringwidth pop Pad dup add add def X /StrX X Pad add def X Branches null eq { % Icon? or X /H LineHeight def X /Y Y H sub def X /StrY Y Font fontdescent add H LineHeight sub 2 div add def X /y Y store X } { X OpenToRight? { X /x x W add Pad add LineGap add store X /y y Pad sub store X } { X /x x SubStructureIndent add Pad add LineGap add store X /y y LineHeight sub Pad sub store X } ifelse X Point X /Point Point Shrink mul store X Branches X /do-layout load X forall X /Point exch store X OpenToRight? { X /x x W sub Pad sub LineGap sub store X } { X /x x SubStructureIndent sub Pad sub LineGap sub store X } ifelse X X 0 % w X Branches { X /W get max X } forall % W X Branches length 0 eq { X 0 % W H X /TipY Y H 2 div sub def X } { X Branches 0 get begin Y H add end % TopY X Branches dup length 1 sub get /Y get % TopY BottomY X 2 copy add 2 div % TopY BottomY TipY X /TipY exch def % TopY BottomY X sub % W H X } ifelse X X OpenToRight? { % W H X LineHeight max 0 max Pad dup add add /H exch def X% LineHeight max 0 max /H exch def X /TipX X W add Pad add def X W add Pad add LineGap add X /W exch def X /Y Y H sub Pad sub def X /StrY X Y Font fontdescent add H Pad sub LineHeight sub 2 div add Pad add X def X /y Y store X } { % W H X 1 max LineHeight add Pad dup add add /H exch def X /TipX x SubStructureIndent add Pad add def X SubStructureIndent add Pad add LineGap add W max Pad add X /W exch def X /Y Y H sub def X /StrY X Y Font fontdescent add H LineHeight sub add X def X /y Y store X } ifelse X } ifelse X X Controls null ne { X /x x SubStructureIndent add store X% /x x LineGap 2 div add store X /y y Pad sub store % XXX? X Point X /Point Point Shrink mul store X Controls X /do-layout load X forall X /Point exch store X% /x x LineGap 2 div sub store X /x x SubStructureIndent sub store X X 0 % w X Controls { X /W get max X } forall % W X X Controls length 0 eq { X 0 % W H X } { X Controls 0 get begin Y H add end % TopY X Controls dup length 1 sub get /Y get % TopY BottomY X sub % W H X } ifelse X X /Y Y 2 index sub Pad dup add sub def X% /H exch H add def /W exch LineGap 2 div add W max def X /H exch H add Pad dup add add def X /W exch SubStructureIndent add Pad add W max def X /y Y store X } if X X /ObjectWidth ObjectWidth x W add max store X } def X X /canvas-rect { % can => w h X gsave X setcanvas X clippath pathbbox points2rect X grestore X } def X X % layout-proc X /layout-canvasbbox { X /Str make-label def X /Font ItemFont Point scalefontquant def X C I get dup type /canvastype ne { pop 1 1 } { X % size of parent or of self if null parent X dup /Parent get dup null ne { exch } if X pop canvas-rect % x y w h X 4 2 roll pop pop % w h X } ifelse X /ParentH exch def /ParentW exch def X /LineHeight Point 5 mul 1 max def X /H LineHeight Pad dup add add def % why the extra pad??? X /W LineHeight ParentH div ParentW mul Pad dup add add def X /X x def X /Y y H sub def X /y Y store X /ObjectWidth ObjectWidth x W add max store X } def X X % layout-proc X /layout-canvasimage { X /Str make-label def X /Font ItemFont Point scalefontquant def X% C I get dup type /canvastype ne { pop 1 1 } { X% % size of parent or of self if null parent X% dup /Parent get dup null ne { exch } if X% pop canvas-rect % x y w h X% 4 2 roll pop pop % w h X% } ifelse X /LineHeight Point 5 mul 1 max def X /H C /ViewHeight get Pad dup add add def X /W C /ViewWidth get Pad dup add add def X /X x def X /Y y H sub def X /y Y store X /ObjectWidth ObjectWidth x W add max store X } def X X /transfer-reparent { X % if it's a canvas, and we're a canvas, reparent it into our canvas. X % XXX: TODO! X } def X X /draw-struct { % dict => - X pause X begin X Icon? { X gsave X Font setfont X 0 Font fontdescent IconH sub X 2 copy moveto X Str _show X translate X -2 ItemRadius X Str stringbbox points2rect X insetrrect rrectpath X 0 setlinewidth X 0 setgray X _stroke X grestore X } { X gsave X % get default if not defined (don't use parent's) X currentdict /display-proc known { X /display-proc load X } { X self /display-proc get X } ifelse X cvx exec X grestore X } ifelse X end X } def X X% The arcto's trigger a pathforall bug with still.ps ... X % display-proc X /bad-display-button { X _newpath X X Y 1 add moveto X X W add Y 1 add % x1 y1 X 2 copy H 2 div add % x1 y1 x2 y2 X Pad arcto pop pop pop pop % X X W add Y H add % x1 y1 X X Y H add % x1 y1 x2 y2 X Pad arcto pop pop pop pop X X Y H add lineto X _stroke X display-tree-struct X } def X X % display-proc X /display-button { X _newpath X X Y 1 add moveto X% X Y moveto X W Pad sub 0 rlineto X Pad Pad rlineto X% 0 H Pad dup add sub rlineto X 0 H Pad dup add sub 1 sub rlineto X Pad neg Pad rlineto X Pad W sub 0 rlineto X _stroke X display-tree-struct X } def X X /display-tree-struct { X show-obj X Branches null ne { X show-structure-lines X show-insides X } if X Controls null ne { X show-control-lines X show-controls X } if X } def X X /display-canvasbbox { X X Pad add Y Pad add translate X W Pad dup add sub ParentW div X H Pad dup add sub ParentH div scale X _newpath X 0 0 ParentW ParentH rectpath X .5 setgray _fill X C I get % can X dup type /canvastype eq { dup /Parent get null eq } true ifelse { X pop X } { X gsave X dup /Parent get setcanvas X dup getcanvaslocation X grestore X translate X canvas-rect % x y w h X rectpath % X 0 setgray X _fill X } ifelse X } def X X /display-canvasimage { X X Y translate X _newpath X 0 0 W H rectpath X gsave .5 setgray _fill grestore X 0 setgray _stroke X Pad Pad translate X 0 0 W Pad dup add sub H Pad dup add sub rectpath X clip X _newpath X C I get % can X dup type /canvastype eq { dup /Parent get null eq } true ifelse { X pop X } { X gsave X dup canvas-rect % x y w h X C /ViewX get neg C /ViewY get neg translate X scale % x y X pop pop % X imagecanvas X grestore X } ifelse X } def X X /show-obj { X Font setfont X StrX StrY moveto X Str _show X } def X X % erase-proc X /erase-nothing { } def X X % erase-proc X /erase-label { X gsave X Font setfont X StrX StrY translate X Str stringbbox points2rect % x y w h X exch Pad add exch % fudge the width X rectpath X% X Y W H rectpath X 1 setgray fill X grestore X } def X X /erase-lines { X Branches null ne { X Branches length 0 ne { X gsave X newpath X TipX 1 sub Y Branches 0 get /X get TipX sub 2 add H rectpath X 1 setgray fill X grestore X } if X } if X } def X X /old-change-label { % str => - X gsave X Font setfont X Str stringwidth pop X exch /Str exch def X Str stringwidth pop X exch sub X dup 0 eq Branches null eq or { X pop show-obj X } { X erase-lines X /TipX exch TipX add def X TipX X Branches 0 get /X get Pad 4 mul sub TipX lt { X /TipX TipX LineGap add def X /redo-layout null self exch pop send X } { X show-structure-lines X show-obj X } ifelse X } ifelse X grestore X } def X X /change-label { % str => - X OpenToRight? { old-change-label } { X /Str exch def X show-obj X } ifelse X } def X X% /show-structure-lines { X% TipX TipY X% Branches length 0 eq { X% 2 copy moveto Pad dup rlineto X% moveto Pad dup neg rlineto X% _stroke X% } { X% Branches 0 get % first X% begin X% 2 copy moveto X% X Pad sub Y H add lineto X% Pad 5 mul 0 rlineto X% _stroke X% end X% ShowFan? { X% Branches 0 1 index length 1 sub getinterval { X% begin X% 2 copy moveto X% X Pad sub Y lineto X% Pad 2 mul 0 rlineto X% _stroke X% end X% } forall X% } if X% Branches dup length 1 sub get begin X% moveto X% X Pad sub Y lineto X% Pad 5 mul 0 rlineto X% _stroke X% end X% } ifelse X% OpenToRight? not { X% TipX TipY moveto X% Pad neg 0 rlineto X% TipX Pad sub StrY Font fontdescent sub lineto X% _stroke X% } if X% } def X% X /show-structure-lines { X Branches length 0 eq { X TipX TipY moveto Pad 0 rlineto X _stroke X } { X C I get dup type /arraytype ne { pop } { X xcheck { X % draw { } X% TODO: Make braces! X Branches 0 get begin Y H add end % TopY X Branches dup length 1 sub get /Y get % TopY BottomY X sub 2 div % FanHeight X TipX LineGap add % FanHeight x X TipY 2 index add % FanHeight x y X moveto % FanHeight X LineGap neg 1 index -2 div rlineto X LineGap 4 div % FanHeight dx X 1 index -4 div % FanHeight dx dy X rlineto % FanHeight X X TipX LineGap add % FanHeight x X TipY 2 index sub % FanHeight x y X moveto % FanHeight X LineGap neg 1 index 2 div rlineto X LineGap 4 div % FanHeight dx X 1 index 4 div % FanHeight dx dy X rlineto % FanHeight X pop % X _stroke X } { X % draw [ ] X TipX LineGap add % x X Branches 0 get begin Y H add end % x y X moveto % X LineGap neg 0 rlineto X TipX % x X Branches dup length 1 sub get /Y get % x y X lineto % X LineGap 0 rlineto X _stroke X } ifelse X } ifelse X TipX TipY % x y X Branches 0 get begin X 2 copy moveto X X Y H add lineto X Pad 5 mul 0 rlineto X _stroke X end X ShowFan? { X Branches 0 1 index length 1 sub getinterval { X begin X 2 copy moveto X X Y lineto X Pad 2 mul 0 rlineto X _stroke X end X } forall X } if X Branches dup length 1 sub get begin X moveto % X X Y lineto X Pad 5 mul 0 rlineto X _stroke X end X } ifelse X TipX TipY moveto X Pad neg 0 rlineto X OpenToRight? not { X TipX Pad sub StrY Font fontdescent sub lineto X } if X _stroke X } def X X /show-insides { X Branches { X draw-struct X } forall X } def X X /show-control-lines { X Controls null ne { X Controls length 0 ne { X Controls dup length 1 sub get begin X X dup X Y moveto X end X StrY Font fontdescent sub lineto X 0 setgray X _stroke X } if X } if X } def X X /show-controls { X Controls { X draw-struct X } forall X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Printing X X /write-DL { X DL print-struct X } def X X /print-struct { X { LayoutLock { X X gsave X ItemCanvas setcanvas X erasepage X% ObjectX ObjectY ObjectHeight add translate X StillDict begin X 10 dict begin X /_usefont? true def X /_out? true def X /_output_tx -30 def X /_output_ty -30 def X /_output_sx 1 def X /_output_sy 1 def X _stillbegin X X% ItemRadius label-bbox rrectpath X label-bbox rectpath X ItemFillColor setcolor _fill X ItemFrame 0 gt { X% ItemFrame ItemRadius label-bbox rrectframe X ItemFrame label-bbox rectframe X ItemBorderColor setcolor _eofill X } if X% ItemRadius object-bbox rrectpath X object-bbox rectpath X ItemFillColor setcolor _fill X ItemFrame 0 gt { X% ItemFrame ItemRadius object-bbox rrectframe X ItemFrame object-bbox rectframe X ItemBorderColor setcolor _eofill X } if X X% ShowLabel: X ItemLabel ItemTextColor LabelX LabelY ItemLabelFont X gsave X setfont translate setcolor X 0 0 moveto X % Assuming a string Thing... X 0 currentfont fontdescent rmoveto _show X grestore X X ItemTextColor setcolor X ObjectX ObjectY ObjectHeight add translate X X 0 setlinewidth X DL draw-struct X _stillend X end % 10 dict X end % StillDict X grestore X X } monitor X X } fork waitprocess pop X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Stack stuff X X /execute-it { % obj => - X /exec-and-update dialog-item send X } def X X /TellStack { % message => - X createevent begin X /Name exch def X /ClientData Index def X /Action StackI def X /Canvas ItemParent def X currentdict end sendevent X } def X X /pack { X StackI null ne { X /PackStack items StackI get send X } if X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Snap dragging X X /pinned? { % y h => bool X location pop PinX add 3 1 roll % x y h X 6 exch % x y w h X pin-rect rectsoverlap X } def X X % items backgroundcolor => - (interactively move item) X /moveinteractive { X ItemBegin X 10 dict begin X /GA_constraint 0 def X /GA_value /calc_GA_value load def X currentcursorlocation X /DY exch def /DX exch def X ItemCanvas /Transparent get { X fillcanvas % items X /bbox self send % items x y w h X true dragcanvas currentcanvas mapcanvas X X % paint all items overlapping old item bbox & newly moved item X % the mark ugly is just to avoid a local var dict; mainly X % because of the self call above. X mark 6 -1 roll { % x y w h mark item X counttomark 2 eq {exch pop} if % x y w h mark item X exch pop % x y w h item X 5 copy % x y w h item x y w h item X /bbox exch send rectsoverlap 1 index self eq or X {/paint exch send} {pop} ifelse X mark % x y w h mark X } forall X 5 {pop} repeat X } { X currentcanvas mapcanvas false dragcanvas X% true dragcanvas currentcanvas mapcanvas X pop pop X } ifelse X end X ItemEnd X } def X X /SnapIn { X ThisI StackI ne { X StackI null ne { X /PopMe TellStack X } if X /StackI ThisI store X /PushMe TellStack X } if X } def X X /SnapOut { X StackI null ne StackI Index ne and { X /PopMe TellStack X /StackI null store X } if X } def X X /snaps-here? { % - => bool X ThisI null eq ThisI Index eq or {false} { X /pin-rect dialog-item send X label-rect X rectsoverlap dup { X SnapIn X } { X SnapOut X } ifelse X } ifelse X } def X X /calc_GA_value { X StackI Index eq { X currentcursorlocation pop % cx X } { X StackI null eq { X snaps-here? { X location X pop DX add % ix X } { X currentcursorlocation pop % cx X } ifelse X } { X location TabY add TabHeight X /pinned? items StackI get send not { X SnapOut X pop currentcursorlocation pop % cx X } { % ix X { location pop PinX add } items StackI get send % ItemX PinX X PinX sub % ItemX ItemGoal X exch 1 index exch sub % ItemGoal ItemDelta X currentcursorlocation pop % ItemGoal ItemDelta CurX' X 2 index exch sub % ItemGoal ItemDelta CurDelta X DX add dup abs TabWidth gt { X SnapOut X pop pop pop currentcursorlocation pop DX sub X } { X 1 index abs 1 index abs gt {exch} if % ItemGoal Close Far X pop % ItemGoal Close X% .2 mul sub X sub X } ifelse X DX add X } ifelse X } ifelse X } ifelse X } def X X /NextPos { % - => x y X location % x y X label-bbox % X Y x y w h X exch pop add % X Y x y+h X 3 -1 roll add % X x Y+y+h X exch 3 -1 roll add exch % X+x Y+y+h X exch PinX add exch X } def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Storage managment X X /Free { X SnapOut X ItemCanvas /Retained false put X unmap X /DL null store X% /ItemObject [[null] 0] store X ItemLock { X /free-items [ X free-items aload pop Index X ] store X } monitor X } def X X /init-attributes { X { /ObjectWidth /DL /Shrink X /layout-proc /click-proc /transfer-proc /display-proc /erase-proc X /Point /OpenToRight? /ShowFan?} X { InstanceVarDict 1 index get store } forall X /ObjectLoc /Right store X self /StartPoint undef X adjust-geometry X } def X X % obj => - X /Reuse { X Collection Index 3 -1 roll put X ItemCanvas /Retained true put X ItemCanvas canvastotop X init-attributes X %ensure-DL X %redo-layout X } def X X /destroy { X ItemCanvas /Retained false put X unmap X ItemEventMgr null ne { X ItemEventMgr killprocess X } if X } def X Xclassend def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Pallets of useful functions X X% Pallets are meant to be pushed onto the stack, opened up, and used X% like control panels by clicking on the functions. Double click the X% point button, or set the click-action to click-exec, and clicking X% the Adjust button. (After a few revolutions, the pallets will X% automatically have click-exec actions, and the functions will look X% like buttons. (By virtue of a general purpose view-saving facility.)) X X/Pallets 100 dict def X XPallets begin X X /Debug dictbegin X X /break-exit { dbgexit dstack } def X /break-kill { dbgkill dstack } def X /break-list /dbglistbreaks load def X /break-enter { dbgenter dstack } def X /break-cont { dbgcontinue dstack } def X /break-copy&cont { dbgcopystack dbgcontinue dstack } def X X /clear /clear load def X /enter-it { selected-object enter } def X /exit /exit load def X X X /fix-typo { % undefined (select correct spelling) => - X userdict begin X dup cvlit [ selected-object (%) sprintf cvn cvx ] cvx def X end X exec X } def X X /push-dictstack { currentprocess /DictionaryStack get } def X /push-execstack {DbgImplicitBreak DbgGetExecStack} def X /push-process { DbgImplicitBreak } def X X /show-dictstack { dstack } def X /show-execstack /dbgwhere load def X X dictend def X X /Window 20 dict begin X /make-a-window! { X /win X framebuffer /new DefaultWindow send X def X { newprocessgroup X /reshapefromuser win send X /map win send X } fork waitprocess pop X /can /ClientCanvas win send def X (%% The new window is called "win".\n) print X (%% Its ClientCanvas is called "can".\n) print X (%% Setting the currentcanvas to "can", ) print currentcanvas == X can setcanvas X } def X dictend def X X /Menu dictbegin X /dict-select { X selected-object dup type /dicttype ne { pop } { X [ exch X { X 1 index type /nametype eq { X exch X 40 string cvs X exch X } if X [ exch [ exch ] 0 /get load /select-object cvx ] cvx X } forall X ] /new DefaultMenu send X dup /MenuButton AdjustButton put X dup /AdjustButton MenuButton put X gsave X framebuffer setcanvas X currentcursorlocation /showat 4 -1 roll send X grestore X } ifelse X } def X dictend def X Xend % Pallets X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% StructItem Menu definitions X X/nhh { X gsave X framebuffer setcanvas X currentcursorlocation X [ (Nothing)(Happens)(Here!) ] popmsg pop X grestore X} def X XXNeWS? { X /MakePointSizeThings { % - => ...things... X {1 3 5 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 28 30 32 34} X { X [ exch dup 3 string cvs exch X { dup SmallPointSize le ItemSFont ItemFont ifelse } StructItem send X exch scalefontquant ] X } forall X } def X} { X /MakePointSizeThings { % - => ...things... X {1 2 4 6 8 10 12 14 16 18 20 22 24 28 32} { X [ exch dup 3 string cvs exch X { dup SmallPointSize le ItemSFont ItemFont ifelse } StructItem send X exch scalefontquant ] X } forall X } def X} ifelse X X/TabLocationMenu [ X (LeftBelow) (LeftAbove) (AboveLeft) (AboveRight) X (RightAbove) (RightBelow) (BelowRight) (BelowLeft) X] [ X { currentkey cvn X {/ObjectLoc exch def location 10 10 reshape damage-view} X it send } X] /new CyberMenu send store XTabLocationMenu /PieInitialAngle 360 16 div put X X/TabClickMenu [ X (click-transfer) (click-type) X (click-exec) (click-magic) (click-push) X (click-step) (click-select) (click-edit) X] [ X {currentkey cvn {/click-proc exch def} it send} X] /new CyberMenu send def X X/ClickMenu [ X (click-transfer) (click-type) X (click-exec) (click-magic) (click-push) X (click-step) (click-select) (click-edit) X] [ X {ob /click-proc currentkey cvn dup /null eq {pop undef} {put} ifelse} X] /new CyberMenu send def X X/TabViewMenu [ X [ MakePointSizeThings ] % point size X [ (true) (false) ] % fan X [ (0) (1) (2) (3) (4) (5) (6) (7) (8) ] % open X [ (/Below) (/Right) ] % direction X [ 10 5 200 { 100 div 10 string cvs } for ] % shrink X nullarray % --- X nullarray % --- X nullarray % click... X] [ X (point size) X {getmenuarg 0 get cvx exec {/StartPoint exch def redo-layout} it send} X (fan) { getmenuarg cvx exec {/ShowFan? exch def paint} X it send } X (open) { getmenuarg cvi X { DL null eq { pop } { X /ob DL store X open-obj X } ifelse X } it send } X (direction) { getmenuarg cvx exec /set-open-direction it send} X (shrink) { getmenuarg cvx exec X 1000 mul floor 1000 div % X11/NeWS .9499 bug X {/Shrink exch def redo-layout} X it send } X (---) {} X (---) {} X (click...) TabClickMenu X] /new PulloutCyberMenu send def XTabViewMenu /LabelMinRadius 35 put X%TabViewMenu /PieInitialAngle 135 put X X/ViewMenu [ X [ MakePointSizeThings (/Default) ] % point size X [ (true) (false) (/Default) ] % fan X [ (0) (1) (2) (3) (4) (5) (6) (7) (8) ] % open X [ (/Below) (/Right) (/Default) ] % direction X [ 10 5 200 { 100 div 10 string cvs } for (/Default) ] % shrink X nullarray % --- X nullarray % --- X nullarray % click... X] [ X (point size) {getmenuarg 0 get cvx exec /pointsize-obj it send} X (fan) {getmenuarg cvx exec {set-show-fan paint} it send} X (open) {getmenuarg cvi /open-obj it send} X (direction) {getmenuarg cvx exec {set-open-direction redo-layout} X it send} X (shrink) { getmenuarg cvx exec X /shrink-obj it send} X (---) { } X (---) { } X (click...) ClickMenu X] /new PulloutCyberMenu send def XViewMenu /LabelMinRadius 35 put X%ViewMenu /PieInitialAngle 135 put X X/TabMenu [ X (Layout) {/redo-layout it send} X (Tab...) TabLocationMenu X (Zap) {/Free it send} X (Paint) {/paint it send} X (Print) {/write-DL it send} X (View...) TabViewMenu X] /new CyberMenu send store X X/ConvertMenu [ X (tokein) { /tokein-obj it send } X (executable) { /cvx-obj it send } X (name) { /cvn-obj it send } X (string) { /cvs-obj it send } X (tokeout) { /tokeout-obj it send } X (literal) { /cvlit-obj it send } X (integer) { /cvi-obj it send } X (real) { /cvr-obj it send } X] /new CyberMenu send def X X/SelectMenu [ X (Pointer) { ob /C get ob /I get kbd-select-pointer } X (Index) { ob /I get kbd-select-object } X (Object) { ob /C get ob /I get get kbd-select-object } X (Container) { ob /C get kbd-select-object } X] /new CyberMenu send def X X/OpenMenu [ X nullarray X [ (1) (2) (3) (4) ] X [ (1) (2) (3) (4) ] X nullarray X] [ X (---) {} X (right) {getmenuarg cvi /open-right-obj it send} X (below) {getmenuarg cvi /open-below-obj it send} X (close) {0 /open-obj it send} X] /new PulloutCyberMenu send def X X/GutsMenu [ X (it: item) { it kbd-select-object } X (DL: item's DL) { /DL it send kbd-select-object } X (userdict) { userdict kbd-select-object } X (ob: DL object) { ob kbd-select-object } X (obs: DL path) { obs kbd-select-object } X] /new CyberMenu send def X X/EtcMenu [ X (molecule) { /molecule-obj it send } X (select...) SelectMenu X% (reference) { /reference-obj it send } X (load) { /load-obj it send } X (guts...) GutsMenu X] /new CyberMenu send def X X/TypeFont /Screen findfont 12 scalefontquant def X X/StructMenu [ X nullarray X [ [ { [ ob /Obj get type 30 string cvs X 0 1 index length 4 sub getinterval % chop "type" X TypeFont X ] exch pop dup type exec X } X ] X ] X nullarray nullarray nullarray nullarray nullarray nullarray X] [ % Note: depends on fixed getmenuarg X (push) {/push-obj it send} X (type...) /FigureTypeAction cvx X% (load) {/load-obj it send} X (open...) OpenMenu X (etc...) EtcMenu X (exec) {/exec-obj it send} X (convert...) ConvertMenu X (paste) {/paste-obj it send} X (view...) ViewMenu X] X/new PulloutCyberMenu send def X{ /LabelMinRadius 25 def X /FigureTypeAction { X ob /Obj get type TypeActionDict 1 index known { X TypeActionDict exch get cvx exec X } { X% pop { /nhh it send } X OtherMenu X } ifelse X } def X} StructMenu send X X/PalletMenu X [ Pallets { pop 100 string cvs } forall ] {lt} quicksort X [ { currentkey cvn { Pallets exch get push-it } dialog-item send } ] X /new CyberMenu send Xdef X X/CommandMenu [ X (wet) {} X (paint) {} X] /new CyberMenu send def X X/BreakMenu [ X (userdict) { { clear countdictstack 2 sub { end } repeat X userdict /CyberUserdict dbgbreak } fork pop } X (stack) { { clear dialog-item X /CyberStack /dbgbreak dialog-item send } fork pop } X (window) { { clear win X /CyberWindow /dbgbreak win send } fork pop } X (struct) { { clear items 0 get X /CyberStruct /dbgbreak 2 index send } fork pop } X] /new CyberMenu send def X X/DialogMenu [ X nullarray X [ MakePointSizeThings ] X [(7) (11) (13) (15)] X nullarray X nullarray X nullarray X] [ X (dbgbreak...) BreakMenu X (object size) {StructItem /StartPoint getmenuarg 0 get cvi put} X (text size) {null getmenuarg cvi /changefont dialog-text send} X (pack stack) {/PackStack it send} X (reboot process) {/kbd-reboot dialog-item send} X (reset input) {/kbd-reset it send} X% (credits) { /display-credits win send } X] /new PulloutCyberMenu send def X X/SelectionMenu [ X (push) {{Collection Index get push-it} it send} X (load) {{Collection Index get load-it} it send} X (exec) {{Collection Index get exec-it} it send} X% (convert...) /ConvertMenu StructItem send X (convert...) ConvertMenu X] /new CyberMenu send def X X/BackgroundMenu [ X (Pallets...) PalletMenu X (Framebuffer) { /push-framebuffer-children dialog-item send } X (Canvases) { /push-selected-canvases dialog-item send } X (Windows) { /push-windows dialog-item send } X (Commands...) CommandMenu X (Processes) { /push-processes dialog-item send } X (Stack...) DialogMenu X (Object) { /push-object dialog-item send } X] /new CyberMenu send def X X/Types { X nulltype integertype realtype booleantype colortype marktype X operatortype nametype stringtype shapetype monitortype X graphicsstatetype cursortype filetype arraytype dicttype X fonttype canvastype processtype eventtype X% X11/NeWS: X savetype packedarraytype colormapentrytype environmenttype X colormaptype pathtype visualtype vmtype X} def X X/TypeActionDict 50 dict def XTypeActionDict begin X /integertype /IntegerMenu def X /realtype /RealMenu def X /booleantype /BooleanMenu def X /colortype /ColorMenu def X /nametype /NameMenu def X /stringtype /StringMenu def X /graphicsstatetype /GraphicsstateMenu def X /arraytype /ArrayMenu def X /dicttype /DictMenu def X /fonttype /FontMenu def X /canvastype /CanvasMenu def X /processtype /ProcessMenu def X /eventtype /EventMenu def X% /filetype /FileMenu def X% /shapetype /ShapeMenu def X% /cursortype /CursorMenu def X% /monitortype /MonitorMenu def X% /operatortype /OperatorMenu def X% /nulltype /NullMenu def X% /marktype /MarkMenu def X% X11/NeWS: X% /savetype /SaveMenu def X /packedarraytype /ArrayMenu def X% /colormapentrytype /ColormapentryMenu def X% /environmenttype /EnvironmentMenu def X% /colormaptype /ColormapMenu def X% /pathtype /PathMenu def X% /visualtype /VisualMenu def Xend % TypeActionDict X X% ======================================================================= X% Type menus X X/IntegerMenu [ X (step editor) {/step /open-editor it send} X (shift editor) {/shift /open-editor it send} X (digit editor) {/digit /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/RealMenu IntegerMenu def X% /RealMenu [ X% (step editor) {/step /open-editor it send} X% (shift editor) {/shift /open-editor it send} X% (digit editor) {/digit /open-editor it send} X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X X/BooleanMenu [ X (true) {true /modify-obj it send} X (false) {false /modify-obj it send} X (not) {{not} /transform-obj it send} X (boolean editor) {/boolean /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/ColorMenu [ X (user editor) {/user /open-editor it send} X% put color pie menu here! X] /new CyberMenu send def X X/NameMenu [ X (definitions editor) {/definitions /open-editor it send} X (user editor) {/user /open-editor it send} X% pop up menu of definitions? X] /new CyberMenu send def X X/GraphicsstateMenu [ X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/JuggleArrayMenu [ X (pop) { /pop-array-obj it send } % to selection X % rotate array member or subinterval to top X (top) { /top-array-obj it send } X % splice array member or unsplice subinterval X (splice) { /splice-array-obj it send } X % rotate array member or subinterval to bottom X (bottom) { /bottom-array-obj it send } X (push) { /push-array-obj it send } % selected object X (append) { /append-to-array-obj it send } % selected array X % selected array member or subinterval X (delete) { /delete-array-obj it send } X (prepend) { /prepend-to-array-obj it send } % selected array X] /new CyberMenu send def X X/ArrayMenu [ X (juggle...) JuggleArrayMenu X (element editor) {/element /open-editor it send} X (scroller) {/scroller /open-editor it send} X (filter editor) {/filter /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/StringMenu ArrayMenu def X% /StringMenu [ X% (array...) ArrayMenu X% (prepend) {nhh} % selected string X% (append) {nhh} % selected string X% (token) {nhh} % selected string X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X X/DictMenu [ X (def) { /def-in-dict-obj it send } % selected object X (undef) { /undef-in-dict-obj it send } % selected key (or pointer index) X (begin) { /begin-obj it send } X (enter) { /enter-obj it send } X (dbgbreak) { /break-obj it send } X (scroller) {/scroller /open-editor it send} X (filter editor) {/filter /open-editor it send} X (user editor) {/user /open-editor it send} X (class editor) {/class /open-editor it send} X] /new CyberMenu send def X X/FontMenu [ X (class editor) {/class /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/CanvasStateMenu [ X (top) {ob /C get ob /I get get canvastotop} X (map) {ob /C get ob /I get get /Mapped true put} X (retain) {ob /C get ob /I get get /Retained true put} X (unmap) {ob /C get ob /I get get /Mapped false put} X (bottom) {ob /C get ob /I get get canvastobottom} X (opaque) {ob /C get ob /I get get /Transparent false put} X (unretain) {ob /C get ob /I get get /Retained false put} X (transparent) {ob /C get ob /I get get /Transparent true put} X] /new CyberMenu send def X X/CanvasMenu [ X (state...) CanvasStateMenu X% (manager) {nhh} % select /Interests 0 /Process X% (bbox) {nhh} % select [x y w h] X% (setcanvas) {nhh} % changes proc's gstate X% (zap) {nhh} % unretain & unmap whole tree X (class editor) {/class /open-editor it send} X (canvas editor) {/canvas /open-editor it send} X (scroller) {/canvas /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/ProcessMenu [ X% XXX: Implement these!!! X% (kill) {nhh} X% (kill group) {nhh} X% (suspend) {nhh} X% (resume) {nhh} X% (wait) {nhh} % select return value X% (userdict) {nhh} % select userdict X (class editor) {/class /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X/EventMenu [ X% XXX: Implement these!!! X% (express) {nhh} % Does this make any sense in this context? X% (revoke) {nhh} X% (sendevent) {nhh} X (class editor) {/class /open-editor it send} X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X% /FileMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X% X% /ShapeMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X% X% /CursorMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X% X% /MonitorMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X% X% /OperatorMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X% X% /NullMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X% X% /MarkMenu [ X% (user editor) {/user /open-editor it send} X% ] /new CyberMenu send def X X/OtherMenu [ X (user editor) {/user /open-editor it send} X] /new CyberMenu send def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% TextStructItem class definition X X/TextStructItem StructItem Xdictbegin X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Instance variables X X /I null def X /MyStack null def X /MyProcess null def X /Scroller null def X /ScrollerWidth 18 def X /Notifier null def X /NotifierHeight 24 def X /SubItemGap 2 def X /SubItemMgr null def X /DeferedUpdateEvent null def X /UpdateDelay .5 60 div def X /PinHeight 0 def X /DropShadow 6 def Xdictend Xclassbegin X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Class Variables X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Methods X X /new { X /new super send begin X /MyStack [] def X /ItemLabel (Stack \267) def X currentdict end X } def X X /push-selected-canvases { X gsave X fboverlay setcanvas X 0 0 { moveto 20 20 rmoveto X -40 -40 rlineto X 40 0 rmoveto X -40 40 rlineto X } getanimated waitprocess aload pop X find_canvas X push-it X grestore X } def X X /push-windows { X 10 dict begin X /d 200 dict def X [d] X { currentprocess X /ParentDict where { pop self } { currentdict } ifelse X put X } cvlit X append cvx X RootUserDict begin X AllWin X end % RootUserDict X 10 { pause } repeat % Is this enough, or will 1 pause do it, or what? X d push-it X end % localdict X } def X X XNeWS? { X /push-processes { X getprocesses push-it X } def X } { X /push-processes { X % How should we simulate this bugger in NeWS 1.1? X % getprocesses push-it X (You need NeWS/X!) push-it X } def X } ifelse X X /push-object { X Object push-it % XXX: push opened object editor X } def X X /push-framebuffer-children { X framebuffer push-it % XXX: push opened canvas hierarchy editor X } def X X /kbd-reset { X /dialog-buf () store X /dialog-string () store X { psh-socket bytesavailable string readstring pop X } errored X {(\n%% Reset!\n) print} execute-it X } def X X /shut-down { X { psh-socket (\ndbgstop\nquit\n) writestring X psh-socket flushfile X } errored pop X null null /DropDead TellMyProcess X 1 60 div sleep X } def X X /kbd-reboot { X { X /dialog-buf () store X /dialog-string () store X [ () (%% Reboot!) () ] false /writeatcaret dialog-text send X shut-down X psh-socket null ne { X psh-socket status { psh-socket closefile } if X } if X /psh-socket null store X % I don't know why I have to do this, but it sure helps... (i hope) X items { X% { LayoutLock monitorlocked { /LayoutLock createmonitor def } if X { /LayoutLock createmonitor def X } exch send X } forall X ensure-DL X% { EventMgr null ne { EventMgr killprocess } if X% /EventMgr Interests forkeventmgr store X% KeyboardEventMgr null ne { KeyboardEventMgr killprocess } if X% /KeyboardEventMgr { KeyboardHandler } fork store X% } dialog-text send X start-event-mgrs X } fork pop X } def X X /use-selected-process { X selected-object dup type /processtype eq { X set-process X } if X } def X X /ObjectSize { % - => w h X % XXX bletch: X ObjectWidth 0 eq ObjectHeight 0 eq or { X /ObjectWidth X ItemBorder dup add ItemWidth 1 index sub % w X ScrollerWidth dup add SubItemGap add max X store X /ObjectHeight X ItemHeight exch sub % w h X ScrollerWidth NotifierHeight add SubItemGap add max X store X } if X ObjectWidth ObjectHeight X } def X X /adjust-geometry { X LabelSize /LabelHeight exch def /LabelWidth exch def ======== END OF cyber.shar.splitae ======== From don Thu Nov 23 02:00:10 1989 Date: Thu, 23 Nov 89 02:00:10 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitaf From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitaf ======== X ObjectSize /ObjectHeight exch def /ObjectWidth exch def X AdjustItemSize X CalcObj&LabelXY X } def X X /replace-obj { % obj => - X Collection Index 2 index put X kbd-select-object X } def X X /toggle-icon {} def X X /show-tab-menu { X /it self store X CurrentEvent /showat DialogMenu send X } def X X /show-struct-menu { X /it self store X /ob 20 dict store X ob begin X /C Collection def X /I Index def X /Obj Collection Index get def X end X CurrentEvent /showat SelectionMenu send X } def X X /do-search { X /it self store X /ob null store X } def X X /make-selection { % We ARE the selection. X } def X X /pin-rect { % X Y w h X location exch PinX add 3 sub exch % x y X PinHeight 0 lt { X PinHeight add X } if X ItemHeight PinHeight abs add X 6 exch X } def X X /exec-and-update { % func => - X null /ExecIt TellMyProcess X } def X X /TellMyProcess { % ClientData Action Name X 8 { % wait up to 4 seconds if no process X MyProcess null eq { .5 60 div sleep } { exit } ifelse X } repeat X MyProcess null eq { X pop pop pop X gsave framebuffer setcanvas X currentcursorlocation [(No process!)] popmsg pop X grestore X } { X createevent begin X /Name exch def X /Action exch def X /ClientData exch def X /Process MyProcess def X currentdict end sendevent X } ifelse X } def X X /UpdateStack { % event => - X DeferedUpdateEvent null ne { X DeferedUpdateEvent recallevent X } if X /DeferedUpdateEvent CurrentEvent store X DeferedUpdateEvent begin X /Name /DeferedUpdate def X /TimeStamp currenttime UpdateDelay add def X end % event X DeferedUpdateEvent sendevent X pop X } def X X /DeferedUpdate { % event => - X /DeferedUpdateEvent null store X dialog-promptlines 0 ne { X /getcaretpos dialog-text send X exch pop 1 exch dialog-promptlines 1 sub 0 max sub X 2 copy /movecaret dialog-text send X exch pop dialog-promptlines exch /deleteline dialog-text send X } if X [ X dialog-string dialog-buf X CurrentEvent /ClientData get length X (NeWS[%]> %%) sprintf X { (\n) search { % chop string up at newlines X exch pop exch X } { X exit X } ifelse X } loop X ] X dup length /dialog-promptlines exch store X false /writeatcaret dialog-text send X pause X CurrentEvent /ClientData get X setoperandstack X pop X } def X X /ProcessReady { % event => - X dup /ClientData get X exch /Action get X set-process X } def X X /set-process { % stack process => - X /MyProcess exch def X setoperandstack X { currentprocess (%% ) (%Hello, my name is %!\n) printf } execute-it X } def X X /SelectionChanged { % event => - X CurrentEvent /Action get /PrimarySelection eq { X CurrentEvent /ClientData get % selection X dup selection-type % selection type X dup /text eq { X pop dissect-selection X Collection Index 2 index put X (text: %) exch [ exch ] X } { % selection type X (%: %) [ 4 2 roll % fmt mark selection type X exch % fmt mark type selection X dissect-selection X Collection Index 2 index put X smart-name % fmt mark type name X ] X } ifelse X sprintf X /printstring Notifier send X } if X pop X } def X X /makestartinterests { X /makestartinterests super send X [ exch aload pop X /ProcessReady {/ProcessReady /Self GetFromCurrentEvent send} X null ItemCanvas eventmgrinterest X dup /Self self PutInEventMgrInterest X /UpdateStack {/UpdateStack /Self GetFromCurrentEvent send} X null ItemCanvas eventmgrinterest X dup /Self self PutInEventMgrInterest X /DeferedUpdate {/DeferedUpdate /Self GetFromCurrentEvent send} X null ItemCanvas eventmgrinterest X dup /Self self PutInEventMgrInterest X /SelectionChanged {/SelectionChanged /Self GetFromCurrentEvent send} X null null eventmgrinterest X dup /Self self PutInEventMgrInterest X /PushMe {/DoPushMe /Self GetFromCurrentEvent send} X Index ItemParent eventmgrinterest X dup /Self self PutInEventMgrInterest X /PopMe {/DoPopMe /Self GetFromCurrentEvent send} X Index ItemParent eventmgrinterest X dup /Self self PutInEventMgrInterest X /MoveMe {/DoMoveMe /Self GetFromCurrentEvent send} X Index ItemParent eventmgrinterest X dup /Self self PutInEventMgrInterest X ] X } def X X /DoPushMe { % event => - X /ClientData get PushMe X } def X X /DoPopMe { % event => - X /ClientData get PopMe X } def X X /DoMoveMe { % event => - X ItemLock { X SortStack ReplaceStack X } monitor X pop X } def X X /PushMe { % index => - X ItemLock { X /I exch def X /MyStack [ X MyStack { X dup I eq {pop} if X } forall X I X ] store X SortStack X getoperandstack X {Collection Index get} items I get send X smart-name (%% Push: ) exch append (\n) append X /ReplaceStack TellMyProcess X } monitor X } def X X /PopMe { % index => - X ItemLock { X /I exch def X /MyStack [ X MyStack { X dup I eq {pop} if X } forall X ] store X getoperandstack X {Collection Index get} items I get send X smart-name (%% Pop: ) exch append (\n) append X /ReplaceStack TellMyProcess X } monitor X } def X X /ReplaceStack { X ItemLock { X getoperandstack X null X /ReplaceStack TellMyProcess X } monitor X } def X X /SortStack { X ItemLock { X MyStack { X /tab-top exch items exch get send exch X /tab-top exch items exch get send X lt X } quicksort pop X } monitor X } def X X % This code was designed to be rewritten! X % To do: X % Make the stack display premptable: Each pass it does one thing to make the X % display look more like MyStack. (bottom to top priority) X /SetStack { % stack => - X ItemLock { X ItemBegin 10 dict begin X /NewStack exch def X /OldStack 200 dict def X MyStack { X items 1 index get {Collection Index get} exch send X OldStack 3 1 roll put X } forall X /MyStack [] store X NewStack { % new X pause X /I null def X OldStack { % new ind old X dup 3 index eq { % new ind old X xcheck 2 index xcheck eq { % new ind X /I exch def exit % new X } { pop } ifelse % new X } { pop pop } ifelse % new X } forall % new X pause X /I load null ne { X pop % X OldStack /I load undef X /MyStack [ X MyStack aload pop /I load X ] store X } { % new X /MyStack [ X MyStack aload length 3 add -1 roll % /MyStack [ ... new X create-struct % /MyStack [ ... newind X ] store % X } ifelse X } forall X pause X OldStack { % ind old X pop % ind X items exch get % item X dup /StackI null put % XXX X /Free exch send % X pause X } forall X pause X /Y tab-top def X MyStack { % ind X items exch get % item X Y { % PrevTop X dup tab-bottom exch sub % PrevTop below X dup 0 lt { X location 2 index sub just-move X pause X } if X pop pop tab-top X } 3 -1 roll send % NextTop X /Y exch def % X } forall % X pin-rect % x y w h X exch pop add exch pop % PinTop X Y lt { % if we ran off the top of the stack, then pack it down. X PackStack X } if X pause X ItemEnd end X } monitor X } def X X /create-struct { % obj => i X ItemLock { X 20 dict begin X /Obj exch def X NextStackPos X /NextY exch def /NextX exch def X free-items length 0 eq { X Stack SP /Obj load put X Stack SP {handle-click} can X /new StructItem send X /It exch def X /items [ X items aload pop X It X ] store X /I SP def X /SP SP 1 add store X It /StackI Index put X createevent begin X /Name /UpdateInterests def X /Canvas ItemParent def X /ClientData I def X currentdict end sendevent X } { X /I free-items dup length 1 sub get def X /It items I get def X /free-items free-items 0 1 index length 1 sub getinterval store X It /StackI Index put X /Obj load /Reuse It send X } ifelse X NextX NextY X { 2 copy 20 20 just-reshape X exch PinX sub exch just-move X map damage-view X } It send X I X pause pause X end X } monitor X } def X X /getoperandstack { X % Don't use [ ... ] in case there are marks on the stack!! X MyStack { X {Collection Index get} exch items exch get send X } forall X MyStack length array astore X } def X X /getdictstack { % - => dictstack X MyProcess null eq { nullarray } { X MyProcess /DictionaryStack get X } ifelse X } def X X /PackStack { X 10 dict begin X /Y tab-top def X MyStack { X items exch get X Y { % PrevTop X dup tab-bottom exch sub % PrevTop below X location 2 index sub just-move X pause pause X pop pop tab-top X } 3 -1 roll send X /Y exch def X pause pause X } forall X end X pause X } def X X /NextStackPos { % - => x y X MyStack length 0 eq { X NextPos X } { X MyStack dup length 1 sub get items exch get X /NextPos exch send X } ifelse X } def X X /setoperandstack { X SetStack X } def X X /ClientExit { X CurrentEvent /KeyState get { X dup AdjustButton eq { X { X ItemBegin X /StackI Index store X /ThisI Index store X ItemCanvas setcanvas X location TabY add TabHeight 2 div add exch PinX add exch X ItemParent createoverlay setcanvas X { 2 setlinewidth exch pop x0 exch lineto } X getanimated waitprocess aload pop % x y X exch pop location exch pop sub X dup 0 gt {ItemHeight sub 0 max} if X /PinHeight exch store X /paint-hilite win send X ItemEnd X } fork pop pop exit X } if X } forall X StopItem X } def X X /paint-struct { X gsave X ensure-DL X /paint Scroller send X /paint Notifier send X dialog-can setcanvas X /fixdamage dialog-text send X grestore X } def X X /DrawHilite { X gsave can setcanvas X location CanvasYFudge add translate X ItemRadius object-bbox X 4 -1 roll DropShadow add X 4 -1 roll DropShadow sub X 4 2 roll X rrectpath X .5 setgray fill X% -3 ItemRadius label-bbox insetrrect rrectpath X 2 setlinewidth 0 setgray stroke X PinHeight 0 ne { X 1 setlinecap X 2 setlinewidth X 0 setgray X PinX 0 dup PinHeight add min 6 sub moveto X 0 ItemHeight PinHeight abs add 12 add rlineto X stroke X X 1 setlinecap X 6 setlinewidth X 0 setgray X X PinX 0 dup PinHeight add min moveto X 0 ItemHeight PinHeight abs add rlineto X X gsave stroke grestore X 2 setlinewidth X 1 setgray X stroke X } if X grestore X } def X X /reshapefromuser { X } def X X /reshape { X /reshape super send X gsave X% ensure-DL X ItemCanvas setcanvas X ObjectX ScrollerWidth add SubItemGap add ObjectY translate X 0 0 X ObjectWidth ScrollerWidth sub SubItemGap sub X ObjectHeight NotifierHeight sub SubItemGap sub X rectpath dialog-can reshapecanvas X dialog-can /Mapped true put X /reshape dialog-text send X X ItemCanvas setcanvas X { [ 1 0 1 TextHeight div dup CanHeight floor 1 sub mul null ] } X dialog-text send X /setrange Scroller send X ObjectX ObjectY X ScrollerWidth ObjectHeight NotifierHeight sub SubItemGap sub X /reshape Scroller send X /paint Scroller send X X ObjectX ObjectY ObjectHeight add NotifierHeight sub X ObjectWidth NotifierHeight X { /ObjectX 0 def /ObjectY 0 def X reshape } Notifier send X /paint Notifier send X X SubItemMgr null eq { X /SubItemMgr X dictbegin X /Scroller Scroller def X /Notifier Notifier def X dictend forkitems X store X } if X grestore X } def X X /ensure-DL { X dialog-text null eq { X /dialog-can ItemCanvas newcanvas store X%dialog-can /Transparent false put X%dialog-can /Retained true put X%dialog-can /Parent get dup /Transparent false put /Retained true put X /dialog-text 200 dialog-can /new TextCanvas send store X { /KeyDict 200 dict def X KeyDict begin X X 0 { (prompt) comment X prompt X } def X X 127 { (erase character) comment % Rubout X dialog-string length 0 ne { X getcaretpos X exch dup 1 gt { X 1 sub exch X movecaret X getcaretpos X 1 3 1 roll deletestring X /dialog-string dialog-string dup length 1 sub X 0 max 0 exch getinterval store X } if X } if X } def X 8 127 load def % Backspace X X 23 { (erase word) comment % ^W X 0 X { dialog-string length 1 index sub % i X dup 0 le { pop exit } if X 1 sub dialog-string exch get X DelimDict exch known 1 index 0 ne and { X exit X } if X 1 add X } loop X dup 0 eq { pop } { X dup X getcaretpos exch 2 index sub exch X 2 copy movecaret X deletestring X /dialog-string dialog-string dup length 4 -1 roll sub X 0 max 0 exch getinterval store X } ifelse X } def X X 24 { (erase line) comment % ^X X getcaretpos X exch dialog-string length sub 1 max exch X 2 copy X movecaret X dialog-string length 3 1 roll X deletestring X /dialog-string () store X } def X 21 24 load def % ^U X X 13 { (exec line) comment % Return X [ () () ] false writeatcaret X dialog-string /dialog-enter dialog-item send X /dialog-string () store X /dialog-promptlines X 0 dialog-buf { X (\n) search { X pop pop exch 1 add exch X } { X pop exit X } ifelse X } loop X 1 add X store X } def X X 10 { (select line) comment % Newline X [ () () ] false writeatcaret X dialog-string kbd-select-object X /dialog-string () store X prompt X } def X X 10 128 add { (input line) comment % Meta-Newline X [ () () ] false writeatcaret X dialog-string /dialog-newline dialog-item send X /dialog-string () store X prompt X } def X X 19 { (insert selection) comment % ^S X selected-object (%) sprintf X [ 1 index ] false writeatcaret X /dialog-string exch dialog-string exch append store X } def X X 12 { (load) comment % ^L X { (%% load\n) print X load X } execute-it X } def X X 20 { (exchange) comment % ^T X { (%% exch\n) print X exch X } execute-it X } def X X 11 { (stack to selection) comment % ^K X { (%% Stack to selection\n) print X count 0 ne { select-object } if X } /execute-it dialog-item send X } def X X 25 { (selection to stack) comment % ^Y X { (%% Selection to stack\n) print X selected-object X } /execute-it dialog-item send X } def X X /FunctionR3 { (execute selection) comment X selected-object X % Since 'token' doesn't recognize \r's as ending comments, X % if the selection has \r's in it, make a copy with \r's X % mapped to \n's. X dup type /stringtype eq { X dup remove-returns exch 1 index ne { X kbd-select-object X } if X } if X { selected-object cvx X dup (%) sprintf X (\n) search { exch pop exch pop ( ...) append} if X (%% ) (%Execute selection %\n) printf X exec X } /execute-it dialog-item send X } def X (x) 0 get 128 add /FunctionR3 load def % Meta-x X (X) 0 get 128 add /FunctionR3 load def % Meta-X X X 3 { (reset input) comment % ^C X /kbd-reset dialog-item send X } def X X 255 { (reboot process) comment % Meta-Delete X Control { X [ () (Hey! This ain't no stinkin' MS-DOS!!!) () ] X false writeatcaret X } if X /kbd-reboot dialog-item send X } def X 31 128 add 255 load def X X /FunctionR9 { (page up) comment X /ScrollPageForward /FakeScroll dialog-scroll send X } def X (v) 0 get 128 add /FunctionR9 load def % Meta-v X (V) 0 get 128 add /FunctionR9 load def % Meta-V X X /FunctionR15 { (page down) comment X /ScrollPageBackward /FakeScroll dialog-scroll send X } def X 22 /FunctionR15 load def % ^V X X /FunctionR7 { (scroll up) comment X /ScrollLineForward /FakeScroll dialog-scroll send X } def X (z) 0 get 128 add /FunctionR7 load def % Meta-z X (Z) 0 get 128 add /FunctionR7 load def % Meta-Z X X /FunctionR13 { (scroll down) comment X /ScrollLineBackward /FakeScroll dialog-scroll send X } def X 26 /FunctionR13 load def % ^Z X X /FunctionR11 { (scroll to bottom) comment X 1 /ScrollTo dialog-scroll send X } def X (>) 0 get 128 add /FunctionR11 load def % Meta-> X (.) 0 get 128 add /FunctionR11 load def % Meta-. X X /FunctionF10 { (help) comment % Alternate X [ () (Key Bindings:) ()] false writeatcaret X [ KeyDict { X comment-string exch key-name X (%: %) sprintf X pause pause X } forall ] X {gt} quicksort X { [ exch () ] false writeatcaret X pause pause pause } forall X prompt X } def X (?) 0 get 128 add /FunctionF10 load def % Meta-? X (/) 0 get 128 add /FunctionF10 load def % Meta-/ X X /FunctionR1 { (describe key) comment X [ () (Describe key: ) ] false writeatcaret X /DescribingKey? true store X } def X (k) 0 get 128 add /FunctionR1 load def % Meta-k X (K) 0 get 128 add /FunctionR1 load def % Meta-K X X /FunctionR2 { (bind selection to key) comment X [ () selected-object smart-type (Bind selection %) sprintf X (to key: ) ] X false writeatcaret X /BindingKey? true store X } def X (b) 0 get 128 add /FunctionR2 load def % Meta-b X (B) 0 get 128 add /FunctionR2 load def % Meta-B X X /FunctionL9 { (find completions) comment X [ dialog-string { X DelimDict 1 index known { cleartomark mark } if X } forall X ] cvas X dup length 0 eq { pop } { X kbd-select-object X { selected-object X (%% Finding completions of ") print dup print (":\n) print X currentprocess /DictionaryStack get X 20 dict begin X /DS exch def X /pat exch def X /found null def X /complete null def X% X11/NeWS pre fcs gives rangecheck errors when we try to cvs something X% into a string it's too long for... X% /str pat length string def X /wholestr 256 string def X /str wholestr 0 pat length getinterval def X DS length 1 sub -1 0 { /i exch def X DS i get { X /val exch def X% dup str cvs pat ne { pop } { X dup wholestr cvs pop str pat ne { pop } { X found null eq { X /found 1 index 256 string cvs def X /complete found def X } { X /found 1 index 256 string cvs def X found length complete length lt { X /complete found def X } { X 0 complete { X found 2 index get ne { X /complete complete 0 3 index getinterval store X exit X } if X 1 add X } forall X pop X } ifelse X } ifelse X /val load smart-name exch i (%: /% %\n) printf X } ifelse X } forall X pause pause X } for X pause pause pause X complete null eq { () } { X complete pat length 1 index length 1 index sub X getinterval X } ifelse X createevent begin X /Name /InsertValue def X /Action exch def X /Canvas X % Fails with more than one interest! X% currentprocess /Interests get 0 get % event X currentprocess /Interests get X % the first interest expressed is the last on the list X dup length 1 sub get % event X /ClientData get /ViewCanvas get % can X /Parent get % clientcanvas has keyboard interests! X def X currentdict end sendevent X complete null ne { complete select-object } if X end X } execute-it X } ifelse X } def X 27 128 add /FunctionL9 load def X X 27 { (complete) comment % Escape X [ dialog-string { X DelimDict 1 index known { cleartomark mark } if X } forall X ] cvas X dup length 0 eq { pop } { X kbd-select-object X { selected-object X currentprocess /DictionaryStack get X 20 dict begin X /DS exch def X /pat exch def X /found null def X /complete null def X% X11/NeWS pre fcs gives rangecheck errors when we try to cvs something X% into a string it's too long for... X% /str pat length string def X /wholestr 256 string def X /str wholestr 0 pat length getinterval def X DS length 1 sub -1 0 { /i exch def X DS i get { X /val exch def X% dup str cvs pat ne { pop } { X dup wholestr cvs pop str pat ne { pop } { X found null eq { X /found 1 index 256 string cvs def X /complete found def X } { X /found 1 index 256 string cvs def X found length complete length lt { X /complete found def X } { X 0 complete { X found 2 index get ne { X /complete complete 0 3 index getinterval store X exit X } if X 1 add X } forall X pop X } ifelse X } ifelse X pop X } ifelse X } forall X pause X } for X pause X complete null ne { X complete pat length 1 index length 1 index sub X getinterval X createevent begin X /Name /InsertValue def X /Action exch def X /Canvas X currentprocess /Interests get 0 get % event X /ClientData get /ViewCanvas get % can X /Parent get % clientcanvas has keyboard interests! X def X currentdict end sendevent X complete null ne { complete select-object } if X } if X end X } execute-it X } ifelse X } def X X 4 { (completions) comment % ^D X [ dialog-string { X DelimDict 1 index known { cleartomark mark } if X } forall X ] cvas X dup length 0 eq { pop } { X kbd-select-object X { selected-object X (%% Completions of ") print dup print (":\n) print X currentprocess /DictionaryStack get X 20 dict begin X /DS exch def X /pat exch def X /found null def X /complete null def X% X11/NeWS pre fcs gives rangecheck errors when we try to cvs something X% into a string it's too long for... X% /str pat length string def X /wholestr 256 string def X /str wholestr 0 pat length getinterval def X DS length 1 sub -1 0 { /i exch def X DS i get { X /val exch def X% dup str cvs pat ne { pop } { X dup wholestr cvs pop str pat ne { pop } { X found null eq { X /found 1 index 256 string cvs def X /complete found def X } { X /found 1 index 256 string cvs def X found length complete length lt { X /complete found def X } { X 0 complete { X found 2 index get ne { X /complete complete 0 3 index getinterval store X exit X } if X 1 add X } forall X pop X } ifelse X } ifelse X (% ) printf X } ifelse X } forall X pause X } for X (\n) printf X pause pause X complete null ne { X complete pat length 1 index length 1 index sub X getinterval X select-object X } if X end X } execute-it X } ifelse X } def X X end % KeyDict X X /DelimDict 50 dict def X DelimDict begin X 0 1 32 { dup def } for X (%/()<>[]{}) { dup def } forall X end X X /typein { X [1 index] false writeatcaret X /dialog-string exch dialog-string exch append store X } def X X /DescribingKey? false def X /BindingKey? false def X /key 0 def X X /KeyHitCallback { % event => X dup update-shifts X /Name get X dup type /integertype eq { X% Meta {128 add} if X Meta {128 or} if X } { X (%) sprintf % X11/NeWS pre fcs bug: /foo cvn => typecheck error! X Meta { (Meta%) sprintf } if X Shift { (Shift%) sprintf } if X Control { (Control%) sprintf } if X cvn X } ifelse X /key exch def X BindingKey? DescribingKey? or { X BindingKey? { X selected-object X KeyDict key known { X KeyDict key get X } { null } ifelse X kbd-select-object X dup null eq { X pop KeyDict key undef X } { X KeyDict exch key exch put X } ifelse X } if X [ () X KeyDict key known { X KeyDict key get comment-string X } { X key type /integertype eq (self insert) (unbound) ifelse X } ifelse X key key-name X (%: %) sprintf X () X ] false writeatcaret X /BindingKey? false store X /DescribingKey? false store X prompt X } { X KeyDict key known { X { KeyDict key get cvx exec } fork pop X pause X } { X key type /integertype eq { X key cvis typein X } { X % beep X } ifelse X } ifelse X } ifelse X } def X X /s null def X /skip 0 def X /newlines 0 def X /i 0 def X /a null def X /pre null def X /lastnl 0 def X X /InsertValueCallback { % string => - X /skip dialog-string length store X /s exch dialog-string exch append store X /newlines 0 store X /lastnl null store X 0 1 s length 1 sub { X /i exch store X s i get 13 eq { s i 10 put } if X s i get 10 eq { X /newlines newlines 1 add store X /lastnl i store X pause X } if X } for X lastnl null ne { X s 0 lastnl 1 add getinterval X /dialog-enter dialog-item send X pause pause pause X /dialog-string X s lastnl 1 add 1 index length 1 index sub X getinterval X store X pause X } if X /s s skip 1 index length 1 index sub X getinterval store X /a newlines 1 add array store X 0 1 newlines 1 sub { X pause X /i exch store X s (\n) search pop X /pre exch store X pop X /s exch store X a i pre put X } for X X /dialog-string dialog-string s append store X X a newlines s put X a false writeatcaret X X /dialog-promptlines X newlines 1 add % dialog-string length 0 eq { 1 add } if X store X } def X X% XXXX: Here be the start of the trouble. X X /KeyboardHandler { % - => - X % --- Handler for keyboard, InsertValue, and Deselect events X /KeyboardInterest can addkbdinterests def X % X11/NeWS pre fcs: Now I don't get any key events at all when the X % meta keys is held down. I used to get 0..127, and I was looking X % for /Meta in the event KeyStates and or'ing in the 128 by hand, X % but it stopped working, so now I have to do this... X XNeWS? { % We want meta keys 128..255 as well as 0..127 X% KeyboardInterest 0 get revokeinterest % is this necessary? X 256 dict begin X KeyboardInterest 0 get /Name get currentdict copy X 128 1 255 { X dup def X } for X KeyboardInterest 0 get /Name currentdict put X end X% KeyboardInterest 0 get expressinterest % is this necessary? X } if X /MoreInterests [ X can addselectioninterests aload pop X revokeinterest % Get rid of mouse interests X% can addfunctionstringsinterest X can addfunctionnamesinterest X dup /Action 1 dict begin X /DownTransition dup def X currentdict X end X put % only want down transitions! X ] def X /dialog-proc currentprocess store X { awaitevent dup /Name get { X /DeSelect { X dup /Action get /PrimarySelection eq { X false DrawSelection X /SelectionPath null store X } if X /Action get /InputFocus eq { X InactivateCaret X } if X } X /RestoreFocus { X pop ReactivateCaret X } X /InsertValue { X /Action get InsertValueCallback X } X /Ignore { X pop X } X /Default { X KeyHitCallback X } X } case X } loop X } def X X /destroy { % - => - X /Scroller null store X /Notifier null store X KeyboardInterest null ne { X { KeyboardInterest can revokekbdinterests } errored pop X MoreInterests { X { revokeinterest } errored pop X } forall X } if X KeyboardEventMgr null ne { % added! -deh X KeyboardEventMgr killprocess X } if X EventMgr null ne { X EventMgr killprocess X } if X DelayedMoveProc null ne { % added! -deh X DelayedMoveProc killprocess X } if X MouseDragEventMgr null ne { X MouseDragEventMgr killprocess X } if X } def X X /CaretBlinkTime 3 def X /CaretDutyCycle 0.95 def % Percentage on X X % This doesn't work: X /FontHeight 12 def X /FontName FontName def X X [ () (%% Ready!) () ] false writeatcaret X X oncaret X } dialog-text send X X /Scroller X [1 0 .005 .05 null] 1 {} ItemCanvas /new NeWSScrollbar send X def X X /dialog-scroll Scroller store X X { X /NotifyUser { X null ItemValue /moveviewport dialog-text send X } def X X /ClientDrag { X DoScroll null ItemValue /moveviewport dialog-text send X } def X X /FakeScroll { % motion => - X ItemBegin X /ScrollMotion exch def X DoScroll X EraseBox PaintBox X NotifyUser X ItemEnd X } def X X /ScrollTo { % val => - X ItemBegin X /ItemValue exch def X EraseBox PaintBox X NotifyUser X ItemEnd X } def X X } Scroller send X X /Notifier X (Selected:) () /Right {} ItemCanvas /new MessageItem send X def X X { X /LabelFont /Courier findfont 20 scalefontquant def X /ItemFont /Courier-Bold findfont 20 scalefontquant def X /ItemFrame 1 def X } Notifier send X } if X X } def X X /dialog-newline { % str => - X psh-socket exch writestring X psh-socket 10 write X psh-socket flushfile X } def X X% /dialog-enter { % str => - X% /dialog-buf exch dialog-buf (%%\n) sprintf remove-returns store X% { dialog-buf X% { token } errored { X% [(%% Syntax error!)] false /writeatcaret dialog-text send X% kbd-reset exit X% } { X% { exch /dialog-buf exch store X% [ exch ] cvx execute-it X% } { X% dialog-buf ( _FOO_) append token { % Ignore white space X% exch pop /_FOO_ eq { X% /dialog-buf () store X% prompt X% } if X% } if X% exit X% } ifelse X% } ifelse X% pause X% } loop X% } def X X /dialog-enter { % str => - X dialog-newline X } def X X /destroy { X shut-down X SubItemMgr null ne { X SubItemMgr killprocess X /SubItemMgr null store X } if X dialog-text null ne { X% {{destroy} errored pop} dialog-text send X dialog-can /Retained false put X /destroy dialog-text send X /dialog-text null store X /dialog-can null store X } if X MyProcess type /processtype eq { X pause pause pause % maybe it will kill itsself X MyProcess killprocessgroup X } if X /MyProcess null store X /DeferedUpdateEvent null store X /Stack null store X /Pallets null store X /destroy super send X } def X Xclassend def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Nasty userdict variables X X/dialog-text null def X/dialog-can null def X/dialog-proc null def X/dialog-string () def X/dialog-buf () def X/dialog-promptlines 0 def X/dialog-item null def X/dialog-scroll null def X X(NEWSSERVER) getenv X(;) search pop X(.) search pop pop pop X/socket-port exch def Xpop X/socket-host exch def X/socket-file (%socketc) socket-port append socket-host append def X/psh-socket null def X X/SP 0 def X/Stack 256 array def XStack 0 {By Don Hopkins (don@brillig.umd.edu)} put XStack 1 (Nothing!) put X X/ThisI null def X X/it null def X/ob null def X/obs null def X X/FillColor 1 1 1 rgbcolor def X X/ItemLock createmonitor def X X/items [] def X/free-items [] def X X/Meta false def X/Control false def X/Shift false def X X/win null def X/can null def X X/slidemgr null def X/itemmgr null def X/incoming null def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Item managment X X/createitems { X ItemLock { X /items [ X Stack 0 {handle-click} can X /new StructItem send X 200 400 0 0 /reshape 5 index send X Stack 1 {} can X /new TextStructItem send X { /ObjectWidth 600 def X /ObjectHeight 200 def X 30 20 0 0 reshape X } 1 index send X ] def X /SP items length store X /dialog-item items 1 get store X {/PinHeight 600 def /StackI 1 def} dialog-item send X /ThisI 1 store X } monitor X} def X X/slideitem { % items fillcolor item => - X ItemLock { X gsave X% dup 4 1 roll % item items fillcolor item X {ItemCanvas canvastotop X moveinteractive location move} exch send % item X grestore X } monitor X} def X X/update-slide-interests { % event => - X CurrentEvent /ClientData get % Index X items exch get % item X dup /ItemCanvas get % item can X MiddleMouseButton [/pop cvx items FillColor % item can name [ dict color X 6 -1 roll /slideitem cvx] cvx % can name proc X DownTransition % can name proc action X 4 -1 roll eventmgrinterest % interest X expressinterest X pop X} def X X/update-start-interests { % event => - X CurrentEvent /ClientData get % Index X items exch get % item X mark X [/makestartinterests 3 index send aload pop] X {dup xcheck {exec} {expressinterest} ifelse} forall X cleartomark % event mark X pop pop % X} def X X/transfer-to-deck { % event => - X gsave X can setcanvas X selected-object X ItemLock { X 20 dict begin X /Obj exch def X currentcursorlocation X /NextY exch def /NextX exch def X free-items length 0 eq { X Stack SP /Obj load put X Stack SP {handle-click} can X /new StructItem send X /It exch def X /items [ X items aload pop X It X ] store X /I SP def X /SP SP 1 add store X It /StackI null put X createevent begin X /Name /UpdateInterests def X /Canvas can def X /ClientData I def X currentdict end sendevent X } { X /I free-items dup length 1 sub get def X /It items I get def X /free-items free-items 0 1 index length 1 sub getinterval store X It /StackI null put X /Obj load /Reuse It send X } ifelse X NextX NextY X { 2 copy 20 20 just-reshape X exch PinX sub exch move X map damage-view X } It send X pause pause X end X } monitor X grestore X pop X} def X X/start-event-mgrs { X% Create event manager to slide around the items. X% Create a bunch of interests to move the items. X% Note we actually create toe call-back proc to have the arguments we need. X% The proc looks like: {items color "thisitem" slideitem}. X% We could also have used the interest's clientdata dict. X slidemgr null ne {slidemgr killprocess} if X% { %XXX X% /slidemgr [ X% items { % key item X% dup /ItemCanvas get % item can X% MiddleMouseButton [items FillColor % item can name mark dict color X% 6 -1 roll /slideitem cvx] cvx % can name proc X% DownTransition % can name proc action X% 4 -1 roll eventmgrinterest % interest X% } forall X% /UpdateInterests /update-slide-interests X% null can eventmgrinterest X% ] forkeventmgr store X% } pop %XXX X itemmgr null ne {itemmgr killprocess} if X /itemmgr [ X items iteminterests aload pop X /UpdateInterests /update-start-interests X null can eventmgrinterest X /DoTransfer /transfer-to-deck X null can eventmgrinterest X ] forkeventmgr store X X { % send to dialog-item X psh-socket null eq { X X MyProcess null ne { MyProcess killprocessgroup } if X /MyProcess null store X incoming null ne { incoming killprocess } if X /incoming null store X X systemdict /_ViewCanvas ItemCanvas put X X /psh-socket { socket-file (r) file } errored { X { newprocessgroup X framebuffer setcanvas X 500 500 [(Could not establish connection)] popmsg pop X } fork pause pause pop X currentprocess killprocessgroup X } if store X X% /incoming { X% { { psh-socket CanWidth string readline false eq { X% [() (Lost it!) ()] false writeatcaret X% % 1 60 div sleep X% % /kbd-reboot dialog-item send X% /incoming null store X% currentprocess killprocess X% } if X% dialog-promptlines 0 ne { X% getcaretpos exch pop 1 exch dialog-promptlines sub 1 add X% dup dialog-promptlines exch deleteline X% movecaret X% /dialog-promptlines 0 store X% } if X% [ exch () X% ] false writeatcaret X% psh-socket bytesavailable 0 eq { prompt } if X% } loop X% } dialog-text send X% } fork store X X /incoming { X { { psh-socket CanWidth string readline false eq { X [() (Lost it!) ()] X false writeatcaret X % 1 60 div sleep X % /kbd-reboot dialog-item send X /incoming null store X currentprocess killprocess X } if X [ exch () X ] false writeatcaret X% psh-socket bytesavailable 0 eq { prompt } if X } loop X } dialog-text send X } fork store X X psh-socket X% (systemdict/dbgstart known not{(NeWS/debug.ps)run}if dbgstart\n_ReadyProcess\n) X (executive\n_ReadyProcess\n) % X11/NeWS pre fcs X writestring X psh-socket flushfile X } if X } dialog-item send X} def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Window class definition X X/DeckWindow DefaultWindow Xdictbegin X /FrameLabel (CyberSpace Deck) def X /IconLabel (CyberSpace Deck) def X /IconImage /galaxy def Xdictend Xclassbegin X /dragframe? true def X X /PaintClient { X paint-hilite X items paintitems X } def X X /paint-hilite { X ClientCanvas setcanvas X erasepage X /DrawHilite dialog-item send X } def X X /ClientMenu BackgroundMenu def X X /display-credits { X gsave X framebuffer setcanvas X currentcursorlocation X [ (CyberSpace Deck:) X ( by Don Hopkins) X (----------------) X (Code stolen from:) X ( Josh Siegel) X ( Don Woods) X ] popmsg pop X grestore X } def X X /DestroyClient { X { X newprocessgroup X FrameCanvas /Mapped false put X FrameCanvas /Retained false put X ClientCanvas /Retained false put X itemmgr type /processtype eq { itemmgr killprocess } if X slidemgr type /processtype eq { slidemgr killprocess } if X items null ne { X items X /items null store X { X /destroy exch send X } forall X } if X /_ViewCanvas null store X /PrimarySelection clearselection % XXX? X /DestroyClient super send X } fork pop X } def Xclassend def X X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% Create objects X X/win framebuffer /new DeckWindow send def % Create a window X X%0 0 900 900 /reshape win send X/reshapefromuser win send X/can win /ClientCanvas get def X X% BOO HISS Xcan /Parent get /Retained true put Xcreateitems X X% /reshapefromuser win send X/map win send Xstart-event-mgrs X Xbreakpoint % so we can catch stdout from psh //go.sysin dd * if [ `wc -c < cyber.ps` != 166395 ]; then made=false echo error transmitting cyber.ps -- echo length should be 166395, not `wc -c < cyber.ps` else made=true fi if $made; then chmod 644 cyber.ps echo -n ' '; ls -ld cyber.ps fi echo Extracting distill.ps sed 's/^X//' <<'//go.sysin dd *' >distill.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% @(#)distill.ps X% NeWS distillery X% Copyright (C) 1989. X% By Don Hopkins. (don@brillig.umd.edu) X% All rights reserved. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% You are free to redistribute this program. Please leave the comments X% intact, add your own interpretations, views, hallucinations, navagation X% aids, and pass it on to friends! The author is not responsible for any X% time or brain cells wasted with this software. X% X% The following is in the spirit of Glenn Reid's Distillery. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X Xsystemdict begin X X% X% X% litstring replace escapes in strings with escaped escapes! X% Thus (foo\n) products (\(foo\\n\)) which prints as (foo\n) X% Mainly used with printf when you want the arg to print as X% the string you typed to the interpreter. X% test: /s (\b\t\n\f\r\(\\\)\200\300) def s litstring X% X/litstring { % str => str' X [ X 40 3 -1 roll { X dup { X 8 9 10 12 13 { % \b \11 \n \f \r X (\\ ) dup 1 (--------btn-fr) 4 index get put X } X 40 41 92 { % ( ) & \ X (\\ ) 1 2 index put X } X% true { % all other chars X /Default { % all other chars X dup 32 lt 1 index 126 gt or { X (\\000) dup % i s s X 2 index dup 0 lt {256 add} if % BUG workaround X 8 4 string cvrs % i s s os X dup length 4 exch sub exch putinterval X } if X } X } case X dup type /stringtype eq {exch pop {} forall} if X } forall 41 % 41 is ')' X ] cvas X} def X X/StillDict 200 dict def XStillDict begin X X /_out null def X /_out? false def X% /_outfile (/dev/ttya) def X% /_outfile (%socketc2000) def X /_outfile (still_out.ps) def X X /_ascii? true def % false doesn't work yet because of typedprint X X /_display_def? false def X X /_showpage? true def X X /_eof? false def X X /_wrap_things? true def X X /_buf 80 string def X X /_smartcolor? false def X /_usefont? false def X X /_fonts 100 dict def X /_fcount 0 def X /_font null def X /_font_id null def X /_font_name null def X /_font_size null def X /_color null def X /_linecap null def X /_linejoin null def X /_linewidth null def X /_miterlimit null def X /_dashoff null def X /_dasharray null def X X /_output_flatness 0 def X X /_output_tx -80 def X /_output_ty -100 def X /_output_sx 2 def X /_output_sy 2 def X /_output_r 0 def X X /_outputmatrix matrix def X X /_MOVETO (m\n) def X /_LINETO (l\n) def X /_CURVETO (c\n) def X /_CLOSEPATH (p\n) def X /_CONTROLPOINT (k\n) def X /_FILL (f\n) def X /_EOFILL (e\n) def X /_STROKE (s\n) def X /_SHOW (t\n) def X /_NEWPATH (x\n) def X /_SETFONT (n\n) def X /_GSAVE (gs\n) def X /_GRESTORE (gr\n) def X /_SETGRAY (sg\n) def X /_SETHSBCOLOR (sh\n) def X /_SETLINECAP (sc\n) def X /_SETLINEJOIN (sj\n) def X /_SETLINEWIDTH (sw\n) def X /_SETMITERLIMIT (sm\n) def X /_SETDASH (sd\n) def X /_DISPLAYBEGIN (/display {\n) def X /_DISPLAYEND (} def\n) def X /_SHOWPAGE (showpage\n) def X /_SETUP () def X /_SETDOWN () def X /_STILLBEGIN ( X100 dict begin X X/m /moveto load def X/l /lineto load def X/c /curveto load def X/p /closepath load def X/k X /controlpoint where { /controlpoint get } { { pop lineto } } ifelse Xdef X/f /fill load def X/e /eofill load def X/s /stroke load def X/t /show load def X/x /newpath load def X/n /setfont load def X/gs /gsave load def X/gr /grestore load def X/sg /setgray load def X/sh /sethsbcolor load def X/sc /setlinecap load def X/sj /setlinejoin load def X/sw /setlinewidth load def X/sm /setmiterlimit load def X/sd /setdash load def X X) def X /_STILLEND (end % StillHeaderDict\n) def X /_BOF () def X /_EOF (\004) def X /_BEGINGROUP { ProcessMax 1 gt (\n) (% BeginGroup {\n) ifelse } def X /_ENDGROUP { ProcessMax 1 gt (\n) (%} EndGroup\n) ifelse } def X /_BEGINTHING ({\n) def X /_ENDTHING (} exec\n) def X X /_stillon { X /_out? true store X } def X X /_stilloff { X /_out? false store X } def X X /_stillbegin { X _init X _out null eq { X _out? { X systemdict /_printer known { X /_out _printer store X } { X /_out _outfile (w) file store X } ifelse X _eof? { _BOF _write_out } if X (%!\n%BoundingBox: % % % %\n/display_w % def\n/display_h % def\n\n) X [ (%) (%%) X gsave X clippath pathbbox X points2rect X 4 2 roll pop pop 0 0 4 2 roll X grestore X 2 copy X ] sprintf X _write_out X _display_def? { _DISPLAYBEGIN _write_out } if X _SETUP _write_out X _STILLBEGIN _write_out X _GSAVE _write_out X } { X NoStillDict begin X } ifelse X } if X } def X X /_stillend { X _out? { X _SETDOWN _write_out X _GRESTORE _write_out X _STILLEND _write_out X _display_def? { _DISPLAYEND _write_out } if X _showpage? { _SHOWPAGE _write_out } if X _eof? { _EOF _write_out } if X _out flushfile X systemdict /_printer known not { X _out closefile X } if X /_out null store X } if X currentdict NoStillDict eq { end } if X } def X X /_init { X gsave X _output_tx _output_ty translate X _output_sx _output_sy scale X _output_r rotate X _outputmatrix currentmatrix pop X grestore X /_fonts 100 dict store X /_fcount 0 store X /_font null store X /_color null store X /_linecap null store X /_linejoin null store X /_linewidth null store X /_miterlimit null store X /_dasharray null store X /_dashoff null store X _output_flatness setflat X } def X X /_write_out { X _out exch writestring X } def X X % XXX: Writes to stdout! X /_typed_out { X typedprint X } def X X /_write_string { X _ascii? { litstring _write_out } { _typed_out } ifelse X } def X X /_write_number { X _ascii? { _buf cvs _write_out ( ) _write_out } { _typed_out } ifelse X } def X X /_write_state { X _usefont? { X _font_id X /_font_id currentfont (%) sprintf store X _font_id ne X } false ifelse { X /_font_id currentfont (%) sprintf store X /_font_name currentfont /FontName get store X /_font_size currentfont /FontMatrix get 0 get store X _fonts _font_id (%) sprintf known { X _fonts _font_id get _write_out ( ) _write_out X } { X _fonts _font_id _fcount (_f%) sprintf put X _font_name (/% findfont ) sprintf _write_out X _font_size _write_number X _fcount (scalefont dup /_f% exch def ) sprintf _write_out X /_fcount _fcount 1 add store X } ifelse % (_f#) X _SETFONT _write_out X /_font currentfont store X } if X _smartcolor? { X % ... X } { X _color currentcolor ne { X currentrgbcolor X 1 index eq { eq } { pop pop false } ifelse { X currentgray _write_number _SETGRAY _write_out X } { X currenthsbcolor X 3 -1 roll _write_number exch _write_number _write_number X _SETHSBCOLOR _write_out X } ifelse X /_color currentcolor store X } if X } ifelse X _linecap currentlinecap ne { X currentlinecap _write_number _SETLINECAP _write_out X /_linecap currentlinecap store X } if X _linejoin currentlinejoin ne { X currentlinejoin _write_number _SETLINEJOIN _write_out X /_linejoin currentlinejoin store X } if X _miterlimit currentmiterlimit ne { X currentmiterlimit _write_number X _SETMITERLIMIT _write_out X /_miterlimit currentmiterlimit store X } if X gsave _outputmatrix setmatrix X _linewidth currentlinewidth ne { X currentlinewidth _write_number X _SETLINEWIDTH _write_out X /_linewidth currentlinewidth store X } if X currentdash exch _dashoff ne { pop false } { X dup length _dasharray length ne { pop false } { X _dasharray {eq} arrayop X true exch {not {not exit} if} forall X } ifelse X } ifelse { X currentdash exch X ([) _write_out { _write_number } forall (]) _write_out X _write_number X _SETDASH _write_out X currentdash /_dasharray exch store /_dashoff exch store X } if X grestore X } def X X /_write_path { X gsave _outputmatrix setmatrix X _output_flatness setflat X %flattenpath X { { exch _write_number _write_number X _MOVETO _write_out } X { exch _write_number _write_number X _LINETO _write_out } X { 6 -1 roll _write_number X 5 -1 roll _write_number X 4 -1 roll _write_number X 3 -1 roll _write_number X exch _write_number _write_number X _CURVETO _write_out } X { _CLOSEPATH _write_out } X% { 3 -1 roll _write_number exch _write_number _write_number X% _CONTROLPOINT _write_out } X } pathforallvec X grestore X } def X X /_begingroup { X _out? { X _BEGINGROUP _write_out X } if X } def X X /_endgroup { X _out? { X _ENDGROUP _write_out X } if X } def X X /_fill { X _out? { X gsave fill grestore X _write_path X _write_state X _FILL _write_out X newpath X } { X fill X } ifelse X } def X X /_eofill { X _out? { X gsave eofill grestore X _write_path X _write_state X _EOFILL _write_out X newpath X } { X eofill X } ifelse X } def X X /_stroke { X _out? { X gsave stroke grestore X _write_path X _write_state X _STROKE _write_out X newpath X } { X stroke X } ifelse X } def X X /_show { X _out? { X gsave X _write_state X _outputmatrix setmatrix X% _GSAVE _write_out X% _write_matrix X currentpoint exch _write_number _write_number X _MOVETO _write_out X dup _write_string X _SHOW _write_out X% _GRESTORE _write_out X grestore X } if X show X } def X X /_newpath { % signifies a new object X _out? { X _NEWPATH _write_out X } if X newpath X } def X Xend % StillDict X X/NoStillDict 200 dict def XNoStillDict begin X X /_init nullproc def X /_begingroup nullproc def X /_endgroup nullproc def X /_fill /fill load def X /_eofill /eofill load def X /_stroke /stroke load def X /_show /show load def X /_newpath /newpath load def X Xend % NoStillDict X Xend % systemdict //go.sysin dd * if [ `wc -c < distill.ps` != 9959 ]; then made=false echo error transmitting distill.ps -- echo length should be 9959, not `wc -c < distill.ps` else made=true fi if $made; then chmod 664 distill.ps echo -n ' '; ls -ld distill.ps fi echo Extracting ps.ps sed 's/^X//' <<'//go.sysin dd *' >ps.ps X%! X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% @(#)ps.ps X% PostScript meta-interpreter. X% Copyright (C) 1989. X% By Don Hopkins. (don@brillig.umd.edu) X% All rights reserved. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X% X% This program is provided for UNRESTRICTED use provided that this X% copyright message is preserved on all copies and derivative works. X% This is provided without any warranty. No author or distributor X% accepts any responsibility whatsoever to any person or any entity X% with respect to any loss or damage caused or alleged to be caused X% directly or indirectly by this program. If you have read this far, X% you obviously take this stuff far too seriously, and if you're a X% lawyer, you should give up your vile and evil ways, and go find X% meaningful employment. So there. X% X%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% X X% Problems: X% How do we catch the execution of event Name and Action dict values, X% executed by awaitevent? X Xsystemdict begin X X/iexec-types 100 dict def X/iexec-operators 100 dict def X/iexec-names 200 dict def X/iexec-exit-stoppers 20 dict def X/iexec-single-forall-types 20 dict def X/iexec-array-like-types 20 dict def X X/iexec-continue-procs? true def X/iexec-continue-names? true def X X/iexecing? false def X X/signal-error { % name => - X dbgbreak X} def X X/iexec-stopped-pending? { % - => bool X false X ExecSP 1 sub -1 0 { X ExecStack exch get % ob X dup type /dicttype eq { X dup /continuation known { X dup /continuation get /stopped eq { X pop true exit X } { pop } ifelse X } { pop } ifelse X } { pop } ifelse X } for X} def X X/olddbgerrorhandler /DbgErrorHandler load ?def X X/iexec-handle-error { X iexec-stopped-pending? X true { stoppedpending? } ifelse X { X /stop load PushExec X } { X $error /errorname get signal-error X } ifelse X} def X X/DbgErrorHandler { X iexecing? { X iexec-handle-error X } //olddbgerrorhandler ifelse X} def X X/isarray? { % obj => bool X type iexec-array-like-types exch known X} ?def X X% X% A procedure to allow programmer to know if there is a "stopped" X% pending somewhere within the scope of the call. This is used X% to check if it's safe to rely on stopped to handle an error, X% rather than the errordict. The debugger can use this to X% catch errors that have no stopped call pending. X% X/stoppedpending? { % - => bool X false currentprocess /ExecutionStack get % result a X dup length 1 sub -2 1 { % result a i X 2 copy get % result a i index X exch 1 sub 2 index exch get % result a index proc X dup isarray? { X exch 1 sub get % result a caller X /stopped load eq {pop true exch exit} if X } { X pop pop X } ifelse X } for X pop X} ?def X X/?iexec-handle-error { % - => - X { iexec-handle-error } if X} def X X% interpretivly execute an object X X/iexec { % obj => ... X 100 dict begin X % This functions "end"s the interpreter dict, executes an object in the X % context of the interpreted process, and "begin"'s back onto the X % interpreter dict. Note the circularity. X /MumbleFrotz [ % obj => ... X /end load /exec load currentdict /begin load X ] cvx def X X /ExecStack 32 array def X /ExecSP -1 def X X /PushExec [ % obj => - X /ExecSP dup cvx 1 /add load /store load X ExecStack /exch load /ExecSP cvx /exch load /put load X ] cvx def X X /PopExec [ % obj => - X ExecStack /ExecSP cvx /get load X /ExecSP dup cvx 1 /sub load /store load X ] cvx def X X /TraceStep { X iexec-step X } def X X PushExec X X { ExecSP 0 lt { nullproc exit } if % nothing left to execute? goodbye. X X ExecStack 0 ExecSP 1 add getinterval X TraceStep pop X X % pop top of exec stack onto the operand stack X PopExec X X % is it executable? (else just push literal) X dup xcheck { % obj X % do we know how to execute it? X dup type X //iexec-types 1 index known { % obj type X //iexec-types exch get exec % ... X } { % obj type X % some random type. just push it. X pop % obj X } ifelse X } if % else: obj X X } loop % goodbye-proc X X currentdict /MumbleFrotz undef % Clean up circular reference X end X exec % whoever exited the above loop left a goodbye proc on the stack. X} def X X% visually execute an object, dumping drawing of stacks to trace-file X X/vexec { % obj => ... X { { X ( X%! X/l { % gray x y lastx lasty X moveto X 2 copy lineto X 0 setgray X stroke X X 2 copy .3 0 360 arc X 0 setgray X fill X X .25 0 360 arc X setgray X fill X X pause X} def X/e { % x y => - X gsave X translate X 0 setlinewidth X 360 32 div rotate X 16 { X 0 0 moveto X 1 0 rlineto X 0 setgray X stroke X 1 0 .1 0 360 arc X random setgray X fill X 360 16 div rotate X } repeat X grestore X} def Xsystemdict /pause known not { X /pause {} def X} if Xgsave X20 20 scale X1 1 translate X0 setgray X0 setlinewidth Xerasepage X) X trace-print X /TraceX 0 def X /TraceY count 1 sub def X /TraceZ 0 def X /TraceStep { X% (\() print ExecSP iexec-printexec (\)print ) trace-print X TraceY TraceX % x y X /TraceX ExecSP def X /TraceY count 2 sub def X /TraceZ TraceZ 1 add 360 mod def X TraceZ 15 mul cos 1 add 3 div 1 exch sub trace-print# X TraceX trace-print# TraceY trace-print# X trace-print# trace-print# % print x,y X (l\n) trace-print X random .2 le { flush pause pause pause } if X } def X /signal-error { % name => - X /TraceX ExecSP def X /TraceY count 3 sub def X TraceX trace-print# TraceY trace-print# X (e\n) trace-print X (grestore showpage\n) trace-print trace-flush X /stop load PushExec X } def X } meta-exec X exec X (grestore showpage\n) trace-print trace-flush X } iexec X} def X X/trace-file (%socketc2000) (w) file def X X/trace-flush { X trace-file dup null eq { pop currentfile } if X flushfile X} def X X/trace-print { % string => - X trace-file dup null eq { pop currentfile } if X exch writestring X} def X X%/trace-print# {typedprint} def X%/trace-print# {=} def X/trace-print# { X (%\n) sprintf trace-print X} def X X/iexec-printexec { % index => - X ExecStack 1 index get X dup type /dicttype eq { X dup /namestring known { X begin namestring end X } if X } if X exch (% %\n) printf X} def X X/iexec-where { X 0 1 ExecSP { X iexec-printexec X } for X} def X X% execute step by step on the cyberspace deck stack display. X% To step, execute 'exit'. (make an 'exit' button to step with the mouse). X X/cexec { X { { /TraceStep { X ExecSP X iexec-printexec X select-object X /ThisStep ThisStep 1 add def X ThisStep Steps ge { X /ThisStep 0 def X _SendUpdateStack X eventloop X } if X null X } def X /Steps 1 def X /ThisStep 0 def X } meta-exec X exec X } iexec X} def X X/iexec-step { % operand stack ... execee X} def X X/iexec-sends { % - => context0 context1 ... contextn X ExecSP 1 sub -1 0 { X ExecStack exch get % ob X dup type /dicttype eq { X dup /continuation known { X dup /continuation get /send eq { X /context get X dup null eq { pop } if X } { pop } ifelse X } { pop } ifelse X } { pop } ifelse X } for X} def X X% Re-enter the NeWS PS interpreter, execute object, and return. X% We need to construct the currentprocess's /SendStack from the interpreter's X% send stack, so ThisWindow and other functions that look at the SendStack X% will work. X/iexec-reenter { % obj => ... X mark X /ParentDictArray where pop X iexec-sends % obj mark context0 context1 ... contextn X { { % obj mark context0 context1 ... contextn {func} X 1 index mark eq { % obj mark {func} X pop pop % obj X {exec} stopped % ... bool X } { % obj mark context0 context1 ... contextn {func} X dup 3 -1 roll send % ... X } ifelse X } dup exec X } MumbleFrotz X ?iexec-handle-error X} def X Xiexec-array-like-types begin X /arraytype true def X /packedarraytype true def Xend % iexec-array-like-types X X/iexec-token { % token => ... X dup xcheck { X % This is the "weird" thing about PostScript: X % If object is isn't an executable array, execute it, else push it. X //iexec-array-like-types 1 index type known not { PushExec } if X } if X} def X Xiexec-types begin X X /nametype { % name => ... X pause X iexec-continue-names? { X % We push a dummy name continuation on the exec stack here to X % help with debugging, by making stack dumps more informative... X 10 dict begin X /continuation /name def X /continue { % dict X pop X } def X /name 1 index def X /namestring { X /name load cvlit (name: % *done*) sprintf X } def X currentdict cvx PushExec X end X } if X //iexec-names 1 index known { % name X //iexec-names exch get % func X exec % X } { X % name X {{load}stopped} MumbleFrotz { X true ?iexec-handle-error X } { X PushExec X } ifelse X } ifelse X } def X X /arraytype { % array => ... X iexec-continue-procs? { X 10 dict begin X /continuation /procedure def X /proc exch def X /i 0 def X /len /proc load length def X /continue { % dict => - X begin X i len lt { X currentdict cvx PushExec X /proc load i get iexec-token X /i i 1 add def X } if X end X } def X /namestring { X (procedure % @ %: %) X [ /proc load i X 1 index length 1 index gt { 2 copy get } (*done*) ifelse X ] sprintf X } def X currentdict cvx PushExec X end X } { X dup length dup 0 eq { % array length X pop pop % X } { % array length X 1 eq { % array X 0 get % X iexec-token % X } { % array X dup 0 get % array head X % push rest of array to execute later X exch 1 1 index length 1 sub getinterval % head tail X PushExec % head X iexec-token % X } ifelse X } ifelse X } ifelse X } def X X /packedarraytype /arraytype load def X X /stringtype { % string => ... X dup token { % string rest token X exch dup length 0 eq { pop } { PushExec } ifelse % string token X exch pop % token X iexec-token % ... X } { % str X dup length 0 eq { X pop % X } { % str X /syntax signal-error X } ifelse X } ifelse X } def X X /filetype { % file => - X dup token { % file token X exch dup % token file file X status { PushExec } { pop } ifelse % token X iexec-token % ... X } { % file X dup status { X /syntax signal-error X } { X pop X } ifelse X } ifelse X } def X X /operatortype { % operator => - X //iexec-operators 1 index known { X //iexec-operators exch get exec X } { X {{exec}stopped} X MumbleFrotz X ?iexec-handle-error X } ifelse X } def X X /dicttype { % dict => - X dup /continuation known { X dup /continue get exec X } if X } def X Xend % iexec-types X Xiexec-operators begin X X /exec load { % obj => - X PushExec X } def X X /if load { % bool proc => - ======== END OF cyber.shar.splitaf ======== From don Thu Nov 23 02:00:35 1989 Date: Thu, 23 Nov 89 02:00:35 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitag From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitag ======== X exch { X PushExec X } { X pop X } ifelse X } def X X /ifelse load { % bool trueproc falseproc X 3 -1 roll { exch } if % wrongproc rightproc X PushExec pop X } def X X iexec-single-forall-types begin X {/arraytype /packedarraytype /stringtype} X {true def} forall X end % iexec-single-forall-types X X /forall load { % obj proc => - X 10 dict begin X /continuation /forall def X /proc exch def X /obj exch cvlit def X /i 0 def X //iexec-single-forall-types obj type known { X /continue { % dict => - X begin X i obj length lt { X currentdict cvx PushExec X obj i get X /proc load PushExec X /i i 1 add def X } if X end X } def X /namestring { X (forall: proc=% obj=% @ %: %) X [ /proc load /obj load i X 1 index length 1 index gt { 2 copy get } (*done*) ifelse X ] sprintf X } def X } { X /keys [ X obj {pop} forall X ] def X /continue { % dict => - X begin X i obj length lt { X currentdict cvx PushExec X keys i get % key X obj 1 index get % key val X /proc load PushExec X /i i 1 add def X } if X end X } def X /namestring { X (forall: proc=% obj=% @ %: %) X [ /proc load /obj load X keys i X 1 index length 1 index gt { X get 2 copy get X } { X pop null (*done*) X } ifelse X ] sprintf X } def X } ifelse X currentdict cvx PushExec X end X } def X X /for load { % first step last proc X 10 dict begin X /continuation /for def X /proc exch def X /last exch def X /step exch def X /first exch def X /i first def X /continue { % dict => - X begin X i last step 0 gt {le} {ge} ifelse { X currentdict cvx PushExec X i X /proc load PushExec X /i i step add def X } if X end X } def X /namestring { X (for: proc=% first=% step=% last=% i=%) X [/proc load first step last i] sprintf X } def X currentdict cvx PushExec X end X } def X X /repeat load { X 10 dict begin X /continuation /repeat def X /proc exch def X /times exch def X /i 0 def X /continue { % dict => - X begin X i times lt { X currentdict cvx PushExec X /proc load PushExec X /i i 1 add def X } if X end X } def X /namestring { X (repeat: proc=% times=% i=%) X [/proc load times i] sprintf X } def X currentdict cvx PushExec X end X } def X X /loop load { X 10 dict begin X /continuation /loop def X /proc exch def X /continue { % dict => - X begin X currentdict cvx PushExec X /proc load PushExec X end X } def X /namestring { X /proc load (loop: proc=%) sprintf X } def X currentdict cvx PushExec X end X } def X X /pathforallvec load { X%... X } def X X iexec-exit-stoppers begin X {/forall /for /repeat /loop /pathforallvec} X {true def} forall X end % iexec-exit-stoppers X X /exit load { X { ExecSP 0 lt { % exit out of interpreter? X true exit X } { X PopExec % obj X dup dup xcheck exch type /dicttype eq and { % obj X dup /continuation known { X dup /continuation get iexec-exit-stoppers exch known { X pop false exit X } { X pop X } ifelse X } { X pop X } ifelse X } { % obj X pop X } ifelse X } ifelse X } loop X X { {exit} exit } if X } def X X /stop load { X { ExecSP 0 lt { % stop out of interpreter? X true exit X } { X PopExec % obj X dup dup xcheck exch type /dicttype eq and { % obj X dup /continuation known { X dup /continuation get /stopped eq { X pop true false exit X } { X pop X } ifelse X } { X pop X } ifelse X } { % obj X pop X } ifelse X } ifelse X } loop X X { {stop} exit } if X } def X X /stopped load { % proc X 10 dict begin X /continuation /stopped def X /continue { % dict => - X pop false X } def X /proc 1 index def % debugging X /namestring { X /proc load (stopped: proc=%) sprintf X } def X currentdict cvx PushExec X PushExec X end X } def X X /send load { % message object => X { currentdict } MumbleFrotz % message object context X 2 copy eq { % message object context X pop pop cvx PushExec X } { % message object context X 10 dict begin X /continuation /send def X /context X exch dup /ParentDictArray known not { pop null } if X def % message object X /object exch def % message X /message 1 index def % message X /continue { % cdict => - X { % cdict X ParentDictArray dup type /arraytype ne { % X11/NeWS X /ParentDictArray get length 1 add X } { X length X } ifelse X 1 add {end} repeat X /context get % context X dup null eq { % context X pop % X } { % idict context X dup /ParentDictArray get {begin} forall begin % X } ifelse % X } MumbleFrotz X } def X /unwind /continue load def X /namestring { X (send: message=% object=% context=%) X [/message load object context] sprintf X } def X currentdict cvx PushExec X object context % message object context X end % of cdict X { null ne { X ParentDictArray length 1 add {end} repeat X } if X dup /ParentDictArray get X dup type /arraytype ne { % X11/NeWS X dup /ParentDictArray get X {begin} forall begin begin % message X } { X {begin} forall begin % message X } ifelse X } MumbleFrotz % message X cvx PushExec % X } ifelse X } def X X% supersend (operator in X11/NeWS, proc in 1.1?) X X /currentfile load { % => file X null X ExecStack length 1 sub -1 0 { X ExecStack exch get % obj X dup type /filetype eq { X exit X } { X pop X } ifelse X } for X dup null eq { X pop currentfile X } { X exch pop X } ifelse X } def X X % We have to have the send contexts set up right when we do a fork, since X % the child process inherits them. (i.e. so ThisWindow works) X /fork load { X {fork} iexec-reenter X } def X X /countexecstack load { X /countexecstack dbgbreak X } def X X /quit load { X /quit dbgbreak X } def X Xend % iexec-operators X Xiexec-names begin X X /sendstack { X [ iexec-sends X currentprocess /SendContexts get aload pop X ] X } def X X /iexecing? true def X X % meta-exec is a hook back up to the interpreter context. X /meta-exec { X exec X } def X X /append { X {{append} stopped} MumbleFrotz X ?iexec-handle-error X } def X X /sprintf { X {{sprintf} stopped} MumbleFrotz X ?iexec-handle-error X } def X X% execstack X Xend % iexec-names X Xend % systemdict X //go.sysin dd * if [ `wc -c < ps.ps` != 17287 ]; then made=false echo error transmitting ps.ps -- echo length should be 17287, not `wc -c < ps.ps` else made=true fi if $made; then chmod 664 ps.ps echo -n ' '; ls -ld ps.ps fi echo Extracting scrap.ps sed 's/^X//' <<'//go.sysin dd *' >scrap.ps X% From owen@Sun.COM Mon Dec 12 21:12:13 1988 X% Date: Mon, 5 Dec 88 11:25:55 PST X% From: owen@Sun.COM (Owen Densmore) X% To: don@amanda.cs.umd.edu X% Subject: Re: scrap.ps & codebook.ps X% X% The scrap.ps file is possibly not that interesting because it X% is fairly out of date. I'll send anyway. X% =============================================================== X% scrap.ps X% Anybody can pick over these for whatever purpose they'd like. X% They are random pieces used in a class given at Sun for X% tech support engineers. X% Note: The /demo procedures included below are small code X% fragments illustrating various parts of the system. X% Because they all have the same name, each one should X% be cut & paste to NeWS individually, as needed. X% =============================================================== X% Misc: X% =============================================================== X/cds {countdictstack =} def X/ps {pstack} def X/fb {framebuffer} def X/temp { X executive systemdict begin (~/ps/server/NeWS/scrap.ps)run end X} def X/scrap {(~/ps/server/NeWS/scrap.ps)run} def X% --------------------------------------------------------- X/setshade { % GrayOrColor => - (set gray or color) X dup type /colortype eq {setcolor} {setgray} ifelse X} def X% --------------------------------------------------------- X/fillcanvas { % GrayOrColor => - (Fills current canvas w/ GrayOrColor) X setshade clippath fill X} def X% --------------------------------------------------------- X/insetrect { % delta x y w h => x' y' w' h' (return new rect inset by delta) X10 dict begin X [/h /w /y /x /delta] {exch def} forall X x delta add y delta add w delta dup add sub h delta dup add sub Xend X} def X% --------------------------------------------------------- X/rectpath { % x y w h => - (make a rect path) X 4 2 roll moveto X dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath X} def X% --------------------------------------------------------- X/ovalpath { % x y w h => - (make a oval path) X matrix currentmatrix 5 1 roll % xfm x y w h X 4 2 roll translate scale % xfm X .5 .5 translate 0 0 .5 0 360 arc closepath % xfm X setmatrix % - X} def X% --------------------------------------------------------- X/starpath { % x y w h => - (make a star path) X matrix currentmatrix 5 1 roll % xfm x y w h X 4 2 roll translate scale % xfm X .2 0 moveto .5 1 lineto .8 0 lineto % xfm X 0 .65 lineto 1 .65 lineto closepath % xfm X setmatrix % - X} def X% =============================================================== X% Canvases: X% =============================================================== X/demo { Xgsave X framebuffer setcanvas X 100 100 translate 0 0 300 300 rectpath X X /can framebuffer newcanvas def X can reshapecanvas X can /Mapped true put X X can setcanvas .5 fillcanvas Xgrestore X} def X% --------------------------------------------------------- X/pathcanvas { % x y w h parent path => canvas (make a "path" shaped canvas) X10 dict begin X gsave X cvx [/path /parent /h /w /y /x] {exch def} forall X /can parent newcanvas def X X parent setcanvas X x y translate 0 0 w h path X X can reshapecanvas X can /Mapped true put X can X grestore Xend X} def X% --------------------------------------------------------- X/rectcanvas { {rectpath} pathcanvas } def % x y w h parent => canvas X/rectcanvas { /rectpath pathcanvas } def % x y w h parent => canvas X X/demo { X /can 100 100 200 200 framebuffer rectcanvas def X can setcanvas .5 fillcanvas X} def X% --------------------------------------------------------- X/ovalcanvas { {ovalpath} pathcanvas } def % x y w h parent => canvas X X/demo { X /can 100 100 200 200 framebuffer ovalcanvas def X can setcanvas .5 fillcanvas X} def X% --------------------------------------------------------- X/starcanvas { {starpath} pathcanvas } def % x y w h parent => canvas X X/demo { X /can 100 100 200 200 framebuffer starcanvas def X can setcanvas .5 fillcanvas X} def X% =============================================================== X% Sub Canvases: X% =============================================================== X/demo { X /can 100 100 200 200 framebuffer rectcanvas def X /can1 10 10 180 180 can rectcanvas def X can setcanvas .5 fillcanvas X can1 setcanvas 1 fillcanvas X} def X% --------------------------------------------------------- X/demo { X /can 100 100 200 200 framebuffer ovalcanvas def X /can1 10 10 180 180 can ovalcanvas def X can setcanvas .5 fillcanvas X can1 setcanvas 1 fillcanvas X} def X% --------------------------------------------------------- X/demo { X /can 100 100 200 200 framebuffer starcanvas def X /can1 25 25 150 150 can starcanvas def X can setcanvas .5 fillcanvas X can1 setcanvas 1 fillcanvas X} def X% --------------------------------------------------------- X/demo { X /look { % canvas => - (print a canvas & its sub-tree) X countdictstack 2 sub {( ) print} repeat dup == X begin X TopChild null ne {TopChild look} if X CanvasBelow X end X dup null ne {look} {pop} ifelse X } def X framebuffer look X} def X% =============================================================== X% Transparency: X% =============================================================== X/demo { % transparent? => - (make /can & /can1) Xgsave X framebuffer setcanvas X 100 100 translate 0 0 300 300 rectpath X X /can framebuffer newcanvas def X can reshapecanvas X can /Mapped true put X X can setcanvas X 75 75 translate 0 0 150 150 ovalpath X X /can1 can newcanvas def X can1 reshapecanvas X can1 /Transparent 3 -1 roll put X can1 /Mapped true put Xgrestore X} def X X/demo1 { X true demo X can1 setcanvas .5 fillcanvas X can setcanvas 0 fillcanvas X can1 setcanvas .5 fillcanvas X X false demo X can1 setcanvas .5 fillcanvas X can setcanvas 0 fillcanvas X} def X% =============================================================== X% Overlay Canvases: X% =============================================================== X/demo { % needs /can to be defined X /Times-Roman findfont 36 scalefont setfont X X /olay can createoverlay def X can setcanvas 1 fillcanvas X 0 setshade 20 20 moveto (Here Is Some Text) show X olay setcanvas X X 0 fillcanvas X erasepage X X 20 20 50 50 ovalpath stroke X 20 100 moveto (Here Is Some Text) show X erasepage X} def X% =============================================================== X% Lightweight Processes X% =============================================================== X/demo { X /p {2 2 add} def X p = X % 4 X /pp {p} fork def X pp = X % process(7663140, runnable) X pp waitprocess = X % 4 X} def X% --------------------------------------------------------- X/demo { X /p {2 2 add} fork def X p = X % process(7762460, runnable) X pause X p = X % process(7762460, zombie) X p waitprocess = X % 4 X} def X% --------------------------------------------------------- X/demo { X /p {1 2 3} fork def X p waitprocess = X % 3 X /p {[1 2 3]} fork def X p waitprocess dup == X % [1 2 3] X aload pop ps clear X % 1 2 3 X} def X% --------------------------------------------------------- X/demo { X clear X /a 1 def X /p null def X /peek { % - => array (Return an array showing the current status.) X [ count 1 roll ] X [ exch X (Dictstack=% a=% Stack=) [countdictstack a] sprintf X exch X ] X } def X X 10 dict begin X /a 10 def X (Hi!) X /p { X peek X } fork store X pop X end X X peek == X % [(Dictstack=2 a=1 Stack=) []] X p waitprocess == X % [(Dictstack=3 a=10 Stack=) [(Hi!) /p]] X} def X/demo { X /a 1 def X /PrintStatus { % - => - (Print current processes status.) X (State of process:%\n a=% Dictstack=% stack=) X [currentprocess a countdictstack] printf X pstack X } def X X PrintStatus X X%State of process:process(2222550, runnable) X% a=1 Dictstack=2 stack=Empty stack X X 10 dict begin X /a 10 def X (Hi!) X /p { X PrintStatus X } fork store X pop X end X X%State of process:process(4041374, runnable) X% a=10 Dictstack=3 stack=(Hi!) /p X} def X% =============================================================== X% Events & Interests X% =============================================================== X/snoop { X /snoopprocess { X createevent expressinterest {awaitevent dup == redistributeevent} loop X } fork def X} def X/killsnoop {snoopprocess killprocess} def X X/demo { X snoop X% event(0x1f7f3c, [382,223], name(/MouseDragged), action(null)) X% event(0x1f42f0, [382,223], name(/LeftMouseButton), action(/DownTransition)) X% event(0x1f7f3c, [382,223], name(/LeftMouseButton), action(/UpTransition)) X% event(0x1f7f3c, [382,223], name(28493), action(/DownTransition)) X% event(0x1f7f3c, [382,223], name(28493), action(/UpTransition)) X% event(0x1f42f0, [356,229], name(/MouseDragged), action(null)) X killsnoop X} def X% --------------------------------------------------------- X/settarget { % - => - (set tty target = current selection holder) X /TtyTarget createevent dup begin X /Name /InsertValue def X /Process /PrimarySelection getselection /SelectionHolder get def X /Canvas /PrimarySelection getselection /Canvas get def X end def X} def X X/sendtarget { % string => - (send string to current tty target) X TtyTarget /Action 3 -1 roll put X TtyTarget sendevent X} def X X/demo { X settarget X (ls\n) sendtarget X (ps\n) sendtarget X} def X X/demo { X settarget X ( X 1 2 add = X ) sendtarget X} def X/demo { X settarget X(/settarget { % - => - (set tty target = current selection holder) X /TtyTarget createevent dup begin X /Name /InsertValue def X /Process /PrimarySelection getselection /SelectionHolder get def X /Canvas /PrimarySelection getselection /Canvas get def X end def X} def X X/sendtarget { % string => - (send string to current tty target) X TtyTarget /Action 3 -1 roll put X TtyTarget sendevent X} def X) sendtarget X} def X% --------------------------------------------------------- X/demo { X /sendtimeevent { % timedelta => - X createevent begin X /Name /Timer def X /TimeStamp exch currenttime add def X currentdict X end sendevent X } def X X /p { X /timercount 0 def X createevent dup /Name /Timer put expressinterest X { awaitevent pop X (Tick\n) print X /timercount timercount 1 add def X timercount 10 eq {exit} if X 1 60 div sendtimeevent X } loop X } fork def X X p = X (Starting processes:\n) print X 1 60 div sendtimeevent X p waitprocess pop X p = X% process(2716670, runnable) X% Starting processes: X% Tick X% Tick X% Tick X% Tick X% Tick X% Tick X% Tick X% Tick X% Tick X% Tick X% process(2716670, zombie) X} def X% --------------------------------------------------------- X/demo { X /sendnameevent { % name => - X createevent dup /Name 4 -1 roll put sendevent X } def X X /p1 { X /p1count 0 def X createevent dup /Name /Tick put expressinterest X { awaitevent pop X (Tick ) print X /Tock sendnameevent X /p1count p1count 1 add def X p1count 10 eq {exit} if X } loop X } fork def X X /p2 { X /p2count 0 def X createevent dup /Name /Tock put expressinterest X { awaitevent pop X (Tock!\n) print X /Tick sendnameevent X /p2count p2count 1 add def X p2count 10 eq {exit} if X } loop X } fork def X X p1 = p2 = X (Starting processes:\n) print X /Tick sendnameevent X 21 {pause} repeat X p1 = p2 = X% process(4244540, input_wait) X% process(2716670, runnable) X% Starting processes: X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% Tick Tock! X% process(4244540, zombie) X% process(2716670, zombie) X} def X% =============================================================== X% ADD MONITORS X% =============================================================== X X% =============================================================== X% Keyboard X% =============================================================== X/snoop { X /snoopprocess { X createevent dup /Priority 10 put expressinterest X {awaitevent dup == redistributeevent} loop X } fork def X} def X/killsnoop {snoopprocess killprocess} def X X% snoop X% event(0x27836C, [184,325], name(/MouseDragged), action(null)) X% event(0x27836C, [186,325], name(28493), action(/DownTransition)) X% event(0x24C17C, [186,325], name(28493), action(/UpTransition)) X% event(0x27836C, [186,325], name(/RightMouseButton), action(/DownTransition)) X% event(0x26CFA4, [170,324], name(/RightMouseButton), action(/UpTransition)) X% event(0x279564, [0,0], name(/DoItEvent), action(/Window)) X% event(0x24C1D8, [169,324], name(/MouseDragged), action(null)) X% killsnoop X X% --------------------------------------------------------- X/demo {( X% Text Sample (Jerry Farrell) X/MaxLen 1024 def X/buffer MaxLen string def X/buflen 0 def X X/addchar { X buflen MaxLen lt { X buffer buflen Name put X /buflen buflen 1 add store X } if X} def X/backchar { X buflen 0 gt { X /buflen buflen 1 sub store X } if X} def X/clearline { X /buflen 0 def X} def X/replaceline { X Action length MaxLen gt { X /Action Action 0 MaxLen getinterval def X } if X buffer 0 Action putinterval X /buflen Action length store X} def X X/namedict dictbegin X 8 /backchar load def % BS X 10 /clearline load def % LF X 13 /clearline load def % CR X 21 /clearline load def % ^U X 32 1 126 { /addchar load def } for % printable characters X 127 /backchar load def % DEL X /InsertValue /replaceline load def % strings Xdictend def X X/win framebuffer /new DefaultWindow send def X{ /PaintClient { X 1 fillcanvas 0 setgray 10 10 moveto X buffer 0 buflen getinterval show X } def X /FrameLabel (Text Example) def X /DestroyClient { X kbdinterests ClientCanvas revokekbdinterests X KbdHandler killprocessgroup X } def X} win send X/reshapefromuser win send X/map win send X X/KbdHandler { X /kbdinterests win /ClientCanvas get addkbdinterests def X { awaitevent begin X namedict Name known { X namedict Name get exec X /paintclient win send X } if X end X } loop X} fork def X) runprogram }def X% --------------------------------------------------------- X/seteventmgrcallback { % interest proc => - X /ClientData 10 dict dup /CallBack 5 -1 roll put put X} def X/eventmgrkbdinterest { % callback can Editkeys? Fnames? Fstrings? => proc X [6 1 roll] { X 3 index addkbdinterests % p can E? FN? FS? a X exch {[4 index addfunctionstringsinterest] append} if % p can E? FN? a X exch {[3 index addfunctionnamesinterest] append} if % p can E? a X exch {[2 index addeditkeysinterest] append} if % p can a X {2 index seteventmgrcallback} forall % p can X pop pop X } append cvx X} def X/demo { X framebuffer setcanvas X 100 100 translate 0 0 300 300 rectpath X /can framebuffer newcanvas def X can reshapecanvas X can /Mapped true put X can setcanvas .5 fillcanvas X X /MyEventProc {==} def X /p [ X PointButton {interactivemove .5 fillcanvas} X /DownTransition can eventmgrinterest X X {MyEventProc} can true true false eventmgrkbdinterest X ] forkeventmgr def X} def X% =============================================================== X% User Interaction X% =============================================================== X/interact { % proc startup? => result X% Repeatedly call proc, with x0 y0 x y defined in a local X% dictionary, whenever MouseDragged & MouseUp. If startup? X% also call on initial MouseDown. Returns TOS of tracker. X% Uses "callback" procedures stored in interests. X20 dict begin X /startup? exch def X /proc exch cvx def X X currentcursorlocation /y0 exch def /x0 exch def X /x x0 def /y y0 def X /callproc {/x XLocation store /y YLocation store proc} def X X MakeInteractInterests X X { startup? X {[StartInterest]} X {proc [TrackInterest StopInterest]} ifelse X {expressinterest} forall X { awaitevent begin X Interest /ClientData get exec X end X } loop X } fork waitprocess Xend X} def X X/MakeInteractInterests { % proc startup? X /StartInterest createevent dup begin X /Name [/LeftMouseButton /RightMouseButton /MiddleMouseButton] def X /Action /DownTransition def X /ClientData { X /x0 XLocation store /y0 YLocation store X StopInterest /Name Name put X TrackInterest expressinterest X StopInterest expressinterest X callproc X } def X end def X /TrackInterest createevent dup begin X /Name /MouseDragged def X /ClientData {callproc} def X end def X /StopInterest createevent dup begin X /Action /UpTransition def X /ClientData {callproc exit} def X end def X} def X% --------------------------------------------------------- X/demo { X /p { (x0=% y0=% x=% y=%\n) [x0 y0 x y] printf } def X /p true interact == X /p false interact == X% x0=463 y0=283 x=463 y=283 X% x0=463 y0=283 x=422 y=267 X% x0=463 y0=283 x=298 y=193 X% x0=463 y0=283 x=238 y=153 X% x0=463 y0=283 x=10 y=59 X% x0=463 y0=283 x=-64 y=37 X% x0=463 y0=283 x=-66 y=35 X% x0=463 y0=283 x=-66 y=35 X% null X} def X% --------------------------------------------------------- X/calcbbox {x0 x min y0 y min x x0 sub abs y y0 sub abs} def X/getbbox { % canvas pathproc startup? => [x y w h] (relative to canvas) X gsave X 3 -1 roll createoverlay setcanvas % pathproc bool X { erasepage calcbbox X 4 index cvx exec stroke % use the path proc X Action /UpTransition eq { X erasepage [calcbbox] X } if X } exch interact % pathproc array X exch pop % array X grestore X} def X X/demo { X framebuffer /starpath true getbbox X /can exch aload pop framebuffer starcanvas def X can setcanvas .5 fillcanvas X} def X% --------------------------------------------------------- X/canvasfromuser { % parent pathproc => canvas X 2 copy true getbbox aload pop % parent proc x y w h X 6 -2 roll pathcanvas % canvas X} def X X/demo { X /can framebuffer /starpath canvasfromuser def X can setcanvas .5 fillcanvas X} def X% --------------------------------------------------------- X/slidecanvas { % canvas startup? => - (interactively move canvas) X gsave X 1 index /Parent get setcanvas X {gsave dup setcanvas x y movecanvas grestore} exch interact X pop pop X grestore X} def X/slidecanvas { % canvas startup? => - (interactively move canvas) X gsave X exch dup /Parent get setcanvas % bool canvas (parent=current) X dup getcanvaslocation % bool canvas x1 y1 X { gsave 2 index setcanvas % canvas x1 y1 X x x0 sub 2 index add % canvas x1 y1 x X y y0 sub 2 index add movecanvas % canvas x1 y1 X grestore X } 5 -1 roll interact % canvas x1 y1 result X pop pop pop pop X grestore X} def X X/demo { X can true slidecanvas X} def X% =============================================================== X% Utilities X% =============================================================== X/isutility { % keyword => bool X load type /arraytype eq = X} def X X/demo { X /add isutility X % false X /rectpath isutility X % true X X% forkeventmgr: interests => process (fork a process with these interests) X% eventmgrinterest: eventname eventproc action canvas => interest X X} def X% =============================================================== X% Classes X% =============================================================== X/temp { % FCS documentation X X/Foo Object % Foo is a subclass of Object Xdictbegin % (initialized) instance variables X /Value 0 def X /Time null def Xdictend Xclassbegin X /ClassTime currenttime def % The class variable "ClassTime". X X % class methods X /new { % - => - (Make a new Foo) X /new super send begin X /resettime self send X currentdict X end X } def X /printvars { % - => - (Print current state) X (..we got: Value=%, Time=%.\n) [Value Time] printf X } def X /changevalue { % value => - (Change the value of "Value") X /Value exch def X } def X /resettime { % - => - (Change Time to the current time) X /Time currenttime def X } def Xclassend def X X/foo /new Foo send def X/printvars foo send X% ..we got: Value=0, Time=1.31435. X X(A String) /changevalue foo send X/printvars foo send X% ..we got: Value=A String, Time=1.31435. X X/resettime foo send X/printvars foo send X% ..we got: Value=A String, Time=1.31667. X X{/Time ClassTime def} foo send X/printvars foo send X% ..we got: Value=A String, Time=1.31168. X X{currenttime Time sub round /changevalue self send} /doit foo send X/printvars foo send X% ..we got: Value=0, Time=1.31168. X X{currenttime 60 mul round} /changevalue foo send X/printvars foo send 1000 {pause} repeat /printvars foo send X% ..we got: Value=79, Time=1.31168. X% ..we got: Value=81, Time=1.31168. X X} def X% =============================================================== X/demo { % page 62-65 of smalltalk blue book X /One Object [] classbegin X /test {1} def X /result1 {/test self send} def X classend def X X /Two One [] classbegin X /test {2} def X classend def X X /ex1 /new One send def X /ex2 /new Two send def X X /test ex1 send = X /result1 ex1 send = X /test ex2 send = X /result1 ex2 send = X X /Three Two [] classbegin X /result2 {/result1 self send} def X /result3 {/test super send} def X classend def X /Four Three [] classbegin X /test {4} def X classend def X X /ex3 /new Three send def X /ex4 /new Four send def X X /test ex3 send = X /result1 ex4 send = X /result2 ex3 send = X /result2 ex4 send = X /result3 ex3 send = X /result3 ex4 send = X} def X% =============================================================== X/Canvas Object [/TheCanvas /EventMgr /Height /Width] Xclassbegin X /FillColor 1 1 1 rgbcolor def X /EdgeColor .5 .5 .5 rgbcolor def X /EdgeSize 8 def X X /new { % ParentCanvas => instance X /new super send begin X /TheCanvas exch newcanvas store X currentdict X end X } def X X /path {rectpath} def % x y w h => - (currentpath now is my kind of path) X X /reshape { % x y w h => - X gsave X TheCanvas /Parent get setcanvas X /Height exch def /Width exch def translate X 0 0 Width Height /path self send X TheCanvas reshapecanvas X grestore X } def X X /reshapefromuser { % - => - X TheCanvas /Parent get /path true getbbox X aload pop /reshape self send X } def X X /paint { % - => - X gsave X TheCanvas setcanvas X EdgeColor fillcanvas FillColor setcolor X EdgeSize 0 0 Width Height % delta x y w h X insetrect /path self send % - X fill X grestore X } def X X /fix { % - => - X gsave X TheCanvas setcanvas X damagepath clipcanvas X /paint self send X newpath clipcanvas X grestore X } def X X /map { % - => - X EventMgr null eq {/fork self send} if X TheCanvas /Mapped true put X } def X X /fork { % - => - X /EventMgr [ X PointButton {TheCanvas canvastotop} X /DownTransition TheCanvas eventmgrinterest X X AdjustButton {TheCanvas false slidecanvas} X /DownTransition TheCanvas eventmgrinterest X X /Damaged {/fix self send} X null TheCanvas eventmgrinterest X ] forkeventmgr def X } def Xclassend def X% --------------------------------------------------------- X/demo { X /can framebuffer /new Canvas send def X /reshapefromuser can send X /map can send X X 10 20 100 200 /reshape can send X} def X% --------------------------------------------------------- X/OvalCanvas Canvas [] Xclassbegin X /path {ovalpath} def Xclassend def X X/demo { X /can1 framebuffer /new OvalCanvas send def X /reshapefromuser can1 send X /map can1 send X} def X% --------------------------------------------------------- X/StarCanvas Canvas [] Xclassbegin X /EdgeSize 20 def X /path {starpath} def Xclassend def X X/demo { X /can2 framebuffer /new StarCanvas send def X /reshapefromuser can2 send X /map can2 send X} def X% =============================================================== X% Windows & Menus X% =============================================================== X/demo { X /win framebuffer /new DefaultWindow send def X { /FrameLabel (USENIX is a Star!) def X /IconImage /hello_world def X /PaintClient { X .5 fillcanvas 1 setshade X clippath pathbbox starpath fill X } def X } win send X /reshapefromuser win send X /map win send X} def X% --------------------------------------------------------- X/demo { X /StarGray 1 def X /FillGray .5 def X /FillCanvasWithStar { % stargray fillgray => - X fillcanvas setshade X clippath pathbbox starpath fill X } def X /SetStarGrays { % stargray fillgray => - X /FillGray exch store /StarGray exch store X /paintclient win send X } def X X /win framebuffer /new DefaultWindow send def X { /FrameLabel (USENIX is a Star!) def X /PaintIcon {.25 .75 FillCanvasWithStar 0 strokecanvas} def X /PaintClient {StarGray FillGray FillCanvasWithStar} def X /ClientMenu [ X (White Star) { 1 FillGray SetStarGrays} X (Lite Star) {.75 FillGray SetStarGrays} X (Gray Star) {.50 FillGray SetStarGrays} X (Dark Star) {.25 FillGray SetStarGrays} X (Black Star) { 0 FillGray SetStarGrays} X (White Fill) {StarGray 1 SetStarGrays} X (Gray Fill) {StarGray .50 SetStarGrays} X (Black Fill) {StarGray 0 SetStarGrays} X ] /new DefaultMenu send def X } win send X /reshapefromuser win send X /map win send X} def X% --------------------------------------------------------- X/demo { X /StarGray 1 def X /FillGray .5 def X /FillCanvasWithStar { % stargray fillgray => - X fillcanvas setshade X clippath pathbbox starpath fill X } def X /SetStarGrays { % stargray fillgray => - X /FillGray exch store /StarGray exch store X /paintclient win send X } def X X /GetMenuNumber {/currentkey self send cvr} def % - => num X /StarGraysMenu X [(.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9) (1.0)] X [{GetMenuNumber FillGray SetStarGrays}] X /new DefaultMenu send def X /FillGraysMenu X [(.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9) (1.0)] X [{StarGray GetMenuNumber SetStarGrays}] X /new DefaultMenu send def X X /win framebuffer /new DefaultWindow send def X { /FrameLabel (USENIX is a Star!) def X /PaintIcon {.25 .75 FillCanvasWithStar 0 strokecanvas} def X /PaintClient {StarGray FillGray FillCanvasWithStar} def X /ClientMenu [ X (White on Black) { 1 0 SetStarGrays} X (Black on White) { 0 1 SetStarGrays} X (Lite on Dark) {.75 .25 SetStarGrays} X (Star Grays =>) StarGraysMenu X (Fill Grays =>) FillGraysMenu X ] /new DefaultMenu send def X } win send X /reshapefromuser win send X /map win send X} def X% =============================================================== X% Custom Windows X% =============================================================== X/OvalWindow LiteWindow [] Xclassbegin X /Border 16 def X /FrameFillColor .75 .75 .75 rgbcolor def X X /ShapeFrameCanvas { % - => - ([Re]set frame canvas' shape) X gsave X ParentCanvas setcanvas X FrameX FrameY translate 0 0 FrameWidth FrameHeight ovalpath X FrameCanvas reshapecanvas X grestore X } def X /PaintFrame { % - => - (Paint frame canvas) X FrameFillColor fillcanvas PaintFocus X } def X /PaintFocus { % - => - (Paint frame focus) X gsave X FrameCanvas setcanvas X KeyFocus? {0} {FrameFillColor} ifelse setshade X Border 2 div 0 0 FrameWidth FrameHeight insetrect ovalpath stroke X grestore X } def X /ShapeClientCanvas { % - => - ([Re]set client canvas' shape) X ClientCanvas null ne { X gsave X FrameCanvas setcanvas X Border 0 0 FrameWidth FrameHeight insetrect X 4 2 roll translate 0 0 4 2 roll ovalpath X ClientCanvas reshapecanvas X grestore X } if X } def Xclassend def X X/demo { X /win framebuffer /new OvalWindow send def X { /IconImage /hello_world def X /PaintClient {1 fillcanvas} def X } win send X /reshapefromuser win send X /map win send X} def X% =============================================================== X% Development X% =============================================================== X/demo { X /win framebuffer /new DefaultWindow send def X /reshapefromuser win send X /map win send X X /paintme {.5 fillcanvas} def X win /PaintClient {paintme} put X} def X% --------------------------------------------------------- X/runprogram { % string => - (exececute the string as a psh program) X (/tmp/pshscript) (w) file % str file X dup 3 -1 roll % file file str X writestring closefile % - X (psh /tmp/pshscript) forkunix X} def X% X% timeit X% X/Temp 10 dict dup begin X /timeitms { % - => int X % (T2-T1)*60000/Count -or- (T2-T1)/(minim*Count) X T2 T1 sub X 60000 mul X Count div X % truncate at third decimal. X 1000 mul round 1000 div X } def Xend def X/timeit { % count test => - X //Temp begin X /Proc 1 index def X /Count 2 index def X /T1 currenttime def X end X repeat currenttime X //Temp begin X /T2 exch def X (Time: % ms, Loops: %, Test: ) [timeitms Count] printf /Proc load == X end X} def X%------------------------------------------ X% from Sam Leffler @ Pixar X% Time: 6998.291 ms X/bubblesort { % array => array (sort array with bubble sort) X10 dict begin X /a exch def X a length 2 sub -1 -1 { % for j=n-2 step -1 until 0 do X 0 1 3 -1 roll { % for i=0 step 1 until j do X /i exch def X a i 1 add get a i get lt { % if a[i+1] < a[i] then X a i get % a[i] X a i 1 add get a i 3 -1 roll put % a[i] = a[i+1] X a i 1 add 3 -1 roll put % a[i+1] = a[i] X } if X } for X } for X a Xend X} def X%------------------------------------------ X% Time: 1952.82 ms (358% faster!) X/SiftDown { % L U => - X /U exch def X /L exch def X /Xl X L get def X { X /C L 2 mul 1 add def X C U gt {exit} if X /Xc X C get def X /C+1 C 1 add def X X C+1 U le { X X C+1 get dup Xc Bigger? X {/Xc exch def /C C+1 def} {pop} ifelse X } if X X Xl Xc Bigger? {exit} if X X L Xc put X /L C def X } loop X X L Xl put X} def X/heapsort { % array proc => array (sorted) X10 dict begin X /Bigger? exch cvx def % a b bigger? => t if a>b X /X exch def X /N X length 1 sub def X X % Make the heap X N % X N X dup 1 sub 2 div floor -1 0 { % N n; for: |N/2| -1 0 X 1 index SiftDown X } for % N X X % Sort the heap X -1 1 { % i:N -1 1 X /I exch def X X 0 get X I get X X 0 3 -1 roll put X X I 3 -1 roll put X 0 I 1 sub SiftDown X } for X X Xend X} def X X% Time: 1679.69 ms (16% faster than above) X/SiftDown { % L U => - X /U exch def X /L exch def X /Xl X L get def X { L 2 mul 1 add % C (i.e child index) X dup U gt {pop exit} if X X 1 index get % C Xc X 1 index 1 add % C Xc C+1 X X dup U le { X X 1 index get % C Xc C+1 Xc+1 X dup 3 index Bigger? {4 2 roll} if X pop pop % C' Xc' (largest child) X } {pop} ifelse X X Xl 1 index Bigger? {pop pop exit} if X X L 3 -1 roll put X /L exch def X } loop X X L Xl put X} def X/heapsort { % array proc => array (sorted) X10 dict begin X /Bigger? exch cvx def % a b bigger? => t if a>b X /X exch def X X % Make the heap X X dup length 1 sub % X N X dup 1 sub 2 div floor -1 0 { % X N for: |N/2| -1 0 X 1 index SiftDown X } for % X N X X % Sort the heap X -1 1 { % X i:N -1 1 X 2 copy 1 index 0 % X i X i X 0 X 4 copy get 3 1 roll get exch % X i X i X 0 Xi X0 X 4 1 roll put put % X i X X 0 exch 1 sub SiftDown X } for Xend X} def X X% Time: 1599.43 ms (6% faster than above) X% Converting /Bigger? to use /gt rather than {gt}: 1499.634! X% Using gt rather than Bigger? 100ms faster. X/SiftDown { % X L U => - X 3 1 roll 2 copy get exch % U X Xl L X { X dup 2 mul 1 add % U X Xl L C (i.e child index) X dup 5 index gt {pop exit} if % C>U: exit X 3 index 1 index get % U X Xl L C Xc X 1 index 1 add % U X Xl L C Xc C+1 X X dup 7 index le { % C+1<=U: check right child X 5 index 1 index get % U X Xl L C Xc C+1 Xc+1 X dup 3 index Bigger? % Xc+1 > Xc: roll X {4 2 roll} if X pop pop % U X Xl L C' Xc' (largest child) X } {pop} ifelse X % U X Xl L C Xc X 3 index 1 index Bigger? % Xl > Xc: exit X {pop pop exit} if X 4 index 3 index 3 -1 roll put % U X Xl L C; X[L]=Xc X exch pop % U X Xl L'; L=C X } loop X exch put pop % -; X[L]=Xl X} def X/heapsort { % array proc => array (sorted) X10 dict begin X /Bigger? exch cvx def % a b bigger? => t if a>b X X % Make the heap X dup length 1 sub % X N X dup 1 sub 2 div floor -1 0 { % X N n ; for: |N/2| -1 0 X 3 copy exch SiftDown pop X } for % X N X X % Sort the heap X -1 1 { % X i:N -1 1 X X 57 type = X 11.56 type = X true type = X (Foo) type = X /Foo type = X [1 2 3] type = X {3 4 add} type = X {3 4 add} xcheck = X 10 dict type = X X clear pstack X 64 (Hi) /Name pstack X exch pstack X dup pstack X 2 index pstack X pop pop pstack X 3 1 roll X pstack X 3 copy X pstack X X clear X X X /min X {dup 2 X index X lt X pstack X X {xch X pop X (1st) X ==} X X {op X (2nd) X ==} X X ielse X } def X X 76 X -6 X min X == X X X X -676 m = X 2 copy 1 index 0 % X i X i X 0 X 4 copy get 3 1 roll get exch % X i X i X 0 Xi X0 X 4 1 roll put put % X i X 2 copy 1 sub 0 exch SiftDown pop % X X } for Xend X} def X%------------------------------------------ X X //go.sysin dd * if [ `wc -c < scrap.ps` != 34241 ]; then made=false echo error transmitting scrap.ps -- echo length should be 34241, not `wc -c < scrap.ps` else made=true fi if $made; then chmod 664 scrap.ps echo -n ' '; ls -ld scrap.ps fi echo Extracting cond.ps sed 's/^X//' <<'//go.sysin dd *' >cond.ps Xsystemdict begin X X/setpacking {pop} ?def X/currentpacking false ?def X X% X% A "cond" (condition) statement: Consists of predicate-proc pairs. X% The first predicate that evaluates to true executes its correnponding X% procedure. Thus: X% X% 2 { X% {dup 1 eq} {(one)} X% {dup 2 eq} {(two)} X% true {(other)} X% } cond X% X% results in "2 (two)" being left on the stack. Note "true" effects X% a default branch. X% X% The implementation is very wierd. Here are the author's notes: X% Here's another entry in the cond-test. It's like Owen & Jerry's last X% ones in that it uses forall to step through all the elements, except X% instead of leaving a boolean or integer on the top of the stack to tell X% it what to do on the next iteration, it puts the code to be executed X% itself. Notice the mind-bending self referentiality: X% X% NextProc contains the code to be executed the next time a test is to be X% made, "exec null exit" gets executed in the clause after a true result, X% "pop /NextProc" gets executed in the clause after a false result - X% which is setting up for the next test. X% X% The "/NextProc" in the definition of /NextProc should really be X% //NextProc except that NextProc isn't defined yet... X% I then reach into the array and install it after /NextProc X% is defined. X% Xcurrentpacking % bool left on stack for later setpacking call Xfalse setpacking X/NextProc { exec { { exec null exit } } { { pop /NextProc } } ifelse } def X//NextProc 2 get 0 get 1 //NextProc put % replace placeholder by a recursion Xsetpacking X X/cond { % args array => args X //NextProc % args a nextproc X exch { % args nextproc ai X exch exec % args newnextproc X } forall X pop X} ?def Xcurrentdict /NextProc undef X Xend % systemdict //go.sysin dd * if [ `wc -c < cond.ps` != 1749 ]; then made=false echo error transmitting cond.ps -- echo length should be 1749, not `wc -c < cond.ps` else made=true fi if $made; then chmod 664 cond.ps echo -n ' '; ls -ld cond.ps fi echo Extracting trace.ps sed 's/^X//' <<'//go.sysin dd *' >trace.ps X% Copyright (c) 1989, Sun Microsystems, Inc. RESTRICTED RIGHTS LEGEND: X% Use, duplication, or disclosure by the Government is subject to X% restrictions as set forth in subparagraph (c)(1)(ii) of the Rights in X% Technical Data and Computer Software clause at DFARS 52.227-7013 and X% in similar clauses in the FAR and NASA FAR Supplement. X% X% @(#)trace.ps 1.9 89/05/17 X% X X% Trace utilities. X X% How to use the trace utilities. X% X% Here is a summary of the most commonly used trace functions. See the X% documentation above the function definitions in the code for more X% information and for more functions. X% X% / trace % find fn in dict stack X% / /trace send % find fn in class dict stack X% / untrace X% / /untrace send X% X% listtraces % list all set traces X% untraceall % remove all set traces X% X% /traceclass send % trace all methods in a class X% /untraceclass send X% X% / /tracesupers send % trace method in class & all supers X% / /untracesupers send X% X% The trace works by replacing the function's definition with one that X% wraps the original definition with calls to functions tracein and X% traceout. The default versions of these functions print the X% dictionary and name of the traced function, and the dictionary stack. X% Untrace removes the wrapper. Here are some samples: X% X% /reshape /trace ClassButton send X% /but /demo OpenLookButton send def X% /B /setname but send X% 0 0 100 20 /reshape but send X% In ClassButton /reshape ["B"]: 0 0 100 20 X% Out ClassButton /reshape ["B"]: Empty stack X% X% The last two lines are produced by trace. They show the class and X% method being entered and exited, the object on the top of the dict X% stack, i.e. the instance to which /reshape was sent, and the operand X% stack contents. Since we used /setname to name the instance "B", that X% is what trace prints. X% X% Here's a more involved example: X% X% /newinit /tracesupers ClassButton send X% listtraces X% Object: /newinit X% ClassCanvas: /newinit X% ClassControl: /newinit X% ClassButton: /newinit X% X% (Hello) {pop} framebuffer /new OpenLookButton send X% In ClassButton /newinit [.OpenLookButton]: (Hello) array{1} X% In ClassControl /newinit [.OpenLookButton]: (Hello) array{1} X% In ClassCanvas /newinit [.OpenLookButton]: (Hello) array{1} X% In Object /newinit [.OpenLookButton]: (Hello) array{1} X% Out Object /newinit [.OpenLookButton]: (Hello) array{1} X% Out ClassCanvas /newinit [.OpenLookButton]: (Hello) array{1} X% Out ClassControl /newinit [.OpenLookButton]: (Hello) X% In Object /newinit [.OpenLookButtonGraphic]: (Hello) X% Out Object /newinit [.OpenLookButtonGraphic]: (Hello) X% Out ClassButton /newinit [.OpenLookButton]: Empty stack X% X% This illustrates: X% /tracesupers traces a method in all superclasses. X% listtraces shows traced methods and their classes. X% Trace output is indented to show nested calls. X% Unnamed instances of classes are printed as .ClassName X% X% If you turn off autobinding you can trace operators: X% X% false setautobind X% /add trace X% 5 6 add X% In systemdict /add []: 5 6 X% Out systemdict /add []: 11 X% X% You can even trace send. If you are feeling real adventurous, try X% tracing def or store! X X X% Implementation: X% X% The /trace function finds the named function in a dictionary then wraps X% the function with calls to the tracein and traceout functions. The X% /untrace function finds the function, looks at it to see if it has the X% trace wrapper, then removes the wrapper. X% X% An array of traced functions is kept in tracelist. Since the first X% two elements of the trace wrapper are the dictionary and function name X% of the traced function, they can be used to locate the function for X% removing the trace. Function /untraceall goes through the list and X% removes all the traces. Function /listtraces displays all functions X% in the list. X Xsystemdict begin X X/print-operator /print load def X/printf-operator /printf load def X X % NeWS 1.1 compatibility X X % X X systemdict /XNeWS? known not { X systemdict /XNeWS? false put X } if X X XNeWS? not { % Is it NeWS 1.1? X X% Force print not to autobind X/print {//print-operator} def X/printf {//printf-operator} def X X/setpacking {pop} ?def X/currentpacking false ?def X X% from basics.ps X X% X% A "cond" (condition) statement: Consists of predicate-proc pairs. X% The first predicate that evaluates to true executes its correnponding X% procedure. Thus: X% X% 2 { X% {dup 1 eq} {(one)} X% {dup 2 eq} {(two)} X% true {(other)} X% } cond X% X% results in "2 (two)" being left on the stack. Note "true" effects X% a default branch. X% X% The implementation is very wierd. Here are the author's notes: X% Here's another entry in the cond-test. It's like Owen & Jerry's last X% ones in that it uses forall to step through all the elements, except X% instead of leaving a boolean or integer on the top of the stack to tell X% it what to do on the next iteration, it puts the code to be executed X% itself. Notice the mind-bending self referentiality: X% X% NextProc contains the code to be executed the next time a test is to be X% made, "exec null exit" gets executed in the clause after a true result, X% "pop /NextProc" gets executed in the clause after a false result - X% which is setting up for the next test. X% X% The "/NextProc" in the definition of /NextProc should really be X% //NextProc except that NextProc isn't defined yet... X% I then reach into the array and install it after /NextProc X% is defined. X% Xcurrentpacking % bool left on stack for later setpacking call Xfalse setpacking X% Beginning of string X% This is a string so the scanner doesn't see //NextProc before it's defined. X( X/NextProc { exec { { exec null exit } } { { pop /NextProc } } ifelse } def X//NextProc 2 get 0 get 1 //NextProc put % replace placeholder by a recursion Xsetpacking X X/cond { % args array => args X //NextProc % args a nextproc X exch { % args nextproc ai X exch exec % args newnextproc X } forall X pop X} ?def Xcurrentdict /NextProc undef X% End the string and execute it: X) cvx exec X X/isarray? { % any => boolean X type dup /arraytype eq exch /packedarraytype eq or X} def X X% from util.ps X X%%%%%%%%%%%%%%%%%%% X% array utilities % X%%%%%%%%%%%%%%%%%%% X X/arraycontains? { % array value => bool ; returns true if value is in array. X exch false exch { % value bool ai X 2 index eq {pop true exit} if X } forall % value bool X exch pop X} def X X/arraysequal? { % A B => bool X 0 exch { % A i bi X 2 index 2 index get ne % A i bool X {exit} {1 add} ifelse % A i X } forall X exch length eq X} def X X/arrayindex { % array value => index true -or- false X exch 0 exch { % value i ai X 2 index eq % value i X {exch pop true exit} {1 add} ifelse X } forall % i true -or- value i X dup true ne {pop pop false} if % i true -or- false X} def X X% From class.ps X( X/Temp 10 dict dup begin X /dicttype dup def X /canvastype dup def X /eventtype dup def X /processtype dup def Xend def X/isobject? { % obj => bool; test for "sendable" object (instance or class). X //Temp 1 index type known { X /ParentDictArray known X } {pop false} ifelse X} def X/isclass? { % obj => bool; test for class. X //Temp 1 index type known { X /ClassName known X } {pop false} ifelse X} def X/isinstance? { % obj => bool; test for instance of class. X //Temp 1 index type known { X dup /ParentDictArray known exch /ClassName known not and X } {pop false} ifelse X} def X) cvx exec X X{ % Send to Object: X /installmethod { % name proc => -; compile and install a new method. X ParentDict % NeWS 1.1 /methodcompile takes different args! X /methodcompile self send def X } dup exec % what convenience! X X /superclasses { % - => array ;return inheritance array. X ParentDictArray X dup type /dicttype eq { X dup /ParentDictArray get X exch 1 array astore append X } if X } installmethod X % NeWS 1.1 has subclass names, instead of the actual subclasses X /subclasses { X [ SubClasses { X dup where { X exch get X } { pop } ifelse X } forall X ] X } installmethod X X % Routines to handle promotion of defaults to instance vars. X % promote: promote a class variable to an instance variable. X % promoted?: check if the variable is an instance variable. X % ?promote: promote variable if it differs from the class version. X % unpromote: remove variable from instance vars. X /promote {self 3 1 roll put} installmethod % name object => - X /promoted? {self exch known} installmethod % name => bool X /unpromote {self exch undef} installmethod % name => -; remove name as an instance X /?promote { % name object => - X % Note: the value of the variable is determined by /send because X % it may be executable. X 2 copy exch self send eq {pop pop} {/promote self send} ifelse X } installmethod X X /classname { ClassName } def X X /name { Name } installmethod % - => name X /setname { self /Name 3 -1 roll put } installmethod % name => - X /id { ID } installmethod % - => name X /setid { self /ID 3 -1 roll put } installmethod % name => - X X% Class Variables X /Name {ClassName} def X /ID null def X X} Object send X X } if % end if NeWS 1.1 X X % CyberSpace pallet interface X X/args { pop pop } ?def X X/TraceDict 200 dict def XTraceDict begin X /list-traces /listtraces def X /show-trace-stats /showtracestats def X /list-callcount-stats { X /callcount listtracestats X } def X /list-totaltime-stats { X /totaltime listtracestats X } def X /clear-trace-stats { {procname} null args X cleartracestats X } def X /set-trace-output { null null args X currentfile settraceoutput X } def X /set-trace-default { null null args X /defaulttracein /defaulttraceout settracefunctions X } def X /set-trace-fast { null null args X /fasttracein /fasttraceout settracefunctions X } def X /trace-name { {procname} null args X trace X } def X /trace-class-method { {class procname} null args X exch /trace exch send X } def X /untrace-name { {procname} null args X trace X } def X /untrace-all /untraceall def X /trace-list { null {array} args X tracelist X } def X /trace-class { {class} null args X /traceclass exch send X } def X /untrace-class { {class} null args X /traceclass exch send X } def X /trace-supers { {class procname} null args X exch /tracesupers exch send X } def X /untrace-supers { {class procname} null args X exch /untracesupers exch send X } def X /trace-subclasses { {class} null args X /tracesubclasses exch send X } def X /trace-superclasses { {class} null args X /tracesubclasses exch send X } def Xend X X % This function in systemdict makes sure ClassName is always in a X % dictionary on the dict stack. Objects all have their own class X % name. This function provides names for /systemdict and /userdict. X % It returns the dictionary itself for other dictionaries. X % X % The use of this is a little bad and hacky because /ClassName is used X % as a method for any object (including classes themselves), even though X % it is not an advertised method in class Object. X % X /ClassName { % - => name | dict X currentdict X dup userdict eq {pop /userdict} if X dup systemdict eq {pop /systemdict} if X } def X X % Each traced function has a dictionary of information about the function. X % The dictionary contains: X % X % Key Value X % /dictname Printable name of dictionary (class) containing routine X % /fnname Printable name of function X % /fndict The actual dictionary containing the routine X % /callcount Number of times routine is called X % /totaltime Total time spent in the routine X % /stackdelta Change in # of objects on stack from entry to exit X X % Array of info dicts for all traced functions. X % X /tracelist [] def X X X% Functions for Setting and Removing Traces: X X % Add trace to a function. Usually used in a send context on a X % method in a class. X % X % /procname trace X % /procname /trace object send X % X /trace { % procname => - X % X % Locate the named proc by finding the given name in the current X % dictionary stack. Get the value associated with it, usually a X % function. Construct a new function that is the old one with a X % wrapper around it. The new function is: X % X % { tracein exec traceout} X % X % Where is a dictionary with the keys listed above. X % X % If the proc is already of the form above, i.e. is already being X % traced, the trace function does nothing. X % X 4 dict begin X /proc exch def X proc where { X /dct exch def X /dctname /ClassName dct send def X X dct proc get istraced? not { X X % Create trace info dictionary. X /tracedict 6 dict dup begin X /dictname dctname def X /fnname proc def X /fndict dct def X /callcount 0 def X /stackdelta null def X /totaltime 0 def X end def X X % Add trace info dict to trace array. X tracelist [tracedict] append X /tracelist exch store X X % Build wrapper code. X [ X tracedict /tracein cvx X dct proc get X dup isarray? {/exec cvx} if X tracedict /traceout cvx X ] cvx X X % Store new wrapped code in place of old. X dct proc 3 -1 roll put X } if X } if X end X } def X X % Remove trace from one method. X % X % /procname untrace X % /procname /untrace object send X % X /untrace { % procname => - X % X % The given proc is located in the current dictionary stack, and X % if it has the trace wrapper code, the wrapper code is removed X % and the trace dict is removed from the tracelist array. X % X 1 dict begin X /proc exch def X X proc load % proc X dup istraced? { X dup 0 get exch % tracedict proc X 2 get % tracedict oldproc X proc exch store % tracedict X X % Remove from tracelist. X tracelist exch arrayindex { X tracelist exch arraydelete X /tracelist exch store X } if X } {pop} ifelse X end X } def X X % Return true if the given proc has the trace wrapper around it. X % X /istraced? { % proc => - X dup isarray? { X dup length 5 ge { X 1 get /tracein eq X } {pop false} ifelse X } {pop false} ifelse X } def X X % Remove all traces that have been set. X % X /untraceall { % - => - X % Note: we loop through a copy of the tracelist array because X % untrace alters the original array. X tracelist dup length array copy { X begin % tracedict X fndict begin % dict containing routine X fnname untrace X end X end X pause X } forall X /trace_level 0 store X } def X X % Trace all methods in a class. X % X % /traceclass class send X % X /traceclass { % - => - X % Note: check for class Object is a kludge because some methods X % in that class are used by the trace utilities and infinite X % loops can occur if they are traced. X Object currentdict ne { X currentdict { X xcheck {trace} {pop} ifelse X } forall X } if X } def X X % Untrace all methods in a class. X % X % /untraceclass class send X % X /untraceclass { % - => - X currentdict { X xcheck {untrace} {pop} ifelse X } forall X } def X X % Trace a method in a class and all its superclasses. X % X % /method /tracesupers class send X % /method /tracesupers object send X % X /tracesupers { % method => - X /superclasses self send self arrayappend { X 2 copy exch known { X 2 copy /trace exch send X } if X pop X } forall X pop X } def X X % Untrace a method in a class and all its superclasses. X % X % /method /untracesupers class send X % /method /untracesupers object send X % X /untracesupers { % method => - X /superclasses self send self arrayappend { X 2 copy exch known { X 2 copy /untrace exch send X } if X pop X } forall X pop X } def X X % Trace a class and all its subclasses. X % X % /tracesubclasses class send X % X /tracesubclasses { % - => - X {(Tracing %\n) [/classname self send] printf} traceoutput X /traceclass self send X /subclasses self send { X pause X /tracesubclasses exch send X } forall X } def X X % Trace a class and all its superclasses. X % X % /tracesuperclasses class|instance send X % X /tracesuperclasses { % - => - X {(Tracing %\n) [/classname self send] printf} traceoutput X /traceclass self send X /superclasses self send { X pause X /traceclass exch send X } forall X } def X X X% Functions for Displaying Traces and Statistics: X X % List all traced functions. X % X /listtraces { % - => - X { X tracelist { X begin X (%: /%\n) X [dictname fnname] printf X end X } forall X } traceoutput X } def X X % Display the stats collected for a particular proc. X % X /showtracestats { % procname => - X load X dup istraced? { X 0 get begin X { X (% /%:\n) [dictname fnname] printf X ( Calls: %\n) [callcount] printf X ( Time: %\n) [totaltime] printf X ( Stack delta: ) printf stackdelta == X } traceoutput X end X } {pop} ifelse X } def X X % Show a sorted list of all traced functions with statistics. X % Argument is the name of the field to sort by: /callcount or /totaltime. X % X % /callcount: sort by how often function was called X % /totaltime: sort by total time spent in function X % X /listtracestats { % sortby => - X 1 dict begin X /attribute exch def X X % Build array of all functions that were called at least once. X [tracelist {dup /stackdelta get null eq {pop} if} forall] X X % Sort the array. X { X attribute get exch X attribute get exch X lt X } quicksort % array X X { X { X begin X (% %: /% /callcount=% /totaltime=% stack=%\n) X [attribute cvx exec X dictname fnname callcount totaltime stackdelta] X printf X end X } forall X } traceoutput X end X } def X X % Zero the function call counts for all traced routines. X % X /cleartracestats { % - => - X tracelist { X dup /callcount 0 put X /totaltime 0 put X } forall X } def X X X% Functions Called on Entry and Exit of Traced Functions: X X % Note: Functions called within traces are bound immediately so you can X % trace any operator inside them (e.g. send, store) without worrying about X % infinite recursion. It is assumed that these operators are not X % traced when these functions are defined. X X /trace_level 0 def X /trace_indent 1 def X /trace_stackcounts 100 array def X /trace_entertimes 100 array def X X % Function called on entry to traced function. X % X /tracein { % tracedict => - X pop X } def X X % Function called on exit from traced function. X % X /traceout { % tracedict => - X pop X } def X X % Change trace in and trace out functions. The arguments are either X % executable arrays or the names of functions. X % X /settracefunctions { % tracein traceout => - X dup xcheck not {load} if X /traceout exch store X dup xcheck not {load} if X /tracein exch store X } def X X % The next two functions display messages of the form X % X % In/Out / []: X % X % Where is the dictionary containing the traced function, X % is the name of the traced function, X % is the printable name of the currentdict X % is the current contents of the operand stack. X % X % The messages are prefixed by blank spaces so the nesting structure X % is apparent visually. Each Out message is always aligned directly X % below its corresponding In message. X X % Function called on entry into a traced function. X % X /defaulttracein { % tracedict => - X count trace_stackcounts trace_level 3 -1 roll put X X { X begin X trace_level trace_indent mul { ( ) print } repeat X (In % /% [%]: ) X [dictname fnname X currentdict end X currentdict isobject? X {currentdict objectstring} {nullstring} ifelse X exch begin X ] printf X /callcount callcount 1 add store X end X showstack X } traceoutput X X trace_entertimes trace_level X /trace_level trace_level 1 add store X currenttime put X } bind def X X % Function called on exit from a traced function. X % X /defaulttraceout { % tracedict => - X currenttime X /trace_level trace_level 1 sub store X trace_entertimes trace_level get sub exch % time tracedict X X begin % time X count trace_stackcounts trace_level get sub % time count X X % Update the stack delta. X dup stackdelta eq {pop}{ X stackdelta type { X /integertype {[exch stackdelta]} X /arraytype { X stackdelta 1 index arraycontains? { X pop stackdelta X }{ X [exch] stackdelta append X } ifelse X } X } case X /stackdelta exch store X } ifelse X X totaltime add X /totaltime exch store X { X trace_level trace_indent mul { ( ) print } repeat X (Out % /% [%]: ) X [dictname fnname X currentdict end X currentdict isobject? X {currentdict objectstring} {nullstring} ifelse X exch begin X ] printf X showstack X } traceoutput X end X } bind def X X % A tracein function that collects stats without printing anything. X % X /fasttracein { % tracedict => - X begin X /callcount callcount 1 add store X /stackdelta 99 store X end X X trace_entertimes trace_level X /trace_level trace_level 1 add store X currenttime put X } bind def X X % A traceout function that collects stats without printing anything. X % X /fasttraceout { % tracedict => - X currenttime X /trace_level trace_level 1 sub store X trace_entertimes trace_level get sub exch % time tracedict X X begin X totaltime add X /totaltime exch store X end X } bind def X X % Initialize the tracein and traceout functions to the defaults. X % X /defaulttracein /defaulttraceout settracefunctions X X% Functions for Printing Objects: X X % Return a printable string for an object. X % X % type = nametype: X % Executable: name X % Non-executable: /name X % type = stringtype: (string) X % Objects: X % Class: ClassName X % Named instance: "name" X % Other instances: .ClassName X % Special dicts: X % systemdict: systemdict X % userdict: userdict X % X /objectstring { % object => string X dup type { X /nametype {dup xcheck {(%)}{(/%)} ifelse [3 -1 roll] sprintf} X /stringtype {((%)) [3 -1 roll] sprintf} X /Default { X dup isobject? { X dup isclass? { ======== END OF cyber.shar.splitag ======== From don Thu Nov 23 02:00:57 1989 Date: Thu, 23 Nov 89 02:00:57 -0500 To: NeWS-makers@brillig.umd.edu Subject: cyber.shar.splitah From: don@tumtum.cs.umd.edu (Don Hopkins) Sender: NeWS-makers-request@brillig.umd.edu (Don Hopkins) ======== START OF cyber.shar.splitah ======== X /ClassName exch send 50 string cvs X }{ X % REMIND - incestuous knowledge of class Object X /Name /promoted? 2 index send X {("%")} {(.%)} ifelse % obj str X /name 3 -1 roll send % obj str name X [exch] sprintf X } ifelse X }{ X % Note: this is cond, not case, so the userdict in the X % comparison will not be bound to a particular userdict. X % Userdict must be evaluated each time this routine X % is called, so the test works when called from different X % processes with different userdicts. X { X {dup systemdict eq} {pop (systemdict)} X {dup userdict eq} {pop (userdict)} X true {50 string cvs} X } cond X } ifelse X } X } case X } def X X % Like PostScript Red Book = operator, but display name of class X % instead of "dictionary[N]". Also, don't do a newline. X % X /showobject { % object => - X objectstring print X } bind def X X % Like PostScript Red Book stack operator, but use showobject instead of =. X % X /showstack { % - => - X count 0 eq { X (Empty stack) print X } { X count 1 sub -1 0 { X index showobject ( ) print X } for X } ifelse X (\n) print X } bind def X X X% Output Functions (to redirect trace output): X X % Trace output file. Null to not redirect trace output. Use X % settraceoutput to change. X % X /trace_output null def X X % Function for changing where trace output goes. Use this instead X % of changing trace_output directly. This prevents the problem of X % changing traceout instead by mistake. X % X /settraceoutput { % file => - X /trace_output exch store X } bind def X X % Execute a procedure with output redirected to the specified file. X % X % Note: the output is redirected by saving the current /Stdout, X % changing it to the given file, then restoring it. The file X % is saved as /trace_savedStdout in systemdict rather than on the X % stack or in a local dict so neither the operand nor dict X % stacks is changed when the proc parameter is executed. X % X % Note: /trace_savedStdout must be set to null to prevent an extra X % reference to the current output file from lingering. X % XXNeWS? { X /outputtofile { % file proc X systemdict /trace_savedStdout currentprocess /Stdout get put X currentprocess /Stdout 4 -1 roll put X stopped X currentprocess /Stdout systemdict /trace_savedStdout get put X systemdict /trace_savedStdout null put X {(process stopped\n) print} if X } bind def X} { % else if NeWS 1.1 X X% NeWS 1.1 processes do not have a /Stdout field, so we redefine print above X% so it does not get autobound in these definitions. X X % Depends on above /print kludge! X /outputtofile { % file proc X 10 dict begin X /print { X /_ProcessStdoutKludge where { X pop _ProcessStdoutKludge exch writestring X } { X systemdict /print get exec X } ifelse X } def X /printf { X /_ProcessStdoutKludge where { X pop sprintf _ProcessStdoutKludge exch writestring X } { X systemdict /printf get exec X } ifelse X } def X exch /_ProcessStdoutKludge exch def % proc X stopped X {(process stopped\n) print} if X end % 10 dict X } bind def X} ifelse X X % Execute a proc with output redirected to the trace output file, X % if there is one. If not, just execute the proc. X % X /traceoutput { % proc => - X trace_output null eq {exec} { X trace_output exch outputtofile X trace_output flushfile X } ifelse X } bind def X X/print /print-operator load def % undo above /print kludge Xsystemdict /print-operator undef X/printf /printf-operator load def Xsystemdict /printf-operator undef X Xend % systemdict //go.sysin dd * if [ `wc -c < trace.ps` != 27159 ]; then made=false echo error transmitting trace.ps -- echo length should be 27159, not `wc -c < trace.ps` else made=true fi if $made; then chmod 664 trace.ps echo -n ' '; ls -ld trace.ps fi echo Extracting doc.ps sed 's/^X//' <<'//go.sysin dd *' >doc.ps X%! X% NeWS 2.0 Reference Card X% X% Striped into raw data structures by Don Hopkins, for the PSIBER Space Deck. X% X% Date: Tue, 31 Oct 89 16:33:26 PST X% From: rbogen@EBay.Sun.COM (Richard Bogen) X% To: NeWS-makers@brillig.umd.edu X% Subject: Updated XNeWS Refcard X% X% The previous posting was based on pre-FCS manuals and contained some X% minor flaws. Here is a more accurate one based on the latest info: X% X% Date: Wed, 25 Oct 89 09:23:19 PDT X% From: rbogen@EBay.Sun.COM (Richard Bogen) X% To: NeWS-makers@brillig.umd.edu X% Subject: XNeWS Reference Card X% X% In honor of the release of X11/NeWS on SUN3's here is a file which X% produces a 2 page reference card listing of datatypes & operators. X% Try sending it to your laserprinter after loading it with card stock. X% X% From: ou@ulowell.UUCP (Chris Katsaounis) X% Date: 3 Jul 86 17:04:07 GMT X% X% Modified: October 20, 1989 by rbogen@sun.com (Richard A. Bogen) X% To reflect changes from X11 merge X% X X/C { X 2 array astore X exch token pop exch pop exch X def X} def X/empty {(---)} def X Xsystemdict begin X /NeWSDoc 100 dict def Xend % systemdict XNeWSDoc begin X X /Types 100 dict def X Types begin X X /Canvas 100 dict def X Canvas begin X (/TopCanvas) empty (canvas) C X (/BottomCanvas) empty {(canvas)| (null)} C X (/CanvasAbove) empty {(canvas) | (null)} C X (/CanvasBelow) empty {(canvas) | (null)} C X (/TopChild) empty {(canvas) | (null)} C X (/Parent) {(canvas) | (null)} {(canvas) | (null)} C X (/Transparent) (boolean) (boolean) C X (/Mapped) (boolean) (boolean) C X (/Retained) (boolean) (boolean) C X (/SaveBehind) (boolean) empty C X (/Color) empty (boolean) C X (/EventsConsumed) (name) (name) C X (/Interests) empty (array) C X (/Cursor) (cursor) {(cursor) | (null)} C X (/Colormap) (colormap) (colormap) C X (/Visual) empty (visual) C X (/VisualList) empty (array) C X (/OverrideRedirect) empty (boolean) C X (/BorderWidth) {(null) | (integer)} {(null) | (integer)} C X (/UserProps) (dict) (dict) C X (/XID) empty (number) C X (/SharedFile) (string) (string) C X (/RowBytes) empty (number) C X (/Grabbed) (boolean) (boolean) C X (/GrabToken) empty (integer) C X end % Canvas X X /Cursor 100 dict def X Cursor begin X (/CursorChar) empty (integer) C X (/CursorColor) empty (object) C X (/CursorFont) empty (object) C X (/MaskChar) empty (integer) C X (/MaskColor) empty (object) C X (/MaskFont) empty (object) C X end % Cursor X X /Visual 100 dict def X Visual begin X (/Size) empty (integer) C X (/Class) empty (integer) C X (/BitsPerPixel) empty (integer) C X end % Visual X X /Colormap 100 dict def X Colormap begin X (/Entries) empty (array) C X (/Free) empty (number) C X (/Installed) (boolean) (boolean) C X (/Visual) empty (object) C X end % Colormap X X /Colormapentry 100 dict def X Colormapentry begin X (/Colormap) empty (object) C X (/Mask) empty (integer) C X (/Slot) empty (integer) C X end % Colormapentry X X /Process 100 dict def X Process begin X (/$error) {(null) | (dict)} {(null) | (dict)} C X (/errordict) (dict) (dict) C X (/DictionaryStack) empty (array) C X (/ErrorCode) empty (name) C X (/ErrorDetailLevel) (integer) (integer) C X (/Execee) empty (object) C X (/ExecutionStack) empty (array) C X (/Interests) empty (array) C X (/OperandStack) empty (array) C X (/State) empty (array) C X (/Priority) (integer) (integer) C X (/ProcessName) (name) (name) C X (/Stdout) (file) (file) C X (/Stderr) (file) (file) C X (/SendContexts) empty (array) C X (/SendStack) empty (array) C X end % Process X X /Event 100 dict def X Event begin X (/Action) (object) (object) C X (/Canvas) {(dict) | (array) | (canvas) | (null)} X {(dict) | (array) | (canvas) | (null)} C X (/ClientData) (object) (object) C X (/Exclusivity) (boolean) (boolean) C X (/Interest) empty (event) C X (/IsInterest) empty (boolean) C X (/IsPreChild) empty (boolean) C X (/IsQueued) empty (boolean) C X (/KeyState) empty (array) C X (/Name) (object) (object) C X (/Priority) (number) (number) C X (/Process) {(null)|(process)} {(null)|(process)} C X (/Serial) empty (number) C X (/TimeStamp) (number) (number) C X (/XLocation) (number) (number) C X (/YLocation) (number) (number) C X (/Coordinates) (xnumber ynumber) (xnumber ynumber) C X end % Event X X /Environment 100 dict def X Environment begin X (/BellDuration) (integer) (integer) C X (/BellPitch) (number) (number) C X (/BellPercent) (number) (number) C X (/KeyClickPercent) (number) (number) C X (/Leds) (integer) (integer) C X (/AutoRepeat) (boolean) (boolean) C X (/KeyRepeatTime) (number) (number) C X (/KeyRepeatThresh) (number) (number) C X (/MotionCompression) (boolean) (boolean) C X (/Threshold) (integer) (integer) C X (/AccelNumerator) (number) (number) C X (/AccelDenominator) (number) (number) C X end % Environment X X end % Types X X /Operators 100 dict def X Operators begin X X /Path 100 dict def X Path begin X (copyarea) (dx dy) empty C X (currentpath) empty (path) C X (damagepath) empty empty C X (emptypath) empty (boolean) C X (eocopyarea) (dx dy) empty C X (eocurrentpath) empty (path) C X (eoextenddamage) empty empty C X (eoextenddamageall) empty empty C X (extenddamage) empty empty C X (extenddamageall) empty empty C X (pointinpath) (x y) (boolean) C X (setpath) (path) empty C X end % Path X X /Canvas 100 dict def X Canvas begin X (buildimage) (w h bits matrix proc) (canvas) C X (canvasesunderpath) empty (array) C X (canvasesunderpoint) {(null) | (xnum ynum)} (array) C X (canvastobottom) (canvas) empty C X (canvastotop) (canvas) empty C X (clipcanvas) empty empty C X (clipcanvaspath) empty empty C X (createdevice) (string) (canvas) C X (createoverlay) (canvas) (canvas) C X (currentcanvas) empty (canvas) C X (eoclipcanvas) empty empty C X (eoreshapecanvas) (canvas) empty C X (eowritecanvas) {(file) | (string)} empty C X (eowritescreen) {(file) | (string)} empty C X (getcanvaslocation) (canvas) (x y) C X (getcanvashape) empty (path) C X (imagecanvas) (canvas) empty C X (imagemaskcanvas) (boolean canvas) empty C X (insertcanvasabove) (canvas x y) empty C X (insertcanvasbelow) (canvas x y) empty C X (movecanvas) {(x y)| (x y canvas)} empty C X (newcanvas) {(pcan) | (pcan visual cmap)} (ncan) C X (readcanvas) {(file) | (string)} (canvas) C X (reshapecanvas) {(canvas)| (canvas path width)} empty C X (setcanvas) (canvas) empty C X (writecanvas) {(file) | (string)} empty C X (writescreen) {(file) | (string)} empty C X end % Canvas X X /Cursor 100 dict def X Cursor begin X (currentcursorlocation) empty (x y) C X (getcanvascursor) (canvas) (font char char) C X (grabcursor) {(cursor) | (null)} empty C X (newcursor) (char char font ) (cursor) C X (setcursorlocation) (x y) empty C X end % Cursor X X /Colormap 100 dict def X Colormap begin X (createcolormap) (visual) (colormap) C X (createcolorsegment) (colormap color) (colormapentry) C X (createcolorsegment) (colormap int int) (array) C X (currentbackpixel) empty (integer) C X (currentpixel) empty (integer) C X (getcolor) (cmapseg integer) (color) C X (putcolor) (cmapseg int color) empty C X (setbackpixel) (integer) empty C X (setpixel) (integer) empty C X end % Colormap X X /Color 100 dict def X Color begin X (contrastswithcurrent) (color) (boolean) C X (currentbackcolor) empty (color) C X (currentcolor) empty (color) C X (hsbcolor) (h s b) (color) C X (rgbcolor) (r g b) (color) C X (setcolor) (color) empty C X (setbackcolor) (color) empty C X end % Color X X /Process 100 dict def X Process begin X (breakpoint) empty empty C X (clearsendcontexts) empty empty C X (continueprocess) (process) empty C X (createmonitor) empty (monitor) C X (currentprocess) empty (process) C X (currentshared) empty (boolean) C X (defaulterroraction) (object name) empty C X (fork) (proc) (process) C X (geteventlogger) empty (process) C X (getprocesses) empty (array) C X (getprocessgroup) {(process) | (null)} (array) C X (killprocess) (process) empty C X (killprocessgroup) (process) empty C X (monitor) (monitor proc) empty C X (monitorlocked) (monitor) (boolean) C X (newprocessgroup) empty empty C X (pause) empty empty C X (runprogram) (string) empty C X (seteventlogger) (process) empty C X (suspendprocess) empty empty C X (waitprocess) (process) (value) C X end % Process X X /Event 100 dict def X Event begin X (awaitevent) empty (event) C X (blockinputqueue) (num) empty C X (countinputqueue) empty (num) C X (createevent) empty (event) C X (expressinterest) {(event)| (event process)} empty C X (getmousetranslation) empty (boolean) C X (lasteventkeystate) empty (array) C X (lasteventtime) empty (num) C X (lasteventx) empty (num) C X (lasteventy) empty (num) C X (postcrossings) (can can name name bool) empty C X (recallevent) (event) empty C X (redistributeevent) (event) empty C X (revokeinterest) {(event)|(event process)} empty C X (sendevent) (event) empty C X (unblockinputqueue) empty empty C X end % Event X X /File 100 dict def X File begin X (acceptconnection) (listenfile) (file) C X (countfileinputtoken) (file) (integer) C X (getfileinputtoken) {(int) | (int file)} (object) C X (getsocketlocaladdress) (file) (string) C X (getsocketpeername) (file) (string) C X (setfileinputtoken) (object int ) empty C X (tagprint) (num) empty C X (typedprint) (object) empty C X (writeobject) (file object) empty C X end % File X X /Mathematical 100 dict def X Mathematical begin X (arccos) (num) (num) C X (arcsin) (num) (num) C X (arctan) (num) (num) C X (max) (num num) (num) C X (min) (num num) (num) C X (random) empty (num) C X end % Mathematical X X /Keyboard 100 dict def X Keyboard begin X (getkeyboardtranslation) empty (num) C X (getmousetranslation) empty (boolean) C X (keyboardtype) empty (num) C X (setkeyboardtranslation) (boolean) empty C X (setmousetranslation) (boolean) empty C X end % Keyboard X X /Font 100 dict def X Font begin X (currentfontmen) empty (integer) C X (encodefont) {(font array) | (font name)} (font) C X (enumeratefontdicts) empty (name1) (name2 ...) C X (findfilefont) (string) (font) C X (fontascent) (font) (integer) C X (fontdescent) (font) (integer) C X (fontheight) (font) (integer) C X (setfontmen) (integer) empty C X end % Font X X /Miscellaneous 100 dict def X Miscellaneous begin X (assert) (boolean errorname) empty C X (beep) empty empty C X (currentautobind) empty (boolean) C X (currentpacking) empty (boolean) C X (currentplanemask) empty (integer) C X (currentprintermatch) empty (boolean) C X (currentrasteropcode) empty (num) C X (currentstate) empty (state) C X (currenttime) empty (num) C X (getcard32) (string integer) (integer) C X (getenv) (string1) (string2) C X (harden) (object) (object) C X (localhostname) empty (string) C X (objectdump) (file) empty C X (packedarray) (objects int) (packedarray) C X (packedarraytype) (object) (boolean) C X (pathforallvec) (array) empty C X (putcard32) (string integer integer) empty C X (putenv) (string1 string2) empty C X (refcnt) (object) (integer integer) C X (reffinder) {(object) | (object boolean)} empty C X (send) {(name object) | (proc object)} empty C X (setautobind) (boolean) empty C X (setpacking) (boolean) empty C X (setplanemask) (integer) empty C X (setprintermatch) (boolean) empty C X (setrasteropcode) (num) empty C X (setshared) (boolean) empty C X (setstate) (graphicsstate) empty C X (soft) (object) (boolean) C X (soften) (object) (object) C X (truetype) (object) (name) C X (undef) (dictionary key) empty C X (vmstatus) empty (avail used size) C X end % Miscellaneous X end % Operators X Xend % NeWSDoc X XNeWSDoc //go.sysin dd * if [ `wc -c < doc.ps` != 12549 ]; then made=false echo error transmitting doc.ps -- echo length should be 12549, not `wc -c < doc.ps` else made=true fi if $made; then chmod 644 doc.ps echo -n ' '; ls -ld doc.ps fi echo Extracting cyber sed 's/^X//' <<'//go.sysin dd *' >cyber X#!/bin/csh -f Xecho "systemdict /CyberDir (`pwd`) put" | psh Xpsh cyber.ps //go.sysin dd * if [ `wc -c < cyber` != 73 ]; then made=false echo error transmitting cyber -- echo length should be 73, not `wc -c < cyber` else made=true fi if $made; then chmod 775 cyber echo -n ' '; ls -ld cyber fi echo Extracting arpa.map sed 's/^X//' <<'//go.sysin dd *' >arpa.map Xsystemdict begin X X /ArpaMap 100 dict def X Xend % systemdict X XArpaMap begin X X /ARADC 20 dict def X ARADC begin X /@ARADC: (ARADC IMP) def X /LINC /replaceme def X /UROCH /replaceme def X end % ARADC X X /ARPA 20 dict def X ARPA begin X /@ARPA: (ARPA IMP) def X /CSS /replaceme def X /USC /replaceme def X /DCEC /replaceme def X end % ARPA X X /BBN63 20 dict def X BBN63 begin X /@BBN63: (BBN63 IMP) def X /RCC5 /replaceme def X /BRX25 /replaceme def X /BBN82 /replaceme def X end % BBN63 X X /BBN82 20 dict def X BBN82 begin X /@BBN82: (BBN82 IMP) def X /COLUM /replaceme def X /BBN63 /replaceme def X /RCC5 /replaceme def X /HARV /replaceme def X end % BBN82 X X /BERK 20 dict def X BERK begin X /@BERK: (BERK IMP) def X /WASH /replaceme def X /LBL2 /replaceme def X /XEROX /replaceme def X /SRI2 /replaceme def X end % BERK X X /BRAGG 20 dict def X BRAGG begin X /@BRAGG: (BRAGG IMP) def X /TEXAS /replaceme def X /DCEC /replaceme def X end % BRAGG X X /BRX25 20 dict def X BRX25 begin X /@BRX25: (BRX25 IMP) def X /BBN63 /replaceme def X end % BRX25 X X /CCA 20 dict def X CCA begin X /@CCA: (CCA IMP) def X /UDEL /replaceme def X /MIT6 /replaceme def X /RCC5 /replaceme def X end % CCA X X /CIT 20 dict def X CIT begin X /@CIT: (CIT IMP) def X /USC /replaceme def X /UCLA /replaceme def X end % CIT X X /CMU 20 dict def X CMU begin X /@CMU: (CMU IMP) def X /COLUM /replaceme def X /PURDU /replaceme def X /DCEC /replaceme def X end % CMU X X /COLNS 20 dict def X COLNS begin X /@COLNS: (COLNS IMP) def X /TEXAS /replaceme def X /SRI2 /replaceme def X /SAC /replaceme def X end % COLNS X X /COLUM 20 dict def X COLUM begin X /@COLUM: (COLUM IMP) def X /BBN82 /replaceme def X /CMU /replaceme def X end % COLUM X X /CSS 20 dict def X CSS begin X /@CSS: (CSS IMP) def X /MTR2 /replaceme def X /UDEL /replaceme def X /ARPA /replaceme def X end % CSS X X /DCEC 20 dict def X DCEC begin X /@DCEC: (DCEC IMP) def X /ARPA /replaceme def X /NSA2 /replaceme def X /CMU /replaceme def X /BRAGG /replaceme def X end % DCEC X X /DEC 20 dict def X DEC begin X /@DEC: (DEC IMP) def X /LINC /replaceme def X /HARV /replaceme def X end % DEC X X /HARV 20 dict def X HARV begin X /@HARV: (HARV IMP) def X /BBN82 /replaceme def X /DEC /replaceme def X end % HARV X X /ISI22 20 dict def X ISI22 begin X /@ISI22: (ISI22 IMP) def X /ISI27 /replaceme def X /ISI52 /replaceme def X /STAN /replaceme def X end % ISI22 X X /ISI27 20 dict def X ISI27 begin X /@ISI27: (ISI27 IMP) def X /ISI52 /replaceme def X /ISI22 /replaceme def X /UCLA /replaceme def X end % ISI27 X X /ISI52 20 dict def X ISI52 begin X /@ISI52: (ISI52 IMP) def X /ISI22 /replaceme def X /ISI27 /replaceme def X /RAND /replaceme def X end % ISI52 X X /LBL2 20 dict def X LBL2 begin X /@LBL2: (LBL2 IMP) def X /UTAH /replaceme def X /BERK /replaceme def X end % LBL2 X X /LINC 20 dict def X LINC begin X /@LINC: (LINC IMP) def X /ARADC /replaceme def X /MIT77 /replaceme def X /DEC /replaceme def X /MTR2 /replaceme def X end % LINC X X /MIT44 20 dict def X MIT44 begin X /@MIT44: (MIT44 IMP) def X /MIT6 /replaceme def X /MIT77 /replaceme def X end % MIT44 X X /MIT6 20 dict def X MIT6 begin X /@MIT6: (MIT6 IMP) def X /CCA /replaceme def X /MIT44 /replaceme def X /MIT77 /replaceme def X end % MIT6 X X /MIT77 20 dict def X MIT77 begin X /@MIT77: (MIT77 IMP) def X /MIT44 /replaceme def X /LINC /replaceme def X /MIT6 /replaceme def X end % MIT77 X X /MTR2 20 dict def X MTR2 begin X /@MTR2: (MTR2 IMP) def X /CSS /replaceme def X /LINC /replaceme def X end % MTR2 X X /NSA2 20 dict def X NSA2 begin X /@NSA2: (NSA2 IMP) def X /DCEC /replaceme def X end % NSA2 X X /PURDU 20 dict def X PURDU begin X /@PURDU: (PURDU IMP) def X /CMU /replaceme def X end % PURDU X X /RAND 20 dict def X RAND begin X /@RAND: (RAND IMP) def X /ISI52 /replaceme def X /USC /replaceme def X end % RAND X X /RCC5 20 dict def X RCC5 begin X /@RCC5: (RCC5 IMP) def X /UROCH /replaceme def X /CCA /replaceme def X /BBN82 /replaceme def X /BBN63 /replaceme def X end % RCC5 X X /SAC 20 dict def X SAC begin X /@SAC: (SAC IMP) def X /SAC2 /replaceme def X /WISC /replaceme def X /UTAH /replaceme def X /COLNS /replaceme def X end % SAC X X /SAC2 20 dict def X SAC2 begin X /@SAC2: (SAC2 IMP) def X /SAC /replaceme def X end % SAC2 X X /SR107 20 dict def X SR107 begin X /@SR107: (SR107 IMP) def X /SRI2 /replaceme def X /SRI51 /replaceme def X /SRI12 /replaceme def X end % SR107 X X /SRI12 20 dict def X SRI12 begin X /@SRI12: (SRI12 IMP) def X /SR107 /replaceme def X end % SRI12 X X /SRI2 20 dict def X SRI2 begin X /@SRI2: (SRI2 IMP) def X /XEROX /replaceme def X /SRI51 /replaceme def X /SR107 /replaceme def X /COLNS /replaceme def X /BERK /replaceme def X end % SRI2 X X /SRI51 20 dict def X SRI51 begin X /@SRI51: (SRI51 IMP) def X /STAN /replaceme def X /SR107 /replaceme def X /SRI2 /replaceme def X end % SRI51 X X /STAN 20 dict def X STAN begin X /@STAN: (STAN IMP) def X /ISI22 /replaceme def X /SUMEX /replaceme def X /SRI51 /replaceme def X end % STAN X X /SUMEX 20 dict def X SUMEX begin X /@SUMEX: (SUMEX IMP) def X /STAN /replaceme def X /XEROX /replaceme def X end % SUMEX X X /TEXAS 20 dict def X TEXAS begin X /@TEXAS: (TEXAS IMP) def X /COLNS /replaceme def X /BRAGG /replaceme def X /UCLA /replaceme def X end % TEXAS X X /UCLA 20 dict def X UCLA begin X /@UCLA: (UCLA IMP) def X /CIT /replaceme def X /TEXAS /replaceme def X /XEROX /replaceme def X /ISI27 /replaceme def X end % UCLA X X /UDEL 20 dict def X UDEL begin X /@UDEL: (UDEL IMP) def X /CSS /replaceme def X /CCA /replaceme def X end % UDEL X X /UROCH 20 dict def X UROCH begin X /@UROCH: (UROCH IMP) def X /ARADC /replaceme def X /WISC /replaceme def X /RCC5 /replaceme def X end % UROCH X X /US121 20 dict def X US121 begin X /@US121: (US121 IMP) def X /USC /replaceme def X end % US121 X X /USC 20 dict def X USC begin X /@USC: (USC IMP) def X /ARPA /replaceme def X /RAND /replaceme def X /CIT /replaceme def X /US121 /replaceme def X end % USC X X /UTAH 20 dict def X UTAH begin X /@UTAH: (UTAH IMP) def X /LBL2 /replaceme def X /SAC /replaceme def X /WASH /replaceme def X end % UTAH X X /WASH 20 dict def X WASH begin X /@WASH: (WASH IMP) def X /BERK /replaceme def X /UTAH /replaceme def X end % WASH X X /WISC 20 dict def X WISC begin X /@WISC: (WISC IMP) def X /SAC /replaceme def X /UROCH /replaceme def X end % WISC X X /XEROX 20 dict def X XEROX begin X /@XEROX: (XEROX IMP) def X /SUMEX /replaceme def X /SRI2 /replaceme def X /BERK /replaceme def X /UCLA /replaceme def X end % XEROX X Xend % ArpaMap X XArpaMap { X begin pop X currentdict { X /replaceme eq { X ArpaMap 1 index get def X } { pop } ifelse X } forall X end X} forall X XArpaMap //go.sysin dd * if [ `wc -c < arpa.map` != 6964 ]; then made=false echo error transmitting arpa.map -- echo length should be 6964, not `wc -c < arpa.map` else made=true fi if $made; then chmod 644 arpa.map echo -n ' '; ls -ld arpa.map fi echo Extracting advent.map sed 's/^X//' <<'//go.sysin dd *' >advent.map X/def-descr { % descr# str => - X currentdict 2 index known not { X 1 index nullarray def X } if X [ exch ] 1 index load exch append def X} def X X/room-descriptions dictbegin X1 (You are standing at the end of a road before a small brick building.) Xdef-descr X1 (Around you is a forest. A small stream flows out of the building and) Xdef-descr X1 (down a gully.) Xdef-descr X2 (You have walked up a hill, still in the forest. The road slopes back) Xdef-descr X2 (down the other side of the hill. There is a building in the distance.) Xdef-descr X3 (You are inside a building, a well house for a large spring.) Xdef-descr X4 (You are in a valley in the forest beside a stream tumbling along a) Xdef-descr X4 (rocky bed.) Xdef-descr X5 (You are in open forest, with a deep valley to one side.) Xdef-descr X6 (You are in open forest near both a valley and a road.) Xdef-descr X7 (At your feet all the water of the stream splashes into a 2-inch slit) Xdef-descr X7 (in the rock. Downstream the streambed is bare rock.) Xdef-descr X8 (You are in a 20-foot depression floored with bare dirt. Set into the) Xdef-descr X8 (dirt is a strong steel grate mounted in concrete. A dry streambed) Xdef-descr X8 (leads into the depression.) Xdef-descr X9 (You are in a small chamber beneath a 3x3 steel grate to the surface.) Xdef-descr X9 (A low crawl over cobbles leads inward to the west.) Xdef-descr X10 (You are crawling over cobbles in a low passage. There is a dim light) Xdef-descr X10 (at the east end of the passage.) Xdef-descr X11 (You are in a debris room filled with stuff washed in from the surface.) Xdef-descr X11 (A low wide passage with cobbles becomes plugged with mud and debris) Xdef-descr X11 (here, but an awkward canyon leads upward and west. A note on the wall) Xdef-descr X11 (says "magic word xyzzy".) Xdef-descr X12 (You are in an awkward sloping east/west canyon.) Xdef-descr X13 (You are in a splendid chamber thirty feet high. The walls are frozen) Xdef-descr X13 (rivers of orange stone. An awkward canyon and a good passage exit) Xdef-descr X13 (From east and west sides of the chamber.) Xdef-descr X14 (At your feet is a small pit breathing traces of white mist. An east) Xdef-descr X14 (passage ends here except for a small crack leading on.) Xdef-descr X15 (You are at one end of a vast hall stretching forward out of sight to) Xdef-descr X15 (the west. There are openings to either side. Nearby, a wide stone) Xdef-descr X15 (staircase leads downward. The hall is filled with wisps of white mist) Xdef-descr X15 (swaying to and fro almost as if alive. A cold wind blows up the) Xdef-descr X15 (staircase. There is a passage at the top of a dome behind you.) Xdef-descr X16 (The crack is far too small for you to follow.) Xdef-descr X17 (You are on the east bank of a fissure slicing clear across the hall.) Xdef-descr X17 (The mist is quite thick here, and the fissure is too wide to jump.) Xdef-descr X18 (This is a low room with a crude note on the wall. The note says,) Xdef-descr X18 ("You won't get it up the steps".) Xdef-descr X19 (You are in the hall of the mountain king, with passages off in all) Xdef-descr X19 (directions.) Xdef-descr X20 (You are at the bottom of the pit with a broken neck.) Xdef-descr X21 (You didn't make it.) Xdef-descr X22 (The dome is unclimbable.) Xdef-descr X23 (You are at the west end of the twopit room. There is a large hole in) Xdef-descr X23 (the wall above the pit at this end of the room.) Xdef-descr X24 (You are at the bottom of the eastern pit in the twopit room. There is) Xdef-descr X24 (a small pool of oil in one corner of the pit.) Xdef-descr X25 (You are at the bottom of the western pit in the twopit room. There is) Xdef-descr X25 (a large hole in the wall about 25 feet above you.) Xdef-descr X26 (You clamber up the plant and scurry through the hole at the top.) Xdef-descr X27 (You are on the west side of the fissure in the hall of mists.) Xdef-descr X28 (You are in a low n/s passage at a hole in the floor. The hole goes) Xdef-descr X28 (down to an e/w passage.) Xdef-descr X29 (You are in the south side chamber.) Xdef-descr X30 (You are in the west side chamber of the hall of the mountain king.) Xdef-descr X30 (A passage continues west and up here.) Xdef-descr X31 (>$<) Xdef-descr X32 (You can't get by the snake.) Xdef-descr X33 (You are in a large room, with a passage to the south, a passage to the) Xdef-descr X33 (west, and a wall of broken rock to the east. There is a large "y2" on) Xdef-descr X33 (A rock in the room's center.) Xdef-descr X34 (You are in a jumble of rock, with cracks everywhere.) Xdef-descr X35 (You're at a low window overlooking a huge pit, which extends up out of) Xdef-descr X35 (sight. A floor is indistinctly visible over 50 feet below. Traces of) Xdef-descr X35 (White mist cover the floor of the pit, becoming thicker to the right.) Xdef-descr X35 (Marks in the dust around the window would seem to indicate that) Xdef-descr X35 (someone has been here recently. Directly across the pit from you and) Xdef-descr X35 (25 Feet away there is a similar window looking into a lighted room. A) Xdef-descr X35 (shadowy figure can be seen there peering back at you.) Xdef-descr X36 (You are in a dirty broken passage. To the east is a crawl. To the) Xdef-descr X36 (west is a large passage. Above you is a hole to another passage.) Xdef-descr X37 (You are on the brink of a small clean climbable pit. A crawl leads) Xdef-descr X37 (west.) Xdef-descr X38 (You are in the bottom of a small pit with a little stream, which) Xdef-descr X38 (Enters and exits through tiny slits.) Xdef-descr X39 (You are in a large room full of dusty rocks. There is a big hole in) Xdef-descr X39 (the floor. There are cracks everywhere, and a passage leading east.) Xdef-descr X40 (You have crawled through a very low wide passage parallel to and north) Xdef-descr X40 (of the hall of mists.) Xdef-descr X41 (You are at the west end of hall of mists. A low wide crawl continues) Xdef-descr X41 (west and another goes north. To the south is a little passage 6 feet) Xdef-descr X41 (Off the floor.) Xdef-descr X42 (You are in a maze of twisty little passages, all alike.) Xdef-descr X43 (You are in a maze of twisty little passages, all alike.) Xdef-descr X44 (You are in a maze of twisty little passages, all alike.) Xdef-descr X45 (You are in a maze of twisty little passages, all alike.) Xdef-descr X46 (Dead end) Xdef-descr X47 (Dead end) Xdef-descr X48 (Dead end) Xdef-descr X49 (You are in a maze of twisty little passages, all alike.) Xdef-descr X50 (You are in a maze of twisty little passages, all alike.) Xdef-descr X51 (You are in a maze of twisty little passages, all alike.) Xdef-descr X52 (You are in a maze of twisty little passages, all alike.) Xdef-descr X53 (You are in a maze of twisty little passages, all alike.) Xdef-descr X54 (Dead end) Xdef-descr X55 (You are in a maze of twisty little passages, all alike.) Xdef-descr X56 (Dead end) Xdef-descr X57 (You are on the brink of a thirty foot pit with a massive orange column) Xdef-descr X57 (down one wall. You could climb down here but you could not get back) Xdef-descr X57 (up. The maze continues at this level.) Xdef-descr X58 (Dead end) Xdef-descr X59 (You have crawled through a very low wide passage parallel to and north) Xdef-descr X59 (of the hall of mists.) Xdef-descr X60 (You are at the east end of a very long hall apparently without side) Xdef-descr X60 (chambers. To the east a low wide crawl slants up. To the north a) Xdef-descr X60 (round two foot hole slants down.) Xdef-descr X61 (You are at the west end of a very long featureless hall. The hall) Xdef-descr X61 (joins up with a narrow north/south passage.) Xdef-descr X62 (You are at a crossover of a high n/s passage and a low e/w one.) Xdef-descr X63 (Dead end) Xdef-descr X64 (You are at a complex junction. A low hands and knees passage from the) Xdef-descr X64 (north joins a higher crawl from the east to make a walking passage) Xdef-descr X64 (going west. There is also a large room above. The air is damp here.) Xdef-descr X65 (You are in bedquilt, a long east/west passage with holes everywhere.) Xdef-descr X65 (To explore at random select north, south, up, or down.) Xdef-descr X66 (You are in a room whose walls resemble swiss cheese. Obvious passages) Xdef-descr X66 (go west, east, ne, and nw. Part of the room is occupied by a large) Xdef-descr X66 (bedrock block.) Xdef-descr X67 (You are at the east end of the twopit room. The floor here is) Xdef-descr X67 (littered with thin rock slabs, which make it easy to descend the pits.) Xdef-descr X67 (There is a path here bypassing the pits to connect passages from east) Xdef-descr X67 (and west. There are holes all over, but the only big one is on the) Xdef-descr X67 (wall directly over the west pit where you can't get to it.) Xdef-descr X68 (You are in a large low circular chamber whose floor is an immense slab) Xdef-descr X68 (fallen from the ceiling (slab room). East and west there once were) Xdef-descr X68 (large passages, but they are now filled with boulders. Low small) Xdef-descr X68 (passages go north and south, and the south one quickly bends west) Xdef-descr X68 (around the boulders.) Xdef-descr X69 (You are in a secret n/s canyon above a large room.) Xdef-descr X70 (You are in a secret n/s canyon above a sizable passage.) Xdef-descr X71 (You are in a secret canyon at a junction of three canyons, bearing) Xdef-descr X71 (north, south, and se. The north one is as tall as the other two) Xdef-descr X71 (combined.) Xdef-descr X72 (You are in a large low room. Crawls lead north, se, and sw.) Xdef-descr X73 (Dead end crawl.) Xdef-descr X74 (You are in a secret canyon which here runs e/w. It crosses over a) Xdef-descr X74 (very tight canyon 15 feet below. If you go down you may not be able) Xdef-descr X74 (to get back up.) Xdef-descr X75 (You are at a wide place in a very tight n/s canyon.) Xdef-descr X76 (The canyon here becomes too tight to go further south.) Xdef-descr X77 (You are in a tall e/w canyon. A low tight crawl goes 3 feet north and) Xdef-descr X77 (seems to open up.) Xdef-descr X78 (The canyon runs into a mass of boulders -- dead end.) Xdef-descr X79 (The stream flows out through a pair of 1 foot diameter sewer pipes.) Xdef-descr X79 (It would be advisable to use the exit.) Xdef-descr X80 (You are in a maze of twisty little passages, all alike.) Xdef-descr X81 (Dead end) Xdef-descr X82 (Dead end) Xdef-descr X83 (You are in a maze of twisty little passages, all alike.) Xdef-descr X84 (You are in a maze of twisty little passages, all alike.) Xdef-descr X85 (Dead end) Xdef-descr X86 (Dead end) Xdef-descr X87 (You are in a maze of twisty little passages, all alike.) Xdef-descr X88 (You are in a long, narrow corridor stretching out of sight to the) Xdef-descr X88 (west. At the eastern end is a hole through which you can see a) Xdef-descr X88 (profusion of leaves.) Xdef-descr X89 (There is nothing here to climb. Use "up" or "out" to leave the pit.) Xdef-descr X90 (You have climbed up the plant and out of the pit.) Xdef-descr X91 (You are at the top of a steep incline above a large room. You could) Xdef-descr X91 (climb down here, but you would not be able to climb up. There is a) Xdef-descr X91 (passage leading back to the north.) Xdef-descr X92 (You are in the giant room. The ceiling here is too high up for your) Xdef-descr X92 (lamp to show it. Cavernous passages lead east, north, and south. On) Xdef-descr X92 (the west wall is scrawled the inscription, "fee fie foe foo" [sic].) Xdef-descr X93 (The passage here is blocked by a recent cave-in.) Xdef-descr X94 (You are at one end of an immense north/south passage.) Xdef-descr X95 (You are in a magnificent cavern with a rushing stream, which cascades) Xdef-descr X95 (over a sparkling waterfall into a roaring whirlpool which disappears) Xdef-descr X95 (through a hole in the floor. Passages exit to the south and west.) Xdef-descr X96 (You are in the soft room. The walls are covered with heavy curtains,) Xdef-descr X96 (the floor with a thick pile carpet. Moss covers the ceiling.) Xdef-descr X97 (This is the oriental room. Ancient oriental cave drawings cover the) Xdef-descr X97 (walls. A gently sloping passage leads upward to the north, another) Xdef-descr X97 (passage leads se, and a hands and knees crawl leads west.) Xdef-descr X98 (You are following a wide path around the outer edge of a large cavern.) Xdef-descr X98 (Far below, through a heavy white mist, strange splashing noises can be) Xdef-descr X98 (heard. The mist rises up through a fissure in the ceiling. The path) Xdef-descr X98 (exits to the south and west.) Xdef-descr X99 (You are in an alcove. A small nw path seems to widen after a short) Xdef-descr X99 (distance. An extremely tight tunnel leads east. It looks like a very) Xdef-descr X99 (tight squeeze. An eerie light can be seen at the other end.) Xdef-descr X100 (You're in a small chamber lit by an eerie green light. An extremely) Xdef-descr X100 (narrow tunnel exits to the west. A dark corridor leads ne.) Xdef-descr X101 (You're in the dark-room. A corridor leading south is the only exit.) Xdef-descr X102 (You are in an arched hall. A coral passage once continued up and east) Xdef-descr X102 (from here, but is now blocked by debris. The air smells of sea water.) Xdef-descr X103 (You're in a large room carved out of sedimentary rock. The floor and) Xdef-descr X103 (walls are littered with bits of shells imbedded in the stone. A) Xdef-descr X103 (shallow passage proceeds downward, and a somewhat steeper one leads) Xdef-descr X103 (up. A low hands and knees passage enters from the south.) Xdef-descr X104 (You are in a long sloping corridor with ragged sharp walls.) Xdef-descr X105 (You are in a cul-de-sac about eight feet across.) Xdef-descr X106 (You are in an anteroom leading to a large passage to the east. Small) Xdef-descr X106 (passages go west and up. The remnants of recent digging are evident.) Xdef-descr X106 (A sign in midair here says "Cave under construction beyond this point.) Xdef-descr X106 (Proceed at own risk. [Witt construction company]") Xdef-descr X107 (You are in a maze of twisty little passages, all different.) Xdef-descr X108 (You are at Witt's end. Passages lead off in *all* directions.) Xdef-descr X109 (You are in a north/south canyon about 25 feet across. The floor is) Xdef-descr X109 (covered by white mist seeping in from the north. The walls extend) Xdef-descr X109 (upward for well over 100 feet. Suspended from some unseen point far) Xdef-descr X109 (above you, an enormous two-sided mirror is hanging parallel to and) Xdef-descr X109 (Midway between the canyon walls. (The mirror is obviously provided) Xdef-descr X109 (for the use of the dwarves, who as you know, are extremely vain.) A) Xdef-descr X109 (Small window can be seen in either wall, some fifty feet up.) Xdef-descr X110 (You're at a low window overlooking a huge pit, which extends up out of) Xdef-descr X110 (sight. A floor is indistinctly visible over 50 feet below. Traces of) Xdef-descr X110 (white mist cover the floor of the pit, becoming thicker to the left.) Xdef-descr X110 (Marks in the dust around the window would seem to indicate that) Xdef-descr X110 (someone has been here recently. Directly across the pit from you and) Xdef-descr X110 (25 Feet away there is a similar window looking into a lighted room. A) Xdef-descr X110 (shadowy figure can be seen there peering back at you.) Xdef-descr X111 (A large stalactite extends from the roof and almost reaches the floor) Xdef-descr X111 (below. You could climb down it, and jump from it to the floor, but) Xdef-descr X111 (having done so you would be unable to reach it to climb back up.) Xdef-descr X112 (You are in a little maze of twisting passages, all different.) Xdef-descr X113 (You are at the edge of a large underground reservoir. An opaque cloud) Xdef-descr X113 (of white mist fills the room and rises rapidly upward. The lake is) Xdef-descr X113 (fed by a stream, which tumbles out of a hole in the wall about 10 feet) Xdef-descr X113 (overhead and splashes noisily into the water somewhere within the) Xdef-descr X113 (Mist. The only passage goes back toward the south.) Xdef-descr X114 (Dead end) Xdef-descr X115 (You are at the northeast end of an immense room, even larger than the) Xdef-descr X115 (giant room. It appears to be a repository for the "adventure") Xdef-descr X115 (program. Massive torches far overhead bathe the room with smoky) Xdef-descr X115 (yellow light. Scattered about you can be seen a pile of bottles (all) Xdef-descr X115 (of them empty), a nursery of young beanstalks murmuring quietly, a bed) Xdef-descr X115 (of oysters, a bundle of black rods with rusty stars on their ends, and) Xdef-descr X115 (a collection of brass lanterns. Off to one side a great many dwarves) Xdef-descr X115 (are sleeping on the floor, snoring loudly. A sign nearby reads: "Do) Xdef-descr X115 (not disturb the dwarves!" An immense mirror is hanging against one) Xdef-descr X115 (wall, and stretches to the other end of the room, where various other) Xdef-descr X115 (sundry objects can be glimpsed dimly in the distance.) Xdef-descr X116 (You are at the southwest end of the repository. To one side is a pit) Xdef-descr X116 (full of fierce green snakes. On the other side is a row of small) Xdef-descr X116 (wicker cages, each of which contains a little sulking bird. In one) Xdef-descr X116 (corner is a bundle of black rods with rusty marks on their ends. A) Xdef-descr X116 (large number of velvet pillows are scattered about on the floor. A) Xdef-descr X116 (vast mirror stretches off to the northeast. At your feet is a large) Xdef-descr X116 (steel grate, next to which is a sign which reads, "Treasure vault.) Xdef-descr X116 (Keys in main office.") Xdef-descr X117 (You are on one side of a large, deep chasm. A heavy white mist rising) Xdef-descr X117 (up from below obscures all view of the far side. A sw path leads away) Xdef-descr X117 (from the chasm into a winding corridor.) Xdef-descr X118 (You are in a long winding corridor sloping out of sight in both) Xdef-descr X118 (directions.) Xdef-descr X119 (You are in a secret canyon which exits to the north and east.) Xdef-descr X120 (You are in a secret canyon which exits to the north and east.) Xdef-descr X121 (You are in a secret canyon which exits to the north and east.) Xdef-descr X122 (You are on the far side of the chasm. A ne path leads away from the) Xdef-descr X122 (chasm on this side.) Xdef-descr X123 (You're in a long east/west corridor. A faint rumbling noise can be) Xdef-descr X123 (heard in the distance.) Xdef-descr X124 (The path forks here. The left fork leads northeast. A dull rumbling) Xdef-descr X124 (seems to get louder in that direction. The right fork leads southeast) Xdef-descr X124 (down a gentle slope. The main corridor enters from the west.) Xdef-descr X125 (The walls are quite warm here. From the north can be heard a steady) Xdef-descr X125 (roar, so loud that the entire cave seems to be trembling. Another) Xdef-descr X125 (passage leads south, and a low crawl goes east.) Xdef-descr X126 (You are on the edge of a breath-taking view. Far below you is an) Xdef-descr X126 (active volcano, from which great gouts of molten lava come surging) Xdef-descr X126 (out, cascading back down into the depths. The glowing rock fills the) Xdef-descr X126 (farthest reaches of the cavern with a blood-red glare, giving every-) Xdef-descr X126 (thing an eerie, macabre appearance. The air is filled with flickering) Xdef-descr X126 (sparks of ash and a heavy smell of brimstone. The walls are hot to) Xdef-descr X126 (the touch, and the thundering of the volcano drowns out all other) Xdef-descr X126 (sounds. Embedded in the jagged roof far overhead are myriad twisted) Xdef-descr X126 (formations composed of pure white alabaster, which scatter the murky) Xdef-descr X126 (light into sinister apparitions upon the walls. To one side is a deep) Xdef-descr X126 (gorge, filled with a bizarre chaos of tortured rock which seems to) Xdef-descr X126 (have been crafted by the devil himself. An immense river of fire) Xdef-descr X126 (crashes out from the depths of the volcano, burns its way through the) Xdef-descr X126 (gorge, and plummets into a bottomless pit far off to your left. To) Xdef-descr X126 (the right, an immense geyser of blistering steam erupts continuously) Xdef-descr X126 (from a barren island in the center of a sulfurous lake, which bubbles) Xdef-descr X126 (ominously. The far right wall is aflame with an incandescence of its) Xdef-descr X126 (own, which lends an additional infernal splendor to the already) Xdef-descr X126 (hellish scene. A dark, foreboding passage exits to the south.) Xdef-descr X127 (You are in a small chamber filled with large boulders. The walls are) Xdef-descr X127 (very warm, causing the air in the room to be almost stifling from the) Xdef-descr X127 (heat. The only exit is a crawl heading west, through which is coming) Xdef-descr X127 (a low rumbling.) Xdef-descr X128 (You are walking along a gently sloping north/south passage lined with) Xdef-descr X128 (oddly shaped limestone formations.) Xdef-descr X129 (You are standing at the entrance to a large, barren room. A sign) Xdef-descr X129 (posted above the entrance reads: "Caution! Bear in room!") Xdef-descr X130 (You are inside a barren room. The center of the room is completely) Xdef-descr X130 (empty except for some dust. Marks in the dust lead away toward the) Xdef-descr X130 (far end of the room. The only exit is the way you came in.) Xdef-descr X131 (You are in a maze of twisting little passages, all different.) Xdef-descr X132 (You are in a little maze of twisty passages, all different.) Xdef-descr X133 (You are in a twisting maze of little passages, all different.) Xdef-descr X134 (You are in a twisting little maze of passages, all different.) Xdef-descr X135 (You are in a twisty little maze of passages, all different.) Xdef-descr X136 (You are in a twisty maze of little passages, all different.) Xdef-descr X137 (You are in a little twisty maze of passages, all different.) Xdef-descr X138 (You are in a maze of little twisting passages, all different.) Xdef-descr X139 (You are in a maze of little twisty passages, all different.) Xdef-descr X140 (Dead end) Xdef-descr Xdictend def X X/def-verb { % index name => - X currentdict 1 index known not { X 2 copy def X } if X exch def X} def X X/verbs dictbegin X 1 /yow! def-verb X 2 /road def-verb X 2 /hill def-verb X 3 /enter def-verb X 4 /upstr def-verb X 5 /downs def-verb X 6 /fores def-verb X 7 /forwa def-verb X 7 /conti def-verb X 7 /onwar def-verb X 8 /back def-verb X 8 /retur def-verb X 8 /retre def-verb X 9 /valle def-verb X 10 /stair def-verb X 11 /out def-verb X 11 /outsi def-verb X 11 /exit def-verb X 11 /leave def-verb X 12 /build def-verb X 12 /house def-verb X 13 /gully def-verb X 14 /strea def-verb X 15 /rock def-verb X 16 /bed def-verb X 17 /crawl def-verb X 18 /cobbl def-verb X 19 /inwar def-verb X 19 /insid def-verb X 19 /in def-verb X 20 /surfa def-verb X 21 /null def-verb X 21 /nowhe def-verb X 22 /dark def-verb X 23 /passa def-verb X 23 /tunne def-verb X 24 /low def-verb X 25 /canyo def-verb X 26 /awkwa def-verb X 27 /giant def-verb X 28 /view def-verb X 29 /upwar def-verb X 29 /up def-verb X 29 /u def-verb X 29 /above def-verb X 29 /ascen def-verb X 30 /d def-verb X 30 /downw def-verb X 30 /down def-verb X 30 /desce def-verb X 31 /pit def-verb X 32 /outdo def-verb X 33 /crack def-verb X 34 /steps def-verb X 35 /dome def-verb X 36 /left def-verb X 37 /right def-verb X 38 /hall def-verb X 39 /jump def-verb X 40 /barre def-verb X 41 /over def-verb X 42 /acros def-verb X 43 /east def-verb X 43 /e def-verb X 44 /west def-verb X 44 /w def-verb X 45 /north def-verb X 45 /n def-verb X 46 /south def-verb X 46 /s def-verb X 47 /ne def-verb X 48 /se def-verb X 49 /sw def-verb X 50 /nw def-verb X 51 /debri def-verb X 52 /hole def-verb X 53 /wall def-verb X 54 /broke def-verb X 55 /y2 def-verb X 56 /climb def-verb X 57 /look def-verb X 57 /exami def-verb X 57 /touch def-verb X 57 /descr def-verb X 58 /floor def-verb X 59 /room def-verb X 60 /slit def-verb X 61 /slab def-verb X 61 /slabr def-verb X 62 /xyzzy def-verb X 63 /depre def-verb X 64 /entra def-verb X 65 /plugh def-verb X 66 /secre def-verb X 67 /cave def-verb X 69 /cross def-verb X 70 /bedqu def-verb X 71 /plove def-verb X 72 /orien def-verb X 73 /caver def-verb X 74 /shell def-verb X 75 /reser def-verb X 76 /main def-verb X 76 /offic def-verb X 77 /fork def-verb Xdictend def X X/def-travel { % room# [ neighbor# verb# ... ] X currentdict 2 index known not { X 1 index dictbegin X /Room# 1 index def X 0 room-descriptions Room# get { X 1 index ( %) sprintf exch def X 1 add X } forall X pop X dictend def X } if X exch load % [ neighbor# verb# ... ] roomdict X begin X 0 2 getinterval aload pop % neighbor# verb# X verbs exch get % neighbor# verb X exch def % X end X} def X X/travel-table dictbegin X 1 [ 2 2 44 29 ] def-travel X 1 [ 3 3 12 19 43 ] def-travel X 1 [ 4 5 13 14 46 30 ] def-travel X 1 [ 5 6 45 43 ] def-travel X 1 [ 8 63 ] def-travel X 2 [ 1 2 12 7 43 45 30 ] def-travel X 2 [ 5 6 45 46 ] def-travel X 3 [ 1 3 11 32 44 ] def-travel X 3 [ 11 62 ] def-travel X 3 [ 33 65 ] def-travel X 3 [ 79 5 14 ] def-travel X 4 [ 1 4 12 45 ] def-travel X 4 [ 5 6 43 44 29 ] def-travel X 4 [ 7 5 46 30 ] def-travel X 4 [ 8 63 ] def-travel X 5 [ 4 9 43 30 ] def-travel X 5 [ 50005 6 7 45 ] def-travel X 5 [ 6 6 ] def-travel X 5 [ 5 44 46 ] def-travel X 6 [ 1 2 45 ] def-travel X 6 [ 4 9 43 44 30 ] def-travel X 6 [ 5 6 46 ] def-travel X 7 [ 1 12 ] def-travel X 7 [ 4 4 45 ] def-travel X 7 [ 5 6 43 44 ] def-travel X 7 [ 8 5 15 16 46 ] def-travel X 7 [ 595 60 14 30 ] def-travel X 8 [ 5 6 43 44 46 ] def-travel X 8 [ 1 12 ] def-travel X 8 [ 7 4 13 45 ] def-travel X 8 [ 303009 3 19 30 ] def-travel X 8 [ 593 3 ] def-travel X 9 [ 303008 11 29 ] def-travel X 9 [ 593 11 ] def-travel X 9 [ 10 17 18 19 44 ] def-travel X 9 [ 14 31 ] def-travel X 9 [ 11 51 ] def-travel X 10 [ 9 11 20 21 43 ] def-travel X 10 [ 11 19 22 44 51 ] def-travel X 10 [ 14 31 ] def-travel X 11 [ 303008 63 ] def-travel X 11 [ 9 64 ] def-travel X 11 [ 10 17 18 23 24 43 ] def-travel X 11 [ 12 25 19 29 44 ] def-travel X 11 [ 3 62 ] def-travel X 11 [ 14 31 ] def-travel X 12 [ 303008 63 ] def-travel X 12 [ 9 64 ] def-travel X 12 [ 11 30 43 51 ] def-travel X 12 [ 13 19 29 44 ] def-travel X 12 [ 14 31 ] def-travel X 13 [ 303008 63 ] def-travel X 13 [ 9 64 ] def-travel X 13 [ 11 51 ] def-travel X 13 [ 12 25 43 ] def-travel X 13 [ 14 23 31 44 ] def-travel X 14 [ 303008 63 ] def-travel X 14 [ 9 64 ] def-travel X 14 [ 11 51 ] def-travel X 14 [ 13 23 43 ] def-travel X 14 [ 150020 30 31 34 ] def-travel X 14 [ 15 30 ] def-travel X 14 [ 16 33 44 ] def-travel X 15 [ 18 36 46 ] def-travel X 15 [ 17 7 38 44 ] def-travel X 15 [ 19 10 30 45 ] def-travel X 15 [ 150022 29 31 34 35 23 43 ] def-travel X 15 [ 14 29 ] def-travel X 15 [ 34 55 ] def-travel X 16 [ 14 1 ] def-travel X 17 [ 15 38 43 ] def-travel X 17 [ 312596 39 ] def-travel X 17 [ 412021 7 ] def-travel X 17 [ 412597 41 42 44 69 ] def-travel X 17 [ 27 41 ] def-travel X 18 [ 15 38 11 45 ] def-travel X 19 [ 15 10 29 43 ] def-travel X 19 [ 311028 45 36 ] def-travel X 19 [ 311029 46 37 ] def-travel X 19 [ 311030 44 7 ] def-travel X 19 [ 32 45 ] def-travel X 19 [ 35074 49 ] def-travel X 19 [ 211032 49 ] def-travel X 19 [ 74 66 ] def-travel X 20 [ 0 1 ] def-travel X 21 [ 0 1 ] def-travel X 22 [ 15 1 ] def-travel X 23 [ 67 43 42 ] def-travel X 23 [ 68 44 61 ] def-travel X 23 [ 25 30 31 ] def-travel X 23 [ 648 52 ] def-travel X 24 [ 67 29 11 ] def-travel X 25 [ 23 29 11 ] def-travel X 25 [ 724031 56 ] def-travel X 25 [ 26 56 ] def-travel X 26 [ 88 1 ] def-travel X 27 [ 312596 39 ] def-travel X 27 [ 412021 7 ] def-travel X 27 [ 412597 41 42 43 69 ] def-travel X 27 [ 17 41 ] def-travel X 27 [ 40 45 ] def-travel X 27 [ 41 44 ] def-travel X 28 [ 19 38 11 46 ] def-travel X 28 [ 33 45 55 ] def-travel X 28 [ 36 30 52 ] def-travel X 29 [ 19 38 11 45 ] def-travel X 30 [ 19 38 11 43 ] def-travel X 30 [ 62 44 29 ] def-travel X 31 [ 524089 1 ] def-travel X 31 [ 90 1 ] def-travel X 32 [ 19 1 ] def-travel X 33 [ 3 65 ] def-travel X 33 [ 28 46 ] def-travel X 33 [ 34 43 53 54 ] def-travel X 33 [ 35 44 ] def-travel X 33 [ 159302 71 ] def-travel X 33 [ 100 71 ] def-travel X 34 [ 33 30 55 ] def-travel X 34 [ 15 29 ] def-travel X 35 [ 33 43 55 ] def-travel X 35 [ 20 39 ] def-travel X 36 [ 37 43 17 ] def-travel X 36 [ 28 29 52 ] def-travel X 36 [ 39 44 ] def-travel X 36 [ 65 70 ] def-travel X 37 [ 36 44 17 ] def-travel X 37 [ 38 30 31 56 ] def-travel X 38 [ 37 56 29 11 ] def-travel X 38 [ 595 60 14 30 4 5 ] def-travel X 39 [ 36 43 23 ] def-travel X 39 [ 64 30 52 58 ] def-travel X 39 [ 65 70 ] def-travel X 40 [ 41 1 ] def-travel X 41 [ 42 46 29 23 56 ] def-travel X 41 [ 27 43 ] def-travel X 41 [ 59 45 ] def-travel X 41 [ 60 44 17 ] def-travel X 42 [ 41 29 ] def-travel X 42 [ 42 45 ] def-travel X 42 [ 43 43 ] def-travel X 42 [ 45 46 ] def-travel X 42 [ 80 44 ] def-travel X 43 [ 42 44 ] def-travel X 43 [ 44 46 ] def-travel X 43 [ 45 43 ] def-travel X 44 [ 43 43 ] def-travel X 44 [ 48 30 ] def-travel X 44 [ 50 46 ] def-travel X 44 [ 82 45 ] def-travel X 45 [ 42 44 ] def-travel X 45 [ 43 45 ] def-travel X 45 [ 46 43 ] def-travel X 45 [ 47 46 ] def-travel X 45 [ 87 29 30 ] def-travel X 46 [ 45 44 11 ] def-travel X 47 [ 45 43 11 ] def-travel X 48 [ 44 29 11 ] def-travel X 49 [ 50 43 ] def-travel X 49 [ 51 44 ] def-travel X 50 [ 44 43 ] def-travel X 50 [ 49 44 ] def-travel X 50 [ 51 30 ] def-travel X 50 [ 52 46 ] def-travel X 51 [ 49 44 ] def-travel X 51 [ 50 29 ] def-travel X 51 [ 52 43 ] def-travel X 51 [ 53 46 ] def-travel X 52 [ 50 44 ] def-travel X 52 [ 51 43 ] def-travel X 52 [ 52 46 ] def-travel X 52 [ 53 29 ] def-travel X 52 [ 55 45 ] def-travel X 52 [ 86 30 ] def-travel X 53 [ 51 44 ] def-travel X 53 [ 52 45 ] def-travel X 53 [ 54 46 ] def-travel X 54 [ 53 44 11 ] def-travel X 55 [ 52 44 ] def-travel X 55 [ 55 45 ] def-travel X 55 [ 56 30 ] def-travel X 55 [ 57 43 ] def-travel X 56 [ 55 29 11 ] def-travel X 57 [ 13 30 56 ] def-travel X 57 [ 55 44 ] def-travel X 57 [ 58 46 ] def-travel X 57 [ 83 45 ] def-travel X 57 [ 84 43 ] def-travel X 58 [ 57 43 11 ] def-travel X 59 [ 27 1 ] def-travel X 60 [ 41 43 29 17 ] def-travel X 60 [ 61 44 ] def-travel X 60 [ 62 45 30 52 ] def-travel X 61 [ 60 43 ] def-travel X 61 [ 62 45 ] def-travel X 61 [ 100107 46 ] def-travel X 62 [ 60 44 ] def-travel X 62 [ 63 45 ] def-travel X 62 [ 30 43 ] def-travel X 62 [ 61 46 ] def-travel X 63 [ 62 46 11 ] def-travel X 64 [ 39 29 56 59 ] def-travel X 64 [ 65 44 70 ] def-travel X 64 [ 103 45 74 ] def-travel X 64 [ 106 43 ] def-travel X 65 [ 64 43 ] def-travel X 65 [ 66 44 ] def-travel X 65 [ 80556 46 ] def-travel X 65 [ 68 61 ] def-travel X 65 [ 80556 29 ] def-travel X 65 [ 50070 29 ] def-travel X 65 [ 39 29 ] def-travel X 65 [ 60556 45 ] def-travel X 65 [ 75072 45 ] def-travel X 65 [ 71 45 ] def-travel X 65 [ 80556 30 ] def-travel X 65 [ 106 30 ] def-travel X 66 [ 65 47 ] def-travel X 66 [ 67 44 ] def-travel X 66 [ 80556 46 ] def-travel X 66 [ 77 25 ] def-travel X 66 [ 96 43 ] def-travel X 66 [ 50556 50 ] def-travel X 66 [ 97 72 ] def-travel X 67 [ 66 43 ] def-travel X 67 [ 23 44 42 ] def-travel X 67 [ 24 30 31 ] def-travel X 68 [ 23 46 ] def-travel X 68 [ 69 29 56 ] def-travel X 68 [ 65 45 ] def-travel X 69 [ 68 30 61 ] def-travel X 69 [ 331120 46 ] def-travel X 69 [ 119 46 ] def-travel X 69 [ 109 45 ] def-travel X 69 [ 113 75 ] def-travel X 70 [ 71 45 ] def-travel X 70 [ 65 30 23 ] def-travel X 70 [ 111 46 ] def-travel X 71 [ 65 48 ] def-travel X 71 [ 70 46 ] def-travel X 71 [ 110 45 ] def-travel X 72 [ 65 70 ] def-travel X 72 [ 118 49 ] def-travel X 72 [ 73 45 ] def-travel X 72 [ 97 48 72 ] def-travel X 73 [ 72 46 17 11 ] def-travel X 74 [ 19 43 ] def-travel X 74 [ 331120 44 ] def-travel X 74 [ 121 44 ] def-travel X 74 [ 75 30 ] def-travel X 75 [ 76 46 ] def-travel X 75 [ 77 45 ] def-travel X 76 [ 75 45 ] def-travel X 77 [ 75 43 ] def-travel X 77 [ 78 44 ] def-travel X 77 [ 66 45 17 ] def-travel X 78 [ 77 46 ] def-travel X 79 [ 3 1 ] def-travel X 80 [ 42 45 ] def-travel X 80 [ 80 44 ] def-travel X 80 [ 80 46 ] def-travel X 80 [ 81 43 ] def-travel X 81 [ 80 44 11 ] def-travel X 82 [ 44 46 11 ] def-travel X 83 [ 57 46 ] def-travel X 83 [ 84 43 ] def-travel X 83 [ 85 44 ] def-travel X 84 [ 57 45 ] def-travel X 84 [ 83 44 ] def-travel X 84 [ 114 50 ] def-travel X 85 [ 83 43 11 ] def-travel X 86 [ 52 29 11 ] def-travel X 87 [ 45 29 30 ] def-travel X 88 [ 25 30 56 43 ] def-travel X 88 [ 20 39 ] def-travel X 88 [ 92 44 27 ] def-travel X 89 [ 25 1 ] def-travel X 90 [ 23 1 ] def-travel X 91 [ 95 45 73 23 ] def-travel X 91 [ 72 30 56 ] def-travel X 92 [ 88 46 ] def-travel X 92 [ 93 43 ] def-travel X 92 [ 94 45 ] def-travel X 93 [ 92 46 27 11 ] def-travel X 94 [ 92 46 27 23 ] def-travel X 94 [ 309095 45 3 73 ] def-travel X 94 [ 611 45 ] def-travel X 95 [ 94 46 11 ] def-travel X 95 [ 92 27 ] def-travel X 95 [ 91 44 ] def-travel X 96 [ 66 44 11 ] def-travel X 97 [ 66 48 ] def-travel X 97 [ 72 44 17 ] def-travel X 97 [ 98 29 45 73 ] def-travel X 98 [ 97 46 72 ] def-travel X 98 [ 99 44 ] def-travel X 99 [ 98 50 73 ] def-travel X 99 [ 301 43 23 ] def-travel X 99 [ 100 43 ] def-travel X 100 [ 301 44 23 11 ] def-travel X 100 [ 99 44 ] def-travel X 100 [ 159302 71 ] def-travel X 100 [ 33 71 ] def-travel X 100 [ 101 47 22 ] def-travel X 101 [ 100 46 71 11 ] def-travel X 102 [ 103 30 74 11 ] def-travel X 103 [ 102 29 38 ] def-travel X 103 [ 104 30 ] def-travel X 103 [ 114618 46 ] def-travel X 103 [ 115619 46 ] def-travel X 103 [ 64 46 ] def-travel X 104 [ 103 29 74 ] def-travel X 104 [ 105 30 ] def-travel X 105 [ 104 29 11 ] def-travel X 105 [ 103 74 ] def-travel X 106 [ 64 29 ] def-travel X 106 [ 65 44 ] def-travel X 106 [ 108 43 ] def-travel X 107 [ 131 46 ] def-travel X 107 [ 132 49 ] def-travel X 107 [ 133 47 ] def-travel X 107 [ 134 48 ] def-travel X 107 [ 135 29 ] def-travel X 107 [ 136 50 ] def-travel X 107 [ 137 43 ] def-travel X 107 [ 138 44 ] def-travel X 107 [ 139 45 ] def-travel X 107 [ 61 30 ] def-travel X 108 [ 95556 43 45 46 47 48 49 50 29 30 ] def-travel X 108 [ 106 43 ] def-travel X 108 [ 626 44 ] def-travel X 109 [ 69 46 ] def-travel X 109 [ 113 45 75 ] def-travel X 110 [ 71 44 ] def-travel X 110 [ 20 39 ] def-travel X 111 [ 70 45 ] def-travel X 111 [ 40050 30 39 56 ] def-travel X 111 [ 50053 30 ] def-travel X 111 [ 45 30 ] def-travel X 112 [ 131 49 ] def-travel X 112 [ 132 45 ] def-travel X 112 [ 133 43 ] def-travel X 112 [ 134 50 ] def-travel X 112 [ 135 48 ] def-travel X 112 [ 136 47 ] def-travel X 112 [ 137 44 ] def-travel X 112 [ 138 30 ] def-travel X 112 [ 139 29 ] def-travel X 112 [ 140 46 ] def-travel X 113 [ 109 46 11 109 ] def-travel X 114 [ 84 48 ] def-travel X 115 [ 116 49 ] def-travel X 116 [ 115 47 ] def-travel X 116 [ 593 30 ] def-travel X 117 [ 118 49 ] def-travel X 117 [ 233660 41 42 69 47 ] def-travel X 117 [ 332661 41 ] def-travel X 117 [ 303 41 ] def-travel X 117 [ 332021 39 ] def-travel X 117 [ 596 39 ] def-travel X 118 [ 72 30 ] def-travel X 118 [ 117 29 ] def-travel X 119 [ 69 45 11 ] def-travel X 119 [ 653 43 7 ] def-travel X 120 [ 69 45 ] def-travel X 120 [ 74 43 ] def-travel X 121 [ 74 43 11 ] def-travel X 121 [ 653 45 7 ] def-travel X 122 [ 123 47 ] def-travel X 122 [ 233660 41 42 69 49 ] def-travel X 122 [ 303 41 ] def-travel X 122 [ 596 39 ] def-travel X 122 [ 124 77 ] def-travel X 122 [ 126 28 ] def-travel X 122 [ 129 40 ] def-travel X 123 [ 122 44 ] def-travel X 123 [ 124 43 77 ] def-travel X 123 [ 126 28 ] def-travel X 123 [ 129 40 ] def-travel X 124 [ 123 44 ] def-travel X 124 [ 125 47 36 ] def-travel X 124 [ 128 48 37 30 ] def-travel X 124 [ 126 28 ] def-travel X 124 [ 129 40 ] def-travel X 125 [ 124 46 77 ] def-travel X 125 [ 126 45 28 ] def-travel X 125 [ 127 43 17 ] def-travel X 126 [ 125 46 23 11 ] def-travel X 126 [ 124 77 ] def-travel X 126 [ 610 30 39 ] def-travel X 127 [ 125 44 11 17 ] def-travel X 127 [ 124 77 ] def-travel X 127 [ 126 28 ] def-travel X 128 [ 124 45 29 77 ] def-travel X 128 [ 129 46 30 40 ] def-travel X 128 [ 126 28 ] def-travel X 129 [ 128 44 29 ] def-travel X 129 [ 124 77 ] def-travel X 129 [ 130 43 19 40 3 ] def-travel X 129 [ 126 28 ] def-travel X 130 [ 129 44 11 ] def-travel X 130 [ 124 77 ] def-travel X 130 [ 126 28 ] def-travel X 131 [ 107 44 ] def-travel X 131 [ 132 48 ] def-travel X 131 [ 133 50 ] def-travel X 131 [ 134 49 ] def-travel X 131 [ 135 47 ] def-travel X 131 [ 136 29 ] def-travel X 131 [ 137 30 ] def-travel X 131 [ 138 45 ] def-travel X 131 [ 139 46 ] def-travel X 131 [ 112 43 ] def-travel X 132 [ 107 50 ] def-travel X 132 [ 131 29 ] def-travel X 132 [ 133 45 ] def-travel X 132 [ 134 46 ] def-travel X 132 [ 135 44 ] def-travel X 132 [ 136 49 ] def-travel X 132 [ 137 47 ] def-travel X 132 [ 138 43 ] def-travel X 132 [ 139 30 ] def-travel X 132 [ 112 48 ] def-travel X 133 [ 107 29 ] def-travel X 133 [ 131 30 ] def-travel X 133 [ 132 44 ] def-travel X 133 [ 134 47 ] def-travel X 133 [ 135 49 ] def-travel X 133 [ 136 43 ] def-travel X 133 [ 137 45 ] def-travel X 133 [ 138 50 ] def-travel X 133 [ 139 48 ] def-travel X 133 [ 112 46 ] def-travel X 134 [ 107 47 ] def-travel X 134 [ 131 45 ] def-travel X 134 [ 132 50 ] def-travel X 134 [ 133 48 ] def-travel X 134 [ 135 43 ] def-travel X 134 [ 136 30 ] def-travel X 134 [ 137 46 ] def-travel X 134 [ 138 29 ] def-travel X 134 [ 139 44 ] def-travel X 134 [ 112 49 ] def-travel X 135 [ 107 45 ] def-travel X 135 [ 131 48 ] def-travel X 135 [ 132 30 ] def-travel X 135 [ 133 46 ] def-travel X 135 [ 134 43 ] def-travel X 135 [ 136 44 ] def-travel X 135 [ 137 49 ] def-travel X 135 [ 138 47 ] def-travel X 135 [ 139 50 ] def-travel X 135 [ 112 29 ] def-travel X 136 [ 107 43 ] def-travel X 136 [ 131 44 ] def-travel X 136 [ 132 29 ] def-travel X 136 [ 133 49 ] def-travel X 136 [ 134 30 ] def-travel X 136 [ 135 46 ] def-travel X 136 [ 137 50 ] def-travel X 136 [ 138 48 ] def-travel X 136 [ 139 47 ] def-travel X 136 [ 112 45 ] def-travel X 137 [ 107 48 ] def-travel X 137 [ 131 47 ] def-travel X 137 [ 132 46 ] def-travel X 137 [ 133 30 ] def-travel X 137 [ 134 29 ] def-travel X 137 [ 135 50 ] def-travel X 137 [ 136 45 ] def-travel X 137 [ 138 49 ] def-travel X 137 [ 139 43 ] def-travel X 137 [ 112 44 ] def-travel X 138 [ 107 30 ] def-travel X 138 [ 131 43 ] def-travel X 138 [ 132 47 ] def-travel X 138 [ 133 29 ] def-travel X 138 [ 134 44 ] def-travel X 138 [ 135 45 ] def-travel X 138 [ 136 46 ] def-travel X 138 [ 137 48 ] def-travel X 138 [ 139 49 ] def-travel X 138 [ 112 50 ] def-travel X 139 [ 107 49 ] def-travel X 139 [ 131 50 ] def-travel X 139 [ 132 43 ] def-travel X 139 [ 133 44 ] def-travel X 139 [ 134 45 ] def-travel X 139 [ 135 30 ] def-travel X 139 [ 136 48 ] def-travel X 139 [ 137 29 ] def-travel X 139 [ 138 46 ] def-travel X 139 [ 112 47 ] def-travel X 140 [ 112 45 11 ] def-travel Xdictend def X Xtravel-table { % room# dict X exch pop X begin X currentdict { % verb neighbor# X verbs 2 index known not { pop pop } { X travel-table exch X dup 999 gt { X dup 1000 div floor 1000 mul sub X cvi X } if X 2 copy known { X get % verb dict X def X } { X pop pop pop X } ifelse X } ifelse X } forall X end X} forall X Xsystemdict begin X /ColossalCave travel-table def X ColossalCave Xend % systemdict //go.sysin dd * if [ `wc -c < advent.map` != 38413 ]; then made=false echo error transmitting advent.map -- echo length should be 38413, not `wc -c < advent.map` else made=true fi if $made; then chmod 644 advent.map echo -n ' '; ls -ld advent.map fi ======== END OF cyber.shar.splitah ========