1: 'Subj: Re: AdamS60982 2: 'Date: 94-04-17 20:38:07 EDT 3: 'From: AdamS60982 4: ' 5: 'I couldn't really recommend any SB books since I don't have any. :) 6: 'About the FM, the following example is the best I could find that uses the 7: 'information found in the SB 8: ' SBSOUND.BAS by Brett Levin 1992 9: ' 10: 'These routines were made entirely from a pretty detailed(techie, but 11: 'not that I mind <G>) text file on programming the FM ports on the AdLib/SB. 12: 'You are free to use this in any program what so ever, as long as you 13: 'give credit where credit is due.. (stole that line from Rich!) :) 14: 15: 16: DEFINT A-Z 17: DECLARE FUNCTION DetectCard% () 18: DECLARE SUB SBInit () 19: DECLARE SUB WriteReg (Reg%, Value%) 20: DECLARE SUB SBPlay (note%) 21: 22: CONST false = 0, true = NOT false 23: SCREEN 0: CLS 24: 25: IF DetectCard = true THEN 26: PRINT "AdLib-compatible sound card detected." 27: ELSE 28: PRINT "Unable to find/detect sound card." 29: BEEP 30: SYSTEM 31: END IF 32: PRINT " Initalizing..."; : SBInit 33: PRINT " Done." 34: DO UNTIL INKEY$ = CHR$(27) 35: SBPlay INT(RND * 255) 36: LOOP 37: CALL WriteReg(&HB0, &H0) 'Makes sure no extra sound is left playing 38: 39: FUNCTION DetectCard% 40: ' Purpose: Detects an AdLib-compatible card. 41: ' Returns -1 (true) if detected and 0 (false) if not. 42: ' Variables: Nope 43: 44: CALL WriteReg(&H4, &H60) 45: CALL WriteReg(&H4, &H80) 46: b = INP(&H388) 47: CALL WriteReg(&H2, &HFF) 48: CALL WriteReg(&H4, &H21) 49: FOR x = 0 TO 130 50: a = INP(&H388) 51: NEXT x 52: c = INP(&H388) 53: CALL WriteReg(&H4, &H60) 54: CALL WriteReg(&H4, &H80) 55: Success = 0 56: IF (b AND &HE0) = &H0 THEN 57: IF (c AND &HE0) = &HC0 THEN 58: Success = -1 59: END IF 60: END IF 61: DetectCard% = Success 62: END FUNCTION 63: 64: SUB SBInit 65: ' Initialize the sound card 66: 67: '(This is the "quick-and-dirty" method; what it's doing is zeroing out 68: 69: ' all of the card's registers. I haven't had any problems with this.) 70: FOR q = 1 TO &HF5 71: CALL WriteReg(q, 0) 72: NEXT q 73: END SUB 74: 75: SUB SBPlay (freq%) 76: ' Purpose: Plays a note 77: ' Variables: freq% - Frequency (00-FF hex) 78: ' duration% - Duration (n seconds) (not used) 79: ' I'm still working on this part, it may be ugly, but it works <g>. 80: ' The first group of WriteRegs is the modulator, the second is the 81: ' carrier. 82: ' If you just want to know how to create your own instrument, play around 83: ' with the second values in the first four calls to WriteReg in each group. 84: ' :-) Have fun! - Brett 85: 86: CALL WriteReg(&H20, &H7) ' Set modulator's multiple to F 87: CALL WriteReg(&H40, &HF) ' Set modulator's level to 40 dB 88: CALL WriteReg(&H60, &HF0) ' Modulator attack: quick, decay: long 89: 90: CALL WriteReg(&H80, &HF0) ' Modulator sustain: medium, release: medium 91: CALL WriteReg(&HA0, freq%) 92: 93: 94: CALL WriteReg(&H23, &HF) ' Set carrier's multiple to 0 95: CALL WriteReg(&H43, &H0) ' Set carrier's level to 0 dB 96: CALL WriteReg(&H63, &HF0) ' Carrier attack: quick, decay: long 97: 98: CALL WriteReg(&H83, &HFF) ' Carrier sustain: quick, release: quick 99: CALL WriteReg(&HB0, &H20) ' Octave 100: 101: CALL WriteReg(&HE0, &H0) ' Waveform argument for Tom.. 102: ' &H00 is the default, but I felt like 103: ' dropping it in for you.. :) 104: 105: ' I originally had an extra argument, duration!, but for some reason 106: ' I wanted to do the timing outside of this sub.. You can change it back 107: ' if needs require.. 108: 109: 'TimeUp! = TIMER + duation! 110: 'WHILE TimeUp! > TIMER: WEND ' Worst you can be off is .182 of a second 111: 112: END SUB 113: 114: SUB WriteReg (Reg%, Value%) 115: 'Purpose: Writes to any of the SB/AdLib's registers 116: 'Variables: Reg%: Register number, 117: 'Value%: Value to insert in register 118: '(Note: The registers are from 00-F5 (hex)) 119: OUT &H388, Reg% '388h = address/status port, 389h = dataport 120: FOR x = 0 TO 5 'This tells the SB what register we want to write to 121: a = INP(&H388) 'After we write to the address port we must wait 3.3ms 122: NEXT x 123: OUT &H389, Value% 'Send the value for the register to 389h 124: FOR x = 0 TO 34 'Here we must also wait, this time 23ms 125: a = INP(&H388) 126: NEXT x 127: END SUB 128: |