'Name      : Playsfxs.bas
'Purpose   : Loads and plays a sound effect from an .SFX file using a Sub
'Date      : 1/22/97
'Finalized : 1/26/97
'Author    : Tim Truman
'Copyright (c) 1997  Nocturnal Creations. All Rights Reserved
'
'Feel free to use this code in your distributed programs. Perhaps you could
'mention the FX program in your own? Thanks.

DEFINT A-Z

DECLARE FUNCTION GetResource$ (lo%, Tag$)
DECLARE SUB DrawMousePix ()
DECLARE SUB MoveMousePix ()
DECLARE SUB PutMousePix ()
DECLARE SUB GetMousePix ()
DECLARE SUB splay (a$)
DECLARE FUNCTION paus2 ()
DECLARE SUB PlaySfx (fx$)
DECLARE FUNCTION ClickMouse ()

CONST MaxScroll = 60
CONST MAXARRAYSIZE = 60

COMMON SHARED TextMode 'configurable
COMMON SHARED BwMode   'configurable
COMMON SHARED MusicOn
COMMON SHARED SoundOn
COMMON SHARED AllUpper 'configurable
COMMON SHARED Box1Size 'This is set by code, not configurable
COMMON SHARED Box2Size 'This is set by code, not configurable
COMMON SHARED a$
COMMON SHARED lo AS INTEGER
COMMON SHARED Fbuff AS STRING * 8960 'For Fonts
COMMON SHARED ScrollArray() AS STRING * 96
COMMON SHARED bs1$, bs2$, bs3$, bs4$, bs5$, bs6$, bs0$, bsb$

DIM SHARED HasMouse
DIM SHARED OldPixel(9)
DIM SHARED OldMouseX
DIM SHARED OldMouseY

DIM SHARED ScrollArray(MAXARRAYSIZE, 1 TO 2) AS STRING * 96

DIM SHARED c(8) AS STRING * 62 'FM register information for 9 channels
DIM SHARED sfx(1 TO 3, 1 TO 12) AS STRING * 80
DIM SHARED Octave AS INTEGER
DIM SHARED KillSound$

CLS

DEFSNG A-Z
SUB LoadSounds

'c$(0) = "&hB0&h20&h23&h40&h43&h60&h63&h80&h83&hA0&HBD&HC0&HE0&HE3&hB0"
'c$(1) = "&hB1&h21&h24&h41&h44&h61&h64&h81&h84&hA1&HBD&HC1&HE1&HE4&hB1"
'c$(2) = "&hB2&h22&h25&h42&h45&h62&h65&h82&h85&hA2&HBD&HC2&HE2&HE5&hB2"
'c$(3) = "&hB3&h28&h2B&h48&h4B&h68&h6B&h88&h8B&hA3&HBD&HC3&HE8&HEB&hB3"
'c$(4) = "&hB4&h29&h2C&h49&h4C&h69&h6C&h89&h8C&hA4&HBD&HC4&HE9&HEC&hB4"
'c$(5) = "&hB5&h2A&h2D&h4A&h4D&h6A&h6D&h8A&h8D&hA5&HBD&HC5&HEA&HED&hB5"
'c$(6) = "&hB6&h30&h33&h50&h53&h70&h73&h90&h93&hA6&HBD&HC6&HF0&HF3&hB6"
'c$(7) = "&hB7&h31&h34&h51&h54&h71&h74&h91&h94&hA7&HBD&HC7&HF1&HF4&hB7"
'c$(8) = "&hB8&h32&h35&h52&h55&h72&h75&h92&h95&hA8&HBD&HC8&HF2&HF5&hB8"

FOR X = 0 TO 8
    c$(X) = GetResource$(37, "C" + LTRIM$(STR$(X)))
NEXT X

'OPEN "lunatix.sfx" FOR INPUT AS #2        'open the .SFX file
FOR Octave = 1 TO 3
    FOR Sfxnum% = 1 TO 12                 'load all sounds
        'INPUT #2, sfx(Octave, Sfxnum%)    'load sound into string
        sfx(Octave, Sfxnum%) = GetResource$(37, "O" + LTRIM$(STR$(Octave)) + "S" + LTRIM$(STR$(Sfxnum%)))
    NEXT
NEXT
KillSound$ = GetResource$(37, "RESET")
'INPUT #2, KillSound$                  'load string that "stops" sounds!
'CLOSE #2                              'close the file

Octave = 1

END SUB

DEFINT A-Z
FUNCTION paus2
    jd = 0
    n! = TIMER
    DO WHILE ABS(TIMER - n!) < .01
        IF ClickMouse > 0 THEN jd = 1
        MoveMousePix
    LOOP
    paus2 = jd
END FUNCTION

SUB PlayAndSleep (Repeat, CanExit, s$)

'*** INITIALIZE THE MOUSE
GetMousePix
DrawMousePix

FOR X = 1 TO 16: f$ = INKEY$: NEXT X: 'throw away the buffer, if any
null = ClickMouse: null = ClickMouse: null = ClickMouse: 'throw away clicks
null = LeftHold: null = RightHold: X = MouseX: Y = MouseY

Sx = 1
LastChar = 0
WHILE 1
    i$ = INKEY$
    n = 0
    IF LastChar <> Sx THEN
        b$ = UCASE$(MID$(s$, Sx, 1))
        IF Sx < LEN(s$) THEN
            c$ = MID$(s$, Sx + 1, 1)
            IF c$ = "+" THEN b$ = b$ + "+": Sx = Sx + 1
        END IF
        IF b$ = "C" THEN n = 1
        IF b$ = "C+" THEN n = 2
        IF b$ = "D" THEN n = 3
        IF b$ = "D+" THEN n = 4
        IF b$ = "E" THEN n = 5
        IF b$ = "F" THEN n = 6
        IF b$ = "F+" THEN n = 7
        IF b$ = "G" THEN n = 8
        IF b$ = "G+" THEN n = 9
        IF b$ = "A" THEN n = 10
        IF b$ = "A+" THEN n = 11
        IF b$ = "B" THEN n = 12
        IF b$ = "." THEN n = 13
        'IF b$ = "!" THEN Octave = 1
        IF b$ = "@" THEN Octave = 1
        IF b$ = "#" THEN Octave = 2
        IF b$ = "$" THEN Octave = 3
        'IF b$ = "%" THEN Octave = 5
        IF n >= 1 THEN
            IF n <= 12 THEN
                PlaySfx sfx(Octave, n)
                'IF Octave <= 4 THEN
                '    PlaySfx sfx(Octave, n)
                'END IF
                'IF Octave >= 2 THEN PlaySfx sfx(Octave - 1, n)
                'PlaySfx sf2$(Octave + 1, n)
            END IF
            T! = TIMER
            IF Repeat > 0 OR Sx < LEN(s$) THEN
                IF b$ <> " " THEN
                    i1 = paus2: i2 = paus2
                    IF i1 > 0 OR i2 > 0 OR ClickMouse > 0 THEN i$ = "X"
                END IF
            END IF
        END IF
        LastChar = Sx
        Sx = Sx + 1
        IF Sx > LEN(s$) THEN
            IF Repeat > 0 THEN
                Sx = 1: Repeat = Repeat - 1
            ELSE
                GOTO LeavePls
            END IF
        END IF
    END IF

    IF CanExit > 0 THEN
        IF i$ <> "" OR ClickMouse > 0 THEN GOTO LeavePls
    END IF
WEND

LeavePls: PutMousePix

END SUB

SUB PlaySfx (sfx$)

'plays an sfx$ that is sent to it.
'sub expects the c$() array (channel info) to be global

IF MusicOn < 1 THEN EXIT SUB

chan% = VAL(MID$(sfx$, 61, 4))
FOR in = 1 TO 60 STEP 4
  reg$ = MID$(c$(chan%), in, 4): reg% = VAL(reg$)
  dat$ = MID$(sfx$, in, 4): dat% = VAL(dat$)
  OUT &H388, reg%: FOR d% = 1 TO 6: b% = INP(&H388): NEXT
  OUT &H389, dat%: FOR d% = 1 TO 35: b% = INP(&H388): NEXT
NEXT

END SUB