'===========================================================================
' Subject: SOUND BLASTER STARFIELD            Date: 09-01-96 (14:51)       
'  Author: Luke Molnar                        Code: QB, QBasic, PDS        
'  Origin: Blood225@aol.com                 Packet: DEMOS.ABC
'===========================================================================
'*****************************************************************************
'*                                                                           *
'*   This program was written as a demonstration of using the MK Music       *
'*     Loader / Player in a program that does a moderate amount of           *
'*  calculations.  This is not designed to be the revolutionary graphics     *
'*                     demonstration or anything.                            *
'*                                                                           *
'*   This program was written by Molnar \ Kucalaba Productions in 1996       *
'*                                                                           *
'*             http://members.aol.com/mkwebsite/index.html                   *
'*                   ftp://users.aol.com/blood225/                           *
'*                                                                           *
'*****************************************************************************

DECLARE SUB InitSong ()
DECLARE SUB Main ()
DECLARE SUB SBInit ()
DECLARE SUB PlayMusic ()
DECLARE SUB InitStars ()
DECLARE SUB CloseChannels ()
DECLARE SUB SetIns (Channel%)
DECLARE SUB WriteReg (Reg%, value%)


CONST BasePort% = &H220  ' Change this for other sound cards.  It is most
                         ' likely 220h. (or 380h for Adlib)

CLS
SCREEN 13

'$DYNAMIC
RANDOMIZE TIMER

TYPE StarType
 X AS INTEGER
 y AS INTEGER
 Speed AS INTEGER
END TYPE

DIM SHARED MaxChannel%, MaxNotes%
MaxChannel% = 3
CONST MaxPlay% = -1

TYPE InsType
 MMult AS INTEGER
 MLevel AS INTEGER
 MAttack AS INTEGER
 MSustain AS INTEGER
 CMult AS INTEGER
 CLevel AS INTEGER
 CAttack AS INTEGER
 CSustain AS INTEGER
END TYPE

TYPE ChannelType
 Defined AS INTEGER
 Speed AS SINGLE
 SongPtr AS INTEGER
 PStat AS SINGLE
 Octave AS INTEGER
 WaveForm AS INTEGER
 Flag AS INTEGER
 Flag2 AS INTEGER
 IsPlaying AS INTEGER
 IsDone AS INTEGER
END TYPE



DIM SHARED SongBuf(1 TO 790) AS INTEGER
DIM SHARED ChannelStat(1 TO 3) AS ChannelType
DIM SHARED Stars(100) AS StarType
DIM SHARED CurrentIns AS InsType


 SBInit
 InitStars
 InitSong
  
   Main

 SBInit
 SYSTEM

SongData:
DATA &HFD,&HFD,&HFD,&H28,&H14,&H28,&HFE,&HFE,&HFE,&H1,&H3,&H3,&HF,&HFF,&H44,&HFE,&H258,&H43,&H2,&H46,&HFD,&HF,&H46,&H14,&HFD,&H46,&H44,&H14,&H15,&H44,&HF,&H46,&H43,&H15,&HFE,&H44,&H46,&H4,&HFF,&H45,&H11,&H14,&HFF,&HFE,&H44,&H28,&H3,&H43,&H46,&HF,&HFF,&H45,&HFF,&H28,&HFF,&H64,&H44,&H14,&HF,&H44,&H46,&HF,&H44,&HFF,&HF,&HFD,&H14,&HF,&H28,&H45,&HF,&HFE,&HFD,&HF,&H3,&H28,&HF,&H44,&HFE,&HFF,&H43,&H1,&H64,&HFD,&HF,&HFE,&H14,&HFE,&H4,&H44,&H2,&H11,&H44,&HF,&H11,&H43,&HFD,&H12,&H44,&H14
DATA &HFF,&HFF,&HF,&H28,&H14,&H15,&H11,&H44,&H46,&H46,&H43,&H45,&H46,&HFF,&HFF,&H46,&H28,&H28,&H46,&H44,&H46,&H46,&H44,&H45,&H46,&H44,&HFF,&H46,&HFD,&H14,&H46,&H28,&H46,&H46,&HFE,&HFF,&H46,&H3,&H14,&HFD,&H44,&H45,&HC8,&H43,&HFD,&H12,&HFD,&H28,&HFD,&H14,&HFE,&H14,&H44,&H1,&H11,&H44,&HF,&H11,&H43,&HFE,&H12,&H44,&H2,&H11,&HFF,&HF,&HF,&H14,&HFD,&HF,&H44,&H14,&HFF,&H43,&HF,&H12C,&HFF,&H15,&HFD,&H28,&H46,&H28,&H44,&H45,&HFE,&H44,&HFF,&H3,&H44,&H28,&HF,&HFD,&H46,&HF,&H28,&H45,&HFF,&HFE,&HFF,&H14
DATA &H3,&H14,&HFD,&H44,&H46,&H14,&H43,&HFF,&HFE,&HFD,&H14,&H4,&H14,&H45,&H12,&H44,&HFD,&H46,&H44,&H28,&H12,&H43,&HFE,&H11,&H44,&H1,&H12,&HFF,&HF,&H46,&H14,&HFE,&H12,&H44,&H2,&H11,&H43,&HF,&H12,&HFF,&HFD,&H46,&H28,&H14,&H12,&H44,&HF,&H11,&H44,&H15,&H12,&H44,&H46,&H46,&HFD,&HF,&H12,&H28,&HFF,&H11,&HFE,&H14,&HFE,&H3,&HF,&H4,&H44,&HFF,&HFD,&H43,&H14,&HA,&HFD,&H46,&HF,&H14,&H15,&H15,&H44,&HFF,&H46,&H44,&H14,&HF,&H43,&HF,&H15,&H44,&HFF,&H46,&HFF,&H14,&HF,&H14,&HFD,&H15,&H44,&H28,&H46,&H43
DATA &HFE,&HF,&HFF,&H2,&H15,&H28,&H12,&H46,&H44,&HFE,&HF,&H44,&H3,&H15,&H44,&H12,&H46,&HFD,&HFD,&HF,&H28,&H14,&H15,&HFE,&H12,&H46,&H3,&H11,&H12,&H44,&HFE,&H11,&H43,&H2,&H12,&HFD,&HF,&HFE,&H14,&H15,&H3,&H44,&HFF,&HF,&H44,&H28,&HFF,&H43,&HF,&H14,&H44,&H15,&HF,&HFF,&HFF,&H15,&H14,&H14,&H46,&H44,&HF,&H12,&H43,&HFF,&H46,&HFF,&H14,&HF,&H28,&H15,&HFF,&H44,&HFD,&H14,&H44,&H28,&HFE,&H44,&HFE,&H5,&HFD,&H2,&H12,&H28,&H12,&H12,&HFE,&HFE,&H12,&H3,&H3,&H12,&H44,&H12,&H12,&H43,&HFD,&H12,&HFD,&H14
DATA &H12,&H14,&H12,&H12,&H44,&H11,&HFD,&H44,&HFE,&H64,&H43,&H2,&H12,&H44,&HF,&HFF,&HFF,&HFE,&H3C,&H14,&H3,&HFB,&H44,&H12,&H0,&H43,&HFF,&H0,&HFF,&H14,&H0,&H28,&H12,&H0,&H44,&HFF,&H0,&H44,&H14,&H0,&H44,&HFE,&H0,&HFD,&H2,&H0,&H28,&HF,&H0,&HFE,&HFE,&H0,&H3,&H3,&H0,&H44,&H11,&H0,&H43,&HFF,&H0,&HFD,&H14,&H0,&H14,&H12,&H0,&H44,&HFF,&H0,&H44,&H14,&H0,&H43,&HFD,&H0,&H44,&H28,&H0,&HFF,&HFE,&H0,&H14,&H1,&H0,&H44,&HF,&H0,&H43,&HFE,&H0,&HFF,&H2,&H0,&H28,&HF,&H0,&H44,&HFD,&H0
DATA &H44,&H14,&H0,&H44,&HF,&H0,&HFD,&H15,&H0,&H28,&H46,&H0,&HFE,&HF,&H0,&H3,&HFF,&H0,&H44,&H14,&H0,&H43,&HF,&H0,&HFD,&HFF,&H0,&H14,&H14,&H0,&H44,&H46,&H0,&H44,&H15,&H0,&H43,&HFF,&H0,&H44,&H14,&H0,&HFF,&HF,&H0,&H14,&HFF,&H0,&H44,&H14,&H0,&H43,&HFD,&H0,&HFF,&H28,&H0,&H28,&HFE,&H0,&H44,&H2,&H0,&H44,&H46,&H0,&H44,&HFE,&H0,&HFD,&H3,&H0,&H28,&H46,&H0,&HFE,&HFD,&H0,&H3,&H14,&H0,&H44,&H46,&H0,&H43,&H12,&H0,&HFD,&HFE,&H0,&H14,&H2,&H0,&H44,&H43,&H0,&H44,&HFE,&H0,&H43
DATA &H3,&H0,&H44,&H46,&H0,&HFF,&HFF,&H0,&H14,&H14,&H0,&H44,&H46,&H0,&H43,&HFF,&H0,&HFF,&H14,&H0,&H28,&HFE,&H0,&H44,&H2,&H0,&H44,&H43,&H0,&H44,&HFE,&H0,&HFD,&H3,&H0,&H28,&H12,&H0,&HFE,&HFF,&H0,&H3,&H14,&H0,&H44,&H46,&H0,&H43,&HFF,&H0,&HFD,&H14,&H0,&H14,&HFD,&H0,&H44,&H14,&H0,&H44,&HFE,&H0,&H43,&H3,&H0,&H44,&H12,&H0,&HFF,&H12,&H0,&H14,&H12,&H0,&H44,&H12,&H0,&H43,&H12,&H0,&HFF,&H11,&H0,&H28,&HFE,&H0,&H44,&H2,&H0,&H44,&HF,&H0,&H44,&HFE,&H0,&H0,&H3,&H0,&H0,&HF
DATA &H0,&H0,&HFF,&H0,&H0,&H28,&H0,&H0,&HFE,&H0,&H0,&H3,&H0,&H0,&H15,&H0,&H0,&H15,&H0,&H0,&H12,&H0,&H0,&HFE,&H0,&H0,&H2,&H0,&H0,&H11,&H0,&H0,&HFF,&H0,&H0,&H28,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0

InstrumentData:
DATA &H1,&H0,&HE4,&H9D,&H1,&H1F,&HE4,&H9D
DATA &H22,&H2,&H57,&H48,&H71,&H42,&HB3,&HB
DATA &HE1,&H2,&HC8,&HF9,&HF9,&HEC,&HF6,&H6C

REM $STATIC
SUB CloseChannels
FOR Channel% = &HB0 TO &HBF
 CALL WriteReg(Channel%, 0)
NEXT
END SUB

SUB InitSong
RESTORE SongData

FOR X% = 1 TO 790
  READ SongBuf(X%)
NEXT

RESTORE InstrumentData

FOR X% = 1 TO 3
  ChannelStat(X%).Defined = 1
  ChannelStat(X%).SongPtr = 1

  READ CurrentIns.MMult, CurrentIns.MLevel, CurrentIns.MAttack, CurrentIns.MSustain
  READ CurrentIns.CMult, CurrentIns.CLevel, CurrentIns.CAttack, CurrentIns.CSustain
  
  Ficx% = X%
  SetIns X%
  X% = Ficx%

NEXT

END SUB

SUB InitStars
FOR Fill% = 1 TO 100
 Stars(Fill%).X = INT(RND * 320) + 1
 Stars(Fill%).y = INT(RND * 200) + 1
 Stars(Fill%).Speed = INT(RND * 5) + 1
NEXT

FOR X% = 1 TO 5
    OUT &H3C8, X%
    OUT &H3C9, X% * 12
    OUT &H3C9, X% * 12
    OUT &H3C9, X% * 12
NEXT
END SUB

SUB Main

DO
 
  FOR X% = 1 TO 100
    PSET (Stars(X%).X, Stars(X%).y), 0
    Stars(X%).X = Stars(X%).X + Stars(X%).Speed
      IF Stars(X%).X > 320 THEN
        Stars(X%).X = 0
        Stars(X%).y = INT(RND * 200) + 1
      END IF
    PSET (Stars(X%).X, Stars(X%).y), Stars(X%).Speed
  NEXT

 PlayMusic

LOOP UNTIL INKEY$ <> ""

END SUB

SUB PlayMusic

FOR Channel% = 1 TO MaxChannel%

  IF ChannelStat(Channel%).Defined = 0 THEN GOTO NoGotosPlease

  RChan% = Channel% - 1

  IF ChannelStat(Channel%).IsDone = 1 THEN
   ChannelStat(Channel%).PStat = TIMER + ChannelStat(Channel%).Speed
   ChannelStat(Channel%).SongPtr = ChannelStat(Channel%).SongPtr + MaxChannel%
   ChannelStat(Channel%).IsDone = 0
   ChannelStat(Channel%).IsPlaying = 0
  END IF

   IF ChannelStat(Channel%).IsPlaying = 0 AND SongBuf(ChannelStat(Channel%).SongPtr + Channel% - 1) <> 0 THEN
    ChannelStat(Channel%).PStat = TIMER + ChannelStat(Channel%).Speed
     SELECT CASE SongBuf(ChannelStat(Channel%).SongPtr + RChan%)
       CASE 68
         WriteReg &HA0 + RChan%, &H81
         WriteReg &HB0 + RChan%, &H21 + 4 * ChannelStat(Channel%).Octave
       CASE 69
         WriteReg &HA0 + RChan%, &HB0
         WriteReg &HB0 + RChan%, &H21 + 4 * ChannelStat(Channel%).Octave
       CASE 70
         WriteReg &HA0 + RChan%, &HCA
         WriteReg &HB0 + RChan%, &H21 + 4 * ChannelStat(Channel%).Octave
       CASE 71
         WriteReg &HA0 + RChan%, &H2
         WriteReg &HB0 + RChan%, &H22 + 4 * ChannelStat(Channel%).Octave
       CASE 65
         WriteReg &HA0 + RChan%, &H41
         WriteReg &HB0 + RChan%, &H22 + 4 * ChannelStat(Channel%).Octave
       CASE 66
         WriteReg &HA0 + RChan%, &H87
         WriteReg &HB0 + RChan%, &H22 + 4 * ChannelStat(Channel%).Octave
       CASE 67
         WriteReg &HA0 + RChan%, &HAE
         WriteReg &HB0 + RChan%, &H22 + 4 * ChannelStat(Channel%).Octave
       CASE 17
         WriteReg &HA0 + RChan%, &H6B
         WriteReg &HB0 + RChan%, &H21 + 4 * ChannelStat(Channel%).Octave
       CASE 18
         WriteReg &HA0 + RChan%, &H98
         WriteReg &HB0 + RChan%, &H21 + 4 * ChannelStat(Channel%).Octave
       CASE 20
         WriteReg &HA0 + RChan%, &HE5
         WriteReg &HB0 + RChan%, &H21 + 4 * ChannelStat(Channel%).Octave
       CASE 21
         WriteReg &HA0 + RChan%, &H20
         WriteReg &HB0 + RChan%, &H22 + 4 * ChannelStat(Channel%).Octave
       CASE 15
         WriteReg &HA0 + RChan%, &H63
         WriteReg &HB0 + RChan%, &H22 + 4 * ChannelStat(Channel%).Octave
       
       CASE 255
         ChannelStat(Channel%).IsPlaying = 1
         ChannelStat(Channel%).PStat = TIMER + SongBuf(ChannelStat(Channel%).SongPtr + Channel% - 1 + MaxChannel%) / 100
         ChannelStat(Channel%).Flag = -1
       CASE 254
         ChannelStat(Channel%).Octave = SongBuf(ChannelStat(Channel%).SongPtr + Channel% - 1 + MaxChannel%)
         ChannelStat(Channel%).SongPtr = ChannelStat(Channel%).SongPtr + MaxChannel%
       CASE 253
         ChannelStat(Channel%).Speed = SongBuf(ChannelStat(Channel%).SongPtr + Channel% - 1 + MaxChannel%) / 100
         ChannelStat(Channel%).SongPtr = ChannelStat(Channel%).SongPtr + MaxChannel%
       CASE 252
         ChannelStat(Channel%).WaveForm = SongBuf(ChannelStat(Channel%).SongPtr + Channel% - 1 + MaxChannel%) - 300
         ChannelStat(Channel%).SongPtr = ChannelStat(Channel%).SongPtr + MaxChannel%
         IF RChan% > 2 THEN RRChan% = RChan% + 6 ELSE RRChan% = 0
         WriteReg &HE0 + RChan% + RRChan%, ChannelStat(Channel%).WaveForm
       CASE 251
         ChannelStat(1).Flag2 = -1
          FOR MaxChan% = 1 TO MaxChannel%
           ChannelStat(MaxChan%).SongPtr = 1
           ChannelStat(MaxChan%).IsPlaying = 0
           ChannelStat(MaxChan%).IsDone = 0
          NEXT
         CloseChannels
         EXIT SUB
     END SELECT
   END IF

    IF ChannelStat(Channel%).IsPlaying = 1 THEN
     IF TIMER >= ChannelStat(Channel%).PStat THEN
      WriteReg &HB0 + RChan%, 0
      ChannelStat(Channel%).IsDone = 1
       IF ChannelStat(Channel%).Flag = -1 THEN
        ChannelStat(Channel%).SongPtr = ChannelStat(Channel%).SongPtr + MaxChannel%
        ChannelStat(Channel%).Flag = 0
       END IF
     END IF
    END IF
  
   IF ChannelStat(Channel%).SongPtr > MaxChannel% + 1 THEN
     IF SongBuf(ChannelStat(Channel%).SongPtr + RChan%) <> 0 AND SongBuf(ChannelStat(Channel%).SongPtr - MaxChannel% + RChan%) < 250 THEN
       IF ChannelStat(Channel%).IsPlaying = 0 THEN ChannelStat(Channel%).IsPlaying = 1
     END IF
   END IF

NoGotosPlease:
NEXT Channel%


FOR Channel% = 1 TO MaxChannel%

 IF ChannelStat(Channel%).IsPlaying = 0 THEN
  ChannelStat(Channel%).SongPtr = ChannelStat(Channel%).SongPtr + MaxChannel%
  IF ChannelStat(Channel%).SongPtr >= UBOUND(SongBuf) / MaxChannel% THEN
   ChannelStat(Channel%).SongPtr = 1
  END IF
 END IF
NEXT Channel%


END SUB

SUB SBInit
   FOR z% = 1 TO &HF5
     WriteReg z%, 0
   NEXT z%
END SUB

SUB SetIns (Channel%)
CarChan% = Channel% - 1
WriteReg &H20 + CarChan%, CurrentIns.CMult
WriteReg &H23 + CarChan%, CurrentIns.MMult
WriteReg &H40 + CarChan%, CurrentIns.CLevel
WriteReg &H43 + CarChan%, CurrentIns.MLevel
WriteReg &H60 + CarChan%, CurrentIns.CAttack
WriteReg &H63 + CarChan%, CurrentIns.MAttack
WriteReg &H80 + CarChan%, CurrentIns.CSustain
WriteReg &H83 + CarChan%, CurrentIns.MSustain
END SUB

DEFINT A-Z
SUB WriteReg (Reg%, value%)
OUT BasePort% + 8, Reg%
 FOR V% = 1 TO 6
  Buf% = INP(BasePort% + 8)
 NEXT
OUT BasePort% + 9, value%
 FOR V% = 1 TO 34
  Buf% = INP(BasePort% + 9)
 NEXT
END SUB