#!/usr/bin/wish
# (C) 2002 Witold Filipczyk
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#   Author contact information:
#   E-mail: witekfl@poczta.onet.pl
#   Postal address: Wgsty 1, 11-332 Lutry, Poland

proc zrob_obrazek {nr height data i} {

	set xpm_header "#define image4
#define image4_width 8
#define image4_height $height
static unsigned char image4_bits\[\] = \{\n"

	set aaa $xpm_header
	set bbb $xpm_header
	set forma "0x%02x, "

	set res [binary format "b[expr $height*8]" $data]
	binary scan $res c$height data2
	foreach liczba $data2 {
		if {$liczba < 0} {
			set liczba [expr $liczba + 256]
		}
		append aaa [format $forma $liczba]
		append bbb [format $forma 255]
	}
	append aaa "\};"
	append bbb "\};"
	set w .font$nr
	set a [image create bitmap $w.$i.im -data $aaa -maskdata $bbb \
		-background white -foreground black]
	return $a
}

wm title . "PSF font editor"
wm iconname . "PSF edit"

set pusty "00000000"
foreach a { 0.125 0.25 0.5 1 2 4 8 16 32 64 128 256 512} {
	append pusty $pusty
}

frame .edycja
pack .edycja -expand yes -fill both -padx 2 -pady 2 
for {set y 0} {$y < 16} {incr y} {
	for {set x 0} {$x < 8} {incr x} {
		checkbutton .edycja.$y$x -indicatoron false -offvalue 0 \
		-onvalue 1 -width 1 -height 1 -variable zmienna($y,$x) \
		-activebackground blue
	  bind .edycja.$y$x <Button-3> ".edycja.$y$x deselect"
		bind .edycja.$y$x <Button-2> ".edycja.$y$x select"
		bind .edycja.$y$x <Left> "if {$x > 0} {\
			focus .edycja.$y[expr $x - 1]}"
		bind .edycja.$y$x <Right> "if {$x < 7} {\
			focus .edycja.$y[expr $x + 1]}"
		bind .edycja.$y$x <Up> "if {$y > 0} {\
			focus .edycja.[expr $y - 1]$x}"
		bind .edycja.$y$x <Down> "if {$y < 15} {\
			focus .edycja.[expr $y + 1]$x}"
		grid .edycja.$y$x -in .edycja -column $x -row $y
	}
}

menu .menu -tearoff 0
set m .menu.file
menu $m -tearoff 0
.menu add cascade -label "File" -menu $m -underline 0
$m add command -label "Open..." -command "open_file"
$m add command -label "New" -command "nowy"
$m add separator
$m add command -label "Exit" -command "destroy ."

set m .menu.help
.menu add cascade -label "Help" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Help" -command "pomoc"
$m add command -label "About" -command "about"

. configure -menu .menu

set nr 0

# Wywietla okienko wyboru pliku 
proc open_file {} {

	set filename [tk_getOpenFile -initialdir /usr/share/consolefonts \
	-title "Choose font" \
	-filetypes { \
	{"PSF files" {.psf .psf.gz .psfu .psfu.gz}} \
	{"All files"  *}} ]
 
	if {[file extension $filename] == ".gz"} {
		set f [open "| zcat $filename" "r"]
	} {
		set f [open $filename "r"]
	}

	set header [read $f 4]
	binary scan $header cccc header1 header2 mode height
	if {$header1 == 0x36 && $header2 == 0x04} {
		if {$mode & 1 == 1} {
			set glyphs  512
		} {
			set glyphs  256
		}
	
		if {$mode & 2 == 2} {
			set has_unicode 1
		} {
			set has_unicode 0
		}
	
		set font [read $f [expr $height * $glyphs]]
		set unicode_info [read $f]
		close $f
		binary scan $font "B[expr 8 * $height * $glyphs]" napis
		showfont $height $glyphs $napis $unicode_info $filename
	} {
		puts "Unknown file"
	}
} 


# Wywietla wszystkie symbole z fontu
proc showfont {height glyphs napis unicode_info filename} {
	global data nr h chars files symbol uni
	
	incr nr
	set data($nr) $napis
	set files($nr) $filename
	set h($nr) $height
	set chars($nr) $glyphs
	set uni($nr) $unicode_info

	set w .font$nr
	catch {destroy $w}
	toplevel $w
	wm title $w "Font $filename"
	
	menu $w.menu -tearoff 0
	set m $w.menu.file
	menu $m -tearoff 0
	$w.menu add cascade -label "File" -menu $m -underline 0
	$m add command -label "Save As..." -command "save_as $nr"
	$m add separator
	$m add command -label "Close" -command "destroy $w"
	
	$w configure -menu $w.menu
		
	frame $w.grid
	pack $w.grid -expand yes -fill both -padx 1 -pady 1
	for {set i 0} {$i < $glyphs} {incr i} {
		set offset [expr $height * $i]
		set first [expr $height * 8 * $i]
		set last [expr $height * 8 * ($i + 1) - 1]
		set a [zrob_obrazek $nr $height [string range $napis $first $last] $i]
		radiobutton $w.radio$i -image $a -indicatoron false \
			-activebackground blue -selectcolor red -relief flat \
			-variable symbol($nr) -value $i -command "powiekszenie $nr"
		bind $w.radio$i <Button-3> "wstaw $nr %W"
		bind $w.radio$i <p> "wstaw $nr %W"
		bind $w.radio$i <Left> "if {[expr $i % 32] != 0} {\
			focus $w.radio[expr $i - 1]}"
		bind $w.radio$i <Right> "if {[expr $i % 32] != 31} {\
			focus $w.radio[expr $i + 1]}"
		bind $w.radio$i <Up> "if {$i > 31} {\
			focus $w.radio[expr $i - 32]}"
		bind $w.radio$i <Down> "if {[expr $i + 32] < $glyphs} {\
			focus $w.radio[expr $i + 32]}"
		bind $w.radio$i <Button-2> "swap $nr %W"
		bind $w.radio$i <s> "swap $nr %W"
		grid $w.radio$i -in $w.grid -column [expr $i % 32] -row [expr $i / 32]
	}
}

# Powiksza symbol wskazany lewym przyciskiem myszy
proc powiekszenie {nr} {
	global symbol h 
	
	show $nr $h($nr) $symbol($nr)
}

proc show {nr height symbol} {
global data

	set first [expr $height * 8 * $symbol]
	set last [expr $height * 8 * ($symbol + 1) - 1]
	set la [string range $data($nr) $first $last]

	for {set y 0} {$y < $height} {incr y} {
		for {set x 0} {$x < 8} {incr x} {
			if {[string index $la [expr $x+$y*8]] == 1} {
				.edycja.$y$x select
			} {
				.edycja.$y$x deselect
			}
		}
	}
}

# zamienia znak obecnie edytowany ze wskazanym prawym klawiszem myszy
proc swap {nr i} {
	global h 
	
	scan [winfo name $i] "radio%d" symbol
	set aaa [odczyt $h($nr)]
	show $nr $h($nr) $symbol
	change $nr $h($nr) $i $aaa $symbol
}


# wstawia znak z edycji na pozycj wskazan prawym przyciskiem myszy
proc wstaw {nr i} {
	global h

	scan [winfo name $i] "radio%d" symbol

	set aaa [odczyt $h($nr)]
	change $nr $h($nr) $i $aaa $symbol
}

proc change {nr height i aaa symbol} {	
	global data

	set bbb ""
	set first [expr $height * 8 * ($symbol) - 1]
	set len [string length $aaa]
	set last2 [expr [string length $data($nr)] - 1]
	append bbb [string range $data($nr) 0 $first] $aaa \
             [string range $data($nr) [expr $first+$len+1] $last2]	  
	set data($nr) $bbb
	
	set w .font$nr
	image delete $w.$symbol.im
	zrob_obrazek $nr $height $aaa $symbol
}	


# odczytuje dane z edycji - zwraca zerojedynkowy acuch
proc odczyt {height} {
global zmienna

	set a ""
	for {set y 0} {$y < $height} {incr y} {
		for {set x 0} {$x < 8} {incr x} {
			append a $zmienna($y,$x)
		}
	}
	return $a
}

proc pomoc {} {
	tk_messageBox -icon info -message "Edit
* left button - toggle
* middle button - select
* right button - deselect
---------------------------
Font
* left button - Edit
* middle button or 's' - Swap
* right button or 'p' - Paste" -type ok -parent .
}

proc about {} {
	tk_messageBox -icon info -message "Prosty edytor fontw PSF
(C) 2002 Witold Filipczyk
License: GPLv2"  -type ok -parent .
}

proc nowy {} {
	global pusty
	
	showfont 16 256 $pusty "" "Bez_nazwy.psf"
}

proc save_as {nr} {
global chars data h files uni 

	set filename [tk_getSaveFile -initialfile $files($nr) -initialdir /usr/share/consolefonts -title "Wybierz czcionk" \
	-filetypes { \
	{"Czcionki PSF" {.psf .psf.gz .psfu .psfu.gz}} \
	{"Wszystkie pliki"  *}} ]

	set format "B[expr $h($nr) * 8 * $chars($nr)]"
	set font [binary format $format $data($nr)]
	set mode 0
	if { $uni($nr) != "" } {
		set mode [expr $mode + 2]
	}
	if { $chars($nr) > 256 } {
		set mode [expr $mode + 1]
	}
	set header [binary format "cccc" 0x36 0x04 $mode $h($nr)]
	set res $header
	append res $font $uni($nr)
	
	if {[file extension $filename] == ".gz"} {
		set f [open "| gzip > $filename" "w"]
	} {
		set f [open $filename "w"]
	}
	puts -nonewline $f $res
	close $f
}
