% $Header: /cvsroot/html2ps/postscript/box.select.ps,v 1.1 2005/12/18 07:21:37 Konstantin Exp $

/box-select-button-triangle-padding 1.5 def

/box-select-create {
  box-container-create             % => Box
  dup box-select-setup-methods
  dup /box-select add-type
} def

/box-select-reflow {               % => Context Parent This
% append to parent line box
  dup 2 index box-container-append-line

% Determine coordinates of upper-left _margin_ corner
  1 index 1 index box-generic-guess-corner

% Determine the box width
  2 index 1 index /get-max-width call-method
  1 index put-full-width

  2 index 1 index
  box-container-reflow-content

  2 index context-pop-collapsed-margin
  0 3 index
  context-push-collapsed-margin    % => Context Parent This
             
  dup get-content 0 get get-baseline
  1 index get-extra-top add
  1 index put-baseline             % => Context Parent This

  dup get-baseline
  1 index put-default-baseline

% Offset parent current X coordinate
  1 index get-current-x
  1 index get-full-width add
  2 index put-current-x

% Extend parent height
  dup get-bottom-margin
  2 index box-generic-extend-height

  pop pop pop
} def

/box-select-setup-methods {        % => Box
  dup /Methods get
  dup /reflow {box-select-reflow} put
  dup /show   {box-select-show} put
  pop pop
} def

/box-select-show {                 % => Viewport Box
  2 copy box-container-show

  dup get-height
  1 index get-padding-top add
  1 index get-padding-bottom add   % => Viewport Box ButtonHeight

% Show arrow button box
  0.93 0.93 0.93 setrgbcolor
  1 index get-right-padding
  1 index sub                      % => Viewport Box ButtonHeight X
  2 index get-bottom-padding       % => Viewport Box ButtonHeight X Y
  2 index dup                      % => Viewport Box ButtonHeight X Y W H
  rectfill                         % => Viewport Box ButtonHeight

% Show box boundary
  0 0 0 setrgbcolor
  1 index get-right-padding
  1 index sub                      % => Viewport Box ButtonHeight X
  2 index get-bottom-padding       % => Viewport Box ButtonHeight X Y
  2 index dup                      % => Viewport Box ButtonHeight X Y W H
  rectstroke                       % => Viewport Box ButtonHeight

% Show arrow
  0 0 0 setrgbcolor
  
  1 index get-right-padding
  box-select-button-triangle-padding sub
  2 index get-top-padding
  box-select-button-triangle-padding sub moveto

  1 index get-right-padding
  1 index sub
  box-select-button-triangle-padding add
  2 index get-top-padding
  box-select-button-triangle-padding sub lineto

  1 index get-right-padding
  1 index 2 div sub
  2 index get-bottom-padding
  box-select-button-triangle-padding add lineto

  closepath
  fill

  pop pop pop
} def