1########################################################################
2##
3## Copyright (C) 2006-2021 The Octave Project Developers
4##
5## See the file COPYRIGHT.md in the top-level directory of this
6## distribution or <https://octave.org/copyright/>.
7##
8## This file is part of Octave.
9##
10## Octave is free software: you can redistribute it and/or modify it
11## under the terms of the GNU General Public License as published by
12## the Free Software Foundation, either version 3 of the License, or
13## (at your option) any later version.
14##
15## Octave is distributed in the hope that it will be useful, but
16## WITHOUT ANY WARRANTY; without even the implied warranty of
17## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18## GNU General Public License for more details.
19##
20## You should have received a copy of the GNU General Public License
21## along with Octave; see the file COPYING.  If not, see
22## <https://www.gnu.org/licenses/>.
23##
24########################################################################
25
26## -*- texinfo -*-
27## @deftypefn {} {@var{h} =} __stem__ (@var{have_z}, @var{varargin})
28## Undocumented internal function.
29## @end deftypefn
30
31function h = __stem__ (have_z, varargin)
32
33  if (have_z)
34    caller = "stem3";
35  else
36    caller = "stem";
37  endif
38
39  [hax, varargin, nargin] = __plt_get_axis_arg__ (caller, varargin{:});
40
41  [x, y, z, dofill, llc, ls, mmc, ms, varargin] = ...
42                                           check_stem_arg (have_z, varargin{:});
43
44  oldfig = [];
45  if (! isempty (hax))
46    oldfig = get (0, "currentfigure");
47  endif
48  unwind_protect
49    hax = newplot (hax);
50    hold_state = get (hax, "nextplot");
51    set (hax, "nextplot", "add");
52
53    h = [];
54    nx = rows (x);
55    h_baseline = [];
56
57    for i = 1 : columns (x)
58      if (have_z)
59        xt = x(:)';
60        xt = [xt; xt; NaN(1, nx)](:);
61        yt = y(:)';
62        yt = [yt; yt; NaN(1, nx)](:);
63        zt = z(:)';
64        zt = [zeros(1, nx); zt; NaN(1, nx)](:);
65      else
66        xt = x(:, i)';
67        xt = [xt; xt; NaN(1, nx)](:);
68        yt = y(:, i)';
69        yt = [zeros(1, nx); yt; NaN(1, nx)](:);
70      endif
71
72      if (isempty (llc))
73        lc = __next_line_color__ ();
74      else
75        lc = llc;
76      endif
77
78      if (isempty (mmc))
79        mc = lc;
80      else
81        mc = mmc;
82      endif
83
84      if (dofill)
85        fc = mc;
86      else
87        fc = "none";
88      endif
89
90      ## Must occur after __next_line_color__ in order to work correctly.
91      hg = hggroup ("__appdata__", struct ("__creator__", "__stem__"));
92      h = [h; hg];
93      args = __add_datasource__ (caller, hg, {"x", "y", "z"}, varargin{:});
94
95      if (have_z)
96        __line__ (hax, xt, yt, zt, "color", lc, "linestyle", ls, "parent", hg);
97        __line__ (hax, x, y, z, "color", mc, "linestyle", "none",
98                       "marker", ms, "markerfacecolor", fc, "parent", hg);
99      else
100        __line__ (hax, xt, yt, "color", lc, "linestyle", ls, "parent", hg);
101        __line__ (hax, x(:,i), y(:, i), "color", mc, "linestyle", "none",
102                       "marker", ms, "markerfacecolor", fc, "parent", hg);
103
104        x_axis_range = get (hax, "xlim");
105        if (isempty (h_baseline))
106          h_baseline = __go_line__ (hax, "xdata", x_axis_range,
107                                         "ydata", [0, 0],
108                                         "color", [0, 0, 0]);
109          set (h_baseline, "handlevisibility", "off", "xliminclude", "off");
110          addproperty ("basevalue", h_baseline, "data", 0);
111        else
112          set (h_baseline, "xdata", x_axis_range);
113        endif
114      endif
115
116      ## Setup the hggroup and listeners.
117      addproperty ("showbaseline", hg, "radio", "{on}|off");
118      addproperty ("baseline", hg, "data", h_baseline);
119      addproperty ("basevalue", hg, "data", 0);
120
121      addproperty ("color", hg, "linecolor", lc);
122      addproperty ("linestyle", hg, "linelinestyle", ls);
123      addproperty ("linewidth", hg, "linelinewidth", 0.5);
124      addproperty ("marker", hg, "linemarker", ms);
125      addproperty ("markeredgecolor", hg, "linemarkerfacecolor", mc);
126      addproperty ("markerfacecolor", hg, "linemarkerfacecolor", fc);
127      addproperty ("markersize", hg, "linemarkersize", 6);
128
129      addlistener (hg, "color", @update_props);
130      addlistener (hg, "linestyle", @update_props);
131      addlistener (hg, "linewidth", @update_props);
132      addlistener (hg, "marker", @update_props);
133      addlistener (hg, "markeredgecolor", @update_props);
134      addlistener (hg, "markerfacecolor", @update_props);
135      addlistener (hg, "markersize", @update_props);
136
137      if (islogical (x))
138        x = double (x);
139      endif
140      addproperty ("xdata", hg, "data", x(:, i));
141      if (islogical (y))
142        y = double (y);
143      endif
144      addproperty ("ydata", hg, "data", y(:, i));
145      if (have_z)
146        addproperty ("zdata", hg, "data", z(:, i));
147      else
148        addproperty ("zdata", hg, "data", []);
149      endif
150
151      addlistener (hg, "xdata", @update_data);
152      addlistener (hg, "ydata", @update_data);
153      addlistener (hg, "zdata", @update_data);
154
155      ## Matlab property, although Octave does not implement it.
156      addproperty ("hittestarea", hg, "radio", "on|{off}", "off");
157
158    endfor
159
160    ## baseline listeners
161    if (! isempty (h_baseline))
162      fcn_handle = @update_xlim;
163      addlistener (hax, "xlim", fcn_handle);
164      set (h_baseline, "deletefcn", {@rm_xlim_listener, hax, fcn_handle});
165
166      for hg = h'
167        addlistener (hg, "showbaseline", @show_baseline);
168        addlistener (hg, "visible", {@show_baseline, h});
169        addlistener (hg, "basevalue", @move_baseline);
170      endfor
171
172      addlistener (h_baseline, "basevalue", {@update_baseline, 0});
173      addlistener (h_baseline, "ydata", {@update_baseline, 1});
174      addlistener (h_baseline, "visible", {@update_baseline, 2});
175      set (h_baseline, "parent", get (hg(1), "parent"));
176    endif
177
178    ## property/value pairs
179    if (! isempty (args))
180        set (h, args{:});
181    endif
182
183    if (! strcmp (hold_state, "add"))
184      if (! have_z)
185        set (hax, "box", "on");
186      else
187        set (hax, "view", [-37.5 30],
188                  "xgrid", "on", "ygrid", "on", "zgrid", "on");
189      endif
190    endif
191    set (hax, "nextplot", hold_state);
192
193  unwind_protect_cleanup
194    if (! isempty (oldfig))
195      set (0, "currentfigure", oldfig);
196    endif
197  end_unwind_protect
198
199endfunction
200
201function [x, y, z, dofill, lc, ls, mc, ms, args] = check_stem_arg (have_z, varargin)
202
203  if (have_z)
204    caller = "stem3";
205  else
206    caller = "stem";
207  endif
208  nargin = nargin () - 1;  # account for have_z argument
209
210  num_numeric = find (cellfun ("isclass", varargin, "char"), 1) - 1;
211  if (isempty (num_numeric))
212    num_numeric = nargin;
213  endif
214
215  if (num_numeric < 1 || num_numeric > 3)
216    print_usage (caller);
217  endif
218
219  x = y = z = [];
220  if (num_numeric == 1)
221    if (have_z)
222      z = varargin{1};
223    else
224      y = varargin{1};
225    endif
226  elseif (num_numeric == 2)
227    if (have_z)
228      error ("stem3: must define X, Y, and Z");
229    else
230      x = varargin{1};
231      y = varargin{2};
232    endif
233  else  # nun_numeric == 3
234    if (have_z)
235      x = varargin{1};
236      y = varargin{2};
237      z = varargin{3};
238    else
239      error ("stem: can not define Z for 2-D stem plot");
240    endif
241  endif
242
243  ## Validate numeric data
244  if (have_z)
245    if (isempty (x))
246      [nr, nc] = size (z);
247      if (nr >= nc)
248        x = repmat ([1:nc], nr, 1);
249        y = repmat ([1:nr]', 1, nc);
250      else
251        x = repmat ([1:nc], nr, 1);
252        y = repmat ([1:nr]', 1, nc);
253      endif
254    endif
255    if (! (isnumeric (x) || islogical (x))
256        || ! (isnumeric (y) || islogical (y))
257        || ! (isnumeric (z) || islogical (z)))
258      error ("stem3: X, Y, and Z must be numeric");
259    endif
260  else
261    if (isempty (x))
262      if (isvector (y))
263        x = 1:length (y);
264      elseif (ismatrix (y))
265        x = 1:rows (y);
266      else
267        error ("stem: Y must be a vector or 2-D array");
268      endif
269    endif
270    if (! (isnumeric (x) || islogical (x))
271        || ! (isnumeric (y) || islogical (y)))
272      error ("stem: X and Y must be numeric");
273    endif
274  endif
275
276  ## Check sizes of x, y and z.
277  if (have_z)
278    if (! size_equal (x, y, z))
279      error ("stem3: inconsistent sizes for X, Y, and Z");
280    endif
281    x = x(:);
282    y = y(:);
283    z = z(:);
284  else
285    if (isvector (x))
286      x = x(:);
287      if (isvector (y))
288        if (length (x) != length (y))
289          error ("stem: inconsistent sizes for X and Y");
290        endif
291        y = y(:);
292      else
293        if (length (x) == rows (y))
294          x = repmat (x(:), 1, columns (y));
295        else
296          error ("stem: inconsistent sizes for X and Y");
297        endif
298      endif
299    elseif (! size_equal (x, y))
300      error ("stem: inconsistent sizes for X and Y");
301    endif
302  endif
303
304  dofill = false;
305  have_line_spec = false;
306  ## set specifiers to default values.
307  [lc, ls, mc, ms] = set_default_values ();
308
309  args = {};
310  ioff = num_numeric + 1;
311  while (ioff <= nargin)
312    arg = varargin{ioff++};
313    if (ischar (arg) && any (strcmpi (arg, {"fill", "filled"})))
314      dofill = true;
315    elseif ((ischar (arg) || iscellstr (arg)) && ! have_line_spec)
316      [linespec, valid] = __pltopt__ (caller, arg, false);
317      if (valid)
318        have_line_spec = true;
319        [lc, ls, mc, ms] = stem_line_spec (linespec);
320      else
321        args{end+1} = arg;
322        if (ioff <= nargin)
323          args{end+1} = varargin{ioff++};
324        else
325          error ('%s: No value specified for property "%s"', caller, arg);
326        endif
327      endif
328    else
329      args{end+1} = arg;
330      if (ioff <= nargin)
331        args{end+1} = varargin{ioff++};
332      else
333        error ('%s: No value specified for property "%s"', caller, arg);
334      endif
335    endif
336  endwhile
337
338endfunction
339
340function [lc, ls, mc, ms] = stem_line_spec (lspec)
341
342  [lc, ls, mc, ms] = set_default_values ();
343
344  if (! isempty (lspec.color))
345    lc = mc = lspec.color;
346  endif
347
348  if (! isempty (lspec.linestyle) && ! strcmp (lspec.linestyle, "none"))
349    ls = lspec.linestyle;
350  endif
351
352  if (! isempty (lspec.marker) && ! strcmp (lspec.marker, "none"))
353    ms = lspec.marker;
354  endif
355
356endfunction
357
358function [lc, ls, mc, ms] = set_default_values ()
359  mc = [];
360  lc = [];
361  ls = "-";
362  ms = "o";
363endfunction
364
365function update_xlim (h, ~)
366
367  kids = get (h, "children");
368  xlim = get (h, "xlim");
369
370  for i = 1 : length (kids)
371    obj = get (kids(i));
372    if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline"))
373      if (any (get (obj.baseline, "xdata") != xlim))
374        set (obj.baseline, "xdata", xlim);
375      endif
376    endif
377  endfor
378
379endfunction
380
381## Good practice to remove listeners when object is deleted.
382## In this case, required to avoid error in update_xlim callback (bug #57391).
383function rm_xlim_listener (~, ~, hax, fcn_handle)
384  dellistener (hax, "xlim", fcn_handle);
385endfunction
386
387function update_baseline (h, ~, src)
388
389  visible = get (h, "visible");
390  if (src == 0)
391    basevalue = get (h, "basevalue");
392  else
393    basevalue = get (h, "ydata")(1);
394  endif
395
396  kids = get (get (h, "parent"), "children");
397  for i = 1 : length (kids)
398    obj = get (kids(i));
399    if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline")
400        && obj.baseline == h)
401      ## Avoid lots of unnecessary listener updates
402      if (! strcmp (get (kids(i), "showbaseline"), visible))
403        set (kids(i), "showbaseline", visible);
404      endif
405      if (get (kids(i), "basevalue") != basevalue)
406        set (kids(i), "basevalue", basevalue);
407      endif
408    endif
409  endfor
410
411endfunction
412
413function show_baseline (h, ~, hg = [])
414
415  if (isempty (hg))
416    set (get (h, "baseline"), "visible", get (h, "showbaseline"));
417  else
418    if (all (strcmp (get (hg, "visible"), "off")))
419      set (get (h, "baseline"), "visible", "off");
420    else
421      set (get (h, "baseline"), "visible", "on");
422    endif
423  endif
424
425endfunction
426
427function move_baseline (h, ~)
428
429  b0 = get (h, "basevalue");
430  bl = get (h, "baseline");
431
432  set (bl, "ydata", [b0, b0], "basevalue", b0);
433
434  kids = get (h, "children");
435  yt = get (h, "ydata")(:)';
436  ny = length (yt);
437  yt = [b0 * ones(1, ny); yt; NaN(1, ny)](:);
438  set (kids(2), "ydata", yt);
439
440endfunction
441
442function update_props (h, ~)
443
444  kids = get (h, "children");
445  set (kids(2), "color", get (h, "color"),
446                "linestyle", get (h, "linestyle"),
447                "linewidth", get (h, "linewidth"));
448  set (kids(1), "color", get (h, "markeredgecolor"),
449                "marker", get (h, "marker"),
450                "markerfacecolor", get (h, "markerfacecolor"),
451                "markersize", get (h, "markersize"));
452
453endfunction
454
455function update_data (h, ~)
456
457  x = get (h, "xdata");
458  y = get (h, "ydata");
459  z = get (h, "zdata");
460
461  if (! isempty (z) && size_equal (x, y, z))
462    sz = min ([size(x); size(y); size(z)]);
463    x = x(1:sz(1),1:sz(2));
464    y = y(1:sz(1),1:sz(2));
465    z = z(1:sz(1),1:sz(2));
466  elseif (numel (x) != numel (y))
467    sz = min ([size(x); size(y)]);
468    x = x(1:sz(1),1:sz(2));
469    y = y(1:sz(1),1:sz(2));
470  endif
471  bl = get (h, "basevalue");
472  nx = numel (x);
473  x = x(:)';
474  xt = [x; x; NaN(1, nx)](:);
475  if (! isempty (z))
476    y = y(:)';
477    yt = [y; y; NaN(1, nx)](:);
478    z = z(:)';
479    zt = [bl * ones(1, nx); z; NaN(1, nx)](:);
480  else
481    y = y(:)';
482    yt = [bl * ones(1, nx); y; NaN(1, nx)](:);
483    zt = [];
484  endif
485
486  kids = get (h, "children");
487  set (kids(2), "xdata", xt, "ydata", yt, "zdata", zt);
488  set (kids(1), "xdata", x, "ydata", y, "zdata", z);
489
490endfunction
491