#!/home/root/MTA/vtutilsh
#
# vtutil - modify/set Linux VC fonts, take pnm screenshots of VCs.
# Edrx, 99oct20.
# This is a Tcl script using the vtutilsh extensions.
# (find-fline "~/MTA/vtutilsh.c")
# (find-fline "~/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
}
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
}
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
}
#
# Functions callable by the user
#
proc modifyfont {nchars nrows fontfname newfontfname} {
global charimages charchars
set data [readfile $fontfname]
foreach charmatrix $charimages destchar $charchars {
if {$destchar!="."} {
set chardata [eval tobinary $charmatrix]
if {$nrows>=14} {set chardata [duplicate_rows $chardata]}
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...
setfont0 $devfile $nchars $nrows [readfile $fontfname]
close $devfile
}
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'"
}
}
}
# (find-k2file "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"
}
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 |
|ooo o | ooo | oo |
| o | o o | oo |
| ooo | ooo | oo |
| | o | oo |
| | 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
lappend charchars ü Œ
lappend charcomps -1 bq In
# (setglyphs ?\^R nil 18 ?\^E nil 5 ?\^T nil 20 ?\^D nil 4)
# (ascstr 0 255)
if {$argv==""} {
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
"
exit 1
} else {
eval $argv
}