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