
namespace eval ::tclzlib {
    namespace export deflate

    
    proc deflate { stream } {

	#status_log "reading from file $stream\n"
	set time [clock clicks]

	set def ""

	binary scan [read $stream 20] b* zlib

	set CMF [string range $zlib 0 7]
	set FLG [string range $zlib 8 15]
	#status_log "CMF = $CMF\nFLG = $FLG\n" red

	if { [binary format b* $CMF] != "\x78" || [string range $FLG 5 5] != 0 } {
	    #status_log "Compression of the zlib data is in an unknown format\n" error
	    return -1
	}

	binary scan [binary format b* [string range $zlib 0 15]] S FCHECK
	#status_log "FCHECK is such that CMF_FLG = $FCHECK\n" red
	if { [expr $FCHECK % 31 ] != 0 } {
	    #status_log "FCHECK is not a multiple of 31, corrupted data\n"
	    return -1
	}


	set bfinal  "0"
	set idx 16
	set len 160

	while { $bfinal != "1" } {

	    
	    set bfinal [string range $zlib $idx $idx]
	    incr idx
	    binary scan [binary format b* [string range $zlib $idx [expr $idx + 1]]] c btype
	    set idx [expr $idx + 2]

	    #status_log "Reading compressed block, with compression type $btype and final bloc = $bfinal\n"
	    if { $btype == 0 } {

		if { [expr $idx % 8] != 0 } {
		    set idx [expr $idx + 8 - ( $idx % 8)]
		}

		binary scan [string range $zlib $idx [expr $idx + 31]] SS len nlen 
		set idx [expr $idx + 32]
		if { [string map { "0" "1" } $bnlen] != $blen } {
		    #status_log "Len and NLen does not match : [string range $zlib [expr $idx -32] [expr $idx - 17]] --- [string range $zlib [expr $idx -16] [expr $idx - 1]]\nValues are $len and $nlen\n" red
		    return -1
		} else {
		    binary scan [string range $zlib $idx [expr $idx + 1]] S len 
		}
		
		#status_log "Reading uncompressed block with length $len from index $idx to [expr $idx + 3 + $len]\n"
		set def "${def}[string range $zlib [expr $idx + 4] [expr $idx + 3 + $len]]"
		set idx [expr $idx + 3 + $len]
		
	    } elseif { $btype == 3 } {
		#status_log "Got reserved word 11 for compression type : error\n" error
		return -1
	    } else {
		if { $btype == 2 } {
		    #status_log "Got Huffman's dynamic compression block, processing\n"
		    
		    #set time [clock clicks]

		    binary scan [binary format b* [string range $zlib $idx [expr $idx + 4]]] c hlit
		    set idx [expr $idx + 5]
		    set hlit [expr $hlit + 257]
		    binary scan [binary format b* [string range $zlib $idx [expr $idx + 4]]] c hdist
		    set idx [expr $idx + 5]
		    incr hdist
		    binary scan [binary format b* [string range $zlib $idx [expr $idx + 3]]] c hclen
		    set idx [expr $idx + 4]
		    set hclen [expr $hclen + 4]

		    #status_log "Got hlit = $hlit \nhdist = $hdist\nhclen = $hclen\n"


		    set codelengths [list 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15]
		    for { set i 0 } { $i < [expr $hclen * 3] } { set i [expr $i + 3]} {
			if { $idx > [expr $len - 3] } {
			    binary scan [read $stream 30] b* tmp
			    set zlib "[string range $zlib $idx end]$tmp"
			    set idx 0
			    set len [string length $zlib]
			}
			binary scan [binary format b* [string range $zlib $idx [expr $idx + 2]]] c clen([lindex $codelengths [expr $i / 3]])
			set idx [expr $idx + 3]
		    }
		    #status_log "Read the codelengths, idx = $idx -- len = $len --- zlib = $zlib\ncodelengths = \n[array get clen]\n"

		    array set huffcodes [createcodes [array get clen] 7 18]



		    #status_log "huffcodes = [array get huffcodes]\n"
		    #status_log "binary : [string range $zlib $idx  [expr $idx + 100]]\n\n"
		    set inc 0
		    set index 0
		    while { $index < $hlit } {
			if { $idx > [expr $len - 7] } {
			    binary scan [read $stream 30] b* tmp
			    set zlib "[string range $zlib $idx end]$tmp"
			    set idx 0
			    set len [string length $zlib]
			}
			set bin [string range $zlib $idx [expr $idx + $inc]]
			if { [info exists huffcodes($bin)] } {
			    #			#status_log "Found a length, for litteral value $index = $huffcodes($bin)\n"
			    set idx [expr $idx + $inc + 1]
			    if { $huffcodes($bin) < 16 } {
				set litclen($index) $huffcodes($bin)
				incr index
			    } elseif { $huffcodes($bin) == 16 } {
				set tocopy $litclen([expr $index - 1])
				binary scan [binary format b* [string range $zlib $idx [expr $idx + 1]]] c length
				set length [expr $length + 3]
				incr idx
				incr idx

				#			    #status_log "Copying value $tocopy into the next $length codes starting from $index\n"

				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "Literal length $index, copied value : $tocopy\n"
				    set litclen($index) $tocopy
				    incr index
				}

			    } elseif { $huffcodes($bin) == 17 } {
				binary scan [binary format b* [string range $zlib $idx [expr $idx + 2]]] c length
				set length [expr $length + 3]
				set idx [expr $idx + 3]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "Literal length $index, copied value : 0\n"
				    set litclen($index) 0
				    incr index
				}
			    } else {
				binary scan [binary format b* [string range $zlib $idx [expr $idx + 6]]] c length
				set length [expr $length + 11]
				set idx [expr $idx + 7]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "Literal length $index, copied value : 0\n"
				    set litclen($index) 0
				    incr index
				}
				
			    }
			    set inc 0
			} else {
			    incr inc
			    if { $inc > 7 } {
				#status_log "Erreur.. l'increment a depasse 7.. \ndump :\nindex = $idx - increment = $inc, index = $index, $hlit\nmemoire = [string range $zlib [expr $idx ] [expr $idx + $inc ]]\n"
	
				return -1
			    }

			}




		    }

		    array set litval [createcodes [array get litclen] 18 $hlit]
		   

		    set inc 0
		    set index 0
		    while { $index < $hdist } {
			if { $idx > [expr $len - 7] } {
			    binary scan [read $stream 30] b* tmp
			    set zlib "[string range $zlib $idx end]$tmp"
			    set idx 0
			    set len [string length $zlib]
			}
			set bin [string range $zlib $idx [expr $idx + $inc]]
			if { [info exists huffcodes($bin)] } {
			    #			#status_log "Found a length, for distance value $index = $huffcodes($bin)\n"
			    set idx [expr $idx + $inc + 1]
			    if { $huffcodes($bin) < 16 } {
				set distclen($index) $huffcodes($bin)
				incr index
			    } elseif { $huffcodes($bin) == 16 } {
				set tocopy $distclen([expr $index - 1])
				binary scan [binary format b* [string range $zlib $idx [expr $idx + 1]]] c length
				set length [expr $length + 3]
				incr idx
				incr idx

				#			    #status_log "Copying value $tocopy into the next $length codes starting from $index\n"

				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "distance length $index, copied value : $tocopy\n"
				    set distclen($index) $tocopy
				    incr index
				}

			    } elseif { $huffcodes($bin) == 17 } {
				binary scan [binary format b* [string range $zlib $idx [expr $idx + 2]]] c length
				set length [expr $length + 3]
				set idx [expr $idx + 3]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "distance length $index, copied value : 0\n"
				    set distclen($index) 0
				    incr index
				}
			    } else {
				binary scan [binary format b* [string range $zlib $idx [expr $idx + 6]]] c length
				set length [expr $length + 11]
				set idx [expr $idx + 7]
				#			    #status_log "Copying value 0 into the next $length codes starting from $index\n"
				for { set t 0 } { $t < $length } { incr t } {
				    #				#status_log "distance length $index, copied value : 0\n"
				    set distclen($index) 0
				    incr index
				}
				
			    }
			    set inc 0
			} else {
			    incr inc
			    if { $inc > 7 } {
				#status_log "Erreur.. l'increment a depasse 7.. \ndump :\nindex = $idx - increment = $inc, index = $index, $hlit\nmemoire = [string range $zlib [expr $idx ] [expr $idx + $inc ]]\n"
	
				return -1
			    }

			}
		    }

		    array set distval [createcodes [array get distclen] 18 $hdist]
	


		} else {
		    #status_log "Got Huffman's compressed block, processing\n"
		    array set litval [createcodes [fill_length lit] 18 287]
		    array set distval [createcodes [fill_length dist] 18 32]
		

		}
		

#		status_log "Time for processing header: [expr [clock clicks] - $time]\n"

		############################################################################################################

		set inc 0
		set index [string length $def]
		#set time [clock clicks]
		for { } { 1 } { } {
		    if { $idx > [expr $len - 15] } {
			binary scan [read $stream 30] b* tmp
			set zlib "[string range $zlib $idx end]$tmp"
			set idx 0
			set len [string length $zlib]
		    }
		    set bin [string range $zlib $idx [expr $idx + $inc]]
		    #status_log "time for string range : [time "string range $zlib $idx [expr $idx + $inc]"]\n"
		    #status_log "Time for infoexits : [time "info exists litval($bin)"] --- bin = $bin\n"
		    if { [info exists litval($bin)] } {
			set out $litval($bin)
					    #status_log "Found a length in index $index, for output = $out\n"
			set idx [expr $idx + $inc + 1]
			if { $out < 256 } {
			    set def "${def}[binary format c $out]"
			    incr index
			   #status_log "Time for literal value : [expr [clock clicks] - $time]\n"
			} elseif { $out == 256 } {
			    #status_log "FOUND END OF BLOCK\n" red
			    break
			} else {
			    #status_log "Need to move backward distance $out -- processing\n"
			    #set time [clock clicks]

			    if { $idx > [expr $len - 5] } {
				binary scan [read $stream 30] b* tmp
				set zlib "[string range $zlib $idx end]$tmp"
				set idx 0
				set len [string length $zlib]
			    }

			    if { $out < 265 } {
				set plus 0
				set length [expr $out - 254]
			    } elseif { $out == 285 } {
				set plus 0
				set length 258
			    } elseif { $out > 264 && $out < 269 } {
				binary scan [binary format b* [string range $zlib $idx  $idx]] c plus
				incr idx
				set length [expr (($out - 265) * 2) + $plus + 11]
			    } elseif { $out > 268 && $out < 273} {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 1]]] c plus
				incr idx
				incr idx
				set length [expr (($out - 269) * 4) + $plus + 19]
			    } elseif { $out > 272 && $out < 277 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 2]]] c plus
				set idx [expr $idx + 3]
				set length [expr (($out - 273) * 8) + $plus + 35]
			    } elseif { $out > 276 && $out < 281 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 3]]] c plus
				set idx [expr $idx + 4]
				set length [expr (($out - 277) * 16) + $plus + 67]
			    } else {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 4]]] c plus
				set idx [expr $idx + 5]
				set length [expr (($out - 281) * 32) + $plus + 131]
			    }

			    #status_log "time for ifelses : [expr [clock clicks] - $time]"
			    #status_log "Found length $length with added $plus\n"

			    set out2 -1 
			    set inc2 0
			    while { $out2 == -1 } {
				if { $idx > [expr $len - 15] } {
				    binary scan [read $stream 30] b* tmp
				    set zlib "[string range $zlib $idx end]$tmp"
				    set idx 0
				    set len [string length $zlib]
				}
				set bin [string range $zlib $idx [expr $idx + $inc2]]
				if { [info exists distval($bin)] } {
				    set out2 $distval($bin)
				    #status_log "Found a distance code  $out2\n"
				    set idx [expr $idx + $inc2 + 1]
				} else {
				    incr inc2
				    if { $inc2 > 15 } {
					#status_log "Erreur.. l'increment a depasse 15.. \ndump :\nindex = $idx - increment = $inc2, index = $index, $hlit\nmemoire = [string range $zlib [expr $idx ] [expr $idx + $inc2 ]]\n"
					return -1
				    }
				}
			    }

			    if { $idx > [expr $len - 13] } {
				binary scan [read $stream 30] b* tmp
				set zlib "[string range $zlib $idx end]$tmp"
				set idx 0
				set len [string length $zlib]
			    }

			    if { $out2 < 4 } {
				set plus 0
				set distance [expr $out2 + 1]
			    } elseif { $out2 == 4 || $out2 == 5} {
				binary scan [binary format b* [string range $zlib $idx  $idx]] c plus
				set plus [expr $plus % 256]
				incr idx
				set distance [expr (($out2 - 4) * 2) + $plus + 5]
			    } elseif { $out2 == 6 || $out2 == 7} {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 1]]] c plus
				set plus [expr $plus % 256]
				incr idx
				incr idx 
				set distance [expr (($out2 - 6) * 4) + $plus + 9]
			    } elseif { $out2 == 8 || $out2 == 9 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 2]]] c plus
				set plus [expr $plus % 256]
				set idx [expr $idx + 3]
				set distance [expr (($out2 - 8) * 8) + $plus + 17]
			    } elseif { $out2 == 10 || $out2 == 11} {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 3]]] c plus
				set plus [expr $plus % 256]
				set idx [expr $idx + 4]
				set distance [expr (($out2 - 10) * 16) + $plus + 33]
			    } elseif {$out2 == 12 || $out2 == 13 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 4]]] c plus
				set plus [expr $plus % 256]
				set idx [expr $idx + 5]
				set distance [expr (($out2 - 12) * 32) + $plus + 65]
			    } elseif {$out2 == 14 || $out2 == 15 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 5]]] c plus
				set plus [expr $plus % 256]
				set idx [expr $idx + 6]
				set distance [expr (($out2 - 14) * 64) + $plus + 129]
			    } elseif {$out2 == 16 || $out2 == 17 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 6]]] c plus
				set plus [expr $plus % 256]
				set idx [expr $idx + 7]
				set distance [expr (($out2 - 16) * 128) + $plus + 257]
			    } elseif {$out2 == 18 || $out2 == 19 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 7]]] c plus
				set plus [expr $plus % 256]
				set idx [expr $idx + 8]
				set distance [expr (($out2 - 18) * 256) + $plus + 513]
			    } elseif {$out2 == 20 || $out2 == 21 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 8]]] s plus
				set plus [expr $plus % 65536]
				set idx [expr $idx + 9]
				set distance [expr (($out2 - 20) * 512) + $plus + 1025]
			    } elseif {$out2 == 22 || $out2 == 23 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 9]]] s plus
				set plus [expr $plus % 65536]
				set idx [expr $idx + 10]
				set distance [expr (($out2 - 22) * 1024) + $plus + 2049]
			    } elseif {$out2 == 24 || $out2 == 25 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 10]]] s plus
				set plus [expr $plus % 65536]
				set idx [expr $idx + 11]
				set distance [expr (($out2 - 24) * 2048) + $plus + 4097]
			    } elseif {$out2 == 26 || $out2 == 27 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 11]]] s plus
				set plus [expr $plus % 65536]
				set idx [expr $idx + 12]
				set distance [expr (($out2 - 26) * 4096) + $plus + 8193]
			    } elseif {$out2 == 28 || $out2 == 29 } {
				binary scan [binary format b* [string range $zlib $idx  [expr $idx + 12]]] s plus
				set plus [expr $plus % 65536]
				set idx [expr $idx + 13]
				set distance [expr (($out2 - 28) * 8192) + $plus + 16385]
			    }

			    #			#status_log "Found distance $distance with added $plus\n"

			    set tocopy [string range $def [expr $index - $distance] $index]
			    while { [string length $tocopy] <= $length } {
				set tocopy "${tocopy}${tocopy}"
			    }

			    set tocopy [string range $tocopy 0 [expr $length -1]]
			    set def "${def}$tocopy"

			    set index [expr $index + $length]
			   #status_log "Time for distance : [expr [clock clicks] - $time]\n"
			}
			set inc 0
#			set time [clock clicks]
		    } else {
			incr inc

		    }
		}
		
	    }
	    
	}


	#status_log "Finished reading and uncompressing zlib blocks of data\n" blue
	status_log "Time for zlib: [expr [clock clicks] - $time]\n"

	return $def

    }


    proc createcodes { oclen maxbits maxcode } {

	array set clen $oclen 

	#    set clen [list 3 3 3 3 3 2 4 4]

	foreach c [array names clen] {
	    if {[info exists bl_count($clen($c))] } {
		incr bl_count($clen($c))
	    } else {
		set bl_count($clen($c)) 1
	    }
	}

	set code 0

	set bl_count(0) 0;
	#status_log "bl_cout = [array get bl_count]\n"
	for { set bits 1 } { $bits <= $maxbits } {incr bits} {
	    if { ![info exists bl_count([expr $bits - 1])] } {
		set bl_count([expr $bits - 1]) 0
	    }
	    set code [expr ($code + $bl_count([expr $bits - 1])) << 1];
	    set next_code($bits) $code;
	}
	
	#status_log "code = $code\nnext_code = [array get next_code]\n"

	for {set n  0} { $n <= $maxcode} {incr n} {
	    if { [info exists clen($n)]} {
		set len $clen($n) 
	    } else {
		set len 0
	    }
	    if { $len != 0} {
		binary scan [binary format s $next_code($len)] b$len bin
		#	    #status_log "$len = $next_code($len) = $bin = [invert $bin]\n"
		set bin [invert $bin]
		set codes($bin) $n
		incr next_code($len)
	    }
	}


	return [array get codes]

    }


    proc invert { bin } {

	set out ""
	
	for { set i [expr [string length $bin] - 1] } { $i >= 0 } { set i [expr $i - 1]} {
	    set out "$out[string index $bin $i]"
	}

	return $out
    }

    proc fill_length { type } {
	set out ""
	switch $type { 
	    "lit" {
		for { set i 0 } { $i <= 287 } { incr i } {
		    if { $i <= 143 } {
			set out "$out $i 8"
		    } elseif { $i <= 255 } {
			set out "$out $i 9"
		    } elseif { $i <= 279 } {
			set out "$out $i 7"
		    } else {
			set out "$out $i 8"
		    }
		}
	    }
	    "dist" {
		for { set i 0 } { $i <= 31} { incr i } {
		    set out "$out $i 5"
		}
	    }
	}

	return $out
    }
}

package provide tclzlib 0.1