-- 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.Characters.Latin_1; with Ada.Strings.Fixed; with Gdk.Main; with Glib.Main; with BDF_Font; with Dasher_Codes; use Dasher_Codes; with Display_P; use Display_P; with Logging; use Logging; with Session_Logger; with Mini_Expect; with Redirector; package body Terminal is function Create (Emul : Emulation_T) return Terminal_Acc_T is T : aliased constant Terminal_Acc_T := new Terminal_T; begin T.Emulation := Emul; T.Cursor_X := 0; T.Cursor_Y := 0; T.In_Command := False; T.In_Extended_Command := False; T.Getting_X_Addr := False; T.Getting_Y_Addr := False; T.Roll_Enabled := True; T.Protection_Enabled := True; T.Skip_Byte := False; T.Holding := False; T.Expecting := False; T.Raw_Mode := False; T.Blinking := False; T.Dimmed := False; T.Reversed := False; T.Underscored := False; T.Protectd := False; T.Updated := True; Processor_Task := new Processor; Processor_Task.Start (T); return T; end Create; procedure Self_Test (T : in out Terminal_T) is HRule1 : constant String := "123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012245"; HRule2 : constant String := " 1 2 3 4 5 6 7 8 9 10 11 12 13 "; Chars : constant String := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!""$%^&*"; NLine : constant String := "3 Normal : "; DLine : constant String := "4 Dim : "; BLine : constant String := "5 Blink : "; RLine : constant String := "6 Reverse: "; ULine : constant String := "7 Under : "; NL, Op : String (1 .. 1); begin NL (1) := Dasher_NL; Op (1) := Dasher_Erase_Page; T.Process (Op); T.Process (HRule1 (1 .. Display.Get_Visible_Cols)); T.Process (HRule2 (1 .. Display.Get_Visible_Cols)); T.Process (NLine); T.Process (Chars); T.Process (NL); T.Process (DLine); Op (1) := Dasher_Dim_On; T.Process (Op); T.Process (Chars); Op (1) := Dasher_Dim_Off; T.Process (Op); T.Process (NL); T.Process (BLine); Op (1) := Dasher_Blink_On; T.Process (Op); T.Process (Chars); Op (1) := Dasher_Blink_Off; T.Process (Op); T.Process (NL); T.Process (RLine); Op (1) := Dasher_Rev_On; T.Process (Op); T.Process (Chars); Op (1) := Dasher_Rev_Off; T.Process (Op); T.Process (NL); T.Process (ULine); Op (1) := Dasher_Underline; T.Process (Op); T.Process (Chars); Op (1) := Dasher_Normal; T.Process (Op); T.Process (NL); for L in 8 .. Display.Get_Visible_Lines loop if L > 8 then T.Process (NL); end if; T.Process (Ada.Strings.Fixed.Trim (L'Image, Ada.Strings.Left)); end loop; end Self_Test; task body Processor is TA : Terminal_Acc_T; begin accept Start (Termin : Terminal_Acc_T) do TA := Termin; end Start; loop select accept Accept_Data (Str : String) do TA.Process (Str); end Accept_Data; or accept Stop; exit; or terminate; end select; end loop; Log (ERROR, "Terminal Processor has exited"); end Processor; procedure Set_Cursor (T : in out Terminal_T; X, Y : Natural) is begin T.Cursor_X := X; T.Cursor_Y := Y; end Set_Cursor; function Beep return Boolean is begin Gdk.Main.Beep; return False; end Beep; procedure Send_Model_ID (T : Terminal_T) is Response : String (1 .. 6); begin Response (1) := Character'Val (8#036#); -- Header 1 Response (1) := Character'Val (8#157#); -- Header 2 Response (3) := Character'Val (8#043#); -- Model Report Follows case T.Emulation is when D200 => Response (4) := Character'Val (8#041#); -- D100/D200 Response (5) := Character'Val (2#01011010#); -- see p.2-7 of D100/D200 User Manual (="Z") Response (6) := Character'Val (8#003#); -- Firmware Code when D210 => Response (4) := Character'Val (8#050#); -- D210 Response (5) := Character'Val (2#01010001#); -- See p.3-9 of D210/D211 User Manual Response (6) := Character'Val (8#132#); -- Firmware Code end case; Redirector.Router.Send_Data (Response); end Send_Model_ID; -- Process is to be called with a Byte_Arr whenever there is any data for -- the terminal to display or otherwise handle. procedure Process (T : in out Terminal_T; Str : String) is B : Character; B_Int : Integer; C : Character; begin for Ix in Str'Range loop B := Str (Ix); B_Int := Character'Pos (B); -- Ada.Text_IO.Put_Line ("DEBUG: Terminal.Process got: " & B'Image); T.Skip_Byte := False; if T.Getting_X_Addr then -- host is setting cursor address T.New_X_Addr := Natural (B_Int mod 127); if T.New_X_Addr = 127 then -- special case - x stays the same - see D410 User Manual p.3-25 T.New_X_Addr := T.Cursor_X; elsif T.New_X_Addr >= Display.Get_Visible_Cols then T.New_X_Addr := T.New_X_Addr - Display.Get_Visible_Cols; end if; T.Getting_X_Addr := False; T.Getting_Y_Addr := True; goto Redraw_Tube; end if; if T.Getting_Y_Addr then T.New_Y_Addr := Natural (B_Int mod 127); if T.New_Y_Addr = 127 then T.New_Y_Addr := T.Cursor_Y; elsif T.New_Y_Addr >= Display.Get_Visible_Lines then -- see end of p.3-24 in D410 User Manual if T.Roll_Enabled then Display.Scroll_Up (T.New_Y_Addr - (Display.Get_Visible_Lines - 1)); end if; T.New_Y_Addr := T.New_Y_Addr - Display.Get_Visible_Lines; end if; T.Set_Cursor (T.New_X_Addr, T.New_Y_Addr); T.Getting_Y_Addr := False; goto Redraw_Tube; end if; -- Log it if required if Session_Logger.Logging then Session_Logger.Log_Char (Character'Val (B_Int)); end if; -- short DASHER commands if T.In_Command then case B is when 'C' => T.Send_Model_ID; when 'D' => T.Reversed := True; when 'E' => T.Reversed := False; when 'F' => T.In_Extended_Command := True; when others => Log (WARNING, "Unrecognised Break-CMD code:" & B_Int'Image); end case; T.In_Command := False; goto Redraw_Tube; end if; -- D210 Command(s) if T.In_Extended_Command then case B is when 'F' => -- erase unprotected to end of screen -- clear to end of current line for Col in T.Cursor_X .. (Display.Get_Visible_Cols - 1) loop Display.Clear_Unprotected_Cell (Line => T.Cursor_Y, Col => Col); end loop; -- clear all lines below for Line in (T.Cursor_Y + 1) .. (Display.Get_Visible_Lines - 1) loop for Col in 0 .. (Display.Get_Visible_Cols - 1) loop Display.Clear_Unprotected_Cell (Line => T.Cursor_Y, Col => Col); end loop; end loop; when others => Log (WARNING, "Unrecognised Break-CMD F code:" & B_Int'Image); end case; T.In_Extended_Command := False; goto Redraw_Tube; end if; case B is when Dasher_Null => T.Skip_Byte := True; when Dasher_Bell => declare Dummy_ID : Glib.Main.G_Source_Id; begin Dummy_ID := Glib.Main.Idle_Add (Beep'Access); end; Log (INFO, "*** BEEP! ***" & Ada.Characters.Latin_1.BEL); -- on running terminal... T.Skip_Byte := True; when Dasher_Blink_On => T.Blinking := True; T.Skip_Byte := True; when Dasher_Blink_Off => T.Blinking := False; T.Skip_Byte := True; when Dasher_Blink_Enable => Display.Set_Blink_Enabled (True); -- Modifies Display T.Skip_Byte := True; when Dasher_Blink_Disable => Display.Set_Blink_Enabled (False); -- Modifies Display T.Skip_Byte := True; when Dasher_Command => T.In_Command := True; -- next char will form (part of) a command T.Skip_Byte := True; when Dasher_Cursor_Down => if T.Cursor_Y < Display.Get_Visible_Lines - 1 then T.Cursor_Y := T.Cursor_Y + 1; else T.Cursor_Y := 0; end if; T.Skip_Byte := True; when Dasher_Cursor_Left => if T.Cursor_X > 0 then T.Cursor_X := T.Cursor_X - 1; else T.Cursor_X := Display.Get_Visible_Cols - 1; if T.Cursor_Y > 0 then T.Cursor_Y := T.Cursor_Y - 1; else T.Cursor_Y := Display.Get_Visible_Lines - 1; end if; end if; T.Skip_Byte := True; when Dasher_Cursor_Right => if T.Cursor_X < Display.Get_Visible_Cols - 1 then T.Cursor_X := T.Cursor_X + 1; else T.Cursor_X := 0; if T.Cursor_Y < Display.Get_Visible_Lines - 1 then T.Cursor_Y := T.Cursor_Y + 1; else T.Cursor_Y := 0; end if; end if; T.Skip_Byte := True; when Dasher_Cursor_Up => if T.Cursor_Y > 0 then T.Cursor_Y := T.Cursor_Y - 1; else T.Cursor_Y := Display.Get_Visible_Lines - 1; end if; T.Skip_Byte := True; when Dasher_Dim_On => T.Dimmed := True; T.Skip_Byte := True; when Dasher_Dim_Off => T.Dimmed := False; T.Skip_Byte := True; when Dasher_Erase_EOL => for Col in T.Cursor_X .. Display.Get_Visible_Cols - 1 loop Display.Clear_Cell (T.Cursor_Y, Col); end loop; T.Skip_Byte := True; when Dasher_Erase_Page => Display.Scroll_Up (Display.Get_Visible_Lines); T.Set_Cursor (0, 0); T.Skip_Byte := True; when Dasher_Home => T.Set_Cursor (0, 0); T.Skip_Byte := True; when Dasher_Read_Window_Addr => -- REQUIRES RESPONSE - see D410 User Manual p.3-18 declare B3_Arr : String (1 .. 3); begin B3_Arr (1) := Character'Val (31); B3_Arr (2) := Character'Val (T.Cursor_X); B3_Arr (3) := Character'Val (T.Cursor_Y); select Redirector.Router.Send_Data (B3_Arr); or delay 0.5; end select; end; T.Skip_Byte := True; when Dasher_Rev_On => if T.Emulation /= D200 then -- only for D210 and later models T.Reversed := True; T.Skip_Byte := True; end if; when Dasher_Rev_Off => if T.Emulation /= D200 then T.Reversed := False; T.Skip_Byte := True; end if; when Dasher_Roll_Disable => T.Roll_Enabled := False; T.Skip_Byte := True; when Dasher_Roll_Enable => T.Roll_Enabled := True; T.Skip_Byte := True; when Dasher_Underline => T.Underscored := True; T.Skip_Byte := True; when Dasher_Normal => T.Underscored := False; T.Skip_Byte := True; -- TAB handling removed, according to the docs it is handled at the host end, not locally -- ... and re-added because I don't think it can ever cause a problem... when Dasher_Tab => T.Cursor_X := T.Cursor_X + 1; -- always at least 1 column while (T.Cursor_X + 1) mod 8 /= 0 loop if T.Cursor_X >= Display.Get_Visible_Cols - 1 then T.Cursor_X := 0; -- ??? What about Cursor_Y ??? else T.Cursor_X := T.Cursor_X + 1; end if; end loop; T.Skip_Byte := True; when Dasher_Write_Window_Addr => T.Getting_X_Addr := True; T.Skip_Byte := True; when others => null; end case; if T.Skip_Byte then goto Redraw_Tube; end if; -- wrap due to hitting margin or new line? if T.Cursor_X = Display.Get_Visible_Cols or else B = Dasher_NL then -- hit bottom of screen? if T.Cursor_Y = Display.Get_Visible_Lines - 1 then if T.Roll_Enabled then Display.Scroll_Up (1); else T.Cursor_Y := 0; Display.Clear_Line (T.Cursor_Y); end if; else T.Cursor_Y := T.Cursor_Y + 1; if not T.Roll_Enabled then Display.Clear_Line (T.Cursor_Y); end if; end if; T.Cursor_X := 0; end if; -- CR or NL? if B = Dasher_CR or else B = Dasher_NL then T.Cursor_X := 0; -- TODO handle Expect case goto Redraw_Tube; end if; -- if Mini_Expect.Runner.Is_Expecting then if Mini_Expect.Expecting then -- Mini_Expect.Runner_Task.Expect (B); declare Finished : Boolean; begin Mini_Expect.Handle_Char (B, Finished); -- if not Finished then -- Mini_Expect.Runner.Execute; -- end if; end; end if; -- Finally! Put the character in the displayable matrix C := Character'Val (127); -- the 'unknown character' character if B_Int < 128 and then BDF_Font.Font.Is_Loaded (B_Int) then C := B; end if; Display.Set_Cell (Line => T.Cursor_Y, Col => T.Cursor_X, Char => C, Blink => T.Blinking, Dim => T.Dimmed, Rev => T.Reversed, Under => T.Underscored, Prot => T.Protectd); T.Cursor_X := T.Cursor_X + 1; <> Display.Set_Cursor (T.Cursor_X, T.Cursor_Y); Display.Set_Dirty; end loop; end Process; end Terminal;