Path: utzoo!attcan!uunet!mcvax!prlb2!bernard From: bernard@prlb2.UUCP (Bernard Yves) Newsgroups: comp.windows.news Subject: NeWSillustrator (part 1) Keywords: ... Message-ID: <519@prlb2.UUCP> Date: 5 Jan 89 14:33:57 GMT Organization: Philips Research Laboratory, Brussels Lines: 1306 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 {% => - 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 } def /change_geom {%change geometry; => - %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 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.uucp