DECLARE FUNCTION W$ (a%)
DECLARE SUB WRITEHEAD ()
OPTION BASE 0
CONST SYNCHRO = 3
DIM a AS INTEGER, I AS INTEGER
DIM SHARED CNT AS LONG
DIM C AS LONG
DIM COUNT(4) AS INTEGER
DIM SHARED ST(4) AS STRING
DIM D(4, 141) AS INTEGER
DIM SHARED DSTWAV AS STRING
DIM DST AS STRING, SRC AS STRING
DIM SHARED FREQ AS INTEGER: FREQ = 22050

DATA 0,63,63,0,-64,-64,0,63,63,0,-64,-64,256
DATA 0,32,55,64,55,32,0,-33,-56,-65,-56,-33,0,55,55,0,-56,-56,256
DATA 0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,0,63,63,0,-64,-64,256
DATA 0,16,29,36,38,41,41,42,42,42,42,42,0,-17,-30,-37,-41,-42,-43,-43,-43,-43,-43,-18,0,26,34,38,39,41,0,-17,-29,-36,-39,-39,0,55,55,0,-56,-56,256
DATA 0,15,40,53,60,63,65,65,66,66,66,66,66,65,65,65,65,65,64,64,64,64,64,63,63,62,62,62,61,60,50,0,-39,-56,-64,-69,-71,-72,-73,-73,-73,-73,-73,-72,-72,-72,-72,-71,-71,-71,-71,-71,-70,-70,-70,-70,-70,-69,-69,-69,-69,-68,-66,-6,256

CLS
RESTORE
FOR J = 0 TO 4
I = 0
DO: I = I + 1: READ a: IF a = 256 THEN EXIT DO
D(J, I) = a + 128: ST(J) = ST(J) + CHR$(a + 128)
LOOP
COUNT(J) = I
NEXT J

INPUT "Enter binary file name: ", SRC
DST = "": INPUT "Enter target file name (Enter for default): ", DST
IF DST = "" THEN DST = SRC
LDST = LEN(DST)
IF LDST < 16 THEN DST = DST + STRING$(16 - LDST, 32)
DPOS = INSTR(SRC, ".")
DSTWAV = SRC
IF DPOS > 0 THEN DSTWAV = LEFT$(DSTWAV, DPOS - 1)
IF LEN(DSTWAV) > 8 THEN DSTWAV = LEFT$(DSTWAV, 8)
DSTWAV = DSTWAV + ".wav"
PRINT "Audio file name: "; DSTWAV

FOR I = 1 TO 16
Q% = ASC(MID$(DST, I))
NM$ = NM$ + W$(Q%)
NEXT I
GOSUB T1

CNT = (512& + 2& + 32&) * LEN(ST(2)) + 4& * LEN(ST(SYNCHRO)) + LEN(AD$ + NM$) + LNG + LEN(CS$) + LEN(ST(4))
CALL WRITEHEAD

FOR I = 1 TO 512: PRINT #1, ST(2); : NEXT: PRINT #1, ST(SYNCHRO);
PRINT #1, ST(2); ST(SYNCHRO);
PRINT #1, AD$; NM$;
PRINT #1, ST(2); ST(SYNCHRO);
GOSUB WR
PRINT #1, CS$;
PRINT #1, ST(4);
FOR I = 1 TO 32: PRINT #1, ST(2); : NEXT: PRINT #1, ST(SYNCHRO);
CLOSE 1
END

T1:
SM& = 0
OPEN SRC FOR BINARY AS #2
AD0$ = INPUT$(4, #2): AD$ = "": FOR I = 1 TO 4: AD$ = AD$ + W$(ASC(MID$(AD0$, I))): NEXT
C = 0: LNG = 0
DO
E$ = INPUT$(1, #2): IF E$ = "" THEN EXIT DO
a% = ASC(E$)
SM& = SM& + CLNG(a%): IF SM& > 65535 THEN SM& = SM& - 65535
C = C + 1
LNG = LNG + LEN(W$(a%))
LOOP
PRINT "Checksum="; HEX$(C)
CLOSE #2

CS1% = CINT(SM& AND 255)
CS2% = CINT((SM& AND NOT 255) / 256)
CS$ = W$(CS1%) + W$(CS2%)
RETURN

WR:
OPEN SRC FOR BINARY AS #2
DC$ = INPUT$(4, #2)
DO
E$ = INPUT$(1, #2): IF E$ = "" THEN EXIT DO
a% = ASC(E$)
PRINT #1, W$(a%);
LOOP
CLOSE #2
RETURN

FUNCTION W$ (V%)
T$ = ""
FOR G% = 0 TO 7
U% = 2 ^ G%
T$ = T$ + ST((V% AND U%) / U%)
NEXT G%
W$ = T$
END FUNCTION

SUB WRITEHEAD
OPEN DSTWAV FOR OUTPUT ACCESS WRITE AS #1
PRINT #1, "RIFF";
Z$ = MKL$(CNT + 36): PRINT #1, Z$;
PRINT #1, "WAVEfmt ";
Z$ = MKL$(16): PRINT #1, Z$; 'subchunk size
Z$ = MKI$(1): PRINT #1, Z$; 'PCM
Z$ = MKI$(1): PRINT #1, Z$; 'Mono
Z$ = MKL$(FREQ): PRINT #1, Z$; 'kHz
Z$ = MKL$(FREQ): PRINT #1, Z$; 'Byterate
Z$ = MKI$(1): PRINT #1, Z$; 'Blockalign
Z$ = MKI$(8): PRINT #1, Z$; 'bit
PRINT #1, "data";
Z$ = MKL$(CNT): PRINT #1, Z$;
END SUB