|
Warning: this is an htmlized version!
The original is here, 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: