Mod Player/2

 BBS: Inland Empire Archive
Date: 11-30-92 (21:15)             Number: 374
From: RICH GELDREICH               Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Mod Player/2                   Conf: (2) Quik_Bas

'<<Part 2 Starts Here>>
DIM C.VolumeSpeed(3)

'Misc. Arrays
DIM PeriodHigh(1023),   PeriodLow(1023) 'Precalculated step rates
DIM VolumeTable(63, 255) 'Precalculated volume tables
DIM SampleBuffer(1199)   'Sample buffer;for mixing+playing at same time.
DIM PatternSegment(127)  'Holds segment's of all the patterns to play
DIM ActiveChannels(3)    'Holds active channels while mixing
DIM ChannelOn(3)

DIM Scale8to6(255)       'translation table for dividing each signed
                         'sample by 4
'=====================================================================
ON ERROR GOTO ErrorHandler

PRINT "QBMP v1.5 - An Amiga MOD player written in PDS/QuickBASIC."
PRINT "(C) Copyright 1992 By Rich Geldreich"
'Precalculate an 8-bit to 6-bit signed translation table
FOR A=-128 to 127
    C=A\4
    IF A<0 then Scale8to6(A+256)=C ELSE Scale8to6(A)=C
NEXT

'Free up 300,000 bytes of far memory.
Null& = SETMEM(-300000)

FileSpec$ = Command$
IF INSTR(FileSpec$,".")=0 THEN FileSpec$=FileSpec$+".MOD"
'Attempt to open the MOD file.
OPEN FileSpec$ FOR INPUT AS #1:CLOSE #1
OPEN FileSpec$ FOR BINARY AS #1

'Check to see if MOD contains 15 or 31 samples...
A$ = "    ": GET #1, 1081, A$
'If the string at offset 1081 is "M.K.", or the first 3 letters are
'"FLT", then the MOD contains 31 samples:
S.Max = 15 - 16 * ((A$ = "M.K.") OR (LEFT$(A$, 3) = "FLT"))

'Print the MOD's title
A$ = SPACE$(20): GET #1, 1, A$
PRINT "Title: ";A$
'=====================================================================
A$ = SPACE$(8)
FOR A = 0 TO S.Max - 1
    'Skip the sample's name
    GET #1, , S.Name(A)
    'Get the info on the sample
    GET #1, , A$
    S.Volume(A)         = ASC(MID$(A$, 4, 1))
    IF S.Volume(A) > 64 THEN S.Volume(A) = 64
    S.Length(A)         = Extract(A$, 1)
    S.RepStart(A)       = Extract(A$, 5)
    S.RepLength(A)      = Extract(A$, 7)
    IF S.RepLength(A) = 2 THEN S.RepLength(A) = 0
    IF S.Length(A)=2 THEN S.Length(A)=0
NEXT
'=====================================================================
A$ = " ": GET #1, , A$: T.Length = ASC(A$): GET #1, , A$
'Load the pattern table.
HighestPattern = -1
FOR A = 0 TO 127
    GET #1, , A$: B = ASC(A$)
    IF B > HighestPattern THEN HighestPattern = B
    PatternSegment(A) = B
NEXT
'=====================================================================
IF S.Max = 31 THEN SEEK #1, LOC(1) + 5
A$ = SPACE$(1024)
'Load the patterns.
FOR A = 0 TO HighestPattern
    LOCATE , 1: PRINT USING "Parsing Pattern ##"; A;
    GET #1, , A$
    B = Alloc(80): DEF SEG = B: C = 0

    e = 1
    FOR d = 1 TO 256
        b1 = ASC(MID$(A$, e, 1))
        b2 = ASC(MID$(A$, e + 1, 1))
        b3 = ASC(MID$(A$, e + 2, 1))
        b4 = ASC(MID$(A$, e + 3, 1))
        e = e + 4
        sample = (b1 AND 240) OR (b3 \ 16)
        period = (b1 AND 15) * 256 OR b2
        effect = b3 AND 15
        operand = b4

        IF sample > S.Max THEN sample = 0
        IF period > 1023 OR period < 20 THEN period = 0

        SELECT CASE effect
        CASE &HC
            IF operand > 64 THEN operand = 64
        END SELECT
'<<-Continued On Next Message->>

--- MsgToss 2.0b
 * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)