Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!ames!amdcad!sun!pitstop!sundc!seismo!uunet!mcvax!prlb2!bernard From: bernard@prlb2.UUCP (Bernard Yves) Newsgroups: comp.windows.news Subject: NeWSillustrator (part 3 of 5) Message-ID: <528@prlb2.UUCP> Date: 27 Jan 89 13:23:20 GMT Organization: Philips Research Laboratory, Brussels Lines: 1232 %----------------------------------------------------------------------------- {/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} if