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: 8282 (0x205a) 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 Muncher_Unix is begin Text_Io.Put_Line ("This procedure is only for Unix versions."); end Muncher_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 Mch_Main; --// --// with Xlbt_Arithmetic; --// use Xlbt_Arithmetic; --// with Xlbt_String; --// use Xlbt_String; --// --// with Xlbp_Display; --// use Xlbp_Display; --// --// procedure Muncher_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 for the game. --// -- -geometry <geom>- Geometry - Specifies the window geometry --// -- -r - Use_Root - Specifies that the root display be used --// -- -s <number> - Muncher_Seed - Specifies seed for random number gen. --// -- -v - Verbose_Mode - Specifies verbose mode --// -- -q - Verbose_Mode - Specifies quiet mode --// -- --// -- Run the muncher 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; --// Use_Root : Boolean := False; --// Muncher_Seed : S_Long := 0; --// Verbose_Mode : 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: muncher [-display <display>]"); --// P (" -help - display this printout"); --// P (" -display <display> - display to use"); --// P (" -geometry <geom> - the window geometry"); --// P (" -r - root display is used"); --// P (" -s <number> - seed for random number gen."); --// P (" -v - verbose mode"); --// P (" -q - quiet mode"); --/ 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 This_Arg; --/ end if; --// --// --\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); --// --// ---- -r - Root - Specfies that the root window is to be used --// --// elsif This_Arg = "-r" then --// Use_Root := True; --// --// -- -s <number> - Muncher_Seed - Specifies seed for random number gen. --// --// elsif This_Arg = "-s" and then Argvi < Argc then --// Next_Arg; --// begin --// Muncher_Seed := S_Long'Value (To_String (This_Arg)); --// exception --// when others => --// Text_Io.Put_Line --// ("Bad argument to -s, expected a number: " & --// To_String (This_Arg)); --// Usage (0); --// end; --// --// -- -v - Verbose_Mode - Specifies verbose mode --// -- -q - Verbose_Mode - Specifies quiet mode --// --// elsif This_Arg = "-v" then --// Verbose_Mode := True; --// elsif This_Arg = "-q" then --// Verbose_Mode := False; --// --// ----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; --// --// Mch_Main.Main (Display => Display.all, --// Geometry => Geometry.all, --// Use_Root => Use_Root, --// Muncher_Seed => Muncher_Seed, --// Verbose_Mode => Verbose_Mode); --// --/ 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 Muncher_Unix; --/ if Cdf_Hpux then --// pragma Main; --/ end if; --// --/ end if; -- not R1000