Просмотр сообщений
В этом разделе можно просмотреть все сообщения, сделанные этим пользователем.
Проверять текст гораздо проще в текстовом виде, а не во время тестирования. Готов помочь, если что.помочь в редактуре или переводе?
Ага, он говорил что где-то исходник или алгоритм сжатия нашёл.я использовал модуль для Delphi, где взял не помню, где-то в нете, но очень давно.
unit LZss;
interface
uses
Windows, Classes;
Procedure LZSSCompress(LZss_Ms: TStream);
procedure LZSSDecompress(LZss_Ms: TStream);
Type
chunk_t = record
code, bitcount: byte;
end;
lz_t = record
length, offset, distance: Word;
end;
const
Window_Size = 4095;
Max_Match_Length = 17;
Min_Match_Length = 2;
implementation
Procedure search_lz(pos: integer; Buffer: Array of byte; inputsize: integer;
var lz: lz_t);
var
lz_off, lz_len: integer;
match: byte;
win: integer;
begin
lz_off := 0;
lz_len := 0;
match := 0;
win := pos - Window_Size;
if win < 0 then
win := 0;
while (win < pos) and (win + Max_Match_Length < pos + Max_Match_Length) do
begin
if Buffer[win] = Buffer[pos] then
begin
match := 1;
while (Buffer[win + match] = Buffer[pos + match]) and
(pos + match < inputsize) do
begin
if match >= Max_Match_Length then
Break;
inc(match);
end;
if match > lz_len then
begin
lz_len := match;
lz_off := win;
end;
end;
if match > Max_Match_Length then
begin
lz_len := Max_Match_Length;
Break;
end;
inc(win);
end;
lz.length := lz_len;
lz.offset := lz_off;
lz.distance := pos - lz_off;
end;
Procedure write_lz(var read_pos: integer; var write_buf: Array of byte;
var write_pos: integer; var lz: lz_t; var chunk: chunk_t);
var
lz1, lz2: byte;
lz_dist, lz_len: Word;
lz_d1, lz_d2: Word;
begin
lz_dist := lz.distance;
lz_len := (lz.length - Min_Match_Length) and $0F;
lz_len := (lz_len shl 4) and $F0;
lz_d1 := (lz_dist and $0F00) shr 8;
lz_d2 := lz_dist and $FF;
lz1 := lz_d2;
lz2 := lz_d1 or lz_len;
write_buf[write_pos] := lz1;
inc(write_pos);
write_buf[write_pos] := lz2;
inc(write_pos);
read_pos := read_pos + lz.length;
chunk.code := chunk.code shr 1;
chunk.code := chunk.code or $00;
inc(chunk.bitcount);
end;
Procedure write_lit(var read_pos: integer; var read_buf: Array of byte;
var write_pos: integer; var write_buf: Array of byte; var chunk: chunk_t);
begin
write_buf[write_pos] := read_buf[read_pos];
inc(write_pos);
inc(read_pos);
chunk.code := chunk.code shr 1;
chunk.code := chunk.code or $80;
inc(chunk.bitcount);
end;
Procedure LZSSCompress(LZss_Ms: TStream);
var
input, output: Array of byte;
inputposition, outputposition, headerposition: integer;
inputsize: integer;
lz, lz_alt: lz_t;
chunk: chunk_t;
bit_shift: byte;
begin
chunk.code := 0;
chunk.bitcount := 0;
headerposition := 0;
inputposition := 0;
outputposition := 1;
inputsize := LZss_Ms.Size;
SetLength(input, inputsize);
SetLength(output, inputsize);
LZss_Ms.Read(input[0], inputsize);
LZss_Ms.Size := 0;
LZss_Ms.Position := 0;
write_lit(inputposition, input, outputposition, output, chunk);
while inputposition < inputsize do
begin
search_lz(inputposition, input, inputsize, lz);
search_lz(inputposition + 1, input, inputsize, lz_alt);
if (lz_alt.length > lz.length) and (lz_alt.length >= Min_Match_Length) then
write_lit(inputposition, input, outputposition, output, chunk)
else
begin
if lz.length < Min_Match_Length then
write_lit(inputposition, input, outputposition, output, chunk)
else
write_lz(inputposition, output, outputposition, lz, chunk);
end;
if chunk.bitcount = 8 then
begin
output[headerposition] := chunk.code;
chunk.code := $00;
chunk.bitcount := 0;
headerposition := outputposition;
inc(outputposition)
end;
end;
if (chunk.bitcount < 8) and (chunk.bitcount <> 0) then
begin
bit_shift := 8 - chunk.bitcount;
chunk.code := chunk.code shr bit_shift;
output[headerposition] := chunk.code;
end;
SetLength(output, outputposition);
LZss_Ms.WriteBuffer(output[0], outputposition);
LZss_Ms.Position := 0;
end;
procedure LZSSDecompress(LZss_Ms: TStream);
var
Temp_Ms: Tmemorystream;
ch, Temp_, Temp: byte;
i, jump, Size, flag: integer;
b: array [0 .. 16] of byte;
Temp_Offset, Last_Offset: DWORD;
begin
flag := 1;
LZss_Ms.Position := 0;
Temp_Ms := Tmemorystream.Create;
while LZss_Ms.Position < LZss_Ms.Size do
begin
if flag = 1 then
begin
LZss_Ms.Read(Temp, 1);
flag := Temp or $100;
end;
LZss_Ms.Read(ch, 1);
if Bool(flag and 1) then
Temp_Ms.Write(ch, 1)
else
begin
LZss_Ms.Read(Temp_, 1);
jump := ((Temp_ and $F) shl 8) or ch;
Size := (Temp_ shr 4) + 2;
Temp_Offset := Temp_Ms.Position;
Temp_Ms.Position := Temp_Ms.Position - jump;
Last_Offset := Temp_Ms.Position;
for i := 0 to Size - 1 do
begin
Temp_Ms.Read(b[i], 1);
if Temp_Ms.Position >= Temp_Ms.Size then
Temp_Ms.Position := Last_Offset;
end;
Temp_Ms.Position := Temp_Offset;
Temp_Ms.Write(b, Size);
end;
flag := flag shr 1;
end;
LZss_Ms.Size := 0;
Temp_Ms.Position := 0;
LZss_Ms.CopyFrom(Temp_Ms, Temp_Ms.Size);
LZss_Ms.Position := 0;
Temp_Ms.Free;
end;
end.
и даже представить не могу, эту самую, русскую озвучкузначит ты не матрос)
для озвучки как раз-таки нужен фон без речи
С тестированием могу помочьок, отпишусь как будет дело идти к завершению
Кто-то разбирал "The King of Fighters 2006" для PS2? Легко там музыку заменить?а чего его кто-то разбирать то будет?))
Посоны, я просто оставлю это здесь:чёт я сомневаюсь, что оно пойдёт на железе с такой скоростью, и пойдёт ли вообще
Понимаю что оффтопик однако.
