home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / ANSIEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-06  |  21KB  |  1,099 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.   for cnt:=1 to lines do begin
  337.     n:=cnt+topline-1;
  338.     if n<=m.numlines then begin
  339.       write (m.text[n]);
  340.       if cnt<>lines then writeln
  341.     end
  342.   end;
  343.   updatecpos
  344. end;
  345.  
  346. procedure repos (dorefresh:boolean);
  347. var cl,tl:integer;
  348. begin
  349.   checkspaces;
  350.   cl:=curline;
  351.   tl:=topline;
  352.   if curline<1 then curline:=1;
  353.   if curline>m.numlines then curline:=m.numlines;
  354.   if topline>curline then topline:=curline;
  355.   if topline+lines<curline then topline:=curline-lines;
  356.   if topline<1 then topline:=1;
  357.   checkcx;
  358.   computecy;
  359.   if (cl=curline) and (tl=topline) and (not dorefresh)
  360.     then updatecpos
  361.     else fullrefresh
  362. end;
  363.  
  364. procedure partrefresh;  { Refreshes from CY }
  365. var cnt,n:integer;
  366. begin
  367.   if topline<1 then repos(true) else begin
  368.     moveto (1,cy);
  369.     for cnt:=cy to lines do begin
  370.       n:=cnt+topline-1;
  371.       if n<=m.numlines then write (m.text[n]);
  372.       cleareol;
  373.       if cnt<>lines then writeln
  374.     end;
  375.     updatecpos
  376.   end
  377. end;
  378.  
  379. procedure pageup;
  380. begin
  381.   checkspaces;
  382.   if curline=1 then exit;
  383.   curline:=curline-lines+4;
  384.   topline:=topline-lines+4;
  385.   repos (true)
  386. end;
  387.  
  388. procedure pagedn;
  389. begin
  390.   checkspaces;
  391.   if curline=m.numlines then exit;
  392.   curline:=curline+lines-4;
  393.   topline:=topline+lines-4;
  394.   repos (true)
  395. end;
  396.  
  397. procedure toggleins;
  398. begin
  399.   insertmode:=not insertmode
  400. end;
  401.  
  402. procedure scrolldown;
  403. begin
  404.   topline:=curline-lines+2;
  405.   repos (true)
  406. end;
  407.  
  408. procedure scrollup;
  409. begin
  410.   if topline<1 then begin
  411.     topline:=topline+1;
  412.     moveto (1,lines);
  413.     computecy;
  414.     writeln
  415.   end else begin
  416.     topline:=curline-1;
  417.     repos (true)
  418.   end
  419. end;
  420.  
  421. procedure topofmsg;
  422. begin
  423.   checkspaces;
  424.   cx:=1;
  425.   cy:=1;
  426.   curline:=1;
  427.   if topline=1
  428.     then updatecpos
  429.     else
  430.       begin
  431.         topline:=1;
  432.         fullrefresh
  433.       end
  434. end;
  435.  
  436. procedure updatetoeol;
  437. var cnt:integer;
  438. begin
  439.   savecsr;
  440.   write (copy(m.text[curline],cx,255));
  441.   cleareol;
  442.   restorecsr
  443. end;
  444.  
  445. procedure letterkey (k:char);
  446. var l:^lstr;
  447.     w:lstr;
  448.     n,ox:integer;
  449.     q:char;
  450.     inserted,refr:boolean;
  451.  
  452.   procedure scrollwwrap;
  453.   begin
  454.     if topline>0 then begin
  455.       scrollup;
  456.       exit
  457.     end;
  458.     cy:=cy-1;
  459.     moveto (length(m.text[curline-1])+1,cy);
  460.     cleareol;
  461.     writeln;
  462.     write (m.text[curline]);
  463.     topline:=topline+1;
  464.     cx:=curx
  465.   end;
  466.  
  467. begin
  468.   l:=addr(m.text[curline]);
  469.   if length(l^)>=rightmargin then begin
  470.     if curline=maxmessagesize then exit;
  471.     if cx<=length(l^) then exit;
  472.     l^:=l^+k;
  473.     w:='';
  474.     cx:=length(l^);
  475.     repeat
  476.       q:=l^[cx];
  477.       if q<>' ' then insert (q,w,1);
  478.       cx:=cx-1
  479.     until (q=' ') or (cx<1);
  480.     if cx<1 then begin
  481.       cx:=length(l^)-1;
  482.       w:=k
  483.     end;
  484.     l^[0]:=chr(cx);
  485.     checkspaces;
  486.     curline:=curline+1;
  487.     if curline>m.numlines then m.numlines:=curline;
  488.     inserted:=m.text[curline]<>'';
  489.     if inserted then insertabove;
  490.     m.text[curline]:=w;
  491.     cy:=cy+1;
  492.     ox:=cx;
  493.     cx:=length(w)+1;
  494.     refr:=cy>lines;
  495.     if refr
  496.       then scrollwwrap
  497.       else begin
  498.         if length(w)>0 then begin
  499.           moveto (ox+1,cy-1);
  500.           for n:=1 to length(w) do write (' ')
  501.         end;
  502.         if inserted and (m.numlines>curline)
  503.           then partrefresh
  504.           else begin
  505.             moveto (1,cy);
  506.             write (m.text[curline]);
  507.           end
  508.       end;
  509.     exit
  510.   end;
  511.   if insertmode
  512.     then insert (k,l^,cx)
  513.     else begin
  514.       while length(l^)<cx do l^:=l^+' ';
  515.       l^[cx]:=k
  516.     end;
  517.   write (k);
  518.   cx:=cx+1;
  519.   if insertmode and (cx<=length(l^)) then updatetoeol
  520. end;
  521.  
  522. procedure back;
  523. begin
  524.   if cx=1 then begin
  525.     if curline=1 then exit;
  526.     checkspaces;
  527.     curline:=curline-1;
  528.     cy:=cy-1;
  529.     cx:=length(m.text[curline])+1;
  530.     if cy<1 then scrolldown else updatecpos;
  531.   end else begin
  532.     cx:=cx-1;
  533.     clf (1)
  534.   end
  535. end;
  536.  
  537. procedure fowrd;
  538. begin
  539.   if cx>length(m.text[curline]) then begin
  540.     if curline=maxmessagesize then exit;
  541.     checkspaces;
  542.     curline:=curline+1;
  543.     if curline>m.numlines then m.numlines:=curline;
  544.     cy:=cy+1;
  545.     cx:=1;
  546.     if cy>lines then scrollup else updatecpos
  547.   end else begin
  548.     cx:=cx+1;
  549.     crg (1)
  550.   end
  551. end;
  552.  
  553. procedure del;
  554. begin
  555.   if length(m.text[curline])=0 then begin
  556.     deletethis;
  557.     partrefresh;
  558.     exit
  559.   end;
  560.   delete (m.text[curline],cx,1);
  561.   if cx>length(m.text[curline])
  562.     then write (' '^H)
  563.     else updatetoeol
  564. end;
  565.  
  566. procedure bkspace;
  567. begin
  568.   if length(m.text[curline])=0 then begin
  569.     if curline=1 then exit;
  570.     deletethis;
  571.     checkspaces;
  572.     curline:=curline-1;
  573.     cy:=cy-1;
  574.     cx:=length(m.text[curline])+1;
  575.     if cy<1
  576.       then scrolldown
  577.       else partrefresh;
  578.     exit
  579.   end;
  580.   if cx=1 then exit;
  581.   cx:=cx-1;
  582.   write (^H);
  583.   del
  584. end;
  585.  
  586. procedure beginline;
  587. begin
  588.   if cx=1 then exit;
  589.   cx:=1;
  590.   updatecpos
  591. end;
  592.  
  593. procedure endline;
  594. var dx:integer;
  595. begin
  596.   dx:=length(m.text[curline])+1;
  597.   if cx=dx then exit;
  598.   cx:=dx;
  599.   updatecpos
  600. end;
  601.  
  602. procedure upline;
  603. var chx:boolean;
  604.     l:integer;
  605. begin
  606.   checkspaces;
  607.   if curline=1 then exit;
  608.   curline:=curline-1;
  609.   l:=length(m.text[curline]);
  610.   chx:=cx>l;
  611.   if chx then cx:=l+1;
  612.   cy:=cy-1;
  613.   if cy>0
  614.     then if chx
  615.       then updatecpos
  616.       else cup (1)
  617.     else scrolldown
  618. end;
  619.  
  620. procedure downline;
  621. var chx:boolean;
  622.     l:integer;
  623. begin
  624.   checkspaces;
  625.   if curline=maxmessagesize then exit;
  626.   curline:=curline+1;
  627.   if curline>m.numlines then m.numlines:=curline;
  628.   l:=length(m.text[curline]);
  629.   chx:=cx>l;
  630.   if chx then cx:=l+1;
  631.   cy:=cy+1;
  632.   if cy<=lines
  633.     then if chx
  634.       then updatecpos
  635.       else cdn (1)
  636.     else scrollup
  637. end;
  638.  
  639. procedure crlf;
  640. var k:char;
  641. begin
  642.   if (length(m.text[curline])=2) and (m.text[curline][1]='/') then begin
  643.     k:=upcase(m.text[curline][2]);
  644.     case k of
  645.       'S':begin
  646.         deletethis;
  647.         msgdone:=true;
  648.         ansireedit:=true;
  649.         exit
  650.       end
  651.     end
  652.   end;
  653.   beginline;
  654.   downline
  655. end;
  656.  
  657. function conword:boolean;
  658. var l:^lstr;
  659. begin
  660.   l:=addr(m.text[curline]);
  661.   conword:=false;
  662.   if (cx>length(l^)) or (cx=0) then exit;
  663.   conword:=true;
  664.   if cx=1 then exit;
  665.   if (l^[cx-1]=' ') and (l^[cx]<>' ') then exit;
  666.   conword:=false
  667. end;
  668.  
  669. procedure wordleft;
  670. begin
  671.   repeat
  672.     cx:=cx-1;
  673.     if cx<1 then begin
  674.       if curline=1 then begin
  675.         cx:=1;
  676.         repos (false);
  677.         exit
  678.       end;
  679.       checkspaces;
  680.       curline:=curline-1;
  681.       cy:=cy-1;
  682.       cx:=length(m.text[curline])
  683.     end;
  684.   until conword;
  685.   if cx=0 then cx:=1;
  686.   if cy<1
  687.     then repos (true)
  688.     else updatecpos
  689. end;
  690.  
  691. procedure wordright;
  692. begin
  693.   repeat
  694.     cx:=cx+1;
  695.     if cx>length(m.text[curline]) then begin
  696.       if curline=m.numlines then begin
  697.         repos (false);
  698.         exit
  699.       end;
  700.       checkspaces;
  701.       curline:=curline+1;
  702.       cy:=cy+1;
  703.       cx:=1
  704.     end;
  705.   until conword;
  706.   if cy>lines
  707.     then repos (true)
  708.     else updatecpos
  709. end;
  710.  
  711. procedure worddel;
  712. var l:^lstr;
  713.     b:byte;
  714.     s,n:integer;
  715. begin
  716.   l:=addr(m.text[curline]);
  717.   b:=length(l^);
  718.   if cx>b then exit;
  719.   s:=cx;
  720.   repeat
  721.     cx:=cx+1
  722.   until conword or (cx>b);
  723.   n:=cx-s;
  724.   delete (l^,s,n);
  725.   cx:=s;
  726.   updatetoeol
  727. end;
  728.  
  729. procedure deleteline;
  730. begin
  731.   deletethis;
  732.   partrefresh
  733. end;
  734.  
  735. procedure insertline;
  736. begin
  737.   if m.numlines>=maxmessagesize then exit;
  738.   insertabove;
  739.   checkcx;
  740.   partrefresh
  741. end;
  742.  
  743. procedure help;
  744. var k:char;
  745. begin
  746.   clearscr;
  747.   printfile (textfiledir+'Edithelp.Ans');
  748.   write (^B^M'Press a key to continue.');
  749.   k:=waitforchar;
  750.   fullrefresh
  751. end;
  752.  
  753. procedure breakline;
  754. begin
  755.   if (m.numlines>=maxmessagesize) or (cy=lines) or
  756.     (cx=1) or (cx>length(m.text[curline])) then exit;
  757.   insertabove;
  758.   m.text[curline]:=copy(m.text[curline+1],1,cx-1);
  759.   delete (m.text[curline+1],1,cx-1);
  760.   partrefresh
  761. end;
  762.  
  763. procedure joinlines;
  764. var n:integer;
  765. begin
  766.   if curline=m.numlines then exit;
  767.   if length(m.text[curline])+length(m.text[curline+1])>rightmargin then exit;
  768.   m.text[curline]:=m.text[curline]+m.text[curline+1];
  769.   n:=cx;
  770.   curline:=curline+1;
  771.   deletethis;
  772.   curline:=curline-1;
  773.   cx:=n;
  774.   partrefresh
  775. end;
  776.  
  777. procedure userescape;
  778. var k:char;
  779. begin
  780.   {
  781.   repeat
  782.   k:=waitforchar;
  783.     case k of
  784.       'A':upline;
  785.       'B':downline;
  786.       'C':fowrd;
  787.       'D':back
  788.     end
  789.   until (k<>'[') or hungupon
  790.   }
  791. end;
  792.  
  793. procedure deleteeol;
  794. begin
  795.   cleareol;
  796.   m.text[curline][0]:=chr(cx-1)
  797. end;
  798.  
  799. procedure tab;
  800. var nx,n,cnt:integer;
  801. begin
  802.   nx:=((cx+8) and 248)+1;
  803.   n:=nx-cx;
  804.   if (n+length(m.text[curline])>=cols) or (nx>=cols) then exit;
  805.   for cnt:=1 to n do insert (' ',m.text[curline],cx);
  806.   updatetoeol;
  807.   cx:=cx+n;
  808.   updatecpos
  809. end;
  810.  
  811. procedure commands;
  812.  
  813.   function youaresure:boolean;
  814.   var q:string[1];
  815.   begin
  816.     youaresure:=false;
  817.     moveto (0,-1);
  818.     write (^R'Abort [y/n]? '^U);
  819.     buflen:=1;
  820.     getstr (1);
  821.     cup (1);
  822.     write (^R'               ');
  823.     youaresure:=yes;
  824.     clearbreak;
  825.     nobreak:=true
  826.   end;
  827.  
  828.   procedure savemes;
  829.   begin
  830.     msgdone:=true;
  831.     ansireedit:=true
  832.   end;
  833.  
  834.   procedure abortmes;
  835.   begin
  836.     if youaresure then begin
  837.       m.numlines:=0;
  838.       msgdone:=true
  839.     end
  840.   end;
  841.  
  842.   procedure formattext;
  843.   var ol,il,c:integer;
  844.       oln,wd,iln:lstr;
  845.       k:char;
  846.  
  847.     procedure putword;
  848.     var cnt:integer;
  849.         b:boolean;
  850.     begin
  851.       b:=true;
  852.       for cnt:=1 to length(wd) do if wd[cnt]<>' ' then b:=false;
  853.       if b then exit;
  854.       while wd[length(wd)]=' ' do wd[0]:=pred(wd[0]);
  855.       if length(wd)=0 then exit;
  856.       if length(wd)+length(oln)>rightmargin then begin
  857.         m.text[ol]:=oln;
  858.         ol:=ol+1;
  859.         while (wd[1]=' ') and (length(wd)>0) do delete (wd,1,1);
  860.         oln:=wd
  861.       end else oln:=oln+wd;
  862.       if wd[length(wd)] in ['.','?','!']
  863.         then wd:='  '
  864.         else wd:=' '
  865.     end;
  866.  
  867.   begin
  868.     il:=curline;
  869.     ol:=il;
  870.     c:=1;
  871.     oln:='';
  872.     wd:='';
  873.     iln:=m.text[il];
  874.     repeat
  875.       if length(iln)=0 then begin
  876.         putword;
  877.         m.text[ol]:=oln;
  878.         partrefresh;
  879.         checkcx;
  880.         updatecpos;
  881.         exit
  882.       end;
  883.       if c>length(iln) then begin
  884.         il:=il+1;
  885.         if il>m.numlines
  886.           then iln:=''
  887.           else begin
  888.             iln:=m.text[il];
  889.             m.text[il]:=''
  890.           end;
  891.         c:=0;
  892.         k:=' '
  893.       end else k:=iln[c];
  894.       c:=c+1;
  895.       if k=' '
  896.         then putword
  897.         else wd:=wd+k
  898.     until 0=1
  899.   end;
  900.  
  901. var cmd:string[1];
  902.     k:char;
  903. begin
  904.   clearbreak;
  905.   nobreak:=true;
  906.   moveto (0,-1);
  907.   write (^R'Command: '^U);
  908.   buflen:=1;
  909.   getstr (1);
  910.   clearbreak;
  911.   nobreak:=true;
  912.   cup (1);
  913.   write (^R'          ');
  914.   if length(input)=0 then begin
  915.     updatecpos;
  916.     exit
  917.   end;
  918.   k:=upcase(input[1]);
  919.   case k of
  920.     'S':savemes;
  921.     'A':abortmes;
  922.     'F':formattext;
  923.     '?':help
  924.   end;
  925.   updatecpos
  926. end;
  927.  
  928. procedure macrocmds;
  929. var cmd:string[1];
  930.     k:char;
  931.     x,y,z:integer;
  932. begin
  933.   clearbreak;
  934.   nobreak:=true;
  935.   moveto (0,-1);
  936.   write ('Macro #[1-3]: ');
  937.   buflen:=1;
  938.   getstr (1);
  939.   clearbreak;
  940.   nobreak:=true;
  941.   cup (1);
  942.   write ('               ');
  943.   if length(input)=0 then begin
  944.     updatecpos;
  945.     exit
  946.   end;
  947.   k:=upcase(input[1]);
  948.   case k of
  949.     '1':begin
  950.          updatecpos;
  951.          for x := 1 to length (urec.macro1) do
  952.           letterkey (urec.macro1[x]);
  953.         end;
  954.     '2':begin
  955.          updatecpos;
  956.          for y := 1 to length (urec.macro2) do
  957.           letterkey (urec.macro2[y]);
  958.         end;
  959.     '3':begin
  960.          updatecpos;
  961.          for z := 1 to length (urec.macro3) do
  962.           letterkey (urec.macro3[z]);
  963.         end;
  964.   end
  965.  { updatecpos }
  966. end;
  967.  
  968. procedure extendedcmds;
  969. begin
  970.  
  971. end;
  972.  
  973. procedure processkey;
  974. var k:char;
  975. begin
  976.   clearbreak;
  977.   nobreak:=true;
  978.   k:=waitforchar;
  979.   case k of
  980.     ' '..'~':letterkey (k);
  981.   { #127..#255:letterkey (k); }
  982.     ^S:back;
  983.     ^D:fowrd;
  984.     ^H:bkspace;
  985.     ^M:crlf;
  986.     ^V:toggleins;
  987.     ^E:upline;
  988.     ^X:downline;
  989.     ^U:help;
  990.     ^K:commands;
  991.     ^R:pageup;
  992.     ^C:pagedn;
  993.     ^G:del;
  994.     ^A:wordleft;
  995.     ^F:wordright;
  996.     ^T:worddel;
  997.     ^Q:beginline;
  998.     ^W:endline;
  999.     ^L:fullrefresh;
  1000.     ^Y:deleteline;
  1001.     ^N:insertline;
  1002.     ^I:tab;
  1003.     ^B:breakline;
  1004.     ^P:deleteeol;
  1005.     ^J:joinlines;
  1006.     ^Z:macrocmds;
  1007.     #27:letterkey (#27); {userescape}
  1008.   end
  1009. end;
  1010.  
  1011. var cnt:integer;
  1012.     mp:boolean;
  1013. begin
  1014.   clearbreak;
  1015.   nobreak:=true;
  1016.   ansireedit:=false;
  1017.   for cnt:=m.numlines+1 to maxmessagesize do m.text[cnt]:='';
  1018.   scrnsize:=urec.displaylen;
  1019.   winds[0].y2:=scrnsize;
  1020.   unsplit;
  1021.   wholescreen;
  1022.   gotoxy (1,25);
  1023.   clreol;
  1024.   if eightycols in urec.config
  1025.     then cols:=80
  1026.     else cols:=40;
  1027.   ansimode:=ansigraphics in urec.config;
  1028.   mp:=moreprompts in urec.config;
  1029.   if mp then urec.config:=urec.config-[moreprompts];
  1030.   lines:=scrnsize-4; {lines:=22;}
  1031.   topscrn:=scrnsize-lines+1;
  1032.   insertmode:=false;
  1033.   rightmargin:=cols-1;
  1034.   msgdone:=false;
  1035.   cx:=1;
  1036.   curline:=1;
  1037.   topline:=2-lines;
  1038.   computecy;
  1039.   updatecpos;
  1040.   if m.numlines>0
  1041.     then fullrefresh
  1042.     else
  1043.       begin
  1044.         clearscr;
  1045.         m.numlines:=1;
  1046.         fullrefresh;
  1047.       end;
  1048.   repeat
  1049.     processkey
  1050.   until msgdone or hungupon;
  1051.   moveto (1,lines);
  1052.   cleareol;
  1053.   writeln (^M^M^M^M);
  1054.   if mp then urec.config:=urec.config+[moreprompts];
  1055.   winds[0].y2:=25;
  1056.   bottom;
  1057.   bottomline
  1058. end;
  1059.  
  1060.  
  1061. {$ifdef testansieditor}
  1062. {*}
  1063. {*}procedure termmode;
  1064. {*}var k:char;
  1065. {*}begin
  1066. {*}  setparam (1,1200,false);
  1067. {*}  writeln ('Press ^D when connected.');
  1068. {*}  repeat
  1069. {*}    if keypressed then begin
  1070. {*}      read (kbd,k);
  1071. {*}      if k=#4 then exit;
  1072. {*}      if k=#3 then halt;
  1073. {*}      sendchar (k)
  1074. {*}    end;
  1075. {*}    while numchars>0 do write (getchar)
  1076. {*}  until 0=1
  1077. {*}end;
  1078. {*}
  1079. {*}var m:message;
  1080. {*}    cnt:integer;
  1081. {*}begin
  1082. {*}  checkbreak:=false;
  1083. {*}  urec.displaylen:=22;
  1084. {*}  urec.config:=[eightycols]; { ,ansigraphics]; }
  1085. {*}  if not driverpresent then begin
  1086. {*}    writeln ('You fool.');
  1087. {*}    halt
  1088. {*}  end;
  1089. {*}  termmode;
  1090. {*}  coninptr:=ofs(readchar);
  1091. {*}  conoutptr:=ofs(writechar);
  1092. {*}  m.numlines:=0;
  1093. {*}  for cnt:=1 to 100 do m.text[cnt]:='Hello line '+chr(cnt+64);
  1094. {*}  writeln (ansireedit(m,false))
  1095. {*}
  1096. {$endif}
  1097.  
  1098. end.
  1099.