korp@atlantis.ees.anl.gov (Peter Korp) (11/17/90)
This is an alternate version of the viewmaster program posted earlier. It too
uses shared memory techniques, but allows the user to zoom-in on the rasterfile
and still scroll through the whole entire image at the zoomed level.
This is a csh program, run by:
rv <rasterfile>
------------------------------ Cut here -------------------------------------
#! /bin/csh -f
if( $1 == "" ) then
echo "Usage : " $0 " rasterfile"
exit
endif
psh <<+++
%% Raster Viewer
%% by
%% David C. Mak
%%
%% This application was developed to allow a user to view a raster file
%% at various zoom levels. Once zoomed in, the entire raster file is still
%% available for perusal using the scrollbars attached to the window.
%%
%% Shared memory enhancement by Peter A. Korp
%%
%% This application uses the BTOL toolkit developed at Argonne and will not
%% run without it.
%%
%% This file is a product of Argonne National Laboratory, and is provided for
%% unrestricted use provided that this legend is included on all tape
%% media and as a part of the software program in whole or part. Users
%% may copy or modify this file without charge, but are not authorized to
%% license or distribute it to anyone else except as part of a product
%% or program developed by the user.
%%
%% THIS FILE IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE
%% WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
%% PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE.
%%
%% This file is provided with no support and without any obligation on the
%% part of Argonne National Laboratory to assist in its use, correction,
%% modification or enhancement.
%%
%% ARGONNE NATIONAL LABORATORY SHALL HAVE NO LIABILITY WITH RESPECT TO THE
%% INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS FILE
%% OR ANY PART THEREOF.
%%
%% In no event will Argonne National Laboratory be liable for any lost revenue
%% or profits or other special, indirect and consequential damages, even
%% if Sun has been advised of the possibility of such damages.
%%
%% Argonne National Laboratory
%% 9700 S. Cass Avenue
%% Argonne, Il. 6049
%%
/appname ($0) def
/appcurrentdir ($PWD) def
/appfilename ($1) def
appfilename 0 get 47 ne
{
/appfilename appcurrentdir (/) append appfilename append store
} if
(ARGONNE_HOME) getenv (/BTOL/BTOL.ps) append run
systemdict /statusdict get begin 2000 setjobtimeout end
/rectheight 20 def
/getrestrictrect % canvas w/h => x y w h
{
gsave
10 dict begin
/ratio exch def
/thecanvas exch def
% get the first click
thecanvas
{
currentcursorlocation
rectheight ratio mul rectheight neg rectpath
stroke
} instancedrawing
/y0 exch def
/x0 exch def
% get the second click
thecanvas
{
currentcursorlocation
/y1 exch def
/x1 exch def
x0 y0
x1 x0 sub abs 1 max y1 y0 sub abs 1 max div
ratio lt
{
y1 y0 sub
dup abs x1 x0 sub 0 lt { -1 } { 1 } ifelse mul ratio mul
exch
}
{
x1 x0 sub
dup abs y1 y0 sub 0 lt { -1 } { 1 } ifelse mul ratio div
} ifelse
rectpath stroke
} instancedrawing
/y1 exch def
/x1 exch def
x0 y0
x1 x0 sub abs
y1 y0 sub abs lt
{
y1 y0 sub
dup abs x1 x0 sub 0 lt { -1 } { 1 } ifelse mul ratio mul
exch
}
{
x1 x0 sub
dup abs y1 y0 sub 0 lt { -1 } { 1 } ifelse mul ratio div
} ifelse
rectpath pathbbox points2rect
end
grestore
} def
/mywin (Raster Viewer) /new BtolAppWin send def
{
{ /tmpimage pause appfilename readcanvas pause def } stopped
{
[
appname
(: Can not open rasterfile ')
appfilename
('.\n)
%appname
%(: The file must be accessible from the NeWS server!\n)
]
{ print } forall
quit
} if
version cvr 2 ge
{
tmpimage false getbbox
}
{
gsave
tmpimage setcanvas
clippath pathbbox
grestore
} ifelse
/imageh exch def
/imagew exch def
pop pop
/theimage framebuffer newcanvas def
theimage /Retained true put
gsave
framebuffer setcanvas
0 0 imagew imageh newpath rectpath
theimage reshapecanvas
theimage setcanvas
imagew imageh scale
pause tmpimage imagecanvas pause
grestore
/tmpimage null store
/Buffer theimage newcanvas def
Buffer /Transparent true put
/BufferWidth 0 def
/BufferHeight 0 def
/ScaleStack [ 1 ] def
/FrameMenu
[ (Zoom In) (Zoom Out) (Redisplay) (Quit) ]
[
{ /zoomin /getappwin BtolAppWin send send }
{ /zoomout /getappwin BtolAppWin send send }
{ /paint /getappwin BtolAppWin send send }
{ /destroy /getappwin BtolAppWin send send }
] /new BtolMenu send def
FrameLabel { /FrameLabel exch store AutoSize } FrameMenu send
/currentscale % - => scale
{
ScaleStack 0 get
} def
/popscale % - => -
{
ScaleStack length 1 gt
{
/ScaleStack ScaleStack 0 arraydelete store
} if
} def
/pushscale % scale => -
{
/ScaleStack ScaleStack 0 4 -1 roll arrayinsert store
} def
/zoomin % - => -
{
10 dict begin
ClientCanvas ClientWidth ClientHeight div getrestrictrect
/userh exch def
/userw exch def
/usery exch def
/userx exch def
/realx HScrollbar /ItemValue get userx currentscale div add def
/realy VScrollbar /ItemValue get usery currentscale div add def
/realw userw currentscale div def
/realh userh currentscale div def
ClientWidth realw div ClientHeight realh div min pushscale
scrollbarsetrange
realx round /setvalue HScrollbar send
realy round /setvalue VScrollbar send
end
reshapebuffer
paintclient
} def
/zoomout % - => -
{
ScaleStack length 1 gt
{
10 dict begin
/centerx
HScrollbar /ItemValue get
ClientWidth currentscale div 2 div add store
/centery
VScrollbar /ItemValue get
ClientHeight currentscale div 2 div add store
popscale
scrollbarsetrange
/realw ClientWidth currentscale div def
/realh ClientHeight currentscale div def
centerx realw 2 div sub round /setvalue HScrollbar send
centery realh 2 div sub round /setvalue VScrollbar send
end
reshapebuffer
paintclient
} if
} def
/scrollbarsetrange % - => -
{
10 dict begin
/realx HScrollbar /ItemValue get def
/realy VScrollbar /ItemValue get def
/realw ClientWidth currentscale div def
/realh ClientHeight currentscale div def
[ 0 imagew realw sub round
5 realw 2 div round 5 max
realw imagew div ]
/setrange HScrollbar send
[ 0 imageh realh sub round
5 realh 2 div round 5 max
realh imageh div ]
/setrange VScrollbar send
realx cvi /setvalue HScrollbar send
realy cvi /setvalue VScrollbar send
end
} def
/reshapebuffer % - => -
{
/BufferWidth ClientWidth currentscale div floor 1 max store
/BufferHeight ClientHeight currentscale div floor 1 max store
gsave
theimage setcanvas
0 0 BufferWidth BufferHeight newpath rectpath
Buffer reshapecanvas
grestore
} def
/reshape /reshape {}
{
self mywin eq
{
ClientWidth imagew gt
{
/ClientWidth imagew store
FrameX FrameY ClientWidth BorderRight BorderLeft add add ClientHeight reshape
} if
ClientHeight imageh gt
{
/ClientHeight imageh store
FrameX FrameY ClientWidth ClientHeight BorderTop BorderBottom add add reshape
} if
scrollbarsetrange
reshapebuffer
} if
} modifyproc def
/imagebuffer % - => -
{
gsave
Buffer setcanvas
HScrollbar /ItemValue get 1 sub
VScrollbar /ItemValue get 1 sub
movecanvas
grestore
} def
/PaintClient % - => -
{
FrameCanvas /Mapped get Buffer null ne and
{
imagebuffer
version cvr 2 lt
{ BufferWidth BufferHeight scale } if
currentscale dup scale
Buffer imagecanvas
} if
} def
/destroy
{
/theimage null store
/Buffer null store
ZapNotify
} def
CreateZapControl
CreateCloseControl
CreateResizeControl
{/paintclient Owner send} attachVScrollbar
{/paintclient Owner send} attachHScrollbar
reshapefromuser
%imageh round /setvalue VScrollbar send
ClientCanvas /Retained true put
attachframemenu
totop
map
} mywin send
currentprocess newprocessgroup
currentfile closefile
+++