|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11264 (0x2c00) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package body Buffer, package body Keyboard, package body Screen, package body Spreadsheet_Generic, package body Tool_Set, seg_0046ba
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« └─⟦this⟧
package body Spreadsheet_Generic is use Tool_Set; Nr_Of_Columns : constant Positive := Column_Type'Pos (Column_Type'Last) - Column_Type'Pos (Column_Type'First) + 1; Nr_Of_Lines : constant Positive := Line_Type'Pos (Line_Type'Last) - Line_Type'Pos (Line_Type'First) + 1; subtype Column_Number is Integer range 1 .. Nr_Of_Columns; subtype Line_Number is Integer range 1 .. Nr_Of_Lines; Screen_Width : constant Positive := 80; type Column_Width_Array is array (Column_Number) of Natural; Default_Column_Width : constant Positive := Screen_Width / Nr_Of_Columns; Actual_Column_Width : Column_Width_Array; Column_Offset : Column_Width_Array; type Cell is access String; Display : array (Line_Number, Column_Number) of Cell; The_Current_Line : Line_Type := Line_Type'First; The_Current_Column : Column_Type := Column_Type'First; type Field is (Cursor_Location, Status); ------- function Line (C : Line_Type := The_Current_Line) return Line_Number; function Col (C : Column_Type := The_Current_Column) return Column_Number; -- Entry buffer management -- package Buffer is procedure Clear; -- Untouched := true procedure Erase; -- Untouched := Untouched procedure Append (C : Character); procedure Put (S : String); procedure Del; function Get return String; function Is_Untouched return Boolean; end Buffer; package Screen is procedure Open (Name : String); procedure Close; procedure Cursor (Offset : Integer := 0); procedure Normal (S : String); procedure Inverse (S : String); function Prompt_For (S : String) return String; procedure Refresh; generic -- this is the only way I could make the generic actual -- parameter to Engine visible to Screen... with function Is_Selected (L : Line_Type; C : Column_Type) return Boolean; procedure Refresh_And_Highlight; procedure Refresh_End_Of_Line; procedure Mark; procedure Unmark; procedure Show (L : Line_Number; C : Column_Number); procedure Alert (S : String := ""; Beeps : Natural := 2); procedure Banner (F : Field := Status; Text : String := ""); end Screen; package Keyboard is type Logical_Key is -- (Up, Down, Right, Left, Begin_Of, End_Of,-- movement keys Bottom, Home, -- in fact "complete" and Ascii.Vt -- Definition, Help, Edit, Command, Print, Time,-- Save, Load, -- Compute, Format, Show, Reset, Del, Erase, -- Window, Object, Image, Line, Word, Mark, -- Enter, Numeric, -- Ascii_Char, Unknown); subtype Movement_Key is Logical_Key range Up .. Home; function Get_Key return Logical_Key; function Get_Char return Character; -- associated with logical keys: Ascii_Char or Numeric Disconnect, Quit : exception; end Keyboard; ------------- -- Bodies of default generic parameters function All_Columns_Equal (C : Column_Type) return Positive is begin return Default_Column_Width; end All_Columns_Equal; function All_Modifiable (L : Line_Type; C : Column_Type) return Boolean is begin return True; end All_Modifiable; function Not_Selected (L : Line_Type; C : Column_Type) return Boolean is begin return False; end Not_Selected; function No_Help return String is begin return "Sorry, no help available"; end No_Help; function No_Definition (L : Line_Type; C : Column_Type) return String is begin return "Sorry, no definition available"; end No_Definition; function No_Message return String is begin return "Sorry, no error message"; end No_Message; function No_File_Name return String is begin return "<None>"; end No_File_Name; function Default_File_Name return String is begin return "<Default>"; end Default_File_Name; procedure Up_And_Left_Border is begin for L in Line_Type loop Set (L, Column_Type'First, Left_Align (Capitalize (Line_Type'Image (L)), Actual_Column_Width (Column_Number'First))); end loop; for C in Column_Type loop Set (Line_Type'First, C, Right_Align (Capitalize (Column_Type'Image (C)), Actual_Column_Width (Col (C)))); end loop; end Up_And_Left_Border; procedure Upper_Left_Corner (L : out Line_Type; C : out Column_Type) is begin L := Line_Type'First; C := Column_Type'First; end Upper_Left_Corner; procedure Noop is begin Beep; end Noop; procedure Set (L : Line_Type := Current_Line; C : Column_Type := Current_Column; To_String : String; Immediately_Shown : Boolean := False) is begin Display (Line (L), Col (C)).all := To_String; if Immediately_Shown then Screen.Show (Line (L), Col (C)); end if; end Set; function Get (L : Line_Type := Current_Line; C : Column_Type := Current_Column) return String is begin return Display (Line (L), Col (C)).all; end Get; function Width (C : Column_Type := Current_Column) return Positive is begin return Actual_Column_Width (Col (C)); end Width; function Line (C : Line_Type := The_Current_Line) return Line_Number is begin return Line_Type'Pos (C) - Line_Type'Pos (Line_Type'First) + 1; end Line; function Col (C : Column_Type := The_Current_Column) return Column_Number is begin return Column_Type'Pos (C) - Column_Type'Pos (Column_Type'First) + 1; end Col; function Current_Line return Line_Type is begin return The_Current_Line; end Current_Line; function Current_Column return Column_Type is begin return The_Current_Column; end Current_Column; package body Buffer is separate; package body Keyboard is separate; package body Screen is separate; package body Tool_Set is separate; procedure Engine (Window_Name : String := Default_Name; Initial_File_To_Load : String := No_File_Name) is separate; end Spreadsheet_Generic;
nblk1=a nid=0 hdr6=14 [0x00] rec0=1c rec1=00 rec2=01 rec3=000 [0x01] rec0=01 rec1=00 rec2=0a rec3=01a [0x02] rec0=1a rec1=00 rec2=02 rec3=08e [0x03] rec0=01 rec1=00 rec2=09 rec3=042 [0x04] rec0=19 rec1=00 rec2=03 rec3=014 [0x05] rec0=00 rec1=00 rec2=08 rec3=006 [0x06] rec0=22 rec1=00 rec2=04 rec3=090 [0x07] rec0=1f rec1=00 rec2=05 rec3=01e [0x08] rec0=21 rec1=00 rec2=06 rec3=002 [0x09] rec0=1d rec1=00 rec2=07 rec3=000 tail 0x2170029fc815c66f16e71 0x42a00088462061e03