#!/usr/NeWS/bin/psh systemdict /Item known not { (NeWS/liteitem.ps) run } if 200 dict begin /notify? true def /notify { notify? {(Notify: Value=%) [ItemValue] /printf messages send} if } def /FillColor .75 def /createitems { /items 100 dict dup begin /warpbutton (Warp!) /warpit control-can 100 0 /new ButtonItem send dup /ItemBorderColor .5 .5 .5 rgbcolor put 10 10 /move 3 index send def /messages /panel_text () /Right {} control-can 500 0 /new MessageItem send dup begin /ItemFrame 1 def /ItemBorder 4 def end 120 15 /move 3 index send def /rowslider0 (row 0:) [0 100 100] /Left {warprows 0 ItemValue put} control-can 200 20 /new SliderItem send 10 60 /move 3 index send def /rowslider1 (row 1:) [0 100 100] /Left {warprows 1 ItemValue put} control-can 200 20 /new SliderItem send 10 100 /move 3 index send def /rowslider2 (row 2:) [0 100 100] /Left {warprows 2 ItemValue put} control-can 200 20 /new SliderItem send 10 140 /move 3 index send def /rowslider3 (row 3:) [0 100 100] /Left {warprows 3 ItemValue put} control-can 200 20 /new SliderItem send 10 180 /move 3 index send def /rowslider4 (row 4:) [0 100 100] /Left {warprows 4 ItemValue put} control-can 200 20 /new SliderItem send 10 220 /move 3 index send def /rowslider5 (row 5:) [0 100 100] /Left {warprows 5 ItemValue put} control-can 200 20 /new SliderItem send 10 260 /move 3 index send def /rowslider6 (row 6:) [0 100 100] /Left {warprows 6 ItemValue put} control-can 200 20 /new SliderItem send 10 300 /move 3 index send def /rowslider7 (row 7:) [0 100 100] /Left {warprows 7 ItemValue put} control-can 200 20 /new SliderItem send 10 340 /move 3 index send def /colslider0 (col 0:) [0 100 100] /Left {warpcolumns 0 ItemValue put} control-can 200 20 /new SliderItem send 250 340 /move 3 index send def /colslider1 (col 1:) [0 100 100] /Left {warpcolumns 1 ItemValue put} control-can 200 20 /new SliderItem send 250 300 /move 3 index send def /colslider2 (col 2:) [0 100 100] /Left {warpcolumns 2 ItemValue put} control-can 200 20 /new SliderItem send 250 260 /move 3 index send def /colslider3 (col 3:) [0 100 100] /Left {warpcolumns 3 ItemValue put} control-can 200 20 /new SliderItem send 250 220 /move 3 index send def /colslider4 (col 4:) [0 100 100] /Left {warpcolumns 4 ItemValue put} control-can 200 20 /new SliderItem send 250 180 /move 3 index send def /colslider5 (col 5:) [0 100 100] /Left {warpcolumns 5 ItemValue put} control-can 200 20 /new SliderItem send 250 140 /move 3 index send def /colslider6 (col 6:) [0 100 100] /Left {warpcolumns 6 ItemValue put} control-can 200 20 /new SliderItem send 250 100 /move 3 index send def /colslider7 (col 7:) [0 100 100] /Left {warpcolumns 7 ItemValue put} control-can 200 20 /new SliderItem send 250 60 /move 3 index send def end def /messages items /messages get def } def /slideitem { % items fillcolor item => - gsave dup 4 1 roll % item items fillcolor item /moveinteractive exch send % item /bbox exch send % x y w h (Item: x=%, y=%, w=%, h=% Canvas: w=%, h=%) [ 6 2 roll control-win begin FrameWidth FrameHeight end ] /printf messages send grestore } def /warpdict 20 dict def warpdict begin /fudge 2 def end /warp % hparts vparts source ==> --- { warpdict begin /fromCan exch def gsave fromCan setcanvas clippath pathbbox points2rect /fromHeight exch def /fromWidth exch def pop pop /thruCan fromCan newcanvas def thruCan /Retained true put grestore /fromHeights exch normalize def /fromWidths exch normalize def /n fromHeights length def /m fromWidths length def /toWidth 1 n div def /toHeight 1 m div def /thruY 0 def /toY 0 def % (Warp %/%) [image_number 1 add images] printf flush 0 1 m 1 sub { /j exch def /thruX 0 def /toX 0 def 0 1 n 1 sub { /i exch def gsave showsquare grestore % (.) print flush /thruX thruX thruWidth add def /toX toX toWidth add def } for /thruY thruY thruHeight add def /toY toY toHeight add def } for % (\n) print flush end } def % Divide the numbers in an array by their sum, so the array sums to 1. /normalize % array ==> normalized_array { 0 1 index { add } forall /total exch def [ exch { total div } forall ] } def /showsquare % --- ==> --- { /thruWidth fromWidths i get fromWidth mul round def /thruHeight fromHeights j get fromHeight mul round def % Make a copy of the source square gsave fromCan setcanvas thruX thruY translate 0 0 thruWidth thruHeight rectpath thruCan reshapecanvas thruCan setcanvas thruX neg thruY neg translate fromWidth fromHeight scale fromCan imagecanvas grestore % Translate and scale so that the thru square is mapped onto % the destination square toX toY translate fudge dup idtransform abs toHeight add exch abs toWidth add exch scale thruCan imagecanvas 5 { pause } repeat } def /load_can { % - => - systemdict /canvas-dict known not { systemdict /canvas-dict 100 dict put } if canvas-dict canvasfile known { /can canvas-dict canvasfile get def } { currentcursorlocation [(I'm getting loaded ...)] popmsg /can canvasfile readcanvas def systemdict canvasfile can put killprocess } ifelse } def /warprows [100 100 100 100 100 100 100 100] def /warpcolumns [100 100 100 100 100 100 100 100] def /autowarp false def /warpit { % => gsave % image_number /new-page win send setcanvas clippath pathbbox scale pop pop warpcolumns warprows can warp /update-last-page win send grestore } def /main { /canvasfile ($1) dup length 0 eq {pop (demo/ron.can)} if def load_can /control-win framebuffer /new DefaultWindow send def % Create a window { /PaintClient {FillColor fillcanvas items paintitems} def /FrameLabel (Warp-o-matic) def /IconImage /trek def /ClientMenu [ (Ron) {use_ron} (Founders) {use_founders} ] /new DefaultMenu send def } control-win send % Install my stuff. 0 0 600 400 /reshape control-win send % Shape it. /control-can control-win /ClientCanvas get def % Get the window canvas % Create all the items. createitems % Create event manager to slide around the items. % Create a bunch of interests to move the items. % Note we actually create toe call-back proc to have the arguments we need. % The proc looks like: {items color "thisitem" slideitem}. % We could also have used the interest's clientdata dict. /slidemgr [ % items { % key value % MiddleMouseButton {slideitem} % key item but proc % 1 dict dup DownTransition 5 index put % key item but proc dict % 5 -2 roll exch pop % but proc dict item % /ItemCanvas get eventmgrinterest % } forall items { % key item exch pop dup /ItemCanvas get % item can MiddleMouseButton [items FillColor % item can name mark dict color 6 -1 roll /slideitem cvx] cvx % can name proc DownTransition % can name proc action 4 -1 roll eventmgrinterest % interest } forall ] forkeventmgr def % Now let the user specify the window's size and position. Then map % the window. (See above) Then activate the items. % /ptr /ptr_m framebuffer setstandardcursor /reshapefromuser control-win send % Reshape from user. /map control-win send % Map the window & install window event manager. % (Damage causes PaintClient to be called) /itemmgr items forkitems def % create warp window /win framebuffer /new Animator send def % Create a window /reshapefromuser win send % Shape window. /map win send } def main