bernard@prlb2.UUCP (Bernard Yves) (01/05/89)
I am about to post 2 following articles with the complete source code of NeWSillustrator for NeWS 1.1. NeWSillustrator is an object-oriented drawing program (similar to fig or NewsDraw). It includes various object types (lines, polygons, curves, text,...) with full control on line width, line type, line color, font, font size, color filling... Objects can be moved, scaled, rotated, grouped, copied, edited, clipped, aligned, centered,... Objects can be saved and loaded, Postscript files can be imported (with the limitation of the NeWS postscript interpreter)to be manipulated as objects, and generated for laser printing. Full scrolling and zooming capabilities are available. Contrarly to NewsDraw, NeWSillustrator is entirely written in NeWS: there is no client program written in C or some other traditional language. One will note the equal code size of NeWSillustrator (i.e. 2600 lines of NeWS postscript) and NewsDraw (i.e. 500 lines of NeWS PS and 2000 lines of C) for much greater functionalities in NeWSillustrator. This is partly due to the object-oriented extension of NeWS. And that for the same performance... and with probably a much better readability and flexibility. For me, this raises the following remark : for this kind of application, it is easier to program in NeWS than in C. If I had to write some client program, I will not do it in C, but in higher level languages such as Objective-C or Prolog. Many improvments should be made to NeWSillustrator. The main one would be to replace the very long command menu with an iconic tool window. Try to do it or wait for the next version... I am waiting now for a better NeWS implementation (full Postscript compatible), good NeWS documentation, ...and an equivalent Display Postscript of NeWSillustrator. Manual (draft). -------------- After loading, NeWSillustrator will ask you to shape two windows. Make them big enough. The first one is the Control Panel, the second one is the Drawing Area. Drawing Area ------------ This is where the drawing is made. The dashed lines are the sides of the visible area of an A4 sheet on a laser printer. The command menu is activated in pressing the right mouse button. In this menu, the available operations are divided in 3 parts : edition operations, object creation operations and finally zoom, font and files operations Usually, once a command is selected, messages are printed in the control panel to explain you what to do and what happened. The message panel item is at the bottom of the control panel. If you don't see it, move or reshape the control panel window. For all commands requiring text input or file name (e.g. Text, ImportPS,...), enter the text or name in the corresponding control panel item (e.g. Text String, PS file name) BEFORE selecting the command. Object Creation Operations. --------------------------- These are : Rect, Line, Polygon, Curve, RoundedRect, Oval, Text, Group, ImportPS. For all these operations, you will be asked to input points with the mouse: a point is entered in clicking on any button. When asked for a sequence of points (e.g. line and curve), end the sequence by clicking twice (or double-clicking) on the last point. Once an object is successfuly created, it becomes the current object. Rect, Line, Polygon, RoundedRect, Oval : should be obvious. Curve : curves are made of Postscript elementary curves which are defined by 4 points. You will be asked to enter a sequence of points, and every time you input 3 points, a elementary curve is drawn connecting the 3 points with the last point of the previous curve. Text : before selecting this command, first enter the text to draw in the 'Text String' item of the control panel : just click in the Text String item with the left mouse button and insert text. Text editing is allowed with the DEL, ctrl-f, ctrl-b and ctrl-d keys with the usual emacs meaning. Once the text is input, select the text command in the drawing area window menu and position the text at the right place. Group : A group is a collection of any objects. A group is defined in two ways: by a box (the default) or by enumeration. The definition mode is changed in clicking in the 'Group Defined by' item of the control panel. by box: just enter a box enclosing completly the objects to group. by enumeration : enter the origin point of the group, and then select each object by clicking on it. End in double-clicking on any point. Objects in a group are not accessible individually : to select an object in a group, you have to delete the group. A group is depicted on the screen by drawing its components and small squares on its enclosing box (Sometime, after rotation and scaling the box is not correct). A group is selected by clicking a point in that box. ImportPS : This object type correspond to imported Postscript files. The range of importable files is limited by the NeWS Postscript omissions (fonts, pattern filling,...). PS files produced by Fig seem to work. Of course, PS files generated by NeWSillustrator can be imported. Files which NeWS can not display will cause errors -- see the message in the control panel -- and will be (or should be) refused. Again, before selecting ImportPS, define the PS file to import in the corresponding item in the Control Panel. If the file can be successfully loaded, it will be displayed on the screen and you will be asked to give its bounding box. An imported file is considered as an usual object : it can be moved, copied, rotated, scaled, grouped,... Importation of Postscript file is made by generating an intermediate file in your home directory with the same name as the imported file and ".wps" as extension. Edition Operations. ------------------- These operations always work on the current selection. To set an object as the current selection use the select command. Select : click in the inside of the object. NeWSillustrator will select the first object found under the clicked point. If it is not the one you want (because of many overlapping objects), move other objects or create a group that you will define by a box enclosing the object you want. Groups are selected by clicking in their enclosing box. Move, Rotate, Scale : obvious. Rotation and scaling use the origin point of the object as reference point. The origin point is usually the first point input when defining the object or a corner of the enclosing box. Copy : makes a copy of the current object. The copy becomes the new selection and you have to move it where you want. Redisplay : objects overlapping moved objects are not redrawn. Use Redisplay to redraw all the objects and redraw them in the current order. Move Up, Move Down : the display order defines how objects overlap each other. Move Up and Down change the display order and give full control on overlapping. Move Up (Down) will swap the current object with the next encountered object in the display list which is drawn after (before) it. If you continuously apply Move Up (Down) on an object, it should then become the last (first) displayed object (see the message in the control panel). Delete : delete the current selection. Delete a group but not its components (i.e. ungroup). Destroy : deletes a group AND all its components. Other => : a submenu of other editing operations: --------- Edit : only works for Lines, Polygons and Curves; allows to move points defining the selected objects. First, select a point by clicking on it and then move it. To stop edition double-click anywhere. Note that the first point of an item is not editable. Clip : clip the current selection object with another object which will have to be selected by the user. The clipping object should not be a group, a text or an ImportPS object. The inside of the clipping path is determined by the normal PostScript non-zero winding number rule. A clipped object is implemented as a special kind of group: many operations available on group can be used on clipped object (e.g. delete, destroy). Align Left, Right,..., Center : works for items in a selected group; Zoom Operations : easy ; use the scroll bar to scroll your drawing. ----------------- Font => ------- Choose the font in the font menu. It will be the default font of newly created text object and, change the font of the current selection. All the fonts listed are not available on the laser. Also, there are problems with some fonts in NeWS. Font Size => : obvious. ------------ Files Operations. ---------------- The 'Files IO =>' leads to a submenu with files operations. They require the corresponding file name to be defined in the control panel before selecting them. save PS file : generates a Postscript file printable on a laser and importable as an object in NeWSillustrator; save Objects file: save all the objects of the current drawing; load Object file: add all the objects in the file to the current drawing; (Object files can be used as a library) Control Panel ------------- There are three types of Control panel items : text and file name items, drawing parameters items and control items. Drawing parameters Items: They are : line width, style, join, cap, color, fill color, Rounded Corner Radius. Values of the drawing parameters are those of the curent selection. Change of a drawing parameter always affect the current selection. If it is a group, its components will be affected. Use of Sliding items (e.g line color): just click anywhere on the line or drag the cursor to the required value. line color : the gray level from 0 (black) to 100 (white). fill color : idem ; the -1 is used for no fill. Color of text is changed by the line color slide, but in NeWS text is always displayed as black on a monochrome screen. Control Items : grid size, grid on, group defined by, message item, line quality. The line quality controls the rendering quality of NeWS : 0 = low quality but faster, 10 = best quality but slower. Grid Size : the current unit is screen point. The grid will be displayed at the next repaint of the Drawing Area Window. File Items : obvious. ---------------------------------------------------------------------------- Yves Bernard Philips Research Lab Brussels, 2 av. Van Becelaere 1170 Brussels, Belgium bernard@prlb2.uucp
bernard@prlb2.UUCP (Bernard Yves) (01/05/89)
NeWSillustrator part 1
append it with part 2, put it in a file, do chmod u+x and run it.
--------------------------------------------------------------------------
#!/usr/NeWS/bin/psh
%==========================================================================
% scrollable and zoomable window class definition
systemdict /zapmenu known not
{systemdict begin
/zapmenu [
(No, not really) {}
(Yes, really) {/destroy ThisWindow send}
] /new DefaultMenu send def
end
} if
/ScrollAndZoomWindow ScrollWindow
dictbegin
/PictureWidth 0 def % for translating the client window
/PictureHeight 0 def
/LDivisions 10 def % number of scroll bad pieces/whole
/PDivisions 3 def % number of scroll bad pieces/whole
/ScrollH 0 def % cumulative translation factors
/ScrollV 0 def % due to successive scrolling;
/ZoomFactor 1 def % zooming factor;
/newox 0 def
/newoy 0 def
/Nzoom 0 def
/zoomstack 50 array def
/overlaycan null def
dictend
classbegin
/Resize { % width height => - size the backround canvas
/PictureHeight exch def
/PictureWidth exch def
[%0 PictureWidth ClientWidth sub
newox neg PictureWidth ClientWidth sub newox add %min max
dup dup LDivisions div exch PDivisions div
null]
/setrange HScrollbar send
[%0 PictureHeight ClientHeight sub
newoy neg PictureHeight ClientHeight sub newoy add
dup dup LDivisions div exch PDivisions div null]
/setrange VScrollbar send
} def
/SetNotifiers { % Hnotifier Vnotifier => -
VScrollbar /NotifyUser 3 -1 roll put
HScrollbar /NotifyUser 3 -1 roll put
} def
/Scroll {ScrollProc} def
/ZoomIn {/ZoomFactor ZoomFactor 2 mul def ZoomInProc} def
/ZoomOut {ZoomFactor 1 ne
{/ZoomFactor ZoomFactor 2 div def ZoomOutProc} if} def
/ShapeClientCanvas {
ClientCanvas null ne {
ScrollAndZoomAxis} if
} def
/CreateFrameMenu { % - => - (Create frame menu)
% Note: Store menu in class to share menus, especially if retained.
/FrameMenu [
(Move) {/slide ThisWindow send}
(Move Constrained)
{getfbclick pop pop /slideconstrained ThisWindow send}
(Top) {/totop ThisWindow send}
(Bottom) {/tobottom ThisWindow send}
(Zap => ) zapmenu
(Resize) {/reshapefromuser ThisWindow send}
(Stretch Corner)
{getfbclick pop pop /stretchcorner ThisWindow send}
(Stretch Edge)
{getfbclick pop pop /stretchwindowedge ThisWindow send}
(Close) {/flipiconic ThisWindow send}
(Redisplay) {/paint ThisWindow send}
] /new DefaultMenu send def
} def
/ScrollAxis {%the scorllbar values are always in abs. coord.
/ScrollH HScrollbar /ItemValue get def
/ScrollV VScrollbar /ItemValue get def
BorderLeft BorderBottom translate
ScrollH neg ScrollV neg translate
} def
/ScrollProc {
ScrollAndZoomAxis
/PaintClient self send
} def
/pushzoomstack{% - => -
zoomstack Nzoom [ScrollH ScrollV ] put
/Nzoom Nzoom 1 add store
} def
/popzoomstack{%
Nzoom 0 ne
{/Nzoom Nzoom 1 sub store
zoomstack Nzoom get aload pop
%put that in the scroll bar value
/ScrollV exch store /ScrollH exch store
HScrollbar /ItemValue ScrollH put
VScrollbar /ItemValue ScrollV put
} if
} def
/ZoomInAxis { %zoom in by 1, 2, 4, 8,...
/newox ClientWidth 2 div ClientWidth 2 ZoomFactor exp div sub def
/newoy ClientHeight 2 div ClientHeight 2 ZoomFactor exp div sub def
newox neg newoy neg translate
ZoomFactor ZoomFactor scale
%
ScrollH ZoomFactor div newox ZoomFactor div add
ScrollV ZoomFactor div newoy ZoomFactor div add
ClientWidth ZoomFactor div ClientHeight ZoomFactor div
ClientPath ClientCanvas reshapecanvas
} def
/ScrollAndZoomAxis {
gsave
FrameCanvas setcanvas
ScrollAxis
% modifies the transf. matrix of the client canvas:
ZoomFactor 1 eq
{/newox 0 store
/newoy 0 store
ScrollH ScrollV ClientWidth ClientHeight ClientPath
ClientCanvas reshapecanvas}
{ZoomInAxis} ifelse
/overlaycan ClientCanvas createoverlay store
grestore
} def
/ZoomInProc {
pushzoomstack
ScrollAndZoomAxis
/PaintClient self send
PictureWidth 2 mul
PictureHeight 2 mul /Resize self send
% HScrollbar dup /ItemValue exch /ItemValue get 2 mul put
% VScrollbar dup /ItemValue exch /ItemValue get 2 mul put
HScrollbar /ItemValue ScrollH newox add put
VScrollbar /ItemValue ScrollV newoy add put
/paintscrollbars self send
} def
/ZoomOutProc {
popzoomstack
ScrollAndZoomAxis
/PaintClient self send
PictureWidth 2 div
PictureHeight 2 div /Resize self send
% HScrollbar dup /ItemValue exch /ItemValue get 2 mul put
% VScrollbar dup /ItemValue exch /ItemValue get 2 mul put
HScrollbar /ItemValue ScrollH newox add put
VScrollbar /ItemValue ScrollV newoy add put
/paintscrollbars self send
} def
classend def
%===========================================================================
% utilities
%===========================================================================
/setoverlay {win begin overlaycan end setcanvas} def
/prdebug false def
/printdbg { prdebug {print} {pop} ifelse} def
(Loading utilities \n) printdbg
/drect { % x,y w, h => - : makes a path corresponding to the box
4 2 roll moveto rect
} def
%setting of the object coord. system
/spos {translate rotate scale} def
/printcoord { exch 3 string cvs print ( X\n) print
3 string cvs print ( Y\n) print} def
/printpath {
{printcoord} {printcoord} {printcoord printcoord printcoord}
{} pathforall} def
/b1 null def
/boxpath { % [x1 y1 x2 y2] => - makes path of the box
aload pop
3 index 3 index moveto %x1 y1 x2 y2
2 index sub %x1 y1 x2 (y2-y1)
exch 3 index sub exch rect
pop pop
} def
/box_in_box {% b1 b2 => bool ; true if b1 in b2; box = [x0, y0, x1, y1]
gsave
boxpath
aload pop %x1 y1 x2 y2
pointinpath 3 1 roll
pointinpath and
grestore
} def
/box_of_box {% b1 b2 => b2 ;computes the box enclosing the 2
% gsave
aload pop 5 -1 roll aload pop %4 points on the stack connect them in
newpath
moveto lineto lineto lineto
[ pathbbox ]
% grestore
} def
/o_dict dictbegin /x1 0 def /x2 0 def /y1 0 def /y2 0 def dictend def
/overlapping_interval{ % x1 x2 y1 y2 => true if [x1 x1] inter [y1 y2]
%non null
o_dict begin
/y2 exch store /y1 exch store /x2 exch store /x1 exch store
{
x1 y1 le x2 y1 ge and {true exit} if
x1 y2 le x2 y2 ge and {true exit} if
y1 x1 le y2 x2 ge and {true exit} if
false exit
} loop
end
} def
/overlapping_box{% b1 b2 => bool; true if box overlaps
aload pop
5 -1 roll aload pop
7 index 6 index %x11 x12
5 index 4 index %x21 x22
overlapping_interval
{6 index 5 index 4 index 3 index overlapping_interval}
{false} ifelse
mark 10 2 roll cleartomark
} def
%working var.
/mtrx0 matrix def
/mtrx1 matrix def
/newarray null def
/tmparray 100 array def
/Ntmp 0 def
/N 0 def
/tmpstr 50 string def
/Angle2 0 def
/Sx2 1 def
/Sy2 1 def
/Sx3 1 def
/Sy3 1 def
/X0 0 def
/Y0 0 def
/X1 0 def
/Y1 0 def
/X2 0 def
/Y2 0 def
/Xc 0 def
/Yc 0 def
/oldcanvas null def
%===========================================================================
% object Table definition and management
/SizeObjTable 1000 def
/ObjTable SizeObjTable array def
0 1 199 {ObjTable exch null put} for
/Nobj 0 def %
/AddObject
{% <obj> => -
dup ObjTable exch Nobj exch put begin /tableindex Nobj store end
/Nobj Nobj 1 add store
Nobj SizeObjTable ge {(Object Table is full) prmessage} if
}
def
/RepaintAll {% repaint all objects in table;
gsave
/display a4rect send
0 1 Nobj 1 sub
{ObjTable exch get
dup null ne {dup begin ingroup end
{pop}
{/display exch send} ifelse
}
{pop} ifelse} for
grestore
draw_grid
} def
/PrintPS_header{ %postscript utilities
PSfile
(/rect {dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath } def
/ovalpath { matrix currentmatrix 5 1 roll
4 2 roll translate scale .5 .5 translate 0 0 .5 0 360 arc closepath
setmatrix} def\n) [] fprintf
PSfile
(/rrectpath {
matrix currentmatrix 6 1 roll % m r x y w h
4 2 roll translate % m r w h
10 dict begin
/h exch def /w exch def /r exch def
mark
r 0 moveto
w 0 w h r arcto w h 0 h r arcto
0 h 0 0 r arcto 0 0 w 0 r arcto closepath
cleartomark
end
setmatrix
} def\n) writestring
%dash patterns
print_dasharray_ps
PSfile
(/setdashpat{% n => -
dasharray exch get aload pop setdash} def\n) writestring
PSfile (0 setlinewidth 0 setgray
/privatedict 100 dict def
/savemtrx matrix def
/spos {translate rotate scale} def
privatedict begin /showpage {} def end \n) writestring
} def
/dasharray [ [ [] 0 ] [ [3] 0 ] [ [6] 0 ] ] def
/setdashpat{% n => -
dasharray exch get aload pop setdash} def
/print_dasharray_ps{%
PSfile (/dasharray [\n) writestring
dasharray {aload pop exch %offset array
PSfile ([ [ ) writestring
{ PSfile exch ( % ) exch [ exch ] fprintf} forall
PSfile ( ] ) writestring
PSfile exch ( % ] ) exch [ exch ] fprintf
} forall
PSfile ( ] def\n) writestring
} def
/importfiledict null def
%used when generating the postscript file
%to remind what imported PS file have already been written
/RepaintAll_ps {% generates postscript file
PrintPS_header
/importfiledict 50 dict store
PSfile (gsave \n) [] fprintf
0 1 Nobj 1 sub
{ObjTable exch get
dup null ne {dup begin ingroup end
{pop}
{/display_ps exch send} ifelse
}
{pop} ifelse} for
PSfile (grestore showpage\n) [] fprintf
} def
/SaveAllObjects {% generates NeWS files of object def; loaded with run
0 1 Nobj 1 sub
{ObjTable exch get
dup null ne {dup begin ingroup end
{pop}
{/saveobject exch send} ifelse
}
{pop} ifelse} for
} def
/loadobj{%used in loading obj files.
counttomark 1 add index %obj mark var1... varn obj
/loadivar exch send cleartomark
dup begin ingroup not end {pop} if
} def
(Loading Class def \n) printdbg
/DrawObject Object
dictbegin
/X 0 def %position
/Y 0 def
/Sx 1 def %scaling
/Sy 1 def
/Angle 0 def %rotation
/bbox null def %bounding box [x1,y1,x2,y2]
/color -1 def %filling pattern = -1 : no filling
/linewidth 0 def %line width
/linecolor 0 def %line color = black
/linestyle 0 def %line style = plain or dashed
/linejoin 0 def
/linecap 0 def
/geom null def %
% default geom is a rect [w,h]
/tableindex -1 def
/ingroup false def % true if object part of a group
dictend
classbegin
/new {
/new super send begin
/init self send
currentdict end
} def
/init {
/bbox 4 array store} def
/delete {
/erase self send
ObjTable tableindex null put} def
/destroy {} def
/saveivar{%writes instance var. on File
OSfile ( % % % % % ) [X Y Sx Sy Angle] fprintf
OSfile ( [ % % % % ] \n) bbox fprintf
OSfile ( % % % % % % \n) [color linewidth linecolor
linestyle linejoin linecap] fprintf
/save_geom self send
OSfile ( % ) [ingroup] fprintf
} def
/loadivar {% mark objects instances var => self if ingroup else -
%in the order in which they are defined
/ingroup exch store
%tableindex
/geom exch store
/linecap exch store
/linejoin exch store
/linestyle exch store
/linecolor exch store
/linewidth exch store
/color exch store
/bbox exch store
/Angle exch store
/Sy exch store
/Sx exch store
/Y exch store
/X exch store
} def
/getclassname{%get the class name of the object
ParentDictArray dup length 1 sub get begin ClassName end
} def
/saveobject{%saves object descr in OSfile
OSfile (/new % send dup AddObject mark \n)
[/getclassname self send] fprintf
/saveivar self send
OSfile ( loadobj\n) writestring
} def
/save_geom{%save geom descr
OSfile ( [ % % ]\n) geom fprintf} def
/setradcorner {pop} def
/setlinestyle{/linestyle exch store} def
/setlinejoin2 {/linejoin exch store} def
/setlinecap2 {/linecap exch store} def
/setlinewidth2 { /linewidth exch store } def
/setlinecolor { /linecolor exch store } def
/setcolor { /color exch store } def
/changefont {} def
/changefontsize {} def
/update_control_panel{% put display param of objects in control panel
linewidth linecolor color linestyle linejoin linecap
putinControlPanel
} def
/bbox_path { %in absolute coord syst.
bbox 0 get bbox 1 get moveto
bbox 2 get bbox 0 get sub bbox 3 get bbox 1 get sub rect
} def
/make_path { % Sx Sy angle X Y => -
%makes the path of the object : default is drawing a rect
%of W, H
geom null ne {
spos
% translate rotate scale
newpath
0 0 moveto
geom aload pop rect} if
} def
/make_path_ps{% - => -
geom null ne {
PSfile
(spos newpath 0 0 moveto % % rect\n) geom
fprintf}
if
} def
/is_in_box {% x y => bool ;
gsave
/bbox_path self send
pointinpath
grestore
} def
/is_in_obj {% x y => bool ;
geom null eq {pop pop false}
{gsave
newpath moveto
X Y translate Angle rotate Sx Sy scale %
{} {} {} {} pathforall %x y in object coord. sys.
1 1 0 0 0 /make_path self send
pointinpath
grestore} ifelse
} def
/dr { %low-level drawing : linewidth linecolor color linejoin linecap
% linestyle => -
%graphic state is preserved; dash not implemented in news
%emulate it
gsave
setdashpat
setlinecap setlinejoin
Sx Sy Angle X Y /make_path self send
dup -1 ne {gsave setgray fill grestore} {pop} ifelse
setgray setlinewidth
stroke
grestore
} def
/dr_ps {% color => -
PSfile (gsave setdashpat setlinecap setlinejoin % % % % %\n)
[Sx Sy Angle X Y] fprintf
/make_path_ps self send
-1 ne { PSfile ( gsave setgray fill grestore ) [] fprintf}
{PSfile ( pop ) [] fprintf} ifelse
PSfile (setgray setlinewidth stroke grestore\n) [] fprintf
} def
/erase { % this will also erase parts of overlapping objects
linewidth 1 color -1 eq {color} {1} ifelse
linejoin linecap linestyle /dr self send } def
/display { %display the object
linewidth linecolor color linejoin linecap linestyle
/dr self send} def
/display_ps {%generation of postscript
PSfile ( % % % % % % ) [linewidth linecolor color linejoin
linecap linestyle] fprintf
color /dr_ps self send
} def
/make_bbox { %computes the bounding box of the object in the current
%coord system
mtrx0 currentmatrix pop
gsave
Sx Sy Angle X Y /make_path self send
%path made in trans,scaled,rotated
%coord. sys; get coord in normal sys;
mtrx0 setmatrix %path set in mtrx0 coord syst.
pathbbox bbox astore pop
grestore
} def
/move { % x' y' sx' sy' a' => moves to new position and orientation;
% recomputes bbox;
erase_flag {/erase self send} if
/Angle exch def
/Sy exch def
/Sx exch def
/Y exch def
/X exch def
/make_bbox self send
/display self send
} def
/set_geom {% [p1,p2] => - ; new H and W
/geom exch store
} def
/scale_geom { % sx sy => -
geom 1 get mul geom exch 1 exch put
geom 0 get mul geom exch 0 exch put
} def
/get_geom { % => <geom param array>
geom } def
/change_geom {%change geometry; <changecode> => -
%erases old shapes and redraws it;
/erase self send
exec %exec change proc on stack
/make_bbox self send
/display self send
} def
/make_opath{ %the outline path used in draging mode
/make_path self send
} def
/drag { %drag outline of shape following cursor
% returns dragged position of new origin X' Y'
/oldcanvas currentcanvas store
setoverlay
/Angle2 Angle store
/Sx2 Sx store
/Sy2 Sy store
0 0 { newpath
Sx2 Sy2 Angle2 x y gsave /make_opath self send stroke grestore
} getanimated
waitprocess aload pop
oldcanvas setcanvas
} def
/bbox_center { % => xc, yc ; box center
bbox 0 get bbox 2 get add 2 div
bbox 1 get bbox 3 get add 2 div
} def
/drotate {%interactive rotation : put x y on stack
/oldcanvas currentcanvas store
setoverlay
/Angle2 Angle store
/Sx2 Sx store
/Sy2 Sy store
/X2 X store
/Y2 Y store
/bbox_center self send /Yc exch store /Xc exch store
0 0 { newpath
% get angle of vector Xc,Yc - x,y
Sx2 Sy2 Angle2 y Yc sub x Xc sub atan add X2 Y2
gsave /make_opath self send stroke grestore
} getanimated
waitprocess aload pop
oldcanvas setcanvas
} def
/dscale { %interactive scaling from box lower left corner
/oldcanvas currentcanvas store
setoverlay
/Angle2 Angle store
/Sx2 Sx store
/Sy2 Sy store
/X2 X store
/Y2 Y store
/Xc bbox 2 get bbox 0 get sub store
/Yc bbox 3 get bbox 1 get sub store
% /get_geom self send
bbox 0 get bbox 1 get {
newpath
Sx2 x x0 sub Xc div mul
Sy2 y y0 sub Yc div mul Angle2 X2 Y2
gsave /make_opath self send stroke grestore
} getanimated
waitprocess aload pop
oldcanvas setcanvas
} def
/drag_and_scale {%scale the geometry definition; preserve line width!!
/dscale self send % [old_geom] ,x y of new bbox corner on stack
/Y2 exch store /X2 exch store
X2 bbox 0 get sub bbox 2 get bbox 0 get sub div %sx'
Y2 bbox 1 get sub bbox 3 get bbox 1 get sub div %sy'
% X Y Sx2 Sx mul Sy2 Sy mul Angle /move self send} def
% this does not preserve line width !
{/scale_geom self send} /change_geom self send
} def
/drag_and_trans {
/drag self send %x' y' on stack; move to that
Sx Sy Angle /move self send} def
/drag_and_rotate {
/drotate self send %x' x' on stack; recompute angle;
/Y2 exch store
/X2 exch store
X Y Sx Sy Angle Y2 Yc sub X2 Xc sub atan add /move self send} def
/i_get_geom {%gets geom def. from user interaction ; - => X Y [geom def]
getwholerect waitprocess % [x0 y0 x1 y1]
aload pop
/Y1 exch store /X1 exch store
/Y0 exch store /X0 exch store
X0 Y0 [X1 X0 sub Y1 Y0 sub]
} def
/i_def_geom {%interactive definition of geom
/oldcanvas currentcanvas store
setoverlay
/i_get_geom self send % X Y <geom param>
3 -2 roll
oldcanvas setcanvas
geom null ne {/erase self send} if
/Y exch store
/X exch store
/set_geom self send
geom null ne {
/make_bbox self send
/display self send} if
} def
/edit_geom {} def
/clone_geom {%obj contains in its geom structured data which is
%shared by other objects ; copies geom and bbox
geom type (arraytype) eq
{/geom geom dup length array copy store
} if
bbox 4 array copy /bbox exch store
} def
/clone { % -> returns a clone of self
self length dict self exch copy %clone on stack
dup /clone_geom exch send
} def
classend def
(Oval \n) printdbg
/Oval DrawObject %geom = [w,h] of oval
dictbegin
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/make_path {% geom contains radius;
geom null ne {
spos
% translate rotate scale
newpath
0 0 geom 0 get geom 1 get ovalpath
} if
} def
/make_path_ps{
geom null ne {
PSfile ( spos newpath 0 0 % % ovalpath\n)
geom fprintf
} if
} def
/i_get_geom {
getclick
/Y0 exch store /X0 exch store %center
X0 Y0
{newpath x0 y0 x x0 sub y y0 sub ovalpath
} getanimated
waitprocess aload pop %x1 y1
/Y1 exch store
/X1 exch store
X0 Y0 [X1 X0 sub Y1 Y0 sub] %X,Y, w, h
} def
classend def
(Group \n) printdbg
/Group DrawObject
dictbegin
/Ngr 0 def %geom will contain an array with all the subobjects
%position of subobjects are relative to the position
%of the group
/Ncopy 0 def %working var. for recursive cloning
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/saveivar {
/saveivar super send
OSfile ( % ) [Ngr] fprintf
} def
/loadivar{
/Ngr exch store
/loadivar super send
} def
/delete {% all components are defined in the group coord. syst.
% put them back in the global syst.
mtrx0 currentmatrix pop
%translation correction
gsave
/components_path self send
mtrx0 setmatrix %coord expressed in global syst.
/N 0 store
{pop pop} {%component position X Y
geom N get begin /Y exch store /X exch store end
/N N 1 add store}
{} {} pathforall
grestore
%rotation
/Angle2 Angle store
geom {dup begin
/Angle Angle Angle2 add store
/ingroup false store
end
/make_bbox exch send
} forall
ObjTable tableindex null put
ingroup not {gsave
1 setgray /contour_mark self send
grestore} if
} def
/clone_geom{% makes a clone of each component
/clone_geom super send
/Ncopy 0 store
geom { /clone exch send dup geom exch Ncopy exch put
/Ncopy Ncopy 1 add store
AddObject} forall
} def
/destroy {%deletes all compoments
/erase self send
geom {begin ObjTable tableindex null put end} forall
ObjTable tableindex null put
} def
/setradcorner {
/Xc exch store
geom {Xc exch /setradcorner exch send} forall} def
/setlinejoin2 {
/Xc exch store
geom {Xc exch /setlinejoin2 exch send} forall} def
/setlinecap2 {
/Xc exch store
geom {Xc exch /setlinecap2 exch send} forall} def
/setlinestyle {
/Xc exch store
geom {Xc exch /setlinestyle exch send} forall} def
/setlinewidth2 {
/Xc exch store
geom {Xc exch /setlinewidth2 exch send} forall} def
/setlinecolor {
/Xc exch store
geom {Xc exch /setlinecolor exch send} forall} def
/setcolor {
/Xc exch store
geom {Xc exch /setcolor exch send} forall} def
/make_path {%stroke the path of each object; used in draging mode
%for scaling, we can not have at the same time good
%scaling of objects positions and good scaling of their shapes
geom null ne {
spos
geom
{dup begin
% Sx3 Sy3
Sx Sy Angle X Y end 6 -1 roll gsave /make_path
exch send stroke grestore} forall
} if
} def
/make_opath {%stroke the path of each object; used in draging mode
%for scaling, we can not have at the same time good
%scaling of objects positions and good scaling of their shapes
geom null ne {
spos
geom
{dup begin
% Sx3 Sy3
Sx Sy Angle X Y end 6 -1 roll gsave /make_opath
exch send stroke grestore} forall
} if
} def
/is_in_obj {
/is_in_box self send} def
/set_geom {%[o1 o2 o3 ...] =>
%change X Y of Oi to X' Y' relative to X Y of group obj
%set ingroup flag of each Oi
% (set_geom\n) print
dup length /geom exch array store
geom copy pop
/Ngr geom length store
%get origin of group : first point of bbox
/X 0 store /Y 0 store
% /make_bbox_component self send
/make_bbox self send
bbox aload pop %x1 y1 x2 y2
pop pop /Y exch store /X exch store
/X0 X store /Y0 Y store
geom {begin /X X X0 sub store /Y Y Y0 sub store /ingroup true
store end} forall
/make_bbox_component self send
( % components put in group) [Ngr] prmessage
} def
/save_geom{% saves on OSfile an array composed of each object saving
OSfile ([ %group geometry\n) writestring
geom {/saveobject exch send} forall
OSfile ( ] %end of group geometry\n) writestring
} def
/make_bbox_component{%compute bbox of comp. in this group coord. syst
gsave
X Y translate %Angle rotate
Sx Sy scale
geom {
/make_bbox exch send} forall
grestore
} def
/contour_mark{
bbox 0 get bbox 1 get moveto -2.5 dup rmoveto 5 5 rect fill
bbox 0 get bbox 2 get add 2 div bbox 1 get moveto
-2.5 dup rmoveto 5 dup rect fill
bbox 2 get bbox 1 get moveto -2.5 dup rmoveto 5 dup rect fill
bbox 2 get bbox 1 get bbox 3 get add 2 div moveto
-2.5 dup rmoveto 5 dup rect fill
bbox 2 get bbox 3 get moveto -2.5 dup rmoveto 5 dup rect fill
bbox 0 get bbox 2 get add 2 div bbox 3 get moveto
-2.5 dup rmoveto 5 dup rect fill
bbox 0 get bbox 3 get moveto -2.5 dup rmoveto 5 dup rect fill
bbox 0 get bbox 1 get bbox 3 get add 2 div moveto
-2.5 dup rmoveto 5 dup rect fill
} def
/display {
gsave
Sx Sy Angle X Y spos
geom {/display exch send} forall
grestore
ingroup not {
gsave
0 setgray
/contour_mark self send
grestore} if
} def
/align_left{%align all elements on the left side of the bbox
geom{begin /X X bbox 0 get sub store end} forall
/make_bbox_component self send
} def
/align_bottom{
geom{begin /Y Y bbox 1 get sub store end} forall
/make_bbox_component self send
} def
/align_right{%
/X1 bbox 2 get bbox 0 get sub store
geom {begin /X X X1 bbox 2 get sub add store end} forall
/make_bbox_component self send
} def
/align_top{%
/X1 bbox 3 get bbox 1 get sub store
geom {begin /Y Y X1 bbox 3 get sub add store end} forall
/make_bbox_component self send
} def
/center_vertical{
/X1 bbox 2 get bbox 0 get add 2 div bbox 0 get sub store
geom {begin /X X X1 bbox 2 get bbox 0 get add 2 div sub add store end}
forall
/make_bbox_component self send
} def
/center_horizontal{
/X1 bbox 3 get bbox 1 get add 2 div bbox 1 get sub store
geom {begin /Y Y X1 bbox 3 get bbox 1 get add 2 div sub add store end}
forall
/make_bbox_component self send
} def
/display_ps {
PSfile
(gsave % % translate % rotate % % scale\n) [X Y Angle Sx Sy] fprintf
geom {/display_ps exch send} forall
PSfile ( grestore\n) [] fprintf
} def
/erase {
gsave
X Y translate Angle rotate Sx Sy scale
geom {/erase exch send} forall
grestore
ingroup not {
gsave 1 setgray
/contour_mark self send
grestore} if
} def
/scale_geom {%sx sy
/Sy2 exch store /Sx2 exch store
geom {dup Sx2 Sy2 /scale_geom 4 -1 roll send
begin /X X Sx2 mul store /Y Y Sy2 mul store end} forall
/make_bbox_component self send
} def
/changefont {
{geom { /changefont exch send} forall} /change_geom self send
} def
/changefontsize{
{geom {/changefontsize exch send} forall} /change_geom self send
} def
/components_path {%makes a path going from 0 0 to origins of components
%relative to group coord. syst.
X Y translate Angle rotate Sx Sy scale
newpath
0 0 moveto
geom {begin X Y lineto end} forall
} def
/make_bbox {% approximatively computed from the box of components
%expressed relatively
%to the group coord. syst.
mtrx1 currentmatrix pop
gsave
%draws a path following all the boxex components
X Y translate Angle rotate Sx Sy scale
geom 0 get begin bbox aload pop %x1 y1 x2 y2
newpath moveto pop pop end
geom 0 Ngr getinterval
{begin bbox aload pop %x1 y1 x2 y2
2 copy lineto %x1 y1 x2 y2 ; x2 y2
1 index 3 index lineto % ; x2 y1
3 index 3 index lineto % ; x1 y1
3 index 1 index lineto % ; x1 y2
pop pop pop pop
end} forall
mtrx1 setmatrix
pathbbox bbox astore pop
grestore
} def
/i_get_geom_enum{%put selected objects as part of group
getclick %X1 Y1 - group origin
/Y1 exch store /X1 exch store
/X2 X1 store /Y2 Y1 store
/Ntmp 0 store
%repeat
{
(enter origin point : ) prmessage
getclick
/Y0 exch store /X0 exch store
(select objects - end with twice the same point :) prmessage
X0 X2 ne Y0 Y2 ne and
{
X0 Y0 find_object_on_pt
dup
null ne { dup begin (% added in group) [tableindex] prmessage end
tmparray exch Ntmp exch put /Ntmp Ntmp 1 add store
}
{pop} ifelse
/X2 X0 store /Y2 Y0 store
}
{exit} ifelse
} loop
% Ntmp 3 string cvs print ( N\n) print
X1 Y1 tmparray 0 Ntmp getinterval
} def
/i_get_geom_by_box{%define group in giving a box
(enter box enclosing objects to group : ) prmessage
getwholerect waitprocess %[x1 y1 x2 y2]
/bbox exch store
[ bbox find_objects_in_box /Ntmp exch store ]
(% objects to group) [Ntmp] prmessage
bbox 0 get bbox 1 get 3 -1 roll %the origin should be
%the bounding box
} def
/i_get_geom{
group_def_mode (by box) eq
{/i_get_geom_by_box self send}
{/i_get_geom_enum self send} ifelse
} def
classend def
(ClippingGroup \n) printdbg
/ClippingGroup Group
dictbegin
%a clipping group is composed of 2 objects : the first one
%is the clipping obj and the second one the clipped obj. The clipping obj
%should be a line or curve;
dictend
classbegin
/setclip{
mtrx1 currentmatrix pop
geom 0 get begin Sx Sy Angle X Y end
/make_path geom 0 get send clip %set the clip path
mtrx1 setmatrix
} def
/set_geom {%[o1 o2 o3 ...] =>
%change X Y of Oi to X' Y' relative to X Y of group obj
%set ingroup flag of each Oi
% (set_geom\n) print
dup length /geom exch array store
geom copy pop
/Ngr geom length store
%get origin of group : first point of bbox of clipping
geom 0 get begin bbox end aload pop %x1 y1 x2 y2
pop pop /Y exch store /X exch store
/X0 X store /Y0 Y store
geom {begin /X X X0 sub store /Y Y Y0 sub store /ingroup true
store end} forall
/make_bbox_component self send
} def
/delete{
geom 1 get begin /ingroup false store end
gsave
Sx Sy Angle X Y spos
/display geom 1 get send
grestore
/delete super send
} def
/display {
gsave
Sx Sy Angle X Y spos
/display geom 0 get send %dipslay clipping obj
/setclip self send
/display geom 1 get send %draws the clipped
grestore
} def
/display_ps {
PSfile
(gsave % % % % % spos\n) [Sx Sy Angle X Y] fprintf
/display_ps geom 0 get send
PSfile ( % % % % % ) [geom 0 get begin Sx Sy Angle X Y end] fprintf
/make_path_ps geom 0 get send PSfile ( clip ) [] fprintf
/display_ps geom 1 get send
PSfile ( grestore\n) [] fprintf
} def
/erase {
gsave
Sx Sy Angle X Y spos
/erase geom 0 get send %dipslay clipping obj
/setclip self send
/erase geom 1 get send %draws the clipped
grestore
} def
/make_bbox{ %the bounding box is the one of the clipping obj
/Ngr 1 store
/make_bbox super send
/Ngr 2 store
} def
classend def
(RoundedRect \n) printdbg
/RoundedRect DrawObject
dictbegin
/radcorner 8 def
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/setradcorner {/radcorner exch store} def
/saveivar{
/saveivar super send
OSfile ( % ) [radcorner] fprintf
} def
/loadivar{
/radcorner exch store
/loadivar super send
} def
/make_path {% geom contains radius;
geom null ne {
spos
% translate rotate scale
newpath
radcorner 0 0 geom 0 get geom 1 get rrectpath
} if
} def
/make_path_ps{
geom null ne {
PSfile
(spos newpath % 0 0 % % rrectpath\n)
[radcorner geom 0 get geom 1 get] fprintf
} if
}
/i_get_geom {
getclick
/Y0 exch store /X0 exch store %center
X0 Y0
{newpath radcorner x0 y0 x x0 sub y y0 sub rrectpath
} getanimated
waitprocess aload pop %x1 y1
/Y1 exch store
/X1 exch store
X0 Y0 [X1 X0 sub Y1 Y0 sub] %X,Y, w, h
} def
classend def
/get_path {%ask a path to the user; path terminated by double-clicking
%last point;
%path put in tmparray as [ [x1,y1],.... ] , Ntmp elements
%first point -origin - in X0, Y0, all xi,yi relative to origin
%get points until two points are equal
(enter points - enter twice the same point to end) prmessage
getclick
/Y0 exch store /X0 exch store %origin
gsave
X0 Y0 translate
/X2 0 store /Y2 0 store
/Ntmp 0 store
%repeat
{
0 0
{
newpath
0 0 moveto
tmparray 0 Ntmp getinterval {aload pop lineto} forall
X2 Y2 moveto
x y lineto stroke}
getanimated
waitprocess aload pop
/Y1 exch store /X1 exch store
X2 X1 eq Y2 Y1 eq and
{exit}
{tmparray Ntmp [X1 Y1] put /Ntmp Ntmp 1 add store
/X2 X1 store /Y2 Y1 store
} ifelse
} loop
grestore
(% points path) [Ntmp] prmessage
} def
/edit_path{%edit path of a polyline
{newpath
0 0 moveto
tmparray 0 Ntmp getinterval {aload pop lineto} forall
Closed {closepath} if stroke
} g_edit_path
} def
----------------------------------------------------------------------------
Yves Bernard
Philips Research Lab Brussels,
2 av. Van Becelaere 1170 Brussels, Belgium
bernard@prlb2.uucpbernard@prlb2.UUCP (Bernard Yves) (01/05/89)
NeWSillustrator part 2
----------------------------------------------------------------------------
/outline_proc {} def
/Ne 0 def
/g_edit_path{ %generic path edition
%outline_proc => -; the outlining function
%a path is in tmparray 0-Ntmp;
%allows the user to edit
%it by its moving points;
/outline_proc exch store
gsave
Sx Sy Angle X Y spos
/X2 0 store /Y2 0 store
{
%select point to move
%equivalent to a getclick but with the good outlining function
0 0 {outline_proc} getanimated waitprocess aload pop
/Y1 exch store /X1 exch store
X2 X1 eq Y2 Y1 eq and
{exit } %stop edition
{
/X2 X1 store /Y2 Y1 store
X1 Y1 findpointofpath %=> -1 or N
dup 0 ge %a point is selected
{/Ne exch store
(point selected -- move it) prmessage
0 0 {tmparray Ne [x y] put outline_proc}
getanimated
waitprocess pop
}
{
(point not found) prmessage pop
} ifelse
} ifelse
} loop
grestore
} def
/findpointofpath{% X Y => N
/N -1 store
0 1 Ntmp 1 sub
{dup tmparray exch get aload pop %x y n x1 y1
3 index sub abs 3 lt exch %x y n b1 x1
4 index sub abs 3 lt %x y n b1 b2
and {/N exch store
exit
} {pop} ifelse
} for
pop pop N
} def
/outline_curve{
newpath
0 0 moveto /N 1 store /Xc 0 store /Yc 0 store
tmparray 0 Ntmp getinterval
{aload pop %x y
N 3 eq {gsave Xc Yc moveto
2 copy /Yc exch store /Xc exch store
curveto
/N 1 store
stroke grestore Xc Yc moveto}
{ 2 copy lineto
/N N 1 add store} ifelse} forall
} def
/edit_curved_path{
{outline_curve stroke} g_edit_path
} def
/get_curved_path {%ask a path to the user; path terminated by double-clicking
%last point;
%path put in tmparray as [ [x1,y1],.... ] , Ntmp elements
%first point -origin - in X0, Y0, all xi,yi relative to origin
%get points until two points are equal
(enter first point : ) prmessage
getclick
/Y0 exch store /X0 exch store %origin
gsave
(enter points 3 by 3 - enter twice the same point to end) prmessage
X0 Y0 translate
/X2 0 store /Y2 0 store
/Ntmp 0 store
/N 1 store
%repeat
{
0 0
{ outline_curve
X2 Y2 moveto
x y lineto stroke}
getanimated
waitprocess aload pop
/Y1 exch store /X1 exch store
X2 X1 eq Y2 Y1 eq and
{exit}
{tmparray Ntmp [X1 Y1] put /Ntmp Ntmp 1 add store
/X2 X1 store /Y2 Y1 store
} ifelse
} loop
/Ntmp Ntmp Ntmp 3 mod sub store %Ntmp a multiple of 4
grestore
(% curves path) [ Ntmp 3 div ] prmessage
} def
(Polyline \n) printdbg
/Polyline DrawObject
dictbegin
/Npoint 0 def %nbre de points
/Closed false def %if true -> polygon
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/saveivar{
/saveivar super send
OSfile ( % % ) [Npoint Closed] fprintf
} def
/loadivar{
/Closed exch store
/Npoint exch store
/loadivar super send
} def
/make_path {%the path coord relative to 0,0 are stored in an array in geom
geom null ne {
spos
newpath
0 0 moveto
geom {aload pop lineto} forall Closed {closepath} if
} if
} def
/make_path_ps{
geom null ne {
PSfile (spos newpath 0 0 moveto \n) [] fprintf
geom {PSfile exch ( % % lineto \n) exch fprintf} forall
Closed {PSfile ( closepath\n) [] fprintf} if
} if
} def
/scale_geom { %sx sy => -
mtrx0 currentmatrix pop
gsave
0 0 0 /make_path self send %path
mtrx0 setmatrix %path is scaled
/N 0 store
{pop pop} { %x y
geom N get astore pop
/N N 1 add store}
{} {} pathforall
grestore
} def
/i_get_geom {
get_path %path introduced by user in tmparray;
X0 Y0 tmparray 0 Ntmp getinterval
%x y [array of [xi yi] ] on stack
} def
/edit_proc {edit_path} def
/edit_geom {%interactive edition of geom
(select point of line and move it -- click twice on same point to end)
prmessage
/oldcanvas currentcanvas store
setoverlay
/Ntmp Npoint store
tmparray 0 geom putinterval
/edit_proc self send
oldcanvas setcanvas
geom null ne {/erase self send} if
tmparray 0 Ntmp getinterval /set_geom self send
geom null ne {
/make_bbox self send
/display self send} if
} def
/set_geom { %[ [x1 y1] [x2 y2] ... ] => -
dup length array /geom exch store
geom copy
length /Npoint exch store
} def
/save_geom{%
OSfile ([ %polyg. geom\n) writestring
geom {OSfile exch ( [ % % ] ) exch fprintf} forall
OSfile ( ] %end of polyg. geom\n) writestring
} def
/clone_geom { %here the geom is an array of array
geom type (arraytype) eq
{/newarray geom length array store /N 0 store
geom {2 array copy newarray exch N exch put
/N N 1 add store} forall
/geom newarray store} if
/newarray 4 array store
bbox newarray copy /bbox exch store
} def
classend def
(Curve \n) printdbg
/Curve Polyline
dictbegin
/iter 1 def
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/make_path {%the path coord relative to 0,0 are stored in an array in geom
geom null ne {
spos
% translate rotate scale
newpath
0 0 moveto
/iter 1 def
geom {
aload pop
iter 3 eq {curveto /iter 1 store }
{/iter iter 1 add store} ifelse
} forall
Closed {closepath} if
} if
} def
/make_path_ps {%the path coord relative to 0,0 are stored in an array in geom
geom null ne {
PSfile (spos newpath 0 0 moveto\n) [] fprintf
/iter 1 def
geom {
PSfile exch ( % % ) exch fprintf
% aload pop
iter 3 eq {
PSfile ( curveto\n) [] fprintf /iter 1 store }
{/iter iter 1 add store} ifelse
} forall
Closed {PSfile ( closepath\n) [] fprintf} if
} if
} def
/scale_geom { %sx sy => -
mtrx0 currentmatrix pop
gsave
0 0 0 /make_path super send %path
mtrx0 setmatrix %path is scaled
/N 0 store
{pop pop} { %x y
geom N get astore pop
/N N 1 add store}
{} {} pathforall
grestore
} def
/edit_proc {edit_curved_path} def
/i_get_geom {
get_curved_path %path introduced by user in tmparray;
X0 Y0 tmparray 0 Ntmp getinterval
%x y [array of [xi yi] ] on stack
} def
classend def
/FontName /Times-Roman def
/pointsize 30 def
(Text\n) printdbg
/TextObject DrawObject
dictbegin
/Fontname /Times-Roman def
/Size 30 def
/font null def
/Sh 0 def %the height, width of the box enclosing the
/Sw 0 def %string in global coord. sys. (non scaled and non rot.)
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/init{
/init super send
/Fontname FontName store
/Size pointsize store
/color 0 store %black
} def
/saveivar{
/saveivar super send
OSfile (/% % % %) [Fontname Size Sh Sw] fprintf
} def
/loadivar{
/Sw exch store
/Sh exch store
/Size exch store
/Fontname exch store
/loadivar super send
} def
/save_geom{
OSfile ( \() writestring
OSfile geom writestring OSfile (\) \n) writestring
} def
/make_font {% sets the font entry
/font Fontname findfont Size scalefont store} def
/set_font_and_size {% /fontname size =>
/Size exch def
/Fontname exch def
/make_font self send} def
/changefont{ % change the font
{/Fontname FontName store} /change_geom self send
} def
/changefontsize{% change font size
{/Size pointsize store} /change_geom self send
} def
/make_path {
geom null ne {
spos
Fontname findfont Size scalefont setfont
newpath
0 0 moveto geom show
} if
} def
/make_path_ps {
geom null ne {
PSfile (spos\n) [] fprintf
PSfile ( /% findfont % scalefont setfont\n) [Fontname Size] fprintf
PSfile (newpath 0 0 moveto (%) show\n) [geom] fprintf
} if
} def
/is_in_obj {
/is_in_box self send} def
/dr {% linewidth linecolor color linejoin linecap linestyle => - only
%color is important
gsave
pop pop pop setgray pop pop
Sx Sy Angle X Y /make_path self send
grestore
} def
/dr_ps{
PSfile (gsave pop pop pop setgray pop pop % % % % % \n)
[Sx Sy Angle X Y] fprintf
/make_path_ps self send
PSfile (grestore\n) writestring
} def
/make_bbox{ %there seems to be problem with charpath and rotation;
%therefore finds the box and draws it in the object coord.
%system and extracts its bbox in the current coord. syst
geom null ne {
gsave
mtrx0 currentmatrix pop
Fontname findfont Size scalefont setfont
0 0 moveto geom stringbbox %here we have the box x,y,w,h
2 copy /Sh exch store /Sw exch store
X Y translate Angle rotate Sx Sy scale
0 0 moveto rect pop pop
mtrx0 setmatrix
pathbbox bbox astore pop
grestore} if
} def
/make_opath{ spos 0 0 moveto Sw Sh rect} def
/scale_geom { %sx sy
% max Size mul /Size exch store
/Sy exch store /Sx exch store
} def
/i_get_geom {%the string is in textstring;
/geom get_textstring store
0 0 {newpath
Sx Sy Angle x y gsave /make_path self send grestore
} getanimated
waitprocess aload pop %x y
textstring
} def
classend def
(PostScriptImport\n) printdbg
%the local bbox of the object is stored in the geom variable
/alreadyimporteddict 50 dict def
%for each imported file, will contain
%a PostScript object for which the corresponding
%drawproc has been correctly defined
/PSFileCycle{ % filename => bool ; true if filename is an already
% imported PS file
false
alreadyimporteddict
{ %key, value is an PS object %filename false key obj
exch pop % obj
/filename get %filename false filename2
2 index eq { %filename false
pop true exit} if
} forall
exch pop
} def
%utilities
/add_extension{% filename (.extension) => filename.extension
exch %ext filename
( ) search %ext post match pre true
{
4 -1 roll %post match pre ext
4 2 roll %pre ext post match
pop pop append
}
{ %ext pre
exch append
} ifelse
} def
/extract_fname{% /.../.../.../toto.xxx => toto.xxx
{
(/) search
{ % post match pre
pop pop}
{exit} ifelse
} loop
} def
/make_wrappedfname{%filename => PWD/fname.wps
(PWD) getenv (/) append exch extract_fname append (.wps) add_extension
} def
/achar 1 string def
/linestring2 256 string def
/make_procname{ % filename => -
%from a filename make a postscript name
%by repacing all / by a _
/N 0 store
0 1 linestring2 length 1 sub {linestring2 exch 32 put} for
{ achar 0 3 -1 roll put achar dup (/) eq {pop (_)} if %char or _
linestring2 N 3 -1 roll putinterval
/N N 1 add store
} forall
linestring2 ( ) search pop %post match pre
3 1 roll pop pop cvn
} def
/linestring 256 string def
/TmpFile null def
/PS2file null def
/errorstring 30 string def
/copytofile{% filename file => bool ; true if error
exch %file filename
{
(r) file /TmpFile exch store % file
{
dup % file file
TmpFile linestring readline % file file subst bool
{writestring % file
dup (\n) writestring % file
}
{pop exit} ifelse
} loop
TmpFile closefile
} stopped dup {get_errorstr} if
} def
/get_errorstr{%gets current errorname and puts it in errorstring
$error begin errorname end errorstring cvs pop
} def
/fileerrorpr{% operation filename => -
%print last file error message
exch
(file error : ) errorstring append
exch append exch append prmessage
} def
/PostScript DrawObject
dictbegin
/drawproc nullproc def %the drawing code; any legal ps?
/filename 100 string def %the imported file
/privatedict null def
/procname null def
/savemtrx null def
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/init{
/init super send
% /geom 4 array store
/privatedict 50 dict store %a private dict for drawproc def and store
/savemtrx matrix store
} def
/clone_geom{
/clone_geom super send
privatedict 50 dict copy /privatedict exch store
} def
/display{%drawing param are set; it is the responsability
%of the drawing proc to reset them to its own values
savemtrx currentmatrix pop
gsave
Sx Sy Angle X Y spos
geom 0 get neg geom 1 get neg translate
linewidth setlinewidth
linecolor setgray
linecap setlinecap
linejoin setlinejoin
linestyle setdashpat
mark
privatedict begin drawproc end
cleartomark
grestore
savemtrx setmatrix
} def
/display_ps {%for each imported file <file> a procedure /<file> is
%defined and called
procname null eq {/procname filename make_procname store} if
importfiledict procname known not
{% the procedure is not yet defined in the ps file
%procname procname
self /drawproc get length 300 lt
{
PSfile (\n/%{\n) [ procname ] fprintf
filename PSfile copytofile pop %procname
PSfile (\n} def\n) writestring
importfiledict procname 1 put %procname
} if
%if the proc is too long
%do not create a proc, but write
%the imported file each time it is needed
} if
PSfile
(savemtrx currentmatrix pop gsave % % % % % spos % % translate\n)
[Sx Sy Angle X Y geom 0 get neg geom 1 get neg] fprintf
PSfile
(% % % % % setdashpat setlinejoin setlinecap setgray setlinewidth\n)
[linewidth linecolor linecap linejoin linestyle] fprintf
self /drawproc get length 300 lt
{PSfile
(mark privatedict begin % end cleartomark grestore savemtrx setmatrix\n)
[procname] fprintf
}
{PSfile
(mark privatedict begin\n) writestring
filename PSfile copytofile
PSfile
(end cleartomark grestore savemtrx setmatrix\n) writestring
} ifelse
} def
/scale_geom{
Sy mul /Sy exch store
Sx mul /Sx exch store
} def
/make_opath{%draws the local bbox
spos
% geom 0 get geom 1 get moveto
0 0 moveto
geom 2 get geom 0 get sub geom 3 get geom 1 get sub rect
} def
/make_path{ /make_opath self send} def
%will be used in is_in_obj;
/erase{%erases the local bounding box
gsave
1 setgray
Sx Sy Angle X Y
make_opath fill
grestore
} def
/make_bbox{%computes the global bbox
gsave
mtrx0 currentmatrix pop
Sx Sy Angle X Y /make_opath self send
mtrx0 setmatrix
pathbbox bbox astore pop
grestore
} def
/load_drawproc{ % - => bool; true if ok;
%if not already made, makes the wrapped file and loads it
%the wrapped file is created in the user Home directory
%with the same name as the user file and *.wps as extension
/procname filename make_procname store
alreadyimporteddict procname known
%the dict entry contains the Postscript object
%for which the corresponding drawproc has been defined
{/drawproc
{alreadyimporteddict procname get /drawproc get exec} def
true
}
{
/PS2file filename make_wrappedfname (w) file store
PS2file (/drawproc{ \n) writestring
filename PS2file copytofile %copies filename to the
%end of PS2file
{%error in copying file
false
}
{
PS2file (\n} def \n) writestring
PS2file closefile
(loading wrapped file ) filename make_wrappedfname append prmessage
filename make_wrappedfname LoadFile
dup {alreadyimporteddict procname self put} if
} ifelse
} ifelse
} def
/i_get_geom{ %reads the imported filename * and loads it
%makes a 'wrapped' file *.wps
%where the ps code is embedded : /drawproc{ <code> } def
%then loads it with LoadFile
/filename get_ps_filename dup length string copy store
(making wrapped file ) filename make_wrappedfname append prmessage
/load_drawproc self send %true if ok;
{
(enter the bounding box : ) prmessage
currentcanvas %the overlay canvas
oldcanvas setcanvas %the win canvas
{savemtrx currentmatrix pop
gsave mark privatedict begin drawproc end cleartomark grestore
savemtrx setmatrix} stopped
{(error in executing PS file ) filename append prmessage
setcanvas
0 0 null
}
{
setcanvas %reset the overlay
getwholerect waitprocess %box
dup aload pop %box x1 y1 x2 y2
pop pop 3 -1 roll %x1 y1 box
(PS file imported: ) filename append prmessage
} ifelse
}
{( in loading ) filename fileerrorpr
0 0 null
} ifelse
}def
/save_geom{ OSfile ( [ % % % % ] \n) geom fprintf} def
/saveivar{
/saveivar super send
OSfile ( \() writestring
OSfile filename writestring OSfile (\) \n) writestring
} def
/loadivar{
/filename exch store
mark
/load_drawproc self send
{} %ok
{(error in importing) filename append prmessage)} ifelse
cleartomark
/loadivar super send
} def
classend def
%building of an A4 size rectangle
/a4rect /new DrawObject send def
{
/X 100 35 div 3 mul def
/Y 100 35 div 3 mul def
/geom [100 35 div 197 mul 100 35 div 282 mul] def
/linecolor .85 def
/linewidth 2 def
/ingroup true def %so that it is not selectable by user;
} a4rect send
%=============================================================================
%drawing area window definition
%===========================================================================
/win framebuffer /new ScrollAndZoomWindow send def
(main interaction routines\n) printdbg
/selected_obj null def
/old_selection null def
/create_object {%class => obj
{ClientCanvas} win send setcanvas
/new exch send /selected_obj exch store
/i_def_geom selected_obj send
selected_obj begin geom end null ne
{selected_obj AddObject}
{/selected_obj null store} ifelse
} def
/create_polygon {
{ClientCanvas} win send setcanvas
/new Polyline send /selected_obj exch store selected_obj AddObject
selected_obj begin /Closed true store end
/i_def_geom selected_obj send
} def
/find_object_on_pt {%x y => obj | null
%only objects which are not in a group can be found
/Y0 exch store /X0 exch store
/Xc null store
/Yc null store
ObjTable 0 Nobj getinterval {
/Xc exch store
Xc null ne
{Xc begin ingroup end not
{X0 Y0 /is_in_obj Xc send
{/Yc Xc store exit} if} if} if} forall
Yc
} def
/find_objects_in_box {% [x1 y1 x2 y2] => o1 o2.... on n
/b1 exch store
/N 0 def
ObjTable 0 Nobj getinterval {
/Xc exch store
Xc null ne
{Xc begin ingroup end not
{Xc begin bbox end b1 box_in_box
{Xc /N N 1 add store} if} if} if} forall
N
} def
/select_object {
{ClientCanvas} win send setcanvas
gsave
/oldcanvas currentcanvas store
(select object by clicking on it : ) prmessage
setoverlay
getclick
oldcanvas setcanvas
find_object_on_pt
grestore
dup
null ne {dup /erase exch send
/selected_obj exch store
pause
/display selected_obj send
selected_obj begin [tableindex] end
(% is selected) exch prmessage
/getclassname selected_obj send /Group ne
{/update_control_panel selected_obj send} if
}
{pop
(no object selected) prmessage} ifelse
} def
/i1 0 def
/i2 0 def
/swap_obj{ % o1 o2 => - ; swaps the 2 obj in ObjTable;
dup begin /i2 tableindex store end
exch dup begin /i1 tableindex store end %o2 o1
dup begin /tableindex i2 store end ObjTable exch i2 exch put
dup begin /tableindex i1 store end ObjTable exch i1 exch put
(% and % swapped) [i1 i2] prmessage
} def
/find_overlapping_obj{ % fromindex step toindex obj => first_over_obj
%obj in X1, overlap in Xc
/X1 exch store
/Xc null store
{ObjTable exch get dup /X2 exch store
null ne
{X2 begin ingroup end not
{X1 begin bbox end X2 begin bbox end overlapping_box
{/Xc X2 store exit} if
} if
} if
} for
Xc
} def
/move_down{ % obj => obj2 ; invert position of obj in ObjTable with
% the next object behind it overlapping it
dup begin tableindex end 1 sub -1 0 4 -1 roll find_overlapping_obj
dup null ne {X1 Xc swap_obj} if
} def
/move_up{ % obj => obj2 ; invert position of obj in ObjTable with
% the next object over it overlapping it obj2
dup begin tableindex end 1 add 1 Nobj 1 sub 4 -1 roll
find_overlapping_obj
dup null ne {X1 Xc swap_obj} if
} def
/apply_on_sel {% proc => - ; apply proc on selection if non null
selected_obj null ne
{{ClientCanvas} win send setcanvas
exec
}
{pop (no object selected !) prmessage} ifelse
} def
/notifyselection true def
/apply_on_sel2 {% proc => - ; apply proc on selection if non null
selected_obj null ne notifyselection and
{{ClientCanvas} win send setcanvas
exec
% (selection notified\n) print
}
{pop} ifelse
} def
/current_linecolor 0 def %black
/current_linewidth 0 def %hair line
/current_fill 0 def
/current_linecap 0 def
/current_linejoin 0 def
/current_linestyle 0 def
/current_radcorner 8 def
/erase_flag true def
/group_def_mode (by box) def
/fontmenu
[
FontDirectory {
% include all fonts except /Cursor
pop dup /Cursor ne {
25 string cvs
dup length 3 le { pop } if
} {
pop
} ifelse
} forall
]
[{/FontName currentkey store
{ /changefont selected_obj send} apply_on_sel2}]
/new DefaultMenu send def
/pointsizemenu
[( 6 ) (8) (10) (12) (14) (16) (18) (24) (30) (32) (64)]
[{/pointsize currentkey cvi store
{ /changefontsize selected_obj send} apply_on_sel2}]
/new DefaultMenu send def
/filemenu
[
(save PS file) {generate_ps}
(save Objects file) {generate_os}
(load Objects file) {load_osfile}
]
/new DefaultMenu send def
/align_op{%align_proc => -
selected_obj null ne
{{ClientCanvas} win send setcanvas
/getclassname selected_obj send /Group eq
{/change_geom selected_obj send} if
}
{pop (no group object selected !) prmessage} ifelse
} def
/clipped_obj null def
/clipping_obj null def
/make_clip{%the current selection contains the clipped object
%ask for the clipping obj and creates a ClippingGroup
/clipped_obj selected_obj store
clipped_obj begin /ingroup true store end
select_object
clipped_obj begin /ingroup false store end
selected_obj null ne {
/getclassname selected_obj send /Group ne
/getclassname selected_obj send /TextObject ne and
/getclassname selected_obj send /PostScript ne and
{
/clipping_obj selected_obj store
/erase clipped_obj send
/new ClippingGroup send /selected_obj exch store
[clipping_obj clipped_obj] /set_geom selected_obj send
/make_bbox selected_obj send
/display selected_obj send
selected_obj AddObject
}
{
(error : the clipping obj can not be a group, a text or an importPS)
prmessage
/selected_obj clipped_obj store
} ifelse
} if
} def
/othermenu
[
(edit line or curve) {{/edit_geom selected_obj send} apply_on_sel}
(clip) {{make_clip} apply_on_sel}
(align left) {{/align_left self send} align_op}
(align bottom) {{/align_bottom self send} align_op}
(align right) {{/align_right self send} align_op}
(align top) {{/align_top self send} align_op}
(center vertical) {{/center_vertical self send} align_op}
(center horizontal) {{/center_horizontal self send} align_op}
] /new DefaultMenu send def
/psfilename null def
/get_ps_filename{
items /psfilename get /ItemValue get} def
/notifypsfname{
/psfilename ItemValue store} def
/PSfile null def
/generate_ps {
{ClientCanvas} win send setcanvas
get_ps_filename PSFileCycle not
{
{get_ps_filename (w) file /PSfile exch store
RepaintAll_ps
PSfile closefile} stopped
{get_errorstr ( in writing ) get_ps_filename fileerrorpr}
{(PS file is written: ) get_ps_filename append prmessage} ifelse
}
{(can not write PS file: cycle,same name as an imported PS file )
get_ps_filename append prmessage
} ifelse
} def
/osfilename null def
/get_os_filename{
items /osfilename get /ItemValue get} def
/notifyosfname{
/osfilename ItemValue store} def
/OSfile null def
/generate_os {
{ClientCanvas} win send setcanvas
{get_os_filename (w) file /OSfile exch store
SaveAllObjects
OSfile closefile} stopped
{get_errorstr ( in writing ) get_os_filename fileerrorpr}
{(Objects file is written: ) get_os_filename append prmessage}
ifelse
} def
/load_osfile{
{ClientCanvas} win send setcanvas
(loading...) prmessage
get_os_filename LoadFile
{(Object file loaded: ) get_os_filename append prmessage
/PaintClient win send
}
{get_errorstr ( in loading ) get_os_filename fileerrorpr}
ifelse
} def
(Window definition \n) printdbg
{
/PaintClient
{
ClientCanvas setcanvas 1 fillcanvas
RepaintAll
} def
/FrameLabel (Drawing Area) def
/ClientMenu [
(Redisplay) {/PaintClient ThisWindow send}
(Select) {select_object}
(Move) {{/drag_and_trans selected_obj send} apply_on_sel}
(Rotate) {{/drag_and_rotate selected_obj send} apply_on_sel}
(Scale) {{/drag_and_scale selected_obj send} apply_on_sel}
(Copy) {{
/old_selection selected_obj store
/selected_obj /clone selected_obj send store
selected_obj AddObject
/erase_flag false store
/drag_and_trans selected_obj send
/erase_flag true store
} apply_on_sel}
(Move Up) {{
selected_obj move_up
dup null ne {/display exch send
/display selected_obj send}
{(no overlapping object over selection)
prmessage} ifelse
} apply_on_sel
}
(Move Down) {{
selected_obj move_down
dup null ne {/display selected_obj send
/display exch send}
{(no overlapping object behind selection)
prmessage} ifelse
} apply_on_sel
}
(Delete) {{
/delete selected_obj send
/selected_obj null store} apply_on_sel}
(Destroy) {{
/destroy selected_obj send
/selected_obj null store} apply_on_sel}
(Other =>) othermenu
(------) {}
(Rect) {
DrawObject create_object
}
(Line) {
Polyline create_object
}
(Polygon) {Polyline create_object
selected_obj begin /Closed true store end
/display selected_obj send
}
(Curve) {
Curve create_object
}
(RoundedRect) {RoundedRect create_object}
(Oval) {Oval create_object}
(Text) {TextObject create_object}
(Group) {Group create_object}
(Import PS) {PostScript create_object}
(------) {}
(Zoom In) {/ZoomIn win send}
(Zoom Out) {/ZoomOut win send}
(Font => ) fontmenu
(FontSize => ) pointsizemenu
(Files IO => ) filemenu
] /new DefaultMenu send def
} win send
%============================================================================
%control panel window definition
%============================================================================
(Control Panel definition\n) printdbg
systemdict /Item known not { (NeWS/liteitem.ps) run } if
%systemdict /Item known not { (NeWS/liteitem.ps) LoadFile pop } if
/notify? true def
/notify {
notify? {(Notify: Value=%) [ItemValue] /printf messages send} if
} def
/FillColor .75 def
/prmessage { % sting => - print messages in Control Panel
gsave
/printf messages send
grestore
} def
/notifylq {ItemValue 10 div setlinequality} def
/notifylw
{/current_linewidth ItemValue store
{
{current_linewidth /setlinewidth2 self send}
/change_geom selected_obj send} apply_on_sel2
} def
/notifylc
{/current_linecolor ItemValue 100 div store
{
{current_linecolor /setlinecolor self send}
/change_geom selected_obj send} apply_on_sel2
} def
/notifyfc
{/current_fill ItemValue 0 lt {-1} {ItemValue 100 div} ifelse store
{
{current_fill /setcolor self send}
/change_geom selected_obj send} apply_on_sel2
} def
/notifygroupdefmode
{/group_def_mode ItemValue 0 eq (by box) (by enumeration) ifelse
store
} def
/notifylcap{/current_linecap ItemValue store
{{current_linecap /setlinecap2 self send}
/change_geom selected_obj send} apply_on_sel2
} def
/notifyljoin{/current_linejoin ItemValue store
{{current_linejoin /setlinejoin2 self send}
/change_geom selected_obj send} apply_on_sel2
} def
/notifylstyle{/current_linestyle ItemValue store
{{current_linestyle /setlinestyle self send}
/change_geom selected_obj send} apply_on_sel2
} def
/notifyradcorner {/current_radcorner ItemValue cvr
dup 0 eq {pop 8} if store
{{current_radcorner /setradcorner self send}
/change_geom selected_obj send} apply_on_sel2
} def
/textstring (enter string) def
/notifytext{/textstring ItemValue store} def
/gridon false def
/gridsize 100 def
/notifygridsize {/gridsize ItemValue cvr store} def
/notifygridon
{/gridon ItemValue 1 eq store
} def
/get_textstring{%gets the ItemValue of the text liteitem
items /textstring get /ItemValue get dup /textstring exch store
} def
/draw_grid{% draws the grid
gridon gridsize 0 gt and
{gsave
0 setgray [2 5] 0 setdash
0 gridsize 1000 {dup 0 moveto 1000 lineto stroke} for
0 gridsize 1000 {dup 0 exch moveto 1000 exch lineto stroke} for
grestore} if
} def
/putinControlPanel{%linewidth linecolor color linestyle linejoin linecap
/notifyselection false store
/oldcanvas currentcanvas store
{ClientCanvas} controlpanel send setcanvas
items begin
linecap /ItemValue 3 -1 roll put /paint linecap send
linejoin /ItemValue 3 -1 roll put /paint linejoin send
linestyle /ItemValue 3 -1 roll put /paint linestyle send
dup -1 ne {100 mul} if
fillcolor /ItemValue 3 -1 roll put
/paint fillcolor send
100 mul linecolor /ItemValue 3 -1 roll put /paint linecolor send
linewidth /ItemValue 3 -1 roll put /paint linewidth send
end
oldcanvas setcanvas
pause
/notifyselection true store
} def
%Items creation
/createitems {
/items 15 dict dup begin
/messages /panel_text (<messages come here>) /Right {} can 700 0
/new MessageItem send dup begin
/ItemFrame 1 def
/ItemBorder 4 def
end 20 20 /move 3 index send def
/textstring (Text String:) (Text string) /Right /notifytext can 500 0
/new TextItem send 20 290 /move 3 index send def
/osfilename (Objects file name:) (PWD) getenv
% (/u3/bernard/NeWS/PrologNeWS/obj)
/Right /notifyosfname can 500 0
/new TextItem send 20 260 /move 3 index send def
/psfilename (PS file name:) (PWD) getenv
%(/u3/bernard/NeWS/PrologNeWS/ps0)
/Right /notifypsfname can 500 0
/new TextItem send 20 230 /move 3 index send def
/gridsize (Grid Size:) (100) /Right /notifygridsize can 220 0
/new TextItem send 20 200 /move 3 index send def
/gridbutton (Grid on:) [/panel_check_off /panel_check_on]
/Right /notifygridon can 0 0 /new CycleItem send
dup /LabelY -4 put 250 200 /move 3 index send def
/linequality (line quality:) [0 10 10] /Right /notifylq can 220 20
/new SliderItem send 20 170 /move 3 index send def
/linecap (line cap:) [(butt) (round) (square) ]
/Right /notifylcap can 0 0 /new CycleItem send
250 140 /move 3 index send def
/linejoin (line join:) [(miter) (round) (belevel) ]
/Right /notifyljoin can 0 0 /new CycleItem send
355 170 /move 3 index send def
/linestyle (line style:) [(plain) (dash1) (dash2) ]
/Right /notifylstyle can 0 0 /new CycleItem send
250 170 /move 3 index send def
/linewidth (line width:) [0 10 0] /Right /notifylw can 220 20
/new SliderItem send dup /ItemFrame 1 put
20 140 /move 3 index send def
/linecolor (line color:) [0 100 0] /Right /notifylc can 220 20
/new SliderItem send dup /ItemFrame 1 put
20 110 /move 3 index send def
/fillcolor (fill color:) [-1 100 -1] /Right /notifyfc can 220 20
/new SliderItem send dup /ItemFrame 1 put
20 80 /move 3 index send def
/groupdef (Group Defined by :) [
( box)
( enumeration)
] /Right /notifygroupdefmode can 220 0 /new CycleItem send
20 50 /move 3 index send def
/radcorner (Rounded Corner Radius:) (8) /Right /notifyradcorner can 220 0
/new TextItem send 250 50 /move 3 index send def
end def
/messages items /messages get def
} def
/slideitem { % items fillcolor item => -
gsave
dup 4 1 roll % item items fillcolor item
/moveinteractive exch send % item
/bbox exch send % x y w h
(Item: x=%, y=%, w=%, h=% Canvas: w=%, h=%) [
6 2 roll
win begin FrameWidth FrameHeight end
] /printf messages send
grestore
} def
/MakeControlPanel {
% Create and size a window. The size is chosen to accommodate the
% items we are creating. Right before we map the window, we ask the
% user to reshape the window. This is atypical, but gets the items
% positioned the way we want them.
/controlpanel framebuffer /new DefaultWindow send def % Create a window
{ /PaintClient {FillColor fillcanvas items paintitems} def
/FrameLabel (Control Panel) def
/IconImage /galaxy def
/ClientMenu [
(White Background) {/FillColor 1 store /paintclient controlpanel send}
(Light Background) {/FillColor .75 store /paintclient controlpanel send}
(Medium Background) {/FillColor .50 store /paintclient controlpanel send}
(Dark Background) {/FillColor .25 store /paintclient controlpanel send}
(Black Background) {/FillColor 0 store /paintclient controlpanel send}
(Flip Verbose) {/notify? notify? not store}
] /new DefaultMenu send def
} controlpanel send % Install my stuff.
200 200 700 350 /reshape controlpanel send % Shape it.
/can controlpanel /ClientCanvas get def % Get the window canvas
% Create all the items.
createitems
% Create event manager to slide around the items.
% Create a bunch of interests to move the items.
% Note we actually create toe call-back proc to have the arguments we need.
% The proc looks like: {items color "thisitem" slideitem}.
% We could also have used the interest's clientdata dict.
/slidemgr [
items { % key item
exch pop dup /ItemCanvas get % item can
MiddleMouseButton [items FillColor % item can name [ dict color
6 -1 roll /slideitem cvx] cvx % can name proc
DownTransition % can name proc action
4 -1 roll eventmgrinterest % interest
} forall
] forkeventmgr def
% Now let the user specify the window's size and position. Then map
% the window. (See above) Then activate the items.
% /ptr /ptr_m framebuffer setstandardcursor
/reshapefromuser controlpanel send % Reshape from user.
/map controlpanel send % Map the window & install window event manager.
% (Damage causes PaintClient to be called)
/itemmgr items forkitems def
} def
MakeControlPanel
1 setlinequality
a4rect AddObject
%obj1 AddObject
%obj2 AddObject
%s1 AddObject
/make_bbox a4rect send
%/make_bbox obj1 send
%/make_bbox obj2 send
%/make_bbox s1 send
/reshapefromuser win send /map win send
1000 1000 /Resize win send
{/Scroll win send} {/Scroll win send} /SetNotifiers win send
win /ClientCanvas get setcanvas
win begin /overlaycan ClientCanvas createoverlay store end
----------------------------------------------------------------------------
Yves Bernard
Philips Research Lab Brussels,
2 av. Van Becelaere 1170 Brussels, Belgium
bernard@prlb2.uucpbernard@prlb2.UUCP (Bernard Yves) (01/27/89)
append the other parts together, make a chmod a+x on the file.
--------------------------------------------------------------------------
#!/usr/NeWS/bin/psh
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% NeWSillustrator version 1.0
%
% Copyright : Yves Bernard, Philips Research Lab Brussels
% e-mail : bernard@prlb2.uucp
% 2 avenue Van Becelaere 1170 Brussels Belgium
%
% 1. You may freely copy and distribute copies of NeWSillustrator as you
% receive it, provided that you appropriately publish on each file this
% entire copyright notice
%
% 2. You may modify your copy or NeWSillustrator and copy and distribute
% such modifications under the terms of Paragraph 1 provided that you
% also include a notice stating what changes you made, and provided that
% your copy does not change the mention to NeWSillustrator in the
% windows labels and does not delete the original 'Info' copyright entry
% of the file menu.
%
% 3. You are not allowed to sell or distribute for any commercial purposes
% this software or any copies derived directly or indirectly from it.
%
% 4. For other licensing policies, contact the author at the above
% address
%
% 6. This copyright notice is clearly derived from the Free Software
% Foundation licensing policy (-:)
%
% This software is provided without warranty of any kind, of course.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% scrollable and zoomable window class definition
systemdict /zapmenu known not
{systemdict begin
/zapmenu [
(No, not really) {}
(Yes, really) {/destroy ThisWindow send}
] /new DefaultMenu send def
end
} if
/marksize 5 def %size of mark for group box
/ScrollAndZoomWindow ScrollWindow
dictbegin
/PictureWidth 0 def % for translating the client window
/PictureHeight 0 def
/LDivisions 10 def % number of scroll bad pieces/whole
/PDivisions 3 def % number of scroll bad pieces/whole
/ScrollH 0 def % cumulative translation factors
/ScrollV 0 def % due to successive scrolling;
/ZoomFactor 1 def % zooming factor;
/newox 0 def
/newoy 0 def
/Nzoom 0 def
/zoomstack 50 array def
/overlaycan null def
dictend
classbegin
/Resize { % width height => - size the backround canvas
/PictureHeight exch def
/PictureWidth exch def
[%0 PictureWidth ClientWidth sub
newox neg PictureWidth ClientWidth sub newox add %min max
dup dup LDivisions div exch PDivisions div
null]
/setrange HScrollbar send
[%0 PictureHeight ClientHeight sub
newoy neg PictureHeight ClientHeight sub newoy add
dup dup LDivisions div exch PDivisions div null]
/setrange VScrollbar send
} def
/SetNotifiers { % Hnotifier Vnotifier => -
VScrollbar /NotifyUser 3 -1 roll put
HScrollbar /NotifyUser 3 -1 roll put
} def
/Scroll {ScrollProc} def
/ZoomIn {/marksize marksize 2 div store
/ZoomFactor ZoomFactor 2 mul def ZoomInProc} def
/ZoomOut {ZoomFactor 1 ne
{/marksize marksize 2 mul store
/ZoomFactor ZoomFactor 2 div def ZoomOutProc} if} def
/ShapeClientCanvas {
ClientCanvas null ne {
ScrollAndZoomAxis} if
} def
/CreateFrameMenu { % - => - (Create frame menu)
% Note: Store menu in class to share menus, especially if retained.
/FrameMenu [
(Move) {/slide ThisWindow send}
(Move Constrained)
{getfbclick pop pop /slideconstrained ThisWindow send}
(Top) {/totop ThisWindow send}
(Bottom) {/tobottom ThisWindow send}
(Zap => ) zapmenu
(Resize) {/reshapefromuser ThisWindow send}
(Stretch Corner)
{getfbclick pop pop /stretchcorner ThisWindow send}
(Stretch Edge)
{getfbclick pop pop /stretchwindowedge ThisWindow send}
(Close) {/flipiconic ThisWindow send}
(Redisplay) {/paint ThisWindow send}
] /new DefaultMenu send def
} def
/ScrollAxis {%the scorllbar values are always in abs. coord.
/ScrollH HScrollbar /ItemValue get def
/ScrollV VScrollbar /ItemValue get def
BorderLeft BorderBottom translate
ScrollH neg ScrollV neg translate
} def
/ScrollProc {
ScrollAndZoomAxis
/PaintClient self send
} def
/pushzoomstack{% - => -
zoomstack Nzoom [ScrollH ScrollV ] put
/Nzoom Nzoom 1 add store
} def
/popzoomstack{%
Nzoom 0 ne
{/Nzoom Nzoom 1 sub store
zoomstack Nzoom get aload pop
%put that in the scroll bar value
/ScrollV exch store /ScrollH exch store
HScrollbar /ItemValue ScrollH put
VScrollbar /ItemValue ScrollV put
} if
} def
/ZoomInAxis { %zoom in by 1, 2, 4, 8,...
/newox ClientWidth 2 div ClientWidth 2 ZoomFactor exp div sub def
/newoy ClientHeight 2 div ClientHeight 2 ZoomFactor exp div sub def
newox neg newoy neg translate
ZoomFactor ZoomFactor scale
ScrollH ZoomFactor div newox ZoomFactor div add
ScrollV ZoomFactor div newoy ZoomFactor div add
ClientWidth ZoomFactor div ClientHeight ZoomFactor div
ClientPath ClientCanvas reshapecanvas
} def
/ScrollAndZoomAxis {
gsave
FrameCanvas setcanvas
ScrollAxis
% modifies the transf. matrix of the client canvas:
ZoomFactor 1 eq
{/newox 0 store
/newoy 0 store
ScrollH ScrollV ClientWidth ClientHeight ClientPath
ClientCanvas reshapecanvas}
{ZoomInAxis} ifelse
/overlaycan ClientCanvas createoverlay store
grestore
MakeScrollEvent sendevent
} def
/reshape{
pause KillDefComProcess pause
/reshape super send
/overlaycan ClientCanvas createoverlay store
NeWSillustratorDict /Started known
{MakeDefComProcess pause} if
} def
/ZoomInProc {
pushzoomstack
ScrollAndZoomAxis
/PaintClient self send
PictureWidth 2 mul
PictureHeight 2 mul /Resize self send
HScrollbar /ItemValue ScrollH newox add put
VScrollbar /ItemValue ScrollV newoy add put
/paintscrollbars self send
} def
/ZoomOutProc {
popzoomstack
ScrollAndZoomAxis
/PaintClient self send
PictureWidth 2 div
PictureHeight 2 div /Resize self send
HScrollbar /ItemValue ScrollH newox add put
VScrollbar /ItemValue ScrollV newoy add put
/paintscrollbars self send
} def
/destroy{ % typical to NeWSillustrator
KillDefComProcess
/destroy super send
} def
classend def
/MyWindowClass DefaultWindow
dictbegin
dictend
classbegin
/reshape
{KillDefComProcess pause
/reshape super send pause pause
NeWSillustratorDict /Started known
{MakeDefComProcess} if
} def
/destroy{ %
KillDefComProcess
/destroy super send
} def
classend def
%private dict for all definitions
/NeWSillustratorDict 400 dict def
NeWSillustratorDict begin
%if user wants to redefine that...
/LeftMouseButton /LeftMouseButton def
/RightMouseButton /RightMouseButton def
/MiddleMouseButton /MiddleMouseButton def
/snap_to_grid{% x y => xg yg
gridsize div round gridsize mul %x yg
exch gridsize div round gridsize mul %yg xg
exch
} def
/SnapToGrid? false def
/animate_event null def
/crosshair? false def
/Cancel? {animate_event RightMouseButton eq} def
/Abort? false def
/Confirm? {% message => true | false
( Confirm by Left, Abort with R. or M. button)
append prmessage
.033333 blockinputqueue
{ createevent dup begin
/Action [ /DownTransition /UpTransition] def
/Exclusivity true def
end expressinterest
createevent dup /Name /MouseDragged put expressinterest
unblockinputqueue
{
awaitevent begin
Action UpTransition eq
{ Name end exit } if
end
} loop
} fork waitprocess
LeftMouseButton eq
} def
/MakeScrollEvent{
createevent dup begin
/Name /WindowScrolled def
end} def
/ThisObj null def
/RedisplayWhenScroll {} def
/mygetanimated { % x0 y0 proc => x y; puts button name in
% animate_event
{ 3 copy false SnapToGrid? mygetanimated_2
dup
% dup /CurAniProc exch store
waitprocess %p [x y]
animate_event /WindowScrolled ne
{pop exit} %p
{pause pop pop
/RedisplayWhenScroll load length 0 ne
{ {ClientCanvas} win send setcanvas
RedisplayWhenScroll
} if
setoverlay X0 Y0 translate
} ifelse
} loop %x0 y0 proc p
4 -3 roll pop pop pop %p
waitprocess aload pop %x y
}def %x y ; animate_event
/mygetanimated_2 { %x0 y0 proc LetMenu? snap? => [ x y ];
%puts button name in animate_event
20 dict begin
/snap? exch store
/LetMenu? exch def
/proc exch def /y0 exch def /x0 exch def
currentcursorlocation /y exch def /x exch def /gridoff? gridon not def
%this should accelerate dragging a little..
/X2 X2 def /Y2 Y2 def /Sx2 Sx2 def /Sy2 Sy2 def /Angle2 Angle2 def
/LB LeftMouseButton def /RB RightMouseButton def
/MB MiddleMouseButton def
/crosshair? crosshair? def
.033333 blockinputqueue
{ %newprocessgroup
createevent dup begin
/Canvas {ClientCanvas} win send def
/Action [ /DownTransition /UpTransition ] def
/Exclusivity true def
end expressinterest
createevent dup
begin /Name /MouseDragged def
/Canvas {ClientCanvas} win send def
/Exclusivity true def end
expressinterest
MakeScrollEvent expressinterest
WaitForEvent expressinterest
unblockinputqueue
{
snap? gridoff? and
{x y snap_to_grid /y exch store /x exch store} if
erasepage x0 y0 moveto x y /proc load exec crosshair stroke
awaitevent dup begin %ev
Name dup /WindowScrolled eq
{pop /animate_event /WindowScrolled store
end exit} if
dup /AlphaEvent eq %ev Name
{pop Action dup /Point eq exch /Stop eq or
{/animate_event Action /Point eq {LB} {RB} ifelse store
ClientData aload pop /y exch store /x exch store}
{/animate_event Name store WaitForEvent /ClientData
ClientData put} ifelse
end exit} if
pop
Action /UpTransition eq
{end exit} if
LetMenu? Name RB eq and
Action /DownTransition eq and
{redistributeevent} if
%downtransition
/x XLocation store /y YLocation store
/animate_event Name store
end %end dict event
pop %pop
} loop %event
erasepage
/cur_event exch store
snap? {x y snap_to_grid 2 array astore}
{ [x y] } ifelse
} fork % [x y]
end %end mygetanimated_2 dict
} def
/crosshair {
crosshair? {x -1000 moveto 0 2000 rlineto
-1000 y moveto 2000 0 rlineto} if
} def
/mygetclick { % - => x y
0 0 { (X, Y : %, %) [x y] sprintf prvalue } mygetanimated
} def
/getclickwithmenu{
0 0 { (X, Y : %, %) [x y] sprintf prvalue } true false mygetanimated_2
waitprocess aload pop
} def
/mygetwholerect { % - => [x, y, w, h]
{ x0 y lineto lineto x y0 lineto closepath
(dX, dY : %, %) [x y ] sprintf prvalue
} getrectthing %x y [w h]
aload pop 4 array astore
} def
/getrectdict dictbegin /XR0 0 def /YR0 0 def /proca null def dictend def
/getrectthing{% proc => [x, y, w, h] ; proc = oval, rect, rrect
getrectdict begin /proca exch store
mygetclick % x y
/Relative? true store
Cancel? { pop pop /Abort? true store 0 0 [0 0]}
{
/YR0 exch store /XR0 exch store %origin
XR0 YR0 translate
0 0 /proca load mygetanimated %w h
2 array astore XR0 YR0 3 -1 roll %x y [w h]
Cancel? {/Abort? true store} if
} ifelse
end
/Relative? false store
} def
%===========================================================================
% utilities
%===========================================================================
/setoverlay {win begin overlaycan end setcanvas} def
/prdebug false def
/printdbg { prdebug {console exch [] fprintf} {pop} ifelse} def
(Loading utilities \n) printdbg
/drect { % x,y w, h => - : makes a path corresponding to the box
4 2 roll moveto rect
} def
/myrrectpath { %because NeWS rrectpath uses arcto which does not
%work with dashed lines...
matrix currentmatrix 6 1 roll % m r x y w h
4 2 roll translate % m r w h
10 dict begin
/h exch def /w exch def /r exch def
h 0 lt { 1 -1 scale /h h neg store} if
w 0 lt { -1 1 scale /w w neg store} if
r 0 moveto
w r sub r r 270 0 arc
w r sub h r sub r 0 90 arc
r h r sub r 90 180 arc
r r r 180 270 arc
closepath
end
setmatrix
} def
%setting of the object coord. system
/spos {translate rotate scale} def
/b1 null def
/boxpath { % [x1 y1 x2 y2] => - makes path of the box
aload pop
3 index 3 index moveto %x1 y1 x2 y2
2 index sub %x1 y1 x2 (y2-y1)
exch 3 index sub exch rect
pop pop
} def
/box_in_box {% b1 b2 => bool ; true if b1 in b2; box = [x0, y0, x1, y1]
gsave
boxpath
aload pop %x1 y1 x2 y2
pointinpath 3 1 roll
pointinpath and
grestore
} def
/box_of_box {% b1 b2 => b3 ;computes the box enclosing the 2
aload pop 5 -1 roll aload pop %4 points on the stack connect them in
newpath
moveto lineto lineto lineto
[ pathbbox ]
} def
/o_dict dictbegin /x1 0 def /x2 0 def /y1 0 def /y2 0 def dictend def
/overlapping_interval{ % x1 x2 y1 y2 => true if [x1 x2] inter [y1 y2]
%non null
o_dict begin
/y2 exch store /y1 exch store /x2 exch store /x1 exch store
x1 y1 y2 in_interval
x2 y1 y2 in_interval or
{true}
{y1 x1 x2 in_interval y2 x1 x2 in_interval or}
ifelse
end
} def
/in_interval{% x y1 y2 => bool
2 copy min %x y1 y2 min
3 1 roll max %x min max
2 index gt %x min b1
3 1 roll gt and
} def
/overlapping_box{% b1 b2 => bool; true if box overlaps
aload pop
5 -1 roll aload pop
7 index 6 index %x11 x12
5 index 4 index %x21 x22
overlapping_interval
{6 index 5 index 4 index 3 index overlapping_interval}
{false} ifelse
mark 10 2 roll cleartomark
} def
/on_seg_dict 10 dict def
/neareq{%x1 x2 => bool
sub abs 3 lt
} def
/is_on_segment{% x y x0 y0 x1 y1 => bool ; true
% if x y on segment x0 y0 x1 y1
on_seg_dict
begin
/y1 exch def /x1 exch def /y0 exch def /x0 exch def
/y exch def /x exch def /dist 0 def
false
x0 x1 neareq %vertical
{pop x x0 neareq y y0 y1 in_interval and}
{y0 y1 neareq %horiz
{pop y y0 neareq x x0 x1 in_interval and}
{ %oblique
x x0 x1 in_interval
{y y0 y1 in_interval
{x1 x0 sub y y0 sub mul %p1x * py
y1 y0 sub x x0 sub mul %p1y * px
sub abs
dup /dist exch store
500 lt
{pop true} if
} if} if
} ifelse
} ifelse
end
} def
/drarrow { % size x0 y0 x1 y1 => - ; draws an arrow
% at end of seg
gsave
[] 0 setdash %plain line
dup 3 index sub %s x0 y0 x1 y1 yr
2 index 5 index sub atan %s x0 y0 x1 y1 a
3 1 roll %s x0 y0 a x1 y1
translate rotate pop pop %s
dup neg dup neg %s -s s
moveto 0 0 lineto %s
neg dup lineto
stroke
grestore
} def
%working var.
%/mtrx0 matrix def
%/mtrx1 matrix def
%/newarray null def
%/tmparray 100 array def
%/Ntmp 0 def
/N 0 def
/tmpstr 50 string def
%/Angle2 0 def
%/Sx2 1 def
%/Sy2 1 def
%/Sx3 1 def
%/Sy3 1 def
/X0 0 def
/Y0 0 def
%/X1 0 def
%/Y1 0 def
%/X2 0 def
%/Y2 0 def
%/Xc 0 def
%/Yc 0 def
/oldcanvas null def
%===========================================================================
% object Table definition and management
/SizeObjTable 1000 def
/ObjTable SizeObjTable array def
0 1 SizeObjTable 1 sub {ObjTable exch null put} for
/FreeObj 10 array def
/FreeObjTop 0 def
/AddFreeEntry {% free obj table entry => -
FreeObjTop 9 le {FreeObj exch FreeObjTop exch put
/FreeObjTop FreeObjTop 1 add store}
{pop} ifelse
} def
/DeleteFreeEntries{
/FreeObjTop 0 store
} def
/GetFreeEntry{
FreeObjTop 0 gt {/FreeObjTop FreeObjTop 1 sub store
FreeObj FreeObjTop get}
{Nobj /Nobj Nobj 1 add store} ifelse
} def
/Nobj 0 def %
/AddObject
{% <obj> => -
GetFreeEntry 2 copy exch ObjTable 3 1 roll put %obj index
exch begin /tableindex exch store end
Nobj SizeObjTable ge {(Object Table is full) prmessage} if
}
def
/ForProc {} def
/ForEachObj {% proc = ->; apply proc on each object in the table
%which is not in a group
/ForProc exch store
0 1 Nobj 1 sub
{ObjTable exch get
dup null ne {dup begin ingroup end
{pop}
{ForProc} ifelse
}
{pop} ifelse} for
} def
/RepaintAll {% repaint all objects in table;
gsave
/display a4rect send
{/display exch send} ForEachObj
grestore
draw_grid
} def
/procfile null def
/procstr 50 string def
/token_in_line 0 def
/c_writestring{% string => -
procfile exch writestring procfile ( ) writestring
token_in_line 10 gt {procfile (\n) writestring
/token_in_line 0 store}
{/token_in_line token_in_line 1 add store}
ifelse
} def
/print_any{ %any => postscript code to procfile
dup type /operatortype eq
{dup procstr cvs
dup ('mark) eq
{ pop ([) c_writestring }
{ dup (') search
{ % s post match pre ; a postscrip op.
pop pop pop
dup length 2 sub 1 exch getinterval c_writestring}
{% s s ; a /name
procfile (/) writestring
c_writestring pop
} ifelse}
ifelse
}
{dup type /arraytype eq 1 index xcheck and %code array
{ ({) c_writestring
procfile print_procdef
(}) c_writestring
}
{dup type /nametype eq %a name
{dup xcheck {procstr cvs c_writestring}
{procfile (/) writestring
procstr cvs c_writestring
} ifelse}
{dup type /arraytype eq %an array value
{([) c_writestring
{print_any} forall
(]) c_writestring
}
{dup type /stringtype eq
{procfile exch ( (%) ) exch [ exch ] fprintf}
{procstr cvs c_writestring} ifelse
} ifelse
} ifelse
}
ifelse
}
ifelse
} def
/print_procdef { % proc file => - ; print the text of proc in file
/procfile exch store
cvlit
{
print_any
} forall
} def
/print_code { % /name => - ; in PSfile
/token_in_line 0 store
dup NeWSillustratorDict exch known
{% /name
dup procstr cvs PSfile exch (/% { \n) exch [ exch ] fprintf
NeWSillustratorDict exch get PSfile print_procdef
PSfile (\n } def \n) writestring
}
{pop} ifelse
} def
/PSsignature
(%!
%%NeWSillustrator -- Y. Bernard, Philips Research\n) def
% Rotation=0,Width=540,Height=384,Xoff=13,Yoff=219
/psbox null def
/PSbox{%computes the bounding box of the drawing
Nobj 0 gt {%get first box
ObjTable 0 get /bbox get 4 array copy /psbox exch store
{begin bbox end psbox box_of_box /psbox exch store} ForEachObj
psbox aload pop %x1 y1 x2 y2
2 index sub exch %x1 y1 h x2
3 index sub exch %x1 y1 w h
4 2 roll %w h x1 y1
4 array astore
} {[0 0 0 0 ]} ifelse
} def
/LatexFile? false def
/PrintPS_header{ %postscript utilities
%this is not standard but is used here for inclusion in Latex
LatexFile?
{PSfile (% ) writestring
PSfile (Rotation=0,Width=%,Height=%,Xoff=%,Yoff=%\n)
PSbox fprintf} if
PSfile PSsignature writestring
PSfile
(/rect {dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath } def
/ovalpath { matrix currentmatrix 5 1 roll
4 2 roll translate scale .5 .5 translate 0 0 .5 0 360 arc closepath
setmatrix} def\n) [] fprintf
/myrrectpath print_code
%dash patterns
print_dasharray_ps
/setdashpat print_code
/drarrow print_code
/spos print_code
PSfile (0 setlinewidth 0 setgray
/privatedict 100 dict def
/mtrx1 matrix def
/savemtrx matrix def
privatedict begin /showpage {} def end \n) writestring
} def
/dasharray [ [ [] 0 ] [ [3] 0 ] [ [6] 0 ] ] def
/setdashpat{% n => -
dasharray exch get aload pop setdash} def
/print_dasharray_ps{%
PSfile (/dasharray \n) writestring
dasharray print_any
PSfile ( def\n) writestring
} def
/importfiledict null def
%used when generating the postscript file
%to remind what imported PS file have already been written
/RepaintAll_ps {% generates postscript file
PrintPS_header
/importfiledict 50 dict store
PSfile (gsave \n) [] fprintf
{/display_ps exch send} ForEachObj
PSfile (grestore showpage\n) [] fprintf
} def
/saveobjprelude null def
/SaveAllObjects {% generates NeWS files of object def; loaded with run
/saveobjprelude ( dup AddObject mark \n) store
{/saveobject exch send} ForEachObj
} def
/loadobj{%used in loading obj files.
counttomark 1 add index %obj mark var1... varn obj
/loadivar exch send cleartomark
dup begin ingroup not end {pop} if
} def
%Default display parameters
/current_linecolor 0 def %black
/current_linewidth 0 def %hair line
/current_fill -1 def
/current_linecap 0 def
/current_linejoin 0 def
/current_linestyle 0 def
/current_arrowsize 5 def
/current_startarrow? false def
/current_endarrow? false def
/current_radcorner 8 def
/erase_flag true def
/group_def_mode (by box) def
% Root Class -- Defines the protocol of all other object classes
(Loading Class def \n) printdbg
/DrawObject Object
dictbegin
/X 0 def %position
/Y 0 def
/Sx 1 def %scaling
/Sy 1 def
/Angle 0 def %rotation
/bbox null def %bounding box [x1,y1,x2,y2]
/color -1 def %filling pattern = -1 : no filling
/linewidth 0 def %line width
/linecolor 0 def %line color = black
/linestyle 0 def %line style = plain or dashed
/linejoin 0 def
/linecap 0 def
/geom null def %
% default geom is a rect [w,h]
/tableindex -1 def
/ingroup false def % true if object part of a group
dictend
classbegin
%some working var. put as class variables
/mtrx0 matrix def
/mtrx1 matrix def
/newarray null def
/tmparray 100 array def
/Ntmp 0 def
/Angle2 0 def
/Sx2 1 def
/Sy2 1 def
/Sx3 1 def
/Sy3 1 def
/X1 0 def
/Y1 0 def
/X2 0 def
/Y2 0 def
/Xc 0 def
/Yc 0 def
/new {
/new super send begin
/init self send
currentdict end
} def
/init {
/bbox 4 array store
/getcurrentdisplayparam self send} def
/delete {
/erase self send
ObjTable tableindex null put
tableindex AddFreeEntry} def
/destroy {} def
/saveivar{%writes instance var. on File
OSfile ( % % % % % ) [X Y Sx Sy Angle] fprintf
OSfile ( [ % % % % ] \n) bbox fprintf
OSfile ( % % % % % % \n) [color linewidth linecolor
linestyle linejoin linecap] fprintf
/save_geom self send
OSfile ( % ) [ingroup] fprintf
} def
/loadivar {% mark objects instances var => self if ingroup else -
%in the order in which they are defined
/ingroup exch store
%tableindex
/geom exch store
/linecap exch store
/linejoin exch store
/linestyle exch store
/linecolor exch store
/linewidth exch store
/color exch store
/bbox exch store
/Angle exch store
/Sy exch store
/Sx exch store
/Y exch store
/X exch store
} def
/getclassname{%get the class name of the object
ParentDictArray dup length 1 sub get begin ClassName end
} def
/saveobject{%saves object descr in OSfile
OSfile (/new % send ) [/getclassname self send] fprintf
OSfile saveobjprelude writestring
/saveivar self send
OSfile ( loadobj\n) writestring
} def
/save_geom{%save geom descr
OSfile ( [ % % ]\n) geom fprintf} def
/setradcorner {pop} def
/setlinestyle{/linestyle exch store} def
/setlinejoin2 {/linejoin exch store} def
/setlinecap2 {/linecap exch store} def
/setlinewidth2 { /linewidth exch store } def
/setlinecolor { /linecolor exch store } def
/setcolor { /color exch store } def
/changefont {} def
/changefontsize {} def
/setarrowsize {} def
/setarrow {} def
/setdisplayparam{%
/linewidth exch store
/linecolor exch store
/color exch store
/linestyle exch store
/linejoin exch store
/linecap exch store
} def
/getcurrentdisplayparam{
current_linecap current_linejoin current_linestyle
current_fill current_linecolor current_linewidth
/setdisplayparam self send
} def
/update_control_panel{% put display param of objects in control panel
linewidth linecolor color linestyle linejoin linecap
putinControlPanel
} def
/bbox_path { %in absolute coord syst.
bbox 0 get bbox 1 get moveto
bbox 2 get bbox 0 get sub bbox 3 get bbox 1 get sub rect
} def
/make_path { % Sx Sy angle X Y => -
%makes the path of the object : default is drawing a rect
%of W, H
geom null ne {
spos
% translate rotate scale
newpath
0 0 moveto
geom aload pop rect} if
} def
/make_path_ps{% - => -
geom null ne {
PSfile
(spos newpath 0 0 moveto % % rect\n) geom
fprintf}
if
} def
/BoxSize{% gives box surface
bbox aload pop %x1 y1 x2 y2
2 index sub %x1 y1 x2 (y2-y1)
exch 3 index sub exch mul abs
} def
/is_in_box {% x y => bool ;
bbox 1 get bbox 3 get in_interval %x by
exch bbox 0 get bbox 2 get in_interval
and
} def
/is_in_obj {% x y => bool ;
geom null eq {pop pop false}
{gsave
newpath moveto
X Y translate Angle rotate Sx Sy scale %
{} {} {} {} pathforall %x y in object coord. sys.
1 1 0 0 0 /make_path self send
pointinpath
grestore} ifelse
} def
/dr { %low-level drawing : linewidth linecolor color linejoin linecap
% linestyle => -
%graphic state is preserved;
gsave
setdashpat
setlinecap setlinejoin
Sx Sy Angle X Y /make_path self send
dup -1 ne {gsave setgray fill grestore} {pop} ifelse
setgray setlinewidth
stroke
grestore
} def
/dr_ps {% color => -
PSfile (gsave setdashpat setlinecap setlinejoin % % % % %\n)
[Sx Sy Angle X Y] fprintf
/make_path_ps self send
-1 ne { PSfile ( gsave setgray fill grestore ) [] fprintf}
{PSfile ( pop ) [] fprintf} ifelse
PSfile (setgray setlinewidth stroke grestore\n) [] fprintf
} def
/erase { % this will also erase parts of overlapping objects
linewidth 1 color -1 eq {color} {1} ifelse
linejoin linecap linestyle /dr self send } def
/display { %display the object
linewidth linecolor color linejoin linecap linestyle
/dr self send} def
/display_ps {%generation of postscript
PSfile ( % % % % % % ) [linewidth linecolor color linejoin
linecap linestyle] fprintf
color /dr_ps self send
} def
/make_bbox { %computes the bounding box of the object in the current
%coord system
mtrx0 currentmatrix pop
gsave
Sx Sy Angle X Y /make_path self send
%path made in trans,scaled,rotated
%coord. sys; get coord in normal sys;
mtrx0 setmatrix %path set in mtrx0 coord syst.
pathbbox bbox astore pop
grestore
} def
/move { % x' y' sx' sy' a' => moves to new position and orientation;
% recomputes bbox;
Cancel? not {
erase_flag {/erase self send} if
/Angle exch def
/Sy exch def
/Sx exch def
/Y exch def
/X exch def
/make_bbox self send
/display self send} if
} def
/set_geom {% [p1,p2] => - ; new H and W
/geom exch store
} def
/scale_geom { % sx sy => -
geom 1 get mul geom exch 1 exch put
geom 0 get mul geom exch 0 exch put
} def
/get_geom { % => <geom param array>
geom } def
/change_geom {%change geometry; <changecode> => -
%erases old shapes and redraws it;
/erase self send
exec %exec change proc on stack
/make_bbox self send
/display self send
} def
/make_opath{ %the outline path used in draging mode
/make_path self send
} def
/drag { %drag outline of shape following cursor
% returns dragged position of new origin X' Y'
/oldcanvas currentcanvas store
setoverlay
/Angle2 Angle store
/Sx2 Sx store
/Sy2 Sy store
/xoff 0 store /yoff 0 store
ClickToMove?
{
(enter starting point of move) prmessage
mygetclick
/yoff exch store /xoff exch store
/xoff xoff X sub store /yoff yoff Y sub store
(move object now) prmessage setoverlay} if
/WaitForEvent MoveEvent store
0 0 { newpath
Sx2 Sy2 Angle2 x xoff sub y yoff sub
gsave /make_opath self send stroke grestore
(X, Y : %, % ) [x y] sprintf prvalue
} mygetanimated %x y
animate_event /AlphaEvent eq %gets the data
{pop pop WaitForEvent /ClientData get
aload pop %xr yr
Y add exch %Y' xr
X add exch} if
/WaitForEvent PointEvent store
yoff sub exch xoff sub exch
oldcanvas setcanvas
} def
/bbox_center { % => xc, yc ; box center
bbox 0 get bbox 2 get add 2 div
bbox 1 get bbox 3 get add 2 div
} def
/drotate {%interactive rotation : put x y on stack
/oldcanvas currentcanvas store
setoverlay
/Angle2 Angle store
/Sx2 Sx store
/Sy2 Sy store
/X2 X store
/Y2 Y store
/bbox_center self send /Yc exch store /Xc exch store
/WaitForEvent RotateEvent store
0 0 { newpath
% get angle of vector Xc,Yc - x,y
Sx2 Sy2 Angle2 y Yc sub x Xc sub atan add %sx sy angle
dup [ exch ] (Angle : %) exch sprintf prvalue
X2 Y2 gsave /make_opath self send stroke grestore
} mygetanimated %x y
oldcanvas setcanvas
} def
/dscale { %interactive scaling from box lower left corner
/oldcanvas currentcanvas store
setoverlay
/Angle2 Angle store
/Sx2 Sx store
/Sy2 Sy store
/X2 X store
/Y2 Y store
/Xc bbox 2 get bbox 0 get sub store
/Yc bbox 3 get bbox 1 get sub store
/WaitForEvent ScaleEvent store
bbox 0 get bbox 1 get {
newpath
Sx2 x x0 sub Xc div mul
Sy2 y y0 sub Yc div mul %sx sy
[ 2 index 2 index ] (Sx, Sy : %, %) exch sprintf prvalue
Angle2 X2 Y2 gsave /make_opath self send stroke grestore
} mygetanimated %x y
oldcanvas setcanvas
} def
/drag_and_scale {% scale the geometry definition; preserve line width!!
(scale) prmessage
/dscale self send % x y
Cancel? not {
animate_event /AlphaEvent eq %gets the data
{pop pop WaitForEvent /ClientData get
aload pop} %sx sy
{
/Y2 exch store /X2 exch store
X2 bbox 0 get sub bbox 2 get bbox 0 get sub div %sx'
Y2 bbox 1 get sub bbox 3 get bbox 1 get sub div %sy'
} ifelse
{/scale_geom self send} /change_geom self send
} if
/WaitForEvent PointEvent store
} def
/drag_and_trans {
(move) prmessage
/crosshair? true store
/drag self send %x' y' on stack; move to that
Sx Sy Angle /move self send
/crosshair? false store} def
/drag_and_rotate {
(rotate) prmessage
/drotate self send %x' x' on stack; recompute angle;
/Y2 exch store
/X2 exch store
X Y Sx Sy Angle
animate_event /AlphaEvent eq %gets the data
{ WaitForEvent /ClientData get}
{ Y2 Yc sub X2 Xc sub atan } ifelse %the angle
RecordEvents?
{dup
/AlphaEvent /Rotate exch MakeEventToRecord AddEvent} if
add /move self send
/WaitForEvent PointEvent store
} def
/i_get_geom {%gets geom def. from user interaction ; - => X Y [geom def]
(Rectangle) prmessage
mygetwholerect % [x0 y0 w h]
aload pop % x0 y0 w h
2 array astore % X0 Y0 [w h ]
/Abort? Cancel? store
} def
/i_def_geom {%interactive definition of geom
/oldcanvas currentcanvas store
setoverlay
/crosshair? true store
/i_get_geom self send % X Y <geom param>
oldcanvas setcanvas
Abort? not
{
3 -2 roll
geom null ne {/erase self send} if
/Y exch store
/X exch store
/set_geom self send
geom null ne {
/make_bbox self send
/display self send} if
/crosshair? false store
} {/geom null store /Abort? false store} ifelse
} def
/edit_geom {} def
/clone_geom {%obj contains in its geom structured data which is
%shared by other objects ; copies geom and bbox
geom type (arraytype) eqbernard@prlb2.UUCP (Bernard Yves) (01/27/89)
%-----------------------------------------------------------------------------
{/geom geom dup length array copy store
} if
bbox 4 array copy /bbox exch store
} def
/clone { % -> returns a clone of self
self length dict self exch copy %clone on stack
dup /clone_geom exch send
} def
classend def
(Oval \n) printdbg
/Oval DrawObject %geom = [w,h] of oval
dictbegin
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/make_path {% geom contains radius;
geom null ne {
spos
newpath
0 0 geom 0 get geom 1 get ovalpath
} if
} def
/make_path_ps{
geom null ne {
PSfile ( spos newpath 0 0 % % ovalpath\n)
geom fprintf
} if
} def
/i_get_geom {
(Oval) prmessage
{newpath x0 y0 x y ovalpath
(dX, dY : %, %) [x y] sprintf prvalue
} getrectthing
% X0 Y0 [X1 Y1 ] %X,Y, [w, h]
} def
classend def
(Group \n) printdbg
/Group DrawObject
dictbegin
/Ngr 0 def %geom will contain an array with all the subobjects
%position of subobjects are relative to the position
%of the group
/Ncopy 0 def %working var. for recursive cloning
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/saveivar {
/saveivar super send
OSfile ( % ) [Ngr] fprintf
} def
/loadivar{
/Ngr exch store
/loadivar super send
} def
/components_path {%makes a path going from 0 0 to origins of components
%relative to group coord. syst.
X Y translate Angle rotate Sx Sy scale
newpath
0 0 moveto
geom {begin X Y lineto end} forall
} def
/delete {% all components are defined in the group coord. syst.
% put them back in the global syst.
mtrx0 currentmatrix pop
%translation correction
gsave
/components_path self send
mtrx0 setmatrix %coord expressed in global syst.
/N 0 store
{pop pop} {%component position X Y
geom N get begin /Y exch store /X exch store end
/N N 1 add store}
{} {} pathforall
grestore
%rotation
ingroup not {gsave
1 setgray /contour_mark self send
grestore} if
/Angle2 Angle store
gsave 0 setgray
geom {dup begin
/Angle Angle Angle2 add store
/ingroup false store
end
dup /make_bbox exch send
dup /getclassname exch send /Group eq
{/contour_mark exch send}
{pop} ifelse
} forall
grestore
ObjTable tableindex null put tableindex AddFreeEntry
} def
/clone_geom{% makes a clone of each component
/clone_geom super send
/Ncopy 0 store
geom { /clone exch send dup geom exch Ncopy exch put
/Ncopy Ncopy 1 add store
AddObject} forall
} def
/destroy {%deletes all compoments
/erase self send
geom {begin ObjTable tableindex null put
tableindex AddFreeEntry end} forall
ObjTable tableindex null put tableindex AddFreeEntry
} def
/undestroy{% undo the destroy
geom {dup begin tableindex end exch ObjTable 3 1 roll put}
forall
} def
/setarrowsize{
/Xc exch store
geom {Xc exch /setarrowsize exch send} forall} def
/setarrow{% [ s? e?]
geom {1 index %[s e] o [s e]
exch %[s e] [s e] o
/setarrow exch send} forall
pop
} def
/setradcorner {
/Xc exch store
geom {Xc exch /setradcorner exch send} forall} def
/setlinejoin2 {
/Xc exch store
geom {Xc exch /setlinejoin2 exch send} forall} def
/setlinecap2 {
/Xc exch store
geom {Xc exch /setlinecap2 exch send} forall} def
/setlinestyle {
/Xc exch store
geom {Xc exch /setlinestyle exch send} forall} def
/setlinewidth2 {
/Xc exch store
geom {Xc exch /setlinewidth2 exch send} forall} def
/setlinecolor {
/Xc exch store
geom {Xc exch /setlinecolor exch send} forall} def
/setcolor {
/Xc exch store
geom {Xc exch /setcolor exch send} forall} def
/make_path {%stroke the path of each object; used in draging mode
%for scaling, we can not have at the same time good
%scaling of objects positions and good scaling of their shapes
geom null ne {
spos
geom
{dup begin
% Sx3 Sy3
Sx Sy Angle X Y end 6 -1 roll gsave /make_path
exch send stroke grestore} forall
} if
} def
/make_opath {%stroke the path of each object; used in draging mode
%for scaling, we can not have at the same time good
%scaling of objects positions and good scaling of their shapes
geom null ne {
spos
geom
{dup begin
% Sx3 Sy3
Sx Sy Angle X Y end 6 -1 roll gsave /make_opath
exch send stroke grestore} forall
} if
} def
/is_in_obj {
/is_in_box self send} def
/set_geom {%[o1 o2 o3 ...] =>
%change X Y of Oi to X' Y' relative to X Y of group obj
%set ingroup flag of each Oi
dup length /geom exch array store
geom copy pop
/Ngr geom length store
Ngr 0 ne
{
%get origin of group : first point of bbox
gsave 1 setgray
geom {dup /getclassname exch send /Group eq
{/contour_mark exch send} {pop} ifelse} forall
grestore
/X 0 store /Y 0 store
/make_bbox self send
bbox aload pop %x1 y1 x2 y2
pop pop /Y exch store /X exch store
/X0 X store /Y0 Y store
geom {begin /X X X0 sub store /Y Y Y0 sub store /ingroup true
store end} forall
/make_bbox_component self send
( % components put in group) [Ngr] prmessage
}
{/geom null store} ifelse
} def
/save_geom{% saves on OSfile an array composed of each object saving
OSfile ([ %group geometry\n) writestring
geom {/saveobject exch send} forall
OSfile ( ] %end of group geometry\n) writestring
} def
/make_bbox_component{%compute bbox of comp. in this group coord. syst
gsave
X Y translate %Angle rotate
Sx Sy scale
geom {
/make_bbox exch send} forall
grestore
} def
/contour_mark{
bbox 0 get bbox 1 get moveto drawmark fill
bbox 0 get bbox 2 get add 2 div bbox 1 get moveto drawmark fill
bbox 2 get bbox 1 get moveto drawmark fill
bbox 2 get bbox 1 get bbox 3 get add 2 div moveto drawmark fill
bbox 2 get bbox 3 get moveto drawmark fill
bbox 0 get bbox 2 get add 2 div bbox 3 get moveto drawmark fill
bbox 0 get bbox 3 get moveto drawmark fill
bbox 0 get bbox 1 get bbox 3 get add 2 div moveto drawmark fill
} def
/display {
gsave
Sx Sy Angle X Y spos
geom {/display exch send} forall
grestore
ingroup not {
gsave
0 setgray
/contour_mark self send
grestore} if
} def
/align_left{%align all elements on the left side of the bbox
(align left) prmessage
geom{begin /X X bbox 0 get sub store end} forall
/make_bbox_component self send
} def
/align_bottom{
(align bottom) prmessage
geom{begin /Y Y bbox 1 get sub store end} forall
/make_bbox_component self send
} def
/align_right{%
(align right) prmessage
/X1 bbox 2 get bbox 0 get sub store
geom {begin /X X X1 bbox 2 get sub add store end} forall
/make_bbox_component self send
} def
/align_top{%
(align top) prmessage
/X1 bbox 3 get bbox 1 get sub store
geom {begin /Y Y X1 bbox 3 get sub add store end} forall
/make_bbox_component self send
} def
/center_vertical{
(center vertical) prmessage
/X1 bbox 2 get bbox 0 get add 2 div bbox 0 get sub store
geom {begin /X X X1 bbox 2 get bbox 0 get add 2 div sub add store end}
forall
/make_bbox_component self send
} def
/center_horizontal{
(center horizontal) prmessage
/X1 bbox 3 get bbox 1 get add 2 div bbox 1 get sub store
geom {begin /Y Y X1 bbox 3 get bbox 1 get add 2 div sub add store end}
forall
/make_bbox_component self send
} def
/display_ps {
PSfile
(gsave % % translate % rotate % % scale\n) [X Y Angle Sx Sy] fprintf
geom {/display_ps exch send} forall
PSfile ( grestore\n) [] fprintf
} def
/erase {
gsave
X Y translate Angle rotate Sx Sy scale
geom {/erase exch send} forall
grestore
ingroup not {
gsave 1 setgray
/contour_mark self send
grestore} if
} def
/scale_geom {%sx sy
/Sy2 exch store /Sx2 exch store
geom {dup Sx2 Sy2 /scale_geom 4 -1 roll send
begin /X X Sx2 mul store /Y Y Sy2 mul store end} forall
/make_bbox_component self send
} def
/changefont {% fontname
geom{ % font obj
1 index exch /changefont exch send} forall pop
} def
/changefontsize{% size
geom{ % font obj
1 index exch /changefontsize exch send} forall pop
} def
/make_bbox {% approximatively computed from the box of components
%expressed relatively
%to the group coord. syst.
mtrx1 currentmatrix pop
gsave
%draws a path following all the boxex components
X Y translate Angle rotate Sx Sy scale
geom 0 get begin bbox aload pop %x1 y1 x2 y2
newpath moveto pop pop end
geom 0 Ngr getinterval
{begin bbox aload pop %x1 y1 x2 y2
2 copy lineto %x1 y1 x2 y2 ; x2 y2
1 index 3 index lineto % ; x2 y1
3 index 3 index lineto % ; x1 y1
3 index 1 index lineto % ; x1 y2
pop pop pop pop
end} forall
mtrx1 setmatrix
pathbbox bbox astore pop
grestore
} def
/i_get_geom_enum{%put selected objects as part of group
%end with Left button, Middle button cancels last object.
/Ntmp 0 store
%repeat
{
(select component object with Left button - end with Right button :)
prmessage
mygetclick
/Y0 exch store /X0 exch store
animate_event LeftMouseButton eq
{
X0 Y0 find_object_on_pt
dup
null ne { dup begin (% added in group) [tableindex] prmessage end
dup /erase exch send pause dup /display exch send
tmparray exch Ntmp exch put /Ntmp Ntmp 1 add store
}
{pop} ifelse
} if
animate_event MiddleMouseButton eq %suppress last object
{Ntmp 0 gt {/Ntmp Ntmp 1 sub store} if} if
Cancel? {exit} if
} loop
X0 Y0 tmparray 0 Ntmp getinterval
} def
/i_get_geom_by_box{%define group in giving a box
(enter box enclosing objects to group : ) prmessage
mygetwholerect %[x1 y1 w h]
aload pop %x1 y1 w h
2 index add %x1 y1 w y2
exch 3 index add %x1 y1 y2 x2
exch 4 array astore
/bbox exch store
[ bbox find_objects_in_box /Ntmp exch store ]
(% objects to group) [Ntmp] prmessage
bbox 0 get bbox 1 get 3 -1 roll %the origin should be
%the bounding box
} def
/i_get_geom{
(Group) prmessage
group_def_mode (by box) eq
{/i_get_geom_by_box self send}
{/i_get_geom_enum self send} ifelse
} def
classend def
(ClippingGroup \n) printdbg
/ClippingGroup Group
dictbegin
%a clipping group is composed of 2 objects : the first one
%is the clipping obj and the second one the clipped obj. The clipping obj
%should be a line or curve;
dictend
classbegin
/setclip{
mtrx1 currentmatrix pop
geom 0 get begin Sx Sy Angle X Y end
/make_path geom 0 get send clip %set the clip path
mtrx1 setmatrix
} def
/set_geom {%[o1 o2 o3 ...] =>
%change X Y of Oi to X' Y' relative to X Y of group obj
%set ingroup flag of each Oi
% (set_geom\n) print
dup length /geom exch array store
geom copy pop
/Ngr geom length store
%get origin of group : first point of bbox of clipping
geom 0 get begin bbox end aload pop %x1 y1 x2 y2
pop pop /Y exch store /X exch store
/X0 X store /Y0 Y store
geom {begin /X X X0 sub store /Y Y Y0 sub store /ingroup true
store end} forall
/make_bbox_component self send
} def
/display {
gsave
Sx Sy Angle X Y spos
/display geom 0 get send %dipslay clipping obj
/setclip self send
/display geom 1 get send %draws the clipped
grestore
} def
/display_ps {
PSfile
(gsave % % % % % spos\n) [Sx Sy Angle X Y] fprintf
/display_ps geom 0 get send
PSfile (mtrx1 currentmatrix pop % % % % % \n)
[geom 0 get begin Sx Sy Angle X Y end] fprintf
/make_path_ps geom 0 get send
PSfile ( clip mtrx1 setmatrix \n) [] fprintf
/display_ps geom 1 get send
PSfile ( grestore\n) [] fprintf
} def
/erase {
gsave
Sx Sy Angle X Y spos
/erase geom 0 get send %dipslay clipping obj
/setclip self send
/erase geom 1 get send %draws the clipped
grestore
} def
/make_bbox{ %the bounding box is the one of the clipping obj
/Ngr 1 store
/make_bbox super send
/Ngr 2 store
} def
classend def
(RoundedRect \n) printdbg
/RoundedRect DrawObject
dictbegin
/radcorner 8 def
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/setradcorner {/radcorner exch store} def
/saveivar{
/saveivar super send
OSfile ( % ) [radcorner] fprintf
} def
/loadivar{
/radcorner exch store
/loadivar super send
} def
/make_path {%
geom null ne {
spos
newpath
radcorner 0 0 geom 0 get geom 1 get myrrectpath
} if
} def
/make_path_ps {
geom null ne {
PSfile
(spos newpath % 0 0 % % myrrectpath\n)
[radcorner geom 0 get geom 1 get] fprintf
} if
} def
/i_get_geom {
(RoundedRect) prmessage
/radcorner current_radcorner store
{newpath radcorner x0 y0 x y myrrectpath
(dX, dY : %, %) [x y ] sprintf prvalue
} getrectthing
} def
classend def
/path_action{
Cancel? {% animate_event RightButton eq
RecordEvents?
{[0 0] /Stop /AlphaEvent MakeEventToRecord AddEvent} if
exit
} if
animate_event LeftMouseButton eq
{ aload pop /Y1 exch store /X1 exch store
tmparray Ntmp [X1 Y1] put /Ntmp Ntmp 1 add store
/X2 X1 store /Y2 Y1 store
} if
animate_event MiddleMouseButton eq
{Ntmp 0 gt {/Ntmp Ntmp 1 sub store
Ntmp 0 gt {
tmparray Ntmp 1 sub get
aload pop} {0 0} ifelse
/Y2 exch store /X2 exch store} if} if
} def
/get_path {%ask a path to the user; path terminated by right button;
%point entered with left and suppressed with middle
%path put in tmparray as [ [x1,y1],.... ] , Ntmp elements
%first point -origin - in X0, Y0, all xi,yi relative to origin
(enter points with Left button, Right to stop, Middle to delete Last)
prmessage
mygetclick
/Y0 exch store /X0 exch store %origin
/Relative? true store
gsave
X0 Y0 translate
/X2 0 store /Y2 0 store
/Ntmp 0 store
Cancel? not {
%repeat
{
0 0
{
newpath
0 0 moveto
tmparray 0 Ntmp getinterval {aload pop lineto} forall
X2 Y2 moveto
x y lineto stroke
(Xr, Yr : %, %) [x y] sprintf prvalue
}
mygetanimated mark %x y mark
3 1 roll ] %[x y]
path_action %add points, waits stop, record it if needed
} loop
} {/Abort? true store} ifelse
grestore
(% points path) [Ntmp] prmessage
/Relative? false store
} def
/drawmark{ marksize 2 div neg dup rmoveto marksize dup rect} def
/edit_path{%edit path of a polyline
{newpath
0 0 moveto
tmparray 0 Ntmp getinterval {aload pop lineto} forall
Closed {closepath} if stroke
x y moveto drawmark stroke
} g_edit_path
} def
/outline_proc {} def
/oldmarksize 0 def
/Ne 0 def
/g_edit_path{ %generic path edition
%outline_proc => -; the outlining function
%a path is in tmparray 0-Ntmp;
%allows the user to edit
%it by its moving points;
%Left to select a point or insert a point
% ; confirm move by Left click
%Middle to delete a selected point
%Right to stop
/outline_proc exch store
/oldmarksize marksize store
/marksize marksize 2 mul store
/Relative? true store
gsave
Sx Sy Angle X Y spos
/X2 0 store /Y2 0 store
{
%select point to move
%equivalent to a getclick but with the good outlining function
0 0 {outline_proc} mygetanimated %x y
Cancel? {pop pop
RecordEvents?
{[0 0 ] /Stop /AlphaEvent MakeEventToRecord AddEvent} if
exit } if
/Y1 exch store /X1 exch store
animate_event LeftMouseButton eq
{%try to find a point or a segment
X1 Y1 findpointofpath %0 nothing, 1 a point, 2 a seg
pop
fstatus 1 eq %a point is selected
{/Ne exch store
tmparray Ne get aload pop /Y2 exch store /X2 exch store
(point selected -- move or delete it) prmessage
0 0 {tmparray Ne [x y] put outline_proc}
mygetanimated 2 array astore %[x y]
Cancel? {tmparray Ne [X2 Y2] put} if
animate_event MiddleMouseButton eq
{delete_point} if
} if
fstatus 2 eq %a point on a seg
{/Ne exch store %seg start point index
[X1 Y1] add_point
/Ne Ne 1 add store
(new point inserted -- move it) prmessage
0 0 {tmparray Ne [x y] put outline_proc}
mygetanimated 2 array astore % [x y]
Cancel?
animate_event MiddleMouseButton eq or
{delete_point} if
} if
fstatus 0 eq
{
(point or seg not found) prmessage pop
} if
} if
} loop
grestore
/marksize oldmarksize store
/Relative? false store
} def
/add_point{% [x y] => - ;adds a point in tmparray at position found in Ne
tmparray Ne 2 add %shift 1 in tmp
tmparray Ne 1 add Ntmp Ne sub 1 sub getinterval
putinterval
tmparray exch Ne 1 add exch put
/Ntmp Ntmp 1 add store
} def
/delete_point{% Ne is the index of the point to delete
(point deleted) prmessage
tmparray Ne %shift 1 left
tmparray Ne 1 add Ntmp Ne sub 1 sub getinterval
putinterval
/Ntmp Ntmp 1 sub store
} def
/fstatus 0 def
/findpointofpath{% X Y => pointindex 1 | startsegindex 2 | 0
/fstatus 0 store
0 1 Ntmp 1 sub
{dup tmparray exch get aload pop %x y n x1 y1
3 index sub abs 3 lt exch %x y n b1 x1
4 index sub abs 3 lt %x y n b1 b2
and {/N exch store /fstatus 1 store
exit
}
{%if not last point try if on a seg %x y n
/N exch store
N Ntmp 1 sub lt {
2 copy
tmparray N get aload pop %x y x1 y1
tmparray N 1 add get aload pop % ... x2 y2
is_on_segment
{/fstatus 2 store exit} if
} if
} ifelse
} for
pop pop
fstatus 0 eq {fstatus} {N fstatus} ifelse
} def
/outline_curve{
newpath
0 0 moveto /N 1 store /Xc 0 store /Yc 0 store
tmparray 0 Ntmp getinterval
{aload pop %x y
N 3 eq {gsave Xc Yc moveto
2 copy /Yc exch store /Xc exch store
curveto
/N 1 store
stroke grestore Xc Yc moveto}
{ 2 copy lineto
/N N 1 add store} ifelse} forall
} def
/edit_curved_path{
{outline_curve stroke x y moveto drawmark stroke} g_edit_path
} def
/get_curved_path {%ask a path to the user; path terminated by double-clicking
%last point;
%path put in tmparray as [ [x1,y1],.... ] , Ntmp elements
%first point -origin - in X0, Y0, all xi,yi relative to origin
%get points until two points are equal
(enter first point : ) prmessage
mygetclick
/Y0 exch store /X0 exch store %origin
/Relative? true store
gsave
(enter points 3 by 3 - Right button to end, Middle to delete Last)
prmessage
X0 Y0 translate
/X2 0 store /Y2 0 store
/Ntmp 0 store
/N 1 store
Cancel? not
{
%repeat
{
0 0
{ outline_curve
X2 Y2 moveto
x y lineto stroke
(Xr, Yr : %, %) [x y] sprintf prvalue}
mygetanimated 2 array astore %[x y]
path_action
} loop
/Ntmp Ntmp Ntmp 3 mod sub store %Ntmp a multiple of 4
} {/Abort? true store} ifelse
grestore
(% curves path) [ Ntmp 3 div ] prmessage
/Relative? false store
} def
(Polyline \n) printdbg
/Polyline DrawObject
dictbegin
/Npoint 0 def %nbre de points
/Closed false def %if true -> polygon
/arrowsize 5 def
/startarrow? false def
/endarrow? false def
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/setarrowsize{ /arrowsize exch store} def
/setarrow{% [start? end?]
aload pop
/endarrow? exch store
/startarrow? exch store
} def
/getcurrentdisplayparam{
/getcurrentdisplayparam super send
/arrowsize current_arrowsize store
/startarrow? current_startarrow? store
/endarrow? current_endarrow? store
} def
/saveivar{
/saveivar super send
OSfile ( % % % % % \n )
[Npoint Closed arrowsize startarrow? endarrow? ] fprintf
} def
/loadivar{
/endarrow? exch store
/startarrow? exch store
/arrowsize exch store
/Closed exch store
/Npoint exch store
/loadivar super send
} def
/make_path {%the path coord relative to 0,0 are stored in an array in geom
geom null ne {
spos
newpath
0 0 moveto
geom {aload pop lineto} forall Closed {closepath} if
} if
} def
/make_path_ps{
geom null ne {
PSfile (spos newpath 0 0 moveto \n) [] fprintf
geom {PSfile exch ( % % lineto \n) exch fprintf} forall
Closed {PSfile ( closepath\n) [] fprintf} if
} if
} def
/dr {
gsave
setdashpat
setlinecap setlinejoin
Sx Sy Angle X Y /make_path self send
dup -1 ne {gsave setgray fill grestore} {pop} ifelse
setgray setlinewidth
stroke
startarrow? {arrowsize geom 0 get aload pop 0 0 drarrow} if
endarrow? {arrowsize Npoint 1 eq {0 0}
{geom Npoint 2 sub get aload pop} ifelse
geom Npoint 1 sub get aload pop drarrow} if
grestore
} def
/dr_ps {% color => -
PSfile (gsave setdashpat setlinecap setlinejoin % % % % %\n)
[Sx Sy Angle X Y] fprintf
/make_path_ps self send
-1 ne { PSfile ( gsave setgray fill grestore ) [] fprintf}
{PSfile ( pop ) [] fprintf} ifelse
PSfile (setgray setlinewidth stroke \n) [] fprintf
startarrow? {
PSfile ( % % % % % drarrow\n)
[arrowsize geom 0 get aload pop 0 0 ] fprintf} if
endarrow? {
PSfile ( % % % % % drarrow\n)
[arrowsize Npoint 1 eq {0 0}
{geom Npoint 2 sub get aload pop} ifelse
geom Npoint 1 sub get aload pop] fprintf} if
PSfile ( grestore\n) [] fprintf
} def
/BoxSize {%if it is a segment than 0
Npoint 1 le {0}
{/BoxSize super send} ifelse
} def
/is_in_obj {% x y => bool ; problem with pointinpath;;
% seems to crash the news_server (unexpected sigsegv signal...)
geom null eq {pop pop false}
{
Npoint 1 gt %x y b
2 index 2 index /is_in_box self send not and %not a line and not in box
{pop pop false}
{gsave
newpath moveto
X Y translate Angle rotate Sx Sy scale %
{} {} {} {} pathforall %x y in object coord. sys.
Npoint 1 le %we have a line segment
{0 0 geom 0 get aload pop %x y 0 0 x1 y1
is_on_segment}
{
1 1 0 0 0 /make_path self send
Closed not {closepath} if
pointinpath
} ifelse
grestore} ifelse
} ifelse
} def
/scale_geom { %sx sy => -
2 copy max arrowsize mul /arrowsize exch store
mtrx0 currentmatrix pop
gsave
0 0 0 /make_path self send %path
mtrx0 setmatrix %path is scaled
/N 0 store
{pop pop} { %x y
geom N get astore pop
/N N 1 add store}
{} {} pathforall
grestore
} def
/i_get_geom {
get_path %path introduced by user in tmparray;
X0 Y0 tmparray 0 Ntmp getinterval
%x y [array of [xi yi] ] on stack
Ntmp 0 eq {/Abort? true store} if
} def
/edit_proc {edit_path} def
/edit_geom {%interactive edition of geom
(select point of line and move it -- end with Right button)
prmessage
/erase self send
/oldcanvas currentcanvas store
setoverlay /crosshair? true store
/Ntmp Npoint store
tmparray 0 geom putinterval
/edit_proc self send
oldcanvas setcanvas
geom null ne {/erase self send} if
tmparray 0 Ntmp getinterval /set_geom self send
geom null ne {
/make_bbox self send
/display self send} if
/crosshair? false store
} def
/set_geom { %[ [x1 y1] [x2 y2] ... ] => -
dup length array /geom exch store
geom copy
length /Npoint exch store
} def
/save_geom{%
OSfile ([ %polyg. geom\n) writestring
geom {OSfile exch ( [ % % ] ) exch fprintf} forall
OSfile ( ] %end of polyg. geom\n) writestring
} def
/clone_geom { %here the geom is an array of array
geom type (arraytype) eq
{/newarray geom length array store /N 0 store
geom {2 array copy newarray exch N exch put
/N N 1 add store} forall
/geom newarray store} if
/newarray 4 array store
bbox newarray copy /bbox exch store
} def
classend def
(Curve \n) printdbg
/Curve Polyline
dictbegin
/iter 1 def
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/make_path {%the path coord relative to 0,0 are stored in an array in geom
geom null ne {
spos
% translate rotate scale
newpath
0 0 moveto
/iter 1 def
geom {
aload pop
iter 3 eq {curveto /iter 1 store }
{/iter iter 1 add store} ifelse
} forall
Closed {closepath} if
} if
} def
/make_path_ps {%the path coord relative to 0,0 are stored in an array in geom
geom null ne {
PSfile (spos newpath 0 0 moveto\n) [] fprintf
/iter 1 def
geom {
PSfile exch ( % % ) exch fprintf
% aload pop
iter 3 eq {
PSfile ( curveto\n) [] fprintf /iter 1 store }
{/iter iter 1 add store} ifelse
} forall
Closed {PSfile ( closepath\n) [] fprintf} if
} if
} def
/scale_geom { %sx sy => -
mtrx0 currentmatrix pop
gsave
0 0 0 /make_path super send %path
mtrx0 setmatrix %path is scaled
/N 0 store
{pop pop} { %x y
geom N get astore pop
/N N 1 add store}
{} {} pathforall
grestore
} def
/edit_proc {edit_curved_path
/Ntmp Ntmp Ntmp 3 mod sub store %Ntmp a multiple of 4
} def
/i_get_geom {
get_curved_path %path introduced by user in tmparray;
X0 Y0 tmparray 0 Ntmp getinterval
%x y [array of [xi yi] ] on stack
Ntmp 0 eq {/Abort? true store} if
} def
classend def
/FontName /Times-Roman def
/pointsize 30 def
(Text\n) printdbg
/TextObject DrawObject
dictbegin
/Fontname FontName def
/Size pointsize def
/font null def
/Sh 0 def %the height, width of the box enclosing the
/Sw 0 def %string in global coord. sys. (non scaled and non rot.)
dictend
classbegin
/new {
/new super send begin
currentdict end
} def
/init{
/init super send
/Fontname FontName store
/Size pointsize store
/color 0 store %black
} def
/saveivar{
/saveivar super send
OSfile (/% % % %) [Fontname Size Sh Sw] fprintf
} def
/loadivar{
/Sw exch store
/Sh exch store
/Size exch store
/Fontname exch store
/loadivar super send
} def
/save_geom{
OSfile ( \() writestring
OSfile geom writestring OSfile (\) \n) writestring
} def
/make_font {% sets the font entry
/font Fontname findfont Size scalefont store} def
/set_font_and_size {% /fontname size =>
/Size exch def
/Fontname exch def
/make_font self send} def
/changefont{ % FontName -- change the font
/Fontname exch store
} def
/changefontsize{% change font size -- font size
/Size exch store
} def
/make_path {
geom null ne {
spos
Fontname findfont Size scalefont setfont
newpath
0 0 moveto geom show
} if
} def
/make_path_ps {
geom null ne {
PSfile (spos\n) [] fprintf
PSfile ( /% findfont % scalefont setfont\n) [Fontname Size] fprintf
PSfile (newpath 0 0 moveto (%) show\n) [geom] fprintf
} if
} def
/is_in_obj {
/is_in_box self send} def
/dr {% linewidth linecolor color linejoin linecap linestyle => - only
%color is important
gsave
pop pop pop setgray pop pop
Sx Sy Angle X Y /make_path self send
grestore
} def
/dr_ps{
PSfile (gsave pop pop pop setgray pop pop % % % % % \n)
[Sx Sy Angle X Y] fprintf
/make_path_ps self send
PSfile (grestore\n) writestring
} def
/make_bbox{ %there seems to be problem with charpath and rotation;
%therefore finds the box and draws it in the object coord.
%system and extracts its bbox in the current coord. syst
geom null ne {
gsave
mtrx0 currentmatrix pop
Fontname findfont Size scalefont setfont
0 0 moveto geom stringbbox %here we have the box x,y,w,h
2 copy /Sh exch store /Sw exch store
X Y translate Angle rotate Sx Sy scale
0 0 moveto rect pop pop
mtrx0 setmatrix
pathbbox bbox astore pop
grestore} if
} def
/make_opath{ spos 0 0 moveto Sw Sh rect} def
/scale_geom { %sx sy
% max Size mul /Size exch store
/Sy exch store /Sx exch store
} def
/i_get_geom {%the string is in textstring;
(Text) prmessage
0 0 {newpath
Sx Sy Angle x y gsave
/geom get_textstring store
/make_path self send grestore
} mygetanimated % x y
Cancel? {null /Abort true store}
{/geom get_textstring length string store
get_textstring geom copy
} ifelse
} def
/edit_geom {%interactive edition of geom
(Edit Text)
prmessage
/erase self send
/oldcanvas currentcanvas store
setoverlay
items /textstring get /ItemValue geom geom length string copy put
geom %oldgeom
0 0 {newpath
Sx Sy Angle X Y gsave
/geom get_textstring store
/make_path self send grestore
} mygetanimated %x y
Cancel? {/geom exch store}
{pop /geom get_textstring length string store
get_textstring geom copy
} ifelse
oldcanvas setcanvas
geom null ne {
/make_bbox self send
/display self send} if
} def
classend def
(PostScriptImport\n) printdbg
%the local bbox of the object is stored in the geom variable
/alreadyimporteddict 50 dict def
%for each imported file, we will have
% /procname [ codearray filename ]
/savefname null def
/SaveImportedFiles {%
OSfile (alreadyimporteddict begin \n) writestring
alreadyimporteddict
{% key [ code filename ]
exch OSfile exch (/% [ { \n) exch [ exch procstr cvs ] fprintf
aload pop %code fname
exch pop /savefname exch store % -
(copying PS file ) savefname append prmessage
savefname OSfile copytofile {(error in copying PS imported file )
prmessage} if %fname
OSfile ( } \n) writestring
OSfile ( (%) ) [ savefname] fprintf
OSfile (\n ] def \n) writestring
} forall
OSfile (\n end \n) writestring
} def
/PSFileCycle{ % filename => bool ; true if filename is an already
% imported PS file
false
alreadyimporteddict
{ %key, [ codearray filename ]
exch pop %
aload pop exch pop %filename false filename2
2 index eq { %filename false
pop true exit} ifbernard@prlb2.UUCP (Bernard Yves) (01/27/89)
%--------------------------------------------------------------------- } forall exch pop } def %utilities /add_extension{% filename (.extension) => filename.extension exch %ext filename ( ) search %ext post match pre true { 4 -1 roll %post match pre ext 4 2 roll %pre ext post match pop pop append } { %ext pre exch append } ifelse } def /extract_fname{% /.../.../.../toto.xxx => toto.xxx { (/) search { % post match pre pop pop} {exit} ifelse } loop } def /make_wrappedfname{%filename => PWD/fname.wps (PWD) getenv (/) append exch extract_fname append (.wps) add_extension } def /achar 1 string def /linestring2 256 string def /make_procname{ % filename => - %from a filename make a postscript name %by repacing all / by a _ /N 0 store 0 1 linestring2 length 1 sub {linestring2 exch 32 put} for { achar 0 3 -1 roll put achar dup (/) eq {pop (_)} if %char or _ linestring2 N 3 -1 roll putinterval /N N 1 add store } forall linestring2 ( ) search pop %post match pre 3 1 roll pop pop cvn } def /linestring 256 string def /TmpFile null def /PS2file null def /errorstring 30 string def /copytofile{% filename file => bool ; true if error exch %file filename { (r) file /TmpFile exch store % file { dup % file file TmpFile linestring readline % file file subst bool {writestring % file dup (\n) writestring % file } {pop exit} ifelse } loop TmpFile closefile } stopped dup {get_errorstr} if } def /get_errorstr{%gets current errorname and puts it in errorstring $error begin errorname end errorstring cvs pop } def /fileerrorpr{% operation filename => - %print last file error message exch (file error : ) errorstring append exch append exch append prerror } def /FileExist? {% filename => true | false { (r) file} stopped {false} {closefile true} ifelse } def /PostScript DrawObject dictbegin /drawproc nullproc def %the drawing code; any legal ps? /filename 100 string def %the imported file /privatedict2 null def /procname null def /savemtrx null def /RedisplayIfScroll {} def dictend classbegin /new { /new super send begin currentdict end } def /init{ /init super send % /geom 4 array store /privatedict2 50 dict store %a private dict for drawproc def and store /savemtrx matrix store } def /clone_geom{ /clone_geom super send privatedict2 50 dict copy /privatedict2 exch store } def /display{%drawing param are set; it is the responsability %of the drawing proc to reset them to its own values savemtrx currentmatrix pop gsave Sx Sy Angle X Y spos geom 0 get neg geom 1 get neg translate linewidth setlinewidth linecolor setgray linecap setlinecap linejoin setlinejoin linestyle setdashpat mark privatedict2 begin drawproc end cleartomark grestore savemtrx setmatrix } def /display_ps {%for each imported file <file> a procedure /<file> is %defined and called procname null eq {/procname filename make_procname store} if importfiledict procname known not {% the procedure is not yet defined in the ps file %procname procname self /drawproc get length 300 lt { PSfile (\n/%{\n) [ procname ] fprintf filename PSfile copytofile pop %procname PSfile (\n} def\n) writestring importfiledict procname 1 put %procname } if %if the proc is too long %do not create a proc, but write %the imported file each time it is needed } if PSfile (savemtrx currentmatrix pop gsave % % % % % spos % % translate\n) [Sx Sy Angle X Y geom 0 get neg geom 1 get neg] fprintf PSfile (% % % % % setdashpat setlinejoin setlinecap setgray setlinewidth\n) [linewidth linecolor linecap linejoin linestyle] fprintf self /drawproc get length 300 lt {PSfile (mark privatedict begin % end cleartomark grestore savemtrx setmatrix\n) [procname] fprintf } {PSfile (mark privatedict begin\n) writestring filename PSfile copytofile pop PSfile (end cleartomark grestore savemtrx setmatrix\n) writestring } ifelse } def /scale_geom{ Sy mul /Sy exch store Sx mul /Sx exch store } def /make_opath{%draws the local bbox spos % geom 0 get geom 1 get moveto 0 0 moveto geom 2 get geom 0 get sub geom 3 get geom 1 get sub rect } def /make_path{ /make_opath self send} def %will be used in is_in_obj; /erase{%erases the local bounding box gsave 1 setgray Sx Sy Angle X Y make_opath fill grestore } def /make_bbox{%computes the global bbox gsave mtrx0 currentmatrix pop Sx Sy Angle X Y /make_opath self send mtrx0 setmatrix pathbbox bbox astore pop grestore } def /load_drawproc{ % - => bool; true if ok; %if not already made, makes the wrapped file and loads it %the wrapped file is created in the user Home directory %with the same name as the user file and *.wps as extension /procname filename make_procname store alreadyimporteddict procname known %the dict entry contains the Postscript object %for which the corresponding drawproc has been defined {/drawproc alreadyimporteddict procname get aload pop pop def true } {%the PS file is not yet loaded /PS2file filename make_wrappedfname (w) file store PS2file (/drawproc{ \n) writestring filename PS2file copytofile %copies filename to the %end of PS2file {%error in copying file false PS2file closefile } {%close it and load it to define /drawproc PS2file (\n} def \n) writestring PS2file closefile (loading wrapped file ) filename make_wrappedfname append prmessage filename make_wrappedfname LoadFile dup {alreadyimporteddict procname [/drawproc load filename ] put} if } ifelse } ifelse } def /i_get_geom{ %reads the imported filename * and loads it %makes a 'wrapped' file *.wps %where the ps code is embedded : /drawproc{ <code> } def %then loads it with LoadFile (Import PostScript) prmessage /filename get_ps_filename dup length string copy store filename extract_fname length 0 gt { (making wrapped file ) filename make_wrappedfname append prmessage /load_drawproc self send %true if ok; { (enter the bounding box : ) prmessage currentcanvas %the overlay canvas oldcanvas setcanvas %the win canvas /X0 0 store /Y0 0 store /RedisplayIfScroll {gsave 0 0 translate savemtrx currentmatrix pop gsave mark privatedict2 begin drawproc end cleartomark grestore savemtrx setmatrix grestore } store /ThisObj self store /RedisplayWhenScroll { {RedisplayIfScroll} ThisObj send } store {RedisplayIfScroll} stopped {(error in executing PS file ) filename append prerror setcanvas 0 0 null } { setcanvas %reset the overlay mygetwholerect %[x y w h] aload pop %x1 y1 w h 2 index add %x1 y1 w y2 exch 3 index add %x1 y1 y2 x2 exch 3 index 3 index %x1 y1 x2 y2 x1 y1 6 2 roll 4 array astore %x1 y1 box (PS file imported: ) filename append prmessage } ifelse } {( in loading ) filename fileerrorpr 0 0 null } ifelse } {( in loading ) filename fileerrorpr 0 0 null } ifelse /RedisplayWhenScroll {} store }def /save_geom{ OSfile ( [ % % % % ] \n) geom fprintf} def /saveivar{ /saveivar super send OSfile ( \() writestring OSfile filename writestring OSfile (\) \n) writestring } def /loadivar{ /filename exch store mark /load_drawproc self send {} %ok {(error in importing) filename append prerror)} ifelse cleartomark /loadivar super send } def classend def %building of an A4 size rectangle /a4rect /new DrawObject send def { /X 100 35 div 3 mul def /Y 100 35 div 3 mul def /geom [100 35 div 197 mul 100 35 div 282 mul] def /linecolor .85 def /linewidth 2 def /ingroup true def %so that it is not selectable by user; } a4rect send %============================================================================= %drawing area window definition %=========================================================================== %/win framebuffer /new ScrollAndZoomWindow send def (main interaction routines\n) printdbg /previous_selection null def /current_selection null def /old_selection null def /push_selection{% obj /previous_selection current_selection store /current_selection exch store } def /pop_selection{% /current_selection previous_selection store /previous_selection null store } def /ClosedPath? false def /create_object {%class => obj {ClientCanvas} win send setcanvas /new exch send push_selection % /current_selection exch store ClosedPath? {current_selection begin /Closed true store end /ClosedPath? false store} if /i_def_geom current_selection send current_selection begin geom end null ne {current_selection AddObject} {pop_selection} ifelse } def /foundlist 100 array def /Nfound 0 def /MaxBoxSize 0 def /find_object_on_pt {%x y => obj | null %only objects which are not in a group can be found /Y0 exch store /X0 exch store /Xc null store /Yc null store /Nfound 0 store ObjTable 0 Nobj getinterval { /Xc exch store Xc null ne {Xc begin ingroup end not {X0 Y0 /is_in_obj Xc send { foundlist Nfound Xc put /Nfound Nfound 1 add store } if} if} if} forall Nfound 0 eq { null} { /MaxBoxSize 10000000 store foundlist 0 Nfound getinterval { /Xc exch store /BoxSize Xc send dup MaxBoxSize le {/Yc Xc store /MaxBoxSize exch store MaxBoxSize 0 eq {exit} if} {pop} ifelse } forall Yc } ifelse } def /find_objects_in_box {% [x1 y1 x2 y2] => o1 o2.... on n /b1 exch store /N 0 def ObjTable 0 Nobj getinterval { /Xc exch store Xc null ne {Xc begin ingroup end not {Xc begin bbox end b1 box_in_box {Xc /N N 1 add store} if} if} if} forall N } def /select_object { {ClientCanvas} win send setcanvas gsave /oldcanvas currentcanvas store (select object by clicking on it : ) prmessage setoverlay getclickwithmenu oldcanvas setcanvas find_object_on_pt grestore dup null ne {dup /erase exch send push_selection pause /display current_selection send current_selection begin [tableindex] end (% is selected) exch prmessage /getclassname current_selection send /Group ne {/update_control_panel current_selection send} if } {pop (no object selected) prmessage} ifelse } def /i1 0 def /i2 0 def /swap_obj{ % o1 o2 => - ; swaps the 2 obj in ObjTable; dup begin /i2 tableindex store end exch dup begin /i1 tableindex store end %o2 o1 dup begin /tableindex i2 store end ObjTable exch i2 exch put dup begin /tableindex i1 store end ObjTable exch i1 exch put (% and % swapped) [i1 i2] prmessage } def /find_overlapping_obj{ % fromindex step toindex obj => first_over_obj %obj in X1, overlap in Xc /X1 exch store /Xc null store {ObjTable exch get dup /X2 exch store null ne {X2 begin ingroup end not {X1 begin bbox end X2 begin bbox end overlapping_box {/Xc X2 store exit} if } if } if } for Xc } def /move_down{ % obj => obj2 ; invert position of obj in ObjTable with % the next object behind it overlapping it dup begin tableindex end 1 sub -1 0 4 -1 roll find_overlapping_obj dup null ne {X1 Xc swap_obj} if } def /move_up{ % obj => obj2 ; invert position of obj in ObjTable with % the next object over it overlapping it obj2 dup begin tableindex end 1 add 1 Nobj 1 sub 4 -1 roll find_overlapping_obj dup null ne {X1 Xc swap_obj} if } def /apply_on_sel {% proc => - ; apply proc on selection if non null current_selection null ne {{ClientCanvas} win send setcanvas exec } {pop (no object selected !) prmessage} ifelse } def /fapply_on_sel{% /message -> apply it on current selection current_selection dup null ne %/message obj {{ClientCanvas} win send setcanvas send } {pop pop (no object selected !) prmessage} ifelse } def /notifyselection true def /setdpar {% value /paramfunct => - ; %apply change of param on selection if non null 2 copy %arg1 arg2 arg1 arg2 current_selection null ne notifyselection and {{ClientCanvas} win send setcanvas {self send} /change_geom current_selection send pop pop } {pop pop } ifelse } def /fontmenu [ FontDirectory { % include all fonts except /Cursor pop dup /Cursor ne { 25 string cvs dup length 3 le { pop } if } { pop } ifelse } forall ] [{/FontName currentkey store FontName /changefont setdpar} ] /new DefaultMenu send def /pointsizemenu [( 6 ) (8) (10) (12) (14) (16) (18) (24) (30) (32) (64)] [{/pointsize currentkey cvi store pointsize /changefontsize setdpar} ] /new DefaultMenu send def /filemenu [ (save PS file) {generate_ps} (------) {} (save Objects file) {generate_os} (load Objects file) {load_osfile} (------) {} (save Tools file) {SaveTools} (load Tools file) {LoadToolFile} (------) {} (Windows Pos.) {WindowPositions} (Info) {CopyrightNotice prmessage {ClientCanvas} win send setcanvas} ] /new DefaultMenu send def /CopyrightNotice (NeWSillustrator 1.0.p, jan 89, Yves Bernard, Philips Research Lab, Brussels) def /align_op{%align_proc => - current_selection null ne {{ClientCanvas} win send setcanvas /getclassname current_selection send /Group eq {/change_geom current_selection send} if } {pop (no group object selected !) prmessage} ifelse } def /clipped_obj null def /clipping_obj null def /make_clip{%the current selection contains the clipping object %the previous selection should contain the object to clip current_selection null eq previous_selection null eq or {(error : no objects for making clip) prerror} { /clipped_obj previous_selection store /getclassname current_selection send dup /Group ne %class b 1 index /TextObject ne and %class b 1 index /PostScript ne and %class b exch pop { /clipping_obj current_selection store /erase clipped_obj send /new ClippingGroup send push_selection [clipping_obj clipped_obj] /set_geom current_selection send /make_bbox current_selection send /display current_selection send current_selection AddObject } { (error : the clipping obj can not be a group, a text or an importPS) prerror } ifelse } ifelse } def /psfilename null def /get_ps_filename{ items /psfilename get /ItemValue get} def /notifypsfname{ /psfilename ItemValue store} def /ConfirmWriteFile? {% filename FileExist? {(Overwrite Existing File ?? ) Confirm?} {true} ifelse } def /PSfile null def /generate_ps { {ClientCanvas} win send setcanvas get_ps_filename PSFileCycle not { get_ps_filename ConfirmWriteFile? { {get_ps_filename (w) file /PSfile exch store (writing PS file...) prmessage RepaintAll_ps PSfile closefile} stopped {get_errorstr ( in writing ) get_ps_filename fileerrorpr} {(PS file is written: ) get_ps_filename append prmessage} ifelse } {(writing aborted...) prmessage} ifelse } {(can not write PS file: cycle,same name as an imported PS file ) get_ps_filename append prerror } ifelse } def /osfilename null def /get_os_filename{ items /osfilename get /ItemValue get} def /notifyosfname{ /osfilename ItemValue store} def /saveproc null def /GenericSave{% proc => -; to file OSfile /saveproc exch store get_os_filename ConfirmWriteFile? { { /OSfile get_os_filename (w) file store /procfile OSfile store saveproc OSfile (\n) writestring OSfile closefile } stopped {get_errorstr ( in writing ) get_os_filename fileerrorpr} {(file is written) prmessage} ifelse } if } def /OSfile null def /generate_os { {ClientCanvas} win send setcanvas {(writing object files...) prmessage SaveImportedFiles SaveAllObjects} GenericSave } def /load_osfile{ {ClientCanvas} win send setcanvas (loading...) prmessage get_os_filename LoadFile {(Object file loaded: ) get_os_filename append prmessage /PaintClient win send } {get_errorstr ( in loading ) get_os_filename fileerrorpr} ifelse } def %============================================================================ %control panel window definition %============================================================================ (Control Panel definition\n) printdbg systemdict /Item known not { (NeWS/liteitem.ps) run } if %systemdict /Item known not { (NeWS/liteitem.ps) LoadFile pop } if /notify? true def /notify { notify? {(Notify: Value=%) [ItemValue] /printf messages send} if } def /FillColor .75 def /prmessage { % sting => - print messages in Control Panel gsave /printf messages send grestore } def /prerror { % sting => - print messages in Control Panel gsave /printf errormessage send grestore } def /prvalue { % string => - print in Control Panel gsave /printf valuemessage send grestore } def /recstr 30 string def /notifylq {ItemValue 10 div setlinequality} def /ParValue 0 def /notifylw {ItemValue /setlinewidth2 setdpar} def /notifylc {ItemValue 100 div /setlinecolor setdpar} def /notifyfc {ItemValue 0 lt {-1} {ItemValue 100 div} ifelse /setcolor setdpar} def /notifygroupdefmode {/group_def_mode ItemValue 0 eq (by box) (by enumeration) ifelse store } def /notifylcap{ItemValue /setlinecap2 setdpar} def /notifyljoin{ItemValue /setlinejoin2 setdpar} def /notifylstyle{ItemValue /setlinestyle setdpar} def /notifyarrowsize{ItemValue cvr /setarrowsize setdpar} def /arrowstartend? { % - => startarrow endarrow ParValue 0 eq {false false} if ParValue 1 eq {true false} if ParValue 2 eq {false true} if ParValue 3 eq {true true} if } def /Pend false def /Pstart false def /notifylarrow{/ParValue ItemValue store arrowstartend? /Pend exch store /Pstart exch store [Pstart Pend] /setarrow setdpar} def /notifyradcorner {ItemValue cvr dup 0 eq {pop 8} if /setradcorner setdpar} def /textstring (enter string) def /notifytext{/textstring ItemValue store} def /gridon false def /gridsize 100 def /notifygridsize {/gridsize ItemValue cvr dup 0 eq {pop 100} if store} def /notifysnap {/SnapToGrid? ItemValue 1 eq store } def /updateCPitem{% newvalue /name items exch get %newvalue it dup 2 index /ItemValue exch put %v it exch pop /paint exch send } def /ClickToMove? false def /xoff 0 def /yoff 0 def /notifyclicktomove{/ClickToMove? ItemValue 1 eq store} def /notifygridon {/gridon ItemValue 1 eq store gridon {{ClientCanvas} win send setcanvas draw_grid} {/PaintClient win send} ifelse } def /get_textstring{%gets the ItemValue of the text liteitem items /textstring get /ItemValue get dup /textstring exch store } def /notifyalphadata {} def /draw_grid{% draws the grid gridon gridsize 0 gt and {gsave 0 setgray [2 5] 0 setdash 0 gridsize 1000 {dup 0 moveto 1000 lineto stroke} for 0 gridsize 1000 {dup 0 exch moveto 1000 exch lineto stroke} for grestore} if } def /putinControlPanel{%linewidth linecolor color linestyle linejoin linecap /notifyselection false store /oldcanvas currentcanvas store {ClientCanvas} controlpanel send setcanvas items begin linecap /ItemValue 3 -1 roll put /paint linecap send linejoin /ItemValue 3 -1 roll put /paint linejoin send linestyle /ItemValue 3 -1 roll put /paint linestyle send dup -1 ne {100 mul} if fillcolor /ItemValue 3 -1 roll put /paint fillcolor send 100 mul linecolor /ItemValue 3 -1 roll put /paint linecolor send linewidth /ItemValue 3 -1 roll put /paint linewidth send end oldcanvas setcanvas pause /notifyselection true store } def /setcurrentdisplayparam{%set control parameters as default items begin linecap /ItemValue get /current_linecap exch store linejoin /ItemValue get /current_linejoin exch store linestyle /ItemValue get /current_linestyle exch store fillcolor /ItemValue get dup 0 lt {pop -1} {100 div} ifelse /current_fill exch store linecolor /ItemValue get 100 div /current_linecolor exch store linewidth /ItemValue get /current_linewidth exch store arrowsize /ItemValue get cvr /current_arrowsize exch store linearrow /ItemValue get /ParValue exch store arrowstartend? /current_arrowend? exch store /current_arrowstart? exch store end } def %Items creation /createitems { /items 30 dict dup begin /messages /panel_text (<messages come here>) /Right {} can 700 0 /new MessageItem send dup begin /ItemFrame 1 def /ItemBorder 4 def end 20 20 /move 3 index send def /value /panel_text (<values>) /Right {} can 700 0 /new MessageItem send dup begin /ItemFrame 1 def /ItemBorder 4 def end 20 0 /move 3 index send def /errormessage /panel_text (<error message>) /Right {} can 700 0 /new MessageItem send dup begin /ItemFrame 1 def /ItemBorder 4 def end 20 -20 /move 3 index send def /textstring (Text String:) (Text string) /Right /notifytext can 500 0 /new TextItem send 20 290 /move 3 index send def /osfilename (Objects file name:) (PWD) getenv (/) append /Right /notifyosfname can 500 0 /new TextItem send 20 260 /move 3 index send def /psfilename (PS file name:) (PWD) getenv (/) append /Right /notifypsfname can 500 0 /new TextItem send 20 230 /move 3 index send def /gridsize (Grid Size:) (100) /Right /notifygridsize can 220 0 /new TextItem send 20 200 /move 3 index send def /gridbutton (Grid on:) [/panel_check_off /panel_check_on] /Right /notifygridon can 0 0 /new CycleItem send dup /LabelY -4 put 250 200 /move 3 index send def /SnapToGrid? (Snap To Grid:) [/panel_check_off /panel_check_on] /Right /notifysnap can 0 0 /new CycleItem send dup /LabelY -4 put 355 200 /move 3 index send def /linequality (line quality:) [0 10 10] /Right /notifylq can 220 20 /new SliderItem send 20 170 /move 3 index send def /linecap (line cap:) [(butt) (round) (square) ] /Right /notifylcap can 0 0 /new CycleItem send 250 140 /move 3 index send def /linejoin (line join:) [(miter) (round) (belevel) ] /Right /notifyljoin can 0 0 /new CycleItem send 355 170 /move 3 index send def /linestyle (line style:) [(plain) (dash1) (dash2) ] /Right /notifylstyle can 0 0 /new CycleItem send 250 170 /move 3 index send def /linearrow (line arrow:) [(no) (at start) (at end) (at start and end) ] /Right /notifylarrow can 0 0 /new CycleItem send 355 140 /move 3 index send def /linewidth (line width:) [0 10 0] /Right /notifylw can 220 20 /new SliderItem send dup /ItemFrame 1 put 20 140 /move 3 index send def /linecolor (line color:) [0 100 0] /Right /notifylc can 220 20 /new SliderItem send dup /ItemFrame 1 put 20 110 /move 3 index send def /fillcolor (fill color:) [-1 100 -1] /Right /notifyfc can 220 20 /new SliderItem send dup /ItemFrame 1 put 20 80 /move 3 index send def /groupdef (Group Defined by :) [ ( box) ( enumeration) ] /Right /notifygroupdefmode can 220 0 /new CycleItem send 20 50 /move 3 index send def /radcorner (Rounded Corner Radius:) (8) /Right /notifyradcorner can 220 0 /new TextItem send 250 50 /move 3 index send def /arrowsize (Arrow Size :) (5) /Right /notifyarrowsize can 165 0 /new TextItem send 250 110 /move 3 index send def /ClickToMove? (Click To Move:) [/panel_check_off /panel_check_on] /Right /notifyclicktomove can 0 0 /new CycleItem send dup /LabelY -4 put 250 80 /move 3 index send def /alphadata (Data :) (arguments) /Right /notifyalphadata can 220 0 /new TextItem send 20 -50 /move 3 index send def /doitbutton (SendIt!) /SendAlphaEvent can 100 0 /new ButtonItem send dup /ItemBorderColor .5 .5 .5 rgbcolor put 130 -90 /move 3 index send def end def /messages items /messages get def /valuemessage items /value get def /errormessage items /errormessage get def } def /slideitem { % items fillcolor item => - gsave dup 4 1 roll % item items fillcolor item /moveinteractive exch send % item /bbox exch send % x y w h (Item: x=%, y=%, w=%, h=% Canvas: w=%, h=%) [ 6 2 roll win begin FrameWidth FrameHeight end ] /printf messages send grestore } def /MakeControlPanel { % Create and size a window. The size is chosen to accommodate the % items we are creating. Right before we map the window, we ask the % user to reshape the window. This is atypical, but gets the items % positioned the way we want them. /controlpanel framebuffer /new MyWindowClass send def { /PaintClient {FillColor fillcanvas items paintitems} def /FrameLabel (NeWSillustrator - Control Panel) def /IconLabel (Control Panel) def /IconImage /galaxy def /ClientMenu [ (set as Default) {setcurrentdisplayparam} (White Background) {/FillColor 1 store /paintclient controlpanel send} (Light Background) {/FillColor .75 store /paintclient controlpanel send} (Medium Background) {/FillColor .50 store /paintclient controlpanel send} (Dark Background) {/FillColor .25 store /paintclient controlpanel send} (Black Background) {/FillColor 0 store /paintclient controlpanel send} ] /new DefaultMenu send def } controlpanel send 30 30 700 350 /reshape controlpanel send /can controlpanel /ClientCanvas get def % Create all the items. createitems % Create event manager to slide around the items. /slidemgr [ items { % key item exch pop dup /ItemCanvas get % item can MiddleMouseButton [items FillColor % item can name [ dict color 6 -1 roll /slideitem cvx] cvx % can name proc DownTransition % can name proc action 4 -1 roll eventmgrinterest % interest } forall ] forkeventmgr def ControlPanelPosition null eq {/reshapefromuser controlpanel send } {ControlPanelPosition aload pop /reshape controlpanel send} ifelse /map controlpanel send /itemmgr items forkitems def } def 1 setlinequality /make_bbox a4rect send %------------------------------------------------------------------------- % Iconic command window or Tool Palette %------------------------------------------------------------------------- (CommandObj Class\n) printdbg /CommandObj Group %a command is a group ; the geom of the group is the icon of the command dictbegin /name null def /ident 0 def %use to identify command in macro /param null def /execproc nullproc def /undoproc {} def /repeatproc {} def /CanBeDefault? false def /kind /Standard def dictend classbegin /new { /new super send begin /CanBeDefault? false def currentdict end } def /display { gsave Sx Sy Angle X Y spos geom {/display exch send} forall grestore } def /execcommand {% /hilite self send pause {ClientCanvas} win send setcanvas execproc RepeatCommand self ne {/LastCommand self store /LastCommand? true store} if /deshilite self send } def /saveivar{% /saveivar super send OSfile (/%) [name] fprintf } def /loadivar{% /name exch def name null ne { CommandDict name self put} if %tool built from macro are not put in the commanddict /loadivar super send } def /saveobject{ OSfile (/new CommandObj send dup AddCommand mark\n) writestring /saveivar self send OSfile ( loadobj\n) writestring OSfile ({\n) writestring OSfile (/kind /% def\n) [kind] fprintf OSfile (/execproc \n) writestring /execproc load print_any OSfile ( def\n) writestring OSfile (/undoproc \n) writestring /undoproc load print_any OSfile ( def\n) writestring OSfile (/repeatproc \n) writestring /repeatproc load print_any OSfile ( def\n) writestring OSfile (/CanBeDefault? % def\n) [CanBeDefault?] fprintf OSfile (} topcom send\n) writestring } def /undo{ undoproc } def /borderpath{% bbox 0 get bbox 1 get moveto -7 -7 rmoveto bbox 2 get bbox 0 get sub 14 add %w bbox 3 get bbox 1 get sub 14 add rect } def /hilite{% when a command is selected, it is highlighted % by drawing a thick rect around it {ClientCanvas} CommandWindow send setcanvas gsave 0 setgray 4 setlinewidth /borderpath self send stroke grestore } def /deshilite{ {ClientCanvas} CommandWindow send setcanvas gsave 1 setgray 4 setlinewidth /borderpath self send stroke grestore } def classend def %/DefaultCommand select_command def /LastCommand null def /LastCommand? false def /CommandDict 100 dict def /CommandTable 100 array def /Ncommand 0 def /AddCommand {% <obj> => - dup CommandTable exch Ncommand exch put %obj begin /ident Ncommand store end /Ncommand Ncommand 1 add store } def (MakeNeWCommand\n) printdbg /NewComDict dictbegin /toolerror {(error: the valid expressions are: (1) (macroname) CallMacro (2) {PScode}) prerror } def /thenewcom null def /itscode null def /theGroup null def dictend def /MakeNewCommand{%makes a command from the current_selection if %it is a group; %ask the place in the tool palette and the code %for its exec proc NewComDict begin current_selection null ne { /getclassname current_selection send /Group eq { /itscode null store current_selection GroupToCommand /thenewcom exch store %ask the code (ok with this code: ) ConfirmText? {%parse it mark get_textstring {token {exch} {exit} ifelse} loop %codearray or (macroname) CallMacro { %case loop %mark {} or mark (name) /CallMacro counttomark 2 gt {toolerror exit} if dup type /nametype eq %macroname CallMacro {(macro call) prmessage dup /CallMacro eq %macroname CallMacro {exec /itscode exch store /itscode load 10 string cvs prvalue thenewcom begin /kind /MacroTool def end} {pop toolerror} ifelse exit} if %codearray dup type /arraytype eq 1 index xcheck and %mark {} {(code array) prmessage /itscode exch store itscode 10 string cvs prvalue exit } if %mark xxx pop } loop %mark -- itscode cleartomark /itscode load null ne {%save it and give position /itscode load thenewcom begin /execproc exch store end PlaceCommand theGroup begin ObjTable tableindex null put end /erase theGroup send (The tool is added) prmessage } {(tool creation aborted) prmessage /Ncommand Ncommand 1 sub store } ifelse } if %Confirm } {(command icons are made from group!!) prerror} ifelse } {(no selected object) prerror} ifelse end } def /PlaceCommand{% thenewcom => - place it on Tool Palette (place the icon in the tool palette -- click with any button) prmessage {ClientCanvas} CommandWindow send createoverlay setcanvas thenewcom begin bbox aload pop end %x1 y1 x2 y2 2 index sub %x1 y1 x2 h exch 3 index sub %x1 y1 h w /X2 exch store /Y2 exch store 0 0 {x y moveto X2 Y2 rect} getanimated waitprocess aload pop %x y thenewcom begin /Y exch store /X exch store end {ClientCanvas} CommandWindow send setcanvas /make_bbox thenewcom send /display thenewcom send {ClientCanvas} win send setcanvas } def /GroupToCommand {%group => command /theGroup exch store /new CommandObj send dup AddCommand /thenewcom exch store theGroup begin bbox X Y Angle geom Ngr end thenewcom begin /Ngr exch store /geom exch store /Angle exch store /Y exch store /X exch store /bbox exch store end thenewcom } def /SaveTools{% save new added tools in a file /saveobjprelude ( mark\n) store {(writing tool file...) prmessage CommandTable FirstUserCommand dup Ncommand exch sub getinterval {/saveobject exch send} forall } GenericSave } def /LoadToolFile{% (Loading tool file ) get_os_filename append ( ??) append Confirm? {get_os_filename LoadFile {(tool file loaded) prmessage pause {ClientCanvas} CommandWindow send setcanvas /PaintClient CommandWindow send } {(in loading) get_os_filename fileerrorpr} ifelse } if } def /DefComProcess null store /MakeDefComProcess{% DefComProcess null eq {/DefComProcess { newprocessgroup {/execcommand DefaultCommand send pause} loop } fork store pause } if } def /KillDefComProcess{ DefComProcess null ne { pause DefComProcess killprocessgroup pause /DefComProcess null store pause} if } def (Command Window\n) printdbg
bernard@prlb2.UUCP (Bernard Yves) (01/27/89)
%--------------------------------------------------------------------------------
/ConfirmText? {%message => bool
get_textstring append ( ??) append Confirm?
} def
/CommandWinMenu
[
(Redisplay) {/PaintClient CommandWindow send pause
/PaintClient win send pause
KillDefComProcess}
(Zoom In) {/ZoomIn win send}
(Zoom Out) {/ZoomOut win send}
(----) {}
(Font => ) fontmenu
(FontSize => ) pointsizemenu
(Files => ) filemenu
(----) {}
(Make Tool) {MakeNewCommand}
] /new DefaultMenu send def
/MakeCommandWindow {
/CommandWindow framebuffer /new MyWindowClass send def
{ /PaintClient {
ClientCanvas setcanvas
1 fillcanvas
CommandTable 0 Ncommand getinterval
{/display exch send} forall
pause pause
DefaultCommand null ne {/hilite DefaultCommand send} if
} def
/ClientMenu CommandWinMenu def
/FrameLabel (NeWSillustrator - Tools Palette) def
/IconLabel (Tools) def
} CommandWindow send
ToolPalettePosition null eq
{/reshapefromuser CommandWindow send}
{ToolPalettePosition aload pop /reshape CommandWindow send} ifelse
/map CommandWindow send
{ClientCanvas} CommandWindow send setcanvas
% Create event manager to select command.
/selectmgr
[
LeftMouseButton %a new command is selected
{
KillDefComProcess
select_command %exec the selected com
/hilite DefaultCommand send
MakeDefComProcess}
DownTransition
{ClientCanvas} CommandWindow send
eventmgrinterest % interest
MiddleMouseButton %a new command is selected as default
{
KillDefComProcess
select_command
LastCommand null ne LastCommand? and
{LastCommand /CanBeDefault? get
{/DefaultCommand LastCommand store} if } if
/hilite DefaultCommand send
MakeDefComProcess
}
DownTransition
{ClientCanvas} CommandWindow send
eventmgrinterest % interest
] forkeventmgr def
pause
MakeDefComProcess
pause
} def
/select_command{ %the event is in CurrentEvent
CurrentEvent
begin XLocation YLocation end %x y of click
find_command dup null ne %command
{/deshilite DefaultCommand send
/execcommand exch send
}
{pop} ifelse
} def
/foundcommand null def
/find_command{% x y => command | null;
%if found, the command is highlited
/foundcommand null store
CommandTable 0 Ncommand getinterval
{%x y com
3 copy %x y com x y com
/is_in_obj exch send
{/foundcommand exch store exit}
{pop} ifelse
} forall pop pop
foundcommand null ne
{
LastCommand null ne LastCommand? and
{/deshilite LastCommand send} if
/hilite foundcommand send} if
foundcommand
} def
%------------------------------------------------------------------------
% alphanumeric input of tool arguments
%high-level event ; the value - coord, angle or scale factors
%will be in /ClientData
%the followint event types (Name) are recorded in macro
% /Command, /AlphaEvent (action /Point /Move /Rotate /Scale /String /Stop)
% /Param, /Dparam
% these events are stored as 3 dict begin /Name /Action /ClientData end
(alphanum input\n) printdbg
/MakeEventToRecord{% data action name => myevent
3 dict dup begin %data action name ev
4 1 roll
/Name exch def
/Action exch def
/ClientData exch def
end
} def
/MakeEventToSend{% data action name => NeWS event
createevent dup begin %data action name ev
4 1 roll
/Name exch def
/Action exch def
/ClientData exch def
end
} def
/PointEvent null /Point /AlphaEvent MakeEventToSend def
/MoveEvent null /Move /AlphaEvent MakeEventToSend def %
/RotateEvent null /Rotate /AlphaEvent MakeEventToSend def
/ScaleEvent null /Scale /AlphaEvent MakeEventToSend def
/WaitForEvent PointEvent def
/ParseDataDict dictbegin
/argarray 10 array def
/argtop 0 def
/iarg 0 def
/GoodType {% /type1 /type2
exch dup /num eq
{%/type2 /num
pop dup /integertype eq exch /realtype eq or}
{eq} ifelse
} def
dictend def
/DataFormat null def
/ParseData{ % string => argument bool
% true if the string contains an argument compatible
% with the DataFormat
ParseDataDict begin
/argtop 0 store
{token
{% post token
dup type %post token t
dup /integertype eq exch %post token ib t
/realtype eq or %post token b
{argarray exch argtop exch put
/argtop argtop 1 add store %post
} {exit} ifelse %post
}
{exit} ifelse
} loop
/iarg 0 store
DataFormat
{% type
argarray iarg get type GoodType {/iarg iarg 1 add store}
{/iarg -1 store exit}
ifelse
} forall
iarg -1 eq
{false}
{ iarg 1 eq {argarray 0 get}
{[ argarray 0 iarg getinterval aload pop ]} ifelse
true} ifelse
end
} def
/SendAlphaEvent {% reads the string in the CP data item
% and sends as an AlphaEvent it if matches the awaited event
items begin alphadata /ItemValue get end
WaitForEvent /Action get /Rotate eq
{/DataFormat [/num] store}
{/DataFormat [/num /num] store} ifelse
ParseData
{% data
WaitForEvent begin Action Name end
MakeEventToSend sendevent pause
}
{(data do not match awaited event) prerror}
ifelse
} def
/RecordEvents? false def
%-------------------------------------------------------------------------
%Tool definition
%-----------------------------------------------------------------------
(Tool Definition\n) printdbg
/topcom {CommandTable Ncommand 1 sub get} def
%Select
/new CommandObj send dup AddCommand mark
11 537.88 1 1 0 [ 11 537.88 44 571.376 ]
-1 0 0 0 0 0
[ %group geometry
/new Polyline send mark
0 32.928 1 1 0 [ 0 0 31.4561 32.928 ]
-1 5 0 0 0 0
[ %polyg. geom
[ 31.4561 -32.928 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
0 21.006 1 1 0 [ 0 21.006 10.847 33.496 ]
-1 5 0 0 0 0
[ %polyg. geom
[ 0 12.49 ] [ 10.847 12.49 ] ] %end of polyg. geom
true 2 false 0 false false loadobj
] %end of group geometry
false 2 /Select loadobj
{
/CanBeDefault? true def
/execproc { select_object
} def
} topcom send
/DefaultCommand topcom def
%Rect
/new CommandObj send dup AddCommand mark
11 480.54 1 1 0 [ 11 480.54 45.168 512.9002 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 32.3602 1 1 0 [ 0 0 34.168 32.3602 ]
-1 0 0 0 0 0
[ 34.168 -32.3602 ]
true loadobj
] %end of group geometry
false 1 /Rectangle loadobj
{
/execproc {
DrawObject create_object
} def
/CanBeDefault? true def
} topcom send
%Line
/new CommandObj send dup AddCommand mark
11 420.929 1 1 0 [ 11 420.929 45.168 460.102 ]
-1 0 0 0 0 0
[ %group geometry
/new Polyline send mark
0 39.173 1 1 0 [ 0 0 34.168 39.173 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 7.051 -33.496 ] [ 16.813 -10.219 ] [ 34.168 -39.173 ] ] %end of polyg. geom
true 3 false 0 false false loadobj
] %end of group geometry
false 1 /Polyline loadobj
{
/CanBeDefault? true def
/execproc {
Polyline create_object
} def} topcom send
%Polygon
/new CommandObj send dup AddCommand mark
11 364.724 1 1 0 [ 11 364.724 45.7102 403.3291 ]
-1 0 0 0 0 0
[ %group geometry
/new Polyline send mark
0 38.6051 1 1 0 [ 0 0 34.7102 38.6051 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 9.22 -38.6051 ] [ 34.7102 -28.3861 ] [ 20.6091 -13.058 ] [ 34.168 -1.703 ] ] %end of polyg. geom
true 4 true 0 false false loadobj
] %end of group geometry
false 1 /Polygon loadobj
{
/CanBeDefault? true def
/execproc {Polyline create_object
current_selection null ne
{current_selection begin /Closed true store end
/display current_selection send} if
} def} topcom send
%Curve
/new CommandObj send dup AddCommand mark
11 301.139 1 1 0 [ 11 301.139 47.337 348.26 ]
-1 0 0 0 0 0
[ %group geometry
/new Curve send mark
0 47.121 1 1 0 [ 0 0 36.337 47.121 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 2.216 -19.8403 ] [ 11.5213 -29.761 ] [ 19.498 -20.4603 ] [ 25.259 -11.1601 ] [ 32.792 -17.3602 ] [ 36.337 -47.121 ] ] %end of polyg. geom
true 6 false 0 false false loadobj
] %end of group geometry
false 1 /Curve loadobj
{/CanBeDefault? true def
/execproc {
Curve create_object
} def} topcom send
%RoundedRect
/new CommandObj send dup AddCommand mark
11 252.3141 1 1 0 [ 11 252.3141 45.7102 290.3521 ]
-1 0 0 0 0 0
[ %group geometry
/new RoundedRect send mark
0 38.038 1 1 0 [ 0 0 34.7102 38.038 ]
-1 0 0 0 0 0
[ 34.7102 -38.038 ]
true 14 loadobj
] %end of group geometry
false 1 /RoundRect loadobj
{/CanBeDefault? true def
/execproc {RoundedRect create_object} def } topcom send
%Oval
/new CommandObj send dup AddCommand mark
11 191 1 1 0 [ 11 191 45.7102 232.444 ]
-1 0 0 0 0 0
[ %group geometry
/new Oval send mark
0 41.444 1 1 0 [ 0 0 34.7102 41.444 ]
-1 0 0 0 0 0
[ 34.7102 -41.444 ]
true loadobj
] %end of group geometry
false 1 /Oval loadobj
{/CanBeDefault? true def
/execproc {Oval create_object} def} topcom send
%Text
/new CommandObj send dup AddCommand mark
11 129 1 1 0 [ 11 129 58 174 ]
-1 0 0 0 0 0
[ %group geometry
/new TextObject send mark
7 13 0.578 0.585 0 [ 7 13 39.3673 25.287 ]
0 0 0 0 0 0
(Text)
true /Times-Roman 30 21 56 loadobj
/new DrawObject send mark
0 45 1 1 0 [ 0 0 47 45 ]
-1 0 0 0 0 0
[ 47 -45 ]
true loadobj
] %end of group geometry
false 2 /Text loadobj
{/CanBeDefault? true def
/execproc {TextObject create_object
} def} topcom send
%Group
/new CommandObj send dup AddCommand mark
11 71.488 1 1 0 [ 11 71.488 48.572 115.3771 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
0 0 1 1 0 [ 0 0 37.572 43.8891 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0.578 43.8891 1 1 0 [ 0.578 32.1853 10.983 43.8891 ]
-1 0 0 0 0 0
[ 10.405 -11.704 ]
true loadobj
/new Polyline send mark
13.295 17.556 1 1 0 [ 13.295 17.556 29.48 31.015 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 16.185 0 ] [ 5.7802 13.4592 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new Oval send mark
24.8553 11.704 1 1 0 [ 24.8553 0 37.572 11.704 ]
-1 0 0 0 0 0
[ 12.717 -11.704 ]
true loadobj
/new DrawObject send mark
0 43.8891 1 1 0 [ 0 0 37.572 43.8891 ]
-1 0 0 1 0 0
[ 37.572 -43.8891 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /Group loadobj
{/CanBeDefault? true def
/execproc {Group create_object} def } topcom send
%ImportPS
/new CommandObj send dup AddCommand mark
11 13 1 1 0 [ 11 13 59 56 ]
-1 0 0 0 0 0
[ %group geometry
/new TextObject send mark
12 14 0.578 0.585 0 [ 12 14 31.074 26.8721 ]
0 0 0 0 0 0
(PS)
true /Times-Roman 30 22 33 loadobj
/new DrawObject send mark
0 43 1 1 0 [ 0 0 48 43 ]
-1 0 0 0 0 0
[ 48 -43 ]
true loadobj
] %end of group geometry
false 2 /ImportPS loadobj
{
/execproc {PostScript create_object} def} topcom send
%Move
/new CommandObj send dup AddCommand mark
83 531.265 1 1 0 [ 83 531.265 127.694 571.861 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
23 18.735 1 1 0 [ 23 0 44.694 18.735 ]
-1 0 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
/new DrawObject send mark
0 40.596 1 1 0 [ 0 21.861 21.694 40.596 ]
-1 3 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
] %end of group geometry
false 2 /Move loadobj
{
/execproc {/crosshair? true def
/drag_and_trans fapply_on_sel
/crosshair? false def
/commandswitch [/ClickToMove? ClickToMove?] store
} def
} topcom send
%Rotate
/new CommandObj send dup AddCommand mark
83 477.051 1 1 0 [ 83 477.051 111.647 510.517 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 18.735 1 1 0 [ 0 0 21.694 18.735 ]
-1 3 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
/new DrawObject send mark
0 18.735 1 1 42.7681 [ 0 4.982 28.647 33.466 ]
-1 0 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
] %end of group geometry
false 2 /Rotate loadobj
{
/execproc {/drag_and_rotate fapply_on_sel} def
} topcom send
%Scale
/new CommandObj send dup AddCommand mark
83 418.0071 1 1 0 [ 83 418.0071 122.592 456.6123 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 38.6051 1 1 0 [ 0 19.8702 21.694 38.6051 ]
-1 3 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
/new DrawObject send mark
0 38.038 1 1 0 [ 0 0 39.592 38.038 ]
-1 0 0 0 0 0
[ 39.592 -38.038 ]
true loadobj
] %end of group geometry
false 2 /Scale loadobj
{
/execproc {/drag_and_scale fapply_on_sel} def
} topcom send
%Copy
/new CommandObj send dup AddCommand mark
83 359.265 1 1 0 [ 83 359.265 129.694 402.111 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 42.846 1 1 0 [ 0 24.111 21.694 42.846 ]
-1 3 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
/new DrawObject send mark
25 18.735 1 1 0 [ 25 0 46.694 18.735 ]
-1 3 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
] %end of group geometry
false 2 /Copy loadobj
{
/param dictbegin /xr 0 def /yr 0 def dictend store
/execproc {{
/old_selection current_selection store
/current_selection /clone current_selection send store
/erase_flag false store /crosshair? true store
/drag_and_trans current_selection send
/crosshair? false store
/erase_flag true store
Abort? {/current_selection old_selection store}
{current_selection AddObject
current_selection push_selection
param begin
/xr current_selection /X get old_selection /X get sub store
/yr current_selection /Y get old_selection /Y get sub store
end} ifelse
} apply_on_sel} def
/repeatproc {{
/old_selection current_selection store
/current_selection /clone current_selection send store
current_selection begin /X X param /xr get add store
/Y Y param /yr get add store
end
/make_bbox current_selection send
/display current_selection send
Cancel? {
/erase current_selection send
/current_selection old_selection store
}
{current_selection AddObject
current_selection push_selection
} ifelse
} apply_on_sel} def
} topcom send
%Move Up
/new CommandObj send dup AddCommand mark
82 295.2652 1 1 0 [ 82 295.2652 127 346.0002 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
12 32.735 1 1 0 [ 12 0 45 32.735 ]
0.5 0 0 0 0 0
[ 33 -32.735 ]
true loadobj
/new DrawObject send mark
0 50.735 1 1 0 [ 0 18 33 50.735 ]
-1 3 0 0 0 0
[ 33 -32.735 ]
true loadobj
] %end of group geometry
false 2 /MoveUp loadobj
{
/execproc {{
current_selection move_up
dup null ne {/display exch send
/display current_selection send}
{(no overlapping object over selection)
prmessage} ifelse
} apply_on_sel
} def
} topcom send
%Move Down
/new CommandObj send dup AddCommand mark
79 241.2652 1 1 0 [ 79 241.2652 126 290.0002 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 48.735 1 1 0 [ 0 16 33 48.735 ]
-1 3 0 0 0 0
[ 33 -32.735 ]
true loadobj
/new DrawObject send mark
14 32.735 1 1 0 [ 14 0 47 32.735 ]
0.5 0 0 0 0 0
[ 33 -32.735 ]
true loadobj
] %end of group geometry
false 2 /MoveDown loadobj
{
/execproc {{
current_selection move_down
dup null ne {/display current_selection send
/display exch send}
{(no overlapping object behind selection)
prmessage} ifelse
} apply_on_sel
} def
} topcom send
%Delete
/new CommandObj send dup AddCommand mark
83 190.974 1 1 0 [ 83 190.974 119.3373 228.444 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
8 29.026 1 1 0 [ 8 10.291 29.694 29.026 ]
-1 3 0 0 0 0
[ 21.694 -18.735 ]
true loadobj
/new Polyline send mark
0 37.47 1 1 0 [ 0 1.703 36.3373 37.47 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 36.3373 -35.767 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
0 0 1 1 0 [ 0 0 33.0832 37.47 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 33.0832 37.47 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
] %end of group geometry
false 3 /Delete loadobj
{
/param 10 dict def
/execproc { param begin /deleted null def end
{
/delete current_selection send
param begin /deleted current_selection def end
pop_selection} apply_on_sel} def
/undoproc {
{ClientCanvas} win send setcanvas
param begin
deleted null ne
{
/getclassname deleted send /Group eq
/getclassname deleted send /ClippingGroup eq or
{ gsave deleted begin /X 0 store /Y 0 store
/Angle 0 store /Sx 1 store /Sx 1 store geom end
/set_geom deleted send
grestore} if
gsave
/display deleted send
/current_selection deleted store
DeleteFreeEntries
current_selection /tableindex get ObjTable exch
current_selection put
current_selection push_selection
grestore
} if
end
} def
} topcom send
%Destroy
/new CommandObj send dup AddCommand mark
83 122.086 1 1 0 [ 83 122.086 129.243 172.998 ]
-1 0 0 0 0 0
[ %group geometry
/new Polyline send mark
0 28.914 1 1 0 [ 0 17.914 14 28.914 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 14 -11 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new DrawObject send mark
0 46.815 1 1 0 [ 0 35.111 10.405 46.815 ]
-1 3 0 0 0 0
[ 10.405 -11.704 ]
true loadobj
/new Polyline send mark
0 20.482 1 1 0 [ 0 20.482 16.185 33.9412 ]
-1 3 0 0 0 0
[ %polyg. geom
[ 16.185 0 ] [ 5.7802 13.4592 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new Oval send mark
0 14.63 1 1 0 [ 0 2.926 12.717 14.63 ]
-1 3 0 0 0 0
[ 12.717 -11.704 ]
true loadobj
/new DrawObject send mark
0 46.815 1 1 0 [ 0 2.926 37.5721 46.815 ]
-1 3 0 1 0 0
[ 37.572 -43.8891 ]
true loadobj
/new Polyline send mark
0 50.912 1 1 0 [ 0 0 46.243 50.912 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 46.243 -50.912 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
0 0 1 1 0 [ 0 0 46.243 49.741 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 46.243 49.741 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
16.185 48.805 1 1 0 [ 0 32.42 16.185 48.805 ]
-1 0 0 0 0 0
[ %polyg. geom
[ -16.185 -16.3852 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
0 15.449 1 1 0 [ 0 1.404 13.873 15.449 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 13.873 -14.045 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
0 0.8191 1 1 0 [ 0 0.8191 15.029 14.8641 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.029 14.045 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
/new Polyline send mark
0 16.914 1 1 0 [ 0 16.914 15 31.914 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15 15 ] ] %end of polyg. geom
true 1 false 0 false false loadobj
] %end of group geometry
false 11 /Destroy loadobj
{
/param 10 dict def
/undoproc {
{ClientCanvas} win send setcanvas
param begin
deleted null ne
{ %the table entry may not be the same
/getclassname deleted send /Group eq
/getclassname deleted send /ClippingGroup eq or
{
/undestroy deleted send
/display deleted send
/current_selection deleted store
DeleteFreeEntries
current_selection /tableindex get ObjTable exch
current_selection put
current_selection push_selection
} if
} if
end
} def
/execproc { param begin /deleted null def end
{
param begin /deleted current_selection def end
/destroy current_selection send
pop_selection} apply_on_sel
} def
} topcom send
%Edit
/new CommandObj send dup AddCommand mark
83 66.552 1 1 0 [ 83 66.552 121.1501 104.589 ]
-1 0 0 0 0 0
[ %group geometry
/new Polyline send mark
0 38.037 1 1 0 [ 0 0.585 28.902 38.037 ]
-1 3 0 0 0 0
[ %polyg. geom
[ 7.677 -37.452 ] [ 28.902 -27.538 ] [ 17.1602 -12.6673 ] [ 28.45 -1.6521 ] ] %end of polyg. geom
true 4 true 0 false false loadobj
/new Polyline send mark
0 37.452 1 1 0 [ 0 0 38.1501 37.452 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 7.677 -37.452 ] [ 38.1501 -12.874 ] [ 17.1602 -12.6673 ] [ 28.45 -1.6521 ] ] %end of polyg. geom
true 4 true 0 false false loadobj
] %end of group geometry
false 2 /Edit loadobj
{
/execproc {/edit_geom fapply_on_sel} def
} topcom send
%Clip
/new CommandObj send dup AddCommand mark
83 3 1 1 0 [ 83 3 121.728 51.571 ]
-1 0 0 0 0 0
[ %group geometry
/new Curve send mark
0 48.571 1 1 0 [ 0 0 38.728 48.571 ]
-1 5 0 0 0 0
[ %polyg. geom
[ 2.3613 -20.451 ] [ 12.28 -30.676 ] [ 20.781 -21.09 ] [ 26.9203 -11.504 ] [ 34.9493 -17.8943 ] [ 38.728 -48.571 ] ] %end of polyg. geom
true 6 false 0 false false loadobj
/new ClippingGroup send mark
0 5.267 1 1 0 [ 0 5.267 36.994 47.986 ]
-1 0 0 0 0 0
[ %group geometry
/new Oval send mark
0 42.719 1 1 0 [ 0 0 36.994 42.719 ]
1 0 0 0 0 0
[ 36.994 -42.719 ]
true loadobj
/new Curve send mark
-2.312 43.304 1 1 0 [ -2.312 -5.267 36.416 43.304 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 2.3613 -20.451 ] [ 12.28 -30.676 ] [ 20.781 -21.09 ] [ 26.9203 -11.504 ] [ 34.9493 -17.8943 ] [ 38.728 -48.571 ] ] %end of polyg. geom
true 6 false 0 false false loadobj
] %end of group geometry
true 2 loadobj
] %end of group geometry
false 2 /Clip loadobj
{
/execproc {{make_clip current_selection send} fapply_on_sel} def
} topcom send
%Align Left
/new CommandObj send dup AddCommand mark
155 530.2944 1 1 0 [ 155 530.2944 190.253 572.8742 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
0 0 1 1 0 [ 0 0 35.253 42.58 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 42.58 1 1 0 [ 0 31.225 9.7622 42.58 ]
-1 0 0 0 0 0
[ 9.7621 -11.355 ]
true loadobj
/new Polyline send mark
0 17.033 1 1 0 [ 0 17.033 15.186 30.091 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.186 0 ] [ 5.4233 13.058 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new Oval send mark
0 11.355 1 1 0 [ 0 0 11.932 11.355 ]
-1 0 0 0 0 0
[ 11.932 -11.355 ]
true loadobj
/new DrawObject send mark
0 42.58 1 1 0 [ 0 0.001 35.253 42.58 ]
-1 0 0 1 0 0
[ 35.253 -42.5792 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /AlignLeft loadobj
{
/execproc {{/align_left self send} align_op} def
} topcom send
%A Bottom
/new CommandObj send dup AddCommand mark
155.0002 473.9692 1 1 0 [ 155.0002 473.9692 197.679 509.343 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
42.679 0.121 1 1 90.163 [ 0 0 42.679 35.3732 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0 42.5792 1 1 0 [ 0 31.225 9.7621 42.5792 ]
-1 0 0 0 0 0
[ 9.7621 -11.355 ]
true loadobj
/new Polyline send mark
0 17.032 1 1 0 [ 0 17.032 15.186 30.0893 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.186 0 ] [ 5.4233 13.058 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new Oval send mark
0 11.3543 1 1 0 [ 0 0 11.932 11.355 ]
-1 0 0 0 0 0
[ 11.932 -11.355 ]
true loadobj
/new DrawObject send mark
0 42.5792 1 1 0 [ 0 0 35.253 42.5792 ]
-1 0 0 1 0 0
[ 35.253 -42.5792 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /AlignBottom loadobj
{
/execproc {{/align_bottom self send} align_op} def
} topcom send
%A Right
/new CommandObj send dup AddCommand mark
155 414.479 1 1 0 [ 155 414.479 190.253 457.0582 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
0 0 1 1 0 [ 0 0 35.253 42.5792 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
25.4903 42.5792 1 1 0 [ 25.4903 31.225 35.253 42.5792 ]
-1 0 0 0 0 0
[ 9.7621 -11.355 ]
true loadobj
/new Polyline send mark
20.067 17.032 1 1 0 [ 20.067 17.032 35.253 30.0893 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.186 0 ] [ 5.4233 13.058 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new Oval send mark
23.321 11.3543 1 1 0 [ 23.321 0 35.253 11.355 ]
-1 0 0 0 0 0
[ 11.932 -11.355 ]
true loadobj
/new DrawObject send mark
0 42.5792 1 1 0 [ 0 0 35.253 42.5792 ]
-1 0 0 1 0 0
[ 35.253 -42.5792 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /AlignRight loadobj
{
/execproc {{/align_right self send} align_op} def
} topcom send
%A Top
/new CommandObj send dup AddCommand mark
155 359.289 1 1 0 [ 155 359.289 197.679 395.855 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
0 0 1 1 0 [ 0 0 42.679 36.566 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0.1 0 1 1 90.163 [ 0 0 42.679 35.373 ]
-1 0 0 1 0 0
[ 35.253 -42.5792 ]
true loadobj
/new Oval send mark
29.929 24.5002 1 1 90.163 [ 29.895 24.5003 41.283 36.464 ]
-1 0 0 0 0 0
[ 11.932 -11.355 ]
true loadobj
/new Polyline send mark
24.5053 21.1262 1 1 90.163 [ 11.433 21.1262 24.5053 36.312 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.186 0 ] [ 5.4233 13.058 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new DrawObject send mark
0.1 26.7711 1 1 90.163 [ 0.0722 26.7711 11.4542 36.566 ]
-1 0 0 0 0 0
[ 9.7621 -11.355 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /AlignTop loadobj
{
/execproc {{/align_top self send} align_op} def
} topcom send
%C vert
/new CommandObj send dup AddCommand mark
155 299.7983 1 1 0 [ 155 299.7983 190.253 342.378 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
0 0 1 1 0 [ 0 0 35.253 42.5792 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
12.7451 42.5792 1 1 0 [ 12.7451 31.225 22.5073 42.5792 ]
-1 0 0 0 0 0
[ 9.7621 -11.355 ]
true loadobj
/new Polyline send mark
10.0333 17.032 1 1 0 [ 10.0333 17.032 25.2191 30.0893 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.186 0 ] [ 5.4233 13.058 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new Oval send mark
11.661 11.3543 1 1 0 [ 11.6603 0 23.592 11.355 ]
-1 0 0 0 0 0
[ 11.932 -11.355 ]
true loadobj
/new DrawObject send mark
0 42.5792 1 1 0 [ 0 0 35.253 42.5792 ]
-1 0 0 1 0 0
[ 35.253 -42.5792 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /CenterV loadobj
{
/execproc {{/center_vertical self send} align_op} def
} topcom send
%C hor
/new CommandObj send dup AddCommand mark
155 247 1 1 0 [ 155 247 197.679 282.373 ]
-1 0 0 0 0 0
[ %group geometry
/new Group send mark
0 0 1 1 0 [ 0 0 42.679 35.373 ]
-1 0 0 0 0 0
[ %group geometry
/new DrawObject send mark
0.1 0 1 1 90.163 [ 0 0 42.679 35.373 ]
-1 0 0 1 0 0
[ 35.253 -42.5792 ]
true loadobj
/new Oval send mark
29.929 12.25 1 1 90.163 [ 29.895 12.2501 41.283 24.214 ]
-1 0 0 0 0 0
[ 11.932 -11.355 ]
true loadobj
/new Polyline send mark
24.5053 10.563 1 1 90.163 [ 11.433 10.563 24.5053 25.749 ]
-1 0 0 0 0 0
[ %polyg. geom
[ 15.186 0 ] [ 5.4233 13.058 ] ] %end of polyg. geom
true 2 true 0 false false loadobj
/new DrawObject send mark
0.1 13.386 1 1 90.163 [ 0.0722 13.386 11.4542 23.18 ]
-1 0 0 0 0 0
[ 9.7621 -11.355 ]
true loadobj
] %end of group geometry
true 4 loadobj
] %end of group geometry
false 1 /CenterH loadobj
{
/execproc {{/center_horizontal self send} align_op} def
} topcom send
%repeat
/new CommandObj send dup AddCommand mark
152 187 1 1 0 [ 152 187 205 234 ]
-1 0 0 0 0 0
[ %group geometry
/new TextObject send mark
2 20 0.6 1.0024 0 [ 2 20 52.3723 41.051 ]
0 0 0 0 0 0
(Repeat)
true /Times-Roman 30 21 84 loadobj
/new DrawObject send mark
0 47 1 1 0 [ 0 0 53 47 ]
-1 0 0 0 0 0
[ 53 -47 ]
true loadobj
] %end of group geometry
false 2 /Repeat loadobj
{
/execproc{
LastCommand null ne
{LastCommand? %a command
{/repeatproc LastCommand send}
{/execmacro LastCommand send} ifelse
} if
} def} topcom send
/RepeatCommand topcom def
%Undo
/new CommandObj send dup AddCommand mark
152 126 1 1 0 [ 152 126 205 173 ]
-1 0 0 0 0 0
[ %group geometry
/new TextObject send mark
2 16.7373 0.732 0.9184 0 [ 2 16.7373 51.777 36.944 ]
0 0 0 0 0 0
(Undo)
true /Times-Roman 30 22 68 loadobj
/new DrawObject send mark
0 47 1 1 0 [ 0 0 53 47 ]
-1 0 0 0 0 0
[ 53 -47 ]
true loadobj
] %end of group geometry
false 2 /Undo loadobj
{
/execproc {
LastCommand null ne
{ {undoproc} LastCommand send } if } def
} topcom send
%redefines that in your .NeWSillustrator to [x y w h]
/ControlPanelPosition null def
/DrawingAreaPosition null def
/ToolPalettePosition null def
/WindowPositions{%print in the message panel the 3 windows position
(CP: % % % %, DA: % % % %, TP: % % % %)
[{FrameX FrameY FrameWidth FrameHeight} controlpanel send
{FrameX FrameY FrameWidth FrameHeight} win send
{FrameX FrameY FrameWidth FrameHeight} CommandWindow send
] sprintf prmessage
} def
(Window definition \n) printdbg
/WinMenu [
(Redisplay) {/PaintClient ThisWindow send}
(Zoom In) {/ZoomIn ThisWindow send}
(Zoom Out) {/ZoomOut ThisWindow send}
(Font => ) fontmenu
(FontSize => ) pointsizemenu
(Files IO => ) filemenu
(-------) { }
] /new DefaultMenu send def
/win framebuffer /new ScrollAndZoomWindow send def
{
/PaintClient
{
ClientCanvas setcanvas 1 fillcanvas
/display a4rect send
RepaintAll
} def
/FrameLabel (NeWSillustrator - Drawing Area) def
/IconLabel (Drawing Area) def
/ClientMenu WinMenu def
} win send
%user file
(.NeWSillustrator\n) printdbg
(HOME) getenv (/.NeWSillustrator) append LoadFile pop
MakeControlPanel
DrawingAreaPosition null eq
{/reshapefromuser win send}
{ DrawingAreaPosition aload pop /reshape win send} ifelse
/map win send
1000 1000 /Resize win send
{/Scroll win send} {/Scroll win send} /SetNotifiers win send
win /ClientCanvas get setcanvas
win begin /overlaycan ClientCanvas createoverlay store end
MakeCommandWindow
/Started 1 def
/FirstUserCommand Ncommand def
%end %end NeWSillustratorDicttktk@physics.att.com (09/04/89)
Does anyone have a good copy of the NeWSillustrator by Yves Bernard, Philips Research Lab Brussels? It seems that pieces of mine may have gotten trashed in transit. In any case my documentation is truncated. Has anyone converted it to color? Terry Kovacs tktk@physics.att.com