Skip to content

Instantly share code, notes, and snippets.

@da-x

da-x/Code from 1996 - XEDIT.PAS

Last active November 14, 2016 21:06
Show Gist options
  • Save da-x/2a3ce68fd17b0988f00ac1f249f60b4d to your computer and use it in GitHub Desktop.
Save da-x/2a3ce68fd17b0988f00ac1f249f60b4d to your computer and use it in GitHub Desktop.
Download ZIP
Code from 1996 - XEDIT.PAS
Raw
Code from 1996 - XEDIT.PAS
Uses dans, sunit, crt, DOS, mgdrive, danmath,clocks, newgraph;
Const
vers = '0.01';
editorname = 'DAedit';
VersO = editorname + ' ' + vers;
StyleS1 : Array [1..15] Of String [4] = (
'_/*#', '_/*', '/*#', '_*#', '_/#', '_*', '*#', '*/', '/#', '/_', '#_', '_', '/', '#', '*');
StyleS2 : Array [1..15] Of String [4] = (
'#*/_', '*/_', '#*/', '#*_', '#/_', '*_', '#*', '/*', '#/', '_/', '_#', '_', '/', '#', '*');
Type
qs = (Yes, No, Cencel);
String12 = String [12];
String80 = String [80];
Point = Record X, Y: Byte End;
Rect = Record a, b: point End;
Colo = Record back, Ford: Byte; End;
SetupColor = Record
Status, Help, Sargel, Vertic, Mark: colo;
Style: Array [1..15] Of colo;
Text : Record
normal,
Q,
tear,
Origin,
tag: colo;
End;
End;
SetupRec = Record
SargelLine,
Helpline,
Statusline,
Vertic,
fifty,
hebrew,
autolang
: Boolean;
Color: SetupColor;
ELeft, Erigth, Hleft, Hrigth: Integer;
Firstline,
screensave,
autosave
: Integer;
ImportBegin,
ImportEnd: String80;
UUEImportBegin,
UUEImportEnd: String80;
Tearline: String;
golded: String;
CommandLine: String;
Memsofit: Char;
Hebfix: Char;
ccx, ccy: Byte;
End;
Const
dra: Array [1..11] Of String [11] =
('Ú¿ÀÙijŽÅÁÃ',
'ַӜĺҶ×ÐÇ',
'՞ԟͳѵØÏÆ',
'ɻȌͺ˹ÎÊÌ',
'ÛÛÛÛÛÛÛÛÛÛÛ',
'***********',
'/\\/*******',
'/\\/-|+++++',
'+++++++++++',
'++++-|+++++',
' ');
uuecodestream : Array [1..64] Of Char = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
MustPushChars : Array [1..36] Of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
OtherPushchars : Array [1..16] Of Char = '.,:;_/\()[]{}-+=';
NormalRect: rect = (a: (X: 1; Y: 1); b: (X: 80; Y: 25) );
DefSetup: SetupRec = (SargelLine: True; Helpline: True;
Statusline: True; Vertic: True; fifty: False; hebrew: True; autolang: false;
Color: (
Status: (back: 1; ford: 11) ;
Help: (back: 1; ford: 11);
Sargel: (back: 0; ford: 1);
Vertic: (back: 0; ford: 8);
Mark: (back: 7; ford: 0);
Style : (
(back: 0; ford: 7), (back: 0; ford: 13), (back: 0; ford: 4), (back: 0; ford: 1), (back: 0; ford: 14)
, (back: 0; ford: 11), (back: 0; ford: 2), (back: 0; ford: 5), (back: 0; ford: 12), (back: 0; ford: 6)
, (back: 0; ford: 15), (back: 0; ford: 10), (back: 0; ford: 14), (back: 0; ford: 9), (back: 0; ford: 12) );
Text: (normal: (back: 0; ford: 15);
q: (back: 0; ford: 14);
tear: (back: 0; ford: 7);
Origin: (back: 0; ford: 10);
Tag: (back: 0; ford: 12)
)
);
ELeft: 1; Erigth: 75; Hleft: 10; Hrigth: 65;
Firstline: 1;
screensave: 180;
Autosave: 179;
Importbegin:'|ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ @F Start ]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|';
ImportEnd: '|ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ @F End ]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|';
UUEImportbegin:'|ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ @F Start Coded file]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|';
UUEImportEnd: '|ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ @F End Coded file ]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|';
Tearline: editorname + ' @V';
golded: 'C:\FD\GOLDED';
commandline: '';
memsofit: #79;
hebfix:#255
);
q: String80 = 'yrety';
DB__Byte = 1;
DB__Integer = 2;
DB__String = 3;
DB__Longint = 4;
DB__Colo = 5;
DB__Boolean = 6;
Type
Linearray = Array [1..5000] Of ^String80;
DelLineBuff = Array [1..300] Of ^String80;
DataboxParit =
Record
D: pointer;
Dtype, Fsize: Integer;
X, Y: Byte;
after, before: String [30];
above: String [75];
End;
Databox = Object
Pot: Array [1..50] Of ^DataboxParit;
Coter: String [40];
Numofpot: Integer;
curdb: Integer;
X, Y, X2, Y2: Integer;
Procedure Add (Var p; Dtype, Fsize: Integer; X1, Y1: Byte);
Function Run: Byte;
Constructor Init (Coter1: String; X1, Y1, X21, Y21: Integer);
Destructor DeInit;
End;
Boton = Object
X, Y: Byte;
Chktag: Boolean;
Alabel: String12;
Procedure Init (X1, Y1: Byte; Chktag1: Boolean; Alabel1: String12);
Procedure Draw;
End;
SetupObj = Object
Setup: SetupRec;
Constructor Init (b: SetupRec);
Function GetCFGfileName: String;
Procedure Load;
Procedure Save;
Procedure Edit;
End;
String67 = String [67];
LLString67 = ^LString67;
LString67 = Record Next: LLString67; data: ^String67; End;
HElpStrList = Object
ChainHead: LLString67;
Records: LongInt;
Constructor Init;
Procedure Add (a: String67);
Function GetOp (l: Integer): String67;
Destructor Deinit;
End;
Editor =
Object
Lin:^Linearray;
numlines: Integer;
currow, curline, curlinedisp: Integer;
curdru: Byte;
eleft, erigth: Integer;
hleft, hrigth: Integer;
hebr, inst, push: Boolean;
LineMode: Boolean;
Mark, MarkSum: Integer;
LMp, Lastcur: point;
Window: rect;
filename, fileimport: String;
Saveqes: qs;
Constructor init (U1: Rect; s: String);
Destructor deinit;
Procedure Addline (lnum: Integer; s: String80);
Procedure DelLine (lnum: Integer);
Procedure AddlineEnd (s: String80);
Function run: Byte;
Procedure Lprint (lnum: Integer);
Procedure Allprint;
Procedure Smiley (a: Int);
Procedure SaveAsfile (filenam: String; ovrr: Boolean);
Procedure importfile (uue, part: Boolean);
Procedure loadfile;
Procedure Movemarked;
Procedure Copymarked;
Procedure Deletemarked;
Procedure DrawVertic;
Procedure Drawstatus;
Procedure Drawhelpline;
Procedure Drawsargel;
Procedure delchar (baks: Boolean);
Procedure Putchar (c: Char);
Procedure Beready;
Procedure Enter;
Procedure warp (Lnum: Word);
Procedure PendHome (a: Boolean);
Function endol (a: String): Integer;
Function Curow: Char;
Procedure godos;
Procedure Give_slicex (Var X: clock);
End;
MultiEditor = Object
Dellin:^DelLineBuff;
numdellines: Integer;
Lmode: Word;
Ef: Array [1..10] Of ^Editor;
CurEF: Byte;
Setup:^SetupObj;
Constructor Init;
Procedure RemoveDellineEnd;
Procedure AddDellineEnd (s: String80);
Function GetDelline: String80;
Destructor DeInit;
Procedure Run;
End;
Var
Me: ^MultiEditor;
ScrSwapSeed: Integer;
i: Integer;
engchar, hebchar: String;
ExtKEy : Boolean;
progpath: String;
execname: String [20];
Procedure GetTtextmode;
Begin
TextMode (co80 + Font8X8 * Ord (Me^. Setup^. setup. fifty) );
noblink;
End;
Procedure SwapTscr;
Var
f: File Of textscreen;
Begin
Inc (ScrSwapSeed);
Assign (f, progpath + 'DAES' + inttostr (ScrSwapSeed) + '.swp');
Rewrite (f);
Write (f, Tscr);
Close (f);
End;
Procedure UnSwapTscr;
Var
f: File Of textscreen;
Begin
Assign (f, progpath + 'DAES' + inttostr (ScrSwapSeed) + '.swp');
Reset (f);
Read (f, Tscr);
Close (f);
Erase (f);
Dec (ScrSwapSeed);
End;
Function LeadingZero (w : Word) : String;
Var
s : String;
Begin
Str (w: 0, s);
If Length (s) = 1 Then
s := '0' + s;
LeadingZero := s;
End;
Function GetTimeStr: String;
Var
h, m, s, hund : Word;
Begin
GetTime (h, m, s, hund);
gettimestr := LeadingZero (h) + ':' +
LeadingZero (m) + ':' + LeadingZero (s);
End;
Procedure Screensaver2;
Var
CurrX, CurrY, a2, b2, a, b: Real;
i, j, Counter: Integer;
XPos, YPos: Word;
o, p: Byte;
Procedure Cycle;
Var
Color: Byte;
Var R, G, B, R1, G1, B1: Byte;
Begin
Port [$3c7] := 0; R1 := Port [$3c9]; G1 := Port [$3c9]; B1 := Port [$3c9];
For Color := 0 To 62 Do
Begin
Port [$3c7] := Color + 1; R := Port [$3c9]; G := Port [$3c9]; B := Port [$3c9];
Port [$3c8] := Color; Port [$3c9] := R; Port [$3c9] := G; Port [$3c9] := B;
Delay (1);
End;
Port [$3c8] := 63; Port [$3c9] := R1; Port [$3c9] := G1; Port [$3c9] := B1;
End;
Label 1;
Begin
o := WhereX;
p := WhereY;
HideCursor;
swaptscr;
Randomize;
initscreen ($13);
For i := 0 To 15 Do PutRGB (i, 0, i * 2, i * 4);
For i := 0 To 16 Do PutRGB (i + 16, i * 4, 32 + i * 2, 63);
For i := 0 To 32 Do PutRGB (i + 31, 63, 63, 63);
Cscr (0);
For YPos := 0 To 99 Do
For XPos := 0 To 319 Do
Begin
CurrX := XPos * 0.008124 - 1.7666666;
CurrY := YPos * 0.010833 - 1.0833333;
a := 0;
b := 0;
Counter := 0;
Repeat
a2 := a * a;
b2 := b * b;
b := 2 * a * b + CurrY;
a := a2 - b2 + CurrX;
Inc (Counter);
Until (Counter >= 32) Or (a2 + b2 >= 1000) Or KeyPressed;
If KeyPressed Then Goto 1;
Pset (xpos, Ypos, Counter);
Pset (xpos, 199 - Ypos, Counter);
End;
1:
Repeat
Cycle;
{giveslice;}
Until KeyPressed;
ReadKey;
initscreen ($3);
GetTtextmode;
unswaptscr;
GotoXY (o, p);
End;
Procedure Give_slice;
Begin
{ Repeat}
{ For i := 1 To 10 Do giveslice;}
{ Until keypre;}
End;
Procedure Linedraw (X1, Y1, X2, Y2: Word; Var lin: Linearray; numlines, curdru: Integer); Forward;
Constructor SetupObj. Init (b: SetupRec);
Begin Setup := b; End;
Procedure picdrawthemon1 (coo, coo2: Char; ccx, ccy: Byte);
Var
i: Integer;
aop: Array [1..2] Of Char;
Begin
aop [1] := coo;
aop [2] := coo2;
For i := 1 To 2 Do puttext (22 + i * 2 + ccx * 2, 6 + ccy, 0, 10, aop [i] );
End;
Procedure piccharx (CH: pointer); Far;
Var
Dod:^Byte;
i, j: Integer;
X: Byte;
Label 2;
Begin
With Me^. setup^. setup Do
Begin
dod := CH;
SwapTscr;
Drawbox (23, 5, 57, 22, 1, 9, 15, 0, True, True);
For i := 0 To 15 Do
For j := 0 To 15 Do
puttextpASM (25 + j * 2, 6 + i, 0, 15, Chr (j + i * 16) );
Repeat
picdrawthemon1 ('>', '<', dod^ Mod 16, dod^ Div 16);
give_slice;
Drawbox (23, 5, 57, 22, 1, 9, 15, 0, False, True);
X := dod^;
Give_slice;
Case ReadKey Of
#0: Case ReadKey Of
#75: Dec (dod^);
#77: Inc (dod^);
#72: Dec (dod^, 16);
#80: Inc (dod^, 16);
End;
#13, #27: Break;
End;
picdrawthemon1 (' ', ' ', X Mod 16, X Div 16);
Until False;
2:
UnSwapTscr;
End;
End;
Function picchar (Var choosen: Boolean): Byte; Far;
Var
i, j: Integer;
pccx, pccy: Byte;
c, c2: Char;
Label 2;
Begin
With Me^. setup^. setup Do
Begin
SwapTscr;
choosen := True;
pccx := ccx;
pccy := ccy;
Drawbox (23, 5, 57, 22, 1, 9, 15, 0, True, True);
For i := 0 To 15 Do
For j := 0 To 15 Do
puttext (24 + j * 2, 6 + i, 0, 15, (#255 + Chr (i * 16 + j) ) );
c2 := (#255);
Repeat
picdrawthemon1 ('>', '<', ccx, ccy);
puttext (38, 22, 0, 15, 'µ' + inttostr (ccy * 16 + ccx) + 'Æ');
c2 := c;
Give_slice;
c := ReadKey;
Drawbox (23, 5, 57, 22, 1, 9, 15, 0, False, True);
picdrawthemon1 (' ', ' ', ccx, ccy);
If c2 = Chr (0) Then
Case Ord (c) Of
72: ccy := ccy - 1; 80: ccy := ccy + 1; 75: ccx := ccx - 1; 77: ccx := ccx + 1;
End;
If ccx = 255 Then ccx := 15;
If ccy = 255 Then ccy := 15;
If ccx = 16 Then ccx := 0;
If ccy = 16 Then ccy := 0;
Until (c = (#13) ) Or (c = (#27) );
If c = (#27) Then
Begin
ccx := pccx;
ccy := pccy;
choosen := False;
Goto 2;
End;
picchar := ccx + ccy * 16;
2:
UnSwapTscr;
End;
End;
Procedure piccolor (Var dod: colo); Far;
Var
i, j: Integer;
c, c2: Char;
X, Y: Byte;
Label 2;
Begin
With Me^. setup^. setup Do
Begin
SwapTscr;
Drawbox (23, 5, 57, 22, 1, 9, 15, 0, True, True);
For i := 0 To 15 Do
For j := 0 To 15 Do
puttextpASM (25 + j * 2, 6 + i, i, j, '€');
c2 := (#255);
Repeat
picdrawthemon1 ('>', '<', dod. ford, dod. back);
c2 := c;
give_slice;
Drawbox (23, 5, 57, 22, 1, 9, 15, 0, False, True);
X := dod. ford;
Y := dod. back;
Give_slice;
Case ReadKey Of
#0: Case ReadKey Of
#75: Dec (dod. ford);
#77: Inc (dod. ford);
#72: Dec (dod. back);
#80: Inc (dod. back);
End;
#13, #27: Break;
End;
picdrawthemon1 (' ', ' ', X, Y);
dod. ford := dod. ford Mod 16;
dod. back := dod. back Mod 16;
If dod. ford = 16 Then dod. ford := 0;
If dod. back = 16 Then dod. back := 0;
Until False;
2:
UnSwapTscr;
End;
End;
Function Fixstr (A: String; b: Byte): String; Far;
Var
i: Integer;
s: String;
Begin
s := a;
If b - Length (s) > 0 Then Begin
FillChar (s [Length (s) + 1], b - Length (s), 32);
s [0] := Chr (b);
End;
Fixstr := s;
End;
Procedure HelpMe;
Var
List:^HElpstrList;
CurLDisp: Integer;
TotalDisp: Integer;
Procedure WriteAll;
Var
i: Integer;
Begin
For i := CurlDisp To CurlDisp + TotalDisp - 1 Do
If i <= List^. Records Then
Puttext (7, 4 + i - curldisp, 7, 0, Fixstr (List^. GetOp (i), 67) )
Else Puttext (7, 4 + i - curldisp, 7, 15, Fixstr ('', 67) );
End;
Begin
Noblink;
Hidecursor;
SwapTscr;
New (List, Init);
CurLDisp := 1;
TotalDisp := 19 + Ord (Me^. setup^. setup. fifty) * 25;
Drawbox (6, 3, 74, TotalDisp + 4, 7, 15, 15, 7, True, True);
Puttext (37, 3, 15, 7, ' Help ');
List^. add ('F1 - This help screen');
List^. add ('F2 - Save as');
List^. add ('F3 - Import A file');
List^. add ('SHIFT-F3 - Import A file and code in UUE');
List^. add ('F7 - Mark/Demark/End Mark of sagment');
List^. add ('ALT-F7 - Move marked lines to current position');
List^. add ('CTRL-F7 - Copy marked lines to current position');
List^. add ('SHIFT-F7 - Delete marked lines');
List^. add ('F8 - Start/Continue drawing a line');
List^. add ('ALT-F8 - Choose drawing line type');
List^. add ('F9 - Load a file');
List^. add ('F10 - Fast Save and Exit');
List^. add ('CTRL-F10 - !!! MultiFile Manager !!!');
{ List^. add ('F11 - Fast Save and no Exit');
List^. add ('F12 - Fast Exit and NO SAVE');}
List^. add ('ALT-C - Configuration');
List^. add ('TAB - Switch bitween HEBREW and ENGLISH mode');
List^. add ('SHIFT-TAB - Toggle PUSHMODE On/Off.');
List^. add ('CTRL-] - Set rigth mergin');
List^. add ('CTRL-[ - Set left mergin');
List^. add ('CTRL-HOME - Go to the start of the file');
List^. add ('CTRL-END - Go to the end of the file');
List^. add ('CTRL-PGUP - Delete ALL quted line above the current line');
List^. add ('CTRL-PGDN - Delete ALL quted line below the current line');
List^. add ('CTRL-ENTER - Insert an empty line');
List^. add ('CTRL-Y - Delete a current line');
List^. add ('CTRL-U - Restore line deleted by CTRL-Y (up to 300) (Multifile)');
List^. add ('CTRL-S - Save cursor position');
List^. add ('CTRL-R - Restore cursor position');
List^. add ('ALT-T - Pick a char from the ASCII Table and put it. [AUTOSAVE]');
List^. add ('CTRL-T - Put the same char from ALT-T and put it.');
List^. add ('ALT-1 - Hide/show Status line [Autosave]');
List^. add ('ALT-2 - Hide/show Upper Ruler line [Autosave]');
List^. add ('ALT-3 - Hide/show Rigth Ruler line [Autosave]');
List^. add ('ALT-4 - Hide/show Help line [Autosave]');
List^. add ('ALT-5 - Switch bitween 50 lines and 25 lines mode');
List^. add ('ALT-6 - Prints '':-)''');
List^. add ('ALT-7 - Prints '':-(''');
List^. add ('ALT-8 - Prints '';-)''');
List^. add ('ALT-9 - Prints '';-(''');
List^. add ('ALT-0 - Prints ''ROTFL!!!'' or ''!!!Œ”ˆ…˜''');
List^. add ('ALT-G - Jump to a line specified by the user');
List^. add ('');
List^. add ('');
List^. add (' Command-Line Syntex:');
List^. add ('');
List^. add (' ' + execname + ' [Filename] [/c]'); ;
List^. add ('');
List^. add (' Filename - file to edit');
List^. add (' /c - load configuration only');
List^. add ('');
List^. add (editorname + ' by Dan Aloni (1997)');
List^. add ('');
Repeat
For i := 7 To 73 Do PutTextpasm (i, TotalDisp + 4, 7, 15, 'Ä');
PutText (19, TotalDisp + 4, 15, 7, ' ESC ');
If curldisp > 1 Then
Begin
PutText (25, TotalDisp + 4, 15, 7, '  ');
PutText (33, TotalDisp + 4, 15, 7, ' PAGEUP ');
End;
If CurlDisp < List^. records - Totaldisp + 1 Then
Begin
PutText (29, TotalDisp + 4, 15, 7, '  ');
PutText (44, TotalDisp + 4, 15, 7, ' PAGEDOWN ');
End;
WriteAll;
Give_slice;
Case ReadKey Of
#0: Case ReadKey Of
#80: Inc (CurlDisp);
#72: Dec (CurlDisp);
#81: Inc (CurlDisp, TotalDisp);
#73: Dec (CurlDisp, TotalDisp);
#79: CurlDisp := List^. records;
#71: CurlDisp := 1;
End;
#27: Break;
End;
If CurlDisp > List^. records - Totaldisp + 1 Then CurlDisp := List^. records - Totaldisp + 1;
If CurlDisp < 1 Then CurlDisp := 1;
Until False;
Dispose (List, deInit);
UnSwapTscr;
End;
Function ExReadKey (Var Extended : Boolean) : Char;
Var Regs : Registers;
Begin
Regs. AX := $1000;
Intr ($16, Regs);
Extended := (Regs. AL = 0) Or (Regs. AL > 127);
If Extended Then ExReadKey := Chr (Regs. AH)
Else ExReadKey := Chr (Regs. AL);
End;
Procedure Valimiti (Var t : Integer; s, e: Integer);
Begin
If t < s Then t := s;
If t > e Then t := e;
End;
Constructor HElpStrList. Init;
Begin
Records := 0;
ChainHead := Nil;
End;
Procedure HElpStrList. Add (A: String67);
Var
tmp, po: LLstring67;
Begin
If records = 0 Then
Begin
New (ChainHead);
GetMem (ChainHead^. Data, Length (a) + 1);
ChainHead^. Data^ := a;
With ChainHead^ Do Begin Next := Nil; End;
End
Else
Begin
New (Tmp);
GetMem (Tmp^. Data, Length (a) + 1);
Tmp^. Data^ := a;
po := ChainHead;
While (po^. next <> Nil) Do po := po^. next;
Tmp^. next := Nil;
po^. next := Tmp;
End;
Inc (Records);
End;
Destructor HElpStrList. Deinit;
Var
po, tmp: LLstring67;
Begin
If records > 0 Then
Begin
po := chainhead;
Repeat
tmp := po;
po := po^. next;
FreeMem (Tmp^. data, Length (Tmp^. data^) + 1);
Dispose (tmp);
Until po = Nil;
End;
End;
Function HElpStrList. GetOp (l: Integer): String67;
Var
po, tmp: LLstring67;
i: Integer;
Begin
If records > 0 Then
Begin
po := chainhead;
i := 0;
Repeat
tmp := po;
po := po^. next;
GetOp := tmp^. data^;
Inc (i);
Until (po = Nil) Or (i = l);
End;
End;
Constructor databox. Init (Coter1: String; X1, Y1, X21, Y21: Integer);
Begin
Noblink;
Coter := coter1;
X := X1;
Y := Y1;
X2 := X21;
Y2 := Y21;
Numofpot := 0;
curdb := 1;
Drawbox (X, Y, X2, Y2, 7, 15, 15, 7, True, True);
Puttext ( (X + X2) Div 2 - 1 - Length (coter) Div 2, Y, 15, 7, ' ' + coter + ' ');
End;
Destructor databox. DeInit;
Var
i: Integer;
Begin
For i := 1 To numofpot Do Dispose (Pot [i] );
End;
Procedure databox. Add (Var p; Dtype, Fsize: Integer; X1, Y1: Byte);
Begin
Inc (numofpot);
New (Pot [numofpot] );
Pot [numofpot]^. D := @p;
Pot [numofpot]^. dType := Dtype;
Pot [numofpot]^. Fsize := Fsize;
Pot [numofpot]^. X := X1;
Pot [numofpot]^. Y := Y1;
End;
Procedure Boton. Init (X1, Y1: Byte; Chktag1: Boolean; Alabel1: String12);
Begin
X := X1;
Y := Y1;
Alabel := Alabel1;
Chktag := Chktag1;
End;
Procedure Boton. Draw;
Var
i: Integer;
Begin
Puttext (X, Y, 15 - Ord (Chktag), 0, Alabel);
Puttextpixel (X, Y + 1, 4, 0, ' ', Tscr);
For i := 1 To Length (alabel) Do Puttextpixel (X + i, Y + 1, 4, 0, 'ß', Tscr);
Puttextpixel (X + Length (Alabel), Y, 4, 0, 'Ü', Tscr);
End;
Function Qset (s1: String; cencle: Boolean; def: qs): qs;
Var
i, j, kk, t1: Integer;
c: Char;
Tbot: Array [1..3] Of ^boton;
Procedure eUpdatebot;
Var
i: Integer;
Begin
Delay (10);
For I := 1 To 2 + Ord (cencle) Do Tbot [i]^. chktag := False;
Tbot [kk]^. chktag := True;
For i := 1 To 2 + Ord (cencle) Do Tbot [i]^. Draw;
End;
Label 2;
Begin
HideCursor;
noblink;
SwapTscr;
kk := Ord (def) + 1;
Qset := cencel;
t1 := 15;
For I := 1 To 3 - Ord (cencle) Do New (Tbot [I] );
Tbot [1]^. Init (Ord (Not (cencle) ) * 5 + 37 - t1 Div 2 - 2, 15, True, ' Yes ');
Tbot [2]^. Init (Ord (Not (cencle) ) * 5 + 37 , 15, False, ' No ');
If cencle Then Tbot [3]^. Init (37 + t1 Div 2, 15, False, ' Cencel ');
Drawbox (40 - t1 - 2, 11, 40 + t1 + 2, 17, 4, 15, 15, 4, True, True);
Puttext (40 - Length (s1) Div 2, 13, 4, 15, s1);
eUpdatebot;
Repeat
Give_slice;
c := ReadKey;
Case UpCase (c) Of
#$0: Case ReadKey Of
#75: Dec (kk);
#77: Inc (kk);
End;
'Y':
Begin Qset := Yes; Goto 2; End;
'N': Begin Qset := No; Goto 2; End;
(#13): Begin
Case kk Of
1: Qset := yes;
2: Qset := no;
3: Qset := Cencel;
End;
Break;
End;
Else Break;
End;
Valimiti (kk, 1, 2 + Ord (cencle) );
eUpdatebot;
Until False;
2:
restoreCursor;
For I := 1 To 3 - Ord (cencle) Do Dispose (Tbot [I] );
UnSwapTscr;
End;
Procedure Fixdir (Var s: String); Far;
Begin
If s [Ord (s [0] ) ] <> '\' Then
Begin
Inc (s [0] );
s [Ord (s [0] ) ] := '\';
End;
End;
Function FileExists (FileName: String): Boolean; Far;
Var
F: Text;
Attr: Word;
Begin
Assign (F, FileName);
GetFAttr (F, Attr);
FileExists := DosError = 0;
End;
Function SetupObj. GetCFGfileName: String;
Var
D: DirStr;
N: NameStr;
E: ExtStr;
Begin
FSplit (ParamStr (0), D, N, E);
GetCFGfileName := D + 'Daedit.cfg';
End;
Procedure SetupObj. save;
Var
f: File Of SetupRec;
Begin
Assign (f, GetCFGfileName);
Rewrite (f);
Write (f, Setup);
Close (f);
End;
Procedure SetupObj. load;
Var
f: File Of SetupRec;
s: String;
Begin
s := GetCFGfileName;
If Not (FileExists (s) ) Then save;
Assign (f, s);
Reset (f);
Read (f, Setup);
Close (f);
hebchar [111] := setup. memsofit
End;
Function Choose (title: String; Var data; strsize, numofcomp: Byte; Var curcomp: Byte; gg: Boolean): Byte;
Var
dob: Array [0..0] Of Byte Absolute data;
X, Y: Integer;
CH: Integer;
c: Char;
Function Get (a: Byte): String;
Var
s: String;
Begin
Move (dob [ (a - 1) * (strsize + 1) ], s, strsize + 1);
Get := s;
End;
Procedure PrintAll;
Var
i: Integer;
Begin
For i := 1 To numofcomp Do
If i = curcomp Then
Puttext (X, Y + i - 1, 0, 15, ' ' + fixstr (Get (i), strsize) + ' ')
Else Puttext (X, Y + i - 1, 7, 15, ' ' + fixstr (Get (i), strsize) + ' ')
End;
Begin
If gg Then SwapTscr;
CH := curcomp;
X := 39 - strsize Div 2;
Y := 13 - numofcomp Div 2;
Choose := 0;
Drawbox (X - 1, Y - 1, X + strsize + 2, Y + numofcomp, 7, 15, 15, 7, True, True);
Puttext (X + strsize Div 2 - Length (title) Div 2, Y - 1, 15, 7, ' ' + title + ' ');
Repeat
PrintAll;
Give_slice;
Extkey := False;
c := ReadKey;
Case c Of
#0:
Begin
Extkey := True;
c := ReadKey;
Case c Of
#80: Inc (curcomp);
#72: Dec (curcomp);
Else Begin
Choose := Ord (c);
Break;
End;
End
End;
#27:
Begin
curcomp := CH;
Choose := 27;
Break;
End;
#13:
Begin
Choose := 13;
Break;
End;
Else Begin
Choose := Ord (c);
Break;
End;
End;
If curcomp > numofcomp Then curcomp := numofcomp;
If curcomp < 1 Then curcomp := 1;
Until False;
If gg Then UnSwapTscr;
End;
Procedure StrEdit (s: String; X, Y, l, pla: Byte; Var Result1: String; Var REsult2: Char; Var plss: Byte); Far;
Var
Sp, pl: Byte;
o: String;
i: Integer;
c, c2: Char;
Insr: Boolean;
Procedure DrawStrEdit;
Var
i: Integer;
Begin
For i := sp To sp + l - 1 Do If i <= Length (s) Then
PutTextPixel (X + i - sp, Y, 0, 15, S [i], Tscr)
Else PutTextPixel (X + i - sp, Y, 0, 15, 'ú', Tscr)
End;
Label 2;
Begin
o := s;
insr := False;
RestoreCursor;
pl := pla;
Sp := 1;
Repeat
DrawStrEdit;
GotoXY (X + pl - sp, Y);
Give_slice;
c := ReadKey;
Case Ord (C) Of
0:
Begin
c2 := ReadKey;
Case Ord (C2) Of
80: Goto 2;
72: Goto 2;
82:
Begin insr := Not (insr); Case insr Of True: BigCursor; False: RestoreCursor End; End;
83: S := Copy (S, 1, pl - 1) + Copy (S, pl + 1, Length (s) - pl);
77: Inc (pl);
75: Dec (pl);
79: Pl := Length (s) + 1;
71: Pl := 1;
63: Goto 2;
End;
End;
27: Goto 2;
9: Goto 2;
8:
Begin Dec (pl); S := Copy (S, 1, pl - 1) + Copy (S, pl + 1, Length (s) - pl); End;
13:;
Else
Begin
Case insr Of
False: S := Copy (S, 1, pl - 1) + c + Copy (S, pl, Length (s) - pl + 1);
True: S := Copy (S, 1, pl - 1) + c + Copy (S, pl + 1, Length (s) - pl);
End;
Pl := pl + 1;
End;
End;
If pl > Length (s) + 1 Then pl := Length (s) + 1;
If pl < 1 Then pl := 1;
If pl > l Then sp := pl - l;
Until c = (#13);
2:
Result1 := s;
REsult2 := c;
If c = #27 Then Result1 := o;
If c = #0 Then REsult2 := c2;
plss := pl;
HideCursor;
End;
Function ByteToStr (I: Byte): String15;
Var
S: String [15];
Begin
Str (I, S);
ByteToStr := S;
End;
Function Fixstr250 (A: String; b: Byte): String; Far;
Var
i: Integer;
s: String;
Begin
s := a;
If b - Length (s) > 0 Then Begin
FillChar (s [Length (s) + 1], b - Length (s), 250);
s [0] := Chr (b);
End;
Fixstr250 := s;
End;
Function databox. Run: Byte;
Var
d_s :^String;
d_i :^Integer;
d_b :^Byte;
d_l :^LongInt;
d_c :^colo;
d_bl :^Boolean;
s, res : String;
c: Char;
c2: Byte;
Procedure PrintItAll;
Var
i: Integer;
Begin
For i := 1 To numofpot Do
With Pot [i]^ Do
Begin
Case Dtype Of
DB__Integer: s := inttostr (Integer (D^) );
DB__String:
Begin d_s := D; s := d_s^; End;
DB__Longint: s := Longinttostr (LongInt (D^) );
End;
If Length (s) > Fsize Then s := Copy (s, 1, Fsize);
If Dtype <> DB__colo Then
If Dtype = DB__byte Then
Puttextpasm (X, Y, 0, 15, Char (D^) )
Else
If Dtype = DB__boolean Then
If Boolean (D^) Then puttext (X, Y, 0, 15, 'Yes')
Else puttext (X, Y, 0, 15, 'No ')
Else Puttext (X, Y, 0, 15, fixstr250 (s, Fsize) )
End;
End;
Begin
Run := 0;
PrintItAll;
If curdb < 1 Then curdb := 1;
If curdb > Numofpot Then curdb := Numofpot;
With Pot [curdb]^ Do
Begin
Case Dtype Of
DB__Boolean: d_bl := D;
DB__Byte: d_b := D;
DB__Integer:
Begin d_i := D; s := Inttostr (D_i^); End;
DB__String: Begin d_s := D; s := d_s^; End;
DB__Longint: Begin d_l := D; s := longInttostr (D_l^); End;
DB__colo: d_c := D;
End;
If (Dtype = DB__colo) Or (Dtype = DB__byte)
Or (Dtype = DB__boolean)
Then
Begin
REstorecursor;
GotoXY (X, Y);
Repeat
If (Dtype = DB__boolean) Then
If d_bl^ Then puttext (X, Y, 0, 15, 'Yes')
Else puttext (X, Y, 0, 15, 'No ');
Give_slice;
c := ReadKey;
Case c Of
#13: If (Dtype <> DB__boolean) Then Begin
Case Dtype Of
DB__colo: PicColor (d_c^);
DB__byte: Piccharx (D);
End;
Break;
End;
#0:
Begin
c := ReadKey;
Case c Of
#80, #72: Break;
Else d_bl^ := Not (d_bl^);
End;
End;
#27, #9: Break;
Else d_bl^ := Not (d_bl^);
End;
Until False
End
Else
StrEdit (s, X, Y, Fsize, Length (s) + 1, res, c, c2);
Case c Of
#80, #9: Inc (curdb);
#72: Dec (curdb);
#27: Run := 1;
End;
Case Dtype Of
DB__Integer: d_i^ := Strtoint (res);
DB__String: d_s^ := res;
DB__Longint: d_l^ := Strtolongint (res);
End;
End;
End;
Function Ups (s: String): String; Far;
Var
i: Integer;
Begin
For i := 1 To Length (s) Do s [i] := UpCase (s [i] );
Ups := s;
End;
Procedure Docmessage (Title: String; c: Byte); Far;
Var
t:^textscreen;
Begin
New (t);
savetscr (t^);
Drawbox (38 - Length (title) Div 2, 12, 42 + Length (title) Div 2, 14, c, c + 8, c + 8, c, True, True);
Puttext (40 - Length (title) Div 2, 13, c, 15, title);
Give_slice;
np;
loadtscr (t^);
Dispose (t);
RestoreCursor;
End;
Procedure Puttextd (column, row: Byte; back, ford: Byte; s: String); Far;
Var
doba, i, j1, j2, k, k2, j3, j4: Integer;
backc, fordc: Byte;
s3: Array [1..4] Of String [4];
s2: String [4];
BoldStop : String [10];
c: Char;
hada: Byte;
dow: Boolean;
Function ifhada (g, o: Byte): Byte;
Begin
ifhada := g + Pos (Styles2 [o], Copy (S, g + Length (styles2 [o] ), Length (s) - g) );
End;
Function ifhada2 (g: String; D: Char): Boolean;
Var
i: Integer;
Begin
Ifhada2 := True;
For i := 1 To Length (g) Do
If g [i] = D Then Begin Ifhada2 := False; Break End;
End;
Label n1;
Begin
BoldStop := '/\-Ä.:;';
doba := 0;
fordc := ford;
backc := back;
hada := 0;
dow := True;
For I := Column To (Column + Length (s) - 1) Do
Begin
c := s [i - column + 1];
If (doba <= 0) And ( (c = '_') Or (c = '/') Or (c = '#') Or (c = '*') )
Then
Begin
For k2 := 1 To 4 Do s3 [k2] := Copy (s, 1 + i - Column, k2);
For j1 := 1 To 15 Do
Begin
s2 := s3 [Length (Styles1 [j1] ) ];
If (s2 = Styles1 [j1] ) Then
Begin
k2 := ifhada (1 + i - Column, j1);
If (k2 <> 0) Then
Begin
For j3 := 1 + i - Column + Length (Styles1 [j1] ) To Length (s) Do
If ifhada2 (boldStop, s [j3] )
And (Copy (s, j3, Length (Styles2 [j1] ) ) = Styles2 [j1] )
Then
Begin
doba := j3 - i + Column + Length (Styles2 [j1] );
Break;
Break;
Break;
Break;
End;
For j4 := i - column + 1 + Length (Styles2 [j1] )
To i - column + 1 + doba - Length (Styles2 [j1] ) Do
If Not (ifhada2 (boldStop, s [j4] ) ) Then
Begin
doba := 0;
Break;
End;
If doba < 3 Then doba := 0;
hada := j1;
End;
Goto n1
End;
End;
End;
n1:
Dec (doba);
If doba < 0 Then doba := 0;
If (hada <> 0) And (doba > 0) Then
With Me^. setup^. setup. Color Do
PuttextpASM (i, row, Style [hada].back,
Style [hada].ford, s [1 + i - Column] )
Else PuttextpASM (i, row, backc, fordc, s [1 + i - Column] );
End;
End;
Function Fixstr2 (a: String; b: Byte): String; Far;
Begin
Fixstr2 := fixstr ('', b - Length (a) ) + a;
End;
Procedure Getfile (Var Getfileo: String); Far;
Type
FileList = Array [1..2000] Of ^SearchRec;
PVaribleRec = ^VaribleRec;
VaribleRec = Record
DirInfo: ^SearchRec;
Listoffiles:^FileList;
Curfile, CurFileDisp, Numoffiles: Int;
c: Char;
End;
Var
Avar:^VaribleRec;
i, j, k: Int;
p: pointer;
s: String;
wasfile: String;
wasdir: String [80];
dada: Byte;
c: Char;
Function Dcase (a: Char): Char;
Begin
If (a >= 'A') And (a <= 'Z') Then Dcase := Chr (Ord (a) - Ord ('A') + Ord ('a') )
Else Dcase := a;
End;
Function LZ (w : Word) : String;
Var
s : String;
Begin
Str (w: 0, s);
If Length (s) = 1 Then
s := '0' + s;
LZ := s;
End;
Function Dirinfo2Str (Var b: SearchRec): String; Far;
Var
a: SearchRec;
i: Int;
dt : DateTime;
sizes: String [10];
Begin
a := b;
If a. Attr And Directory = 0 Then
For i := 1 To Length (a. Name) Do a. Name [i] := Dcase (a. Name [i] )
Else sizes := ' SUB-DIR';
If a. Name <> '..' Then
Begin
i := 1;
While (a. Name [i] <> '.') And (i <= Length (a. Name) ) Do Inc (i);
If a. Attr And Directory = 0 Then sizes := Fixstr2 (longinttostr (a. Size), 10);
End Else sizes := ' UP--DIR';
UnpackTime (a. Time, dt);
With dt Do
Dirinfo2Str :=
fixstr (Copy (a. Name, 1, i - 1), 9) + fixstr (Copy (a. Name, i + 1, Length (a. Name) - 1), 3)
+ ' ' + sizes + ' ' + LZ (Day) + '-' + LZ (Month) + '-'
+ LZ (Year) + ' ' + LZ (Hour) + ':' + LZ (Min) + ':' + LZ (Sec);
;
End;
Procedure WriteListFile (Var Avar: VaribleRec); Far;
Var
i: Int;
a, b: Byte;
Begin
With Avar Do
Begin
For i := Curfiledisp To Curfiledisp + 18 Do
If i <= numoffiles Then
Begin
a := 7; b := 0; If i = curfile Then Begin a := 8; b := 15; End;
Puttext (17, i - Curfiledisp + 4, a, b, Fixstr (Dirinfo2Str (Listoffiles^ [i]^), 45) )
End Else Puttext (17, i - Curfiledisp + 4, 7, 0, Fixstr ('', 45) )
End;
End;
Procedure Shore (k: Integer); Far;
Var
i, j: Integer;
Begin
With Avar^ Do
Begin
For i := k + 1 To numoffiles Do
For j := i + 1 To numoffiles Do
Begin
If Listoffiles^ [i]^. Name > Listoffiles^ [j]^. Name Then
Begin
p := Listoffiles^ [i];
Listoffiles^ [i] := Listoffiles^ [j];
Listoffiles^ [j] := p;
End
End;
End;
End;
Procedure Shore2; Far;
Begin
With Avar^ Do
Begin
Inc (Numoffiles);
New (Listoffiles^ [Numoffiles] );
Listoffiles^ [Numoffiles]^ := Dirinfo^;
End;
End;
Procedure AdderA (a: Char); Far;
Begin
Inc (dada, 2);
Puttext (dada, 23, 7, 14, a);
End;
Var
DX: DirStr;
Nx: NameStr;
Ex: ExtStr;
Procedure Luz; Far;
Var
i: Integer;
Begin
With Avar^ Do
Begin
For i := 1 To numoffiles Do Dispose (Listoffiles^ [i] );
Dispose (Listoffiles);
Dispose (Dirinfo);
End;
End;
Label 1, 2, 3;
Begin
noblink;
New (Avar);
SwapTscr;
FSplit (getfileo, DX, Nx, Ex);
GetDir (0, wasdir);
wasfile := Getfileo;
ChDir (DX);
Drawbox (16, 3, 62, 23, 7, 15, 15, 7, True, True);
With Avar^ Do
Begin
1:
New (Dirinfo);
New (Listoffiles);
Numoffiles := 0;
Curfile := 1;
CurFileDisp := 1;
dada := 16;
AdderA ('A');
If numfloppies = 2 Then AdderA ('B');
For i := 3 To 22 Do If DiskSize (i) <> - 1 Then AdderA (Chr (64 + i) );
FindFirst ('*.*', Directory, Dirinfo^);
While DosError = 0 Do
Begin
If (Dirinfo^. Attr And Directory <> 0 ) And (Dirinfo^. Name <> '.') Then Shore2;
FindNext (Dirinfo^);
End;
k := numoffiles;
Shore (0);
FindFirst ('*.*', AnyFile - Directory, Dirinfo^);
While DosError = 0 Do
Begin
If Dirinfo^. Name <> '.' Then Shore2;
FindNext (Dirinfo^);
End;
Shore (k);
Repeat
WriteListFile (avar^);
Give_slice;
c := ReadKey;
Case c Of
#27:
Begin getfileo := wasfile; Break; End;
#0: Case ReadKey Of
#71: curfile := 1;
#79: curfile := numoffiles;
#80: Inc (curfile);
#72: Dec (curfile);
#81: Inc (curfile, 18);
#73: Dec (curfile, 18);
End;
#13: If Listoffiles^ [curfile]^. Attr And Directory <> 0 Then
Begin
ChDir (Listoffiles^ [curfile]^. Name);
Goto 2;
End
Else
Begin
getfileo := FExpand (Listoffiles^ [curfile]^. Name);
Break;
End;
Else
Begin
ChDir (UpCase (c) + ':');
Goto 2;
End
End;
If curfile < 1 Then curfile := 1;
If curfile > numoffiles Then curfile := numoffiles;
If CurFileDisp + 18 < curfile Then CurFileDisp := curfile - 18;
If CurFileDisp + 18 > numoffiles Then CurFileDisp := numoffiles - 18;
If CurFileDisp > curfile Then CurFileDisp := curfile;
If CurFileDisp < 1 Then CurFileDisp := 1;
Until c = #27;
Goto 3;
2:
Luz;
Goto 1;
3:
Luz;
End;
Dispose (Avar);
UnSwapTscr;
ChDir (wasdir);
End;
Function Editor. endol (a: String): Integer;
Var
i: Integer;
Begin
If hebr Then
Begin
For i := 1 To Length (a) Do If (a [i] <> #$20) And (a [i] <> #$FF) Then
Begin
endol := i - 1;
Break;
End;
End Else endol := Length (a);
End;
Function ifq (a: String): Byte; Far;
Var
i: Byte;
Begin
ifq := 0;
For i := 1 To 10 Do
If a [i] = '>' Then
Begin
ifq := i;
Break;
End;
End;
Function iftear (a: String): Boolean; Far;
Begin
iftear := Copy (a, 1, 4) = '--- ';
End;
Function iftag (a: String): Boolean; Far;
Begin
iftag := Copy (a, 1, 4) = '... ';
End;
Function iforigin (a: String): Boolean; Far;
Begin
iforigin := Copy (a, 1, 9) = ' * Origin';
End;
Function EditStrx (Title: String; Var X: String): Byte;
Var
c: Char;
c1: Byte;
u: Byte;
t:^textscreen;
Label 1;
Begin
noblink;
New (t);
savetscr (t^);
u := 0;
Drawbox (5, 12, 76, 14, 7, 15, 15, 7, True, True);
Puttext (40 - Length (title) Div 2, 12, 15, 7, ' ' + title + ' ');
Puttext (7, 14, 7, 15, 'Press F5 for file browsing');
1:
StrEdit (X, 6, 13, 70, 1, X, c, c1);
If c = #27 Then u := 1;
If c = #63 Then Begin Getfile (X); Goto 1 End;
loadtscr (t^);
Dispose (t);
EditStrx := u;
RestoreCursor;
Hidecursor;
End;
Function EditInt (Title: String; Var X: Integer): Byte;
Var
c: Char;
c1: Byte;
u: Byte;
t:^textscreen;
s: String;
Label 1;
Begin
noblink;
New (t);
u := 0;
savetscr (t^);
s := inttostr (X);
Drawbox (32, 11, 48, 15, 7, 15, 15, 7, True, True);
Puttext (39 - Length (title) Div 2, 11, 15, 7, ' ' + title + ' ');
1:
StrEdit (s, 38, 13, 4, 1, s, c, c1);
If c = #27 Then u := 1;
If c = #63 Then Goto 1;
If u = 0 Then X := strtoint (s);
loadtscr (t^);
Dispose (t);
EditInt := u;
RestoreCursor;
End;
Function ifempt (a: String): Boolean; Far;
Var
i: Integer;
Begin
ifempt := False;
If a = '' Then ifempt := True Else
Begin
ifempt := True;
For i := 1 To Length (a) Do If (a [i] <> #$20) And (a [i] <> #$FF) And (a [i] <> #$0) Then
Begin
ifempt := False;
Break;
End;
End;
End;
Function DeFixstr (A: String): String; Far;
Var
i: Integer;
s: String;
Begin
s := a;
i := Length (s);
While (s [i] = ' ') Or (s [i] = #$FF) Do Dec (i);
s [0] := Chr (i);
DeFixstr := s;
End;
Function Editor. Curow: Char;
Begin
Curow := Lin^ [curline]^ [currow];
End;
Procedure Editor. Lprint (lnum: Integer);
Var
c, cb: Byte;
s: String;
Begin
With Me^. setup^. setup. Color. Text Do
Begin
c := normal. ford;
cb := normal. back;
If (lnum >= curlinedisp) And (lnum <= curlinedisp + Window. b. Y - Window. a. Y) Then
If (lnum > 0) And (lnum <= numlines) Then
Begin
If iftag (Lin^ [lnum]^) Then
Begin c := tag. ford; cb := tag. back; End Else
If iftear (Lin^ [lnum]^) Then
Begin c := tear. ford; cb := tear. back; End Else
If Copy (Lin^ [lnum]^, 4, 6) = 'Origin' Then
Begin c := Origin. ford; cb := Origin. back; End Else
If ifq (Lin^ [lnum]^) <> 0 Then
Begin c := q. ford; cb := q. back; End;
If Mark <> 0 Then
If (lnum >= Mark) And (lnum <= Mark + marksum - 1) Then
Begin
c := Me^. setup^. setup. Color. Mark. ford;
cb := Me^. setup^. setup. Color. Mark. back;
End;
s := fixstr (Copy (Lin^ [lnum]^, 1, Window. b. X - Window. a. X + 1), Window. b. X - Window. a. X + 1);
Puttextd (Window. a. X, Window. a. Y + lnum - curlinedisp, cb, c, s);
If Linemode And (Lnum = lmp. Y) Then
Begin
PuttextPAsm (Window. a. X + lmp. X - 1, Window. a. Y + lnum - curlinedisp, 7, 0,
Getchar (Window. a. X + lmp. X - 1, Window. a. Y + lnum - curlinedisp) );
End;
End
Else Puttext (Window. a. X, Window. a. Y + lnum - curlinedisp, cb, 15, fixstr ('', Window. b. X - Window. a. X + 1) );
End;
End;
Procedure Editor. Allprint;
Var
i: Integer;
Begin
For i := curlinedisp To curlinedisp + Window. b. Y - Window. a. Y Do
Lprint (i);
End;
Constructor editor. init (U1: Rect; s: String);
Var
i: Integer;
Begin
Lastcur. X := 1;
Lastcur. Y := 1;
Mark := 0;
MarkSum := 0;
eleft := Me^. setup^. setup. eleft;
erigth := Me^. setup^. setup. erigth;
hleft := Me^. setup^. setup. hleft;
hrigth := Me^. setup^. setup. hrigth;
numlines := 0;
currow := 0;
curline := 1;
curlinedisp := 1;
Window := u1;
curdru := 1;
push := False;
hebr := Me^. setup^. setup. hebrew;
inst := False;
LineMode := False;
fileimport := '';
If Me^. setup^. setup. SargelLine Then Inc (Window. a. Y);
If Me^. setup^. setup. StatusLine Then Inc (Window. a. Y);
If Me^. setup^. setup. HelpLine Then Dec (Window. b. Y);
If Me^. setup^. setup. Vertic Then Dec (Window. b. X);
filename := s;
If filename = '' Then filename := 'Untitled.txt';
New (Lin);
For i := 1 To 5000 Do lin^ [i] := Nil;
End;
Procedure editor. loadfile;
Var
f: Text;
i: Integer;
m: Boolean;
Begin
m := False;
Assign (f, filename);
If FileExists (filename) Then
Begin
Reset (f);
For i := 1 To numlines Do Dispose (lin^ [i] );
numlines := 0;
Repeat
Inc (numlines);
New (lin^ [numlines] );
ReadLn (f, lin^ [numlines]^);
If lin^ [numlines]^ [1] = Me^. setup^. setup. hebfix Then
lin^ [numlines]^ [1] := ' ';
If ME^.setup^.setup.autolang and
(numlines > 3) And Not (iftear (lin^ [numlines]^) )
And Not (iftag (lin^ [numlines]^) )
And Not (ifq (lin^ [numlines]^) <> 0)
And Not (iforigin (lin^ [numlines]^) )
Then
Begin
For i := 1 To Length (lin^ [numlines]^) Do
If (lin^ [numlines]^ [i] >= #128) And
(lin^ [numlines]^ [i] <= #154)
Then m := True;
End;
If Copy (lin^ [numlines]^, 1, 4) = #1'XID' Then DelLine (numlines);
Until EoF (f);
With Me^. Setup^. setup Do If firstline <= numlines Then
Curline := firstline
Else curline := 1;
if ME^.setup^.setup.autolang then hebr := m;
End
Else
Begin
Rewrite (f);
numlines := 1;
New (lin^ [numlines] );
lin^ [numlines]^ := '';
curline := 1;
hebr := True;
End;
If hebr Then currow := Hrigth Else currow := Eleft;
Close (f);
End;
Procedure editor. godos;
Var
Swapfile: File;
i: Integer;
R: LongInt;
s: String;
Begin
s := Me^. setup^. setup. commandline;
i := Pos ('@F', s);
If i <> 0 Then
Begin
Delete (s, i, 2);
Insert (filename, s, i);
End;
R := MemAvail;
SwapTscr;
Assign (swapfile, 'DASWAP00.DAT');
Rewrite (swapfile, 1);
For i := 1 To numlines Do
Begin
BlockWrite (swapfile, Lin^ [i]^, 81);
Dispose (Lin^ [i] );
End;
Dispose (Lin);
Close (swapfile);
TextMode (co80);
WriteLn (VersO, ' - Command exit, Swaping to disk ', MemAvail - r, ' bytes saved');
Dosshell (s);
Reset (swapfile, 1);
New (Lin);
For i := 1 To numlines Do
Begin
New (Lin^ [i] );
BlockRead (swapfile, Lin^ [i]^, 81);
End;
Erase (swapfile);
GetTtextmode;
UnSwapTscr;
End;
Procedure editor. importfile (uue, part: Boolean);
Var
f: Text;
i, l, j, jp, k, oi: Integer;
s: String80;
D: DirStr;
N: NameStr;
E: ExtStr;
mystr, s3: String;
co: Char;
dirinfo: SearchRec;
fs2: LongInt;
Procedure ter (o: String; u: Integer);
Begin
s := o;
j := Pos ('@F', s);
If j <> 0 Then
Begin
Delete (s, j, 2);
Insert (n + e, s, j);
End;
Addline (u, s);
End;
Procedure Addlinex (s: String80); Far;
Begin
Addline (oi, s);
Inc (oi);
End;
Begin
Assign (f, fileimport);
If FileExists (fileimport) Then
Begin
FSplit (fileimport, D, N, E);
If uue Then ter (Me^. setup^. setup. UUEImportBegin, curline)
Else ter (Me^. setup^. setup. ImportBegin, curline);
Reset (f);
oi := curline + 1;
If uue Then
Begin
FindFirst (fileimport, Archive, dirinfo);
fs2 := dirinfo. Size;
Addlinex ('begin 644 ' + ups (N + E) );
Inc (j);
jp := 0;
Repeat
i := 0;
mystr := '';
k := jp;
Repeat
Inc (i);
s3 := '';
For l := 1 To 3 Do
Begin
Read (f, co); If (jp < fs2) Then Inc (jp) Else co := (#0);
s3 := s3 + Bin8 (Ord (co) );
End;
For l := 1 To 4 Do
mystr := mystr + uuecodestream [Bin8tobyte ('00' + s3 [l * 6 - 5] + s3 [l * 6 - 4] + s3 [l * 6 - 3]
+ s3 [l * 6 - 2] + s3 [l * 6 - 1] + s3 [l * 6] ) + 1];
Until (i = 15) Or (jp >= fs2);
mystr := uuecodestream [jp - k + 1] + mystr;
Addlinex (mystr);
Inc (j);
Until (jp >= fs2);
Addlinex (uuecodestream [1] );
Addlinex ('end');
End
Else
Begin
Repeat
ReadLn (f, s);
Addline (oi, s);
Inc (oi);
Until EoF (f);
End;
Close (f);
If uue Then ter (Me^. setup^. setup. UUEImportEnd, oi)
Else ter (Me^. setup^. setup. UUEImportEnd, oi);
If hebr Then currow := Hrigth Else currow := Eleft;
End
Else Docmessage ('File isn''t exist or can''t be loaded', 4);
End;
Procedure DanWriteln (Var a: File; g: String); Far;
Var
b: String;
Begin
b := g + #$D#$A;
BlockWrite (a, b [1], Length (b) );
End;
Procedure editor. SaveAsfile (filenam: String; ovrr: Boolean);
Var
f: File;
S: String;
xid: Boolean;
Procedure Doit;
Var
i, j: Integer;
Begin
Assign (f, filenam);
Rewrite (f, 1);
i := IOResult;
If i <> 0 Then
Begin
Docmessage ('Error: File has no access, Save Cancelled: ' + inttostr (i), 4);
Close (f);
End
Else
Begin
xid := False;
For i := numlines Downto 1 Do
If iforigin (lin^ [i]^) Then
Begin
xid := True;
Break;
End;
If xid Then Addline (1, #1'XID: ' + VersO);
SwapTscr;
s := 'Saving....';
Drawbox (38 - Length (s) Div 2, 12, 42 + Length (s) Div 2, 14, 2, 10, 10, 2, True, True);
Puttext (40 - Length (s) Div 2, 13, 2, 15, s);
For i := 1 To numlines Do
Begin
s := defixstr (lin^ [i]^);
If s [1] = ' ' Then
For j := 1 To Length (s) Do
If s [j] > #127 Then
Begin
s [1] := Me^. setup^. setup. hebfix;
Break;
End;
If iftear (s) And Not (ifempt (Me^. setup^. setup. tearline) ) Then
Begin
s := '--- ' + Me^. setup^. setup. tearline;
j := Pos ('@V', s);
If j <> 0 Then
Begin
Delete (s, j, 2);
Insert (vers, s, j);
End;
End;
DanWriteln (f, s);
End;
Close (f);
If xid Then DelLine (1);
UnswapTscr;
End;
End;
Begin
If ovrr Then
If fileexists (filenam) Then
If Qset ('File already exist, Overwrite? ', False, Yes) = Yes Then Doit
Else
Else Doit
Else doit;
End;
Procedure editor. PendHome (a: Boolean);
Var
I: Integer;
D: Array [1..3] Of Integer;
s: String;
Begin
s := lin^ [curline]^;
If a Then
If hebr Then
Begin
D [1] := Endol (s);
D [2] := Hleft;
D [3] := 1;
End
Else
Begin
D [1] := Length (s) + 1;
D [2] := ERigth;
D [3] := 80;
End
Else
If hebr Then
Begin
D [1] := Hrigth;
D [2] := Length (s);
D [3] := 80;
End Else
Begin
D [1] := 1;
D [2] := ELeft;
For i := 1 To Length (s) Do If (s [i] <> #$20) And (s [i] <> #$FF) Then
Begin
D [3] := i;
Break;
End;
End;
If currow = D [1] Then currow := D [2] Else
If currow = D [2] Then currow := D [3] Else
currow := D [1];
If currow < 1 Then currow := 1;
End;
Destructor editor. deinit;
Var
i: Integer;
Begin
For i := 1 To numlines Do Dispose (lin^ [i] );
Dispose (lin);
End;
Procedure editor. AddlineEnd (s: String80);
Var
i: Integer;
Begin
Inc (numlines);
New (lin^ [numlines] );
lin^ [numlines]^ := s;
End;
Procedure MultiEditor. AddDellineEnd (s: String80);
Var
i: Integer;
Begin
If numdellines = 300 Then
Begin
Dispose (dellin^ [1] );
Move (dellin^ [2], dellin^ [1], 299 * 4);
New (dellin^ [numdellines] );
dellin^ [numdellines]^ := s;
End Else
Begin
Inc (numdellines);
New (dellin^ [numdellines] );
dellin^ [numdellines]^ := s;
End;
End;
Procedure Multieditor. RemoveDellineEnd;
Var
i: Integer;
Begin
If numdellines > 0 Then
Begin
Dispose (dellin^ [numdellines] );
Dec (numdellines);
End;
End;
Function Multieditor. GetDelline: String80;
Var
i: Integer;
Begin
If numdellines > 0 Then
Begin
GetDelline := dellin^ [numdellines]^;
RemoveDellineEnd;
End Else GetDelline := '';
End;
Procedure editor. Addline (lnum: Integer; s: String80);
Var
i: Integer;
Begin
If lnum > numlines Then AddlineEND (s)
Else
Begin
If Mark <> 0 Then
If (Mark <= curline) And (Mark + marksum - 1 >= curline) Then
Inc (marksum)
Else If Mark > curline Then Inc (Mark);
Move (Lin^ [lnum], Lin^ [lnum + 1], (Numlines - lnum + 1) * 4);
New (Lin^ [lnum] );
Lin^ [lnum]^ := s;
Inc (numlines);
End;
End;
Procedure editor. DelLine (lnum: Integer);
Var
i: Integer;
Begin
If numlines > 0 Then
Begin
If lnum >= numlines Then Dispose (Lin^ [numlines] )
Else If lnum > 0 Then
Begin
Dispose (Lin^ [lnum] );
Move (Lin^ [lnum + 1], Lin^ [lnum], (Numlines - lnum) * 4);
End;
If lnum > 0 Then Dec (numlines);
If (Mark <> 0) Then
If (Mark <= lnum) And (Lnum <= Mark + Marksum - 1) Then
Begin
Dec (Marksum);
If marksum = 0 Then Mark := 0;
End
Else
If (Mark > lnum) Then
Dec (Mark);
End;
End;
Procedure editor. Movemarked;
Var
j, i: Integer;
s: String80;
Begin
If Mark <> 0 Then
Begin
j := marksum;
If (Mark > curline) Then
Begin
For i := 1 To j Do
Begin
s := Lin^ [Mark]^;
DelLine (Mark);
Addline (i - 1 + curline, s);
End;
Mark := curline;
marksum := j;
End
Else If Mark + marksum - 1 <= curline Then
Begin
For i := 1 To j Do
Begin
s := Lin^ [Mark]^;
DelLine (Mark);
Addline (curline, s);
End;
Dec (curline, j - 1);
Mark := curline;
marksum := j;
End;
allprint;
End;
End;
Procedure editor. Copymarked;
Var
j, i: Integer;
s: String80;
Begin
If Mark <> 0 Then
Begin
For i := 1 To marksum Do Addline (i - 1 + curline, Lin^ [Mark + i - 1]^);
allprint;
End;
End;
Procedure editor. Deletemarked;
Begin
While Mark <> 0 Do DelLine (Mark);
allprint;
End;
Procedure editor. Enter;
Var
i: Integer;
Xrigth: Integer;
s: String;
Procedure Stuff;
Begin
Lin^ [curline + 1]^ [i - currow + xrigth] := Lin^ [curline]^ [i];
Lin^ [curline]^ [i] := ' ';
End;
Begin
s := Lin^ [curline]^;
Case hebr Of
True:
Begin
Xrigth := Length (s);
If Currow > Xrigth Then
Addline (curline + 1, '')
Else
Begin
If xRigth > Hrigth Then xRigth := Hrigth;
Addline (curline + 1, fixstr ('', Xrigth) );
For i := currow Downto 1 Do Stuff;
currow := Xrigth;
End;
End;
False:
Begin
Lin^ [curline]^ := fixstr (Lin^ [curline]^, 80);
For Xrigth := 1 To Length (s) Do
If (s [Xrigth] <> #$20) And (s [Xrigth] <> #$FF) Then Break;
If Currow < Xrigth Then
Addline (curline + 1, '')
Else
Begin
Addline (curline + 1, fixstr ('', Xrigth + Length (s) - currow) );
For i := currow To Length (s) Do Stuff;
currow := Xrigth;
End;
Lin^ [curline]^ := defixstr (Lin^ [curline]^);
End;
End;
Inc (curline);
Allprint;
End;
Procedure editor. Drawstatus;
Var
s: String;
h1, h2: String [3];
Begin
If hebr Then h1 := 'HEB' Else h1 := 'ENG';
If push Then h2 := '-P-' Else h2 := ' ';
s := fixstr (Fixstr (VersO, 10) + '³ by Dan Aloni ³ [' + h1 + '] ' + h2 + ' Line: '
+ fixstr (inttostr (curline), 4) + 'Row: ' + fixstr (inttostr (currow), 4)
+ 'Total: ' + fixstr (inttostr (numlines), 4) + ' ' + inttostr (MemAvail Div 1000)
+ 'Kb Mem' , 80);
With Me^. setup^. setup. Color. status Do Puttext (1, 1, back, ford, s);
End;
Procedure editor. Drawhelpline;
Var
s: String;
Begin
If linemode Then
s := fixstr ('[---LINEMODE---] [Esc=Exit Linemode] [F8-Draw to point]', 80)
Else s := fixstr (' ³[F2 = Save as] [F9 = Load as] File: ' + filename, 80);
With Me^. setup^. setup. Color. help Do Puttext (1, Window. b. Y + 1, back, ford, s);
End;
Procedure editor. warp (Lnum: Word);
Var
i, ws, we: Integer;
Begin
Case hebr Of
True:
If (Lin^ [lnum]^ [Hleft] <> ' ') And (Lin^ [lnum]^ [Hleft] < #176) Then
Begin
we := Hleft; ws := Hleft;
If ifempt (Lin^ [lnum + 1]^) Or (ifq (Lin^ [lnum + 1]^) <> 0) Then
Begin
Addline (lnum + 1, '');
Allprint;
End;
While Lin^ [lnum]^ [ws] <> ' ' Do Dec (ws);
While Lin^ [lnum]^ [we] <> ' ' Do Inc (we);
If we - ws < Hrigth - Hleft Then
Begin
Dec (we);
Lin^ [lnum + 1]^ := Fixstr (Lin^ [lnum + 1]^, 80);
For i := ws To we Do
Begin
Insert (Lin^ [lnum]^ [i], Lin^ [lnum + 1]^, Hrigth + 1);
Delete (Lin^ [lnum + 1]^, 1, 1);
warp (Lnum + 1);
Lin^ [lnum]^ [i] := ' ';
End;
If (currow >= ws) And (currow <= we) Then
Begin
Currow := Hrigth - (we - currow);
Inc (curline);
If Lin^ [lnum + 1]^ [currow] <> ' ' Then Inc (currow);
End;
Lin^ [lnum + 1]^ := DeFixstr (Lin^ [lnum + 1]^);
End Else
Begin
currow := Hrigth;
Inc (curline);
End;
End;
False:
If (Lin^ [lnum]^ [Erigth] <> ' ') And (Lin^ [lnum]^ [Erigth] < #176) Then
Begin
we := Erigth; ws := Erigth;
If ifempt (Lin^ [lnum + 1]^) Or (ifq (Lin^ [lnum + 1]^) <> 0) Then
Begin
Addline (lnum + 1, '');
Allprint;
End;
While Lin^ [lnum]^ [ws] <> ' ' Do Dec (ws);
While Lin^ [lnum]^ [we] <> ' ' Do Inc (we);
Inc (ws);
If ws - we < Erigth - Eleft Then
Begin
Lin^ [lnum + 1]^ := Fixstr (Lin^ [lnum + 1]^, 80);
For i := ws To we Do
Begin
Insert (Lin^ [lnum]^ [i], Lin^ [lnum + 1]^, Eleft + i - ws);
warp (Lnum + 1);
Lin^ [lnum]^ [i] := ' ';
End;
If (currow >= ws) And (currow <= we) Then
Begin
Currow := Eleft + (currow - ws);
Inc (curline);
End;
Lin^ [lnum + 1]^ := DeFixstr (Lin^ [lnum + 1]^);
End Else
Begin
currow := Eleft;
Inc (curline);
End;
End;
End;
Lprint (Lnum);
End;
Procedure editor. PutChar (c: Char);
Var
CH: Char;
o: Boolean;
m, i, j: Integer;
Label 2;
Function QMust (a: Char): Boolean;
Var
i: Integer;
o: Boolean;
Begin
o := False;
For i := 1 To Length (MustPushChars) Do
If MustPushChars [i] = a Then
Begin
Inc (m);
o := True;
Break;
End;
QMust := o;
End;
Function QOther (a: Char): Boolean;
Var
i: Integer;
o: Boolean;
Begin
o := False;
For i := 1 To Length (OtherPushChars) Do
If OtherPushChars [i] = a Then
Begin
o := True;
Break;
End;
QOther := o;
End;
Begin
Lin^ [curline]^ := Fixstr (Lin^ [curline]^, 80);
If hebr Then
Begin
If push Then
Begin
Insert (C , Lin^ [curline]^, currow + 1);
Delete (Lin^ [curline]^, 1 + ifq (Lin^ [curline]^), 1);
End
Else
Begin
CH := Hebchar [Ord (c) ];
If Not (QMust (CH) Or Qother (CH) ) And
(Lin^ [curline]^ [currow + 1] = ' ') And (QMust (curow) Or Qother (curow) )
Then
Begin
j := currow - 1;
While
(QMust (Lin^ [curline]^ [j] ) Or
QOther (Lin^ [curline]^ [j] ) )
And (Lin^ [curline]^ [j] <> ' ') And (j > 0)
Do Dec (j);
If Lin^ [curline]^ [j] = ' ' Then
Begin
currow := j - 1;
Goto 2;
End;
End;
If inst Then Lin^ [curline]^ [currow] := CH
Else
Begin
Insert (CH , Lin^ [curline]^, currow + 1);
Delete (Lin^ [curline]^, 1 + ifq (Lin^ [curline]^)
+ Ord (iftear (Lin^ [curline]^) ) * 4
+ Ord (iftag (Lin^ [curline]^) ) * 4, 1);
End;
o := False;
If C <> 'o' Then
Begin
If QMust (CH) Then Goto 2 Else
Begin
If QOther (CH) Then
Begin
i := currow;
While (Lin^ [curline]^ [i] <> ' ')
And (i > 0)
Do Dec (i);
m := 0;
j := currow;
While
(QMust (Lin^ [curline]^ [j] ) Or
QOther (Lin^ [curline]^ [j] ) )
And (Lin^ [curline]^ [j] <> ' ') And (j > 0)
Do Dec (j);
If (i = j) And (m <> 0) Then Goto 2;
End;
End;
End;
Dec (currow);
2:
End;
End
Else
Begin
If push Then
Insert (Hebchar [Ord (c) ] , Lin^ [curline]^, currow)
Else
Begin
If inst Then Lin^ [curline]^ [currow] := c
Else Insert (c , Lin^ [curline]^, currow);
Inc (currow);
End;
End;
Lin^ [curline]^ := deFixstr (Lin^ [curline]^);
If ifq (Lin^ [curline]^) = 0 Then warp (curline)
Else Lprint (curline);
End;
Procedure editor. DrawVertic;
Var
i, j: Integer;
Begin
If numlines <> 0 Then
j := Window. a. Y + 1 + ( (Window. b. Y - Window. a. Y - 1) * (curline - 1) ) Div numlines
Else j := 0;
With Me^. Setup^. setup. Color. vertic Do
Begin
PuttextpASM (Window. b. X + 1, Window. a. Y, back, ford, '');
PuttextpASM (Window. b. X + 1, Window. b. Y, back, ford, '');
For i := Window. a. Y + 1 To Window. b. Y - 1 Do
If i = j Then puttextpASM (Window. b. X + 1, i, back, ford, 'Û')
Else puttextpASM (Window. b. X + 1, i, back, ford, '°')
End;
End;
Procedure editor. Smiley (a: Int);
Const
Smily : Array [0..1, 0..4] Of String [9] =
( (' (-:', ' )-:', ' (-;', ' )-;', 'ROTFL!!! '),
(' :-(', ' :-)', ' `-(', ' `-)', '˜…ˆ”Œ!!! ' ) );
Var
i: Integer;
Begin
For i := 1 To Length (Smily [Ord (hebr), a] ) Do PutCHAR (Smily [Ord (hebr), a] [i] );
End;
Procedure editor. DrawSargel;
Var
s: String;
i, l, r: Integer;
k, c1, c2: Byte;
Begin
With Me^. setup^. setup. Color. sargel Do
Begin
k := 1 + Ord (Me^. setup^. setup. Statusline);
If hebr Then Begin l := Hleft; r := Hrigth; End
Else Begin l := Eleft; r := Erigth; End;
For i := 1 To 80 Do
Begin
If i = currow Then
Begin c1 := ford; c2 := back; End
Else Begin c1 := back; c2 := ford; End;
If i = l Then PuttextpASM (i, k, c1, c2, '[')
Else If i = r Then PuttextpASM (i, k, c1, c2, ']')
Else PuttextpASM (i, k, c1, c2, '-');
End;
End;
End;
Procedure editor. delchar (baks: Boolean);
Var
s, sn, st: String;
endo, i, j: Integer;
hRigthx: Integer;
Begin
s := Lin^ [curline]^;
If hebr Then
Begin
endo := endol (s) - 1;
If Not (baks) And (curline < numlines) And ( (endo - hleft) > 0) And (currow <= endo + 1) Then
Begin
sn := Lin^ [curline + 1]^;
If ifempt (sn) Then
DelLine (curline + 1)
Else If ifq (sn) = 0 Then
Begin
hRigthx := Length (sn);
i := hrigthx - endo + hleft - 1;
If sn [i] <> ' ' Then While (sn [i] <> ' ') And (i <= hrigthx) Do Inc (i)
Else While (sn [i] = ' ') And (i <= hrigthx) Do Inc (i);
st := Copy (sn, i, Hrigthx - i + 1);
Delete (sn, i, Hrigthx - i + 1);
sn := fixstr ('', Hrigthx - i + 1) + sn;
Lin^ [curline + 1]^ := sn;
For i := endo Downto endo - Length (st) + 1 Do
s [i] := St [i - endo + Length (st) ];
End;
Allprint;
End
Else
Begin
Delete (s, currow, 1);
Insert (' ', s, 1 + ifq (s) + Ord (iftear (Lin^ [curline]^) ) * 4
+ Ord (iftag (Lin^ [curline]^) ) * 4);
End;
End Else
Begin
endo := Length (s);
If Not (baks) And (curline < numlines) And ( (erigth - endo) > 0) And (currow > endo) Then
Begin
sn := Lin^ [curline + 1]^;
If ifempt (sn) Then
DelLine (curline + 1)
Else If ifq (sn) = 0 Then
Begin
hRigthx := 1; While (sn [hRigthx] = ' ') Or (sn [hRigthx] = #$FF) Do Inc (hRigthx);
i := hrigthx + erigth - endo;
If sn [i] <> ' ' Then
While (sn [i] <> ' ') And (i >= hrigthx) Do Dec (i)
Else While (sn [i] = ' ') And (i >= hrigthx) Do Dec (i);
st := Copy (sn, Hrigthx, i - Hrigthx + 1);
Delete (sn, Hrigthx, i - Hrigthx + 1);
Lin^ [curline + 1]^ := sn;
If (st [1] <> ' ') And (s [Length (s) ] <> ' ') Then st := ' ' + st;
s := s + st;
End;
Allprint;
End
Else Delete (s, currow, 1);
End;
Lin^ [curline]^ := s;
Lprint (curline)
End;
Procedure editor. Beready;
Begin
With Me^. setup^. setup Do
Begin
If Vertic Then DrawVertic;
If StatusLine Then Drawstatus;
If HelpLine Then DrawHelpline;
If SargelLine Then DrawSargel;
End;
Allprint;
End;
Function editor. run: Byte;
Var
i, j: Integer;
Lcurrow, Lnumoflines, Lcurline: Integer;
c, c2: Char;
o: Boolean;
dan_clock: clock;
Begin
GetTtextmode;
Inc (Window. b. Y, 25 * Ord (Me^. Setup^. setup. fifty) );
noblink;
run := 0;
dan_clock. start (Dosclock);
Beready;
Repeat
If (curline >= curlinedisp) And (curline <= curlinedisp + Window. b. Y - Window. a. Y) Then
GotoXY (Window. a. X - 1 + currow, Window. a. Y + curline - curlinedisp);
Lcurrow := currow; Lnumoflines := numlines; Lcurline := curline;
If inst Then bigcursor Else restorecursor;
Give_slicex (dan_clock);
c := ExReadKey (extkey);
Case extkey Of
True:
Begin
Case c Of
#19: godos;
#46: Me^. Setup^. edit;
#103: Begin
run := 1;
Break;
End;
#118:
Begin
i := curline - 1;
Repeat
Inc (i);
While (ifq (Lin^ [i]^) <> 0) And (i <= numlines)
Do DelLine (i);
Until i >= numlines;
allprint;
End;
#132:
Begin
i := curline;
For i := curline Downto 1 Do
If (ifq (Lin^ [i]^) <> 0) Then
Begin DelLine (i); Dec (curline); End;
allprint;
End;
#59: HelpMe;
#34: If EditInt ('Go to line', curline) = 0 Then
Begin
If curline < 1 Then curline := 1;
If curline > numlines Then curline := numlines;
allprint;
End;
#20: With Me^. setup^. setup Do
Begin
c2 := Chr (picchar (o) );
If o Then Putchar (c2);
End;
#119: Curline := 1;
#117: Curline := numlines;
#120: With Me^. setup^. setup Do StatusLine := Not (StatusLine);
#121: With Me^. setup^. setup Do SargelLine := Not (SargelLine);
#122: With Me^. setup^. setup Do HelpLine := Not (HelpLine);
#123: With Me^. setup^. setup Do Vertic := Not (Vertic);
#124:
Begin
With Me^. setup^. setup Do fifty := Not (fifty);
GetTtextmode;
End;
#15:
Begin
push := Not (push);
beready;
i := Endol (lin^ [curline]^);
If Not (push) Then
If hebr Then
While (curow < #128) And (currow > i) Do Dec (currow)
Else
While ( (curow < #65) Or (curow > #127) ) And (currow <= i) Do Inc (currow)
End;
#90: DeleteMarked;
#100: CopyMarked;
#110: MoveMarked;
#77: Inc (currow);
#75: Dec (currow);
#79: Pendhome (True); {End}
#71: Pendhome (False); {home}
#82: Inst := Not (inst);
#80: Inc (curline);
#72: Dec (curline);
#81: Inc (curline, Window. b. Y - Window. a. Y + 1);
#73: Dec (curline, Window. b. Y - Window. a. Y + 1);
#133:
Begin
SaveAsfile (filename, False);
Beready;
End;
#134: Break;
#66:
Begin
If Not (LineMode) Then
Begin
LineMode := True;
Lmp. X := currow;
Lmp. Y := curline;
Lprint (curline);
End Else
Begin
i := Lmp. X;
j := Lmp. Y;
Lmp. X := currow;
Lmp. Y := curline;
Linedraw (i, j, lmp. X, lmp. Y, lin^, numlines, curdru);
Allprint;
End;
Beready;
End;
#111: Choose ('Line', dra, 11, 11, curdru, True);
#60: Case EditStrx ('Save as', filename) Of
0:
Begin SaveAsfile (filename, True); Beready; End;
End;
#61: Case EditStrx ('Import file', fileimport) Of
0: Begin editor. importfile (False, False); allprint; Beready; End;
End;
#63:
Begin Addline (Curline, Lin^ [curline]^); Allprint; End;
#65: Begin
If Mark = 0 Then
Begin
Mark := curline;
MarkSum := 1;
End Else
If Mark = curline Then Mark := 0
Else
If marksum = 1 Then
If Mark < curline Then Marksum := Curline - Mark + 1
Else Mark := 0
Else Mark := 0;
allprint;
End;
#67:
Begin
Case Qset ('Save changes before loading?', True, Yes) Of
Yes:
Begin
SaveAsfile (filename, False);
If EditStrx ('Load as', filename) = 0 Then Loadfile;
End;
No: If EditStrx ('Load as', filename) = 0 Then Loadfile;
End;
allprint;
Beready;
End;
#68:
Begin
SaveAsfile (filename, False);
Beready;
Break;
End;
#83: If ifempt (lin^ [curline]^) Then
Begin
DelLine (curline);
Allprint;
End Else delchar (False);
#86: Case EditStrx ('Import file and Code to UUE', fileimport) Of
0:
Begin editor. importfile (True, False); allprint; Beready; End;
End;
End;
Case c Of
#120..#124:
Begin
Window := NormalRect;
With Me^. setup^. setup Do
Begin
If fifty Then Inc (Window. b. Y, 25);
If SargelLine Then Inc (Window. a. Y);
If StatusLine Then Inc (Window. a. Y);
If HelpLine Then Dec (Window. b. Y);
If Vertic Then Dec (Window. b. X);
End;
Allprint;
Beready;
End;
#125..#129: Smiley (Ord (c) - 125);
End;
End;
False: Case c Of
#19:
Begin
Lastcur. X := currow;
Lastcur. Y := curline;
End;
#18:
Begin
currow := Lastcur. X;
curline := Lastcur. Y;
End;
#10:
Begin
Addline (curline, '');
Allprint;
End;
#13: Enter;
#20: With Me^. setup^. setup Do Putchar (Chr (ccx + ccy * 16) );
#25:
Begin
ME^. AddDellineEnd (Lin^ [curline]^);
DelLine (curline);
Allprint;
End;
#21:
Begin
Addline (curline, ME^. GetDelline);
Allprint;
End;
#9:
Begin
Hebr := Not (hebr);
If hebr Then currow := Hrigth Else currow := Eleft;
Beready;
End;
#8:
Begin
Inc (currow, Ord (hebr) * 2 - 1);
If (currow < 1) Then currow := 1;
Case hebr Of
True: If (currow > Hrigth) Then currow := Hrigth;
False: If (currow < Eleft) Then currow := Eleft;
End;
delchar (True);
End;
#27:
If linemode Then
Begin
linemode := False;
Allprint;
Beready;
End Else
Begin
If Port [$60] = 1 Then
Begin
Saveqes := Qset ('Save before exit?', True, Yes);
Case Saveqes Of
Yes: Begin
SaveAsfile (filename, False);
Break
End;
No: Break;
Cencel:;
End;
End
Else If Port [$60] = 26 Then
Begin
If hebr Then HLeft := Currow Else Eleft := Currow;
If Me^. Setup^. setup. SargelLine Then DrawSargel;
End;
End;
#29:
Begin
If hebr Then HRigth := Currow Else ERigth := Currow;
If Me^. Setup^. setup. SargelLine Then DrawSargel;
End;
Else PutChar (c);
End;
End;
If curline < 1 Then curline := 1;
If curline > numlines Then curline := numlines;
If curlinedisp > curline Then
Begin
curlinedisp := curline;
Allprint;
End Else
If curlinedisp + Window. b. Y - Window. a. Y < curline Then
Begin
curlinedisp := curline - (Window. b. Y - Window. a. Y);
Allprint;
End;
if currow < 1 then currow := 1;
if currow > 80 then currow := 80;
If Me^. Setup^. setup. StatusLine And ( (Lcurrow <> currow) Or
(Lnumoflines <> numlines) Or (Lcurline <> curline) )
Then Drawstatus;
If Me^. Setup^. setup. SargelLine And (Lcurrow <> currow) Then editor. DrawSargel;
If Me^. Setup^. setup. Vertic And ( (Lcurline <> curline)
Or (Lnumoflines <> numlines) )
Then editor. DrawVertic;
Until False;
End;
Procedure HebInit;
Var
D: DirStr;
N: NameStr;
E: ExtStr;
Begin
FSplit (ParamStr (0), D, N, E);
progpath := D;
execname := n + e;
fixdir (progpath);
For i := 0 To 255 Do
Begin
engchar [i] := Chr (i);
hebchar [i] := Chr (i);
End;
hebchar [33] := '!'; hebchar [39] := ','; hebchar [44] := 'š'; hebchar [46] := '•';
hebchar [47] := '.'; hebchar [59] := '“'; hebchar [97] := '™'; hebchar [98] := '';
hebchar [99] := ''; hebchar [100] := '‚'; hebchar [101] := '—'; hebchar [102] := '‹';
hebchar [103] := '’'; hebchar [104] := '‰'; hebchar [105] := ''; hebchar [106] := '‡';
hebchar [107] := 'Œ'; hebchar [108] := 'Š'; hebchar [109] := '–'; hebchar [110] := 'Ž';
hebchar [111] := 'O'; hebchar [112] := '”'; hebchar [113] := '/'; hebchar [114] := '˜';
hebchar [115] := 'ƒ'; hebchar [116] := '€'; hebchar [117] := '…'; hebchar [118] := '„';
hebchar [119] := ''''; hebchar [120] := '‘'; hebchar [121] := 'ˆ'; hebchar [122] := '†';
hebchar [Ord ('`') ] := ';';
End;
Procedure Linedraw (X1, Y1, X2, Y2: Word; Var lin: Linearray; numlines, curdru: Integer);
Var
Y, X: Word;
c, c1: Char;
dr : String [11];
Procedure strtline (a: Word); Far;
Begin
Lin [a]^ := fixstr (Lin [a]^, 80);
End;
Function wc1: Char; Begin
If ( (Y - 1) >= 1) And ( (Y - 1) <= numlines) And (X >= 1) And (X <= 80) Then
Begin strtline (Y - 1); wc1 := Lin [Y - 1]^ [X] End;
End;
Function wc2: Char; Begin
If ( (Y + 1) >= 1) And ( (Y + 1) <= numlines) And (X >= 1) And (X <= 80) Then
Begin strtline (Y + 1); wc2 := Lin [Y + 1]^ [X] End;
End;
Function wc3: Char; Begin
If ( (X - 1) >= 1) And ( (X - 1) <= 80) And ( (Y) >= 1) And ( (Y) <= numlines) Then
Begin strtline (Y); wc3 := Lin [Y]^ [X - 1] End;
End;
Function wc4: Char; Begin
If ( (X + 1) >= 1) And ( (X + 1) <= 80) And ( (Y) >= 1) And ( (Y) <= numlines) Then
Begin strtline (Y); wc4 := Lin [Y]^ [X + 1] End;
End;
Procedure writec (CH: Char); Far;
Begin
If (X >= 1) And (X <= 80)
And (Y >= 1) And (Y <= numlines)
Then
Begin
strtline (Y);
Lin [Y]^ [X] := CH;
End;
End;
Function ifes (CH: Char): Boolean; Far;
Begin
ifes := (dr [1] <> CH) And (dr [2] <> CH)
And (dr [3] <> CH) And (dr [4] <> CH)
And (dr [5] <> CH) And (dr [6] <> CH)
And (dr [7] <> CH) And (dr [8] <> CH)
And (dr [9] <> CH) And (dr [10] <> CH)
And (dr [11] <> CH)
End;
Procedure goLeft; Far;
Begin
If ifes (wc1) And ifes (wc2) And ifes (wc4) Then writec (dr [5] );
If (wc1 = dr [6] ) Or (wc1 = dr [9] ) Or (wc1 = dr [2] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [7] ) Or (wc1 = dr [11] ) Or (wc1 = dr [9] )
Or (wc1 = dr [1] )
Then writec (dr [4] );
If (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] )
Then writec (dr [5] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [11] )
Or (wc2 = dr [3] ) Or (wc2 = dr [6] ) Or (wc2 = dr [9] ) )
Then writec (dr [2] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [11] ) Or (wc2 = dr [10] )
Or (wc2 = dr [6] ) Or (wc2 = dr [3] ) Or (wc2 = dr [9] ) ) And
( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [7] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And ( (wc4 = dr [4] )
Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] )
Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [10] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And ( (wc2 = dr [4] )
Or (wc2 = dr [8] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [10] )
Or (wc2 = dr [6] ) Or (wc2 = dr [9] ) )
Then writec (dr [8] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [9] )
Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [11] ) ) And ( (wc2 = dr [4] )
Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [3] )
Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) ) And ( (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) )
Then writec (dr [9] ); X := X - 1;
If (wc1 = dr [6] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [7] ) Or (wc1 = dr [11] ) Or (wc1 = dr [9] )
Or (wc1 = dr [1] )
Then writec (dr [4] );
If (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] )
Then writec (dr [5] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] )
Or (wc2 = dr [10] ) Or (wc2 = dr [11] ) Or (wc2 = dr [3] ) Or (wc2 = dr [6] )
Or (wc2 = dr [9] ) )
Then writec (dr [2] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] )
Or (wc2 = dr [11] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [3] )
Or (wc2 = dr [9] ) ) And ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2]
)
Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [7] ); If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] )
Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And
( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [10] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And
( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] )
Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [9] ) )
Then writec (dr [8] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [9] )
Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [11] ) ) And ( (wc2 = dr [4] )
Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [3] )
Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) ) And ( (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) )
Then writec (dr [9] );
If ifes (wc1) And ifes (wc2) And ifes (wc4) Then writec (dr [5] );
End;
Procedure GoRigth; Far;
Begin
If ifes (wc1) And ifes (wc2) And ifes (wc3) Then writec (dr [5] );
If (wc1 = dr [6] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [7] ) Or (wc1 = dr [11] ) Or (wc1 = dr [9] )
Or (wc1 = dr [1] )
Then writec (dr [3] );
If (wc3 = dr [11] ) Or (wc3 = dr [7] )
Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] )
Or (wc3 = dr [1] )
Then writec (dr [5] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] )
Or (wc2 = dr [10] ) Or (wc2 = dr [11] ) Or (wc2 = dr [3] ) Or (wc2 = dr [6] )
Or (wc2 = dr [9] ) )
Then writec (dr [1] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] )
Or (wc2 = dr [11] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [3] )
Or (wc2 = dr [9] ) ) And ( (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5
] )
Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [7] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] )
Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) )
And ( (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] )
Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [10] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And ( (wc2 = dr [4] )
Or (wc2 = dr [8] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [10] )
Or (wc2 = dr [6] ) Or (wc2 = dr [9] ) )
Then writec (dr [11] );
If ( (wc1 = dr [6] )
Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [9] )
Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [11] ) ) And ( (wc2 = dr
[4] ) Or (wc2 = dr [8] )
Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [3] )
Or (wc2 = dr [11] )
Or (wc2 = dr [9] ) ) And ( (wc3 = dr [11] ) Or (wc3 = dr
[7] ) Or (wc3 = dr [5] )
Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] )
Or (wc3 = dr [1] ) )
Then writec (dr [9] ); X := X + 1; If (wc1 = dr [6] ) Or (wc1 = dr [8] )
Or (wc1 = dr [2] ) Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [7] )
Or (wc1 = dr [11] ) Or (wc1 = dr [9] ) Or (wc1 = dr [1] )
Then writec (dr [3] );
If (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] )
Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] )
Then writec (dr [5] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [11] )
Or (wc2 = dr [3] ) Or (wc2 = dr [6] ) Or (wc2 = dr [9] ) )
Then writec (dr [1] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [11] ) Or (wc2 = dr [10] )
Or (wc2 = dr [6] ) Or (wc2 = dr [3] ) Or (wc2 = dr [9] ) ) And ( (wc3 = dr [11] )
Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [7] );
If ( (wc1 = dr [6] )
Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] )
Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And ( (wc3 = dr
[11] )
Or (wc3 = dr [7] )
Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] )
Or (wc3 = dr [1] ) )
Then writec (dr [10] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] )
Or (wc1 = dr [8] ) Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [9] )
Or (wc1 = dr [11] ) ) And ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr
[3] )
Or (wc2 = dr [11] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [9]
) )
Then writec (dr [11] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] )
Or (wc1 = dr [9] ) Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [11] ) )
And ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] )
Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) ) And ( (wc3 = dr [11] )
Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [9] );
If ifes (wc1) And ifes (wc2) And ifes (wc3) Then writec (dr [5] );
End;
Procedure Godown; Far;
Begin
If ifes (wc3) And ifes (wc4) And ifes (wc1) Then writec (dr [6] );
If (wc1 = dr [6] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [7] ) Or (wc1 = dr [11] ) Or (wc1 = dr [9] )
Or (wc1 = dr [1] )
Then writec (dr [6] );
If (wc3 = dr [11] ) Or (wc3 = dr [7] )
Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] )
Or (wc3 = dr [1] )
Then writec (dr [2] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) )
Then writec (dr [1] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr
[5] )
Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [7] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] )
Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) )
And ( (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] )
Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [8] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And ( (wc4 = dr [4] )
Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] )
Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [11] );
If ( (wc1 = dr [6] )
Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [9] )
Or (wc1 = dr [2] )
Or (wc1 = dr [1] ) Or (wc1 = dr [11] ) ) And ( (wc4 = dr
[4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] )
Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] ) Or (wc3 = dr [
7] ) Or (wc3 = dr [5] )
Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] )
Or (wc3 = dr [1] ) )
Then writec (dr [9] ); Y := Y + 1; If (wc1 = dr [6] ) Or (wc1 = dr [8] )
Or (wc1 = dr [2] ) Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [7] )
Or (wc1 = dr [11] ) Or (wc1 = dr [9] ) Or (wc1 = dr [1] )
Then writec (dr [6] );
If (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] )
Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] )
Then writec (dr [2] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [1] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] )
Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [7] );
If ( (wc1 = dr [6] )
Or (wc1 = dr [7] ) Or (wc1 = dr [8] ) Or (wc1 = dr [2] )
Or (wc1 = dr [1] )
Or (wc1 = dr [9] ) Or (wc1 = dr [11] ) ) And ( (wc3 = dr [
11] ) Or (wc3 = dr [7] )
Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [8] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] )
Or (wc1 = dr [8] ) Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [9] )
Or (wc1 = dr [11] ) ) And ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr
[2] )
Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [11] );
If ( (wc1 = dr [6] ) Or (wc1 = dr [7] ) Or (wc1 = dr [8] )
Or (wc1 = dr [9] ) Or (wc1 = dr [2] ) Or (wc1 = dr [1] ) Or (wc1 = dr [11] ) )
And ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] )
Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [9] );
If ifes (wc3) And ifes (wc4) And ifes (wc1) Then writec (dr [6] );
End;
Procedure Goup; Far;
Begin
If ifes (wc3) And ifes (wc4) And ifes (wc2) Then writec (dr [6] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] )
Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) )
Then writec (dr [6] );
If (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] )
Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] )
Then writec (dr [4] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [3] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] )
Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [10] );
If ( (wc2 = dr [4] )
Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] )
Or (wc2 = dr [3] )
Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) ) And ( (wc3 = dr
[11] ) Or (wc3 = dr [7] )
Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] )
Or (wc3 = dr [1] ) )
Then writec (dr [8] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] )
Or (wc2 = dr [10] ) Or (wc2 = dr [6] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] )
Or (wc2 = dr [9] ) ) And ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2]
)
Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [11] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] )
Or (wc2 = dr [6] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) )
And ( (wc4 = dr [4] ) Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] )
Or (wc4 = dr [7] ) Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] )
Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] )
Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [9] ); Y := Y - 1;
If ( (wc2 = dr [4] )
Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2
= dr [6] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] )
Or (wc2 = dr [9] ) )
Then writec (dr [6] );
If (wc3 = dr [11] ) Or (wc3 = dr [7] )
Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] )
Or (wc3 = dr [1] )
Then writec (dr [4] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) )
Then writec (dr [3] );
If ( (wc4 = dr [4] ) Or (wc4 = dr [8] )
Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] ) Or (wc4 = dr [5] )
Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5]
)
Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [10] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] )
Or (wc2 = dr [6] ) Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) )
And ( (wc3 = dr [11] ) Or (wc3 = dr [7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] )
Or (wc3 = dr [10] ) Or (wc3 = dr [3] ) Or (wc3 = dr [1] ) )
Then writec (dr [8] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] )
Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) ) And ( (wc4 = dr [4] )
Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] )
Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) )
Then writec (dr [11] );
If ( (wc2 = dr [4] ) Or (wc2 = dr [8] ) Or (wc2 = dr [10] ) Or (wc2 = dr [6] )
Or (wc2 = dr [3] ) Or (wc2 = dr [11] ) Or (wc2 = dr [9] ) ) And ( (wc4 = dr [4] )
Or (wc4 = dr [8] ) Or (wc4 = dr [2] ) Or (wc4 = dr [10] ) Or (wc4 = dr [7] )
Or (wc4 = dr [5] ) Or (wc4 = dr [9] ) ) And ( (wc3 = dr [11] ) Or (wc3 = dr
[7] ) Or (wc3 = dr [5] ) Or (wc3 = dr [9] ) Or (wc3 = dr [10] ) Or (wc3 = dr [3] )
Or (wc3 = dr [1] ) )
Then writec (dr [9] );
If ifes (wc3) And ifes (wc4) And ifes (wc2) Then writec (dr [6] );
End;
Begin
dr := dra [curdru];
X := X1;
Y := Y1;
If (X1 = X2) Then
Begin
If (Y1 < Y2) Then For i := 1 To Y2 - Y1
Do godown
Else For i := 1 To Y1 - Y2 Do goup;
End Else
If (Y1 = Y2) Then
Begin
If (X1 < X2) Then For i := 1 To X2 - X1 Do gorigth Else
For i := 1 To X1 - X2 Do goleft;
End;
End;
Procedure SetupOBJ. edit;
Var
mydb:^databox;
o: Integer;
l: Integer;
i: Byte;
t: Byte;
sTitle: String [7];
s: String [70];
Const
Mainc : Array [1..5] Of String [20] =
(' Mergin',
' Color',
' General',
' Load Default',
' Exit and save'
);
Label 1;
Begin
SwapTscr;
TextMode (co80);
noblink;
o := 0;
i := 1;
sTitle := Editorname + ' ';
Repeat
Inc (i);
If i = 8 Then i := 1;
Mem [$B800: o * 2] := Ord (Stitle [i] );
Mem [$B800: o * 2 + 1] := 1;
Inc (o);
Until o >= 2000;
i := 1;
1:
t := Choose ('Configuration', Mainc, 20, 5, i, True);
Case t Of
13: Case i Of
1: With setup Do
Begin
SwapTscr;
New (mydb, init ('Mergins', 21, 9, 53, 16) );
Puttext (25, 11, 7, 15, 'English Left Mergin : ');
Puttext (25, 12, 7, 15, 'English Rigth Mergin: ');
Puttext (25, 13, 7, 15, 'Hebrew Left Mergin : ');
Puttext (25, 14, 7, 15, 'Hebrew Rigth Mergin : ');
mydb^. Add (Eleft, db__integer, 3, 47, 11);
mydb^. Add (Erigth, db__integer, 3, 47, 12);
mydb^. Add (Hleft, db__integer, 3, 47, 13);
mydb^. Add (Hrigth, db__integer, 3, 47, 14);
Repeat
l := mydb^. Run;
Until l = 1;
Dispose (mydb, deinit);
UnSwapTscr;
Goto 1;
End;
2: With setup Do
Begin
SwapTscr;
New (mydb, init ('Colors', 2, 2, 78, 22) );
Puttext (5, 4, 7, 15, 'Program colors:');
mydb^. Add (Color. status, db__colo, 3, 5, 6);
mydb^. Add (Color. help, db__colo, 3, 5, 7);
mydb^. Add (Color. Sargel, db__colo, 3, 5, 8);
mydb^. Add (Color. Vertic, db__colo, 3, 5, 9);
mydb^. Add (Color. Mark, db__colo, 3, 5, 10);
Puttext (5, 12, 7, 15, 'Text colors:');
mydb^. Add (Color. Text. Normal, db__colo, 3, 5, 14);
mydb^. Add (Color. Text. Q, db__colo, 3, 5, 15);
mydb^. Add (Color. Text. tear, db__colo, 3, 5, 16);
mydb^. Add (Color. Text. Origin, db__colo, 3, 5, 17);
mydb^. Add (Color. Text. Tag, db__colo, 3, 5, 18);
Puttext (35, 4, 7, 15, 'Styles marks:');
For l := 1 To 15 Do
mydb^. Add (Color. Style [l], db__colo, 3, 35, 5 + l);
Repeat
For l := 1 To 15 Do
Begin
s := StyleS1 [l] + 'Style' + StyleS2 [l];
s := Fixstr ('', (40 - Length (s) ) Div 2) + s;
s := fixstr (s, 40);
With Color. Style [l] Do Puttext (35, 5 + l, back, ford, s);
End;
With Color Do
Begin
With status Do Puttext (5, 6, back, ford, ' Status line ');
With Help Do Puttext (5, 7, back, ford, ' Help line ');
With Sargel Do Puttext (5, 8, back, ford, ' Upper Ruler ');
With Vertic Do Puttext (5, 9, back, ford, ' Rigth Ruler ');
With Mark Do Puttext (5, 10, back, ford, ' Marked Lines ');
With Text Do
Begin
With Normal Do Puttext (5, 14, back, ford, ' Normal Text ');
With q Do Puttext (5, 15, back, ford, ' Qouted Text ');
With tear Do Puttext (5, 16, back, ford, ' TearLine ');
With Origin Do Puttext (5, 17, back, ford, ' Origin Line ');
With Tag Do Puttext (5, 18, back, ford, ' Tagline ');
End;
End;
l := mydb^. Run;
Until l = 1;
Dispose (mydb, deinit);
UnSwapTscr;
Goto 1;
End;
3: With setup Do
Begin
SwapTscr;
New (mydb, init ('General', 3, 2, 77, 24) );
Puttext (6, 4, 7, 15, 'First line when starting (if exist):');
mydb^. Add (FirstLine, db__integer, 3, 43, 4);
Puttext (48, 4, 7, 15, 'Memsofit:');
mydb^. Add (Memsofit, db__byte, 3, 57, 4);
Puttext (61, 4, 7, 15, 'Heb fix char:');
mydb^. Add (hebfix, db__byte, 3, 74, 4);
Puttext (6, 6, 7, 15, 'Import''s start and end lines:');
mydb^. Add (Importbegin, db__string, 70, 6, 7);
mydb^. Add (ImportEnd, db__string, 70, 6, 8);
Puttext (6, 9, 7, 15, 'UUE Code Import start and end lines:');
mydb^. Add (UUEImportbegin, db__string, 70, 6, 10);
mydb^. Add (UUEImportEnd, db__string, 70, 6, 11);
Puttext (6, 13, 7, 15, 'Tearline (@V = Version, leave empty for no tearline):');
mydb^. Add (Tearline, db__string, 70, 6, 14);
Puttext (6, 15, 7, 15, 'Golded Path (System and points only):');
mydb^. Add (Golded, db__string, 70, 6, 16);
Puttext (6, 17, 7, 15, 'Command line for ALT-R, (@F=File):');
mydb^. Add (Commandline, db__string, 70, 6, 18);
Puttext (6, 19, 7, 15, 'Enable auto language feature:');
mydb^. Add (autolang, db__boolean, 3, 36, 19);
Puttext (6, 21, 7, 15, 'Seconds of inactivity to run screensaver (0=Disable): ');
mydb^. Add (screensave, db__integer, 5, 60, 21);
Puttext (6, 22, 7, 15, 'Scconds interval bitween automatic file save (0=Disable): ');
mydb^. Add (Autosave, db__integer, 5, 64, 22);
Repeat
l := mydb^. Run;
Until l = 1;
Dispose (mydb, deinit);
UnSwapTscr;
Goto 1;
End;
4:
Begin
If Qset ('Area you sure?', False, Yes) = Yes
Then Setup := defsetup;
Goto 1;
End;
End;
End;
hebchar [111] := setup. memsofit;
getTtextmode;
UnSwapTscr;
End;
Function Ifparam (s: String): Boolean;
Var
i: Integer;
Begin
Ifparam := False;
For i := 1 To ParamCount Do
If ups (ParamStr (i) ) = ups (s) Then
Begin
Ifparam := True;
Break;
End;
End;
Constructor MultiEDitor. Init;
Var
i: Integer;
Begin
ScrSwapSeed := 0;
Lmode := LastMode;
ClrScr;
HebInit;
For i := 1 To 10 Do Ef [i] := Nil;
CurEF := 1;
New (Setup, Init (Defsetup) );
Setup^. load;
If Ifparam ('/C') Then
Setup^. edit
Else
Begin
numdellines := 0;
New (DelLin);
For i := 1 To 300 Do DEllin^ [i] := Nil;
End;
End;
Procedure MultiEDitor. run;
Type
String70 = String [70];
Var
i, j: Integer;
o, wasCUREF: Byte;
c: Char;
Wik: Array [1..10] Of String70;
s: String80;
filename: String;
Procedure Getwik;
Var
i: Integer;
Begin
For i := 1 To 10 Do
If Ef [i] <> Nil Then
Wik [i] := Ef [i]^. filename
Else
Wik [i] := ' [-----EMPTY------] ';
End;
Label 1;
Begin
New (Ef [CurEF], Init (NormalRect, ParamStr (1) ) );
Ef [CurEF]^. loadfile;
Repeat
i := Ef [CurEF]^. run;
If i = 1 Then
Begin
1:
ClrScr;
TextMode (co80);
Hidecursor;
noblink;
Puttext (4, 20, 0, 15, '[DEL] Remove file (NO save)');
Puttext (4, 21, 0, 15, '[F2] Save all and exit program');
Puttext (4, 22, 0, 15, '[F3] Save file');
Puttext (4, 23, 0, 15, '[F6] Rename file');
Puttext (4, 24, 0, 15, '[F10] Save file and remove it');
Puttext (38, 20, 0, 15, '[INSRT] Make a new file (on empty slot)');
Puttext (38, 21, 0, 15, '[ESC] Exit (to editor, or from program)');
wasCUREF := CUREF;
Repeat
s := fixstr (Fixstr (VersO, 10) + '³ by Dan Aloni ³ ' + inttostr (MemAvail Div 1000)
+ 'Kb Mem' , 80);
With Me^. setup^. setup. Color. status Do Puttext (1, 1, back, ford, s);
Getwik;
o := Choose ('File Maneger', Wik, 70, 10, CurEF, False);
If extkey Then
Case o Of
64: If Ef [CurEF] <> Nil Then
Begin
EditStrx ('Load as', Ef [CurEF]^. filename);
End;
83: If Ef [CurEF] <> Nil Then
Begin
Dispose (Ef [CurEF], deInit);
Ef [CurEF] := Nil;
End;
82: If Ef [CurEF] = Nil Then
Begin
If EditStrx ('Load as', filename) = 0 Then
Begin
New (Ef [CurEF], Init (NormalRect, filename) );
Ef [CurEF]^. Loadfile;
End;
End;
68: If Ef [CurEF] <> Nil Then
Begin
Ef [CurEF]^. SaveAsfile (Ef [CurEF]^. filename, False);
Dispose (Ef [CurEF], deInit);
Ef [CurEF] := Nil;
End;
60:
Begin
For j := 1 To 10 Do
If Ef [j] <> Nil Then
Begin
Ef [j]^. SaveAsfile (Ef [j]^. filename, False);
Dispose (Ef [j], deInit);
Ef [j] := Nil;
End;
i := 0;
Break;
End;
61: If Ef [CurEF] <> Nil Then
Ef [CurEF]^. SaveAsfile (Ef [CurEF]^. filename, False);
End
Else
Case o Of
13: If Ef [CurEF] <> Nil Then Break;
27:
Begin
If Ef [WasCurEF] <> Nil Then
CurEF := wasCurEF
Else i := 0;
Break;
End;
End;
Until False;
getTtextmode;
End Else
Begin
Dispose (Ef [CurEF], deInit);
Ef [CurEF] := Nil;
End;
Until i = 0;
For i := 1 To 10 Do If Ef [i] <> Nil Then Goto 1;
End;
Destructor MultiEDitor. DeInit;
Begin
If Not (Ifparam ('/C') ) Then Begin
For i := 1 To 10 Do If Ef [i] <> Nil Then Dispose (Ef [i], deInit);
For i := 1 To numdellines Do Dispose (dellin^ [i] );
Dispose (dellin);
End;
Setup^. Save;
Dispose (Setup);
ClrScr;
RestoreCursor;
TextMode (lmode);
End;
Begin
New (Me, init);
If Not (Ifparam ('/C') ) Then Me^. run;
Dispose (Me, Deinit);
End.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment