Keskustelu: Koodit: QB: Sound Blaster FM-Synth

TYPE soundsystem
    SoundType AS STRING * 1 '"c"=carrier, "m"=modulator

    AmplitudeModulation AS INTEGER '0 tai 1
    Vibrato             AS INTEGER '0 tai 1
    OctaveShift         AS INTEGER '0 tai 15, 1=normalli

    KeyScaling  AS INTEGER '0...3
    OutPutLevel AS INTEGER '0...63

    Attack  AS INTEGER '0...15
    Decay   AS INTEGER '0...15
    Sustain AS INTEGER '0...15
    Release AS INTEGER '0...15
END TYPE
'Settaa dataa kortille
 DECLARE SUB SoundSetReg (Reg%, Value%)
'Settaa äänityyppijutskan jollekki kanavalle, kanavia on 0...8
 DECLARE SUB setsounds (Sydeemi AS soundsystem, Canawa%)
'PlaySound soittaa yhden nuotin.
'Octave% on 0llasta 7ttämään, ja Note on C#,D,D#,E,F,F#,G,G#,A,A#,B tai C.
 DECLARE SUB playsound (Octave%, Note$, Channel%)
'Sun soundicardis base osoite, vaihda jos se on eri
 CONST SoundBaseAddr = &H220
'totta vai tarua
 CONST FALSE = 0, TRUE = NOT FALSE

DIM c AS soundsystem, m AS soundsystem
c.SoundType = "c"
c.AmplitudeModulation = 0
c.Vibrato = 1
c.OctaveShift = 1
c.KeyScaling = 0
c.OutPutLevel = 1
c.Attack = 14
c.Decay = 4
c.Sustain = 9
c.Release = 13

m.SoundType = "m"
m.AmplitudeModulation = 0
m.Vibrato = 1
m.OctaveShift = 1
m.KeyScaling = 0
m.OutPutLevel = 1
m.Attack = 14
m.Decay = 4
m.Sustain = 9
m.Release = 13

setsounds c, 0 'settaa carrier
setsounds m, 0 'settaa modulaattori
playsound 1, "F", 0 'soita ääni kanavassa 0
sleep 2 'venataan että se soi
soundoff 0 'kanava 0 pois

DEFINT A-Z
SUB playsound (Octave, Note$, Channel)
SELECT CASE UCASE$(Note$)
    CASE "C#"
        SoundSetReg &HA0 + Channel, &H6B
        SoundSetReg &HB0 + Channel, &H21 + 4 * Octave
    CASE "D"
        SoundSetReg &HA0 + Channel, &H81
        SoundSetReg &HB0 + Channel, &H21 + 4 * Octave
    CASE "D#"
        SoundSetReg &HA0 + Channel, &H98
        SoundSetReg &HB0 + Channel, &H21 + 4 * Octave
    CASE "E"
        SoundSetReg &HA0 + Channel, &HB0
        SoundSetReg &HB0 + Channel, &H21 + 4 * Octave
    CASE "F"
        SoundSetReg &HA0 + Channel, &HCA
        SoundSetReg &HB0 + Channel, &H21 + 4 * Octave
    CASE "F#"
        SoundSetReg &HA0 + Channel, &HE5
        SoundSetReg &HB0 + Channel, &H21 + 4 * Octave
    CASE "G"
        SoundSetReg &HA0 + Channel, &H2
        SoundSetReg &HB0 + Channel, &H22 + 4 * Octave
    CASE "G#"
        SoundSetReg &HA0 + Channel, &H20
        SoundSetReg &HB0 + Channel, &H22 + 4 * Octave
    CASE "A"
        SoundSetReg &HA0 + Channel, &H41
        SoundSetReg &HB0 + Channel, &H22 + 4 * Octave
    CASE "A#"
        SoundSetReg &HA0 + Channel, &H63
        SoundSetReg &HB0 + Channel, &H22 + 4 * Octave
    CASE "B"
        SoundSetReg &HA0 + Channel, &H87
        SoundSetReg &HB0 + Channel, &H22 + 4 * Octave
    CASE "C"
        SoundSetReg &HA0 + Channel, &HAE
        SoundSetReg &HB0 + Channel, &H22 + 4 * Octave
END SELECT
END SUB

SUB soundoff(Channel)
    SoundSetReg &HB0 + Channel, 0
END SUB

SUB setsounds (Sydeemi AS soundsystem, Canawa)
SELECT CASE Canawa
    CASE 0: ccarrier = &H0: cmodulator = &H3
    CASE 1: ccarrier = &H1: cmodulator = &H4
    CASE 2: ccarrier = &H2: cmodulator = &H5
    CASE 3: ccarrier = &H8: cmodulator = &HB
    CASE 4: ccarrier = &H9: cmodulator = &HC
    CASE 5: ccarrier = &HA: cmodulator = &HD
    CASE 6: ccarrier = &H10: cmodulator = &H13
    CASE 7: ccarrier = &H11: cmodulator = &H14
    CASE 8: ccarrier = &H12: cmodulator = &H15
END SELECT
IF LCASE$(Sydeemi.SoundType) = "c" THEN
    settaus = ccarrier
ELSEIF LCASE$(Sydeemi.SoundType) = "m" THEN
    settaus = cmodulator
ELSE
    EXIT SUB
END IF

d = 0
IF Sydeemi.AmplitudeModulation THEN d = d + 128
IF Sydeemi.Vibrato THEN d = d + 64
IF (Sydeemi.OctaveShift >= 0) AND (Sydeemi.OctaveShift <= 15) THEN
    d = d OR Sydeemi.OctaveShift
END IF
SoundSetReg &H20 + settaus, d
'PRINT HEX$(&H20 + settaus); "->"; HEX$(d); " OK"

d = 0
IF (Sydeemi.KeyScaling >= 0) AND (Sydeemi.KeyScaling <= 3) THEN
    d = d OR (Sydeemi.KeyScaling * 64)
END IF
IF (Sydeemi.OutPutLevel >= 0) AND (Sydeemi.OutPutLevel <= 63) THEN
    d = d OR Sydeemi.OutPutLevel
END IF
SoundSetReg &H40 + settaus, d
'PRINT HEX$(&H40 + settaus); "->"; HEX$(d); " OK"

d = 0
IF (Sydeemi.Attack >= 0) AND (Sydeemi.Attack <= 15) THEN
    d = d OR (Sydeemi.Attack * 16)
END IF
IF (Sydeemi.Decay >= 0) AND (Sydeemi.Decay <= 15) THEN
    d = d OR Sydeemi.Decay
END IF
SoundSetReg &H60 + settaus, d
'PRINT HEX$(&H60 + settaus); "->"; HEX$(d); " OK"

d = 0
IF (Sydeemi.Sustain >= 0) AND (Sydeemi.Sustain <= 15) THEN
    d = d OR (Sydeemi.Sustain * 16)
END IF
IF (Sydeemi.Release >= 0) AND (Sydeemi.Release <= 15) THEN
    d = d OR Sydeemi.Release
END IF
SoundSetReg &H80 + settaus, d
'PRINT HEX$(&H80 + settaus); "->"; HEX$(d); " OK"
END SUB

SUB SoundSetReg (Reg, Value)
OUT SoundBaseAddr + 8, Reg
OUT SoundBaseAddr + 9, Value
END SUB