home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / v / voc2sds.zip / VOC2SDS.BAS < prev    next >
BASIC Source File  |  1993-03-02  |  15KB  |  447 lines
  1.  
  2. '
  3. ' VOC2SDS by Monte Ferguson (C) Copyright 1993 Monte Ferguson
  4. '
  5. ' Notes: This code was not written to be elegant or user friendly, or to be
  6. ' a tutorial on how to write good code - it was written to WORK the way *I*
  7. ' wanted it to.
  8. '
  9. ' If you'd like to swipe the code or hack it, please feel free. I ask only
  10. ' that you send me a copy of anything you create with it - that would be my
  11. ' payment. Mention in your dox would be nice, too :-)
  12. '
  13. ' Monte Ferguson
  14. ' 1250 Anita Drive #304
  15. ' Kent, OH  44240
  16. ' Fido: 1:157/200.39
  17. '
  18. ' Enjoy.
  19. '
  20. ' P.S. - hardcoded stuff that's easy to change is generally marked with
  21. '      <<< LOOK <<
  22. ' ie, channel numbers, sample number, etc.
  23.  
  24. DECLARE FUNCTION GetBlkLen! ()
  25. DECLARE FUNCTION GenPath$ (FSpec$)
  26. DECLARE FUNCTION GenSpec$ (FSpec$, DefExt$)
  27. DECLARE FUNCTION SngToM3$ (n!)
  28. DECLARE FUNCTION M3toDec! (m3$)
  29. DECLARE FUNCTION Hx$ (Text$)
  30.  
  31. DEFINT A-Z
  32. '
  33. ' VOC2SDS - Converts .VOC files to Sample Dump Standard
  34. ' Copyright 1993 Monte Ferguson
  35. '
  36. ' First version      01-Mar-93
  37. '
  38. CONST Vers = "1.0"
  39. CONST LastUpdate = "02-Mar-93"
  40. CONST Copyright = "VOC2SDS Copyright 1993, Monte Ferguson"
  41. CONST False = 0
  42. CONST True = NOT False
  43.  
  44. TYPE VOCHeaderType
  45.   Des AS STRING * 20
  46.   BlockOffset AS INTEGER
  47.   Vers AS INTEGER
  48.   VerComp AS INTEGER
  49. END TYPE
  50.  
  51. TYPE SDSHeaderType
  52.   f07e AS STRING * 2
  53.   Channel AS STRING * 1
  54.   One AS STRING * 1
  55.   SampleNum AS STRING * 2
  56.   Bits AS STRING * 1
  57.   Period AS STRING * 3
  58.   SLength AS STRING * 3
  59.   SustLoopStart AS STRING * 3
  60.   SustLoopEnd AS STRING * 3
  61.   LoopType AS STRING * 1
  62.   F7 AS STRING * 1
  63. END TYPE
  64.  
  65. TYPE SDSBLockType
  66.   f07e AS STRING * 2
  67.   Channel AS STRING * 1
  68.   Two AS STRING * 1
  69.   PktCnt AS STRING * 1
  70.   DTA AS STRING * 120
  71.   ChkSum AS STRING * 1
  72.   F7 AS STRING * 1
  73. END TYPE
  74.  
  75.  
  76.  
  77. DIM VocHead AS VOCHeaderType
  78. DIM SDSHead AS SDSHeaderType
  79. DIM SDSBLock AS SDSBLockType
  80.  
  81.  
  82.  
  83. FileSpec$ = GenSpec$(LTRIM$(UCASE$(COMMAND$)), "VOC")
  84.  
  85. PRINT Copyright
  86. PRINT Vers + " " + LastUpdate
  87. PRINT ""
  88.  
  89. IF LEN(FileSpec$) > 0 THEN
  90.   FPath$ = GenPath$(FileSpec$)
  91.   d$ = DIR$(FileSpec$)
  92.   DO WHILE d$ <> ""
  93.     KY$ = INKEY$
  94.     f$ = FPath$ + d$
  95.     PRINT ""
  96.     a$ = "------" + f$ + "------"
  97.     PRINT SPACE$(40 - LEN(a$) / 2) + a$
  98.     PRINT ""
  99.     ' Examine the file
  100.     OPEN f$ FOR BINARY AS #1
  101.     GET #1, , VocHead
  102.     IF VocHead.Des <> "Creative Voice File" + CHR$(26) THEN
  103.       PRINT "Bogus header, not a .VOC file."
  104.     ELSE
  105.       v$ = HEX$(VocHead.Vers)
  106.       IF LEN(v$) < 4 THEN v$ = STRING$(4 - LEN(v$), "0") + v$
  107.       v$ = LTRIM$(STR$(VAL("&H" + LEFT$(v$, 2)))) + "." + LTRIM$(STR$(VAL("&H" + RIGHT$(v$, 2))))
  108.       PRINT "Version:"; v$
  109.       PRINT "Offset to 1st data block:"; VocHead.BlockOffset
  110.       SEEK #1, VocHead.BlockOffset + 1
  111.       BlockCount = 0
  112.  
  113.       '         1         2         3         4         5         6         7         8
  114.       '12345678901234567890123456789012345678901234567890123456789012345678901234567890
  115.       'Blk Type                Bytes     Secs  SmplRate Pack      Other
  116.       '##  \                 \ #,###,### ###.# ##,###   \       \ \                  \
  117.       PRINT "Blk Type                Bytes     Secs  SmplRate Pack      Other"
  118.       PRINT STRING$(79, "-")
  119.       Converted = False
  120.         DO
  121.           BlockCount = BlockCount + 1
  122.           BType$ = SPACE$(1)
  123.           GET #1, , BType$
  124.           SELECT CASE ASC(BType$)
  125.             CASE 0
  126.               BType$ = "Terminator"
  127.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; 0; 0; 0; "N/A"
  128.               EXIT DO
  129.             CASE 1
  130.               BL! = GetBlkLen
  131.               s! = SEEK(1)
  132.               BType$ = "Voice Data"
  133.               SR$ = SPACE$(1)
  134.               GET #1, , SR$
  135.               SR! = ASC(SR$)
  136.               SR! = INT(1000000! / (256 - SR!) + .5)
  137.               Secs! = INT((BL! / SR!) * 10) / 10
  138.               Pk$ = SPACE$(1)
  139.               
  140.               GET #1, , Pk$
  141.               SELECT CASE ASC(Pk$)
  142.                 CASE 0
  143.                   PT$ = "Raw 8-bit"
  144.                 CASE 1
  145.                   PT$ = "4-bit"
  146.                 CASE 2
  147.                   PT$ = "2.6 bit"
  148.                 CASE 3
  149.                   PT$ = "2 bit"
  150.                 CASE ELSE
  151.                   PT$ = "Unknown!"
  152.               END SELECT
  153.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
  154.               IF Pk$ <> CHR$(0) THEN
  155.                 PRINT "    ---> PACKED BLOCK, CANNOT CONVERT!"
  156.               ELSE
  157.                 IF NOT Converted THEN
  158.                   PRINT "    ---> Converting...";
  159.                   Target$ = FPath$ + d$
  160.                   p = LEN(Target$)
  161.                   DO WHILE p >= 1
  162.                     IF MID$(Target$, p, 1) = "." THEN
  163.                       EXIT DO
  164.                     END IF
  165.                     p = p - 1
  166.                   LOOP
  167.                   IF p = 0 THEN
  168.                     Target$ = Target$ + ".SDS"
  169.                   ELSE
  170.                     Target$ = LEFT$(Target$, p) + "SDS"
  171.                   END IF
  172.                   OPEN Target$ FOR BINARY AS #2
  173.                   SDSHead.f07e = CHR$(&HF0) + CHR$(&H7E)
  174.                   SDSHead.Channel = CHR$(0)         ' <<<<<<<<<<<<<<<< LOOK <<<<<<
  175.                   SDSHead.One = CHR$(1)
  176.                   SDSHead.SampleNum = CHR$(0) + CHR$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<
  177.                   SDSHead.Bits = CHR$(16)           ' <<<<<<<<<<<<<<<< LOOK <<<<<<
  178.                   SDSHead.Period = SngToM3$((1 / SR!) * 1000000000#)
  179.                   SDSHead.SLength = SngToM3$(BL!)
  180.                   SDSHead.SustLoopStart = SngToM3$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<
  181.                   SDSHead.SustLoopEnd = SngToM3$(BL!)' <<<<<<<<<<<<<<<< LOOK <<<<<<
  182.                   SDSHead.LoopType = CHR$(0)         ' <<<<<<<<<<<<<<<< LOOK <<<<<<
  183.                   SDSHead.F7 = CHR$(&HF7)
  184.                   PUT #2, , SDSHead
  185.                   ' Now we create blocks by fetching 40 bytes of .VOC data
  186.                   ' at a shot. Since 16 bits takes 3 7-bit words, that gives
  187.                   ' us the correct 120 bytes/block length for SDS.
  188.                   nb! = BL! / 40
  189.                   IF nb! <> INT(nb!) THEN
  190.                     nb! = INT(nb!) + 1
  191.                   END IF
  192.                   
  193.                   ' Yes, this grunges the last block if it's not a multiple of
  194.                   ' 40 bytes. So sue me. I *told* you this was quick and dirty! :-)
  195.                   FOR i = 1 TO nb!
  196.                     Pkt = (i - 1) MOD 128' Packet Count
  197.                     Smp$ = SPACE$(40)
  198.                     GET #1, , Smp$
  199.                     Chk = &H7E      ' The running checksum
  200.                     Chk = Chk XOR 0 ' Channel Num
  201.                     Chk = Chk XOR 2 ' "Two"
  202.                     Chk = Chk XOR Pkt
  203.                     DTA$ = ""
  204.                     FOR j = 1 TO LEN(Smp$)
  205.                       Byte8 = ASC(MID$(Smp$, j, 1))
  206.                       ' This next line converts the 8-bit sample to 16 bits:
  207.                       Byte16! = Byte8 * 256!
  208.                       ' And this stuff divides our 16 bits into three MIDI data bytes.
  209.                       ' The 1st bytes is 512s, the 2nd byte is 4 and the last bytes is the
  210.                       ' remainder (0-3) but LEFT JUSTIFIED within the 7-bit field. Hey, I
  211.                       ' didn't write the standard, I just live with it! :-)
  212.                       b1 = INT(Byte16! / 512)
  213.                       r1! = Byte16! - (b1 * 512!)
  214.                       b2 = INT(r1! / 4)
  215.                       r2! = r1! - (b2 * 4)
  216.                       b3 = r2! * 32
  217.                       Chk = Chk XOR b1
  218.                       Chk = Chk XOR b2
  219.                       Chk = Chk XOR b3
  220.                       DTA$ = DTA$ + CHR$(b1) + CHR$(b2) + CHR$(b3)
  221.                     NEXT j
  222.  
  223.                     SDSBLock.f07e = CHR$(&HF0) + CHR$(&H7E)
  224.                     SDSBLock.Channel = CHR$(0)      ' <<<<<<<< LOOK <<<<<<<<<<<<
  225.                     SDSBLock.Two = CHR$(2)
  226.                     SDSBLock.PktCnt = CHR$(Pkt)
  227.                     SDSBLock.DTA = DTA$
  228.                     SDSBLock.ChkSum = CHR$(Chk)
  229.                     SDSBLock.F7 = CHR$(&HF7)
  230.                     PUT #2, , SDSBLock
  231.                     y = CSRLIN
  232.                     x = POS(0)
  233.                     PRINT INT((i / nb!) * 100); "%";
  234.                     LOCATE y, x
  235.                   NEXT i
  236.                   CLOSE #2
  237.                   PRINT "Done."
  238.                   Converted = True
  239.                   REM Stuff
  240.                 ELSE
  241.                   PRINT "(this version only converts the 1st block...)"
  242.                 END IF
  243.               END IF
  244.  
  245.  
  246.               SEEK #1, s! + BL!
  247.             CASE 2
  248.               BL! = GetBlkLen
  249.               s! = SEEK(1)
  250.               BType$ = "Voice Continuation"
  251.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
  252.               SEEK #1, s! + BL!
  253.             CASE 3
  254.               BL! = GetBlkLen
  255.               s! = SEEK(1)
  256.               BType$ = "Silence"
  257.               Pr$ = SPACE$(2)
  258.               GET #1, , Pr$
  259.               Pr = CVI(Pr$)
  260.               SR$ = SPACE$(1)
  261.               GET #1, , SR$
  262.               SR! = ASC(SR$)
  263.               SR! = INT(1000000! / (256 - SR!) + .5)
  264.               Secs! = INT((Pr / SR!) * 10) / 10
  265.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"
  266.               SEEK #1, s! + BL!
  267.             CASE 4
  268.               BL! = GetBlkLen
  269.               s! = SEEK(1)
  270.               BType$ = "Marker"
  271.               Pr$ = SPACE$(2)
  272.               GET #1, , Pr$
  273.               Pr = CVI(Pr$)
  274.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"; "Marker=" + LTRIM$(STR$(Pr))
  275.               SEEK #1, s! + BL!
  276.             CASE 5
  277.               BL! = GetBlkLen
  278.               BType$ = "ASCII Text"
  279.               s! = SEEK(1)
  280.               Txt$ = SPACE$(BL!)
  281.               GET #1, , Txt$
  282.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"; "Text follows:"
  283.               PRINT SPACE$(4); Txt$
  284.               SEEK #1, s! + BL!
  285.             CASE 6
  286.               BL! = GetBlkLen
  287.               s! = SEEK(1)
  288.               BType$ = "Repeat"
  289.               Pr$ = SPACE$(2)
  290.               GET #1, , Pr$
  291.               Pr = CVI(Pr$)
  292.               IF Pr <> &HFFFF THEN
  293.                 RP$ = "Repeat" + STR$(Pr) + " times."
  294.               ELSE
  295.                 RP$ = "Repeat endlessly."
  296.               END IF
  297.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"; RP$
  298.               SEEK #1, s! + BL!
  299.             CASE 7
  300.               BL! = GetBlkLen
  301.               s! = SEEK(1)
  302.               BType$ = "End Repeat"
  303.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; 0; 0; "N/A"
  304.               SEEK #1, s! + BL!
  305.             CASE ELSE
  306.               BL! = GetBlkLen
  307.               s! = SEEK(1)
  308.               BType$ = "UNKNOWN:" + LTRIM$(STR$(ASC(BType$)))
  309.               SR$ = SPACE$(1)
  310.               GET #1, , SR$
  311.               SR! = ASC(SR$)
  312.               SR! = INT(1000000! / (256 - SR!) + .5)
  313.               Secs! = INT((BL! / SR!) * 10) / 10
  314.               Pk$ = SPACE$(1)
  315.               GET #1, , Pk$
  316.               SELECT CASE ASC(Pk$)
  317.                 CASE 0
  318.                   PT$ = "Raw 8-bit"
  319.                 CASE 1
  320.                   PT$ = "4-bit"
  321.                 CASE 2
  322.                   PT$ = "2.6 bit"
  323.                 CASE 3
  324.                   PT$ = "2 bit"
  325.                 CASE ELSE
  326.                   PT$ = "Unknown!"
  327.               END SELECT
  328.               PRINT USING "##  \                 \ #,###,### ###.# ##,###   \       \ \                  \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
  329.               SEEK #1, s! + BL!
  330.           END SELECT
  331.           IF BType$ = CHR$(0) OR KY$ = CHR$(27) THEN
  332.             EXIT DO
  333.           END IF
  334.         LOOP
  335.  
  336.     END IF
  337.     CLOSE #1
  338.     PRINT ""
  339.     PRINT ""
  340.     IF KY$ = CHR$(27) THEN
  341.       EXIT DO
  342.     END IF
  343.     d$ = DIR$
  344.   LOOP
  345. ELSE
  346.   PRINT "No files matching " + COMMAND$
  347.   PRINT ""
  348.   PRINT "VOC2SDS - a utility to convert .VOC files to Sample Dump Standard MIDIEx data."
  349.   PRINT "Copyright 1993 Monte Ferguson"
  350.   PRINT "Vers: "; Vers; ", Last Updated:"; LastUpdate
  351.   PRINT "Usage: VOC2SDS filespec"
  352.   PRINT ""
  353.   PRINT "filespec may contain wildcard characters, .VOC extension is assumed."
  354.   PRINT "Data is written to filename.SDS. Only 8-bit RAW blocks can be converted!"
  355.   PRINT "(and this version does only the 1st voice block)"
  356. END IF
  357.  
  358. FUNCTION GenPath$ (FSpec$)
  359.   ' Parses the path out of passed file spec (FSpec$)
  360.   p = LEN(FSpec$)
  361.   DO WHILE p > 0
  362.     IF INSTR("\:", MID$(FSpec$, p, 1)) > 0 THEN
  363.       EXIT DO
  364.     END IF
  365.     p = p - 1
  366.   LOOP
  367.   IF p > 0 THEN
  368.     GenPath$ = LEFT$(FSpec$, p)
  369.   ELSE
  370.     GenPath$ = ""
  371.   END IF
  372.  
  373. END FUNCTION
  374.  
  375. FUNCTION GenSpec$ (FSpec$, DefExt$)
  376. REM --------------------------------------------------------------------
  377. REM  Given a filespec (FSpec$) and a default extension (DefExt$) try to
  378. REM find some matching files
  379. REM
  380. REM
  381. t$ = FSpec$           ' Temp work variable
  382.  
  383. REM Let's try as-is...
  384. IF LEN(DIR$(t$)) = 0 THEN
  385.   ' Ok, let's add the default extention...
  386.   IF RIGHT$(t$, 1) <> ":" THEN
  387.     ' Keeps us from blowing up on "A:.TXT", etc
  388.     t$ = t$ + "." + DefExt$
  389.   END IF
  390.   IF LEN(DIR$(t$)) = 0 THEN
  391.     ' Alright, let's do *.ext
  392.     t$ = FSpec$ + "*." + DefExt$
  393.     IF LEN(DIR$(t$)) = 0 THEN
  394.       ' Last try... add a directory slash AND *.ext
  395.       t$ = FSpec$ + "\*." + DefExt$
  396.       IF LEN(DIR$(t$)) = 0 THEN
  397.         ' I give up!
  398.         t$ = ""
  399.       END IF
  400.     END IF
  401.   END IF
  402. END IF
  403.  
  404. GenSpec$ = t$
  405.  
  406. END FUNCTION
  407.  
  408. FUNCTION GetBlkLen!
  409.   a$ = SPACE$(3)
  410.   GET #1, , a$
  411.   l = ASC(a$)
  412.   M = ASC(MID$(a$, 2))
  413.   h = ASC(RIGHT$(a$, 1))
  414.   GetBlkLen! = h * 256! * 256! + M * 256! + l
  415. END FUNCTION
  416.  
  417. FUNCTION Hx$ (Text$)
  418.   h$ = ""
  419.   FOR i = 1 TO LEN(Text$)
  420.     a = ASC(MID$(Text$, i, 1))
  421.     d$ = HEX$(a)
  422.     IF LEN(d$) < 2 THEN d$ = "0" + d$
  423.     IF LEN(h$) > 0 THEN
  424.       h$ = h$ + SPACE$(1)
  425.     END IF
  426.     h$ = h$ + d$
  427.   NEXT i
  428.   Hx$ = h$
  429. END FUNCTION
  430.  
  431. FUNCTION M3toDec! (m3$)
  432.   IF LEN(m3$) <> 3 THEN STOP
  433.   m1 = ASC(MID$(m3$, 1))
  434.   m2! = ASC(MID$(m3$, 2)) * 128
  435.   m3! = ASC(MID$(m3$, 3)) * 16384!
  436.   M3toDec! = m1 + m2! + m3!
  437. END FUNCTION
  438.  
  439. FUNCTION SngToM3$ (n!)
  440.   i1 = INT(n! / 16384!)
  441.   r! = n! - (i1 * 16384!)
  442.   i2 = INT(r! / 128)
  443.   i3 = r! - (i2 * 128)
  444.   SngToM3$ = CHR$(i3) + CHR$(i2) + CHR$(i1)
  445. END FUNCTION
  446.  
  447.