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: FOR nt = 0 TO 255 35: SBPlay nt 36: NEXT nt 37: PRINT 38: PRINT " These routines only support one channel/voice of the FM chip, but" 39: PRINT "eventually I may fix them so you can have a bunch o'instruments on" 40: PRINT "at once. I'd also like to write a replacement for SBFMDRV.COM, but" 41: PRINT "that's far off, and probably not in QB anyway. This is too fast" 42: PRINT "compiled, so if you are going to use it in anything, add a delay." 43: PRINT " Enjoy! -Brett 11 / 12 / 92" 44: PRINT 45: FOR nt = 255 TO 0 STEP -1 46: SBPlay nt 47: NEXT nt 48: PRINT "[Press any key to end]" 49: SLEEP 50: CALL WriteReg(&HB0, &H0) 'Makes sure no extra sound is left playing 51: 52: FUNCTION DetectCard% 53: ' Purpose: Detects an AdLib-compatible card. 54: ' Returns -1 (true) if detected and 0 (false) if not. 55: ' Variables: Nope 56: 57: CALL WriteReg(&H4, &H60) 58: CALL WriteReg(&H4, &H80) 59: b = INP(&H388) 60: CALL WriteReg(&H2, &HFF) 61: CALL WriteReg(&H4, &H21) 62: FOR x = 0 TO 130 63: a = INP(&H388) 64: NEXT x 65: c = INP(&H388) 66: CALL WriteReg(&H4, &H60) 67: CALL WriteReg(&H4, &H80) 68: Success = 0 69: IF (b AND &HE0) = &H0 THEN 70: IF (c AND &HE0) = &HC0 THEN 71: Success = -1 72: END IF 73: END IF 74: DetectCard% = Success 75: END FUNCTION 76: 77: SUB SBInit 78: ' Initialize the sound card 79: 80: '(This is the "quick-and-dirty" method; what it's doing is zeroing out 81: 82: ' all of the card's registers. I haven't had any problems with this.) 83: FOR q = 1 TO &HF5 84: CALL WriteReg(q, 0) 85: NEXT q 86: END SUB 87: 88: SUB SBPlay (freq%) 89: ' Purpose: Plays a note 90: ' Variables: freq% - Frequency (00-FF hex) 91: ' duration% - Duration (n seconds) (not used) 92: ' I'm still working on this part, it may be ugly, but it works <g>. 93: ' The first group of WriteRegs is the modulator, the second is the 94: ' carrier. 95: ' If you just want to know how to create your own instrument, play around 96: ' with the second values in the first four calls to WriteReg in each group. 97: ' :-) Have fun! - Brett 98: 99: CALL WriteReg(&H20, &H7) ' Set modulator's multiple to F 100: CALL WriteReg(&H40, &HF) ' Set modulator's level to 40 dB 101: CALL WriteReg(&H60, &HF0) ' Modulator attack: quick, decay: long 102: 103: CALL WriteReg(&H80, &HF0) ' Modulator sustain: medium, release: medium 104: CALL WriteReg(&HA0, freq%) 105: 106: 107: CALL WriteReg(&H23, &HF) ' Set carrier's multiple to 0 108: CALL WriteReg(&H43, &H0) ' Set carrier's level to 0 dB 109: CALL WriteReg(&H63, &HF0) ' Carrier attack: quick, decay: long 110: 111: CALL WriteReg(&H83, &HFF) ' Carrier sustain: quick, release: quick 112: CALL WriteReg(&HB0, &H20) ' Octave 113: 114: CALL WriteReg(&HE0, &H0) ' Waveform argument for Tom.. 115: ' &H00 is the default, but I felt like 116: ' dropping it in for you.. :) 117: 118: ' I originally had an extra argument, duration!, but for some reason 119: ' I wanted to do the timing outside of this sub.. You can change it back 120: ' if needs require.. 121: 122: 'TimeUp! = TIMER + duation! 123: 'WHILE TimeUp! > TIMER: WEND ' Worst you can be off is .182 of a second 124: 125: END SUB 126: 127: SUB WriteReg (Reg%, Value%) 128: 'Purpose: Writes to any of the SB/AdLib's registers 129: 'Variables: Reg%: Register number, 130: 'Value%: Value to insert in register 131: '(Note: The registers are from 00-F5 (hex)) 132: OUT &H388, Reg% '388h = address/status port, 389h = dataport 133: FOR x = 0 TO 5 'This tells the SB what register we want to write to 134: a = INP(&H388) 'After we write to the address port we must wait 3.3ms 135: NEXT x 136: OUT &H389, Value% 'Send the value for the register to 389h 137: FOR x = 0 TO 34 'Here we must also wait, this time 23ms 138: a = INP(&H388) 139: NEXT x 140: END SUB 141: |