|
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: 11419 (0x2c9b)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦306851c02⟧
└─⟦this⟧
--/ if R1000 then
with Text_Io;
procedure Ico_Unix is
begin
Text_Io.Put_Line ("This procedure is only for Unix versions.");
end Ico_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 Ico_Main;
--//
--// with Xlbt_Arithmetic;
--// use Xlbt_Arithmetic;
--// with Xlbt_String;
--// use Xlbt_String;
--//
--// with Xlbp_Display;
--// use Xlbp_Display;
--//
--// procedure Ico_Unix is
--// ------------------------------------------------------------------------------
--// -- Copyright 1990 - 1991 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
--// -- -obj <object> - Object - Specifies the object to use
--// -- -noedges - Edges - Specifies that edges are invisible
--// -- -faces - Faces - Specifies that faces are drawn
--// -- -geometry <geom>- Geometry - Specifies the window geometry
--// -- -i - Invert - Specifies inverted/reverse colors
--// -- -colors <list> - Colors - Specifies a list of colors to use
--// -- -d <number> - Dashes - Specifies a dashed-line patter to use
--// -- -sleep <secs> - Sleep - Specifies a sleep interval
--// -- -dbl - Double_Buffer - Specifies that double buffering occur
--// -- -r - Root - Specfies that the root window is to be used
--// -- -help - Help - Specifies that a help list be displaye
--// --
--// -- Run the ico 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;
--// Object : X_String_Pointer;
--// Edges : Boolean := True;
--// Faces : Boolean := False;
--// Geometry : X_String_Pointer;
--// Invert : Boolean := False;
--// Colors : X_String_Pointer;
--// Dashes : S_Natural := 0;
--// Sleep : Duration := 0.0;
--// Double_Buffer : Boolean := False;
--// Use_Root : 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: ico [-display <display>]");
--// P (" -help - display this printout");
--// P (" -display <display> - display to use");
--// P (" -obj <object> - object to draw; cube, ico, tetra");
--// P (" -noedges - edges are invisible");
--// P (" -faces - faces are drawn");
--// P (" -geometry <geom> - the window geometry");
--// P (" -i - inverted/reverse colors");
--// P (" -colors <list> - list of colors to use");
--// P (" -d <number> - dashed-line patter to use");
--// P (" -sleep <secs> - sleep interval, eg. 0.5");
--// P (" -dbl - double buffering");
--// P (" -r - root window is to be used");
--/ 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
--/ end if;
--//
--// Argc := Get_Argc;
--// 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);
--//
--// ---- -obj <object> - Object - Specifies the object to use
--//
--// elsif This_Arg = "-obj" and then Argvi < Argc then
--// Next_Arg;
--// Object := new X_String'(This_Arg);
--//
--// ---- -noedges - Edges - Specifies that edges are invisible
--//
--// elsif This_Arg = "-noedges" then
--// Edges := False;
--//
--// ---- -faces - Faces - Specifies that faces are drawn
--//
--// elsif This_Arg = "-faces" then
--// Faces := True;
--//
--// ---- -geometry - Geometry - Specifies the window geometry
--//
--// elsif This_Arg = "-geometry" and then Argvi < Argc then
--// Next_Arg;
--// Geometry := new X_String'(This_Arg);
--//
--// ---- -i - Invert - Specifies inverted/reverse colors
--//
--// elsif This_Arg = "-i" then
--// Invert := True;
--//
--// ---- -colors <list> - Colors - Specifies a list of colors to use
--//
--// elsif This_Arg = "-colors" and then Argvi < Argc then
--// Next_Arg;
--// Colors := new X_String'(This_Arg);
--//
--// ---- -d <number> - Dashes - Specifies a dashed-line patter to use
--//
--// elsif This_Arg = "-d" and then Argvi < Argc then
--// Next_Arg;
--// begin
--// Dashes := S_Long'Value (To_String (This_Arg)) and 16#FF#;
--// exception
--// when others =>
--// Text_Io.Put_Line
--// ("Bad argument to -d, expected a number: " &
--// To_String (This_Arg));
--// Usage (0);
--// end;
--//
--// ---- -sleep <secs> - Sleep - Specifies a sleep interval
--//
--// elsif This_Arg = "-sleep" and then Argvi < Argc then
--// Next_Arg;
--// declare
--// package Fooey is new Text_Io.Fixed_Io (Duration);
--// Void : Positive;
--// begin
--// Fooey.Get (To_String (This_Arg), Sleep, Void);
--// exception
--// when others =>
--// Text_Io.Put_Line
--// ("Bad argument to -sleep, expected a fixed point number: " &
--// To_String (This_Arg));
--// Usage (0);
--// end;
--//
--// ---- -dbl - Double_Buffer - Specifies that double buffering occur
--//
--// elsif This_Arg = "-dbl" then
--// Double_Buffer := True;
--//
--// ---- -r - Root - Specfies that the root window is to be used
--//
--// elsif This_Arg = "-r" then
--// Use_Root := 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 Object = None_X_String_Pointer then
--// Object := new X_String'("ICO");
--// end if;
--// if Geometry = None_X_String_Pointer then
--// Geometry := new X_String'("");
--// end if;
--// if Colors = None_X_String_Pointer then
--// Colors := new X_String'("");
--// end if;
--//
--// Ico_Main.Main (Display => Display.all,
--// Object => To_String (Object.all),
--// Edges => Edges,
--// Faces => Faces,
--// Geometry => Geometry.all,
--// Invert => Invert,
--// Colors => Colors.all,
--// Dashes => Dashes,
--// Sleep => Sleep,
--// Double_Buffer => Double_Buffer,
--// Use_Root => Use_Root,
--// Help_Printout => False);
--//
--/ 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 Ico_Unix;
--/ if Cdf_Hpux then
--// pragma Main;
--/ end if;
--//
--/ end if; -- not R1000