home *** CD-ROM | disk | FTP | other *** search
- {$R-,S-,I+,D+,F-,V-,B-,N-,L+ }
-
-
- Unit Scl;
- Interface
-
-
- Uses Dos,Crt;
-
- CONST
- {************************************************************************}
- Programname ='OASIS / SCL';
- Version ='5.0';
- Copyright='Copyright (c)1986,87,88 Eureka Associates';
- {************************************************************************}
-
- TYPE
- String128 = STRING[128];
- String80 = STRING[80];
- String10 = STRING[10];
- String20 = STRING[20];
- String13 = STRING[13];
- String40 = STRING[40];
- String70 = STRING[70];
-
- CONST
-
- {Increase the following values if required}
-
- Max_Error_Messages = 100; {max 100 recs in file ???.ERR}
- Max_Input_Messages = 400; {max 400 recs in file ???.MSG}
- Max_Heap_Screens = 20; {max 20 formats in Mem simultaneously}
-
- Screenfile_Ext : String10 = '.scs'; {Change for other file name}
- Indexfile_Ext : String10 = '.sci'; {extensions}
- Errorfile_Ext : String10 = '.err';
- Messagefile_Ext: String10 = '.msg';
-
- {Help system }
-
- Code_Help_Field : INTEGER = 1060; {F2 Key to display field help screen}
- Code_Help_Format : INTEGER = 1059; {F1 Key to display format help screen}
- Auto_Help_Set : BOOLEAN = TRUE; {Autohelp feature enabled}
- Autohelp_Screen = 'AUTOHELP'; {Name of autohelp format}
- Maxerrors : INTEGER = 3; {Display Autohelp after 3 consecutive
- input errors.}
-
- {Country information to be used by SCL; 0=Use System setting. Change if other
- country code is to be used}
-
- CONST
- Scl_Country : INTEGER = 0;
-
- {Cursor wrap around feature; Set to TRUE if no wraparound is desired (Mouse) }
-
- No_Wrap : BOOLEAN = FALSE;{Overrides format specs if TRUE}
-
-
- {Field blinker}
-
- Timer_Intervall : INTEGER = 3; {Increase for slower blinking fields}
-
-
- {Beep Sound}
-
- Beep_Off : BOOLEAN = FALSE; {SCL beeps in case of input errors}
- Beep_Time : INTEGER = 3; {3 bursts of about 50 ms each}
- Beep_Frequency_1 : INTEGER = 200; {First frequency 200 hertz}
- Beep_Frequency_2 : INTEGER = 350; {Second frequency 350 hertz}
-
- (*pointers to the background tasks; inilialized during 'Select_format_file'
- to point to 'dummy' *)
-
- Lp_Background_Pointer:Pointer=NIL;
- Hp_Background_Pointer:Pointer=NIL;
-
- {Messages}
-
- Input_Msg_Set : BOOLEAN = TRUE; {Input messages are not supressed}
- Error_Msg_Set : BOOLEAN = TRUE; {error messages are not supressed}
-
-
- {**************************************************************************}
- { NOTE:
- All constants named 'Code...' define keyboard keys to perform certain
- functions within SCL.
- They are the ASCII Codes of the appropriate keys with 1000 added, if they
- return a two byte (extended) code, starting with an ESC character.
- Example: Code_F7. The F7 key returns a two byte code <ESC> 'A'.
- Therefore it is coded as follows: 1000 + 65 = 1065. (65 is the ASCII Value
- of 'A'.
- (The same scheme applies to all character coding in SCL)
- ***************************************************************************}
-
- {Characters to be used for the 'Marked field attribute'}
-
- Mark_Field_Left : INTEGER = 16; {ASCII 16}
- Mark_Field_Right : INTEGER = 17; {ASCII 17}
-
- {Characters representing 'Yes' and 'No'. Used for boolean variables.
- Change for other languages.}
-
- Code_Yes : INTEGER = 89; {'Y'}
- Code_No : INTEGER = 78; {'N'}
-
-
- {Special Keys, change for non standard keyboard layouts}
-
- Code_Cancel_Act : INTEGER = 1061; {F3 to cancel a field change}
- Code_Abort : INTEGER = 1068; {F10 to unconditionally abort a format}
- Code_Escape : INTEGER = 27;
- Code_Home : INTEGER = 1071;
- Code_Tab : INTEGER = 9;
- Code_Ctrltab : INTEGER = 1116; {Internal use, don't change}
- Code_Rtab : INTEGER = 1015;
- Code_Return : INTEGER = 13;
- Code_Left : INTEGER = 1075;
- Code_Right : INTEGER = 1077;
- Code_Down : INTEGER = 1080;
- Code_Up : INTEGER = 1072;
- Code_End : INTEGER = 1079;
- Code_Ins : INTEGER = 1082;
- Code_Del : INTEGER = 1083;
- Code_Backspace : INTEGER = 8;
- Code_Pgup : INTEGER = 1073;
- Code_Pgdown : INTEGER = 1081;
-
- {Codes for function keys}
-
- Code_F1 : INTEGER = 1059;
- Code_F2 : INTEGER = 1060;
- Code_F3 : INTEGER = 1061;
- Code_F4 : INTEGER = 1062;
- Code_F5 : INTEGER = 1063;
- Code_F6 : INTEGER = 1064;
- Code_F7 : INTEGER = 1065;
- Code_F8 : INTEGER = 1066;
- Code_F9 : INTEGER = 1067;
- Code_F10 : INTEGER = 1068;
-
- {'Do nothing' character. Don't change.}
-
- Code_Noop = 255;
-
-
- {Permitted characters for the different types of variables}
-
- Anything_Set : SET OF BYTE = [1..6,8,14..27,32..254];
- Integer_Set : SET OF BYTE = [32,43,45,48..57];
- Real_Set : SET OF BYTE = [32,43,45,46,48..57];
- Alpha_Set : SET OF BYTE = [32,65..90,97..122,128..167];
-
-
- {Message to be displayed in case of fatal SCL error, change for other language}
-
- Fatal_Msg_1 = 'FATAL ERROR IN SCREENHANDLER: ';
- Fatal_Msg_2 = 'ERROR NR: ';
- Fatal_Msg_3 = 'PROGRAM ABORTED.';
-
-
- {SCL internal Flags}
-
- Format_Aborted : BOOLEAN = FALSE;
- Msgfile_Exists : BOOLEAN = FALSE;
- Field_Inverted : BOOLEAN = TRUE;
- Blink_Count : INTEGER = 0;
- Beep_Switch : BOOLEAN = TRUE;
- Beep_Count : INTEGER = 0;
-
- {System dependant info. Don't change}
-
- Minint : INTEGER = -32767;
- Max_Format_Width = 80; {Max chars per line}
- Max_Format_Height = 25; {Max lines on display}
- Key_Buffer_Size = 50; {Type ahead buffer size}
- Max_Format_Fields = 50; {Max 50 fields on a format}
- Space : CHAR = ' '; {That's what a space looks like}
- Save_Exitproc : Pointer = NIL;
-
- TYPE
-
- Msgrec = String70;
- Fieldkinds = (Variable,Textfield,Constant);
- Contkinds = (I,R,Alpha,Anything,Bool);
- Position = (Left,Right,Center);
- Line = STRING[Max_Format_Width];
- Tenfunctions = ARRAY[1..10] OF BOOLEAN;
- Tenchars = ARRAY[1..10] OF INTEGER;
- Linearray = ARRAY[1..Max_Format_Height] OF Line;
- Inputbuffer = ARRAY[0..Key_Buffer_Size] OF INTEGER;
- Displaytypes = (Mda, Cga, Ega, Mcga, Vga);
-
-
- Fieldrec = RECORD
- Field_Msg_Nr :INTEGER; {ptr to rec in *.msg}
- Field_Help_Screen :String10;{help screen for this field}
- Fx, {column where this field starts}
- Fy, {row of this field}
- Fl :BYTE; {field length}
- Ld_Char :CHAR; {the char for left delimiter}
- Rd_Char :CHAR; {char for right delimiter}
- Next_Tab, {the field to go to if tab is pressed}
- Prev_Tab, {the field to go to if rtab is pressed}
- Look_Norm, {char attribute byte}
- Look_Act_Color, {char attribute byte}
- Look_Act_Mono, {special coding, see above}
- Look_Sel_Color, {char attribute byte}
- Look_Sel_Mono :BYTE;
- Inp_Required :BOOLEAN;
- Field_Type :Fieldkinds;
- Fill_Char :CHAR;
- Check_Each_Char :BOOLEAN;
- Cont_Type :Contkinds;
- Justify :Position;
- Cont_Min,
- Cont_Max :REAL;
- Nr_Of_Dec,
- Group_First,
- Group_Last :BYTE;
- Selected,
- Highlighted :BOOLEAN;
- END;
- Fieldarray = ARRAY[1..Max_Format_Fields] OF Fieldrec;
- Screen = RECORD
- Format_Status :BYTE;
- Screenname :String10;
- Format_Help_Screen :String10;
- F_Int :Tenfunctions;
- Char_Int :Tenchars;
- Error_Field,
- Message_Field,
- Total_Fields,
- First_Tab,
- Last_Tab,
- Format_Width,
- Format_Height :BYTE;
- Abort_Ok,
- Wrap_Ok :BOOLEAN;
- Spare :BOOLEAN;
- Format_Color :BYTE;
- Format_Image :Linearray;
- Field :Fieldarray;
- Filler :ARRAY[1..119] OF BYTE; {to get to 36*
- 128 bytes}
- END;
-
- Sckeyrec = RECORD
- Deleted :BOOLEAN;
- Scname :String10;
- Sckey :INTEGER;
- END;
- Screcptrtyp = ^heapscreenrec;
- Scstackrec = RECORD
- Saved_Mx,
- Saved_My,
- Saved_Fn,
- Saved_Xoff,
- Saved_Yoff,
- Recovery_Left,
- Recovery_Right,
- Recovery_Top,
- Recovery_Bottom,
- Saved_Status,
- Saved_Char_Code,
- Saved_Err :INTEGER;
- Saved_Fcs :String80;
- Saved_Char_Image :CHAR;
- Saved_Editmode,
- Saved_Char_Interrupt,
- Saved_Fieldend,
- Format_End :BOOLEAN;
- Screc :Screcptrtyp;
- END;
- Heapscreenrec = Screen;
- Scstacktyp = ARRAY[1..Max_Heap_Screens] OF Scstackrec;
- Msgptr = ^msg;
- Msg = String70;
-
- VAR
- Country, {contains country code used}
- Date_Format :INTEGER; {0=mmddyy, 1=ddmmyy}
- Date_Separator:CHAR; {from country info}
- Time_Separator:CHAR; {from country info}
- Currency :String10; {from country info}
- Flicker :BOOLEAN; {CGA ; needs Snow suppression}
- Screen_Mode :BYTE; {IBM Screen mode}
- Screenbase :Word; {Base address of video mem}
-
- {above info is set during SCL init and can be inquired anytime}
-
-
- Old_Clock : Pointer;
- Glb_Regs : Registers;
- Spaces : String80;
- Scmsg : ARRAY [1..500] OF Msgptr;
- Errorfile : TEXT;
- Msgfile : FILE OF Msgrec;
- Stack : Scstacktyp;
- Keyrec : Sckeyrec;
- Active_Format,
- Active_Field : INTEGER;
- Screens : FILE;
- Screenindex : FILE OF Sckeyrec;
- Inbuff : Inputbuffer;
- Buffbot,
- Bufftop : INTEGER;
- Editmode,
- {Mono_Adapter,}
- Fieldend : BOOLEAN;
- Progpath : String80;
- Stack_Debth,
- Xoff,
- Yoff,
- Activeformat,
- R_Ptr,
- W_Ptr,
- S_Ptr,
- Scmsgnr,
- Errorcount : INTEGER;
- Char_Image : CHAR;
- Char_Code,
- Mx,
- My,
- Glb_Status,
- Glb_Error : INTEGER;
- Error_Msg_Present,
- Msg_Present : BOOLEAN;
- Fieldcontsave : String80;
- Active_Format_File
- : String10;
- Checkrequired,
- Glb_Ok,
- User_Function,
- Begin_Of_Field,
- End_Of_Field,
- End_Of_Format : BOOLEAN;
- Newtime : REAL;
- Lasterror : INTEGER;
-
- Screen_Color_Translation_Table: ARRAY[0..255] OF BYTE;
- Current_Screen_Page :BYTE ABSOLUTE $000:$462;
-
- TYPE
- Cursoraddr=RECORD
- X,Y:BYTE;
- END;
-
- Carray=ARRAY[0..7] OF Cursoraddr;
-
- VAR
- Cursorpos:Carray ABSOLUTE $000:$450;
-
-
-
- (*Datacom related Declarations*)
-
- CONST
- Dc_Parity : CHAR = 'E';
- Dc_Stopbits : INTEGER = 1;
- Dc_Speed : INTEGER = 9600;
- Dc_Charsize : INTEGER = 7;
- Dc_Int_Save : Pointer = NIL;
- Dc_Buffer_Size = 2100;
- Dc_Rx_Buff_Bottom:INTEGER= 0;
- Dc_Rx_Buff_Top : INTEGER = 0;
- Dc_Open : BOOLEAN = FALSE;
- Tx_Char_Timeout: INTEGER = 500;
- Rts_Cts_Timeout: INTEGER = 500;
- Rts_Holdover : INTEGER = 0;
- Rts_Cts_Delay : INTEGER = 30;
- Bcc_Set : BOOLEAN = TRUE;
-
- (*Datacom Control Characters*)
-
- Nul = $0;
- Soh = $1;
- Stx = $2;
- Etx = $3;
- Eot = $4;
- Enq = $5;
- Ack = $6;
- Bel = $7;
- CON = $7;
- Bs = $8;
- Ht = $9;
- Lf = $a;
- Vt = $b;
- Ff = $c;
- Cr = $d;
- S0 = $e;
- S1 = $f;
- Dle = $10;
- Dc1 = $11;
- Dc2 = $12;
- Dc3 = $13;
- Dc4 = $14;
- Nak = $15;
- Syn = $16;
- Etb = $17;
- Can = $18;
- Em = $19;
- Sub = $1a;
- Esc = $1b;
- Fs = $1c;
- Gs = $1d;
- Rs = $1e;
- Us = $1f;
- Pol = $70;
- Sel = $71;
- Fsl = $73;
- Bsl = $74;
- Del = $7f;
-
-
- (*Datacom Receive Buffer*)
-
- VAR
- Dc_Rx_Buffer : ARRAY[0..Dc_Buffer_Size] OF BYTE;
- Bcc : BYTE;
-
-
-
- PROCEDURE Reset_Screen_Colors;
-
- PROCEDURE Change_Color(Att,Newatt:BYTE);
-
- FUNCTION Get_Current_Color(Attr:BYTE):BYTE;
-
- FUNCTION Capital(Wstr: STRING): STRING;
-
- FUNCTION Stripleft(Wstr: STRING): STRING;
-
- FUNCTION Stripright(Wstr: STRING): STRING;
-
- PROCEDURE Strip(VAR Wstr:STRING;VAR Len:INTEGER);
-
- FUNCTION Charstring(Whatchar:CHAR;Len:INTEGER):STRING;
-
- PROCEDURE Ftab(VAR Wstr:STRING;Fill_Char:CHAR;Just:Position;Len:INTEGER);
-
- FUNCTION Justify_Left(STR:STRING;Len:INTEGER):STRING;
-
- FUNCTION Justify_Right(STR:STRING;Len:INTEGER):STRING;
-
- FUNCTION Justify_Center(STR:STRING;Len:INTEGER):STRING;
-
- PROCEDURE Frontstring(STR:STRING;VAR Head,Tail:STRING);
-
- FUNCTION X_Max:INTEGER;
-
- FUNCTION Y_Max:INTEGER;
-
- FUNCTION St(I:INTEGER):String80;
-
- FUNCTION Nr(St:String80):INTEGER;
-
- FUNCTION Rst(R:REAL; Decimals:INTEGER):String80;
-
- FUNCTION Rnr(S:STRING):REAL;
-
- FUNCTION Power(Mantissa, Exponent:REAL):REAL;
-
- PROCEDURE Get_Screen_Mode;
-
- PROCEDURE Get_Country;
-
- PROCEDURE Cursor(Top,Bottom:BYTE);
-
- PROCEDURE Cursor_Off;
-
- PROCEDURE Scl_Init_Fields;
-
- PROCEDURE Set_Edit_Mode(Yes:BOOLEAN);
-
- PROCEDURE Writeta(Txt:STRING;X,Y,Attr:BYTE);
-
- PROCEDURE Writet(Txt:STRING;X,Y:BYTE);
-
- PROCEDURE Writea(Count:Word;X,Y,Attr:BYTE);
-
- FUNCTION Displaytype:Displaytypes;
-
- FUNCTION Videomode:BYTE;
-
- PROCEDURE Set_Screen_Color(Color:BYTE);
-
- PROCEDURE Set_Field_Color(Fieldnr:INTEGER;Color:BYTE);
-
- PROCEDURE Scl_Undraw_Marks(Fieldnr:INTEGER);
-
- PROCEDURE Scl_Prepare_Stack;
-
- FUNCTION Format_Name:String80;
-
- FUNCTION Get_Att(X,Y:BYTE):BYTE;
-
- PROCEDURE Paint_Format_Frame(Color:BYTE);
-
- PROCEDURE Set_Mx(Value:INTEGER);
-
- PROCEDURE Set_My(Value:INTEGER);
-
- FUNCTION Exist(Fn : String80):BOOLEAN;
-
- FUNCTION Date_String(Y,M,D:Word):String10;
-
- FUNCTION Time_String(H,M,S:Word):String10;
-
- PROCEDURE Check_Time(VAR Time_Str:String10;VAR H,M,S:Word);
-
- PROCEDURE Check_Date(VAR Date_Str:String10;VAR Y,M,D:Word);
-
- FUNCTION Weekday(Y,M,D:Word):Word;
-
- FUNCTION Julian_Date(VAR Y,M,D:Word):REAL;
-
- PROCEDURE Normal_Date(Julian:REAL;VAR Y,M,D:Word);
-
- FUNCTION Date:String10;
-
- FUNCTION Time(Seconds:BOOLEAN):String10;
-
- FUNCTION Environment(Env_Name:String128):String128;
-
- PROCEDURE EXECUTE(Progstring:String128);
-
- PROCEDURE Executedos(Command:String128);
-
- FUNCTION Printer_Ready(Res:BYTE):BOOLEAN;
-
- FUNCTION Next_Char(VAR Esc:BOOLEAN):CHAR;
-
- FUNCTION Rtime:REAL;
-
- PROCEDURE Beep;
-
- PROCEDURE Fatal_Scl_Error(Errornr:INTEGER);
-
- PROCEDURE W_Crt(Fieldnr:INTEGER;Msg:String80);
-
- FUNCTION Sys_Msg(Nr:INTEGER):String80;
-
- FUNCTION User_Msg(Nr:INTEGER):String80;
-
- PROCEDURE Input_Error(Msgnr:INTEGER);
-
- PROCEDURE W_Field_Msg(Fn:INTEGER);
-
- PROCEDURE Update_Field(Fieldnr:INTEGER;Fill:BOOLEAN);
-
- PROCEDURE R_Cont(Fieldnr:INTEGER;VAR Contents:String80);
-
- PROCEDURE R_Sel(Fieldnr:INTEGER; VAR Sel:BOOLEAN);
-
- FUNCTION G_Cont(Fn:INTEGER):String80;
-
- FUNCTION Scl_G_Cont(Fn:INTEGER):String80;
-
- FUNCTION G_Sel(Fn:INTEGER):BOOLEAN;
-
- FUNCTION Scl_G_Sel(Fn:INTEGER):BOOLEAN;
-
- PROCEDURE Set_Field_Norm(Fieldnr:INTEGER);
-
- PROCEDURE Set_Field_Act(Fieldnr:INTEGER);
-
- PROCEDURE Finish_Format(Check:BOOLEAN);
-
- PROCEDURE Close_Formats;
-
- PROCEDURE Select_Format_File(Filename:String10);
-
- PROCEDURE Blank_Format;
-
- PROCEDURE Select_Format(Fname:String10);
-
- PROCEDURE Get_Next_Char(VAR Charnumber:INTEGER ; VAR Inputchar:CHAR);
-
- PROCEDURE W_Cont(Fieldnr:INTEGER;Cont:String80);
-
- PROCEDURE W_Sel(Fieldnr:INTEGER;Sel:BOOLEAN);
-
- PROCEDURE C_Cont(Fieldnr:INTEGER);
-
- FUNCTION Format_Done:BOOLEAN;
-
- PROCEDURE Goto_Field(Fn:INTEGER);
-
- PROCEDURE Display_Format(Xoffset,Yoffset:INTEGER);
-
- PROCEDURE Handle_Format;
-
- (* --------Datacom Routines----------- *)
- PROCEDURE Clear_Rx_Buffer;
-
- PROCEDURE Set_Dc_Params;
-
- PROCEDURE Get_Dc_Status(VAR Status:INTEGER);
-
- PROCEDURE Dc_Break;
-
- FUNCTION Cts:BOOLEAN;
-
- FUNCTION Dsr:BOOLEAN;
-
- FUNCTION Ri:BOOLEAN;
-
- PROCEDURE Set_Rts(On:BOOLEAN);
-
- PROCEDURE Set_Dtr(On:BOOLEAN);
-
- PROCEDURE Enable_Port;
-
- PROCEDURE Disable_Port;
-
- PROCEDURE Dc_Diagnose(On:BOOLEAN);
-
- PROCEDURE Close_Dc;
-
- PROCEDURE Open_Dc(VAR Result:INTEGER);
-
- PROCEDURE Dc_Write(Code:BYTE;VAR Ok:BOOLEAN);
-
- FUNCTION Tx_Ok:BOOLEAN;
-
- PROCEDURE Send_Char(Code:BYTE;VAR Ok:BOOLEAN);
-
- PROCEDURE Send_String(Data:STRING;VAR Ok:BOOLEAN);
-
- PROCEDURE Send_Buffer(VAR Tx_Buff;Buff_Start,Buff_Length,Bcc_Add:INTEGER;
- Head:STRING;VAR Ok:BOOLEAN);
- PROCEDURE Receive_Char(VAR Code:INTEGER;VAR Ok:BOOLEAN);
-
-