snd_mix.pas

delphi编的不错的贪吃蛇

// Juha: For some reason Delphi(6 at least) compiler optimizations messes
// things up..
{$O-}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): snd_mix.c                                                         }
{ Content: Quake2\ref_soft\ sound structures and constants                   }
{                                                                            }
{ Initial conversion by : Skaljac Bojan ([e-mail])                  }
{ Initial conversion on : 17-Feb-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 03-jun-2002                                                   }
{ Updated by : Juha Hartikainen ([e-mail])                        }
{ - Language fixes to make this compile                                      }
{ Updated on : 18-jul-2002                                                   }
{ Updated by : Alexey Barkovoy ([e-mail])                          }
{ - Fixes to "cracking sound bug"                                            }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{----------------------------------------------------------------------------}
// snd_mix.c -- portable code to mix sounds for snd_dma.c
unit snd_mix;

interface

uses
  DelphiTypes,
  SysUtils,
  snd_loc,
  snd_dma;

const
  PAINTBUFFER_SIZE = 2048;

var
  paintbuffer: array[0..PAINTBUFFER_SIZE - 1] of portable_samplepair_t;
  snd_scaletable: array[0..31, 0..255] of Integer;
  snd_p: PIntegerArray;
  snd_linear_count, snd_vol: Integer;
  snd_out: PSmallIntArray;              // short *name;

procedure S_WriteLinearBlastStereo16;
procedure S_PaintChannelFrom8(ch: channel_p; sc: sfxcache_p; count, offset: Integer);
procedure S_PaintChannelFrom16(ch: channel_p; sc: sfxcache_p; count, offset: Integer);
procedure S_InitScaletable;
procedure S_PaintChannels(endtime: Integer);

implementation

uses
  snd_mem;

procedure S_WriteLinearBlastStereo16;
var
  i, val: Integer;
begin
  i := 0;
  while (i < snd_linear_count) do
  begin
    // val = snd_p[i]>>8;
    asm
      mov eax, snd_p
      mov edx, i
      mov eax, [eax + edx*4]
      sar eax, 8
      mov val, eax
    end;
    if (val > $7FFF) then
      snd_out^[i] := $7FFF
    else if (val < SmallInt($8000)) then
      snd_out^[i] := SmallInt($8000)
    else
      snd_out^[i] := val;

    // val = snd_p[i+1]>>8;
    asm
      mov eax, snd_p
      mov edx, i
      mov eax, [eax + edx*4 + 4]
      sar eax, 8
      mov val, eax
    end;
    if (val > $7FFF) then
      snd_out^[i + 1] := $7FFF
    else if (val < SmallInt($8000)) then
      snd_out^[i + 1] := SmallInt($8000)
    else
      snd_out^[i + 1] := val;

    Inc(i, 2);
  end;
end;

(*
procedure S_WriteLinearBlastStereo16;
 asm
 push edi
 push ebx
 mov ecx,ds:dword ptr[snd_linear_count]
 mov ebx,ds:dword ptr[snd_p]
 mov edi,ds:dword ptr[snd_out]
@LWLBLoopTop:
 mov eax,ds:dword ptr[-8+ebx+ecx*4]
 sar eax,8
 cmp eax,07FFFh
 jg @LClampHigh
 cmp eax,0FFFF8000h
 jnl @LClampDone
 mov eax,0FFFF8000h
 jmp @LClampDone
@LClampHigh:
 mov eax,07FFFh
@LClampDone:
 mov edx,ds:dword ptr[-4+ebx+ecx*4]
 sar edx,8
 cmp edx,07FFFh
 jg @LClampHigh2
 cmp edx,0FFFF8000h
 jnl @LClampDone2
 mov edx,0FFFF8000h
 jmp @LClampDone2
@LClampHigh2:
 mov edx,07FFFh
@LClampDone2:
 shl edx,16
 and eax,0FFFFh
 or edx,eax
 mov ds:dword ptr[-4+edi+ecx*2],edx
 sub ecx,2
 jnz @LWLBLoopTop
 pop ebx
 pop edi
 ret
end;
*)

procedure S_TransferStereo16(pbuf: PCardinalArray; endtime: Integer);
var
  lpos,
    lpaintedtime: Integer;
begin
  snd_p := @paintbuffer;
  lpaintedtime := paintedtime;

  while (lpaintedtime < endtime) do
  begin
    // handle recirculating buffer issues
    lpos := lpaintedtime and ((dma.samples shr 1) - 1);

    snd_out := Pointer(Cardinal(pbuf) + (lpos shl 1) * SizeOf(SmallInt));

    snd_linear_count := (dma.samples shr 1) - lpos;
    if (lpaintedtime + snd_linear_count > endtime) then
      snd_linear_count := endtime - lpaintedtime;

    snd_linear_count := snd_linear_count shl 1;

    // write a linear blast of samples
    S_WriteLinearBlastStereo16();

    snd_p := Pointer(Cardinal(snd_p) + snd_linear_count * SizeOf(Cardinal));
    lpaintedtime := lpaintedtime + (snd_linear_count shr 1);
  end;
end;

(*
===================
S_TransferPaintBuffer

===================
*)

procedure S_TransferPaintBuffer(endtime: Integer);
var
  out_idx,
    count,
    out_mask,
    step,
    val: Integer;
  p: PIntegerArray;
  pbuf: PCardinalArray;
  i: Integer;
  out8: PByteArray;
  out16: PSmallIntArray;
begin
  pbuf := PCardinalArray(dma.buffer);

  if (s_testsound^.value <> 0) then
  begin
    // write a fixed sine wave
    count := (endtime - paintedtime);
    for i := 0 to count - 1 do
    begin
      paintbuffer[i].left := Trunc(sin((paintedtime + i) * 0.1) * 20000 * 256);
      paintbuffer[i].right := paintbuffer[i].left;
    end;
  end;

  if ((dma.samplebits = 16) and (dma.channels = 2)) then
  begin                                 // optimized case
    S_TransferStereo16(pbuf, endtime);
  end
  else
  begin                                 // general case
    p := @paintbuffer;
    count := (endtime - paintedtime) * dma.channels;
    out_mask := dma.samples - 1;
    out_idx := paintedtime * dma.channels and out_mask;
    step := 3 - dma.channels;

    if (dma.samplebits = 16) then
    begin
      out16 := PSmallIntArray(pbuf);
      while (count <> 0) do
      begin
        Dec(Count);
        val := p[0] shr 8;
        p := Pointer(Cardinal(p) + step * SizeOf(Integer));
        if (val > $7FFF) then
          val := $7FFF
        else if (val < SmallInt($8000)) then
          val := SmallInt($8000);
        out16[out_idx] := val;
        out_idx := (out_idx + 1) and out_mask;
      end;
    end
    else if (dma.samplebits = 8) then
    begin
      out8 := PByteArray(pbuf);
      while (count <> 0) do
      begin
        Dec(Count);
        val := p[0] shr 8;
        p := Pointer(Cardinal(p) + step * SizeOf(Byte));
        if (val > $7FFF) then
          val := $7FFF
        else if (val < SmallInt($8000)) then
          val := $8000;
        out8[out_idx] := (val shr 8) + 128;
        out_idx := (out_idx + 1) and out_mask;
      end;
    end;
  end;
end;

(*
===============================================================================

CHANNEL MIXING

===============================================================================
*)

procedure S_PaintChannels(endtime: Integer);
var
  i, _end: Integer;
  sc: sfxcache_p;
  ltime, count: Integer;