package provide xtcl 0.1

# NE MARCHE PAS ENCORE !!!
# 
# set d [Base64_Encode $t]; string llength $d
# 
# Exemple d'utilisation pour décoder un fichier avec stead :
# - lancer la console <Meta-y>
# - file_write OUT.ps [Base64_Decode [file_read rapport_gaudin.ps.b64.brut]]
# 
# historique :
# 03/04/01 (diam) : ajout de Base64_Decodefile
# 03/04/01 (diam) : séparation de  Base64_Init
# copyright...
#   The core of these proc is from Brent Welch :
# 
#     From: bwelch@Eng.Sun.COM (Brent B. Welch)
#     Newsgroups: comp.lang.tcl
#     Subject: base64.tcl
#     Date: 17 Sep 1997 16:10:00 GMT
#     Organization: Sun Microsystems Inc., Mountain View, CA
# 
####################################################################
#
# File : base64.tcl (de exmh)
# 
proc Base64_Init {} {
    global base64 base64_en
    # Emit base64 encoding for a string
    set i 0
    foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
                  a b c d e f g h i j k l m n o p q r s t u v w x y z \
                  0 1 2 3 4 5 6 7 8 9 + /} {
        set base64($char) $i
        set base64_en($i) $char
        incr i
    }
}
proc Base64_Encode {string} {
    global base64_en
    if {![array exists base64]} {
        Base64_Init
    }
    
    return [Base64_EncodePriv $string]
}
proc Base64_Decode {string} {
    global base64
    if {![array exists base64]} {
        Base64_Init
    }
    
    # Remove all spaces 
    regsub -all {[\n\t ]} $string {} string

    return [Base64_DecodePriv $string]
}
##  --
# Effectue le traitement brut sur une chaine supposée correcte
proc Base64_EncodePriv {string} {
    global base64_en

    set result {}
    set state 0
    set length 0
    foreach {c} [split $string {}] {
	scan $c %c x
	switch [incr state] {
	    1 {	append result $base64_en([expr {($x >>2) & 0x3F}]) }
	    2 { append result $base64_en([expr {(($old << 4) & 0x30) \
                                             | (($x >> 4) &  0xF)}]) }
	    3 {
		append result $base64_en([expr {(($old << 2) & 0x3C) \
                                             | (($x >> 6) & 0x3)}])
		append result $base64_en([expr {($x & 0x3F)}])
		set state 0
	    }
	}
	set old $x
	incr length
	if {$length >= 72} {
	    append result \n
	    set length 0
	}
    }
    set x 0
    switch $state {
	0 { # OK }
	1 { append result $base64_en([expr {(($old << 4) & 0x30)}])== }
	2 { append result $base64_en([expr {(($old << 2) & 0x3C)}])=               }
    }
    return $result
}
## Base64_DecodePriv -- 
# Effectue le traitement brut sur une chaine supposée correcte
# 
proc Base64_DecodePriv {string} {
    global base64
    set output {}
    set group 0
    set j 18
    foreach char [split $string {}] {
	if [string compare $char "="] {
	    set bits $base64($char)
	    set group [expr {$group | ($bits << $j)}]
	}

	if {[incr j -6] < 0} {
		scan [format %06x $group]] %2x%2x%2x a b c
		append output [format %c%c%c $a $b $c]
		set group 0
		set j 18
	}
    }
    return $output
}
## Base64_Decodefile -- decode un fichier base64 en un fchier de sortie
# 
# 
proc Base64_Decodefile { fileIn fileOut } {
    set stringIn [file_read $fileIn]
    
    # One should strip all header !
    # ...
    
    set stringOut [Base64_Decode $stringIn]
    # # write_file $fileOut $stringOut
    file_write $fileOut $stringOut
}
# ./
