1Program Edit_Demo;
2{---------------------------------------------------------------------------
3                                 CncWare
4                         (c) Copyright 1999-2000
5 ---------------------------------------------------------------------------
6  Filename..: edit_demo.pp
7  Programmer: Ken J. Wright, ken@cncware.com
8  Date......: 12/12/99
9
10  Purpose - Demonstrate the use of the oCrt unit.
11
12-------------------------------<< REVISIONS >>--------------------------------
13  Ver  |   Date   | Prog| Description
14-------+----------+-----+-----------------------------------------------------
15  1.00 | 12/12/99 | kjw | Initial Release.
16  1.01 | 12/13/99 | kjw | Changed to use oCrt.
17  1.02 | 06/16/00 | kjw | Added help & goto line pop-up screens.
18                        | Changes for control keys.
19  1.03 | 07/25/00 | kjw | Added use of new tnMenu object.
20------------------------------------------------------------------------------
21}
22uses oCrt;
23
24const
25   MAXLINES = 52;                 { allow for long screens }
26   CURLINES : Integer = MAXLINES; { adjusted later }
27   FRAMED = true;
28   NOFRAME = false;
29   bg = 16;                       { background color multiplier }
30
31type
32   { doubly linked list of strings to edit }
33   pLine = ^tLine;
34   tLine = Record
35      s : ^string;
36      next,
37      prev : pLine;
38   End;
39   s80 = string[80];
40
41var
42   hdr,                            { list head }
43   line,                           { current position in list }
44   line1 : pLine;                  { first list item of current page }
45   ss : array[1..MAXLINES] of s80; { a sliding screen buffer }
46   xp,yp : string;                 { x & y positions for the status line }
47   EdWin,                          { main edit window }
48   StatWin : tnWindow;             { status line }
49   mnu0 : tnMenu;                  { main menu }
50   mnu1 : pnMenu;                  { dynamic menu for sub menus }
51   xi,                             { integer scratch pad }
52   cv,                             { edit character return value }
53   idx : integer;                  { current screen buffer row index }
54   cline,                          { current line number }
55   dlines : integer;               { number of displayed lines }
56   lines : longint;                { total number of lines in the list }
57   mactive,                        { is the menu active? }
58   Finished : boolean;             { exit when finished }
59   tf : text;                      { the text file we are reading/writing }
60   fnam : string;                  { name of the current file, tf }
61
62
63{ replace the old string with a new one }
64Procedure ReallocateLine(var p : pLine; s : string);
65Begin
66   If p = Nil Then Exit;
67   If p^.s^ <> s Then Begin
68      FreeMem(p^.s,Length(p^.s^)+1);
69      GetMem(p^.s,Length(s)+1);
70      p^.s^ := s;
71   End;
72End;
73
74{ insert a new pline into the edit list before p }
75Procedure InsertLine(var p : pLine; s : string);
76Var
77   tmp : pLine;
78Begin
79   New(tmp);
80   GetMem(tmp^.s,Length(s)+1);
81   tmp^.s^ := s;
82   tmp^.prev := p^.prev;
83   tmp^.next := p;
84   p^.prev := tmp;
85   tmp^.prev^.next := tmp;
86   inc(lines);
87End;
88
89{ delete a pline from the edit list }
90Procedure DeleteLine(var p : pLine);
91Var
92   tmp : pLine;
93Begin
94   FreeMem(p^.s,Length(p^.s^));
95   tmp := p^.next;
96   tmp^.prev := p^.prev;
97   p^.prev^.next := tmp;
98   Dispose(p);
99   p := tmp;
100   dec(lines);
101   If cline > lines Then cline := lines;
102End;
103
104{ return the minimum of two integer values }
105Function Min(i1,i2 : integer) : integer;
106Begin
107  If i1 < i2 Then
108     Min := i1
109  Else
110     Min := i2;
111End;
112
113{ fill the edit buffer starting with position h in the edit list }
114Procedure LoadLines(var h : pLine);
115Var
116   tmp : pLine;
117   i : integer;
118Begin
119   FillChar(ss,SizeOf(ss),#0);
120   tmp := h;
121   If tmp = hdr Then tmp := tmp^.Next;
122   For i := 1 to CURLINES Do Begin
123      If (tmp <> Nil) and (tmp <> hdr) Then Begin
124         ss[i] := tmp^.s^;
125         tmp := tmp^.next;
126         dlines := i;
127      End;
128   End;
129End;
130
131{ display the edit buffer in the edit window }
132Procedure DisplayLines;
133Var
134   i : integer;
135Begin
136   With EdWin Do Begin
137      For i := 1 to CURLINES Do Begin
138         FWrite(1,i,GetColor,Cols,ss[i]);
139      End;
140   End;
141End;
142
143{ free the entire edit list }
144Procedure ClearLines(var h : pLine);
145Var
146   tmp : pLine;
147Begin
148   If h <> Nil Then Begin
149      tmp := h^.prev;
150      If (tmp <> h) and (tmp^.s <> Nil) Then Begin
151         FreeMem(tmp^.s,Length(tmp^.s^)+1);
152         tmp^.next := h;
153         Dispose(tmp);
154      End;
155   End;
156   New(h);
157   h^.next := h;
158   h^.prev := h;
159   h^.s := nil;
160End;
161
162Function PromptFile(hs : string; var s : string) : integer;
163Var
164   win : pnWindow;
165   ret : integer;
166Begin
167   New(win,Init(1,1,EdWin.Cols,3,cyan*bg,FRAMED,cyan*bg+white));
168   With win^ Do Begin
169      PutHeader(hs,GetFrameColor,center);
170      FWrite(2,1,GetColor,0,'Filename: ');
171      Align(center,center);
172      Show;
173      s := Edit(12,1,GetColor+white,Cols,12,fnam,ret);
174      PromptFile := ret;
175      Hide;
176   End;
177   Dispose(win,Done);
178End;
179
180{ prompt for, and open a text file }
181Function OpenFile(var f : text; prompt : boolean) : boolean;
182Var
183   s : string;
184   tst : text;
185   ret : integer;
186Begin
187   If prompt Then
188      ret := PromptFile('Open File',s)
189   Else Begin
190      s := fnam;
191      ret := nkEnter;
192   End;
193   If ret = nkEnter Then Begin
194      Assign(tst,s);
195      {$push}{$I-}
196      Reset(tst);
197      {$pop}
198      If IoResult = 0 Then Begin
199         Close(tst);
200         Assign(f,s);
201         Reset(f);
202         OpenFile := true;
203         fnam := s;
204      End Else Begin
205         nShowMessage('Could not open file "'+s+'"',79,' Error ',78,true);
206         OpenFile := false;
207      End;
208   End Else
209      OpenFile := false;
210End;
211
212{ read a file line by line into the edit list }
213Procedure ReadFile(var f : text; prompt : boolean);
214Var
215   err : boolean;
216   s : string;
217   win : pnWindow;
218Begin
219   If Not OpenFile(f,prompt) Then Exit;
220   ClearLines(hdr);
221   lines := 0;
222   win := nShowMessage('Reading "'+fnam+'"...',47,' Open File ',46,false);
223   {$push}{$I-}
224   Repeat
225      If Not Eof(f) Then Begin
226         Readln(f,s);
227         err := (IoResult <> 0);
228         If Not Err Then InsertLine(hdr,s);
229      End;
230   Until Eof(f) or err;
231   Close(f);
232   {$pop}
233   win^.Hide;
234   win^.Done;
235   line1 := hdr^.next;
236   line := line1;
237   LoadLines(line1);
238   DisplayLines;
239   idx := 1;
240End;
241
242{ save the edit list to disk }
243Procedure SaveFile(var f : text);
244Var
245   tmp : text;
246   s,
247   tnam : string;
248   cur : pLine;
249   win : pnWindow;
250Begin
251   If PromptFile('Save File',s) = nkEsc Then
252      Exit
253   Else
254      fnam := s;
255   tnam := fnam+'~';
256   Assign(tmp,tnam);
257   Assign(f,fnam);
258   win := nShowMessage('Saving "'+fnam+'"...',47,' Save File ',46,false);
259   {$push}{$I-}
260   Reset(tmp);
261   If IoResult = 0 Then Begin
262      Close(tmp);
263      Erase(tmp);
264      Rename(f,tnam);
265      Assign(f,fnam);
266   End;
267   ReWrite(f);
268   cur := hdr^.next;
269   Repeat
270      If cur <> hdr Then Writeln(f,cur^.s^);
271      cur := cur^.next;
272   Until cur = hdr;
273   Close(f);
274   {$pop}
275   win^.Hide;
276   win^.Done;
277End;
278
279{ make the menu appear active }
280Procedure MenuUp;
281Begin
282   With mnu0 Do Begin
283      SetColor(48);
284      SetCursorColor(79);
285      Show;
286   End;
287   StatWin.FWrite(1,1,StatWin.GetColor,0,'Esc=Edit');
288End;
289
290{ make the menu appear inactive }
291Procedure MenuDown;
292Begin
293   With mnu0 Do Begin
294      SetColor(56);
295      SetCursorColor(56);
296      Show;
297   End;
298   StatWin.FWrite(1,1,StatWin.GetColor,0,'Esc=Menu');
299End;
300
301{ execute the File submenu }
302Procedure Menu_File;
303Begin
304   mnu0.SetIndex(1);
305   MenuUp;
306   New(mnu1,Init(1,1,0,3,1,48,79,8,FRAMED,62));
307   With mnu1^ Do Begin
308      Add('Open');
309      Add('Save');
310      Add('Exit - F10');
311      Post; { need the item count for move }
312      Move(1,nMaxRows-Count-2);
313      Start;
314      Case Index of
315         1 : ReadFile(tf,true);
316         2 : SaveFile(tf);
317         3 : Finished := true;
318      End;
319      Hide;
320   End;
321   Dispose(mnu1,Done);
322   MenuDown;
323End;
324
325{ display the help screen }
326Procedure Help;
327Var
328   hwin : pnWindow;
329Begin
330   mnu0.SetIndex(4);
331   MenuUp;
332   New(hwin,Init(1,1,40,20,62,FRAMED,49));
333   With hwin^ Do Begin
334      Align(center,center);
335      PutHeader('Edit_Demo Help',15,center);
336      FWrite(2, 2,63,0,'Ctrl/Q    - Move to column 1');
337      FWrite(2, 3,63,0,'Ctrl/W    - Move to end of line');
338      FWrite(2, 4,63,0,'Ctrl/A    - Move to previous word');
339      FWrite(2, 5,63,0,'Ctrl/F    - Move to next word');
340      FWrite(2, 6,63,0,'Ctrl/G    - Delete character');
341      FWrite(2, 7,63,0,'Ctrl/H    - Destructive Backspace');
342      FWrite(2, 8,63,0,'Ctrl/D    - Move forward one column');
343      FWrite(2, 9,63,0,'Ctrl/S    - Move back one column');
344      FWrite(2,10,63,0,'Ctrl/I    - Toggle Insert/Overwrite');
345      FWrite(2,11,63,0,'Ctrl/P    - Embed control character');
346      FWrite(2,12,63,0,'Ctrl/L    - Goto line number');
347      FWrite(2,13,63,0,'Ctrl/N    - Insert new line');
348      FWrite(2,14,63,0,'Ctrl/Y    - Delete current line');
349      FWrite(2,15,63,0,'Ctrl/X    - Move down one line');
350      FWrite(2,16,63,0,'Ctrl/E    - Move up one line');
351      FWrite(2,17,63,0,'Esc/1..0  - F1..F10');
352      Show;
353      Repeat Until Keypressed;
354      While KeyPressed Do ReadKey;
355      Hide;
356   End;
357   Dispose(hwin,Done);
358   MenuDown;
359End;
360
361{ goto the specified line in the edit buffer }
362Function GotoLine : boolean;
363Var
364   gwin : pnWindow;
365   l,
366   ii : longint;
367   esc : boolean;
368   aline : pline;
369Begin
370   New(gwin,Init(1,1,40,3,62,FRAMED,49));
371   With gwin^ Do Begin
372      Align(center,center);
373      PutHeader('Goto Line Number',15,center);
374      FWrite(2,1,63,0,'Line: ');
375      Show;
376      ec.ClearMode := true;
377      ii := EditNumber(8,1,63,8,0,'',cline,1,lines,esc);
378{      If esc or not (i in [1..lines]) Then i := ii;}
379      Hide;
380   End;
381   Dispose(gwin,Done);
382   If Not esc Then Begin
383      l := 0;
384      aline := hdr;
385      Repeat
386         inc(l);
387         aline := aline^.next;
388      Until (l = ii);
389      line1 := aline;
390      cline := l;
391   End;
392   GotoLine := (Not esc);
393End;
394
395{ initialize the global stuff }
396Procedure EditInit;
397Begin
398   With mnu0 Do Begin
399      Init(1,1,45,1,5,56,56,7,NOFRAME,0);
400      Add('File');
401      Add('InsLn');
402      Add('DelLn');
403      Add('Help');
404      Add('Exit');
405      Post;
406      Align(left,bottom);
407   End;
408   With StatWin Do Begin
409      Init(1,1,nStdScr.Cols-(mnu0.Wind^.Cols),1,48,NOFRAME,0);
410      Align(right,bottom);
411      Show;
412   End;
413   MenuDown;
414   With EdWin Do Begin
415      Init(1,1,nStdScr.Cols,nStdScr.Rows-1,30,FRAMED,31);
416      PutHeader(' oCrt Editor Demonstration ',15,center);
417      Show;
418      GotoXY(1,1);
419      {--------------------------------------------------------------------
420        The next line causes sedit to exit after every keystroke so we can
421        capture the insert mode and cursor positions for display update.
422        Alternatively, we could setup an ec.Special string to exit only on
423        certain keystrokes of interest.
424       --------------------------------------------------------------------}
425      ec.ExitMode := true;
426      { too re-assign a built-in key, put it in ec.special,
427        then use it in the case statement below
428
429      EdWin.ec.Special := EdWin.ec.Special + #5;
430      }
431      { now let's bind some keystrokes to the editor window }
432      ec.AddChMap(^a#0#0+chr(nKeyCtrlLeft));
433      ec.AddChMap(^s#0#0+chr(nKeyLeft));
434      ec.AddChMap(^f#0#0+chr(nKeyCtrlRight));
435      ec.AddChMap(^d#0#0+chr(nKeyRight));
436      ec.AddChMap(^e#0#0+chr(nKeyUp));
437      ec.AddChMap(^x#0#0+chr(nKeyDown));
438      ec.AddChMap(^q#0#0+chr(nKeyHome));
439      ec.AddChMap(^w#0#0+chr(nKeyEnd));
440      { define the number of edit window rows }
441      CURLINES := Min(MAXLINES,Rows);
442   End;
443   FillChar(ss,SizeOf(ss),#0);
444   nEscDelay(250);
445   idx := 1;
446   Finished := false;
447   mactive := false;
448   ClearLines(hdr);
449   If ParamCount > 0 Then Begin
450      fnam := ParamStr(1);
451      ReadFile(tf,false);
452   End Else
453      fnam := '';
454   { an empty list? }
455   If hdr^.next = hdr Then Begin
456      InsertLine(hdr,'');
457      line1 := hdr^.next;
458      line := line1;
459      dlines := 1;
460   End;
461   cline := 1;
462End;
463
464Begin
465   EditInit;
466   Repeat
467      With EdWin Do Begin
468         Case ec.InsMode of
469            true : StatWin.FWrite(11,1,StatWin.GetColor,0,'Ins');
470            false: StatWin.FWrite(11,1,StatWin.GetColor,0,'Ovr');
471         End;
472         Str(WhereX:0,xp);
473         Str(cline:0,yp);
474         StatWin.FWrite(16,1,StatWin.GetColor,StatWin.Cols,'Col:'+xp+'  Row:'+yp);
475         If mactive Then Begin
476            With mnu0 Do Begin
477               MenuUp;
478               Start;
479               Case Index Of
480                  1 : cv := nkAltF;
481                  2 : cv := nkF1;
482                  3 : cv := nkF2;
483                  4 : cv := nkF3;
484                  5 : cv := nkF10;
485                  Else cv := 0;
486               End;
487               MenuDown;
488               Show;
489            End;
490            mactive := false;
491            Active;
492            GotoXY(WhereX,WhereY);
493         End Else Begin
494            ss[idx] := Edit(1,idx,26,Cols,WhereX,ss[idx],cv);
495            FWrite(1,idx,GetColor,Cols,ss[idx]);
496            ReallocateLine(line,ss[idx]);
497         End;
498         Case cv of
499                12 : If GotoLine Then Begin
500                        idx := 1;
501                        LoadLines(line1);
502                        DisplayLines;
503                     End;
504            {5,}
505            nkUp   : Begin
506                        dec(idx);
507                        dec(cline);
508                        If (idx < 1) and (line1^.prev <> hdr) Then Begin
509                           line1 := line1^.prev;
510                           LoadLines(line1);
511                           DisplayLines;
512                        End;
513                     End;
514            nkDown : Begin
515                        inc(idx);
516                        inc(cline);
517                        If idx > CURLINES Then Begin
518                           line1 := line1^.next;
519                           LoadLines(line1);
520                           DisplayLines;
521                        End;
522                     End;
523            nkPgUp : Begin
524                        For xi := 1 to CURLINES Do Begin
525                           line1 := line1^.prev;
526                           dec(cline);
527                           If line1 = hdr Then
528                              line1 := line1^.next;
529                        End;
530                        LoadLines(line1);
531                        DisplayLines;
532                     End;
533            nkPgDn : Begin
534                        If dlines = CURLINES Then Begin
535                           For xi := 1 to CURLINES Do Begin
536                              inc(cline);
537                              line1 := line1^.next;
538                              If line1 = hdr Then
539                                 line1 := line1^.prev;
540                           End;
541                           LoadLines(line1);
542                           DisplayLines;
543                        End;
544                     End;
545            nkEnter: Begin
546                        GotoXY(1,WhereY);
547                        If line^.next = hdr Then Begin
548                           InsertLine(hdr,'');
549                           If dlines < CURLINES Then inc(dlines);
550                        End;
551                        If idx < CURLINES Then
552                           inc(idx)
553                        Else Begin
554                           line1 := line1^.next;
555                           LoadLines(line1);
556                           DisplayLines;
557                        End;
558                        inc(cline);
559                     End;
560            14, { ctrl/n }
561            nkF1   : Begin
562                        { first displayed line? }
563                        If line1 = line Then Begin
564                           line1 := line1^.prev;
565                           InsertLine(line,'');
566                           line1 := line1^.next;
567                        End Else
568                           InsertLine(line,'');
569                        LoadLines(line1);
570                        DisplayLines;
571                     End;
572            25, { ctrl/y }
573            nkF2   : Begin
574                        { first displayed line? }
575                        If line1 = line Then line1 := line^.next;
576                        DeleteLine(line);
577                        LoadLines(line1);
578                        DisplayLines;
579                     End;
580            nkAltH,
581            nkF3   : Help;
582            nkEsc  : mactive := true;
583            nkF10  : Finished := true;
584            nkAltF : menu_file;
585         End;
586         Active;
587         If idx > CURLINES Then idx := CURLINES; { keep in window, }
588         If idx > dlines Then idx := dlines;     { but not below last }
589         If idx < 1 Then idx := 1;
590         If cline < 1 Then cline := 1;
591         If cline > lines Then cline := lines;
592         GotoXY(WhereX,idx);
593         line := line1;
594         For xi := 1 to idx-1 Do Begin
595            line := line^.next;
596         End;
597      End;
598   Until Finished;
599   ClearLines(hdr);
600   EdWin.Done;
601   StatWin.Done;
602   ClrScr;
603End.
604