--
-- Copyright (C) 2020  <fastrgv@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You may read the full text of the GNU General Public License
-- at <http://www.gnu.org/licenses/>.
--



with sndloop;
with text_io; use text_io;
with sysutils;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with ada.real_time; use ada.real_time;



package body snd4ada_hpp is

	subtype namerng is integer range 1..80;
	type nametype is new string(namerng);

	maxbuf : constant int := 26;
	subtype bufrng is int range 0..maxbuf;
	tbuf: bufrng := 0;

	clipdur : array(bufrng) of time_span;
	buf : array(bufrng) of nametype;
	len : array(bufrng) of namerng;

	tsk : array(bufrng) of sndloop.sndtask;
	isloop,running : array(bufrng) of boolean := (others=>false);

   procedure initSnds is
	begin
		null;
	end initSnds;

   function initSnd (
		pc : Interfaces.C.Strings.chars_ptr; 
		vol : int
		) return int is

		lt: constant size_t := Strlen(pc);
		ln: constant namerng := namerng(lt);
	begin

		tbuf:=tbuf+1;

		for i in 1..ln loop
			buf(tbuf)(i) := value(pc)(i);
		end loop;

		len(tbuf):=ln;
		return tbuf;

	end initSnd;

	--transient sound...play Once:
   procedure playSnd (nbuf : int) is
		ln: constant namerng := len(nbuf);
		name: constant string := string( buf(nbuf) );
		cmd : constant string := 
			"aplay --nonblock --quiet "&name(1..ln);
		Ok: boolean;
	begin
		sysutils.Shell( cmd, Ok );
	end playSnd;


--==============================================================

   function initLoop (
		pc : Interfaces.C.Strings.chars_ptr; 
		dur : gldouble; --duration of sound clip
		vol : int
		) return int is
		tb: bufrng;
	begin
		tb := initSnd(pc,vol);
		clipdur(tb):= milliseconds( integer( dur*1000.0 ) );
		isloop(tb):=true;
		return tb;
	end initLoop;


	--sound loop...play Many using task:
   procedure playLoop (nbuf : int) is
		ln: constant namerng := len(nbuf);
		name: constant string := string( buf(nbuf) );

		--alphabetic {a..z} task identifier allows unique
		--filename containing PID (used for termination):
		ch : constant character := character'val(96+nbuf);

	begin

		if isloop(nbuf) and not running(nbuf) then
			running(nbuf):=true;
			tsk(nbuf).start( name(1..ln), clipdur(nbuf), ch );
		end if;

		exception
			when others =>
				put_line("snd4ada.playLoop error");
				raise;

	end playLoop;



   procedure stopLoop (nbuf : int) is
	begin

		if isloop(nbuf) and running(nbuf) then
			tsk(nbuf).stop;
			running(nbuf):=false;
		end if;

		exception
			when others =>
				put_line("snd4ada.stopLoop error");
				raise;

	end stopLoop;

	procedure stopLoops is
	begin
		for i in bufrng loop
			stopLoop(i);
		end loop;
	end stopLoops;

   procedure termSnds is
	begin
		stopLoops;
	end termSnds;



end snd4ada_hpp;
