#!/bin/env perl

#
# th7 replay parser module.
# 
# Original sources:
#	http://touhou.csie.org/replay/ptsrply.php?source
#	piaip''s Touhou Series Replay Management system
#	Replay File Parser Module
# 
# Modified by dl.
# 
# License under Creative Commons License
# http://creativecommons.org/licenses/by-nc-sa/2.0/
# 
# Thanks to Chikei Lee and Piaip.
#
package TH7Replay;

use Exporter;

@ISA = (Exporter);
@EXPORT = qw(TH7Replay_getReplayFileInfo);


# get th7 replay info.
#
# param: 
#   [replay-filepath]
# return: 
#   array[date, player, char, score, rank, version. drop]
#     kind of chars:
#      ("ReimuA", "ReimuB", "MarisaA", "MarisaB", "SakuyaA", "SakuyaB")
#     kind of ranks: 
#      ("Easy","Normal","Hard","Lunatic","Extra","Phantasm")
sub TH7Replay_getReplayFileInfo{

	my($filepath) = @_;
	
	# [date, player, char, score, rank, version, drop]
	@retArray = ("", "", "", "", "", "", "");

	open(INPUT, "<$filepath") or die "$!";
	binmode(INPUT);
	read(INPUT, $dat, -s $filepath);
	close(INPUT);

	# format and decode method provided to Chikei Lee 2004/9/10
	# rewritten as php by piaip
	# rewritten as perl by dl
	$dat2 = substr($dat, 0, 0x10);
	$min_info = 0x100;

	# decrypt
	$mask = ord(substr($dat, 0x0d, 1));
	for ($i = 0x10; $i < length($dat); $i++) {
		$dat2 .= chr((ord(substr($dat,$i,1)) - $mask) & 0xff);
		$mask = ($mask + 7) & 0xff;
	}

	if (length($dat) < 1 || substr($dat2, (length($dat)-1), 1) != 0) {
		return retArray;
	}

	$dat = $dat2;
	$dat2 = '';
	# decompress
	# -- vars
	$v04 = 0; $v1c = 0; $v30 = 0; 
	$v0c = 0; $v24 = 0; $v10 = 0; 
	$v2c = 0; $v28 = 0; $v34 = 1; 
	$v11 = 0x80; $v20 = 0;
	# reinit v20
	for ($i = 0; $i < 4; $i++) {
		$v20 = $v20 * 0x100 + ord(substr($dat, 0x17 - $i, 1));
	}
	$v3c = $v20;
	$v4b = ();
	for ($i = 0; $i < 2048; $i++) {
		$v4b[$i] = 0;
	}

	# not compressed until 0x54
	$ibase = 0x54;
	$i	= $ibase;	# input
	$dat2 = substr($dat,0,$ibase);

	while(length($dat2) < $min_info){
		$flStopDoLoop = 0;
		while(length($dat2) < $min_info) {
			$flFirstRun = 1;
			do {
				if($v11==0x80) {
					$v04=ord(substr($dat,$i,1));
					if($i-$ibase < $v20){
						$i ++;
					}
					else{
						$v04 = 0;
					}
					$v28 += $v04;
				} # $v11 == 0x80

				if($flFirstRun == 1) {
					$v1c = $v04 & $v11;
					$v11 = $v11 >> 1;

					if ($v11 == 0) {
						$v11=0x80;
					}
					if ($v1c == 0) {
						$flStopDoLoop = 1;
						last;
					}
					$v30 = 0x80;
					$v1c = 0;
					$flFirstRun = 0;
				} else {
					if (($v11 & $v04)!=0){
						$v1c=$v1c | $v30;
					}

					$v30=$v30 >> 1;
					$v11=$v11 >> 1;

					if($v11==0) {
						$v11=0x80;
					}
				}
			} while($v30!=0);
			
			if($flStopDoLoop == 1) {
				last;
			}
			$dat2 .= chr($v1c);
			$v4b[$v34]=chr($v1c & 0xff);
			$v34 = ($v34+1) & 0x1FFF;
		} # 2nd. while(1)
		if (length($dat2) > $min_info) {
			last;
		}
		$v30=0x1000;
		$v1c=0;

		while($v30!=0) {
			if($v11==0x80) {
					$v04=ord(substr($dat, $i, 1));
					if($i-$ibase < $v20){
						$i ++;
					}
					else{
						$v04 = 0;
					}
					$v28 += $v04;
			} # $v11 == 0x80

			if(($v11 & $v04)!=0) {
				$v1c = $v1c | $v30;
			}
			$v30 = $v30>>1;
			$v11 = $v11>>1;
			if($v11==0) {
				$v11 = 0x80;
			}
		}

		$v0c = $v1c;
		if($v0c==0) {
			last;
		}

		$v30=8;
		$v1c=0;
		while ($v30 != 0) {
			if ($v11 == 0x80) {
				$v04=ord(substr($dat, $i, 1));
				if($i-$ibase < $v20){
					$i ++;
				}
				else{
					$v04 = 0;
				}
				$v28 += $v04;
			} # $v11 == 0x80
			if(($v11 & $v04)!=0) {
				$v1c=$v1c|$v30;
			}
			$v30=$v30>>1;
			$v11=$v11>>1; 
			if($v11==0) {
				$v11=0x80;
			}
		} # $v30 != 0
		$v24 = $v1c+2;
		$v10=0;
		while($v10<=$v24 && length($dat2) < $min_info)
		{
			$v2c=$v4b[($v0c+$v10)&0x1FFF];
			$dat2 .= $v2c;
			$v4b[$v34]=chr(ord($v2c) & 0xff);
			$v34=($v34+1) & 0x1FFF;
			$v10++;
		} # $v10 <= $v24
	} # 1st. level while(1)


	# raplay info
	$date = substr($dat2, 0x58, 5);
	$name = substr($dat2, 0x5e, 8);
	$char = ord(substr($dat2, 0x56, 1));
	$rank = ord(substr($dat2, 0x57, 1));
	$myver= substr($dat2, 0xe0, 5); # '0100a' etc
	$myver = substr($myver, 0, 2) . '.' . substr($myver, 2);
	if (substr($myver,0,1) == '0') {
		$myver = substr($myver, 1);
	}
	$score = 0;
	for ($fi = 0; $fi < 4; $fi ++) {
		$score = $score * 0x0100 + ord(substr($dat2, 0x6c + 3 - $fi, 1));
	}
	$score = $score*10;
	$drop = trimDrop(cvt2float4(substr($dat2, 0xcc, 4)));

	# [date, player, char, score, rank, version, drop]
	$retArray[0] = $date;
	$retArray[1] = $name;
	@chars = ("ReimuA", "ReimuB", "MarisaA", "MarisaB", "SakuyaA", "SakuyaB");
	$retArray[2] = $chars[$char];
	$retArray[3] = $score;
	@levels = ("Easy","Normal","Hard","Lunatic","Extra","Phantasm");
	$retArray[4] = $levels[$rank];
	$retArray[5] = $myver;
	$retArray[6] = $drop;
	return @retArray;
}


sub cvt2float4{
	
	my($fltstr) = @_;
	
	# Parse the string
	$float0 = unpack("C", substr($fltstr,0,1));
	$float1 = unpack("C", substr($fltstr,1,1));
	$float2 = unpack("C", substr($fltstr,2,1));
	$float3 = unpack("C", substr($fltstr,3,1));
	# Convert to an integer representation
	$float4 = $float0*pow(2,0) + $float1*pow(2,8) + $float2*pow(2,16) + $float3*pow(2,24);
	# Get the Sign
	$sign	= ($float4 & 0x80000000) >> 31;
	# Get the exponent
	$exp	= (($float4 & 0x7F800000) >> 23) - 127;
	# Get the Mantissa
	$mantissa = $float4 & 0x007FFFFF;
	# Calculate the float
	$sum = 0.0;
	for ($i=-23;$i<0;$i++)
	{
		$value = $mantissa & 1;
		$sum = $sum + $value*pow(2,$i)*pow(2,$exp);
		$mantissa = $mantissa >> 1;
	}
	$sum = $sum + 1*pow(2,0)*pow(2,$exp);

	if ($sign == 1){
		$float4 = $sum*-1;	
	}
	else{
		$float4 = $sum;
	}
	return $float4;
}

sub pow{
	my($v1, $v2) = @_;
	return $v1 ** $v2;
}

sub trimDrop{
	my($drop) = @_;
	
	$index = index($drop, ".", 0);
	if($index < 0){
		return $drop;
	}
	
	$len = length($drop);
	$ret = $drop;
	if($index >= 0 && $index+3 <= $len){
		$ret = substr($drop, 0, $index+3);
	}
	return $ret;
}


return 1;

