edit: Ah, darnit, meant to post this as a reply to TXT to CHT.
Code: Select all
use Tk;
open(LD,'ld');
$rd=<LD>;
close(LD);
$b=chr(0);
%bin=('D'=>'0000','6'=>'1000','F'=>'0001','B'=>'1001',
'4'=>'0010','C'=>'1010','7'=>'0011','8'=>'1011','0'=>'0100',
'A'=>'1100','9'=>'0101','2'=>'1101','1'=>'0110','3'=>'1110',
'5'=>'0111','E'=>'1111');
%bin2=('0'=>'1101','8'=>'0110','1'=>'1111','9'=>'1011',
'2'=>'0100','A'=>'1100','3'=>'0111','B'=>'1000','4'=>'0000',
'C'=>'1010','5'=>'1001','D'=>'0010','6'=>'0001','E'=>'0011'
,'7'=>'0101','F'=>'1110');
%hex=('0000'=>'0','0001'=>'1','0010'=>'2','0011'=>'3','
0100'=>'4','0101'=>'5',
'0110'=>'6','0111'=>'7','1000'=>'8','1001'=>'9','1010'=>'A',
'1011'=>'B','1100'=>'C','1101'=>'D','1110'=>'E','1111'=>'F');
%hex2=('0'=>'0000','1'=>'0001','2'=>'0010','3'=>'0011',
'4'=>'0100','5'=>'0101',
'6'=>'0110','7'=>'0111','8'=>'1000','9'=>'1001','A'=>'1010','
B'=>'1011','C'=>'1100','D'=>'1101','E'=>'1110','F'=>'1111');
@pos=(8,9,10,11,16,17,18,19,14,15,0,1,2,3,20,21,22,23,4,5,6,7,12,13);
@pos2=(10,11,12,13,18,19,20,21,0,1,2,3,22,23,8,9,4,5,6,7,14,15,16,17);
$mw=new MainWindow(-title=>'CHT Maker');
$chfr=$mw->Frame()->grid(-column=>0, -row=>0);
$cfr=$mw->Frame()->grid(-column=>1, -row=>0);
$dlab=$chfr->Label(-text=>'Rom directory:')->grid(-column=>0, -row=>0);
$dent=$chfr->Entry(-textvariable=>\$rd)->grid(-column=>1, -row=>0);
$dbut=$chfr->Button(-text=>'Load Roms', -command=>\&lrm)->grid(-column=>3, -row=>0);
$dlist=$chfr->Scrolled(Listbox, -width=>40, -height=>30, -scrollbars=>'se')->grid(-column=>0, -row=>1, -columnspan=>4);
&lrm if $rd;
$dlist->bind('<Up>'=>sub{&rdcht($dlist->get('active'))});
$dlist->bind('<Down>'=>sub{&rdcht($dlist->get('active'))});
$dlist->bind('<1>'=>sub{$dlist->focus();&rdcht($dlist->get('anchor'));});
for($i=0;$i<5;$i++)
{
$tlab[$i]=$cfr->Label(-text=>'Code'.($i+1).':')->grid(-column=>0, -row=>$i*5);
$namelab[$i]=$cfr->Label(-text=>'Description: ')->grid(-column=>0, -row=>$i*5+1);
$nameent[$i]=$cfr->Entry(-textvariable=>\$name[$i])->grid(-column=>1, -row=>$i*5+1);
$gglab[$i]=$cfr->Label(-text=>'Game Genie Code: ')->grid(-column=>0, -row=>$i*5+2);
$ggent[$i]=$cfr->Entry(-textvariable=>\$gg[$i])->grid(-column=>1, -row=>$i*5+2);
$parlab[$i]=$cfr->Label(-text=>'Pro Action Replay Code: ')->grid(-column=>0, -row=>$i*5+3);
$parent[$i]=$cfr->Entry(-textvariable=>\$par[$i])->grid(-column=>1, -row=>$i*5+3);
$aclab[$i]=$cfr->Label(-text=>'Active: ')->grid(-column=>0, -row=>$i*5+4);
$acchk[$i]=$cfr->Checkbutton(-variable=>\$act[$i])->grid(-column=>1, -row=>$i*5+4);
}
for($i=5;$i<10;$i++)
{
$tlab[$i]=$cfr->Label(-text=>'Code'.($i+1).':')->grid(-column=>2, -row=>($i-5)*5);
$namelab[$i]=$cfr->Label(-text=>'Description: ')->grid(-column=>2, -row=>($i-5)*5+1);
$nameent[$i]=$cfr->Entry(-textvariable=>\$name[$i])->grid(-column=>3, -row=>($i-5)*5+1);
$gglab[$i]=$cfr->Label(-text=>'Game Genie Code: ')->grid(-column=>2, -row=>($i-5)*5+2);
$ggent[$i]=$cfr->Entry(-textvariable=>\$gg[$i])->grid(-column=>3, -row=>($i-5)*5+2);
$parlab[$i]=$cfr->Label(-text=>'Pro Action Replay Code: ')->grid(-column=>2, -row=>($i-5)*5+3);
$parent[$i]=$cfr->Entry(-textvariable=>\$par[$i])->grid(-column=>3, -row=>($i-5)*5+3);
$aclab[$i]=$cfr->Label(-text=>'Active: ')->grid(-column=>2, -row=>($i-5)*5+4);
$acchk[$i]=$cfr->Checkbutton(-variable=>\$act[$i])->grid(-column=>3, -row=>($i-5)*5+4);
}
$cbut=$mw->Button(-text=>'Save CHT file', -command=>\&go)->grid(-row=>1, -column=>1);
MainLoop;
sub go
{
$g=0;
foreach(@gg)
{
if($_)
{
&decode($g++);
}
else
{
next unless $par[$g];
&encode($g++);
}
}
&mkcht;
}
sub decode
{
$a=0;
$d=$gg[$_[0]];
$d=uc($d);
$d=~s/-//;
$d=~s/(..)//;
$v=$1;
$v=~tr/DF4709156BC8A23E/0123456789ABCDEF/;
$d=~s/(.)/$bin{$1}/g;
$new[$pos[$a++]]=$_ foreach(split //, $d);
$d=join '', @new;
$d=~s/(....)/$hex{$1}/g;
$par[$_[0]]="$d$v";
}
sub mkcht
{
$chtfile='';
$once=0;
$g=0;
foreach(@par)
{
next unless $_;
$cht=$act[$g]?chr(0):chr(4);
foreach $h (reverse($_=~/(..)/g))
{
$cht.=chr(hex($h));
}
$gap=$once ? (chr(0).chr(0)) : (chr(hex('FE')).chr(hex('FC')));
$cht.=chr(0).$gap.uc($name[$g++]);
$cht=~/(.{0,28})/s;
$cht.=chr(0) x (28-length($cht));
$chtfile.=$cht;
$once=1;
}
$_=$cur;
s/....$/\.cht/;
open(CHT,">$rd$_");
binmode(CHT);
print CHT $chtfile;
close CHT;
}
sub rdcht
{
$cur=$_[0];
$_=$rd.$_[0];
s/....$/\.cht/;
open(CHT,$_);
for($i=0;$i<10;$i++)
{
$name[$i]='';
$gg[$i]='';
$par[$i]='';
$act[$i]='';
}
binmode(CHT);
$_=join '', <CHT>;
close(CHT);
$g=0;
$chunk=(length()%28) ? 18: 28;
$bn=$chunk==18?5:7;
foreach(/(.{$chunk})/gs)
{
s/(.)//;
$act[$g]=!ord($1);
/(.{4})/s;
$code[$#code+1]=ord($_) foreach reverse(split //, $1);
$par[$g]=sprintf('%02X%02X%02X%02X', @code);
/.{$bn}(.*)$b.*/s;
$name[$g]=$1;
&encode($g++);
@code=();
}
}
sub encode
{
$a=0;
$e=$par[$_[0]];
$e=uc($e);
$e=~s/://;
$e=~s/(..)$//;
$v=$1;
$v=~tr/0123456789ABCDEF/DF4709156BC8A23E/;
$e=~s/(.)/$hex2{$1}/g;
$new[$pos2[$a++]]=$_ foreach(split //, $e);
$e=join '', @new;
$e=~s/(....)/$hex{$1}/g;
$e=~tr/0123456789ABCDEF/DF4709156BC8A23E/;
$e="$v$e";
$gg[$_[0]]=join '-', $e=~/(....)/g;
}
sub lrm
{
$rd=~/(\/|\\)/;
$sdir=$1;
$rd=~/(.)$/;
$rd.=$sdir unless $1 eq $sdir;
opendir(DIR,$rd);
$dlist->delete('0','end');
foreach(readdir(DIR))
{
$dlist->insert('end', $_) if /\.smc|\.fig|\.swc|\.zip/;
}
close(DIR);
open(LD,'>ld');
print LD $rd;
close(LD);
}
