'===========================================================================
' Subject: RIP 669 SOUND UTILITY             Date: 08-18-93 (00:16)       
' Author:  Edward Schlunder                  Code: PDS                    
' Keys:    RIP,669,SOUND,UTILITY           Packet: SOUND.ABC
'===========================================================================
'      Here's a little program to rip out the samples in a 669 file. It
'   will help you get the hang of 669 file formats.. I'm sorry if it
'   doesn't run in QB4.5, I'm using PDS 7.1..

'      Yeah, it's copyrighted, but you guys can use any of the stuff in
'   here as long as you give me credit for the things I wrote. Ok guys?

DEFINT A-Z
DECLARE FUNCTION Exist% (FileName$)
TYPE RegTypeX
 AX AS INTEGER
 BX AS INTEGER
 CX AS INTEGER
 DX AS INTEGER
 BP AS INTEGER
 SI AS INTEGER
 DI AS INTEGER
 FLAGS AS INTEGER
 DS AS INTEGER
 ES AS INTEGER
END TYPE

TYPE Struc669
 Marker    AS INTEGER
 SongMess1 AS STRING * 36
 SongMess2 AS STRING * 36
 SongMess3 AS STRING * 36
 NOS       AS STRING * 1
 NOP       AS STRING * 1
 Loop      AS STRING * 1
 PatOrder  AS STRING * 128
 PatTempo  AS STRING * 128
 PatBreak  AS STRING * 128
END TYPE

TYPE SampType
 FileName  AS STRING * 13
 InsLeng   AS LONG
 BegLoop   AS LONG
 EndLoop   AS LONG
END TYPE

COLOR 10, 1
CLS
PRINT "                              Rip 669 sound utility."
PRINT "                                  Version 1.00."
PRINT "             Written by: Edward Schlunder. Copyright (C) 1993,
MAGICS"
COLOR 11
PRINT STRING$(80, 196);
PRINT

COLOR 12, 1
FileName$ = COMMAND$

GetNewFile:
IF LEN(FileName$) = 0 THEN
COLOR 12
PRINT "Enter EXIT to abort."
INPUT "Name and path of file to rip [HARDWIRE]: ", FileName$
IF UCASE$(FileName$) = "EXIT" THEN END
IF LEN(FileName$) = 0 THEN FileName$ = "HARDWIRE"
END IF

IF INSTR(FileName$, ".") = 0 THEN FileName$ = FileName$ + ".669"

IF Exist(FileName$) = 0 THEN
COLOR 12
PRINT "File "; FileName$; " does not exist! ";
FileName$ = ""
GOTO GetNewFile
END IF

OPEN FileName$ FOR BINARY AS 1

DIM Header AS Struc669
GET 1, 1, Header
IF Header.Marker <> &H6669 THEN
COLOR 12
PRINT "File is not in .669 file format or is corrupted."
END
ELSE
COLOR 12
PRINT "Valid .669 file."
END IF

COLOR 12
COLOR 10
PRINT "ÚÄ ";
COLOR 12
PRINT "Song Message: ";
COLOR 10
PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³"; Header.SongMess1; "³"
PRINT "³"; Header.SongMess2; "³"
PRINT "³"; Header.SongMess3; "³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

COLOR 12
NOS& = ASC(Header.NOS)
NOP& = ASC(Header.NOP)
PRINT "Number of samples saved: "; NOS&
PRINT "Number of patterns saved:"; NOP&

DIM Samples(NOS&) AS SampType
FOR J = 0 TO NOS& - 1
 GET 1, , Samples(J)
NEXT


SEEK 1, &H1F1 + NOS& * 25 + NOP& * 1536
COLOR 11
 FOR J = 0 TO NOS& - 1
GetNew:
 IF INSTR(Samples(J).FileName, CHR$(0)) > 9 THEN
  IF INSTR(Samples(J).FileName, ".") = 0 THEN
   MID$(Samples(J).FileName, 9, 1) = CHR$(0)
  END IF
 END IF

 File$ = LEFT$(Samples(J).FileName, INSTR(Samples(J).FileName, CHR$(0)) - 1)
 IF File$ = "" THEN J = J + 1: GOTO GetNew

 IF Exist((File$)) THEN
  Row = CSRLIN
  LOCATE 24, 1
  PRINT File$; " already exists! Input new filename (SKIP to goto next):";
  INPUT "", File$
  LOCATE Row
  IF LEN(File$) = 0 THEN END
  IF UCASE$(File$) = "SKIP" THEN GOTO Skip
 END IF

 OPEN File$ FOR BINARY AS 2
  IF J MOD 2 THEN LOCATE , 40 ELSE LOCATE CSRLIN + 1, 1
  PRINT File$; ","; Samples(J).InsLeng; "bytes long.";

  IF Samples(J).InsLeng > 32767 THEN InsLeng = 32767 ELSE InsLeng = Samples(J).
  Sam$ = SPACE$(InsLeng)
  ByteLoc& = SEEK(1)
  GET 1, , Sam$
  SEEK 1, ByteLoc& + Samples(J).InsLeng
  PUT 2, 1, Samples(J)
  PUT 2, , Sam$
 CLOSE 2
Skip:
NEXT
CLOSE 1
END


FUNCTION Exist% (FileName$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
File$ = FileName$
InRegs.AX = &H4E00             'Function for searching for a file
InRegs.CX = 63                 'Search for all files
FileName$ = FileName$ + CHR$(0)'Dos requires an ASCIIZ string, so add
CHR$(0)
InRegs.DS = SSEG(FileName$)    'Load DS:DX with
InRegs.DX = SADD(FileName$)    'the address of FileName$
CALL InterruptX(&H21, InRegs, OutRegs)   'Call DOS
'If AX contains a value, then file does not exist
SELECT CASE OutRegs.AX
CASE 0
Exist = -1
CASE ELSE
Exist = 0
END SELECT
FileName$ = File$
END FUNCTION