%% $Id: pst-bar.tex 603 2022-09-10 07:53:35Z herbert $
%%
%%
%% This is file `pst-bar.tex',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pst-bar.tex'
%%
%% Alan Ristow 
%% Herbert Voss <Herbert.Voss _at_ pstricks.de>
%%
%% This program can be redistributed and/or modified under the terms
%% of the LaTeX Project Public License Distributed from CTAN archives
%% in directory macros/latex/base/lppl.txt.
%%
%% DESCRIPTION:
%%   `pst-bar' is a PSTricks package for additionals to the standard
%%         pstricks package
%%
\csname PSTBarLoaded\endcsname%
\let\PSTBarLoaded\endinput%
\ifx\PSTricksLoaded\endinput\else\input pstricks \fi
\ifx\PSTplotLoaded\endinput\else\input pst-plot \fi
\ifx\PSTXKeyLoaded\endinput\else\input pst-xkey \fi


\def\fileversion{0.93}
\def\filedate{2022/09/10}
\message{`pst-bar' v\fileversion, \filedate\space (Alan Ristow, hv)}%

\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax

\pstheader{pst-bar.pro}%
\pst@addfams{pst-bar}

\newlength\psk@labelwidth%
\define@key[psset]{pst-bar}{barsep}{\edef\psk@barsep{#1}}%
\define@key[psset]{pst-bar}{barcolsep}{\edef\psk@barcolsep{#1}}%
\define@key[psset]{pst-bar}{barstyle}{\def\@barstylelist{#1}}%
\define@key[psset]{pst-bar}{barlabelrot}{\edef\psk@barlabelrot{#1}}%
\define@key[psset]{pst-bar}{labelalign}{\def\psk@labelalign{#1}}%
\define@key[psset]{pst-bar}{labelwidth}{\setlength\psk@labelwidth{#1}}%
\def\psk@labelalign{\centering}%
\setlength\psk@labelwidth{0.5in}%
%
% chartstyle=cluster|stack|block  (0,1,2)
\define@key[psset]{pst-bar}{chartstyle}{\pst@expandafter\psset@@chartstyle{#1}\@nil\psk@chartstyle}%
\def\psset@@chartstyle#1#2\@nil#3{%
  \ifx#1c\let#3\z@\else
    \ifx#1s\let#3\@ne\else
      \ifx#1b\let#3\tw@\else
        \@pstrickserr{Bad argument: `#1#2'}\@ehpa
      \fi
    \fi
  \fi
}%
% orientation=vertical|horizontal (0,1)
\define@key[psset]{pst-bar}{orientation}{\pst@expandafter\psset@@orientation{#1}\@nil\psk@orientation}%
\def\psset@@orientation#1#2\@nil#3{%
  \ifx#1h\let#3\p@\else
    \ifx#1v\let#3\z@\else
      \@pstrickserr{Bad argument: `#1#2'}\@ehpa
    \fi
  \fi
}%
\define@key[psset]{pst-bar}{header}{\pst@expandafter\psset@@header{#1}\@nil\psk@header}%
\def\psset@@header#1#2\@nil#3{%
  \ifx#1t\let#3\z@\else
    \ifx#1f\let#3\@ne\else
      \@pstrickserr{Bad argument: `#1#2'}\@ehpa
    \fi
  \fi
}%
\psset[pst-bar]{barsep=0.0,barcolsep=0.4,barstyle=\@empty,barlabelrot=0,%
  chartstyle=cluster,orientation=vertical,header=true}%

\def\psbarchart{\def\pst@par{}\pst@object{psbarchart}}%
\def\pstbar@header{\@empty}%
\def\psbarlabel#1{#1}%
\def\psbarlabelsep{0pt}%
\def\psbarscale(#1)#2{%
  \def\psbar@mul{#1\space}%
  \def\psbar@psop{#2\space}%
}
\def\psbar@mul{1\space}%
\def\psbar@psop{\@empty}%

\newread\pstbar@file%

% Define bar chart styles

\def\newpsbarstyle#1#2{\@namedef{psbarcs@#1}{\psset{#2}}}%

\def\begin@barstyle{\def\pst@tempd{/barstyles [ }}%
\def\add@barstyle{%
  \def\pst@code{}%
  \ifpsshadow%
    \pst@closedshadow%
  \fi%
  \ifdim\psk@border\p@>\z@%
    \pst@addborder%
  \fi%
  \psk@fillstyle%
  \pst@stroke%
  \ifpsdoubleline%
    \pst@doublestroke%
  \fi%
  \def\pst@tempa{\strip@pt\psk@orientation}%
  \edef\pst@tempd{ \pst@tempd (%
    \pst@tempc \psk@cornersize%
    xbar1 ybar1 xbar2 ybar2 4 -\pst@tempa\space roll
    \psk@dimen%
    \tx@Frame%
    \pst@code )%
  }%
}
\def\end@barstyle{\edef\pst@tempd{ \pst@tempd ] def }}%

\def\setbarstyle{%
  \begin@barstyle%
  \expandafter\@setbarstyle\@barstylelist,\@nil\ignorespaces%
  \end@barstyle%
}%
\def\@setbarstyle#1,{%
  \@@setbarstyle{#1}%
  \@ifnextchar\@nil{\@gobble}{\@setbarstyle}%
}%
\def\@@setbarstyle#1{%
  \@ifundefined{psbarcs@#1}%
  {\@pstrickserr{Custom bar chart style `#1' undefined}\@ehpa}%
  {\@nameuse{psbarcs@#1}\add@barstyle}%
}%

% Default bar chart styles

\newpsbarstyle{red}{fillcolor=red,fillstyle=solid,framearc=0}%
\newpsbarstyle{green}{fillcolor=green,fillstyle=solid,framearc=0}%
\newpsbarstyle{blue}{fillcolor=blue,fillstyle=solid,framearc=0}%
\newpsbarstyle{black}{fillcolor=black,fillstyle=solid,framearc=0}%
\newpsbarstyle{white}{fillcolor=white,fillstyle=solid,framearc=0}%
\newpsbarstyle{gray}{fillcolor=gray,fillstyle=solid,framearc=0}%
\newpsbarstyle{lightgray}{fillcolor=lightgray,fillstyle=solid,framearc=0}%
\newpsbarstyle{darkgray}{fillcolor=darkgray,fillstyle=solid,framearc=0}%

%\psset@barstyle{black,darkgray,gray,lightgray,white,red,green,blue}%
\psset[pst-bar]{barstyle={black,darkgray,gray,lightgray,white,red,green,blue}}%

\def\readpsbardata{\@ifnextchar[{\readpsbardata@i}{\readpsbardata@i[]}}

\def\readpsbardata@i[#1]#2#3{%
  \def\pst@tempa{#1}%
  \ifx\pst@tempa\@empty\else\psset{#1}\fi
  \openin\pstbar@file=#3\relax%
  \ifeof\pstbar@file%
    \@pstrickserr{Data file `#3' not found.}\@ehpa
  \else
    \def\pst@tempb{\@empty}%
    \ifx\psk@header\z@%
      \@readpsbarheader%
    \fi
    \readpsbardata@ii%
    \edef\pst@tempb{[\pst@tempb]}%
    \let#2\pst@tempb%
  \fi
  \closein\pstbar@file%
}%

\def\readpsbardata@ii{%
  \read\pstbar@file to \pst@tempa
  \ifeof\pstbar@file
    \relax
  \else
    \edef\pst@tempb{\pst@tempb [}%
    \expandafter\readpsbardata@iii\pst@tempa,\@nil\ignorespaces%
    \edef\pst@tempb{\pst@tempb ]}%
    \readpsbardata@ii%
  \fi
}%

\def\readpsbardata@iii#1,{%
  \edef\pst@tempb{\pst@tempb #1\space}%
  \@ifnextchar\@nil{\@gobble}{\readpsbardata@iii}%
}%

\def\@readpsbarheader{%
  \read\pstbar@file to \pst@tempa
  \ifeof\pstbar@file
    \relax
  \else
    \let\pstbar@header\pst@tempa
  \fi
}%

% Apply labels from file header to bar chart columns.
% TODO: Deal with column headings that contain commas.

% The trimspaces command is (c) Michael Downes 1994
% (http://www.tug.org/tex-archive/info/aro-bend/answer.015).
\catcode`\Q=3
\def\psbar@trimspaces#1{%
  \begingroup
  \aftergroup\toks\aftergroup0\aftergroup{%
  \expandafter\trimb\expandafter\noexpand#1Q Q}%
  \edef#1{\the\toks0}%
}
\def\trimb#1 Q{\trimc#1Q}
\def\trimc#1Q#2{\afterassignment\endgroup \vfuzz\the\vfuzz#1}
\catcode`\Q=11

\def\pstbar@xlabels{%
  \pst@dima=-0.5pt\relax%
  \expandafter\pstbar@xlabels@i\pstbar@header,\@nil\ignorespaces%
}%

\def\pstbar@xlabels@i#1,{%
  \def\pst@tempa{#1}%
  \psbar@trimspaces\pst@tempa%
  \advance\pst@dima by 1pt%
  \def\pst@tempb{\strip@pt\pst@dima}%
  \uput[-90]{\psk@barlabelrot}(\pst@tempb,-\psbarlabelsep){\psbarlabel{\parbox{\psk@labelwidth}{\psk@labelalign\pst@tempa}}}%
  \@ifnextchar\@nil{\@gobble}{\pstbar@xlabels@i}%
}%

\def\pstbar@labelcount#1{%
  \pst@dima=0pt\relax%
  \expandafter\pstbar@labelcount@i\pstbar@header,\@nil\ignorespaces%
  \let#1\pst@dima%
}%

\def\pstbar@labelcount@i#1,{%
  \advance\pst@dima by 1pt%
  \@ifnextchar\@nil{\@gobble}{\pstbar@labelcount@i}%
}%

\def\pstbar@ylabels{%
  \pstbar@labelcount{\pst@dima}%
  \advance\pst@dima by 0.5pt%
  \expandafter\pstbar@ylabels@i\pstbar@header,\@nil\ignorespaces%
}%

\def\pstbar@ylabels@i#1,{%
  \def\pst@tempa{#1}%
  \psbar@trimspaces\pst@tempa%
  \advance\pst@dima by -1pt%
  \def\pst@tempb{\strip@pt\pst@dima}%
  \uput[180]{\psk@barlabelrot}(-\psbarlabelsep,\pst@tempb){\psbarlabel{\parbox{\psk@labelwidth}{\psk@labelalign\pst@tempa}}}%
  \@ifnextchar\@nil{\@gobble}{\pstbar@ylabels@i}%
}%

\def\psbarchart@i#1{%
  \pst@killglue%
  \begingroup%
    \use@par%
    \psbarchart@ii{#1}%
  \endgroup%
  \ignorespaces%
}%

\def\psbarchart@ii#1{%
  \begin@SpecialObj%

    % Save contents of \pst@code and load start-of-path code
    % into \pst@tempc

    \let\pst@tempb\pst@code%
    \def\pst@code{}%
    \solid@star%
    \let\pst@tempc\pst@code%

    % Load end-of-path code into \pst@tempd and restore original
    % contents of \pst@code

    \begin@barstyle%
    \expandafter\@setbarstyle\@barstylelist,\@nil\ignorespaces%
    \end@barstyle%
    \let\pst@code\pst@tempb%

    % Draw bar chart

    \pst@checknum\psk@barcolsep\pst@tempa%
    \pst@checknum\psk@barsep\pst@tempb%
    \ifx\psk@orientation\z@             % vertical
      \pst@dima=\psxunit%
      \pst@dimb=\psyunit%
      \def\pst@tempc{true}%
    \else\ifx\psk@orientation\p@        % horizontal
      \pst@dima=\psyunit%
      \pst@dimb=\psxunit%
      \def\pst@tempc{false}%
    \else
      \@pstrickserr{Bad orientation specification}\@ehpa
    \fi\fi
    \ifcase\psk@chartstyle% chartstyle=cluster
      \addto@pscode{%
        /scx { \pst@number\psxunit mul } def 
        /scy { \pst@number\psyunit mul } def
        \pst@tempd%
        /BARDATA #1 def
        /nbars BARDATA length def
        /ncols BARDATA 0 get length def
        /colwidth \pst@number\pst@dima def
        /barcolsep \pst@tempa \pst@number\pst@dima mul def
        /barsep \pst@tempb \pst@number\pst@dima mul def
        /barwidth colwidth barcolsep sub nbars 1 sub barsep mul sub nbars div def
        /bXoffset 0.5 barcolsep mul def
        /colcount \pst@tempc\space {0}{ncols 1 sub} ifelse def
        /barcount 0 def
        /ybar1 0 def
        BARDATA {
          /DATAVECTOR exch def
          DATAVECTOR {
            /ybar2 exch \psbar@psop \psbar@mul mul \pst@number\pst@dimb mul def
            /xoffset barwidth barsep add barcount mul bXoffset add def
            /xbar1 colcount colwidth mul xoffset add def
            /xbar2 xbar1 barwidth add def
            ybar1 ybar2 ne {  % if ybar1 == ybar2, don't stroke a path
              newpath
              barstyles barcount get cvx exec
            } if
            /colcount \pst@tempc\space {colcount 1 add}{colcount 1 sub} ifelse def
          } forall
          /colcount \pst@tempc\space {0}{ncols 1 sub} ifelse def
          /barcount barcount 1 add def
        } forall
      }%
    \or%  chartstyle=stack
      \addto@pscode{%
        \pst@tempd%
        tx@BarDict begin
        /BARDATA #1 transpose def
        /ncols BARDATA length def
        /colwidth \pst@number\pst@dima def
        /barcolsep \pst@tempa \pst@number\pst@dima mul def
        /barwidth colwidth barcolsep sub def
        /bXoffset 0.5 barcolsep mul def
        /colcount \pst@tempc\space {0}{ncols 1 sub} ifelse def
        /barcount 0 def
        /ybar1 0 def
        BARDATA {
          /DATAVECTOR exch def
          /xbar1 colcount colwidth mul bXoffset add def
          /xbar2 xbar1 barwidth add def
          /count 0 def
          DATAVECTOR {
            count 0 eq {
              /ybar2 exch \psbar@psop \psbar@mul mul \pst@number\pst@dimb mul ybar1 add def
            }{
              /ybar2 exch \psbar@mul mul \pst@number\pst@dimb mul ybar1 add def
            } ifelse
            ybar1 ybar2 ne {  % if ybar1 == ybar2, don't stroke a path
              newpath
              barstyles barcount get cvx exec
              closepath
            } if
            /ybar1 ybar2 def
            /barcount barcount 1 add def
            /count count 1 add def
          } forall
          /barcount 0 def
          /ybar1 0 def
          /colcount \pst@tempc\space {colcount 1 add}{colcount 1 sub} ifelse def
        } forall
        end
      }%
    \or% chartstyle=block
      \addto@pscode{%
        \pst@tempd%
        tx@BarDict begin
        /BARDATA #1 transpose def
        /ncols BARDATA length def
        /nbars BARDATA 0 get length 2 idiv def
        /colwidth \pst@number\pst@dima def
        /barcolsep \pst@tempa \pst@number\pst@dima mul def
        /barsep \pst@tempb \pst@number\pst@dima mul def
        /barwidth colwidth barcolsep sub nbars 1 sub barsep mul sub nbars div def
        /bXoffset 0.5 barcolsep mul def
        /colcount \pst@tempc\space {0}{ncols 1 sub} ifelse def
        /barcount 0 def
        /ybar1 0 def
        BARDATA {
          /DATAVECTOR exch def
          0 1 nbars 1 sub {
            dup
            /ybar1 exch 2 mul DATAVECTOR exch get \psbar@psop \psbar@mul mul \pst@number\pst@dimb mul def
            /ybar2 exch 2 mul 1 add DATAVECTOR exch get \psbar@psop \psbar@mul mul \pst@number\pst@dimb mul def
            /xoffset barwidth barsep add barcount mul bXoffset add def
            /xbar1 colcount colwidth mul xoffset add def
            /xbar2 xbar1 barwidth add def
            ybar1 ybar2 ne {  % if ybar1 == ybar2, don't stroke a path
              newpath
              barstyles barcount get cvx exec
            } if
            /barcount barcount 1 add def
          } for
          /barcount 0 def
          /colcount \pst@tempc\space {colcount 1 add}{colcount 1 sub} ifelse def
        } forall
        end
      }%
    \else%
      \@pstrickserr{Unknown chart style.}\@ehpa%
    \fi%
    \ifx\psk@orientation\z@%
      \pstbar@xlabels%
    \else
      \pstbar@ylabels%
    \fi
  \end@SpecialObj%
}%

\catcode`\@=\PstAtCode\relax
\endinput