%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% tNt Tab Frames, release 1.0
% Copyright (C) 1990
% By Don Hopkins, University of Maryland Human Computer Interaction Lab
% Started, May 13 1989.
% Reimplemented mostly from scratch for X11/NeWS FCS.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Copyright (C) 1990 by Don Hopkins. All rights reserved.
% This program is provided for unrestricted use, provided that this 
% copyright message is preserved. There is no warranty, and no author 
% or distributer accepts responsibility for any damage caused by this 
% program. 
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% To get TabFrame as the default frame class automatically upon startup, put 
% the following into your .startup.ps file:
%
% UserProfile /OpenLookFrame {
%   ClassFrame /DefaultClass { TabFrame } put
% } put
% 
% [
%   /TabFrame (NeWS/tabframe.ps)
% ] DefineAutoLoads
% 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

systemdict begin

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% TabFrame
%

/TabFrame OpenLookFrame
dictbegin
  /TabEdge /Top def
  /TabPosition 0 def
dictend
classbegin
  /ThreeDee? true def
%  /ThreeDee? framebuffer /Color get def
  /Contrast .1 def
  /Bright .75 dup dup rgbcolor def
  /Dim .25 dup dup rgbcolor def
  /LabelMinWidth 8 def
  /SelStroke 2 def
  /UnSelStroke 1 def

  /ZoomX 0 def
  /ZoomY 0 def
  /ZoomWidth 512 def
  framebuffer true getbbox /ZoomHeight exch def pop pop pop
  /ZoomTabEdge /Right def
  /ZoomTabPos 1 def
  /ZoomTabPosition {
    ZoomTabPos TabHeight ZoomHeight div sub
    dup 0 lt { pop 1 } if
    /ZoomTabPos 1 index store
  } def

  /LabelCreate { % - => -
      /Label [
        { /TabNotify parent send pop } OpenLookTabFrameLabel 
      ] /addclient self send
  } def

  /ReshapeCreate { % - => -
      /Reshape
      [{/ReshapeNotify /parent self send send} OpenLookTabFrameCorners]
      /addclient self send
  } def

  /ReshapeNotify { % object => -
      gsave
 	pop %
 	Parent setcanvas
 	currentcursorlocation
        /stretchany self send
      grestore
  } def

  /stretchany { % event|x y => -
      dup type /eventtype eq {
	  begin XLocation YLocation end
      } if

      20 dict begin
        /y exch def /x exch def
	bbox unfittab
	2 copy /h exch def /w exch def
	rect2points
	/y1 exch def /x1 exch def
	/y0 exch def /x0 exch def
	x  x0 w .3 mul add  le /Left {
	  x  x0 w .7 mul add ge  /Right /Middle ifelse
	} ifelse % xpart
	y  y0 h .3 mul add  le  /Bottom {
	  y  y0 h .7 mul add ge  /Top /Middle ifelse
	} ifelse % xpart ypart
	dup /Bottom eq {
	  /y0 y1 /y1 y0 def def
	} if
	1 index /Left eq {
	  /x0 x1 /x1 x0 def def
	} if
	(%%) sprintf cvn
	x1 y1 x1 x sub y1 y sub 	% edge x1 y1 x1-x y1-y
	[x0 y0] cvx 			% edge x1 y1 x1-x y1-y X0Y0proc
      end
      5 index {
	/MiddleRight /MiddleLeft {
          {begin XLocation DeltaX add Y1 end}
        }
	/TopMiddle /BottomMiddle /MiddleMiddle {
          {begin X1 YLocation DeltaY add end}
	}
	/Default {
          {begin XLocation DeltaX add YLocation DeltaY add end}
	}
      } case
      [/xhair /xhair_m Parent]
      {
	  InitOverlay
	  InstallXYProcs
	  /DeltaY exch def /DeltaX exch def
	  /Y1 exch def /X1 exch def
	  /Edge exch def
	  /Moved? false def
      }{
	  Changed? {erasepage BBox fittab /path self send stroke} if
	  /Moved? true def
      }{
	  erasepage
	  null SetGlobalCursor
	  Moved? {
            x0 x min y0 y min x0 x sub abs y0 y sub abs 
	    invalidatetab
	    % /TabWidth unpromote /HeaderWidth unpromote
	    fittab rect2points
	    true
	  } false ifelse
      }
      /UpTransition getfromuser {
	  /anchorbox self send
	  /reshape self send
      } if
  } def

  /TabNotify { % canvas => -
    pop
    DragTab
  } def

  /DragTab { % - => -
    gsave
      Parent setcanvas
      10 dict begin
	bbox unfittab rect2points
	/top exch def /right exch def
	/bottom exch def /left exch def

	parent setcanvas
	null null
	[/xhair /xhair_m Parent]
	{ InitOverlay InstallXYProcs
	}
	{ Changed? {

	    TabEdge {
	      /Left {
		x left gt {
		  y top gt {
		    /Top setedge
		  } {
		    y bottom lt {
		      /Bottom setedge
		    } {
		      x right gt {
			/Right setedge
		      } if
		    } ifelse
		  } ifelse
		} if
	      }
	      /Right {
		x right lt {
		  y top gt {
		    /Top setedge
		  } {
		    y bottom lt {
		      /Bottom setedge
		    } {
		      x left lt {
			/Left setedge
		      } if
		    } ifelse
		  } ifelse
		} if
	      }
	      /Top {
		y top lt {
		  x left lt {
		    /Left setedge
		  } {
		    x right gt {
		      /Right setedge
		    } {
		      y bottom lt {
			/Bottom setedge
		      } if
		    } ifelse
		  } ifelse
		} if
	      }
	      /Bottom {
		y bottom gt {
		  x left lt {
		    /Left setedge
		  } {
		    x right gt {
		      /Right setedge
		    } {
		      y top gt {
			/Top setedge
		      } if
		    } ifelse
		  } ifelse
		} if
	      }
	    } case

	    TabEdge {
	      /Left /Right {
		y bottom sub
		TabHeight .5 mul sub
		top bottom sub TabHeight sub 1 max div
		0 max 1 min
	      }
	      /Top /Bottom {
		x left sub
		TabWidth .5 mul sub
		right left sub TabWidth sub 1 max div
		0 max 1 min
	      }
	    } case
	    setposition

	    erasepage
	    left bottom right 2 index sub top 2 index sub % x y w h
	    fittab
	    /path self send stroke
	  } if }
	{erasepage null SetGlobalCursor Changed?}
	[/UpTransition /DownTransition]
	getfromuser {
	  left bottom right 2 index sub top 2 index sub % x y w h
	  ?validate % XXX
	  fittab
	  minsize % x y w h mw mh
	  3 -1 roll max % x y w mw H
	  3 1 roll max % x y H W
	  exch % x y W H
	  /reshape self send
	} {
	  % do something appropriate
	} ifelse
      end % tempdict
    grestore
  } def

  /invalidatetab {
    /TabWidth unpromote /TabHeight unpromote
    /TabX unpromote /TabY unpromote
    /HeaderWidth unpromote /HeaderHeight unpromote
  } def

  /setedge { % /Left|/Right|/Top|/Bottom => -
    /TabEdge exch store
    invalidatetab
    invalidate
  } def

  /resetedge { % edge => -
    bbox unfittab
    5 -1 roll setedge
    %% ?validate % XXX?
    fittab reshape
  } def

  /setposition { % 0..1 => -
    /TabPosition exch store
    invalidatetab
    invalidate
  } def

  /BorderLeft { % - => l
    BorderEdge
    TabEdge /Left eq { TabWidth add } if
  } def

  /BorderRight { % - => r
    BorderEdge
    TabEdge /Right eq { TabWidth add } if
  } def

  /BorderBottom { % - => b
%    /BorderBottom super send
    Footer {
       0 /Left /getbyname self send {
	  /preferredsize exch send exch pop add
       } if
       0 /Right /getbyname self send {
	  /preferredsize exch send exch pop add
       } if
       max
       {
	   TextFamily findfont
	   TextSize scalefont
	   fontheight
       } FrameLabelGraphic send
       max
       FooterPad dup add add
       SelStroke add
    }{
	BorderEdge
    } ifelse
%    Reshape { BorderEdge dup add 2 add max } if
    TabEdge /Bottom eq { TabHeight add } if
  } def

  /BorderTop { % - => t
    BorderEdge
    TabEdge /Top eq { TabHeight add } if
  } def

  /TabSize { % - => w h
    BorderEdge dup add
%    ThreeDee? { SelStroke add } if
    dup HeaderWidth add
    exch HeaderHeight add
  } def

  /CalcTabXY { % width height => x y
    TabEdge {
      /Left { % width height
	exch pop 0 exch % 0 height
	TabHeight sub TabPosition mul round % 0 y
      }
      /Right { % width height
	exch TabWidth sub % height x
	exch TabHeight sub TabPosition mul round % x y
      }
      /Top { % width height
	exch TabWidth sub TabPosition mul round % height x
	exch TabHeight sub % x y
      }
      /Bottom { % width height
	pop TabWidth sub TabPosition mul round % x
	0 % x 0
      }
    } case
  } def

  /validate {
    invalidatetab
    /BorderLeft unpromote
    /BorderLeft /BorderLeft self send promote
    /BorderRight unpromote
    /BorderRight /BorderRight self send promote
    /validate super send
  } def

  /TabX {
    TabXY /TabY exch promote /TabX exch promote
    TabX
  } def

  /TabY {
    TabXY /TabY exch promote /TabX exch promote
    TabY
  } def

  /TabXY { % - => x y
    Width Height CalcTabXY
  } def

  /TabWidth {
    TabSize /TabHeight exch promote /TabWidth exch promote
    TabWidth
  } def

  /TabHeight {
    TabSize /TabHeight exch promote /TabWidth exch promote
    TabHeight
  } def

  /HeaderWidth {
    HeaderSize /HeaderHeight exch promote /HeaderWidth exch promote
    HeaderWidth
  } def

  /HeaderHeight {
    HeaderSize /HeaderHeight exch promote /HeaderWidth exch promote
    HeaderHeight
  } def

  /HeaderSize { % - => w h
    0 0 % W H
    /Label /getbyname self send {
      /preferredsize exch send % W H w h
      3 -1 roll max % W w H
      3 1 roll add % H W
      LabelMinWidth max HeaderPadding add
      exch % W H
    } if
    /Pin /getbyname self send {
      /minsize exch send % W H w h
      3 -1 roll max % W w H
      3 1 roll add % H W
      HeaderPadding add
      exch % W H
    } if
    /Close /getbyname self send {
      /minsize exch send % W H w h
      3 -1 roll max % W w H
      3 1 roll add % H W
      HeaderPadding add
      exch % W H
    } if
    2 {
      exch dup 0 ne {
        HeaderPadding dup add add
      } if
    } repeat
  } def

  % erase the current frame header. Used when changing busy state.
  %
  /EraseHeader { % - => -
    FillColor setcolor
    TabX BorderEdge add TabY BorderEdge add
    HeaderWidth HeaderHeight
    rectpath fill
  } def

  % Paint the frames current focus state.
  %
  /PaintHeader { % busy? focus? => -
    % Only paint the header if we have one of these ornaments.
    %
    Label Close or Pin or {
      exch {
	pop
	BusyColor setcolor
	TabX BorderEdge add TabY BorderEdge add
	HeaderWidth HeaderHeight
	rectpath fill
      } {
%	{TextColor} {FillColor} ifelse
%	setcolor

%	ClickToType {
%	  TabX BorderEdge add TabY BorderEdge add
%	  HeaderWidth HeaderHeight
%	  rectpath fill
%	}{
	  % Draw the two lines for follow-mouse focus.
	  % Having a different highlight depending on what
	  % focus mode got us here sounds like donkey-doo but
	  % it's in the spec so we implement it.
	  %
	  ThreeDee? {
	    gsave 10 dict begin
	      /focus? 1 index def
	      { 
		framebuffer /Color get {
	          FillColor colorhsb 3 copy % h s b h s b
	          Contrast sub 0 max hsbcolor % h s b dim
		  4 1 roll % dim r g b
	          Contrast add 1 min hsbcolor % dim bright
		} {
		  Dim Bright
		} ifelse
	      } {
	        FillColor dup % dim bright
	      } ifelse
	      /l BorderEdge SelStroke sub def

	      TabX BorderEdge add  TabY BorderEdge add  moveto
	      l neg dup rlineto
	      0  HeaderHeight l dup add add  rlineto
	      HeaderWidth l dup add add  0  rlineto
	      l neg dup rlineto
	      HeaderWidth neg  0  rlineto
	      0  HeaderHeight neg  rlineto
	      closepath
	      setcolor
	      fill

	      TabX BorderEdge add .75 add
	      TabY BorderEdge add .75 sub  moveto
	      l neg dup rlineto
	      HeaderWidth l dup add add  0  rlineto
	      0  HeaderHeight l dup add add  rlineto
	      l neg dup rlineto
	      0  HeaderHeight neg  rlineto
	      HeaderWidth neg  0  rlineto
	      closepath
	      setcolor
	      fill

	      TabX BorderEdge add
	      TabY BorderEdge add .25 add
	      2 copy % x y x y
	      HeaderWidth .5 sub HeaderHeight .5 sub % x y x y w h
	      rectpath % x y
	      2 copy moveto  l neg dup rlineto
	      2 copy HeaderHeight add .5 sub moveto  l dup neg exch rlineto
	      exch HeaderWidth add .5 sub exch 2 copy moveto
	      l dup neg rlineto
	      HeaderHeight add .5 sub moveto  l dup rlineto

	      focus? {StrokeColor} {FillColor} ifelse setcolor
	      stroke

	    end grestore
	  } {
            {TextColor} {FillColor} ifelse
	    setcolor
	    currentlinewidth
	    2 setlinewidth
	    TabX BorderEdge add TabY BorderEdge add
	    HeaderWidth HeaderHeight
	    rectpath stroke
	    setlinewidth
	  } ifelse
%	} ifelse
      } ifelse
    } {
      pop pop
    } ifelse
  } def

  % Overide: Take the label, the footer and the resize corners
  % into account.
  %
  /MinSize { % - => minwidth minheight
      %   Because of the unique factorization of client layout
      %   from client creation we must make sure the frame has
      %   been correctly layed out here in order to get the
      %   right minsize.
      %
      /?validate self send
      /Client getbyname { /minsize exch send } { 0 0 } ifelse
      fitclient
      TabEdge dup /Left eq exch /Right eq or {
        TabHeight max
      } {
        exch TabWidth max exch
      } ifelse
  } def

  % Overide: Take the label, the footer and the resize corners
  % into account.
  %
  /PreferredSize { % - => preferredwidth preferredheight
    %   Because of the unique factorization of client layout
    %   from client creation we must make sure the frame has
    %   been correctly layed out here in order to get the
    %   right preferredsize.
    %
    /?validate self send
    /PreferredSize OpenLookFrame /SuperSend load exec % XXX
  } def

  /SuperSend /supersend load def

% Layout

  /FooterLayout { % - => -
    /Left /getbyname self send {
      BorderEdge 2 mul 1 add
      dup TabEdge /Left eq { TabWidth add } if
      exch
      SelStroke FooterPad add
      TabEdge /Bottom eq { TabHeight add } if
      Width
      TabEdge dup /Right eq exch /Left eq or { TabWidth sub } if
      .5 mul 3 -1 roll sub 1 sub
      /preferredsize 4 index send exch pop
      /reshape 6 -1 roll send
    } if
    /Right /getbyname self send {
      Width
      TabEdge dup /Right eq exch /Left eq or { TabWidth sub } if
      .5 mul
      dup TabEdge /Left eq { TabWidth add } if
      exch
      SelStroke FooterPad add
      TabEdge /Bottom eq { TabHeight add } if
      exch BorderEdge 2 mul 1 add sub
      /preferredsize 4 index send exch pop
      /reshape 6 -1 roll send
    } if
  } def

  /ReshapeLayout { % - => -
    /Reshape /getbyname self send {
      bbox unfittab
      /reshape 6 -1 roll send
    } if
  } def

  /CloseLayout { % - => -
    /Close /getbyname self send { % close
      TabX BorderEdge add HeaderPadding add % close x
      /minsize 2 index send % close x w h
      HeaderHeight 1 index sub % close x w h hh-h
      .5 mul .5 add truncate % close x w h _(hh-h)/2+.5_
      TabY BorderEdge add add % close x w h y
      3 1 roll % close x y w h
      /reshape 6 -1 roll send %
    } if
  } def

  /PinLayout { % - => -
    /Pin /getbyname self send {
      TabX BorderEdge add HeaderPadding add % pin x
      /Close getbyname self send {
	/minsize exch send pop add
	HeaderPadding add
      } if
      /minsize 2 index send % pin x w h
      HeaderHeight 1 index sub % pin x w h hh-h
      .5 mul % pin x w h (hh-h)/2
      TabY BorderEdge add add % pin x w h y
      3 1 roll % pin x y w h
      /reshape 6 -1 roll send %
    } if
  } def

  /LabelLayout { % - => -
      /Label /getbyname self send {
	  TabX BorderEdge add HeaderPadding add % x
	  /Pin /getbyname self send {
	      /bbox exch send
	      rect2points pop 3 1 roll pop pop
	      HeaderPadding add max
	  } if
	  /Close /getbyname self send {
	      /bbox exch send
	      rect2points pop 3 1 roll pop pop
	      HeaderPadding add max
	  } if
	  /preferredsize 2 index send % x w h
	  exch 8 max exch
	  HeaderHeight 1 index sub .5 mul % x w h y
	  TabY BorderEdge add add % x w h y
	  3 1 roll % x y w h
	  /reshape 6 -1 roll send
      } if
  } def

  /setlabel { % graphic|thing|null => -
      /Label /getbyname self send {
	invalidate
	/setlabel exch send
      } {pop} ifelse
  } def

  % This is the next available position to place a window at.
  % It is where the upper left corner of the window should go.
  /NextPosition null store
  /WindowYIncrement -37 store
  /WindowXIncrement 0 store
  /WindowRows 0 store

  /setgravity {   % /Left|/Right|/Top|/Bottom => -
      /Gravity exch store
      /NextPosition null store
      /WindowRows 0 store
      Gravity {
	  /UpperLeft {
	      /InitialDefaultPosition { % w h => x y
		  pop pop
		  /bbox /parent self send send
		  exch pop add
	      } def
	      /WindowYIncrement -37 store
	      /WindowXIncrement 0 store
	  }
	  /UpperRight {
	      /InitialDefaultPosition { % w h => x y
		  pop
		  /bbox /parent self send send
		  3 -1 roll add 3 1 roll add 3 -1 roll sub exch
	      } store
	      /WindowYIncrement -37 store
	      /WindowXIncrement 0 store
	  }
	  /LowerLeft {
	      /InitialDefaultPosition { % w h => x y
		  exch pop
		  /location /parent self send send
		  3 -1 roll add
	      } store
	      /WindowYIncrement 37 store
	      /WindowXIncrement 0 store
	  }
	  /LowerRight {
	      /InitialDefaultPosition { % w h => x y
		  /bbox /parent self send send
		  pop 3 -1 roll add 4 -1 roll sub exch
		  3 -1 roll add
	      } store
	      /WindowYIncrement 37 store
	      /WindowXIncrement 0 store
	  }
	  /Default {}
      } case
  } def

  /UpperLeft setgravity

  /path { % x y w h => -
    10 dict begin
      /mat matrix currentmatrix def
      /h exch def /w exch def
      translate
      TabEdge {
	/Left {
	  TabWidth 0 moveto
	  0 h TabHeight sub TabPosition mul round rlineto
	  TabWidth neg 0 rlineto
	  0 TabHeight rlineto
	  TabWidth 0 rlineto
	  TabWidth h lineto
	  w h lineto
	  w 0 lineto
	  closepath
	}
	/Right {
	  h TabHeight sub TabPosition mul round
	  0 0 moveto
	  0 h rlineto
	  w TabWidth sub 0 rlineto
	  0 1 index TabHeight add h sub
	  rlineto
	  TabWidth 0 rlineto
	  0 TabHeight neg rlineto
	  TabWidth neg 0 rlineto
	  0 exch neg rlineto
	  closepath
	}
	/Top {
	  0 0 moveto
	  0 h TabHeight sub rlineto
	  w TabWidth sub TabPosition mul round 0 rlineto
	  0 TabHeight rlineto
	  TabWidth 0 rlineto
	  0 TabHeight neg rlineto
	  w h TabHeight sub lineto
	  w 0 lineto
	  closepath
	}
	/Bottom {
	  0 TabHeight moveto
	  0 h TabHeight sub rlineto
	  w 0 rlineto
	  0 h TabHeight sub neg rlineto
	  w TabWidth sub TabPosition mul round TabWidth add TabHeight lineto
	  0 TabHeight neg rlineto
	  TabWidth neg 0 rlineto
	  0 TabHeight rlineto
	  closepath
	}
      } case
      mat setmatrix
    end % tempdict
  } def

  % given tabbed frame bbox, returns bbox of frame w/out tab
  /unfittab { % x y w h => x' y' w' h'
      TabEdge {
        /Left {
	  4 -1 roll TabWidth add 4 1 roll
	  exch TabWidth sub exch
	}
	/Right {
	  exch TabWidth sub exch
	}
	/Top {
	  TabHeight sub
	}
	/Bottom {
	  3 -1 roll TabHeight add 3 1 roll
	  TabHeight sub
	}
      } case
  } def

  % given untabbed frame bbox, returns bbox of frame with tab
  /fittab { % x' y' w' h' => x y w h
      TabEdge {
        /Left {
	  4 -1 roll TabWidth sub 4 1 roll
	  exch TabWidth add exch
	}
	/Right {
	  exch TabWidth add exch
	}
	/Top {
	  TabHeight add
	}
	/Bottom {
	  3 -1 roll TabHeight sub 3 1 roll
	  TabHeight add
	}
      } case
  } def

  % Return the corner farthest from the given x y.
  % Coordinates are in the parents space.
  %
  /farthestcorner { % x y =>  x' y'
      /bbox self send
      4 copy rect2points 10 4 roll
      unfittab rect2points % x y x0 y0 x1 y1 X0 Y0 X1 Y1
      3 index 6 index sub abs 2 index 7 index sub abs gt
      {9} {7} ifelse index
      3 index 6 index sub abs 2 index 7 index sub abs gt
      {9} {7} ifelse index
      mark 13 3 roll cleartomark       % x y X0 Y0 X1 Y1 x' y' => x' y'
  } def

  /StrokeCanvas { % color inset => -
      % REMIND: Should this use thick lines?
      exch setcolor
      gsave
        dup add setlinewidth
        /bbox self send /path self send
        stroke
      grestore
  } def

  % Grow to full (screen) size  (true) or revert to normal size (false).
  %
  /zoom { % bool => -
      dup /zoomed? self send eq {pop} {
	  gsave                       % bool
	  framebuffer setcanvas       % bool
	      {
		  /UnZoomedSize [
		    /bbox self send unfittab 
		    TabEdge TabPosition ] promote
		  ZoomTabPosition setposition 
		  ZoomTabEdge setedge
		  ZoomX ZoomY ZoomWidth ZoomHeight
		  ?validate % XXX?
		  fittab
	      }{
		  UnZoomedSize aload pop
		  setposition setedge
		  ?validate % XXX?
		  fittab
		  /UnZoomedSize /unpromote self send
	      } ifelse
	      /reshape self send
	  grestore
      } ifelse
      /mapped? self send not {true /open self send} if
  } def

  % make a default base frame with footer & grow control; then call vanilla
  % initialization procs for labels, footer, reshape etc.
  /demo { % - => window
    10 dict begin
      % make a base frame and initialize it:
      [ FlexBag ]
      [/Footer true] framebuffer
	  /newdefault ClassName load send
      /frame exch def
      /bag /client frame send def
      [ (Top) null {
	  /Top /resetedge /parent target send send }
        (Bottom) null {
	  /Bottom /resetedge /parent target send send }
	(Left) null {
	  /Left /resetedge /parent target send send }
        (Right) null {
	  /Right /resetedge /parent target send send }
      ] framebuffer /new OpenLookMenu send
      /setmenu bag send

      /Right /setedge frame send
      random /setposition frame send
      null
      random random 4 div  random 4 div .75 add hsbcolor 
      null
      /setcolors frame send
      null
      random  random  random 4 div .75 add hsbcolor 
      null 
      /setcolors bag send
      (Tab Frame) /setlabel frame send
      (Take a look) (and feel free!) /setfooter frame send
      200 100 200 500 /reshape frame send
      /activate frame send
      /map frame send
      frame
    end
  } def

classend def

/TabBaseFrame [OpenLookBaseFrame TabFrame] []
classbegin classend def

/TabPropertyFrame [OpenLookPropertyFrame TabFrame] []
classbegin classend def

/TabCommandFrame [OpenLookCommandFrame TabFrame] []
classbegin classend def

/TabHelpFrame [OpenLookHelpFrame TabFrame] []
classbegin classend def

{ /BaseFrameClass { TabBaseFrame } def
  /PropertyFrameClass { TabPropertyFrame } def
  /CommandFrameClass { TabCommandFrame } def
  /HelpFrameClass { TabHelpFrame } def
} ClassFrame send

{  /DefaultClass { TabBaseFrame } def } ClassBaseFrame send
{  /DefaultClass { TabPropertyFrame } def } ClassPropertyFrame send
{  /DefaultClass { TabCommandFrame } def } ClassCommandFrame send
{  /DefaultClass { TabHelpFrame } def } ClassHelpFrame send

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% OpenLookTabFrameCorners
%

/OpenLookTabFrameCorners OpenLookFrameCorners []
classbegin

    /Edges { % x y w h delta => -
	20 dict begin
	    /d exch def /h exch def /w exch def /y exch def /x exch def
	    /-d d neg def /D d 2 mul def /-D D neg def
	    /X x w add def /Y y h add def

	    x y h .5 mul add [ 0  d  d -D -d ] polyrectpath
	    X y h .5 mul add [ 0 -d -d  D  d ] polyrectpath
	    x w .5 mul add y [ d  d -D -d ] polyrectpath
	    x w .5 mul add Y [ d -d -D  d ] polyrectpath
	end
    } def

    % Override
    %
    % Hack: the path should be made from Corners; however, because
    % in 1.1 a fat line cannot intercept the clip, we use a fudge:
    % we make the path slightly larger than desired.
    %
    /path { % x y w h => -
	Delta 2 add 5 copy Corners Edges
    } def

    /PaintCanvas { % - => -
	% Fat line problem: we can't do the obvious:
	% FillColor setcolor clippath fill
	% 1 setlinequality 2 setlinewidth
	% StrokeColor setcolor clippath stroke

	.5 .5 Width 1 sub Height 1 sub Delta 5 copy Corners Edges
	FillColor setcolor gsave fill grestore
	StrokeColor setcolor stroke
    } def

classend def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% OpenLookTabFrameLabel
%

/OpenLookTabFrameLabel [ClassControl OpenLookFrameLabel] []
classbegin

  /EventHandler { % event => -
    % callnotify puts self on stack and calls NotifyUser
    unblockinputqueue
    /callnotify self send
  } def

  /EventsConsumed /MatchedEvents def

  /ControlButton AdjustButton def	% Which mouse button to use

  % This is so we can drag a string into the label.
  /MakeInterests {
    /MakeInterests super send
    Canvas /setlabel true /new AsciiTransferInterest send
  } def

classend def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

end % systemdict