[Qbasic] Soundkaart aansturen, hoe?

[Engineer]

.

[ Voor 100% gewijzigd door Engineer op 13-10-2018 17:42 ]

[Verwijderd]

http://www.phys.uu.nl/~bergmann/soundblaster.html
http://lithium.zext.net/ds4qb++/
http://www.google.com

[Osiris]

Huh? Wat moet jij met QBasic???

[Verwijderd]

Hdd heeft z'n wijdepijpenbroek aangetrokken, wat lounge aangezet en gaat heerlijk retro QB coden?

[Osiris]

Was vroeger wel gaaf btw, QBasic. Nog gedaan op m'n MSX I...

_{Maar nu ga ik Hackers verder kijken...}

[Koen_R]

Dit vond ik in de oude doos, de PLAY functie, maar dan via je Adlib Compatible soundcard.

Have Fun

code:

DefInt A-Z
DECLARE FUNCTION DetectCard% ()
DECLARE SUB SBInit ()
DECLARE SUB WriteReg (Reg%, Value%)
DECLARE SUB SBPlay (note%)
                                        
CONST false = 0, true = NOT false
                                        
Screen 0: Cls
                                        
If DetectCard = True Then
  Print "AdLib-compatible sound card detected."
Else
  Print "Unable to find/detect sound card."
  Beep
  System
End If
Print " Initalizing...";
                                        
SBInit
                                        
Print " Done."
                                        
For nt = 0 To 255
SBPlay nt
Next nt
                                        
Print
Print "  These routines only support one channel/voice of the FM chip, but"
Print "eventually I may fix them so you can have a bunch o'instruments on"
Print "at once.  I'd also like to write a replacement for SBFMDRV.COM, but"
Print "that's far off, and probably not in QB anyway.  This is too fast"
Print "compiled, so if you are going to use it in anything, add a delay."
Print "                     Enjoy!     -Brett 11 / 12 / 92"
Print
                                        
For nt = 255 To 0 Step -1
SBPlay nt
Next nt
 
Print "[Press any key to end]"
SLEEP
                                        
Call WriteReg(&HB0, &H0) 'Makes sure no extra sound is left playing


Function DetectCard%()
                                        
'  Purpose:   Detects an AdLib-compatible card.
'        Returns -1 (true) if detected and 0 (false) if not.
'  Variables: Nope
                                        
Call WriteReg(&H4, &H60)
Call WriteReg(&H4, &H80)
B = INP(&H388)
Call WriteReg(&H2, &HFF)
Call WriteReg(&H4, &H21)
  For x = 0 To 130
    a = INP(&H388)
  Next x
C = INP(&H388)
Call WriteReg(&H4, &H60)
Call WriteReg(&H4, &H80)
Success = 0
If (B And &HE0) = &H0 Then
  If (C And &HE0) = &HC0 Then
    Success = -1
  End If
End If
DetectCard% = Success
End Function

Sub SBInit()
'  Initialize the sound card
                                        
'(This is the "quick-and-dirty" method; what it's doing is zeroing out

'  all of the card's registers.  I haven't had any problems with this.)


                                        
For q = 1 To &HF5
  Call WriteReg(q, 0)
Next q
                                        
End Sub

Sub SBPlay(freq%)
'  Purpose: Plays a note
'  Variables:    freq% - Frequency (00-FF hex)
'           duration% - Duration (n seconds) (not used)
'  I'm still working on this part, it may be ugly, but it works <g>.

'  The first group of WriteRegs is the modulator, the second is the

'  carrier.
'  If you just want to know how to create your own instrument, play around

'  with the second values in the first four calls to WriteReg in each group.

'  :-)  Have fun!  - Brett
                                        
Call WriteReg(&H20, &H7)    ' Set modulator's multiple to F
Call WriteReg(&H40, &HF)    ' Set modulator's level to 40 dB
Call WriteReg(&H60, &HF0)   ' Modulator attack: quick, decay: long

Call WriteReg(&H80, &HF0)   ' Modulator sustain: medium, release: medium
Call WriteReg(&HA0, freq%)
                                        
                                        
Call WriteReg(&H23, &HF)   ' Set carrier's multiple to 0
Call WriteReg(&H43, &H0)   ' Set carrier's level to 0 dB
Call WriteReg(&H63, &HF0)  ' Carrier attack: quick, decay: long

Call WriteReg(&H83, &HFF)  ' Carrier sustain: quick, release: quick
Call WriteReg(&HB0, &H20)  ' Octave
                                        
Call WriteReg(&HE0, &H0)   ' Waveform argument for Tom..
                   ' &H00 is the default, but I felt like
                   ' dropping it in for you.. :)
                                        
' I originally had an extra argument, duration!, but for some reason
' I wanted to do the timing outside of this sub..  You can change it back

' if needs require..
                                        
'TimeUp! = TIMER + duation!
'WHILE TimeUp! > TIMER: WEND  ' Worst you can be off is .182 of a second

End Sub

Sub WriteReg(Reg%, Value%)
'  Purpose:   Writes to any of the SB/AdLib's registers
'  Variables: Reg%: Register number,
'        Value%: Value to insert in register
'         (Note: The registers are from 00-F5 (hex))
OUT &H388, Reg     '388h = address/status port, 389h = dataport
  For x = 0 To 5   ' This tells the SB what register we want to write to

 
    a = INP(&H388) ' After we write to the address port we must wait 3.3ms

  Next x
                                        
OUT &H389, Value   ' Send the value for the register to 389h
  For x = 0 To 34  ' Here we must also wait, this time 23ms
    a = INP(&H388)
  Next x
End Sub

[Verwijderd]

SUB

line input ; "Is qbasic nog steeds boeind" $a
If $a = "ja" THEN print "Jij moet naar de dokter..!"
If $a = "nee" THEN GOTO doh
If ELSE THEN PRINT "Typ ja of nee"
doh:
COLOR 25
PRINT "Ja je hebt gelijk "
END

END SUB

Debug me maar

[Koen_R]

[Verwijderd]

Haal dan die sub command weg
laat ook maar btw

[Koen_R]

code:

kneus:

INPUT "Is qbasic nog steeds boeind? ", a$
IF LCASE$(a$) = "ja" THEN
      PRINT "Jij moet naar de dokter..!"
      END
ELSEIF LCASE$(a$) = "nee" THEN
      GOTO doh
ELSE
      PRINT "Typ ja of nee"
      GOTO kneus
END IF


doh:
COLOR 25
PRINT "Ja je hebt gelijk  "
END

[Verwijderd]

PRINT " Ik veronderschuldig mij nadat ik de nieuwste versie van QB heb geinstalled."

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:39 ]

[Arjan Scholl]

Op zaterdag 05 januari 2002 23:03 schreef digimortal het volgende:
SUB

line input ; "Is qbasic nog steeds boeind" $a
If $a = "ja" THEN print "Jij moet naar de dokter..!"
If $a = "nee" THEN GOTO doh
If ELSE THEN PRINT "Typ ja of nee"
doh:
COLOR 25
PRINT "Ja je hebt gelijk "
END

END SUB

Debug me maar

Ik ben wel geen guru maar na 4 fouten te hebben verbeterd (excl die SUB) doet ie het nog niet.

[Koen_R]

Op zaterdag 05 januari 2002 23:30 schreef arjanscholl het volgende:

[..]

Ik ben wel geen guru maar na 4 fouten te hebben verbeterd (excl die SUB) doet ie het nog niet.

Zie mijn hernieuwde versie in de post daar ergens onder

[Verwijderd]

Ik ben wel geen guru maar na 4 fouten te hebben verbeterd (excl die SUB) doet ie het nog niet.

Dan betekent het dus dat ik de volgende keer met een taal het vaker moet gebruiken anders word het overschreven in mijn koppie.

[markvt]

play "abcdefg"

beep

sound 800,10

zie de help voor die functies er ff op na

[Verwijderd]

Ik hoor alweer vader jakob klinken

[PipoDeClown]

Op zaterdag 05 januari 2002 23:29 schreef hdd het volgende:

[..]

[..]

Waar slaan die reacties op Ik prog vanaf m'n negende al in qbasic..

Mag ik aannemen dat je er ook een serieuze applicazie in hebt gebakken?

[Koen_R]

Op zaterdag 05 januari 2002 23:36 schreef markvt het volgende:
play "abcdefg"

beep

sound 800,10

zie de help voor die functies er ff op na

check de topictitel:

[Qbasic]Soundkaart aansturen, hoe?

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:39 ]

[markvt]

maarja pc speaker werkt op elke pc, soundkaart niet

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:37 ]

[markvt]

Op zaterdag 05 januari 2002 23:44 schreef hdd het volgende:

[..]

Aangezien het progsel toch niet veel verder dan m'n eigen pc zal komen kan het best. Uit een soundkaart kun je btw "iets" meer bass halen

k, mijn soundcard is niet SB compatible dus vandaar.

[Arjan Scholl]

offtopic:
Mijn versie
[code]CLS
INPUT "Is QBasic nog steeds boeiend? ", a$
b$ = LCASE$(a$)

DO
LOOP WHILE b$ = ""

IF b$ = "nee" THEN GOTO doh ELSE PRINT "Jij moet naar de dokter!!!": END

doh:
COLOR 25
PRINT "Ja je hebt gelijk!"

END[/code]

[Bigs]

Op zaterdag 05 januari 2002 21:05 schreef Osiris_NL het volgende:
Was vroeger wel gaaf btw, QBasic. Nog gedaan op m'n MSX I...

Das knap Volgens mij is dat er alleen voor de PC (onder DOS)

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:37 ]

[Verwijderd]

Ik word de hele tijd gescrewt met mijn ugly code
maar ja eigen schuld dikke bult en btw die mening was lelijk en nu veranderd

[Bigs]

Op zaterdag 05 januari 2002 23:52 schreef hdd het volgende:

[..]

Neej, kheb hier nog zo'n qbasic apparaat tussen het schroot liggen dat je op je tv kan aansluiten

Dat is geen QBasic.. MSX-Basic of dat TRS-80 taaltje, maar dat is behoorlijk anders hoor (moet je nog regelnummers gebruiken en ondersteunt geen functies enzo).

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:37 ]

[Verwijderd]

QuickBASIC roels!!!!!

[Mithrandir]

Op zondag 06 januari 2002 12:34 schreef Xtentic het volgende:
QuickBASIC roels!!!!!

jep.

Ik zoek een manier om de compoort aan te sturen. MAAR ik kan niets vinden wat bruikbaar is ... Voor VB6, niet voor QB

[.oisyn]

Op zondag 06 januari 2002 13:39 schreef DinoRaptor het volgende:

[..]

jep.

Ik zoek een manier om de compoort aan te sturen. MAAR ik kan niets vinden wat bruikbaar is ... Voor VB6, niet voor QB

zucht

OPEN "COM1:bla bla bla" AS #1

wel heel erg RTFM hoor

[Skinkie]

Is er nou al een nieuwe versie van QuickBasic uit? ik "doe" het soms nog met 4.5

[Verwijderd]

Op zondag 06 januari 2002 13:39 schreef DinoRaptor het volgende:

[..]

jep.

Ik zoek een manier om de compoort aan te sturen. MAAR ik kan niets vinden wat bruikbaar is ... Voor VB6, niet voor QB

compoort in de zin van modem ?

[Verwijderd]

Op zondag 06 januari 2002 14:39 schreef Skinkie het volgende:
Is er nou al een nieuwe versie van QuickBasic uit? ik "doe" het soms nog met 4.5

Nee, maar er zijn wel andere versies

Rapid-Q (voor windows/linux/hpfs programmeren in een basic taal)
PDS 7.1 (Same als QuickBASIC maar toch ietsje anders )

[Osiris]

Gewoon ff een vraagje hoor: Waarom programeer je in QBasic Hdd? Borland Pascal is ook DOS en daar kun je veel meer mee...
In Pascal kan ik namelijk wél de geluidskaart aansturen

_{Of vind je het gewoon leuk}

[Mithrandir]

Op zondag 06 januari 2002 14:33 schreef OiSyN het volgende:

[..]

zucht

OPEN "COM1:bla bla bla" AS #1

wel heel erg RTFM hoor

:o! Ik heb geen manual Wel 2 boeken over MSX-basic, maar daar stond 't niet in, en op internet kon ik er niets over vinden.

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:36 ]

[Mithrandir]

Op zondag 06 januari 2002 15:28 schreef hdd het volgende:

[..]

Qbasic kan ik zonder allemaal moeilijk gedoe met serials en daarna een uur lang laden opstarten, sim-pel

Plus het feit dat je overal in je vrije tijd ken proggen

Een uur lang laden opstarten

[edit]
Ik heb nu de volgende code om de compoort te openen, maar ik zou niet weten hoe ik het moet veranderen ofzo...

code:

' Now open COM Port as selected with a 2048-byte buffer in Tx and Rx
 SELECT CASE comport
  CASE 1
   OPEN "COM1:9600,N,8,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #1
  CASE 2
   OPEN "COM2:9600,N,8,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #1
 END SELECT

[Engineer]

.

[ Voor 99% gewijzigd door Engineer op 13-10-2018 17:35 ]

[Arjan Scholl]

Op zondag 06 januari 2002 14:39 schreef Skinkie het volgende:
Is er nou al een nieuwe versie van QuickBasic uit? ik "doe" het soms nog met 4.5

Jeps...QuickBasic Extended 7.1 © 1990

[.oisyn]

Op zondag 06 januari 2002 15:11 schreef DinoRaptor het volgende:

[..]

:o! Ik heb geen manual Wel 2 boeken over MSX-basic, maar daar stond 't niet in, en op internet kon ik er niets over vinden.

wel eens op f1 gedrukt? Daar staat het allemaal mooi in

[Mithrandir]

Op zondag 06 januari 2002 16:15 schreef OiSyN het volgende:

[..]

wel eens op f1 gedrukt? Daar staat het allemaal mooi in

Welke compiler?? Ik heb zo'n freeware-ding... Daar wordt deze functie niet beschreven.

[edit]
Heb jij ICQ eigenlijk wel aan? Add me nou ff!!

[edit2]
Gevonden! QBasic.exe heb ik ook

[.oisyn]

mij adden heeft geen zin aangezien ik een hekel heb aan QB en er al 6 jaar niet meer in heb gecode

[Mithrandir]

Op zondag 06 januari 2002 16:45 schreef OiSyN het volgende:
mij adden heeft geen zin aangezien ik een hekel heb aan QB en er al 6 jaar niet meer in heb gecode

Wat doe jij dan in dit topic

Nouja, ik heb 'm dus, maar ik snap geen bout van de baudrate ofzo. Wat is dat?
En verder staan er nog allemaal dingen als 'OPEN "COM1:300,N,8,1,CD0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #1'

[.oisyn]

dus ik mag hier niet komen als ik niet meer in qb code

verder weet ik niet hoe het allemaal werkt met seriele poorten in qb, maar als jij dingen als baudrate niet weet vraag ik me af wat jij in hemelsnaam wilt doen met de seriele poort (en wat het allemaal betekent staat in de manual, ik gaf alleen maar een tip dat je het daar kon vinden)

[Mithrandir]

Op zondag 06 januari 2002 17:01 schreef OiSyN het volgende:
dus ik mag hier niet komen als ik niet meer in qb code

verder weet ik niet hoe het allemaal werkt met seriele poorten in qb, maar als jij dingen als baudrate niet weet vraag ik me af wat jij in hemelsnaam wilt doen met de seriele poort (en wat het allemaal betekent staat in de manual, ik gaf alleen maar een tip dat je het daar kon vinden)

1. dat was een grapje.
2. Eh... laat ook maar (m'n fans aansturen, daar wil ik zelf wat voor schrijven. *iets geknipt wat er niet inhoorde*

[.oisyn]

Op zondag 06 januari 2002 17:19 schreef DinoRaptor het volgende:

[..]

1. dat was een grapje.

ah ok, een erbij had wel handig geweest misschien

2. Eh... laat ook maar (m'n fans aansturen, daar wil ik zelf wat voor schrijven. Een digitale baybus zegmaar )

staan die dingen dan niet in de specs van de baybus?

[Verwijderd]

/me heeft nog wel een source code + lib voor een HSC player onder dos... Wies geintresseerd?