home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PAS_0493.ZIP / TERMCODE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-22  |  6.1 KB  |  223 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 455 of 535
  3. From : Gregory P. Smith                    1:104/332.11         21 Apr 93  14:59
  4. To   : Joe Maffuccio                       1:321/212.0
  5. Subj : Generating AVT/0 & ANSI codes
  6. ────────────────────────────────────────────────────────────────────────────────
  7. On Apr 19 23:40, Joe Maffuccio of 1:321/212 wrote:
  8.  
  9.  JM> I just recieved your PAvatar 1.50 package in the mail. Um, haha, I have a
  10.  JM> question. How do I use it? Hhaa. Ok, lets say in a door. Something
  11.  JM> simple. Say this. I have a door, the function that sends strings out to
  12.  JM> the user is called Procedure Print(var Message:string);. Let's say I
  13.  JM> wanted to send that message in the color light blue to the user. How
  14.  JM> would I go about doing that with PAvatar.  I also want to add something
  15.  JM> that will allow me to just call a procedure with a number or two, and
  16.  JM> have PAvatar change color both locally and over the modem.
  17.  
  18. Here's a unit I just pieced together from some old code I wrote a couple years
  19. ago.  It'll generate AVT/0+ and ANSI codes:
  20.  
  21. ========== }
  22.  
  23. Unit TermCode;  {$S-,D-,L-,R-,F-,O-}
  24. {  Generate ANSI and AVT/0+ codes for color and cursor ctrl }
  25. {  Public Domain -- by Gregory P. Smith  }  { untested }
  26.  
  27. interface
  28.  
  29. type
  30.   Str12 = string[12];  { Maximum size for most ANSI strings }
  31.   Str3  = string[3];
  32.   grTermType = (TTY, ANSI, AVT0); { TTY, ANSI or Avatar/0+ }
  33.  
  34. var
  35.   grTerm : grTermType;
  36.   grColor : Byte;  { Last color set }
  37.  
  38. { Non Specific functions }
  39. Function grRepChar(c:char;n:byte): string;   { Repeat Chars }
  40. Function grSetPos(x,y:byte): Str12;   { Set Cursor Position }
  41. Function grCLS: Str12;          { Clear Screen + reset Attr }
  42. Function grDelEOL: Str12;                   { Delete to EOL }
  43.  
  44. Function grSetAttr(a:byte): Str12;      { Change writing color }
  45. Function grSetColor(fg,bg:byte): Str12; { Change color fg & bg }
  46.  
  47. { AVT/0+ Specific functions }
  48. Function AVTRepPat(pat:string;n:byte): string; { Repeat Pattern (AVT/0+) }
  49. Function AVTScrollUp(n,x1,y1,x2,y2:byte): Str12;
  50. Function AVTScrollDown(n,x1,y1,x2,y2:byte): Str12;
  51. Function AVTClearArea(a,l,c:byte): Str12;
  52. Function AVTInitArea(ch:char;a,l,c:byte): Str12;
  53.  
  54. IMPLEMENTATION
  55.  
  56. const
  57.   hdr = #27'['; { ansi header }
  58.  
  59. { Misc support functions }
  60.  
  61. function bts(x:byte): str3; { byte to string }
  62. var
  63.   z: str3;
  64. begin
  65.   Str(x,z);
  66.   bts := z;
  67. end;
  68.  
  69. function Repl(n:byte; c:char): string;
  70. var
  71.   z : string;
  72. begin
  73.   fillchar(z[1],n,c);
  74.   z[0] := chr(n);
  75.   repl := z;
  76. end;
  77.  
  78. { Cursor Control functions }
  79.  
  80. function grRepChar(c:char;n:byte): string;
  81. begin
  82.   if grTerm = AVT0 then
  83.     grRepChar := ^Y+c+chr(n)
  84.   else
  85.     grRepChar := repl(n,c);
  86. end; { repcahr }
  87.  
  88. function grSetPos(x,y:byte): Str12;
  89. begin
  90.   case grTerm of
  91.     ANSI : if (x = 1) and (y > 1) then
  92.              grSetPos := hdr+bts(y)+'H'   { x defualts to 1 }
  93.            else
  94.              grSetPos := hdr+bts(y)+';'+bts(x)+'H';
  95.     AVT0 : grSetPos := ^V+^H+chr(y)+chr(x);
  96.     TTY  : grSetPos := '';
  97.   end; { case }
  98. end;
  99.  
  100.  
  101. function grCLS: Str12;
  102. begin
  103.   case grTerm of
  104.     ANSI : grCLS := hdr+'2J';
  105.     TTY,
  106.     AVT0 : grCLS := ^L;
  107.   end;
  108.   if grTerm = AVT0 then GrColor := 3; { reset the color }
  109. end; { cls }
  110.  
  111. function grDelEOL: Str12; { clear rest of line }
  112. begin
  113.   case grTerm of
  114.     ANSI : grDelEOL := hdr+'K';
  115.     AVT0 : grDelEOL := ^V^G;
  116.     TTY  : grDelEOL := '';
  117.   end;
  118. end;
  119.  
  120. { Color functions }
  121.  
  122. function grSetAttr(a:byte): Str12;
  123. const
  124.   ANS_Colors : Array[0..7] of char = ('0','4','2','6','1','5','3','7');
  125. var
  126.   tmp : Str12;
  127. begin
  128.   tmp := '';
  129.   case grTerm of
  130.     ANSI : begin
  131.       tmp := hdr;
  132.       if (a and $08)=8 then tmp := tmp+'1' else tmp := tmp+'0'; { bright }
  133.       if (a and $80)=$80 then tmp := tmp+';5';  { blink }
  134.       tmp := tmp+';3'+ANS_Colors[a and $07]; { foreground }
  135.       tmp := tmp+';4'+ANS_Colors[(a shr 4) and $07]; { background }
  136.       grSetAttr := tmp+'m'; { complete ANSI code }
  137.     end;
  138.     AVT0 : begin
  139.       tmp := ^V+^A+chr(a AND $7f);
  140.       if a > 127  then tmp := tmp+^V+^B; { Blink }
  141.       grSetAttr := tmp;
  142.     end;
  143.     TTY  : grSetAttr := '';
  144.   end; { case }
  145.   GrColor := a; { Current Attribute }
  146. end; { setattr }
  147.  
  148. function grSetColor(fg,bg:byte): Str12;
  149. begin
  150.   grSetColor := grSetAttr((bg shl 4) OR (fg and $0f));
  151. end; { SetColor }
  152.  
  153. { AVATAR Specific functions: }
  154.  
  155. function AVTRepPat(pat:string;n:byte): string; { Repeat Pattern (AVT/0+) }
  156. begin
  157.   AVTRepPat := ^V+^Y+pat[0]+pat+chr(n); { Repeat pat n times }
  158. end;
  159.  
  160. function AVTScrollUp(n,x1,y1,x2,y2:byte): Str12;
  161. begin
  162.   AVTScrollUp := ^V+^J+chr(n)+chr(y1)+chr(x1)+chr(y2)+chr(x2);
  163. end; { AVTScrollUp }
  164.  
  165. function AVTScrollDown(n,x1,y1,x2,y2:byte): Str12;
  166. begin
  167.   AVTScrollDown := ^V+^K+chr(n)+chr(y1)+chr(x1)+chr(y2)+chr(x2);
  168. end; { AVTScrollDown }
  169.  
  170. function AVTClearArea(a,l,c:byte): Str12;
  171. var
  172.   b:byte;
  173.   s:Str12;
  174. begin       { Clear lines,columns from cursor pos with Attr }
  175.   b := a and $7f;
  176.   s := ^V+^L+chr(b)+chr(l)+chr(c);
  177.   if a > 127 then Insert(^V+^B,s,1); { blink on }
  178.   AVTClearArea := s;
  179.   GrColor := a;
  180. end; { AVTClearArea }
  181.  
  182. function AVTInitArea(ch:char;a,l,c:byte): Str12;
  183. var
  184.   b:byte;
  185.   s:Str12;
  186. begin
  187.   b := a AND $7f;
  188.   s := ^V+^M+chr(b)+ch+chr(l)+chr(c);
  189.   if a > 127 then Insert(^V+^B,s,1);
  190.   AvtInitArea := s;
  191.   GrColor := a;
  192. end; { AVTInitArea }
  193.  
  194. { Initalization code }
  195. BEGIN
  196.   GrTerm  := AVT0;  { Default to Avatar }
  197.   GrColor := 3;     { Cyan is the AVT/0+ defualt }
  198. END.
  199.  
  200. =============
  201.  
  202. set GrTerm to whatever terminal codes you want to create; then you can use the 
  203. common routines to generate ANSI or Avatar codes.  Here's a Print procedure
  204. that you were mentioning:
  205.  
  206. Procedure Print(var msg:string);
  207. var
  208.   idx : byte
  209. begin
  210.   if length(msg) > 0 then
  211.     for idx := 1 to length(msg) do begin
  212.       Parse_AVT1(msg[idx]);
  213.       SendOutComPortThingy(msg[idx]);
  214.     end; { for }
  215. end;
  216.  
  217. You could modify this so that it pays attention to the TextAttr variable of the
  218. Crt unit if you wish so that it compares TextAttr to GrColor and adds a
  219. SetAttr(TextAttr) command in before it sends msg.
  220.  
  221. Hope that helps,
  222.  
  223.  .. Greg