(***************************************************************************)
(* *)
(* TapeCat v1.00 (c) by Wouter Ras, Delft, March 1998 *)
(* -------------------------------------------------- *)
(* *)
(* 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 *)
(* *)
(***************************************************************************)
{$g+,f-,i-,r-,m 16384,80000,80000}
PROGRAM TAPECAT;
USES DOS,CRT,HEXA;
CONST SAMPLESIZE = $2000;
WAVE0 : ARRAY[0..94] OF SHORTINT =
( 0, -4,-11,-17,-24,-30,-35,-38,-40,-42,
-44,-45,-47,-49,-50,-52,-53,-53,-53,-53,
-53,-52,-50,-47,-44,-41,-38,-37,-36,-34,
-33,-32,-32,-32,-31,-31,-30,-28,-26,-23,
-20,-18,-14,-11, -8, -4, 0, 4, 9, 14,
19, 24, 29, 34, 38, 43, 48, 51, 53, 55,
59, 61, 62, 63, 64, 66, 67, 66, 65, 65,
64, 62, 60, 56, 53, 50, 47, 46, 45, 44,
43, 42, 41, 40, 39, 38, 36, 33, 30, 27,
23, 19, 16, 11, 6);
WAVE1 : ARRAY[0..91] OF SHORTINT =
( 0, -6,-13,-18,-22,-26,-30,-32,-33,-33,
-34,-34,-34,-34,-33,-33,-32,-31,-27,-22,
-17,-12, -6, 0, 7, 14, 21, 27, 30, 32,
34, 36, 37, 38, 38, 38, 38, 38, 36, 34,
32, 30, 27, 22, 15, 8, 0, -6,-11,-17,
-22,-28,-32,-33,-34,-34,-35,-35,-35,-35,
-34,-34,-32,-29,-25,-21,-17,-12, -6, 0,
8, 16, 22, 26, 39, 31, 34, 36, 37, 37,
36, 36, 36, 34, 32, 31, 29, 26, 21, 14,
8, 3);
SILENCE = $80;
SILENCEMIN = $7C;
SILENCEMAX = $84;
MAXWAVE1 = +11;
MINWAVE0 = +16;
MAXWAVE0 = +21;
TYPE DMABUFTYPE = ARRAY[$0000..PRED(SAMPLESIZE)] OF BYTE;
SPEEDTYPE = (SCOS,FCOS);
STR2 = STRING[2];
ATMHEADERREC = RECORD
ATOMNAME : ARRAY[$00..$0F] OF BYTE;
STARTADDRESS : WORD;
EXECADDRESS : WORD;
DATASIZE : WORD;
END;
DATUMREC = RECORD
DAG : BYTE;
MAAND : BYTE;
JAAR : WORD;
END;
TIJDREC = RECORD
UUR : BYTE;
MIN : BYTE;
SEC : BYTE;
END;
VAR DSPVERSION : WORD; {hi:major; lo:minor}
IOPORT : WORD; {soundblaster i/o-port}
IRQ : BYTE; {soundblaster irq number}
DMA : BYTE; {soundblaster dma channel}
SPEEDMODE : SPEEDTYPE; {fcos or scos}
DMABUF : ^DMABUFTYPE; {samplebuffer 1}
DMABUFNR : BYTE; {buffernumber currently outputted to dsp}
DMABUFPTR : WORD; {pointer to data from/to _NOT_ dmabuffer}
IRQOCC : BYTE; {irq occurred? 00h=no; 01h=yes}
USERBREAK : BOOLEAN; {escape pressed?}
FIRSTWAVEDOWN : BOOLEAN;
WAVELENGTH : BYTE;
ATMHEADER : ATMHEADERREC;
TOF : TEXT;
FILENAME : STRING;
DIR : DIRSTR;
NAME : NAMESTR;
EXT : EXTSTR;
DATUM : DATUMREC;
TIJD : TIJDREC;
STARTTIJD : LONGINT;
PROCEDURE INPUTSTRING (LENGTE:BYTE;VAR S:STRING);
LABEL 1;
VAR CH,DH:CHAR;
N,P:BYTE;
XC,YC:BYTE;
T:STRING;
BEGIN
USERBREAK := FALSE;
T := S;
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 (P>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
USERBREAK := TRUE;
EXIT;
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 RESETDSP; ASSEMBLER;
ASM;
MOV DX,WORD PTR IOPORT
ADD DL,$06
MOV AL,$01
OUT DX,AL
MOV CX,$0400
@RESDSP1: NOP
LOOP @RESDSP1
MOV AL,$00
OUT DX,AL
MOV BL,$10
@RESDSP3: MOV DX,WORD PTR IOPORT
ADD DL,$0E
MOV CX,$0100
@RESDSP2: IN AL,DX
TEST AL,$80
JNZ @RESDSP4
LOOP @RESDSP2
JMP @RESDSP5
@RESDSP4: SUB DL,$04
IN AL,DX
CMP AL,$AA
JZ @RESDSP6
DEC BL
JNZ @RESDSP3
@RESDSP5: MOV WORD PTR IOPORT,$0000
@RESDSP6:
END;
PROCEDURE OUTBYTE; ASSEMBLER;
ASM;
MOV AH,AL
@OUTB1: IN AL,DX
OR AL,AL
JS @OUTB1
MOV AL,AH
OUT DX,AL
END;
PROCEDURE INBYTE; ASSEMBLER; {uitvoer AL=byte}
ASM;
MOV DX,WORD PTR IOPORT
ADD DL,$0E
@INB1: IN AL,DX
OR AL,AL
JNS @INB1
SUB DL,$04
IN AL,DX
END;
PROCEDURE STARTDMA (SEGM,ADRS:WORD;DIRECTION:BYTE); ASSEMBLER;
ASM; {direction=00h:from PC to ATOM; 01h:from ATOM to PC}
{set samplerate}
MOV DX,WORD PTR IOPORT
ADD DL,$0C
MOV AL,$40
CALL OUTBYTE
MOV AL,$D2 {22050 Hz}
CALL OUTBYTE
CMP WORD PTR DSPVERSION,$0400
JB @SK1
{set 8-bit, mono mode on SB16}
MOV AL,$C6
CALL OUTBYTE
MOV AL,$00
CALL OUTBYTE
@SK1: {set dma blocksize}
MOV AL,$48
CALL OUTBYTE
MOV AL,((SAMPLESIZE SHR 1) - 1) AND $FF
CALL OUTBYTE
MOV AL,((SAMPLESIZE SHR 1) - 1) SHR 8
CALL OUTBYTE
{enable speaker}
MOV AL,$D1
CALL OUTBYTE
{setup dma}
MOV AL,BYTE PTR DMA
OR AL,$04
OUT $0A,AL
MOV AL,$00
OUT $0C,AL
MOV AL,$58
CMP BYTE PTR DIRECTION,$00
JZ @SK2
MOV AL,$54
@SK2: OR AL,BYTE PTR DMA
OUT $0B,AL
MOV AX,WORD PTR ADRS
MOV DX,WORD PTR SEGM
ROL DX,4
MOV CX,DX
AND DX,+$0F
AND CX,-$10
ADD AX,CX
ADC DX,+$00
PUSH DX
MOV DL,BYTE PTR DMA
SHL DL,1
MOV DH,$00
OUT DX,AL {address byte 0}
MOV AL,AH
OUT DX,AL {address byte 1}
INC DX
MOV AL,(SAMPLESIZE - 1) AND $FF
OUT DX,AL {byte count lo}
MOV AL,(SAMPLESIZE - 1) SHR 8
OUT DX,AL {byte count hi}
MOV BL,BYTE PTR DMA
MOV BH,$00
MOV DL,BYTE PTR @PAGENR[CS:BX]
MOV DH,$00
POP AX
OUT DX,AL {address byte 2}
MOV AL,BYTE PTR DMA
OUT $0A,AL
{perform auto-init}
MOV DX,WORD PTR IOPORT
ADD DL,$0C
MOV AL,$1C
CMP BYTE PTR DIRECTION,$00
JZ @SK3
MOV AL,$2C
@SK3: CALL OUTBYTE
JMP @ENDOFPROC
@PAGENR: DB $87,$83,$81,$82
@ENDOFPROC:
END;
PROCEDURE IRQVECTOR (ZETTEN:BYTE); ASSEMBLER;
ASM;
MOV BL,BYTE PTR IRQ
TEST BL,$08
JZ @SETCLRIRQ2
AND BL,$07
ADD BL,$70
JMP @SETCLRIRQ1
@SETCLRIRQ2: ADD BL,$08
@SETCLRIRQ1: MOV BH,$00
SHL BX,2
SUB AX,AX
MOV ES,AX
TEST BYTE PTR ZETTEN,$FF
JZ @CLRIRQVEC
CLI
MOV AX,WORD PTR [ES:BX]
MOV WORD PTR @ORGIRQVEC[CS:$00],AX
MOV AX,WORD PTR [ES:BX+$02]
MOV WORD PTR @ORGIRQVEC[CS:$02],AX
MOV AX,OFFSET @IRQHANDLER
MOV WORD PTR [ES:BX],AX
MOV WORD PTR [ES:BX+$02],CS
STI
JMP @ENDOFPROC
@CLRIRQVEC: CLI
MOV AX,WORD PTR @ORGIRQVEC[CS:$00]
MOV WORD PTR [ES:BX],AX
MOV AX,WORD PTR @ORGIRQVEC[CS:$02]
MOV WORD PTR [ES:BX+$02],AX
STI
JMP @ENDOFPROC
@IRQHANDLER: PUSH DS
PUSH DX
PUSH AX
MOV AX,SEG IOPORT
MOV DS,AX
MOV DX,WORD PTR IOPORT
ADD DL,$0E
IN AL,DX
XOR BYTE PTR DMABUFNR,$03
MOV BYTE PTR IRQOCC,$01
MOV AL,$20
CMP BYTE PTR IRQ,$07
JBE @IRQH1
OUT $A0,AL
@IRQH1: OUT $20,AL
POP AX
POP DX
POP DS
IRET
@ORGIRQVEC: DD $00000000
@ENDOFPROC:
END;
PROCEDURE CLRIRQMASK; ASSEMBLER;
ASM;
MOV DX,$0021
MOV CL,BYTE PTR IRQ
TEST CL,$08
JZ @SETMASK1
AND CL,$07
MOV DL,$A1
@SETMASK1: MOV AH,$01
SHL AH,CL
NOT AH
IN AL,DX
AND AL,AH
OUT DX,AL
END;
PROCEDURE SETIRQMASK; ASSEMBLER;
ASM;
MOV DX,$0021
MOV CL,BYTE PTR IRQ
TEST CL,$08
JZ @CLRMASK1
AND CL,$07
MOV DL,$A1
@CLRMASK1: MOV AH,$01
SHL AH,CL
IN AL,DX
OR AL,AH
OUT DX,AL
END;
PROCEDURE STOPDMA; ASSEMBLER;
ASM;
MOV DX,WORD PTR IOPORT
ADD DL,$0C
{disable speaker}
MOV AL,$D3
CALL OUTBYTE
{halt dma}
MOV AL,$D0
CALL OUTBYTE
{exit auto-init mode}
MOV AL,$DA
CALL OUTBYTE
{halt dma}
MOV AL,$D0
CALL OUTBYTE
END;
FUNCTION HEX2DEC (S:STRING):WORD;
VAR I:BYTE;
BEGIN
FOR I := 1 TO LENGTH(S) DO S[I] := UPCASE(S[I]);
WHILE LENGTH(S) < 4 DO S := '0' + S;
FOR I := 1 TO 4 DO
BEGIN
DEC (S[I],48);
IF ORD(S[I]) > 9 THEN DEC (S[I],7);
END;
HEX2DEC := SWAP((ORD(S[1]) SHL 4) + ORD(S[2])) +
(ORD(S[3]) SHL 4) + ORD(S[4]);
END;
PROCEDURE INITBLASTER;
VAR S,T:STRING[80];
I,J:BYTE;
CODE:INTEGER;
PS,IS,DS:BOOLEAN;
BEGIN
PS := FALSE;
IS := FALSE;
DS := FALSE;
S := GETENV ('BLASTER');
FOR I := 1 TO LENGTH(S) DO S[I] := UPCASE(S[I]);
WHILE (LENGTH(S) > 0) DO
BEGIN
IF (S[1]='A') OR (S[1]='I') OR (S[1]='D') THEN
BEGIN
T := '';
I := 2;
WHILE (I <= LENGTH(S)) AND (S[I] <> ' ') DO
BEGIN
T := T + S[I];
INC (I);
END;
IF S[1] = 'A' THEN
BEGIN
IOPORT := HEX2DEC (T);
PS := TRUE;
END;
IF S[1] = 'I' THEN
BEGIN
VAL (T,IRQ,CODE);
IF CODE=0 THEN IS := TRUE;
END;
IF S[1] = 'D' THEN
BEGIN
VAL (T,DMA,CODE);
IF CODE=0 THEN DS := TRUE;
END;
DELETE (S,1,I);
END ELSE
BEGIN
DELETE (S,1,1);
END;
END;
IF NOT (PS AND IS AND DS) THEN
BEGIN
WRITELN ('Blaster environment string not set or not set correctly. Program aborted.');
HALT;
END;
WRITELN ('Soundcard detected at I/O-port ',HEXW(IOPORT),'h');
WRITELN (' IRQ-number ',IRQ);
WRITELN (' DMA-channel ',DMA);
RESETDSP;
IF IOPORT = $0000 THEN
BEGIN
WRITELN ('Cannot initialize SoundBlaster. Program aborted.');
HALT;
END;
ASM;
MOV DX,WORD PTR IOPORT
ADD DL,$0C
MOV AL,$E1
CALL OUTBYTE
CALL INBYTE
MOV AH,AL
CALL INBYTE
MOV WORD PTR DSPVERSION,AX
END;
WRITE ('Card type: SoundBlaster ');
CASE HI(DSPVERSION) OF 1: WRITE;
2: WRITE ('2');
3: WRITE ('Pro');
ELSE WRITE ('16');
END;
WRITELN (' or clone');
WRITE (' DSP-version ',HI(DSPVERSION),'.');
IF LO(DSPVERSION) < 10 THEN WRITE ('0');
WRITELN (LO(DSPVERSION));
WRITELN;
IF HI(DSPVERSION) <= 1 THEN
BEGIN
WRITELN ('Sorry, this card cannot handle "auto-init" mode. Program aborted.');
HALT;
END;
END;
PROCEDURE GEEFDATUM;
BEGIN
ASM;
MOV AH,$2A
INT $21
MOV BYTE PTR DATUM[$00],DL {day}
MOV BYTE PTR DATUM[$01],DH {month}
MOV WORD PTR DATUM[$02],CX {year}
END;
END;
PROCEDURE GEEFTIJD;
BEGIN
ASM;
MOV AH,$2C
INT $21
MOV BYTE PTR TIJD[$00],CH {hour}
MOV BYTE PTR TIJD[$01],CL {minute}
MOV BYTE PTR TIJD[$02],DH {second}
END;
END;
FUNCTION LZ(B:BYTE):STR2;
VAR S:STR2;
BEGIN
STR (B:2,S);
IF S[1] = ' ' THEN S[1] := '0';
LZ := S;
END;
{---[data from atom to pc]--------------------------------------------------}
FUNCTION BUFHALF:WORD;
BEGIN
IF DMABUFNR = 1 THEN BUFHALF := SIZEOF(DMABUFTYPE) SHR 1
ELSE BUFHALF := 0;
END;
FUNCTION GETBYTE:BYTE;
VAR CH:CHAR;
BEGIN
IF USERBREAK THEN EXIT;
IF DMABUFPTR >= (SIZEOF(DMABUFTYPE) SHR 1) THEN
BEGIN
DMABUFPTR := $0000;
REPEAT
IF KEYPRESSED THEN
BEGIN
CH := READKEY;
IF CH = #27 THEN USERBREAK := TRUE;
WHILE KEYPRESSED DO CH := READKEY;
END;
UNTIL (IRQOCC <> $00) OR USERBREAK;
IRQOCC := $00;
END;
GETBYTE := DMABUF^[BUFHALF+DMABUFPTR];
INC (DMABUFPTR);
INC (WAVELENGTH);
END;
PROCEDURE SEEKENDOFWAVE;
BEGIN
WAVELENGTH := 0;
IF FIRSTWAVEDOWN THEN
BEGIN
REPEAT
IF USERBREAK THEN EXIT;
UNTIL GETBYTE > SILENCE;
REPEAT
IF USERBREAK THEN EXIT;
UNTIL (GETBYTE < SILENCE) OR (WAVELENGTH = $FF);
IF (WAVELENGTH > MAXWAVE1) AND (WAVELENGTH < MINWAVE0) THEN
BEGIN
REPEAT
IF USERBREAK THEN EXIT;
UNTIL GETBYTE > SILENCE;
WAVELENGTH := (MINWAVE0 + MAXWAVE0) DIV 2;
FIRSTWAVEDOWN := FALSE;
END;
END ELSE
BEGIN
REPEAT
IF USERBREAK THEN EXIT;
UNTIL GETBYTE < SILENCE;
REPEAT
IF USERBREAK THEN EXIT;
UNTIL (GETBYTE > SILENCE) OR (WAVELENGTH = $FF);
IF (WAVELENGTH > MAXWAVE1) AND (WAVELENGTH < MINWAVE0) THEN
BEGIN
REPEAT
IF USERBREAK THEN EXIT;
UNTIL GETBYTE < SILENCE;
WAVELENGTH := (MINWAVE0 + MAXWAVE0) DIV 2;
FIRSTWAVEDOWN := TRUE;
END;
END;
END;
FUNCTION READONEATMBYTE:BYTE;
VAR DATABITS:ARRAY[0..9] OF BYTE;
S:STRING[16];
I:BYTE;
BEGIN
I := 0;
DATABITS[0] := 0;
S := '';
WHILE I <= 9 DO
BEGIN
SEEKENDOFWAVE;
IF WAVELENGTH <= MAXWAVE1 THEN
BEGIN
S := S + '1';
END ELSE
IF WAVELENGTH >= MINWAVE0 THEN
BEGIN
S := S + '00';
END;
IF ((SPEEDMODE = FCOS) AND (S='00')) OR
((SPEEDMODE = SCOS) AND (S='00000000')) THEN
BEGIN
DATABITS[I] := 0;
INC (I);
S := '';
END ELSE
IF ((SPEEDMODE = FCOS) AND (S='11')) OR
((SPEEDMODE = SCOS) AND (S='11111111')) THEN
BEGIN
DATABITS[I] := 1;
INC (I);
S := '';
END;
IF ((SPEEDMODE = FCOS) AND (LENGTH(S) > 2)) OR
((SPEEDMODE = SCOS) AND (LENGTH(S) > 8)) THEN
BEGIN
READONEATMBYTE := 0;
EXIT;
END;
END;
SEEKENDOFWAVE; {stopbit always has one extra wave}
IF DATABITS[0] <> 0 THEN
BEGIN
READONEATMBYTE := 0;
EXIT;
END;
ASM;
MOV DI,$0001
@LP1: SHR BYTE PTR DATABITS[DI],1
RCR AL,1
INC DI
CMP DI,+$09
JB @LP1
MOV BYTE PTR I,AL
END;
READONEATMBYTE := I;
END;
FUNCTION READFIRSTBYTEHEADER:BOOLEAN;
CONST NIL_FAST = '00';
NIL_SLOW = '00000000';
ONE_FAST = '11';
ONE_SLOW = '11111111';
ASTERISK_FAST = NIL_FAST +
NIL_FAST + ONE_FAST + NIL_FAST + ONE_FAST +
NIL_FAST + ONE_FAST + NIL_FAST + NIL_FAST +
ONE_FAST + '1';
ASTERISK_SLOW = NIL_SLOW +
NIL_SLOW + ONE_SLOW + NIL_SLOW + ONE_SLOW +
NIL_SLOW + ONE_SLOW + NIL_SLOW + NIL_SLOW +
ONE_SLOW + '1';
VAR S:STRING;
BEGIN
S := '00';
REPEAT
SEEKENDOFWAVE;
IF WAVELENGTH <= MAXWAVE1 THEN
BEGIN
S := S + '1';
END ELSE
IF WAVELENGTH >= MINWAVE0 THEN
BEGIN
S := S + '00';
END;
IF S = ASTERISK_FAST THEN
BEGIN
SPEEDMODE := FCOS;
READFIRSTBYTEHEADER := TRUE;
EXIT;
END;
IF S = ASTERISK_SLOW THEN
BEGIN
SPEEDMODE := SCOS;
READFIRSTBYTEHEADER := TRUE;
EXIT;
END;
UNTIL (LENGTH(S) > LENGTH(ASTERISK_SLOW)) OR USERBREAK;
READFIRSTBYTEHEADER := FALSE;
END;
PROCEDURE ATOM_TO_PC;
LABEL 1,2;
VAR HEADER:ARRAY[$00..$FF] OF BYTE;
HP:BYTE;
I:BYTE;
W,NUMBYTES:WORD;
HT:LONGINT;
BEGIN
USERBREAK := FALSE;
IRQOCC := $00;
DMABUFNR := 1;
DMABUFPTR := $0000;
FILLCHAR (DMABUF^,SIZEOF(DMABUFTYPE),$80);
IRQVECTOR (1);
CLRIRQMASK;
IF HI(DSPVERSION) >= 3 THEN
BEGIN
ASM;
MOV DX,WORD PTR IOPORT
ADD DL,$04
MOV AL,$0C
OUT DX,AL
INC DX
IN AL,DX
OR AL,00000110b
OUT DX,AL
END;
END;
IF HI(DSPVERSION) >= 4 THEN
BEGIN
ASM;
MOV DX,WORD PTR IOPORT
ADD DL,$04
MOV AL,$3D
OUT DX,AL
INC DX
MOV AL,00011000b
OUT DX,AL
DEC DX
MOV CX,$0200
@LP1: NOP
LOOP @LP1
MOV AL,$3E
OUT DX,AL
INC DX
MOV AL,00011000b
OUT DX,AL
END;
END;
STARTDMA (SEG(DMABUF^),OFS(DMABUF^),$01);
TEXTCOLOR (WHITE);
WRITELN ('Receive status:');
TEXTCOLOR (LIGHTGRAY);
2:FIRSTWAVEDOWN := FALSE;
GOTOXY (1,WHEREY);
WRITE ('Waiting for control block...');
CLREOL;
REPEAT
SEEKENDOFWAVE;
IF USERBREAK THEN GOTO 1;
UNTIL (WAVELENGTH > MAXWAVE1) AND (WAVELENGTH <= MAXWAVE0);
IF NOT READFIRSTBYTEHEADER THEN GOTO 2;
HEADER[0] := $2A;
HP := 1;
REPEAT
HEADER[HP] := READONEATMBYTE;
IF USERBREAK THEN GOTO 1;
INC (HP);
UNTIL ((HP >= $0D) AND (HEADER[HP-$09] = $0D)) OR (HP >= $80);
GOTOXY (1,WHEREY);
IF (HEADER[$00] <> ORD('*')) OR (HEADER[$01] <> ORD('*')) OR
(HEADER[$02] <> ORD('*')) OR (HEADER[$03] <> ORD('*')) THEN GOTO 2;
APPEND (TOF);
I := $04;
WHILE HEADER[I] <> $0D DO
BEGIN
WRITE (CHR(HEADER[I]));
WRITE (TOF,CHR(HEADER[I]));
ATMHEADER.ATOMNAME[I-$04] := HEADER[I];
INC (I);
END;
INC (I);
WHILE WHEREX < 17 DO
BEGIN
WRITE (' ');
WRITE (TOF,' ');
END;
W := HEADER[I+$07] + (WORD(HEADER[I+$06]) SHL 8);
IF HEADER[I+$02] = $00 THEN ATMHEADER.STARTADDRESS := W;
WRITE (HEXW(W),' ');
WRITE (TOF,HEXW(W),' ');
NUMBYTES := SUCC(WORD(HEADER[I+$03]));
INC (W,PRED(NUMBYTES));
WRITE (HEXW(W),' ');
WRITE (TOF,HEXW(W),' ');
W := HEADER[I+$05] + (WORD(HEADER[I+$04]) SHL 8);
IF HEADER[I+$02] = $00 THEN ATMHEADER.EXECADDRESS := W;
WRITE (HEXW(W),' ');
WRITE (TOF,HEXW(W),' ');
W := HEADER[I+$02];
WRITE (HEX(W),' ');
WRITE (TOF,HEX(W),' ');
IF SPEEDMODE = FCOS THEN
BEGIN
WRITE ('1200');
WRITE (TOF,'1200');
END ELSE
BEGIN
WRITE (' 300');
WRITE (TOF,' 300');
END;
WRITE (' bps ');
WRITE (TOF,' bps ');
GEEFTIJD;
HT := LONGINT(TIJD.UUR)*3600 +
LONGINT(TIJD.MIN)*60 +
LONGINT(TIJD.SEC);
WRITE (LZ(TIJD.UUR),':',LZ(TIJD.MIN),':',LZ(TIJD.SEC),' ');
WRITE (TOF,LZ(TIJD.UUR),':',LZ(TIJD.MIN),':',LZ(TIJD.SEC),' ');
HT := HT - STARTTIJD;
IF HT < 0 THEN INC (HT,24*3600);
TIJD.UUR := HT DIV 3600;
TIJD.MIN := (HT MOD 3600) DIV 60;
TIJD.SEC := (HT MOD 3600) MOD 60;
WRITELN (LZ(TIJD.UUR),':',LZ(TIJD.MIN),':',LZ(TIJD.SEC));
WRITELN (TOF,LZ(TIJD.UUR),':',LZ(TIJD.MIN),':',LZ(TIJD.SEC));
CLOSE (TOF);
GOTO 2;
1:STOPDMA;
SETIRQMASK;
IRQVECTOR (0);
END;
{---[main]------------------------------------------------------------------}
LABEL 1;
CONST MONTH:ARRAY[1..12] OF STRING[9] =
('january','februari','march','april','may','june',
'july','august','september','october','november','december');
VAR PHYSADDR:LONGINT;
DUMMY:POINTER;
DUMMYSIZE:LONGINT;
CH:CHAR;
BEGIN
SPEEDMODE := FCOS;
CLRSCR;
TEXTCOLOR (WHITE);
WRITELN ('--------------------------------------------------');
WRITELN (' TapeCat v1.00 (c) Wouter Ras, Delft, March 1998. ');
WRITELN ('--------------------------------------------------');
WRITELN;
TEXTCOLOR (LIGHTGRAY);
WINDOW (1,5,80,25);
INITBLASTER;
{allocate memory for dma buffer, make sure it's entirely on 1 page}
GETMEM (DUMMY,1);
PHYSADDR := (LONGINT(SEG(DUMMY^)) SHL 4) + LONGINT(OFS(DUMMY^));
DUMMYSIZE := $10000 - (PHYSADDR AND $FFFF);
IF DUMMYSIZE >= SIZEOF(DMABUFTYPE) THEN DUMMYSIZE := 0;
FREEMEM (DUMMY,1);
GETMEM (DUMMY,DUMMYSIZE);
GETMEM (DMABUF,SIZEOF(DMABUFTYPE));
FILENAME := '';
1:WRITE ('Enter filename? ');
INPUTSTRING (45,FILENAME);
IF LENGTH(FILENAME) = 0 THEN GOTO 1;
IF USERBREAK THEN
BEGIN
WRITE ('[Esc]');
CLREOL;
WRITELN;
WRITELN;
HALT;
END;
FSPLIT (FILENAME,DIR,NAME,EXT);
IF (EXT='') OR (EXT='.') THEN EXT := '.CAT';
FILENAME := DIR + NAME + EXT;
WRITELN;
WRITELN;
ASSIGN (TOF,FILENAME);
RESET (TOF);
IF IORESULT = 0 THEN
BEGIN
WRITE (FILENAME,' exists. Overwrite [Y/N] ? N',#8);
REPEAT
CH := UPCASE(READKEY);
IF (CH=#13) OR (CH=#27) THEN CH := 'N';
UNTIL (CH='Y') OR (CH='N');
WRITELN (CH);
WRITELN;
IF CH='N' THEN GOTO 1;
END;
REWRITE (TOF);
IF IORESULT <> 0 THEN
BEGIN
WRITELN ('Error while creating file. Program aborted.');
HALT;
END;
WRITELN (TOF,'--------------------------------------------------');
WRITELN (TOF,' TapeCat v1.00 (c) Wouter Ras, Delft, March 1998.');
WRITELN (TOF,'--------------------------------------------------');
GEEFDATUM;
WRITE (TOF,'Date: ',DATUM.DAG,' ',MONTH[DATUM.MAAND],' ',DATUM.JAAR,', ');
GEEFTIJD;
STARTTIJD := LONGINT(TIJD.UUR)*3600 +
LONGINT(TIJD.MIN)*60 +
LONGINT(TIJD.SEC);
WRITELN (TOF,'Time: ',LZ(TIJD.UUR),':',LZ(TIJD.MIN),':',LZ(TIJD.SEC));
WRITELN (TOF);
WRITELN (TOF);
CLOSE (TOF);
ATOM_TO_PC;
END.
|