% Feta (not the Font-En-Tja) music font -- auxiliary macros for both feta and parmesan fonts
% This file is part of LilyPond, the GNU music typesetter.
%
% Copyright (C) 1997--2022 Han-Wen Nienhuys <hanwen@xs4all.nl>
%
% The LilyPond font 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, or under the SIL Open Font License.
%
% LilyPond 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 LilyPond.  If not, see <http://www.gnu.org/licenses/>.


%
% debugging
%


def print_penpos (suffix $) =
  message
    "z" & str$ & "l = (" & decimal x.$.l & ", " &decimal y.$.l & ");"
    & " z" & str$ & "r = (" & decimal x.$.r & ", " & decimal y.$.r & ");";
enddef;


def test_grid =
  if test > 1:
    proofrulethickness 1pt#;

    makegrid
      (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor)
      (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor);

    proofrulethickness .1pt#;

    makegrid
      (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor)
      (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor);
  fi;
enddef;


def treq =
  tracingequations := tracingonline := 1;
enddef;


def draw_staff_if_debugging (expr first, last) =
  if test <> 0:
    pickup pencircle scaled stafflinethickness;

    for i := first step 1 until last:
      draw (-staff_space,
            (i + stafflines_y_offset) * staff_space_rounded)
           -- (4 staff_space,
               (i + stafflines_y_offset) * staff_space_rounded);
    endfor;
  fi;
enddef;


%
% Draw the outline of the stafflines.  For fine tuning.
%

def draw_staff_outline (expr first, last, offset) =
  if test <> 0:
    save p;
    path p;

    pickup pencircle scaled 2;

    for i := first step 1 until last:
      p := (-staff_space,
            (i + offset) * staff_space_rounded)
           -- (4 staff_space,
               (i + offset) * staff_space_rounded);

      draw p shifted (0, .5 stafflinethickness);
      draw p shifted (0, -.5 stafflinethickness);
    endfor;
  fi;
enddef;


%
% Transformations
%

def scaledabout (expr point, scale) =
  shifted -point scaled scale shifted point
enddef;


%
% make a local (restored after endgroup) copy of t_var
%

def local_copy (text type, t_var) =
  save copy_temp;
  type copy_temp;
  copy_temp := t_var;
  save t_var;
  type t_var;
  t_var := copy_temp;
enddef;


%
% Urgh! Want to do parametric types
%

def del_picture_stack =
  save save_picture_stack, picture_stack_idx;
enddef;


%
% better versions of Taupin/Egler savepic cmds
%

def make_picture_stack =
  % override previous stack
  del_picture_stack;
  picture save_picture_stack[];
  numeric picture_stack_idx;
  picture_stack_idx := 0;

  def push_picture (expr p) =
    save_picture_stack[picture_stack_idx] := p;
    picture_stack_idx := picture_stack_idx + 1;
  enddef;

  def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
  def top_picture = save_picture_stack[picture_stack_idx] enddef;
enddef;


%
% save/restore pens
% why can't I delete individual pens?
%

def make_pen_stack =
  del_pen_stack;
  pen save_pen_stack[];
  numeric pen_stack_idx;
  pen_stack_idx := 0;
  def push_pen (expr p) =
    save_pen_stack[pen_stack_idx] := p;
    pen_stack_idx := pen_stack_idx + 1;
  enddef;
  def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
  def top_pen = save_pen_stack[pen_stack_idx] enddef;
enddef;


def del_pen_stack =
  save save_pen_stack, pen_stack_idx;
enddef;


%
% drawing
%

def soft_penstroke text t =
  forsuffixes e = l, r:
    path_.e := t;
  endfor;

  if cycle path_.l:
    cyclestroke_;
  else:
    fill path_.l
         ..tension1.5.. reverse path_.r
         ..tension1.5.. cycle;
  fi;
enddef;


def soft_start_penstroke text t =
  forsuffixes e = l, r:
    path_.e := t;
  endfor;

  if cycle path_.l:
    cyclestroke_;
  else:
    fill path_.l
         -- reverse path_.r
         ..tension1.5.. cycle;
  fi;
enddef;


def soft_end_penstroke text t =
  forsuffixes e = l, r:
    path_.e := t;
  endfor;

  if cycle path_.l:
    cyclestroke_;
  else:
    fill path_.l
         ..tension1.5.. reverse path_.r
         -- cycle;
  fi;
enddef;


%
% Make a round path segment going from P to Q.  2*A is the angle that the
% path should take.
%

def simple_serif (expr p, q, a) =
  p{dir (angle (q - p) - a)}
  .. q{-dir (angle (p - q) + a)}
enddef;


%
% Draw an axis aligned block making sure that edges are on pixels.
%

def draw_rounded_block (expr bottom_left, top_right, roundness) =
  begingroup;
    save size;
    save x, y;

    % Originally, there was `floor' instead of `round', but this is
    % not correct because pens use `round' also.
    size = round min (roundness,
                      xpart (top_right - bottom_left),
                      ypart (top_right - bottom_left));

    z2 + (size / 2, size / 2) = top_right;
    z4 - (size / 2, size / 2) = bottom_left;
    y3 = y2;
    y4 = y1;
    x2 = x1;
    x4 = x3;

    pickup pencircle scaled size;

    fill bot z1{right}
         .. rt z1{up}
         -- rt z2{up}
         .. top z2{left}
         -- top z3{left}
         .. lft z3{down}
         -- lft z4{down}
         .. bot z4{right}
         -- cycle;
  endgroup;
enddef;


def draw_block (expr bottom_left, top_right) =
  draw_rounded_block (bottom_left, top_right, blot_diameter);
enddef;


def draw_square_block (expr bottom_left, top_right) =
  save x, y;

  x1 = xpart bottom_left;
  y1 = ypart bottom_left;
  x2 = xpart top_right;
  y2 = ypart top_right;

  fill (x1, y1)
       -- (x2, y1)
       -- (x2, y2)
       -- (x1, y2)
       -- cycle;
enddef;


def draw_gridline (expr bottom_left, top_right, thickness) =
  draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
                      top_right + (thickness / 2, thickness / 2),
                      thickness);
enddef;


def draw_brush (expr a, w, b, v, show_labels) =
  save x, y;

  z1' = a;
  z2' = b;
  z3' = z4' = z1';
  z5' = z6' = z2';

  penpos3' (w, angle (z2' - z1') + 90);
  penpos4' (w, angle (z2' - z1'));
  penpos5' (v, angle (z1' - z2') + 90);
  penpos6' (v, angle (z1' - z2'));

  if show_labels = 1:
    labels (1', 2');
    penlabels (3', 4', 5', 6');
  fi;

  fill z3'r{z3'r - z5'l}
       .. z4'l
       .. {z5'r - z3'l}z3'l
       .. z5'r{z5'r - z3'l}
       .. z6'l
       .. {z3'r - z5'l}z5'l
       .. cycle;
enddef;


%
% Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
% Take superness = sqrt(2)/2 to get a circle segment.
%
% See Knuth, p. 267 and p.126.

def super_curvelet (expr from, to, superness, dir) =
  if dir = 1:
    (superness [xpart to, xpart from],
     superness [ypart from, ypart to]){to - from}
  else:
    (superness [xpart from, xpart to],
     superness [ypart to, ypart from]){to - from}
  fi
enddef;


%
% Bulb with smooth inside curve.
%
% alpha = start direction
% beta = which side to turn to
% flare = diameter of the bulb
% line = diameter of line attachment
% direction = is ink on left or right side (1 or -1)
%
% Note that `currentpen' must be set correctly -- only circular pens
% are supported properly.

def flare_path (expr pos, alpha, beta, line, flare, direction) =
  begingroup;
    save thick;

    thick = pen_top + pen_bot;

    clearxy;

    penpos1' (line - thick, 180 + beta + alpha);
    top z1'r = pos;

    penpos2' (flare - thick, 180 + beta + alpha);
    z2' = z3';

    penpos3' (flare - thick, 0 + alpha);
    rt x3'l = hround (x1'r
                      + (1/2 + 0.43) * flare * xpart dir (alpha + beta));
    bot y2'l = vround (y1'r
                       + (1 + 0.43) * flare * ypart dir (alpha + beta));

    rt x4' = x2'r - line * xpart dir (alpha);
    y4' = y2'r - line * ypart dir (alpha);

    penlabels (1', 2', 3', 4');

    save t, p;
    t = 0.833;
    path p;

    p := z1'r{dir (alpha)}
         .. z3'r{dir (180 + alpha - beta)}
         .. z2'l{dir (alpha + 180)}
         .. z3'l{dir (180 + alpha + beta)}
         ..tension t.. z4'{dir (180 + alpha + beta)}
         .. z1'l{dir (alpha + 180)};

    if direction <> 1:
      p := reverse p;
    fi;

    p
  endgroup
enddef;


%
% Draw a (rest) crook, starting at thickness STEM in point A,
% ending a ball W to the left, diameter BALLDIAM.
% ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
%

def balled_crook (expr a, w, balldiam, stem) =
  begingroup;
    save x, y;

    penpos1 (balldiam / 2, -90);
    penpos2 (balldiam / 2, 0);
    penpos3 (balldiam / 2, 90);
    penpos4 (balldiam / 2, 180);

    x4r = xpart a - w;
    y3r = ypart a + balldiam / 4;
    x1l = x2l = x3l = x4l;
    y1l = y2l = y3l = y4l;

    penpos5 (stem, 250);
    x5 = x4r + 9/8 balldiam;
    y5r = y1r;

    penpos6 (stem, 260);
    x6l = xpart a;
    y6l = ypart a;

    penstroke z1e
              .. z2e
              .. z3e
              .. z4e
              .. z1e
              .. z5e{right}
              .. z6e;

    penlabels (1, 2, 3, 4, 5, 6);
  endgroup;
enddef;


def y_mirror_char =
  currentpicture := currentpicture yscaled -1;

  set_char_box (charbp, charwd, charht, chardp);
enddef;


def xy_mirror_char =
  currentpicture := currentpicture scaled -1;

  set_char_box (charwd, charbp, charht, chardp);
enddef;


%
% center_factor: typically .5; the larger, the larger the radius of the bulb
% radius factor: how much the bulb curves inward
%

def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor) =
  begingroup;
    save rad, ang, pat;
    path pat;

    clearxy;

    ang = angle (zr - zl);

    % don't get near infinity
    % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
    z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);

    rad = bulb_rad;

    z1' = z0' + radius_factor * rad * dir (ang + turndir * 100);
    z2' = z0' + rad * dir (ang + turndir * 300);

    labels (0', 1', 2');

    pat = zr{dir (ang + turndir * 90)}
          .. z1'
          .. z2'
          .. cycle;

    % avoid grazing outlines
    fill subpath (0, 2.5) of pat
         -- cycle;
  endgroup
enddef;


pi := 3.14159;


%
% To get symmetry at low resolutions we need to shift some points and
% paths, but not if mf2pt1 is used.
%

if known miterlimit:
  vardef hfloor primary x = x enddef;
  vardef vfloor primary y = y enddef;
  vardef hceiling primary x = x enddef;
  vardef vceiling primary y = y enddef;
else:
  vardef hfloor primary x = floor x enddef;
  vardef vfloor primary y = (floor y.o_)_o_ enddef;
  vardef hceiling primary x = ceiling x enddef;
  vardef vceiling primary y = (ceiling y.o_)_o_ enddef;
fi;