program KCLOAD;
{$D KC-Load 0.59 (05/13)}
{$R-,S-,I-,Q-,W-,K+,G+,A+}
{$C MOVEABLE PRELOAD PERMANENT}
{$R KCLOAD.RES}
{$M $3000,$1000}
{$DEFINE MOTOR} {=Motorschaltspannung}
{Wnschenswerte Erweiterungen:
* OK: Auto-Detect von KC, KC-Turbo, Z1013 und BASICODE
* OK: Hochpass-Filter
* OK: Variable Sampleraten 11, 22; 44 kS/s: N! Doch: 11kHz lesen!
* Vollautomatik (Einlesen und Abspeichern hintereinanderweg)
* OK: grne Aussteuerungs-Anzeige
* OK: Motorschaltspannungs-Untersttzung (Int15/AH=0&1)
* OK: Unverfrhte Statusanzeige bei SAVE
* OK: Mehr als nur 2 Puffer
* Mehrere Dateien hintereinanderweg: N! (LFN beit sich mit MultiSelect)
* Fortschrittsbalken: % der Datei gelesen; Lese-Zeiger akt. Block
* Aussagekrftige Titelzeile falls Icon: teilweise
* zweizeiliges Statusfenster fr Lade-Name, Argumente und Blocknummern
* Blocknummern-Anzeige auch vor dem 1. Block
* Immer ein Wave-Gert auswhlen
}
uses
WinTypes, WinProcs, Win31, MMSystem, CommDlg, ShellApi,
WUtils, lfn;
const
UserDllFilter='*.KCL';
RegPath: array[0..12] of Char='KCEMU\KCLOAD';
HelpFileName: array[0..10] of Char='KCLOAD.HLP';
WaveFileName: array[0..10] of Char='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..42] of THandle; {Puffer fr ca. 4 Sekunden}
Queued: Integer; {Wave-Blcke in der Ausgabe-Warteschlange}
Modus: AModus; {0=frei, 1=LOAD (Band->PC), 2=SAVE (PC->Band)}
type
TGlobal=record
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; {Lautstrke-Multiplikator (log.) bei Ausgabe}
AutoSave: Boolean; {Schalter fr Automatisches Speichern}
WaveInDev: Integer; {Nummer des Ein- bzw. Ausgabegertes: }
WaveOutDev: Integer; {-2=KCLOAD.WAV, -1=Wave-Mapper, 0=erste Soundkarte...}
end;
var
g: TGlobal; {Gespeicherte/zu speichernde Setup-Daten (Registry)}
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=$800; {je grer, desto weniger Last, aber asynchroner}
{2 KB ist eine "Idealgre" fr einen SoundBlaster-
Treiber in Windows-Machart (umlaufende DMA in 4KB)}
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;
WM_OpenFile=WM_User+14; {Warum gibt's diese Message nicht sowieso??}
type
TCallProc=procedure; {Formatabhngige 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!)}
WaveDC: Byte; {Mittelwert (normalerweise 80h)}
WavePeak: Integer; {Maximale Amplitude eines Wave-Blocks beim Lesen}
StatusBuf: TS31; {Statuszeilen-Text}
{*************************************}
{** Prozeduren zur Wave-Ein/Ausgabe **}
{*************************************}
procedure SetRate(Rate:Word);
begin
LongRec(MyWav.wf.nSamplesPerSec).lo:=Rate;
LongRec(MyWav.wf.nAvgBytesPerSec).lo:=Rate;
end;
procedure FindPeak(P:PChar; len:Word);
begin
asm mov cx,[len]
jcxz @@e
xor dx,dx {LONG-Akkumulator}
xor ax,ax
les di,[P]
@@l: add al,es:[di] {Zusammenzhlen}
adc ah,0
adc dx,0
inc di
loop @@l
div [len] {Mittelwert}
mov [WaveDC],al
@@e: end;
{ if len<>0 then begin
dc:=0;
i:=0; repeat
Inc(dc,Byte(P[i]));
Inc(i);
until i=len;
WaveDC:=LongDivW(dc,len);
end;}
WavePeak:=0;
while len<>0 do begin
WavePeak:=max(WavePeak,abs(ShortInt(Byte(P^)-WaveDC)));
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 SetStat_LOAD(s:PChar); forward; {hier: immediamente}
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;
function WaveOutBlock:Boolean;
{Kontext: MMTASK.TSK - Warten bei Wave-Ausgabe (auch bei Flush)}
var
Msg:TMsg;
begin
if not GetMessage(Msg,0,0,0) then begin
WaveOutBlock:=false;
exit;
end;
{$IFOPT D+} if Msg.message<>MM_WOM_Done then asm int 3 end; {$ENDIF}
CurWaveHdr:=Pointer(Msg.lParam); {Geleerter Puffer}
{Die vorher "von Hand" eingesetzten Puffer haben kein gesetztes WHDR_Done}
if LongRec(CurWaveHdr^.dwFlags).lo and WHDR_Done<>0
then Dec(Queued);
WaveOutBlock:=true;
end;
procedure SetStat_SAVING;
{Kontext: MMTASK.TSK - Statuszeilen-Aktualisierung je nach CurWaveHdr}
var
SP: PChar;
begin
SP:=PChar(CurWaveHdr)+sizeof(TWaveHdr)+WAVBLK;
if SP^<>#0 then begin {Jetzt Status setzen}
SetStat_LOAD(SP);
SP^:=#0; {Meldung ist erledigt}
end;
end;
procedure ProcessBlock;
{Kontext: MMTASK.TSK}
label fehler,ende,ende1;
var
Msg: TMsg;
L: LongInt;
W: Word;
begin
with CurWaveHdr^ do case Modus of
LOAD: begin
if g.WaveInDev=-2 then begin
W:=39; {"Fehler beim Lesen"}
L:=dwBufferLength;
if L>ck.cksize then L:=ck.ckSize;
if L=0 then goto ende1; {nichts mehr zu lesen: Speichern anbieten}
dwBytesRecorded:=mmioRead(hWav,lpData,L);
Dec(ck.cksize,dwBytesRecorded);
if LongRec(dwBytesRecorded).Lo<>L then goto fehler;
PeekMessage(Msg,0,0,0,PM_Remove); {Windows zum Zug kommen lassen}
if Msg.message=WM_Quit then goto ende; {hier: niemals speichern}
end else begin
W:=WaveInAddBuffer(hWav,CurWaveHdr,sizeof(TWaveHdr));
if W<>0 then goto fehler; {leeren Puffer hinein}
if not GetMessage(Msg,0,0,0) then ende1: EndProcess1(BufPtr<>0);
{$IFOPT D+} if Msg.message<>MM_WIM_Data then asm int 3 end; {$ENDIF}
CurWaveHdr:=Pointer(Msg.lParam);
end; {Neuer Block, gefllt mit Daten, steht bereit}
FindPeak(CurWaveHdr^.lpData,CurWaveHdr^.dwBytesRecorded);
end;
SAVE: begin
if g.WaveOutDev=-2 then begin
W:=41; {"Fehler beim Schreiben"}
if mmioWrite(hWav,lpData,dwBufferLength)<>dwBufferLength
then goto fehler;
PeekMessage(Msg,0,0,0,PM_Remove); {Windows zum Zug kommen lassen}
if Msg.message=WM_Quit then goto ende;
end else begin
W:=WaveOutWrite(hWav,CurWaveHdr,sizeof(TWaveHdr)); {vollen Puffer hinein}
if W<>0 then goto fehler;
Inc(Queued);
if not WaveOutBlock then goto ende;
end;
SetStat_SAVING;
end;
end;
ByteIndex:=0; {Lese- oder Schreibzeiger an den Anfang}
exit;
fehler:
PostMessage(MainWnd,WM_ReportWaveError,W,0);
ende:
EndProcess1(false);
end;
procedure CheckReadBlock;
{Prft auf ausgelesenen Puffer und beschafft ggf. einen neuen}
begin
if ByteIndex>=LongRec(CurWaveHdr^.dwBytesRecorded).Lo
then ProcessBlock; {Nchsten Block einlesen}
end;
procedure CheckWriteBlock;
{Prft auf vollen Puffer und beschafft ggf. einen neuen}
begin
if ByteIndex>=WAVBLK
then ProcessBlock; {Vollen Block schreiben}
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 "Prparation" dieser Puffer.
Beim Speichern "hngt" 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);
LongRec(WH^.dwBufferLength).lo:=WAVBLK;
case Modus of
LOAD: if g.WaveInDev>-2
then WaveInPrepareHeader(hWav,WH,sizeof(TWaveHdr));
SAVE: if g.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 g.WaveInDev>-2
then WaveInUnprepareHeader(hWav,WH,sizeof(TWaveHdr));
SAVE: if g.WaveOutDev>-2
then WaveOutUnprepareHeader(hWav,WH,sizeof(TWaveHdr));
end;
GlobalUnlock(M);
end;
M:=GlobalFree(M);
end;
procedure WriteSwing1(Len:Integer); forward;
procedure EndProcess1(OK:Boolean);
{Kontext: MMTASK.TSK, Funktion beendet Task}
var
I: Integer;
begin
{1. Puffer von ihrer Arbeit erlsen}
{$IFOPT D+} asm int 3 end; {$ENDIF}
case Modus of
LOAD: if g.WaveInDev>-2 then WaveInReset(hWav);
{Restliche (leere) Puffer "ausspucken"}
SAVE: begin
if OK then begin {Flush in diesem Fall}
WriteSwing1(120); {Noch ein letzter Fluwechsel}
if ByteIndex<>0 then begin
LongRec(CurWaveHdr^.dwBufferLength).Lo:=ByteIndex;
ProcessBlock;
end;
if g.WaveOutDev>-2 then while Queued<>0 do begin
{Die frhere Methode, WaveOutClose zu versuchen, bis kein WAVERR_StillPlaying
kommt, hat den Fehler, dass die Puffer nicht mehr unprpariert werden knnen}
OK:=WaveOutBlock;
if not OK then break;
SetStat_SAVING;
end else begin
if (mmioAscend(hWav,@ck,0)<>0)
or (mmioAscend(hWav,@ckRIFF,0)<>0)
or (mmioFlush(hWav,0)<>0) then begin
OK:=false; {"Fehler beim Schreiben"}
PostMessage(MainWnd,WM_ReportWaveError,41,0);
end;
end;
end;
if g.WaveOutDev>-2 then WaveOutReset(hWav); {abbrechen, wenn OK und NOK}
end;
end;
{2. Puffer unprparieren und freigeben}
for I:=0 to HIGH(Waves) do FreeWaveBlock(Waves[I]);
{3. Wave-Kanal freigeben}
case Modus of
LOAD: begin {Lesen vom Band oder von der WAV-Datei}
if g.WaveInDev>-2 then begin
{$IFDEF MOTOR} asm mov ah,1; int 15h end; {$ENDIF} {Kassettenmotor AUS}
WaveInClose(hWav)
end else mmioClose(hWav,0);
FindPeak(nil,0); {Anzeige rcksetzen (lassen)}
end;
SAVE: begin {Schreiben aufs Band oder in die WAV-Datei}
if g.WaveOutDev>-2 then begin
{$IFDEF MOTOR} asm mov ah,1; int 15h end; {$ENDIF} {Kassettenmotor AUS}
WaveOutClose(hWav)
end else begin
mmioClose(hWav,0);
if not OK then mmioOpen(WaveFileName,nil,MMIO_Delete);
end;
end;
end{case};
hWav:=0; {Referenz killen}
PostMessage(MainWnd,WM_EndProcess,Word(OK),0);
halt; {effektiv Int21h AH=4Ch}
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;
SetRate(22050); {zuerst mit der hohen Rate probieren}
if g.WaveInDev=-2 then begin
I:=36; {"Kann nicht ffnen"}
hWav:=mmioOpen(WaveFileName,nil,
MMIO_Read or MMIO_AllocBuf or MMIO_DenyNone);
if hWav=0 then goto err;
Inc(I); {"Keine WAV-Datei"}
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;
Inc(I); {"Nicht untersttztes Format"}
if not memcmpw(ThisWav,MyWav,sizeof(TPCMWaveFormat) div 2) then begin
SetRate(11025);
if not memcmpw(ThisWav,MyWav,sizeof(TPCMWaveFormat) div 2)
then goto errfile;
end;
Inc(I); {"Lesefehler"}
ck.ckID:=$61746164; {'data'}
if mmioDescend(hWav,@ck,@ckRIFF,MMIO_FindChunk)<>0 then goto errfile;
CurWaveHdr:=MakeWaveBlock(Waves[0]);
end else begin
SetMessageQueue(HIGH(Waves)+4); {Schlangen-Kandidaten}
I:=Integer(WaveInOpen(@hWav,Word(g.WaveInDev),@MyWav.wf,
MMGetCurrentTask,0,Callback_Task));
if I=WAVERR_BadFormat then begin
SetRate(11025);
I:=Integer(WaveInOpen(@hWav,Word(g.WaveInDev),@MyWav.wf,
MMGetCurrentTask,0,Callback_Task));
end;
if I<>0 then goto err;
MMTaskBlock(Task); {MM_WIM_Open entfernen}
for I:=0 to HIGH(Waves)-1 do
WaveInAddbuffer(hWav,MakeWaveBlock(Waves[I]),sizeof(TWaveHdr));
CurWaveHdr:=MakeWaveBlock(Waves[HIGH(Waves)]);
ByteIndex:=$FFFF;
{$IFDEF MOTOR} asm mov ah,0; int 15h end; {$ENDIF} {Kassettenmotor EIN}
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;
SetRate(22050); {Jede Soundkarte schafft das!}
if g.WaveOutDev=-2 then begin
I:=40; {"Kann Datei nicht erzeugen"}
hWav:=mmioOpen(WaveFileName,nil,
MMIO_Write or MMIO_AllocBuf or MMIO_Create or MMIO_DenyNone);
if hWav=0 then goto err;
Inc(I); {"Fehler beim Schreiben"}
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
SetMessageQueue(HIGH(Waves)+4); {Schlangen-Kandidaten}
Queued:=0;
I:=Integer(WaveOutOpen(@hWav,Word(g.WaveOutDev),@MyWav.wf,
MMGetCurrentTask,0,Callback_Task));
if I<>0 then goto err;
MMTaskBlock(Task); {MM_WOM_Open entfernen}
for I:=1 to HIGH(Waves) do
PostAppMessage(MMGetCurrentTask,MM_WOM_Done,hWav,
LongInt(MakeWaveBlock(Waves[I])));
{$IFDEF MOTOR} asm mov ah,0; int 15h end; {$ENDIF} {Kassettenmotor EIN}
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;
{**********************************************}
{** Formatabhngiges Lesen: Anzeige-Routinen **}
{**********************************************}
procedure LoadStr31(D,S:PChar);
begin
if PtrRec(S).sel=0
then LoadString(Seg(HInstance),LongRec(S).lo,D,32)
else lstrcpyn(D,S,32);
end;
procedure SetStat_LOAD(S:PChar);
var
Msg:TMsg;
begin
LoadStr31(StatusBuf,S);
{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);
end;
procedure SetStat_SAVE(S:PChar);
begin
LoadStr31(PChar(CurWaveHdr)+sizeof(TWaveHdr)+WAVBLK,S);
end;
function Char_KC2ANSI:Char; assembler;
{Zeichen-Bereich begrenzen, 6 Zeichencodes (vornehmlich Umlaute) austauschen.
Liefert auerdem 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;
type TNearProc=Word;
function GetFileNameKC(S,buf:PChar;konvert:TNearProc):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 [konvert]
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 [konvert]
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 knnen'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 nchste Sample als vzb. 8-Bit-Wert zur globalen Variable "Amp"}
{Kontext: MMTASK.TSK}
begin
CheckReadBlock; {Ggf. nchsten Block einlesen}
asm les di,[CurWaveHdr]
mov bx,[ByteIndex]
mov al,es:[di+bx+(TYPE TWaveHdr)]
sub al,[WaveDC] {vzl. - vzl. = vzb. mit Sttigung}
jc @@1
jns @@2 {mte positiv sein: OK}
mov al,127 {negativ geworden? Maximale positive Zahl!}
@@1: js @@2 {mte negativ sein: OK}
mov al,-128 {positiv geworden? Minimale negative Zahl!}
@@2: mov [Amp],al
inc [ByteIndex]
end;
(*
Amp:=Integer(CurWaveHdr^.lpData[ByteIndex])-WaveDC;
Inc(ByteIndex);
*)
end;
function ReadSwing1:Integer;
{Liest Samples bis zum nchsten 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;
if LongRec(MyWav.wf.nSamplesPerSec).lo=11025 then Inc(W,W);
ReadSwing1:=W;
end;
function ReadSwing2: Integer;
{Liefert die Zeit in Samples fr eine ganze Schwingung}
{Kontext: MMTASK.TSK}
begin
ReadSwing2:=ReadSwing1+ReadSwing1;
end;
{**************************************}
{** Formatabhngiges 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-Zhler (aufwrts!)}
l: LongInt; {Erwartete Daten-Lnge}
spos1: Integer; {String-Position: ! stehenlassen}
spos2: Integer; {String-Position: ? stehenlassen}
t: PChar; {String-Template}
tl: Integer; {Ausgabe-Lnge 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.l:=MaxLongInt;
BL.t:=t;
BL.tl:=tl;
FillChar(BL.s,31,' ');
end;
procedure HandleBL(var BL:TBL);
{Gelesenen Block behandeln
PE: expect, readbl und ok geeignet gesetzt,
PA: ok (=false bei falscher Blocknummer, =true bei letztem Leseversuch
Blocknummer kommentiert ausgegeben, mit folgenden Markern:
> gelesen OK
? fehlerhaft gelesen; wiederholen (zurckspulen)
! fehlerhaft gelesen, trotzdem OK
* falsche Blocknummer, aber Block OK
- falsche Blocknummer und Block defekt}
begin
with BL do begin
spos2:=tl; {zunchst Platz lassen}
if readbl=expect then begin
if ok then begin
showch:='>';
end else begin
showch:='?';
Inc(retry);
if (retry>=g.Retries) or (g.WaveInDev=-2) then begin
ok:=true; {doch bernehmen}
showch:='!';
end;
end;
if ok then begin
spos2:=0;
retry:=0;
end;
end else begin
showch:='*';
if not ok then showch:='-'; {falsch UND fehlerhaft}
ok:=false; {nicht bernehmen}
end;
wvsprintf(s+spos1+spos2,t,readbl);
if (showch='!') and (spos1<StatusChars-2*tl)
then Inc(spos1,tl); {(einige) Ausrufezeichen-Blcke stehen lassen}
SetStat_LOAD(s);
end;
end;
procedure HandleKCBlockFF(var BL:TBL);
begin
with BL do begin
if (readbl=$FF) {Schlussblock: gekommen?}
and (expect<>$FF) {und nicht erwartet?}
and (retry=0) {und keine Wiederholung?}
then begin
if (l=MaxLongInt) then begin{Datenmenge: unbekannt?}
l:=0; {Datenvolumen erfllt}
expect:=$FF; {Sei erwarteter Block}
end else if BufPtr+$80>=l then begin {Datenmenge erreicht?}
expect:=$FF; {Der Rest steckt in diesem Block}
end;
end;
end;
end;
procedure CatHex(S:PChar; W:Word);
{Hngt 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;
type
TBlock=array[0..127] of Byte; {KC85-Block}
function IsHCBasic(P:PChar; Scope:Byte):Boolean; assembler;
{testet 3 Bytes auf SSS,TTT,UUU,WWW,XXX,YYY +80h}
{Scope=1 fr SSS und WWW, Scope=3 fr alle 6 Typen}
asm les si,[P]
seges lodsb
sub al,0D3h
and al,not 4 ;{Schreibschutz-Bit raus}
cmp al,[Scope]
jnc @@e
mov ah,al
mov di,si
scasw ;{nachfolgende 2 Bytes vergleichen}
clc
jnz @@e
stc
@@e: mov al,0
adc al,al
end;
function HandleMPMHeader(buf:TBlock):LongInt;
{Zeigt den KC85-Header in der Statuszeile und berechnet die Dateilnge}
var
s:TS31;
begin
HandleMPMHeader:=MaxLongInt;
GetFileNameKC(s,PChar(@buf),Ofs(Char_KC2Ansi));
if IsHCBasic(PChar(@buf),1) then begin
HandleMPMHeader:=PWord(@buf[11])^+LongInt(14);
CatHex(s,PWord(@buf[11])^);
BufContent:=SSS; {als BASIC speichern lassen}
end else if IsHCBasic(PChar(@buf),3) then begin
BufContent:=SSS; {als BASIC speichern lassen}
end else if buf[16] in [2..10] 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;
procedure Sync(Vorton,vtu,vto,tzu,tzo:Integer; tzvoll:Boolean);
label step1,step2;
var I,W, au,ao: Integer;
begin
{Schritt 1: Vorton erkennen und aufsynchronisieren}
step1:
I:=Vorton;
repeat
W:=ReadSwing2;
if W<vtu then goto step1;
if W>vto then goto step1;
Dec(I);
until I=0;
{Schritt 2: Trennzeichen holen}
step2:
if tzvoll then begin
au:=min(vtu,tzu);
ao:=max(vto,tzo);
repeat
W:=ReadSwing1 shl 1;
if W<au then goto step1; {Aussetzer im Vorton}
if W>ao then goto step1; {Strnadel im Vorton}
until (tzu<=W) and (W<=tzo);
W:=idiv2(W)+ReadSwing1;
if (W<tzu) then goto step2;
if (W>tzo) then goto step2; {2. halbes Trennzeichen mu folgen!}
end else begin
au:=min(idiv2(vtu),tzu);
ao:=max(idiv2(vto),tzo);
repeat
W:=ReadSwing1;
if W>au then goto step1;
if W<ao then goto step1;
until (tzu<=W) and (W<=tzo);
end;
end;
{h#s-Turbo-Format:
Nach 2 Blcken im normalen KC-Format, die den 128-Byte-Bootstrap-Loader
enthalten, der ab B870h im Modulsteuerwortspeicher landet,
kommt der Speicherabzug
oder das BASIC-Programm (gemeinhin auch ein Speicherabzug).
(Eine frhere Version, die ab B880h lud, ruinierte dort leider
die Modul-Steuerbytes fr den Diskettenaufsatz),
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)
Aha, eine modernisierte Version berschreibt nicht mehr die
Modulsteuerbytes des Disketten-Aufsatzes!
Die bevorzugten Extensionen waren dabei wohl #B# und #C#, oder?
Offset
86 Byte MC/BASIC-Schalter, MC=CDh
A8 Wort Lade-Lnge
D8 Byte Prfsumme
Falls Maschinenprogramm
81 w arg1 = aadr (->11h)
84 w arg2 = eadr (->13h), nur fr Anzeige
E0 b C3h wenn Autostart (->10h=3)
E1 w arg3 = sadr (->15h)
100+ b Daten (->80h)
Falls BASIC-Programm
84 w Endadresse des BASIC-Programms (-1 ->0) (->3D7)
101+ b Daten (->2)
}
const
hs_header: array[0..6] of Byte=( {Bytes ab 10h}
$03,$70,$B8,$F0,$B8,$70,$B8); {aadr=B870, eadr=B8F0, sadr=B870}
hs_baspatch: array[0..3] of Byte=( {Patch-Bytes ab 86h}
$ED,$53,$D7,$03);
{ LD (3D7),DE}
hs_code: array[0..$73] of Byte=( {Bytes ab 80h}
$21,$01,$04,$11,$00,$00,$CD,$03,$F0,$1B,$DB,$88,$F5,$F6,$60,$D3,
$88,$3E,$83,$D3,$8A,$06,$40,$CD,$D5,$B8,$FE,$44,$38,$F7,$10,$F7,
$CD,$D5,$B8,$FE,$68,$38,$F9,$01,$00,$10,$C5,$1E,$08,$CD,$D5,$B8,
$FE,$84,$CB,$12,$1D,$20,$F6,$72,$ED,$A1,$EA,$9B,$B8,$2B,$C1,$3E,
$03,$D3,$8E,$D3,$8A,$3E,$47,$D3,$8E,$3E,$14,$D3,$8E,$F1,$D3,$88,
$AF,$86,$ED,$A9,$EA,$C1,$B8,$FE,$9E,$28,$05,$CD,$03,$F0,$19,$C9,
$CD,$03,$F0,$2C,$C9,$DB,$88,$D3,$88,$DD,$7E,$00,$B7,$28,$F6,$DD,
$36,$00,$00,$C9);
{ LD HL,aadr
LD DE,eadr
OSCALL 1B ;DE und HL ausgeben
IN 88
PUSH AF
OR 60
OUT 88
LD A,83
OUT 8A ;Interrupt PIO A freigeben
B885: LD B,40
B887: CALL B8D5
CP 44
JC B885 ;(-09)
DJNZ B887 ;(-09)
B890: CALL B8D5
CP 68
JC B890 ;(-07)
LD BC,len
PUSH BC
B89B: LD E,08
B89D: CALL B8D5
CP 84
RL D
DEC E
JNZ B89D ;(-0A)
LD M,D
CPI
JPPE B89B
CP B
DEC HL
POP BC
LD A,03
OUT 8E ;DI PIO Port A
OUT 8A ;Reset CTC Kanal 2
LD A,47
OUT 8E
LD A,14 ;CTC Kanal 2 auf normales Blinken stellen
OUT 8E
POP AF
OUT 88
XOR A
B8C1: ADD M
CPD
JPPE B8C1
CP cksum
JZ B8D0 ;(+05)
OSCALL 19 ;Fehlermeldung ERROR
RET
B8D0:
OSCALL 2C ;Neue Zeile (Patch durch Autostart)
RET
B8D5:
IN 88
OUT 88 ;KC85/4-PIO-Interruptlogik freimachen
LD A,(IX+00)
OR A
JZ B8D5 ;(-0A)
LD (IX+00),0
RET
B8E4: }
procedure ReadDataHSTurbo;
{Kontext: MMTASK.TSK}
{Liest nur den Rest der Datei ein!}
var
S: array[0..31] of Char;
Summe,Akku:Byte;
pBuf:PChar;
l: Word;
begin
if BufPtr<>$100 then EndProcess1(false);
LoadString(Seg(HInstance),19,S,sizeof(S)); {'Turbo h#s'}
{Teilweise gefllten Puffer umkopieren zum KCC- oder SSS-Format}
pBuf:=GlobalLock(hBuffer);
if PtrRec(pBuf).ofs<>0 then RunError(221);
asm push ds
mov ds,PtrRec[pBuf].sel
mov ax,[0A8h] {Lade-Lnge holen}
mov [l],ax
mov al,[0D8h] {Prfsumme holen}
mov [Summe],al
cmp byte ptr [86h],0CDh {vom CALL 0F003h}
je @@mc
cmp byte ptr [80h],21h {von mir vernderter BASIC-Header?}
mov ax,[84h]
je @@bas1
mov ax,[81h]
@@bas1: mov [11],ax {Name wird erst von SAVE FILE abgeschnitten}
mov cl,SSS
mov ax,13 {13 Bytes als Header-Lnge}
jmp @@e
@@mc:
mov ax,[81h] {aadr}
mov [11h],ax
mov ax,[84h] {eadr}
mov [13h],ax
mov ax,[0E1h] {sadr}
mov [15h],ax
cmp byte ptr [0E0h],0C3h
jz @@has_start
mov byte ptr [10h],2
@@has_start:
mov cl,KCC
mov ax,80h
@@e:
pop ds
mov [BufContent],cl
mov LongRec[BufPtr].lo,ax {Lnge neu setzen}
end;
if BufContent=SSS then CatHex(S,PWord(pBuf+11)^)
else begin
CatHex(S,PWord(pBuf+17)^);
CatHex(S,PWord(pBuf+19)^);
if pBuf[16]<>#2 then CatHex(S,PWord(pBuf+21)^);
end;
GlobalUnlock(hBuffer);
SetStat_LOAD(S);
Sync(40,12,20,7,11,false);
asm
mov [Akku],0
mov cx,[l]
@@l2: mov dh,8 {8 Datenbits pro Byte}
push cx
@@l1: push dx
call ReadSwing1
pop dx
add ax,-7 {>=7 fhrt zu CY=1}
adc dl,dl {CY einschieben}
dec dh
jnz @@l1
push dx
mov ax,sp {Adresse gepushtes DL}
push ss; push ax
push 1
call AddData
pop dx
pop cx
add [Akku],dl
loop @@l2
end;
if Summe<>Akku then begin
SetStat_LOAD(PChar(111)); {"Lesefehler!"}
EndProcess1(false); {nicht speichern (i.d.R. groer Unsinn)}
end;
end;
{KC-Format:
Die Angaben im KC-Handbuch und (z.Z.) KCEMU-Hilfe sind FALSCH!
Ursache: Die Mhlhuser Programmierer haben die Latenzzeit der
Interruptserviceroutine unterschlagen.
Z.B. Vorton: TC=$2F=47->1179Hz(848s), es sind aber ca. 1060Hz(943s).
In dieser Zeit wird der Timer 2x per ISR neu programmiert, 943-848=95s,
pro Aufruf also 47.5s->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 Datenblcke, 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 ldt weiter
und interessiert sich mitnichten fr den FF-Block
(dieser enthlt 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;
var
I: Integer;
B,Sum:Byte;
begin
ReadBlock:=false;
Sync(Vorton,17,26,27,50,true);
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;
jmpturbo: Boolean;
begin
SetStat_LOAD(PChar(17)); {'KC85,KC87'}
InitBL(BL,' %02X%c',4);
repeat
BL.expect:=$FFFF; {"falscher Block" erzwingen}
BL.ok:=ReadBlock(Byte(BL.readbl),buf,300);
if BL.readbl in [0,1] {Der erste Block kann (am KC87) Nr. 0 sein!}
then BL.expect:=BL.readbl;
HandleBL(BL);
until BL.ok;
jmpturbo:=(g.Coding=HS) or
(g.Coding=AUTO) and
(memcmp(PChar(@buf[16]),PChar(@hs_header),sizeof(hs_header))=0);
AddData(PChar(@Buf),sizeof(buf));
BL.l:=HandleMPMHeader(buf);
repeat
Inc(Byte(BL.expect));
nochmal:
BL.ok:=ReadBlock(Byte(BL.readbl),buf,16);
HandleKCBlockFF(BL); {expect bei Blocknummer FF anpassen}
HandleBL(BL);
if not BL.ok then goto nochmal;
AddData(PChar(@Buf),sizeof(buf));
until BufPtr>=BL.l;
if jmpturbo then ReadDataHSTurbo;
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;
var
I: Integer;
B,Sum:Byte;
begin
ReadBlock:=false;
Sync(Vorton,8,12,20,28,true);
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;
begin
SetStat_LOAD(PChar(18)); {'Turbo MPM'}
InitBL(BL,' %02X%c',4);
BL.expect:=1; {Dieser Block wird zuerst erwartet}
repeat
BL.ok:=ReadBlock(Byte(BL.readbl),buf,300);
HandleBL(BL);
until BL.ok;
AddData(PChar(@Buf),sizeof(buf));
BL.l:=HandleMPMHeader(buf);
repeat
Inc(Byte(BL.expect));
nochmal:
BL.ok:=ReadBlock(Byte(BL.readbl),buf,16);
HandleKCBlockFF(BL); {expect bei Blocknummer FF anpassen}
HandleBL(BL);
if not BL.ok then goto nochmal;
AddData(PChar(@Buf),sizeof(buf));
until GetSize>=BL.l;
end;
{Z1013-Format:
Vorton: Vollschwingung 660 Hz ( 33 Samples)
Trennz: Vollschwingung 1320 Hz ( 17 Samples)
0-Bit: Vollschwingung 2500 Hz (4+5 Samples 4.. 6)
1-Bit: Halbschwingung 1250 Hz ( 9 Samples 7..12)
Wort: Bit0, Bit1, ... Bit15
Block: Vorton (14..2000) - Trennz - Wort (BlockNum = Zieladr.) - 16 Wort -
Wort (Summe ber die vorhergehenden 17(!) Worte)
Die Zieladresse ist stets 0 beim Speichern per Monitor
(also ohne Headersave, mit Kommando "S")
Unklar ist die Zieladresse bei Headersave, wenn Dateityp weder "M"
(Speicherabzug) noch "C" (Programm mit Startadresse), bspw. "B" (Basic)
Datei: HEADERSAVE-Vorblock (bel. Zieladresse), n Datenblcke
HEADERSAVE-Vorblock (leider optional, aber sehr verbreitet):
WORD aadr,eadr,sadr; CHAR creator[6]; BYTE type; BYTE magic[3];
CHAR filename[16]
Die Endadresse <eadr> ist inklusive, also nicht wie beim KC85.
}
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
Sync(VLen,24,42,10,23,true);
Sum:=Wordin;
BlkNum:=Sum;
for I:=0 to 15 do begin
W:=WordIn;
Inc(Sum,W);
Buffer[I]:=W;
end;
ReadBlock:=WordIn=Sum;
end;
label nochmal;
var
BL:TBL;
buf: TBlk;
hs: Boolean; {Headersave gefunden}
begin
SetStat_LOAD(PChar(20)); {'Z1013'}
InitBL(BL,' %04X%c',6);
repeat
BL.ok:=ReadBlock(BL.readbl,buf,25); {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));
BufContent:=DUM;
hs:=false;
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);
BL.l:=buf[1]-buf[0]+LongInt(32);
BufContent:=Z80; {Vorzugs-Speicherformat}
BL.expect:=buf[0];
hs:=true;
end;
repeat
BL.ok:=ReadBlock(BL.readbl,buf,4);
if not hs then BL.expect:=BL.readbl;
HandleBL(BL);
if not BL.ok then continue;
AddData(PChar(@Buf),sizeof(buf));
{ if (BL.l=MaxLongInt) {Datenmenge: unbekannt?}
{ and (ReadSwing2>100) {scheint nichts mehr vom Band zu kommen?}
{ then break; {Schleife beenden!}
Inc(BL.expect,32);
until GetSize>=BL.l; {ohne Headersave Abbruch nur durch Benutzer}
end;
{BASICODE-Format:
0-Bit: Vollschwingung 1200 Hz (18 Samples)
1-Bit: 2 Vollschw. 2400 Hz (9+9 Samples) Diskriminator: 6
Vorton: 1-Bits (svw. vorhergehende Stoppbits)
Startbit: 0-Bit
Byte: Startbit, Bit0, Bit1, ... Bit6, /Bit7, Stopbit, Stopbit
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; assembler;
asm
@@s: call ReadSwing1 {Startbit erfassen}
cmp ax,7
jl @@s
cmp ax,14
jge @@s
call ReadSwing1
cmp ax,7
jl @@s
cmp ax,14
jge @@s
mov ah,8 {Datenbits erfassen}
@@l: push ax
call ReadSwing2
cmp ax,14
jnc @@1
call ReadSwing2
stc
@@1: pop ax
rcr al,1
dec ah
jnz @@l
xor al,$80 {Bit7 andersherum}
end;
var
w: Word;
begin
SetStat_LOAD(PChar(21)); {'BASICODE'}
BufContent:=BAC;
for I:=1 to 40 do begin {Vorton suchen}
W:=ReadSwing1;
if W>=6 then begin
I:=0;
continue;
end;
end;
I:=0;
B:=ByteIn;
if B<>2 then begin {das erste Byte muss 02h (STX) sein!}
SetStat_LOAD(PChar(22)); {'Lesefehler erkannt!'}
ShortYield; {falsches Startbyte ignorieren und weiter}
end;
Sum:=B;
repeat
B:=ByteIn;
Sum:=Sum xor B;
if B=3 then begin {Ende-Byte (ETX), danach Prfsumme}
If ByteIn<>Sum 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); {der Text zum Mitlesen}
I:=0;
end;
until false;
end;
{Automatische Formaterkennung am Vorton:
2400 Hz -> BASICODE (= MPM-Turbo)
1050 Hz -> KC
660 Hz -> Z1013
}
procedure ReadDataAuto; far;
label step1;
var
I,U,O,D,Z: Integer;
S: TS31;
begin
SetStat_LOAD(PChar(16)); {'Suche...'}
step1:
U:=200; O:=0; Z:=200;
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 groe 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<=33) and (33<=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_; assembler;
{Schreibt ein Sample AL (globale Variable) auf die Wave-Ausgabe,
darf nur in ASM aufgerufen werden!}
{Kontext: MMTASK.TSK}
(*
CurWaveHdr^.lpData[ByteIndex]:=Char(Integer(Amp)+$80);
Inc(ByteIndex);
*)
asm push ax
push cx
les di,[CurWaveHdr]
add di,[ByteIndex]
add al,80h
add di,TYPE TWaveHdr
inc [ByteIndex]
stosb
call CheckWriteBlock {Ggf. vollen Block schreiben}
pop cx
pop ax
end;
procedure WriteSwing1_; assembler;
{Schreibt eine Halbschwingung der gewnschten Lnge CX mit abgerundeter
Vorderflanke (e-Funktion mit 1/ 10kHz) -
ansonsten war die Aufzeichnung futsch sowie keine KC-Direktankopplung
(ohne Magnetband) mglich.
Der Wegfall von Stapelrahmen rechtfertigt m.E. Assembler-Prozeduren!
PE: CX=Lnge der Halbwelle
PA: CX=0, AX unverndert!
Kontext: MMTASK.TSK}
asm neg [Amp]
jcxz @@ex {sollte nie vorkommen}
push ax
mov ah,[Amp]
mov al,0 {damit geht's los! (Null-Spannung)}
@@l1: call WriteB_
cmp ah,-1 {Nichts mehr zu schieben...}
je @@2
sar ah,1 {/2, /4, /8 usw.}
jz @@2 {Raus wenn Null (Amp positiv)}
add al,ah {dazu, gibt 1/2, 3/4, 7/8 usw.}
loop @@l1
jmp @@e
@@2:
mov al,[Amp]
@@l2: call WriteB_ {Fr den Rest volle Amplitude ausgeben}
loop @@l2
@@e: pop ax
@@ex:
end;
procedure WriteSwing1(Len:Integer); assembler;
{Kapsel fr ASM-Prozedur}
{Kontext: MMTASK.TSK}
asm mov cx,[Len]
call WriteSwing1_
end;
procedure WriteSwing2_; assembler;
{Ganze Schwingung der gewnschten Lnge (in 22-kHz-Samples) schreiben
PE: CX=Lnge, PA: CX=0, AX unverndert}
{Kontext: MMTASK.TSK}
asm mov dx,cx
shr cx,1
sub dx,cx
push dx
call WriteSwing1_
pop cx
jmp WriteSwing1_ {normalerweise: Einlauf!}
end;
procedure WriteSwing2(Len:Integer); assembler;
{Kapsel fr ASM-Prozedur}
{Kontext: MMTASK.TSK}
asm mov cx,[Len]
call WriteSwing2_
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
mov cx,11
jnc @@1
mov cl,21
@@1: call WriteSwing2_
dec ah
jnz @@l
mov cl,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: Word;
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
mov cx,5
jnc @@1
mov cl,12
@@1: call WriteSwing1_
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;
(*
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;
*)
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 ax,512
@@l: mov cx,30
call WriteSwing2_
dec ax
jnz @@l
mov cl,9
call WriteSwing1_ {Trennzeichen}
end;
while GetData(PChar(@B),1)<>0 do asm
mov al,[B]
mov ah,8
@@l: mov cx,4 {Null-Bit}
add al,al
jnc @@1
mov cl,9 {Eins-Bit}
@@1: call WriteSwing1_
dec ah
jnz @@l
end;
end;
procedure WriteDataZ1013; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer, stets mit Headersave}
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
mov dx,offset WriteSwing1_
jc @@1
mov dx,offset WriteSwing2_
@@1: mov cx,9
call dx
pop cx
loop @@l
end;
procedure WriteBlock(const Buffer:TBlk; W:Word; Vorton:Integer);
var
I:Integer;
Sum:Word;
begin
repeat WriteSwing1(17); Dec(Vorton); until Vorton=0; {Vorton}
WriteSwing2(16); {Trennzeichen}
WriteWord(W); {Zieladresse = Blocknummer}
Sum:=W;
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;
if true then begin {stets mit Headersave}
GetData(PChar(@buf),sizeof(buf));
GetFileNameZ80(S,PChar(@buf));
CatHex(S,buf[0]);
CatHex(S,buf[1]);
if PChar(@buf)[12]='C' then CatHex(S,buf[2]);
Setstat_SAVE(S);
WriteBlock(buf,0,I);
W:=buf[0];
I:=1000; {Zwischen-Vorton}
end else W:=0; {Zieladresse unbekannt}
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 WriteBit(B:Byte); {Bit 0 (0 oder 1) ausgeben}
begin
if B and 1 =0 then WriteSwing2(18)
else begin WriteSwing2(9);WriteSwing2(9);end;
end;
procedure WriteByte(B:Byte);
var
I,W:Integer;
begin
Sum:=Sum xor B;
asm xor [B],$80 end;
WriteBit(0); {Startbit}
for I:=0 to 7 do begin
WriteBit(B); {Datenbit}
asm shr [B],1 end;
end;
WriteBit(1); {2 Stoppbits}
WriteBit(1);
end;
begin
SetStat_SAVE(PChar(21));
Sum:=0;
for I:=1 to 4500 do WriteBit(1);
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);
for I:=1 to 1750 do WriteBit(1);
end;
{-Dialogfunktionen----------------------------------------------------------}
const
ID_OfnWriteProt=1040;
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word; export;
{trgt lediglich 'mit Vorblock' ein;
sollte 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: TLfnBuf; {Gerade aktiver Dateiname}
SFilter: TS255;
SExt: TS31;
const
hm: Word=WM_User+100; {HelpMessageString-Nachricht}
const
Ofn: TOpenFileName=(
lStructSize: sizeof(TOpenFileName);
hWndOwner: 0;
hInstance: 0; {nur wichtig fr lpTemplateName}
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):=g.Filter;
if g.Filter<>NON then begin
SP1:=SFilter; {Mibrauch!}
for I:=Integer(g.Filter)*2 downto 2 {min. 1x}
do Inc(SP1,lstrlen(SP1)+1); {auf den Filter-Ausdruck}
{"Bug" der COMMDLG.DLL bereinigen:
Wenn ein Filter <>0 vorgegeben wird, soll auch das zuletzt genutzte
User-Filter (welches die COMMDLG.DLL stets in SExt+1 speichert)
an der Stelle des Vorgabe-Filters wirksam werden.
Beispiel:
* User whlt "Maschinenkode\0*.kcc" = Filter Nr.2
* User gibt neues Filter ein: "*.com"
* User whlt eine (.com-)Datei aus
* COMMDLG.DLL speichert nFilterIndex=2 und lpstrCustomFilter+1="*.com"
Nunmehr: User ffnet Datei-Dialog nochmals
* User sollte "Maschinenkode\0*.com" als Filter Nr.2 zu sehen bekommen!
(ansonsten msste er immer wieder "*.com" eintippen, wie das leider
bei der Mehrzahl der Windows-Programme der Fall ist)
COMMDLG ignoriert lpstrCustomFilter, da muss man nun selbst "basteln"
und "SFilter" entsprechend modifizieren (deshalb ist SFilter statisch!)
}
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 Eintrge 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 ausgewhlt?}
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 {Grobuchstabe}
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
mov dh,byte ptr [ofn.nFileExtension]
sub dh,byte ptr [ofn.nFileOffset]
@@l1: lodsb
or al,al {Ende extensionsloser Dateiname}
jz @@2
dec dh {Ende Dateiname (Namensbestandteil)}
jz @@2 {der LETZTE Punkt ist magebend!}
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 lschen!}
jmp @@l1 {Extension <blank-padded> anhngen}
@@3: end;
function GetCoding:ACoding;
{Ermittelt Kodierung, lst "automatisch" anhand Filter auf}
begin
case g.Coding of
AUTO: case g.Filter of
Z80: GetCoding:=Z1013;
BAC: GetCoding:=BASICODE;
else GetCoding:=KC;
end;
else GetCoding:=g.Coding;
end;
end;
function Char_KC2UML:Char; assembler;
{Zeichen-Bereich begrenzen, 6 Zeichencodes (vornehmlich Umlaute) austauschen.
Der Z1013 hat leider keine Umlaute.
Liefert auerdem Flags vom Vergleich des Zeichens mit ' '!}
asm push dx
and al,7Fh
cmp al,5Ch
mov dh,7Ch {Pipe-Symbol}
je @@2
cmp al,5Dh
mov dh,'-' {Negations-Zeichen}
je @@2
cmp al,7Bh
mov dx,'ea' {}
je @@3
cmp al,7Ch
mov dx,'eo' {}
je @@3
cmp al,7Dh
mov dx,'eu' {}
je @@2
cmp al,7Eh
mov dx,'ss' {}
jne @@e
@@3: xchg dl,al
stosb {knallhart dazusetzen}
@@2: xchg dh,al
@@e: cmp al,' '
ja @@1
mov al,' '
@@1: pop dx
end;
function KCC2Z80(pBuf:PChar; var buflen:LongInt):boolean; assembler;
asm cld
push ds
lds si,[pBuf]
add si,16
lodsb
cmp al,11
cmc
jc @@e {nicht konvertierbar}
cmp al,2
jc @@e {nicht konvertierbar}
mov dl,'M' {Maschinenprogramm, nicht selbststartend}
jz @@1
mov dl,'C' {Maschinenprogramm, selbststartend}
@@1: push ds
pop es
lea di,[si+60h-17]
lodsw
stosw {aadr}
xchg cx,ax
lodsw
dec ax
stosw {eadr}
inc ax
sub ax,cx {Stack=Lnge}
push ax
movsw {sadr}
mov ax,'CK'
stosw
mov ax,'oL'
stosw
mov ax,'da'
stosw
xchg dx,ax
mov ah,0D3h
stosw
mov al,ah
stosw
push ds
push di
push ds
push PtrRec[pBuf].ofs
push offset Char_KC2UML
call GetFileNameKC
pop dx
mov cx,16
sub cx,ax
jc @@e {Name zu lang: verpfuscht!}
mov al,' '
dec si {Terminierende Null tilgen}
rep stosb {Rest mit Leerzeichen auffllen}
xchg dx,ax
add ax,80h
jc @@e {zu lang zum Verarbeiten}
les di,[buflen]
cmp es:LongRec[di].hi,0
jnz @@2
cmp es:LongRec[di].lo,ax
jc @@e {Datenmenge zu gering!}
@@2:
sub ax,60h
mov cx,ax {tatschliche Byte-Menge}
add ax,1Fh
and ax,not 1Fh {auf Block-Grenzen aufrunden}
stosw {neue Datenmenge eintragen}
sub ax,cx {Fll-Bytes im letzten Block}
push ax
xor ax,ax
stosw {High-Teil nullsetzen}
mov di,PtrRec[pBuf].ofs
lea si,[di+60h]
push ds
pop es
rep movsb {Header und Daten runterkopieren}
pop cx
mov al,1Ah {EOF}
stosb {auffllen}
@@e: pop ds
mov al,TRUE
sbb al,0
end;
function DUM2KCC(FName, pBuf:PChar; var buflen:LongInt):Boolean; assembler;
{Alles Wahrscheinlichkeitstheorie!
Falls buflen<64K, dann Ladeadresse 200h
Falls buflen in ganzen Blcken dann ASM-Format (argc=0)
Falls buflen "krumm" dann BASIC-Format}
asm
end;
type TFileInfo=record
HasHeader: Boolean;
argn: Byte; {0=unbekannt, 1=BASIC, 2..FF=MC}
a,e,s: Word;
end;
var
FileInfo: TFileInfo;
function CheckFile(Name:PChar; var Filter:AFilter): Integer;
{Testet Datei <Name> oder auch geffnete Datei <LOWORD(Name)>
auf Gltigkeit und korrigiert ggf. Filter:
0 Bei unbekanntem Filter und den sicheren Endungen KCC, SSS und Z80
Filter vorbesetzen (ohne Datei zu ffnen), fr Drag'n'Drop ->
behindert Missbrauch dieser Endungen
1 Nicht zu ffnende Dateien -> FALSE
2 Datei-Lnge Null -> FALSE
3 Filter gegeben und nur Header-Lnge -> FALSE
(KC- und Z1013-Programme kommen hiermit sowieso nicht zurecht)
entfllt: 4 Beim Fehlen typischer Header-Merkmale
Rckstufung auf "Speicherabzug"
5 Header-Merkmale OK und Datei zu kurz -> FALSE
Dateizeiger steht beim Beenden irgendwo!
BytesToWrite ist auf Dateilnge gesetzt
HasHeader wird gesetzt, wenn:
KCC: immer
DUM: nie
SSS: wenn die Datei (irrtmlich) einen Header hat
Z80: wenn die Datei (blich) einen HEADERSAVE-Header hat
BAC: nie
IsMC wird gesetzt, wenn:
KCC: wenn das Byte "Anzahl Argumente" 2..10 ist
DUM: immer
SSS: nie
Z80: wenn ohne Header oder Typ='C' oder 'M'(?) ist
BAC: nie
Liefert String-ID als Fehlerkode; -090420: IDs, Grenvergleich
}
label skiplh,exi;
var
f: HFile absolute Name;
flen: LongInt;
ext: PChar;
hdr: array[0..31] of Char;
begin
if PtrRec(Name).sel<>0 then begin
{Dateityp-Vorbestimmung anhand Endung}
if Filter=NON then begin {Anhand der Endung Typ vorbestimmen}
ext:=GetFileNameExt(Name);
if ext^='.' then begin
Inc(ext);
if lstrcmpi(ext,'KCC')=0 then Filter:=KCC
else if lstrcmpi(ext,'SSS')=0 then Filter:=SSS
else if lstrcmpi(ext,'Z80')=0 then Filter:=Z80
end;
end;
f:=_lopen2(Name,OF_Share_Deny_Write);
end;
CheckFile:=96; {"kann nicht ffnen"}
if f=-1 then exit; {Punkt 1}
flen:=_llseek(f,0,2);
CheckFile:=97; {"leere Datei"}
_llseek(f,0,0);
FillChar(hdr,32,0);
if _lread(f,hdr,32)=0 then goto exi; {Punkt 2}
CheckFile:=98; {"zu kurz"}
if (Filter=KCC) and (flen<=$80) then goto exi;{Punkt 3}
{Dateityp-Bestimmung anhand Header, SSS kann nicht erkannt werden!}
if Filter=NON then begin
Filter:=DUM; {Allgemeine Annahme}
if (flen>$20) {knnte Z1013- oder KCC-Header sein}
and (hdr[13]=#$D3) and (PWord(hdr+14)^=$D3D3) then Filter:=Z80
else if (flen>$80) and (PLongInt(hdr+12)^=0)
and (PByte(hdr+16)^ in [2..4]) then Filter:=KCC
else if PWord(hdr+0)^=flen-1 then Filter:=SSS
else if IsHCBasic(hdr,3) then Filter:=SSS;
end;
with FileInfo do begin
HasHeader:=false;
argn:=0;
{Datei-Konsistenzprfung, SSS (wegen TTT, TXW) nicht prfbar}
case Filter of
KCC: begin
HasHeader:=true;
Move(hdr[16],argn,7);
if argn in [2..10] then begin {nur dies ist prfbar!}
if e<=a then begin CheckFile:=99; goto exi; end;
{Ende<=Anfang, KC kann das nicht laden! "inkonsistent"}
if e-a > flen-$80 then goto exi; {Datei zu kurz}
end else argn:=0;
end;
DUM: begin
argn:=2;
a:=$200;
e:=a+LongRec(flen).lo;
end;
SSS: begin
HasHeader:=IsHCBasic(hdr,3);
argn:=1; {Unsicher! Bei TTT, TXW Null!}
end;
Z80: if (hdr[13]=#$D3) and (PWord(hdr+14)^=$D3D3) then begin
HasHeader:=true;
Move(hdr,a,6); Inc(e);
case hdr[12] of
'C': argn:=3;
'M': argn:=2;
end;
if Word(e-1)<a then begin CheckFile:=99; goto exi; end;
{Ende=Anfang ist hier OK = 1 Byte!}
if e-a > flen-$20 then goto exi; {Datei zu kurz}
end;
end;
end;
{Hier angekommen sind die Prfungen bestanden}
BytesToWrite:=flen;
CheckFile:=0;
exi:
if PtrRec(Name).sel<>0 then _lclose(f);
end;
function LoadFile(Name:PChar; Filter:AFilter):Boolean;
label exi, exi2, exi3;
{ 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: HFile;
pBuf: PChar;
buf: TBlock;
This_Coding: ACoding;
add,EC: Integer;
begin
LoadFile:=false;
EC:=96; {"kann nicht ffnen"}
f:=_lopen2(SFile,OF_Share_Deny_Write);
if f=-1 then goto exi2;
EC:=CheckFile(PChar(f),Filter);
if EC<>0 then goto exi;
{$IFOPT D+} asm int 3 end; {$ENDIF}
add:=0;
This_Coding:=g.Coding;
case Filter of
KCC: begin
if not (This_Coding in [AUTO,KC,MPM,HS,Z1013]) {Code-Zwang!}
then This_Coding:=KC;
end;
DUM: begin
add:=$80;
if not (This_Coding in [AUTO,KC,MPM,HS,Z1013]) {Code-Zwang!}
then This_Coding:=KC;
end;
SSS: begin
if not FileInfo.HasHeader then add:=11;
if not (This_Coding in [AUTO,KC,MPM,HS]) {Code-Zwang!}
then This_Coding:=KC;
end;
Z80: begin
add:=$80;
if not (This_Coding in [AUTO,KC,MPM,HS,Z1013]) {Code-Zwang!}
then This_Coding:=Z1013;
if FileInfo.HasHeader then begin
add:=$60;
if (FileInfo.argn<2) {Nicht-MC kann nicht gewandelt werden}
and not (This_Coding in [AUTO,Z1013])
then This_Coding:=Z1013;
end;
end;
BAC: if not (g.Coding in [AUTO,BASICODE]) {Code-Zwang!}
then This_Coding:=BASICODE;
end;
if g.Coding<>This_Coding
then SendDlgItemMessage(MainWnd,12,CB_SetCurSel,Word(This_Coding),0);
This_Coding:=GetCoding;
if This_Coding=Z1013 then Dec(add,$60); {Immer mit Headersave speichern}
_llseek(f,max(0,-add),0);
hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share or GMEM_ZeroInit,
BytesToWrite+$100);
pBuf:=GlobalLock(hBuffer);
if _hread(f,pbuf+max(0,add),BytesToWrite)<>BytesToWrite then goto exi;
if add<>0 then case This_Coding of
KC,MPM,HS: begin
FillChar(pbuf[$60],$20,0); {evtl. Z80-Header killen}
if pbuf[0]=#0 then PutFileName(pbuf);
if FileInfo.argn>=2 then Move(FileInfo.argn,pbuf[16],7);
end;
Z1013: begin
if FileInfo.argn>=2 then begin
Move(FileInfo.a,pbuf[0],6);
pbuf[12]:='M';
if FileInfo.argn>2 then pbuf[12]:='C';
end;
if pbuf[6]=#0 then begin {Programmlogik-Problem! Test notwendig?}
Move(RegPath[6],pbuf[6],6); {'KCLOAD' als Creator einsetzen}
end;
pbuf[13]:=#$D3;
PWord(pbuf+14)^:=$D3D3;
if pbuf[16]=#0 then PutFileName(pbuf+16); {besser:LongFileName}
end;
end;
Inc(BytesToWrite,Add);
if _lclose(f)<>0 then goto exi2;
GlobalUnlock(hBuffer);
LoadFile:=true;
exit;
exi:
_lclose(f);
exi2:
GlobalUnlock(hBuffer);
hBuffer:=GlobalFree(hBuffer);
exi3:
MBox1(MainWnd,EC,MB_OK or MB_IconExclamation,SFile);
end;
procedure LoadFileDialog;
begin
PrepareOfn;
asm or LongRec[ofn.Flags].lo,OFN_FileMustExist end;
if not GetOpenFileName(ofn) then exit;
g.Filter:=AFilter(ofn.nFilterIndex);
SendMessageP(MainWnd,WM_OpenFile,LongRec(ofn.nFilterIndex).lo,@SFile);
end;
procedure HaveLFN; assembler; {liefert CY=1 wenn kein LFN}
const
rootname: array[0..3] of Char='C:\';
var
buf: TS31;
asm mov ah,19h
int 21h
add al,'A'
mov byte ptr [rootname],al
mov dx,offset rootname
push ss
pop es
lea di,buf
mov cx,32
stc
mov ax,71A0h
int 21h
end;
const
InvalChars: array[0..17] of Char='"<|>:\/*? .+,;=[]'; {ab ' ' fr SFN}
SubstChars: array[0..17] of Char='--__-{}';{hnliche Latin1-Formen}
procedure StripInvalChars(S:PChar); assembler;
asm call HaveLFN
mov dx,9 {Anzahl ungltiger Zeichen}
jnc @@1
add dx,8 {noch mehr ungltig! Fehlt noch: 8.3-Krzung!}
@@1:
cld
push ds
push ds
pop es
lds si,[S]
@@l: lodsb
or al,al
jz @@e
mov cx,dx
mov di,offset InvalChars
repne scasb
jne @@l
{ mov al,[di+16] {knnte funktionieren:-)}
sub di,offset InvalChars
{ add di,offset SubstChars-1}
mov al,[di+offset SubstChars-1]
mov [si-1],al
jmp @@l
@@e: pop ds
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);
g.Filter:=BufContent;
PrepareOfn;
asm and LongRec[ofn.Flags].lo,not OFN_FileMustExist end;
{fr Turbolader h#s und Z1013 ohne Headersave Dateiname weglassen;
durch zweckmige Vorgabe wie UnbenanntXXX ersetzen}
case g.Filter of
KCC,SSS: GetFileNameKC(SFile,pBuf,Ofs(Char_KC2Ansi));
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,MB_Sound or MB_IconExclamation or MB_OK,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: MBox0(MainWnd,102,MB_IconExclamation);
WAVERR_Sync: MBox0(MainWnd,101,MB_IconExclamation);
else begin
WaveInGetErrorText(Code,S,sizeof(S));
MBox1(MainWnd,103,MB_IconExclamation,S)
end;
end;
end;
procedure SetModus(NewModus:AModus);
begin
if Modus<>NewModus then begin
Modus:=NewModus;
DragAcceptFiles(MainWnd,Modus=NONE);
EnableDlgItem(MainWnd,1,Modus=NONE);
EnableDlgItem(MainWnd,22,Modus=NONE);
ShowDlgItem(MainWnd,2,Integer(Modus<>NONE));
ShowDlgItem(MainWnd,3,Integer(Modus=NONE));
ShowDlgItem(MainWnd,19,Integer(Modus=LOAD));
if (Modus=NONE) and IsIconic(MainWnd)
then SetWindowText(MainWnd,AppName);
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(g.Coding),@LibName);
LibInst:=LoadLibrary(LibName);
if LibInst<32 then begin
MBox1(MainWnd,114,MB_IconExclamation,LibName);
exit;
end;
P:=GetProcAddress(LibInst,Entry);
if P=nil then begin
MBox1(MainWnd,115,MB_IconExclamation,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-Vernderung 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-Gerte-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;
lParP: PChar 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}
GetWindowText(Wnd,AppName,sizeof(AppName));
WUtils.StdMBoxTitle:=AppName; {MessageBox-Titel 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;
g.Retries:=GetInt(SP,4);
PInteger(@g.Coding)^:=GetInt(SP,0);
PInteger(@g.WaveVol)^:=GetInt(SP,4);
g.WaveInDev:=GetInt(SP,0);
g.WaveOutDev:=GetInt(SP,0);
SetDlgItemInt(Wnd,11,g.Retries,true);
if g.WaveInDev=-2 then EnableDlgItem(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(g.Coding),0);
SetDlgItemInt(Wnd,13,g.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,g.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_1M08 or WAVE_Format_2M08)<>0)
then IODev_AddString(W,WaveInCaps.szPName,J,g.WaveInDev);
end;
W:=GetDlgItem(Wnd,15); {Handle Kombibox WaveOUT}
IODev_AddString(W,S,-2,g.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,g.WaveOutDev);
end;
if g.AutoSave then CheckDlgButton(Wnd,18,1);
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);
if IsIconic(Wnd) then SetWindowText(Wnd,StatusBuf);
end;
WM_Size: asm
push [Wnd]
push ds
mov ax,offset AppName
cmp [wParam],SIZE_Minimized
jne @@1
mov ax,offset StatusBuf
@@1: push ax
call SetWindowText
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 (MBox0(Wnd,113,
MB_Sound or MB_IconQuestion or MB_YesNo or MB_DefButton2)<>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 MBox0(Wnd,113,
MB_Sound or MB_IconQuestion or MB_YesNo or MB_DefButton2)<>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_OpenFile: begin {wParam=Filter-Typ, lParam=(LFN-)Dateiname mit Pfad}
if Modus=NONE then begin {Datei in <SFile> (Filter) ausgeben}
if not LoadFile(lParP,AFilter(wParam)) 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(g.WaveVol)*2;
SetModus(SAVE);
MMTaskCreate(@WaveOutTask,Task,LongInt(Proc));
end;
end;
WM_DropFiles: begin {umwandeln in WM_OpenFile-Nachrichten}
DragQueryFile(wParam,0,SFile,sizeof(SFile)); {SFN}
TranslateName(SFile,SFile,TN_Longname or TN_SubstDrive);
if (DragQueryFile(wParam,Word(-1),nil,0)=1)
or (MBox1(MainWnd,118,MB_IconQuestion or MB_YesNo,SFile)=IDYes)
then SendMessageP(Wnd,WM_OpenFile,0,@SFile);
DragFinish(wParam);
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 g.Retries:=I;
end;
12: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then g.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
g.WaveVol:=I;
I:=sqr(g.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
g.WaveInDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
EnableDlgItem(Wnd,11,g.WaveInDev<>-2);
end;
end;
15: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then g.WaveOutDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
end;
18: g.AutoSave:=Boolean(IsDlgButtonChecked(Wnd,wParam));
{Tastendrcke}
3: SendMessage(Wnd,WM_Close,0,0); {Programmende}
IDCancel: begin {Abbruch}
SetStat_LOAD(PChar(110));
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 g.Coding of
AUTO: Proc:=@ReadDataAuto;
KC: Proc:=@ReadDataKCC;
MPM: Proc:=@ReadDataMPMTurbo;
HS: Proc:=@ReadDataKCC; {kmmert sich selbst ums TURBO}
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: LoadFileDialog; {Datei ausgeben}
23: begin
Installed:=true;
wvsprintf(S,'%d %d %d %d %d',g);
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:@RegPath[6]); {'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;
procedure SetStatus(S:PChar); export;
begin
if Modus=LOAD
then SetStat_LOAD(S)
else 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, {Fluwechsel lesen}
WriteSwing index 3, {Fluwechsel schreiben}
EndProcess index 4, {Vorzeitig abbrechen}
SetStatus index 5, {Statuszeile setzen}
GetSizeData index 6, {restliche Bytes ermitteln}
GetDataBlock index 7, {Nchsten Datenblock aus Puffer lesen}
AddDataBlock index 8, {Neuen Datenblock in Puffer anhngen}
GetName index 9, {DOS-Dateiname holen}
SetNameHint index 10; {DOS-Dateiname vorschlagen}
begin
if HPrevInst<>0 then begin {Nicht doppelt starten!}
MainWnd:=MemW[HPrevInst:Ofs(MainWnd)];
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 Vernderungen (* = gendert, - = Bugfix, + = neues Feature):
*020100 Wave-Datei-Verarbeitung auf Windows-Chunk-Befehle umgestellt
-020100 Wave-Datei-Voreinstellung in Kombinationsfenster korrigiert
-130508 Vollaussteuerung beim Einlesen fhrte zu Lesefehler:
berlauf bei Subtraktion von Gleichspannungswert
}
Vorgefundene Kodierung: UTF-8 | 0
|