'===========================================================================
' Subject: SB NOTE PLAYER                     Date: Unknown Date           
'  Author: Jos Szabo                          Code: QB, QBasic, PDS        
'  Origin: BASIC Archives HomePage          Packet: SOUND.ABC
'===========================================================================
DECLARE SUB TickPause (Ticks%)
OPTION BASE 1
DEFINT A-Z
DIM A0$(6)
AddressPort = &H388
DataPort = &H389
FOR clport = 0 TO 244:
OUT AddressPort, clport: OUT DataPort, 0
NEXT
OUT AddressPort, &H20: OUT DataPort, &HF1
OUT AddressPort, &HDB: OUT DataPort, &HFF
OUT AddressPort, &H40: OUT DataPort, &H90
OUT AddressPort, &H60: OUT DataPort, &HF0
OUT AddressPort, &H80: OUT DataPort, &HFF
OUT AddressPort, &H23: OUT DataPort, &H1
OUT AddressPort, &H43: OUT DataPort, &H0
OUT AddressPort, &H63: OUT DataPort, &HF0
OUT AddressPort, &H83: OUT DataPort, &H77

littleJAZZditty:

FOR xx = 1 TO 2
        FOR x = 1 TO 6
                GOSUB BinDelta
                OUT AddressPort, &HA0: OUT DataPort, A0
                OUT AddressPort, &HB0: OUT DataPort, &H30
                TickPause 2.5
                OUT AddressPort, &HB0: OUT DataPort, &H0
                TickPause .3
        NEXT x
        FOR a = 1 TO 3
                x = 5
                GOSUB BinDelta
                OUT AddressPort, &HA0: OUT DataPort, A0
                OUT AddressPort, &HB0: OUT DataPort, &H30
                TickPause 4
                x = 2 + a
                GOSUB BinDelta
                OUT AddressPort, &HA0: OUT DataPort, A0
                OUT AddressPort, &HB0: OUT DataPort, &H30
                TickPause 6
        NEXT a
        OUT AddressPort, &HB0: OUT DataPort, 0
NEXT xx
FOR x = 6 TO 2 STEP -1
        GOSUB BinDelta
        OUT AddressPort, &HA0: OUT DataPort, A0
        OUT AddressPort, &HB0: OUT DataPort, &H30
        TickPause 4
        OUT AddressPort, &HB0: OUT DataPort, &H0
        TickPause .3
NEXT x
x = 5
GOSUB BinDelta
OUT AddressPort, &HA0: OUT DataPort, A0
OUT AddressPort, &HB0: OUT DataPort, &H30
TickPause 16
OUT AddressPort, &HB0: OUT DataPort, &H0
END

BinDelta:

    A0$(1) = "01101011"   ' 1
    A0$(2) = "10000001"   ' 2
    A0$(3) = "10011000"   ' 3
    A0$(4) = "10110000"   ' 4
    A0$(5) = "11001010"   ' 5
    A0$(6) = "11100101"   ' 6
'      b0$ = "00110000"
           '  xx^   ^      /2 unused/1 on-off/3 octave/2 fnum-hi
           '  xxOoctFmbit

    bn$ = A0$(x): rBn$ = "": GOSUB BtD: A0 = Dec
RETURN

BtD:

Dec = 0!
IF LEN(bn$) <> 8 THEN RETURN
    FOR xT = 8 TO 1 STEP -1
        rBn$ = rBn$ + MID$(bn$, xT, 1)
    NEXT

    FOR xT = 0 TO 7
        BD = VAL(MID$(rBn$, xT + 1, 1))
        IF BD THEN Dec = Dec + 2 ^ xT
    NEXT
RETURN

'
'  ZDDDDDDBDDDDDDDDDDDBDDDDDDDDDDBDDDDDBDDDDDDDDDDD?
'  3      3           3          3F-H  3 F-NUMBER L3
'  3 NOTE 3 FREQUENCY 3 F-NUMBER CDDDDDEDDDDDDDDDDD4
'  3      3           3          3  10 3 76543210  3
'  CDDDDDDEDDDDDDDDDDDEDDDDDDDDDDEDDDDDEDDDDDDDDDDD4
'  3  C#  3   277.2   3    363   3  01 3 01101011  3
'  3  D   3   293.7   3    385   3  01 3 10000001  3
'  3  D#  3   311.1   3    408   3  01 3 10011000  3
'  3  E   3   329.6   3    432   3  01 3 10110000  3
'  3  F   3   349.2   3    458   3  01 3 11001010  3
'  3  F#  3   370.0   3    485   3  01 3 11100101  3
'  @DDDDDDADDDDDDDDDDDADDDDDDDDDDADDDDDDDDDDDDDDDDDY
'

DEFSNG A-Z
SUB TickPause (Ticks%) STATIC
DEFINT A-Z

    ' Ticks%        The number of ticks to delay.  There are 18.2 ticks
    '               per second.  This routine returns the ticks as an
    '               integer - it does not use QB's floating point
    '               routine.

    TestTick = 0

    DEF SEG = zero
    WHILE TestTick < Ticks

        lastTick = Tick
        Tick = PEEK(&H46C)     'Get a tick from the clock.

        '   ---- Prevents endless loop when rolling past midnight.
        IF lastTick <> Tick THEN TestTick = TestTick + 1

    WEND
    DEF SEG

END SUB
