Power-Programmierung/CD1.mdf/pascal/library/dos/sound/sbutil/source.exe/CMSDRVR.PAS

Pascal/Delphi Source File | 1991-04-25 | 7.5 KB | 278 lines

{**************************************************************************

                               CMSDRVR
                          Direct CMS Output

                             Date: 4/4/91
                              Version: 1

***************************************************************************

                   Copyright (c) 1991, Zackzon Labs.

                       Author: Anthony Rumble

==========
Addresses:
==========
InterNet: [e-mail]
SIGNet:  28:2200/108

Snail Mail:
 32 Woolwich Rd.
 Hunters Hill, NSW, 2110
 Australia

-------------------------------------------------------------------------
                              HISTORY
-------------------------------------------------------------------------
1.0 - Works fine so far
***************************************************************************}

unit cmsdrvr;

interface

{Musical Notes Constants}

type
 octave_type = array[1..3] of byte;

const
 A  = 3;
 AS = 31;
 BF = AS;
 B  = 58;
 C  = 83;
 CS = 107;
 DF = CS;
 D  = 130;
 DS = 151;
 EP = DS;
 E  = 172;
 F  = 191;
 FS = 209;
 GP = FS;
 G  = 226;
 GS = 242;
 AF = GS;
 octave_null:octave_type = (0,0,0);

var
 main_port:word;
 port:word;
 octaves:octave_type;
 sav:byte;
 temp:word;

procedure cms_reset;
procedure cms_play(note:byte; ampl, ampr:byte; octave:byte; channel:word);

implementation

{***************************************************************************
                              CMS_RESET
---------------------------------------------------------------------------
              Resets all the frequencies and registeres
***************************************************************************}
procedure cms_reset; assembler;
asm
         { Initial Voice# 1-6 }

         mov  dx,[port]  { Address Register for Voice #1-6 }
         inc  dx
         mov  al,0       { Start with regs.address 0}

@@label1:  out  dx,al    { Select internal register }
         mov  ah,al      { preserve regs.address }
         dec  dx         { Point to Data Register }
         sub  al,al      { Zero al }
         out  dx,al      { Init to 0 }
         inc  dx         { Point to Address Register again }
         mov  al,ah      { Recover Regs.address }
         inc  al         { Move to next address }
         cmp  al,20h
         jb   @@label1

         mov  al,1ch     { Select Frequency reset register }
         out  dx,al
         dec  dx
         mov  al,2
         out  dx,al      { Reset frequency for voice# 7-12 }

         { Initial voice# 7-12 }

         mov  dx,[port]  { Address register for voice# 7-12 }
         inc  dx
         inc  dx
         inc  dx
         mov  al,0

@@label2:  out  dx,al    { Select internal register }
         mov  ah,al      { Preserve regs.address }
         dec  dx         { point to Data Register }
         sub  al,al      { Zero al }
         out  dx,al      { Init to 0 }
         inc  dx         { Point to Address Register Again }

         mov  al,ah      { Recover Regs.address }
         inc  al         { move to next address }
         cmp  al,20h
         jb   @@label2

         mov  al,1ch     { Select frequency reset register }
         out  dx,al
         dec  dx
         mov  al,2
         out  dx,al      { Reset Frequency register for voice# 7-12 }
end;
{***************************************************************************
                              CMS_PLAY
---------------------------------------------------------------------------
***************************************************************************}
procedure cms_play(note:byte; ampl, ampr:byte; octave:byte; channel:word);

{---------------------------------------------------------------------------
                              SET_AMP
---------------------------------------------------------------------------}
procedure set_amp(ampl:byte; channel:byte); assembler;
asm

{Set Amplitude}

        mov dx,[port]; {Set up the port}
        inc dx
        xor al,al       {Select register 0}
        add al,channel
        out dx,al

        dec dx         {Load Data Port}
        mov al,ampl    {Load AX with the amplitude}
        out dx,al      {Set Amplitude}
end;
{---------------------------------------------------------------------------
                              SET_FREQ
---------------------------------------------------------------------------}
procedure set_freq(note:byte; channel:byte); assembler;
asm

{Set Frequency}

        mov dx,[port]; {Set up the port}
        inc dx
        mov al,8h       {Select register 8h}
        add al,channel
        out dx,al

        dec dx         {Load Data Port}
        mov al,note    {Load AX with the frequency}
        out dx,al      {Set Frequency}
end;
{---------------------------------------------------------------------------
                              SET_OCTAVE
---------------------------------------------------------------------------}
procedure set_octave(octave:byte; port2:byte); assembler;
asm

{Set Octave}

        mov dx,[port]; {Set up the port}
        inc dx
        mov al,10h      {Select register 10h}
        add al,port2
        out dx,al

        dec dx         {Load Data Port}
        mov al,octave  {Load AX with the octave}
        out dx,al      {Set octave}
end;
{---------------------------------------------------------------------------
                              FREQ_ENABLE
---------------------------------------------------------------------------}
procedure freq_enable; assembler;
asm

{Set FREQ Enable}

        mov dx,[port]; {Set up the port}
        inc dx
        mov al,14h     {Select register 14h}
        out dx,al

        dec dx         {Load Data Port}
        mov al,3fh     {Load AX with the freq enable}
        out dx,al      {freq enable}

        mov dx,[port]; {Set up the port}
        inc dx
        mov al,1ch     {Select register 1ch}
        out dx,al

        dec dx         {Load Data Port}
        mov al,01h     {Load AX with the Sound Enable}
        out dx,al      {Sound Enable}
end;

begin
 case channel of
   1,7:
   begin
    sav:=octaves[1] AND 112;
    octaves[1]:= octaves[1] OR 7;
    octaves[1]:= octaves[1] AND (octave OR sav);
    set_octave(octaves[1], 0);
   end;
   2,8:
   begin
    sav:=octaves[1] AND 7;
    octaves[1]:=octaves[1] OR 112;
    octaves[1]:=octaves[1] AND ((octave shl 4) OR sav);
    set_octave(octaves[1], 0);
   end;
   3,9:
   begin
    sav:=octaves[2] AND 112;
    octaves[2]:=octaves[2] OR 7;
    octaves[2]:=octaves[2] AND (octave OR sav);
    set_octave(octaves[2], 1);
   end;
   4,10:
   begin
    sav:=octaves[2] AND 7;
    octaves[2]:=octaves[2] OR 112;
    octaves[2]:=octaves[2] AND ((octave shl 4) OR sav);
    set_octave(octaves[2], 1);
   end;
   5,11:
   begin
    sav:=octaves[3] AND 112;
    octaves[3]:=octaves[3] OR 7;
    octaves[3]:=octaves[3] AND (octave OR sav);
    set_octave(octaves[3], 2);
   end;
   6,12:
   begin
    sav:=octaves[3] AND 7;
    octaves[3]:=octaves[3] OR 112;
    octaves[3]:=octaves[3] AND ((octave shl 4) OR sav);
    set_octave(octaves[3], 2);
   end;
 end;
 if channel>6 then
 begin
  port:=main_port+2;
  channel:=channel-6;
 end;
 channel:=channel-1;
 set_freq(note, channel);
 set_amp(ampl+(ampr*16), channel);
 port:=main_port;
 freq_enable;
end;


begin
 main_port:=$220;
 port:=main_port;
 octaves:=octave_null;
end.