OpenAL with GTKAda GUI “Sample2”
Referenced
https://www.openal.org/documentation/OpenAL_Programmers_Guide.pdf
https://www.openal.org/documentation/openal-1.1-specification.pdf
https://github.com/io7m/coreland-openal-ada/blob/master/openal-context-capture.adb
https://github.com/io7m/coreland-openal-ada-dist/tree/master/doc/openal-ada-doc-1.1.1/single.html
(openal-ada 1.1.1 documentation…This is OpenAL-Ada command reference)
Development and confirmed environment
PC: HP Envy-17t-S100
OS: Ubuntu 20.04.4 LTS
GTKAda: Adacore, GNAT Studio Community 2020 (20200427) hosted on x86_64-pc-linux-gnu
OpenAL: Coreland, openal-ada 1.1.1, File: OpenALaoa12nov20
File Structures
Directory: ada/Sample2/ — gnatstudio project files to control build options
Directory: ada/Sample2/src/ — source files
Directory: ada/Sample2/obj/ (File “main” is the executable file and lots of files are created in here).
A picture and a sound files are located here.
File Details
Download:
https://github.com/moriyasum/GtkAda_OpenAL_Doppler_Sample2
GtkAda_Build_Setting_File
with "gtkada";
project Default is
for Source_Dirs use ("src", "../../../../usr/local/include/coreland/openal-ada");
for Object_Dir use "obj";
for Main use ("main.adb");
package Linker is
for Switches ("ada") use ("-lopenal", "-lalut");
end Linker;
for Source_List_File use "sourcefiles.text";
end Default;All_File_Names_to_Build_GtkAda
main.adb
tintr.ads
tintr.adb
gui.ads
gui.adb
audio.ads
audio.adb
common.ads
common.adb
openal.ads
openal-alc_thin.ads
openal-buffer.adb
openal-buffer.ads
openal-context.adb
openal-context.ads
openal-context-capture.adb
openal-context-capture.ads
openal-context-error.adb
openal-context-error.ads
openal-error.adb
openal-error.ads
openal-extension.ads
openal-extension-efx.adb
openal-extension-efx.ads
openal-extension-efx_thin.adb
openal-extension-efx_thin.ads
openal-extension-float32.adb
openal-extension-float32.ads
openal-extension-float32_thin.ads
openal-global.adb
openal-global.ads
openal_info.adb
openal_info.ads
openal_info_main.adb
openal-list.adb
openal-list.ads
openal-listener.adb
openal-listener.ads
openal-load.adb
openal-load.ads
openal-source.adb
openal-source.ads
openal-thin.ads
openal-types.adsMain_Program
with Gtk.Box; use Gtk.Box;
with Gtk.Main; use Gtk.Main;
with Gtk.Window; use Gtk.Window;
with Gtk.Frame; use Gtk.Frame;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Progress_Bar; use Gtk.Progress_Bar; --Timer interrupt
with OpenAL.Context;
with Glib.Main; use Glib.Main; --Timer Interrupt Time_Cb.Timeout_Add
with Gdk.Event; use Gdk.Event;
with Audio;
with Gui;
with Tintr;
With Common;
procedure Main is
package Time_Cb is new Glib.Main.Generic_Sources (Gtk_Progress_Bar);
Win : Gtk_Window;
FrameM : Gtk_Frame;
BoxM : Gtk_Vbox;
begin
-- Initialize GtkAda.
Gtk.Main.Init;
-- Create a window with a size of 400x400
Gtk_New (Win);
Win.Set_Default_Size (1100, 700);
-- Create a box to organize vertically the contents of the window
Gtk_New_Vbox (BoxM);
Win.Add (BoxM);
Gtk_New (FrameM);
BoxM.Add(FrameM);
Gui.Run(FrameM);
-- Start Timer Interrupt
Tintr.Gid_dummy := Time_Cb.Timeout_Add
(Tintr.TINTR_PITCH, Tintr.Timer_Intr'Access, Tintr.Datatype_dummy);
-- End, close OpenAL device
OpenAL.Context.Close_Device (Audio.CX_Devicet); --CLOSE "OpenAL Soft"
-- Stop the Gtk process when closing the window
Win.On_Delete_Event (Common.Delete_Event_Cb'Unrestricted_Access);
-- Show the window and present it
Win.Show_All;
Win.Present;
-- Start the Gtk+ main loop
Gtk.Main.Main;
end Main;GUI_Specification
with Gtk.Box; use Gtk.Box;
with Gtk.Label; use Gtk.Label;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Main; use Gtk.Main;
with Gtk.Window; use Gtk.Window;
with Gtk.Frame; use Gtk.Frame;
with Gtk.Button; use Gtk.Button;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Handlers; use Gtk.Handlers;
with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;
with Gtk.Adjustment; use Gtk.Adjustment;
with Gtk.Drawing_Area; use Gtk.Drawing_Area;
with Gtk.Spin_Button; use Gtk.Spin_Button;
with Gtkada.Canvas; use Gtkada.Canvas;
with Gtkada.Canvas_View; use Gtkada.Canvas_View;
with Gtkada.Canvas_View.Views; use Gtkada.Canvas_View.Views;
with Gtkada.Style; use Gtkada.Style;
with Ada.Numerics.Discrete_Random;
with Ada.Numerics.Elementary_Functions; --For Sin
use Ada.Numerics.Elementary_Functions; --For Sin
with Ada.Numerics; use Ada.Numerics;
with Ada.Float_Text_IO; use Ada.Float_Text_IO;
with Gdk; use Gdk;
with Gdk.Cairo; use Gdk.Cairo;
with Gdk.RGBA; use Gdk.RGBA;
with Gdk.Pixbuf; use Gdk.Pixbuf;
with Glib; use Glib;
with Glib.Error; use Glib.Error;
with Glib.Object; use Glib.Object;
with Cairo; use Cairo;
with Cairo.Pattern; use Cairo.Pattern;
with Cairo.Png; use Cairo.Png;
with Cairo.Region; use Cairo.Region;
with Cairo.Surface; use Cairo.Surface;
with OpenAL.Context; use OpenAL.Context;
with Text_IO; use Text_IO;
package Gui is
-----------------------------
-- Misc. types and variables
-----------------------------
-- package Items_Random is new Ada.Numerics.Discrete_Random (Positive);
-- use Items_Random;
Max_Size : constant := 400;
subtype Coordinate_Type is Gint range Default_Grid_Size + 1 .. Max_Size;
package Coordinate_Random is new
Ada.Numerics.Discrete_Random (Coordinate_Type);
use Coordinate_Random;
subtype Zoom_Type is Gint range 1 .. 2;
package Zoom_Random is new Ada.Numerics.Discrete_Random (Zoom_Type);
use Zoom_Random;
type FixedPoint0018 is delta 0.001 digits 8; --To display Float with FixedPoint value
FixPnt008 : FixedPoint0018;
type FixedPoint0016 is delta 0.1 digits 6; --To display Float with FixedPoint value
FixPnt006 : FixedPoint0016;
----------------------------------------------------------------
-- Redefine our own item type, since we want to provide our own
-- graphics.
----------------------------------------------------------------
type Display_Item_Record is new GtkAda.Canvas.Canvas_Item_Record with record
Canvas : Interactive_Canvas;
Color : Gdk.RGBA.Gdk_RGBA;
W, H : Gint;
Num : Positive;
end record;
type Display_Item is access all Display_Item_Record'Class;
----------------------------------------------------
-- Our own canvas, with optional background image --
----------------------------------------------------
type Image_Canvas_Record is new Interactive_Canvas_Record with record
Background : Cairo_Pattern := Null_Pattern;
Draw_Grid : Boolean := True;
end record;
type Image_Canvas is access all Image_Canvas_Record'Class;
type Image_Drawing_Record is new Gtk.Box.Gtk_Box_Record with record
Area : Gtk.Drawing_Area.Gtk_Drawing_Area;
PixG : Gdk.Pixbuf.Gdk_Pixbuf;
end record;
type Image_Drawing is access all Image_Drawing_Record'Class;
-- A special type of drawing area that can be associated with
-- an image.
package Canvas_Cb is new Gtk.Handlers.Callback
(Interactive_Canvas_Record);
package Canvas_User_Cb is new Gtk.Handlers.User_Callback
(Gtk_Widget_Record, Image_Canvas);
------------------------
-- Callbacks packages --
------------------------
package Expose_Cb is new Gtk.Handlers.Return_Callback
(Image_Drawing_Record, Boolean);
package Destroy_Cb is new Gtk.Handlers.Callback (Image_Drawing_Record);
-----------------------
-- PROTYPE
-----------------------
procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class);
procedure Button_Single_Cb
(Canvas : access Interactive_Canvas_Record'Class);
procedure Button_Loop_Cb
(Canvas : access Interactive_Canvas_Record'Class);
procedure Button_Step_Cb
(Canvas : access Interactive_Canvas_Record'Class);
procedure Button_Clear_Cb
(Canvas : access Interactive_Canvas_Record'Class);
procedure Draw --Draw #1 *********
(Item : access Display_Item_Record;
Cr : Cairo_Context);
procedure Initial_Plane_Item_Setup
(Canvas : access Interactive_Canvas_Record'Class);
procedure Initialize_Listener_Image
(Draw : out Image_Drawing;
Pixbuf : Gdk.Pixbuf.Gdk_Pixbuf;
Title : String);
function On_Draw_Listener_Image
(Draw : access Image_Drawing_Record'Class;
Cr : Cairo_Context) return Boolean;
Procedure Calculate_Display_Sound
(Counter : in Integer);
Procedure Display_Plane
(Counter : in Integer);
procedure On_Listner_Loc (Spin : access Glib.Object.GObject_Record'Class);
-----------------------------
-- GLOBAL VARIABLES
-----------------------------
Button_Single : Gtk_Button;
Button_Loop : Gtk_Button;
Button_Step : Gtk_Button;
Button_Clear : Gtk_Button;
ButtonColor : Gdk_RGBA;
Dummy_Boolean : Boolean;
Label_Dummy1 : Gtk_Label; --Left pane top for clearance
Label_TCnt : Gtk_Label; --Left pane, TimeCnt
Label_S2SndPos_X : Gtk_Label; --Left pane, New postion X
Label_S2SndPos_Y : Gtk_Label; --Left pane, New postion Y
Label_SndVel_X : Gtk_Label; --Left pane, Sound Veloctiy X
Label_SndVel_Y : Gtk_Label; --Left pane, Sound Veloctiy Y
Label_Speed_Angle : Gtk_Label; --Left pane, Sound Angle
Label_Start_Flag : Gtk_Label; --Left pane, Status
OFFSET_X : Gtk_Spin_Button;
OFFSET_Y : Gtk_Spin_Button;
PIXFACTOR_X : Gtk_Spin_Button;
PIXFACTOR_Y : Gtk_Spin_Button;
SND_POS_FACTOR : Gtk_Spin_Button; --Sound Distance Factor
SND_SPD_FACTOR : Gtk_Spin_Button; --Sound SPeed Factor
TIME_CYCLE_X : Gtk_Spin_Button;
TIME_CYCLE_Y : Gtk_Spin_Button;
LPOS_X : Gtk_Spin_Button;
LPOS_Y : Gtk_Spin_Button;
Buf_LPOS_X : float;
Buf_LPOS_Y : float;
S1Pos_X : float := 99999.9; --Source X Coordinate OLD Memory, @previous Timer Interrupt Position
S1Pos_Y : float := 99999.9; --Source Y Coordinate OLD Memory, @previous Timer Interrupt Position
S2Pos_X : float := 99999.9; --Source X Coordinate NEW, Normalized value
S2Pos_Y : float := 99999.9; --Source Y Coordinate NEW, Normalized value
S2PixPos_X : float; --Source Display Pixel Absolute Position = S2Pos_X * PIXFACTOR_X
S2PixPos_Y : float; --Source Display Pixel Absolute Position = S2Pos_Y * PIXFACTOR_Y
S2SndPos_X : float; --Sound Relative Position from Listener=(S2Pos_X-Buf_LPOS_X)*SND_POS_FACTOR
S2SndPos_Y : float; --Sound Relative Position from Listener=(S2Pos_Y-Buf_LPOS_Y)*SND_POS_FACTOR
Distance_SL : float; --Distance Source-Listener * Sound_Factor
Vel_Snd_X : float; --Plane Velocity for Sound, SND_SPD_FACTOR * (X2-X1)/Intr_cycle
Vel_Snd_Y : float; --Plane Velocity for Sound, SND_SPD_FACTOR * (Y2-Y1)/Intr_cycle
Speed_Angle : float :=0.0; --Plane Angle [rad]
Speed_NOM : float; --Plane Speed Nominal Scalar
Speed_Pix : float; --Plane Speed Pixel Scalar
Time_X, Time_Y : Float; --Figure Tracing Timer counter
Draw_Listener_Counter : Integer :=0; --Counter how many times Draw_Listener called by System
Draw_Plane_Counter : Integer := 0; --Counter how many times Draw_Plane called by System
Step_Counter : Integer := 0; --Set STEP mode, how many Interrupts, downcounter, preset=STEP_NUMBER.
STEP_NUMBER : constant := 3; --How many steps for "Step". It presets Step_Counter
PLANE_BODY_COLOR : constant Gdk.RGBA.Gdk_RGBA := (0.0, 0.0, 0.8, 1.0); --RGBA (Blue)
end Gui;GUI_Body
with Audio; use Audio;
with Tintr; use Tintr;
package body Gui is
-------------------------------
-- Valiables
------------------------------
Box : Gtk_Box;
HBox1, HBox2 : Gtk_Box;
Scrolled : Gtk_Scrolled_Window;
CanvasG : Image_Canvas;
DrawPic : Image_Drawing; --Picture
VBoxL : Gtk_Box; --Left pane
VBoxL1, VBoxL2 : Gtk_Box; --Left pane upper and lower boxes
PixG : Gdk_Pixbuf;
Item0 : Display_Item; --This is DUMMY, but it is needed to work properly.
Item1 : Display_Item; --Plane Item. Plane is drawn on this Item.
Items_List : array (1 .. 500) of Gtkada.Canvas.Canvas_Item;
Draw1_Before : Integer := 0; --for debug
Filled, Black_Filled : Drawing_Style;
Sloppy : Boolean := False;
-----------------------------------------------------------
--Button_START SINGLE Callback
------------------------------------------------------------
procedure Button_Single_Cb
(Canvas : access Interactive_Canvas_Record'Class) is
begin
Draw_Listener_Counter := 0; --Counter, how many times the photo Draw called for debug
If (Start_Flag=0) then --Normal Start turns ON
--If SINGLE button is pressed from OFF to ON then start up.
ALSound_Initialize;
S1Pos_X := 0.0; --Save for next Direction Calc
S1Pos_Y := 0.0; --Save for next Direction Calc
Start_Flag := 1;
Pause_Flag := 0;
Set_Label (Button_Single, "Single");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
elsif((Start_Flag=1) or (Start_Flag=2)) then --working or Pausing Single
If (Pause_Flag=0) then
--Switch SINGLE to PAUSE
Pause_Flag := 1; --PAUSE
Set_Label (Button_Single, "Single");
Parse (ButtonColor, "Red", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
else --Now PAUSE, then switch to continue Single again
--Switch PAUSE to SINGLE (Re-starting)
Pause_Flag := 0;
Set_Label (Button_Single, "Single");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
end if;
else --In the other modes and pressed Single button
-- Switch to SINGLE mode and go again
Pause_Flag := 0;
Start_Flag := 2; --SINGLE and CONTINUE flag
--If button is pressed from ON to OFF then stop
Set_Label (Button_Single, "Single");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Loop, "Loop");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Step, "Step");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
-- OpenAL.Context.Close_Device (Audio.CX_Devicet); -- CLOSE "OpenAL Soft"
end if;
-- Show_All (CanvasG);
end Button_Single_Cb;
-----------------------------------------------------------
--Button_START LOOP Callback
------------------------------------------------------------
procedure Button_Loop_Cb
(Canvas : access Interactive_Canvas_Record'Class) is
begin
Draw_Listener_Counter := 0; --Counter, how many times the photo Draw called for debug
If (Start_Flag=0) then --Normal Start turns ON
--If button is pressed from OFF to ON then start up.
ALSound_Initialize;
S1Pos_X :=0.0; --Previous locaction X = 0
S1Pos_Y :=0.0; --Previous locaction Y = 0
Start_Flag := 5;
Pause_Flag := 0;
Set_Label (Button_Loop, "Loop");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
elsif((Start_Flag=5) or (Start_Flag=6)) then --LOOPing or Pausing LOOP
If (Pause_Flag=0) then
--Not PAUSE, then Switch LOOP to PAUSE
Pause_Flag := 1; --PAUSE
Set_Label (Button_Loop, "Loop");
Parse (ButtonColor, "Red", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
else --Now PAUSE, then switch to continue Single again
--PAUSE, then Switch PAUSE to LOOP
Pause_Flag := 0;
Set_Label (Button_Loop, "Loop");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
end if;
else --In the other modes and pressed LOOP button
-- Switch to LOOP mode and go again
Pause_Flag := 0;
Start_Flag := 6; --LOOP and CONTINUE flag
--If button is pressed from ON to OFF then stop
Set_Label (Button_Single, "Single");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Loop, "Loop");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Step, "Step");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
-- OpenAL.Context.Close_Device (Audio.CX_Devicet); -- CLOSE "OpenAL Soft"
end if;
-- Show (Gval.Box);
-- Show_All (CanvasG);
end Button_Loop_Cb;
------------------------------------------------------------
--Button_STEP Callback
-- NOTE STEP cannot stop
------------------------------------------------------------
procedure Button_Step_Cb
(Canvas : access Interactive_Canvas_Record'Class) is
begin
Draw_Listener_Counter := 0; --Counter, how many times the photo Draw called for debug
If (Start_Flag=0) then --Normal Start turns ON
--If button is pressed from OFF to ON then start STEP.
ALSound_Initialize;
S1Pos_X :=0.0; --Previous locaction X = 0
S1Pos_Y :=0.0; --Previous locaction Y = 0
Step_Counter := STEP_NUMBER; --Preset down-counter
Start_Flag := 3; --Flag=3: Start STEP
Pause_Flag := 0; --Reset WAIT counter
Set_Label (Button_Step, "Step");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
else
--Pressed STEP button at Working any mode or HALT, then Re-start STEP
Start_Flag := 3; --Flag=3: Start STEP
Pause_Flag := 0; --Reset WAIT counter
Step_Counter := STEP_NUMBER; --Preset Down-counter
Set_Label (Button_Loop, "Loop");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Single, "Single");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Step, "Step");
Parse (ButtonColor, "Blue", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
end if;
end Button_Step_Cb;
--------------------------------------------------------
-- Button CLEAR Callback
--------------------------------------------------------
procedure Button_Clear_Cb
(Canvas : access Interactive_Canvas_Record'Class) is
function Remove_Internal
(Canvas : access Interactive_Canvas_Record'Class;
Item : access GtkAda.Canvas.Canvas_Item_Record'Class) return Boolean is
begin
Remove (Canvas, Item);
return True;
end Remove_Internal;
begin
Start_Flag := 0;
Pause_Flag := 0;
Step_Counter := 0;
TimeCnt :=0;
S1Pos_X :=0.0; --Previous locaction X = 0
S1Pos_Y :=0.0; --Previous locaction Y = 0
TimerIntrCounter_Before := 0; --Used in Tintr
Set_Label (Gui.Button_Single, "Single");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Gui.Button_Loop, "Loop");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
OpenAL.Context.Close_Device (Audio.CX_Devicet); -- CLOSE "OpenAL Soft" and stop sound
Set_Label (Button_Step, "Step");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Display_Plane(10);
Put_Line("TimeCnt=" & Integer'Image(TimeCnt) & " S2PixPos_X= " & float'Image(S2PixPos_X) & " S2PixPos_Y" & float'Image(S2PixPos_Y));
end Button_Clear_Cb;
------------------------------------------------------------
-- Draw_#1 To_Double_Buffer -- Regular Rectangle
-- Plane Drawing
------------------------------------------------------------
procedure Draw
(Item : access Display_Item_Record;
Cr : Cairo_Context) is
Iw, Ih, Iwc, Ihc : Gdouble;
Ang : Float;
Icolor : Gdk.RGBA.Gdk_RGBA;
begin
if(TimerIntrCounter=TimerIntrCounter_Before) then
If (TimeCnt_Draw=0) then goto END_OF_DRAW; end if; --SKIP if counter is full (protect from too much display)
TimeCnt_Draw := TimeCnt_Draw - 1;
else
TimeCnt_Draw := TIMECNT_DRAW_PRESET; --Initialize down-counter
end if;
Ang := Speed_angle; --Radian, Angle from the Origin (positive X axis=0 deg, CW=Positive, Radian)
Iw := Gdouble(Item.w); --Image Width
Ih := Gdouble(Item.h); --Image Height
Iwc := 0.5 * Iw; --Image Rotation Center=a half Width
Ihc := 0.5 * Ih; --Image Rotation Center=a half Height
Icolor := Item.Color; --Save body color, Gdk.RGBA.Gdk_RGBA
--Draw exhaust flame Lower Half
Arc (Cr, Iwc+0.325*Iw*GDouble(Cos(3.5358+Ang)), Ihc+0.325*Iw*GDouble(Sin(3.5358+Ang)), 0.25*Iw, GDouble(0.5235+Ang), GDouble(2.618+Ang));
Set_Source_Rgb (Cr, 1.0, 0.5, 0.5); --Red
Cairo.Fill (Cr); -- Fill color
--Draw exhaust flame Upper Half
Arc (Cr, Iwc+0.325*Iw*GDouble(Cos(2.7462+Ang)), Ihc+0.325*Iw*GDouble(Sin(2.7462+Ang)), 0.25*Iw, GDouble(3.663+Ang), GDouble(5.757+Ang));
Set_Source_Rgb (Cr, 1.0, 0.5, 0.5);
Cairo.Fill (Cr); -- Fill color
--Draw Jet nozzle Circle
Item.Color := (1.0, 0.0, 0.0, 1.0); --Red color
Gdk.Cairo.Set_Source_RGBA (Cr, Item.Color);
Arc (Cr, Iwc+0.2*Iw*GDouble(Cos(Pi+Ang)), Ihc+0.2*Ih*GDouble(Sin(Pi+Ang)), 0.1*Iw, 0.0, 2.0*Pi);
Cairo.Fill (Cr); --Fill without outline
--Plane body
Move_To (Cr, Iwc+0.45*Iw*GDouble(cos(Ang)), Ihc+0.45*Ih*GDouble(sin(Ang))); --#1 Move to the Top
Line_To (Cr, Iwc+0.4060*Iw*GDouble(cos(0.1732+Ang)), Ihc+0.4060*Ih*GDouble(sin(0.1732+Ang))); --#2 Draw Lower Half
Line_To (Cr, Iwc+0.3569*Iw*GDouble(cos(0.1974+Ang)), Ihc+0.3569*Ih*GDouble(sin(0.1974+Ang))); --#3
Line_To (Cr, Iwc+0.3640*Iw*GDouble(cos(0.2783+Ang)), Ihc+0.3640*Ih*GDouble(sin(0.2783+Ang))); --#4
Line_To (Cr, Iwc+0.3162*Iw*GDouble(cos(0.3218+Ang)), Ihc+0.3162*Ih*GDouble(sin(0.3218+Ang))); --#5
Line_To (Cr, Iwc+0.3162*Iw*GDouble(cos(1.2490+Ang)), Ihc+0.3162*Ih*GDouble(sin(1.2490+Ang))); --#6
Line_To (Cr, Iwc+0.3000*Iw*GDouble(cos(1.5700+Ang)), Ihc+0.3000*Ih*GDouble(sin(1.5700+Ang))); --#7 90'
Line_To (Cr, Iwc+0.1414*Iw*GDouble(cos(0.7850+Ang)), Ihc+0.1414*Ih*GDouble(sin(0.7850+Ang))); --#8
Line_To (Cr, Iwc+0.1000*Iw*GDouble(cos(1.5700+Ang)), Ihc+0.1000*Ih*GDouble(sin(1.5700+Ang))); --#9 90'
Line_To (Cr, Iwc+0.2236*Iw*GDouble(cos(2.0330+Ang)), Ihc+0.2236*Ih*GDouble(sin(2.0330+Ang))); --#10
Line_To (Cr, Iwc+0.2500*Iw*GDouble(cos(2.2120+Ang)), Ihc+0.2500*Ih*GDouble(sin(2.2120+Ang))); --#11
Line_To (Cr, Iwc+0.1581*Iw*GDouble(cos(2.8180+Ang)), Ihc+0.1581*Ih*GDouble(sin(2.8180+Ang))); --#12
Line_To (Cr, Iwc+0.1118*Iw*GDouble(cos(2.6760+Ang)), Ihc+0.1118*Ih*GDouble(sin(2.6760+Ang))); --#13
Line_To (Cr, Iwc+0.1000*Iw*GDouble(cos(3.1410+Ang)), Ihc+0.1000*Ih*GDouble(sin(3.1410+Ang))); --#14 Tail center
Move_To(Cr, Iwc, Ihc); --Move to the Center, the Center is always the same position
Move_To (Cr, Iwc+0.45*Iw*GDouble(cos(Ang)), Ihc+0.45*Ih*GDouble(sin(Ang))); --#1 Move to the Top
Line_To (Cr, Iwc+0.406*Iw*GDouble(cos(2.0*Pi-0.1732+Ang)), Ihc+0.406*Ih*GDouble(sin(2.0*Pi-0.1732+Ang))); --#2 Draw upper half
Line_To (Cr, Iwc+0.3569*Iw*GDouble(cos(2.0*Pi-0.1974+Ang)), Ihc+0.3569*Ih*GDouble(sin(2.0*Pi-0.1974+Ang))); --#3
Line_To (Cr, Iwc+0.3640*Iw*GDouble(cos(2.0*Pi-0.2783+Ang)), Ihc+0.3640*Ih*GDouble(sin(2.0*Pi-0.2783+Ang))); --#4
Line_To (Cr, Iwc+0.3162*Iw*GDouble(cos(2.0*Pi-0.3218+Ang)), Ihc+0.3162*Ih*GDouble(sin(2.0*Pi-0.3218+Ang))); --#5
Line_To (Cr, Iwc+0.3162*Iw*GDouble(cos(2.0*Pi-1.249+Ang)), Ihc+0.3162*Ih*GDouble(sin(2.0*Pi-1.249+Ang))); --#6
Line_To (Cr, Iwc+0.3000*Iw*GDouble(cos(2.0*Pi-1.5700+Ang)), Ihc+0.3000*Ih*GDouble(sin(2.0*Pi-1.5700+Ang))); --#7 270'
Line_To (Cr, Iwc+0.1414*Iw*GDouble(cos(2.0*Pi-0.785 +Ang)), Ihc+0.1414*Ih*GDouble(sin(2.0*Pi-0.7850+Ang))); --#8
Line_To (Cr, Iwc+0.1000*Iw*GDouble(cos(2.0*Pi-1.570+Ang)), Ihc+0.1000*Ih*GDouble(sin(2.0*Pi-1.5700+Ang))); --#9 270'
Line_To (Cr, Iwc+0.2236*Iw*GDouble(cos(2.0*Pi-2.033+Ang)), Ihc+0.2236*Ih*GDouble(sin(2.0*Pi-2.033+Ang))); --#10
Line_To (Cr, Iwc+0.2500*Iw*GDouble(cos(2.0*Pi-2.212+Ang)), Ihc+0.2500*Ih*GDouble(sin(2.0*Pi-2.212+Ang))); --#11
Line_To (Cr, Iwc+0.1581*Iw*GDouble(cos(2.0*Pi-2.818+Ang)), Ihc+0.1581*Ih*GDouble(sin(2.0*Pi-2.818+Ang))); --#12
Line_To (Cr, Iwc+0.1118*Iw*GDouble(cos(2.0*Pi-2.676+Ang)), Ihc+0.1118*Ih*GDouble(sin(2.0*Pi-2.676+Ang))); --#13
Line_To (Cr, Iwc+0.1000*Iw*GDouble(cos(2.0*Pi-3.141+Ang)), Ihc+0.1000*Ih*GDouble(sin(2.0*Pi-3.141+Ang))); --#14
Close_Path (Cr); --Close Polygon to fill color
Item.Color := Icolor; --Return to the saved color
Gdk.Cairo.Set_Source_RGBA (Cr, Item.Color); --Paint the plane body
-- Gdk.Cairo.Set_Source_RGBA (Cr, Icolor); --NOTE: This does not work
Cairo.Fill (Cr); -- Fill color
Draw_Plane_Counter := Draw_Plane_Counter + 1; --Just to countup calling this Draw how many times
<< END_OF_DRAW >> --GOTO Jump Flag
TimerIntrCounter_Before := TimeCnt;
end Draw;
------------------------------------------------------------------
-- On_Draw_Listener_Image -- This On_Draw_Listener_Image is coming from libart_demo.adb
-- Display Picture image in LEFT VBoxL or RIGHT Canvas
------------------------------------------------------------------
function On_Draw_Listener_Image
(Draw : access Image_Drawing_Record'Class;
Cr : Cairo_Context) return Boolean is
begin
Text_IO.Put_Line("Width=" & Gint'Image(Get_Width(Draw.PixG)) & " Height=" & Gint'Image(Get_Height(Draw.PixG)));
Set_Source_Pixbuf (Cr, Draw.PixG, 0.0, 0.0);
Cairo.Paint (Cr); --Need to display picture
Cairo.Stroke (Cr);
Draw_Listener_Counter := Draw_Listener_Counter + 1;
return False;
end On_Draw_Listener_Image;
-----------------------------------------------------------
-- Initialize_Listener_Image -- to display Picture image
-- Called from "Run"
-----------------------------------------------------------
procedure Initialize_Listener_Image
(Draw : out Image_Drawing; --DrawPic
Pixbuf : Gdk_Pixbuf; --PixG
Title : String) is --"Initial Image"
Label : Gtk_Label;
begin
Draw := new Image_Drawing_Record;
Initialize_Vbox (Draw, Homogeneous => False, Spacing => 0);
Gtk_New (Label, Title);
Pack_Start (Draw, Label, Expand => False, Fill => False);
Draw.PixG := Pixbuf; --Picture
Set_Size_Request
(Draw,
Get_Width (Draw.PixG),
Get_Height (Draw.PixG) + Get_Allocated_Height (Label));
Gtk_New (Draw.Area);
Pack_Start (Draw, Draw.Area);
Expose_Cb.Object_Connect
(Draw.Area, Signal_Draw,
Expose_Cb.To_Marshaller (On_Draw_Listener_Image'Access),
Slot_Object => Draw);
end Initialize_Listener_Image;
---------------------------------------------------------------
-- Initialize Display Plane Items
---------------------------------------------------------------
procedure Initial_Plane_Item_Setup
(Canvas : access Interactive_Canvas_Record'Class) is
begin
-- Place a Dummy Item ***************************
-- Workaround for the first location (0,0) BUG and another BUG
Item0 := new Display_Item_Record;
Item0.Canvas := Interactive_Canvas (Canvas);
Item0.Color := (1.0, 1.0, 1.0, 0.0); -- RGBA Color=White
Item0.W := 0; -- Width=0
Item0.H := 0; -- Height=0
Set_Screen_Size (Item0, Item0.W, Item0.H);
Put (Canvas, Item0, 0, 0); --Dummy PUT, Location X=0,Y=0
--***********************************************
Item1 := new Display_Item_Record; --Draw #1
Item1.Canvas := Interactive_Canvas (Canvas);
Item1.Color := PLANE_BODY_COLOR; --Color: Gdk.RGBA.Gdk_RGBA
Item1.W := 140; --Figure W size
Item1.H := 140; --Figure H size
Item1.Num := 1;
Set_Screen_Size (Item1, 150, 150); --Item drawing area, wider than figure to rotate
end Initial_Plane_Item_Setup;
--------------------------------------------------------------
-- Calculate all Parameters of Source, Move and Display
--------------------------------------------------------------
Procedure Display_Plane
(Counter : in Integer) is
Begin
Calculate_Display_Sound (Counter); -- Calculate all
Move_To (CanvasG, Item1, Glib.Gint(S2PixPos_X), Glib.Gint(S2PixPos_Y)); --Important. Don't use Put for an Item multiple times.
Show_All (CanvasG);
End Display_Plane;
--------------------------------------------------------------
-- Calculate all Plane Location and Audio Parameters
--------------------------------------------------------------
Procedure Calculate_Display_Sound
(Counter : in Integer) is --TimeCnt
Just_Begin_Flag : Boolean;
Begin
If (Pause_Flag /= 0) then Return; end if;
If(S1Pos_X=0.0 and S1Pos_Y=0.0) then --If this is the first call, then set flag to skip some calculatios
Just_Begin_Flag := True;
else
Just_Begin_Flag := False;
end if;
-- Calculate Current P2 Location
S2Pos_X := float(Get_Value(OFFSET_X)) + Sin (2.0 * Pi / float(Get_Value(TIME_CYCLE_X)) * float(TINTR_PITCH) /1000.0 * Time_X); --Normalized 1+Sin(wt)
S2PixPos_X := float(Get_Value(PIXFACTOR_X)) * S2Pos_X; --For Display Absolute
S2SndPos_X := float(Get_Value(SND_POS_FACTOR)) * (S2Pos_X - Buf_LPOS_X); --For Sound Relative S-L
S2Pos_Y := float(Get_Value(OFFSET_Y)) + Cos (2.0 * Pi / float(Get_Value(TIME_CYCLE_Y)) * float(TINTR_PITCH) / 1000.0 * Time_Y); --Normalized 2+Cos(wt)
S2PixPos_Y := float(Get_Value(PIXFACTOR_Y)) * S2Pos_Y; --For Display Absolute
--- S2SndPos_Y := float(Get_Value(SND_POS_FACTOR)) * (Buf_LPOS_Y - S2Pos_Y); --For Sound Relative S-L
S2SndPos_Y := float(Get_Value(SND_POS_FACTOR)) * (S2Pos_Y - Buf_LPOS_Y); --For Sound Relative S-L
If (Just_Begin_Flag = False) then
--Not the first time, then calculate speed and direction
Vel_Snd_X := float(Get_Value(SND_SPD_FACTOR)) * (S2Pos_X - S1Pos_X) * 1000.0 / float(TINTR_PITCH); --For Sound_SPD_Factor * (X2-X1)/Intr_cycle
Vel_Snd_Y := float(Get_Value(SND_SPD_FACTOR)) * (S2Pos_Y - S1Pos_Y) * 1000.0 / float(TINTR_PITCH); --For Sound_SPD_Factor * (Y2-Y1)/Intr_cycle
If (Abs(S2Pos_X-S1Pos_X) <= 0.0001) then --To avoid 0 division
If (S2Pos_Y > S1Pos_Y) then
Speed_Angle := 0.5*Pi; --Pi/2rad=90deg, Protect Zero division
else
Speed_Angle := 1.5*Pi; --4.712rad=270 deg, Protect Zero division
end if;
else --Not 0, then normal calculatio
Speed_Angle := Abs(Arctan ((S2Pos_Y-S1Pos_Y)/(S2Pos_X-S1Pos_X))); --Right Lower(no correction)
If ((S2Pos_Y-S1Pos_Y)<0.0 and (S2Pos_X-S1Pos_X)>0.0) then --Right upper
Speed_Angle := 2.0*Pi - Speed_Angle;
elsif ((S2Pos_Y-S1Pos_Y)>=0.0 and (S2Pos_X-S1Pos_X)<0.0) then --Left Lower
Speed_Angle := Pi - Speed_Angle;
elsif ((S2Pos_Y-S1Pos_Y)<0.0 and (S2Pos_X-S1Pos_X)<0.0) then --Left Upper
Speed_Angle := Pi + Speed_Angle;
end if;
end if;
else -- First time, INITIAL, just started
Speed_Angle := 0.0;
Vel_Snd_X := 0.0;
Vel_Snd_Y := 0.0;
end if;
Distance_SL := SQRT (S2SndPos_X**2 + S2SndPos_Y**2); --Use Sound,because Relative
S1Pos_X := S2Pos_X; --Save for next Direction Calc
S1Pos_Y := S2Pos_Y; --Save for next Direction Calc
--Display Labels
Set_Label (Gui.Label_TCnt, "TimeCnt=" & Integer'Image(TimeCnt));
FixPnt006 := FixedPoint0016(S2SndPos_X);
Set_Label (Gui.Label_S2SndPOS_X, "SndPos_X=" & FixedPoint0016'Image(FixPnt006));
FixPnt006 := FixedPoint0016(S2SndPos_Y);
Set_Label (Gui.Label_S2SndPos_Y, "SndPos_Y=" & FixedPoint0016'Image(FixPnt006));
FixPnt006 := FixedPoint0016(Vel_Snd_X);
Set_Label (Gui.Label_SndVel_X, "SndVel_X=" & FixedPoint0016'Image(FixPnt006));
FixPnt006 := FixedPoint0016(Vel_Snd_Y);
Set_Label (Gui.Label_SndVel_Y, "SndVel_Y=" & FixedPoint0016'Image(FixPnt006));
FixPnt008 := FixedPoint0018(Speed_Angle);
Set_Label (Gui.Label_Speed_Angle, "Angle=" & FixedPoint0018'Image(FixPnt008));
Set_Label (Gui.Label_Start_Flag, "Start_Flag=" & Integer'Image(Start_Flag));
--Display on Text Screen
Text_IO.Put("TimeCnt=" & Integer'Image(TimeCnt));
Text_IO.Put(" Pos_X=");
Ada.Float_Text_IO.Put(S2Pos_X, 4,2,0); --Item, Fore, Aft, Exp
Text_IO.Put(" Pos_Y=");
Ada.Float_Text_IO.Put(S2Pos_Y, 4,2,0); --Item, Fore, Aft, Exp
Text_IO.Put(" L=");
Ada.Float_Text_IO.Put(Distance_SL, 4,2,0); --Item, Fore, Aft, Exp
Put_Line(" Draw1=" & Integer'Image(Draw_Plane_Counter) & " Diff=" & Integer'Image(Draw_Plane_Counter - Draw1_Before)
& " Pause_F=" & Integer'Image(Pause_Flag));
Draw1_Before := Draw_Plane_Counter;
End Calculate_Display_Sound;
-------------------------------------------------------------------
-- Set Listner location, set Spins LPOS_X & LPOS_Y to Buffers
-------------------------------------------------------------------
procedure On_Listner_Loc (Spin : access GObject_Record'Class) is
S : constant Gtk_Spin_Button := Gtk_Spin_Button (Spin);
X, Y : Glib.Gint;
Begin
Buf_LPOS_X := float(Get_Value(LPOS_X));
X := Glib.Gint(Buf_LPOS_X * float(Get_Value(PIXFACTOR_X))); --Glib.Gint
Buf_LPOS_Y := float(Get_Value(LPOS_Y));
Y := Glib.Gint(Buf_LPOS_Y * float(Get_Value(PIXFACTOR_Y)));
Move (CanvasG, DrawPic, X, Y); --To move the picture NOT "Cairo.Move_To" , use this Move command
end On_Listner_Loc;
-------------------------------------------------------
-- Run --
-------------------------------------------------------
procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
Label : Gtk_Label;
Error : Glib.Error.GError;
X, Y : Glib.Gint;
TempBox : Gtk_Box; --Spin setting
TempLabel : Gtk_Label; --Spin label setting
TempAdj : Gtk_Adjustment; --Spin setting
begin
Gtk_New_Vbox (Box, Homogeneous => False); --All screen
Add (Frame, Box); --Box.Add
Gtk_New_Hbox (Hbox1, Homogeneous => False); --Top Buttons Box, if True:Wide buttons, Faluse:Narrow
Pack_Start (Box, Hbox1, Expand => False, Fill => False);
Gtk_New_Hbox (HBox2, Homogeneous => False); --L pane +R Canvas. False:narrow, True: 50%/50%
Pack_Start (Box, HBox2, Expand => True, Fill => True);
Gtk_New_Vbox (VBoxL, Homogeneous => False); --LEFT Pane Box, If True then VBoxL1/VBoxL2=50%/50%
Pack_Start (HBox2, VBoxL, False, True, 30); -- 30 is VBoxL1/VBoxL2 portion of VBox2 Width
-- Pack_Start (HBox2, VBoxL, Expand=>False, Fill=>False); --Left pane is minimum
-- Pack_Start (HBox2, VBoxL, Expand=>True, Fill=>True); --50%/50%
-- Pack_Start (HBox2, VBoxL, Expand=>True, Fill=>False); --50%/50%
Gtk_New_VBox (VBoxL1, Homogeneous => False); --LEFT Pane Upper status area Box
Pack_Start (VBoxL, VBoxL1, False, True, 0);
Gtk_New_VBox (VBoxL2, Homogeneous => False); --LEFT Pane Lower Spin area Box
Pack_Start (VBoxL, VBoxL2, False, True, 0);
Gtk_New (Scrolled); --RIGHT Canvas Box
Pack_Start (HBox2, Scrolled, True, True); --Main-RIGHT Canvas is all remained area (wide)
CanvasG := new Image_Canvas_Record;
Gtkada.Canvas.Initialize (CanvasG);
Add (Scrolled, CanvasG);
--"Single" Button
Gtk_New (Button_Single, "Single");
Pack_Start (HBox1, Button_Single, Expand => False, Fill => True);
Canvas_Cb.Object_Connect
(Button_Single, "clicked",
Canvas_Cb.To_Marshaller (Button_Single_Cb'Access), CanvasG);
--"Loop" Button
Gtk_New (Button_Loop, "Loop");
Pack_Start (HBox1, Button_Loop, Expand => False, Fill => True);
Canvas_Cb.Object_Connect
(Button_Loop, "clicked",
Canvas_Cb.To_Marshaller (Button_Loop_Cb'Access), CanvasG);
--"Step" Button
Gtk_New (Button_Step, "Step");
Pack_Start (HBox1, Button_Step, Expand => False, Fill => True);
Canvas_Cb.Object_Connect
(Button_Step, "clicked",
Canvas_Cb.To_Marshaller (Button_Step_Cb'Access), CanvasG);
--"Clear" Button
Gtk_New (Button_Clear, "Clear");
Pack_Start (HBox1, Button_Clear, Expand => False, Fill => True);
Canvas_Cb.Object_Connect
(Button_Clear, "clicked",
Canvas_Cb.To_Marshaller (Button_Clear_Cb'Access), CanvasG);
--Left Pane Labels (Upper VBoxL1)
Gtk_New (Label_Dummy1, " "); --Dummy for clearance
Pack_Start(VBoxL1, Label_Dummy1, Expand=>False, Fill=>True);
Gtk_New (Label_TCnt, "TimeCnt= ");
Pack_Start(VBoxL1, Label_TCnt, Expand=>False, Fill =>True);
Gtk_New (Label_S2SndPos_X, "SndPos_X= ");
Pack_Start(VBoxL1, Label_S2SndPos_X, Expand=>False, Fill=>True);
Gtk_New (Label_S2SndPos_Y, "SndPos_Y= ");
Pack_Start(VBoxL1, Label_S2SndPos_Y, Expand=>False, Fill=>True);
Gtk_New (Label_SndVel_X, "SndVel_X= ");
Pack_Start(VBoxL1, Label_SndVel_X, Expand=>False, Fill=>True);
Gtk_New (Label_SndVel_Y, "SndVel_Y= ");
Pack_Start(VBoxL1, Label_SndVel_Y, Expand=>False, Fill=>True);
Gtk_New (Label_Speed_Angle, "Angle= ");
Pack_Start(VBoxL1, Label_Speed_Angle, Expand=>False, Fill=>True);
Gtk_New (Label_Start_Flag, "Start_Flag= ");
Pack_Start(VBoxL1, Label_Start_Flag, Expand=>False, Fill=>True);
Gtk_New (Label_Dummy1, " "); --Dummy for clearance
Pack_Start(VBoxL1, Label_Dummy1, Expand=>False, Fill=>True);
--"OFFSET_X" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "OFFSET_X");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 1.0, 0.2, 3.0, 0.1, 0.2); --Initial, Min, Max, Step, Page (Gtk.Adjustment)
Gtk_New (OFFSET_X, TempAdj, 0.01, 2); --Spin,Adj, Step, Digits after DP (Gtk.Spin_Button)
Pack_Start (TempBox, OFFSET_X, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--"OFFSET_Y" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "OFFSET_Y");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 1.0, 0.2, 5.0, 0.1, 0.2); --Initial, Min, Max, Step, Page (Gtk.Adjustment)
Gtk_New (OFFSET_Y, TempAdj, 0.01, 2);
Pack_Start (TempBox, OFFSET_Y, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--"PIXFACTOR-X" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "PIXFACTOR_X");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 350.0, 200.0, 500.0, 10.0, 20.0);
Gtk_New (PIXFACTOR_X, TempAdj, 1.0, 0);
Pack_Start (TempBox, PIXFACTOR_X, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--"PIXFACTOR-Y" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "PIXFACTOR_Y");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 180.0, 50.0, 300.0, 10.0, 20.0);
Gtk_New (PIXFACTOR_Y, TempAdj, 1.0, 0);
Pack_Start (TempBox, PIXFACTOR_Y, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--SON_POS_FACTOR" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "SND_POS_FACTOR");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 30.0, 1.0, 500.0, 1.0, 10.0);
Gtk_New (SND_POS_FACTOR, TempAdj, 1.0, 0);
Pack_Start (TempBox, SND_POS_FACTOR, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--SND_SPD_FACTOR" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "SND_SPD_FACTOR");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 200.0, 1.0, 500.0, 1.0, 10.0);
Gtk_New (SND_SPD_FACTOR, TempAdj, 1.0, 0);
Pack_Start (TempBox, SND_SPD_FACTOR, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--"TIME_CYCLE_X" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "TIME_CYCLE_X");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 10.0, 3.0, 30.0, 1.0, 2.0);
Gtk_New (TIME_CYCLE_X, TempAdj, 1.0, 0);
Pack_Start (TempBox, TIME_CYCLE_X, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--"TIME_CYCLE_Y" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "TIME_CYCLE_Y");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 10.0, 3.0, 30.0, 1.0, 2.0);
Gtk_New (TIME_CYCLE_Y, TempAdj, 1.0, 0);
Pack_Start (TempBox, TIME_CYCLE_Y, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
--"LPOS_X" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "LPOS_X");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 1.0, 0.2, 3.0, 0.01, 0.1);
Gtk_New (LPOS_X, TempAdj, 0.01, 2);
Pack_Start (TempBox, LPOS_X, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
TempAdj.On_Value_Changed(On_Listner_Loc'Access,LPOS_X);
--"LPOS_Y" Spin
Gtk_New_VBox (TempBox, Homogeneous => False); --LEFT Pane upper status area Box
Gtk_New (TempLabel, "LPOS_Y");
Pack_Start (TempBox, TempLabel, Expand => False, Fill => False);
Gtk_New (TempAdj, 2.8, 0.5, 5.0, 0.01, 0.1); --Initial, Min, Max, Step, Page (Gtk.Adjustment)
Gtk_New (LPOS_Y, TempAdj, 0.01, 2); --Spin,Adj, Step, Digits after DP (Gtk.Spin_Button)
Pack_Start (TempBox, LPOS_Y, Expand => False, Fill => False);
Pack_Start (VBoxL2, TempBox, Expand => False, Fill => False);
TempAdj.On_Value_Changed(On_Listner_Loc'Access,LPOS_Y);
--Setup Canvas background color and location
Align_On_Grid (CanvasG, False); --Locate dragged Object on the nearest grid or not.
Configure (CanvasG,
Grid_Size=>0, --Size=0 is no grid on the Canvas, 10=10dot pitch
Background=>(0.01,0.01,0.01,0.03)); --Canvas Back color: RGBA, Gdk.RGBA.Gdk_RGBA := Gdk.RGBA.White_RGBA);
--Display Listner Picture image in RIGHT CANVAS ************
Gdk_New_From_File (PixG, "./BackShot140140.png", Error);
if PixG = Null_Pixbuf then --If Error:
Gtk_New (Label, "Pixmaps #1 not found. Please run testgtk from the"
& " testgtk/ directory itself.");
Add (VBoxL, Label);
Show_All (VBoxL);
return;
end if;
Initialize_Listener_Image (DrawPic, PixG, "Listener"); --Set Picture. New Original Procedure Initialize_Listener_Image
--Display Listner Image
Buf_LPOS_X := float(Get_Value(LPOS_X));
X := Glib.Gint(Buf_LPOS_X * float(Get_Value(PIXFACTOR_X))); --Glib.Gint
Buf_LPOS_Y := float(Get_Value(LPOS_Y));
Y := Glib.Gint(Buf_LPOS_Y * float(Get_Value(PIXFACTOR_Y)));
Put (CanvasG, DrawPic, X, Y); --Display Listener Photo image
--Display Source Image
Initial_Plane_Item_Setup (CanvasG); --Setup Item1
Put (CanvasG, Item1, 2, 200); ---Gtkada.Canvas.Put(), Display Plane Graphics at the initial position
-- Refresh_Canvas (CanvasG);
-- Show_Item (CanvasG, Item1);
-- Show_All (FrameM);
end Run;
end Gui;Audio_Specification
with Gtk.Widget; use Gtk.Widget;
with Gtk.Handlers; use Gtk.Handlers;
with Interfaces; use Interfaces;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Sequential_IO; --use Ada.Sequential_IO; --cannot use "use" for this generic package
with OpenAL.Context; use OpenAL.Context; --use is needed
with OpenAL.List;
with OpenAL.Types;
with OpenAL.Buffer;
with OpenAL.Error; use OpenAL.Error; --use is needed
with OpenAL.Listener;
with OpenAL.Source;
with OpenAL.Thin;
with OpenAL.Global; use OpenAL.Global; --for Get_Doppler_Factor
Package Audio is
package Handlers is new Gtk.Handlers.Callback --Need with Gtk.Handlers
(Widget_Type => Gtk_Widget_Record); --Need with Gtk.Widget
Function Test_Error (Display_Message : String) return Boolean;
WAVE_FILE_NAME : constant string := "testsound.wav";
Function LoadWaveFile(
WaveFile: in String; -- WAV File name string
Format : out Unsigned_16; --PCM=01,00
Data : out OpenAL.Buffer.Sample_Array_16_t;
Length : out Unsigned_32; --Byte, Only Data portion=(05..08)+8-44
Freq : out OpenAL.Types.Size_t;
Channel : out Unsigned_16; --1ch=01,00, 2ch=02,00
Sample : out Unsigned_16 --16bit=10,00
) Return Boolean;
Procedure ALSound_Initialize;
Procedure ALSound_Process;
---------------------------------------
--CONSTANT
---------------------------------------
LISTENER_GAIN : constant := 10.0;
---------------------------------------
-- GLOBAL VARIABLES
---------------------------------------
CX_Devicet : OpenAL.Context.Device_t; --Used when Open and Close Audio Context
Sound_Source : OpenAL.Source.Source_t;
Sound_Source_Array : OpenAL.Source.Source_Array_t(1..1);
end Audio;Audio_Body
with Ada.Text_IO; use Ada.Text_IO;
with Gui; use Gui;
Package body Audio is
---------------------------------------------------------
-- Function: Display OpenAL Procedure/Function Result
-- In: OpenAL result Code number
-- Out: Boolean result. Good=True, Error=False
-- Note; Function Get_Error doesn't work perfectly
-- Note; Error Codes are different between in Spec and in Code.
---------------------------------------------------------
Function Test_Error (Display_Message : String) return Boolean is
Result : Boolean;
Errort : OpenAL.Error.Error_t;
begin
Errort := OpenAL.Error.Get_Error;
If(Errort = No_Error) then
Result := True;
else
Result := False;
end if;
Put(Display_Message & " ");
Case Errort is
when No_Error => Put_Line("GOOD: SUCCESS");
when Invalid_Name => Put_Line("ERROR!!! Invalid_Name####################");
when Invalid_Enumeration => Put_Line("ERROR!!! Invalid_Enumeration###########################");
when Invalid_Value => Put_Line("ERROR!!! Invalid_Value####################");
when Invalid_Operation => Put_Line("ERROR!!! Invalid_Opearation######################");
when Out_Of_Memory => Put_Line("ERROR!!! Out_Of_Memory###################");
when Unknown_Error => Put_Line("ERROR!!! Unknown_Error###################");
when Others => Put_Line("ERROR!!! UNDEFINED ERROR######################");
end case;
Return Result;
end Test_Error;
---------------------------------------------------------
-- Function: Open WAV file and store the parameters and data
-- IN: File name string and output valiable addresses,
-- OUT: Boolean result Good=True, Error=False
---------------------------------------------------------
Function LoadWaveFile (
WaveFile: in String; -- File name string
Format : out Unsigned_16; --PCM=01,00
Data : out OpenAL.Buffer.Sample_Array_16_t;
Length : out Unsigned_32; --Byte, Only Data portion=(05..08)+8-44
Freq : out OpenAL.Types.Size_t;
Channel : out Unsigned_16; --1ch=01,00, 2ch=02,00
Sample : out Unsigned_16 --16bit=10,00
) Return Boolean is --True=Success, False=Error
---
type Sample_16_t is range -32768 .. 32767;
for Sample_16_t'Size use 16;
package UWI_IO is new Ada.Sequential_IO (Unsigned_16);
use UWI_IO;
FT : UWI_IO.File_Type;
WAttrb : array (1..50) of Unsigned_16 := (1..50 => 0); --Wave file Attribute portion
Cnt : Integer;
Index : array (1..2) of Unsigned_16 := (Others=>0); --"data" search buffer in WAV file header
K1,K2 : Unsigned_16;
Data1U16 : Unsigned_16;
Data1S16t : OpenAL.Buffer.Sample_16_t;
DataCnt : Integer;
Begin
Begin --File open
UWI_IO.Open (File=>FT, Mode=>In_File, Name=>WaveFile); --Text_IO Open doesnot work for Binary file
exception
when others=>
Put_Line("ERROR!!! WAV File cannot Open");
raise;
end; --File open end
Put_Line("File Open done");
Cnt := 1;
while not End_Of_File (FT) loop
Read(FT, WAttrb(Cnt));
Index(1):=Index(2); Index(2):=WAttrb(Cnt);
exit when ((Index(1)=16#6164#) and (Index(2)=16#6174#)); -- Found "data"=Subchunk2 ID
If (Cnt=50-2) then
Put_Line("ERROR WAV file Index is too long");
Return False;
end if; --WAVE FORMAT ERROR
Cnt := Cnt+1;
end loop;
--"data" was found, then get next Subchunk2Size
Read(FT, K1);
WAttrb(Cnt):=K1; -- Lower 16bit of Data number of BYTE Length 32bit
Cnt := Cnt + 1;
Read(FT, K2);
WAttrb(Cnt):=K2; -- Upper 16bit
Length := Unsigned_32(K2)*65536 + Unsigned_32(K1); -- Data Length, number of BYTE
DataCnt := 1;
while not End_Of_File (FT) loop
Read(FT, Data1U16);
if(Data1U16<32768) then Data1S16t := OpenAL.Buffer.Sample_16_t(Data1U16); --Positive
else Data1S16t := OpenAL.Buffer.Sample_16_t(-(Integer_16(NOT Data1U16) + 1)); --Negative value
end if;
Data(OpenAL.Buffer.Sample_Size_t(DataCnt)) := Data1S16t; --Store data
DataCnt := DataCnt + 1;
If (DataCnt > Integer(Length)/2+1) then --DataCnt=16bit, Length=8bit
Put_Line("ERROR WAV file DATA is too long");
Return False;
end if;
end loop;
Put_Line("DataCnt=" & Integer'Image(DataCnt) & " Integer(Length)/2+1=" & Integer'Image(Integer(Length)/2+1));
--Result is: DataCnt= 220501 Integer(Length)/2+1= 220501
Close (FT); -- File close
Format := WAttrb(11); --PCM=0001=01,00
Freq := OpenAL.Types.Size_t(Unsigned_32(WAttrb(13)) + Unsigned_32(WAttrb(14))*65536);
Channel := WAttrb(12);
Sample := Wattrb(18);
Return True; --Success End
End LoadWaveFile;
----------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------
-- Sound Initialize
-- Open Wav file and setup all parameters, but
----------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------
Procedure ALSound_Initialize is
Bool : Boolean;
NrPlayback_Devices : Integer;
Vector_Cnt : Integer;
Playback_StrVectt : OpenAL.List.String_Vector_t;
UB_OpenAL_Version : Unbounded_String;
UB_Default_Play : Unbounded_String;
UB_Playback_Devices : Unbounded_String;
CX_Contextt : OpenAL.Context.Context_t;
Set_Active_Context : Boolean;
Source_Set_Position : OpenAL.Types.Vector_3f_t := (0.0, 1.0, 0.0); --X,Y,Z
Source_Set_Velocity : OpenAL.Types.Vector_3f_t := (0.0, 0.0, 0.0); --X,Y,Z
Source_Set_Direction: OpenAL.Types.Vector_3f_t := (0.0, 1.0, 0.0); --X,Y,Z
Listener_Set_Position : OpenAL.Types.Vector_3f_t := (0.0, 2.0, 0.0); --X,Y,Z
Listener_Set_Velocity : OpenAL.Types.Vector_3f_t := (0.0, 0.0, 0.0); --X,Y,Z
Listener_Orientation_Forward : OpenAL.Types.Vector_3f_t := (0.0, 1.0, 0.0); --X,Y,Z
Listener_Orientation_Up : OpenAL.Types.Vector_3f_t := (0.0, 0.0, 1.0); --X,Y,Z
SoundWaveFileName : String := WAVE_FILE_NAME; --"testsound.wav"
Result_WaveFileOPen : Boolean;
WAV_Format : Interfaces.Unsigned_16; --PCM=01,00
WAV_Data : OpenAL.Buffer.Sample_Array_16_t(1..1000000); --WAV File Word Max Capacity
WAV_Length : Unsigned_32; --Only Data portion number of Byte (chunk2 data area)
WAV_Freq : OpenAL.Types.Size_t;
WAV_Channel : Unsigned_16; --1ch=01,00, 2ch=02,00
WAV_Sample : Unsigned_16; --16bit=10,00
Buffer_Arrt : OpenAL.Buffer.Buffer_Array_t (1..1000000); --WAV File Word Max Capacity
ProcessedNr : Natural;
begin
Put_Line("OpenAL Program Sample1");
--***********
--Get OpenAL Version number
--***********
-- UB_OpenAL_Version := To_Unbounded_String(OpenAL.Global.Vendor); --"Version" causes error. Not supported.
--***********
--Get_Default_Device_Specifier (Default Playback)
--***********
--use To_Unbounded_String, because the length is unknown
UB_Default_Play:=To_Unbounded_String(OpenAL.Context.Get_Default_Device_Specifier);
Put_Line("Default Playback=" & UB_Default_Play);
--***********
--Get_All_Device_Specifiers (All Playbacks)
--***********
Playback_StrVectt := OpenAL.Context.Get_Available_Playback_Devices;
Vector_Cnt := 1;
Put_Line("");
Bool := OpenAL.List.String_Vectors.Is_Empty(Playback_StrVectt); --TRUE=EMPTY
NrPlayback_Devices := Integer(OpenAL.List.String_Vectors.Length(Playback_StrVectt));
If(Bool) then --EMPTY
Put_Line("No Playback Device, N=" & Integer'Image(NrPlayback_Devices));
else
Put_Line("Playback Devices N=" & Integer'Image(NrPlayback_Devices));
Vector_Cnt := 1;
Loop
UB_Playback_Devices := To_Unbounded_String(Playback_StrVectt(Vector_Cnt));
Put_Line("Playback Devices Length=" & Integer'image(Length(UB_Playback_Devices)));
Put_Line("Playback Device#" & Integer'Image(Vector_Cnt) & "=" & UB_Playback_Devices);
Vector_Cnt := Vector_Cnt + 1;
Exit when Vector_Cnt >= NrPlayback_Devices;
end loop;
end if;
--****************
-- OPEN Playback Device
-- C: device = alcOpenDevice(NULL); // open default device
---***************
CX_Devicet := OpenAL.Context.Open_Device ("OpenAL Soft"); --"OpenAL Soft")
Put_Line("UB_Playback_Device=" & UB_Playback_Devices);
if (CX_Devicet = Invalid_Device) then --Ref file: openal-alc_thin.ads
Put_Line("BAD-Invalid Device!!! Cannot open Playback Device*******");
else
Put_Line("GOOD, Open Output Device Success");
end if;
--****************
-- Create Context
-- C: context=alcCreateContext(device,NULL); // create context
--****************
CX_Contextt := Create_Context (CX_Devicet);
if (CX_Contextt = Invalid_Context) then --Ref file: openal-alc_thin.ads
Put_Line("BAD-Invalid Context!!! Cannot Create Context *******");
else
Put_Line("GOOD, Create Context Success");
end if;
--****************
-- Set Active Context
-- C: alcMakeContextCurrent(context); // set active context
--****************
Set_Active_Context := Make_Context_Current(CX_Contextt);
if (Set_Active_Context = False) then
Put_Line("ERROR Set Active Context!!! Cannot Set Active Context *******");
end if;
If (Test_Error("Set_Active_Context") = False) then goto END_OF_PROGRAM; end if;
--****************
-- Load testsound.wav
-- Same the old loadWAVFile("testsound.wav",&format,&data,&Length,&freq,&loop);----This is Obsolete
--****************
Result_WaveFileOpen := LoadWaveFile(
SoundWaveFileName,
WAV_Format, -- PCM=0001
WAV_Data, -- Sample_Array_16_t(1)
WAV_Length, -- Number of Wave data Byte
WAV_Freq, -- Frequency_t
WAV_Channel,
WAV_Sample);
If (Result_WaveFileOpen=False) then
Put_Line("Wave file Open ERROR");
goto END_OF_PROGRAM;
end if;
Put_Line("Sound File=" & SoundWaveFileName);
Put("Format=" & Unsigned_16'image(WAV_Format));
If(WAV_Format=1) then Put_Line(" PCM"); else Put_Line(" Some format"); end if;
Put_Line("WAV Data Length=" & Unsigned_32'image(WAV_Length) & " Byte");
Put_Line("Sampling Freq=" & OpenAL.Types.Size_t'image(WAV_Freq) & "Hz");
Put_Line("Channel=" & Unsigned_16'image(WAV_Channel));
Put_Line("Sample=" & unsigned_16'image(WAV_Sample) & "bit");
--****************
--Generate Buffers
-- C: alGenBuffers(NUM_BUFFERS, g_Buffers);
-- Ada: procedure Generate_Buffers (Buffers : in out Buffer_Array_t);
-- The Generate_Buffers procedure generates Buffers'Length buffers.
--****************
OpenAL.Thin.Gen_Buffers
(Size => OpenAL.Types.Size_t(WAV_Length/2), --Set number of Words
Buffers => Buffer_Arrt(1)'Address);
Put_Line("Generated Buffer, WAV_Length=" & Unsigned_32'Image(WAV_Length) & " Byte");
--****************
--Copy WAV data into AL Buffer 0
-- C: alBufferData(g_Buffers[0],format,data,Size(number of Bytes),freq);
-- This proc is not written in the manual, it is in OpenAL.Thin source.
-- It can set Size freely, so it is good to define maximum WAV buffer
--****************
OpenAL.Thin.Buffer_Data(
Buffer_ID => 1, --Types.Unsigned_Integer_t;
Format => OpenAL.Thin.AL_FORMAT_MONO16, --Types.Enumeration_t;
Data => WAV_Data(1)'Address, --system.Address;
Size => OpenAL.Types.Size_t(WAV_Length), --Types.Size_t;==This Length is adjustable
Frequency => WAV_Freq --Types.Size_t;
);
--****************
-- Generate Sources
-- C: alGenSources((ALuint)1, &source); //generates one or more sources, n=number
-- If error: alDeleteBuffers(NUM_BUFFERS, g_Buffers) ???? This was not written in the sample program
--****************
OpenAL.Source.Generate_Sources (Sound_Source_Array); --Gval.Sound_Source_Array(1..1) only one array
Sound_Source := Sound_Source_Array(1); --Sound_Source:Source_t
If (Test_Error("Generate-Sources (Gval.Sound_Source_Array)") = False) then goto END_OF_PROGRAM; end if;
OpenAL.Source.Get_Buffers_Processed (Sound_Source, ProcessedNr);
Put_Line("1 Number of Processed buffers=" & Natural'image(ProcessedNr)); --Nu=0 Just to monitor
OpenAL.Source.Get_Buffers_Queued (Sound_Source, ProcessedNr);
Put_Line("Number of Processed buffers Queued=" & Natural'image(ProcessedNr)); --Queued=0 just to monitor
If(OpenAL.Source.Is_Valid(Sound_Source)=True) then Put_Line("Is_Vlaid=True"); else Put_Line("Is_Valid=False"); end if;
---****************
--Attach buffer to source
-- C: alSourcei(source[0], AL_BUFFER, g_Buffers[0]);
-- procedure Set_Current_Buffer
-- (Source : in Source_t;
-- Buffer : in OpenAL.Buffer.Buffer_t);
--****************
OpenAL.Source.Set_Current_Buffer
(Sound_Source,
Buffer_Arrt(1));
Put_Line("Attached buffer to Source");
OpenAL.Source.Get_Buffers_Processed (Sound_Source, ProcessedNr);
Put_Line("2 Number of Processed buffers=" & Natural'image(ProcessedNr)); --Nr=0 just to monitor
OpenAL.Source.Get_Buffers_Queued (Sound_Source, ProcessedNr);
Put_Line("Number of Processed buffers Queued=" & Natural'image(ProcessedNr)); --Queued=1 just to monitor
If(OpenAL.Source.Is_Valid(Sound_Source)=True) then Put_Line("Is_Vlaid=True"); else Put_Line("Is_Valid=False"); end if;
--****************
-- Set SOURCE Position, Velocity, Direction
-- procedure Set_Position_Float_List
-- (Source : in Source_t;
-- Position : in Types.Vector_3f_t);
--****************
OpenAL.Source.Set_Position_Float_List(Sound_Source, Source_Set_Position);
If (Test_Error("Set Source Set_Position_Float_List") = False) then goto END_OF_PROGRAM; end if;
OpenAL.Source.Set_Velocity_Float_List(Sound_Source, Source_Set_Velocity);
If (Test_Error("Set Source Set_Velocity_Float_List") = False) then goto END_OF_PROGRAM; end if;
OpenAL.Source.Set_Direction_Float_List(Sound_Source, Source_Set_Direction);
If (Test_Error("Set Source Set_Direction_Float_List") = False) then goto END_OF_PROGRAM; end if;
--****************
-- Set LISTENER Position, Velocity, Direction
-- procedure Set_Position_Float_List
-- (Position : in Types.Vector_3f_t);
---****************
OpenAL.Listener.Set_Position_Float_List(Listener_Set_Position); --X,Y,Z set the position of the listener
If (Test_Error("Set Listener Set_Position_Float_List") = False) then goto END_OF_PROGRAM; end if;
OpenAL.Listener.Set_Velocity_Float_List(Listener_Set_Velocity); --X,Y,Z set the velocity of the listener
If (Test_Error("Set Listener Set_Velocity_Float_List") = False) then goto END_OF_PROGRAM; end if;
OpenAL.Listener.Set_Orientation_Float(Listener_Orientation_Forward, Listener_Orientation_Up);
If (Test_Error("Set Listener Orientation Fwd/Up") = False) then goto END_OF_PROGRAM; end if;
---****************
--****************
-- Set Listener GAIN
--****************
OpenAL.Listener.Set_Gain(LISTENER_GAIN);
<< END_OF_PROGRAM >> -- label for goto when Error
end ALSound_Initialize;
-------------------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------------------
-- Output Audio Control Process
-- Called by Timer Interrupt when Start_Flag /= 0
-------------------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------------------
Procedure ALSound_Process is
Begin
-- Set Source, Listener Position
OpenAL.Source.Set_Position_Float(Sound_Source, OpenAL.Types.Float_t(S2SndPos_X) , OpenAL.Types.Float_t(S2SndPos_Y) , 0.0); -- Left(-) to Right(+), XYZ Float
OpenAL.Listener.Set_Position_Float(0.0 , 0.0 , 0.0); -- Listner is Origin=0,0,0. Source uses Relative distance from Listener.
-- Set Velocity
OpenAL.Source.Set_Velocity_Float(Sound_Source, OpenAL.Types.float_t(Vel_Snd_X), OpenAL.Types.float_t(Vel_Snd_Y), 0.0); -- Increase from 0, XYZ Float
end ALSound_Process;
----------------------------------------------------------------------------------------------------------
End Audio;Timer_Interrupt_Specification
with OpenAL.Context;
with OpenAL.List;
with OpenAL.Types;
with OpenAL.Buffer;
with OpenAL.Error;
with OpenAL.Listener;
with OpenAL.Source;
with OpenAL.Thin;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Button; use Gtk.Button;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Spin_Button; use Gtk.Spin_Button;
with Gtk.Progress_Bar; use Gtk.Progress_Bar; --Timer Interrupt
with Ada.Real_Time; use Ada.Real_Time; --Timer Interrupt
with Glib.Main; use Glib.Main; --Timer Interrupt Time_Cb.Timeout_Add
with Gdk.RGBA; use Gdk.RGBA;
with Text_IO; use Text_IO;
package Tintr is
function Timer_Intr (Pbar : Gtk_Progress_Bar) return Boolean;
TimerIntrDuration : Time_Span; --need with Ada.Real_Time
TimerIntrCounter : integer := 0;
TINTR_PITCH : Constant := 100; --100=100ms, 200=200ms
TIMECNT_DRAW_PRESET : Constant := 4; --In Draw, countdown TimeCnt_Draw preset value
TimeCnt : Integer := TIMECNT_DRAW_PRESET; --Playback Time/Location/Speed Counter
TimerIntrCounter_Before : Integer :=0; --In Draw, check if TimeCnt is same or changed
TimeCnt_Draw : integer :=0; --In Draw, count how many Draw is accepted in a TimeCnt
Direction : Integer := 0; --0=Positive(to right), 1=Negative (to Left)
Datatype_dummy : Gtk_Progress_Bar; --Timer interrupt
EndFlag : Integer; --Playback loop End Flag
Gid_dummy : G_Source_Id; --Timer interrupt
Start_Flag : Integer := 0; --0=stop,1=Single Start,2=Single busy, 3=Step Start, 4=Step busy,5=Loop start,6=Loop busy
Pause_Flag : Integer := 0; --default=0, Pause=1
end Tintr;Timer_Interrupt_Body
with Gui; use Gui;
with Audio; use Audio;
Package body Tintr is
--------------------------------------------------------
--------------------------------------------------------
--TIMER INTERRUPT
--------------------------------------------------------
--------------------------------------------------------
function Timer_Intr (Pbar : Gtk_Progress_Bar) return Boolean is
begin
If(Start_Flag =0) then --Flag=0 Nothing to do
TimerIntrCounter := TimerIntrCounter + 1;
TimeCnt := 0;
Time_X := 0.0;
Time_Y := 0.0;
Return True;
end if;
--------------------
-- Display Graphics and Audio Output
--------------------
Display_Plane (TimeCnt); --Calculate and Move Plane
ALSound_Process; --Set Audio Source & Listner Position XYZ and Source Velocity XYZ
if (Pause_Flag=1) then --Pause, then do nothing (keep audio and position)
TimerIntrCounter := TimerIntrCounter + 1;
Return True;
end if;
if ((Start_Flag=1) or (Start_Flag=3) or (Start_Flag=5)) then
--Button was pressed, Begin Audio
OpenAL.Source.Set_Looping(Audio.Sound_Source, Looping => True); --Manual doc is wrong
OpenAL.Source.Play (Audio.Sound_Source_Array(1));
Put_Line("Play(Sound_Source)");
If ((Start_Flag=1) or (Start_Flag=5)) then
TimeCnt := 0; --Initialize
end if;
Start_Flag := Start_Flag + 1; --Flag 1=>2, 3=>4, 5=>6
end if;
--STEP mode and Counter is busy
If (Start_Flag=4) then --STEP mode
If (Step_Counter /= 0) then
Step_Counter := Step_Counter - 1;
If (Step_Counter = 0) then
Pause_Flag := 1;
Set_Label (Button_Step, "Step"); --Turn to stop STEP
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
end if;
end if;
end if; --End Start_Flag=1,3,5
TimerIntrCounter := TimerIntrCounter +1;
TimeCnt := TimeCnt + 1;
Time_X := Time_X +1.0;
If ((Time_X * float(TINTR_PITCH) /1000.0) >= float(Get_Value(TIME_CYCLE_X))) then
--Timer(X) is full, Plane is at the start position, then one loop was finished.
Time_X := 0.0;
If (Start_Flag=2) then --Single loop complted, then stop the process.
--Single mode and End cycle. Finish Single process
Start_Flag := 0;
Pause_Flag := 0;
Set_Label (Gui.Button_Single, "Single");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Single), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Gui.Button_Loop, "Loop");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Loop), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
Set_Label (Button_Step, "Step");
Parse (ButtonColor, "Black", Dummy_Boolean);
Gtk.Widget.Override_Color(Gtk_Widget(Button_Step), Gtk_State_Flag_Normal ,ButtonColor); --Button Character Color is switched to Red, Modify is obsolete
OpenAL.Context.Close_Device (Audio.CX_Devicet); -- CLOSE "OpenAL Soft" and stop sound
Return True;
end if;
--On the way processing
end if;
Time_Y := Time_Y +1.0;
If ((Time_Y * float(TINTR_PITCH) /1000.0) >= float(Get_Value(TIME_CYCLE_Y))) then
Time_Y := 0.0;
end if;
Return True;
end Timer_Intr;
End Tintr;Common_Programs_Specification
with Gtk.Main; use Gtk.Main;
with Gtk; use Gtk;
with Gtk.Adjustment; use Gtk.Adjustment;
with Gtk.Button; use Gtk.Button;
with Gtk.Check_Button; use Gtk.Check_Button;
with Gtk.Dialog; use Gtk.Dialog;
with Gtk.Label; use Gtk.Label;
with Gtk.Handlers; use Gtk.Handlers;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Window; use Gtk.Window;
with Glib; use Glib;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Gdk.Event; use Gdk.Event;
package Common is
package Widget_Handler is new Handlers.Callback (Gtk_Widget_Record);
package User_Widget_Handler is new Handlers.User_Callback
(Gtk_Widget_Record, Gtk_Widget);
package Label_Handler is new Handlers.Callback (Gtk_Label_Record);
package Adj_Handler is new Handlers.Callback (Gtk_Adjustment_Record);
package Check_Handler is new Handlers.Callback (Gtk_Check_Button_Record);
package Button_Handler is new Handlers.Callback (Gtk_Button_Record);
type Gtk_Window_Access is access all Gtk_Window;
package Destroy_Handler is new Handlers.User_Callback
(Gtk_Window_Record, Gtk_Window_Access);
function Delete_Event_Cb
(Self : access Gtk_Widget_Record'Class;
Event : Gdk.Event.Gdk_Event)
return Boolean;
procedure Destroy_Window
(Win : access Gtk.Window.Gtk_Window_Record'Class;
Ptr : Gtk_Window_Access);
type Gtk_Dialog_Access is access all Gtk_Dialog;
package Destroy_Dialog_Handler is new Handlers.User_Callback
(Gtk_Dialog_Record, Gtk_Dialog_Access);
procedure Destroy_Dialog (Win : access Gtk_Dialog_Record'Class;
Ptr : Gtk_Dialog_Access);
end Common;Common_Programs_Body
package body Common is
---------------------
-- Delete_Event_Cb --
---------------------
function Delete_Event_Cb
(Self : access Gtk_Widget_Record'Class;
Event : Gdk.Event.Gdk_Event)
return Boolean is
begin
Gtk.Main.Main_Quit;
return True;
end Delete_Event_Cb;
--------------------
-- Destroy_Window --
--------------------
procedure Destroy_Window
(Win : access Gtk.Window.Gtk_Window_Record'Class;
Ptr : Gtk_Window_Access) is
begin
Ptr.all := null;
end Destroy_Window;
--------------------
-- Destroy_Dialog --
--------------------
procedure Destroy_Dialog
(Win : access Gtk.Dialog.Gtk_Dialog_Record'Class;
Ptr : Gtk_Dialog_Access) is
begin
Ptr.all := null;
end Destroy_Dialog;
end Common;Global_Variables_Specification
--GLOBAL VALIABLES (.ADS only)
with Gtk.Box; use Gtk.Box;
with Gtk.Label; use Gtk.Label;
with Gtk.Button; use Gtk.Button;
with Gtk.Window; use Gtk.Window;
with Gtk.Fixed; use Gtk.Fixed; --To layout Button
with Ada.Real_Time; use Ada.Real_Time;
with Gtk.Progress_Bar; use Gtk.Progress_Bar;
--with Glib; use Glib;
--with Glib.Object; use Glib.Object;
--with Gtk.Frame; use Gtk.Frame;
--with Ada.Text_IO; use Ada.Text_IO;
--with Gtk.Fixed; use Gtk.Fixed; --To layout Button
--with Gtk.Spin_Button; use Gtk.Spin_Button;
--with Gtk.Toggle_Button; use Gtk.Toggle_Button;
with Gtk.Progress_Bar; use Gtk.Progress_Bar;
--with Ada.Real_Time; use Ada.Real_Time;
with Glib.Main; use Glib.Main; --Timer Interrupt Time_Cb.Timeout_Add
with OpenAL.Source;
with OpenAL.Context; use OpenAL.Context;
with OpenAL.Types;
package Gval is
Win : Gtk_Window; --Need with Gtk.Window
Fix : Gtk_Fixed;
Box1 : Gtk_Box;
Label1 : Gtk_Label;
Label2 : Gtk_Label;
Label3 : Gtk_Label;
Button1 : Gtk_Button;
Button2 : Gtk_Button;
-- Counter : Integer := 0;
CX_Devicet : OpenAL.Context.Device_t;
TimeCnt : Integer := 0; --Playback Time/Location/Speed Counter
Direction : Integer := 0; --0=Positive(to right), 1=Negative (to Left)
SetPosF, SetVelF : OpenAL.Types.Float_t; --Vector Calculation
SourcePositionF, SourceVelocityF : Float;
Sound_Source : OpenAL.Source.Source_t;
Sound_Source_Array : OpenAL.Source.Source_Array_t(1..1);
Datatype_dummy : Gtk_Progress_Bar; --Timer interrupt
Gid_dummy : G_Source_Id; --Timer interrupt
-- TIntr_Flag : Integer := 0; --0:before start
AudioFlag : Integer := 0;
AudioLoopFlag : Integer := 0;
TimerIntrDuration : Time_Span; --need with Ada.Real_Time
TimerIntrCounter : integer := 0;
TINTR_PITCH : Constant := 50; --100=50ms, 200=100ms
EndFlag : Integer; --Playback loop End Flag
end Gval; Picture_of_Listener_140x140pix
1kHz_Sound_File
1kHz Tone
Format: PCM, Duration:5sec, Bitrate:705.6kbps, 1channel, Sampling rate:44.1kHz, 16bit, Size:431kB