DataMuseum.dk

top - download

    Length: 8813 (0x226d)
    Types: TextFile
    Names: »B«

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦ada0be243⟧ 
                └─⟦this⟧ 

TextFile

--/ if R1000 then
with Text_Io;

procedure Xev_Unix is  
begin  
    Text_Io.Put_Line ("This procedure is only for Unix versions.");  
end Xev_Unix;

--/ else -- not R1000
--//
--/ if Cdf_Hpux then
--// with Command_Line;
--// with System_Interface;
--//
--/ elsif TeleGen2 and then Unix then
--// with Process_Control;                   -- Unix process control; exit(n)
--// with Unix_Types;                        -- Unix types
--/ end if;
--//
--// with System;
--// with Text_Io;
--//
--// with Xev_Main;
--//
--// with Xlbt_Arithmetic;
--// use Xlbt_Arithmetic;
--// with Xlbt_String;
--// use Xlbt_String;
--// with Xlbt_Window;
--// use Xlbt_Window;
--//
--// with Xlbp_Display;
--// use Xlbp_Display;
--// with Xlbp_Proc_Var;
--// use Xlbp_Proc_Var;
--//
--// with Xlbit_Library3;
--//
--// procedure Xev_Unix is
--// ------------------------------------------------------------------------------
--// -- Copyright 1990 - 1990 by Rational, Santa Clara, California.
--// --
--// --                  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 Rational not be used in
--// -- advertising or publicity pertaining to distribution of the software
--// -- without specific, written prior permission.
--// --
--// -- Rational disclaims all warranties with regard to this software, including
--// -- all implied warranties of merchantability and fitness, in no event shall
--// -- 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.
--// ------------------------------------------------------------------------------
--// ------------------------------------------------------------------------------
--// -- Command line arguments:
--// --
--// --  -display <name> - Display   - Specifies the display to use for the game.
--// --  -geometry <geom>- Geometry  - Specifies the window geometry
--// --  -b              - Backing_Store - Requests backing stroe
--// --  -s              - Save_Under    - Requests save unders
--// --  -bw <number>    - Border_Width  - Specifies the border width
--// --
--// -- Run the xev program.
--// ------------------------------------------------------------------------------
--//
--//     Argc    : Integer;
--//     Argvi   : Integer;
--//
--/ if Cdf_Hpux then
--//     Argv : constant Command_Line.String_Ptr_Array := Command_Line.Arguments;
--/ elsif TeleGen2 and then Unix then
--//     Argv : X_String (1 .. 1024);
--//     Argvlen : Integer;
--/ end if;
--//
--//     Display       : X_String_Pointer;
--//     Geometry      : X_String_Pointer;
--//     Backing_Store : X_Backing_Store_Hint := Not_Useful;
--//     Save_Under    : Boolean              := False;
--//     Border_Width  : U_Short              := 2;
--//     Sync          : boolean              := False;
--//
--// --\f

--/ if TeleGen2 and then Unix then
--//     function Get_Argv (Position    : Integer;
--//                        Arg_Ptr     : System.Address;
--//                        Arg_Max_Len : Integer) return Integer;
--//     pragma Interface (C, Get_Argv);
--//     pragma Linkname (Get_Argv, "Xlbmt_Get_ArgV");
--//
--//     function Get_Argc return Integer;
--//     pragma Interface (C, Get_Argc);
--//     pragma Linkname (Get_Argc, "Xlbmt_Get_ArgC");
--//
--/ end if;
--//
--// --\f

--//     procedure Usage (Result : Integer) is
--//         procedure P (S : String) renames Text_Io.Put_Line;
--//     begin
--//
--//         P ("Usage: xev [-display <display>]");
--//         P ("  -help              - display this printout");
--//         P ("  -display <display> - display to use");
--//         P ("  -geometry <geom>   - the window geometry");
--//         P ("  -b Not_Useful/When_Mapped/Always - request backing store");
--//         P ("  -s                 - request save under");
--//         P ("  -bw <number>       - set window border widths");
--/ if cdf_hpux then
--//         System_Interface.Process.Ext (Result);
--/ elsif TeleGen2 and then Unix then
--//         Process_Control.Exit_Execution (Unix_Types.Integer_32 (Result));
--/ end if;
--//
--//     end Usage;
--//
--// --\f

--//     procedure Next_Arg is
--//     begin
--/ if TeleGen2 and then Unix then
--//         Argvlen := Get_Argv (Argvi,
--//                              Argv (Argv'First)'Address,
--//                              Argv'Length);
--/ end if;
--//         Argvi   := Argvi + 1;
--//     end Next_Arg;
--//
--//     function This_Arg return X_String is
--//     begin
--/ if Cdf_Hpux then
--//         return To_X_String (Argv (Argvi - 1).all);
--/ elsif TeleGen2 and then Unix then
--//         return Argv (1 .. S_Natural (Argvlen));
--/ end if;
--//     end This_Arg;
--//
--// --\f

--// begin
--//
--// ----Process the command line arguments.  Skip the 0'th argument, it is just
--// --  our command name.
--//
--/ if Cdf_Hpux then
--//     Argc := Command_Line.Argc;
--/ elsif TeleGen2 and then Unix then
--//     Argc  := Get_Argc;
--/ end if;
--//
--//     Argvi := 1;
--//     while Argvi < Argc loop
--//         Next_Arg;
--//
--// ---- -display <name> - Display   - Specifies the display to use
--//
--//         if This_Arg = "-display" and then Argvi < Argc then
--//             Next_Arg;
--//             Display := new X_String'(This_Arg);
--//
--// ---- -help           - Help      - Specifies that a help list be displaye
--//
--//         elsif This_Arg = "-help" then
--//             Usage (0);
--//
--// ---- -geometry       - Geometry  - Specifies the window geometry
--//
--//         elsif This_Arg = "-geometry" and then Argvi < Argc then
--//             Next_Arg;
--//             Geometry := new X_String'(This_Arg);
--//
--// ---- -bw <number>   - Border_Width - border width
--//
--//         elsif This_Arg = "-bw" and then Argvi < Argc then
--//             Next_Arg;
--//             begin
--//                 Border_Width := U_Short'Value (To_String (This_Arg));
--//             exception
--//                 when others =>
--//                     Text_Io.Put_Line
--//                        ("Bad argument to -bw, expected a small number: " &
--//                         To_String (This_Arg));
--//                     Usage (0);
--//             end;
--//
--// ---- -b    - Backing_Store
--//
--//         elsif This_Arg = "-b" and then Argvi < Argc then
--//             Next_Arg;
--//             begin
--//                 Backing_Store := X_Backing_Store_Hint'Value
--//                                        (To_String (This_Arg));
--//             exception
--//                 when others =>
--//                     Text_Io.Put_Line
--//                        ("Bad argument to -b, expected Not_Useful/When_Mapped/Always: " &
--//                         To_String (This_Arg));
--//                     Usage (0);
--//             end;
--//
--// ---- -s    - Save_Under
--//
--//         elsif This_Arg = "-s" then
--//             Save_Under := True;
--//
--// ---- -sync    - Synchronous
--//
--//         elsif This_Arg = "-sync" then
--//             Sync := True;
--//
--// ----Anything else is an error.
--//
--//         else
--//             Text_Io.Put_Line ("Unrecognized command line option: {" &
--//                               To_String (This_Arg) & "}");
--//             Usage (1);
--//         end if;
--//     end loop;
--//
--// ----We must have a display.
--//
--//     if Display = None_X_String_Pointer then
--//         Display := new X_String'(X_Display_Name (""));
--//     end if;
--//
--// ----Create the output filename.
--//
--//     if Geometry = None_X_String_Pointer then
--//         Geometry := new X_String'("");
--//     end if;
--//
--//     if Sync then
--//         Xlbit_Library3.X_Lib.Set_Debug (True);
--//     end if;
--//     Xev_Main.Main (Display       => Display.all,
--//                    Geometry      => Geometry.all,
--//                    Backing_Store => Backing_Store,
--//                    Save_Under    => Save_Under,
--//                    Border_Width  => Border_Width);
--//
--/ if Cdf_Hpux then
--//     System_Interface.Process.Ext (0);
--/ elsif TeleGen2 and then Unix then
--//     Process_Control.Exit_Execution (0);      -- Program exit
--/ end if;
--//
--// end Xev_Unix;
--/ if cdf_hpux then
--// pragma Main;
--/ end if;
--//
--/ end if; -- not R1000