
// Retromachine memory map @bytes

//$   00000-$    0FFFF reserved
//    0D400-     0D418 SID
//$   10000-$    4FFFF pallette banks;
//$   50000-$    50FFF 8x16 font
//$   51000-$    51FFF 8x8 fonts x2
//    52000-     59FFF sprite defs 8x4k
//    5A000-     5AFFF audio buffer 4k
//    5B000-     5FFFF reserved
//    60000-     6FFFF hardware regs area
//    70000-    FFFFFF low memory area    (16 MB-448 kB)
//  1000000-   EFFFFFF Basic area        (224 MB)
//  F000000-   FFFFFFF framebuffer area   (16 MB)


// $18000 - hard regs area @long

// 18000 - 60000 - frame counter
// 18001 - 60004 - display start
// 18002 - 60008 - current graphics mode (@60008 only)
//         60009 - bytes per pixel
// 18003 - 6000C - border color
// 18004 - 60010 - pallette bank
// 18005 - 60014 - horizontal pallette selector  bit 31 on, 30..20 add to $18004, 11:0 pixel num.
// 18006 - 60018 - display list start addr
//                 DL entry: 0_LLLLL_MM - display LLLLL lines in mode MM
//                           1_AAAAAAA - set display address to AAAAAAA
//                           F_AAAAAAA - goto address AAAAAAA
// 18007 - 6001C - horizontal scroll right register
// 18008 - 60020 - x res
// 18009   60024 - y res
// 1800A - 60028 - KBD. If key pressed then ascii code in 60028 and 1 in 6002b
// 1800B - 6002C - mouse. 6002c,d x 6002e,f y
// 1800C - 60030   keys,
// 1800D - 60034 - current dl position
// 18010 - 1801F   - sprite control long 0 31..16 y pos  15..0 x pos
//                               long 1 30..16 y zoom 15..0 x zoom 31 mode

// graphic modes: 00..15 256 col; 16..31 64k col; 32..47 32bit col; 48..63 ham (?)

unit retro;

// stripped down retromachine for SID player. Only Graphics 16 left.

{$mode objfpc}{$H+}

interface

uses sdl2,sysutils,crt,classes,windows,unit6502;

type tram=array[0..67108863] of integer;
     tramw=array[0..134217727] of word;
     tramb=array[0..268435455] of byte;
     tsample=array[0..1] of smallint;

     TRetro = class(TThread)
     private
     protected
       procedure Execute; override;
     public
       Constructor Create(CreateSuspended : boolean);
     end;

     TFiltertable=array[0..13] of double;

var fh,filetype:integer;
    play:word;
    scr:PSDL_window;
    sdlRenderer:PSDL_Renderer;
    sdltexture:psdl_texture;
    p2:^integer;
    tim,t,t2,t3,ts,t6,time6502:int64;
    vblank1:byte;

    combined:array[0..1023] of byte;
    scope:array[0..959] of integer;

    desired,obtained:TSDL_AudioSpec;

    db:boolean=false;
    debug:integer;
    sidtime:int64;
    timer1:int64=-1;
    siddelay:int64=20000;
    songtime,songfreq:int64;
    skip:integer;
    scj:integer=0;
    ft1r:Tfiltertable=(0,0,0,0,0,0,0,0,0,0,0,0,0,0);
    ft1l:Tfiltertable=(0,0,0,0,0,0,0,0,0,0,0,0,0,0);
    thread:TRetro;
    times6502:array[0..15] of integer;
    r1:pointer;
    raml:^tram absolute r1;
    ramw:^tramw absolute r1;
    ramb:^tramb absolute r1;


    attacktable:array[0..15] of double=(5.208e-4,1.302e-4,6.51e-5,4.34e-5,2.74e-5,1.86e-5,1.53e-5,1.3e-5,1.04e-5,4.17e-6,2.08e-6,1.302e-6,1.04e-6,3.47e-7,2.08e-7,1.3e-7);
    attacktablei:array[0..15] of int64;
    srtablei:array[0..15] of int64;

    procedure initmachine(mode:integer);
    procedure stopmachine;
    procedure graphics(mode:integer);
    procedure scrconvert(screen:pointer; buf:integer);
    procedure setataripallette(bank:integer);
    procedure cls(c:integer);
    procedure putpixel(x,y,color:integer);
    procedure putchar(x,y:integer;ch:char;col:integer);
    procedure outtextxy(x,y:integer; t:string;c:integer);
    procedure blit(from,x,y,too,x2,y2,length,lines,bpl1,bpl2:integer);
    procedure box(x,y,l,h,c:integer);
    procedure box2(x1,y1,x2,y2,color:integer);
    function gettime:int64;
    procedure poke(addr:integer;b:byte);
    procedure dpoke(addr:integer;w:word);
    procedure lpoke(addr:integer;c:cardinal);
    procedure slpoke(addr,i:integer);
    function peek(addr:integer):byte;
    function dpeek(addr:integer):word;
    function lpeek(addr:integer):cardinal;
    function slpeek(addr:integer):integer;
    procedure sethidecolor(c,bank,mask:integer);
    procedure putcharz(x,y:integer;ch:char;col,xz,yz:integer);
    procedure outtextxyz(x,y:integer; t:string;c,xz,yz:integer);
    procedure scrollup;
    function sid(mode:integer):tsample;
    function noise2:cardinal;
    function noise3:cardinal;

implementation

 uses unit1;

var
  running:integer=0;
  fh2:integer;





// ---- prototypes

procedure sprite(screen:pointer); forward;
procedure sdlevents; forward;
procedure AudioCallback(userdata:pointer; audio:Pbyte; length:integer); cdecl;    forward;
function sdl_sound_init:integer; forward;
function antialias6(input:double;var ft:Tfiltertable):double; forward;


// ---- TRetro thread methods --------------------------------------------------

// ----------------------------------------------------------------------
// constructor: create the thread for the retromachine
// ----------------------------------------------------------------------

constructor TRetro.Create(CreateSuspended : boolean);

begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

// ----------------------------------------------------------------------
// THIS IS THE MAIN RETROMACHINE THREAD
// - convert retromachine screen to raspberry screen
// - display sprites
// - get hardware events from sdl and put them to system variable
// ----------------------------------------------------------------------

procedure TRetro.Execute;

var p3:pointer;
    t:int64;

begin
running:=1;                               // tell them the machine is running
SDL_SetThreadPriority(SDL_THREAD_PRIORITY_HIGH);
repeat
if p2<>nil then                           // the screen is prepared
  begin

  p3:=p2+2304000;                         // second frame buffer
  sdlevents;                              // get events from SDL and update system variables
  vblank1:=0;                             // tell them there is no vblank
  t:=gettime;                             // prepare for screen time measurement
  scrconvert(p2,raml^[$18001]);           // convert the screen
  tim:=gettime-t;                         // get screen time for debug
  raml^[$18000]+=1;                       // increment frame counter
  vblank1:=1;                             // we are in vblank now
  sprite(p2);               // draw sprites
  repeat until peek($70000)<2;            // if peek($70000)=2 then resizing is in progress, don't call SDL
  poke ($70000,0) ;                       // tell them they can not resize

  SDL_UpdateTexture(sdlTexture, nil, p2, 1920 * 4);   // render the screen
  SDL_RenderClear(sdlRenderer);
  SDL_RenderCopy(sdlRenderer, sdlTexture,nil,nil);
  SDL_RenderPresent(sdlRenderer);
  poke ($70000,1);                        // screen rendered, resizing possible


  sdlevents;                              // process the second buffer
  vblank1:=0;
  t:=gettime;
  scrconvert(p3,raml^[$18001]);
  tim:=gettime-t;
  raml^[$18000]+=1;
  vblank1:=1;
  sprite(p3);
  repeat until peek($70000)<2;
  poke ($70000,0);

  SDL_UpdateTexture(sdlTexture, nil, p3, 1920 * 4);
  SDL_RenderClear(sdlRenderer);
  SDL_RenderCopy(sdlRenderer, sdlTexture,nil,nil);
  SDL_RenderPresent(sdlRenderer);
  poke($70000,1) ;

  end;
until terminated;
running:=0;
end;

// ---- Retromachine procedures ------------------------------------------------

// ----------------------------------------------------------------------
// initmachine: start the machine
// constructor procedure: allocate ram, load data from files
// prepare all hardware things
// ----------------------------------------------------------------------

procedure initmachine(mode:integer);

var a,i:integer;
    bb:byte;

begin
for i:=0 to 15 do srtablei[i]:=round(1073741824*(1-attacktable[i]));
for i:=0 to 15 do attacktablei[i]:=round(1073741824*attacktable[i]);
r1:=virtualalloc(nil,268435456, MEM_COMMIT or MEM_RESERVE,PAGE_EXECUTE_READWRITE);  // get 256 MB ram
p2:=virtualalloc(nil,20971520, MEM_COMMIT or MEM_RESERVE,PAGE_READWRITE);  // get the RAM for the framebuffer

fh2:=fileopen('./st4font.def',$40);              // load 8x16 font
fileread(fh2,ramb^[$50000],2048);
fileclose(fh2);

fh2:=fileopen('./combinedwaveforms.bin',$40);   // load combined waveforms for SID
fileread(fh2,combined,1024);
fileclose(fh2);

fh2:=fileopen('./mysz.def',$40);                // load mouse cursor definition at sprite 8
for i:=0 to 1023 do
  begin
  fileread(fh2,bb,1);
  a:=bb;
  a:=a+(a shl 8) + (a shl 16);
  raml^[$16400+i]:=a;
  end;
fileclose(fh2);

// init sdl @ current res and 32 bits, prepare SDL video stuff

SDL_Init(SDL_INIT_everything);

SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, 'best'); // make the scaled rendering look smoother.
SDL_SetHint(SDL_HINT_RENDER_DIRECT3D_THREADSAFE, '1');
if mode=0 then scr := SDL_CreateWindow( 'The Retromachine', SDL_WINDOWPOS_UNDEFINED, SDL_WINDOWPOS_UNDEFINED, 960,600, SDL_WINDOW_shown);
if mode=1 then scr := SDL_CreateWindow( 'The Retromachine', SDL_WINDOWPOS_UNDEFINED, SDL_WINDOWPOS_UNDEFINED, 960,600 , SDL_WINDOW_fullscreen_desktop);
sdlRenderer := SDL_CreateRenderer(scr, -1, 14);
sdlTexture := SDL_CreateTexture(sdlRenderer,SDL_PIXELFORMAT_ARGB8888,SDL_TEXTUREACCESS_STreaming,1920,1200);
SDL_RenderSetLogicalSize(sdlRenderer,1920,1200);

sdl_showcursor(0);             // hide sdl cursor

sdl_sound_init;
sdl_pauseaudio(0);
thread:=tretro.create(true);   // start frame refreshing thread
thread.start;

end;


//  ---------------------------------------------------------------------
//   procedure stopmachine
//   destructor for the retromachine
//   stop the process, free the RAM
//   rev. 2015.10.14
//  ---------------------------------------------------------------------

procedure stopmachine;

begin

// stop the thread

sdl_pauseaudio(1);
sdl_closeaudio;
thread.terminate;
repeat until running=0;
SDL_DestroyTexture( sdlTexture );
SDL_DestroyRenderer( sdlRenderer );
SDL_DestroyWindow ( scr);
sdl_quit;

// free retromachine memory

virtualfree(p2,0,mem_release);
virtualfree(r1,0,mem_release);

end;

//  ---------------------------------------------------------------------
//   BASIC type poke/peek procedures
//   works @ byte addresses
//   rev. 2015.11.01
// ----------------------------------------------------------------------

procedure poke(addr:integer;b:byte);

begin
ramb^[addr]:=b;
end;

procedure dpoke(addr:integer;w:word);

begin
ramw^[addr shr 1]:=w;
end;


procedure lpoke(addr:integer;c:cardinal);

begin
raml^[addr shr 2]:=c;
end;

procedure slpoke(addr,i:integer);

begin
raml^[addr shr 2]:=i;
end;

function peek(addr:integer):byte;

begin
peek:=ramb^[addr];
end;

function dpeek(addr:integer):word;

begin
dpeek:=ramb^[addr]+256*ramb^[addr+1];
end;

function lpeek(addr:integer):cardinal;

begin
lpeek:=raml^[addr shr 2];
end;

function slpeek(addr:integer):integer;

begin
slpeek:=raml^[addr shr 2];
end;


//  ---------------------------------------------------------------------
//   function gettime:int64
//   the function returns the system time in microseconds
//   rev. 2015.11.27
//  ---------------------------------------------------------------------

function gettime:int64;

var pf,tm:int64;

begin
QueryPerformanceFrequency(pf);
QueryPerformanceCounter(tm);
gettime:=round(1000000*tm/pf);
end;

//  ---------------------------------------------------------------------
//   procedure sdlevents
//   Get events from sdl and put them into system vars
//   STUB! rev. 2015.10.18
//   TODO: this should be run in another thread ?
//  ---------------------------------------------------------------------


procedure sdlevents;

var qq:integer;
    event:tsdl_event;
    key:cardinal;

const x:integer=0;
      y:integer=0;

begin
repeat
  qq:=sdl_pollevent(@event)  ;

  if (qq<>0) and (event.type_=sdl_mousemotion)  then
    begin
    x:=event.motion.x;
    y:=event.motion.y;
    if x<64 then x:=64;
    if x>1855 then x:=1855;
    if y<40 then y:=40;
    if y>1159 then y:=1159;
    ramw^[$30016]:=x;
    ramw^[$30017]:=y;

    end
  else if (qq<>0) and (event.type_=sdl_mousebuttondown)  then
    begin
    if event.button.state=sdl_pressed then
      begin
      ramb^[$60033]:=2;
      ramb^[$60030]:=event.button.button;
      end;
    end
  else if (qq<>0) and (event.type_=sdl_keydown) then
    begin
    ramb^[$6002B]:=1;
    key:=event.key.keysym.sym;
    key:=(key shr 24) shl 8 + (key and $FF);
    dpoke($60028,key);
    end;
  until qq=0;
end;

//  ---------------------------------------------------------------------
//   procedure blit(from,x,y,too,x2,y2,lines,length,bpl1,bpl2:integer)
//   copy a rectangle from screen "from" to screen "too"
//   bpl1,bpl1 - bit per line at screen1 and screen 2
//   STUB!  rev. 2015.10.18
//  -------------------------------------------------------------------


procedure blit(from,x,y,too,x2,y2,length,lines,bpl1,bpl2:integer);

// --- TODO - write in asm, add advanced blitting modes

var i,j:integer;
    b1,b2:integer;

begin
if raml^[$18002]<16 then
  begin
  from:=from+x;
  too:=too+x2;
  for i:=0 to lines-1 do
    begin
    b2:=too+bpl2*(i+y2);
    b1:=from+bpl1*(i+y);
    for j:=0 to length-1 do
      ramb^[b2+j]:=ramb^[b1+j];
    end;
  end
else if (raml^[$18002]>=16) and (raml^[$18002]<32) then
  begin
  from:=(from shr 1)+x;
  too:=(too shr 1)+x2;
  for i:=0 to lines-1 do
    begin
    b2:=too+bpl2*(i+y2);
    b1:=from+bpl1*(i+y);
    for j:=0 to length-1 do
      ramw^[b2+j]:=ramw^[b1+j];
    end;
  end
else
  begin
  from:=(from shr 2)+x;
  too:=(too shr 2)+x2;
  for i:=0 to lines-1 do
    begin
    b2:=too+bpl2*(i+y2);
    b1:=from+bpl1*(i+y);
    for j:=0 to length-1 do
      raml^[b2+j]:=raml^[b1+j];
    end;
  end;
end;

procedure graphics(mode:integer);

begin
raml^[$18001]:=$F000000;
case mode of

   16: begin

       raml^[$18002]:=16;
       raml^[$18008]:=1792;
       raml^[$18009]:=1120;
       end;


   else begin

        raml^[$18002]:=16;
        raml^[$18008]:=1792;
        raml^[$18009]:=1120;
        end;
    end;
raml^[$18001]:=$F000000;
setataripallette(0);

cls(0);
end;


procedure scrconvert(screen:pointer;buf:integer);  //convert retro fb to raspberry fb @ graphics mode 16
                                                      //1792x1120x64k

var
  b:integer;
  pi:^integer;
  i,j,k,l:integer;


begin
buf:=buf shr 1;
pi:=screen;
b:=raml^[$18003];
l:=0;
for i:=0 to 39 do begin if peek($70001)=0 then b:=lpeek($10000+4*((i div 4)+lpeek($60000)  ) mod 1024); for j:=0 to 1919  do (pi+i*1920+j)^:=b; end;
k:=76800;
for i:=40 to 1159 do
  begin
  for j:=0 to 63 do begin if peek($70001)=0 then b:=lpeek($10000+4*((i div 4)+lpeek($60000) ) mod 1024); (pi+k)^:=b; k+=1; end;
  for j:=0 to 1791 do begin
  (pi+k)^:=raml^[$4000+ramw^[buf+l]]; k+=1; l+=1; end;
  for j:=0 to 63 do begin (pi+k)^:=b; k+=1; end;
  end;
for i:=1160 to 1199 do begin if peek($70001)=0 then b:=lpeek($10000+4*((i div 4)+lpeek($60000) ) mod 1024); for j:=0 to 1919  do (pi+i*1920+j)^:=b; end;

end;

//  ---------------------------------------------------------------------
//           asm procedure - draw sprites on screen
//           called from retromachine emulation thread
//           rev. 2015.10.13
//  ---------------------------------------------------------------------

procedure sprite(screen:pointer);

  label p100;

var  offset,pixel, spritebase, spritedefs,ctrl1:integer;
     screenbase,pi:^integer;
     xpos,ypos,xzoom, yzoom, i,j,k,l,m: integer;
     mask:cardinal;
                                //  sprite control long 0 31..16 y pos  15..0 x pos
                                //  long 1 30..16 y zoom 15..0 x zoom 31 mode
                                // defs @ 52000

begin
pi:=screen;
spritebase:=$60040;
spritedefs:=$52000;
t:=gettime;
for i:=0 to 7 do
  begin
  mask:=1 shl (i+24);
  ctrl1:=lpeek(spritebase);
  spritebase+=4;
  ypos:=ctrl1 shr 16;
  xpos:=ctrl1 and $FFFF;
  ctrl1:=lpeek(spritebase);
  spritebase+=4;
  yzoom:=(ctrl1 shr 16) and $7FFF ;
  if yzoom>8 then yzoom:=8;
  if yzoom<1 then yzoom:=1;
  xzoom:=ctrl1 and $7FFF ;
  if xzoom>8 then xzoom:=8;
  if xzoom<1 then xzoom:=1;
  if (xpos>2048) or (ypos>2048) then
    begin
    spritedefs+=4096;
    goto p100;
    end;
  for l:=0 to 31 do
    begin
    for m:=1 to yzoom do
      begin
      offset:=xpos+1920*(ypos+yzoom*l+m-1);
      screenbase:=pi+offset;
      for j:=0 to 31 do
        begin
        for k:=1 to xzoom do
          begin
          pixel:=lpeek(spritedefs);
          if ((screenbase^ and mask)=0) and (offset<2304000) and (pixel<>0) then screenbase^:=pixel;
          screenbase+=1;
          end;
        spritedefs+=4;
        end;
      spritedefs-=128
      end;
    spritedefs+=128;
    end;
  p100:
  end;
ts:=gettime-t;

end;


procedure setataripallette(bank:integer);

var fh:integer;


begin
fh:=fileopen('./ataripalette.def',$40);
fileread(fh,raml^[$4000+256*bank],1024);
fileclose(fh);
end;

procedure sethidecolor(c,bank,mask:integer);

begin
raml^[$4000+256*bank+c]+=(mask shl 24);
end;

procedure cls(c:integer);

var c2, i,l:integer;

begin
c:=c mod 65535;

l:=(raml^[$18008]*raml^[$18009]) div 2 ;
c:=c+(c shl 16);
for i:=0 to l do raml^[$3C00000+i]:=c;

end;


//  ---------------------------------------------------------------------
//   putpixel (x,y,color)
//   asm procedure - put color pixel on screen at position (x,y)
//   rev. 2015.10.14
//  ---------------------------------------------------------------------


procedure putpixel(x,y,color:integer);

var adr:integer;

begin

if raml^[$18002]<16 then
  begin adr:=$F000000+x+1792*y; if adr<$FFFFFFF then ramb^[adr]:=color; end
else if (raml^[$18002]>=16) and (raml^[$18002]<32) then
  begin adr:=$7800000+x+1792*y; if adr<$7FFFFFF then ramw^[adr]:=color; end
else
  begin adr:=$3c00000+x+1792*y; if adr<$3FFFFFF then raml^[adr]:=color; end;
end;


//  ---------------------------------------------------------------------
//   box(x,y,l,h,color)
//   asm procedure - draw a filled rectangle, upper left at position (x,y)
//   length l, height h
//   rev. 2015.10.14
//  ---------------------------------------------------------------------

procedure box(x,y,l,h,c:integer);

 var adr,a,i,j:integer;

label p999,p101,p102,p111,p112,p121,p122,p131,p132;
label a60008;


begin
//repeat until vblank1=0;
if x<0 then x:=0;
if x>1792 then x:=1792;
if y<0 then y:=0;
if y>1120 then y:=1120;
if x+l>1792 then l:=1792-x-1;
if y+h>1120 then h:=1120-y-1 ;
if raml^[$18002]<16 then
  begin
  for j:=y to y+h-1 do
    begin
    adr:=$F000000+1792*j;
    for i:=x to x+l-1 do ramb^[adr+i]:=c;
    end;
  end
else if (raml^[$18002]>=16) and (raml^[$18002]<32) then
  begin
  for j:=y to y+h-1 do
    begin
    adr:=$7800000+1792*j;
    for i:=x to x+l-1 do ramw^[adr+i]:=c;
    end;
  end
else
  begin
  for j:=y to y+h-1 do
    begin
    adr:=$3c00000+1792*j;
    for i:=x to x+l-1 do raml^[adr+i]:=c;
    end;
  end
end;

//  ---------------------------------------------------------------------
//   box2(x1,y1,x2,y2,color)
//   Draw a filled rectangle, upper left at position (x1,y1)
//   lower right at position (x2,y2)
//   wrapper for box procedure
//   rev. 2015.10.17
//  ---------------------------------------------------------------------

procedure box2(x1,y1,x2,y2,color:integer);

begin


if (x1<x2) and (y1<y2) then
   box(x1,y1,x2-x1+1, y2-y1+1,color);

end;


//  ---------------------------------------------------------------------
//   putchar(x,y,ch,color)
//   Draw a 8x16 character at position (x1,y1)
//   STUB, will be replaced by asm procedure
//   rev. 2015.10.14
//  ---------------------------------------------------------------------


procedure putchar(x,y:integer;ch:char;col:integer);

// --- TODO: translate to asm, use system variables

var i,j,start:integer;
  b:byte;

begin
start:=$50000+16*ord(ch);
for i:=0 to 15 do
  begin
  b:=ramb^[start+i];
  for j:=0 to 7 do
    begin
    if (b and (1 shl j))<>0 then
      putpixel(x+j,y+i,col);
    end;
  end;
end;

procedure putcharz(x,y:integer;ch:char;col,xz,yz:integer);

// --- TODO: translate to asm, use system variables

var i,j,k,l,start:integer;
  b:byte;

begin
start:=$50000+16*ord(ch);
for i:=0 to 15 do
  begin
  b:=ramb^[start+i];
  for j:=0 to 7 do
    begin
    if (b and (1 shl j))<>0 then
      for k:=0 to yz-1 do
        for l:=0 to xz-1 do
           putpixel(x+j*xz+l,y+i*yz+k,col);
    end;
  end;
end;

procedure outtextxy(x,y:integer; t:string;c:integer);

var i:integer;

begin
for i:=1 to length(t) do putchar(x+8*i-8,y,t[i],c);
end;

procedure outtextxyz(x,y:integer; t:string;c,xz,yz:integer);

var i:integer;

begin
for i:=0 to length(t)-1 do putcharz(x+8*xz*i,y,t[i+1],c,xz,yz);
end;

procedure scrollup;

var i:integer;

begin
for i:=0 to 447 do raml^[$3c7a800+i]:=raml^[$3c00000+i];
for i:=0 to 501760 do raml^[$3C00000+i]:=raml^[$3c001c0+i];
end;


function noise1:byte;

const a:cardinal=$7FFFF8;
      b22:cardinal=1 shl 22;
      b20:cardinal=1 shl 20;
      b16:cardinal=1 shl 16;
      b13:cardinal=1 shl 13;
      b11:cardinal=1 shl 11;
      b07:cardinal=1 shl 07;
      b04:cardinal=1 shl 04;
      b02:cardinal=1 shl 02;
      b17:cardinal=1 shl 17;

var output:cardinal;
    b: boolean;

begin
output:= (a and b22) shr 15;
output+= (a and b20) shr 14;
output+= (a and b16) shr 11;
output+= (a and b13) shr 9;
output+= (a and b11) shr 8;
output+= (a and b07) shr 5;
output+= (a and b04) shr 3;
output+= (a and b02) shr 2;

b:=((a and b22)>0) xor ((a and b17)>0);
a:=a shl 1;
if b then a:=a or 1;
noise1:=output;
end;

function noise2:cardinal;

const a:int64=$7FFFF8;

var output:int64;
    b: boolean;


begin
output:= (a and 4194304) shr 15;
output+= (a and 1048576) shr 14;
output+= (a and 65536) shr 11;
output+= (a and 8192) shr 9;
output+= (a and 2048) shr 8;
output+= (a and 128) shr 5;
output+= (a and 16) shr 3;
output+= (a and 4) shr 2;
b:=((a and 4194304)>0) xor ((a and 131072)>0);
a:=a shl 1;
if b then a:=a or 1;
noise2:=output;
end;

function noise3:cardinal;

const a:int64=$7FFFF8;
      b22:int64=1 shl 22;
      b20:int64=1 shl 20;
      b16:int64=1 shl 16;
      b13:int64=1 shl 13;
      b11:int64=1 shl 11;
      b07:int64=1 shl 07;
      b04:int64=1 shl 04;
      b02:int64=1 shl 02;
      b17:int64=1 shl 17;

var output:int64;
    b: boolean;

begin
output:= (a and b22) shr 15;
output+= (a and b20) shr 14;
output+= (a and b16) shr 11;
output+= (a and b13) shr 9;
output+= (a and b11) shr 8;
output+= (a and b07) shr 5;
output+= (a and b04) shr 3;
output+= (a and b02) shr 2;

b:=((a and b22)>0) xor ((a and b17)>0);
a:=a shl 1;
if b then a:=a or 1;
noise3:=output;
end;
{

/* Pick out bits to make output value */
output = (bit(reg,22) << 7) |
         (bit(reg,20) << 6) |
         (bit(reg,16) << 5) |
         (bit(reg,13) << 4) |
         (bit(reg,11) << 3) |
         (bit(reg, 7) << 2) |
         (bit(reg, 4) << 1) |
         (bit(reg, 2) << 0);

/* Save bits used to feed bit 0 */
bit22= bit(reg,22);
bit17= bit(reg,17);

/* Shift 1 bit left */
reg= reg << 1;

//(* Feed bit 0 */
reg= reg | (bit22 ^ bit17);

}

function sid(mode:integer):tsample;
       // sid vars

const pa1:double=0;
      pa2:double=0;
      pa3:double=0;
      pa1n:double=0;
      pa2n:double=0;
      pa3n:double=0;

      pa1i:integer=0;
      pa2i:integer=0;
      pa3i:integer=0;
      pa1ni:integer=0;
      pa2ni:integer=0;
      pa3ni:integer=0;

      filter_b:double=0;
      filter_h:double=0;
      filter_l:double=0;

      filter_b2:double=0;
      filter_h2:double=0;
      filter_l2:double=0;

      filter_b3:double=0;
      filter_h3:double=0;
      filter_l3:double=0;


      filter_bi:integer=0;
      filter_hi:integer=0;
      filter_li:integer=0;

      filter_b2i:integer=0;
      filter_h2i:integer=0;
      filter_l2i:integer=0;

      filter_b3i:integer=0;
      filter_h3i:integer=0;
      filter_l3i:integer=0;

//      filter_resonance:double=1;
//      filter_freq:double=0.1;
      wv1:double=0;
      wv2:double=0;
      wv3:double=0;
      wv4i:integer=0;
      wv5i:integer=0;
      adsrvol1i:int64=0;
      adsrvol2i:int64=0;
      adsrvol3i:int64=0;
      adsrstate1:byte=0;
      adsrstate2:byte=0;
      adsrstate3:byte=0;
      sustainvol1i:int64=0;
      sustainvol2i:int64=0;
      sustainvol3i:int64=0;
      oldsc:integer=0;
      sc:integer=0;
      sli:integer=0;
      sri:integer=0;


      freq1:double=0;
      freq1n:double=0;
      freq1i:integer=0;
      freq1ni:integer=0;
      waveform1:word=0;
      gate1:byte=0;
      sa1:byte=0;
      sd1:byte=0;
      ss1:byte=0;
      sr1:byte=0;
      pw1i:integer=0;
      test1:byte=0;
      sync1:integer=0;
      ring1:byte=0;
      f1:boolean=false;

      freq2:double=0;
      freq2n:double=0;
      freq2i:integer=0;
      freq2ni:integer=0;
      waveform2:word=0;
      gate2:byte=0;
      sa2:byte=0;
      sd2:byte=0;
      ss2:byte=0;
      sr2:byte=0;
      pw2i:integer=0;
      test2:byte=0;
      sync2:integer=0;
      ring2:byte=0;
      f2:boolean=false;

      freq3:double=0;
      freq3n:double=0;
      freq3i:integer=0;
      freq3ni:integer=0;
      waveform3:word=0;
      gate3:byte=0;
      sa3:byte=0;
      sd3:byte=0;
      ss3:byte=0;
      sr3:byte=0;
      pw3i:integer=0;
      test3:byte=0;
      sync3:integer=0;
      ring3:byte=0;
      f3:boolean=false;

      ff:word=0;
      filter_resonance2:double=0;
      filter_freq:double=0;
      filter_resonance2i:integer=0;
      filter_freqi:integer=0;
      volume:integer=0;
      c3off:double=0;

      fu:integer=0;
      fl:integer=0;
      fb:integer=0;
      wv1i:integer=0;
      wv2i:integer=0;
      wv3i:integer=0;

var i,sid1,sid1l,ind:integer;
          st:int64;
          pp1,pp2,pp3:byte;
          fout,fout2,fout3,fi,fi2,fi3, wv1a,wv2a,wv3a:double;
 //         wv4i,wv5i:int64;
          wv1ii,wv2ii,wv3ii:int64;
          fii,fi2i,fi3i:integer;
          fouti,fout2i,fout3i:integer;
begin
if mode=1 then  // get regs

  begin
  freq1i:=(31928*(ramb^[$D400]+256*ramb^[$d401])) div 32768;
  freq1ni:=freq1i*16;
  freq2i:=(31928*(ramb^[$d407]+256*ramb^[$d408])) div 32768;
  freq2ni:=freq2i*16;
  freq3i:=(31928*(ramb^[$d40e]+256*ramb^[$d40f])) div 32768;
  freq3ni:=freq3i*16;

  gate1:=ramb^[$d404] and 1;
  ring1:=ramb^[$d404] and 4;
  test1:=ramb^[$d404] and 8;
  sync1:=((ramb^[$d404] and 2) shr 1)-1;
  sd1:=ramb^[$d405] and  $F;
  sa1:=ramb^[$d405] shr 4;
  sr1:=ramb^[$d406]and $F;
  ss1:=ramb^[$d406] shr 4;
  pw1i:=((ramb^[$d402]+256*ramb^[$d403]) and $FFF);

  gate2:=ramb^[$d40b] and 1;
  ring2:=ramb^[$d40b] and 4;
  test2:=ramb^[$d40b] and 8;
  sync2:=((ramb^[$d40b] and 2) shr 1)-1;
  sd2:=ramb^[$d40c] and  $F;
  sa2:=ramb^[$d40c] shr 4;
  sr2:=ramb^[$d40d]and $F;
  ss2:=ramb^[$d40d] shr 4;
  pw2i:=((ramb^[$d409]+256*ramb^[$d40a]) and $FFF);

  gate3:=ramb^[$d412] and 1;
  ring3:=ramb^[$d412] and 4;
  test3:=ramb^[$d412] and 8;
  sync3:=((ramb^[$d412] and 2) shr 1)-1;
  sd3:=ramb^[$d413] and  $F;
  sa3:=ramb^[$d413] shr 4;
  sr3:=ramb^[$d414]and $F;
  ss3:=ramb^[$d414] shr 4;
  pw3i:=((ramb^[$d410]+256*ramb^[$d411]) and $FFF);

  ff:=(ramb^[$d416] shl 3)+(ramb^[$d415] and 7);
  filter_freqi:=(ff+(ff shl 2)+30) shr 2;
  if (ramb^[$d417] and 1)>0 then f1:=true else f1:=false;
  if (ramb^[$d417]  and 2)>0 then f2:=true else f2:=false;
  if (ramb^[$d417]  and 4)>0 then f3:=true else f3:=false;
  fl:=-(ramb^[$d418] and $10) shr 4;
  fb:=-(ramb^[$d418] and $20) shr 5;
  fu:=-(ramb^[$d418] and $40) shr 6;
  filter_resonance2i:=round(256*(0.5+(0.5/(1+(peek($d416) shr 4)))));
  volume:=(peek($d418) and 15);

  waveform1:=ramb^[$d404] shr 4;
  waveform2:=ramb^[$d40b] shr 4;
  waveform3:=ramb^[$d412] shr 4;

  sustainvol1i:=ss1 shl 26;
  sustainvol2i:=ss2 shl 26;
  sustainvol3i:=ss3 shl 26;
  end;

sli:=0; sri:=0;

for i:=1 to 5 do

  begin
  pa1i:=pa1i+freq1i;
  pa1ni:=pa1ni+freq1ni;
  if pa1i>16777216 then
    begin
    pa2i:=pa2i and sync2;
    pa1i-=16777216;
    end;
  if pa1ni>=16777216 then
    begin
    pa1ni-=16777216;
    pp1:=1;
    end
  else pp1:=0;

pa2i:=pa2i+freq2i;
pa2ni:=pa2ni+freq2ni;
if pa2i>16777216 then
  begin
  pa2i-=16777216;
  pa3i:=pa3i and sync3;
  end ;
if pa2ni>=16777216 then
  begin
  pa2ni-=16777216;
  pp2:=1;
  end
else pp2:=0;

pa3i:=pa3i+freq3i;
pa3ni:=pa3ni+freq3ni;
if pa3i>16777216 then begin pa3i-=16777216;  pa1i:=pa1i and sync1; end ;
if pa3ni>=16777216 then
  begin
  pa3ni-=16777216;
  pp3:=1;
  end
else pp3:=0;



  if test1>0 then pa1i:=0;
  if test2>0 then pa2i:=0;
  if test3>0 then pa3i:=0;


  case waveform1 of

  0: wv1i:=0;
  1: begin if (pa1i shr 23 = 0) then wv1i:=(pa1i shl 1)-8388608 else wv1i:=((not (pa1i shl 1)) and $FFFFFF)-8388608; if (ring1>0) and (pa3>0) then wv1i:=-wv1i; end;
  2: wv1i:=pa1i-8388608;
  3: begin ind:=pa1i shr 16; wv1i:=((combined[ind]-128) shl 16); end;
  4: if (pa1i shr 12) < pw1i then wv1i:=-8388608 else wv1i:=8388608;
  5: begin ind:=pa1i shr 16; wv1i:=((combined[ind+256]-128) shl 16); end;
  6: begin ind:=pa1i shr 16; wv1i:=((combined[ind+512]-128) shl 16); end;
  7: begin ind:=pa1i shr 16; wv1i:=((combined[ind+768]-128) shl 16); end;
  8: begin if pp1=1 then wv1i:=(noise1-128) shl 16; end;
  9: wv1i:=pa1i;
  10: wv1i:=pa1i;
  11..15: wv1i:=pa1i;
  else begin if pp1=1 then wv1i:=(noise1-128) shl 16; end;

  end;

  case waveform2 of

  0: wv2i:=0;
  1: begin if (pa2i shr 23 = 0) then wv2i:=(pa2i shl 1)-8388608 else wv2i:=((not (pa2i shl 1)) and $FFFFFF)-8388608; if (ring2>0) and (pa1>0) then wv2i:=-wv2i; end;
  2: wv2i:=pa2i-8388608;
  3: begin ind:=pa2i shr 16; wv2i:=((combined[ind]-128) shl 16); end;
  4: if (pa2i shr 12) < pw2i then wv2i:=-8388608 else wv2i:=8388608;
  5: begin ind:=pa2i shr 16; wv2i:=((combined[ind+256]-128) shl 16); end;
  6: begin ind:=pa2i shr 16; wv2i:=((combined[ind+512]-128) shl 16); end;
  7: begin ind:=pa2i shr 16; wv2i:=((combined[ind+768]-128) shl 16); end;
  8: begin if pp2=1 then wv2i:=(noise2-128) shl 16; end;
  9: wv2i:=pa2i;
  10: wv2i:=pa2i;
  11..15: wv2i:=pa2i;
  else begin if pp2=1 then wv2i:=(noise2-128) shl 16; end;
  end;

  case waveform3 of

  0: wv3i:=0;
  1: begin if (pa3i shr 23 = 0) then wv3i:=(pa3i shl 1)-8388608 else wv3i:=((not (pa3i shl 1)) and $FFFFFF)-8388608; if (ring3>0) and (pa2>0) then wv3i:=-wv3i; end;
  2: wv3i:=pa3i-8388608;
  3: begin ind:=pa3i shr 16; wv3i:=((combined[ind]-128) shl 16); end;
  4: if (pa3i shr 12) < pw3i then wv3i:=-8388608 else wv3i:=8388608;
  5: begin ind:=pa3i shr 16; wv3i:=((combined[ind+256]-128) shl 16); end;
  6: begin ind:=pa3i shr 16; wv3i:=((combined[ind+512]-128) shl 16); end;
  7: begin ind:=pa3i shr 16; wv3i:=((combined[ind+768]-128) shl 16); end;
  8: begin if pp3=1 then wv3i:=(noise3-128) shl 16; end;
  9: ;//wv3i:=pa3i;
  10: ; //wv3i:=pa3i;
  11..15: ;//wv3i:=pa3i;
  else begin if pp3=1 then wv3i:=(noise3-128) shl 16; end;
  end;


  if gate1=0 then adsrstate1:=4 else begin if ((adsrstate1=0) or (adsrstate1=4)) then adsrstate1:=1; end;  //release /attack

  if (adsrstate1=3) then adsrvol1i:=sustainvol1i
  else if (adsrstate1=1) then begin adsrvol1i:=adsrvol1i+(attacktablei[sa1]); if adsrvol1i>=1073741824 then adsrstate1:=2; end
  else if (adsrstate1=2) then begin adsrvol1i:=(adsrvol1i*(srtablei[sd1])) shr 30; if adsrvol1i<=sustainvol1i then adsrstate1:=3; end
  else if (adsrstate1=4) then begin adsrvol1i:=(adsrvol1i*(srtablei[sr1])) shr 30; if (adsrvol1i<=65536) then begin adsrstate1:=0; adsrvol1i:=0; end; end
  else adsrvol1i:=0;

  if gate2=0 then adsrstate2:=4 else begin if ((adsrstate2=0) or (adsrstate2=4)) then adsrstate2:=1; end;  //release /attack

  if (adsrstate2=3) then adsrvol2i:=sustainvol2i
  else if (adsrstate2=1) then begin
      adsrvol2i:=adsrvol2i+(attacktablei[sa2]); if adsrvol2i>=1073741824 then adsrstate2:=2; end
  else if (adsrstate2=2) then
    begin
    adsrvol2i:=(adsrvol2i*(srtablei[sd2])) shr 30;
    if adsrvol2i<=sustainvol2i then
      adsrstate2:=3; end
  else if (adsrstate2=4) then begin adsrvol2i:=(adsrvol2i*(srtablei[sr2])) shr 30; if (adsrvol2i<=65536) then begin adsrstate2:=0; adsrvol2i:=0; end; end
  else adsrvol2i:=0;


  if gate3=0 then adsrstate3:=4  else begin if ((adsrstate3=0) or (adsrstate3=4)) then adsrstate3:=1; end;  //release /attack

  if (adsrstate3=3) then adsrvol3i:=sustainvol3i
  else if (adsrstate3=1) then begin adsrvol3i:=adsrvol3i+(attacktablei[sa3]); if adsrvol3i>=1073741824 then adsrstate3:=2; end
  else if (adsrstate3=2) then begin adsrvol3i:=(adsrvol3i*(srtablei[sd3])) shr 30; if adsrvol3i<=sustainvol3i then adsrstate3:=3; end
  else if (adsrstate3=4) then begin adsrvol3i:=(adsrvol3i*(srtablei[sr3])) shr 30; if (adsrvol3i<=65536) then begin adsrstate3:=0; adsrvol3i:=0; end; end
  else adsrvol3i:=0;


  {real adsr: 93-54-26-14-6: 2-4-8-16-30}

  wv1ii:=wv1i*adsrvol1i*ramb^[$70003];    // wv1a:=0;
  wv2ii:=wv2i*adsrvol2i*ramb^[$70004];    // wv2a:=0;
  wv3ii:=wv3i*adsrvol3i*ramb^[$70005];    // wv3a:=0;

// integer

  wv1ii:=(wv1ii div 137438953472);
  wv2ii:=(wv2ii div 137438953472);
  wv3ii:=(wv3ii div 137438953472);

  fii:=1; fi2i:=1; fi3i:=1;
  if f1 then begin fii:=wv1ii; wv1ii:=0; end;
  if f2 then begin fi2i:=wv2ii; wv2ii:=0; end;
  if f3 then begin fi3i:=wv3ii; wv3ii:=0; end;

  filter_Hi  := fii - ((filter_Bi * filter_resonance2i) div 256) - filter_Li;
  filter_H2i  := fi2i - ((filter_B2i * filter_resonance2i) div 256) - filter_L2i;
  filter_H3i  := fi3i - ((filter_B3i * filter_resonance2i) div 256) - filter_L3i;

  filter_Bi += (filter_freqi * filter_Hi) div 32768;
  filter_B2i += (filter_freqi * filter_H2i) div 32768;
  filter_B3i += (filter_freqi * filter_H3i) div 32768;

  filter_Li += (filter_freqi * filter_Bi) div 32768;
  filter_L2i += (filter_freqi * filter_B2i) div 32768;
  filter_L3i += (filter_freqi * filter_B3i) div 32768;

  fouti:=wv1ii;
  fouti+=filter_li and fl;
  fouti+=filter_bi and fb;
  fouti+=filter_hi and fu;

  fout2i:=wv2ii;
  fout2i+=filter_l2i and fl;
  fout2i+=filter_b2i and fb;
  fout2i+=filter_h2i and fu;

  fout3i:=wv3ii;
  fout3i+=filter_l3i and fl;
  fout3i+=filter_b3i and fb;
  fout3i+=filter_h3i and fu;

  wv5i:=(volume*((fouti div 2)+(fout2i div 4)+ (fout2i div 2)+(fout3i)));
  wv4i:=(volume*((fouti)+(fout2i div 4)+ (fout2i div 2)+(fout3i div 2)));


sri+=wv4i;
sli+=wv5i;
  end;


sid1:=sri div 1024;
sid1l:=sli div 1024;
oldsc:=sc;
sc:=sid1+sid1l;
if abs(sc)>65535 then lpoke ($6000c,$FF0000);
scope[scj div 1]:=sc; inc(scj); if scj>959 then if (oldsc<0) and (sc>0) then scj:=0 else scj:=959;
sid[0]:=sid1;
sid[1]:=sid1l;
end;


 {
function sid2:tsample;
       // sid vars

const pa1:double=0;
      pa2:double=0;
      pa3:double=0;
      pa1n:double=0;
      pa2n:double=0;
      pa3n:double=0;
      filter_b:double=0;
      filter_h:double=0;
      filter_l:double=0;

      filter_b2:double=0;
      filter_h2:double=0;
      filter_l2:double=0;

      filter_b3:double=0;
      filter_h3:double=0;
      filter_l3:double=0;
//      filter_resonance:double=1;
//      filter_freq:double=0.1;
      wv1:double=0;
      wv2:double=0;
      wv3:double=0;
      wv4:double=0;
      wv5:double=0;
      attacktable:array[0..15] of double=(0.002,0.008,0.016,0.024,0.038,0.056,0.068,0.080,0.100,0.250,0.500,0.800,1,3,5,8);
      adsrvol1:double=0;
      adsrvol2:double=0;
      adsrvol3:double=0;
      adsrstate1:byte=0;
      adsrstate2:byte=0;
      adsrstate3:byte=0;
      sustainvol1:double=0;
      sustainvol2:double=0;
      sustainvol3:double=0;
      oldsc:integer=0;
      sc:integer=0;
      sl:double=0;
      sr:double=0;
      osl:double=0;
      osr:double=0;

var i,sid1,sid1l,ind:integer;
          st:int64;
          pp1,pp2,pp3:byte;
          fout,fout2,fout3,fi,fi2,fi3, wv1a,wv2a,wv3a:double;
          wv4i,wv5i:int64;


          freq1,waveform1:word;
          freq2,waveform2:word;
          freq3,waveform3:word;
          gate1,sa1,sd1,ss1,sr1:byte;
          gate2,sa2,sd2,ss2,sr2:byte;
          gate3,sa3,sd3,ss3,sr3:byte;
          pw1,pw2,pw3:word;
          test1,test2,test3,sync1,sync2,sync3,ring1,ring2,ring3:byte;
           ff:word;
          filter_resonance2:double;
          filter_freq:double;
          f1,f2,f3:boolean;
          fu,fl,fb:boolean;
           volume:double;
           c3off:double;

begin

// get regs

freq1:=ramb^[$D400]+256*ramb^[$d401];
freq2:=ramb^[$d407]+256*ramb^[$d408];
freq3:=ramb^[$d40e]+256*ramb^[$d40f];
gate1:=ramb^[$d404] and 1;
ring1:=ramb^[$d404] and 4;
test1:=ramb^[$d404] and 8;
sync1:=ramb^[$d404] and 2;
sd1:=ramb^[$d405] and  $F;
sa1:=ramb^[$d405] shr 4;
sr1:=ramb^[$d406]and $F;
ss1:=ramb^[$d406] shr 4;
pw1:=(ramb^[$d402]+256*ramb^[$d403]) and $FFF;

gate2:=ramb^[$d40b] and 1;
ring2:=ramb^[$d40b] and 4;
test2:=ramb^[$d40b] and 8;
sync2:=ramb^[$d40b] and 2;
sd2:=ramb^[$d40c] and  $F;
sa2:=ramb^[$d40c] shr 4;
sr2:=ramb^[$d40d]and $F;
ss2:=ramb^[$d40d] shr 4;
pw2:=(ramb^[$d409]+256*ramb^[$d40a]) and $FFF;

gate3:=ramb^[$d412] and 1;
ring3:=ramb^[$d412] and 4;
test3:=ramb^[$d412] and 8;
sync3:=ramb^[$d412] and 2;
sd3:=ramb^[$d413] and  $F;
sa3:=ramb^[$d413] shr 4;
sr3:=ramb^[$d414]and $F;
ss3:=ramb^[$d414] shr 4;
pw3:=(ramb^[$d410]+256*ramb^[$d411]) and $FFF;

ff:=(peek($d416) shl 3)+(peek($d415) and 7);
filter_freq:=((ff * 5.8) + 30)/240000;
if (peek($d417) and 1)>0 then f1:=true else f1:=false;
if (peek($d417)  and 2)>0 then f2:=true else f2:=false;
if (peek($d417)  and 4)>0 then f3:=true else f3:=false;
if (peek($d418)  and $10)>0 then fl:=true else fl:=false;
if (peek($d418) and $20)>0 then fb:=true else fb:=false;
if (peek($d418) and $40)>0 then fu:=true else fu:=false;
filter_resonance2:=0.5+(0.5/(1+(peek($d416) shr 4)));
volume:=(peek($d418) and 15) /16;
case (peek($d404) shr 4) of
  1:  waveform1:=1;
  2:  waveform1:=0;
  3:  waveform1:=4; //combined tri+saw
  4: waveform1:=2;
  5: waveform1:=5; //combined tri+sqr
  6: waveform1:=6; //combined saw+sqr
  7: waveform1:=7; //combined all
  8: waveform1:=3;
  9..15:freq1:=0;
  end;
case (peek($d40b) shr 4) of
  1:  waveform2:=1;
  2:  waveform2:=0;
  3:  waveform2:=4; //combined tri+saw
  4: waveform2:=2;
  5: waveform2:=5; //combined tri+sqr
  6: waveform2:=6; //combined saw+sqr
  7: waveform2:=7; //combined all
  8: waveform2:=3;
  9..15:freq2:=0;

  end;
case (peek($d412) shr 4) of
  1:  waveform3:=1;
  2:  waveform3:=0;
  3:  waveform3:=4; //combined tri+saw
  4: waveform3:=2;
  5: waveform3:=5; //combined tri+sqr
  6: waveform3:=6; //combined saw+sqr
  7: waveform3:=7; //combined all
  8: waveform3:=3;
  9..15:freq3:=0;
  end;

osl:=sl; osr:=sr;
sl:=0; sr:=0;
for i:=1 to 5 do
  begin
  pa1:=pa1+0.0000000611722469329833984375*freq1;
  pa1n:=pa1n+16*0.0000000611722469329833984375*freq1;
  if pa1>0.5 then
    begin
    if sync2>0 then pa2:=-0.5;
    pa1-=1;
    end;
  if pa1n>=0.5 then
    begin
    pa1n-=1;
    pp1:=1;
    end
  else pp1:=0;

  pa2:=pa2+0.0000000611722469329833984375*freq2;
  pa2n:=pa2n+16*0.0000000611722469329833984375*freq2;
  if pa2>0.5 then begin pa2-=1;  if sync3>0 then pa3:=-0.5; end ;
  if pa2n>=0.5 then
    begin
    pa2n-=1;
    pp2:=1;
    end
  else pp2:=0;

  pa3:=pa3+0.0000000611722469329833984375*freq3;
  pa3n:=pa3n+16*0.0000000611722469329833984375*freq3;
  if pa3>0.5 then begin pa3-=1; if sync1>0 then pa1:=-0.5; end ;
  if pa3n>=0.5 then
    begin
    pa3n-=1;
    pp3:=1;
    end
  else pp3:=0;

  if waveform1=0 then wv1:=pa1;
  if waveform1=1 then begin wv1:=0.5-(2*abs(pa1)); if (ring1>0) and (pa3>0) then wv1:=-wv1; end;
  if waveform1=2 then if (pa1+0.5<(pw1/4095)) then wv1:=-0.5 else wv1:=0.5;
  if waveform1=3 then begin if pp1=1 then wv1:=(noise1-128)/256; end;
  if waveform1=4 then begin ind:=trunc((pa1+0.5)*256); wv1:=(combined[ind]/256)-0.5;end;
  if waveform1=5 then begin ind:=trunc((pa1+0.5)*256); wv1:=(combined[ind+256]/256)-0.5; end;
  if waveform1=6 then begin ind:=trunc((pa1+0.5)*256); wv1:=(combined[ind+512]/256)-0.5; end;
  if waveform1=7 then begin ind:=trunc((pa1+0.5)*256); wv1:=(combined[ind+768]/256)-0.5; end;
  if test1>0 then pa1:=-0.50;

  if waveform2=0 then wv2:=pa2;
  if waveform2=1 then begin wv2:=0.5-(2*abs(pa2));   if (ring2>0) and (pa1>0) then wv2:=-wv2; end;
  if waveform2=2 then if (pa2+0.5<(pw2/4095)) then wv2:=-0.5 else wv2:=0.5;
  if waveform2=3 then begin if pp2=1 then wv2:=(noise2-128)/256; end;
  if waveform2=4 then begin ind:=trunc((pa2+0.5)*256); wv2:=(combined[ind]/256)-0.5; end;
  if waveform2=5 then begin ind:=trunc((pa2+0.5)*256); wv2:=(combined[ind+256]/256)-0.5; end;
  if waveform2=6 then begin ind:=trunc((pa2+0.5)*256); wv2:=(combined[ind+512]/256)-0.5;  end;
  if waveform2=7 then begin ind:=trunc((pa2+0.5)*256); wv2:=(combined[ind+768]/256)-0.5; end;
  if test2>0 then pa2:=-0.50;

  if waveform3=0 then wv3:=pa3;
  if waveform3=1 then begin wv3:=0.5-(2*abs(pa3)); if (ring3>0) and (pa2>0) then wv3:=-wv3; end;

  if waveform3=2 then if (pa3+0.5<(pw3/4095)) then wv3:=-0.5 else wv3:=0.5;
  if waveform3=3 then begin if pp3=1 then wv3:=(noise3-128)/256; end;
  if waveform3=4 then begin ind:=trunc((pa3+0.5)*256); wv3:=(combined[ind]/256)-0.5; end;
  if waveform3=5 then begin ind:=trunc((pa3+0.5)*256); wv3:=(combined[ind+256]/256)-0.5;end;
  if waveform3=6 then begin ind:=trunc((pa3+0.5)*256); wv3:=(combined[ind+512]/256)-0.5;end;
  if waveform3=7 then begin ind:=trunc((pa3+0.5)*256); wv3:=(combined[ind+768]/256)-0.5; end;



  if test3>0 then pa3:=-0.50;


  sustainvol1:=ss1/16;
  sustainvol2:=ss2/16;
  sustainvol3:=ss3/16;

  if (adsrstate1=0) then adsrvol1:=0;
  if ((adsrstate1=0) or (adsrstate1=4)) and (gate1=1) then adsrstate1:=1; //attack
  if (adsrstate1=1) and (adsrvol1>1) then begin adsrvol1:=1; adsrstate1:=2; end; //decay
  if (adsrstate1=2) and (adsrvol1<=sustainvol1) then begin adsrstate1:=3; adsrvol1:=sustainvol1; end; //sustain;
  if ((adsrstate1=1) or (adsrstate1=2) or (adsrstate1=3)) and (gate1=0) then adsrstate1:=4;  //release
  if (adsrstate1=4) and (adsrvol1<=0.0001) then begin adsrvol1:=0; adsrstate1:=0; end; //idle

  if (adsrstate1=1) then adsrvol1:=adsrvol1+(1.0416666666666666666666666666667e-6/attacktable[sa1]);
  if (adsrstate1=2) then adsrvol1:=adsrvol1*(1-(3*3.4722222222222222222222222222222e-7/attacktable[sd1]));
  if (adsrstate1=3) then adsrvol1:=sustainvol1;
  if (adsrstate1=4) then adsrvol1:=adsrvol1*(1-(3*3.4722222222222222222222222222222e-7/attacktable[sr1]));

  if (adsrstate2=0) then adsrvol2:=0;
  if ((adsrstate2=0) or (adsrstate2=4)) and (gate2=1) then adsrstate2:=1; //attack
  if (adsrstate2=1) and (adsrvol2>1) then begin adsrvol2:=1; adsrstate2:=2; end; //decay
  if (adsrstate2=2) and (adsrvol2<=sustainvol2) then begin adsrstate2:=3; adsrvol2:=sustainvol2; end; //sustain;
  if ((adsrstate2=1) or (adsrstate2=2) or (adsrstate2=3)) and (gate2=0) then adsrstate2:=4;  //release
  if (adsrstate2=4) and (adsrvol2<=0.0001) then begin adsrvol2:=0; adsrstate2:=0; end; //idle

  if (adsrstate2=1) then adsrvol2:=adsrvol2+(1.0416666666666666666666666666667e-6/attacktable[sa2]);
  if (adsrstate2=2) then adsrvol2:=adsrvol2*(1-(3*3.4722222222222222222222222222222e-7/attacktable[sd2]));
  if (adsrstate2=3) then adsrvol2:=sustainvol2;
  if (adsrstate2=4) then adsrvol2:=adsrvol2*(1-(3*3.4722222222222222222222222222222e-7/attacktable[sr2]));

  if (adsrstate3=0)  then adsrvol3:=0;
  if ((adsrstate3=0) or (adsrstate3=4)) and (gate3=1) then adsrstate3:=1; //attack
  if (adsrstate3=1) and (adsrvol3>1) then begin adsrvol3:=1; adsrstate3:=2; end; //decay
  if (adsrstate3=2) and (adsrvol3<=sustainvol3) then begin adsrstate3:=3; adsrvol3:=sustainvol3; end; //sustain;
  if ((adsrstate3=1) or (adsrstate3=2) or (adsrstate3=3)) and (gate3=0) then adsrstate3:=4;  //release
  if (adsrstate3=4) and (adsrvol3<=0.0001) then begin adsrvol3:=0; adsrstate3:=0; end; //idle

  if (adsrstate3=1) then adsrvol3:=adsrvol3+(1.0416666666666666666666666666667e-6/attacktable[sa3]);
  if (adsrstate3=2) then adsrvol3:=adsrvol3*(1-(3*3.4722222222222222222222222222222e-7/attacktable[sd3]));
  if (adsrstate3=3) then adsrvol3:=sustainvol3;
  if (adsrstate3=4) then adsrvol3:=adsrvol3*(1-(3*3.4722222222222222222222222222222e-7/attacktable[sr3]));

   {real adsr: 93-54-26-14-6: 2-4-8-16-30}

  wv1a:=wv1*adsrvol1*peek($70003);    // wv1a:=0;
  wv2a:=wv2*adsrvol2*peek($70004);    // wv2a:=0;
  wv3a:=wv3*adsrvol3*peek($70005);    // wv3a:=0;


  fi:=0.001;//(0.5-random)*0.00003;
  fi2:=0.001;//(0.5-random)*0.00003;
  fi3:=0.001;//(0.5-random)*0.00003;

  if f1 then begin fi+=wv1a; wv1a:=0; end;
  if f2 then begin fi2+=wv2a; wv2a:=0; end;
  if f3 then begin fi3+=wv3a; wv3a:=0; end;

  filter_H  := fi - filter_B * filter_resonance2 - filter_L ;
  filter_B += filter_freq * filter_H;
  filter_L += filter_freq * filter_B;

  filter_H2  := fi2 - filter_B2 * filter_resonance2 - filter_L2 ;
  filter_B2 += filter_freq * filter_H2;
  filter_L2 += filter_freq * filter_B2;

  filter_H3  := fi3 - filter_B3 * filter_resonance2 - filter_L3 ;
  filter_B3 += filter_freq * filter_H3;
  filter_L3 += filter_freq * filter_B3;


  fout:=0;
  if fl then fout+=filter_l;
  if fb then fout+=filter_b;
  if fu then fout+=filter_h;
  fout2:=0;
  if fl then fout2+=filter_l2;
  if fb then fout2+=filter_b2;
  if fu then fout2+=filter_h2;
  fout3:=0;
  if fl then fout3+=filter_l3;
  if fb then fout3+=filter_b3;
  if fu then fout3+=filter_h3;

  wv5:=volume*0.5*(0.5*wv1a+0.75*wv2a+wv3a+0.5*fout+0.75*fout2+fout3);
  wv4:=volume*0.5*(wv1a+0.75*wv2a+0.5*wv3a+fout+0.75*fout2+0.5*fout3);

//  wv4:=wv4+0.001;//(0.5-random)*0.00003;
//  wv5:=wv5+0.001;//(0.5-random)*0.00003;


//  wv4:=antialias6(wv4,ft1r);
//  wv5:=antialias6(wv5,ft1l);

sr+=wv4;
sl+=wv5;
  end;


sid1:=round((2*sr)*4915);
sid1l:=round((2*sl)*4915);
oldsc:=sc;
sc:=sid1+sid1l;
scope[scj]:=sc; scj:=scj+1; if scj>959 then if (oldsc<0) and (sc>0) then scj:=0 else scj:=959;
sid2[0]:=sid1;
sid2[1]:=sid1l;
end;
}
// --------------- 6 poles Chebyshev antialias filter -------------------------

function antialias6(input:double;var ft:Tfiltertable):double;

const gain:double=6.855532108e+07 ;

begin

ft[0]:=ft[1];
ft[1]:=ft[2];
ft[2]:=ft[3];
ft[3]:=ft[4];
ft[4]:=ft[5];
ft[5]:=ft[6];

ft[6]:=input/gain;

ft[7]:=ft[8];
ft[8]:=ft[9];
ft[9]:=ft[10];
ft[10]:=ft[11];
ft[11]:=ft[12];
ft[12]:=ft[13];

ft[13]:=(ft[0]+ft[6])+6*(ft[1]+ft[5])+15*(ft[3]+ft[4])+20*ft[3]
                     + ( -0.7992422456 * ft[7]) + (  4.9534616898 * ft[8])
                     + (-12.8163705530 * ft[9]) + ( 17.7202717200 * ft[10])
                     + (-13.8090381750 * ft[11]) + (  5.7509166299 * ft[12]);

antialias6:=ft[13];
end;

// ------------- sdl sound initializaton -------------------------------------

function sdl_sound_init:integer;

begin
Result:=0;
desired.freq := 192000;                                     // sample rate
desired.format := AUDIO_S16;                               // 16-bit samples
desired.samples := 1920;                                    // samples for 1 callback
desired.channels := 2;                                     // stereo
desired.callback := @AudioCallback;
desired.userdata := nil;

if (SDL_OpenAudio(@desired, @obtained) < 0) then
  begin
  Result:=-2;
  end;
end;

procedure AudioCallback(userdata:pointer; audio:Pbyte; length:integer); cdecl;

var audio2:psmallint;
    s:tsample;
    t:int64;
    k,i,il:integer;
    buf:array[0..25] of byte;
    const aa:integer=0;

begin
audio2:=psmallint(audio);
t:=gettime;

for k:=0 to 3 do
  begin
  aa+=2500;
  if (aa>=siddelay) then
    begin
    aa-=siddelay;
    if fh>-1 then
      begin
      if filetype=0 then
        begin
        il:=fileread(fh,buf,25);
        if skip=1 then  il:=fileread(fh,buf,25);
        if il=25 then
          begin
          for i:=0 to 24 do ramb^[$d400+i]:=buf[i];
          for i:=0 to 15 do times6502[i]:=times6502[i+1];
          t6:=gettime;
          times6502[15]:=0;
          t6:=0; for i:=0 to 15 do t6+=times6502[i];
          time6502:=t6;
          timer1+=siddelay;
          songtime+=siddelay;
          end
        else
          begin
          fileclose(fh);
          fh:=-1;
          songtime:=0;
          timer1:=-1;
          for i:=0 to 6 do raml^[$3500+i]:=0;
          end;
        end
      else
        begin

        for i:=0 to 15 do times6502[i]:=times6502[i+1];
        t6:=gettime;
        jsr6502(256, play);
        times6502[15]:=gettime-t6;
        t6:=0; for i:=0 to 15 do t6+=times6502[i];
        time6502:=t6-15;

        for i:=0 to 25 do buf[i]:= read6502($D400+i);
        for i:=0 to 25 do ramb^[$d400+i]:= buf[i] ;


        timer1+=siddelay;
        songtime+=siddelay;
        end;
      end;
    end;


  s:=sid(1);
  audio2[480*k]:=s[0];
  audio2[480*k+1]:=s[1];

  for i:=480*k+1 to 480*k+479 do
    begin
    s:=sid(0);
    audio2[2*i]:=s[0];
    audio2[2*i+1]:=s[1];
    end;
  end;

sidtime:=gettime-t;
end;





end.

