'===========================================================================
' Subject: VOC TO SAMPLE DUMP STANDARD       Date: 03-02-93 (00:00)       
' Author:  Monte Ferguson                    Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: SOUND.ABC
'===========================================================================
' VOC2SDS by Monte Ferguson (C) Copyright 1993 Monte Ferguson
'
' Notes: This code was not written to be elegant or user friendly, or to be
' a tutorial on how to write good code - it was written to WORK the way *I*
' wanted it to.
'
' If you'd like to swipe the code or hack it, please feel free. I ask only
' that you send me a copy of anything you create with it - that would be my
' payment. Mention in your dox would be nice, too :-)
'
' Monte Ferguson
' 1250 Anita Drive #304
' Kent, OH  44240
' Fido: 1:157/200.39
'
' Enjoy.
'
' P.S. - hardcoded stuff that's easy to change is generally marked with
'      <<< LOOK <<
' ie, channel numbers, sample number, etc.

DECLARE FUNCTION GetBlkLen! ()
DECLARE FUNCTION GenPath$ (FSpec$)
DECLARE FUNCTION GenSpec$ (FSpec$, DefExt$)
DECLARE FUNCTION SngToM3$ (n!)
DECLARE FUNCTION M3toDec! (m3$)
DECLARE FUNCTION Hx$ (Text$)

DEFINT A-Z
'
' VOC2SDS - Converts .VOC files to Sample Dump Standard
' Copyright 1993 Monte Ferguson
'
' First version      01-Mar-93
'
CONST Vers = "1.0"
CONST LastUpdate = "02-Mar-93"
CONST Copyright = "VOC2SDS Copyright 1993, Monte Ferguson"
CONST False = 0
CONST True = NOT False

TYPE VOCHeaderType
  Des AS STRING * 20
  BlockOffset AS INTEGER
  Vers AS INTEGER
  VerComp AS INTEGER
END TYPE

TYPE SDSHeaderType
  f07e AS STRING * 2
  Channel AS STRING * 1
  One AS STRING * 1
  SampleNum AS STRING * 2
  Bits AS STRING * 1
  Period AS STRING * 3
  SLength AS STRING * 3
  SustLoopStart AS STRING * 3
  SustLoopEnd AS STRING * 3
  LoopType AS STRING * 1
  F7 AS STRING * 1
END TYPE

TYPE SDSBLockType
  f07e AS STRING * 2
  Channel AS STRING * 1
  Two AS STRING * 1
  PktCnt AS STRING * 1
  DTA AS STRING * 120
  ChkSum AS STRING * 1
  F7 AS STRING * 1
END TYPE



DIM VocHead AS VOCHeaderType
DIM SDSHead AS SDSHeaderType
DIM SDSBLock AS SDSBLockType



FileSpec$ = GenSpec$(LTRIM$(UCASE$(COMMAND$)), "VOC")

PRINT Copyright
PRINT Vers + " " + LastUpdate
PRINT ""

IF LEN(FileSpec$) > 0 THEN
  FPath$ = GenPath$(FileSpec$)
  d$ = DIR$(FileSpec$)
  DO WHILE d$ <> ""
    KY$ = INKEY$
    f$ = FPath$ + d$
    PRINT ""
    a$ = "------" + f$ + "------"
    PRINT SPACE$(40 - LEN(a$) / 2) + a$
    PRINT ""
    ' Examine the file
    OPEN f$ FOR BINARY AS #1
    GET #1, , VocHead
    IF VocHead.Des <> "Creative Voice File" + CHR$(26) THEN
      PRINT "Bogus header, not a .VOC file."
    ELSE
      v$ = HEX$(VocHead.Vers)
      IF LEN(v$) < 4 THEN v$ = STRING$(4 - LEN(v$), "0") + v$
      v$ = LTRIM$(STR$(VAL("&H" + LEFT$(v$, 2)))) + "." + LTRIM$(STR$(VAL("&H" + RIGHT$(v$, 2))))
      PRINT "Version:"; v$
      PRINT "Offset to 1st data block:"; VocHead.BlockOffset
      SEEK #1, VocHead.BlockOffset + 1
      BlockCount = 0

      '         1         2         3         4         5         6         7         8
      '12345678901234567890123456789012345678901234567890123456789012345678901234567890
      'Blk Type                Bytes     Secs  SmplRate Pack      Other
      '##  \                 \ #,###,### ###.# ##,###   \       \ \                  \
      PRINT "Blk Type                Bytes     Secs  SmplRate Pack      Other"
      PRINT STRING$(79, "-")
      Converted = False
        DO
          BlockCount = BlockCount + 1
          BType$ = SPACE$(1)
          GET #1, , BType$
          SELECT CASE ASC(BType$)
            CASE 0
              BType$ = "Terminator"
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; 0; 0; 0; "N/A"
              EXIT DO
            CASE 1
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "Voice Data"
              SR$ = SPACE$(1)
              GET #1, , SR$
              SR! = ASC(SR$)
              SR! = INT(1000000! / (256 - SR!) + .5)
              Secs! = INT((BL! / SR!) * 10) / 10
              Pk$ = SPACE$(1)
              
              GET #1, , Pk$
              SELECT CASE ASC(Pk$)
                CASE 0
                  PT$ = "Raw 8-bit"
                CASE 1
                  PT$ = "4-bit"
                CASE 2
                  PT$ = "2.6 bit"
                CASE 3
                  PT$ = "2 bit"
                CASE ELSE
                  PT$ = "Unknown!"
              END SELECT
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
              IF Pk$ <> CHR$(0) THEN
                PRINT "    ---> PACKED BLOCK, CANNOT CONVERT!"
              ELSE
                IF NOT Converted THEN
                  PRINT "    ---> Converting...";
                  Target$ = FPath$ + d$
                  p = LEN(Target$)
                  DO WHILE p >= 1
                    IF MID$(Target$, p, 1) = "." THEN
                      EXIT DO
                    END IF
                    p = p - 1
                  LOOP
                  IF p = 0 THEN
                    Target$ = Target$ + ".SDS"
                  ELSE
                    Target$ = LEFT$(Target$, p) + "SDS"
                  END IF
                  OPEN Target$ FOR BINARY AS #2
                  SDSHead.f07e = CHR$(&HF0) + CHR$(&H7E)
                  SDSHead.Channel = CHR$(0)         ' <<<<<<<<<<<<<<<< LOOK <<<<<<
                  SDSHead.One = CHR$(1)
                  SDSHead.SampleNum = CHR$(0) + CHR$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<
                  SDSHead.Bits = CHR$(16)           ' <<<<<<<<<<<<<<<< LOOK <<<<<<
                  SDSHead.Period = SngToM3$((1 / SR!) * 1000000000#)
                  SDSHead.SLength = SngToM3$(BL!)
                  SDSHead.SustLoopStart = SngToM3$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<
                  SDSHead.SustLoopEnd = SngToM3$(BL!)' <<<<<<<<<<<<<<<< LOOK <<<<<<
                  SDSHead.LoopType = CHR$(0)         ' <<<<<<<<<<<<<<<< LOOK <<<<<<
                  SDSHead.F7 = CHR$(&HF7)
                  PUT #2, , SDSHead
                  ' Now we create blocks by fetching 40 bytes of .VOC data
                  ' at a shot. Since 16 bits takes 3 7-bit words, that gives
                  ' us the correct 120 bytes/block length for SDS.
                  nb! = BL! / 40
                  IF nb! <> INT(nb!) THEN
                    nb! = INT(nb!) + 1
                  END IF
                  
                  ' Yes, this grunges the last block if it's not a multiple of
                  ' 40 bytes. So sue me. I *told* you this was quick and dirty! :-)
                  FOR i = 1 TO nb!
                    Pkt = (i - 1) MOD 128' Packet Count
                    Smp$ = SPACE$(40)
                    GET #1, , Smp$
                    Chk = &H7E      ' The running checksum
                    Chk = Chk XOR 0 ' Channel Num
                    Chk = Chk XOR 2 ' "Two"
                    Chk = Chk XOR Pkt
                    DTA$ = ""
                    FOR j = 1 TO LEN(Smp$)
                      Byte8 = ASC(MID$(Smp$, j, 1))
                      ' This next line converts the 8-bit sample to 16 bits:
                      Byte16! = Byte8 * 256!
                      ' And this stuff divides our 16 bits into three MIDI data bytes.
                      ' The 1st bytes is 512s, the 2nd byte is 4 and the last bytes is the
                      ' remainder (0-3) but LEFT JUSTIFIED within the 7-bit field. Hey, I
                      ' didn't write the standard, I just live with it! :-)
                      b1 = INT(Byte16! / 512)
                      r1! = Byte16! - (b1 * 512!)
                      b2 = INT(r1! / 4)
                      r2! = r1! - (b2 * 4)
                      b3 = r2! * 32
                      Chk = Chk XOR b1
                      Chk = Chk XOR b2
                      Chk = Chk XOR b3
                      DTA$ = DTA$ + CHR$(b1) + CHR$(b2) + CHR$(b3)
                    NEXT j

                    SDSBLock.f07e = CHR$(&HF0) + CHR$(&H7E)
                    SDSBLock.Channel = CHR$(0)      ' <<<<<<<< LOOK <<<<<<<<<<<<
                    SDSBLock.Two = CHR$(2)
                    SDSBLock.PktCnt = CHR$(Pkt)
                    SDSBLock.DTA = DTA$
                    SDSBLock.ChkSum = CHR$(Chk)
                    SDSBLock.F7 = CHR$(&HF7)
                    PUT #2, , SDSBLock
                    y = CSRLIN
                    x = POS(0)
                    PRINT INT((i / nb!) * 100); "%";
                    LOCATE y, x
                  NEXT i
                  CLOSE #2
                  PRINT "Done."
                  Converted = True
                  REM Stuff
                ELSE
                  PRINT "(this version only converts the 1st block...)"
                END IF
              END IF


              SEEK #1, s! + BL!
            CASE 2
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "Voice Continuation"
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
              SEEK #1, s! + BL!
            CASE 3
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "Silence"
              Pr$ = SPACE$(2)
              GET #1, , Pr$
              Pr = CVI(Pr$)
              SR$ = SPACE$(1)
              GET #1, , SR$
              SR! = ASC(SR$)
              SR! = INT(1000000! / (256 - SR!) + .5)
              Secs! = INT((Pr / SR!) * 10) / 10
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"
              SEEK #1, s! + BL!
            CASE 4
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "Marker"
              Pr$ = SPACE$(2)
              GET #1, , Pr$
              Pr = CVI(Pr$)
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"; "Marker=" + LTRIM$(STR$(Pr))
              SEEK #1, s! + BL!
            CASE 5
              BL! = GetBlkLen
              BType$ = "ASCII Text"
              s! = SEEK(1)
              Txt$ = SPACE$(BL!)
              GET #1, , Txt$
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"; "Text follows:"
              PRINT SPACE$(4); Txt$
              SEEK #1, s! + BL!
            CASE 6
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "Repeat"
              Pr$ = SPACE$(2)
              GET #1, , Pr$
              Pr = CVI(Pr$)
              IF Pr <> &HFFFF THEN
                RP$ = "Repeat" + STR$(Pr) + " times."
              ELSE
                RP$ = "Repeat endlessly."
              END IF
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"; RP$
              SEEK #1, s! + BL!
            CASE 7
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "End Repeat"
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"
              SEEK #1, s! + BL!
            CASE ELSE
              BL! = GetBlkLen
              s! = SEEK(1)
              BType$ = "UNKNOWN:" + LTRIM$(STR$(ASC(BType$)))
              SR$ = SPACE$(1)
              GET #1, , SR$
              SR! = ASC(SR$)
              SR! = INT(1000000! / (256 - SR!) + .5)
              Secs! = INT((BL! / SR!) * 10) / 10
              Pk$ = SPACE$(1)
              GET #1, , Pk$
              SELECT CASE ASC(Pk$)
                CASE 0
                  PT$ = "Raw 8-bit"
                CASE 1
                  PT$ = "4-bit"
                CASE 2
                  PT$ = "2.6 bit"
                CASE 3
                  PT$ = "2 bit"
                CASE ELSE
                  PT$ = "Unknown!"
              END SELECT
              PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
              SEEK #1, s! + BL!
          END SELECT
          IF BType$ = CHR$(0) OR KY$ = CHR$(27) THEN
            EXIT DO
          END IF
        LOOP

    END IF
    CLOSE #1
    PRINT ""
    PRINT ""
    IF KY$ = CHR$(27) THEN
      EXIT DO
    END IF
    d$ = DIR$
  LOOP
ELSE
  PRINT "No files matching " + COMMAND$
  PRINT ""
  PRINT "VOC2SDS - a utility to convert .VOC files to Sample Dump Standard MIDIEx data."
  PRINT "Copyright 1993 Monte Ferguson"
  PRINT "Vers: "; Vers; ", Last Updated:"; LastUpdate
  PRINT "Usage: VOC2SDS filespec"
  PRINT ""
  PRINT "filespec may contain wildcard characters, .VOC extension is assumed."
  PRINT "Data is written to filename.SDS. Only 8-bit RAW blocks can be converted!"
  PRINT "(and this version does only the 1st voice block)"
END IF

FUNCTION GenPath$ (FSpec$)
  ' Parses the path out of passed file spec (FSpec$)
  p = LEN(FSpec$)
  DO WHILE p > 0
    IF INSTR("\:", MID$(FSpec$, p, 1)) > 0 THEN
      EXIT DO
    END IF
    p = p - 1
  LOOP
  IF p > 0 THEN
    GenPath$ = LEFT$(FSpec$, p)
  ELSE
    GenPath$ = ""
  END IF

END FUNCTION

FUNCTION GenSpec$ (FSpec$, DefExt$)
REM --------------------------------------------------------------------
REM  Given a filespec (FSpec$) and a default extension (DefExt$) try to
REM find some matching files
REM
REM
t$ = FSpec$           ' Temp work variable

REM Let's try as-is...
IF LEN(DIR$(t$)) = 0 THEN
  ' Ok, let's add the default extention...
  IF RIGHT$(t$, 1) <> ":" THEN
    ' Keeps us from blowing up on "A:.TXT", etc
    t$ = t$ + "." + DefExt$
  END IF
  IF LEN(DIR$(t$)) = 0 THEN
    ' Alright, let's do *.ext
    t$ = FSpec$ + "*." + DefExt$
    IF LEN(DIR$(t$)) = 0 THEN
      ' Last try... add a directory slash AND *.ext
      t$ = FSpec$ + "\*." + DefExt$
      IF LEN(DIR$(t$)) = 0 THEN
        ' I give up!
        t$ = ""
      END IF
    END IF
  END IF
END IF

GenSpec$ = t$

END FUNCTION

FUNCTION GetBlkLen!
  a$ = SPACE$(3)
  GET #1, , a$
  l = ASC(a$)
  M = ASC(MID$(a$, 2))
  h = ASC(RIGHT$(a$, 1))
  GetBlkLen! = h * 256! * 256! + M * 256! + l
END FUNCTION

FUNCTION Hx$ (Text$)
  h$ = ""
  FOR i = 1 TO LEN(Text$)
    a = ASC(MID$(Text$, i, 1))
    d$ = HEX$(a)
    IF LEN(d$) < 2 THEN d$ = "0" + d$
    IF LEN(h$) > 0 THEN
      h$ = h$ + SPACE$(1)
    END IF
    h$ = h$ + d$
  NEXT i
  Hx$ = h$
END FUNCTION

FUNCTION M3toDec! (m3$)
  IF LEN(m3$) <> 3 THEN STOP
  m1 = ASC(MID$(m3$, 1))
  m2! = ASC(MID$(m3$, 2)) * 128
  m3! = ASC(MID$(m3$, 3)) * 16384!
  M3toDec! = m1 + m2! + m3!
END FUNCTION

FUNCTION SngToM3$ (n!)
  i1 = INT(n! / 16384!)
  r! = n! - (i1 * 16384!)
  i2 = INT(r! / 128)
  i3 = r! - (i2 * 128)
  SngToM3$ = CHR$(i3) + CHR$(i2) + CHR$(i1)
END FUNCTION