home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / ANSIEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-01  |  21KB  |  1,111 lines

  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. {$ifdef testansieditor}
  5. {*}
  6. {*} {*} indicates test code
  7. {*}
  8. {*}uses crt,modem;
  9. {*}
  10. {*}const maxmessagesize=100;
  11. {*}      hungupon=false;
  12. {*}
  13. {*}type anystr=string[255];
  14. {*}     lstr=string[80];
  15. {*}     mstr=string[30];
  16. {*}     sstr=string[15];
  17. {*}
  18. {*}     message=record
  19. {*}       text:array [1..maxmessagesize] of lstr;
  20. {*}       title:mstr;
  21. {*}       anon:boolean;
  22. {*}       numlines:integer
  23. {*}     end;
  24. {*}
  25. {*}     regs=record
  26. {*}       case byte of
  27. {*}         0:(ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
  28. {*}         1:(al,ah,bl,bh,cl,ch,dl,dh:byte)
  29. {*}     end;
  30. {*}
  31. {*}type configtype=(moreprompts,eightycols,ansigraphics);
  32. {*}
  33. {*}var input:anystr;
  34. {*}    nobreak:boolean;
  35. {*}    urec:record
  36. {*}      displaylen:integer;
  37. {*}      config:set of configtype
  38. {*}    end;
  39. {*}    winds:array [0..0] of record y2:integer end;
  40. {*}
  41. {*}
  42. {*}function strr (n:integer):mstr;
  43. {*}var q:mstr;
  44. {*}begin
  45. {*}  str (n,q);
  46. {*}  strr:=q
  47. {*}end;
  48. {*}
  49. {*}function waitforchar:char;
  50. {*}var k:char;
  51. {*}begin
  52. {*}  repeat until keypressed or (numchars>0);
  53. {*}  read (kbd,k);
  54. {*}  waitforchar:=k
  55. {*}end;
  56. {*}
  57. {*}procedure clearbreak;
  58. {*}begin
  59. {*}end;
  60. {*}
  61. {*}function yes:boolean;
  62. {*}begin
  63. {*}  yes:=false;
  64. {*}  if length(input)>0
  65. {*}    then if upcase(input[1])='Y'
  66. {*}      then yes:=true
  67. {*}end;
  68. {*}
  69. {*}function readchar:char;
  70. {*}var r:regs;
  71. {*}begin
  72. {*}  if keypressed then begin
  73. {*}    r.ah:=0;
  74. {*}    intr ($16,r);
  75. {*}    readchar:=chr(r.al);
  76. {*}    if r.al=29 then halt;
  77. {*}    if r.al=0 then case r.ah of
  78. {*}      72:readchar:=^E;
  79. {*}      75:readchar:=^S;
  80. {*}      77:readchar:=^D;
  81. {*}      80:readchar:=^X;
  82. {*}      115:readchar:=^A;
  83. {*}      116:readchar:=^F;
  84. {*}      73:readchar:=^R;
  85. {*}      81:readchar:=^C;
  86. {*}      71:readchar:=^Q;
  87. {*}      79:readchar:=^W;
  88. {*}      83:readchar:=^G;
  89. {*}      82:readchar:=^V;
  90. {*}      117:readchar:=^P;
  91. {*}    end;
  92. {*}    exit
  93. {*}  end;
  94. {*}  if (numchars>0) and carrier
  95. {*}    then readchar:=getchar
  96. {*}    else readchar:=#0
  97. {*}end;
  98. {*}
  99. {*}procedure writeturbo (k:char);
  100. {*}begin
  101. {*}  inline ($8A/$86/k/$50/$ff/$16/usroutptr)
  102. {*}end;
  103. {*}
  104. {*}procedure writechar (k:char);
  105. {*}var r:regs;
  106. {*}begin
  107. {*}  if k=^J then writeturbo (k) else begin
  108. {*}    r.dl:=ord(k);
  109. {*}    r.ah:=2;
  110. {*}    intr ($21,r)
  111. {*}  end;
  112. {*}  if carrier then sendchar (k)
  113. {*}end;
  114. {*}
  115. {*}procedure getstr;
  116. {*}begin
  117. {*}  readln (input)
  118. {*}end;
  119. {*}
  120. {*}procedure printfile (l:lstr);
  121. {*}begin
  122. {*}end;
  123. {*}
  124. {*}procedure wholescreen;
  125. {*}begin
  126. {*}  window (1,1,80,winds[0].y2)
  127. {*}end;
  128. {*}
  129. {*}procedure bottom;
  130. {*}begin
  131. {*}end;
  132. {*}
  133. {*}procedure bottomline;
  134. {*}begin
  135. {*}end;
  136. {*}
  137. {*}procedure unsplit;
  138. {*}begin
  139. {*}end;
  140. {*}
  141. {*}function ansireedit (var m:message; gettitle:boolean):boolean;
  142. {*}
  143. {$else}
  144.  
  145. unit ansiedit;
  146.  
  147. interface
  148.  
  149. uses crt,
  150.      gentypes,modem,configrt,windows,gensubs,subs1,subs2;
  151.  
  152. function ansireedit (var m:message; gettitle:boolean):boolean;
  153.  
  154. implementation
  155.  
  156. function ansireedit (var m:message; gettitle:boolean):boolean;
  157.  
  158. {$endif}
  159.  
  160. var topline,curline,cx,cy,cols,scrnsize,lines,
  161.     rightmargin,savedx,savedy,topscrn:integer;
  162.     insertmode,msgdone,ansimode:boolean;
  163.  
  164. function curx:integer;
  165. begin
  166.   curx:=wherex
  167. end;
  168.  
  169. function cury:integer;
  170. begin
  171.   cury:=wherey-topscrn+1
  172. end;
  173.  
  174. procedure writevt52 (q:lstr);
  175. var cnt:integer;
  176. begin
  177.   if not carrier then exit;
  178.   for cnt:=1 to length(q) do sendchar (q[cnt])
  179. end;
  180.  
  181. procedure moveto (x,y:integer);
  182. begin
  183.   y:=y+topscrn-1;
  184.   if ansimode then begin
  185.     write (direct,#27'[');
  186.     if y<>1 then write (direct,strr(y));
  187.     if x<>1 then write (direct,';',strr(x));
  188.     write ('H')
  189.   end else begin
  190.     gotoxy (x,y);
  191.     writevt52 (#27'Y'+chr(y+31)+chr(x+31))
  192.   end
  193. end;
  194.  
  195. procedure clearscr;
  196. begin
  197.   if ansimode
  198.     then write (direct,#27'[2J')
  199.     else begin
  200.       writevt52 (#27'H'#27'J');
  201.       clrscr
  202.     end
  203. end;
  204.  
  205. procedure cleareol;
  206. begin
  207.   if ansimode
  208.     then write (direct,#27'[K')
  209.     else begin
  210.       writevt52 (#27'K');
  211.       clreol
  212.     end
  213. end;
  214.  
  215. procedure savecsr;
  216. begin
  217.   if ansimode
  218.     then write (direct,#27'[s')
  219.     else begin
  220.       savedx:=curx;
  221.       savedy:=cury
  222.     end
  223. end;
  224.  
  225. procedure restorecsr;
  226. begin
  227.   if ansimode
  228.     then write (direct,#27'[u')
  229.     else moveto (savedx,savedy)
  230. end;
  231.  
  232. procedure cmove (k:char; n,dx,dy:integer);
  233. var cnt:integer;
  234. begin
  235.   if n<1 then exit;
  236.   if ansimode then begin
  237.     write (direct,#27'[');
  238.     if n<>1 then write (direct,strr(n));
  239.     write (direct,k)
  240.   end else
  241.     for cnt:=1 to n do begin
  242.       writevt52 (#27+k);
  243.       gotoxy (wherex+dx,wherey+dy)
  244.     end
  245. end;
  246.  
  247. procedure cup (n:integer);
  248. begin
  249.   cmove ('A',n,0,-1)
  250. end;
  251.  
  252. procedure cdn (n:integer);
  253. begin
  254.   cmove ('B',n,0,1)
  255. end;
  256.  
  257. procedure clf (n:integer);
  258. var cnt:integer;
  259. begin
  260.   cmove ('D',n,-1,0)
  261. end;
  262.  
  263. procedure crg (n:integer);
  264. begin
  265.   cmove ('C',n,1,0)
  266. end;
  267.  
  268. procedure checkspaces;
  269. var q:^lstr;
  270. begin
  271.   q:=addr(m.text[curline]);
  272.   while q^[length(q^)]=' ' do q^[0]:=pred(q^[0])
  273. end;
  274.  
  275. procedure checkcx;
  276. var n:integer;
  277. begin
  278.   n:=length(m.text[curline])+1;
  279.   if cx>n then cx:=n
  280. end;
  281.  
  282. procedure computecy;
  283. begin
  284.   cy:=curline-topline+1
  285. end;
  286.  
  287. procedure updatecpos;
  288. begin
  289.   computecy;
  290.   moveto (cx,cy)
  291. end;
  292.  
  293. procedure insertabove;
  294. var cnt:integer;
  295. begin
  296.   if m.numlines=maxmessagesize then exit;
  297.   for cnt:=m.numlines downto curline do m.text[cnt+1]:=m.text[cnt];
  298.   m.text[curline]:='';
  299.   m.numlines:=m.numlines+1
  300. end;
  301.  
  302. procedure deletethis;
  303. var cnt:integer;
  304. begin
  305.   if m.numlines=1 then begin
  306.     m.text[1]:='';
  307.     exit
  308.   end;
  309.   for cnt:=curline+1 to m.numlines do m.text[cnt-1]:=m.text[cnt];
  310.   m.text[m.numlines]:='';
  311.   m.numlines:=m.numlines-1;
  312.   checkcx
  313. end;
  314.  
  315. procedure fullrefresh;
  316. var cnt,n,foxx:integer;
  317. begin
  318.   clearscr;
  319.   if topline<1 then topline:=1;
  320.   computecy;
  321.   writeln (^R'['^S'TCS '+ver+' '^R'Full-Screen Message Editor] [Press '^S'^U'^R' for '^S'Help'^R']');
  322.   write (^R'[Subject: '^S+m.title+^R'] [To: '^S);
  323.   if length(sendstr)>0 then write (sendstr) else write (m.leftto);
  324.   write (^R']');
  325.   if m.anon then write (^R' ['^S'Anonymous'^R']');
  326.   writeln ('');
  327.   writeln ('');
  328.   ansicolor (urec.statcolor);
  329.   for foxx:=1 to cols do begin
  330.    if (asciigraphics in urec.config) then
  331.     write ('─')
  332.    else
  333.     write ('-');
  334.   end;
  335.   moveto (1,1);
  336.   ansicolor (urec.regularcolor);
  337.   for cnt:=1 to lines do begin
  338.     n:=cnt+topline-1;
  339.     if n<=m.numlines then begin
  340.       write (m.text[n]);
  341.       if cnt<>lines then writeln
  342.     end
  343.   end;
  344.   updatecpos
  345. end;
  346.  
  347. procedure repos (dorefresh:boolean);
  348. var cl,tl:integer;
  349. begin
  350.   checkspaces;
  351.   cl:=curline;
  352.   tl:=topline;
  353.   if curline<1 then curline:=1;
  354.   if curline>m.numlines then curline:=m.numlines;
  355.   if topline>curline then topline:=curline;
  356.   if topline+lines<curline then topline:=curline-lines;
  357.   if topline<1 then topline:=1;
  358.   checkcx;
  359.   computecy;
  360.   if (cl=curline) and (tl=topline) and (not dorefresh)
  361.     then updatecpos
  362.     else fullrefresh
  363. end;
  364.  
  365. procedure partrefresh;  { Refreshes from CY }
  366. var cnt,n:integer;
  367. begin
  368.   if topline<1 then repos(true) else begin
  369.     moveto (1,cy);
  370.     for cnt:=cy to lines do begin
  371.       n:=cnt+topline-1;
  372.       if n<=m.numlines then write (m.text[n]);
  373.       cleareol;
  374.       if cnt<>lines then writeln
  375.     end;
  376.     updatecpos
  377.   end
  378. end;
  379.  
  380. procedure pageup;
  381. begin
  382.   checkspaces;
  383.   if curline=1 then exit;
  384.   curline:=curline-lines+4;
  385.   topline:=topline-lines+4;
  386.   repos (true)
  387. end;
  388.  
  389. procedure pagedn;
  390. begin
  391.   checkspaces;
  392.   if curline=m.numlines then exit;
  393.   curline:=curline+lines-4;
  394.   topline:=topline+lines-4;
  395.   repos (true)
  396. end;
  397.  
  398. procedure toggleins;
  399. begin
  400.   insertmode:=not insertmode
  401. end;
  402.  
  403. procedure scrolldown;
  404. begin
  405.   topline:=curline-lines+2;
  406.   repos (true)
  407. end;
  408.  
  409. procedure scrollup;
  410. begin
  411.   if topline<1 then begin
  412.     topline:=topline+1;
  413.     moveto (1,lines);
  414.     computecy;
  415.     writeln
  416.   end else begin
  417.     topline:=curline-1;
  418.     repos (true)
  419.   end
  420. end;
  421.  
  422. procedure topofmsg;
  423. begin
  424.   checkspaces;
  425.   cx:=1;
  426.   cy:=1;
  427.   curline:=1;
  428.   if topline=1
  429.     then updatecpos
  430.     else
  431.       begin
  432.         topline:=1;
  433.         fullrefresh
  434.       end
  435. end;
  436.  
  437. procedure updatetoeol;
  438. var cnt:integer;
  439. begin
  440.   savecsr;
  441.   write (copy(m.text[curline],cx,255));
  442.   cleareol;
  443.   restorecsr
  444. end;
  445.  
  446. procedure letterkey (k:char);
  447. var l:^lstr;
  448.     w:lstr;
  449.     n,ox:integer;
  450.     q:char;
  451.     inserted,refr:boolean;
  452.  
  453.   procedure scrollwwrap;
  454.   begin
  455.     if topline>0 then begin
  456.       scrollup;
  457.       exit
  458.     end;
  459.     cy:=cy-1;
  460.     moveto (length(m.text[curline-1])+1,cy);
  461.     cleareol;
  462.     writeln;
  463.     write (m.text[curline]);
  464.     topline:=topline+1;
  465.     cx:=curx
  466.   end;
  467.  
  468. begin
  469.   l:=addr(m.text[curline]);
  470.   if length(l^)>=rightmargin then begin
  471.     if curline=maxmessagesize then exit;
  472.     if cx<=length(l^) then exit;
  473.     l^:=l^+k;
  474.     w:='';
  475.     cx:=length(l^);
  476.     repeat
  477.       q:=l^[cx];
  478.       if q<>' ' then insert (q,w,1);
  479.       cx:=cx-1
  480.     until (q=' ') or (cx<1);
  481.     if cx<1 then begin
  482.       cx:=length(l^)-1;
  483.       w:=k
  484.     end;
  485.     l^[0]:=chr(cx);
  486.     checkspaces;
  487.     curline:=curline+1;
  488.     if curline>m.numlines then m.numlines:=curline;
  489.     inserted:=m.text[curline]<>'';
  490.     if inserted then insertabove;
  491.     m.text[curline]:=w;
  492.     cy:=cy+1;
  493.     ox:=cx;
  494.     cx:=length(w)+1;
  495.     refr:=cy>lines;
  496.     if refr
  497.       then scrollwwrap
  498.       else begin
  499.         if length(w)>0 then begin
  500.           moveto (ox+1,cy-1);
  501.           for n:=1 to length(w) do write (' ')
  502.         end;
  503.         if inserted and (m.numlines>curline)
  504.           then partrefresh
  505.           else begin
  506.             moveto (1,cy);
  507.             write (m.text[curline]);
  508.           end
  509.       end;
  510.     exit
  511.   end;
  512.   if insertmode
  513.     then insert (k,l^,cx)
  514.     else begin
  515.       while length(l^)<cx do l^:=l^+' ';
  516.       l^[cx]:=k
  517.     end;
  518.   if k=#27 then write (direct,k) else write (k);
  519.   cx:=cx+1;
  520.   if insertmode and (cx<=length(l^)) then updatetoeol
  521. end;
  522.  
  523. procedure back;
  524. begin
  525.   if cx=1 then begin
  526.     if curline=1 then exit;
  527.     checkspaces;
  528.     curline:=curline-1;
  529.     cy:=cy-1;
  530.     cx:=length(m.text[curline])+1;
  531.     if cy<1 then scrolldown else updatecpos;
  532.   end else begin
  533.     cx:=cx-1;
  534.     clf (1)
  535.   end
  536. end;
  537.  
  538. procedure fowrd;
  539. begin
  540.   if cx>length(m.text[curline]) then begin
  541.     if curline=maxmessagesize then exit;
  542.     checkspaces;
  543.     curline:=curline+1;
  544.     if curline>m.numlines then m.numlines:=curline;
  545.     cy:=cy+1;
  546.     cx:=1;
  547.     if cy>lines then scrollup else updatecpos
  548.   end else begin
  549.     cx:=cx+1;
  550.     crg (1)
  551.   end
  552. end;
  553.  
  554. procedure del;
  555. begin
  556.   if length(m.text[curline])=0 then begin
  557.     deletethis;
  558.     partrefresh;
  559.     exit
  560.   end;
  561.   delete (m.text[curline],cx,1);
  562.   if cx>length(m.text[curline])
  563.     then write (' '^H)
  564.     else updatetoeol
  565. end;
  566.  
  567. procedure bkspace;
  568. begin
  569.   if length(m.text[curline])=0 then begin
  570.     if curline=1 then exit;
  571.     deletethis;
  572.     checkspaces;
  573.     curline:=curline-1;
  574.     cy:=cy-1;
  575.     cx:=length(m.text[curline])+1;
  576.     if cy<1
  577.       then scrolldown
  578.       else partrefresh;
  579.     exit
  580.   end;
  581.   if cx=1 then exit;
  582.   cx:=cx-1;
  583.   write (^H);
  584.   del
  585. end;
  586.  
  587. procedure beginline;
  588. begin
  589.   if cx=1 then exit;
  590.   cx:=1;
  591.   updatecpos
  592. end;
  593.  
  594. procedure endline;
  595. var dx:integer;
  596. begin
  597.   dx:=length(m.text[curline])+1;
  598.   if cx=dx then exit;
  599.   cx:=dx;
  600.   updatecpos
  601. end;
  602.  
  603. procedure upline;
  604. var chx:boolean;
  605.     l:integer;
  606. begin
  607.   checkspaces;
  608.   if curline=1 then exit;
  609.   curline:=curline-1;
  610.   l:=length(m.text[curline]);
  611.   chx:=cx>l;
  612.   if chx then cx:=l+1;
  613.   cy:=cy-1;
  614.   if cy>0
  615.     then if chx
  616.       then updatecpos
  617.       else cup (1)
  618.     else scrolldown
  619. end;
  620.  
  621. procedure downline;
  622. var chx:boolean;
  623.     l:integer;
  624. begin
  625.   checkspaces;
  626.   if curline=maxmessagesize then exit;
  627.   curline:=curline+1;
  628.   if curline>m.numlines then m.numlines:=curline;
  629.   l:=length(m.text[curline]);
  630.   chx:=cx>l;
  631.   if chx then cx:=l+1;
  632.   cy:=cy+1;
  633.   if cy<=lines
  634.     then if chx
  635.       then updatecpos
  636.       else cdn (1)
  637.     else scrollup
  638. end;
  639.  
  640. procedure crlf;
  641. var k:char;
  642. begin
  643.   if (length(m.text[curline])=2) and (m.text[curline][1]='/') then begin
  644.     k:=upcase(m.text[curline][2]);
  645.     case k of
  646.       'S':begin
  647.         deletethis;
  648.         msgdone:=true;
  649.         ansireedit:=true;
  650.         exit
  651.       end
  652.     end
  653.   end;
  654.   beginline;
  655.   downline
  656. end;
  657.  
  658. function conword:boolean;
  659. var l:^lstr;
  660. begin
  661.   l:=addr(m.text[curline]);
  662.   conword:=false;
  663.   if (cx>length(l^)) or (cx=0) then exit;
  664.   conword:=true;
  665.   if cx=1 then exit;
  666.   if (l^[cx-1]=' ') and (l^[cx]<>' ') then exit;
  667.   conword:=false
  668. end;
  669.  
  670. procedure wordleft;
  671. begin
  672.   repeat
  673.     cx:=cx-1;
  674.     if cx<1 then begin
  675.       if curline=1 then begin
  676.         cx:=1;
  677.         repos (false);
  678.         exit
  679.       end;
  680.       checkspaces;
  681.       curline:=curline-1;
  682.       cy:=cy-1;
  683.       cx:=length(m.text[curline])
  684.     end;
  685.   until conword;
  686.   if cx=0 then cx:=1;
  687.   if cy<1
  688.     then repos (true)
  689.     else updatecpos
  690. end;
  691.  
  692. procedure wordright;
  693. begin
  694.   repeat
  695.     cx:=cx+1;
  696.     if cx>length(m.text[curline]) then begin
  697.       if curline=m.numlines then begin
  698.         repos (false);
  699.         exit
  700.       end;
  701.       checkspaces;
  702.       curline:=curline+1;
  703.       cy:=cy+1;
  704.       cx:=1
  705.     end;
  706.   until conword;
  707.   if cy>lines
  708.     then repos (true)
  709.     else updatecpos
  710. end;
  711.  
  712. procedure worddel;
  713. var l:^lstr;
  714.     b:byte;
  715.     s,n:integer;
  716. begin
  717.   l:=addr(m.text[curline]);
  718.   b:=length(l^);
  719.   if cx>b then exit;
  720.   s:=cx;
  721.   repeat
  722.     cx:=cx+1
  723.   until conword or (cx>b);
  724.   n:=cx-s;
  725.   delete (l^,s,n);
  726.   cx:=s;
  727.   updatetoeol
  728. end;
  729.  
  730. procedure deleteline;
  731. begin
  732.   deletethis;
  733.   partrefresh
  734. end;
  735.  
  736. procedure insertline;
  737. begin
  738.   if m.numlines>=maxmessagesize then exit;
  739.   insertabove;
  740.   checkcx;
  741.   partrefresh
  742. end;
  743.  
  744. procedure help;
  745. var k:char;
  746. begin
  747.   clearscr;
  748.   printfile (textfiledir+'Edithelp.Ans');
  749.   write (^B^M'Press a key to continue.');
  750.   k:=waitforchar;
  751.   fullrefresh
  752. end;
  753.  
  754. procedure breakline;
  755. begin
  756.   if (m.numlines>=maxmessagesize) or (cy=lines) or
  757.     (cx=1) or (cx>length(m.text[curline])) then exit;
  758.   insertabove;
  759.   m.text[curline]:=copy(m.text[curline+1],1,cx-1);
  760.   delete (m.text[curline+1],1,cx-1);
  761.   partrefresh
  762. end;
  763.  
  764. procedure joinlines;
  765. var n:integer;
  766. begin
  767.   if curline=m.numlines then exit;
  768.   if length(m.text[curline])+length(m.text[curline+1])>rightmargin then exit;
  769.   m.text[curline]:=m.text[curline]+m.text[curline+1];
  770.   n:=cx;
  771.   curline:=curline+1;
  772.   deletethis;
  773.   curline:=curline-1;
  774.   cx:=n;
  775.   partrefresh
  776. end;
  777.  
  778. procedure centerline;
  779. var spaces:lstr;
  780. begin
  781. { fillchar (spaces[1],80,32); }
  782. { delete(input,1,1);
  783.   while (length(input)>0) and (input[1]=' ') do delete (input,1,1);
  784.   if length(input)=0 then exit;
  785.   spaces[0]:=chr((cols-length(input)) div 2);
  786.   input:=spaces+input;
  787.   insertline; }
  788. end;
  789.  
  790. procedure userescape;
  791. var k:char;
  792. begin
  793.   {
  794.   repeat
  795.   k:=waitforchar;
  796.     case k of
  797.       'A':upline;
  798.       'B':downline;
  799.       'C':fowrd;
  800.       'D':back
  801.     end
  802.   until (k<>'[') or hungupon
  803.   }
  804. end;
  805.  
  806. procedure deleteeol;
  807. begin
  808.   cleareol;
  809.   m.text[curline][0]:=chr(cx-1)
  810. end;
  811.  
  812. procedure tab;
  813. var nx,n,cnt:integer;
  814. begin
  815.   nx:=((cx+8) and 248)+1;
  816.   n:=nx-cx;
  817.   if (n+length(m.text[curline])>=cols) or (nx>=cols) then exit;
  818.   for cnt:=1 to n do insert (' ',m.text[curline],cx);
  819.   updatetoeol;
  820.   cx:=cx+n;
  821.   updatecpos
  822. end;
  823.  
  824. procedure commands;
  825.  
  826.   function youaresure:boolean;
  827.   var q:string[1];
  828.   begin
  829.     youaresure:=false;
  830.     moveto (0,-1);
  831.     write (^R'Abort [y/n]? '^U);
  832.     buflen:=1;
  833.     getstr (1);
  834.     cup (1);
  835.     write (^R'               ');
  836.     youaresure:=yes;
  837.     clearbreak;
  838.     nobreak:=true
  839.   end;
  840.  
  841.   procedure savemes;
  842.   begin
  843.     msgdone:=true;
  844.     ansireedit:=true
  845.   end;
  846.  
  847.   procedure abortmes;
  848.   begin
  849.     if youaresure then begin
  850.       m.numlines:=0;
  851.       msgdone:=true
  852.     end
  853.   end;
  854.  
  855.   procedure formattext;
  856.   var ol,il,c:integer;
  857.       oln,wd,iln:lstr;
  858.       k:char;
  859.  
  860.     procedure putword;
  861.     var cnt:integer;
  862.         b:boolean;
  863.     begin
  864.       b:=true;
  865.       for cnt:=1 to length(wd) do if wd[cnt]<>' ' then b:=false;
  866.       if b then exit;
  867.       while wd[length(wd)]=' ' do wd[0]:=pred(wd[0]);
  868.       if length(wd)=0 then exit;
  869.       if length(wd)+length(oln)>rightmargin then begin
  870.         m.text[ol]:=oln;
  871.         ol:=ol+1;
  872.         while (wd[1]=' ') and (length(wd)>0) do delete (wd,1,1);
  873.         oln:=wd
  874.       end else oln:=oln+wd;
  875.       if wd[length(wd)] in ['.','?','!']
  876.         then wd:='  '
  877.         else wd:=' '
  878.     end;
  879.  
  880.   begin
  881.     il:=curline;
  882.     ol:=il;
  883.     c:=1;
  884.     oln:='';
  885.     wd:='';
  886.     iln:=m.text[il];
  887.     repeat
  888.       if length(iln)=0 then begin
  889.         putword;
  890.         m.text[ol]:=oln;
  891.         partrefresh;
  892.         checkcx;
  893.         updatecpos;
  894.         exit
  895.       end;
  896.       if c>length(iln) then begin
  897.         il:=il+1;
  898.         if il>m.numlines
  899.           then iln:=''
  900.           else begin
  901.             iln:=m.text[il];
  902.             m.text[il]:=''
  903.           end;
  904.         c:=0;
  905.         k:=' '
  906.       end else k:=iln[c];
  907.       c:=c+1;
  908.       if k=' '
  909.         then putword
  910.         else wd:=wd+k
  911.     until 0=1
  912.   end;
  913.  
  914. var cmd:string[1];
  915.     k:char;
  916. begin
  917.   clearbreak;
  918.   nobreak:=true;
  919.   moveto (0,-1);
  920.   write (^R'Command: '^U);
  921.   buflen:=1;
  922.   getstr (1);
  923.   clearbreak;
  924.   nobreak:=true;
  925.   cup (1);
  926.   write (^R'          ');
  927.   if length(input)=0 then begin
  928.     updatecpos;
  929.     exit
  930.   end;
  931.   k:=upcase(input[1]);
  932.   case k of
  933.     'S':savemes;
  934.     'A':abortmes;
  935.     'F':formattext;
  936.     '?':help
  937.   end;
  938.   updatecpos
  939. end;
  940.  
  941. procedure macrocmds;
  942. var cmd:string[1];
  943.     k:char;
  944.     x,y,z:integer;
  945. begin
  946.   clearbreak;
  947.   nobreak:=true;
  948.   moveto (0,-1);
  949.   write ('Macro #[1-3]: ');
  950.   buflen:=1;
  951.   getstr (1);
  952.   clearbreak;
  953.   nobreak:=true;
  954.   cup (1);
  955.   write ('               ');
  956.   if length(input)=0 then begin
  957.     updatecpos;
  958.     exit
  959.   end;
  960.   k:=upcase(input[1]);
  961.   case k of
  962.     '1':begin
  963.          updatecpos;
  964.          for x := 1 to length (urec.macro1) do
  965.           letterkey (urec.macro1[x]);
  966.         end;
  967.     '2':begin
  968.          updatecpos;
  969.          for y := 1 to length (urec.macro2) do
  970.           letterkey (urec.macro2[y]);
  971.         end;
  972.     '3':begin
  973.          updatecpos;
  974.          for z := 1 to length (urec.macro3) do
  975.           letterkey (urec.macro3[z]);
  976.         end;
  977.   end
  978.  { updatecpos }
  979. end;
  980.  
  981. procedure extendedcmds;
  982. begin
  983.  
  984. end;
  985.  
  986. procedure processkey;
  987. var k:char;
  988. begin
  989.   clearbreak;
  990.   nobreak:=true;
  991.   k:=waitforchar;
  992.   case k of
  993.     ' '..'~',#27:letterkey (k);
  994.     ^S:back;
  995.     ^D:fowrd;
  996.     ^H:bkspace;
  997.     ^M:crlf;
  998.     ^V:toggleins;
  999.     ^E:upline;
  1000.     ^X:downline;
  1001.     ^U:help;
  1002.     ^K:commands;
  1003.     ^R:pageup;
  1004.     ^C:pagedn;
  1005.     ^G:del;
  1006.     ^A:wordleft;
  1007.     ^F:wordright;
  1008.     ^T:worddel;
  1009.     ^Q:beginline;
  1010.     ^W:endline;
  1011.     ^L:fullrefresh;
  1012.     ^Y:deleteline;
  1013.     ^N:insertline;
  1014.     ^I:tab;
  1015.     ^B:breakline;
  1016.     ^P:deleteeol;
  1017.     ^J:joinlines;
  1018.     ^Z:macrocmds;
  1019.     ^O:centerline;
  1020.   end
  1021. end;
  1022.  
  1023. var cnt:integer;
  1024.     mp:boolean;
  1025. begin
  1026.   clearbreak;
  1027.   nobreak:=true;
  1028.   ansireedit:=false;
  1029.   for cnt:=m.numlines+1 to maxmessagesize do m.text[cnt]:='';
  1030.   scrnsize:=urec.displaylen;
  1031.   winds[0].y2:=scrnsize;
  1032.   unsplit;
  1033.   wholescreen;
  1034.   gotoxy (1,25);
  1035.   clreol;
  1036.   if eightycols in urec.config
  1037.     then cols:=80
  1038.     else cols:=40;
  1039.   ansimode:=ansigraphics in urec.config;
  1040.   mp:=moreprompts in urec.config;
  1041.   if mp then urec.config:=urec.config-[moreprompts];
  1042.   lines:=scrnsize-4; {lines:=22;}
  1043.   topscrn:=scrnsize-lines+1;
  1044.   insertmode:=false;
  1045.   rightmargin:=cols-1;
  1046.   msgdone:=false;
  1047.   cx:=1;
  1048.   curline:=1;
  1049.   topline:=2-lines;
  1050.   computecy;
  1051.   updatecpos;
  1052.   if m.numlines>0
  1053.     then fullrefresh
  1054.     else
  1055.       begin
  1056.         clearscr;
  1057.         m.numlines:=1;
  1058.         fullrefresh;
  1059.       end;
  1060.   repeat
  1061.     processkey
  1062.   until msgdone or hungupon;
  1063.   moveto (1,lines);
  1064.   cleareol;
  1065.   writeln (^M^M^M^M);
  1066.   if mp then urec.config:=urec.config+[moreprompts];
  1067.   winds[0].y2:=25;
  1068.   bottom;
  1069.   bottomline
  1070. end;
  1071.  
  1072.  
  1073. {$ifdef testansieditor}
  1074. {*}
  1075. {*}procedure termmode;
  1076. {*}var k:char;
  1077. {*}begin
  1078. {*}  setparam (1,1200,false);
  1079. {*}  writeln ('Press ^D when connected.');
  1080. {*}  repeat
  1081. {*}    if keypressed then begin
  1082. {*}      read (kbd,k);
  1083. {*}      if k=#4 then exit;
  1084. {*}      if k=#3 then halt;
  1085. {*}      sendchar (k)
  1086. {*}    end;
  1087. {*}    while numchars>0 do write (getchar)
  1088. {*}  until 0=1
  1089. {*}end;
  1090. {*}
  1091. {*}var m:message;
  1092. {*}    cnt:integer;
  1093. {*}begin
  1094. {*}  checkbreak:=false;
  1095. {*}  urec.displaylen:=22;
  1096. {*}  urec.config:=[eightycols]; { ,ansigraphics]; }
  1097. {*}  if not driverpresent then begin
  1098. {*}    writeln ('You fool.');
  1099. {*}    halt
  1100. {*}  end;
  1101. {*}  termmode;
  1102. {*}  coninptr:=ofs(readchar);
  1103. {*}  conoutptr:=ofs(writechar);
  1104. {*}  m.numlines:=0;
  1105. {*}  for cnt:=1 to 100 do m.text[cnt]:='Hello line '+chr(cnt+64);
  1106. {*}  writeln (ansireedit(m,false))
  1107. {*}
  1108. {$endif}
  1109.  
  1110. end.
  1111.