#! /usr/bin/gawk -f
# Last edited on 2026-04-25 06:23:47 by stolfi

# Extracts from an input Voynichese
# file in ".ivt" format some pairs of strings {W1,W2} of specified length
# that are separated by a specified number of EVA chars.
# 
# User must define (with "-v") variables {qmap}, {kind}, {size} and {skip}.
#
# The script removes all spaces
# [.,-] and maps all EVA letters to a small number of letter classes See
# {map_text} below. Let {N} be the number of characters that remain on
# the line after this mapping. 
#
# The script considers only body lines (non-head, non-tail) where {N} is {Nmin}
# or more. From each such line, extracts a pair of strings {W1,W1}
# each with {size} class letters, separated by {skip} letters.
#
# If {kind} is 0, takes the two strings around the center of each line.
# If {kind} is 1, takes the two strings bracketing the end of that line.
# In the latter case the second line may be a parag tail.

BEGIN {
  Nmin = 20 + 2*size 
  kindx = (kind == 0 ? "in middle of line" : "across break")
  printf "statistics for strings of %d chars, spaced %d chars, %s\n", size, skip, kindx > "/dev/stderr"
  printf "considering only non-head, non-tail lines" > "/dev/stderr"
  printf " with at least %d words\n", Nmin > "/dev/stderr"
  nh = 0 # Parag head lines found.
  nt = 0 # Parag tail lines found.
  nb = 0 # Body lines (non-head, non-tail) read.
  na = 0 # Body lines long enough to be analyzed.
  nw = 0 # Total string pairs collected.
  W1 = "" 
}

/^[^<]/ { next }

// { head = 0; tail = 0 }

/<[%]>/ { head = 1; nh += 1; W1 = ""; }
/<[$]>/ { tail = 1; nt += 1 }

/<[%]>/ { next }

/^<f[0-9]+[rv][.][0-9]+[;][U]>/ {
  loc = $1;
  gsub(/^<[^<>]+> */, "", $0)
  if (NF != 1) { data_error("blanks in text") }
  tx = $1
  gsub(/<[%$]>/, "", tx)
  gsub(/[«=»]/, "", tx)
  gsub(/[,.-]/, "", tx)
  rt = map_text(tx, qmap)
  N = length(rt)
  if (kind == 0) {
    k1 = 1 + int(N/2 - (size + skip/2))
    k2 = k1 + size + skip
  } else if (kind == 1) {
    h = int(skip/2)
    k1 = 1 + N - size - h
    k2 = 1 + (skip - h)
  } else {
    arg_error(("bad kind " kind))
  }
  if ((kind == 1) && (W1 != "") && (k2 + size - 1 <= N)) {
    # Complete pair across break:
    W2 = take_string(rt, N, k2, size); 
    nw += out_pair(W1, W2)
  }
  if (tail) { next; }
  nb += 1
  if (N < Nmin) { 
    printf "!= N = %d\n", N > "/dev/stderr"
    next;
  }
  na += 1
  if (kind == 0) {
    W1 = take_string(rt, N, k1, size)
    W2 = take_string(rt, N, k2, size)
    nw += out_pair(W1, W2)
  } else if (kind == 1) {
    W1 = take_string(rt, N, k1, size)
  } else {
    arg_error(("bad kind " kind))
  }
  next;
} 

// { data_error("bad line format") }

END { 
  printf "%d head lines seen\n", nh > "/dev/stderr"
  printf "%d tail lines seen\n", nt > "/dev/stderr"
  printf "%d body lines read\n", nb > "/dev/stderr"
  printf "%d body lines with at least %d chars\n", na, Nmin > "/dev/stderr"
  printf "%d word pairs collected\n", nw > "/dev/stderr"
}

function take_string(rt, N, start, size) {
  if ((start < 1) || (start + size - 1 > N)) { 
    prog_error(("oflow N = " N "  k1 = " k1 "  k2 = " k2))
  }
  W = substr(rt, start, size)
  return W
}

function out_pair(W1, W2) {
  if (! match((W1 W2), /[?]/)) { 
    printf "%s %s\n", W1, W2; return 1
  } else {
    return 0
  }
}

function map_text(tx,qmap,  rt) {
  rt = tolower(tx)
  # General cleanup, just in case:
  gsub(/[<][!][^<>]*[>]/, "", rt)
  gsub(/[<].[>]/, "", rt)
  gsub(/[«=»]/, "", rt)
  gsub(/[&][0-9][0-9][0-9][;]?/, "?", rt)
  rt = gensub(/[{]([^{}]*)[}]/, "\\1", "g", rt)
  
  # Delete all spaces:
  gsub(/[,.-]/, "", rt)

  # Map rare characters @b, @j, etc to '?':
  gsub(/[bjuvxy]/, "?", rt)

  # Map circles @q, @a, @o, @y:
  gsub(/[q]/, "Q", rt)
  gsub(/[oay]/, "O", rt)
  
  # Map codas: 
  gsub(/[i]*[nmg]/, "N", rt)
  gsub(/[i][i]?r/, "N", rt)
  
  # Map benches:
  gsub(/ee[e]?/, "B", rt)
  gsub(/[ics]h[e]?/, "B", rt)
  gsub(/c'h[e]?/, "B", rt)
  
  # Collapse all gallows to 'K':
  # Assume 'w' and 'z' are puffs with hooks.
  gsub(/[wztkpf][e]?/, "K", rt)
  
  # Split platform gallows:
  gsub(/[ic]Kh[he]?/, "BK", rt)
  
  # Map all dealers to D:
  gsub(/[i]*[dlrs]/, "D", rt)
  
  # Map unmapped letters to '?':
  gsub(/De/, "D?", rt)
  gsub(/Oe/, "O?", rt)
  gsub(/Qe/, "Q?", rt)
  gsub(/[?]e/, "??", rt)
  gsub(/[?]h/, "??", rt)
  
  gsub(/cK/, "?K", rt)
  gsub(/eK/, "?K", rt)
  gsub(/eO/, "?O", rt)
  gsub(/a[?]/, "??", rt)
  gsub(/iK/, "?K", rt)
  gsub(/iB/, "?B", rt)
  gsub(/eD/, "?D", rt)
  gsub(/i[?]/, "??", rt)
  gsub(/i[?]/, "??", rt) # Must do twice for "ii?".
  gsub(/e[?]/, "??", rt)
  
  if (qmap == 0) {
    # TEST - delete "Q", "O"
    gsub(/[QON]/, "", rt)
  }

  if (match(rt, /[^QOBKDN?]/)) { 
    printf "** tx = [[%s]]\n", tx > "/dev/stderr"
    printf "** rt = [[%s]]\n", rt > "/dev/stderr"
    ch = substr(rt, RSTART, RLENGTH)
    prog_error(("mapping failed at '" ch "'"))
  }
  return rt
}