#!/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 }