(***************************************************************************)
(*                                                                         *)
(*         AtomCom v1.10 (c) by Wouter Ras, Delft, Dec 97 - Mar 98         *)
(*         -------------------------------------------------------         *)
(*                                                                         *)
(* 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,655360}
PROGRAM ATOMCOM;
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 ATMBUFTYPE   = ARRAY[$0000..$FFF7] OF BYTE;
     DMABUFTYPE   = ARRAY[$0000..PRED(SAMPLESIZE)] OF BYTE;
     SPEEDTYPE    = (SCOS,FCOS);
     ATMHEADERREC = RECORD
                      ATOMNAME     : ARRAY[$00..$0F] OF BYTE;
                      STARTADDRESS : WORD;
                      EXECADDRESS  : WORD;
                      DATASIZE     : WORD;
                    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}
    ATMBUF        : ^ATMBUFTYPE; {buffer containing .atm file}
    ATMSIZE       : WORD;        {size of .atm file}
    DMABUF        : ^DMABUFTYPE; {samplebuffer 1}
    DMABUFNR      : BYTE;        {buffernumber currently outputted to dsp}
    ATMBUFPTR     : WORD;        {pointer to data from/to atmbuffer}
    DMABUFPTR     : WORD;        {pointer to data from/to _NOT_ dmabuffer}
    WAVEPOS       : REAL;        {pointer to data retrieved from wave arrays}
    CHECKSUM      : BYTE;        {checksum for sending after datablock}
    IRQOCC        : BYTE;        {irq occurred? 00h=no; 01h=yes}
    ENDOFDATA     : BYTE;        {whether or not end of data has been reached}
    USERBREAK     : BOOLEAN;     {escape pressed?}
    FIRSTMAIN     : BOOLEAN;     {first time main menu called: don't clrscr}
    FIRSTWAVEDOWN : BOOLEAN;
    WAVELENGTH    : BYTE;
    ATMHEADER     : ATMHEADERREC;
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
               CMP   BYTE PTR ENDOFDATA,$01
               JB    @IRQH2
               INC   BYTE PTR ENDOFDATA
@IRQH2:        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;
  FIRSTMAIN := TRUE;
END;
{---[main menu]-------------------------------------------------------------}
PROCEDURE MAINMENU (VAR SELECTION:BYTE);
VAR CH:CHAR;
BEGIN
  IF NOT FIRSTMAIN THEN CLRSCR
                   ELSE FIRSTMAIN := FALSE;
  TEXTCOLOR (LIGHTCYAN);
  WRITELN ('M A I N   M E N U');
  TEXTCOLOR (CYAN);
  WRITELN;
  WRITELN ('1   : Transfer data from PC to ATOM,');
  WRITELN ('2   : Transfer data from ATOM to PC,');
  WRITELN ('Esc : Return to OS.');
  TEXTCOLOR (LIGHTGRAY);
  WHILE KEYPRESSED DO CH := READKEY;
  REPEAT
    CH := READKEY;
    IF CH=#27 THEN HALT;
  UNTIL (CH >= '1') AND (CH <= '2');
  SELECTION := ORD(CH)-48;
  WRITELN;
END;
{---[data from pc to atom]--------------------------------------------------}
FUNCTION BUFHALF:WORD;
BEGIN
  IF DMABUFNR = 1 THEN BUFHALF := SIZEOF(DMABUFTYPE) SHR 1
                  ELSE BUFHALF := 0;
END;
PROCEDURE WAITFORDMA; {buffer filled, wait until other buffer is free}
VAR CH:CHAR;
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;
PROCEDURE WRITEWAVE (BIT:BYTE);
VAR I,AANT:BYTE;
BEGIN
  IF SPEEDMODE = SCOS THEN AANT := 4
                      ELSE AANT := 1;
  IF BIT=0 THEN
  BEGIN
    FOR I := 1 TO AANT DO
    BEGIN
      WHILE (ROUND(WAVEPOS) < SIZEOF(WAVE0)) AND (NOT USERBREAK) DO
      BEGIN
        DMABUF^[BUFHALF+DMABUFPTR] := $80 - WAVE0[ROUND(WAVEPOS)];
        WAVEPOS := WAVEPOS + SIZEOF(WAVE0)/(22050/1200);
        INC (DMABUFPTR);
        IF DMABUFPTR >= (SIZEOF(DMABUFTYPE) SHR 1) THEN WAITFORDMA;
      END;
      WAVEPOS := WAVEPOS - SIZEOF(WAVE0);
    END;
  END ELSE
  BEGIN
    FOR I := 1 TO AANT DO
    BEGIN
      WHILE (ROUND(WAVEPOS) < SIZEOF(WAVE1)) AND (NOT USERBREAK) DO
      BEGIN
        DMABUF^[BUFHALF+DMABUFPTR] := $80 - WAVE1[ROUND(WAVEPOS)];
        WAVEPOS := WAVEPOS + SIZEOF(WAVE1)/(22050/1200);
        INC (DMABUFPTR);
        IF DMABUFPTR >= (SIZEOF(DMABUFTYPE) SHR 1) THEN WAITFORDMA;
      END;
      WAVEPOS := WAVEPOS - SIZEOF(WAVE1);
    END;
  END;
END;
PROCEDURE WRITEBYTE (BT:BYTE);
VAR I:WORD;
BEGIN
  CHECKSUM := (CHECKSUM + BT) AND $FF;
  WRITEWAVE (0); {---startbit---}
  I := $01;
  WHILE I < $0100 DO
  BEGIN
    IF BT AND I <> $00 THEN WRITEWAVE (1)
                       ELSE WRITEWAVE (0);
    I := I SHL 1;
  END;
  WRITEWAVE (1); {---stopbit---}
  {---extra half wave1---}
  WHILE (ROUND(WAVEPOS) < 46) AND (NOT USERBREAK) DO
  BEGIN
    DMABUF^[BUFHALF+DMABUFPTR] := $80 - WAVE1[ROUND(WAVEPOS)];
    WAVEPOS := WAVEPOS + SIZEOF(WAVE1)/(22050/1200);
    INC (DMABUFPTR);
    IF DMABUFPTR >= (SIZEOF(DMABUFTYPE) SHR 1 ) THEN WAITFORDMA;
  END;
  WAVEPOS := WAVEPOS - 46;
END;
PROCEDURE LOADSOURCEFILE;
VAR FROMF:FILE;
    SOURCEFILENAME:STRING;
    I:BYTE;
    CH:CHAR;
BEGIN
  WRITE ('Name of .ATM-file ? ');
  SOURCEFILENAME := '';
  INPUTSTRING (59,SOURCEFILENAME);
  IF USERBREAK THEN EXIT;
  WRITELN;
  WRITELN;
  FOR I := 1 TO LENGTH(SOURCEFILENAME) DO
    SOURCEFILENAME[I] := UPCASE(SOURCEFILENAME[I]);
  IF COPY(SOURCEFILENAME,LENGTH(SOURCEFILENAME)-3,4) <> '.ATM' THEN
    SOURCEFILENAME := SOURCEFILENAME + '.ATM';
  ASSIGN (FROMF,SOURCEFILENAME);
  RESET (FROMF,1);
  IF IORESULT <> 0 THEN
  BEGIN
    WRITELN (SOURCEFILENAME,' not found.');
    WHILE KEYPRESSED DO CH := READKEY;
    CH := READKEY;
    WHILE KEYPRESSED DO CH := READKEY;
    USERBREAK := TRUE;
    EXIT;
  END;
  ATMSIZE := FILESIZE(FROMF);
  BLOCKREAD (FROMF,ATMBUF^,ATMSIZE);
  CLOSE (FROMF);
END;
PROCEDURE PC_TO_ATOM;
LABEL 1,2,3;
VAR CH:CHAR;
    I:WORD;
    BLOCKNUMBER:BYTE;
    NUMBYTES:WORD;
    STARTADDRESS:WORD;
    ENDADDRESS:WORD;
    W:WORD;
    S:STRING;
BEGIN
  TEXTCOLOR (YELLOW);
  I := 0;
  WHILE (I < 16) AND (ATMBUF^[I] <> $00) DO
  BEGIN
    WRITE (CHR(ATMBUF^[I]));
    INC (I);
  END;
  WHILE WHEREX < 18 DO WRITE (' ');
  STARTADDRESS := ATMBUF^[$10] + SWAP(ATMBUF^[$11]);
  ENDADDRESS := ATMBUF^[$14] + SWAP(ATMBUF^[$15]) + STARTADDRESS;
  WRITE (HEXW(STARTADDRESS),' ',HEXW(ENDADDRESS),' ');
  WRITELN (HEXW(ATMBUF^[$12]+SWAP(ATMBUF^[$13])));
  TEXTCOLOR (LIGHTGRAY);
  WRITE ('Use SLOW or FAST tape interface [S/F] ? ');
  IF SPEEDMODE = SCOS THEN WRITE ('S')
                      ELSE WRITE ('F');
  WRITE (#8);
  WHILE KEYPRESSED DO CH := READKEY;
  REPEAT
    CH := UPCASE(READKEY);
    IF CH=#27 THEN GOTO 1;
    IF CH=#13 THEN IF SPEEDMODE = SCOS THEN CH := 'S'
                                       ELSE CH := 'F';
  UNTIL (CH='S') OR (CH='F');
  WRITELN (CH);
  IF CH='S' THEN SPEEDMODE := SCOS
            ELSE SPEEDMODE := FCOS;
2:GOTOXY (1,WHEREY);
  WRITE ('Start at ? ');
  CLREOL;
  S := HEXW(STARTADDRESS);
  INPUTSTRING (4,S);
  IF USERBREAK THEN GOTO 1;
  W := HEX2DEC (S);
  IF (W < STARTADDRESS) OR (W >= ENDADDRESS) THEN GOTO 2;
  STARTADDRESS := W;
  WRITELN ('h');
3:GOTOXY (1,WHEREY);
  WRITE ('End at ? ');
  CLREOL;
  S := HEXW(ENDADDRESS);
  INPUTSTRING (4,S);
  IF USERBREAK THEN GOTO 1;
  W := HEX2DEC (S);
  IF (W <= STARTADDRESS) OR (W > ENDADDRESS) THEN GOTO 3;
  ENDADDRESS := W;
  WRITELN ('h');
  WRITELN;
  USERBREAK := FALSE;
  ENDOFDATA := $00;
  IRQOCC := $00;
  DMABUFNR := 1;
  DMABUFPTR := $0000;
  ATMBUFPTR := $0016;
  W := STARTADDRESS - (ATMBUF^[$10] + SWAP(ATMBUF^[$11]));
  MOVE (ATMBUF^[$0016+W],ATMBUF^[$0016],ATMSIZE-W);
  ATMSIZE := $0016 + ENDADDRESS - STARTADDRESS;
  WAVEPOS := 0;
  FILLCHAR (DMABUF^,SIZEOF(DMABUFTYPE),$80);
  BLOCKNUMBER := $00;
  IRQVECTOR (1);
  CLRIRQMASK;
  STARTDMA (SEG(DMABUF^),OFS(DMABUF^),$00);
  TEXTCOLOR (WHITE);
  WRITE ('Send status:');
  TEXTCOLOR (LIGHTGRAY);
  WHILE (ATMBUFPTR < ATMSIZE) AND (NOT USERBREAK) DO
  BEGIN
    NUMBYTES := $0100;
    IF ATMSIZE - ATMBUFPTR < $0100 THEN NUMBYTES := ATMSIZE - ATMBUFPTR;
    FOR I := 1 TO 1200 DO WRITEWAVE (1);
    WRITELN;
    FOR I := 0 TO 15 DO
    BEGIN
      IF ATMBUF^[I] = $00 THEN WRITE (' ')
                          ELSE WRITE (CHR(ATMBUF^[I]));
    END;
    I := STARTADDRESS + SWAP(BLOCKNUMBER);
    WRITE (' ',HEXW(I),' ',HEXW(I+PRED(NUMBYTES)));
    WRITE (' ',HEXW(SWAP(ATMBUF^[$13])+ATMBUF^[$12]));
    WRITE (' ',HEX(BLOCKNUMBER));
    CLREOL;
    {---write control block---}
    CHECKSUM := $00;
    FOR I := 1 TO 4 DO WRITEBYTE (ORD('*'));
    I := 0;
    WHILE (I < 16) AND (ATMBUF^[I] <> $00) DO
    BEGIN
      WRITEBYTE (ATMBUF^[I]);
      INC (I);
    END;
    WRITEBYTE ($0D);
    {---last block?---}
    IF ATMBUFPTR + 256 >= ATMSIZE THEN WRITEBYTE ($7F)
                                  ELSE WRITEBYTE ($FF);
    WRITEBYTE ($00);
    WRITEBYTE (BLOCKNUMBER);
    WRITEBYTE (PRED(NUMBYTES));
    WRITEBYTE (ATMBUF^[$13]);
    WRITEBYTE (ATMBUF^[$12]);
    WRITEBYTE (HI(STARTADDRESS + SWAP(BLOCKNUMBER)));
    WRITEBYTE (LO(STARTADDRESS));
    IF SPEEDMODE = SCOS THEN FOR I := 1 TO 240 DO WRITEWAVE (1)
                        ELSE FOR I := 1 TO 300 DO WRITEWAVE (1);
    {---write datablock---}
    FOR I := 0 TO PRED(NUMBYTES) DO WRITEBYTE (ATMBUF^[ATMBUFPTR+I]);
    INC (ATMBUFPTR,NUMBYTES);
    {---write checksum---}
    WRITEBYTE (CHECKSUM);
    INC (BLOCKNUMBER);
  END;
  WRITEWAVE (1);
  FILLCHAR (DMABUF^[BUFHALF+DMABUFPTR],(SIZEOF(DMABUFTYPE) SHR 1)-DMABUFPTR,$80);
  ENDOFDATA := $01;
  REPEAT UNTIL (ENDOFDATA = $03) OR USERBREAK;
  STOPDMA;
  SETIRQMASK;
  IRQVECTOR (0);
1:GOTOXY (1,WHEREY);
  IF USERBREAK THEN WRITE ('User break.')
               ELSE WRITE ('Transfer ended.');
  CLREOL;
  WRITELN;
END;
{---[data from atom to pc]--------------------------------------------------}
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 (FIRSTWAVEDONE:BOOLEAN):BYTE;
VAR DATABITS:ARRAY[0..9] OF BYTE;
    S:STRING[16];
    I:BYTE;
BEGIN
  I := 0;
  DATABITS[0] := 0;
  S := '';
  IF SPEEDMODE = SCOS THEN
  BEGIN
    IF FIRSTWAVEDONE THEN S := '00';
  END ELSE
  BEGIN
    IF FIRSTWAVEDONE THEN I := 1;
  END;
  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
      GOTOXY (1,WHEREY);
      WRITELN ('Error: Misformed wave pattern.');
      USERBREAK := TRUE;
      EXIT;
    END;
  END;
  SEEKENDOFWAVE; {stopbit always has one extra wave}
  IF DATABITS[0] <> 0 THEN
  BEGIN
    GOTOXY (1,WHEREY);
    WRITELN ('Error: No startbit (0) found.');
    USERBREAK := TRUE;
    EXIT;
  END;
  IF DATABITS[9] <> 1 THEN
  BEGIN
    GOTOXY (1,WHEREY);
    WRITELN ('Error: No stopbit (1) found.');
    USERBREAK := TRUE;
    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,3,4;
VAR HEADER:ARRAY[$00..$FF] OF BYTE;
    HP:BYTE;
    NUMBYTES:WORD;
    I:BYTE;
    W:WORD;
    EERSTE:BOOLEAN;
    LASTBLOCK:BOOLEAN;
    TOF:FILE;
    STARTOFBLOCK:WORD;
    CH:CHAR;
    DESTFILENAME:STRING;
BEGIN
  USERBREAK := FALSE;
  ENDOFDATA := $00;
  IRQOCC := $00;
  DMABUFNR := 1;
  DMABUFPTR := $0000;
  ATMBUFPTR := $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:STARTOFBLOCK := ATMBUFPTR;
  FIRSTWAVEDOWN := FALSE;
  WRITE ('Waiting for control block...');
  REPEAT
    SEEKENDOFWAVE;
    IF USERBREAK THEN GOTO 1;
  UNTIL (WAVELENGTH > MAXWAVE1) AND (WAVELENGTH <= MAXWAVE0);
  GOTOXY (1,WHEREY);
  IF NOT READFIRSTBYTEHEADER THEN GOTO 2;
  WRITE ('Receiving control block...');
  CLREOL;
  HEADER[0] := $2A;
  HP := 1;
  CHECKSUM := $2A;
  REPEAT
    HEADER[HP] := READONEATMBYTE (FALSE);
    IF USERBREAK THEN GOTO 1;
    CHECKSUM := LO(CHECKSUM + HEADER[HP]);
    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
  BEGIN
    WRITELN ('Error: Control block corrupted.');
    USERBREAK := TRUE;
    GOTO 1;
  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---}
  FIRSTWAVEDOWN := FALSE;
  WRITE ('Waiting for data block...');
  REPEAT
    SEEKENDOFWAVE;
    IF USERBREAK THEN GOTO 1;
  UNTIL (WAVELENGTH > MAXWAVE1) AND (WAVELENGTH <= MAXWAVE0);
  {---read datablock---}
  GOTOXY (1,WHEREY);
  WRITE ('Receiving data block...');
  CLREOL;
  EERSTE := TRUE;
  FOR W := 1 TO NUMBYTES DO
  BEGIN
    ATMBUF^[ATMBUFPTR] := READONEATMBYTE (EERSTE);
    EERSTE := FALSE;
    IF USERBREAK THEN GOTO 1;
    CHECKSUM := LO(CHECKSUM + ATMBUF^[ATMBUFPTR]);
    INC (ATMBUFPTR);
  END;
  I := READONEATMBYTE (FALSE); {---checksum---}
  GOTOXY (1,WHEREY);
  CLREOL;
  IF I <> CHECKSUM THEN
  BEGIN
    WRITELN ('Checksum error: ',HEX(CHECKSUM),'h must be ',HEX(I),'h.');
    USERBREAK := TRUE;
    GOTO 1;
  END;
  IF NOT LASTBLOCK THEN GOTO 2;
  STOPDMA;
  SETIRQMASK;
  IRQVECTOR (0);
3:ATMHEADER.DATASIZE := ATMBUFPTR;
  WRITELN;
  WRITELN;
4:WRITE ('Name of .ATM-file ? ');
  DESTFILENAME := '';
  INPUTSTRING (59,DESTFILENAME);
  IF USERBREAK THEN EXIT;
  WRITELN;
  WRITELN;
  FOR I := 1 TO LENGTH(DESTFILENAME) DO
    DESTFILENAME[I] := UPCASE(DESTFILENAME[I]);
  IF COPY(DESTFILENAME,LENGTH(DESTFILENAME)-3,4) <> '.ATM' THEN
    DESTFILENAME := DESTFILENAME + '.ATM';
  ASSIGN (TOF,DESTFILENAME);
  RESET (TOF,1);
  IF IORESULT = 0 THEN
  BEGIN
    CLOSE (TOF);
    WRITE ('Filename ',DESTFILENAME,' already exists. Overwrite [Y/N] ? Y',#8);
    WHILE KEYPRESSED DO CH := READKEY;
    REPEAT
      CH := UPCASE(READKEY);
      IF CH=#27 THEN CH := 'N';
      IF CH=#13 THEN CH := 'Y';
    UNTIL (CH='Y') OR (CH='N');
    WRITELN (CH);
    WRITELN;
    IF CH='N' THEN GOTO 4;
  END;
  REWRITE (TOF,1);
  IF IORESULT <> 0 THEN
  BEGIN
    WRITELN ('Access denied or other I/O-error.');
    GOTO 4;
  END;
  BLOCKWRITE (TOF,ATMHEADER,SIZEOF(ATMHEADER));
  BLOCKWRITE (TOF,ATMBUF^,ATMBUFPTR);
  CLOSE (TOF);
  EXIT;
  {if error occurred}
1:STOPDMA;
  SETIRQMASK;
  IRQVECTOR (0);
  ATMBUFPTR := STARTOFBLOCK;
  IF ATMBUFPTR = $0000 THEN EXIT;
  WRITELN;
  WRITE (HEXW(ATMBUFPTR),'h (',ATMBUFPTR,') bytes of data have been ');
  WRITE ('received and verified. Save [Y/N] ? Y',#8);
  WHILE KEYPRESSED DO CH := READKEY;
  REPEAT
    CH := UPCASE(READKEY);
    IF CH=#27 THEN CH := 'N';
    IF CH=#13 THEN CH := 'Y';
  UNTIL (CH='Y') OR (CH='N');
  WRITE (CH);
  IF CH='Y' THEN GOTO 3;
END;
{---[change baudrate]-------------------------------------------------------}
PROCEDURE CHANGEBAUDRATE;
VAR CH:CHAR;
BEGIN
  WRITE ('Use SLOW or FAST tape interface [S/F] ? ');
  IF SPEEDMODE = SCOS THEN WRITE ('S')
                      ELSE WRITE ('F');
  WRITE (#8);
  WHILE KEYPRESSED DO CH := READKEY;
  REPEAT
    CH := UPCASE(READKEY);
    IF (CH=#13) OR (CH=#27) THEN EXIT;
  UNTIL (CH='S') OR (CH='F');
  WRITELN (CH);
  IF CH='S' THEN SPEEDMODE := SCOS
            ELSE SPEEDMODE := FCOS;
END;
{---[main]------------------------------------------------------------------}
LABEL 1;
VAR SELECTION:BYTE;
    PHYSADDR:LONGINT;
    DUMMY:POINTER;
    DUMMYSIZE:LONGINT;
BEGIN
  SPEEDMODE := FCOS;
  CLRSCR;
  TEXTCOLOR (WHITE);
  WRITELN ('-------------------------------------------------------');
  WRITELN (' AtomCom v1.10 (c) Wouter Ras, Delft, Dec 97 - Mar 98.');
  WRITELN ('-------------------------------------------------------');
  WRITELN;
  TEXTCOLOR (LIGHTGRAY);
  WINDOW (1,5,80,25);
  INITBLASTER;
  GETMEM (ATMBUF,SIZEOF(ATMBUFTYPE));
  {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));
1:MAINMENU (SELECTION);
  CASE SELECTION OF 1: BEGIN
                         WRITELN ('Transfer data from PC to ATOM.');
                         WRITELN;
                         LOADSOURCEFILE;
                         IF USERBREAK THEN GOTO 1;
                         PC_TO_ATOM;
                       END;
                    2: BEGIN
                         WRITELN ('Transfer data from ATOM to PC.');
                         WRITELN;
                         ATOM_TO_PC;
                       END;
  END;
  GOTO 1;
END.