#!/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. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Date: Thu, 12 Jan 89 11:17:06 EST % To: NeWS-makers@brillig.umd.edu % Subject: Printing NeWSIllustrator PostScript Files % From: sgi!ciemo%bananapc.SGI.COM@ucbvax.Berkeley.EDU (Dave Ciemiewicz) % % Silicon Graphics (and I believe Sun) uses Adobe's TranScript software for % printing text on PostScript printers like the Apple LaserWriter. To print % the files generated by Bernard Yves NeWSIllustrator, I've had to add '%!' % PostScript magic number to the files by hand. To quote the Red Book % (PostScript Language Reference Manual, p. 265, Comment Conventions), % % The very first line of every PostScript program (whether it % is conforming or nonconforming) should be a comment that begins % with the characters `%!'. % % By adding the line in the contextual illustrated in the contextual diff below, % NeWSIllustrator will now generate PostScript files with the '%!' magic number % allowing users to do things (on SGI boxes) like "lp ps0". % % *** Old stuff % --- New lines with magic number code (don't forget to remove the '+' character) % *************** % *** 302,307 % % % /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 % % --- 302,308 ----- % % % /PrintPS_header{ %postscript utilities % + PSfile (%!\n) writestring % PostScript header magic number % PSfile % (/rect {dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath } def % /ovalpath { matrix currentmatrix 5 1 roll % *************** % -- % % ciemo (pronounced SEE-MO) "Language is a virus" % Ciemiewicz (pronounced SI-MI-WITZ) --- Laurie Anderson % Dave (pronounced DAYV) % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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 {% => - 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 PSfile (%!\n) writestring % PostScript header magic number %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 } 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 /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 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) 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 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 } 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 a procedure / 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{ } 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 () /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 () /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 () /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 {% => - 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 /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 NeWSillustratorDict