home *** CD-ROM | disk | FTP | other *** search
- {$R-,S+,I+,D+,T-,F-,V-,B-,N-,L+ }
- {$M 16384,0,655360 }
-
-
- unit scl;
- interface
-
-
- uses dos,crt;
-
- 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 : Byte = 16; {ASCII 16}
- Mark_Field_Right : Byte = 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;
-
- Dta_Type = RECORD
- Reserved : ARRAY[1..21] OF Byte;
- Attribute: Byte;
- Time, Date, Filesizelo, Filesizehi : INTEGER;
- Name : STRING[13];
- END;
-
- 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;
- Scr_Pos = RECORD
- Txt,
- Att :Byte;
- END;
- Scrmap = ARRAY[1..25,1..80] OF Scr_Pos;
- Scstacktyp = ARRAY[1..Max_Heap_Screens] OF Scstackrec;
- Msgptr = ^msg;
- Msg = String70;
-
- Var
- Screen_Color_Translation_Table: Array[0..255] of Byte; {screen att xlation}
- 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}
-
- {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;
- Color_True : BOOLEAN;
- Screen_Mode : byte;
- Mscreen : Scrmap Absolute $b000:$0000;
- Cscreen : Scrmap Absolute $b000:$8000;
-
- (*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;
-
-
-
- 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 Reset_Screen_Colors;
-
- Procedure Change_Color(Oldattr,NewAttr:Byte);
-
- Function Get_Current_Color(Attr:Byte):Byte;
-
- PROCEDURE Set_Edit_Mode(Yes:BOOLEAN);
-
- PROCEDURE Set_Att(X,Y:INTEGER;Color:Byte);
-
- PROCEDURE Dc(X,Y,Charcode:Byte);
-
- PROCEDURE Draw_Char(Charcode:Byte);
-
- PROCEDURE Set_Screen_Color(Color:Byte);
-
- PROCEDURE Set_Field_Color(Fieldnr:INTEGER;Color:Byte);
-
- function format_name:string80;
-
- FUNCTION Get_Att(X,Y:INTEGER):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 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;
-
- PROCEDURE Input_Error(Msgnr:INTEGER);
-
- PROCEDURE R_Cont(Fieldnr:INTEGER;VAR Contents:String80);
-
- PROCEDURE R_Sel(Fieldnr:INTEGER; VAR Sel:BOOLEAN);
-
- FUNCTION G_Cont(Fn:INTEGER):String80;
-
- FUNCTION G_Sel(Fn:INTEGER):BOOLEAN;
-
- 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);
-
-
-
- implementation
-
-