Warning: this is an htmlized version!
The original is across this link,
and the conversion rules are here.
#!/usr/bin/tclsh
#!/usr/bin/tclsh8.2
#!/usr/bin/tclsh8.3
#!/home/root/MTA/vtutilsh
#
# «.vcsa2pnm»		(to "vcsa2pnm")
# «.examples_of_usage»	(to "examples_of_usage")

if {[info commands setfont]==""} {
  load [file dirname [info script]]/vtutilsh.so Vtutil
}

# vtutil - modify/set Linux VC fonts, take pnm screenshots of VCs.
# Edrx, 99oct20; last changed 2001feb02
# This is a Tcl script using the vtutilsh extensions.
# (find-angg "MTA/vtutilsh.c")
# (find-angg "MTA/Makefile")
#
# vtutilsh.c defines these Tcl commands:
#
# change_char nchar chardata nchars nrows data  ->  newdata
# change_nchars    newnchars nchars nrows data  ->  newdata
# change_nrows      newnrows nchars nrows data  ->  newdata
# duplicate_rows        data                    ->  newdata
# setfont            channel nchars nrows data
# tobinary           rowdata rowdata ...        ->  chardata
# vcsa2pnmdata rgb0 rgb1 ... rgb15 nchars nrows fontdata vcsadata
#
# change_nchars and change_nrows aren't being used at this moment.

# (find-es "tcl" "mktclapp_objcom")
# (gdb "gdb -quiet -x ~/MTA/new2.gdb new2")
# (find-fline "~/MTA/")
# (find-fline "~/MTA/new2.c")
# (find-fline "~/MTA/new2.gdb")
# (find-fline "~/MTA/newtest.tcl")
# (find-fline "~/MTA/Makefile")
# (find-fline "~/MTA/test.tcl")

proc readfile {fname} {
  set channel [open $fname r]; set bigstr [read $channel]; close $channel
  return $bigstr
}
proc writefile {fname bigstr} {
  set channel [open $fname w]; puts -nonewline $channel $bigstr; close $channel
}

# Return ascii value of the first char in string
proc ord {str} {
  scan $str "%c" ord
  return $ord
}

set shuffle {}
proc shuffle {char} {
  global shuffle
  expr {$shuffle=="" ? $char : [string index $shuffle [ord $char]]}
}

proc transpose {lists} {
  set i 1
  foreach l [lindex $lists 0] {lappend is $i; incr i}
  foreach list $lists {foreach i $is elt $list {lappend T($i) $elt}}
  foreach i $is       {lappend transposed $T($i)}
  return $transposed
}
# Convert a string with many big chars into an array of bitmaps
proc crunch {str} {
  set lines [split $str "\n"]
  set blines {}
  set bitmaps {}
  foreach line $lines {
    if {[regexp {^\|(.*)\|$} $line -> line]} {
      lappend blines [split $line "|"]
    } elseif [regexp {\+--} $line] {
      if {$blines!=""} {
	eval lappend bitmaps [transpose $blines]
      }
      set blines {}
    } else {
      puts "?: $line"
      exit 1
    }
  }
  return $bitmaps
}

# Convert a row of (generally 8) chars to big chars
#
proc rowofbigchars {fontdata startchar nchars height width} {
  set charmatrices {}
  #
  # For each of the $nchars chars we're considering,
  for {set i 0} {$i<$nchars} {incr i} {
    set thischar_rows {}
    set cstart [expr ($startchar+$i)*$height]
    set bytes [string range $fontdata $cstart [expr $cstart+$height-1]]
    #
    # For each of the $height bytes this char takes in the font,
    foreach {byte} [split $bytes {}] {
      lappend thischar_rows [toasciirow $byte " " "o" 8]
    }
    lappend charmatrices $thischar_rows
  }
  set asciirows {}
  foreach {row} [transpose $charmatrices] {
    lappend asciirows "|[join $row "|"]|"
  }
  return $asciirows
}





#
# Functions callable by the user
#

proc 0..255 {} {
  for {set i 0; set s {}} {$i<256} {incr i} {append s [format %c $i]}
  puts -nonewline $s
}
proc setshuffle {fname} {
  global shuffle
  set shuffle [readfile $fname]
}
proc reorderfont {nchars nrows origfontname shufflefile newfontname} {
  setshuffle $shufflefile
  set origfont [readfile $origfontname]
  for {set i 0; set fontdata {}} {$i<$nchars} {incr i} {
    set offset [expr $nrows*[ord [shuffle [format %c $i]]]]
    append fontdata [string range $origfont $offset [expr $offset+$nrows-1]]
  }
  writefile $newfontname $fontdata
}

proc modifyfont {nchars nrows fontfname  newfontfname} {
  global charimages charchars
  set data [readfile $fontfname]
  foreach charmatrix $charimages destchar $charchars {
    if {$destchar!="."} {
      set destchar [shuffle $destchar]
      set chardata [eval tobinary $charmatrix]
      if {$nrows>=14} {set chardata [duplicate_rows $chardata]}
      # puts [string length $data]
      set data [change_char [ord $destchar] $chardata $nchars $nrows $data]
    }
  }
  writefile $newfontfname $data
}

# "setfont" sounds high-level, so we rename the C command to setfont0
rename setfont setfont0

# A hack: if we open /dev/tty or /dev/ttyn then the terminal settings
# are disturbed and "LF"s lose their implicit "CR"s... So we allow
# "file0" (stdin), "file1" (stdout) and "file2" (stderr) in place
# of the devfname, meaning: issue the ioctl on that file descriptor,
# without opening or closing anything. Edrx, 00jan28.
#
# (find-fline "/usr/include/unistd.h" "STDIN")
# (find-es "console" "avoiding_tty_reset")

proc setfont {nchars nrows fontfname  devfname} {
  if {[regexp "file" $devfname]} {
    puts "Using $devfname..."
    setfont0 $devfname $nchars $nrows [readfile $fontfname]
    return
  }
  set devfile [open $devfname {WRONLY NOCTTY NONBLOCK}]
  # I got the flags {WRONLY NOCTTY NONBLOCK} by trial and error...
  puts [string length [readfile $fontfname]]
  setfont0 $devfile $nchars $nrows [readfile $fontfname]
  close $devfile
}

# A quick hack to set 256 chars fonts
proc quicksetfont {fontfname} {
  set nrows [expr [string length [readfile $fontfname]]/256]
  setfont 256 $nrows $fontfname file0
}

proc rowsofbigchars {fontname height} {
  set delim "+--------+--------+--------+--------+--------+--------+--------+--------+"
  set bigstr "$delim\n"
  set fontdata [readfile $fontname]
  set nchars [expr [string length $fontdata]/$height]
  for {set i 0} {$i<$nchars} {incr i 8} {
    append bigstr "[join [rowofbigchars $fontdata $i 8 $height 8] "\n"]\n"
    append bigstr "$delim\n"
  }
  puts -nonewline $bigstr
}


proc composetable {} {
  global charchars charcomps
  foreach charchar $charchars charcomp $charcomps {
    if {$charchar!="." && [string length $charchar]==1} {
      regexp "(.)(.)" $charcomp -> c1 c2
      puts "compose '$c1' '$c2' to '$charchar'"
    }
  }
}

# «vcsa2pnm»  (to ".vcsa2pnm")
# (find-k22file "drivers/char/console.c" "default_red[] =")
# red[] = 00 aa 00 aa 00 aa 00 aa 55 ff 55 ff 55 ff 55 ff
# grn[] = 00 00 aa 55 00 00 aa aa 55 55 ff ff 55 55 ff ff
# blu[] = 00 00 00 00 aa aa aa aa 55 55 55 55 ff ff ff ff
#
proc vcsa2pnm {devfname  nchars nrows fontfname  pnmfname} {
  set pnmdata [vcsa2pnmdata \
    { 0 0 0} { 0 0 2} { 0 2 0} { 0 2 2} \
    { 2 0 0} { 2 0 2} { 2 1 0} { 2 2 2} \
    { 1 1 1} { 1 1 3} { 1 3 1} { 1 3 3} \
    { 3 1 1} { 3 1 3} { 3 3 1} { 3 3 3} \
    $nchars $nrows [readfile $fontfname] [readfile $devfname]]
  writefile $pnmfname "P3\n[expr 80*9] [expr 50*8] 3\n#\n$pnmdata\n"
}

# Experimental - para o meu cartÆo de visitas
#proc vcsa2pnm {devfname  nchars nrows fontfname  pnmfname} {
#  set colors [list \
#    { 0 0 0} { 0 0 2} { 0 2 0} { 0 2 2} \
#    { 2 0 0} { 2 0 2} { 2 1 0} { 2 2 2} \
#    { 1 1 1} { 1 1 3} { 1 3 1} { 1 3 3} \
#    { 3 1 1} { 3 1 3} { 3 3 1} { 3 3 3} \
#  ]
#  foreach n {0 7 15} c {{ 3 3 3} { 0 0 0} { 0 0 0}} {
#    set colors [lreplace $colors $n $n $c]
#  }
#  set pnmdata [eval vcsa2pnmdata $colors \
#    [list $nchars $nrows [readfile $fontfname] [readfile $devfname]]]
#  writefile $pnmfname "P3\n[expr 80*9] [expr 50*8] 3\n#\n$pnmdata\n"
#}





set charimages [crunch {\
+--------+--------+--------+--------+--------+--------+--------+--------+
|ooooooo |   o    |        |o     o | oooooo |        |  ooo   |  ooo   |
|o     o |  o o   | o   o  |o     o |      o |        | o   o  | o o o  |
|o     o | o   o  |  o o   | o   o  |      o |   oo   |o o o o |o  o  o |
|o     o |o     o |   o    | ooooo  |   oooo |  o  o  |o  o  o |ooooooo |
|o     o | o   o  |  o o   |  o o   |      o |  o  o  |o o o o |o  o  o |
|o     o |  o o   | o   o  |  o o   |      o |   oo   | o   o  | o o o  |
|ooooooo |   o    |        |   o    | oooooo |        |  ooo   |  ooo   |
|        |        |        |        |        |        |        |        |
+--------+--------+--------+--------+--------+--------+--------+--------+
|oo      |  ooo   |   o    |        |oo ooo  |        |        |        |
| oo     | o   o  |   o    |        | oo  oo |ooooooo |   o    |   o    |
|  oo    |ooo ooo | ooooo  |    ooo | ooo oo |   o    |   o    | ooooo  |
|  ooo   |o ooo o |        |ooooo oo|oo ooo  |   o    |   o    |   o    |
| oo oo  |ooo ooo |        |    ooo |  ooo   |   o    |   o    |   o    |
|oo   oo | o   o  |        |        | oo oo  |   o    |   o    |   o    |
|o     o |  ooo   |        |        |  ooo   |   o    |ooooooo |  o oo  |
|        |        |        |        |        |        |        |        |
+--------+--------+--------+--------+--------+--------+--------+--------+
| oo     |        |        |        |        |  ooo   |ooooooo |        |
|  oo    |  ooo   | o   o  |  ooo   |        | o   o  |oo   oo |        |
|   oo   | o      | o   o  | o   o  |        |     o  | o   o  |        |
|    oo  | oooo   | o   o  | o   o  | o o o o|  oooo  | oo oo  |        |
| ooooo  | o      | o   o  | o   o  |        | o   o  |  o o   |    ooo |
|        |  ooo   |  ooo   | o   o  |        | o   o  |  ooo   |    ooo |
| ooooo  |        |        |        |        |  ooo   |   o    |    ooo |
|        |        |        |        |        |        |        |        |
+--------+--------+--------+--------+--------+--------+--------+--------+
|        |        |  oooo  |  ooo   |        |        |        |    ooo |
|        |        | oo  oo | oo oo  |        |        |        |   oo   |
|   ooo  |  ooooo | oo  oo |oo   oo | o   o  | oooooo | o    o |    oo  |
|  o   o | oo     | oooooo |oo   oo |o o   o | o    o | o    o |  ooooo |
|  o   o | ooooo  | oo  oo |oo   oo |  o  o  | o    o | o    o | oo  oo |
|  oo  o | oo     | oo  oo | oo oo  |  o o   | o    o | o    o | oo  oo |
|  o oo  |  ooooo |  oooo  |ooo ooo |  oo    | o    o | oooooo |  oooo  |
| oo     |        |        |        |        |        |        |        |
+--------+--------+--------+--------+--------+--------+--------+--------+
|     o  | o      |    oo  |        |        |        |        |        |
|    oo  | o      |   oo o |   o    | o   o  |  o  o  |        |o       |
|ooo  o  | ooo    |   oo   |  o o   | o   o  |  o  o  | oo oo  |o       |
|     o  | o o    |   oo   |  o o   |  o o   |  o  o  |o  o  o |oo   oo |
|    ooo | ooo    |   oo   | o   o  |  o o   |  o  o  |o  o  o |o o o   |
|        |   o    |   oo   | o   o  |   o    | oooooo | oo oo  |o o oo  |
|        |   o    | o oo   |        |        |        |        |oo  o   |
|        |        |  oo    |        |        |        |        |    o   |
+--------+--------+--------+--------+--------+--------+--------+--------+
|  oooo  |  oooo  |ooo ooo |        |        |
|  o     |     o  |o     o |        |        |
|  o     |     o  |o     o |        | o   o  |
|  o     |     o  |o     o |oo oooo |o     o |
|        |        |        |o  o o o|o     o |
|        |        |        |o  o o o|o  o  o |
|        |        |        |o  o o o| oo oo  |
|        |        |        |        |        |
+--------+--------+--------+--------+--------+}]

lappend charnames  nec poss times Fa Ex comp otimes oplus
lappend charchars     è         ì  í      Ï      
lappend charcomps  nn  pp   xx    fa ex oo   ox     o+

lappend charnames  lambda otimes perp lolli  par T  bot truthval
lappend charchars        Ï      Ñ             õ     .
lappend charcomps  ll     ox     pe   -o     &&  TT bo  tv

lappend charnames  >=  in cup cap dotli partial nabla block
lappend charchars     ×  ç      ö                 
lappend charcomps  >=  in cu  ca  ..    pa      na    bl

lappend charnames  rho eps theta Omega nu sqcap sqcup delta
lappend charchars                  ê       Ó     
lappend charcomps  ro  ee  te    Om    nu ka    ku    dd

lappend charnames  -1  nat int land lor amalg infty bf
lappend charchars  ü             ∨        ò     
lappend charcomps  -1  bq  In  la   lo  am    88    bf

lappend charnames  ulcorn urcorn ucorns rm omega
lappend charchars              .        Õ
lappend charcomps  ul     ur     uc     rm ww

# (setglyphs ?\^R nil 18 ?\^E nil 5 ?\^F nil 6 ?\^T nil 20 ?\^D nil 4 ?\^^ nil 30 ?\^_ nil 31)
# (ascstr 0 255)

# cd ~/MTA; make VTUTIL="./vtutilsh vtutil" TCLVERSION=8.3; math


if {$argv==""} {
  # «examples_of_usage»  (to ".examples_of_usage")
  puts stderr "Examples of usage:

  $argv0 modifyfont 256 8 ega1.8  math1.8
  $argv0 setfont    256 8 math1.8  /dev/tty0
  (cat defkeymap850b.map; echo '#'; $argv0 composetable) > math850.map
  $argv0 vcsa2pnm   /dev/vcsa4  256 8 math1.8  /tmp/screenshot1.pnm
  $argv0 rowsofbigchars ega1.8 8
  $argv0 0..255 | tcs -f latin1-850 -t ps2 > isoto850.cmap
  $argv0 reorderfont 256 8 ega1.8 isoto850.cmap latin850.8
  $argv0 'setshuffle isoto850.cmap; modifyfont 256 8 latin850.8 latin850math.8'
"
  exit 1
} else {
  eval $argv
}

# Local Variables:
# coding:               no-conversion
# ee-anchor-format:     "«%s»"
# ee-charset-indicator: "Ñ"
# End: