proc bindex {buf idx} {
	binary scan $buf x${idx}c byte
	expr {$byte & 0xff}
}

namespace eval ::pvrt2tga {}
namespace eval ::pvrt2tga::pfmt {}
namespace eval ::pvrt2tga::dfmt {
	variable tmap {0 1}
}

# src = raw buffer, dst = []BGRA
proc ::pvrt2tga::pfmt::lookup {code} {
	switch -- $code {
	0 { return ::pvrt2tga::pfmt::argb1555 }
	1 { return ::pvrt2tga::pfmt::rgb565 }
	2 { return ::pvrt2tga::pfmt::argb4444 }
	default { return "" }
	}
}
proc ::pvrt2tga::pfmt::argb1555 {srcvar srcidx dstvar dstidx} {
	upvar $srcvar srcbuf $dstvar dstbuf

	set srcidx [expr {$srcidx * 2}]
	binary scan $srcbuf x${srcidx}s pixel

	set dstidx [expr {$dstidx * 4}]
	lset dstbuf $dstidx+0 [expr {($pixel        & 0x1f) * 0xff / 0x1f}]
	lset dstbuf $dstidx+1 [expr {($pixel >> 0x5 & 0x1f) * 0xff / 0x1f}]
	lset dstbuf $dstidx+2 [expr {($pixel >> 0xa & 0x1f) * 0xff / 0x1f}]
	lset dstbuf $dstidx+3 [expr {($pixel >> 0xf & 0x01) * 0xff       }]
}
proc ::pvrt2tga::pfmt::rgb565 {srcvar srcidx dstvar dstidx} {
	upvar $srcvar srcbuf $dstvar dstbuf

	set srcidx [expr {$srcidx * 2}]
	binary scan $srcbuf x${srcidx}s pixel

	set dstidx [expr {$dstidx * 4}]
	lset dstbuf $dstidx+0 [expr {($pixel        & 0x1f) * 0xff / 0x1f}]
	lset dstbuf $dstidx+1 [expr {($pixel >> 0x5 & 0x3f) * 0xff / 0x3f}]
	lset dstbuf $dstidx+2 [expr {($pixel >> 0xb & 0x1f) * 0xff / 0x1f}]
	lset dstbuf $dstidx+3 255
}
proc ::pvrt2tga::pfmt::argb4444 {srcvar srcidx dstvar dstidx} {
	upvar $srcvar srcbuf $dstvar dstbuf

	set srcidx [expr {$srcidx * 2}]
	binary scan $srcbuf x${srcidx}s pixel

	set dstidx [expr {$dstidx * 4}]
	lset dstbuf $dstidx+0 [expr {($pixel        & 0xf) * 0x11}]
	lset dstbuf $dstidx+1 [expr {($pixel >> 0x4 & 0xf) * 0x11}]
	lset dstbuf $dstidx+2 [expr {($pixel >> 0x8 & 0xf) * 0x11}]
	lset dstbuf $dstidx+3 [expr {($pixel >> 0xc & 0xf) * 0x11}]
}

proc ::pvrt2tga::dfmt::extend_tmap {len} {
	variable tmap
	for {set i [llength $tmap]} {$i < $len} {incr i} {
		lappend tmap [expr {(([lindex $tmap $i-1] | 0xaaaaaaaa) + 1) & 0x55555555}]
	}
}

# src = raw buffer, dst = []BGRA
proc ::pvrt2tga::dfmt::lookup {code} {
	switch -- $code {
	1  { return ::pvrt2tga::dfmt::square_twid }
	3  { return ::pvrt2tga::dfmt::vq }
	4  { return ::pvrt2tga::dfmt::vq_mipmap }
	9  { return ::pvrt2tga::dfmt::rect }
	13 { return ::pvrt2tga::dfmt::rect_twid }
	16 { return ::pvrt2tga::dfmt::small_vq }
	default { return "" }
	}
}
proc ::pvrt2tga::dfmt::square_twid {pfmt srcvar dstvar w h} {
	variable tmap
	upvar $srcvar srcbuf $dstvar dstbuf

	extend_tmap $w

	set dstidx 0
	for {set y 0} {$y < $h} {incr y} {
		for {set x 0} {$x < $w} {incr x} {
			set srcidx [expr {[lindex $tmap $x] << 1 | [lindex $tmap $y]}]
			$pfmt srcbuf $srcidx dstbuf $dstidx
			incr dstidx
		}
	}
}
proc ::pvrt2tga::dfmt::vq {pfmt srcvar dstvar w h {mipmaps 0} {small 0}} {
	variable tmap
	upvar $srcvar srcbuf $dstvar dstbuf

	extend_tmap $w

	if {$small} {
		if {$w <= 16} {
			set pallen 64
		} elseif {$w <= 32} {
			set pallen 128
		} elseif {$w <= 64} {
			set pallen 512
		} else {
			set pallen 1024
		}
	} else {
		set pallen 1024
	}

	set palbuf [lrepeat [expr {$pallen * 4}] 0]
	for {set i 0} {$i < $pallen} {incr i} {
		$pfmt srcbuf $i palbuf $i
	}
	set srcbuf [string range $srcbuf [expr {$pallen * 2}] end]

	if {$mipmaps} {
		set w2 [expr {int(pow(2, int(log($w) / log(2))))}]
		set mipmaplen [lindex $tmap [expr {($w2 >> 1) - 1}]]
		set srcbuf [string range $srcbuf $mipmaplen+1 end]
	}

	set dstidx 0
	for {set y 0} {$y < $h / 2} {incr y} {
		for {set x 0} {$x < $w / 2} {incr x} {
			set srcidx [expr {[lindex $tmap $x] << 1 | [lindex $tmap $y]}]
			set palidx [expr {[bindex $srcbuf $srcidx] * 16}]

			for {set x2 0} {$x2 < 2} {incr x2} {
				for {set y2 0} {$y2 < 2} {incr y2} {
					set dstidx [expr {(($y * 2 + $y2) * $w + ($x * 2) + $x2) * 4}]

					# puts "$w $h $pallen $palidx [llength $dstbuf] $dstidx"

					lset dstbuf $dstidx+0 [lindex $palbuf $palidx+0]
					lset dstbuf $dstidx+1 [lindex $palbuf $palidx+1]
					lset dstbuf $dstidx+2 [lindex $palbuf $palidx+2]
					lset dstbuf $dstidx+3 [lindex $palbuf $palidx+3]

					incr palidx 4
				}
			}
		}
	}
}
proc ::pvrt2tga::dfmt::vq_mipmap {pfmt srcvar dstvar w h} {
	upvar $srcvar srcbuf $dstvar dstbuf
	vq $pfmt srcbuf dstbuf $w $h 1

}
proc ::pvrt2tga::dfmt::small_vq {pfmt srcvar dstvar w h} {
	upvar $srcvar srcbuf $dstvar dstbuf
	vq $pfmt srcbuf dstbuf $w $h 0 1

}
proc ::pvrt2tga::dfmt::rect {pfmt srcvar dstvar w h} {
	variable tmap
	upvar $srcvar srcbuf $dstvar dstbuf

	extend_tmap $w

	set i 0
	for {set y 0} {$y < $h} {incr y} {
		for {set x 0} {$x < $w} {incr x} {
			$pfmt srcbuf $i dstbuf $i
			incr i
		}
	}
}
proc ::pvrt2tga::dfmt::rect_twid {pfmt srcvar dstvar w h} {
	variable tmap
	upvar $srcvar srcbuf $dstvar dstbuf

	set size [expr {min($w, $h)}]
	extend_tmap $size

	set nblk [expr {($w / $size) * ($h / $size)}]

	set dstidx 0
	for {set blk 0} {$blk < $nblk} {incr blk} {
		if {$size != $w} {
			set dstidx [expr {$blk * $size}]
		}

		for {set y 0} {$y < $size} {incr y} {
			for {set x 0} {$x < $size} {incr x} {
				set srcidx [expr {($size*$size*$blk) + ([lindex $tmap $x] << 1 | [lindex $tmap $y])}]
				$pfmt srcbuf $srcidx dstbuf $dstidx
				incr dstidx
			}
			if {$size != $w} {
				incr dstidx [expr {$size * ($nblk - 1)}]
			}
		}
	}
}


proc ::pvrt2tga::convert {src dst} {
	set sfp [open $src rb]

	if {[read $sfp 4] == "GBIX"} {
		seek $sfp 16
	}
	if {[read $sfp 4] != "PVRT"} {
		close $sfp
		return -code error "missing PVRT magic"
	}

	binary scan [read $sfp 12] iccsss len pfmt dfmt _ w h
	set srcbuf [read $sfp [expr {$len - 8}]]
	set dstbuf [lrepeat [expr {$w * $h * 4}] 0]

	set pdec [pfmt::lookup $pfmt]
	set ddec [dfmt::lookup $dfmt]

	if {$pdec == ""} {
		return -code error "unsupported pixel format: $pfmt"
	} elseif {$ddec == ""} {
		return -code error "unsupported data format: $dfmt"
	}

	$ddec $pdec srcbuf dstbuf $w $h

	set tga [binary format cccsscsssscbc* 0 0 2 0 0 0 0 0 $w $h 32 00100000 $dstbuf]
	set dfp [open $dst wb]
	puts $dfp $tga
	close $dfp

	close $sfp
}