unit CompressWaveLib;

interface

uses Windows,Classes,Math,SysUtils,DDSD,HuffLib,mmsystem;

const PW_MAXVOLUME = $FFFFFFF;  //かえないでね
const PW_MAXCHANNEL= 7;         //最大チャンネル数

type TCWPlayState = (CWEmpty,CWStop,CWPlay,CWLoop);

//無圧縮WAVEファイルヘッダ
type WAVEDATAHED = record
  //RIFF チャンク
  RiffHed  : array[0..3] of char;
  RiffSize : DWORD;
  WaveHed  : array[0..3] of char;
  //FMT(Format) チャンク
  FmtHed   : array[0..3] of char;
  FmtSize  : DWORD;
  Format   : WORD;
  Channel  : WORD;
  Sample   : DWORD;
  Avg      : DWORD;
  BlockSize: WORD;
  Bit      : WORD;
  //データチャンク
  DataHed  : array[0..3] of char;
  DataSize : DWORD;
end;

//独自圧縮形式ファイルヘッダ
type PRESSWAVEDATAHED = record
  //RIFFチャンク
  HedChar : array[0..7] of char;     // 'CmpWave'
  Channel : DWORD;                   // 2(STEREO) / 1(MONO)
  Sample  : DWORD;                   // 44100Hz / 22050Hz
  Bit     : DWORD;                   // 16bit
  Tbl     : array[0..255] of Integer;// 変換テーブル値
  UnPressSize : Int64;               // 解凍時のデータサイズ
  LoopStart,LoopEnd : Int64;         // ループ開始位置・終了位置
  LoopCount : BYTE;                  // ループ回数
  MusicTitle : string[127];          // 曲名
  MusicArtist: string[127];          // 作曲者
end;

//書き込み用
type TLRWRITEBUFFER = record
  RBuf,LBuf : SmallInt;
end;

//--------------------------------------------------------------------------
//圧縮データクラス
type TCompressWaveData = class
  private
    //レンダリングフラグ（レンダリング中はフラグが立つ）
    NowRendering : Boolean;
    //再生用のフラグ
    Faa1,Faa2,Fvv1,Fvv2 : Integer;
    Fvolume,Ffade,FSetVolume : Integer;
    FEndLoop: Boolean;
    FLoop   : Integer;
    FPlay   : Boolean;
    FWavePosition   : Int64;
    FWaveLength     : Int64;
    //22050kHz用ふらぐ
    LBackBuf,RBackBuf : Integer;
    //復元用
    PosData : THuffPositionData;
    LPFaa1,LPFaa2,LPFvv1,LPFvv2 : Integer;
    //暗号化コード
    CipherCode : DWORD;
    //はふはふはふまん
    RH : THuff;
    procedure   GetLoopState;
    procedure   SetLoopState;
  public
    Data : TMemoryStream;
    Hed  : PRESSWAVEDATAHED;
    //カウントフラグ
    UseTbl : array[0..255] of DWORD;   // 各フラグの使用頻度
    
    constructor Create;
    procedure   Free;
    procedure   MakeTable(Vol : Single);
    procedure   PressFromStream(ss: TMemoryStream);
    procedure   PressFromFile(filename : string);
    procedure   UnPressToStream(var ss : TmemoryStream);
    function    Rendering(buf : Pointer; Len : DWORD) : Boolean;
    procedure   SaveToFile(filename : string);
    procedure   SaveToStream(var ss : TmemoryStream);
    function    LoadFromStream(ss : TmemoryStream):Boolean;
    function    LoadFromFile(filename : string):Boolean;
    function    UnPressToDDSD(QS : TDDSD) : TDDSDWavedata;
    function    UnPressToDDSD3D(QS : TDDSD) : TDDSDWave3D;
    procedure   GetHistGraph(ss : TMemoryStream; Smp,Cha : Integer);
    procedure   HedUpdata;
    procedure   SetCipherCode(Num:DWORD);
    //操作系
    procedure   Play(loop:Boolean);
    procedure   Stop;
    procedure   Previous;
    procedure   Pause;
    procedure   SetVolume(vol : single; fade : single);
    function    GetVolume : single;
    function    GetSetVolume : Single;
    function    GetFade : single;
    function    GetPlayTime : Single;
    function    GetTotalTime: Single;
    function    GetPlayState : TCWPlayState;
end;

//--------------------------------------------------------------------------
//圧縮データプレイヤークラス
type TCompressWavePlayer = class
  private
    NowRendering : Boolean;
    FMusic : array[0..PW_MAXCHANNEL] of TCompressWaveData;  //曲データ(nilの場合は未登録)
    FBuf   : array[0..PW_MAXCHANNEL] of TMemoryStream;      //作業用展開バッファ
    FMVolume,FMFade,FMSetVolume : Integer;
    RefreshTime : int64;
  public
    PrimaryBuffer : TMemoryStream;
    BufferSize  : DWORD;
    constructor Create;
    procedure   Free;
    procedure   SetBufferSize(len : DWORD);
    procedure   Load(ch : Integer; Music : TCompressWaveData);
    procedure   SetVolume(ch : Integer; vol : single; fade : single);
    procedure   Stop(ch : Integer);
    procedure   Previous(ch : Integer);
    procedure   pause(ch : Integer);
    procedure   Play(ch : Integer; loop:Boolean);
    procedure   Swap(ch1,ch2 : Integer);
    procedure   Init;
    procedure   Rendering;
    procedure   SetMasterVolume(vol : single; fade : single);
    function    Buffer : Pointer;
    function    GetVolume(ch : Integer) : single;
    function    GetSetVolume(ch:Integer):single;
    function    GetFade(ch : Integer) : single;
    function    GetPlayTime(ch : Integer) : Single;
    function    GetTotalTime(ch : Integer) : Single;
    function    GetTitle(ch : Integer) : string;
    function    GetArtist(ch : Integer) : String;
    function    GetMasterFade: single;
    function    GetMasterVolume: single;
    function    GetPlayState(ch:Integer):TCWPlayState;
    function    GetReflectTime : Integer;
end;

//------------------------------------------------------------------------------
//ヘルパー関数
function CWav_LoadWave(filename:String; QS:TDDSD) : TDDSDWavedata;
function CWav_LoadWave3D(filename:String; QS:TDDSD) : TDDSDWave3D;
function CWav_LoadWaveFromStream(ms:TMemoryStream; QS:TDDSD) : TDDSDWaveData;
function CWav_LoadWave3DFromStream(ms:TMemoryStream; QS:TDDSD) : TDDSDWave3D;

implementation

//--------------------------------------------------------------------------
//ヘルパー関数
function CWav_LoadWaveFromStream(ms:TMemoryStream; QS:TDDSD) : TDDSDWaveData;
var
  cw : TCompressWaveData;
  buf : TDDSDWavedata;
begin
  result := nil;
  if (QS = nil)then exit;
  if (ms = nil)then exit;
  cw := TCompressWaveData.Create;
  cw.LoadFromStream(ms);
  buf := cw.UnPressToDDSD(QS);
  cw.Free;
  result := buf;
end;

function CWav_LoadWave3DFromStream(ms:TMemoryStream; QS:TDDSD) : TDDSDWave3D;
var
  cw : TCompressWaveData;
  buf : TDDSDWave3D;
begin
  result := nil;
  if (QS = nil)then exit;
  if (ms = nil)then exit;
  cw := TCompressWaveData.Create;
  cw.LoadFromStream(ms);
  buf := cw.UnPressToDDSD3D(QS);
  cw.Free;
  result := buf;
end;

function CWav_LoadWave(filename:String; QS:TDDSD) : TDDSDWavedata;
var
  ms : TMemoryStream;
  Buf: TDDSDWaveData;
begin
  result := nil;
  if (QS = nil)then exit;
  if (FileExists(filename) = FALSE)then exit;
  ms := TMemoryStream.Create;
  ms.LoadFromFile(FileName);
  Buf := CWav_LoadWaveFromStream(ms,QS);
  ms.Free;
  result := buf;
end;

function CWav_LoadWave3D(filename:String; QS:TDDSD) : TDDSDWave3D;
var
  ms : TMemoryStream;
  Buf: TDDSDWave3D;
begin
  result := nil;
  if (QS = nil)then exit;
  if (FileExists(filename) = FALSE)then exit;
  ms := TMemoryStream.Create;
  ms.LoadFromFile(FileName);
  Buf := CWav_LoadWave3DFromStream(ms,QS);
  ms.Free;
  result := buf;
end;

//============================================================================
{ TCompressWaveData }
//-----------------------------------------------------------
//生成
constructor TCompressWaveData.Create;
begin
  Data := nil;
  RH := nil;
  FWavePosition := 0;
  FWaveLength   := 0;
  Fvolume := PW_MAXVOLUME;
  FSetVolume := PW_MAXVOLUME;
  Ffade   := 0;
  FEndLoop:= FALSE;
  FPlay   := FALSE;
  NowRendering := FALSE;
  SetCipherCode(0);
end;
//-----------------------------------------------------------
//解放
procedure TCompressWaveData.Free;
begin
  //同期を取る
  While(NowRendering) do;
  //解放
  if (RH   <> nil)then RH.Free;
  if (Data <> nil)then Data.Free;
  Destroy;
end;
//-----------------------------------------------------------
//WAVEデータに展開してストリームに出力
procedure TCompressWaveData.UnPressToStream(var ss: TmemoryStream);
var
  dHed : WAVEDATAHED;
  aaa : PBYTE;
begin
  if (data = nil)then exit;
  //WAVEヘッダを生成
  Data.Position := sizeof(PRESSWAVEDATAHED);
  dHed.RiffHed := 'RIFF';
  dHed.RiffSize:= Hed.UnPressSize + sizeof(WAVEDATAHED) - 8;
  dHed.WaveHed := 'WAVE';
  dHed.FmtHed  := 'fmt ';
  dHed.FmtSize := 16;
  dHed.Format  := 1;
  dHed.Channel := 2;
  dHed.Sample  := 44100;
  dHed.Avg     := 44100*2*2;
  dHed.BlockSize := 2*2;
  dHed.Bit     := 16;
  dHed.DataHed := 'data';
  dHed.DataSize:= Hed.UnPressSize;
  //WAVEヘッダ書きだし
  if (ss <> nil)then ss.Free;
  ss := TmemoryStream.Create;
  ss.Size := Hed.UnPressSize + sizeof(WAVEDATAHED);
  ss.Write(dHed,sizeof(WAVEDATAHED));
  ss.Position := 0;
  //WAVEに復元する
  Stop;
  aaa := ss.Memory;
  inc(aaa,sizeof(WAVEDATAHED));
  Play(FALSE);
  Rendering(aaa,Hed.UnPressSize);
  Stop;
end;
//-----------------------------------------------------------
//ストリームに格納されたWAVEデータを圧縮する
procedure TCompressWaveData.PressFromStream(ss: TMemoryStream);
var
  sHed : WAVEDATAHED;
  buf1,buf2 : SmallInt;
  Lvol,Rvol,LFlg,RFlg : Integer;
  i,j,aaa,bbb : Integer;
  fs : TFileStream;
  ATblMin,ATblMax : array[0..255] of Integer;
  PressLength : Integer;
  smp,Cha : Integer;
  WH : THuff;

  procedure ReadWave(var x1,x2 : SmallInt);
  var
    aa1,aa2,aa3,aa4 : SmallInt;
  begin
    if (smp = 44100)then
      if (Cha = 2)then
      begin
        ss.Read(x1,2);          //44100 / STEREO
        ss.Read(x2,2);
      end
      else
      begin
        ss.Read(x1,2);          //44100 / MONO
        ss.Read(x2,2);
        x1 := (x1 + x2 ) div 2;
        x2 := x1;
      end;
    if (smp = 22050)then
      if (Cha = 2)then
      begin
        ss.Read(aa1,2);         //22050 / STEREO
        ss.Read(aa2,2);
        ss.Read(aa3,2);
        ss.Read(aa4,2);
        x1 := (aa1 + aa3) div 2;
        x2 := (aa2 + aa4) div 2;
      end
      else
      begin
        ss.Read(aa1,2);         //22050 / MONO
        ss.Read(aa2,2);
        ss.Read(aa3,2);
        ss.Read(aa4,2);
        x1 := (aa1 + aa3 + aa2 + aa4) div 4;
        x2 := x1;
      end;
  end;
  procedure WritePress(x1,x2 : Integer);
  begin
    if (Cha = 2)then
    begin                       //STEREO
      WH.Write(x1);
      WH.Write(x2);
    end
    else
    begin                       //MONO
      WH.Write(x1);
    end;
  end;

begin
  if (ss = nil)then exit;
  //ヘッダをチェック＆書き込み（正しく書き込まれているか？）
  Hed.HedChar := 'CmpWave';
  Cha := Hed.Channel;
  Smp := Hed.Sample;
  if ((Cha <> 1    )and(Cha <> 2    ))then exit;
  if ((Smp <> 22050)and(Smp <> 44100))then exit;
  Hed.Bit     := 16;
  //WAVEから出現頻度ヒストグラムを取得
  GetHistGraph(ss,smp,cha);
  //WAVEヘッダ情報を取得
  ss.Position := 0;
  ss.Read(sHed,sizeof(WAVEDATAHED));
  //Hed.UnPressSize := sHed.DataSize;
  Hed.UnPressSize := ss.Size - sizeof(WAVEDATAHED);
  //作業用バッファの確保
  fs := TFileStream.Create('WaveTemp.dat',fmCreate);
  //逆引きテーブル生成
  aaa := 0;
  bbb := 0;
  for i:=0 to 127 do
  begin
    // +
    ATblMin[i*2+0] := aaa;
    ATblMax[i*2+0] := (Hed.tbl[i*2+0] + Hed.tbl[min(i*2+2,254)]) div 2;
    // -
    ATblMax[i*2+1] := bbb;
    ATblMin[i*2+1] := (Hed.tbl[i*2+1] + Hed.tbl[min(i*2+3,255)]) div 2;
    //一つ前の計算結果を保持
    aaa := ATblMax[i*2+0];
    bbb := ATblMin[i*2+1];
  end;
  //PRESSWAVEヘッダの描き込み
  fs.Write(Hed,sizeof(PRESSWAVEDATAHED));
  //ハフマン符号化クラスを生成
  WH := THuff.Create(fs);
  WH.SetCipherCode(CipherCode);
  WH.BeginWrite(UseTbl);
  //前処理
  Fvv1 := 0;
  Faa1 := 0;
  Fvv2 := 0;
  Faa2 := 0;
  LBackBuf := 0;
  RBackBuf := 0;
  LFlg := 0;
  RFlg := 0;
  //符号化処理
  if (smp = 44100)then PressLength := sHed.DataSize div 4 - 1
                  else PressLength := sHed.DataSize div 8 - 1;
  for i:=0 to PressLength - 1 do   //size
  begin
    //データを読み込む
    ReadWave(buf1,buf2);
    RVol := buf1;
    LVol := buf2;
    // 16Bit → 5Bit
    //R Volume
    aaa := RVol - (Fvv1+Faa1);
    for j:=0 to 255 do
      if ((aaa >= ATblMin[j])and(aaa <= ATblMax[j]))then
      begin
        RFlg := j;
        Faa1 := Faa1 + Hed.tbl[RFlg];
        Fvv1 := Fvv1 + Faa1;
        break;
      end;
    //L Volume
    aaa := LVol - (Fvv2+Faa2);
    for j:=0 to 255 do
      if ((aaa >= ATblMin[j])and(aaa <= ATblMax[j]))then
      begin
        LFlg := j;
        Faa2 := Faa2 + Hed.tbl[LFlg];
        Fvv2 := Fvv2 + Faa2;
        break;
      end;
    //書き込む
    WritePress(RFlg,LFlg);
    //閾値計算
    if (fvv1 > +32760)then
      begin fvv1 := +32760; Faa1 := 0; end;
    if (fvv1 < -32760)then
      begin fvv1 := -32760; Faa1 := 0; end;
    if (fvv2 > +32760)then
      begin fvv2 := +32760; Faa2 := 0; end;
    if (fvv2 < -32760)then
      begin fvv2 := -32760; Faa2 := 0; end;
  end;
  //ハフマン符号化を終了させる
  WH.Free;
  //FileStream（作業用）からTMemoryStreamへ
  if (Data <> nil)then Data.Free;
  Data := TMemoryStream.Create;
  data.SetSize(fs.Size);
  data.CopyFrom(fs,0);
  fs.Free;
  //音楽データの長さと再生位置をセット
  FWaveLength  := Hed.UnPressSize;
  FWavePosition:= 0;
  Data.Position := sizeof(PRESSWAVEDATAHED);
  if (RH <> nil)then RH.Free;
  RH := THuff.Create(Data);
  RH.SetCipherCode(CipherCode);
  RH.BeginRead;
  Stop;
end;
//-----------------------------------------------------------
//WAVEデータからテーブルの出現頻度を返す
procedure TCompressWaveData.GetHistGraph(ss: TMemoryStream; smp,Cha : Integer);
var
  sHed : WAVEDATAHED;
  buf1,buf2 : SmallInt;
  Lvol,Rvol,Lflg,Rflg : Integer;
  i,j,aaa,bbb : Integer;
  ATblMin,ATblMax : array[0..255] of Integer;
  PressLength : Integer;

  procedure ReadWave(var x1,x2 : SmallInt);
  var
    aa1,aa2,aa3,aa4 : SmallInt;
  begin
    if (smp = 44100)then
      if (Cha = 2)then
      begin
        ss.Read(x1,2);          //44100 / STEREO
        ss.Read(x2,2);
      end
      else
      begin
        ss.Read(x1,2);          //44100 / MONO
        ss.Read(x2,2);
        x1 := (x1 + x2) div 2;
        x2 := x1;
      end;
    if (smp = 22050)then
      if (Cha = 2)then
      begin
        ss.Read(aa1,2);         //22050 / STEREO
        ss.Read(aa2,2);
        ss.Read(aa3,2);
        ss.Read(aa4,2);
        x1 := (aa1 + aa3) div 2;
        x2 := (aa2 + aa4) div 2;
      end
      else
      begin
        ss.Read(aa1,2);         //22050 / MONO
        ss.Read(aa2,2);
        ss.Read(aa3,2);
        ss.Read(aa4,2);
        x1 := (aa1 + aa3 + aa2 + aa4) div 4;
        x2 := x1;
      end;
  end;
begin
  if (ss = nil)then exit;
  //WAVEヘッダ情報を取得
  ss.Position := 0;
  ss.Read(sHed,sizeof(WAVEDATAHED));
  //逆引きテーブル生成
  aaa := 0;
  bbb := 0;
  for i:=0 to 127 do
  begin
    // +
    ATblMin[i*2+0] := aaa;
    ATblMax[i*2+0] := (Hed.tbl[i*2+0] + Hed.tbl[min(i*2+2,254)]) div 2;
    // -
    ATblMax[i*2+1] := bbb;
    ATblMin[i*2+1] := (Hed.tbl[i*2+1] + Hed.tbl[min(i*2+3,255)]) div 2;
    //一つ前の計算結果を保持
    aaa := ATblMax[i*2+0];
    bbb := ATblMin[i*2+1];
  end;
  //変換テーブル使用率の算出用
  for i:=0 to 255 do UseTbl[i] := 0;
  //前処理
  Fvv1 := 0;
  Faa1 := 0;
  Fvv2 := 0;
  Faa2 := 0;
  LBackBuf := 0;
  RBackBuf := 0;
  LFlg := 0;
  RFlg := 0;
  //符号化処理
  if (smp = 44100)then PressLength := sHed.DataSize div 4 - 1
                  else PressLength := sHed.DataSize div 8 - 1;
  for i:=0 to PressLength - 1 do   //size
  begin
    ReadWave(buf1,buf2);
    RVol := buf1;
    LVol := buf2;
    // 16Bit → 5Bit
    // R Volume
    aaa := RVol - (Fvv1+Faa1);
    for j:=0 to 255 do
      if ((aaa >= ATblMin[j])and(aaa <= ATblMax[j]))then
      begin
        RFlg := j;
        Faa1 := Faa1 + Hed.tbl[RFlg];
        Fvv1 := Fvv1 + Faa1;
        break;
      end;
    // L Volume
    aaa := LVol - (Fvv2+Faa2);
    for j:=0 to 255 do
      if ((aaa >= ATblMin[j])and(aaa <= ATblMax[j]))then
      begin
        LFlg := j;
        Faa2 := Faa2 + Hed.tbl[LFlg];
        Fvv2 := Fvv2 + Faa2;
        break;
      end;
    //出現回数を返す
    inc(UseTbl[RFlg]);
    inc(UseTbl[LFlg]);
    //閾値計算
    if (fvv1 > +32760)then
      begin fvv1 := +32760; Faa1 := 0; end;
    if (fvv1 < -32760)then
      begin fvv1 := -32760; Faa1 := 0; end;
    if (fvv2 > +32760)then
      begin fvv2 := +32760; Faa2 := 0; end;
    if (fvv2 < -32760)then
      begin fvv2 := -32760; Faa2 := 0; end;
  end;
  ss.Position := 0;
  Stop;
end;
//-----------------------------------------------------------
//指定されたバッファに44100/16Bit/STEREOで波形を出力します
function TCompressWaveData.Rendering(buf: Pointer; Len: DWORD) : Boolean;
var
  RFlg,LFlg,RVol,LVol : Integer;
  i,aaa : Integer;
  buf1 : ^TLRWRITEBUFFER;
  PressLength,WaveStep : Integer;

  procedure ReadPress;
  begin
    if (Hed.Channel = 2)then
    begin
      RFlg := RH.Read;                 //STEREO
      LFlg := RH.Read;
    end
    else
    begin
      RFlg := RH.Read;                 //MONO
      LFlg := RFlg;
    end;
  end;
  procedure WriteWave;
  var
    bbb : TLRWRITEBUFFER;
  begin
    if (Hed.Sample = 44100)then
    begin                             //44100 STEREO/MONO
      bbb.RBuf := RVol;
      bbb.LBuf := LVol;
      buf1^ := bbb;
      inc(buf1);
    end;
    if (Hed.Sample = 22050)then
    begin                             //22050 STEREO/MONO
      bbb.RBuf := (RBackBuf + RVol) div 2;
      bbb.LBuf := (LBackBuf + LVol) div 2;
      buf1^ := bbb;
      inc(buf1);
      bbb.RBuf := RVol;
      bbb.LBuf := LVol;
      buf1^ := bbb;
      inc(buf1);
      RBackBuf := RVol;
      LBackBuf := LVol;
    end;
  end;
begin
  NowRendering := TRUE;
  result := FALSE;
  if (data = nil)then
  begin
    NowRendering := FALSE;
    exit;
  end;
  //フェードアウトしきって曲停止
  if ((Fvolume < 1)and(FSetVolume < 1)) then FPlay := FALSE;
  //if (abs(FSetVolume - FVolume) < Ffade)then FPlay := FALSE;
  //FPlay（プレイフラグ）が立ってなかったらやめとけ
  if (FPlay = FALSE)then
  begin
    NowRendering := FALSE;
    exit;
  end;
  //前処理
  RVol := Fvv1;
  LVol := Fvv2;
  if (Hed.Sample = 44100)then WaveStep := 4
                         else WaveStep := 8;
  PressLength := Integer(len) div WaveStep;
  //展開処理
  buf1 := buf;
  for i:=0 to PressLength - 1 do
  begin
    //越えた？
    if (FWavePosition > FWaveLength)then
      if (FEndLoop = TRUE)then
      begin         //ループ再生かい？
        Previous;
      end
      else
      begin         //ループ再生しない場合
        FPlay := FALSE;
        exit;
      end;
    //ループ関係
    if (Hed.LoopCount > FLoop)then
    begin
      //ループ開始位置だったら、今フラグ状態を保持する
      //shr 3 は8バイトアライメントにあわせる
      if ((Hed.LoopStart shr 3) = (FWavePosition shr 3))then GetLoopState;
      //ループ終了位置に達していたらループする。
      if ((Hed.LoopEnd shr 3) = (FWavePosition shr 3))then
      begin
        if (Hed.LoopCount <> 255)then inc(FLoop);
        SetLoopState;
      end;
    end;
    //読み込み
    ReadPress;
    Faa1 := Faa1 + Hed.tbl[RFlg];
    Faa2 := Faa2 + Hed.tbl[LFlg];
    Fvv1 := Fvv1 + Faa1;
    Fvv2 := Fvv2 + Faa2;
    //音量調節
    aaa := FSetVolume - FVolume;
    if (abs(aaa) < Ffade)then
      FVolume := FSetVolume
    else
      if (aaa > 0)then FVolume := FVolume + Ffade
                  else FVolume := FVolume - Ffade;
    //閾値計算（OverFlowするので）
    if (fvv1 > +32760)then
      begin fvv1 := +32760; Faa1 := 0; end;
    if (fvv1 < -32760)then
      begin fvv1 := -32760; Faa1 := 0; end;
    if (fvv2 > +32760)then
      begin fvv2 := +32760; Faa2 := 0; end;
    if (fvv2 < -32760)then
      begin fvv2 := -32760; Faa2 := 0; end;
    aaa := (FVolume shr 20);
    RVol := Fvv1 * aaa div 256;
    LVol := Fvv2 * aaa div 256;
    //バッファに展開
    WriteWave;
    //再生位置を進ませる
    inc(FWavePosition,WaveStep);
  end;
  //余り計算
  //バッファの長さによっては余りが生じる場合がある
  //例:44100 / 4 = 11025...OK    44100 / 8 = 5512.5...NG
  //もしあまりが生じた場合は、ノイズとして出現する
  if (len mod 8 = 4)then WriteWave;
  NowRendering := FALSE;
  result := TRUE;
end;
//-----------------------------------------------------------
//圧縮形式で保存
procedure TCompressWaveData.SaveToFile(filename: string);
begin
  Data.SaveToFile(filename);
end;
//-----------------------------------------------------------
//圧縮データをストリームに出力
procedure TCompressWaveData.SaveToStream(var ss: TmemoryStream);
begin
  Data.SaveToStream(ss);
end;
//-----------------------------------------------------------
//WAVEファイルを読み込んで圧縮を行う
procedure TCompressWaveData.PressFromFile(filename: string);
var
  ss : TMemoryStream;
begin
  if (FileExists(filename) = FALSE)then exit;
  ss := TMemoryStream.Create;
  ss.LoadFromFile(filename);
  PressFromStream(ss);
  ss.Free;
end;
//-----------------------------------------------------------
//圧縮ファイルを読み込む
function TCompressWaveData.LoadFromFile(filename: string):Boolean;
var
  ss : TMemoryStream;
begin
  result := FALSE;
  if (FileExists(filename) = FALSE)then exit;
  ss := TMemoryStream.Create;
  ss.LoadFromFile(filename);
  LoadFromStream(ss);
  ss.Free;
  result := TRUE;
end;
//-----------------------------------------------------------
//ストリームから圧縮ファイルを読み込む
function TCompressWaveData.LoadFromStream(ss: TMemoryStream):Boolean;
begin
  result := FALSE;
  if (ss = nil)then exit;
  if (data <> nil)then data.Free;
  data := TMemoryStream.Create;
  data.SetSize(ss.Size);
  data.CopyFrom(ss,0);
  //ヘッダ情報を取得
  data.Position := 0;
  data.Read(Hed,sizeof(PRESSWAVEDATAHED));
  FWaveLength := Hed.UnPressSize;
  if (RH <> nil)then RH.Free;
  RH := THuff.Create(data);
  RH.SetCipherCode(CipherCode);
  RH.BeginRead;
  //再生フラグの初期化
  Stop;
  SetVolume(1.0,0.0);
  result := TRUE;
end;
//-----------------------------------------------------------
//圧縮時の波形変換テーブルを生成する。
//圧縮する前に必ず実行しないとダメ
procedure TCompressWaveData.MakeTable(Vol : Single);
var
  i,aaa : Integer;
begin
  //変換テーブル初期化なり
  for i:=0 to 127 do
  begin
    Hed.tbl[i*2+0] := +261000;    //最大値（てきと〜
    Hed.tbl[i*2+1] := -261000;
  end;
  //変換テーブルの生成
  for i:=0 to 126 do
  begin
    aaa :=  round(power(i+2,Vol) * 0.25);
    if (aaa > 261000)then break;
    Hed.tbl[i*2+0] := +aaa;
    Hed.tbl[i*2+1] := -aaa;
  end;
end;

//-----------------------------------------------------------
//ボリュームを設定する
procedure TCompressWaveData.SetVolume(vol: single; fade : single);
var
  aaa : single;
begin
  aaa := vol;
  //音量の閾値設定
  if (aaa > 1.0)then aaa := 1.0;
  if (aaa < 0.0)then aaa := 0.0;
  //フェードタイムから、音量の増加量を計算
  if (fade < 0.01)then
  begin           //fade値０の場合
    Ffade := 0;
    FVolume := round(aaa*PW_MAXVOLUME);
    FSetVolume := FVolume;
  end
  else
  begin           //fade値がある場合
    Ffade := round(PW_MAXVOLUME / fade / 44100);
    FSetVolume := round(aaa*PW_MAXVOLUME);
  end;
end;
//-----------------------------------------------------------
//フェード値を返す
function TCompressWaveData.GetFade: single;
begin
  if ((FFade = 0)or(abs(FVolume-FSetVolume) = 0))then
  begin
    result := 0;
    exit;
  end;
  result := (abs(FVolume - FSetVolume)/44100) / FFade;
end;
//-----------------------------------------------------------
//ボリューム値を返す
function TCompressWaveData.GetVolume: single;
begin
  result := FVolume / PW_MAXVOLUME;
end;
//------------------------------------------------------------------------------
//フェード後の音量を返す
function TCompressWaveData.GetSetVolume: Single;
begin
  result := FSetVolume / PW_MAXVOLUME;
end;
//------------------------------------------------------------------------------
//再生時間（位置）を返す。単位はsec
function TCompressWaveData.GetPlayTime: Single;
begin
  result := FWavePosition / (44100*4);
end;
//-----------------------------------------------------------
//曲の長さを返す。単位はsec
function TCompressWaveData.GetTotalTime: Single;
begin
  result := FWaveLength / (44100*4);
end;
//------------------------------------------------------------------------------
//ヘッダ情報を更新させる
procedure TCompressWaveData.HedUpdata;
begin
  if (Data = nil)then exit;
  Data.Position := 0;
  Data.Write(hed,sizeof(PRESSWAVEDATAHED));
end;
//-----------------------------------------------------------
//圧縮データをTDDSDWaveDataに展開する。
function TCompressWaveData.UnPressToDDSD(QS : TDDSD) : TDDSDWavedata;
var
  ss : TMemoryStream;
  buf: TDDSDWavedata;
begin
  result := nil;
  //音楽データの展開領域確保
  ss := TMemoryStream.Create;
  ss.SetSize(Hed.UnPressSize);
  //圧縮データを展開する
  Stop;
  Play(FALSE);
  Rendering(ss.Memory,ss.Size);
  Stop;
  //DirectSoundBufferを生成、コピーする
  buf := TDDSDWavedata.CreateBuffer(QS,44100,16,TRUE,ss.Size);
  if (buf = nil)then exit;
  buf.BlockCopy(0,ss.Memory,ss.Size);
  ss.Free;
  //SoundBufferアドレスを返す
  result := buf;
end;
//-----------------------------------------------------------
//圧縮データをTDDSDWaveDataに展開する。
function TCompressWaveData.UnPressToDDSD3D(QS : TDDSD) : TDDSDWave3D;
var
  ss : TMemoryStream;
  buf: TDDSDWave3D;
begin
  result := nil;
  //音楽データの展開領域確保
  ss := TMemoryStream.Create;
  ss.SetSize(Hed.UnPressSize);
  //圧縮データを展開する
  Stop;
  Play(FALSE);
  Rendering(ss.Memory,ss.Size);
  Stop;
  //DirectSoundBufferを生成、コピーする
  buf := TDDSDWave3D.CreateBuffer(QS,44100,16,TRUE,ss.Size);
  if (buf = nil)then exit;
  buf.BlockCopy(0,ss.Memory,ss.Size);
  ss.Free;
  //SoundBufferアドレスを返す
  result := buf;
end;
//-----------------------------------------------------------
//再生の停止命令。曲の先頭に戻される
procedure TCompressWaveData.Stop;
begin
  //再生フラグを初期値に
  FWavePosition := 0;
  Fvv1 := 0;
  Faa1 := 0;
  Fvv2 := 0;
  Faa2 := 0;
  LBackBuf := 0;
  RBackBuf := 0;
  SetVolume(1.0,0);
  FPlay := FALSE;
  FLoop := 0;

  if (Data = nil)then exit;
  //同期を取る
  while(NowRendering) do;
  //開始位置に戻す
  RH.MoveBeginPosition;
end;
//-----------------------------------------------------------
//曲の先頭に戻す。STOPとの違いはフェードが初期化されない。
procedure TCompressWaveData.Previous;
begin
  //再生フラグを初期値に
  FWavePosition := 0;
  Fvv1 := 0;
  Faa1 := 0;
  Fvv2 := 0;
  Faa2 := 0;
  LBackBuf := 0;
  RBackBuf := 0;
  FLoop := 0;

  if (Data = nil)then exit;
  //開始位置に戻す
  RH.MoveBeginPosition;
end;
//------------------------------------------------------------
//曲の再生を開始する
procedure TCompressWaveData.Play(loop:Boolean);
begin
  FPlay    := TRUE;
  FEndLoop := loop;
  if ((FVolume = 0)and(FSetVolume = 0))then SetVolume(1.0,0);
end;

//------------------------------------------------------------
//ループ用にパラメータを設定し直す
//--------------------------------------------------------------
//現在の暗号化ファイル上の位置を記憶する。
//ハフマン符号化上に乗っかっているので、そのフラグ状態も保持する必要がある
procedure TCompressWaveData.GetLoopState;
begin
  LPFaa1 := Faa1;
  LPFaa2 := Faa2;
  LPFvv1 := Fvv1;
  LPFvv2 := Fvv2;
  RH.GetPositionData(PosData);
end;
//--------------------------------------------------------------
//記憶した暗号化ファイル上の位置に戻る
procedure TCompressWaveData.SetLoopState;
begin
  Faa1 := LPFaa1;
  Faa2 := LPFaa2;
  Fvv1 := LPFvv1;
  Fvv2 := LPFvv2;
  RH.SetPositionData(PosData);
  FWavePosition := Hed.LoopStart;
end;
//-----------------------------------------------------------
//暗号化コードを設定する
procedure TCompressWaveData.SetCipherCode(Num: DWORD);
begin
  CipherCode := Num;
end;


//============================================================================
{ TCompressWavePlayer }
//-----------------------------------------------------------
//生成
constructor TCompressWavePlayer.Create;
var
  i : Integer;
begin
  NowRendering := FALSE;
  FMVolume := PW_MAXVOLUME;
  FMSetVolume := PW_MAXVOLUME;
  FMFade   := 0;
  //SetBufferSize(44100*2 div 2);
  RefreshTime := TimeGetTime;
  for i:=0 to PW_MAXCHANNEL do
  begin
    FMusic[i] := nil;   //未登録の意味
  end;
end;
//------------------------------------------------------------
//解放
procedure TCompressWavePlayer.Free;
var
  i : Integer;
begin
  if (PrimaryBuffer <> nil)then PrimaryBuffer.Free;
  PrimaryBuffer := nil;
  for i:=0 to PW_MAXCHANNEL do
    if (FBuf[i] <> nil)then FBuf[i].Free;
  Destroy;
end;
//-------------------------------------------------------------
//全曲を停止し、曲が登録されていない状態にする
procedure TCompressWavePlayer.Init;
var
  i : Integer;
begin
  for i:=0 to PW_MAXCHANNEL do Load(i,nil);
end;
//-------------------------------------------------------------
//指定チャンネルに曲を登録する
procedure TCompressWavePlayer.Load(ch: Integer; Music: TCompressWaveData);
var
  i : Integer;
begin
  if (ch > PW_MAXCHANNEL)then exit;
  if (Music = nil)then
  begin
    Stop(Ch);
    //同期を取る
    While (NowRendering) do;
    FMusic[ch] := nil;
    exit;
  end;
  //もし同じ曲データを多重しようものなら破堤が生じるので
  //今登録されたものを優先させ、使用されているものは停止させる
  for i:=0 to PW_MAXCHANNEL do
    if (FMusic[i] = Music)then
    begin
      Stop(i);
      Load(i,nil);
    end;
  //登録させる
  Stop(Ch);
  Load(Ch,nil);
  //同期を取る
  While (NowRendering) do;
  FMusic[ch] := Music;
  SetVolume(Ch,1.0,0);
  Stop(Ch);
end;
//-------------------------------------------------------------
//曲が停止状態なら再生させる
procedure TCompressWavePlayer.Play(ch: Integer; loop:Boolean);
begin
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  FMusic[ch].Play(loop);
end;
//-------------------------------------------------------------
//複数登録された曲を合成し、レンダリングする。
procedure TCompressWavePlayer.Rendering;
var
  i,j,aaa : Integer;
  LVol,RVol : Integer;
  buf : array[0..PW_MAXCHANNEL] of ^TLRWRITEBUFFER;
  Pbuf : ^TLRWRITEBUFFER;
  MixCount : Integer;
begin
  NowRendering := TRUE;
  //例外処理
  if (PrimaryBuffer = nil)then
  begin
    NowRendering := FALSE;
    exit;
  end;
  //マスターボリュームが0ならレンダリングしない
  if ((FMVolume  < 1)and(FMSetVolume < 1)) then
  begin
    NowRendering := FALSE;
    exit;
  end;
  //登録されている曲のみレンダリングする
  MixCount := 0;
  for i:=0 to PW_MAXCHANNEL do
    if (FMusic[i] <> nil)then
      if (FMusic[i].Rendering(FBuf[i].Memory,BufferSize) = TRUE)then
      begin
        buf[MixCount] := FBuf[i].Memory;
        inc(MixCount);
      end;
  //前処理
  Pbuf := PrimaryBuffer.Memory;
  //再生中の曲のみを合成する
  for i:=0 to BufferSize div 4 - 1 do
  begin
    //レンダリングされた曲のみ加算
    RVol := 0;
    LVol := 0;
    for j:=0 to MixCount-1 do
    begin
      RVol := RVol + Integer(buf[j]^.RBuf);
      LVol := LVol + Integer(buf[j]^.LBuf);
      inc(buf[j]);
    end;
    //音量
    aaa := FMSetVolume - FMVolume;
    if (abs(aaa) <= FMfade)then
      FMVolume := FMSetVolume
    else
      if (aaa > 0)then FMVolume := FMVolume + FMfade
                  else FMVolume := FMVolume - FMfade;
    aaa := FMVolume shr 20;
    RVol := RVol * aaa div 256;
    LVol := LVol * aaa div 256;
    //OverFlow対策
    if (RVol > +32760)then RVol := +32760;
    if (RVol < -32760)then RVol := -32760;
    if (LVol > +32760)then LVol := +32760;
    if (LVol < -32760)then LVol := -32760;
    Pbuf^.RBuf := SmallInt(RVol);
    Pbuf^.LBuf := SmallInt(LVol);
    inc(PBuf);
  end;
  NowRendering := FALSE;
  RefreshTime := TimeGetTime;
end;
//-------------------------------------------------------------
//レンダリングするバッファのサイズを指定する
procedure TCompressWavePlayer.SetBufferSize(len: DWORD);
var
  i : Integer;
begin
  if (PrimaryBuffer <> nil)then PrimaryBuffer.Free;
  BufferSize := len;
  PrimaryBuffer := TmemoryStream.Create;
  PrimaryBuffer.SetSize(BufferSize);
  for i:=0 to PW_MAXCHANNEL do
  begin
    if (FBuf[i] <> nil)then FBuf[i].Free;
    FBuf[i] := TMemoryStream.Create;
    FBuf[i].SetSize(BufferSize);
  end;
end;
//--------------------------------------------------------------
//マスターボリュームを設定する
procedure TCompressWavePlayer.SetMasterVolume(vol: single; fade : single);
var
  aaa : single;
begin
  aaa := vol;
  //音量の閾値設定
  if (aaa > 1.0)then aaa := 1.0;
  if (aaa < 0.0)then aaa := 0.0;
  //フェードタイムから、音量の増加量を計算
  if (fade < 0.01)then
  begin           //fade値０の場合
    FMfade := 0;
    FMVolume := round(aaa*PW_MAXVOLUME);
    FMSetVolume := FMVolume;
  end
  else
  begin           //fade値がある場合
    FMfade := round(PW_MAXVOLUME / fade / 44100);
    FMSetVolume := round(aaa*PW_MAXVOLUME);
  end;
end;
//--------------------------------------------------------------
//Chに登録された曲のボリュームを設定する
procedure TCompressWavePlayer.SetVolume(ch: Integer; vol: single; fade : single);
begin
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  FMusic[ch].SetVolume(vol,fade);
end;
//--------------------------------------------------------------
//Chで指定された曲を停止させる
procedure TCompressWavePlayer.Stop(ch: Integer);
begin
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  //同期を取る
  While (NowRendering) do;
  FMusic[ch].Stop;
end;
//--------------------------------------------------------------
//Chを入れ替える。
procedure TCompressWavePlayer.Swap(ch1, ch2: Integer);
var
  temp : TCompressWaveData;
begin
  //同期を取る
  While (NowRendering) do;
  temp := FMusic[ch1];
  FMusic[ch1] := FMusic[ch2];
  FMusic[ch2] := temp;
end;
//------------------------------------------------------------
//レンダリングされたバッファのアドレスを返す
function TCompressWavePlayer.Buffer: Pointer;
begin
  if (PrimaryBuffer = nil)then
    begin result := nil; exit; end;
  result := PrimaryBuffer.Memory;
end;
//------------------------------------------------------------------------------
//巻き戻し
procedure TCompressWavePlayer.Previous(ch: Integer);
begin
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  FMusic[ch].Previous;
end;
//------------------------------------------------------------------------------
//一時停止
procedure TCompressWaveData.Pause;
begin
  FPlay := FALSE;
end;
//------------------------------------------------------------------------------
//一時停止
procedure TCompressWavePlayer.pause(ch: Integer);
begin
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  FMusic[ch].Pause;
end;
//------------------------------------------------------------------------------
//アーティスト名を取得する
function TCompressWavePlayer.GetArtist(ch: Integer): String;
begin
  result := 'NoName';
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].Hed.MusicArtist;
end;
//------------------------------------------------------------------------------
//フェード値を返す
function TCompressWavePlayer.GetFade(ch: Integer): single;
begin
  result := 0.0;
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].GetFade;
end;
//------------------------------------------------------------------------------
//現在の再生時間を返す
function TCompressWavePlayer.GetPlayTime(ch: Integer): Single;
begin
  result := 0.0;
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].GetPlayTime;
end;
//------------------------------------------------------------------------------
//曲の長さを返す。単位はsec
function TCompressWavePlayer.GetTotalTime(ch: Integer): Single;
begin
  result := 0.0;
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].GetTotalTime;
end;
//------------------------------------------------------------------------------
//曲のタイトルを返す
function TCompressWavePlayer.GetTitle(ch: Integer): string;
begin
  result := 'NoENTRY';
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].Hed.MusicTitle;
end;
//------------------------------------------------------------------------------
//音量を返す
function TCompressWavePlayer.GetVolume(ch: Integer): single;
begin
  result := 0.0;
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].GetVolume;
end;
//-----------------------------------------------------------
//マスターのフェード値を返す
function TCompressWavePlayer.GetMasterFade: single;
begin
  if ((FMFade = 0)or(abs(FMVolume-FMSetVolume) = 0))then
  begin
    result := 0;
    exit;
  end;
  result := (abs(FMVolume-FMSetVolume)/44100) / FMFade;
end;
//-----------------------------------------------------------
//マスターのボリューム値を返す
function TCompressWavePlayer.GetMasterVolume: single;
begin
  result := FMVolume / PW_MAXVOLUME;
end;

//------------------------------------------------------------------------------
//フェード後の音量を調べる
function TCompressWavePlayer.GetSetVolume(ch: Integer): single;
begin
  result := 0.0;
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].GetSetVolume;
end;

//--------------------------------------------------------------------------------
//今の再生状態を問う
function TCompressWaveData.GetPlayState: TCWPlayState;
begin
  result := CWStop;
  if (FPlay = TRUE)then
    if (FEndLoop = TRUE)then result := CWLoop
                        else result := CWPlay;
end;

//------------------------------------------------------------------------------
//現在の再生状態を問う
function TCompressWavePlayer.GetPlayState(ch: Integer): TCWPlayState;
begin
  result := CWEmpty;
  if (ch > PW_MAXCHANNEL)then exit;
  if (FMusic[ch] = nil)then exit;
  result := FMusic[ch].GetPlayState;
end;
//------------------------------------------------------------------------------
//次の音声更新までの時間
function TCompressWavePlayer.GetReflectTime: Integer;
begin
  result := (BufferSize div 176) * 2 - (TimeGetTime-RefreshTime);
end;

end.