Last active
May 9, 2020 01:43
-
-
Save FreeFull/e21b937db0d07fe71d57adbcaa665d8c to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| program miditest; | |
| {$mode ObjFPC} | |
| uses go32, strutils, sysutils; | |
| type | |
| BlasterConfig = Record | |
| IoPort, Irq, LowDma, HighDma, MixerPort, MpuPort: Word; | |
| end; | |
| var | |
| Blaster: BlasterConfig = ( | |
| IoPort: $220; | |
| Irq: 5; | |
| LowDma: 1; | |
| HighDma: 5; | |
| MixerPort: $220; | |
| MpuPort: $330); | |
| Note, Velocity: Byte; | |
| procedure WriteDsp(Data: Byte); inline; | |
| var | |
| Status: Byte; | |
| begin | |
| // Wait for the DSP to become ready. | |
| repeat | |
| Status := inportb(Blaster.IoPort + $C); | |
| until (Status and $80) = 0; | |
| outportb(Blaster.IoPort + $C, data); | |
| end; | |
| function ReadDsp : Byte; inline; | |
| var | |
| Status: Byte; | |
| begin | |
| // Wait for the DSP to become ready. | |
| repeat | |
| Status := inportb(Blaster.IoPort + $E); | |
| until (Status and $80) = $80; | |
| ReadDsp := inportb(Blaster.IoPort + $A); | |
| end; | |
| procedure WriteMixer(Reg: Byte; Data: Byte); | |
| begin | |
| outportb(Blaster.IoPort + 4, Reg); | |
| outportb(Blaster.IoPort + 5, Data); | |
| end; | |
| procedure InitBlaster; | |
| var | |
| BlasterEnv: AnsiString; | |
| Elem: AnsiString; | |
| Value: Word; | |
| I: Word; | |
| ResetOk: Boolean = False; | |
| begin | |
| BlasterEnv := GetEnvironmentVariable('BLASTER'); | |
| for Elem in BlasterEnv.Split(' ') do | |
| begin | |
| if Length(Elem) = 0 then continue; | |
| Value := Hex2Dec(Copy(Elem, 2, Length(Elem))); | |
| case Elem[1] of | |
| 'A': begin | |
| Blaster.IoPort := Value; | |
| Blaster.MixerPort := Value; | |
| end; | |
| 'I': Blaster.Irq := Value; | |
| 'D': Blaster.LowDma := Value; | |
| 'H': Blaster.HighDma := Value; | |
| 'M': Blaster.MixerPort := Value; | |
| 'P': Blaster.MpuPort := Value; | |
| end; | |
| end; | |
| // Reset the DSP | |
| outportb(Blaster.IoPort + 6, 1); | |
| sleep(1); | |
| outportb(Blaster.IoPort + 6, 0); | |
| sleep(1); | |
| // Wait for the DSP to initialise itself. | |
| for I:=$FFFF downto 1 do begin | |
| Value := inportb(Blaster.IoPort + $E); | |
| // If bit 7 isn't set, there's no data ready to be read | |
| if (Value and $80) = 0 then continue; | |
| Value := inportb(Blaster.IoPort + $A); | |
| if Value = $AA then begin | |
| ResetOk := True; | |
| break; | |
| end; | |
| end; | |
| if not ResetOk then begin | |
| WriteLn('Failed to initialise the DSP.'); | |
| Halt(1); | |
| end; | |
| // Check DSP version | |
| WriteDsp($E1); | |
| Value := ReadDsp; | |
| // Discard minor version number | |
| ReadDsp; | |
| if Value <> 4 then begin | |
| WriteLn('Only Sound Blaster 16 compatible cards are supported.'); | |
| Halt(2); | |
| end; | |
| // Disable interrupts using an undocumented mixer register | |
| WriteMixer($83, 0); | |
| end; | |
| function ReadMidi: Word; | |
| var | |
| Status: Byte; | |
| begin | |
| repeat | |
| Status := inportb(Blaster.MpuPort+1); | |
| until (Status and $80) = 0; | |
| ReadMidi := inportb(Blaster.MpuPort); | |
| end; | |
| procedure MpuCommand(command: Byte); | |
| var | |
| Data: Byte; | |
| I: Word; | |
| CommandOk: Boolean; | |
| begin | |
| WriteLn('Waiting for write ready.'); | |
| repeat | |
| Data := inportb(Blaster.MpuPort+1); | |
| until (Data and $40) = 0; | |
| WriteLn('Write ready.'); | |
| outportb(Blaster.MpuPort+1, command); | |
| WriteLn('Command written.'); | |
| // Wait for the command to get acknowledged. | |
| for I:=$FFFF downto 1 do begin | |
| Data := inportb(Blaster.MpuPort + $1); | |
| // If bit 7 is set, there's no data ready to be read | |
| if (Data and $80) = $80 then continue; | |
| Data := inportb(Blaster.MpuPort); | |
| if Data = $FE then begin | |
| CommandOk := True; | |
| break; | |
| end; | |
| end; | |
| if not CommandOk then begin | |
| WriteLn('MPU-401 command failed.'); | |
| Halt(3); | |
| end; | |
| end; | |
| procedure ResetMpu; inline; | |
| begin | |
| MpuCommand($FF); | |
| end; | |
| procedure UartMpu; inline; | |
| begin | |
| MpuCommand($3F); | |
| end; | |
| begin | |
| InitBlaster; | |
| WriteLn('Blaster init done.'); | |
| ResetMpu; | |
| WriteLn('MPU reset done.'); | |
| UartMpu; | |
| WriteLn('MPU UART done.'); | |
| WriteLn('Init complete'); | |
| // Main loop here | |
| while True do begin | |
| case ReadMidi of | |
| $90: // Note on | |
| begin | |
| Note := ReadMidi; | |
| Velocity := ReadMidi; | |
| Write('Note on '); | |
| Write(Note); | |
| Write(' '); | |
| if Note < 100 then Write(' '); | |
| if Note < 10 then Write(' '); | |
| WriteLn(Velocity); | |
| end; | |
| $80: // Note off | |
| begin | |
| Note := ReadMidi; | |
| Velocity := ReadMidi; | |
| Write('Note off '); | |
| Write(Note); | |
| Write(' '); | |
| if Note < 100 then Write(' '); | |
| if Note < 10 then Write(' '); | |
| WriteLn(Velocity); | |
| end; | |
| end; | |
| end; | |
| ResetMpu; | |
| InitBlaster; | |
| end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment