%
% This file is a product of Sun Microsystems, Inc. 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 Sun Microsystems, Inc. to assist in its use, correction,
% modification or enhancement.
%
% SUN MICROSYSTEMS, INC. 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 Sun Microsystems, Inc. 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.
%
% Sun Microsystems, Inc.
% 2550 Garcia Avenue
% Mountain View, California  94043
%
%
% @(#)magnify 23.2 90/06/19
%
% Copyright (c) 1989 by Sun Microsystems, Inc.
%

/MagnifyBaseFrame /defaultclass ClassBaseFrame send []
classbegin
    /open { % bool => -
    	/open super send
	/mapped? self send not {
	    /killanimator /client self send send
	} {
	    /StartAnimator /client self send send
	} ifelse
    } def
classend def

/MagnifyCanvas ClassCanvas dictbegin
    /Factor 0 def
    /animator null def
    /ClientWidth 0 def
    /ClientHeight 0 def
    /XPosition 0 def
    /YPosition 0 def
    /SourceMaxX 0 def
    /SourceMaxY 0 def
    /SourceWindow null def
dictend
classbegin

    /newinit {  % - => -
	/newinit super send

        /CreateMenu self send
	/ZoomIn self send
	/ZoomIn self send
	/StartAnimator self send
    } def

    /minsize { % - => w h
	/minsize super send
	32 max exch
	32 max exch
    } def

    /preferredsize { % - => w h
	/preferredsize super send
	128 max exch
	128 max exch
    } def

    /CreateSourceWindow {
	gsave
	    /canvas self send setcanvas

	    /SourceWindow framebuffer newcanvas def
	    framebuffer setcanvas

	    clippath pathbbox
	    Height Factor div sub /SourceMaxY exch def
	    Width Factor div sub /SourceMaxX exch def
	    pop pop

	    0 0 Width Factor div Height Factor div rectpath
	    SourceWindow reshapecanvas
	    SourceWindow /Transparent true put

	    /nouse /nouse_m SourceWindow setstandardcursor
	grestore
    } def

    /PositionSourceWindow { % x y
	gsave
	    /XPosition 2 index def
	    /YPosition 1 index def
	    framebuffer setcanvas
	    exch Width Factor div 2 div sub
	    exch Height Factor div 2 div sub
	    0 max exch 0 max exch
	    SourceMaxY min exch SourceMaxX min exch
	    SourceWindow movecanvas
	grestore
    } def

    /PaintMagnified {
	gsave
	    SourceWindow /Mapped true put
	    SourceWindow canvastotop
	    /canvas self send setcanvas
	    Factor Factor scale
	    SourceWindow imagecanvas
	    SourceWindow /Mapped false put
	grestore
    } def

    /PaintCanvas {
	FillColor /FillCanvas self send
	clippath emptypath not {
	    /PaintMagnified self send
	} if
    } def

    /reshape {
	/reshape super send

	/CreateSourceWindow self send
	XPosition YPosition /PositionSourceWindow self send
    } def

    /CreateMenu { % - => -
	[
	    (Zoom in)	null	/ZoomIn  self soften buildsend
	    (Zoom out)	null	/ZoomOut self soften buildsend
	    (Restart)   null	/StartAnimator self soften buildsend
	] framebuffer /newdefault ClassMenu send
	true /setpinnable 2 index send
	(Magnify) /setlabel 2 index send
	/setmenu self send
    } def

    /MakeInterests {
	/MakeInterests super send
	PointButton { /StartAnimator } BuildCanvasSend
	/DownTransition /canvas self send eventmgrinterest
    } def

    /zoom { % increment => -
	/Factor Factor 3 2 roll add store
	Factor 0 eq { /Factor 1 store } if
	(MagLevel) Factor 3 string cvs /setfooter /parent self send send
	/CreateSourceWindow self send
	XPosition YPosition /PositionSourceWindow self send
	/paint self send
    } def

    /ZoomIn { 1 /zoom self send } def
    /ZoomOut { -1 /zoom self send } def

    /StartAnimator {
	/killanimator self send
	/animator [
	    MouseDragged {
		pop
		currentcursorlocation /PositionSourceWindow self send
		/PaintMagnified self send
	    } null null eventmgrinterest
	    AdjustButton {
		/Action get /UpTransition eq { /killanimator self send } if
	    } null null eventmgrinterest dup /Exclusivity true put
	] forkeventmgr store
    } def

    /killanimator {
	animator null ne {
	    animator
		/animator null store
	    killprocess
	} if
    } def

    /destroy {
	/killanimator self send

        /destroy super send
    } def

classend def

/win [MagnifyCanvas] [] framebuffer /new MagnifyBaseFrame send def

{
    gsave
	/size framebuffer send
	/size self send
	3 -1 roll div exch 3 -1 roll div exch scale
	framebuffer imagecanvas
    grestore
} /seticon win send

null /seticonlabel win send
(Magnifying Glass) /setlabel win send

/place win send
/map win send
/activate win send

newprocessgroup
currentfile closefile
