-- Copyright ©2021,2022 Steve Merrony
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.
with Ada.Directories;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Sequential_IO;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with GNAT.Serial_Communications; use GNAT.Serial_Communications;
with Gdk.Event; -- use Gdk.Event;
with Gdk.Threads;
with Gdk.Types.Keysyms; use Gdk.Types.Keysyms;
with Glib; use Glib;
with Glib.Error; use Glib.Error;
with Gtk.About_Dialog; use Gtk.About_Dialog;
with Gtk.Button;
with Gtk.Clipboard;
with Gtk.Combo_Box_Text;
with Gtk.Container;
with Gtk.Css_Provider; use Gtk.Css_Provider;
with Gtk.Dialog; use Gtk.Dialog;
with Gtk.Drawing_Area;
with Gtk.GEntry;
with Gtk.Enums; use Gtk.Enums;
with Gtk.File_Chooser;
with Gtk.File_Chooser_Dialog;
with Gtk.Frame;
with Gtk.Main;
with Gtk.Menu; use Gtk.Menu;
with Gtk.Menu_Bar; use Gtk.Menu_Bar;
with Gtk.Message_Dialog; use Gtk.Message_Dialog;
with Gtk.Radio_Button;
with Gtk.Scrolled_Window;
with Gtk.Separator;
with Gtk.Separator_Menu_Item; use Gtk.Separator_Menu_Item;
with Gtk.Stock;
with Gtk.Style_Context;
with Gtk.Style_Provider;
with Gtk.Text_Buffer;
with Gtk.Text_View;
with Gtk.Widget; use Gtk.Widget;
with Gtkada.Dialogs; use Gtkada.Dialogs;
with Gtkada.File_Selection;
with Interfaces;
with Text_IO.Unbounded_IO;
with BDF_Font; use BDF_Font;
with Crt;
with Dasher_Codes;
with Display_P; use Display_P;
with Embedded;
with Keyboard;
with Logging; use Logging;
with Mini_Expect;
with Session_Logger;
with Redirector; use Redirector;
with Serial;
with Xmodem;
package body GUI is
package FA is new Gtk.Container.Forall_User_Data (Gtk.Style_Provider.Gtk_Style_Provider);
procedure Apply_Css (Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class;
Provider : Gtk.Style_Provider.Gtk_Style_Provider) is
-- Apply the given CSS to the widget (which may be a container)
begin
Gtk.Style_Context.Get_Style_Context (Widget).Add_Provider (Provider, Glib.Guint'Last);
if Widget.all in Gtk.Container.Gtk_Container_Record'Class then
declare
Container : constant Gtk.Container.Gtk_Container := Gtk.Container.Gtk_Container (Widget);
begin
FA.Forall (Container, Apply_Css'Unrestricted_Access, Provider);
end;
end if;
end Apply_Css;
procedure Window_Close_CB (Window : access Gtk_Widget_Record'Class) is
pragma Unreferenced (Window);
begin
Log (DEBUG, "Calling Main_Quit at level: " & Gtk.Main.Main_Level'Image);
Gtk.Main.Main_Quit;
exception
when others =>
null;
end Window_Close_CB;
procedure Quit_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Conn : Connection_T;
begin
Router.Get_Destination (Conn);
case Conn is
when Local =>
null;
when Async =>
Serial.Close;
when Network =>
Telnet_Sess.Close_Connection;
end case;
Gtk.Main.Main_Quit;
end Quit_CB;
procedure About_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Dialog : Gtk_About_Dialog;
Dummy_Response : Gtk_Response_Type;
begin
Gtk_New (Dialog);
Dialog.Set_Destroy_With_Parent (True);
Dialog.Set_Modal (True);
Dialog.Set_Logo (Icon_PB);
Dialog.Set_Authors ((1 => new String'(App_Author)));
Dialog.Set_Copyright (App_Copyright);
Dialog.Set_Comments (App_Comment);
Dialog.Set_Program_Name (App_Title);
Dialog.Set_Version (App_SemVer);
Dialog.Set_Website (App_Website);
Dummy_Response := Dialog.Run;
Dialog.Destroy;
end About_CB;
procedure D200_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
Term.Emulation := Terminal.D200;
end D200_CB;
procedure D210_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
Term.Emulation := Terminal.D210;
end D210_CB;
procedure Resize_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Dialog : Gtk_Dialog;
Dlg_Box, HB1, HB2, HB3 : Gtk.Box.Gtk_Box;
Lab : Gtk.Label.Gtk_Label;
L24, L25, L36, L48, L66,
C80, C81, C132, C135,
ZL, ZN, ZS, ZT : Gtk.Radio_Button.Gtk_Radio_Button;
Cancel_Unused, Resize_Unused : Gtk.Widget.Gtk_Widget;
begin
Gtk_New (Dialog);
Dialog.Set_Destroy_With_Parent (True);
Dialog.Set_Modal (True);
Dialog.Set_Title (App_Title & " - Resize Terminal");
Dlg_Box := Dialog.Get_Content_Area;
Gtk.Box.Gtk_New (HB1, Orientation => Orientation_Horizontal, Spacing => 6);
Gtk.Label.Gtk_New (Lab, "Lines");
HB1.Pack_Start (Child => Lab, Expand => False, Fill => False, Padding => 1);
L24 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => null, Label => "24");
HB1.Pack_Start (Child => L24, Expand => False, Fill => False, Padding => 1);
L25 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => L24, Label => "25");
HB1.Pack_Start (Child => L25, Expand => False, Fill => False, Padding => 1);
L36 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => L24, Label => "36");
HB1.Pack_Start (Child => L36, Expand => False, Fill => False, Padding => 1);
L48 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => L24, Label => "48");
HB1.Pack_Start (Child => L48, Expand => False, Fill => False, Padding => 1);
L66 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => L24, Label => "66");
HB1.Pack_Start (Child => L66, Expand => False, Fill => False, Padding => 1);
Dlg_Box.Pack_Start (Child => HB1, Expand => False, Fill => False, Padding => 1);
case Display.Get_Visible_Lines is
when 24 => L24.Set_Active (True);
when 25 => L25.Set_Active (True);
when 36 => L36.Set_Active (True);
when 48 => L48.Set_Active (True);
when 66 => L66.Set_Active (True);
when others => null;
end case;
Gtk.Box.Gtk_New (HB2, Orientation => Orientation_Horizontal, Spacing => 6);
Gtk.Label.Gtk_New (Lab, "Columns");
HB2.Pack_Start (Child => Lab, Expand => False, Fill => False, Padding => 1);
C80 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => null, Label => "80");
HB2.Pack_Start (Child => C80, Expand => False, Fill => False, Padding => 1);
C81 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => C80, Label => "81");
HB2.Pack_Start (Child => C81, Expand => False, Fill => False, Padding => 1);
C132 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => C80, Label => "132");
HB2.Pack_Start (Child => C132, Expand => False, Fill => False, Padding => 1);
C135 := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => C80, Label => "135");
HB2.Pack_Start (Child => C135, Expand => False, Fill => False, Padding => 1);
Dlg_Box.Pack_Start (Child => HB2, Expand => False, Fill => False, Padding => 1);
case Display.Get_Visible_Cols is
when 80 => C80.Set_Active (True);
when 81 => C81.Set_Active (True);
when 132 => C132.Set_Active (True);
when 135 => C135.Set_Active (True);
when others => null;
end case;
Gtk.Box.Gtk_New (HB3, Orientation => Orientation_Horizontal, Spacing => 6);
Gtk.Label.Gtk_New (Lab, "Zoom");
HB3.Pack_Start (Child => Lab, Expand => False, Fill => False, Padding => 1);
ZL := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => null, Label => "Large");
HB3.Pack_Start (Child => ZL, Expand => False, Fill => False, Padding => 1);
ZN := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => ZL, Label => "Normal");
HB3.Pack_Start (Child => ZN, Expand => False, Fill => False, Padding => 1);
ZS := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => ZL, Label => "Small");
HB3.Pack_Start (Child => ZS, Expand => False, Fill => False, Padding => 1);
ZT := Gtk.Radio_Button.Gtk_Radio_Button_New_With_Label_From_Widget (Group => ZL, Label => "Tiny");
HB3.Pack_Start (Child => ZT, Expand => False, Fill => False, Padding => 1);
Dlg_Box.Pack_Start (Child => HB3, Expand => False, Fill => False, Padding => 1);
case Crt.Tube.Zoom is
when Large => ZL.Set_Active (True);
when Normal => ZN.Set_Active (True);
when Smaller => ZS.Set_Active (True);
when Tiny => ZT.Set_Active (True);
end case;
Cancel_Unused := Dialog.Add_Button ("Cancel", Gtk_Response_Cancel);
Resize_Unused := Dialog.Add_Button ("Resize", Gtk_Response_Accept);
Dialog.Set_Default_Response (Gtk_Response_Accept);
Dialog.Show_All;
if Dialog.Run = Gtk_Response_Accept then
declare
New_Zoom : Zoom_T;
New_Cols, New_Lines : Gint;
begin
-- first check if zoom has changed
if ZL.Get_Active then
New_Zoom := Large;
elsif ZN.Get_Active then
New_Zoom := Normal;
elsif ZS.Get_Active then
New_Zoom := Smaller;
else
New_Zoom := Tiny;
end if;
if New_Zoom /= Crt.Tube.Zoom then
Font.Load_Font (Crt.Font_Filename, New_Zoom, Saved_Font_Colour);
Crt.Tube.Zoom := New_Zoom;
end if;
-- resize
if L24.Get_Active then
New_Lines := 24;
elsif L25.Get_Active then
New_Lines := 25;
elsif L36.Get_Active then
New_Lines := 36;
elsif L48.Get_Active then
New_Lines := 48;
else
New_Lines := 66;
end if;
if C80.Get_Active then
New_Cols := 80;
elsif C81.Get_Active then
New_Cols := 81;
elsif C132.Get_Active then
New_Cols := 132;
else
New_Cols := 135;
end if;
Crt.Tube.DA.Set_Size_Request (BDF_Font.Font.Get_Char_Width * New_Cols,
BDF_Font.Font.Get_Char_Height * New_Lines);
Display.Set_Visible_Lines (Positive (New_Lines));
Display.Set_Visible_Cols (Positive (New_Cols));
-- Ask for window resize to smaller than we are - the effect
-- is to reduce window size to minimum that contains all content.
Main_Window.Resize (400, 400);
end;
end if;
Dialog.Destroy;
end Resize_CB;
procedure Self_Test_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
Term.Self_Test;
end Self_Test_CB;
function Label_To_Markup (L : Unbounded_String) return Unbounded_String is
M : Unbounded_String := Null_Unbounded_String;
begin
for Ix in 1 .. Length (L) loop
if Element (L, Ix) = '\' then
M := M & ASCII.LF;
else
M := M & Element (L, Ix);
end if;
end loop;
return M;
end Label_To_Markup;
procedure Send_Text_File_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
use Ada.Text_IO;
Filename : constant String :=
Gtkada.File_Selection.File_Selection_Dialog (Title => "DasherA Text File",
Dir_Only => False,
Must_Exist => True);
Text_File : File_Type;
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
if Filename'Length > 0 then
Open (File => Text_File, Mode => In_File, Name => Filename);
while not End_Of_File (Text_File) loop
Redirector.Router.Send_Data (Get_Line (Text_File) & Dasher_Codes.Dasher_NL);
end loop;
Close (Text_File);
end if;
exception
when others =>
Unused_Buttons := Message_Dialog (Msg => "Could not open text file",
Title => "DasherA - Error");
end Send_Text_File_CB;
procedure Load_Template_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Filename : constant String :=
Gtkada.File_Selection.File_Selection_Dialog (Title => "DasherA Function Key Template",
Dir_Only => False,
Must_Exist => True);
Templ_File : Ada.Text_IO.File_Type;
Lab : Unbounded_String;
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
if Filename'Length > 1 then
Log (DEBUG, "Chose template file: " & Filename);
-- clear the labels
for K in 1 .. 17 loop
for R in 1 .. 4 loop
if K /= 6 and then K /= 12 then
Template_Labels (R, K).Set_Markup ("");
end if;
end loop;
end loop;
Ada.Text_IO.Open (File => Templ_File, Mode => Ada.Text_IO.In_File, Name => Filename);
Lab := Text_IO.Unbounded_IO.Get_Line (Templ_File);
L_FKeys_Label.Set_Markup ("" & To_String (Lab) & "");
R_FKeys_Label.Set_Markup ("" & To_String (Lab) & "");
for K in 1 .. 17 loop
for R in reverse 1 .. 4 loop
if K /= 6 and then K /= 12 and then not Ada.Text_IO.End_Of_File (Templ_File) then
Lab := "" & Label_To_Markup (Text_IO.Unbounded_IO.Get_Line (Templ_File)) &
"";
Template_Labels (R, K).Set_Markup (To_String (Lab));
end if;
end loop;
end loop;
Ada.Text_IO.Close (Templ_File);
Template_Revealer.Set_Reveal_Child (True);
Template_Revealer.Set_Visible (True);
Hide_Template_Item.Set_Sensitive (True);
Display.Set_Dirty;
else
Log (INFO, "No Template file chosen");
end if;
exception
when others =>
Unused_Buttons := Message_Dialog (Msg => "Could not load template file",
Title => "DasherA - Error");
end Load_Template_CB;
procedure Hide_Template_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
Template_Revealer.Set_Reveal_Child (False);
L_FKeys_Label.Set_Markup (" ");
R_FKeys_Label.Set_Markup (" ");
Template_Revealer.Set_Visible (False); -- Required to reclaim vertical space when we resize
Hide_Template_Item.Set_Sensitive (False);
-- Ask for window resize to smaller than we are - the effect
-- is to reduce window size to minimum that contains all content.
Main_Window.Resize (400, 400);
Display.Set_Dirty;
end Hide_Template_CB;
procedure Expect_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Filename : constant String :=
Gtkada.File_Selection.File_Selection_Dialog (Title => "DasherA mini-Expect Script",
Dir_Only => False,
Must_Exist => True);
begin
if Filename'Length > 1 then
Mini_Expect.Prepare (Filename);
end if;
end Expect_CB;
procedure Logging_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
if Session_Logger.Logging then
Session_Logger.Stop_Logging;
else
declare
Filename : constant String :=
Gtkada.File_Selection.File_Selection_Dialog (Title => "DasherA Log File",
Dir_Only => False,
Must_Exist => False);
OK : Boolean;
Message : aliased Gtk_Message_Dialog;
begin
if Filename'Length > 1 then
OK := Session_Logger.Start_Logging (Filename);
if not OK then
Message := Gtk_Message_Dialog_New (Parent => Main_Window,
Flags => Modal,
The_Type => Message_Error,
Buttons => Buttons_Close,
Message => "Could not open log file");
end if;
end if;
end;
end if;
end Logging_CB;
procedure Paste_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
use Gtk.Clipboard;
use Gtkada.Dialogs;
pragma Unreferenced (Self);
Clipboard : constant Gtk_Clipboard := Get;
Unused_Buttons : Message_Dialog_Buttons;
begin
if Wait_Is_Text_Available (Clipboard) then
declare
Text : constant String := String (Wait_For_Text (Clipboard));
begin
Redirector.Router.Send_Data (Text);
end;
else
Unused_Buttons := Message_Dialog (Msg => "Nothing in Clipboard to Paste",
Title => "DasherA - Infomation");
end if;
end Paste_CB;
procedure Serial_Connect_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Dialog : Gtk_Dialog;
Dlg_Box : Gtk.Box.Gtk_Box;
Ser_Grid : Gtk.Grid.Gtk_Grid;
Port_Label, Baud_Label, Bits_Label, Parity_Label, Stop_Bits_Label : Gtk.Label.Gtk_Label;
Port_Entry : Gtk.GEntry.Gtk_Entry;
Baud_Combo, Bits_Combo, Parity_Combo, Stop_Bits_Combo : Gtk.Combo_Box_Text.Gtk_Combo_Box_Text;
Cancel_Unused, Connect_Unused : Gtk.Widget.Gtk_Widget;
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
Gtk_New (Dialog);
Dialog.Set_Destroy_With_Parent (True);
Dialog.Set_Modal (True);
Dialog.Set_Title (App_Title & " - Serial Port");
Dlg_Box := Dialog.Get_Content_Area;
Gtk.Grid.Gtk_New (Ser_Grid);
Gtk.Label.Gtk_New (Port_Label, "Port:");
Ser_Grid.Attach (Child => Port_Label, Left => 0, Top => 0);
Gtk.GEntry.Gtk_New (The_Entry => Port_Entry);
Ser_Grid.Attach (Child => Port_Entry, Left => 1, Top => 0);
Gtk.Label.Gtk_New (Baud_Label, "Baud:");
Ser_Grid.Attach (Child => Baud_Label, Left => 0, Top => 1);
Gtk.Combo_Box_Text.Gtk_New (Baud_Combo);
Baud_Combo.Append_Text ("300");
Baud_Combo.Append_Text ("1200");
Baud_Combo.Append_Text ("2400");
Baud_Combo.Append_Text ("9600");
Baud_Combo.Append_Text ("19200");
Baud_Combo.Append_Text ("38400");
Baud_Combo.Set_Active (3);
Ser_Grid.Attach (Child => Baud_Combo, Left => 1, Top => 1);
Gtk.Label.Gtk_New (Bits_Label, "Data Bits:");
Ser_Grid.Attach (Child => Bits_Label, Left => 0, Top => 2);
Gtk.Combo_Box_Text.Gtk_New (Bits_Combo);
Bits_Combo.Append_Text ("7");
Bits_Combo.Append_Text ("8");
Bits_Combo.Set_Active (1);
Ser_Grid.Attach (Child => Bits_Combo, Left => 1, Top => 2);
Gtk.Label.Gtk_New (Parity_Label, "Parity:");
Ser_Grid.Attach (Child => Parity_Label, Left => 0, Top => 3);
Gtk.Combo_Box_Text.Gtk_New (Parity_Combo);
Parity_Combo.Append_Text ("None");
Parity_Combo.Append_Text ("Even");
Parity_Combo.Append_Text ("Odd");
Parity_Combo.Set_Active (0);
Ser_Grid.Attach (Child => Parity_Combo, Left => 1, Top => 3);
Gtk.Label.Gtk_New (Stop_Bits_Label, "Stop Bits:");
Ser_Grid.Attach (Child => Stop_Bits_Label, Left => 0, Top => 4);
Gtk.Combo_Box_Text.Gtk_New (Stop_Bits_Combo);
Stop_Bits_Combo.Append_Text ("1");
Stop_Bits_Combo.Append_Text ("2");
Stop_Bits_Combo.Set_Active (0);
Ser_Grid.Attach (Child => Stop_Bits_Combo, Left => 1, Top => 4);
Dlg_Box.Pack_Start (Child => Ser_Grid, Padding => 5);
Cancel_Unused := Dialog.Add_Button ("Cancel", Gtk_Response_Cancel);
Connect_Unused := Dialog.Add_Button ("Connect", Gtk_Response_Accept);
Dialog.Set_Default_Response (Gtk_Response_Accept);
Dialog.Show_All;
if Dialog.Run = Gtk_Response_Accept then
if Port_Entry.Get_Text_Length = 0 then
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "You must enter a Serial Port",
Title => "DasherA - Error");
else
declare
Port_Str : constant Glib.UTF8_String := Port_Entry.Get_Text;
Rate : Data_Rate;
Bits : Data_Bits;
Stop_Bits : Stop_Bits_Number;
Parity : Parity_Check;
begin
case Baud_Combo.Get_Active is
when 0 => Rate := B300;
when 1 => Rate := B1200;
when 2 => Rate := B2400;
when 3 => Rate := B9600;
when 4 => Rate := B19200;
when 5 => Rate := B38400;
when others => null;
end case;
case Bits_Combo.Get_Active is
when 0 => Bits := CS7;
when 1 => Bits := CS8;
when others => null;
end case;
case Parity_Combo.Get_Active is
when 0 => Parity := None;
when 1 => Parity := Even;
when 2 => Parity := Odd;
when others => null;
end case;
case Stop_Bits_Combo.Get_Active is
when 0 => Stop_Bits := One;
when 1 => Stop_Bits := Two;
when others => null;
end case;
Serial.Open (Port_Str, Rate, Bits, Parity, Stop_Bits);
Redirector.Router.Set_Destination (Redirector.Async);
Serial_Connect_Item.Set_Sensitive (False);
Serial_Disconnect_Item.Set_Sensitive (True);
Net_Connect_Item.Set_Sensitive (False);
Net_Disconnect_Item.Set_Sensitive (False);
Xmodem_Rx_Item.Set_Sensitive (True);
Xmodem_Send_Item.Set_Sensitive (True);
Xmodem_Send1k_Item.Set_Sensitive (True);
exception
when others =>
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "Could not open Serial Port",
Title => "DasherA - Error");
end;
end if;
end if;
Dialog.Destroy;
end Serial_Connect_CB;
procedure Serial_Disconnect_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
Serial.Close;
Redirector.Router.Set_Destination (Redirector.Local);
Serial_Connect_Item.Set_Sensitive (True);
Serial_Disconnect_Item.Set_Sensitive (False);
Net_Connect_Item.Set_Sensitive (True);
Net_Disconnect_Item.Set_Sensitive (False);
Xmodem_Rx_Item.Set_Sensitive (False);
Xmodem_Send_Item.Set_Sensitive (False);
Xmodem_Send1k_Item.Set_Sensitive (False);
end Serial_Disconnect_CB;
procedure Telnet_Connect_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Dialog : Gtk_Dialog;
Dlg_Box : Gtk.Box.Gtk_Box;
Host_Label, Port_Label : Gtk.Label.Gtk_Label;
Host_Entry, Port_Entry : Gtk.GEntry.Gtk_Entry;
Cancel_Unused, Connect_Unused : Gtk.Widget.Gtk_Widget;
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
Gtk_New (Dialog);
Dialog.Set_Destroy_With_Parent (True);
Dialog.Set_Modal (True);
Dialog.Set_Title (App_Title & " - Telnet Host");
Dlg_Box := Dialog.Get_Content_Area;
Gtk.Label.Gtk_New (Host_Label, "Host:");
Dlg_Box.Pack_Start (Child => Host_Label, Expand => True, Fill => True, Padding => 5);
Gtk.GEntry.Gtk_New (The_Entry => Host_Entry);
Dlg_Box.Pack_Start (Child => Host_Entry, Expand => True, Fill => True, Padding => 5);
if Saved_Host /= Null_Unbounded_String then
Host_Entry.Set_Text (To_String (Saved_Host));
end if;
Gtk.Label.Gtk_New (Port_Label, "Port:");
Dlg_Box.Pack_Start (Child => Port_Label, Expand => True, Fill => True, Padding => 5);
Gtk.GEntry.Gtk_New (The_Entry => Port_Entry);
if Saved_Port /= Null_Unbounded_String then
Port_Entry.Set_Text (To_String (Saved_Port));
end if;
Dlg_Box.Pack_Start (Child => Port_Entry, Expand => True, Fill => True, Padding => 5);
Cancel_Unused := Dialog.Add_Button ("Cancel", Gtk_Response_Cancel);
Connect_Unused := Dialog.Add_Button ("Connect", Gtk_Response_Accept);
Dialog.Set_Default_Response (Gtk_Response_Accept);
Dialog.Show_All;
if Dialog.Run = Gtk_Response_Accept then
if Host_Entry.Get_Text_Length = 0 or else Port_Entry.Get_Text_Length = 0 then
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "You must enter both Host and Port",
Title => "DasherA - Error");
else
declare
Host_Str : constant Glib.UTF8_String := Host_Entry.Get_Text;
Port_Num : Positive;
begin
Port_Num := Positive'Value (Port_Entry.Get_Text);
Telnet_Sess := Telnet.New_Connection (String (Host_Str), Port_Num);
Redirector.Router.Set_Destination (Redirector.Network);
Net_Connect_Item.Set_Sensitive (False);
Net_Disconnect_Item.Set_Sensitive (True);
Serial_Connect_Item.Set_Sensitive (False);
Serial_Disconnect_Item.Set_Sensitive (False);
Saved_Host := To_Unbounded_String (Host_Str);
Saved_Port := To_Unbounded_String (Port_Entry.Get_Text);
exception
when Error : others =>
Log (DEBUG, Exception_Information (Error));
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "Could not connect. " &
Exception_Information (Error),
Title => "DasherA - Error");
end;
end if;
end if;
Dialog.Destroy;
end Telnet_Connect_CB;
procedure Telnet_Disconnect_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
begin
Telnet_Sess.Close_Connection;
Redirector.Router.Set_Destination (Redirector.Local);
Net_Connect_Item.Set_Sensitive (True);
Net_Disconnect_Item.Set_Sensitive (False);
Serial_Connect_Item.Set_Sensitive (True);
Serial_Disconnect_Item.Set_Sensitive (False);
end Telnet_Disconnect_CB;
procedure View_History_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
use Gtk.Scrolled_Window;
use Gtk.Text_Buffer;
use Gtk.Text_View;
Dialog : Gtk_Dialog;
Dlg_Box : Gtk.Box.Gtk_Box;
FProvider : constant Gtk.Css_Provider.Gtk_Css_Provider := Gtk.Css_Provider.Gtk_Css_Provider_New;
CSS : constant String :=
"textview.view {" & ASCII.LF
& " font-family: monospace;" & ASCII.LF
& "}" & ASCII.LF;
Error : aliased Glib.Error.GError;
Dummy : Boolean;
Scrollable : Gtk_Scrolled_Window;
View : Gtk_Text_View;
Buffer : Gtk_Text_Buffer;
Close_Unused : Gtk.Widget.Gtk_Widget;
H_First, H_Last, H_Line : Integer;
begin
Gtk_New (Dialog);
Dialog.Set_Modal (True);
Dialog.Set_Title (App_Title & " - History");
Dialog.Set_Size_Request (800, 800);
Dlg_Box := Dialog.Get_Content_Area;
Gtk_New (Scrollable);
Gtk_New (View);
View.Set_Editable (False);
-- View.Set_Monospace (True);
Dummy := FProvider.Load_From_Data (CSS, Error'Access);
if not Dummy then
Log (Logging.ERROR, "Loading CSS from data");
end if;
Apply_Css (Widget => View, Provider => +FProvider);
Buffer := View.Get_Buffer;
Buffer.Set_Text (" *** Start of History ***");
H_First := Display_P.Display.Get_First_History_Line;
H_Last := Display_P.Display.Get_Last_History_Line;
H_Line := H_First;
if H_First > H_Last then
while H_Line < Display_P.History_Lines loop
Buffer.Insert_At_Cursor (Display_P.Display.Get_History_Line (H_Line) & Dasher_Codes.Dasher_NL);
H_Line := H_Line + 1;
end loop;
H_Line := 0;
end if;
while H_Line <= H_Last loop
Buffer.Insert_At_Cursor (Display_P.Display.Get_History_Line (H_Line) & Dasher_Codes.Dasher_NL);
H_Line := H_Line + 1;
end loop;
Scrollable.Add (View);
Dlg_Box.Pack_Start (Child => Scrollable, Expand => True, Padding => 5);
Close_Unused := Dialog.Add_Button ("Close", Gtk_Response_Cancel);
Dialog.Set_Default_Response (Gtk_Response_Cancel);
Dialog.Show_All;
if Dialog.Run = Gtk_Response_Cancel then
null;
end if;
Dialog.Destroy;
end View_History_CB;
procedure Xmodem_Rx_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
use Gtk.File_Chooser; use Gtk.File_Chooser_Dialog;
use Gtk.Stock;
FC_Dialog : Gtk_File_Chooser_Dialog;
Dummy_Button : Gtk_Widget;
Unused_Buttons : Message_Dialog_Buttons;
begin
FC_Dialog := Gtk_File_Chooser_Dialog_New (Title => "DasherA - Xmodem Receive File As...",
Parent => Main_Window,
Action => Action_Save);
Dummy_Button := FC_Dialog.Add_Button (Stock_Cancel, Gtk_Response_Cancel);
Dummy_Button := FC_Dialog.Add_Button (Stock_Ok, Gtk_Response_OK);
if FC_Dialog.Run = Gtk_Response_OK then
Log (DEBUG, "Chosen file for Xmodem Rx: " & FC_Dialog.Get_Filename);
Xmodem.Receive (String (FC_Dialog.Get_Filename), Trace_Xmodem_Opt);
end if;
FC_Dialog.Destroy;
exception
when Xmodem.Already_Exists =>
FC_Dialog.Destroy;
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "The file must not already exist",
Title => "DasherA - Error");
end Xmodem_Rx_CB;
procedure Xmodem_Tx_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Filename : constant String :=
Gtkada.File_Selection.File_Selection_Dialog (Title => "DasherA - Xmodem-CRC File Send",
Dir_Only => False,
Must_Exist => True);
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
if Filename'Length > 0 then
Xmodem.Send (Filename => Filename, Pkt_Len => Xmodem.Short, Trace_Flag => Trace_Xmodem_Opt);
end if;
exception
when Xmodem.Protocol_Error =>
Unused_Buttons := Message_Dialog (Msg => "Xmodem Protocol Error", Title => "DasherA - Error");
when others =>
Unused_Buttons := Message_Dialog (Msg => "Could not open file to send: " & Filename,
Title => "DasherA - Error");
end Xmodem_Tx_CB;
procedure Xmodem_Tx_1k_CB (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class) is
pragma Unreferenced (Self);
Filename : constant String :=
Gtkada.File_Selection.File_Selection_Dialog (Title => "DasherA - Xmodem-CRC 1k File Send",
Dir_Only => False,
Must_Exist => True);
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
if Filename'Length > 0 then
Xmodem.Send (Filename => Filename, Pkt_Len => Xmodem.Long, Trace_Flag => Trace_Xmodem_Opt);
end if;
exception
when Xmodem.Protocol_Error =>
Unused_Buttons := Message_Dialog (Msg => "Xmodem Protocol Error", Title => "DasherA - Error");
when others =>
Unused_Buttons := Message_Dialog (Msg => "Could not open file to send: " & Filename,
Title => "DasherA - Error");
end Xmodem_Tx_1k_CB;
function Handle_Key_Release_Event_CB (Self : access Gtk.Widget.Gtk_Widget_Record'Class; Event : Gdk.Event.Gdk_Event_Key)
return Boolean is
pragma Unreferenced (Self);
begin
Keyboard.Handle_Key_Release (Event.Keyval);
return True;
end Handle_Key_Release_Event_CB;
function Handle_Key_Press_Event_CB (Self : access Gtk.Widget.Gtk_Widget_Record'Class; Event : Gdk.Event.Gdk_Event_Key)
return Boolean is
pragma Unreferenced (Self);
begin
Keyboard.Handle_Key_Press (Event.Keyval);
return True;
end Handle_Key_Press_Event_CB;
function Create_Menu_Bar return Gtk.Menu_Bar.Gtk_Menu_Bar is
Menu_Bar : Gtk.Menu_Bar.Gtk_Menu_Bar;
Sep_Item : Gtk.Separator_Menu_Item.Gtk_Separator_Menu_Item;
File_Menu, Edit_Menu, View_Menu, Emulation_Menu, Serial_Menu,
Network_Menu, Help_Menu : Gtk.Menu.Gtk_Menu;
Menu_Item : Gtk.Menu_Item.Gtk_Menu_Item;
Logging_Item, Expect_Item, Send_File_Item,
History_Item, Resize_Item,
D200_Item, D210_Item, Self_Test_Item,
Quit_Item,
Paste_Item,
About_Item : Gtk.Menu_Item.Gtk_Menu_Item;
begin
Log (DEBUG, "Starting to Create_Menu_Bar");
Gtk_New (Menu_Bar);
-- File
Gtk_New (Menu_Item, "File");
Menu_Bar.Append (Menu_Item);
Gtk_New (File_Menu);
Menu_Item.Set_Submenu (File_Menu);
Gtk_New (Logging_Item, "Logging");
File_Menu.Append (Logging_Item);
Logging_Item.On_Activate (Logging_CB'Access);
Gtk_New (Sep_Item);
File_Menu.Append (Sep_Item);
Gtk_New (Expect_Item, "Run mini-Expect Script");
File_Menu.Append (Expect_Item);
Expect_Item.On_Activate (Expect_CB'Access);
Gtk_New (Sep_Item);
File_Menu.Append (Sep_Item);
Gtk_New (Send_File_Item, "Send (Text) File");
File_Menu.Append (Send_File_Item);
Gtk_New (Sep_Item);
File_Menu.Append (Sep_Item);
Send_File_Item.On_Activate (Send_Text_File_CB'Access);
Gtk_New (Xmodem_Rx_Item, "XMODEM-CRC - Receive File");
Xmodem_Rx_Item.Set_Sensitive (False);
File_Menu.Append (Xmodem_Rx_Item);
Xmodem_Rx_Item.On_Activate (Xmodem_Rx_CB'Access);
Gtk_New (Xmodem_Send_Item, "XMODEM-CRC - Send File");
Xmodem_Send_Item.Set_Sensitive (False);
Xmodem_Send_Item.On_Activate (Xmodem_Tx_CB'Access);
File_Menu.Append (Xmodem_Send_Item);
Gtk_New (Xmodem_Send1k_Item, "XMODEM-CRC - Send File (1k packets");
Xmodem_Send_Item.On_Activate (Xmodem_Tx_1k_CB'Access);
Xmodem_Send1k_Item.Set_Sensitive (False);
File_Menu.Append (Xmodem_Send1k_Item);
Gtk_New (Sep_Item);
File_Menu.Append (Sep_Item);
Gtk_New (Quit_Item, "Quit");
File_Menu.Append (Quit_Item);
Quit_Item.On_Activate (Quit_CB'Access);
-- Edit
Gtk_New (Menu_Item, "Edit");
Menu_Bar.Append (Menu_Item);
Gtk_New (Edit_Menu);
Menu_Item.Set_Submenu (Edit_Menu);
Gtk_New (Paste_Item, "Paste");
Edit_Menu.Append (Paste_Item);
Paste_Item.On_Activate (Paste_CB'Access);
-- View
Gtk_New (Menu_Item, "View");
Menu_Bar.Append (Menu_Item);
Gtk_New (View_Menu);
Menu_Item.Set_Submenu (View_Menu);
Gtk_New (History_Item, "History");
View_Menu.Append (History_Item);
History_Item.On_Activate (View_History_CB'Access);
Gtk_New (Sep_Item);
View_Menu.Append (Sep_Item);
Gtk_New (Load_Template_Item, "Load Func. Key Template");
View_Menu.Append (Load_Template_Item);
Load_Template_Item.On_Activate (Load_Template_CB'Access);
Gtk_New (Hide_Template_Item, "Hide Func. Key Template");
View_Menu.Append (Hide_Template_Item);
Hide_Template_Item.Set_Sensitive (False);
Hide_Template_Item.On_Activate (Hide_Template_CB'Access);
-- Emulation
Gtk_New (Menu_Item, "Emulation");
Menu_Bar.Append (Menu_Item);
Gtk_New (Emulation_Menu);
Menu_Item.Set_Submenu (Emulation_Menu);
Gtk_New (D200_Item, "D200");
Emulation_Menu.Append (D200_Item);
D200_Item.On_Activate (D200_CB'Access);
Gtk_New (D210_Item, "D210");
Emulation_Menu.Append (D210_Item);
D210_Item.On_Activate (D210_CB'Access);
Gtk_New (Sep_Item);
Emulation_Menu.Append (Sep_Item);
Gtk_New (Resize_Item, "Resize Terminal");
Emulation_Menu.Append (Resize_Item);
Resize_Item.On_Activate (Resize_CB'Access);
Gtk_New (Sep_Item);
Emulation_Menu.Append (Sep_Item);
Gtk_New (Self_Test_Item, "Self-Test");
Emulation_Menu.Append (Self_Test_Item);
Self_Test_Item.On_Activate (Self_Test_CB'Access);
-- Serial
Gtk_New (Menu_Item, "Serial");
Menu_Bar.Append (Menu_Item);
Gtk_New (Serial_Menu);
Menu_Item.Set_Submenu (Serial_Menu);
Gtk_New (Serial_Connect_Item, "Connect");
Serial_Menu.Append (Serial_Connect_Item);
Serial_Connect_Item.On_Activate (Serial_Connect_CB'Access);
Gtk_New (Serial_Disconnect_Item, "Disconnect");
Serial_Menu.Append (Serial_Disconnect_Item);
Serial_Disconnect_Item.Set_Sensitive (False);
Serial_Disconnect_Item.On_Activate (Serial_Disconnect_CB'Access);
-- Network
Gtk_New (Menu_Item, "Network");
Menu_Bar.Append (Menu_Item);
Gtk_New (Network_Menu);
Menu_Item.Set_Submenu (Network_Menu);
Gtk_New (Net_Connect_Item, "Connect");
Network_Menu.Append (Net_Connect_Item);
Net_Connect_Item.On_Activate (Telnet_Connect_CB'Access);
Gtk_New (Net_Disconnect_Item, "Disconnect");
Network_Menu.Append (Net_Disconnect_Item);
Net_Disconnect_Item.Set_Sensitive (False);
Net_Disconnect_Item.On_Activate (Telnet_Disconnect_CB'Access);
-- Help
Gtk_New (Menu_Item, "Help");
Menu_Bar.Append (Menu_Item);
Gtk_New (Help_Menu);
Menu_Item.Set_Submenu (Help_Menu);
Gtk_New (About_Item, "About");
Help_Menu.Append (About_Item);
About_Item.On_Activate (About_CB'Access);
return Menu_Bar;
end Create_Menu_Bar;
-- procedure Local_Print_Btn_CB (Btn : access Gtk.Button.Gtk_Button_Record'Class) is
-- pragma Unreferenced (Btn);
-- use Gtk.File_Chooser; use Gtk.File_Chooser_Dialog;
-- use Gtk.Stock;
-- FC_Dialog : Gtk_File_Chooser_Dialog;
-- Dummy_Button : Gtk_Widget;
-- Unused_Buttons : Message_Dialog_Buttons;
-- begin
-- FC_Dialog := Gtk_File_Chooser_Dialog_New (Title => "DasherA - Save Screen Image As...",
-- Parent => Main_Window,
-- Action => Action_Save);
-- Dummy_Button := FC_Dialog.Add_Button (Stock_Cancel, Gtk_Response_Cancel);
-- Dummy_Button := FC_Dialog.Add_Button (Stock_Ok, Gtk_Response_OK);
-- if FC_Dialog.Run = Gtk_Response_OK then
-- NULL;
-- end if;
-- FC_Dialog.Destroy;
-- exception
-- when Xmodem.Already_Exists =>
-- FC_Dialog.Destroy;
-- Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "The file must not already exist",
-- Title => "DasherA - Error");
-- end Local_Print_Btn_CB;
procedure Handle_Key_Btn_CB (Btn : access Gtk.Button.Gtk_Button_Record'Class) is
use Redirector;
Lab : constant String := Btn.Get_Label;
Dest : Redirector.Connection_T;
begin
if Lab = "Break" then
Keyboard.Handle_Key_Release (GDK_Break);
Redirector.Router.Get_Destination (Dest);
if Dest = Async then
Serial.Keyboard_Sender_Task.Send_Break;
else
Log (INFO, "BREAK only implemented for Serial connections");
end if;
elsif Lab = "C1" then
Keyboard.Handle_Key_Release (GDK_F31);
elsif Lab = "C2" then
Keyboard.Handle_Key_Release (GDK_F32);
elsif Lab = "C3" then
Keyboard.Handle_Key_Release (GDK_F33);
elsif Lab = "C4" then
Keyboard.Handle_Key_Release (GDK_F34);
elsif Lab = "Er.Page" then
Keyboard.Handle_Key_Release (GDK_3270_EraseEOF);
-- elsif Lab = "Loc.Print" then
-- Keyboard.Handle_Key_Release (GDK_3270_PrintScreen); -- TODO Local Print
elsif Lab = "Er.EOL" then
Keyboard.Handle_Key_Release (GDK_3270_EraseInput);
elsif Lab = "CR" then
Keyboard.Handle_Key_Release (GDK_KP_Enter);
elsif Lab = "Hold" then
Term.Holding := not Term.Holding;
if Term.Holding then
Keyboard.Handle_Key_Release (GDK_F29);
else
Keyboard.Handle_Key_Release (GDK_F30);
end if;
end if;
end Handle_Key_Btn_CB;
function Create_Keys_Box return Gtk.Box.Gtk_Box is
Keys_Box : Gtk.Box.Gtk_Box;
C1_Btn, C2_Btn, C3_Btn, C4_Btn,
Break_Btn, Er_Pg_Btn, Er_EOL_Btn, CR_Btn, Hold_Btn : Gtk.Button.Gtk_Button;
Sep : Gtk.Separator.Gtk_Vseparator;
begin
Gtk.Box.Gtk_New (Keys_Box, Orientation_Horizontal, 1);
Keys_Box.Set_Homogeneous (False);
Gtk.Button.Gtk_New (Break_Btn, "Break");
Break_Btn.Set_Tooltip_Text ("Send BREAK signal on Serial Connection");
Break_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (Break_Btn);
-- Break_Btn.Set_Hexpand (True);
Gtk.Separator.Gtk_New_Vseparator (Sep);
Keys_Box.Add (Sep);
Sep.Set_Hexpand (True);
Gtk.Button.Gtk_New (C1_Btn, "C1");
C1_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (C1_Btn);
Gtk.Button.Gtk_New (C2_Btn, "C2");
C2_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (C2_Btn);
Gtk.Button.Gtk_New (C3_Btn, "C3");
C3_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (C3_Btn);
Gtk.Button.Gtk_New (C4_Btn, "C4");
C4_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (C4_Btn);
Gtk.Button.Gtk_New (Er_Pg_Btn, "Er.Page");
Er_Pg_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (Er_Pg_Btn);
-- Gtk.Button.Gtk_New (Loc_Pr_Btn, "Loc.Print");
-- Loc_Pr_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
-- Keys_Box.Add (Loc_Pr_Btn);
Gtk.Button.Gtk_New (Er_EOL_Btn, "Er.EOL");
Er_EOL_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (Er_EOL_Btn);
Gtk.Button.Gtk_New (CR_Btn, "CR");
CR_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (CR_Btn);
Gtk.Button.Gtk_New (Hold_Btn, "Hold");
Hold_Btn.On_Clicked (Handle_Key_Btn_CB'Access);
Keys_Box.Add (Hold_Btn);
return Keys_Box;
end Create_Keys_Box;
procedure Handle_FKey_Btn_CB (Btn : access Gtk.Button.Gtk_Button_Record'Class) is
Lab : constant String := Btn.Get_Label;
begin
Log (DEBUG, "Handle_FKey_Btn_CB called for " & Lab);
if Lab = "F1" then
Keyboard.Handle_Key_Release (GDK_F1);
elsif Lab = "F1" then
Keyboard.Handle_Key_Release (GDK_F1);
elsif Lab = "F2" then
Keyboard.Handle_Key_Release (GDK_F2);
elsif Lab = "F3" then
Keyboard.Handle_Key_Release (GDK_F3);
elsif Lab = "F4" then
Keyboard.Handle_Key_Release (GDK_F4);
elsif Lab = "F5" then
Keyboard.Handle_Key_Release (GDK_F5);
elsif Lab = "F6" then
Keyboard.Handle_Key_Release (GDK_F6);
elsif Lab = "F7" then
Keyboard.Handle_Key_Release (GDK_F7);
elsif Lab = "F8" then
Keyboard.Handle_Key_Release (GDK_F8);
elsif Lab = "F9" then
Keyboard.Handle_Key_Release (GDK_F9);
elsif Lab = "F10" then
Keyboard.Handle_Key_Release (GDK_F10);
elsif Lab = "F11" then
Keyboard.Handle_Key_Release (GDK_F11);
elsif Lab = "F12" then
Keyboard.Handle_Key_Release (GDK_F12);
elsif Lab = "F13" then
Keyboard.Handle_Key_Release (GDK_F13);
elsif Lab = "F14" then
Keyboard.Handle_Key_Release (GDK_F14);
elsif Lab = "F15" then
Keyboard.Handle_Key_Release (GDK_F15);
end if;
end Handle_FKey_Btn_CB;
function Create_Template_Labels_Revealer return Gtk.Revealer.Gtk_Revealer is
Template_Rev : Gtk.Revealer.Gtk_Revealer;
Template_Grid : Gtk.Grid.Gtk_Grid;
FProvider : constant Gtk.Css_Provider.Gtk_Css_Provider := Gtk.Css_Provider.Gtk_Css_Provider_New;
Error : aliased Glib.Error.GError;
Dummy : Boolean;
CSS : constant String :=
"label {" & ASCII.LF
& " border-color: white;" & ASCII.LF
& " border-width: 1px;" & ASCII.LF
& " border-style: solid;" & ASCII.LF
& "}" & ASCII.LF;
begin
Gtk.Revealer.Gtk_New (Template_Rev);
Gtk.Grid.Gtk_New (Template_Grid);
for row in 1 .. 4 loop
for col in 1 .. 17 loop
Gtk.Label.Gtk_New (Template_Labels (row, col));
Template_Labels (row, col).Set_Size_Request (Width => 48, Height => 30);
Template_Labels (row, col).Set_Justify (Gtk.Enums.Justify_Center);
Template_Grid.Attach (Child => Template_Labels (row, col), Left => Gint (col) - 1, Top => Gint (row) - 1, Width => 1, Height => 1);
end loop;
end loop;
Template_Labels (1, 6).Set_Markup ("Ctrl-Shift");
Template_Labels (2, 6).Set_Markup ("Ctrl");
Template_Labels (3, 6).Set_Markup ("Shift");
Template_Labels (1, 12).Set_Markup ("Ctrl-Shift");
Template_Labels (2, 12).Set_Markup ("Ctrl");
Template_Labels (3, 12).Set_Markup ("Shift");
Template_Rev.Add (Template_Grid);
Dummy := FProvider.Load_From_Data (CSS, Error'Access);
if not Dummy then
Log (Logging.ERROR, "Loading CSS from data");
end if;
Apply_Css (Widget => Template_Grid, Provider => +FProvider);
Template_Rev.Set_Reveal_Child (False);
return Template_Rev;
end Create_Template_Labels_Revealer;
function Create_FKeys_Box return Gtk.Box.Gtk_Box is
FKeys_Box : Gtk.Box.Gtk_Box;
FKeys : array (1 .. 15) of Gtk.Button.Gtk_Button;
Error : aliased Glib.Error.GError;
FProvider : constant Gtk.Css_Provider.Gtk_Css_Provider := Gtk.Css_Provider.Gtk_Css_Provider_New;
Dummy : Boolean;
CSS : constant String :=
"#FKey_Button {" & ASCII.LF
& " color: white;" & ASCII.LF
& " background-image: none;" & ASCII.LF
& " background-color: rgba(31, 220, 232, 1);" & ASCII.LF
& " border-color: white;" & ASCII.LF
& " font-family: Monospace;" & ASCII.LF
& " font-weight: bold;" & ASCII.LF
& " padding-left: 2px;" & ASCII.LF
& " padding-right: 2px;" & ASCII.LF
& "}";
begin
Gtk.Box.Gtk_New (FKeys_Box, Gtk.Enums.Orientation_Horizontal, 1);
FKeys_Box.Set_Homogeneous (True);
Dummy := FProvider.Load_From_Data (CSS, Error'Access);
if not Dummy then
Log (Logging.ERROR, "Loading CSS from data");
end if;
for N in FKeys'Range loop
declare
Lab : constant String := N'Image;
begin
Gtk.Button.Gtk_New (FKeys (N), "F" & Ada.Strings.Fixed.Trim (Lab, Ada.Strings.Both));
FKeys (N).On_Clicked (Handle_FKey_Btn_CB'Access);
FKeys (N).Set_Size_Request (Width => 40, Height => 28);
FKeys (N).Set_Name ("FKey_Button");
end;
end loop;
-- we want labels between the groups of 5 f-key buttons
for F in 1 .. 5 loop
FKeys_Box.Pack_Start (FKeys (F), False, False);
end loop;
Gtk.Label.Gtk_New (L_FKeys_Label, " ");
FKeys_Box.Pack_Start (L_FKeys_Label);
for F in 6 .. 10 loop
FKeys_Box.Pack_Start (FKeys (F), False, False);
end loop;
Gtk.Label.Gtk_New (R_FKeys_Label, " ");
FKeys_Box.Pack_Start (R_FKeys_Label);
for F in 11 .. 15 loop
FKeys_Box.Pack_Start (FKeys (F), False, False);
end loop;
Apply_Css (FKeys_Box, +FProvider);
return FKeys_Box;
end Create_FKeys_Box;
function Update_Status_Box_CB (SB : Gtk.Box.Gtk_Box) return Boolean is
Dest : Redirector.Connection_T;
begin
Redirector.Router.Get_Destination (Dest);
Gdk.Threads.Enter;
case Dest is
when Redirector.Local =>
Online_Label.Set_Text ("Local");
Host_Label.Set_Text ("(Disconnected)");
Net_Connect_Item.Set_Sensitive (True);
Net_Disconnect_Item.Set_Sensitive (False);
Serial_Connect_Item.Set_Sensitive (True);
Serial_Disconnect_Item.Set_Sensitive (False);
when Redirector.Async =>
Online_Label.Set_Text ("Online (Serial)");
Host_Label.Set_Text (To_String (Serial.Port_US));
when Redirector.Network =>
Online_Label.Set_Text ("Online (Telnet)");
Host_Label.Set_Text (To_String (Telnet_Sess.Host_Str) & ":" &
Ada.Strings.Fixed.Trim (Telnet_Sess.Port_Num'Image, Ada.Strings.Both));
end case;
case Term.Emulation is
when Terminal.D200 => Emul_Label.Set_Text ("D200");
when Terminal.D210 => Emul_Label.Set_Text ("D210");
end case;
if Session_Logger.Logging then
Logging_Label.Set_Text ("Logging");
else
Logging_Label.Set_Text ("Not Logging");
end if;
if Term.Holding then
Hold_Label.Set_Text ("HOLD");
else
Hold_Label.Set_Text ("");
end if;
SB.Queue_Draw;
Gdk.Threads.Leave;
return True;
end Update_Status_Box_CB;
function Create_Status_Box return Gtk.Box.Gtk_Box is
Status_Box : Gtk.Box.Gtk_Box;
Online_Frame, Host_Frame, Logging_Frame, Emul_Frame, Hold_Frame : Gtk.Frame.Gtk_Frame;
begin
Gtk.Box.Gtk_New (Status_Box, Gtk.Enums.Orientation_Horizontal, 2);
Gtk.Frame.Gtk_New (Online_Frame);
Gtk.Label.Gtk_New (Online_Label, "Offline");
Online_Frame.Add (Online_Label);
Status_Box.Pack_Start (Online_Frame);
Gtk.Frame.Gtk_New (Host_Frame);
Gtk.Label.Gtk_New (Host_Label, "Not Connected");
Host_Frame.Add (Host_Label);
Status_Box.Pack_Start (Host_Frame);
Gtk.Frame.Gtk_New (Logging_Frame);
Gtk.Label.Gtk_New (Logging_Label, "Not Logging");
Logging_Frame.Add (Logging_Label);
Status_Box.Pack_Start (Logging_Frame);
Gtk.Frame.Gtk_New (Emul_Frame);
Gtk.Label.Gtk_New (Emul_Label, "D100");
Emul_Frame.Add (Emul_Label);
Status_Box.Pack_Start (Child => Emul_Frame, Expand => False);
Gtk.Frame.Gtk_New (Hold_Frame);
Gtk.Label.Gtk_New (Hold_Label, " ");
Hold_Frame.Add (Hold_Label);
Status_Box.Pack_Start (Child => Hold_Frame, Expand => False);
SB_Timeout := SB_Timeout_P.Timeout_Add (1000, Update_Status_Box_CB'Access, Status_Box);
return Status_Box;
end Create_Status_Box;
function Create_Icon_Pixbuf return Gdk.Pixbuf.Gdk_Pixbuf is
IP : Gdk.Pixbuf.Gdk_Pixbuf;
Icon_Emb : constant Embedded.Content_Type := Embedded.Get_Content (App_Icon);
package IO is new Ada.Sequential_IO (Interfaces.Unsigned_8);
Tmp_Filename : constant String := "DasherA_Icon.tmp";
Tmp_File : IO.File_Type;
Error : aliased Glib.Error.GError;
begin
if Ada.Directories.Exists (Tmp_Filename) then
Ada.Directories.Delete_File (Tmp_Filename);
end if;
IO.Create (File => Tmp_File, Name => Tmp_Filename);
for Val of Icon_Emb.Content.all loop
IO.Write (Tmp_File, Interfaces.Unsigned_8 (Val));
end loop;
IO.Close (Tmp_File);
Gdk.Pixbuf.Gdk_New_From_File (Pixbuf => IP, Filename => Tmp_Filename, Error => Error);
if Error /= null then
Log (WARNING, "Could not find/load icon file: DasherA_Icon.tmp");
end if;
Ada.Directories.Delete_File (Tmp_Filename);
return IP;
end Create_Icon_Pixbuf;
function Create_Window (Host_Arg : Unbounded_String;
Font_Colour : BDF_Font.Font_Colour_T;
Trace_Xmodem : Boolean) return Gtk.Window.Gtk_Window is
Unused_Buttons : Gtkada.Dialogs.Message_Dialog_Buttons;
begin
Log (DEBUG, "Starting to Create_Window");
Trace_Xmodem_Opt := Trace_Xmodem;
Saved_Font_Colour := Font_Colour;
-- Gtk.Window.Initialize (Main_Window);
Gtk.Window.Gtk_New (Main_Window);
Log (DEBUG, "New Window Created");
Main_Window.Set_Title (App_Title);
Main_Window.On_Destroy (Window_Close_CB'Access);
-- Everything is in a Grid...
Gtk.Grid.Gtk_New (Main_Grid);
Main_Grid.Set_Orientation (Gtk.Enums.Orientation_Vertical);
Main_Grid.Set_Row_Spacing (2);
-- Menu
Main_Grid.Add (Create_Menu_Bar);
-- Virtual Keys, Function Keys and Template
Main_Grid.Add (Create_Keys_Box);
Template_Revealer := Create_Template_Labels_Revealer;
Main_Grid.Add (Template_Revealer);
Main_Grid.Add (Create_FKeys_Box);
-- CRT area
Display_P.Display.Init;
Term := Terminal.Create (Terminal.D210);
Crt.Init (BDF_Font.Normal, Font_Colour);
Crt.Tube.DA.On_Configure_Event (Crt.Configure_Event_CB'Access);
Crt.Tube.DA.On_Draw (Crt.Draw_CB'Access);
Main_Grid.Add (Crt.Tube.DA);
-- Status Bar
Main_Grid.Add (Create_Status_Box);
Main_Window.Add (Main_Grid);
Main_Window.Set_Position (Gtk.Enums.Win_Pos_Center);
Redirector.Router := new Redirector.Router_TT;
Redirector.Router.Set_Destination (Redirector.Local);
Redirector.Router.Set_Handler (Redirector.Visual);
Main_Window.On_Key_Press_Event (Handle_Key_Press_Event_CB'Unrestricted_Access);
Main_Window.On_Key_Release_Event (Handle_Key_Release_Event_CB'Unrestricted_Access);
Icon_PB := Create_Icon_Pixbuf;
Main_Window.Set_Icon (Icon_PB);
Log (DEBUG, "Main Window Built");
if Host_Arg /= Null_Unbounded_String then
if Count (Host_Arg, ":") /= 1 then
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "You must enter both Host and Port separated by a colon",
Title => "DasherA - Error");
else
declare
Colon_Ix : constant Natural := Index (Host_Arg, ":");
Host_Str : constant String := Slice (Host_Arg, 1, Colon_Ix - 1);
Port_Num : constant Positive := Positive'Value (Slice (Host_Arg, Colon_Ix + 1, Length (Host_Arg)));
begin
Telnet_Sess := Telnet.New_Connection (Host_Str, Port_Num);
Redirector.Router.Set_Destination (Redirector.Network);
Net_Connect_Item.Set_Sensitive (False);
Net_Disconnect_Item.Set_Sensitive (True);
Serial_Connect_Item.Set_Sensitive (False);
Serial_Disconnect_Item.Set_Sensitive (False);
Saved_Host := To_Unbounded_String (Host_Str);
Saved_Port := To_Unbounded_String (Slice (Host_Arg, Colon_Ix + 1, Length (Host_Arg)));
exception
when Error : others =>
Unused_Buttons := Gtkada.Dialogs.Message_Dialog (Msg => "Could not connect. " &
Exception_Information (Error),
Title => "DasherA - Error");
end;
end if;
end if;
return Main_Window;
end Create_Window;
end GUI;