with BitsAKD; use BitsAKD;
     with ConsAKD; use ConsAKD;
     with FloaAKD; use FloaAKD;
     with InteAKD; use InteAKD;
     with PortAKD; use PortAKD;
     with TextAKD; use TextAKD;

     package body SounAKD is
     ----------------------------------------------------------------------
     -- Copyright (C) 1994 David Wallace Croft.  All rights reserved.
     ----------------------------------------------------------------------

     procedure Demo is
     ----------------------------------------------------------------------
       Def :          natural := 1;
       Opt :          natural;
       Min : constant natural := 0;
       Max : constant natural := 3;
       Speaker_Toggle : boolean := true;
     begin
       Speaker_Tone_Toggle ( false );
       loop
	 Put_Line ( Copyright );
	 New_Line;
	 Put_Line ( " 0 = Quit" );
	 Put_Line ( " 1 = Speaker_Thump" );
	 Put_Line ( " 2 = Speaker_Tone_Toggle" );
	 Put_Line ( " 3 = Speaker_Tone_Set" );
	 New_Line;
	 Opt := Ask_Nat ( "Please choose ", Def, Min, Max );
	 case Opt is
	   when 0 =>
	     exit;
	   when 1 =>
	     Speaker_Thump ( Ask_Nat ( "Count ", 1 ),
	     Ask ( "Interval ", 1.0 ) );
	   when 2 =>
	     Speaker_Tone_Toggle ( Speaker_Toggle );
	     Speaker_Toggle := not Speaker_Toggle;
	   when 3 =>
	     Speaker_Tone_Set (
	       Ask_Int ( "Frequency? ", Freq_Default, Freq_Minimum ) );
	   when others =>
	     Put_Line ( "That option is currently not available." );
	     Pause;
	 end case;
	 New_Line;
	 Def := Opt;
       end loop;
       Speaker_Tone_Toggle ( false );
     exception
       when others =>
	 Speaker_Tone_Toggle ( false );
	 raise;
     end Demo;

     procedure Speaker_Thump (
       Count    : in     natural := 1;
       Interval : in     float   := 0.0 ) is
     ----------------------------------------------------------------------
     begin
       for index in 1..Count loop
	 Out_Byte ( 16#61#,
	   Clear_Bits ( In_Byte ( 16#61# ), 2#0000_0011# ) );
	 Out_Byte ( 16#61#,
	   Set_Bits   ( In_Byte ( 16#61# ), 2#0000_0010# ) );
	 Out_Byte ( 16#61#,
	   Clear_Bits ( In_Byte ( 16#61# ), 2#0000_0010# ) );
	 delay duration ( Interval );
       end loop;
     end Speaker_Thump;

     procedure Speaker_Tone_Toggle (
       Turn_On : in     boolean := false ) is
     ----------------------------------------------------------------------
     begin
       if Turn_On then
	 Out_Byte ( 16#61#, In_Byte ( 16#61# ) Or 2#0000_0011# );
       else
	 Out_Byte ( 16#61#,
	   Clear_Bits ( In_Byte ( 16#61# ), 2#0000_0011# ) );
       end if;
     end Speaker_Tone_Toggle;

     procedure Speaker_Tone_Set (
       Frequency :  in     integer := Freq_Default ) is
     ----------------------------------------------------------------------
       Counter :  Word_Type;
       Freq    :  integer;
     begin
       if Frequency < Freq_Minimum then
	 Freq := Freq_Minimum;
       else
	 Freq := Frequency;
       end if;
       Counter := Word_Type ( 16#12_34_DC# / long_integer ( Freq ) );
       Out_Byte ( 16#42#, Get_Byte ( Counter, true  ) );
       Out_Byte ( 16#42#, Get_Byte ( Counter, false ) );
     end Speaker_Tone_Set;

     ----------------------------------------------------------------------
     ----------------------------------------------------------------------
     end SounAKD;