MIDI in DOS

DOS specific questions.
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

MIDI in DOS

Post by Landeel »

Is it possible to port THIS to FreeBASIC?

I want to port DarkPhear back to DOS, however, the old MIDI players won't work with FreeBASIC.

I know there's Allegro, however, it will only work with the MIDI_DIGMID driver (slow), and it totally f*cks up fbgfx screen refresh timer.
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Post by Landeel »

Here's some code to play MIDI files using Allegro:

Code: Select all

dim shared as integer algmididrv
dim shared as integer algdigidrv

declare sub ALG_StartBlaster()
declare sub ALG_LoadMIDI(algmidifile as string)
declare sub ALG_PlayMIDI(loops as integer=-1)
declare sub ALG_StopMIDI()
declare sub ALG_LoadVOC(vocid as integer, algvocfile as string)
declare sub ALG_PlayVOC(vocid as integer)

sub ALG_SoundTest

'screen 13

ALG_StartBlaster
ALG_LoadMIDI(".\midi\nerves.mid")
ALG_PlayMIDI

'screen 13

cls
print
print "press any key to quit..."
print

dim as integer anim

do

	sleep 1,1
	locate 10

	anim+=1
	if anim>3 then anim=0

	select case anim
		case 1: print "\"
		case 2: print "|"
		case 3: print "/"
		case else : print "-"
	end select

loop until inkey<>""

end sub

ALG_SoundTest

end



#include once "allegro.bi"

dim shared algstarted as integer=0
dim shared algmidiplaying as integer=0
dim shared as midi ptr algmidi
dim shared as sample ptr alg_sound(16)


sub ALG_StartBlaster()

'O valor de digi_card deve ser um dos abaixo:
'DIGI_AUTODETECT	instrui o Allegro a escolher o driver de som
'DIGI_NONE	sem som digital
'DIGI_SB	auto-detecta placas do tipo Sound Blaster
'DIGI_SB10	Sound Blaster 1.0 (8 bit mono)
'DIGI_SB15	Sound Blaster 1.5 (8 bit mono)
'DIGI_SB20	Sound Blaster 2.0 (8 bit mono)
'DIGI_SBPRO	Sound Blaster Pro (8 bit stereo)
'DIGI_SB16	Sound Blaster 16 (16 bit stereo)
'DIGI_AUDIODRIVE	ESS AudioDrive
'DIGI_SOUNDSCAPE	Ensoniq Soundscape

'O valor de midi_card deve ser um dos abaixo:
'MIDI_AUTODETECT	instrui o Allegro a escolher o driver de MIDI
'MIDI_NONE	sem som MIDI
'MIDI_ADLIB	auto-detecta sintetizadores do tipo Adlib ou Sound Blaster FM
'MIDI_OPL2	sintetizador OPL2 (mono, usado em Adlib e Sound Blaster)
'MIDI_2XOPL2	sintetizador OPL2 dual (stereo, usado em Sound Blaster Pro-I)
'MIDI_OPL3	sintetizador OPL3 (stereo, usado em Sound Blaster Pro-II e acima)
'MIDI_SB_OUT	interface MIDI Sound Blaster
'MIDI_MPU	interface MIDI MPU-401
'MIDI_DIGMID	sample-based software wavetable player
'MIDI_AWE32	AWE32 (EMU8000 chip)




	if algstarted=0 then

		allegro_init()
		
		algdigidrv=DIGI_NONE
		'algdigidrv=DIGI_AUTODETECT
		'algdigidrv=DIGI_SB20 'ok
		
		'algmididrv=MIDI_NONE
		algmididrv=MIDI_AUTODETECT
		'algmididrv=MIDI_OPL2 'fail
		'algmididrv=MIDI_OPL3 'fail
		'algmididrv=MIDI_MPU 'fail
		'algmididrv=MIDI_ADLIB 'fail
		
		if InStr(lcase$(command$()), "-midi") then algmididrv=MIDI_AUTODETECT
		if InStr(lcase$(command$()), "-nosfx") then algdigidrv=DIGI_NONE
		if InStr(lcase$(command$()), "-sfxhigh") then algdigidrv=DIGI_AUTODETECT
		if InStr(lcase$(command$()), "-opl2") then algmididrv=MIDI_OPL2
		if InStr(lcase$(command$()), "-opl3") then algmididrv=MIDI_OPL3
		if InStr(lcase$(command$()), "-mpu") then algmididrv=MIDI_MPU
		if InStr(lcase$(command$()), "-digmid") then algmididrv=MIDI_DIGMID
		if InStr(lcase$(command$()), "-nosound") then algmididrv=MIDI_NONE : algdigidrv=DIGI_NONE
		if InStr(lcase$(command$()), "-nomusic") then algmididrv=MIDI_NONE
		
	
		if install_sound(algdigidrv, algmididrv, 0) then print "ERROR STARTING SOUND." : sleep : end
		
	end if
	
	algstarted=1
	
end sub


sub ALG_StopMIDI()
	if algmididrv=MIDI_NONE then exit sub
	if algmidiplaying then
		algmidiplaying=0
		stop_midi()
	end if
end sub

sub ALG_LoadMIDI(algmidifile as string)
	if algmididrv=MIDI_NONE then exit sub
	ALG_StopMIDI()
	if algmidi then	destroy_midi(algmidi)
	algmidi=load_midi(strptr(algmidifile))
end sub

sub ALG_PlayMIDI(loops as integer=-1)
	if algmididrv=MIDI_NONE then exit sub
	if algmidi then
		play_looped_midi(algmidi, 0, loops)
		algmidiplaying=1
	end if
end sub

sub ALG_LoadVOC(vocid as integer, algvocfile as string)
	if algdigidrv=DIGI_NONE then exit sub
	alg_sound(vocid)=load_wav(strptr(algvocfile))
end sub

sub ALG_PlayVOC(vocid as integer)
	if algdigidrv=DIGI_NONE then exit sub
	if alg_sound(vocid) then play_sample(alg_sound(vocid), 255, 127, 1000, 0)
end sub
It won't work with fbgfx.

Change ".\midi\nerves.mid" to any midi file you have.

Uncomment the first "SCREEN 13" and the music will freeze.

Uncomment the second "SCREEN 13" and fbgfx will lag.

Why does Allegro hate fbgfx so much?
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

Re: MIDI in DOS

Post by Mihail_B »

Landeel wrote:the old MIDI players won't work with FreeBASIC.
... this is not an answer to your problem but it might help ...

(but unfurtunatly it only works with SB/SBpro compatible sound cards ... or for SBCards with DOSDrivers ... like Yamaha ... etc ...

Study : "Play_FM()"/"WriteFM"/"WriteFM_all" for FM
(this is a app that can play WAVs in DOS, and do some FM(MID) stuff
in DOS... but you'll need to know the MID format ...)

Code: Select all

#include once "dos/dpmi.bi"
#include once "dos/go32.bi"
#include "dos/sys/movedata.bi"

type word as ushort
type dword as uinteger

type WAVEFORMATEX field=1
	wFormatTag as WORD
	nChannels as WORD
	nSamplesPerSec as DWORD
	nAvgBytesPerSec as DWORD
	nBlockAlign as WORD
	wBitsPerSample as WORD
	cbSize as WORD
end Type
type WAVEFORMAT field=1
	wFormatTag as WORD
	nChannels as WORD
	nSamplesPerSec as DWORD
	nAvgBytesPerSec as DWORD
	nBlockAlign as WORD
end Type
type PCMWAVEFORMAT field=1
	wf as WAVEFORMAT
	wBitsPerSample as WORD
end Type
Type abyte Field=1
	b(1 To &hffffff) As ubyte
End Type 
Type wit Field=1
	wvi(1 To 44100*10) As UByte
End Type
Type wit2 Field=1
	wvi(1 To 44100*600) As UByte
End Type
Type wit3 Field=1
	wvi(1 To 44100*600) As Integer
End Type
Type compact_wavehdr Field=1
	RIFF_id(1 To 4) As ubyte
	rest_of_size As UInteger
	WAVE_id(1 To 4) As UByte
	FMT_id(1 To 4) As UByte
	size_of_fmt As UInteger
	fmt As PCMWAVEFORMAT
	DATA_id(1 To 4) As UByte
	size_of_data As UInteger
End Type
type areThereany
 as ushort segment_,offset_,length_
 as areThereany ptr next_
end type
Declare FUNCTION ResetDSP() as Integer
Declare SUB WriteDSP (b as ubyte)
Declare Sub DMAPlay (Segment2 as ushort, Offset2 as ushort, Length2 as ushort)
Declare SUB DMARec (Segment2 as ushort, Offset2 as ushort, Length2 as ushort)
Declare function recwave2(a as string,func as integer, p as any ptr,bach as any ptr) as integer
Declare Sub playwave2(a As String,func As Integer,p As Any ptr)
Declare Sub init_a_compactwavehdr(c As any Ptr)
Declare sub setupDMA()

type FnIntHandler as function cdecl( byval as uinteger) as integer
declare function fb_isr_set cdecl alias "fb_isr_set"(byval irq_number as uinteger, byval pfnIntHandler as FnIntHandler, byval size as uinteger, byval stack_size as uinteger = 0) as Integer
declare function fb_isr_reset cdecl alias "fb_isr_reset"(byval irq_number as uinteger ) as integer
declare function fb_isr_get cdecl alias "fb_isr_get"(byval irq_number as uinteger ) as FnIntHandler


#Define DSP_speaker_on &hd1
#Define DSP_speaker_off &hd3
#Define DSP_set_time_constant &h40
#Define DSP_DMA_output8 &H14
#Define DSP_DMA_input8 &h24
#Define MIXER_master_volume &h22
#Define MIXER_microphone_volume &h0a

Dim shared as uinteger pgport=&h83
dim shared as uinteger AddPort = &H2
dim shared as uinteger LenPort = &H3
dim shared as uinteger ModeReg = &H49
dim shared as uinteger picporta =&h20
dim shared as uinteger picportb =&h21
dim shared as uinteger MaskReg=&HA
dim shared as uinteger ClearBytePtr=&HC
dim shared as uinteger ModeAdr=&HB
dim shared as uinteger Channel = 1
dim shared as uinteger BasePort = &H220
dim shared as uinteger irq_p = 5

dim shared as uinteger Freq = 11000
dim shared as uinteger sze = 65300

DIM SHARED WavBuffer(1 TO 1) AS STRING * 32767 'Make a 32k buffer for file.
dim shared as uinteger ocw1
'important: DONT MODIFY TEXT location of this segment
dim shared isr_data_start as byte
dim shared as arethereany ptr areany,aredone
dim shared irqint_ticks as integer
dim shared old_isr as FnIntHandler
dim shared isr_data_end as byte
private function isr_sb cdecl( byval irq_number as uinteger) as integer
    irqint_ticks += 1
    inp( baseport+&h0e)
    out PICportA,&h20
    if areany <>0 then
        dim as any ptr tt1=areany->next_
        areany->length_=0
        aredone=areany
        if tt1<>0 then
                areany=tt1
                DMAplay areany->segment_,areany->offset_,areany->length_
        else
            areany=0
        endif
    endif
    if old_isr<>0 and irq_number <> irq_p then
        function = old_isr( irq_number )
    else
        function = 0   ' FALSE = we don't want to abort ISR handling
               '         IOW: call the old ISR handler
    end if
end function
private sub isr_sb_end cdecl()
end sub
'UNTIL HERE DON'T MODIFY

SUB DMAPlay (Segment2 as ushort, Offset2 as ushort, Length2 as ushort)
  dim as ushort page
  dim as uinteger memloc
  Length2 -= 1
  MemLoc = (Segment2 shl 4) + Offset2
  asm cli
  OUT MaskReg, &H4 + Channel
  OUT ClearBytePtr, &H0
  OUT ModeAdr, ModeReg
  OUT AddPort, MemLoc AND &HFF
  OUT AddPort, (MemLoc AND &HFFFF&) shr 8'\ &H100
  'IF (MemLoc AND 65536) THEN Page = Page + 1
  'IF (MemLoc AND 131072) THEN Page = Page + 2
  'IF (MemLoc AND 262144) THEN Page = Page + 4
  'IF (MemLoc AND 524288) THEN Page = Page + 8
  'print "page=";page;" as ";(memloc \ 65536);" ..."

  page = memloc \ 65536  
  OUT PgPort, Page
  OUT LenPort, Length2 AND &HFF
  OUT LenPort, (Length2 shr 8) AND &HFF '\ &H100
  asm sti
  OUT MaskReg, Channel
  WriteDSP DSP_set_time_constant
  WriteDSP (256 - 1000000 \ Freq)
  WriteDSP DSP_DMA_output8
  WriteDSP (Length2 AND &HFF)
  WriteDSP (Length2 AND &HFFFF&) shr 8 '\ &H100)
  out (PICportB), (inp(picPortB) and (bitreset(&hff, irq_p)))  'enable SB IRQ (in PIC)
END SUB

sub setupDMA()
select case Channel
 case 0
  AddPort=0
  LenPort=1
  PgPort=&h87
  MaskReg=&HA
  ClearBytePtr=&HC
  ModeAdr=&HB
  PICportA=&h20
  PICportB=&h21
 case 1
  AddPort=2
  LenPort=3
  PgPort=&h83
  MaskReg=&HA
  ClearBytePtr=&HC
  ModeAdr=&HB
  PICportA=&h20
  PICportB=&h21
 case 2
  AddPort=4
  LenPort=5
  PgPort=&h81
  MaskReg=&HA
  ClearBytePtr=&HC
  ModeAdr=&HB
  PICportA=&h20
  PICportB=&h21
 case 3
  AddPort=6
  LenPort=7
  PgPort=&h82
  MaskReg=&HA
  ClearBytePtr=&HC
  ModeAdr=&HB
  PICportA=&h20
  PICportB=&h21
 case 4
  AddPort=&hc0
  LenPort=&hc2
  PgPort=&h8f
  MaskReg=&Hd4
  ClearBytePtr=&Hd8
  ModeAdr=&Hd6
  PICportA=&ha0
  PICportB=&ha1
 case 5
  AddPort=&hc4
  LenPort=&hc6
  PgPort=&h8b
  MaskReg=&Hd4
  ClearBytePtr=&Hd8
  ModeAdr=&Hd6
  PICportA=&ha0
  PICportB=&ha1  
 case 6
  AddPort=&hc8
  LenPort=&hca
  PgPort=&h89
  MaskReg=&Hd4
  ClearBytePtr=&Hd8
  ModeAdr=&Hd6
  PICportA=&ha0
  PICportB=&ha1  
 case 7
  AddPort=&hcc
  LenPort=&hce
  PgPort=&h8A
  MaskReg=&Hd4
  ClearBytePtr=&Hd8
  ModeAdr=&Hd6
  PICportA=&ha0
  PICportB=&ha1  
end select
end sub
SUB DMARec (Segment2 as ushort, Offset2 as ushort, Length2 as ushort)
  dim as ushort page
  dim as uinteger memloc
  Length2 -= 1
  MemLoc = (Segment2 shl 4) + Offset2
  asm cli
  OUT MaskReg, &H4 + Channel
  OUT ClearBytePtr, &H0
  OUT ModeAdr, (ModeReg and &b111110111) or &b100 'write
  OUT AddPort, MemLoc AND &HFF
  OUT AddPort, (MemLoc AND &HFFFF&) shr 8'\ &H100

  page = memloc \ 65536  
  OUT PgPort, Page
  OUT LenPort, Length2 AND &HFF
  OUT LenPort, (Length2 shr 8) AND &HFF '\ &H100
  asm sti
  OUT MaskReg, Channel

  WriteDSP DSP_set_time_constant
  WriteDSP (256 - 1000000 \ Freq)
  WriteDSP DSP_DMA_input8
  WriteDSP (Length2 AND &HFF)
  WriteDSP (Length2 AND &HFFFF&) shr 8 '\ &H100)
  out PICportB, (inp(PICportB) and (bitreset(&hff, irq_p))) 'enable SB IRQ (in PIC)
END SUB

FUNCTION ResetDSP as integer
  ' Resets the DSP
  dim as integer count,junk
  OUT BasePort + 6, 1
  FOR Count = 1 TO 10
     Junk = INP(BasePort + 6)
  NEXT
  OUT BasePort + 6, 0
  FOR Count = 1 TO 10
     Junk = INP(BasePort + 6)
  NEXT
  IF (INP(BasePort + 14) AND &H80 = &H80) AND (INP(BasePort + 10) = &HAA) THEN
     function = -1
  ELSE
     function = 0
  END IF
END FUNCTION

SUB WriteDSP (b as ubyte)  ' Writes a byte to the DSP
  DO
  LOOP WHILE INP(BasePort + 12) AND &H80
  OUT BasePort + 12, b
END SUB
Sub init_a_compactwavehdr(c As any Ptr)
	Dim As compact_wavehdr Ptr cw=c
	cw->RIFF_id(1)=Asc("R")
	cw->RIFF_id(2)=Asc("I")
	cw->RIFF_id(3)=Asc("F")
	cw->RIFF_id(4)=Asc("F")
	cw->WAVE_id(1)=Asc("W")
	cw->WAVE_id(2)=Asc("A")
	cw->WAVE_id(3)=Asc("V")
	cw->WAVE_id(4)=Asc("E")
	cw->FMT_id(1)=Asc("f")
	cw->FMT_id(2)=Asc("m")
	cw->FMT_id(3)=Asc("t")
	cw->FMT_id(4)=Asc(" ")
	cw->size_of_fmt=&h10
	cw->fmt.wf.wFormatTag=1
	cw->fmt.wf.nChannels=1
	cw->fmt.wf.nSamplesPerSec=8000
	cw->fmt.wf.nAvgBytesPerSec=8000
	cw->fmt.wf.nBlockAlign=1
	cw->fmt.wBitsPerSample=8
	cw->DATA_id(1)=Asc("d")
	cw->DATA_id(2)=Asc("a")
	cw->DATA_id(3)=Asc("t")
	cw->DATA_id(4)=Asc("a")
End Sub

function recwave2(a as string,func as integer, p as any ptr,bach as any ptr) as integer
 if p=0 or func =0 then exit function
 Dim As compact_wavehdr cv
 dim as uinteger fr2,wa,dd,rr,k,f
 Dim As wit2 Ptr t1
 init_a_compactwavehdr @cv
 If Dir(a)<>"" Then
	Print "existing filename [";a;"]"
	Exit function
 End If
 f=freefile
 open a for binary as #f
 fr2=freq
 rr=0
 cv.fmt.wf.nSamplesPerSec=8000
 cv.fmt.wf.nChannels=1
 cv.fmt.wBitsPerSample=8
 cv.fmt.wf.wFormatTag = 1
 wa=cv.fmt.wf.nSamplesPerSec*cv.fmt.wf.nChannels*cv.fmt.wBitsPerSample\8 
 cv.fmt.wf.nAvgBytesPerSec=wa
 cv.fmt.wf.nBlockAlign=1
 if bach<> 0 then
         t1=bach
 else
        t1=allocate(func)
 end if
 dd=wa
 while rr+wa<=func
 DMARec cast(ushort,cast(uinteger,p) shr 4), 0,cast(ushort,dd)
 k=0
 while k<>&hffff
        sleep 250
        k=inp(LenPort)
        k+=(inp(LenPort) shl 8)
        locate ,10: print hex(k);"   ";
 wend
 k=inp(baseport+&h0e)
 dosmemget p, cast(ushort, dd), @t1->wvi(rr+1)
 rr+=dd
 if inkey=chr(27) then exit while
 wend
 cv.rest_of_size=rr+cv.size_of_fmt
 cv.size_of_data=rr
 put #f,1,cv
 put #f,len(compact_wavehdr)+1,t1->wvi(1),rr
 close #f
 freq=fr2
 if bach=0 then deallocate t1
 function=rr
end function

'--------------------------------------------------------------------
Sub playwave2(a As String,func As Integer,p As Any ptr)
 If func=0 Then exit sub
 If Dir(a)="" Then
	Print "bad filename !",a
	Exit Sub
 EndIf

 Dim As Integer k,i,j,jj,rr,dd,fr2,shft
 dim as double delen
 Dim As String c,keyb,dita="data"
 Dim As compact_wavehdr cv
 Dim As wit2 Ptr t1,fs,amp
 Dim As Integer nodita=0,adit,r
 Dim As UByte uin
 k = FreeFile
 Open a For Binary As #k
 Get #k,1,cv
 i=Lof(k)
 t1=Allocate(i)
 'fs=Allocate(1+i\2)
 'amp=Allocate(1+i\2)
 For j=1 To 4
 If dita[j-1]<>cv.DATA_id(j) Then nodita=1
 Next j
 adit=0:r=0
 If nodita=1 Then
 	Do
 	Get #k,,uin
 	r+=1
 	tr1:
  	If uin=dita[adit] Then
		adit+=1
 	ElseIf adit>0 Then
 		adit=0
 		GoTo tr1
 	EndIf
 	Loop Until (adit=4) Or (Eof(k))
 	If adit=4 Then
 		Get #k,,cv.size_of_data
 		r+=4
 	EndIf
 EndIf
 jj=i-SizeOf(compact_wavehdr)-r
 Get #k,,t1->wvi(1),jj
 Close #k
 Dim As Integer WsampleRate = cv.fmt.wf.nSamplesPerSec*cv.fmt.wf.nChannels*cv.fmt.wBitsPerSample\8
 print "[SampleRate:";cv.fmt.wf.nSamplesPerSec;"][Channels:";cv.fmt.wf.nChannels;"][Bits:";cv.fmt.wBitsPerSample;"][Duration:";jj\wsamplerate;"sec][Size:";jj;"]"
 fr2=freq
 freq=cv.fmt.wf.nSamplesPerSec
 '(i-SizeOf(compact_wavehdr)-r),
 delen=func/(2*WsampleRate)
 rr=jj 'jj holds length of BUFFER
 j=0
 shft=0
 areany=allocate(len(arethereany))
 aredone=areany
 print "Buffer S:";
 while rr>0
   dd=rr
   IF dd > WsampleRate*delen THEN dd= WsampleRate*delen 'Adjust length if needed to 32k
   if j=0 then
        dosmemput @t1->wvi(jj-rr+1),cast(ushort, dd), cptr(ubyte ptr,p)+shft
        areany->segment_=cast(ushort,(cast(uinteger,p)+shft) shr 4)
        areany->offset_=0
        areany->length_=cast(ushort,dd)
        areany->next_=0
        DMAPlay areany->segment_, areany->offset_,areany->length_
   endif
   'locate ,20:print "dmapl for =";shft;" as ";func;"    ";
   k=0
   j=0
   i=0
   rr-=dd
    while k<>&hffff
        if i=0 then
          i=1
           if rr>0 then
            dd=rr
            IF dd > WsampleRate*delen THEN dd= WsampleRate*delen 'Adjust length if needed to 32k
            if shft=0 then shft=dd else shft =0
            dosmemput @t1->wvi(jj-rr+1),cast(ushort, dd), cptr(ubyte ptr,p)+shft            
            areany->next_=allocate(len(areThereany))
            areany->next_->segment_=cast(ushort,(cast(uinteger,p)+shft) shr 4)
            areany->next_->offset_=0
            areany->next_->length_=cast(ushort,dd)
            areany->next_->next_=0
            j=1
           end if
         else
          sleep 500*delen
         endif
         k=inp(LenPort)
         k+=(inp(LenPort) shl 8)
         locate ,12: print (jj-rr+1)\WsampleRate;" [";hex(k);"]   ";
         if aredone->length_=0 then
                deallocate aredone
                exit while
         endif
   wend
   k=inp(baseport+&h0e)
   keyb=inkey
   if keyb<>"" then
           select case keyb
                case chr(27)
                 exit while
                case "+"
                      OUT BasePort + 4, &H22
                      k=inp( BasePort + 5)
                      k=(((k and &h0f)+1) and &h0f)
                      if k=0 then k=&hff else k=(k+(k shl 4)) or (&b10001)
                      OUT BasePort + 4, &H22                      
                      OUT BasePort + 5, k
                case "-"
                      OUT BasePort + 4, &H22
                      k=inp( BasePort + 5)
                      k=(((k and &h0f)-1) and &h0f)
                      if k<=1 then k=&h11 else k=k+(k shl 4) or (&b10001)
                      OUT BasePort + 4, &H22                      
                      OUT BasePort + 5, k
           end select
   endif
 wend
 if j=1 then
         while areany<>0:sleep 333: wend
         deallocate aredone
         k=inp(baseport+&h0e)
 endif
 pex:
 freq=fr2
 DeAllocate t1

End Sub
sub writefm(reg as ubyte, value as ubyte)
 dim as ushort FMp,FMv,i
 FMp=&h388
 FMv=&h389
 out FMp,reg
 for i=1 to 6: inp(FMp):next i
 out FMv,value
 for i=1 to 35: inp(FMv):next i
end sub
sub writefm_all(index as ubyte,freq as ubyte, totallevel as ubyte,attackdecay as ubyte,sustainrelease as ubyte,_
                octave as ubyte,voiceon as ubyte)
 writefm &h20+index, freq
 writefm &h40+index, totallevel
 writefm &h60+index, attackdecay
 writefm &h80+index, sustainrelease
 writefm &ha0, octave
 writefm &hb0, voiceon
end sub
sub play_FM()
dim as uinteger i,k,j
dim as ushort FMp,FMv
FMp=&h388
FMv=&h389
for i=1 to &hf5
        writefm(i,0)
next i
' Note that if you wish to use different waveforms, you must then
' turn on bit 5 of register 1.  (This reset need be done only once, at the
asm cli
writefm(1,&b100000)

'      REGISTER     VALUE     DESCRIPTION
writefm &h20, &h01'20          01      Set the modulator's multiple to 1
writefm &h40, &h10'40          10      Set the modulator's level to about 40 dB
writefm &h60, &hF0'60          F0      Modulator attack:  quick;   decay:   long
writefm &h80, &h77'80          77      Modulator sustain: medium;  release: medium
writefm &ha0, &h98'A0          98      Set voice frequency's LSB (it'll be a D#)
writefm &h23, &h01'23          01      Set the carrier's multiple to 1
writefm &h43, &h00'43          00      Set the carrier to maximum volume (about 47 dB)
writefm &h63, &hf0'63          F0      Carrier attack:  quick;   decay:   long
writefm &h83, &h77'83          77      Carrier sustain: medium;  release: medium
writefm &hb0, &h31'B0          31      Turn the voice on; set the octave and freq MSB
sleep 10
writefm &h20, &h01'20          01      Set the modulator's multiple to 1
writefm &h40, &h10'40          10      Set the modulator's level to about 40 dB
writefm &h60, &hF0'60          F0      Modulator attack:  quick;   decay:   long
writefm &h80, &h77'80          77      Modulator sustain: medium;  release: medium
writefm &ha0, &h28'A0          98      Set voice frequency's LSB (it'll be a D#)
writefm &hb0, &h31'B0          31      Turn the voice on; set the octave and freq MSB
sleep 10

for i=1 to &h3ff step 50
writefm_all (0,&h01,&h10,&hf0,&h77,i,&h30 or (i shr 8)):sleep 80
'writefm_all (1,&h01,&h10,&hf0,&h77,&h81,&h31):sleep 14
next i
'writefm_all (1,&h01,&h10,&hf0,&h77,20,&h31):sleep 100
'writefm_all (2,&h01,&h10,&hf0,&h77,90,&h31):sleep 100
writefm &hb0, &h11
asm sti
end sub

'====================================================================
'main
dim as string rtf
dim as ubyte ptr wbp
dim as string file1
dim as integer f,length2
dim as uinteger sel1_,sel2_
dim as any ptr wb


setupDMA () 'important !

irq_p=5

if _go32_dpmi_lock_data( @isr_data_start, @isr_data_end - @isr_data_start )<>0 then
    print "Failed to lock data"
    end 1
end if

sze=32768
f=__dpmi_allocate_dos_memory(sze,@sel1_)
'print f,hex(sel1_)
f=__dpmi_resize_dos_memory(sel1_,sze, @sel2_ )
'print f,hex(sel2_)
sel1_=sel2_
f=__dpmi_resize_dos_memory(sel1_,sze, @sel2_ )
'print f,hex(sel2_)
sel1_=sel2_

sze=32000 'as a way of protecting program against overflows ...
wb=sel1_ shl 4
if wb=0 Then End
ocw1=inp(PICportB)
_go32_dpmi_lock_data( @isr_data_start, @isr_data_end - @isr_data_start )
old_isr = fb_isr_get( irq_p )
dim as byte ptr ptr_end = cast( byte ptr, @isr_sb_end )
dim as byte ptr ptr_start = cast( byte ptr, @isr_sb )
If 0 = fb_isr_set( irq_p, @isr_sb, ptr_end - ptr_start, 16384 ) then
    print "Failed to lock ISR"
    end 1
end if
print "PlayWave Ver. 1 Gnupyright (G) 1996-2010, AlphaX (R) Corp"
PRINT "Programmed by : Mihai Barboi[Ro,Eu], based on:"
PRINT "PlayWav A utility for Playing WAV files Version 1.03"
PRINT "Forever Young Software(r) (C)opyright 1984-2002"

if command(1)="/testfm" then play_FM() '<<<<<<<<<<<<<<<<<<<<<<<< test FM

IF ResetDSP() THEN 'resets DSP (returns true if sucessful)
   PRINT "DSP reset."
   print "Note: if program can not find a continuous 32K block-64k aligned- in conventional memory it will crash !"
ELSE
   PRINT "DSP failed to reset, try another port."
   end 1
END IF

WriteDSP DSP_speaker_on  'turn the speaker on
OUT BasePort + 4, MIXER_master_volume    ' set MASTER volume
OUT BasePort + 5, &HDD    ' Left = HI Nibble, Right = LO nibble (0FF is max)
inp( BasePort + 5)
OUT BasePort + 4, MIXER_microphone_volume    ' set MIC volume
OUT BasePort + 5, &b00010111    ' Left = HI Nibble, Right = LO nibble (0FF is max)
if command(1)<>"" and dir(command(1))<>"" then goto loadTHefile
File1 = "prop.wav"
f=freefile
OPEN File1 FOR BINARY AS #f
  GET #f, 44, WavBuffer(1) 'Get 32k from file (skip header on WAV)
  Length2 = LOF(1) - 44
  IF Length2 > 32767 THEN Length2 = 32767 'Adjust length if needed to 32k
  dosmemput @wavbuffer(1),length2, wb
  DMAPlay cast(ushort,cast(uinteger,wb) shr 4), 0,cast(ushort,length2)  'gdsi.rm_segment, gdsi.rm_offset, Length2
CLOSE #f
f=0
while f<>&hffff
f=inp(LenPort)
f=f+(inp(LenPort) shl 8)
locate ,10: print hex(f);"   ";
sleep 500
wend
print
'input "waiting ...",f

f=inp( baseport+&h0e)
loadTHefile:
if command(1)<>"" then
        print "Play wave file:";command(1)
        playwave2 command(1),sze,wb
        f=inp( baseport+&h0e)
endif
print
'print "am-furt-un-at-lee sb recording doesn't work for some new cards ..."
goto skiprec11
line input "record to file:",rtf
if rtf<>"" then
 input "max file size:",f
 print "recoreded bytes=";recwave2(rtf,f,wb,0)
end if
skiprec11:
print "did=";irqint_ticks;" =";bin(inp(PICportB));" ->";
out picportb,ocw1
fb_isr_reset( irq_p )
__dpmi_free_dos_memory(sel1_)
print bin(inp(picportb))

writedsp DSP_speaker_off
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Post by Landeel »

Hey, this is something!

I was trying to port my old DMA play to FreeBASIC. I could initialize the card, but it wouldn't play anything.

I ended up using Allegro to play wavs. It works because it won't mess up with the timer.

I think implementing a mid player from scratch is not the solution, specially without threads...

I would need something to work with the SBMIDI.EXE tsr.

Thank you.
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

Post by Mihail_B »

...
well ... i've tried ...

anyway maybe someone else needs this kind of info ...
but probably dos will get .... to old ... soon ... and it will probably be
kept alive [only] by old guys like us ...
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Post by Landeel »

DOS will be kept alive by old guys like us and by DOSBOX. :)

I can't help it, I just love SCREEN 13 and my Sound Blaster 16 ISA. :)
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Post by maddogg6 »

Landeel wrote:DOS will be kept alive by old guys like us and by DOSBOX.
Perhaps... but I bet my dollars to your doughnuts that; it wont be solely for doing MIDI.

My keyboard became liberated when I got a windows compatable pcm based synth built into my sound card...

I DO NOT miss those DOS days... you can keep your 'extended' v 'expanded' memory crap ;)

'MIDI ports' are simply Serial IO ports (UARTS IIRC and if that means anything to you) with a 20ma current loop driver.

Depending on the sound card, it may be that is just another midi port, and has hardware synth connected to it - or its a software synth and a system driver to run it either way, I am confident the software to drive it will be drastically different.


edit:
to quell a popular misconception... SB Live sound cards DO NOT have a 'hardware synth' - but has 2 'hardware accelerated software synths'.

So, SBLive cards are probably not gonna be accessible without a proper dos driver... but I have to beleive the AWE cards were closer to a hardware synth - with the anemic PCs of the era.

edit2:
for certain, DB50XG expansion boards for AWE32 cards - were a 'daughter board' that I connected as an external midi device to the physical MIDI port on my SBLive - which is confirmation that even on the awe at least on 'on board synth' is simply a midi port with a hardware synth connected.


- but then again, I got an 'SB32' card once and it had a yamaha software synth with a system driver to drive it. An example of a case where the missing driver means death for that card.

I had another sound card, I forget who made it, but it was first to have PCM synth before or way cheaper than AWE32 it had basically the same dos driver configuration. This was a SB16 'Clone' (16 bit wave audio - with FM synth replaced by a PCM sample based synth but it was 16 note polyphony and its samples were even worse than the awe's)
Last edited by maddogg6 on Nov 06, 2011 0:06, edited 1 time in total.
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Post by Landeel »

DOS is extremely simple, fast, and gives you total control over your hardware.
Well, something I don't miss is the memory managers.
But still, I miss DOS much more than I miss Windows (using Linux).
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Post by maddogg6 »

Landeel wrote:DOS is extremely simple, fast, and gives you total control over your hardware.
Well, something I don't miss is the memory managers.
But still, I miss DOS much more than I miss Windows (using Linux).
Oh sure.... Id endure linux before dos tho for MIDI stuff ;)

I do try to offer info and not just snark.


Oh QEMM was the stuff for my memory manager.... but I did have to be pretty nerd about it tho. constantly tweaking, making menus to load or not load drivers depending on what my purpose for the computer was... lol
rugxulo
Posts: 219
Joined: Jun 30, 2006 5:31
Location: Usono (aka, USA)
Contact:

Post by rugxulo »

You could try MUS Lib (e.g. used in CDoom), but it's not directly MIDI, though a converter exists. (There's also old XM to MIDI or vice versa somewhere, can't remember.) There are also a few other DOS .MID players, but they vary in quality, output (PC speaker or SB), sources, methods, etc. (And I'm far from a MIDI pro, not even close.)

FYI, the Hammer of Thyrion dudes are trying to backport MIDI support to the DJGPP port (via Allegro), if anybody here wants to help them. I'm not very familiar with Allegro, so I can't help.
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Post by marcov »

Classically, afaik the Gravis Ultrasound cards were demomaker's favorites?
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Post by maddogg6 »

marcov wrote:Classically, afaik the Gravis Ultrasound cards were demomaker's favorites?
OMG... 'GUS' I forgot about them 'clones'...lol

This is my take;
demos mostly used mod trackers that needed only 8 bit (eventually 16 bit?) audio playback.

I want to say it was like the awe32 in that you could load banks af audio samples - which freed up dos memory that mod tracker pcm samples needed.

Which allowed for a more complex composition (or more CPU for graphics).

Yes it was a fav for many, and for some time too.
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Post by marcov »

maddogg6 wrote:
marcov wrote:Classically, afaik the Gravis Ultrasound cards were demomaker's favorites?
OMG... 'GUS' I forgot about them 'clones'...lol
The GUS were not clones afaik. They were internally different, and the first cards that focussed really on wavetable sound, while older SBs focussed on their OPL(3) syntheziser chips.

They had a SB emulation driver, but that was not very good.
This is my take;
demos mostly used mod trackers that needed only 8 bit (eventually 16 bit?) audio playback.
The GUS was the first that afaik did this in hardware. MODs could play nearly entirely in hardware. (32 voices iirc)
I want to say it was like the awe32 in that you could load banks af audio samples - which freed up dos memory that mod tracker pcm samples needed.
I don't know how if they have decent dos drivers, but currently people are dropping their Audigy2 cards like dirt (I've seen prices for 2ZS as long as Eur 12,50). Probably because they migrate to PCIex, but most mid range mainboards still have PCI slots so IMHO that is a bit premature.
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Post by maddogg6 »

marcov wrote:The GUS were not clones afaik. They were internally different, and the first cards that focussed really on wavetable sound, while older SBs focussed on their OPL(3) syntheziser chips.
lol - I am dating myself.... when the GUS first came out was called a 'SB clone' in that it did 'audio' like SB's did - but no, very different hardware.

the older sb's using the opl3 chips...lol - that was new tech thank you.

That 'NEW' opl3 chip is what convinced me to abandon my C-64 and SID.

The AWE32 was from a completely different company than SB now.

They actually cared back then, the drivers were constantly 'upgraded' - not boated like they did with liveware AND the upgrades were impressive and welcomed surprises.... compared to now... pff.

For SBLive and Audigy users, use KX Project drivers.... if you like to fiddle with DSP stuff - you can even write your own dps effects with it no compiler required.

I can NOT recommend them enough.

Edit;

'SB clone' just meant it had wave playback hardware and was simply a parrallel port connected 8 bit DAC.
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Post by marcov »

maddogg6 wrote:'SB clone' just meant it had wave playback hardware and was simply a parrallel port connected 8 bit DAC.
That's Covox Speech thing iirc. I'm no -classic expert, but afaik it had multiple modes and higher sampling rates (11025 vs 8000 for CVST?)

But GUS competed more against sbpro and even 16, afaik never competed to the classic sb.
Post Reply