[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]

    {
    BRIAN PAPE

    Ok, here's about 45 minutes of sweating, trying to read some pitifull SB
    reference.  This is about as far as I've gotten trying to make the SB
    make some noise that is actually a note, not just a buzz...  If anyone
    can do ANYTHING at ALL with this, please tell me.

    This program is not Copyright (c)1993 by Brian Pape.
    written 4/13/93
    It is 100% my code with nothing taken from anyone else.  If you can use it in
    anyway, great.  I should have the actual real version done later this summer
    that is more readable.  The .MOD player is about half done, pending the
    finishing of the code to actually play the notes (decoder is done).
    My fido address is 1:2250/26
    }
    program sb;
    uses
      crt;
    const
      on     = true;
      off    = false;
      maxreg = $F5;
      maxch  = 10;

      note_table : array [0..12] of word =
        ($000,$16b,$181,$198,$1b0,$1ca,$1e5,$202,$220,$241,$263,$287,$2ae);
      key_table  : array [1..12] of char =
        'QWERTYUIOP[]';
      voicekey_table : array [1..11] of char =
        '0123456789';
    type
      byteset = set of byte;

    var
      ch        : char;
      channel   : byte;
      ch_active : byteset;
      lastnote  : array [0..maxch] of word;

    procedure writeaddr(b : byte); assembler;
    asm
      mov  al, b
      mov  dx, 388h
      out  dx, al
      mov  cx, 6

     @wait:
      in   al, dx
      loop @wait
    end;

    procedure writedata(b : byte); assembler;
    asm
      mov  al, b
      mov  dx, 389h
      out  dx, al
      mov  cx, 35h
      dec  dx

     @wait:
      in   al, dx
      loop @wait
    end;

    procedure sb_reset;
    var
      i : byte;
    begin
      for i := 1 to maxreg do
      begin
        writeaddr(i);
        writedata(0);
      end;
    end;

    procedure sb_off;
    begin
      writeaddr($b0);
      writedata($11);
    end;

    { r=register,d=data }
    procedure sb_out(r, d : byte);
    begin
      writeaddr(r);
      writedata(d);
    end;

    procedure sb_setup;
    begin
      sb_out($20, $01);
      sb_out($40, $10);
      sb_out($60, $F0);
      sb_out($80, $77);
      sb_out($A0, $98);
      sb_out($23, $01);
      sb_out($43, $00);
      sb_out($63, $F0);
      sb_out($83, $77);
      sb_out($B0, $31);
    end;

    procedure disphelp;
    begin
      clrscr;
      writeln;
      writeln('Q:C#');
      writeln('W:D');
      writeln('E:D#');
      writeln('R:E');
      writeln('T:F');
      writeln('Y:F#');
      writeln('U:G');
      writeln('I:G#');
      writeln('O:A');
      writeln('P:A#');
      writeln('[:B');
      writeln(']:C');
      writeln('X:Quit');
      writeln;
    end;

    procedure sb_note(channel : byte; note : word; on : boolean);
    begin
      sb_out($a0 + channel, lo(note));
      sb_out($b0 + channel, ($20 * byte(on)) or $10 or hi(note));
    end;

    procedure updatestatus;
    var
      i : byte;
    begin
      gotoxy(1,16);
      for i := 0 to maxch do
      begin
        if i in ch_active then
          textcolor(14)
        else
          textcolor(7);
        write(i : 3);
      end;
    end;

    begin
      sb_reset;
      sb_out(1, $10);
      sb_setup;
      disphelp;
      channel   := 0;
      ch_active := [0];
      repeat
        updatestatus;
        ch := upcase(readkey);
        if pos(ch, key_table) <> 0 then
        begin
          lastnote[channel] := note_table[pos(ch, key_table)];
          sb_note(channel, lastnote[channel], on);
        end
        else
        if pos(ch, voicekey_table) <> 0 then
        begin
          channel := pred(pos(ch,voicekey_table));
          if channel in ch_active then
            ch_active := ch_active - [channel]
          else
            ch_active := ch_active + [channel];
          if not (channel in ch_active) then
            sb_note(channel,lastnote[channel],off)
          else
            sb_note(channel,lastnote[channel],on);
        end;
      until ch = 'X';
      sb_off;
    end.

[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]