#! /usr/NeWS/bin/psh
%
% 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
%
%
% "@(#)flags 9.3 88/01/18
%
% Copyright (c) 1987 by Sun Microsystems, Inc.
%

%!PS-Adobe-1.0
%

/edef { exch def } def
/nscale { exch div 1 scale } def

/blue	{ 0 0 1 } def
/yellow	{ 1 1 0 } def
/green	{ 0 1 0 } def
/red	{ 1 0 0 } def
/black	{ 0 0 0 } def
/white	{ 1 1 1 } def

/ssetrgbcolor {			% r g b ssetrgbcolor -
    colorcanvas
	{ setrgbcolor }
	{ .3 mul exch .6 mul add exch .1 mul add setgray }
	ifelse
} def

/filled-circle {		% color x y rad filled-circle -
    gsave
    0 360 arc
    ssetrgbcolor
    fill
    grestore
} def

/filled-box {			% color llx lly urx ury filled-box -
    10 dict begin
    gsave
    /ury edef
    /urx edef
    /lly edef
    /llx edef
    newpath
    llx lly moveto
    llx ury lineto
    urx ury lineto
    urx lly lineto
    closepath
    ssetrgbcolor
    fill
    grestore
    end
} def


/box {				% llx lly urx ury box -
    4 dict begin
    /ury edef
    /urx edef
    /lly edef
    /llx edef
    newpath
    llx lly moveto
    llx ury lineto
    urx ury lineto
    urx lly lineto
    closepath
    stroke
    end
} def

/background {		% color background -
    0 0 1 1 filled-box
} def

/frame {			% yscale xscale frame -
    gsave
    nscale
    0 0 1 1 box
    grestore
} def

/std-cross {			% color std-cross -
    3 dict begin
    /b edef
    /g edef
    /r edef
    newpath
    r g b 0 .4 1 .6 filled-box
    r g b .25 0 .4 1 filled-box
    end
} def

/diag-cross {			% color diag-cross -
    gsave
    ssetrgbcolor

    newpath
    0 .05 moveto
    .95 1 lineto
    1 1 lineto
    1 .95 lineto
    .05 0 lineto
    0 0 lineto
    closepath
    fill

     0 .95 moveto
    .95 0 lineto
    1 0 lineto
    1 .05 lineto
    0.05 1 lineto
    0 1 lineto
    closepath
    fill
    grestore
} def

/thin-diag-cross {			% color thin-diag-cross -
    gsave
    ssetrgbcolor

    newpath
    0 .03 moveto
    .97 1 lineto
    1 1 lineto
    1 .97 lineto
    .03 0 lineto
    0 0 lineto
    closepath
    fill

     0 .97 moveto
    .97 0 lineto
    1 0 lineto
    1 .03 lineto
    0.03 1 lineto
    0 1 lineto
    closepath
    fill
    grestore
} def

/cross-template {		% cross-color background-color yscale xscale cross-template -
    gsave
    nscale
    background
    std-cross
    grestore
} def

/thin-cross {			% color yscale xscale thin-cross
    3 dict begin
    gsave
    nscale
    /b edef
    /g edef
    /r edef
    r g b 0 .44 1 .56 filled-box
    r g b .28 0 .37 1 filled-box
    grestore
    end
} def

/vertical-stripe-template {	% left mid right yscale xscale vertical-stripe-template -
    gsave
    nscale
    white background
    2 3 div 0 1 1 filled-box
    1 3 div 0 2 3 div 1 filled-box
    0 0 1 3 div 1 filled-box
    grestore
} def

/horizontal-stripe-template {	% top mid bottom yscale xscale horizontal-stripe-template -
    gsave
    nscale
    white background
    0   0	  1   1 3 div	filled-box
    0   1 3 div	  1   2 3 div	filled-box
    0   2 3 div	  1   1		filled-box
    grestore
} def

/star {
    newpath
    moveto
    -0.0125  0.005	rmoveto
     0.01    0		rlineto
     0.0025  0.01	rlineto
     0.0025 -0.01	rlineto
     0.01    0		rlineto
    -0.0075 -0.006	rlineto
     0.004  -0.009	rlineto
    -0.009   0.005	rlineto
    -0.009  -0.005	rlineto
     0.004   0.009	rlineto
%   -0.0075  0.006	rlineto
    closepath
    fill
} def

% draw star with center at origin and circumcircle of specified diameter
/unitstar {   % diameter unitstar => -
    gsave
	dup scale
	0 .5 moveto
	.2939 -.4045 lineto
	-.4755 .1545 lineto
	.4755 .1545 lineto
	-.2939 -.4045 lineto
	closepath fill
    grestore
} def

% draw .1 unitstar at (x, y) with tip pointing towards origin
/littlestar { % x y littlestar => -
    gsave
      dup 3 -1 roll dup 3 -1 roll     % y x x y
      translate atan 90 add rotate
      .1 unitstar
    grestore
} def

/legend {			% (text) legend -
    .1 0 moveto show
} def

/Austria {
    red white red 2 3 horizontal-stripe-template
    { 2 3 frame } if
} def

/Australia {
    /frame? edef
    gsave
	1 2 nscale
	blue background
	grestore
    gsave
	.5 .5 scale
	0 1 translate
	false United-Kingdom
	grestore
    frame? { 1 2 frame } if
} def

/Belgium {
    black yellow red 13 15 vertical-stripe-template
    { 13 15 frame } if
} def

/Bulgaria {
    white green red 3 5 horizontal-stripe-template
    { 3 5 frame } if
} def

/Canada {
    gsave
    8 17 nscale
    red 25 34 div 0 1 1 filled-box
    white 9 34 div 0 25 34 div 1 filled-box
    red 0 0 9 34 div 1 filled-box
    9 34 div 0 translate
    8 17 div 1 scale
    red ssetrgbcolor
    newpath
    .48 .1 moveto
    .52 .1 lineto
    .51 .35 lineto
    .7 .33 lineto
    .67 .4 lineto
    .8 .55 lineto
    .77 .58 lineto
    .8 .65 lineto
    .75 .63 lineto
    .74 .67 lineto
    .575 .55 lineto
    .6 .8 lineto
    .55 .75 lineto
    .5 .85 lineto % point of symetry
    .45 .75 lineto
    .4 .8 lineto
    .425 .55 lineto
    .26 .67 lineto
    .25 .63 lineto
    .2 .65 lineto
    .23 .58 lineto
    .2 .55 lineto
    .33 .4 lineto
    .3 .33 lineto
    .49 .35 lineto
    closepath
    fill
    grestore
    { 8 17 frame } if
} def

/China {
    6 dict begin
    gsave
	/x1 .27 def
	/x2 .37 def
	/y1 .15 def
	/y2 18 sin .15 mul def
	/y3 y2 y1 y2 sub dup mul x2 x1 sub dup mul add sqrt sub def
	/y4 y3 y2 add y1 sub def

	2 3 nscale red background
	3 2 nscale yellow ssetrgbcolor

	.25 .75 translate
	.3 unitstar

	x1 y1 littlestar
	x2 y2 littlestar
	x2 y3 littlestar
	x1 y4 littlestar
    grestore
    end
    { 2 3 frame } if
} def

/Colombia {
    gsave
	2 3 nscale
	yellow background
	blue 0 .25 1 .5  filled-box
	red  0 0   1 .25 filled-box
	grestore
    { 2 3 frame } if
} def

/Czechoslovakia {
    gsave
	2 3 nscale
	white background
	red 0 0 1 .5 filled-box
	blue ssetrgbcolor
	0 0 moveto
	.5 .5 lineto
	0 1 lineto
	closepath
	fill
	grestore
    { 2 3 frame } if
} def

/Denmark {
    /frame? edef
    white red 28 37 cross-template
    frame? { 28 37 frame } if
} def

/Finland {
    blue white 11 18 cross-template
    { 11 18 frame } if
} def

/France {
    blue white red 2 3 vertical-stripe-template
    { 2 3 frame } if
} def

/Greece {
    gsave
      2 3 nscale
      white background
      0 1 4.5 div .99 { /y edef blue 0 y 1 y 1 9 div add filled-box } for
      grestore
    gsave
       0 4 9 div translate
       5 9 div dup scale
       blue background
       white std-cross
       grestore
    { 2 3 frame } if
} def

/Iceland {
    white blue 18 25 cross-template
    red 18 25 thin-cross
    { 18 25 frame } if
} def

/Ireland {
    green white yellow 1 2 vertical-stripe-template
    { 1 2 frame } if
} def

/Israel {
    /frame? edef
    gsave
	8 11 nscale
	white background
	blue 0 14 173 div 1 44 173 div filled-box
	blue 0 129 173 div 1 159 173 div filled-box
	newpath
	.5 .65 moveto
	.4 .42 lineto
	.6 .42 lineto
	closepath
	.5 .35 moveto
	.4 .58 lineto
	.6 .58 lineto
	closepath
	blue ssetrgbcolor
	stroke
	grestore
    frame? { 8 11 frame } if
} def

/Italy {
    green white red 2 3 vertical-stripe-template
    { 2 3 frame } if
} def

/Japan {
    /frame? edef
    gsave
	2 3 nscale
	white background
	grestore
    red .5 3 mul 2 div .5 .3 filled-circle
    frame? { 2 3 frame } if
} def

/Luxembourg {
    red white blue 3 5 horizontal-stripe-template
    { 3 5 frame } if
} def

/Netherlands {
    red white blue 2 3 horizontal-stripe-template
    { 2 3 frame } if
} def

/New-Zealand {
    /frame? edef
    gsave
	1 2 nscale
	blue background
	grestore
    gsave
	.5 .5 scale
	0 1 translate
	false United-Kingdom
	grestore
    frame? { 1 2 frame } if
} def


/Norway {
    white red 8 11 cross-template
    blue 8 11 thin-cross
    { 8 11 frame } if
} def

/Sweden {
    yellow blue 5 8 cross-template
    { 5 8 frame } if
} def

/Switzerland {
    10 dict begin
    gsave
	1 1 nscale
	red background
	/w .1 def				% half-width
	/l 1 2 7 mul 6 div add w mul def	% half-length
	white .5 l sub .5 w sub .5 l add .5 w add filled-box
	white .5 w sub .5 l sub .5 w add .5 l add filled-box
	grestore
    { 1 1 frame } if
    end
} def

/Thailand {
    gsave
	2 3 nscale
	red background
	white 0 1 6 div 1 5 6 div filled-box
	blue  0 1 3 div 1 2 3 div filled-box
	grestore
    { 2 3 frame } if
} def

/United-Kingdom {
    gsave
	1 2 nscale
	blue background
	white 0 .4 1 .6 filled-box
	white .425 0 .575 1 filled-box
	white diag-cross
	red thin-diag-cross
	red 0 .44 1 .56 filled-box
	red .455 0 .545 1 filled-box
	grestore
    { 1 2 frame } if
} def

/USA {
    2 dict begin
    gsave
    10 19 nscale
    white background
    0 1 6.5 div .99 { /y edef red 0 y 1 y 1 13 div add filled-box } for
    blue 0 6 13 div .4 1 filled-box
    white ssetrgbcolor
    0 1 4 {
	/y edef
	0 1 5 {
	    /x edef
	    newpath
	    x .065 mul .03 add y .095 mul .54 add star
	} for
    } for
    0 1 3 {
	/y edef
	0 1 4 {
	    /x edef
	    newpath
	    x .065 mul .06 add y .095 mul .58 add star
	} for
    } for
    black ssetrgbcolor
    grestore
    { 10 19 frame } if
    end
} def

/West-Germany {
    black red yellow 3 5 horizontal-stripe-template
    { 3 5 frame } if
} def

/bigflag 4 def
/big? false def

/country-names [
    (Austria)
    (Australia)
    (Belgium)
    (Bulgaria)
    (Canada)
%   (Chile)
    (China)
    (Colombia)
%   (Cuba)
    (Czechoslovakia)
    (Denmark)
    (Finland)
    (France)
    (Greece)
    (Iceland)
%   (Indonesia)
    (Ireland)
    (Israel)
    (Italy)
    (Japan)
%   (Korea)
    (Luxembourg)
%   (Monaco)
    (Netherlands)
    (New Zealand)
    (Norway)
%   (Soviet Union)
    (Sweden)
    (Switzerland)
    (Thailand)
    (United Kingdom)
    (USA)
    (West Germany)
] def

/flag-routines [
    /Austria
    /Australia
    /Belgium
    /Bulgaria
    /Canada
    /China
    /Colombia
    /Czechoslovakia
    /Denmark
    /Finland
    /France
    /Greece
    /Iceland
    /Ireland
    /Israel
    /Italy
    /Japan
    /Luxembourg
    /Netherlands
    /New-Zealand
    /Norway
    /Sweden
    /Switzerland
    /Thailand
    /United-Kingdom
    /USA
    /West-Germany
] def

/flag-scales [
    [2 3]		% /Austria
    [1 2]		% /Australia
    [13 15]		% /Belgium
    [3 5]		% /Bulgaria
    [8 17]		% /Canada
    [2 3]		% /China
    [2 3]		% /Colombia
    [2 3]		% /Czechoslovakia
    [28 37]		% /Denmark
    [11 18]		% /Finland
    [2 3]		% /France
    [2 3]		% /Greece
    [18 25]		% /Iceland
    [1 2]		% /Ireland
    [8 11]		% /Israel
    [2 3]		% /Italy
    [2 3]		% /Japan
    [3 5]		% /Luxembourg
    [2 3]		% /Netherlands
    [1 2]		% /New-Zealand
    [8 11]		% /Norway
    [5 8]		% /Sweden
    [1 1]		% /Switzerland
    [2 3]		% /Thailand
    [1 2]		% /United-Kingdom
    [10 19]		% /USA
    [3 5]		% /West-Germany
] def

/nflags flag-routines length def
/nrows 5 def
/ncols nflags 1 sub nrows idiv 1 add def
/flagsize 95 def

/pickmin {			% x y pickmin min(x,y)
    2 dict begin
    /y edef
    /x edef
    x y lt { x } { y } ifelse
    end
} def

/doflag {			% index doflag -
    10 dict begin
    /i edef
    gsave
    0 .15 translate
    .6 .6 scale
    true flag-routines i get cvx exec
    grestore
    country-names i get legend
    end
} def

/big {				% - big -
    10 dict begin
    /bigscale flag-scales bigflag get aload pop div def
    gsave
	clippath pathbbox /y edef /x edef pop pop
	/s x bigscale mul y pickmin def
	y s gt { 0 y s sub 2 div translate } if
	x s bigscale div gt { x s bigscale div sub 2 div 0 translate } if
	s s scale
    true flag-routines bigflag get cvx exec
    grestore
    end
} def



/all-flags {
    gsave 1 fillcanvas grestore
    gsave
	/Helvetica findfont .12 scalefont setfont
	10 dict begin
	clippath pathbbox
	    wheight div /hscale edef
	    wwidth div /wscale edef
	    pop pop
	/mscale wscale hscale pickmin def
	/hscale hscale mscale div store
	/wscale wscale mscale div store
	mscale mscale scale
	flagsize flagsize scale
	.1 .1 translate
	0 nrows hscale mul translate
	0 1 ncols 1 sub {
	    /col edef
	    0 1 nrows 1 sub {
		0 -1 hscale mul translate
		col nrows mul add dup nflags lt { doflag } {pop} ifelse
	    } for
	    1.5 wscale mul nrows hscale mul translate
	} for
	end
	grestore
} def


/iconscale 1 def

/ican-y 48 def
/ican-x 48 def

/seticonshape {			% - seticonshape -
    win begin
    gsave
    /iconscale flag-scales bigflag get aload pop exch div def
    ParentCanvas setcanvas
    newpath
    IconX IconY
    dup null eq { pop pop 0 0 } if
    moveto
    ican-x iconscale mul ican-y rect
    IconCanvas setcanvasshape
    grestore
    end
} def

/wwidth  ncols flagsize mul 1.5 mul def
/wheight nrows flagsize mul         def

/big-menu
    country-names
    [ {
	/bigflag /currentindex self send store
	seticonshape
	can setcanvas
	gsave 1 fillcanvas grestore
	/big? true store
	% big
	/paintclient win send
    } ]
    /new DefaultMenu send def

/win framebuffer /new DefaultWindow send def	% Create a window
{							% Install my stuff.
    /FrameLabel (Flags of the World) def
    /PaintClient { ClientCanvas setcanvas big? {big} {all-flags} ifelse } def
    /PaintIcon { IconCanvas setcanvas big } def
    /ClientMenu [
	(All)		{ can setcanvas /big? false store all-flags }
	(One =>)	big-menu
    ] /new DefaultMenu send def
} win send
/reshapefromuser win send			% Shape it.
% 100 50 wwidth wheight /reshape win send	% Shape it.
/map win send  % Map the window. (Damage causes PaintClient to be called)

/can win /ClientCanvas get def
/ican win /IconCanvas get def

