program KCLOAD;
{$D KC-Load 0.58 (04/09)}
{$R-,S-,I-,Q-,W-,K+,G+,A+}
{$C MOVEABLE PRELOAD PERMANENT}
{$R KCLOAD.RES}
{$M $3000,$1000}
{$DEFINE MOTOR} {=Motorschaltspannung}
{Wünschenswerte 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: grüne Aussteuerungs-Anzeige
* OK: Motorschaltspannungs-Unterstützung (Int15/AH=0&1)
* OK: Unverfrühte Statusanzeige bei SAVE
* OK: Mehr als nur 2 Puffer
* Mehrere Dateien hintereinanderweg: NÖ! (LFN beißt sich mit MultiSelect)
* Fortschrittsbalken: % der Datei gelesen; Lese-Zeiger akt. Block
* Aussagekräftige Titelzeile falls Icon: teilweise
* zweizeiliges Statusfenster für Lade-Name, Argumente und Blocknummern
* Blocknummern-Anzeige auch vor dem 1. Block
* Immer ein Wave-Gerät auswählen
}
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; {für Ein- und Ausgabe (erfolgt nie gleichzeitig)}
Waves: array[0..42] of THandle; {Puffer für ca. 4 Sekunden}
Queued: Integer; {Wave-Blöcke 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; {Lautstärke-Multiplikator (log.) bei Ausgabe}
AutoSave: Boolean; {Schalter für Automatisches Speichern}
WaveInDev: Integer; {Nummer des Ein- bzw. Ausgabegerätes: }
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 für momentanes Sample in CurWaveHdr}
Task: THandle; {Handle der MMTASK.TSK ("Windows-3.1-Thread")}
LibInst: THandle; {Geladene KCL-Bibliothek}
Back: HBrush; {Hintergrundpinsel für Statusfenster (Blau)}
Green: HBrush; {Pinsel für Aussteuer-Anzeige (Dunkelgrün)}
Font: HFont; {Schrift für Statuszeile}
StatusChars: Integer; {Anzahl sichtbarer Zeichen in Statuszeile}
ckRIFF,ck: TMmCkInfo; {RIFF-Merker zum (Lesen und) Schreiben}
const
WAVBLK=$800; {je größer, desto weniger Last, aber asynchroner}
{2 KB ist eine "Idealgröße" für 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; {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!)}
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] {Zusammenzählen}
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, gefüllt 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;
{Prüft auf ausgelesenen Puffer und beschafft ggf. einen neuen}
begin
if ByteIndex>=LongRec(CurWaveHdr^.dwBytesRecorded).Lo
then ProcessBlock; {Nächsten Block einlesen}
end;
procedure CheckWriteBlock;
{Prüft 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 "Präparation" dieser Puffer.
Beim Speichern "hängt" an diesem Puffer auch noch Platz für
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 erlösen}
{$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 Flußwechsel}
if ByteIndex<>0 then begin
LongRec(CurWaveHdr^.dwBufferLength).Lo:=ByteIndex;
ProcessBlock;
end;
if g.WaveOutDev>-2 then while Queued<>0 do begin
{Die frühere Methode, WaveOutClose zu versuchen, bis kein WAVERR_StillPlaying
kommt, hat den Fehler, dass die Puffer nicht mehr unpräpariert werden können}
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 unpräparieren 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 rücksetzen (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 zurück}
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 unterstütztes 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 zurück}
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;
{**********************************************}
{** Formatabhängiges 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 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;
type TNearProc=Word;
function GetFileNameKC(S,buf:PChar;konvert:TNearProc):integer;assembler;
{Dateiname von Pufferzeiger buf (hier: 11 Bytes, mit Leerzeichen aufgefüllt)
nach S (als ASCIIZ 8.3) extrahieren,
bei den typischen BASIC-Dateinamen wird die vorn liegende Extension
nach hinten gebracht.
Leerzeichen und ungültige 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 {Vorrücken 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 {Vorrücken 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 für 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
CheckReadBlock; {Ggf. nächsten Block einlesen}
asm les di,[CurWaveHdr]
mov bx,[ByteIndex]
mov al,es:[di+bx+(TYPE TWaveHdr)]
sub al,[WaveDC]
mov [Amp],al
inc [ByteIndex]
end;
(*
Amp:=Integer(CurWaveHdr^.lpData[ByteIndex])-WaveDC;
Inc(ByteIndex);
*)
end;
function ReadSwing1:Integer;
{Liest Samples bis zum nächsten Nulldurchgang und liefert die Sample-Anzahl,
somit die Zeit für 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 für 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!)}
l: LongInt; {Erwartete Daten-Länge}
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.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 (zurückspulen)
! fehlerhaft gelesen, trotzdem OK
* falsche Blocknummer, aber Block OK
- falsche Blocknummer und Block defekt}
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>=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-Blöcke 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 erfüllt}
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);
{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;
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 für SSS und WWW, Scope=3 für 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 Dateilänge}
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); {müsste 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; {Störnadel 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 Blöcken 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 frühere Version, die ab B880h lud, ruinierte dort leider
die Modul-Steuerbytes für 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 Prüfsumme 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-Länge
D8 Byte Prüfsumme
Falls Maschinenprogramm
81 w arg1 = aadr (->11h)
84 w arg2 = eadr (->13h), nur für 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 gefüllten 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-Länge holen}
mov [l],ax
mov al,[0D8h] {Prüfsumme holen}
mov [Summe],al
cmp byte ptr [86h],0CDh {vom CALL 0F003h}
je @@mc
cmp byte ptr [80h],21h {von mir veränderter 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-Länge}
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 {Länge 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 führt 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. großer Unsinn)}
end;
end;
{KC-Format:
Die Angaben im KC-Handbuch und (z.Z.) KCEMU-Hilfe sind FALSCH!
Ursache: Die Mühlhä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 Befehlsausführungszeit von 11 Takten). Kommt genau hin!
(Dummerweise wird die CTC rückgesetzt, 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 vernünftige Definition des Vorblock-Inhaltes, verschiedene
Auslegung für 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 für 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;
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
kürzer 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 Glück 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 Datenblöcke
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; {Für 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 für Text.
Datei: Vorton (9000) - 2 (SOT = Start Of Text) - Text -
3 (EOT = End Of Text) - Prüf-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 Prüfsumme}
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 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<=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 gewünschten Länge CX mit abgerundeter
Vorderflanke (e-Funktion mit 1/τ ≈ 10kHz) -
ansonsten war die Aufzeichnung futsch sowie keine KC-Direktankopplung
(ohne Magnetband) möglich.
Der Wegfall von Stapelrahmen rechtfertigt m.E. Assembler-Prozeduren!
PE: CX=Länge der Halbwelle
PA: CX=0, AX unverändert!
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_ {Für den Rest volle Amplitude ausgeben}
loop @@l2
@@e: pop ax
@@ex:
end;
procedure WriteSwing1(Len:Integer); assembler;
{Kapsel für ASM-Prozedur}
{Kontext: MMTASK.TSK}
asm mov cx,[Len]
call WriteSwing1_
end;
procedure WriteSwing2_; assembler;
{Ganze Schwingung der gewünschten Länge (in 22-kHz-Samples) schreiben
PE: CX=Länge, PA: CX=0, AX unverändert}
{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 für 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 für 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;
{trägt 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 für 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; {Mißbrauch!}
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 wählt "Maschinenkode\0*.kcc" = Filter Nr.2
* User gibt neues Filter ein: "*.com"
* User wählt 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 müsste 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 einfügen}
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 auffüllen;
weitere Voraussetzungen sind gültige 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 für 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
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 maßgebend!}
call Char_ANSI2KC
stosb
loop @@l1
@@2: mov al,' '
rep stosb {Rest mit Leerzeichen auffüllen (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 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 außerdem 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=Länge}
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 auffüllen}
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 {tatsächliche Byte-Menge}
add ax,1Fh
and ax,not 1Fh {auf Block-Grenzen aufrunden}
stosw {neue Datenmenge eintragen}
sub ax,cx {Füll-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 {auffüllen}
@@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 Blöcken 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 geöffnete Datei <LOWORD(Name)>
auf Gültigkeit und korrigiert ggf. Filter:
0 Bei unbekanntem Filter und den sicheren Endungen KCC, SSS und Z80
Filter vorbesetzen (ohne Datei zu öffnen), für Drag'n'Drop ->
behindert Missbrauch dieser Endungen
1 Nicht zu öffnende Dateien -> FALSE
2 Datei-Länge Null -> FALSE
3 Filter gegeben und nur Header-Länge -> FALSE
(KC- und Z1013-Programme kommen hiermit sowieso nicht zurecht)
entfällt: 4 Beim Fehlen typischer Header-Merkmale
Rückstufung auf "Speicherabzug"
5 Header-Merkmale OK und Datei zu kurz -> FALSE
Dateizeiger steht beim Beenden irgendwo!
BytesToWrite ist auf Dateilänge gesetzt
HasHeader wird gesetzt, wenn:
KCC: immer
DUM: nie
SSS: wenn die Datei (irrtümlich) 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, Größenvergleich
}
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) {könnte 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-Konsistenzprüfung, SSS (wegen TTT, TXW) nicht prüfbar}
case Filter of
KCC: begin
HasHeader:=true;
Move(hdr[16],argn,7);
if argn in [2..10] then begin {nur dies ist prüfbar!}
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 Prüfungen 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 ' ' für SFN}
SubstChars: array[0..17] of Char='┤½ª╗¿--ñ┐á_▒_¿-{}';{ähnliche Latin1-Formen}
procedure StripInvalChars(S:PChar); assembler;
asm call HaveLFN
mov dx,9 {Anzahl ungültiger Zeichen}
jnc @@1
add dx,8 {noch mehr ungültig! Fehlt noch: 8.3-Kürzung!}
@@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] {könnte 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;
{für Turbolader h#s und Z1013 ohne Headersave Dateiname weglassen;
durch zweckmäßige 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-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);
{Fügt String hinzu mit ItemData J, ist J=K wird dieser Eintrag selektiert.
Für das Füllen 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;
lParP: PChar absolute lParam;
WH: PWaveHdr absolute lParam;
dis: PDrawItemStruct absolute lParam;
S: TS255;
S2: TS31;
WaveOutCaps: TWaveOutCaps;
WaveInCaps: TWaveInCaps absolute WaveOutCaps; {ist kürzer!}
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); {dunkelgrün}
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); {würde 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 für 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));
{Tastendrücke}
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; {kümmert 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, {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
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 Veränderungen:
01/02:
* Wave-Datei-Verarbeitung auf Windows-Chunk-Befehle umgestellt
- Wave-Datei-Voreinstellung in Kombinationsfenster korrigiert
}
| Detected encoding: OEM (CP437) | 1
|
|
|