DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦f67e8d80d⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Worm_Unix, seg_0053a7

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



--/ if R1000 then
with Text_Io;

procedure Worm_Unix is  
begin  
    Text_Io.Put_Line ("This procedure is only for Unix versions.");  
end Worm_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 Worm_Main;
--//
--// with Xlbt_Arithmetic;
--// use Xlbt_Arithmetic;
--// with Xlbt_String;
--// use Xlbt_String;
--//
--// with Xlbp_Display;
--// use Xlbp_Display;
--//
--// procedure Worm_Unix is
--// ------------------------------------------------------------------------------
--// -- Copyright 1991 - 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
--// --  -length <n>     - Length    - Specifies the length of each worm (50)
--// --  -size <n>       - Size      - Specifies the size of each segment (2)
--// --  -number <n>     - Number    - Specifies the number of worms (64)
--// --  -S              - Screen_Saver - Specifies true to cover full screen
--// --  -R              - Rotate_Colors- Specifies true to rotate colormap
--// --  -C              - Chromo_Colors- Specifies true for panchromatic worms
--// --
--// -- Run the Worm 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;
--//     Length        : S_Positive := 50;
--//     Size          : S_Positive := 2;
--//     Number        : S_Positive := 64;
--//     Screen_Saver  : Boolean    := False;
--//     Rotate_Colors : Boolean    := False;
--//     Chromo_Colors : Boolean    := False;
--//
--// --\x0c
--/ 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;
--//
--// --\x0c
--//     procedure Usage (Result : Integer) is
--//         procedure P (S : String) renames Text_Io.Put_Line;
--//     begin
--//
--//         P ("Usage: Worm [-display <display>]");
--//         P ("  -help              - display this printout");
--//         P ("  -display <display> - display to use");
--//         P ("  -geometry <geom>   - the window geometry");
--//         P ("  -length <n>        - length of worm segments (default 50)");
--//         P ("  -size <n>          - size of worm segments (default 2)");
--//         P ("  -number <n>        - number of worms (default 64)");
--//         P ("  -S                 - screen saver mode - covers screen");
--//         P ("  -R                 - rotate colormap while running");
--//         P ("  -C                 - chromocolor worms - multicolor");
--/ 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;
--//         raise Program_Error;
--//
--//     end Usage;
--//
--// --\x0c
--//     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;
--//
--// --\x0c
--// 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);
--//
--// --  -length <n>     - Length - length of worms
--//
--//         elsif This_Arg = "-length" and then Argvi < Argc then
--//             Next_Arg;
--//             begin
--//                 Length := S_Long'Value (To_String (This_Arg));
--//             exception
--//                 when others =>
--//                     Text_Io.Put_Line ("Bad argument to -length, must be > 0: " &
--//                                       To_String (This_Arg));
--//                     Usage (0);
--//             end;
--//
--// --  -size <n>     - Size - length of worm segments
--//
--//         elsif This_Arg = "-size" and then Argvi < Argc then
--//             Next_Arg;
--//             begin
--//                 Size := S_Long'Value (To_String (This_Arg));
--//             exception
--//                 when others =>
--//                     Text_Io.Put_Line ("Bad argument to -size, must be > 0: " &
--//                                       To_String (This_Arg));
--//                     Usage (0);
--//             end;
--//
--// --  -number <n>     - Number - number of worms
--//
--//         elsif This_Arg = "-number" and then Argvi < Argc then
--//             Next_Arg;
--//             begin
--//                 Number := S_Long'Value (To_String (This_Arg));
--//             exception
--//                 when others =>
--//                     Text_Io.Put_Line ("Bad argument to -number, must be > 0: " &
--//                                       To_String (This_Arg));
--//                     Usage (0);
--//             end;
--//
--// ---- -S    - Screen_Saver
--//
--//         elsif This_Arg = "-S" then
--//             Screen_Saver := True;
--//
--// ---- -R    - Rotate_Colors
--//
--//         elsif This_Arg = "-R" then
--//             Rotate_Colors := True;
--//
--// ---- -C    - Chromo_Colors
--//
--//         elsif This_Arg = "-C" then
--//             Chromo_Colors := 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 other strings.
--//
--//     if Geometry = None_X_String_Pointer then
--//         Geometry := new X_String'("");
--//     end if;
--//
--//     Worm_Main.Main (Display       => Display.all,
--//                     Geometry      => Geometry.all,
--//                     Length        => Length,
--//                     Size          => Size,
--//                     Number        => Number,
--//                     Screen_Saver  => Screen_Saver,
--//                     Rotate_Colors => Rotate_Colors,
--//                     Chromo_Colors => Chromo_Colors);
--//
--/ if Cdf_Hpux then
--//     System_Interface.Process.Ext (Result);
--/ elsif TeleGen2 and then Unix then
--//     Process_Control.Exit_Execution (0);      -- Program exit
--/ end if;
--//
--// exception
--//
--//     when Program_Error =>
--/ if Cdf_Hpux then
--//         System_Interface.Process.Ext (Result);
--/ elsif TeleGen2 and then Unix then
--//         Process_Control.Exit_Execution (Unix_Types.Integer_32 (1));
--/ end if;
--//         null;               -- Normal exit
--//
--// end Worm_Unix;
--/ if Cdf_Hpux then
--// pragma Main;
--/ end if;
--//
--/ end if; -- not R1000

E3 Meta Data

    nblk1=b
    nid=0
    hdr6=16
        [0x00] rec0=27 rec1=00 rec2=01 rec3=03e
        [0x01] rec0=0e rec1=00 rec2=02 rec3=016
        [0x02] rec0=11 rec1=00 rec2=03 rec3=024
        [0x03] rec0=1a rec1=00 rec2=04 rec3=012
        [0x04] rec0=15 rec1=00 rec2=05 rec3=00e
        [0x05] rec0=22 rec1=00 rec2=06 rec3=006
        [0x06] rec0=1d rec1=00 rec2=07 rec3=01c
        [0x07] rec0=17 rec1=00 rec2=08 rec3=080
        [0x08] rec0=1f rec1=00 rec2=09 rec3=04c
        [0x09] rec0=1d rec1=00 rec2=0a rec3=00e
        [0x0a] rec0=13 rec1=00 rec2=0b rec3=001
    tail 0x21500a0de8197897ada8a 0x42a00088462063203