Advertisement
Guest User

Untitled

a guest
Sep 27th, 2017
118
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
QBasic 8.15 KB | None | 0 0
  1. #COMPILE EXE
  2. #DIM NONE
  3.  
  4. FUNCTION PBMAIN () AS LONG
  5.     PRINT "XM2ESF - Convert XM to Echo Stream Format"
  6.     PRINT ""
  7.     PRINT "
  8.    IF COMMAND$ = "" THEN
  9.        PRINT "usage: xm2esf <infile> <outfile>"
  10.    END IF
  11.  
  12.    OPEN COMMAND$(1) FOR INPUT AS #1
  13.  
  14.    DIM xmfm&(1 TO 6)
  15.    DIM xmpsg&(1 TO 3)
  16.    DIM fm&
  17.    DIM psg&
  18.  
  19.    tempo& = 7      ' Default tempo :P
  20.  
  21.    WHILE setting$ <> "[Instruments]"
  22.        LINE INPUT #1, setting$
  23.        IF MID$(setting$, 1, 1) <> "#" THEN
  24.           SELECT CASE spleft(setting$)
  25.  
  26.              CASE "FILE"
  27.                xm$ = param(setting$, 1)
  28.                PRINT "XM File: " + xm$
  29.              CASE "TYPE"
  30.                SELECT CASE param(setting$, 1)
  31.                CASE "BGM"
  32.                filetype& = 1
  33.                CASE "SFX"
  34.                filetype& = 2
  35.                END SELECT
  36.                SELECT CASE param(setting$, 2)
  37.                CASE "LOOP"
  38.  
  39.                esfloop& = 1
  40.                IF filetype& = 2 THEN
  41.                    PRINT "INPUT file errorneously declares LOOP WHILE being a SFX. File rejected."
  42.                    PRINT "Press ANY KEY!"
  43.                    WAITKEY$
  44.                    CLOSE
  45.                    EXIT FUNCTION
  46.                END IF
  47.                CASE "NOLOOP"
  48.                esfloop& = 0
  49.  
  50.  
  51.                END SELECT
  52.              
  53.              CASE "TEMPO"
  54.                  tempo& = VAL(param(setting$, 1))
  55.              CASE "FM"
  56.                  fm& = VAL(param(setting$, 1))
  57.                  IF fm > 6 THEN
  58.                      PRINT "Declared more than 6 FM channels. Press ANY KEY!"
  59.  
  60.                  WAITKEY$:CLOSE:EXIT FUNCTION
  61.                  END IF
  62.              CASE "PSG"
  63.                  psg& = VAL(param(setting$, 1))
  64.                  IF psg& > 3 THEN
  65.                      PRINT "Declared more than 3 PSG channels. Press ANY KEY!"
  66.                      PRINT "Press ANY KEY!"
  67.                      WAITKEY$
  68.                      CLOSE
  69.                      EXIT FUNCTION
  70.                  END IF
  71.              CASE "PCM"
  72.                  pcm& = 1
  73.                  IF fm& = 6 THEN
  74.                      PRINT "INPUT file errorneously declares PCM even though 6 FM channels are used"
  75.                      PRINT "Press ANY KEY!"
  76.                      WAITKEY$
  77.                      CLOSE
  78.                      EXIT FUNCTION
  79.  
  80.                  END IF
  81.              CASE "NOISE"
  82.                  noise& = VAL(param(setting$, 1))
  83.              CASE "FM1"
  84.                  xmfm&(1) = VAL(param(setting$, 1))
  85.              CASE "FM2"
  86.                  xmfm&(2) = VAL(param(setting$, 1))
  87.              CASE "FM3"
  88.                  xmfm&(3) = VAL(param(setting$, 1))
  89.              CASE "FM4"
  90.                  xmfm&(4) = VAL(param(setting$, 1))
  91.              CASE "FM5"
  92.                  xmfm&(5) = VAL(param(setting$, 1))
  93.              CASE "FM6"
  94.                  xmfm&(6) = VAL(param(setting$, 1))
  95.              CASE "PCMC"
  96.                  xmpcm& = VAL(param(setting$,1))
  97.              CASE "PSG1"
  98.                  xmpsg&(1) = VAL(param(setting$, 1))
  99.              CASE "PSG2"
  100.                  xmpsg&(2) = VAL(param(setting$, 1))
  101.              CASE "PSG3"
  102.                  xmpsg&(3) = VAL(param(setting$, 1))
  103.              CASE "PSGN"
  104.                  xmnoise& = VAL(param(setting$, 1))
  105.  
  106.           END SELECT
  107.        END IF
  108.  
  109.    WEND
  110.  
  111.    s$ = "loadxm " + xm$
  112.    PRINT "SHELL STEP: " + s$
  113.  
  114.    SHELL s$
  115.  
  116.    'INSTRUMENT ASSIGNMENTS
  117.    DIM xmins&(1 TO 256)
  118.    
  119.    WHILE setting$ <> "[Pitch]"
  120.        
  121.        IF MID$(setting$,1,1) <> "#" THEN
  122.        
  123.        LINE INPUT #1, setting$
  124.        xmins&(VAL(spleft(setting$))) = VAL("&H" + param(setting$,1))
  125.    
  126.        END IF
  127.        
  128.    WEND
  129.    
  130.    'PITCH
  131.    
  132.    ' 123456 = FM
  133.    ' 789    = PSG
  134.    
  135.    ' 10     = PCM
  136.    ' 11     = NSE
  137.    
  138.    
  139.    
  140.    DIM pitch&(1 TO 11)
  141.    
  142.    WHILE setting$ <> "[END]"
  143.        IF MID$(setting$,1,1) <> "#" THEN
  144.            
  145.            SELECT CASE spleft(setting$)
  146.                CASE "FM1"
  147.                    pitch&(1) = VAL(param(setting$,1))
  148.                CASE "FM2"
  149.                    pitch&(2) = VAL(param(setting$,1))
  150.                CASE "FM3"
  151.                    pitch&(3) = VAL(param(setting$,1))
  152.                CASE "FM4"
  153.                    pitch&(4) = VAL(param(setting$,1))
  154.                CASE "FM5"
  155.                    pitch&(5) = VAL(param(setting$,1))
  156.                CASE "FM6"
  157.                    pitch&(6) = VAL(param(setting$,1))
  158.                    
  159.                CASE "PSG1"
  160.                    pitch&(7) = VAL(param(setting$,1))
  161.                CASE "PSG2"
  162.                    pitch&(8) = VAL(param(setting$,1))
  163.                CASE "PSG3"
  164.                    pitch&(9) = VAL(param(setting$,1))
  165.        END IF
  166.        
  167.    
  168.    WEND
  169.    
  170.  
  171.    '
  172.    CLOSE
  173.    
  174.    OPEN COMMAND$(2) FOR BINARY AS #9999
  175.    
  176.    
  177.    DIM i AS INTEGER
  178.    DIM present&(1 TO 11)
  179.    FOR i = 1 TO fm&
  180.      
  181.    present&(i) = 1
  182.    OPEN "temp\C" + TRIM$(VAL(xmfm&(i)) + ".tmp" FOR BINARY AS #i
  183.    
  184.    NEXT i
  185.    
  186.    FOR i = 7 TO psg& + 6
  187.    present&(i) = 1
  188.    
  189.    OPEN "temp\C" + TRIM$(VAL(xmpsg&(i-6)) + ".tmp" FOR BINARY AS #i
  190.    
  191.    WEND
  192.                                                                                  
  193.    IF pcm& = 1 THEN
  194.        
  195.    present&(10) = 1
  196.    OPEN "temp\C" + TRIM$(VAL(xmpcm&)) + ".tmp" FOR BINARY AS #10
  197.    
  198.    END IF
  199.    
  200.    IF noise& = 1 THEN
  201.        
  202.    present&(11) = 1
  203.    OPEN "temp\C" + TRIM$(VAL(xmnoise&)) + ".tmp" FOR BINARY AS #11
  204.    
  205.    END IF
  206.    '       $00nn ..... Note on FM channel #1
  207.    '       $01nn ..... Note on FM channel #2
  208.    '       $02nn ..... Note on FM channel #3
  209.    '       $04nn ..... Note on FM channel #4
  210.    '       $05nn ..... Note on FM channel #5
  211.    '       $06nn ..... Note on FM channel #6
  212.    '       $08nn ..... Note on PSG channel #1
  213.    '       $09nn ..... Note on PSG channel #2
  214.    '       $0Ann ..... Note on PSG channel #3
  215.    '       $0Bnn ..... Note on PSG channel #4
  216.    '       $0Cnn ..... Note on PCM channel
  217.    '
  218.    '
  219.    
  220.    DIM esfchan&(1 TO 11)
  221.                  
  222.    esfchan&(1)  = 0
  223.    esfchan&(2)  = 1
  224.    esfchan&(3)  = 2
  225.    esfchan&(4)  = 4
  226.    esfchan&(5)  = 5
  227.    esfchan&(6)  = 6
  228.    esfchan&(7)  = 8
  229.    esfchan&(8)  = 9
  230.    esfchan&(9)  = 10
  231.    esfchan&(10) = 11
  232.    esfchan&(11) = 12
  233.    
  234.          
  235.    OPEN "temp\file.inf" FOR INPUT AS #1234
  236.    LINE INPUT #1, a$
  237.    LINE INPUT #1, a$
  238.    restart& = VAL(a$)
  239.    LINE INPUT #1, a$
  240.    total& = VAL(a$)
  241.    CLOSE #1234
  242.  
  243.                          
  244.    DIM effectdat&(1 TO 11)
  245.    DIM effectval&(1 TO 11)
  246.    DIM row$(1 TO 11)
  247.    FOR i = 1 TO 11
  248.        row$(i) = "     "
  249.    NEXT i
  250.    
  251.  
  252.    DIM currow AS LONG
  253.    
  254.    FOR currow = 1 TO total&
  255.        
  256.    
  257.    NEXT currow
  258.    
  259.    PRINT "Conversion done!"
  260.    
  261.    CLOSE
  262.    
  263. END FUNCTION
  264.  
  265. FUNCTION param(strn$, b&) AS STRING
  266.    c& = 0
  267.    i& = 1
  268.    car$ = MID$(strn$, 1, 1)
  269.    IF car$ = CHR$(34) THEN
  270.        comp$ = CHR$(34)
  271.        i& = 2
  272.        car$ = MID$(strn$, 2, 1)
  273.    ELSE
  274.        comp$ = " "
  275.    END IF
  276.    WHILE c& <> b&
  277.    WHILE car$ <> comp$
  278.          SPEFT$ = SPEFT$ + car$
  279.          i& = i& + 1
  280.          car$ = MID$(strn$, i&, 1)
  281.          IF i& > LEN(strn$) THEN
  282.              SPEFT$ = ""
  283.              param = SPEFT$
  284.              EXIT FUNCTION
  285.          END IF
  286.    WEND
  287.  
  288.   i& = i& + 1
  289.   c& = c& + 1
  290.   ' SPEFT$ = MID$(strn$, i&, 1)
  291.    car$ = SPEFT$
  292.    WEND
  293.  
  294.  
  295.    param = RTRIM$(spleft(MID$(strn$,i&)))
  296.  
  297. END FUNCTION
  298.  
  299. FUNCTION SPLEFT(strn$) AS STRING
  300.  
  301.    i& = 1
  302.    car$ = MID$(strn$, 1, 1)
  303.    IF car$ = CHR$(34) THEN
  304.        comp$ = CHR$(34)
  305.        i& = 2
  306.        car$ = MID$(strn$, 2, 1)
  307.    ELSE
  308.        comp$ = " "
  309.    END IF
  310.    WHILE car$ <> comp$
  311.          SPEFT$ = SPEFT$ + car$
  312.          i& = i& + 1
  313.          car$ = MID$(strn$, i&, 1)
  314.          IF i& > LEN(strn$) THEN
  315.              SPLEFT = SPEFT$ + cars$
  316.              EXIT FUNCTION
  317.          END IF
  318.    WEND
  319.              SPLEFT = SPEFT$
  320. END FUNCTION
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement