|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 14674 (0x3952)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Key;
use Xlbt_Key;
with Xlbt_Key2;
use Xlbt_Key2;
with Xlbt_Keyboard;
use Xlbt_Keyboard;
with Xlbt_Reply;
use Xlbt_Reply;
with Xlbt_Request;
use Xlbt_Request;
with Xlbip_Get_Reply;
use Xlbip_Get_Reply;
with Xlbip_Internal;
use Xlbip_Internal;
with Xlbip_Put_Request;
use Xlbip_Put_Request;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
package body Xlbp_Keyboard_Encoding is
------------------------------------------------------------------------------
-- X Library Keyboard Encoding
--
-- Xlbp_Keyboard_Encoding - Control over which key means what.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1985 - 1989 by the Massachusetts Institute of Technology
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the names of MIT or Rational not be
-- used in advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- MIT and Rational disclaim all warranties with regard to this software,
-- including all implied warranties of merchantability and fitness, in no
-- event shall MIT or Rational be liable for any special, indirect or
-- consequential damages or any damages whatsoever resulting from loss of use,
-- data or profits, whether in an action of contract, negligence or other
-- tortious action, arising out of or in connection with the use or performance
-- of this software.
------------------------------------------------------------------------------
--\f
procedure X_Change_Keyboard_Mapping (Display : X_Display;
Mapping : X_Key_Sym_Array_2d) is
N_Bytes : S_Natural :=
Mapping'Length (1) * Mapping'Length (2) * X_Key_Sym'Size / 8;
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Change_Keyboard_Mapping_Request
(Display,
(Kind => Change_Keyboard_Mapping,
Length =>
X_Change_Keyboard_Mapping_Request'Size / 32 +
U_Short ((N_Bytes + 3) / 4),
Pad1 => 0,
Key_Codes => Mapping'Length (1),
Key_Syms_Per_Key_Code => Mapping'Length (2),
--/ if not TeleGen2_2d_Bug then
First_Key_Code => Mapping'First (1)),
--/ else
--// First_Key_Code => X_Key_Code(Mapping'First (1))),
--/ end if;
N_Bytes);
Put_X_Key_Sym_Array_2d (Display, Mapping);
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return.
Unlock_Display (Display);
Sync_Handle (Display);
end X_Change_Keyboard_Mapping;
--\f
procedure X_Delete_Modifier_Map_Entry (Map : in out X_Modifier_Keymap;
Key_Code : X_Key_Code;
Modifier : X_Key_Modifier) is
begin
for I in Map.Modifiermap'Range loop
if Map.Modifiermap (I) (Modifier) = Key_Code then
Map.Modifiermap (I) (Modifier) := 0;
end if;
end loop;
-- should we shrink the map??
-- Map := Map;
end X_Delete_Modifier_Map_Entry;
--\f
procedure X_Display_Key_Codes (Display : X_Display;
Min_Key_Code : out X_Key_Code;
Max_Key_Code : out X_Key_Code) is
begin
Min_Key_Code := Display.Min_Keycode;
Max_Key_Code := Display.Max_Keycode;
end X_Display_Key_Codes;
--\f
function X_Get_Keyboard_Mapping
(Display : X_Display;
First_Key_Code : X_Key_Code;
Last_Key_Code : X_Key_Code) return X_Key_Sym_List_2d is
Rep : X_Reply_Contents;
Succ : X_Status;
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Get_Keyboard_Mapping_Request
(Display,
(Kind => Get_Keyboard_Mapping,
Length => X_Get_Keyboard_Mapping_Request'Size / 32,
Pad => 0,
Pad1 => 0,
First_Keycode => First_Key_Code,
Count => U_Char ("-" (Last_Key_Code, First_Key_Code)) + 1));
----Read the reply.
Get_Reply (Display => Display,
Code => Get_Keyboard_Mapping,
Reply => Rep,
Extra => 0,
Discard => False,
Status => Succ);
----Return the results.
if Succ = Failed or else
Rep.Get_Keyboard_Mapping.Length = 0 then
Unlock_Display (Display);
Sync_Handle (Display);
return None_X_Key_Sym_List_2d;
else
declare
Map : X_Key_Sym_List_2d;
N_Keys : constant S_Natural :=
(4 * S_Natural (Rep.Get_Keyboard_Mapping.Length)) /
(X_Key_Sym'Size / 8) /
S_Natural (Rep.Get_Keyboard_Mapping.
Key_Syms_Per_Key_Code);
Last_Key : constant X_Key_Code :=
Display.Min_Keycode + X_Key_Code'Val (N_Keys) - 1;
begin
begin
--/ if not TeleGen2_2d_Bug then
Map := new X_Key_Sym_Array_2d
(Display.Min_Keycode .. Last_Key,
0 .. Rep.Get_Keyboard_Mapping.
Key_Syms_Per_Key_Code - 1);
--/ else
--// Map := new X_Key_Sym_Array_2d
--// (Telegen2_2d_Bug (Display.Min_Keycode) ..
--// Telegen2_2d_Bug (Last_Key),
--// 0 .. Rep.Get_Keyboard_Mapping.
--// Key_Syms_Per_Key_Code - 1);
--/ end if;
exception
when others =>
Eat_Raw_Data
(Display,
S_Natural (Rep.Get_Keyboard_Mapping.Length) *
(32 / 8));
raise;
end;
Get_X_Key_Sym_Array_2d (Display, Map.all);
Unlock_Display (Display);
Sync_Handle (Display);
return Map;
exception
when others =>
Free_X_Key_Sym_List_2d (Map);
raise;
end;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
end X_Get_Keyboard_Mapping;
--\f
function X_Get_Modifier_Mapping
(Display : X_Display) return X_Modifier_Keymap
is
Rep : X_Reply_Contents;
Res : X_Modifier_Keymap;
Succ : X_Status;
Map : X_Modifier_Keymap;
begin
----Lock the display.
Lock_Display (Display);
begin
----Send the request.
Put_X_Get_Modifier_Mapping_Request
(Display, (Kind => Get_Modifier_Mapping,
Length => X_Get_Modifier_Mapping_Request'Size / 32,
Pad => 0));
----Read the reply
Get_Reply (Display => Display,
Code => Get_Modifier_Mapping,
Reply => Rep,
Extra => 0,
Discard => False,
Status => Succ);
if Succ /= Failed then
begin
declare
Bytes : constant S_Natural :=
4 * S_Natural (Rep.Get_Modifier_Mapping.Length);
Columns : constant S_Natural :=
Bytes / (X_Modifier_Key_Code_Sub_Array'Size
/ 8);
begin
Res := new X_Modifier_Keymap_Rec;
Map := Res;
Res.Modifiermap := new X_Modifier_Key_Code_Array
(0 .. Columns - 1);
exception
when others =>
Eat_Raw_Data
(Display,
S_Natural (Rep.Get_Modifier_Mapping.Length) *
(32 / 8));
raise;
end;
Get_X_Modifier_Key_Code_Array
(Display, Res.Modifiermap.all);
Res.Max_Keypermod := Rep.Get_Modifier_Mapping.
Num_Key_Per_Modifier;
exception
when others =>
Free_X_Modifier_Keymap (Res);
Map := None_X_Modifier_Keymap;
raise;
end;
else
Map := None_X_Modifier_Keymap;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return the result.
Unlock_Display (Display);
Sync_Handle (Display);
return Map;
end X_Get_Modifier_Mapping;
--\f
procedure X_Insert_Modifier_Map_Entry (Map : in out X_Modifier_Keymap;
Key_Code : X_Key_Code;
Modifier : X_Key_Modifier) is
Newmap : X_Modifier_Key_Code_List;
Row : X_Key_Modifier := Modifier;
begin
for I in Map.Modifiermap'Range loop
if Map.Modifiermap (I) (Row) = Key_Code then
-- Map := Map; -- already in the map
return;
end if;
if Map.Modifiermap (I) (Row) = 0 then
Map.Modifiermap (I) (Row) := Key_Code;
-- Map := Map; -- we added it without stretching the map
return;
end if;
end loop;
-- stretch the map
Newmap := new X_Modifier_Key_Code_Array
(1 .. S_Natural (Map.Max_Keypermod) + 1);
Newmap (Map.Modifiermap'Range) := Map.Modifiermap.all;
Free_X_Modifier_Key_Code_List (Map.Modifiermap);
Map.Modifiermap := Newmap;
Newmap (Newmap'Last) (Modifier) := Key_Code;
end X_Insert_Modifier_Map_Entry;
--\f
function X_New_Modifier_Map
(Keys_Per_Modifier : U_Char) return X_Modifier_Keymap is
Res : X_Modifier_Keymap := new X_Modifier_Keymap_Rec;
begin
Res.Max_Keypermod := Keys_Per_Modifier;
if Keys_Per_Modifier > 0 then
Res.Modifiermap := new X_Modifier_Key_Code_Array
(0 .. S_Natural (Keys_Per_Modifier) - 1);
else
Res.Modifiermap := null;
end if;
return Res;
exception
when others =>
Free_X_Modifier_Keymap (Res);
raise;
end X_New_Modifier_Map;
--\f
function X_Set_Modifier_Mapping
(Display : X_Display;
Modifier_Map : X_Modifier_Keymap) return X_Mapping_Status is
------------------------------------------------------------------------------
-- Returns:
-- 0 Mapping_Success
-- 1 Mapping_Busy - one or more old or new modifiers are down
-- 2 Mapping_Failed - one or more new modifiers unacceptable
------------------------------------------------------------------------------
Rep : X_Reply_Contents;
Map_Size : S_Natural := S_Natural (Modifier_Map.Max_Keypermod) *
X_Modifier_Key_Code_Sub_Array'Size / 8;
Succ : X_Status;
Stat : X_Mapping_Status := Mapping_Failed;
begin
----Lock the display.
Lock_Display (Display);
begin
Put_X_Set_Modifier_Mapping_Request
(Display,
(Kind => Set_Modifier_Mapping,
Length =>
X_Set_Modifier_Mapping_Request'Size / 32 +
U_Short (Map_Size) / 4,
Num_Key_Per_Modifier => Modifier_Map.Max_Keypermod),
Map_Size);
----Send the extra data.
Put_X_Modifier_Key_Code_Array (Display,
Modifier_Map.Modifiermap.all);
----Get the reply.
Get_Reply (Display => Display,
Code => Set_Modifier_Mapping,
Reply => Rep,
Extra => 0,
Discard => True,
Status => Succ);
if Succ /= Failed then
Stat := Rep.Set_Modifier_Mapping.Success;
end if;
----Catch exceptions.
exception
when others =>
Unlock_Display (Display);
raise;
end;
----Unlock; sync; return success.
Unlock_Display (Display);
Sync_Handle (Display);
return Stat;
end X_Set_Modifier_Mapping;
--\f
end Xlbp_Keyboard_Encoding;