#! /usr/bin/gawk
# Last edited on 2026-09-29 16:50:35 by stolfi

# Factors a text by placing "{}" around each OKOKOKO element,
# together with its "I" and "E" complements.
# Assumes that the field is in EVA. Ligature-capitalization is 
# ignored on input, and added to the output. 
# To be included in factor-field-general etc.

function factor_text(x,   y,e,xold)
{
  # Decomposes "x" into its OKOKO (core-mantle-crust, nine-slot) elements.
  #
  # First, deletes inline comments "<!...>", alignment marks [«=»].
  # Deletes parag marks "<[%$]>". 
  # Removes ligature braces and maps everything to lowercase.
  # Maps weirdo codes "&NNN" or "&...;"
  # to "?".  Maps funky glyphs [bjvx] to @?, @u to @n, and @g to @m
  #
  # Next we fix some assumed scribal or transcription errors and
  # expand abreviations:
  #
  # Next, we split the token {x} into O elements (@a, @o, @y) and
  # {K} elements (everything else).  In each slot before,
  # after, or between two Ks there may be at most two Os.
  # There may be a total of at most three Os per token.
  # 
  # Next, ignoring the Os, the Ks are parsed by the formula
  # 
  #   Q^q D^d X^x G^g H^h X^y D^e N^n
  # 
  # where 
  #   Q is { @q } 
  #   D is { @d, @l, @r, @s }
  #   X is { @ch, @sh, @ee, @che, @she, @eee }
  #   G is { @k, @t, @p, @f, @ke, @te, @pe, @fe  }
  #   H is { @ckh, @cth, @cph, @cfh, @ckhe, @cthe, @cphe, @cfhe }
  #   N is { @n, @in, @iin, @iiin }
  # 
  # q,g,h,n may be 0 or 1;
  # g+h at most 1;
  # q+d+e+n <= 3
  # x+h+y <= 2
  #
  # That is, there can be at most one gallows (simple or platform) per word,
  # at most three of Q, D, and N, and at most two benches, 
  # counting a platform gallows as one bench
  # 
  # Output has braces around each O or K element.
  #
  # Tokens that fail to parse as above will have a '{?}' element
  # inserted where the parsing first failed. The rest will be
  # split into "elements" by {} but the parsing may be arbitrary.

  xold = x # Save for error messages.
  
  # Remove inline comments and other fluff:
  gsub(/<![^<>]*>/, "", x);
  gsub(/[«=»]/, "", x);
  gsub(/<[%$]>/, "", x);

  # Remove ligature capitalization, to simplify patterns:
  x = uncapitalize_ligatures(x);
  
  # Remove braces, assumed to be ligatures:
  x = gensub(/[{]([^{}]*)[}]/, "\\1", "g", x);
  
  # Map weirdos to @?:
  gsub(/[bjvx]/, "?", x)
  gsub(/[&][^;.,]*[;]/, "?", x)
  gsub(/[&][0-9]+/, "?", x)
  
  # Map transcription variants to canoncal glyphs:
  gsub(/u/, "n", x)
  gsub(/g/, "m", x)
  gsub(/ih/, "ch", x)
  gsub(/ikh/, "chk", x)
  gsub(/ith/, "ctk", x)
  gsub(/iph/, "cpk", x)
  gsub(/ifh/, "cfk", x)
  
  # Undo special encodings:
  gsub(/w/, "p", x) # Stolfi's hooked @p
  gsub(/z/, "f", x) # Stolfi's hooked @f
  
  # Expand abbreviations:
  gsub(/m/, "iin", x)
  
  # Correct scribal mistakes:
  gsub(/ir$/, "iin", x)
  gsub(/is$/, "iin", x)
  gsub(/hh/, "he", x)
  
  if (match(x, /[^?ac-fhik-ty]/)) 
    { data_error(("invalid char in word \"" xold "\"")); }
  
  y = ""; 
  
  nO = 0 # Counts total O.
  kO = 0 # Counts O since last K.
  nQ = 0 # Counts total Q.
  nD = 0 # Counts total D.
  kD = 0 # Counts D after X,G,H.
  nX = 0 # Counts total X.
  nGH = 0 # Counts total G, H.
  nN = 0 # Counts total codas.
  
  nBUG = 0; 
  reported = 0
  while (x != "")
    { msg = ""
      # printf "x = [%s]\n", x > "/dev/stderr";
      if (match(x, /^[?]/)) 
        { msg = (msg ", transcription error"); nBUG++; }
      else if (match(x, /^[aoy]/))
        { kO++;
          if (kO > 2) { msg = (msg ", too many Os in a row"); nBUG++ }
          nO++; 
          if (nO > 3) { msg = (msg ", too many Os"); nBUG++ }
        }
      else 
        { if (nN > 0) { msg = (msg ", stuff after the coda"); nBUG++ }
          if (match(x, /^[q]/)) 
            { if (nQ + nD + nX + nGH > 0) 
                { msg = (msg ", internal q"); nBUG++ }
              nQ++;
              kO = 0;
            }
          else if (match(x, /^([cs]h|ee)[e]*/))
            { if ((RLENGTH >= 2) && (RLENGTH % 2 == 1))
                { RLENGTH = 3; }
              else
                { RLENGTH = 2; }
              if (kD > 0) { msg = (msg ", sequence X/G/H - D - X"); nBUG++; }
              nX++;
              if (nX > 2) { msg = (msg ", too many benches/platfs X"); nBUG++ }
              kO = 0;
            }
          else if (match(x, /^[dlrs]/))
            { nD++;                                                                                    if (nX + nGH > 0) { kD++; }
              if (nQ + nD + nN > 3) { msg = (msg ", too many Ds"); nBUG++ }
              kO = 0;
            }
          else if (match(x, /^[ktfp][e]*/))
            { if ((RLENGTH >= 1) && (RLENGTH % 2 == 0))
                { RLENGTH = 2; }
              else
                { RLENGTH = 1; }
              if (kD > 0) { msg = (msg ", sequence X/G/H - D - G"); nBUG++; }
              if (nGH > 0) { msg = (msg ", more than one gallows"); nBUG++ }
              nGH++;
              kO = 0;
            }
          else if (match(x, /^c[ktpf]h[e]*/))
            { if ((RLENGTH >= 3) && (RLENGTH % 2 == 0))
                { RLENGTH = 4; }
              else
                { RLENGTH = 3; }
              if (kD > 0) { msg = (msg ", sequence X/G/H - D - H"); nBUG++; }
              if (nGH > 0) { msg = (msg ", more than one gallows"); nBUG++ }
              nGH++;
              nX++ # Counts as one bench too.
              if (nX > 2)  { msg = (msg ", too many benches/platfs X"); nBUG++ }
              kO = 0;
            }
          else if (match(x, /^[i]*[n]/))
            { if (nN > 0) { msg = (msg ", two codas?"); nBUG++ }
              nN++;
              kO = 0
            }
          else
            { RSTART = 1; RLENGTH = 1;
              msg = (msg ", unparseable char '" substr(x,1,1) "'"); nBUG++
            }
        }
      e = substr(x,1,RLENGTH); x = substr(x, RLENGTH+1);
      if ((nBUG > 0) && (reported == 0)) 
        { parse_warning(msg, xold); 
          reported = 1;
          if (e != "?") { y = ( y "{?}" ) }
        }
      y = ( y "{" e "}" );
    }
  # printf "%s -> %s", xold, y > "/dev/stderr"
  # printf " nO = %d", nO > "/dev/stderr"
  # printf " kO = %d", kO > "/dev/stderr"
  # printf " nQ = %d", nQ > "/dev/stderr"
  # printf " nD = %d", nD > "/dev/stderr"
  # printf " kD = %d", kD > "/dev/stderr"
  # printf " nX = %d", nX > "/dev/stderr"
  # printf " nGH = %d", nGH > "/dev/stderr"
  # printf " nN = %d", nN > "/dev/stderr"
  # printf "\n" > "/dev/stderr"
  return y;
}

function uncapitalize_ligatures(w)
{
  # Removes ligature-capitalization:
  gsub(/C/, "c", w);
  gsub(/S/, "s", w);
  gsub(/I/, "i", w);
  gsub(/H/, "h", w);
  gsub(/K/, "k", w);
  gsub(/T/, "t", w);
  gsub(/P/, "p", w);
  gsub(/F/, "f", w);
  gsub(/Y/, "y", w);
  gsub(/O/, "o", w);
  gsub(/A/, "a", w);
  return w;
}
  
function parse_warning(msg, xold) 
{
  gsub(/^, */, "", msg)
  printf "%s:%d: !! %s '%s'\n", FILENAME, FNR, msg, xold > "/dev/stderr"
}