'===========================================================================
' Subject: ADLIB/SB MUSICAL NOTES             Date: 12-22-96 (12:56)       
'  Author: The ABC Programmer                 Code: QB, QBasic, PDS        
'  Origin: Convert from Pascal code         Packet: SOUND.ABC
'===========================================================================
'===========================================================================
' ADLIB/SB Music Pascal code converted to BASIC by William Yu (12-07-96)
'
' Origin, and original author:
'===========================================================================
' BBS: Canada Remote Systems
'Date: 09-02-93 (00:16)             Number: 36877
'From: CATHY NICOLOFF               Refer#: NONE
'  To: ALL                           Recvd: NO
'Subj: Musical Notes!!!      1/2      Conf: (1221) F-PASCAL
'---------------------------------------------------------------------------
'Here's some help for all you programmers out there! It's straight from
'my personal programming library!

'Explanation : This is used to emulate single note music (IE-ANSI music).

'The array NOTES is the frequencies used to do a SOUND/NOSOUND on the PC
'speaker.

'The SBNOTES and SBOCTAVES arrays are the hex values of the notes, and
'their octaves for any ADLIB compatible card.

'Just take which note you want, and input the note AND the octave
'into the Adlib port. Here's some sample code to show you how :

DEFINT A-Z
DECLARE SUB InitSB ()
DECLARE SUB ResetSB ()
DECLARE FUNCTION DetectSB% ()
DECLARE SUB PlaySB (N%, M%)
DECLARE SUB Delay (Sec!)
DECLARE SUB ConvertNote (Note$, PlayNote%)
DECLARE SUB PlaySong (NumNotes%, MusicNote() AS STRING, MusicDelay() AS INTEGER)

CONST False = 0
CONST True = NOT False

DIM SHARED SBNotes(1 TO 12) AS INTEGER
DIM SHARED SBOctaves(1 TO 84) AS INTEGER
DIM SHARED Notes(1 TO 84) AS INTEGER

FOR N = 1 TO 12
  READ SBNotes(N)
NEXT N
FOR N = 1 TO 84
  READ SBOctaves(N)
NEXT N
FOR N = 1 TO 84
  READ Notes(N)
NEXT N

READ JingleNotes
DIM JingleNote(1 TO JingleNotes) AS STRING
DIM JingleDelay(1 TO JingleNotes) AS INTEGER
FOR N = 1 TO JingleNotes
  READ JingleNote(N)
  READ JingleDelay(N)
NEXT N

READ WeWishNotes
DIM WeWishNote(1 TO WeWishNotes) AS STRING
DIM WeWishDelay(1 TO WeWishNotes) AS INTEGER
FOR N = 1 TO WeWishNotes
  READ WeWishNote(N)
  READ WeWishDelay(N)
NEXT N

READ ItCameUponNotes
DIM ItCameUponNote(1 TO ItCameUponNotes) AS STRING
DIM ItCameUponDelay(1 TO ItCameUponNotes) AS INTEGER
FOR N = 1 TO ItCameUponNotes
  READ ItCameUponNote(N)
  READ ItCameUponDelay(N)
NEXT N


'SBNotes
DATA &HAE, &H6B, &H81, &H98, &HB0, &HCA, &HE5, &H02, &H20, &H41, &H63, &H87

'SBOctaves
DATA &H22, &H25, &H25, &H25, &H25, &H25, &H25, &H26, &H26, &H26, &H26, &H26
DATA &H26, &H29, &H29, &H29, &H29, &H29, &H29, &H2A, &H2A, &H2A, &H2A, &H2A
DATA &H2A, &H2D, &H2D, &H2D, &H2D, &H2D, &H2D, &H2E, &H2E, &H2E, &H2E, &H2E
DATA &H2E, &H31, &H31, &H31, &H31, &H31, &H31, &H32, &H32, &H32, &H32, &H32
DATA &H32, &H35, &H35, &H35, &H35, &H35, &H35, &H36, &H36, &H36, &H36, &H36
DATA &H36, &H39, &H39, &H39, &H39, &H39, &H39, &H3A, &H3A, &H3A, &H3A, &H3A
DATA &H3A, &H3D, &H3D, &H3D, &H3D, &H3D, &H3D, &H3E, &H3E, &H3E, &H3E, &H3E

'     C    C#,D-  D    D#,E-  E     F    F#,G-  G    G#,A-  A    A#,B-  B
DATA 0065, 0070, 0073, 0078, 0082, 0087, 0093, 0098, 0104, 0110, 0117, 0123
DATA 0131, 0139, 0147, 0156, 0165, 0175, 0185, 0196, 0208, 0220, 0233, 0247
DATA 0262, 0277, 0294, 0311, 0330, 0349, 0370, 0392, 0415, 0440, 0466, 0494
DATA 0523, 0554, 0587, 0622, 0659, 0698, 0740, 0784, 0831, 0880, 0932, 0987
DATA 1047, 1109, 1175, 1245, 1329, 1397, 1480, 1568, 1661, 1760, 1865, 1976
DATA 2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951
DATA 4186, 4435, 4699, 4978, 5274, 5588, 5920, 6272, 6645, 7040, 7459, 7902

'Jingle Bells
'First entry is the number of notes in the song.
DATA 56
DATA E3,8,E3,8,E3,8,P,2,E3,8,E3,8,E3,8,P,2,E3,8,G3,8,C3,8,D3,8
DATA E3,14,F3,8,F3,8,F3,8,F3,8,F3,8,E3,8,E3,8,E3,8,E3,8
DATA E3,8,D3,8,D3,8,E3,8,D3,14,G3,10,P,1
DATA E3,8,E3,8,E3,8,P,2,E3,8,E3,8,E3,8,P,2,E3,8,G3,8,C3,8,D3,8
DATA E3,14,F3,8,F3,8,F3,8,F3,8,F3,8,E3,8,E3,8,E3,8,E3,8
DATA G3,8,G3,8,F3,8,D3,8,C3,10

'We wish you a merry christmas
DATA 82
DATA C3,12,F3,12,F3,8,G3,8,F3,8,E3,8,D3,12,D3,12,D3,12,G3,12,G3,8,A3,8,G3,8,F3,8
DATA E3,12,C3,12,C3,12,A3,12,A3,8,B-3,8,A3,8,G3,8,F3,12,D3,12,C3,8,C3,8,D3,12,G3,12
DATA E3,12,F3,16,C3,12,F3,12,F3,12,F3,12,E3,16,E3,12,F3,12,E3,12,D3,12,C3,16,C3,12,A3,12
DATA G3,12,F3,12,C4,12,C3,12,C3,8,C3,8,D3,12,G3,12,E3,12,F3,14,C3,12,F3,12,F3,8,G3,8
DATA F3,8,E3,8,D3,12,D3,12,D3,12,G3,12,G3,8,A3,8,G3,8,F3,8,E3,12,C3,12,C3,12,A3,12
DATA A3,8,B-3,8,A3,8,G3,8,F3,12,D3,12,C3,8,C3,8,D3,12,G3,12,E3,12,F3,16

' "It came upon a midnight clear", Composed by Thomas Ally
' Note/Octave, Delay
' Full delay (1 second) = 32
DATA 70
DATA g4, 8, e5, 16, b4, 8, d5, 8, c5, 8, a4, 8, g4, 16, a4, 8, g4, 16,g4,8
DATA a4,8,b4,8,c5,8,c5,8,d5,8,e5,8,d5,24,d5,16,g4,8,e5,16,b4,8
DATA d5,8,c5,8,a4,8,g4,16,a4,8,g4,16,g4,8,a4,16,a4,8,b4,8,a4,8,g4,8
DATA c5,24,c5,16,e5,8,e5,16,e4,8,e4,8,f#4,8,g#4,8,a4,16,b4,8,c5,16,e5,8
DATA d5,8,c5,8,b4,8,a4,8,b4,8,a4,8,g4,24,g4,16,g4,8,e5,16,b4,8,d5,8,c5,8,a4,8
DATA g4,16,a4,8,g4,16,g4,8,a4,16,a4,8,b4,8,a4,8,g4,8,c5,24,c5,16

'To play note 'C' at octave 3, do the following :

'PlaySB &HA0, SBNotes(1)
'PlaySB &HB0, SBOctaves(1 + 3 * 12)

'To shut off Adlib output, do this :

'PlaySB &H83, &HFF
'PlaySB &HB0, &H11

IF DetectSB = False THEN PRINT "No soundcard detected.": END

InitSB
ResetSB

CLS
PRINT "We wish you a Merry Christmas"
PlaySong WeWishNotes, WeWishNote(), WeWishDelay()
CLS
PRINT "Jingle Bells"
PlaySong JingleNotes, JingleNote(), JingleDelay()
CLS
PRINT "It came upon a midnight clear."
PlaySong ItCameUponNotes, ItCameUponNote(), ItCameUponDelay()


' Turn off sound

PlaySB &H83, &HFF
PlaySB &HB0, &H11

END

SUB ConvertNote (Note$, PlayNote)

' Purpose: Convert string note into recognizable computer note.
' Returns PlayNote.

  SELECT CASE Note$
    CASE "C"
      PlayNote = 1
    CASE "C#", "D-"
      PlayNote = 2
    CASE "D"
      PlayNote = 3
    CASE "D#", "E-"
      PlayNote = 4
    CASE "E"
      PlayNote = 5
    CASE "F"
      PlayNote = 6
    CASE "F#", "G-"
      PlayNote = 7
    CASE "G"
      PlayNote = 8
    CASE "G#", "A-"
      PlayNote = 9
    CASE "A"
      PlayNote = 10
    CASE "A#", "B-"
      PlayNote = 11
    CASE "B"
      PlayNote = 12
  END SELECT

END SUB

SUB Delay (Sec!)
  T! = TIMER
  DO
  LOOP UNTIL ABS(TIMER - T!) > Sec!
END SUB

FUNCTION DetectSB
   PlaySB &H4, &H60
   PlaySB &H4, &H80
   Dummy1 = INP(&H388)
   PlaySB &H2, &HFF
   PlaySB &H4, &H21
   'Delay (8)
   Dummy2 = INP(&H388)
   PlaySB &H4, &H60
   PlaySB &H4, &H80
   IF ((Dummy1 AND &HE0) = 0) AND ((Dummy2 AND &HE0) = &HC0) THEN
      DetectSB = True
   ELSE
      DetectSB = False
   END IF
END FUNCTION

SUB InitSB
   FOR A = 1 TO 244
      PlaySB A, 0
   NEXT A
   PlaySB &H1, 32
   PlaySB &HB0, &H11
   PlaySB &H4, &H60
   PlaySB &H4, &H80
END SUB

SUB PlaySB (N, M)
  OUT &H388, N
  FOR A = 1 TO 6
     Temp = INP(&H388)
  NEXT A
  OUT &H389, M
  FOR A = 1 TO 35
     Temp = INP(&H388)
  NEXT A
END SUB

SUB PlaySong (NumNotes, MusicNote() AS STRING, MusicDelay() AS INTEGER)

FOR I = 1 TO NumNotes
  IF INKEY$ = CHR$(27) THEN EXIT SUB
  LOCATE 2: PRINT CHR$(14);
  IF LEN(MusicNote(I)) = 3 THEN GetNote = 2 ELSE GetNote = 1
  Note$ = UCASE$(LEFT$(MusicNote(I), GetNote))
  Oct = VAL(RIGHT$(MusicNote(I), 1))
  ConvertNote Note$, PlayNote
  PlaySB &H83, &HFF
  PlaySB &HB0, &H11
  IF Note$ <> "P" THEN
    PlaySB &HA0, SBNotes(PlayNote)
    PlaySB &HB0, SBOctaves(PlayNote + Oct * 12)
    Delay MusicDelay(I) / 32  ' How long do you wish to hear each note played?
  ELSE
    Delay MusicDelay(I) / 32  ' How long do you wish to hear each note played?
  END IF
NEXT I

END SUB

SUB ResetSB
   PlaySB &H20, &H41
   PlaySB &H40, &H10
   PlaySB &H60, &HF0
   PlaySB &H80, &H77
   PlaySB &H23, &H41
   PlaySB &H43, &H0
   PlaySB &H63, &HF0
   PlaySB &H83, &H77
   PlaySB &HBD, &H10
END SUB
