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: CLS 35: lors: 36: INPUT "Do you want [L]arge and blocky or [S]mall and detailed"; a$ 37: a$ = UCASE$(a$) 38: SELECT CASE a$ 39: CASE "L" 40: scrn% = 13 41: CASE "S" 42: scrn% = 12 43: CASE IS <> "L", "S" 44: BEEP 45: PRINT "Please pick `L` or `S`" 46: GOTO lors 47: END SELECT 48: INPUT "Enter filename (including drive, path, & extension if necessary):", file$ 49: SCREEN scrn% 50: CLS 51: OPEN file$ FOR BINARY AS #1 52: GET #1, 1, d% 53: u = 1 54: DO 55: IF j = 2 THEN u = u + .05: j = 0 56: j = j + 1 57: GET #1, , d% 58: d% = d% / 1000 59: SBPlay d% * 10 60: IF u > 320 THEN SLEEP: CLS : u = 1 61: IF d% < 0 THEN d% = d% * -1: d% = 67 - d% 62: IF d% > 0 THEN d% = 67 + d% 63: LINE (u, 97)-(u, d%), 2 64: 'PSET (u, d%), 2 65: b = b + 1 66: IF b > 256 THEN b = 1 67: LOOP UNTIL EOF(1) 68: CALL WriteReg(&HB0, &H0) 'Makes sure no extra sound is left playing 69: 70: DEFINT A-Z 71: FUNCTION DetectCard% 72: ' Purpose: Detects an AdLib-compatible card. 73: ' Returns -1 (true) if detected and 0 (false) if not. 74: ' Variables: Nope 75: 76: CALL WriteReg(&H4, &H60) 77: CALL WriteReg(&H4, &H80) 78: b = INP(&H388) 79: CALL WriteReg(&H2, &HFF) 80: CALL WriteReg(&H4, &H21) 81: FOR x = 0 TO 130 82: a = INP(&H388) 83: NEXT x 84: c = INP(&H388) 85: CALL WriteReg(&H4, &H60) 86: CALL WriteReg(&H4, &H80) 87: Success = 0 88: IF (b AND &HE0) = &H0 THEN 89: IF (c AND &HE0) = &HC0 THEN 90: Success = -1 91: END IF 92: END IF 93: DetectCard% = Success 94: END FUNCTION 95: 96: SUB SBInit 97: ' Initialize the sound card 98: 99: '(This is the "quick-and-dirty" method; what it's doing is zeroing out 100: 101: ' all of the card's registers. I haven't had any problems with this.) 102: FOR q = 1 TO &HF5 103: CALL WriteReg(q, 0) 104: NEXT q 105: END SUB 106: 107: SUB SBPlay (freq%) 108: ' Purpose: Plays a note 109: ' Variables: freq% - Frequency (00-FF hex) 110: ' duration% - Duration (n seconds) (not used) 111: ' I'm still working on this part, it may be ugly, but it works <g>. 112: ' The first group of WriteRegs is the modulator, the second is the 113: ' carrier. 114: ' If you just want to know how to create your own instrument, play around 115: ' with the second values in the first four calls to WriteReg in each group. 116: ' :-) Have fun! - Brett 117: 118: CALL WriteReg(&H20, &H7) ' Set modulator's multiple to F 119: CALL WriteReg(&H40, &HF) ' Set modulator's level to 40 dB 120: CALL WriteReg(&H60, &HF0) ' Modulator attack: quick, decay: long 121: 122: CALL WriteReg(&H80, &HF0) ' Modulator sustain: medium, release: medium 123: CALL WriteReg(&HA0, freq%) 124: 125: 126: CALL WriteReg(&H23, &HF) ' Set carrier's multiple to 0 127: CALL WriteReg(&H43, &H0) ' Set carrier's level to 0 dB 128: CALL WriteReg(&H63, &HF0) ' Carrier attack: quick, decay: long 129: 130: CALL WriteReg(&H83, &HFF) ' Carrier sustain: quick, release: quick 131: CALL WriteReg(&HB0, &H20) ' Octave 132: 133: CALL WriteReg(&HE0, &H0) ' Waveform argument for Tom.. 134: ' &H00 is the default, but I felt like 135: ' dropping it in for you.. :) 136: 137: ' I originally had an extra argument, duration!, but for some reason 138: ' I wanted to do the timing outside of this sub.. You can change it back 139: ' if needs require.. 140: 141: 'TimeUp! = TIMER + duation! 142: 'WHILE TimeUp! > TIMER: WEND ' Worst you can be off is .182 of a second 143: 144: END SUB 145: 146: SUB WriteReg (Reg%, Value%) 147: 'Purpose: Writes to any of the SB/AdLib's registers 148: 'Variables: Reg%: Register number, 149: 'Value%: Value to insert in register 150: '(Note: The registers are from 00-F5 (hex)) 151: OUT &H388, Reg% '388h = address/status port, 389h = dataport 152: FOR x = 0 TO 5 'This tells the SB what register we want to write to 153: a = INP(&H388) 'After we write to the address port we must wait 3.3ms 154: NEXT x 155: OUT &H389, Value% 'Send the value for the register to 389h 156: FOR x = 0 TO 34 'Here we must also wait, this time 23ms 157: a = INP(&H388) 158: NEXT x 159: END SUB 160: |