home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TRBOTEXT.ZIP / TRBOTEXT.PAS
Encoding:
Pascal/Delphi Source File  |  1986-08-14  |  7.5 KB  |  289 lines
  1. program turbo_text;
  2.  
  3. const
  4.   keylo                      = 32;
  5.   keyhi                      = 126;
  6.   maxindx                    = 18;
  7.   frametop                   = 7;
  8.   blankline                  = { 78 spaces }
  9. '                                                                            ';
  10.  
  11. type
  12.   text_string                = string [ 80 ];
  13.  
  14. var
  15.   col,row,key,seg,len,tseg,
  16.   lastcol,lside,rside,width,
  17.   lmargin,rmargin,maxline,
  18.   totcol,indx,code,chars,i,
  19.   framebot                   : integer;
  20.   ch                         : char;
  21.   value                      : string [ 2 ];
  22.   line,wrap,topline,botline,
  23.   midline                    : text_string;
  24.   text                       : array [ 1..maxindx ] of text_string;
  25.   edit,moveup,movedn         : boolean;
  26.  
  27. label                          start,
  28.                                getval,
  29.                                chkval;
  30.  
  31. procedure bad_entry;
  32.  
  33. begin
  34.   sound ( 100 );
  35.   delay ( 100 );
  36.   nosound
  37. end;
  38.  
  39. procedure update;
  40.  
  41. begin
  42.   gotoxy(10,4); write(col - lside:2);
  43.   gotoxy(19,4); write(row - frametop + 1:2);
  44.   gotoxy(28,4); write(chars:4);
  45. end;
  46.  
  47. procedure make_frame;
  48.  
  49. begin
  50.   for i := 1 to totcol do begin
  51.     midline := midline + #196;
  52.     end;
  53.   topline := #218 + midline + #191;
  54.   botline := #192 + midline + #217;
  55.   clrscr;
  56.     gotoxy(lside,frametop - 1); write(topline);
  57.       for i := 0 to maxline do begin
  58.         text [ i ] := '';
  59.         gotoxy(lside,frametop + i); write( #179 );
  60.         gotoxy(rside,frametop + i); write( #179 );
  61.         end;
  62.         text [ i ] := '';
  63.     gotoxy(lside,framebot); write(botline);
  64.     gotoxy(1,2); write( 'TurboText - Version 2.0' );
  65.     gotoxy(5,4); write( 'Col:    Line:    Char: ' );
  66.     update;
  67.     write(^g);
  68. end;
  69.  
  70. procedure check_eol;
  71.  
  72. begin
  73.   if ( pos(#174,line) = 0 ) and ( length(line) < rmargin ) then
  74.     line := line + #174;
  75. end;
  76.  
  77. procedure move_cursor;
  78.  
  79. begin
  80.   check_eol;
  81.   text [ indx ] := line;
  82.     if moveup then begin
  83.       indx := indx - 1;
  84.       row := row - 1; update;
  85.       moveup := false;
  86.       end
  87.     else begin
  88.       indx := indx + 1;
  89.       row := row + 1; update;
  90.       movedn := false;
  91.       end;
  92.     line := text [ indx ];
  93.     col := lmargin; tseg := 1; update;
  94.       if length(line) = 0 then lastcol := lmargin
  95.     else
  96.       lastcol := length(line) + 1;
  97. end;
  98.  
  99. procedure editor;
  100.  
  101. begin
  102.   read(kbd,ch); key := ord(ch);
  103.   case key of
  104. 72 : begin { cursor up }
  105.        if row = frametop then begin
  106.          bad_entry;
  107.          exit;
  108.          end;
  109.        moveup := true;
  110.        move_cursor;
  111.        exit;
  112.      end;
  113. 75 : begin { cursor left }
  114.        if col = lmargin then begin
  115.          bad_entry;
  116.          exit;
  117.          end;
  118.        edit := true;
  119.        tseg := tseg - 1;
  120.        lastcol := lmargin + length(line);
  121.        col := col - 1; update;
  122.        exit;
  123.      end;
  124. 77 : begin { cursor right }
  125.        if col = lastcol then begin
  126.          edit := false;
  127.          bad_entry;
  128.          exit;
  129.          end;
  130.        edit := true;
  131.        tseg := tseg + 1;
  132.        col := col + 1; update;
  133.        exit;
  134.      end;
  135. 80 : begin { cursor down }
  136.        if ( row - frametop ) = ( maxline - 1 ) then begin
  137.          bad_entry;
  138.          exit;
  139.          end;
  140.        movedn := true;
  141.        move_cursor;
  142.        exit;
  143.      end;
  144. 83 : begin { delete }
  145.        if col = lastcol then begin
  146.          edit := false;
  147.          bad_entry;
  148.          exit;
  149.          end;
  150.        edit := true;
  151.        delete(line,tseg,1); chars := chars - 1;
  152.        update;
  153.        gotoxy(col,row); write(copy(line,tseg,length(line)),' ');
  154.        lastcol := lastcol - 1;
  155.        exit;
  156.      end;
  157.      else begin
  158.        bad_entry;
  159.        exit;
  160.        end;
  161.   end { of case }
  162. end;  { of procedure }
  163.  
  164. procedure enter_text;
  165.  
  166. label                              jump;
  167.  
  168. begin
  169.   repeat
  170.     repeat
  171.       gotoxy(col,row); read(kbd,ch); key := ord(ch);
  172.         if key = 27 then editor
  173.       else
  174.         if key = 13 then begin
  175.           write(#174);
  176.           goto jump;
  177.           end
  178.       else
  179.         if ( key < keylo ) or ( key > keyhi ) then bad_entry
  180.       else
  181.         begin
  182.           write(ch); insert(ch,line,tseg);
  183.           chars := chars + 1;
  184.           tseg := tseg + 1; col := col + 1;
  185.             if not edit then lastcol := col;
  186.             if edit then begin
  187.               delete(line,tseg,1);
  188.               chars := chars - 1;
  189.               end;
  190.             if edit and ( col = lastcol ) then edit := false;
  191.           update;
  192.         end
  193.     until length(line) = rmargin + 1;
  194.   begin
  195.     if ch = #32 then begin
  196.       line := copy(line,1,length(line) - 1);
  197.       goto jump;
  198.       end
  199.   else
  200.       len := length(line);
  201.       repeat
  202.         ch := copy(line,len,1);
  203.           insert(ch,wrap,1);
  204.           delete(line,len,1);
  205.           seg := seg + 1; len := len - 1;
  206.       until ( ch = #32 ) or ( len = 0 );
  207.         if len = 0 then begin
  208.           seg := length(wrap);
  209.           wrap := copy(wrap,1,seg - 1);
  210.           line := #174;
  211.           end
  212.         else begin
  213.           seg := seg - 1;
  214.           wrap := copy(wrap,2,seg);
  215.           end;
  216.         gotoxy(col - seg,row); write(copy(blankline,1,seg));
  217.         gotoxy(lmargin,row + 1); write(wrap);
  218.           if len = 0 then seg := 0;
  219.   end;
  220. jump:
  221.     begin
  222.       check_eol;
  223.       text [ indx ] := line; indx := indx + 1;
  224.         if length(wrap) <> 0 then begin
  225.           line := wrap; wrap := '';
  226.         end
  227.       else
  228.         begin
  229.           line := '';
  230.         end;
  231.       row := row + 1;
  232.       col := lmargin + seg; lastcol := col;
  233.       tseg := 1 + seg; seg := 0;
  234.       update;
  235.     end;
  236.   until indx > maxline;
  237. end;
  238.  
  239. begin
  240. start:
  241.   clrscr;
  242.   gotoxy( 1,2 ); write( 'TurboText - Text Handling Routines' );
  243.   gotoxy( 1,3 ); write( 'Enter left  margin ( 2 - 77 ) [  ]' );
  244.   gotoxy( 1,4 ); write( 'Enter text columns ( 2 - 77 ) [  ]' );
  245.   gotoxy( 1,5 ); write( 'Enter number of text lines ( 2 - 18 ) [  ]' );
  246.   col := 32; row := 3; lastcol := col + 1; value := '';
  247. getval:
  248.     repeat
  249.       gotoxy(col,row); read(kbd,ch); key := ord(ch);
  250.       write(ch);
  251.         if key = 27 then exit;
  252.         if ( key = 13 ) and ( length( value ) = 0 ) then bad_entry;
  253.         if key = 13 then goto chkval;
  254.         if ( key < 48 ) or ( key > 57 ) then bad_entry;
  255.       value := value + ch; col := col + 1;
  256.     until col = lastcol + 1;
  257. chkval:
  258.     begin
  259.       if row = 3 then begin
  260.         val(value,lmargin,code);
  261.         if ( lmargin < 2 ) or ( lmargin > 77 ) then goto start;
  262.           col := 32; row := 4; value := '';
  263.           goto getval;
  264.           end;
  265.       if row = 4 then begin
  266.         val(value,totcol,code);
  267.         if ( totcol < 2 ) or ( totcol > 77 ) then goto start;
  268.         if lmargin + totcol > 78 then goto start;
  269.           col := 40; row := 5; lastcol := 41; value := '';
  270.           goto getval;
  271.           end;
  272.       if row = 5 then begin
  273.         val(value,maxline,code);
  274.         if ( maxline < 2 ) or ( maxline > 18 ) then goto start;
  275.         end;
  276.     end;
  277.       rmargin := totcol - 1; framebot := frametop + maxline;
  278.       lside := lmargin - 1; rside := lmargin + totcol;
  279.       col := lmargin; row := frametop; chars := 0;
  280.       topline := ''; botline := ''; midline := '';
  281.     make_frame;
  282.       indx := 1; line := ''; wrap := ''; tseg := 1;
  283.       lastcol := col; seg := 0;
  284.       edit := false; moveup := false; movedn := false;
  285.     enter_text;
  286.       gotoxy(1,16);
  287.       for i := 1 to indx - 1 do
  288.         writeln(text [ i ]);
  289. end.