%
% 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
%
%
% @(#)imagedemo 23.5 90/06/19
%
% Copyright (c) 1989 by Sun Microsystems, Inc.
%


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

/ImageCanvas ClassCanvas dictbegin
% Instance Variables

    /proc		/TypeImage def
    /animator		null def
    /themode		0 def
    /repaintproc	null def
    /ImageList		null def
    /Image		null def
    /ImageMatched	null def
    /ImageName		() def
    /ImageExt		(.im8) def
    /ImageWidth		0 def
    /ImageHeight	0 def
    /image_x		0 def
    /image_y		0 def
    /last_x		0 def
    /last_y		0 def
    /abs_x		0 def
    /abs_y		0 def
    /Contrast		0 def
    /Brightness		0 def
dictend
classbegin
% Class Variables

    /FillColor		.5 dup dup rgbcolor def
    /ModeMenu		null def
    /ContrastMenu	null def
    /BrightnessMenu	null def
    /DirMenu		null def

    { (IMAGEDIR) getenv } stopped {
	pop
	/imagedirectory (OPENWINHOME) getenv (/demo/images) append def
    } {
	/imagedirectory exch def
    } ifelse

%%----------------------------------------------------------------------
% System exec's a string in a shell and returns an array of lines from stdout.
%
    /system { % string -> array-of-strings
	pipe pop []			% Pop the write pipe file
	{
	    1 index 100 string readline not {
		exit
	    } if
	    [ exch ] append
	} loop
	pop exch pop
    } def

%%----------------------------------------------------------------------
% Uses system to run Unix commands to read the image directory
%

    /BuildImageDir { % - => array
	(/bin/ls -1 %/*%* | /bin/sed -e 's:.*/\\(.*\\)\%.*:\\1:')
	[ imagedirectory ImageExt ImageExt] sprintf
	system dup length 0 eq {
	    console (imagedemo: no match for images in: %/*%*\n)
	    [ imagedirectory ImageExt ] fprintf
	    /destroy self send
	} if
    } def

%%----------------------------------------------------------------------
% tNt minsize - constrain the window's minimum size.
%

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

%%----------------------------------------------------------------------
% tNt preferredsize - set the window's default starting size.
%

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

%%----------------------------------------------------------------------
% tNt newinit - set up the image list and menus when the instance is created.
%
    /newinit {	% - => -
	/newinit super send

	/ImageList /BuildImageDir self send
	dup 0 get /ImageName exch store store
	ImageList { (stormy) eq { /ImageName (stormy) store exit } if } forall
	/CreateMenu self send
	/UpdatePicture self send
    } def

%%----------------------------------------------------------------------
% Given that ImageName is updated, update all of the image parameters.
%
    /setfooter { % left right
	/setfooter /parent self send send
    } def

    /UpdatePicture { % - => -
	gsave
	    null ImageName /setfooter self send
	    /Image
		imagedirectory (/) ImageName ImageExt append append append
	    readcanvas def
	    Image setcanvas
	    matrix currentmatrix dup
	    0 get /ImageWidth exch def
	    5 get /ImageHeight exch def
	    framebuffer setcanvas
	    /ImageMatched ImageWidth ImageHeight
		monochromecanvas {1}{8} ifelse
		[] null buildimage def
	    ImageMatched setcanvas
	    Image imagecanvas
	    /InitPictureLocation self send
	grestore
    } def

    /InitPictureLocation { % - => -
	gsave
	    Canvas setcanvas
	    /image_x Width ImageWidth sub 2 div def
	    /image_y Height ImageHeight sub 2 div def
	    /last_x image_x def
	    /last_y image_y def
	    /abs_x 0 def
	    /abs_y 0 def
	grestore
    } def

%%----------------------------------------------------------------------
% Emulate the original imagedemo, (just scale the image to the frame.)
%
    /PaintScaledImage {
	gsave
	    Width Height scale
	    /SetTransfer self send
	    Image imagecanvas
	grestore
    } def


%%----------------------------------------------------------------------
% Pan Image
%
    /HomePanImage {			% event => -
	/canvas self send setcanvas
	dup begin XLocation YLocation end
	ImageHeight 2 div sub /image_y exch def
	ImageWidth 2 div sub /image_x exch def
	/PaintPannedImage self send
	/last_x image_x def
	/last_y image_y def
	/PanImage self send
    } def

    /PanImage {				% event => -
	begin XLocation YLocation end
	/abs_y exch def
	/abs_x exch def
	/killanimator self send
	/animator [
	    MouseDragged {
		begin XLocation YLocation end
		2 copy
		abs_y sub /image_y exch image_y add def
		abs_x sub /image_x exch image_x add def
		/abs_y exch def /abs_x exch def
		/PaintPannedImage self send
		/last_x image_x def
		/last_y image_y def
	    } null null excleventmgrinterest

	    null {
		pop /killanimator self send
	    } /UpTransition null excleventmgrinterest
	] forkeventmgr store
    } def

    /PaintPannedImage {
	gsave
	    Canvas setcanvas
	    gsave
		0 0 moveto Width Height rect clip
		image_x image_y moveto
		ImageWidth ImageHeight rect
		eoclip
		last_x last_y moveto
		ImageWidth ImageHeight rect
		FillColor setcolor
		fill
	    grestore
	    initclip
	    image_x image_y translate
	    ImageWidth ImageHeight scale
	    ImageMatched imagecanvas
	grestore
    } def

%%----------------------------------------------------------------------
% Rotated Image Demo
%

    /PaintRotatedImage {
	gsave
	    clippath
	    pathbbox 2 div exch 2 div exch translate pop pop
	    pathbbox min 7 div dup scale pop pop
	    0 36 359 {					% 36 degree steps
		gsave
		    rotate
		    1 0 translate			% move from center
		    4 1.25 mul 4 scale			% reset aspect ratio
		    Image imagecanvas
		    0 0 moveto 1 1 rect 0 1 1 sethsbcolor stroke
		    pause
		grestore
	    } for
	grestore
    } def


%%----------------------------------------------------------------------
% Tiled Image Demo
%

    /replrop { % w h canvas => -
	exch {
	    1 index {
		dup imagecanvas
		1 0 translate
		pause
	    } repeat
	    1 index neg 1 translate
	} repeat
	pop pop
    } def

    /canvassize { % - => w h
	clippath pathbbox
	3 -1 roll sub exch
	3 -1 roll sub exch
    } def

    /replfill { % canvas => -
	gsave dup setcanvas canvassize grestore
	canvassize
	3 -1 roll div ceiling cvi exch
	3 -1 roll div ceiling cvi exch
	3 -1 roll replrop
    } def

    /PaintTiledImage {
	gsave
	    ImageWidth ImageHeight scale
	    ImageMatched replfill
	grestore
    } def

%%----------------------------------------------------------------------
% Bounce Image Demo
%

    /BounceImage { % - => -
	/delta_x 10 def
	/delta_y 10 def
	{
	    /image_x image_x delta_x add
		delta_x 0 gt {
		    dup ImageWidth add Width gt 1 index 0 gt and {
			pop Width ImageWidth sub 0 max
			/delta_x delta_x neg def
		    } if
		} {
		    dup 0 lt 1 index ImageWidth add Width lt and {
			pop 0 Width ImageWidth sub min
			/delta_x delta_x neg def
		    } if
		} ifelse
	    def
	    /image_y image_y delta_y add
		delta_y 0 gt {
		    dup ImageHeight add Height gt 1 index 0 gt and {
			pop Height ImageHeight sub 0 max
			/delta_y delta_y neg def
		    } if
		} {
		    dup 0 lt 1 index ImageHeight add Height lt and {
			pop 0 Height ImageHeight sub min
			/delta_y delta_y neg def
		    } if
		} ifelse
	    def
	    /PaintPannedImage self send
	    /last_x image_x def
	    /last_y image_y def
	    pause
	} loop
    } def

    /PaintBounceImage {
	/animator { clear BounceImage } refork
	animator /ProcessName (Image Bouncer) put
    } def

%%----------------------------------------------------------------------
%%Stencil: triangle

    /TriangleImage {
	gsave
	    Width Height scale
	    .1 .1 moveto
	    .5 .9 lineto
	    .9 .1 lineto
	    clip
	    Image imagecanvas
	grestore
    } def

%%----------------------------------------------------------------------
%%Stencil: doughnut

    /DoughnutImage {
	gsave
	    Width Height scale
	    .5 .5 .15 0 360 arc
	    .5 .5 moveto
	    .5 .5 .45 0 360 arcn
	    clip
	    Image imagecanvas
	grestore
    } def

%%----------------------------------------------------------------------
%%Stencil: Type

    /TypeFont /Bembo-Bold findfont 500 scalefont def
    /TypeImage {
	gsave
	    Width 1152 div Height 700 div scale
	    100 200 moveto
	    TypeFont setfont
	    .8 1.1 scale
	    (N) true charpath
	    -50 0 rmoveto
	    (e) true charpath
	    -100 0 rmoveto
	    (W) true charpath
	    -50 0 rmoveto
	    (S) true charpath
	    clip
	    clippath pathbbox pop pop translate
	    clippath pathbbox scale pop pop
	    Image imagecanvas
	grestore
    } def

%%----------------------------------------------------------------------
%%Stencil: SunLogo

    /ULength .25 def
    /QWidth ULength 3 div def
    /ULWidth ULength 3.35 div def
    /UWidth ULength 6 div def
    /UHwidth ULWidth 2 div def
    /UDraw {
	/Uy exch def
	/Ux exch def
	Ux Uy UWidth add UHwidth add moveto
	Ux ULength add Uy UWidth UHwidth add 90 -90 arcn
	ULength neg 0 rlineto
	0 ULWidth rlineto
	Ux ULength add Uy UWidth UHwidth sub -90 90 arc
	ULength neg 0 rlineto
	closepath
    } def
    /TwoU {
	/Umat 6 array currentmatrix def
	translate
	0 0 QWidth sub UDraw
	ULWidth 2 div floor
	ULength UWidth .03 add add add
	0 translate
	180 rotate
	0 0 QWidth sub UDraw
	Umat setmatrix
    } def
    /sunlogo {
	matrix currentmatrix
	.5 .5 translate
	45 rotate
	4 {
	    QWidth ULWidth sub
	    0 QWidth dup add sub
	    TwoU
	    90 rotate
	} repeat
	setmatrix
    } def

    /SunLogoImage {
	gsave
	    Width Height scale
	    sunlogo
	    clip
	    Image imagecanvas
	grestore
    } def


%%----------------------------------------------------------------------
% Spin Image Demo, (interactive image orientation)
%

    /SpinX 0 def
    /SpinY 0 def
    /SpinW 0 def
    /SpinH 0 def

    /GetFirstSpin { % - => -
	{ {} {} {x y null blockinputqueue } /DownTransition getfromuser } null
	[ /xhair /xhair_m Canvas ]
	{ InitOverlay InstallXYProcs }
	{   Changed? {
		2 dict begin
		    erasepage
		    /dy y y0 sub def
		    /dx x x0 sub def
		    gsave
			x0 y0 moveto
			dy dx
			2 copy 0 ne exch 0 ne or {
			    atan rotate
			} {
			    pop pop
			} ifelse
			dx dup mul dy dup mul add sqrt dup rect stroke
		    grestore
		end
	    } if
	}
	{ erasepage null SetGlobalCursor x0 y0 x x0 sub y y0 sub }
	/UpTransition getfromuser
	/SpinH exch def
	/SpinW exch def
	/SpinY exch def
	/SpinX exch def
    } def

    /GetNewSpin {	% ev => -
	{ begin XLocation YLocation end } null
	[ /xhair /xhair_m Canvas ]
	{ InitOverlay InstallXYProcs }
	{   Changed? {
		2 dict begin
		    erasepage
		    /dy y y0 sub def
		    /dx x x0 sub def
		    gsave
			x0 y0 moveto
			dy dx
			2 copy 0 ne exch 0 ne or {
			    atan rotate
			} {
			    pop pop
			} ifelse
			dx dup mul dy dup mul add sqrt dup rect stroke
		    grestore
		end
	    } if
	}
	{ erasepage null SetGlobalCursor x0 y0 x x0 sub y y0 sub }
	/UpTransition getfromuser
	/SpinH exch def
	/SpinW exch def
	/SpinY exch def
	/SpinX exch def
	/PaintSpinImage self send
    } def

    /PaintSpinImage {
	gsave
	    Canvas setcanvas
	    FillColor fillcanvas
	    SpinX SpinY translate
	    SpinH SpinW
		2 copy 0 ne exch 0 ne or {
		    atan rotate
		} {
		    pop pop
		} ifelse
	    SpinW dup mul SpinH dup mul add sqrt dup scale
	    Image imagecanvas
	grestore
    } def


    /SetTransfer {
	{ 
	    % 1 exch sub		% This will invert
	    Brightness 0 ne { 
		dup Brightness 0 gt {
		    1 exch sub
		} if
		9 mul 1 add log Brightness mul
		1 Brightness sub mul add
	    } if
	    Contrast 0 ne { 
		dup 360 mul sin Contrast mul sub
	    } if
	} settransfer
    } def

    /SetContrast { % val => -
	/Contrast exch store
	gsave
	    /SetTransfer self send
	    ImageMatched setcanvas
	    Image imagecanvas
	grestore
	/paint self send
    } def

    /SetBrightness { % val => -
	/Brightness exch store
	gsave
	    /SetTransfer self send
	    ImageMatched setcanvas
	    Image imagecanvas
	grestore
	/paint self send
    } def


%%----------------------------------------------------------------------
% Set the frame label.
%
    /SetFrameLabel { % string => -
	/setlabel /parent self send send
    } def


%%----------------------------------------------------------------------
% Set the painting proc for the image.
%
    /SetPicture { % string name => -
	/proc exch store
	/SetFrameLabel self send
	/killanimator self send
	/InitPictureLocation self send
	/paint self send
    } def


%%----------------------------------------------------------------------
% tNt repaint handler... forks a process which execs the proper paint proc.
%
    /PaintCanvas { % - => -
	repaintproc null ne {
	    repaintproc killprocess
	    /repaintproc null store
	} if
	/repaintproc {
	    FillColor /FillCanvas self send
	    Canvas setcanvas
	    proc cvx exec
	    /repaintproc null store
	} fork store
	repaintproc /ProcessName (Image Demo Repaint) put
    } def


%%----------------------------------------------------------------------
% Callback from Images menu to pick a new image.
%
    /picimage { % menu => -
	/value exch send
	ImageList exch get
	/ImageName exch store
	/UpdatePicture self send
	/paint self send
    } def

%%----------------------------------------------------------------------
% tNt menu creation handler.
%
    /CreateMenu { % - => -

	/ModeMenu [
	    (Scaled Image) null {
		(Scaled Image) /PaintScaledImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Pan Image)	null {
		(Pan Image) /PaintPannedImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Bounce Image)	null {
		(Bounce Image) /PaintBounceImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Tiled Image)	null {
		(Tiled Image) /PaintTiledImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Rotated Image)	null {
		(Rotated Image) /PaintRotatedImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Spin Image)	null {
		(Drag out a box...) null
		/setfooter /sendtarget 4 index send

		/GetFirstSpin /sendtarget 2 index send

		(Spin Image) /PaintSpinImage
		/SetPicture /sendtarget 4 index send

		(Imagename:) null
		/setfooter /sendtarget 5 -1 roll send
	    }
	    (Triangle stencil)	null {
		(Triangle stencil) /TriangleImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	     (Doughnut stencil)	null {
		(Doughnut stencil) /DoughnutImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Sun Logo stencil)	null {
		(Sun Logo stencil) /SunLogoImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	    (Type stencil)	null {
		(Type stencil) /TypeImage
		/SetPicture /sendtarget 5 -1 roll send
	    }
	] framebuffer /newdefault ClassMenu send store
	true /setpinnable ModeMenu send

	/ContrastMenu
		[ (Lowest) (Lower) (Low) (Normal) (High) (Higher) (Highest) ]
		null {
			/value self send 3 sub .1 mul
			/SetContrast /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable ContrastMenu send
	3 /setdefault ContrastMenu send

	/BrightnessMenu
		[ (Darkest) (Darker) (Dark) (Normal)
		  (Bright) (Brighter) (Brightest) ]
		null {
			/value self send 3 sub .2 mul
			/SetBrightness /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable BrightnessMenu send
	3 /setdefault BrightnessMenu send

	/DirMenu ImageList null /picimage self soften buildsend
	framebuffer /newdefault ClassMenu send store
	false ImageList length dup sqrt floor 2 div cvi exch
	1 index div ceiling cvi exch
	/setlayoutstyle DirMenu send
	true /setpinnable DirMenu send

	/CanvasMenu [
	    (Modes)	ModeMenu	null
	    (Contrast)	ContrastMenu	null
	    (Brightness) BrightnessMenu	null
	    (Images)	DirMenu		null
	] framebuffer /newdefault ClassMenu send def
	false /setpinnable CanvasMenu send
	(Image Demo) /setlabel CanvasMenu send
    } def

    /PointButtonHandler {
	proc {
	    /PaintSpinImage { GetNewSpin }
	    /PaintPannedImage { PanImage }
	    /Default { redistributeevent }
	} case
	pause unblockinputqueue
    } def

    /AdjustButtonHandler {
	proc {
	    /PaintPannedImage { HomePanImage }
	    /Default { redistributeevent }
	} case
	pause unblockinputqueue
    } def

    /MakeInterests {
	/MakeInterests super send

	AdjustButton /AdjustButtonHandler BuildCanvasSend
	/DownTransition /canvas self send soften syncheventmgrinterest

	PointButton /PointButtonHandler BuildCanvasSend
	/DownTransition /canvas self send soften syncheventmgrinterest
    } def

%%----------------------------------------------------------------------
% destruction handler.
%

    /destroy {
	/killanimator self send
	/destroyMenus self send
	/destroy super send
    } def

    /destroyMenus {
	ModeMenu null ne {
	    /destroy ModeMenu send
	    /ModeMenu null store
	    /destroy ContrastMenu send
	    /ContrastMenu null store
	    /destroy BrightnessMenu send
	    /BrightnessMenu null store
	    /destroy DirMenu send
	    /DirMenu null store
	} if
    } def

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

classend def

/win [ImageCanvas] [] framebuffer /new ClassImageFrame send def

{   gsave
	/client /sendsuperframe /parent self send send
	{ /Image load } exch send
	/size self send scale
	imagecanvas
    grestore
} /seticon win send

null /seticonlabel win send
(Image Demo) /setlabel win send
(Imagename:) null /setfooter win send

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

newprocessgroup
currentfile closefile
