(***************************************************************************)
(* *)
(* AtomTape v1.1 (c) by Wouter Ras, Delft, November - December 1997 *)
(* ---------------------------------------------------------------- *)
(* *)
(* This source code may be distributed freely within the following *)
(* restrictions *)
(* 1. You may not charge for this program or for any part of it. *)
(* 2. This copyright message may not be removed from it. *)
(* 3. You may use sections of code from this program in your applications, *)
(* but you must acknowledge its use. I'd appreciate it if you'd let me *)
(* know, i.e. send me a copy of your work. *)
(* *)
(* Please report any problems, questions, comments to me at this address: *)
(* avio@casema.net *)
(* *)
(* The latest version of the emulator can be downloaded from my Atom-page: *)
(* http://www.casema.net/~avio/atom.htm *)
(* *)
(***************************************************************************)
{$r-}
PROGRAM ATOMTAPE;
USES CRT,HEXA;
CONST SILENCE = $80;
SILENCEMIN = $7C;
SILENCEMAX = $84;
MAXWAVE1 = +12;
MINWAVE0 = +16;
MAXWAVE0 = +24;
VOCHEADER : ARRAY[$00..$13] OF CHAR = 'Creative Voice File'+#$1a;
TYPE TAPESPEEDTYPE = (SCOS,FCOS);
BUFTYPE = ARRAY[$0000..$FFF8] OF BYTE;
ATMHEADERREC = RECORD
ATOMNAME : ARRAY[$00..$0F] OF BYTE;
STARTADDRESS : WORD;
EXECADDRESS : WORD;
DATASIZE : WORD;
END;
VAR TAPESPEED : TAPESPEEDTYPE;
HEADER : ARRAY[$00..$FF] OF BYTE;
READBUF : ^BUFTYPE;
WRITEBUF : ^BUFTYPE;
SOURCEFILE : STRING;
DESTFILE : STRING;
FROMF : FILE;
TOF : FILE;
NOMOREDATA : BOOLEAN;
P1 : LONGINT;
P2 : LONGINT;
ABSRP : LONGINT;
RELRP : WORD;
RP : WORD;
WP : WORD;
HP : BYTE;
NR : WORD;
LASTBLOCK : BOOLEAN;
ATMHEADER : ATMHEADERREC;
FIRSTWAVEDOWN: BOOLEAN;
PROCEDURE TERMINATE;
VAR CH:CHAR;
BEGIN
CLOSE (FROMF);
CLOSE (TOF);
ERASE (TOF);
WRITELN ('Program aborted.');
WHILE KEYPRESSED DO CH := READKEY;
HALT;
END;
PROCEDURE GETBYTE (VAR B:BYTE);
BEGIN
IF NOMOREDATA THEN EXIT;
B := READBUF^[RP];
INC (RP);
IF RP >= NR THEN
BEGIN
INC (ABSRP,RP);
BLOCKREAD (FROMF,READBUF^,SIZEOF(BUFTYPE),NR);
IF NR=0 THEN NOMOREDATA := TRUE;
RP := $0000;
END;
END;
PROCEDURE STOREBYTE (B:BYTE);
VAR I:BYTE;
W:WORD;
BEGIN
WRITEBUF^[WP] := B;
INC (WP);
IF WP >= SIZEOF(BUFTYPE) THEN
BEGIN
BLOCKWRITE (TOF,WRITEBUF^,WP);
INC (ATMHEADER.DATASIZE,WP);
WP := $0000;
END;
END;
PROCEDURE SETSTART;
VAR B:BYTE;
BEGIN
IF FIRSTWAVEDOWN THEN
BEGIN
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B > SILENCEMAX;
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B < SILENCE;
END ELSE
BEGIN
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B < SILENCEMIN;
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B > SILENCE;
END;
END;
PROCEDURE SEEKENDOFWAVE;
VAR B:BYTE;
BEGIN
IF FIRSTWAVEDOWN THEN
BEGIN
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B > SILENCE;
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B < SILENCE;
END ELSE
BEGIN
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B < SILENCE;
REPEAT
GETBYTE (B);
IF NOMOREDATA THEN EXIT;
UNTIL B > SILENCE;
END;
END;
PROCEDURE READONEBYTEFROMVOC (FIRSTWAVEDONE:BOOLEAN; VAR B:BYTE);
VAR DATABITS:ARRAY[0..9] OF BYTE;
S:STRING[16];
I:BYTE;
A:BYTE;
BEGIN
I := 0;
DATABITS[0] := 0;
S := '';
IF TAPESPEED = SCOS THEN
BEGIN
IF FIRSTWAVEDONE THEN S := '00';
END ELSE
BEGIN
IF FIRSTWAVEDONE THEN I := 1;
END;
WHILE I <= 9 DO
BEGIN
P1 := P2;
SEEKENDOFWAVE;
IF NOMOREDATA THEN EXIT;
P2 := ABSRP + LONGINT(RP);
IF P2-P1 <= MAXWAVE1 THEN
BEGIN
S := S + '1';
END ELSE
IF P2-P1 >= MINWAVE0 THEN
BEGIN
S := S + '00';
END ELSE
BEGIN
GOTOXY (1,WHEREY);
WRITELN ('Error: Misformed wave pattern at position ',HEXL(P1),'h.');
TERMINATE;
END;
IF ((TAPESPEED = FCOS) AND (S='00')) OR
((TAPESPEED = SCOS) AND (S='00000000')) THEN
BEGIN
DATABITS[I] := 0;
INC (I);
S := '';
END ELSE
IF ((TAPESPEED = FCOS) AND (S='11')) OR
((TAPESPEED = SCOS) AND (S='11111111')) THEN
BEGIN
DATABITS[I] := 1;
INC (I);
S := '';
END;
IF ((TAPESPEED = FCOS) AND (LENGTH(S) > 2)) OR
((TAPESPEED = SCOS) AND (LENGTH(S) > 8)) THEN
BEGIN
GOTOXY (1,WHEREY);
WRITELN ('Error: Misformed wave pattern at position ',HEXL(P1),'h.');
TERMINATE;
END;
END;
P1 := P2;
SEEKENDOFWAVE; {---stopbit always has one extra wave---}
IF NOMOREDATA THEN EXIT;
P2 := ABSRP + LONGINT(RP);
IF DATABITS[0] <> $00 THEN
BEGIN
GOTOXY (1,WHEREY);
WRITELN ('Error: No startbit (0) found at position ',HEXL(P1),'h.');
TERMINATE;
END;
IF DATABITS[9] <> $01 THEN
BEGIN
GOTOXY (1,WHEREY);
WRITELN ('Error: No stopbit (1) found at position ',HEXL(P1),'h.');
TERMINATE;
END;
B := $00;
A := $01;
FOR I := 1 TO 8 DO
BEGIN
IF DATABITS[I] <> $00 THEN B := B OR A;
A := (A SHL 1) AND $FF;
END;
IF KEYPRESSED THEN
BEGIN
GOTOXY (1,WHEREY);
CLREOL;
WRITELN ('User break.');
TERMINATE;
END;
END;
PROCEDURE INPUTSTRING (LENGTE:BYTE;VAR S:STRING);
LABEL 1;
VAR CH,DH:CHAR;
N,P:BYTE;
XC,YC:BYTE;
T:STRING;
BEGIN
T := '';
1:S := T;
XC := WHEREX;
YC := WHEREY;
P := SUCC(LENGTH(S));
REPEAT
WHILE LENGTH(S) < LENGTE DO S := S + '_';
INLINE ($B8/$00/$01/$B9/$07/$26/$CD/$10); {---hidecursor---}
GOTOXY (XC,YC);
WRITE (S);
GOTOXY (XC+PRED(P),YC);
INLINE ($B8/$00/$01/$B9/$06/$05/$CD/$10); {---showcursor---}
CH := READKEY;
IF CH=#0 THEN
BEGIN
DH := READKEY;
IF (DH=#75) AND (Pgt;1) THEN DEC(P);
IF (DH=#77) AND (P<=LENGTE) THEN INC(P);
IF (DH=#83) AND (P<=LENGTE) THEN BEGIN
DELETE (S,P,1);
S := S + '_';
END;
IF (DH=#$75) AND (P<=LENGTE) THEN
BEGIN
FOR N := P TO LENGTE DO S[N] := '_';
END;
IF DH=#$47 THEN P := 1;
IF DH=#$4F THEN BEGIN
P := SUCC(LENGTE);
WHILE S[PRED(P)]='_' DO DEC(P);
END;
END;
IF (CH=#8) AND (P>1) THEN BEGIN
DELETE (S,PRED(P),1);
S := S + '_';
DEC(P);
END;
IF (CH>=' ') AND (P<=LENGTE) Then
BEGIN
DELETE (S,LENGTH(S),1);
INSERT (CH,S,P);
INC (P);
END;
IF CH=#27 THEN BEGIN
WRITELN;
WRITELN;
WRITELN ('User break.');
HALT;
END;
UNTIL (CH=#13);
WHILE S[LENGTH(S)] = '_' DO DELETE (S,LENGTH(S),1);
IF S='' THEN GOTO 1;
GOTOXY (XC,YC);
WRITE (S);
CLREOL;
END;
PROCEDURE CREATETEMPFILE;
LABEL 1;
VAR TOF:FILE;
BLOCKSIZE:LONGINT;
BLOCK01POS:LONGINT;
TOTALSIZE:LONGINT;
AANTAL:WORD;
BEGIN
WRITE ('File consists of more than one datablocks. Restructuring file...');
SEEK (FROMF,0);
ASSIGN (TOF,'$ATMTEMP.TMP');
REWRITE (TOF,1);
{---header---}
BLOCKREAD (FROMF,READBUF^,$1A,NR);
BLOCKWRITE (TOF,READBUF^,$1A);
{---data (including block 8)---}
BLOCKREAD (FROMF,READBUF^,$04,NR);
WHILE (READBUF^[$00] > $02) AND (READBUF^[$00] <> $08) DO
BEGIN
BLOCKSIZE := LONGINT(READBUF^[$01]) +
(LONGINT(READBUF^[$02]) SHL 8) +
(LONGINT(READBUF^[$03]) SHL 16);
SEEK (FROMF,FILEPOS(FROMF)+BLOCKSIZE);
BLOCKREAD (FROMF,READBUF^,$04,NR);
END;
IF READBUF^[$00] = $08 THEN
BEGIN
BLOCKWRITE (TOF,READBUF^,$04);
BLOCKSIZE := LONGINT(READBUF^[$01]) +
(LONGINT(READBUF^[$02]) SHL 8) +
(LONGINT(READBUF^[$03]) SHL 16);
BLOCKREAD (FROMF,READBUF^,BLOCKSIZE,NR);
BLOCKWRITE (TOF,READBUF^,NR);
BLOCKREAD (FROMF,READBUF^,$04,NR);
END;
IF READBUF^[$00] = $01 THEN
BEGIN
BLOCK01POS := FILESIZE(TOF);
TOTALSIZE := $02;
BLOCKWRITE (TOF,READBUF^,$04);
BLOCKSIZE := LONGINT(READBUF^[$01]) +
(LONGINT(READBUF^[$02]) SHL 8) +
(LONGINT(READBUF^[$03]) SHL 16);
BLOCKREAD (FROMF,READBUF^,$02,NR);
BLOCKWRITE (TOF,READBUF^,$02);
DEC (BLOCKSIZE,$02);
END ELSE
BEGIN
CLOSE (FROMF);
CLOSE (TOF);
ERASE (TOF);
WRITELN ('Error: No information about samplerate etc. encountered.');
HALT;
END;
{---rest of data; block 8 ignored---}
1:WHILE BLOCKSIZE > 0 DO
BEGIN
AANTAL := SIZEOF(BUFTYPE);
IF AANTAL > BLOCKSIZE THEN AANTAL := BLOCKSIZE;
INC (TOTALSIZE,AANTAL);
BLOCKREAD (FROMF,READBUF^,AANTAL,NR);
BLOCKWRITE (TOF,READBUF^,NR);
DEC (BLOCKSIZE,NR);
END;
BLOCKREAD (FROMF,READBUF^,$04,NR);
IF READBUF^[$00] = $01 THEN
BEGIN
BLOCKSIZE := LONGINT(READBUF^[$01]) +
(LONGINT(READBUF^[$02]) SHL 8) +
(LONGINT(READBUF^[$03]) SHL 16);
SEEK (FROMF,FILEPOS(FROMF)+$02);
DEC (BLOCKSIZE,$02);
END;
IF READBUF^[$00] = $02 THEN
BEGIN
BLOCKSIZE := LONGINT(READBUF^[$01]) +
(LONGINT(READBUF^[$02]) SHL 8) +
(LONGINT(READBUF^[$03]) SHL 16);
END;
IF READBUF^[$00] <> $00 THEN GOTO 1;
BLOCKWRITE (TOF,READBUF^,$01);
SEEK (TOF,SUCC(BLOCK01POS));
BLOCKWRITE (TOF,TOTALSIZE,$03);
CLOSE (FROMF);
CLOSE (TOF);
ERASE (FROMF);
RENAME (TOF,SOURCEFILE);
WRITELN;
ASSIGN (FROMF,SOURCEFILE);
RESET (FROMF,1);
END;
{===[main]==================================================================}
LABEL 1,2,3;
VAR CH : CHAR;
DH : CHAR;
W : WORD;
B : BYTE;
I : BYTE;
CHKSUM : BYTE;
EERSTE : BOOLEAN;
NUMBYTES : WORD;
SR : WORD;
BLOCKSIZE : LONGINT;
BEGIN
GETMEM (READBUF,SIZEOF(BUFTYPE));
GETMEM (WRITEBUF,SIZEOF(BUFTYPE));
CLRSCR;
WRITELN ('AtomTape v1.1 (c) Wouter Ras, Delft, November-December 1997');
WRITELN;
WRITELN;
WRITE ('Name of VOC-file (without extension) ? ');
INPUTSTRING (30,SOURCEFILE);
FOR I := 1 TO LENGTH(SOURCEFILE) DO SOURCEFILE[I] := UPCASE(SOURCEFILE[I]);
DESTFILE := SOURCEFILE + '.ATM';
SOURCEFILE := SOURCEFILE + '.VOC';
WRITELN;
WRITELN;
ASSIGN (FROMF,SOURCEFILE);
{$i-}
RESET (FROMF,1);
{$i+}
IF IORESULT <> 0 THEN
BEGIN
WRITELN ('Source file (',SOURCEFILE,') not found.');
HALT;
END;
WRITE ('Is it a 300 bps (slow) or 1200 bps (fast) file [S/F] ? F',#8);
WHILE KEYPRESSED DO CH := READKEY;
REPEAT
CH := UPCASE(READKEY);
IF CH=#0 THEN DH := READKEY;
IF CH=#27 THEN BEGIN
WRITELN;
WRITELN;
WRITELN ('User break.');
CLOSE (FROMF);
HALT;
END;
IF CH=#13 THEN CH := 'F';
UNTIL (CH='F') OR (CH='S');
WRITELN (CH);
WRITELN;
WRITELN;
IF CH='S' THEN TAPESPEED := SCOS
ELSE TAPESPEED := FCOS;
FOR I := $00 TO $0F DO ATMHEADER.ATOMNAME[I] := $00;
ATMHEADER.DATASIZE := 0;
3:BLOCKREAD (FROMF,READBUF^,SIZEOF(BUFTYPE),NR);
FOR I := $00 TO $13 DO
BEGIN
IF READBUF^[I] <> ORD(VOCHEADER[I]) THEN
BEGIN
WRITELN ('This is not a valid VOC-file.');
CLOSE (FROMF);
HALT;
END;
END;
RP := $001A;
WHILE (READBUF^[RP] <> $01) AND (READBUF^[RP] <> $08) DO
BEGIN
IF READBUF^[RP] = $02 THEN
BEGIN
WRITELN ('No information about samplerate etc. encountered.');
CLOSE (FROMF);
HALT;
END;
IF (READBUF^[RP] >= $03) AND (READBUF^[RP] <=07) THEN
BEGIN
BLOCKSIZE := LONGINT(READBUF^[RP+$01]) +
(LONGINT(READBUF^[RP+$02]) SHL 8) +
(LONGINT(READBUF^[RP+$03]) SHL 16);
INC (RP,BLOCKSIZE+$04);
END;
END;
IF READBUF^[RP] = $08 THEN
BEGIN
SR := READBUF^[RP+$04] + SWAP(WORD(READBUF^[RP+$05]));
IF (SR < $D2A7-$80) OR (SR > $D2A7+$80) THEN
BEGIN
WRITELN ('Wrong samplerate. It should be 22050 Hz.');
CLOSE (FROMF);
HALT;
END;
IF (READBUF^[RP+$06] <> $00) OR (READBUF^[RP+$07] <> $00) THEN
BEGIN
WRITELN ('File must be 8-bits sample mono recorded.');
CLOSE (FROMF);
HALT;
END;
RP := $0022;
BLOCKSIZE := LONGINT(READBUF^[RP+$01]) +
(LONGINT(READBUF^[RP+$02]) SHL 8) +
(LONGINT(READBUF^[RP+$03]) SHL 16);
IF BLOCKSIZE <> FILESIZE(FROMF)-(RP+$04)-$01 THEN
BEGIN
CREATETEMPFILE;
GOTO 3;
END;
RP := $0028;
END ELSE
BEGIN
IF READBUF^[RP] = $01 THEN
BEGIN
BLOCKSIZE := LONGINT(READBUF^[RP+$01]) +
(LONGINT(READBUF^[RP+$02]) SHL 8) +
(LONGINT(READBUF^[RP+$03]) SHL 16);
IF BLOCKSIZE <> FILESIZE(FROMF)-(RP+$04)-$01 THEN
BEGIN
CREATETEMPFILE;
GOTO 3;
END;
IF (READBUF^[RP+$04] < $D2) OR (READBUF^[RP+$04] > $D3) THEN
BEGIN
WRITELN ('Wrong samplerate. It should be 22050 Hz.');
CLOSE (FROMF);
HALT;
END;
IF READBUF^[RP+$05] <> $00 THEN
BEGIN
WRITELN ('File must be 8-bits sample mono recorded.');
CLOSE (FROMF);
HALT;
END;
RP := $0020;
END ELSE
BEGIN
WRITELN ('Unrecognised VOC-block. Only blocktypes 1 and 8 are allowed.');
CLOSE (FROMF);
HALT;
END;
END;
ABSRP := RP;
NOMOREDATA := FALSE;
ASSIGN (TOF,DESTFILE);
REWRITE (TOF,1);
BLOCKWRITE (TOF,ATMHEADER,SIZEOF(ATMHEADER));
WP := $0000;
WRITELN ('Analyzing VOC-file:');
WRITELN;
WRITELN ('Atom filename Strt End Exec Nr');
WRITELN ('--------------- ---- ---- ---- --');
2:FIRSTWAVEDOWN := TRUE;
{---searching for header---}
WRITE ('Searching header...');
SETSTART;
IF NOMOREDATA THEN GOTO 1;
P2 := ABSRP + LONGINT(RP);
REPEAT
P1 := P2;
SEEKENDOFWAVE;
IF NOMOREDATA THEN GOTO 1;
P2 := ABSRP + LONGINT(RP);
UNTIL (P2-P1 > MAXWAVE1) AND (P2-P1 <= MAXWAVE0);
IF P2-P1 < MINWAVE0 THEN {swap wavestart}
BEGIN
FIRSTWAVEDOWN := FALSE;
SEEKENDOFWAVE;
IF NOMOREDATA THEN GOTO 1;
P2 := ABSRP + LONGINT(RP);
END;
{---read header---}
GOTOXY (1,WHEREY);
WRITE ('Reading header...');
CLREOL;
HP := 0;
EERSTE := TRUE;
CHKSUM := 0;
REPEAT
INC(MEM[$B800:2*80*25]);
READONEBYTEFROMVOC (EERSTE,B);
EERSTE := FALSE;
IF NOMOREDATA THEN GOTO 1;
HEADER[HP] := B;
CHKSUM := LO(CHKSUM + B);
INC (HP);
UNTIL (HP >= $0D) AND (HEADER[HP-$09] = $0D);
GOTOXY (1,WHEREY);
IF (HEADER[$00] <> ORD('*')) OR (HEADER[$01] <> ORD('*')) OR
(HEADER[$02] <> ORD('*')) OR (HEADER[$03] <> ORD('*')) THEN
BEGIN
WRITELN ('Error: Blockheader corrupted.');
TERMINATE;
END;
I := $04;
WHILE HEADER[I] <> $0D DO
BEGIN
WRITE (CHR(HEADER[I]));
ATMHEADER.ATOMNAME[I-$04] := HEADER[I];
INC (I);
END;
INC (I);
WHILE WHEREX < 17 DO WRITE (' ');
W := HEADER[I+$07] + (WORD(HEADER[I+$06]) SHL 8);
IF HEADER[I+$02] = $00 THEN ATMHEADER.STARTADDRESS := W;
WRITE (HEXW(W),' ');
NUMBYTES := SUCC(WORD(HEADER[I+$03]));
INC (W,PRED(NUMBYTES));
WRITE (HEXW(W),' ');
W := HEADER[I+$05] + (WORD(HEADER[I+$04]) SHL 8);
IF HEADER[I+$02] = $00 THEN ATMHEADER.EXECADDRESS := W;
WRITE (HEXW(W),' ');
W := HEADER[I+$02];
WRITELN (HEX(W));
W := HEADER[I];
IF W AND $80 = $00 THEN LASTBLOCK := TRUE
ELSE LASTBLOCK := FALSE;
{---searching datablock---}
WRITE ('Searching datablock...');
REPEAT
P1 := P2;
SEEKENDOFWAVE;
IF NOMOREDATA THEN EXIT;
P2 := ABSRP + LONGINT(RP);
UNTIL P2-P1 <= MAXWAVE1;
REPEAT
P1 := P2;
SEEKENDOFWAVE;
IF NOMOREDATA THEN EXIT;
P2 := ABSRP + LONGINT(RP);
UNTIL (P2-P1 > MAXWAVE1) AND (P2-P1 <= MAXWAVE0);
{---read datablock---}
GOTOXY (1,WHEREY);
WRITE ('Reading datablock...');
CLREOL;
EERSTE := TRUE;
FOR W := 1 TO NUMBYTES DO
BEGIN
INC(MEM[$B800:2*80*25]);
READONEBYTEFROMVOC (EERSTE,B);
EERSTE := FALSE;
IF NOMOREDATA THEN GOTO 1;
STOREBYTE (B);
CHKSUM := LO(CHKSUM + B);
END;
READONEBYTEFROMVOC (FALSE,B); {---checksum---}
GOTOXY (1,WHEREY);
CLREOL;
IF B <> CHKSUM THEN
BEGIN
WRITELN ('Checksum error: ',HEX(CHKSUM),'h should be ',HEX(B),'h.');
TERMINATE;
END;
IF NOT LASTBLOCK THEN GOTO 2;
1:BLOCKWRITE (TOF,WRITEBUF^,WP);
INC (ATMHEADER.DATASIZE,WP);
CLOSE (FROMF);
CLOSE (TOF);
RESET (TOF,1);
BLOCKWRITE (TOF,ATMHEADER,SIZEOF(ATMHEADER));
CLOSE (TOF);
WHILE KEYPRESSED DO CH := READKEY;
IF NOT LASTBLOCK THEN
BEGIN
GOTOXY (1,WHEREY);
WRITELN ('Alert: File might be incomplete.');
END ELSE
BEGIN
WRITELN ('Ready.');
END;
END.
|