Source file: /~heha/basteln/8bit/KC85/kcemu/kcload-2009.zip/ALT/KCLOAD.PAS

program KCLOAD;
{$D KC-Load 0.XX (02/02)}
{$R-,S-,I-,Q-,W-,K+,G+,A+}
{$C MOVEABLE PRELOAD PERMANENT}
{$R KCLOAD.RES}
{Wnschenswerte Erweiterungen:
 * OK: Auto-Detect von KC, KC-Turbo, Z1013 und BASICODE
 * Hochpass-Filter: n”!
 * Variable Sampleraten 11, 22, 44 kS/s: n”!
 * Vollautomatik (Einlesen und Abspeichern hintereinanderweg)
 * OK: grne Aussteuerungs-Anzeige
 * Motorschaltspannungs-Untersttzung (KCMOTOR.DRV)
 * OK: Unverfrhte Statusanzeige bei SAVE
 * Mehr als nur 2 Puffer
}

uses
  WinTypes, WinProcs, Win31, MMSystem, CommDlg, ShellApi,
  WUtils;

const
 RegPath='KCEMU\KCLOAD';
 HelpFileName='KCLOAD.HLP';
 UserDllFilter='*.KCL';
 WaveFileName='KCLOAD.WAV';

type
 AModus=(NONE,LOAD,SAVE);
 ACoding=(AUTO,KC,MPM,HS,Z1013,BASICODE);
 AFilter=(NON,KCC,DUM,SSS,Z80,BAC);

var
 hWav: HWaveIn;		{fr Ein- und Ausgabe (erfolgt nie gleichzeitig)}
 Waves: array[0..1] of THandle;	{sp„ter mehr fr bessere "Flssigkeit"}
 Modus: AModus;		{0=frei, 1=LOADing, 2=SAVEteimas}
{Gespeicherte Setup-Daten (Registry), MšSSEN HINTEREINANDER LIEGEN BLEIBEN}
 Retries: Integer;	{Anzahl Wiederholungen beim Lesen}
 Coding: ACoding;	{Modus KC normal, Turbo MPM, Turbo h#s, Z1013}
 Filter: AFilter;	{FilterIndex bei Datei-Auswahl-Dialog}
 WaveVol: ShortInt;	{Lautst„rke-Multiplikator (log.) bei Ausgabe}
 AutoSave: Boolean;	{Schalter fr Automatisches Speichern}
 WaveInDev, WaveOutDev: Integer;
	{Nummer des Ein- bzw. Ausgabeger„tes:
	 -2=KCLOAD.WAV, -1=Wave-Mapper, 0=erste Soundkarte usw.}
 Installed: Boolean;	{zum automatischen Sichern von Einstellungen}
 BytesToWrite: LongInt;
 BufPtr: LongInt;
 AppName: array[0..31] of Char;
 CurWaveHdr: PWaveHdr;	{ZeigerZeiger auf momentan zu prozessierende Daten}
 ByteIndex: Word;	{Index fr momentanes Sample in CurWaveHdr}
 Task: THandle;		{Handle der MMTASK.TSK ("Windows-3.1-Thread")}
 LibInst: THandle;	{Geladene KCL-Bibliothek}
 Back: HBrush;		{Hintergrundpinsel fr Statusfenster (Blau)}
 Green: HBrush;		{Pinsel fr Aussteuer-Anzeige (Dunkelgrn)}
 Font: HFont;		{Schrift fr Statuszeile}
 StatusChars: Integer;	{Anzahl sichtbarer Zeichen in Statuszeile}
 ckRIFF,ck: TMmCkInfo;	{RIFF-Merker zum (Lesen und) Schreiben}

const
 WAVBLK=$1000;		{je grӇer, desto weniger Aussetzer, aber asynchroner}
 MyWav: TPCMWaveFormat=(
  wf:(
   wFormatTag:      WAVE_Format_PCM;
   nChannels:       1;
   nSamplesPerSec:  22050;
   nAvgBytesPerSec: 22050;
   nBlockAlign:     1);
  wBitsPerSample:   8);

 WM_ContinueInit=WM_User+10;
 WM_EndProcess=WM_User+11;
 WM_SetStatus=WM_User+12;
 WM_ReportWaveError=WM_User+13;

type
 TBlock=array[0..127] of Byte;
 TCallProc=procedure;	{Formatabh„ngige Lese/Schreibfunktion}

var
 MainWnd: HWnd;		{Global ist besser im Zugriff!}
 hBuffer: THandle;	{Speicherabbild der Datei, Wachstum durch Verdopplung}
 BufContent: AFilter;	{vom Leseprogramm gesetzter Puffer-Inhalt}
 Amp: ShortInt;		{Momentanwert (also Elongation!)}
 WavePeak: Integer;	{Maximale Amplitude eines Wave-Blocks beim Lesen}
 StatusBuf: TS31;	{Statuszeilen-Text}

{*************************************}
{** Prozeduren zur Wave-Ein/Ausgabe **}
{*************************************}

procedure FindPeak(P:PChar; len:Word);
 begin
  WavePeak:=0;
  while len<>0 do begin
   WavePeak:=max(WavePeak,abs(ShortInt(Byte(P^)-$80)));
   Inc(P);
   Dec(len);
  end;
  InvalidateRect(GetDlgItem(MainWnd,19),nil,false);
 end;

function GetSize:LongInt;
 begin
  case Modus of
   LOAD: GetSize:=BufPtr;
   SAVE: GetSize:=BytesToWrite-BufPtr;
  end;
 end;

function GetData(P:PChar; Size:Integer):Integer;
 var
  Buf: PChar;
 begin
  Buf:=GlobalLock(hBuffer);
  IncHPL(Buf,BufPtr);
  if Size>BytesToWrite-BufPtr then Size:=BytesToWrite-BufPtr;
  hmemcpy(P,Buf,Size);
  Inc(BufPtr,Size);
  GetData:=Size;
  GlobalUnlock(hBuffer);
 end;

procedure EndProcess1(OK:Boolean); forward;

procedure AddData(P:PChar; Size:Integer);
 var
  Buf: PChar;
 begin
  if BufPtr+Size>GlobalSize(hBuffer) then begin
   hBuffer:=GlobalReAlloc(hBuffer,GlobalSize(hBuffer) shl 1,0);
   if hBuffer=0 then EndProcess1(false);	{sollte nie passieren}
  end;
  Buf:=GlobalLock(hBuffer);
  IncHPL(Buf,BufPtr);
  hmemcpy(Buf,P,Size);
  Inc(BufPtr,Size);
  GlobalUnlock(hBuffer);
 end;

procedure ProcessBlock;
{Kontext: MMTASK.TSK}
 var
  Msg: TMsg;
 begin
  with CurWaveHdr^ do case Modus of
   LOAD: begin
    if WaveInDev=-2 then begin
     LongRec(dwBytesRecorded).Lo:=
       mmioRead(hWav,lpData,LongRec(dwBufferLength).Lo);
     if LongRec(dwBytesRecorded).Lo=0 then EndProcess1(false);
     PeekMessage(Msg,0,0,0,PM_Remove);	{Windows zum Zug kommen lassen}
     if Msg.message=WM_Quit then EndProcess1(false);
    end else begin
     WaveInAddBuffer(hWav,CurWaveHdr,sizeof(TWaveHdr));	{leeren Puffer hinein}
     if not GetMessage(Msg,0,0,0) then EndProcess1(false);
					{gibt Rechenzeit frei}
{$IFOPT D+} if Msg.message<>MM_WIM_Data then asm int 3 end; {$ENDIF}
     CurWaveHdr:=Pointer(Msg.lParam);	{Neuer Block, gefllt mit Daten, steht bereit}
    end;
    FindPeak(CurWaveHdr^.lpData,CurWaveHdr^.dwBytesRecorded);
   end;
   SAVE: begin
    if WaveOutDev=-2 then begin
     if mmioWrite(hWav,CurWaveHdr^.lpData,
       LongRec(CurWaveHdr^.dwBufferLength).Lo)<>
       LongRec(CurWaveHdr^.dwBufferLength).Lo
     then EndProcess1(false);
     PeekMessage(Msg,0,0,0,PM_Remove);	{Windows zum Zug kommen lassen}
     if Msg.message=WM_Quit then EndProcess1(false);
    end else begin
     WaveOutWrite(hWav,CurWaveHdr,sizeof(TWaveHdr));	{vollen Puffer hinein}
     if not GetMessage(Msg,0,0,0) then EndProcess1(false);
					{gibt Rechenzeit frei}
{$IFOPT D+} if Msg.message<>MM_WOM_Done then asm int 3 end; {$ENDIF}
     CurWaveHdr:=Pointer(Msg.lParam);	{Geleerter Puffer}
	{Jetzt erst Status setzen:}
     if PChar(CurWaveHdr)[sizeof(TWaveHdr)+WAVBLK]<>#0 then begin
      lstrcpy(StatusBuf,PChar(CurWaveHdr)+sizeof(TWaveHdr)+WAVBLK);
      {Nicht doppelt in Warteschlange stellen (z.B. langsamer Rechner)}
      if not PeekMessage(Msg,MainWnd,WM_SetStatus,WM_SetStatus,
	PM_NoYield or PM_NoRemove)
      then PostMessage(MainWnd,WM_SetStatus,0,0);
      PChar(CurWaveHdr)[sizeof(TWaveHdr)+WAVBLK]:=#0;
     end;
    end;
   end;
  end;
  ByteIndex:=0;		{Lese- oder Schreibzeiger}
 end;

function MakeWaveBlock(var M:THandle):PWaveHdr;
{Erzeugt einen Speicherblock, bestehend aus WaveHdr und
 einem direkt darauf folgenden Datenpuffer.
 Benutzt globale Variablen hWav, Modus, WaveInDev und WaveOutDev
 wegen der notwendigen "Pr„paration" dieser Puffer.
 Beim Speichern "h„ngt" an diesem Puffer auch noch Platz fr
 einen Status-String, damit dieser erst bei Wave-Ausgabe und nicht
 schon zu seiner Vorbereitung erscheint.}
 var
  WH: PWaveHdr;
 begin
  M:=GlobalAlloc(GHND or GMEM_Share,sizeof(TWaveHdr)+WAVBLK+
    IfThenElse(Modus=SAVE,32,0));
  if M=0 then EndProcess1(false);
  WH:=GlobalLock(M);
  WH^.lpData:=PChar(WH)+sizeof(TWaveHdr);
  WH^.dwBufferLength:=WAVBLK;
  case Modus of
   LOAD: if WaveInDev>-2 then WaveInPrepareHeader(hWav,WH,sizeof(TWaveHdr));
   SAVE: if WaveOutDev>-2 then WaveOutPrepareHeader(hWav,WH,sizeof(TWaveHdr));
  end;
  MakeWaveBlock:=WH;
 end;

procedure FreeWaveBlock(var M:THandle);
{Gegenteil von oben}
 var
  WH: PWaveHdr;
 begin
  if M=0 then exit;	{Nichts tun, falls gar nicht angefordert}
  GlobalUnlock(M);	{der Block war die ganze Zeit gelockt!}
  if hWav<>0 then begin
   WH:=GlobalLock(M);	{Pointer beschaffen}
   case Modus of
    LOAD: if WaveInDev>-2 then WaveInUnprepareHeader(hWav,WH,sizeof(TWaveHdr));
    SAVE: if WaveOutDev>-2 then WaveOutUnprepareHeader(hWav,WH,sizeof(TWaveHdr));
   end;
   GlobalUnlock(M);
  end;
  M:=GlobalFree(M);
 end;

procedure EndProcess1(OK:Boolean);
{Kontext: MMTASK.TSK, Funktion beendet Task}
 begin
  case Modus of
   LOAD: begin		{Lesen vom Band oder von der WAV-Datei}
    if WaveInDev<>-2 then begin
     WaveInReset(hWav);	{Restliche (leere) Puffer "ausspucken"}
     WaveInClose(hWav);	{Ger„t schlieáen}
    end else mmioClose(hWav,0);
    FindPeak(nil,0);	{Anzeige rcksetzen (lassen)}
   end;
   SAVE: begin		{Schreiben aufs Band oder in die WAV-Datei}
    if OK and (ByteIndex<>0) then begin
     LongRec(CurWaveHdr^.dwBufferLength).Lo:=ByteIndex;
     ProcessBlock;
    end;
    if WaveOutDev<>-2 then begin
     if OK then begin
      while WaveOutClose(hWav)<>0	{=WAVERR_StillPlaying}
      do MMTaskBlock(Task);
     end else begin
      WaveOutReset(hWav);	{im Abbruch-Fall}
      WaveOutClose(hWav);
     end;
     hWav:=0;
    end else begin
     if OK then begin		{WAV-Datei patchen lassen}
      if mmioAscend(hWav,@ck,0)<>0 then OK:=false
      else if mmioAscend(hWav,@ckRIFF,0)<>0 then OK:=false;
     end;
     if mmioClose(hWav,0)<>0 then OK:=false;
     if not OK then mmioOpen(WaveFileName,nil,MMIO_Delete);
    end;
   end;
  end{case};
  FreeWaveBlock(Waves[0]);
  FreeWaveBlock(Waves[1]);
  PostMessage(MainWnd,WM_EndProcess,Word(OK),0);
  halt;
 end;

function memcmpw(var p1, p2; vlen: Word):Boolean; assembler;
{Speicher-Vergleich, wortweise}
 asm	push	ds
	 lds	si,[p2]
	 les	di,[p1]
	 mov	cx,vlen
	 mov	al,FALSE
	 cld
	 rep	cmpsw	{[SI]-[DI]}
	pop	ds
	jnz	@@e
	inc	al	{TRUE}
@@e:
 end;

procedure WaveInTask(CallProc:TCallProc);far;
{Kontext: MMTASK.TSK, Funktion beendet Task und kehrt nicht zurck}
 label
  err,errfile;
 var
  I: Integer;
  ThisWav: TPCMWaveFormat;
 begin
  asm mov ax,seg @data; mov ds,ax; {$IFOPT D+} int 3 {$ENDIF} end;
  if WaveInDev=-2 then begin
   I:=mmsyserr_InvalHandle;	{5}
   hWav:=mmioOpen(WaveFileName,nil,
     MMIO_Read or MMIO_AllocBuf or MMIO_DenyNone);
   if hWav=0 then goto err;
   I:=mmsyserr_NotSupported;	{8}
   if mmioDescend(hWav,@ckRIFF,nil,0)<>0 then goto errfile;
   if ckRIFF.ckID<>FOURCC_RIFF then goto errfile;
   if ckRIFF.fccType<>$45564157 then goto errfile;	{'WAVE'}
   ck.ckID:=$20746D66;					{'fmt '}
   if mmioDescend(hWav,@ck,@ckRIFF,MMIO_FindChunk)<>0 then goto errfile;
   if ck.ckSize<sizeof(TPCMWaveFormat) then goto errfile;
   if mmioRead(hWav,PChar(@ThisWav),sizeof(TPCMWaveFormat))
     <>sizeof(TPCMWaveFormat) then goto errfile;
   if mmioAscend(hWav,@ck,0)<>0 then goto errfile;
   if not memcmpw(ThisWav,MyWav,sizeof(TPCMWaveFormat) div 2)
   then goto errfile;
   ck.ckID:=$61746164;					{'data'}
   if mmioDescend(hWav,@ck,@ckRIFF,MMIO_FindChunk)<>0 then goto errfile;
   CurWaveHdr:=MakeWaveBlock(Waves[0]);
  end else begin
   I:=Integer(WaveInOpen(@hWav,Word(WaveInDev),@MyWav.wf,
     MMGetCurrentTask,0,Callback_Task));
   if I<>0 then goto err;
   MMTaskBlock(Task);		{MM_WIM_Open entfernen}
   WaveInAddbuffer(hWav,MakeWaveBlock(Waves[0]),sizeof(TWaveHdr));
   CurWaveHdr:=MakeWaveBlock(Waves[1]);
   ByteIndex:=$FFFF;
   WaveInStart(hWav);
  end;
  CallProc;
  EndProcess1(true);
errfile:
  mmioClose(hWav,0);
err:
  PostMessage(MainWnd,WM_ReportWaveError,I,0);
  halt;				{Prozess MMTASK.TSK beenden (nicht KCLOAD)}
 end;

procedure WaveOutTask(CallProc:TCallProc);far;
{Kontext: MMTASK.TSK, Funktion beendet Task und kehrt nicht zurck}
 label
  err,errfile;
 var
  I: Integer;
 begin
  asm mov ax,seg @data; mov ds,ax; {$IFOPT D+} int 3 {$ENDIF}  end;
  if WaveOutDev=-2 then begin
   I:=mmsyserr_InvalHandle;		{5}
   hWav:=mmioOpen(WaveFileName,nil,
     MMIO_Write or MMIO_AllocBuf or MMIO_Create or MMIO_DenyNone);
   if hWav=0 then goto err;
   I:=mmsyserr_NotSupported;		{8 - besser: cant_write}
   ckRIFF.fccType:=$45564157;				{'WAVE'}
   if mmioCreateChunk(hWav,@ckRIFF,MMIO_CreateRIFF)<>0 then goto errfile;
   ck.ckID:=$20746D66;					{'fmt '}
   ck.ckSize:=sizeof(TPCMWaveFormat);
   if mmioCreateChunk(hWav,@ck,0)<>0 then goto errfile;
   if mmioWrite(hWav,PChar(@MyWav),sizeof(TPCMWaveFormat))
     <>sizeof(TPCMWaveFormat) then goto errfile;
   if mmioAscend(hWav,@ck,0)<>0 then goto errfile;
   ck.ckID:=$61746164;					{'data'}
   if mmioCreateChunk(hWav,@ck,0)<>0 then goto errfile;
  end else begin
   I:=Integer(WaveOutOpen(@hWav,Word(WaveOutDev),@MyWav.wf,
     MMGetCurrentTask,0,Callback_Task));
   if I<>0 then goto err;
   MMTaskBlock(Task);		{MM_WOM_Open entfernen}
   PostAppMessage(MMGetCurrentTask,MM_WOM_Done,hWav,
     LongInt(MakeWaveBlock(Waves[1])));
  end;
  CurWaveHdr:=MakeWaveBlock(Waves[0]);
  ByteIndex:=0;
  CallProc;
  EndProcess1(true);
errfile:
  mmioClose(hWav,0);
  mmioOpen(WaveFileName,nil,MMIO_Delete);
err:
  PostMessage(MainWnd,WM_ReportWaveError,I,0);
  halt;
 end;

{**********************************************}
{** Formatabh„ngiges Lesen: Anzeige-Routinen **}
{**********************************************}

function LoadStr31(D,S:PChar):Integer;
 begin
  if PtrRec(S).sel=0
  then LoadStr31:=LoadString(Seg(HInstance),LongRec(S).lo,D,32)
  else begin
   lstrcpyn(D,S,32);
   LoadStr31:=lstrlen(D);
  end;
 end;

function SetStat_LOAD(S:PChar):Integer;
 begin
  SetStat_LOAD:=LoadStr31(StatusBuf,S);
  PostMessage(MainWnd,WM_SetStatus,0,0);
 end;

function SetStat_SAVE(S:PChar):Integer;
 begin
  SetStat_SAVE:=LoadStr31(PChar(CurWaveHdr)+sizeof(TWaveHdr)+WAVBLK,S);
 end;

function Char_KC2ANSI:Char; assembler;
{Zeichen-Bereich begrenzen, 6 Zeichencodes (vornehmlich Umlaute) austauschen.
 Liefert auáerdem Flags vom Vergleich des Zeichens mit ' '!}
 asm	and	al,7Fh
	cmp	al,5Ch
	mov	ah,7Ch		{Pipe-Symbol}
	je	@@2
	cmp	al,5Dh
	mov	ah,0ACh		{Negations-Zeichen}
	je	@@2
	cmp	al,7Bh
	mov	ah,0E4h		{„}
	je	@@2
	cmp	al,7Ch
	mov	ah,0F6h		{”}
	je	@@2
	cmp	al,7Dh
	mov	ah,0FCh		{}
	je	@@2
	cmp	al,7Eh
	mov	ah,0DFh		{á}
	jne	@@e
@@2:	xchg	ah,al
@@e:	cmp	al,' '
	ja	@@1
	mov	al,' '
@@1:
 end;

function GetFileNameKC(S,buf:PChar):integer;assembler;
{Dateiname von Pufferzeiger buf (hier: 11 Bytes, mit Leerzeichen aufgefllt)
 nach S (als ASCIIZ 8.3) extrahieren,
 bei den typischen BASIC-Dateinamen wird die vorn liegende Extension
 nach hinten gebracht.
 Leerzeichen und ungltige Zeichen werden NOCH NICHT aus dem String entfernt,
 das muá ein nachfolgendes Programm (je nach Vorhandensein einer LFN-API) tun.
 Hat der Name keine Erweiterung, gibt's auch keinen Punkt.
 Liefert Anzahl der Zeichen in S}
 asm	cld
	push	ds
	 les	di,[S]
	 lds	si,[Buf]
	 mov	dx,di
	 xor	bx,bx
	 mov	cx,8		{8 Zeichen}
	 lodsb			{1. Zeichen}
	 test	al,al		{Endung am Anfang?}
	 jns	@@1
	 mov	bx,11		{Kennung}
	 add	si,2		{mit dem 4. Zeichen loslegen}
@@l1:	 lodsb
@@1:	 call	Char_KC2ANSI
	 stosb			{Alle (auch verbotene W31) in Puffer}
	 jbe	@@2
	 mov	dx,di		{Vorrcken bei nicht-leeren Zeichen}
@@2:	 loop	@@l1
	 mov	di,dx
	 mov	al,'.'
	 stosb			{jetzt kommt die Extension!}
	 sub	si,bx		{Korrektur, wenn Extension vorn war!}
	 mov	cx,3
@@l2:	 lodsb
	 call	Char_KC2ANSI
	 stosb
	 jbe	@@3
	 mov	dx,di		{Vorrcken bei nicht-leeren Zeichen}
@@3:	 loop	@@l2
	 mov	di,dx
	 xor	al,al
	 stosb			{Terminierende Null}
	 xchg	dx,ax
	 sub	ax,word ptr [S]
@@e:	pop	ds
 end;

function GetFileNameZ80(S,buf:PChar):integer; assembler;
{Extrahiert Z1013-Headersave-Dateiname - nachlaufende Leerzeichen werden
 abgeschnitten. Liefert Anzahl der Zeichen in S}
 asm	cld
	push	ds
	 les	di,[S]
	 lds	si,[buf]
	 mov	cx,16		{16 Zeichen k”nnen's sein!}
	 add	si,cx
	 mov	dx,di		{Merker fr letztes Nicht-Leerzeichen}
@@l:	 lodsb
	 cmp	al,' '
	 ja	@@1
	 mov	al,' '
@@1:	 stosb
	 jbe	@@2
	 mov	dx,di		{"Ein nicht-leeres Zeichen" merken}
@@2:	 loop	@@l
	 mov	di,dx
	 xor	al,al
	 stosb
	 xchg	dx,ax
	 sub	ax,word ptr [S]	{Anzahl Zeichen liefern}
	pop	ds
 end;

{-Bin-Laden-von-Kassette-----------------------------------------------------}
procedure ReadB;
{Liest das n„chste Sample als vzb. 8-Bit-Wert zur globalen Variable "Amp"}
{Kontext: MMTASK.TSK}
 begin
  with CurWaveHdr^ do begin
   if ByteIndex>=LongRec(dwBytesRecorded).Lo
   then ProcessBlock;		{N„chsten Block einlesen}
  end;				{CurWaveHdr ge„ndert, WITH beenden!!!}
  with CurWaveHdr^ do begin
   Amp:=Integer(lpData[ByteIndex])-$80;
   Inc(ByteIndex);
  end;
 end;

function ReadSwing1:Integer;
{Liest Samples bis zum n„chsten Nulldurchgang und liefert die Sample-Anzahl,
 somit die Zeit fr eine halbe Schwingung}
{Kontext: MMTASK.TSK}
 var
  W: Integer;
 begin
  W:=0;
  if Amp<0
  then repeat ReadB; Inc(W); until Amp>=0
  else repeat ReadB; Inc(W); until Amp<0;
  ReadSwing1:=W;
 end;

function ReadSwing2: Integer;
{Liefert die Zeit in Samples fr eine ganze Schwingung}
{Kontext: MMTASK.TSK}
 begin
  ReadSwing2:=ReadSwing1+ReadSwing1;
 end;

{**************************************}
{** Formatabh„ngiges Lesen: Routinen **}
{**************************************}

type
 TBL=record		{Blocklese-Struktur}
  expect: Word;		{Erwartete Blocknummer}
  readbl: Word;		{Gelesene Blocknummer}
  showch: Char;		{Anzeige-Zeichen}
  ok: Boolean;		{Block OK oder nicht}
  retry: Integer;	{Wiederholungs-Z„hler (aufw„rts!)}
  spos1: Integer;	{String-Position: ! stehenlassen}
  spos2: Integer;	{String-Position: ? stehenlassen}
  t: PChar;		{String-Template}
  tl: Integer;		{Ausgabe-L„nge pro String-Template}
  s: TS31;		{String-Puffer}
 end;

procedure InitBL(var BL:TBL; t:PChar; tl:Integer);
{BL-Struktur initialisieren}
 begin
  FillChar(BL,sizeof(BL),0);
  BL.t:=t;
  BL.tl:=tl;
  FillChar(BL.s,31,' ');
 end;

procedure HandleBL(var BL:TBL);
{Gelesenen Block behandeln; der Aufrufer muss die Elemente
 expect, readbl und ok geeignet setzen!}
 begin
  with BL do begin
   spos2:=tl;		{zun„chst Platz lassen}
   if readbl=expect then begin
    if ok then begin
     showch:='>';
    end else begin
     showch:='?';
     Inc(retry);
     if (retry>=Retries) or (WaveInDev=-2) then begin
      ok:=true;
      showch:='!';
     end;
    end;
    if ok then begin
     spos2:=0;
     retry:=0;
    end;
   end else begin
    showch:='*';
   end;
   wvsprintf(s+spos1+spos2,t,readbl);
   if (showch='!') and (spos1<StatusChars-2*tl)
   then Inc(spos1,tl);	{(einige) Ausrufezeichen-Bl”cke stehen lassen}
   SetStat_LOAD(s);
  end;
 end;

procedure CatHex(S:PChar; W:Word);
{H„ngt eine vierstellige Hexzahl an S an, solange S, mit 31 Zeichen
 angenommen, noch nicht voll ist.}
 var
  I:Integer;
 begin
  I:=lstrlen(S);
  if I>31-5 then exit;	{kein Platz: Zahl weglassen!}
  wvsprintf(S+I,' %04X',W);
 end;

function HandleMPMHeader(buf:TBlock):LongInt;
{Zeigt den KC85-Header in der Statuszeile und berechnet die Dateil„nge}
 function IsBASICProg: Boolean;
  var
   B: Byte;
  begin
   IsBASICProg:=false;
   B:=buf[0];
   if (B-$D3) and not 4 <>0 then exit;
   if B<>buf[1] then exit;
   if B<>buf[2] then exit;
   IsBASICProg:=true;
  end;

 function IsBASICField: Boolean;
  var
   B: Byte;
  begin
   IsBASICField:=false;
   B:=buf[0];
   if (B-$D3) and not 4 >3 then exit;	{SSS,TTT,UUU, WWW,XXX,YYY +80h}
   if B<>buf[1] then exit;
   if B<>buf[2] then exit;
   IsBASICField:=true;
  end;

 function IsMCProg: Boolean;
  begin
   IsMCProg:=buf[16] in [2..10];
  end;

 var
  s:TS31;
 begin
  HandleMPMHeader:=MaxLongInt;
  GetFileNameKC(s,PChar(@buf));
  if IsBASICProg then begin
   HandleMPMHeader:=PWord(@buf[11])^+LongInt(14);
   CatHex(s,PWord(@buf[11])^);
   BufContent:=SSS;	{als BASIC speichern lassen}
  end else if IsBASICField then begin
   BufContent:=SSS;		{als BASIC speichern lassen}
  end else if IsMCProg then begin
   HandleMPMHeader:=PWord(@buf[19])^-PWord(@buf[17])^+LongInt(128);
   BufContent:=KCC;		{als MC speichern lassen}
   CatHex(s,PWord(@buf[17])^);
   CatHex(s,PWord(@buf[19])^);
   if buf[16]>2 then CatHex(s,PWord(@buf[21])^);
  end else if PLongInt(PChar(@buf)+12)^=0 then BufContent:=KCC
  else BufContent:=SSS;	{wahrscheinlich! - aber ziemlich sicher}
  SetStat_LOAD(s);	{msste normalerweise in eine andere Statuszeile!}
 end;

{KC-Format:
 Die Angaben im KC-Handbuch und (z.Z.) KCEMU-Hilfe sind FALSCH!
 Ursache: Die Mhlh„user Programmierer haben die Latenzzeit der
 Interruptserviceroutine unterschlagen.
 Z.B. Vorton: TC=$2F=47->1179Hz(848æs), es sind aber ca. 1060Hz(943æs).
 In dieser Zeit wird der Timer 2x per ISR neu programmiert, 943-848=95æs,
 pro Aufruf also 47.5æs->83 Takte.
 Der IM2 verbraucht 19 Takte, in der ISR vergehen 11+7+11+19+11 Takte,
 macht zusammen 78 Takte. Da die Warteschleife aus einer Schleife
 mit 19+4+12 Takten besteht, ist die mittlere Latenz 5 Takte
 (wegen mittlerer Befehlsausfhrungszeit von 11 Takten). Kommt genau hin!
 (Dummerweise wird die CTC rckgesetzt, eigentlich Schwachsinn!)

 0-Bit: Vollschwingung  1950 Hz (11 Samples,  7-16)
 1-Bit: Vollschwingung  1050 Hz (21 Samples, 17-26)
 Trennzeichen: Vollschw. 557 Hz (39 Samples, 27-50)

 Byte: Bit0, Bit1, ... Bit7, Trennzeichen (TZ)

 Block: Vorton (>160 1-Bits), TZ, Byte (BlockNr), 128 Bytes, Byte (Summe)

 Datei: Vorblock (Nr. 0 oder 1), n Datenbl”cke, Schlussblock (Nr. FF)

 Vorblock: 11 Byte Name, 117 Byte verschieden verwendet oder Datenbytes

 Schlussblock: Kann Daten enthalten

 Idiotien:
 * Keine vernnftige Definition des Vorblock-Inhaltes, verschiedene
   Auslegung fr BASIC oder MC, unsichere Block-Nr.
 * Block-Nr. FF kann, muss aber nicht Schlussblock sein; Auslegung
   verschieden: VERIFY und LOAD machen Schluss, BASIC l„dt weiter
   und interessiert sich mitnichten fr den FF-Block
   (dieser enth„lt keine Daten und wird gar nicht gelesen)
   KC87-BASIC generiert keinen FF-Block
   Dateien >31K haben einen FF-Block mittendrin
 * Schwer behebbare Differenzen zwischen Kassetten- und Disketten-
   Aufzeichnung (das mache man erst mal dem Normalverbraucher klar...)
}
procedure ReadDataKCC; far;
{Kontext: MMTASK.TSK}

 function Bytein:Byte;
  var
   I,W:Integer;
   B:Byte;
 begin
  for I:=0 to 7 do begin
   w:=ReadSwing2;
   asm shr [B],1 end;
   if w>=17 then asm or [B],80h end;	{kompakter als "B:=B or $80"}
  end;
  ReadSwing2;
  Bytein:=B;
 end;

 function ReadBlock(var BlkNr:Byte; var Buffer:TBlock; Vorton:Integer):Boolean;
  label step1,step2;
  var
   I,W:Integer;
   B,Sum:Byte;
  begin
   ReadBlock:=false;
 {Schritt 1: Vorton erkennen und aufsynchronisieren}
step1:
   I:=Vorton;
   {Vorton:=16;			{Wiederholungen mit krzerem Einlauf?}
   repeat
    W:=ReadSwing2;
    if W<17 then goto step1;
    if W>26 then goto step1;
    Dec(I);
   until I=0;
 {Schritt 2: 1. Trennzeichen holen}
step2:
   repeat
    W:=ReadSwing1;
    if W>25 then goto step1;	{Aussetzer im Vorton}
    if W<8 then goto step1;	{St”rnadel im Vorton}
   until W>13;
   Inc(W,ReadSwing1);
   if W<27 then goto step2;
   if W>50 then goto step2;	{2. halbes Trennzeichen muá folgen!}
 {Schritt 3: Bytes lesen}
   BLKNr:=ByteIn;
   Sum:=0;
   for I:=0 to 127 do begin
    B:=ByteIn;
    Inc(Sum,b);
    Buffer[I]:=b;
   end;
   If Sum=ByteIn then ReadBlock:=true;
  end;


 label nochmal;
 var
  BL:TBL;
  buf: TBlock;
  L:LongInt;

 begin
  SetStat_LOAD(PChar(17));		{'KC85,KC87'}
  InitBL(BL,' %02X%c',4);
  repeat
   BL.ok:=ReadBlock(Byte(BL.readbl),buf,300);
   if BL.readbl in [0,1]
   then BL.expect:=BL.readbl
   else BL.expect:=$FFFF;	{"falscher Block" erzwingen}
   HandleBL(BL);
  until BL.ok;
  AddData(PChar(@Buf),sizeof(buf));

  L:=HandleMPMHeader(buf);

  repeat
   Inc(Byte(BL.expect));
nochmal:
   BL.ok:=ReadBlock(Byte(BL.readbl),buf,16);
   if (BL.readbl=$FF)		{Schlussblock: gekommen?}
   and (BL.ok)			{und in Ordnung?}
   and (BL.expect<>$FF)		{und nicht erwartet?}
   and (L=MaxLongInt)		{Datenmenge: unbekannt?}
   then begin
    BL.expect:=$FF;		{Sei erwarteter Block}
    L:=0;			{Datenvolumen erfllt}
   end;
   HandleBL(BL);
   if not BL.ok then goto nochmal;
   AddData(PChar(@Buf),sizeof(buf));
  until GetSize>=L;
 end;

{MPM-Turbo-Format:
 Vorton: Vollwelle 2200 Hz (10 Samples)
 Trennz: Vollwelle  900 Hz (24 Samples)
 0-Bit:  Halbwelle 2200 Hz ( 5 Samples, 2..8)
 1-Bit:  Halbwelle  900 Hz (12 Samples, 9..15)

 Byte: Bit0, Bit1, ... Bit7

 Block: Vorton(70h..1000h) - Trennzeichen - 130 Bytes

 weiter wie KC-Format

 In grauer Vorgeschichte habe ich MPM-Turbo umgeschrieben, damit es
 krzer werde und habe die Geschichte mit der Interrupt-Latenz
 bersehen, so dass verschiedene Ergebnisse zu Tage kommen!
 Original Latenz: (8+12)/4+19+4+7+11+4+11 = 61 Takte (Jitter: 11)
 Meine Latenz: (19+4+12)/6+19+11+7+11+19+11 = 84 Takte (Jitter: 18)
 0-Bit: ZK 15h->336 Takte (Halbwelle), 2200 Hz vs. 2100 Hz
 1-Bit: ZK=39h->912 Takte (Halbwelle), 900 Hz vs. 880 Hz
 Vorton = viele 0-Bits, Trennzeichen = 2 1-Bits
 Zum Glck bleiben die Frequenzen noch detektierbar...
}
procedure ReadDataMPMTurbo; far;
{Kontext: MMTASK.TSK}

 function Bytein:Byte; assembler;
  asm
	mov	ah,8
@@l:	push	ax
	 call	ReadSwing1
	 cmp	ax,9
	 cmc
	pop	ax
	rcr	al,1
	dec	ah
	jnz	@@l
  end;

 function ReadBlock(var BlkNr:Byte; var Buffer:TBlock; Vorton:Integer):Boolean;
  label Try;
  var
   I,W:Integer;
   B,Sum:Byte;
  begin
   ReadBlock:=false;
 {Schritt 1: Vorton erkennen und aufsynchronisieren}
Try:
   for I:=1 to Vorton do begin
    W:=ReadSwing1;
    if W>=10 then begin
     I:=0;
     continue;
    end;
   end;
 {Schritt 2: 1. Trennzeichen holen}
   for I:=1 to 2 do begin
    W:=ReadSwing1;
    if W<10 then begin
     if I=2 then Goto Try else I:=0;
     continue;
    end;
   end;
 {Schritt 3: Bytes lesen}
   BLKNr:=ByteIn;
   Sum:=0;
   for I:=0 to 127 do begin
    B:=ByteIn;
    Inc(Sum,B);
    Buffer[I]:=B;
   end;
   If Sum=ByteIn then ReadBlock:=true;
  end;


 label nochmal;
 var
  BL:TBL;
  buf: TBlock;
  L:LongInt;

 begin
  SetStat_LOAD(PChar(18));		{'Turbo MPM'}
  InitBL(BL,' %02X%c',4);
  repeat
   BL.ok:=ReadBlock(Byte(BL.readbl),buf,300);
   if BL.readbl in [0,1]
   then BL.expect:=BL.readbl
   else BL.expect:=$FFFF;	{"falscher Block" erzwingen}
   HandleBL(BL);
  until BL.ok;
  AddData(PChar(@Buf),sizeof(buf));

  L:=HandleMPMHeader(buf);

  repeat
   Inc(Byte(BL.expect));
nochmal:
   BL.ok:=ReadBlock(Byte(BL.readbl),buf,16);
   if (BL.readbl=$FF)		{Schlussblock: gekommen?}
   and (BL.ok)			{und in Ordnung?}
   and (BL.expect<>$FF)		{und nicht erwartet?}
   and (L=MaxLongInt)		{Datenmenge: unbekannt?}
   then begin
    BL.expect:=$FF;		{Sei erwarteter Block}
    L:=0;			{Datenvolumen erfllt}
   end;
   HandleBL(BL);
   if not BL.ok then goto nochmal;
   AddData(PChar(@Buf),sizeof(buf));
  until GetSize>=L;
 end;

{h#s-Turbo-Format:
 Nach 2 Bl”cken im normalen KC-Format, die den 128-Byte-Bootstrap-Loader
 enthalten, der ab B880h im Modulsteuerwortspeicher landet (und dort leider
 die Steuerbytes fr den Diskettenaufsatz ruiniert), kommt der Speicherabzug
 oder das BASIC-Programm (gemeinhin auch ein Speicherabzug).

 Vorton: Vollschwingung  735 Hz (30 Samples)
 Trennz: Halbschwingung 1200 Hz ( 9 Samples)
 0-Bit:  Halbschwingung 5500 Hz ( 4 Samples)
 1-Bit:  Halbschwingung 2400 Hz ( 9 Samples)

 Byte: Bit7, Bit6, ... Bit0

 Datei: Vorton (512) - Trennzeichen - n Bytes

 (n sowie die Prfsumme stehen im beim Speichern zusammengestellten
  Bootstrap-Loader)
 Der Aufbau des Bootstrap-Laders ist meine Dokumentationsschw„che;
 ich konnte nie mehr das alles entscheidende Listing auftreiben!
}
procedure ReadDataHSTurbo; far;
{Kontext: MMTASK.TSK}
 var
  S: array[0..31] of Char;
  I,W: integer;
  Sum,B:Byte;
 begin
  ReadDataKCC;
  if GetSize<>$100 then EndProcess1(false);
  SetStat_LOAD(PChar(19));		{'Turbo h#s'}
  BufContent:=NON;		{hier: HS-Turbo ist gemeint!}
{fehlt: Ausgeben der Adressen, Bestimmung der Lade-L„nge}
  for I:=0 to 40 do begin
   W:=ReadSwing1;
   if W<12 then begin I:=0;continue;end;
  end;
  repeat
  until ReadSwing1<12;
  Sum:=0;
  Repeat
   for I:=0 to 7 do begin
    w:=ReadSwing1;
    B:=B SHL 1;
    if w>20 then begin AddData(PChar(@Sum),1);exit;end;
    if w>6 then B:=B or 1;
   end;
   inc(Sum,B);
   AddData(PChar(@B),1);
  until false
{fehlt:
    if pBuf[$D8]<>pBuf[BufPtr-1] then
	if MBox1(MainWnd,111,SFile)=IDCANCEL then exit;}
 end;

{Z1013-Format:
 Vorton: Halbschwingung  650 Hz (17 Samples) Diskriminator:
 Trennz: Vollschwingung 1400 Hz (16 Samples)
 0-Bit:  Halbschwingung 1200 Hz ( 9 Samples)
 1-Bit:  Vollschwingung 2400 Hz ( 9 Samples) Diskriminator: 6

 Wort: Bit0, Bit1, ... Bit15

 Block: Vorton (14..2000) - Trennz - Wort (Zieladr.) - 16 Wort -
	Wort (Summe ber die vorhergehenden 17(!) Worte)

 Datei: HEADERSAVE-Vorblock (bel. Zieladresse), n Datenbl”cke

 HEADERSAVE-Vorblock (leider optional, aber sehr verbreitet):
	WORD aadr,eadr,sadr; CHAR creator[6]; BYTE type; BYTE magic[3];
	CHAR filename[16]
}
procedure ReadDataZ1013; far;
{Kontext: MMTASK.TSK}

 type
  TBlk=array[0..15] of Word;

 function Wordin:Word;
  var
   I:Integer;
   W:Word;
 begin
  for I:=0 to 15 do begin
   asm shr [W],1 end;
   if ReadSwing1>6 then asm or byte ptr [W+1],80h end else ReadSwing1;
  end;
  Wordin:=W;
 end;

 function ReadBlock(var BlkNum:Word; var Buffer:TBlk; VLen:Integer):Boolean;
  label step1;
  var
   I:Integer;
   W,Sum:Word;
  begin
   ReadBlock:=false;
 {Schritt 1: Vorton erkennen und aufsynchronisieren}
step1:
   I:=VLen;
   repeat
    W:=ReadSwing1;
    if W<12 then goto step1;
    if W>22 then goto step1;
    Dec(I);
   until I=0;
 {Schritt 2: 1. Trennzeichen holen}
   repeat
    W:=ReadSwing1;
    if W>22 then goto step1;	{Aussetzer im Vorton}
    if W<5 then goto step1;	{St”rnadel im Vorton}
   until W<12;			{ein halbes Trennzeichen}
   W:=ReadSwing1;
   if W<5 then goto step1;
   if W>=12 then goto step1;	{2. halbes Trennzeichen muá folgen!}
 {Schritt 3: Bytes lesen}
   BlkNum:=Wordin;
   Sum:=BlkNum;
   for I:=0 to 15 do begin
    W:=WordIn;
    Sum:=Sum+W;
    Buffer[I]:=W;
   end;
   If Sum=WordIn then ReadBlock:=true;
  end;


 label nochmal;
 var
  BL:TBL;
  buf: TBlk;
  L:LongInt;

 begin
  SetStat_LOAD(PChar(20));		{'Z1013'}
  InitBL(BL,' %04X%c',6);
  repeat
   BL.ok:=ReadBlock(BL.readbl,buf,50);	{langer Vorton ist hier WICHTIG!}
   BL.expect:=BL.readbl;		{Fr den ersten Block kein Hindernis}
   HandleBL(BL);
  until BL.ok;
  AddData(PChar(@Buf),sizeof(buf));
  L:=MaxLongInt;
  BufContent:=DUM;

  if (PChar(@buf)[13]=#$D3)	{Headersave-Vorblock?}
  and (buf[7]=$D3D3) then begin
   GetFileNameZ80(BL.s,PChar(@buf));
   CatHex(BL.s,buf[0]);
   CatHex(BL.s,buf[1]);
   if PChar(@buf)[12]='C' then CatHex(BL.s,buf[2]);
   SetStat_LOAD(BL.s);
   L:=buf[1]-buf[0]+LongInt(32);
   BufContent:=Z80;		{Vorzugs-Speicherformat}
   BL.expect:=buf[0];
   goto nochmal;		{kein INC voraus}
  end;

  repeat
   Inc(BL.expect,32);
nochmal:
   BL.ok:=ReadBlock(BL.readbl,buf,8);
   HandleBL(BL);
   if not BL.ok then goto nochmal;
   AddData(PChar(@Buf),sizeof(buf));
   if (L=MaxLongInt)		{Datenmenge: unbekannt?}
   and (ReadSwing2>100)		{scheint nichts mehr vom Band zu kommen?}
   then break;			{Schleife beenden!}
  until GetSize>=L;
 end;

{BASICODE-Format:
 Vorton: Vollschwingung 2400 Hz ( 9 Samples) Diskriminator:
 Trennz: Vollschwingung 1200 Hz (18 Samples)
 0-Bit:  Vollschwingung 1200 Hz (18 Samples)
 1-Bit:  2 Vollschw.    2400 Hz (9+9 Samples) Diskriminator: 6

 Byte: Trennz, Bit0, Bit1, ... Bit7

 Block: Kein (oder eben nur ein) Block! Nur fr Text.

 Datei: Vorton (9000) - 2 (SOT = Start Of Text) - Text -
	3 (EOT = End Of Text) - Prf-XOR xor 80h - Vorton (3500)
}
procedure ReadDataBasicode; far;
{Kontext: MMTASK.TSK}
 var
  S: array[0..31] of Char;
  I: Integer;
  B,Sum:Byte;

 function Bytein:Byte;
  var
   I,W:Integer;
   B:Byte;
  begin
   for I:=1 to 2 do begin
    W:=ReadSwing1;
    if W<7 then begin
     I:=0;
     continue;
    end;
   end;
   for I:=0 to 7 do begin
    w:=ReadSwing2;
    B:=B SHR 1;
    if w<16 then begin B:=B or $80;ReadSwing2;end;
   end;
   Sum:=Sum xor B;
   Bytein:=B xor $80;
  end;

 var
  w: Word;

 begin
  SetStat_LOAD(PChar(21));		{'BASICODE'}
  BufContent:=BAC;
  for I:=1 to 40 do begin
   W:=ReadSwing1;
   if W>=6 then begin
    I:=0;
    continue;
   end;
  end;
  Sum:=$0;
  If ByteIn=1 then ByteIn;
  Repeat
   B:=ByteIn;
   If B=3 then begin
    B:=Sum;
    If ByteIn<>B then SetStat_LOAD(PChar(22));	{'Lesefehler erkannt!'}
    ShortYield;
    exit;
   end;
   AddData(PChar(@B),1);
   if B=$0D then B:=0;
   B:=B and $7F;
   if B in [1..$1F,$7F] then B:=Byte('.');
   S[I]:=Char(B);
   if I<sizeof(S)-1 then Inc(I);
   if B=0 then begin
    SetStat_LOAD(S);
    I:=0;
   end;
  until false;
 end;

{Automatische Formaterkennung am Vorton:
 2400 Hz -> BASICODE (= MPM-Turbo)
 1050 Hz -> KC
  600 Hz -> Z1013
}

procedure ReadDataAuto; far;
 label step1;
 var
  I,U,O,D,Z: Integer;
  S: TS31;
 begin
  SetStat_LOAD(PChar(16));	{'Suche...'}
step1:
  U:=100; O:=0; Z:=500;
  repeat
   I:=ReadSwing2;
   D:=I div 8 +1;		{erlaubte Differenz O-U}
   U:=min(U,I); O:=max(O,I);
   if U+D<O then goto step1;	{Zu groáe Abweichung: von vorn!}
   Dec(Z)
  until Z=0;
{  if U>=183 then goto step1;	{Nur Netzbrummen: bis 120 Hz}
{  if O<=1 then goto step1;	{Zu hochfrequent}
  if (U<=9) and (9<=O) then ReadDataBasicode
  else if (U<=21) and (21<=O) then ReadDataKCC
  else if (U<=34) and (34<=O) then ReadDataZ1013
  else begin
   Word(I):=44100 div Word(U+O);
   wvsprintf(S,'%u Hz ???',I);
   SetStat_LOAD(S);
   goto step1;
  end;
 end;

{-Speichern-auf-Kassette-----------------------------------------------------}
procedure WriteB;
{Schreibt ein Sample "Amp" (globale Variable) auf die Wave-Ausgabe}
{Kontext: MMTASK.TSK}
 begin
  with CurWaveHdr^ do begin
   lpData[ByteIndex]:=Char(Integer(Amp)+$80);
   Inc(ByteIndex);
   if ByteIndex>=LongRec(dwBufferLength).Lo
   then begin
    {$IFOPT D+} asm int 3 end; {$ENDIF}
    ProcessBlock;		{vollen Block schreiben}
   end;
  end;
 end;

procedure WriteSwing1(Len:Integer);
{Schreibt eine Halbschwingung der gewnschten L„nge mit abgerundeter
 Vorderflanke (nur bei L„ngen >=4) -
 ansonsten war die Aufzeichnung futsch sowie keine KC-Direktankopplung
 (ohne Magnetband) m”glich.}
{Kontext: MMTASK.TSK}
 begin
  if Len>=4 then asm		{bei =4 bleibt die Amplitude auf 7/8}
	mov	al,[Amp]
	neg	al
	push	ax
	 mov	[Amp],0
	 call	WriteB
	pop	ax
	push	ax
	 sar	al,1		{/2, Amp ist immer gerade!}
	 mov	[Amp],al
	 call	WriteB
	pop	ax
	push	ax
	 sar	al,2		{/4}
	 add	[Amp],al	{3/4}
	 call	WriteB
	pop	ax
	push	ax
	 sar	al,3		{/8}
	 add	[Amp],al	{7/8}
	 call	WriteB
	pop	ax
	sub	[Len],4
	mov	[Amp],al
  end else asm
	neg	[Amp]
  end;
  while Len<>0 do begin
   WriteB;			{Rest gerade (Gleichspannung)}
   Dec(Len);
  end;
 end;

procedure WriteSwing2(Len:Integer);
{Ganze Schwingung der gewnschten L„nge (in 22-kHz-Samples) schreiben}
{Kontext: MMTASK.TSK}
 var
  Len1:integer;
 begin
  Len1:=idiv2(Len);		{halbieren...}
  WriteSwing1(Len1);
  WriteSwing1(Len-Len1);	{kann unterschiedliche L„ngen ergeben!}
 end;

procedure WriteDataKCC; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}

 procedure WriteByte(B:Byte); assembler;
  asm
	mov	ah,8
	mov	al,[B]
@@l:	shr	al,1
	push	ax
	 mov	ax,11
	 jnc	@@1
	 mov	al,21
@@1:	 push	ax
	 call	WriteSwing2
	pop	ax
	dec	ah
	jnz	@@l
	push	39
	call	WriteSwing2
  end;

  procedure WriteBlock(BlkNr:Byte; const Buffer:TBlock; Vorton:Integer);
   var
    I,W:Integer;
    B,Sum:Byte;
   begin
    for I:=1 to Vorton do WriteSwing2(21);	{Vorton}
    WriteSwing2(39);				{Trennzeichen}
    WriteByte(BlkNr);
    Sum:=0;
    for I:=0 to $7F do begin
     Inc(Sum,Buffer[I]);
     WriteByte(Buffer[I]);
    end;
    WriteByte(Sum);
   end;

 var
  CurBlk: Byte;
  S: array[0..31] of Char;
  I: Integer;
  buf: TBlock;
  Erster_Block, Letzter_Block: Boolean;
 begin
  SetStat_SAVE(PChar(17));
  CurBlk:=1;
  Erster_Block:=true;
  Letzter_Block:=false;
  repeat
   I:=GetData(PChar(@buf),sizeof(buf));
   if ((I<sizeof(buf)) or (GetSize=0))
   and (not Erster_Block)
   and (CurBlk<>$FF) then begin
    Letzter_Block:=true;
    CurBlk:=$FF;
   end;
   I:=CurBlk;
   wvsprintf(S,' %02X<',I);
   SetStat_SAVE(S);
   I:=$A0;
   if Erster_Block then I:=$A00;
   WriteBlock(CurBlk,buf,I);
   Inc(CurBlk);
   Erster_Block:=false;
  until Letzter_Block;
 end;

procedure WriteDataMPMTurbo; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}

 procedure WriteByte(B:Byte); assembler;
  asm
	mov	ah,8
	mov	al,[B]
@@l:	shr	al,1
	push	ax
	 mov	ax,5
	 jnc	@@1
	 mov	al,12
@@1:	 push	ax
	 call	WriteSwing1
	pop	ax
	dec	ah
	jnz	@@l
  end;

  procedure WriteBlock(BlkNr:Byte; const Buffer:TBlock; Vorton:Integer);
   var
    I,W:Integer;
    B,Sum:Byte;
   begin
    for I:=1 to Vorton do WriteSwing2(10);	{Vorton}
    WriteSwing2(24);				{Trennzeichen}
    WriteByte(BlkNr);
    Sum:=0;
    for I:=0 to $7F do begin
     Sum:=Sum xor Buffer[I];
     WriteByte(Buffer[I]);
    end;
    WriteByte(Sum);
   end;

 var
  CurBlk: Byte;
  S: array[0..31] of Char;
  I: Integer;
  buf: TBlock;
  Erster_Block, Letzter_Block: Boolean;
 begin
  SetStat_SAVE(PChar(18));
  CurBlk:=1;
  Erster_Block:=true;
  Letzter_Block:=false;
  repeat
   I:=GetData(PChar(@buf),sizeof(buf));
   if ((I<sizeof(buf)) or (GetSize=0))
   and (not Erster_Block)
   and (CurBlk<>$FF) then begin
    Letzter_Block:=true;
    CurBlk:=$FF;
   end;
   I:=$70;
   if Erster_Block then I:=$1000;
   WriteBlock(CurBlk,buf,I);
   I:=CurBlk;
   Inc(CurBlk);
   wvsprintf(S,'%02X<',I);
   SetStat_SAVE(S);
   Erster_Block:=false;
  until Letzter_Block;
 end;

procedure WriteDataHSTurbo; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
 var
  BTW: Longint;
  B:Byte;
  S: TS255;
 begin
  {Loader saven}
  BTW:=BytestoWrite;BytestoWrite:=256;
  WriteDataKCC;
  BytestoWrite:=BTW;
  {eigentliche Daten speichern}
  SetStat_SAVE(PChar(19));	{'Turbo h#s'}
  asm	mov	cx,512
@@l:	push	cx
	 push	30
	 call	WriteSwing2
	pop	cx
	loop	@@l
  end;
  WriteSwing1(9);
  while GetData(PChar(@B),1)<>0 do asm
	mov	cx,8
@@l:	mov	ax,4		{Null-Bit}
	shl	[B],1
	jnc	@@1
	mov	al,9		{Eins-Bit}
@@1:	push	cx
	 push	ax
	 call	WriteSwing1
	pop	cx
	loop	@@l
  end;
 end;

procedure WriteDataZ1013; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
 type
  TBlk=array[0..15] of Word;
 var
  S: array[0..31] of Char;
  I:integer;
  buf:TBlk;
  W: Word;

 procedure WriteWord(W:Word); assembler;
  asm
	mov	cx,16
	mov	ax,[W]
@@l:	shr	ax,1
	push cx; push ax
	 mov	ax,offset WriteSwing1
	 jnc	@@1
	 mov	ax,offset WriteSwing2
@@1:	 push	9
	 call	ax
	pop ax; pop cx
	loop	@@l
  end;

 procedure WriteBlock(const Buffer:TBlk; W:Word; Vorton:Integer);
  var
   I:Integer;
   Sum:Word;
  begin
   for I:=1 to Vorton do WriteSwing1(17);	{Vorton}
   WriteSwing2(16);				{Trennzeichen}
   WriteWord(W);
   Sum:=0;
   for I:=0 to 15 do begin
    inc(Sum,Buffer[I]);
    WriteWord(Buffer[I]);
   end;
   WriteWord(Sum);
  end;

 begin
  SetStat_SAVE(PChar(20));
  I:=2000;
  W:=0;
  While GetSize>0 do begin
   GetData(PChar(@buf),sizeof(buf));
   wvsprintf(S,'%04X<',W); Setstat_SAVE(s);
   WriteBlock(buf,W,I);
   Inc(W,32);
   I:=14;
  end;
 end;


procedure WriteDataBasicode; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
 var
  S: array[0..31] of Char;
  I: Integer;
  B,Sum:Byte;

  procedure WriteByte(B:Byte);
   var
    I,W:Integer;
   begin
    Sum:=Sum xor B;
    WriteSwing2(18);
    for I:=0 to 7 do begin
     if B and 1 =0 then WriteSwing2(18)
     else begin WriteSwing2(9);WriteSwing2(9);end;
     B:=B shr 1;
    end;
    WriteSwing2(9);WriteSwing2(9);
   end;

 begin
  SetStat_SAVE(PChar(21));
  Sum:=0;
  for I:=1 to 9000 do WriteSwing2(9);
  WriteByte(2);
  I:=0;
  while GetData(PChar(@B),1)<>0 do begin
   WriteByte(B);
   if B=$0D then B:=0;
   B:=B and $7F;
   if B in [1..$1F,$7F] then B:=Byte('.');
   S[I]:=Char(B);
   if I<sizeof(S)-1 then Inc(I);
   if B=0 then begin
    SetStat_SAVE(S);
    I:=0;
   end;
  end;
  WriteByte(3);
  WriteByte(Sum xor $80);
  for I:=1 to 3500 do WriteSwing2(9);
 end;

{-Dialogfunktionen-----------------------------------------------------------}
const
 ID_OfnWriteProt=1040;
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word; export;
 {tr„gt lediglich 'mit Vorblock' ein;
  sollt bei SAVE aber erkennen, ob es eine BASIC-Datei ist und das
  OFN_ReadOnly-Flag entsprechend setzen! }
 var
  S: TS31;
 begin
  OFNHook:=0;
  case Msg of
   WM_InitDialog: begin
    LoadString(Seg(HInstance),108,S,sizeof(S));	{"Mit Vorblock"}
    SetDlgItemText(Wnd,ID_OfnWriteProt,S);
   end;
  end{case Msg};
 end;

var
 SFile: TS255;
 SFilter: TS255;
 SExt: TS31;
const
 hm: Word=WM_User+100;	{HelpMessageString-Nachricht}
const
 Ofn: TOpenFileName=(
  lStructSize: sizeof(TOpenFileName);
  hWndOwner: 0;
  hInstance: Seg(HInstance);
  lpstrFilter: SFilter;
  lpstrCustomFilter: SExt;
  nMaxCustFilter: sizeof(SExt);
  nFilterIndex: 0;
  lpstrFile: SFile;
  nMaxFile: sizeof(SFile);
  lpstrFileTitle: nil;
  nMaxFileTitle: 0;
  lpstrInitialDir: nil;
  lpstrTitle: nil;
  Flags: OFN_LongNames or OFN_ShowHelp or OFN_PathMustExist
    or OFN_EnableHook or OFN_OverwritePrompt or OFN_HideReadOnly;
  nFileOffset: 0;
  nFileExtension: 0;
  lpstrDefExt: nil;
  lCustData: 0;
  lpfnHook: OFNHook;
  lpTemplateName: nil);

procedure PrepareOFN;
 var
  SP1,SP2:PChar;
  I: Integer;
 begin
  hm:=RegisterWindowMessage(HelpMsgString);
  Ofn.hWndOwner:=MainWnd;
  LoadString(Seg(HInstance),107,SFilter,sizeof(SFilter));
  AFilter(ofn.nFilterIndex):=Filter;
  if Filter<>NON then begin
   SP1:=SFilter;		{Miábrauch!}
   for I:=Integer(Filter)*2 downto 2	{min. 1x}
   do Inc(SP1,lstrlen(SP1)+1);
{Bug der COMMDLG.DLL bereinigen}
   if lstrcmp1(SExt+1,SP1,lstrcmp)<>0 then begin
    SP2:=SP1+lstrlen(SP1);	{String-Ende}
    memmove(SP1+lstrlen(SExt+1),SP2,SFilter+sizeof(SFilter)-SP2);
    lstrcpy(SP1,SExt+1);	{User-Extension einfgen}
   end;
  end;
  SFile[0]:=#0;
 end;

function Char_ANSI2KC:Char; assembler;
{6 Zeichencodes (vornehmlich Umlaute) austauschen}
 asm	mov	ah,5Ch		{Pipe-Symbol}
	cmp	al,7Ch
	jz	@@2
	mov	ah,5Dh		{Negations-Zeichen}
	cmp	al,0ACh
	jz	@@2
	mov	ah,7Bh		{„}
	cmp	al,0E4h
	jz	@@2
	inc	ah		{”}
	cmp	al,0F6h
	jz	@@2
	inc	ah		{}
	cmp	al,0FCh
	jz	@@2
	inc	ah		{á}
	cmp	al,0DFh
	jnz	@@e
@@2:	xchg	ah,al
@@e:
 end;

procedure PutFileName(pBuf:PChar); assembler;
{Dateiname vom globalen String SFile einbauen;
 dabei Name und Erweiterung mit Leerzeichen auffllen;
 weitere Voraussetzungen sind gltige Eintr„ge ofn.nFileOffset,
 ofn.nFileExtension und ofn.nFilterIndex.
 Bei Erweiterungen mit 3 gleichen Buchstaben UND ofn.nFilterIndex=3
 (BASIC-Programm) wird diese an den Anfang gezogen und 80h addiert,
 als Extrawurst fr BASIC-Programme und ~Daten}
 asm	cld
	les	di,[pBuf]
	xor	dx,dx		{Merk-Register}
	mov	al,byte ptr [ofn.nFilterIndex]
	cmp	al,SSS		{BASIC ausgew„hlt?}
	jne	@@1		{nein, Extension egal}
	mov	cx,[ofn.nFileExtension]
	jcxz	@@1		{keine Endung!}
	mov	si,offset SFile
	add	si,cx
	lodsb			{1. Zeichen der Endung}
	cmp	[si],al		{Vgl. mit 2. Zeichen}
	jnz	@@1
	cmp	[si+1],al	{Vgl. mit 3. Zeichen}
	jnz	@@1
	and	al,not 20h	{Groábuchstabe}
	cmp	al,'S'
	jc	@@1		{kein .SSS .. .ZZZ}
	cmp	al,'Z'
	ja	@@1
	or	al,80h		{zuerst Extension+80h}
	stosb
	stosb
	stosb
	inc	dl		{Kennungs-Bit: Extension geschrieben}
@@1:	mov	si,offset SFile
	add	si,[ofn.nFileOffset]
	mov	cx,8
@@l1:	lodsb
	or	al,al		{Ende extensionsloser Dateiname}
	jz	@@2
	cmp	al,'.'		{Ende Dateiname (Namensbestandteil)}
	je	@@2		{eigentlich ist der LETZTE Punkt maágebend!}
	call	Char_ANSI2KC
	stosb
	loop	@@l1
@@2:	mov	al,' '
	rep	stosb		{Rest mit Leerzeichen auffllen (CX=0 = nix)}
	or	dl,dl		{Endung vorgezogen?}
	jnz	@@3
	inc	dl		{keine Rekursion!}
	mov	cx,[ofn.nFileExtension]
	jcxz	@@2		{Keine Extension?}
	mov	si,offset SFile
	add	si,cx
	mov	cx,3		{noch 3 Bytes l”schen!}
	jmp	@@l1		{Extension <blank-padded> anh„ngen}
@@3: end;

function GetCoding:ACoding;
{Ermittelt Kodierung, l”st "automatisch" anhand Filter auf}
 begin
  case Coding of
   AUTO: case Filter of
    Z80: GetCoding:=Z1013;
    BAC: GetCoding:=BASICODE;
    else GetCoding:=KC;
   end;
   else GetCoding:=Coding;
  end;
 end;

function LoadFile:Boolean;
 label exi, exi2;
{ const
  FilterHeaderSizes: array[KCC..BAC] of Byte=($80,0,0,$20,0);}
{  CodingHeaderSizes_C: array[KC..BASICODE] of Byte=($80,$80,0,$20,0);}
{  CodingHeaderSizes_B: array[KC..BASICODE] of Byte=(11,11,0,0,0);}
 var
{  BytesWritten:Longint;}
  f,Add,Sub,I: Integer;
  Sum: Byte;
  pBuf: PChar;
  hLdr: THandle;
  C: Char;
  Autostart: Boolean;
  aadr,eadr,sadr: Word;
  buf: TBlock;
  This_Coding: ACoding;
 begin
  LoadFile:=false;
  PrepareOfn;
  with ofn do begin
   Flags:=Flags or OFN_FileMustExist;
	{or OFN_AllowMultiselect: Zukunftsmusik!}
   if not GetOpenFileName(ofn) then exit;
   Filter:=AFilter(ofn.nFilterIndex);
   {$IFOPT D+} asm int 3 end; {$ENDIF}
   f:=_lopen(SFile,0);
   if f=-1 then goto exi2;
   BytesToWrite:=_llseek(f,0,2);	{Dateil„nge}
   if BytesToWrite=0 then goto exi;
   _llseek(f,0,0);			{Zeiger zurck}

   Add:=0;
   case Filter of
    DUM: begin
     if not (Coding in [AUTO,KC,MPM,Z1013])	{Code-Zwang!}
     then This_Coding:=KC;
    end;
    SSS: begin
     if not (Coding in [AUTO,KC,MPM,HS])	{Code-Zwang!}
     then This_Coding:=KC;
     Add:=11;
    end;
    BAC: if not (Coding in [AUTO,BASICODE])	{Code-Zwang!}
    then This_Coding:=BASICODE;
   end;
   if Coding<>This_Coding
   then SendDlgItemMessage(MainWnd,12,CB_SetCurSel,Word(This_Coding),0);
   This_Coding:=GetCoding;

   case This_Coding of
    KC,MPM: begin
     if Filter=DUM then add:=$80;
     if Filter=Z80 then add:=$60;
    end;
    HS: begin
     add:=$80;
     if Filter=DUM then add:=$100;
     if Filter=SSS then add:=$0FE;	{L„ngen-Byte verschwindet!}
     if Filter=Z80 then add:=$0E0;
     hLdr:=LoadResource(Seg(HInstance),	{Turboloadervorblock}
       FindResource(Seg(HInstance),MakeIntResource(102),RT_RCData));
     if hLdr=0 then RunError(220);	{B”ser Fehler!}
    end;
    Z1013: begin
     if Filter=KCC then add:=-$60;
     if Filter=DUM then add:=$20;
    end;
   end;

   Inc(BytesToWrite,Add);
   hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,BytesToWrite);
   pBuf:=GlobalLock(hBuffer);
   if This_Coding=HS then begin
    MemMove(pBuf,LockResource(hLdr),$100);
    UnlockResource(hLdr);
    FreeResource(hLdr);
   end;
   Autostart:=false;
    if (Add<>0)
    and (_lread(f,PChar(@buf),Add)<>Add) then goto exi;	{Datei zu kurz}
    case Filter of
     KCC: begin				{.KCC}
      aadr:=PWord(@buf[$11])^;
      eadr:=PWord(@buf[$13])^;
      if buf[$10]>=3 then begin
       Autostart:=true;
       sadr:=PWord(@buf[$15])^;
      end;
     end;
     DUM: begin				{Speicherabzug: hier fest ab 200h}
      aadr:=$200;			{CP/M-Freaks wrden hier 100h setzen}
      eadr:=BytesToWrite+aadr;
     end;
     SSS: begin				{BASIC-Programm}
      aadr:=$401;			{wird eigentlich nicht benutzt}
      eadr:=PWord(@buf[0])^+aadr;
     end;
     Z80: begin				{.Z80 - noch nicht benutzt}
      aadr:=PWord(@buf[0])^;
      eadr:=PWord(@buf[2])^;
      if Char(buf[$0C])='C' then begin
       Autostart:=true;
       sadr:=PWord(@buf[4])^;
      end;
     end;
    end{case};

    if Filter=SSS then begin		{Extrawurst fr BASIC}
     MemMove(pbuf+$80,pbuf+$70,$0A);
     PWord(@pbuf[$81])^:=eadr;
    end else begin
     PWord(pbuf+$81)^:=aadr;
     PWord(@pbuf[$84])^:=eadr;
    end;
    PWord(pbuf+$A8)^:=eadr-aadr;
    if Autostart then begin
     pbuf[$E0]:=Char($C3);		{JMP nn}
     PWord(pbuf+$E1)^:=sadr;
    end;

    if _hread(f,pbuf+$100,BytesToWrite)<>BytesToWrite then goto exi;
    Inc(BytesToWrite,$100);		{nun: alle Bytes}
    sum:=0;				{Rest laden - Datei zu kurz?}
    for i:=$100 to BytesToWrite-1 do inc(sum,byte(pBuf[I]));
    pBuf[$D8]:=char(Sum);		{Prfsumme einsetzen}

    GlobalUnlock(hBuffer);
   end;
   hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share or GMEM_ZeroInit,
     BytesToWrite+Add);
   pBuf:=GlobalLock(hBuffer);
   if _hread(f,pBuf+Add,BytesToWrite)<>BytesToWrite then goto exi;
   Inc(BytesToWrite,Add);
   if (Add<>0)
   or (Filter=KCC) and (pbuf[0]=#0)
   then PutFileName(pBuf);
   if (Filter=DUM)
   and (coding<>HS) then begin
    PByte(pBuf+$10)^:=2;			{ARGN; ARG1 bleibt 0}
    PWord(pBuf+$13)^:=LongRec(BytesToWrite).Lo;	{ARG2=EAdr+1}
   end;
   if _lclose(f)<>0 then goto exi2;
   GlobalUnlock(hBuffer);
   LoadFile:=true;
   exit;
exi:
   _lclose(f);
exi2:
   GlobalUnlock(hBuffer);
   hBuffer:=GlobalFree(hBuffer);
   MBox1(MainWnd,105,SFile);
  end{with};
{ end;}

const
 InvalChars_LFN: array[0..6] of Char='"<|>:\/';	{' .+,;=[]' fr SFN}

procedure StripInvalChars(S:PChar); assembler;
 asm	cld
	push	ds
	 push	ds
	 pop	es
	 lds	si,[S]
@@l:	 lodsb
	 or	al,al
	 jz	@@e
	 mov	cx,7
	 mov	di,offset InvalChars_LFN
	 repne	scasb
	 jne	@@l
	 mov	byte ptr [si-1],'_'
	 jmp	@@l
@@e:	pop	ds
 end;

procedure Convert_HS2KCC(pBuf:PChar);
{schaufelt HS-Turbo-Daten in KC-MC oder KC-BASIC-Daten im Speicher um;
 sollte beim Lader geschehen!}
 begin
  if pBuf[$80]=char($21) then begin {Maschinenprg.}
   Dec(BufPtr,$81);
   asm
	les	di,[pBuf]
	mov	si,di
	add	di,11
	xor	ax,ax
	mov	cx,6
	rep	stosb
	add	si,81h
	seges	lodsw
	stosw
	inc	si
	seges	lodsw
	stosw
	add	si,5Ah
	sub	di,5
	push	si
	 seges	lodsb
	 cmp	al,0C3h
	 jnz	@@1
	 mov	al,3
	 stosb
	 add	di,4
	 seges	lodsw
	 jmp	@@2
@@1:	 mov	al,2
	 stosb
	 add	di,4
	 xor	ax,ax
@@2:	 stosw
	 mov	cx,69h
	 xor	ax,ax
	 rep	stosb
	pop	si
	add	si,20h
	mov	cx,word[BufPtr]
@@3:	seges	lodsb
	stosb
	loop	@@3
   end;
   BufContent:=KCC;
  end else begin {BASIC Prg.}
   Dec(BufPtr,$100);
   asm
	les	di,[pBuf]
	mov	si,di
	add	si,81h
	seges	lodsw
	dec	ax
	stosw
	add	si,7Eh
	mov	cx,word[BufPtr]
@@1:	seges	lodsb
	stosb
	loop	@@1
   end;
   BufContent:=SSS;
  end;
 end;

function SaveFile:Boolean;
 var
  BytesWritten: Longint;
  f,Add: Integer;		{Add= 0 oder 11}
  pBuf: PChar;
  C: Char;
  WantFilter: AFilter;
 begin
  SaveFile:=false;
  Add:=0;
  pBuf:=GlobalLock(hBuffer);
  if BufContent=NON then Convert_HS2KCC(pBuf);
  Filter:=BufContent;
  PrepareOfn;
{fr Turbolader h#s und Z1013 ohne Headersave Dateiname weglassen;
 durch zweckm„áige Vorgabe wie UnbenanntXXX ersetzen}
  case Filter of
   KCC,SSS: GetFileNameKC(SFile,pBuf);
   Z80: GetFileNameZ80(SFile,pBuf);
  end;
  StripInvalChars(SFile);
  with ofn do begin
   if not GetSaveFileName(ofn) then exit;
   WantFilter:=AFilter(ofn.nFilterIndex);
   f:=_lcreat(SFile,0);
   if f=-1 then begin
    GlobalUnlock(hBuffer);
    exit;
   end;
   Dec(BufPtr,Add);
   BytesWritten:=_hwrite(f,pBuf+Add,BufPtr);
   GlobalUnlock(hBuffer);
   if (_lclose(f)<>0) or (BytesWritten<>BufPtr) then begin
    MBox1(MainWnd,106,SFile);
    exit;
   end;
   SaveFile:=true;
  end;
 end;

function GetInt(var S: PChar; Def:Integer):Integer;
{macht strtok() und atoi() oder reicht Def durch}
 var
  SP: PChar;
  I,J: Integer;
 begin
  GetInt:=Def;
  if S=nil then exit;
  SP:=lStrChr(S,' ');
  if SP<>nil then begin
   SP^:=#0;
  end;
  Val(S,I,J);
  if SP<>nil then S:=SP+1;
  if J=0 then GetInt:=I;
 end;


procedure HandleMMError(Code:Integer);
 var
  S: array[0..255] of Char;
 begin
  case Code of
   MMSysErr_Allocated: MBox1(MainWnd,102,nil);
   WAVERR_Sync: MBox1(MainWnd,101,nil);
   else begin
    WaveInGetErrorText(Code,S,sizeof(S));
    MBox1(MainWnd,103,S)
   end;
  end;
 end;

procedure SetModus(NewModus:AModus);
 begin
  if Modus<>NewModus then begin
   Modus:=NewModus;
   DragAcceptFiles(MainWnd,Modus=NONE);
   EnableWindow(GetDlgItem(MainWnd,1),Modus=NONE);
   EnableWindow(GetDlgItem(MainWnd,22),Modus=NONE);
   ShowWindow(GetDlgItem(MainWnd,2),Integer(Modus<>NONE));
   ShowWindow(GetDlgItem(MainWnd,3),Integer(Modus=NONE));
   ShowWindow(GetDlgItem(MainWnd,19),Integer(Modus=LOAD));
  end;
  if GetFocus=0 then SetFocus(GetDlgItem(MainWnd,12));
 end;

function GetLibProc(Entry:PChar):TFarProc;
 var
  P: TFarProc;
  LibName: TS31;
 begin
  GetLibProc:=nil;
  SendDlgItemMsgP(MainWnd,12,CB_GetLbText,Word(coding),@LibName);
  LibInst:=LoadLibrary(LibName);
  if LibInst<32 then begin
   MBox1(MainWnd,114,LibName);
   exit;
  end;
  P:=GetProcAddress(LibInst,Entry);
  if P=nil then begin
   MBox1(MainWnd,115,Entry);
   FreeLibrary(LibInst);
   LibInst:=0;
   exit;
  end;
  GetLibProc:=P;
 end;

procedure DoEndProcess(OK:Boolean);
 begin
  if OK and (Modus=LOAD) then SaveFile;
  if hBuffer<>0 then hBuffer:=GlobalFree(hBuffer);
  if LibInst>=32 then FreeLibrary(LibInst);
  SetModus(NONE);
 end;

var
 DefEditProc:TFarProc;

function EditHook(Wnd:HWnd;Msg,wParam:Word;lParam:LongInt):LongInt; export;
{Anzapfung Edit-Fenster mit Rollbalken zur bequemen Wert-Ver„nderung mit
 Maus und/oder Cursortasten (sog. unterklassifiziertes Fenster)}
 var
  I,J,E: Integer;
  S: TS7;
 begin
  EditHook:=0;
  I:=Msg2VScroll(Msg,wParam,2);
  if I=0 then begin
   EditHook:=CallWindowProc(DefEditProc,Wnd,Msg,wParam,lParam);
   exit;
  end;
  GetWindowText(Wnd,S,sizeof(S));
  Val(S,J,E);
  if E<>0 then begin
   MessageBeep(MB_IconHand);
   exit;
  end;
  J:=between(J+I,1,7);
  wvsprintf(S,'%d',J);
  SetWindowText(Wnd,S);
 end;

procedure IODev_AddString(W:HWnd; S:PChar; J,K:Integer);
{Fgt String hinzu mit ItemData J, ist J=K wird dieser Eintrag selektiert.
 Fr das Fllen der Ein- und Ausgabe-Ger„te-Kombinationsfenster}
 var
  I: Integer;
 begin
  I:=SendMessageP(W,CB_AddString,0,S);
  SendMessage(W,CB_SetItemData,I,J);
  if J=K then SendMessage(W,CB_SetCurSel,I,0);
 end;

function MainDlgProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
 var
  lPar: LongRec absolute lParam;
  WH: PWaveHdr absolute lParam;
  dis: PDrawItemStruct absolute lParam;
  S: TS255;
  S2: TS31;
  WaveOutCaps: TWaveOutCaps;
  WaveInCaps: TWaveInCaps absolute WaveOutCaps;	{ist krzer!}
  LF: TLogFont absolute S;
  R: TRect absolute S;
  SP: PChar;
  Proc: TFarProc absolute SP;
  DC: HDC absolute SP;
  W: Word;
  I,J: Integer;
  B: Bool absolute J;
  vsrec: array[0..4] of Integer;
 begin
  MainDlgProc:=false;

  case Msg of
   WM_InitDialog: begin
    MainWnd:=Wnd;		{Globale Variable setzen}
    W:=GetSystemMenu(Wnd,false);
    DeleteMenu(W,SC_Zoom,MF_ByCommand);
    DeleteMenu(W,SC_Size,MF_ByCommand);
    ShowWindow(Wnd,CmdShow);	{Icon? - Sofort wirksam machen!}
    Back:= CreateSolidBrush($FF0000);	{KC-Blau}
    Green:=CreateSolidBrush($008000);	{dunkelgrn}
    PostMessage(Wnd,WM_ContinueInit,0,0);
   end;

   WM_ContinueInit: begin
    LongInt(DefEditProc):=
    SetWindowLong(GetDlgItem(Wnd,11),GWL_WndProc,LongInt(@EditHook));
    SetWindowLong(GetDlgItem(Wnd,13),GWL_WndProc,LongInt(@EditHook));
    UpdateWindow(Wnd);		{wrde in InitDialog nichts bringen !!}
    SP:=nil;
    if RegGetRoot(RegPath,S,sizeof(S)) then begin
     SP:=S;
     Installed:=true;
    end;
    Retries:=GetInt(SP,4);
    Coding:=ACoding(GetInt(SP,0));
    WaveVol:=GetInt(SP,4);
    WaveInDev:=GetInt(SP,0);
    WaveOutDev:=GetInt(SP,0);
    SetDlgItemInt(Wnd,11,Retries,true);
    if WaveInDev=-2 then EnableWindow(GetDlgItem(Wnd,11),false);
    LoadString(Seg(HInstance),104,S,sizeof(S));	{Kassetten-Formate}
    SP:=S;
    W:=GetDlgItem(Wnd,12);	{CB Format}
    while SP^<>#0 do begin
     SendMessageP(W,CB_AddString,0,SP);
     Inc(SP,lstrlen(SP)+1);
    end;
    SendMessageP(W,CB_Dir,0,PChar(UserDllFilter));
    SendMessage(W,CB_SetCurSel,Word(Coding),0);
    SetDlgItemInt(Wnd,13,WaveVol,true);
    W:=GetDlgItem(Wnd,14);	{Handle Kombifenster WaveIN}
    LoadString(Seg(HInstance),112,S2,sizeof(S2));	{"Datei %s"}
    SP:=WaveFileName;
    wvsprintf(S,S2,SP);
    IODev_AddString(W,S,-2,WaveInDev);
    I:=WaveInGetNumDevs;
    for J:=-1 to I-1 do begin	{mit Wave_Mapper (-1) beginnen}
     if (WaveInGetDevCaps(Word(J),@WaveInCaps,sizeof(WaveInCaps))=0)
     and (WaveInCaps.dwFormats and WAVE_Format_2M08 <>0)
     then IODev_AddString(W,WaveInCaps.szPName,J,WaveInDev);
    end;
    W:=GetDlgItem(Wnd,15);	{Handle Kombobox WaveOUT}
    IODev_AddString(W,S,-2,WaveOutDev);
    I:=WaveOutGetNumDevs;
    for J:=-1 to I-1 do begin	{mit Wave_Mapper (-1) beginnen}
     if (WaveOutGetDevCaps(Word(J),@WaveOutCaps,sizeof(WaveOutCaps))=0)
     and (WaveOutCaps.dwFormats and WAVE_Format_2M08 <>0)
     and (WaveOutCaps.dwSupport and WAVECAPS_Sync =0)
     then IODev_AddString(W,WaveOutCaps.szPName,J,WaveOutDev);
    end;
    GetObject(SendMessage(Wnd,WM_GetFont,0,0),sizeof(lf),@lf);
    lstrcpy(lf.lfFaceName,'Courier');
    lf.lfWeight:=FW_Bold;
    Font:=CreateFontIndirect(lf);
    W:=GetDlgItem(Wnd,10);
    SendMessage(W,WM_SetFont,Font,0);
    DC:=GetDC(W);
    wParam:=SelectObject(DC,Font);
    lParam:=GetTextExtent(DC,'X',1); {So viel Aufwand fr eine Zeichenbreite!}
    SelectObject(DC,wParam);
    ReleaseDC(W,DC);
    GetClientRect(W,R);
    StatusChars:=max((R.right-R.left) div lPar.hi,31);
    DragAcceptFiles(Wnd,true);
   end;

   WM_CtlColor: if (lPar.Hi=CtlColor_Static)
   and (GetDlgCtrlID(lPar.Lo)=10) then begin
    MainDlgProc:=Bool(Back);
    SetTextColor(wParam,$FFFFFF);
    SetBkMode(wParam,Transparent);
   end;

   WM_EndProcess: DoEndProcess(Boolean(wParam));

   WM_SetStatus: begin
    SetDlgItemText(Wnd,10,StatusBuf);
   end;

   WM_ReportWaveError: begin	{in MMTASK Fehler bei WaveInOpen()}
    HandleMMError(wParam);
    hBuffer:=GlobalFree(hBuffer);
    SetModus(NONE);
   end;

   WM_DrawItem: with dis^ do begin
    I:=rcitem.left;
    J:=rcItem.right;
    rcItem.right:=MulDiv(WavePeak,J-I,128)+I;
    FillRect(hDC,rcItem,Green);
    rcItem.left:=rcItem.right; rcItem.right:=J;
    FillRect(hDC,rcItem,GetStockObject(Gray_Brush));
    rcItem.left:=I;		{restaurieren (sicherheitshalber)}
   end;

   WM_QueryEndSession: if (Modus<>NONE)
   and (MBox1(Wnd,113,nil)<>IDYes) then MainDlgProc:=true;

   WM_EndSession: if Bool(wParam) and Installed
   then SendMessage(Wnd,WM_Command,23,0);

   WM_Close: begin
    if (Modus<>NONE) then begin
     if MBox1(Wnd,113,nil)<>IDYes then begin
      MainDlgProc:=true;		{Nicht beenden!}
      exit;
     end;
     SendMessage(Wnd,WM_Command,IDCancel,0);
    end;
    DeleteObject(Green);
    DeleteObject(Back);
    DeleteObject(Font);
    if Installed then SendMessage(Wnd,WM_Command,23,0);
    EndDialog(Wnd,1);
   end;

   WM_Command: case wParam of
{Žnderungen an den Eingabe-Elementen erfassen}
    11: if lPar.Hi=EN_Change then begin
     I:=GetDlgItemInt(Wnd,wParam,nil,true);
     if (I>0) and (I<=7) then Retries:=I;
    end;
    12: if lPar.Hi=CBN_SelChange then begin
     I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
     if I>=0 then Coding:=ACoding(I){SendMessage(lPar.Lo,CB_GetItemData,I,0)};
    end;
    13: if lPar.Hi=EN_Change then begin
     I:=GetDlgItemInt(Wnd,wParam,nil,true);
     if (I>0) and (I<=7) then begin
      WaveVol:=I;
      I:=sqr(WaveVol)*2;
      if Amp>=0 then Amp:=I else Amp:=-I;
     end;
    end;
    14: if lPar.Hi=CBN_SelChange then begin
     I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
     if I>=0 then begin
      WaveInDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
      EnableWindow(GetDlgItem(Wnd,11),WaveInDev<>-2);
     end;
    end;
    15: if lPar.Hi=CBN_SelChange then begin
     I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
     if I>=0 then WaveOutDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
    end;
{Tastendrcke}
    3: SendMessage(Wnd,WM_Close,0,0);	{Programmende}

    IDCancel: begin			{Abbruch}
     LoadString(Seg(HInstance),110,S,sizeof(S));
     SetDlgItemText(MainWnd,10,S);
     if Modus<>NONE then begin
      if IsTask(Task) then PostAppMessage(Task,WM_Quit,0,0)
      else SetModus(NONE);
     end;
    end;

    1: if Modus=NONE then begin		{Datei einlesen}
     case coding of
      AUTO:	Proc:=@ReadDataAuto;
      KC:	Proc:=@ReadDataKCC;
      MPM:	Proc:=@ReadDataMPMTurbo;
      HS:	Proc:=@ReadDataHSTurbo;
      Z1013:	Proc:=@ReadDataZ1013;
      BASICODE:	Proc:=@ReadDataBasicode;
      else begin
       Proc:=GetLibProc('LOAD');		{Benutzer-definiert...}
       if Proc=nil then exit;
      end;
     end;
     hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,$8000);
     BufPtr:=0;
     SetModus(LOAD);
     MMTaskCreate(@WaveInTask,Task,LongInt(Proc));
    end;

    22: if Modus=NONE then begin		{Datei ausgeben}
     if not LoadFile then exit;
     case GetCoding of
      KC:	Proc:=@WriteDataKCC;
      MPM:	Proc:=@WriteDataMPMTurbo;
      HS:	Proc:=@WriteDataHSTurbo;
      Z1013:	Proc:=@WriteDataZ1013;
      BASICODE:	Proc:=@WriteDataBasicode;
      else begin
       Proc:=GetLibProc('SAVE');
       if Proc=nil then exit;
      end;
     end;
     BufPtr:=0;
     Amp:=sqr(WaveVol)*2;
     SetModus(SAVE);
     MMTaskCreate(@WaveOutTask,Task,LongInt(Proc));
    end;

    23: begin
     Installed:=true;
     wvsprintf(S,'%d %d %d %d %d',Retries);
     RegSetRoot(RegPath,S);
    end;

    9: WinHelp(Wnd,HelpFileName,HELP_Contents,0);

   end{WM_Command};
  else if Msg=hm then WinHelp(Wnd,HelpFileName,HELP_Context,1);
  end;
 end;

const
 wc:TWndClass=(
  style:	CS_VRedraw or CS_HRedraw;
  lpfnWndProc:	@DefDlgProc;
  cbClsExtra:	0;
  cbWndExtra:	DlgWindowExtra;
  hInstance:	Seg(HInstance);
  hIcon:	0;
  hCursor:	0;
  hbrBackground:Color_Background+1;
  lpszMenuName: nil;
  lpszClassName:'KCLOAD');

{FAR+EXPORT-Wrapper-Routinen (interne Routinen arbeiten mit NEAR)}
function ReadSwing:Integer; export;
 begin ReadSwing:=ReadSwing1; end;

procedure WriteSwing(Len:Integer); export;
 begin WriteSwing1(Len); end;

procedure EndProcess(OK:Boolean); export;
 begin EndProcess1(OK); end;

function SetStatus(S:PChar):Integer; export;
 begin
  if Modus=LOAD
  then SetStatus:=SetStat_LOAD(S)
  else SetStatus:=SetStat_SAVE(S);
 end;

function GetSizeData:Longint; export;
 begin GetSizeData:=GetSize; end;

function GetDataBlock(P:PChar; Size:Integer):Integer; export;
 begin GetDataBlock:=GetData(P,Size); end;

procedure AddDataBlock(P:PChar; Size:Integer); export;
 begin AddData(P,Size); end;

procedure GetName(P:PChar; Size:Integer); export;
 begin lstrcpyn(P,SFile+ofn.nFileOffset,Size); end;

procedure SetNameHint(P:PChar); export;
 begin lstrcpyn(SFile,P,sizeof(SFile)); end;

exports
 ReadSwing	index 2,	{Fluáwechsel lesen}
 WriteSwing	index 3,	{Fluáwechsel schreiben}
 EndProcess	index 4,	{Vorzeitig abbrechen}
 SetStatus	index 5,	{Statuszeile setzen}
 GetSizeData    index 6,	{restliche Bytes ermitteln}
 GetDataBlock	index 7,	{N„chsten Datenblock aus Puffer lesen}
 AddDataBlock	index 8,	{Neuen Datenblock in Puffer anh„ngen}
 GetName	index 9,	{DOS-Dateiname holen}
 SetNameHint	index 10;	{DOS-Dateiname vorschlagen}

begin
 LoadString(Seg(HInstance),100,AppName,sizeof(AppName));
 WUtils.StdMBoxTitle:=AppName;	{MessageBox-Titel in Unit setzen}
 if HPrevInst<>0 then begin	{Nicht doppelt starten!}
  MainWnd:=FindWindow('KCLOAD',nil);
  SetActiveWindow(MainWnd);
  ShowWindow(MainWnd,SW_Restore);
  halt(221);
 end;
 wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
 wc.hCursor:=LoadCursor(0,IDC_Arrow);
 RegisterClass(wc);
 DialogBox(Seg(HInstance),MakeIntResource(100),0,@MainDlgProc);
end.

{
Log der Ver„nderungen:
01/02:
* Wave-Datei-Verarbeitung auf Windows-Chunk-Befehle umgestellt
- Wave-Datei-Voreinstellung in Kombinationsfenster korrigiert
}
Detected encoding: UTF-80