################################################################
#
#	File:	fontimage.icn  
#
#	Subject:  
#
#	Author:	  Edrx
#
#	Date:	  
#
################################################################
#
#
#
# Libbables:
#
################################################################

$include "zinc.icn"

# (find-fline "~/C/fontimage.c")
# (find-ilcfile "dldemo.icn")

$define fontheight 8
$define c0c1 " o"
global rawfontstr
global cookedfontstr

$define FUNCLIB "/home/root/C/myclib.so"
global byteimage		# byteimage(c, c0c1)
global stringtochar		# stringtochar(s, c0c1)
global stoh			# stoh(s)
global htos			# stoh(sh)

## (find-iplfile "ipp.icn")

global Rawfont0, Rawfont, Names, Codes, Pairs
global ChTable

procedure cook8(s, label)
  A := list(8)
  every linen := 0 to fontheight - 1 do {
    A[linen + 1] := "     " || byteimage(s[linen + 1], c0c1)
    every charn := 1 to 7 do {
      A[linen + 1] ||:= "|" ||
	byteimage(s[fontheight * charn + linen + 1], c0c1)
    }
  }
  if \label then
    A[1][1 +: *label] := label
  return A
end

procedure cookrawfont(fontstr)
  A := []
  every cn := 0 to 248 by 8 do {
    s := fontstr[cn * fontheight + 1 +: 8 * fontheight]
    A |||:= cook8(s, right(cn, 3) || ":")
    put(A, "     --------+--------+--------+--------+--------+--------+--------+--------")
  }
  return A
end

procedure readcooked8(A)
  s := ""
  every charn := 0 to 7 do
    every linen := 0 to fontheight - 1 do
      s ||:= stringtochar(A[linen + 1][charn * 9 + 6 +: 8], c0c1)
  return s
end

procedure readcooked(A)
  every lin := 1 to *A do {
    s := A[lin]
    s ? if label := tab(find(":")) then {
      move(1)
      case label of {
	"names" :
	  every a := !(split(tab(0))) do
	    put(Names, if a == "." then &null else a)
	"codes" :
	  every a := !(split(tab(0))) do
	    put(Codes, numeric(a) | if a == "." then &null else ord(a[1]))
	"pairs" :
	  every a := !(split(tab(0))) do
	    put(Pairs, if a == "." then &null else a)
	"comments" :
	  return
	default :
	  Rawfont ||:= readcooked8(A[lin +: 8])
      }
    }
  }
end

procedure arrfind(obj, A)
  every i := 1 to *A do
    if A[i] === obj then
      suspend i
end

procedure processargs(args)
  an := 1
  while an <= *args do {
    case args[an] of {
      "-readrawfont" : {
	Rawfont0 := fname2string(args[an + 1])
	an +:= 2
      }
      "-readextras" : {
	readcooked(fname2array(args[an + 1]))
	an +:= 2
      }
      "-merge" : {
	every i := 1 to *Codes do {
	  if cn := \ (Codes[i]) then
	    Rawfont0[cn * fontheight + 1 +: fontheight] :=
	      Rawfont[(i - 1) * fontheight + 1 +: fontheight]
	}
	an +:= 1
      }
      "-writerawfont" : {
	fout := myopen(args[an + 1], "w")
	writes(fout, Rawfont0)
	an +:= 2
      }
      "-writecooked" : {
	A := cookrawfont(Rawfont0)
	array2fname(A, args[an + 1])
	an +:= 2
      }
      "-writecompose" : {
	every i := 1 to *Codes do {
	  if (cn := \ (Codes[i])) & (pair := \ (Pairs[i])) then
	    write("compose '", pair[1], "' '", pair[2],
		  "' to '", char(cn), "'")
	}
	an +:= 1
      }
      "-tablechars" : {
	every i := 0 to 255 do {
	  s := Rawfont0[i * fontheight + 1 +: fontheight]
	  h := stoh(s)
	  l := " " || right(i, 3) || "." || args[an + 1]
	  ChTable[h] ||:= l
	}
	an +:= 2
      }
      "-writetable" : {
	write(*ChTable)
	every p := !(sort(ChTable, 1)) do
	  write(p[1], p[2])
	an +:= 1
      }
      default : {
	write("Bad instruction: ", args[an])
	write("See ~/C/math.extras for examples of usage.")
	stop()
      }
    }
  }
end

procedure main(args)
  byteimage := loadfunc(FUNCLIB, "byteimage")
  stringtochar := loadfunc(FUNCLIB, "stringtochar")
  stoh := loadfunc(FUNCLIB, "stoh")
  htos := loadfunc(FUNCLIB, "htos")
  Names := []
  Codes := []
  Pairs := []
  Rawfont := ""
  ChTable := table("")
  processargs(args)
end

# -readrawfont /home/replace/ega1.8
# -readkeymap /home/replace/defkeymap850b.map
# -readextras ~/C/math.extras
# -merge
# -writerawfont ~/C/math1.8
# -writecompose