%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%          DualScrollBar.ps v1.0
%
%     Date: January 17, 1990
%     Authors:
%             David G. Zawada
%             EAIS-VIS
%             Argonne National Laboratory
%             zawada@athens.ees.anl.gov
%
%             David C. Mak
%             EAIS-VIS
%             Argonne National Laboratory
%             mak@athens.ees.anl.gov
%
%	DualScrollBar.ps is the definition for a new subclass of
%	the SimpleScrollbar item.  New features include
%	
%	--> Dual Scrolling is available, meaning that Up and Down
%		scrolling are both possible from either end of
%		the ScrollBar.
%
%	--> Continuous Scrolling is possible by keeping any MouseButton
%		 depressed within one of the ScrollButtons.
%
%	--> Colorization is available via the /sethue method.
%
%	--> Adjustable Thumb sizes are available via the /setrange
%		and /reshape methods.  Through the use of these
%		methods, the size of the Thumb can reflect
%		what fraction of the scrolling list is currently
%		visible to the user.  For examples of this 
%		concept, look at applications which use scrollbars
%		and run under the SunView or NeXT environments.
%
%	--> Scrollbar width can be adjustable.  The smallest
%		width that aesthetically pleasing is 18.
%
%  A simple example:
%
%	systemdict /DualScrollBar known not
%		{ (/DualScrollBar.ps) append run } if  %Adjust path as necessary
%
%	/win framebuffer /new DefaultWindow send def
%	{
%		100 dup 400 dup reshape
%
%		/items
%		[
%			[ 1 0 0.1 0.5 0.1] 0 {} ClientCanvas
%			/new DualScrollBar send
%				dup /BarVertical? true put
%				{
%					0.1 sethue
%					10 20 dup 300 reshape
%				} 1 index send
%	
%			[ 1 0 0.1 0.5 0.5] 0 {} ClientCanvas
%			/new DualScrollBar send
%				dup /BarVertical? false put
%				{
%					0.7 sethue
%					60 20 300 34 reshape
%				} 1 index send
%		] def
%
%		items forkitems pop
%
%		/PaintClient { items paintitems } def
%
%		totop
%		map
%	} win send
%	
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

systemdict begin
currentdict /SimpleScrollbar known not
{
	version (1.1) eq	%For X/NeWS compatibility
	{
		($NEWSHOME/lib/NeWS/liteitem.ps) run
	}
	{
		($OPENWINHOME/etc/NeWS/liteitem.ps) run
	} ifelse
} if

/DualScrollBar SimpleScrollbar
dictbegin
	/Hue		0 def
	/ShadowColor	.1 .1 .1 rgbcolor def
	/HiLiteColor	.9 .9 .9 rgbcolor def
	/FaceColor	.7 .7 .7 rgbcolor def
	/ScrollWidth	16 def
	/ScrollMonitor	null def
	/ScrollProcess	null def
	/ScrollDelay	1 60 div 20 div def % 1/10 second
	/LastX	null def
	/LastY	null def
dictend
classbegin
	/new
	{
		/new super send
		begin
			/ScrollMonitor createmonitor def
			/ItemFillColor .5 .5 .5 rgbcolor def
			currentdict
		end
	} def

	/setrange % [ min max dLine dPg PercentView ] => -
	{
		/setrange super send
		ItemHeight null ne
		{
			/BoxSize ItemHeight ScrollWidth 4 mul sub
				BarViewPercent mul ScrollWidth max def
			SetScale
		} if
	} def

	/reshape % x y w h => -
	{
		/reshape super send
		/ScrollWidth ItemWidth ItemFrame 2 mul sub def
		BarViewPercent null ne
		{
			/BoxSize ItemHeight ScrollWidth 4 mul sub
				BarViewPercent mul ScrollWidth max def
		}
		{
			/BoxSize ScrollWidth def
		} ifelse
		SetScale
	} def

	/resetcolors  % => -
	{
		/ShadowColor	.1 .1 .1 rgbcolor store
		/HiLiteColor	.9 .9 .9 rgbcolor store
		/FaceColor	.7 .7 .7 rgbcolor store
		/ItemFillColor	.5 .5 .5 rgbcolor store
	} def

	/sethue % hue => -
	{
		/Hue exch def
		/ShadowColor Hue 1 0.45 hsbcolor def
		/HiLiteColor Hue 0.3 1 hsbcolor def
		/FaceColor Hue 0.4 .9 hsbcolor def
		/ItemFillColor Hue 1 0.7 hsbcolor def
	} def

	/EventInItem?  % - => bool	Determine if user clicked in scrollbar
	{
		ScrollMotion
		{
			/ScrollAbsolute { false }

			/ScrollPageForward % top
			{
				LastX dup 0 ge exch ScrollWidth le
				LastY ItemValue ValueToY ScrollWidth 2 mul add ge
				LastY ItemHeight ScrollWidth 2 mul sub le
				and and and
			}

			/ScrollPageBackward % bottom
			{
				LastX dup 0 ge exch ScrollWidth le
				LastY ScrollWidth 2 mul ge
				LastY ItemValue ValueToY le
				and and and
			}

			/ScrollLineForward % top
			{
				LastX 0 ge
				LastX ScrollWidth le
				LastY ItemHeight ScrollWidth sub ge
				LastY ItemHeight le and
				LastY ScrollWidth ge
				LastY ScrollWidth 2 mul le and
				or and and
			}

			/ScrollLineBackward % bottom
			{
				LastX 0 ge
				LastX ScrollWidth le
				LastY 0 ge
				LastY ScrollWidth le and
				LastY ItemHeight ScrollWidth sub le
				LastY ItemHeight ScrollWidth 2 mul sub ge and
				or and and
			}
		} case
	} def

	/ClientDown  % - => -
	{
		CurrentEvent
		begin
			XLocation YLocation
		end
		/LastY exch def
		/LastX exch def
		SetScrollMotion
		DoScroll

		ScrollMonitor
		{
			ScrollProcess null ne { ScrollProcess killprocess } if
			/ScrollProcess { InteractiveScroll } fork def
		} monitor
	} def
     
	/InteractiveScroll
	{
		{
			ScrollDelay sleep
			ScrollMonitor
			{ EventInItem? { DoScroll } if } monitor
		} loop
	} def

	/ClientUp  % - => -
	{
		ScrollMonitor
		{
			ScrollProcess null ne { ScrollProcess killprocess } if
			/ScrollProcess null def
		} monitor

		PaintButtons
		ItemValue ItemInitialValue ne { NotifyUser } if
	} def

	/BoxPath  % value => - (Make a box path for the given value)
	{
		ValueToY BoxSize 2 div sub ItemFrame exch
		ScrollWidth BoxSize
		rectpath
	} def

	/PaintBar
	{
		ItemFillColor fillcanvas
	} def

	/PaintBox
	{
		gsave
		BarVertical?
		{ PaintVBox }
		{ PaintHBox } ifelse

		ItemValue ItemInitialValue ne { NotifyUser } if
		/ItemPaintedValue ItemValue def
		grestore
	} def

	/PaintVBox
	{
		10 dict begin
		newpath
		ItemValue BoxPath
		gsave FaceColor setcolor fill grestore
		pathbbox points2rect
		/myBoxHeight exch def
		/myBoxWidth exch def
		gsave
			translate

			% paint the hilite
			HiLiteColor setcolor
			newpath
			0 0 moveto
			ItemFrame 2 mul dup rlineto
			0 myBoxHeight ItemFrame 4 mul sub rlineto
			myBoxWidth ItemFrame 4 mul sub 0 rlineto
			ItemFrame 2 mul dup rlineto
			myBoxWidth neg 0 rlineto
			closepath fill

			% paint the shadow
			ShadowColor setcolor
			newpath
			0 0 moveto
			ItemFrame 2 mul dup rlineto
			myBoxWidth ItemFrame 4 mul sub 0 rlineto
			0 myBoxHeight ItemFrame 4 mul sub rlineto
			ItemFrame 2 mul dup rlineto
			0 myBoxHeight neg rlineto
			closepath fill

			% paint the dimple
			newpath
			HiLiteColor setcolor
			myBoxWidth 2 div 1 sub myBoxHeight 2 div
			4 0 360 arc stroke
			newpath
			ShadowColor setcolor
			myBoxWidth 2 div 1 sub myBoxHeight 2 div
			4 35 205 arc stroke
		grestore
		end
	} def

	/PaintHBox
	{
		10 dict begin
		newpath
		ItemValue BoxPath
		gsave FaceColor setcolor fill grestore
		pathbbox points2rect
		/myBoxHeight exch def
		/myBoxWidth exch def
		gsave
			translate

			% paint the hilite
			HiLiteColor setcolor
			newpath
			0 myBoxHeight moveto
			ItemFrame 2 mul dup neg rlineto
			0 myBoxHeight ItemFrame 4 mul sub neg rlineto
			myBoxWidth ItemFrame 4 mul sub 0 rlineto
			ItemFrame 2 mul dup neg rlineto
			myBoxWidth neg 0 rlineto
			fill

			% paint the shadow
			ShadowColor setcolor
			newpath
			0 myBoxHeight moveto
			ItemFrame 2 mul dup neg rlineto
			myBoxWidth ItemFrame 4 mul sub 0 rlineto
			0 myBoxHeight ItemFrame 4 mul sub neg rlineto
			ItemFrame 2 mul dup neg rlineto
			0 myBoxHeight rlineto
			fill

			% paint the dimple
			newpath
			HiLiteColor setcolor
			myBoxWidth 2 div 1 sub myBoxHeight 2 div
			4 0 360 arc stroke
			newpath
			ShadowColor setcolor
			myBoxWidth 2 div 1 sub myBoxHeight 2 div
			4 125 295 arc stroke
		grestore
		end
	} def

	/PaintArrow %
	{
		gsave
			ScrollWidth dup 2 mul scale

		% draw the up arrow
		BarVertical?
		{
			ShadowColor setcolor
			0.125 0.5625 moveto
			0.500 0.9375 lineto stroke
			HiLiteColor setcolor
			0.500 0.9375 moveto
			0.875 0.5625 lineto
			0.125 0.5625 lineto stroke
		}
		{
			ShadowColor setcolor
			0.875 0.5625 moveto
			0.125 0.5625 lineto
			0.500 0.9375 lineto stroke
			HiLiteColor setcolor
			0.500 0.9375 moveto
			0.875 0.5625 lineto stroke
		} ifelse

		% draw the down arrow
		BarVertical?
		{
			ShadowColor setcolor
			0.875 0.4375 moveto
			0.125 0.4375 lineto
			0.500 0.0625 lineto stroke
			HiLiteColor setcolor
			0.875 0.4375 moveto
			0.500 0.0625 lineto stroke
		}
		{
			HiLiteColor setcolor
			0.125 0.4375 moveto
			0.875 0.4375 lineto
			0.500 0.0625 lineto stroke
			ShadowColor setcolor
			0.125 0.4375 moveto
			0.500 0.0625 lineto stroke
		} ifelse

		grestore
	} def

	/PaintShadow % ShadowColor
	{
		setcolor
		BarVertical?
		{
			0 0 moveto
			ItemFrame 2 mul dup rlineto
			ScrollWidth ItemFrame 4 mul sub 0 rlineto
			0 ScrollWidth 2 mul ItemFrame 4 mul sub rlineto
			ItemFrame 2 mul dup rlineto
			0 ScrollWidth 2 mul neg rlineto
		}
		{
			0 ScrollWidth 2 mul moveto
			ItemFrame 2 mul dup neg rlineto
			ScrollWidth ItemFrame 4 mul sub 0 rlineto
			0 ScrollWidth 2 mul ItemFrame 4 mul sub neg rlineto
			ItemFrame 2 mul dup neg rlineto
			0 ScrollWidth 2 mul rlineto
		} ifelse
		fill
	} def

	/PaintHiLite % HiLiteColor
	{
		setcolor
		BarVertical?
		{
			0 0 moveto
			0 ScrollWidth 2 mul rlineto
			ScrollWidth 0 rlineto
			ItemFrame 2 mul neg dup rlineto
			ScrollWidth ItemFrame 4 mul sub neg 0 rlineto
			0 ScrollWidth 2 mul ItemFrame 4 mul sub neg rlineto
		}
		{
			0 ScrollWidth 2 mul moveto
			ItemFrame 2 mul dup neg rlineto
			0 ScrollWidth 2 mul ItemFrame 4 mul sub neg rlineto
			ScrollWidth ItemFrame 4 mul sub 0 rlineto
			ItemFrame 2 mul dup neg rlineto
			ScrollWidth neg 0 rlineto
		} ifelse
		fill
	} def

	/PaintFace % FaceColor
	{
		setcolor
		ItemFrame dup ScrollWidth ItemFrame 2 mul sub
		ScrollWidth 2 mul ItemFrame 2 mul sub rectpath fill
	} def

	/PaintButtons %
	{
		gsave
			ItemFrame dup translate
			ShadowColor PaintShadow
			HiLiteColor PaintHiLite
			FaceColor PaintFace
			PaintArrow
		grestore
		gsave
			ItemFrame ItemHeight ScrollWidth 2 mul sub ItemFrame sub translate
			ShadowColor PaintShadow
			HiLiteColor PaintHiLite
			FaceColor PaintFace
			PaintArrow
		grestore
	} def

	/HiLiteUpArrow % - => -
	{
		gsave
			HiLiteColor setcolor
			ScrollWidth dup 2 mul scale
			0.125 0.5625 moveto
			0.500 0.9375 lineto
			0.875 0.5625 lineto
			fill
		grestore
	} def

	/HiLiteDownArrow % - => -
	{
		gsave
			HiLiteColor setcolor
			ScrollWidth dup 2 mul scale
			0.875 0.4375 moveto
			0.125 0.4375 lineto
			0.500 0.0625 lineto
			fill
		grestore
	} def

	/HiLiteArrows	% bool => -
	{
		{ /HiLiteDownArrow cvx }
		{ /HiLiteUpArrow cvx } ifelse
		gsave
			ItemFrame dup translate
			dup exec
			PaintArrow
		grestore
		gsave
			ItemFrame ItemHeight ScrollWidth 2 mul sub ItemFrame sub translate
			exec
			PaintArrow
		grestore
	} def

	/SetScrollMotion  % - => - (set ScrollMotion from event location)
	{
		CurrentEvent /YLocation get  %Where did the click occur?
		dup ScrollWidth 2 mul le
		{
			% In Bottom Arrow

			dup ScrollWidth le
			{
				/ScrollMotion /ScrollLineBackward def
				true HiLiteArrows
			}
			{
				/ScrollMotion /ScrollLineForward def
				false HiLiteArrows
			} ifelse
		}
		{
			dup ItemHeight ScrollWidth 2 mul sub ge
			{
				% In Top or Right Arrow

				dup ItemHeight ScrollWidth sub le
				{
					/ScrollMotion /ScrollLineBackward def
					true HiLiteArrows
				}
				{
					/ScrollMotion /ScrollLineForward def
					false HiLiteArrows
				} ifelse
			}
			{
				ItemPaintedValue BoxPath pathbbox exch pop 3 -1 roll pop
				2 index le
				{
					% Above Thumb
					pop pop
					/ScrollMotion /ScrollPageForward def
				}
				{
					le
					{
						% Below Thumb
						/ScrollMotion /ScrollPageBackward def
					}
					{
						% In Thumb
						/ScrollMotion /ScrollAbsolute def
					} ifelse
				} ifelse
			} ifelse
		} ifelse
		pop
	} def

	% Geometry utilities:
	/SetScale  % - => - (set BarScale from size)
	{
		/BarScale ItemHeight BoxSize sub ItemFrame 2 mul sub
			ScrollWidth 4 mul sub BarMax BarMin sub div def
	} def

	/ValueToY  % value -> y
	{
		BarMin sub BarScale mul ScrollWidth 2 mul add
			BoxSize 2 div add 1 add
	} def

	/YToValue  % y -> value
	{
		ScrollWidth 2 mul sub BoxSize 2 div sub BarScale div BarMin add
		CheckValueBounds
	} def

classend
def
end