## Copyright (C) 2006-2012 Michel D. Schmid
##
## This file is part of Octave.
##
## Octave is free software; you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 3 of the License, or (at
## your option) any later version.
##
## Octave is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with Octave; see the file COPYING.  If not, see
## <http://www.gnu.org/licenses/>.

## -*- texinfo -*-
## @deftypefn {Function File} {@var{h} =} __stem__ (@var{have_z}, @var{varargin})
## Undocumented internal function.
## @end deftypefn

## Author: Michel D. Schmid <michaelschmid@users.sourceforge.net>
## Adapted-by: jwe

function h = __stem__ (have_z, varargin)

  if (have_z)
    caller = "stem3";
  else
    caller = "stem";
  endif

  [hax, varargin, nargin] = __plt_get_axis_arg__ (caller, varargin{:});

  [x, y, z, dofill, llc, ls, mmc, ms, varargin] = ...
      check_stem_arg (have_z, varargin{:});

  oldfig = [];
  if (! isempty (hax))
    oldfig = get (0, "currentfigure");
  endif
  unwind_protect
    hax = newplot (hax);
    hold_state = get (hax, "nextplot");
    set (hax, "nextplot", "add");

    h = [];
    nx = rows (x);
    for i = 1 : columns (x)
      if (have_z)
        xt = x(:)';
        xt = [xt; xt; NaN(1, nx)](:);
        yt = y(:)';
        yt = [yt; yt; NaN(1, nx)](:);
        zt = z(:)';
        zt = [zeros(1, nx); zt; NaN(1, nx)](:);
      else
        xt = x(:, i)';
        xt = [xt; xt; NaN(1, nx)](:);
        yt = y(:, i)';
        yt = [zeros(1, nx); yt; NaN(1, nx)](:);
      endif

      hg = hggroup ();
      h = [h; hg];
      args = __add_datasource__ (caller, hg, {"x", "y", "z"}, varargin{:});

      if (isempty (llc))
        lc = __next_line_color__ ();
      else
        lc = llc;
      endif

      if (isempty (mmc))
        mc = lc;
      else
        mc = mmc;
      endif

      if (dofill)
        fc = mc;
      else
        fc = "none";
      endif

      if (have_z)
        h_stems = plot3 (hax, xt, yt, zt, "color", lc, "linestyle", ls,
                         "parent", hg, x, y, z, "color", mc,
                         "marker", ms, "linestyle", "none",
                         "markerfacecolor", fc, "parent", hg);

        h_baseline = [];
      else
        h_stems = plot (hax, xt, yt, "color", lc, "linestyle", ls,
                        "parent", hg, x(:,i), y(:, i), "color", mc, "marker",
                        ms, "linestyle", "none", "markerfacecolor",
                        fc, "parent", hg);

        x_axis_range = get (hax, "xlim");
        h_baseline = line (hax, x_axis_range, [0, 0], "color", [0, 0, 0]);
        set (h_baseline, "handlevisibility", "off");
        set (h_baseline, "xliminclude", "off");
        addlistener (hax, "xlim", @update_xlim);
        addlistener (h_baseline, "ydata", @update_baseline);
        addlistener (h_baseline, "visible", @update_baseline);
      endif

      ## Setup the hggroup and listeners.
      addproperty ("showbaseline", hg, "radio", "{on}|off");
      addproperty ("basevalue", hg, "data", 0);
      addproperty ("baseline", hg, "data", h_baseline);

      if (! have_z)
        addlistener (hg, "showbaseline", @show_baseline);
        addlistener (hg, "basevalue", @move_baseline);
      endif

      addproperty ("color", hg, "linecolor", lc);
      addproperty ("linewidth", hg, "linelinewidth", 0.5);
      addproperty ("linestyle", hg, "linelinestyle", ls);
      addproperty ("marker", hg, "linemarker", ms);
      addproperty ("markerfacecolor", hg, "linemarkerfacecolor", fc);
      addproperty ("markersize", hg, "linemarkersize", 6);

      addlistener (hg, "color", @update_props);
      addlistener (hg, "linewidth", @update_props);
      addlistener (hg, "linestyle", @update_props);
      addlistener (hg, "marker", @update_props);
      addlistener (hg, "markerfacecolor", @update_props);
      addlistener (hg, "markersize", @update_props);

      addproperty ("xdata", hg, "data", x(:, i));
      addproperty ("ydata", hg, "data", y(:, i));
      if (have_z)
        addproperty ("zdata", hg, "data", z(:, i));
      else
        addproperty ("zdata", hg, "data", []);
      endif

      addlistener (hg, "xdata", @update_data);
      addlistener (hg, "ydata", @update_data);
      addlistener (hg, "zdata", @update_data);

      if (! isempty (args))
        set (hg, args{:});
      endif
      if (i == 1 && ! isempty (h_baseline))
        set (h_baseline, "parent", get (hg, "parent"));
      endif
    endfor

    if (! strcmp (hold_state, "add") && have_z)
      set (hax, "view", [-37.5 30]);  # 3D view
    endif
    set (hax, "nextplot", hold_state);

  unwind_protect_cleanup
    if (! isempty (oldfig))
      set (0, "currentfigure", oldfig);
    endif
  end_unwind_protect

endfunction

function [x, y, z, dofill, lc, ls, mc, ms, newargs] = check_stem_arg (have_z, varargin)

  ## FIXME -- there seems to be a lot of duplicated code in this
  ## function.  It seems like it should be possible to simplify things
  ## by combining some of the nearly identical code sections into
  ## additional subfunctions.

  if (have_z)
    caller = "stem3";
  else
    caller = "stem";
  endif

  ## Remove prop/val pairs from data to consider.
  i = 2;
  newargs = {};
  while (i < length (varargin))
    if (ischar (varargin{i}) && !(strcmpi ("fill", varargin{i})
                                  || strcmpi ("filled", varargin{i})))
      newargs{end + 1} = varargin{i};
      newargs{end + 1} = varargin{i + 1};
      nargin = nargin - 2;
      varargin(i:i+1) = [];
    else
      i++;
    endif
  endwhile

  ## set specifiers to default values.
  [lc, ls, mc, ms] = set_default_values ();
  dofill = 0;
  fill_2 = 0;
  linespec_2 = 0;
  z = [];

  ## Check input arguments.
  if (nargin == 2)
    if (have_z)
      z = varargin{1};
      x = 1:rows (z);
      y = 1:columns (z);
    else
      y = varargin{1};
      if (isvector (y))
        x = 1:length (y);
      elseif (ismatrix (y))
        x = 1:rows (y);
      else
        error ("stem: Y must be a matrix");
      endif # in each case, x & y will be defined
    endif
  elseif (nargin == 3)
    ## Several possibilities
    ##
    ## 1. the real y data
    ## 2. 'filled'
    ## 3. line spec
    if (ischar (varargin{2}))
      ## Only 2. or 3. possible.
      if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2}))
        dofill = 1;
      else
        ## Parse the linespec.
        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2});
      endif
      if (have_z)
        z = varargin{1};
        x = 1:rows (z);
        y = 1:columns (z);
      else
        y = varargin{1};
        if (isvector (y))
          x = 1:length (y);
        elseif (ismatrix (y))
          x = 1:rows (y);
        else
          error ("stem: Y must be a matrix");
        endif # in each case, x & y will be defined
      endif
    else
      if (have_z)
        error ("stem3: must define X, Y and Z");
      else
        ## Must be the real y data.
        x = varargin{1};
        y = varargin{2};
        if (! (ismatrix (x) && ismatrix (y)))
          error ("stem: X and Y must be matrices");
        endif
      endif
    endif
  elseif (nargin == 4)
    ## Again, several possibilities:
    ##
    ## arg2 1. real y
    ## arg2 2. 'filled' or linespec
    ## arg3 1. real z
    ## arg3 2. 'filled' or linespec
    if (ischar (varargin{2}))
      ## Only arg2 2. / arg3 1. & arg3 3. are possible.
      if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2}))
        dofill = 1;
        fill_2 = 1; # Be sure, no second "fill" is in the arguments.
      else
        ## Must be a linespec.
        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2});
        linespec_2 = 1;
      endif
      if (have_z)
        z = varargin{1};
        x = 1:rows (z);
        y = 1:columns (z);
      else
        y = varargin{1};
        if (isvector (y))
          x = 1:length (y);
        elseif (ismatrix (y))
          x = 1:rows (y);
        else
          error ("stem: Y must be a matrix");
        endif # in each case, x & y will be defined
      endif
    else
      if (have_z)
        x = varargin{1};
        y = varargin{2};
        z = varargin{3};
        if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
          error ("stem3: X, Y and Z must be matrices");
        endif
      else
        ## must be the real y data.
        x = varargin{1};
        y = varargin{2};
        if (! (ismatrix (x) && ismatrix (y)))
          error ("stem: X and Y must be matrices");
        endif
      endif
    endif # if ischar (varargin{2})
    if (! have_z)
      ## varargin{3} must be char.
      ## Check for "fill.
      if ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
          && fill_2)
        error ("stem: duplicate fill argument");
      elseif (strcmpi ("fill", varargin{3}) && linespec_2)
        ## Must be "fill".
        dofill = 1;
        fill_2 = 1;
      elseif ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
          && !linespec_2)
        ## Must be "fill".
        dofill = 1;
        fill_2 = 1;
      elseif (! linespec_2)
        ## Must be linespec.
        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3});
        linespec_2 = 1;
      endif
    endif
  elseif (nargin == 5)
    if (have_z)
      x = varargin{1};
      y = varargin{2};
      z = varargin{3};
      if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
        error ("stem3: X, Y and Z must be matrices");
      endif
    else
      x = varargin{1};
      y = varargin{2};
      if (! (ismatrix (x) && ismatrix (y)))
        error ("stem: X and Y must be matrices");
      endif
    endif

    if (! have_z)
      if (strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
        dofill = 1;
        fill_2 = 1; # Be sure, no second "fill" is in the arguments.
      else
        ## Must be a linespec.
        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3});
        linespec_2 = 1;
      endif
    endif

    ## Check for "fill".
    if ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
        && fill_2)
      error ("%s: duplicate fill argument", caller);
    elseif ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
        && linespec_2)
      ## Must be "fill".
      dofill = 1;
      fill_2 = 1;
    elseif (!strcmpi (varargin{4}, "fill") && !strcmpi (varargin{4}, "filled")
        && !linespec_2)
      ## Must be linespec.
      [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4});
      linespec_2 = 1;
    endif
  elseif (nargin == 6 && have_z)
    x = varargin{1};
    y = varargin{2};
    z = varargin{3};
    if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
      error ("stem3: X, Y and Z must be matrices");
    endif

    if (strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
      dofill = 1;
      fill_2 = 1; # be sure, no second "fill" is in the arguments
    else
      ## Must be a linespec.
      [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4});
      linespec_2 = 1;
    endif

    ## check for "fill" ..
    if ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled"))
        && fill_2)
      error ("stem3: duplicate fill argument");
    elseif ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled"))
        && linespec_2)
      ## Must be "fill".
      dofill = 1;
      fill_2 = 1;
    elseif (!strcmpi (varargin{5}, "fill") && !strcmpi (varargin{5}, "filled")
            && !linespec_2)
      ## Must be linespec.
      [lc, ls, mc, ms] = stem_line_spec (caller, varargin{5});
      linespec_2 = 1;
    endif
  else
    error ("%s: incorrect number of arguments", caller);
  endif

  ## Check sizes of x, y and z.
  if (have_z)
    if (!size_equal (x, y, z))
      error ("stem3: inconsistent size of x, y and z");
    else
      x = x(:);
      y = y(:);
      z = z(:);
    endif
  else
    if (isvector (x))
      x = x(:);
      if (isvector (y))
        if (length (x) != length (y))
          error ("stem: inconsistent size of x and y");
        else
          y = y(:);
        endif
      else
        if (length (x) == rows (y))
          x = repmat (x(:), 1, columns (y));
        else
          error ("stem: inconsistent size of x and y");
        endif
      endif
    elseif (!size_equal (x, y))
      error ("stem: inconsistent size of x and y");
    endif
  endif

endfunction

function [lc, ls, mc, ms] = stem_line_spec (caller, str)
  if (! ischar (str))
    error ("%s: expecting argument to be \"fill\" or a string of specifiers",
           caller);
  endif
  [lc, ls, mc, ms] = set_default_values ();
  ## Parse the line specifier string.
  cur_props = __pltopt__ ("stem", str, false);
  for i = 1:length (cur_props)
    if (isfield (cur_props(i), "color") && ! isempty (cur_props(i).color)); # means line color
      mc = lc = cur_props(i).color;
    elseif (isfield (cur_props(i), "linestyle"))
      ls = cur_props(i).linestyle;
      if (isempty (ls))
        ls = __next_line_style__ ();
      endif
    elseif (isfield (cur_props(i), "marker") && ! strcmpi (cur_props(i).marker, "none"))
      ms = cur_props(i).marker;
      if (isempty (ms))
        [dummy, ms] = __next_line_style__ ();
      endif
    endif
  endfor
endfunction

function [lc, ls, mc, ms] = set_default_values ()
  ## set default values
  mc = [];
  lc = [];
  ls = "-";
  ms = "o";
endfunction

function update_xlim (h, d)
  kids = get (h, "children");
  xlim = get (h, "xlim");

  for i = 1 : length (kids)
    obj = get (kids (i));
    if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline"))
      if (any (get (obj.baseline, "xdata") != xlim))
        set (obj.baseline, "xdata", xlim);
      endif
    endif
  endfor
endfunction

function update_baseline (h, d)
  visible = get (h, "visible");
  ydata = get (h, "ydata")(1);

  kids = get (get (h, "parent"), "children");
  for i = 1 : length (kids)
    obj = get (kids (i));
    if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline")
        && obj.baseline == h)
      ## Only alter if changed to avoid recursion of the listener functions
      if (! strcmpi (get (kids(i), "showbaseline"), visible))
        set (kids (i), "showbaseline", visible);
      endif
      if (! strcmpi (get (kids(i), "basevalue"), visible))
        set (kids (i), "basevalue", ydata);
      endif
    endif
  endfor
endfunction

function show_baseline (h, d)
  set (get (h, "baseline"), "visible", get (h, "showbaseline"));
endfunction

function move_baseline (h, d)
  b0 = get (h, "basevalue");
  bl = get (h, "baseline");

  if (get (bl, "ydata") != [b0, b0])
    set (bl, "ydata", [b0, b0]);
  endif

  kids = get (h, "children");
  yt = get (h, "ydata")(:)';
  ny = length (yt);
  yt = [b0 * ones(1, ny); yt; NaN(1, ny)](:);
  set (kids(2), "ydata", yt);
endfunction

function update_props (h, d)
  kids = get (h, "children");
  set (kids(2), "color", get (h, "color"),
       "linewidth", get (h, "linewidth"),
       "linestyle", get (h, "linestyle"));
  set (kids(1), "color", get (h, "color"),
       "marker", get (h, "marker"),
       "markerfacecolor", get (h, "markerfacecolor"),
       "markersize", get (h, "markersize"));
endfunction

function update_data (h, d)
  x = get (h, "xdata");
  y = get (h, "ydata");
  z = get (h, "zdata");

  if (!isempty (z) && size_equal (x, y, z))
    sz = min ([size(x); size(y); size(z)]);
    x = x(1:sz(1),1:sz(2));
    y = y(1:sz(1),1:sz(2));
    z = z(1:sz(1),1:sz(2));
  elseif (numel (x) != numel (y));
    sz = min ([size(x); size(y)]);
    x = x(1:sz(1),1:sz(2));
    y = y(1:sz(1),1:sz(2));
  endif
  bl = get (h, "basevalue");
  nx = numel (x);
  x = x(:)';
  xt = [x; x; NaN(1, nx)](:);
  if (! isempty (z))
    y = y(:)';
    yt = [y; y; NaN(1, nx)](:);
    z = z(:)';
    zt = [bl * ones(1, nx); z; NaN(1, nx)](:);
  else
    y = y(:)';
    yt = [bl * ones(1, nx); y; NaN(1, nx)](:);
    zt = [];
  endif

  kids = get (h, "children");
  set (kids(2), "xdata", xt, "ydata", yt, "zdata", zt);
  set (kids(1), "xdata", x, "ydata", y, "zdata", z);
endfunction