home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / FDFP_092.ZIP / ANS.PAS next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  9.2 KB  |  400 lines
  1. (* ProBBS ANSI Display Unit *)
  2.  
  3. UNIT Ans;
  4.  
  5. INTERFACE
  6.  
  7. procedure Ansi(Ch : Char);
  8. procedure AnsiWriteL (MyStr : String);
  9. procedure AnsiWriteN (MyStr : String);
  10. Procedure Convert_To_ANSI (var MyStr : String);
  11.  
  12. IMPLEMENTATION
  13.  
  14. Uses
  15.   Crt;
  16.  
  17. VAR
  18.   ANSI_St :String ;  {stores ANSI escape sequence if receiving ANSI}
  19.   ANSI_SCPL :Integer;  {stores the saved cursor position line}
  20.   ANSI_SCPC :Integer;  { "  "  "  "  "  column}
  21.   ANSI_FG :Integer;  {stores current foreground}
  22.   ANSI_BG :Integer;  {stores current background}
  23.   ANSI_C,ANSI_I,ANSI_B,ANSI_R:Boolean ;  {stores current attribute options}
  24.   p,x,y : Integer;
  25.  
  26. PROCEDURE Ansi(ch:char);  {Displays ch following ANSI graphics protocal }
  27.  
  28.   PROCEDURE TABULATE;
  29.   VAR
  30.     x:Integer;
  31.   BEGIN
  32.     x:=WHEREX;
  33.     IF x<80 THEN
  34.       REPEAT
  35.         Inc(x);
  36.       UNTIL (x MOD 8)=0;
  37.     IF x=80 THEN x:=1;
  38.     GOTOXY(x,WHEREY);
  39.     IF x=1 THEN WRITELN;
  40.   END;
  41.  
  42.   PROCEDURE BACKSPACE;
  43.   BEGIN
  44.     IF WHEREX>1 THEN
  45.       WRITE(^H,' ',^H)
  46.     ELSE
  47.       IF WHEREY>1 THEN BEGIN
  48.         GOTOXY(80,WHEREY-1);
  49.         WRITE(' ');
  50.         GOTOXY(80,WHEREY-1);
  51.       END;
  52.   END;
  53.  
  54.   PROCEDURE TTY(ch:char);
  55.   VAR
  56.     x:Integer;
  57.   BEGIN
  58.     IF ANSI_C THEN BEGIN
  59.       IF ANSI_I THEN ANSI_FG:=ANSI_FG OR 8;
  60.       IF ANSI_B THEN ANSI_FG:=ANSI_FG OR 16;
  61.       IF ANSI_R THEN BEGIN
  62.         x:=ANSI_FG;
  63.         ANSI_FG:=ANSI_BG;
  64.         ANSI_BG:=x;
  65.       END;
  66.       ANSI_C:=FALSE;
  67.     END;
  68.     TextColor(ANSI_FG);
  69.     TextBackground(ANSI_BG);
  70.     CASE Ch of
  71.       ^G: BEGIN
  72.             {Sound(2000);
  73.             Delay(75);
  74.             NoSound;}
  75.           END;
  76.       ^H: Backspace;
  77.       ^I: Tabulate;
  78.       ^J: BEGIN
  79.             TextBackground(0);
  80.             Write(^J);
  81.           END;
  82.       ^K: GotoXY(1,1);
  83.       ^L: BEGIN
  84.             TextBackground(0);
  85.             ClrScr;
  86.           END;
  87.       ^M: BEGIN
  88.             TextBackground(0);
  89.             Write(^M);
  90.           END;
  91.       ELSE Write(Ch);
  92.     END;
  93.   END;
  94.  
  95.   PROCEDURE ANSIWrite(S:String);
  96.   VAR
  97.     x:Integer;
  98.   BEGIN
  99.     FOR x:=1 to Length(S) do
  100.       TTY(S[x]);
  101.   END;
  102.  
  103.   FUNCTION Param:Integer;  {returns -1 if no more parameters}
  104.   VAR
  105.     S:String;
  106.     x:Integer;
  107.     XX : LongInt;
  108.     B:Boolean;
  109.   BEGIN
  110.     B:=FALSE;
  111.     FOR x:=3 TO Length(ANSI_St) DO
  112.       IF ANSI_St[x] in ['0'..'9'] THEN B:=TRUE;
  113.     IF NOT B THEN
  114.       Param:=-1
  115.     ELSE BEGIN
  116.       S:='';
  117.       x:=3;
  118.       IF ANSI_St[3]=';' THEN BEGIN
  119.         Param:=0;
  120.         Delete(ANSI_St,3,1);
  121.         EXIT;
  122.       END;
  123.       REPEAT
  124.         S:=S+ANSI_St[x];
  125.         x:=x+1;
  126.       UNTIL (NOT (ANSI_St[x] IN ['0'..'9'])) or (Length(S)>2) or
  127.             (x>Length(ANSI_St));
  128.       IF Length(S)>2 THEN BEGIN
  129.         ANSIWrite(ANSI_St+Ch);
  130.         ANSI_St:='';
  131.         Param:=-1;
  132.         EXIT;
  133.       END;
  134.       Delete(ANSI_St,3,Length(S));
  135.       IF ANSI_St[3]=';' THEN Delete(ANSI_St,3,1);
  136.       Val(S,x,XX);
  137.       Param:=x;
  138.     END;
  139.   END;
  140.  
  141. BEGIN
  142.     IF (Ch<>#27) and (ANSI_St='') THEN BEGIN
  143.     TTY(Ch);
  144.     Exit;
  145.   END;
  146.   IF Ch=#27 THEN BEGIN
  147.     IF ANSI_St<>'' THEN BEGIN
  148.       ANSIWrite(ANSI_St+#27);
  149.       ANSI_St:='';
  150.     END ELSE ANSI_St:=#27;
  151.     EXIT;
  152.   END;
  153.   IF ANSI_St=#27 THEN BEGIN
  154.     IF Ch='[' THEN
  155.       ANSI_St:=#27+'['
  156.     ELSE BEGIN
  157.       ANSIWrite(ANSI_St+Ch);
  158.       ANSI_St:='';
  159.     END;
  160.     Exit;
  161.   END;
  162.   IF (Ch='[') and (ANSI_St<>'') THEN BEGIN
  163.     ANSIWrite(ANSI_St+'[');
  164.     ANSI_St:='';
  165.     EXIT;
  166.   END;
  167.   IF not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) THEN
  168.   BEGIN
  169.     ANSIWrite(ANSI_St+Ch);
  170.     ANSI_St:='';
  171.     EXIT;
  172.   END;
  173.   IF Ch in ['A'..'D','f','H','J','K','m','s','u'] THEN BEGIN
  174.     CASE Ch of
  175.     'A': BEGIN
  176.            p:=Param;
  177.            IF p=-1 THEN p:=1;
  178.            IF WhereY-p<1 THEN
  179.              GotoXY(Wherex,1)
  180.            ELSE GotoXY(WhereX,WhereY-p);
  181.          END;
  182.     'B': BEGIN
  183.            p:=Param;
  184.            IF p=-1 THEN p:=1;
  185.            IF WhereY+p>25 THEN
  186.              GotoXY(WhereX,25)
  187.            ELSE GotoXY(WhereX,WhereY+p);
  188.          END;
  189.     'C': BEGIN
  190.            p:=Param;
  191.            IF p=-1 THEN p:=1;
  192.            IF WhereX+p>80 THEN
  193.              GotoXY(80,WhereY)
  194.            ELSE GotoXY(WhereX+p,WhereY);
  195.          END;
  196.     'D': BEGIN
  197.            p:=Param;
  198.            IF p=-1 THEN p:=1;
  199.            IF WhereX-p<1 THEN
  200.              GotoXY(1,WhereY)
  201.            ELSE GotoXY(WhereX-p,WhereY);
  202.          END;  'H','f': BEGIN
  203.            Y:=Param;
  204.            x:=Param;
  205.            IF Y<1 THEN Y:=1;
  206.            IF x<1 THEN x:=1;
  207.            IF (x>80) or (x<1) or (Y>25) or (Y<1) THEN BEGIN
  208.              ANSI_St:='';
  209.              EXIT;
  210.            END;
  211.            GotoXY(x,Y);
  212.          END;
  213.     'J': BEGIN
  214.            p:=Param;
  215.            IF p=2 THEN BEGIN
  216.              TextBackground(0);
  217.              ClrScr;
  218.            END;
  219.            IF p=0 THEN BEGIN
  220.              x:=WhereX;
  221.              Y:=WhereY;
  222.              Window(1,y,80,25);
  223.              TextBackground(0);
  224.              ClrScr;
  225.              Window(1,1,80,25);
  226.              GotoXY(x,Y);
  227.            END;
  228.            IF p=1 THEN BEGIN
  229.              x:=WhereX;
  230.              Y:=WhereY;
  231.              Window(1,1,80,wherey);
  232.              TextBackground(0);
  233.              ClrScr;
  234.              Window(1,1,80,25);
  235.              GotoXY(x,Y);
  236.            END;
  237.          END;
  238.     'K': BEGIN
  239.            TextBackground(0);
  240.            ClrEol;
  241.          END;
  242.     'm': BEGIN
  243.            IF ANSI_St=#27+'[' THEN BEGIN
  244.              ANSI_FG:=7;
  245.              ANSI_BG:=0;
  246.              ANSI_I:=FALSE;
  247.              ANSI_B:=FALSE;
  248.              ANSI_R:=FALSE;
  249.            END;
  250.            REPEAT
  251.              p:=Param;
  252.              CASE p of
  253.                -1:;
  254.                 0:BEGIN
  255.                     ANSI_FG:=7;
  256.                     ANSI_BG:=0;
  257.                     ANSI_I:=FALSE;
  258.                     ANSI_R:=FALSE;
  259.                     ANSI_B:=FALSE;
  260.                   END;
  261.                 1:ANSI_I:=true;
  262.                 5:ANSI_B:=true;
  263.                 7:ANSI_R:=true;
  264.                30:ANSI_FG:=0;
  265.                31:ANSI_FG:=4;
  266.                32:ANSI_FG:=2;
  267.                33:ANSI_FG:=6;
  268.                34:ANSI_FG:=1;
  269.                35:ANSI_FG:=5;
  270.                36:ANSI_FG:=3;
  271.                37:ANSI_FG:=7;
  272.                40:ANSI_BG:=0;
  273.                41:ANSI_BG:=4;
  274.                42:ANSI_BG:=2;
  275.                43:ANSI_BG:=6;
  276.                44:ANSI_BG:=1;
  277.                45:ANSI_BG:=5;
  278.                46:ANSI_BG:=3;
  279.                47:ANSI_BG:=7;
  280.              END;
  281.              IF ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) THEN
  282.                 ANSI_C:=true;
  283.            UNTIL p=-1;
  284.          END;
  285.     's': BEGIN
  286.            ANSI_SCPL:=WhereY;
  287.            ANSI_SCPC:=WhereX;
  288.          END;
  289.     'u': BEGIN
  290.            IF ANSI_SCPL>-1 THEN GotoXY(ANSI_SCPC,ANSI_SCPL);
  291.            ANSI_SCPL:=-1;
  292.            ANSI_SCPC:=-1;
  293.          END;
  294.     END;
  295.     ANSI_St:='';
  296.     EXIT;
  297.   END;
  298.   IF Ch in ['0'..'9',';'] THEN
  299.     ANSI_St:=ANSI_St+Ch;
  300.   IF Length(ANSI_St)>50 THEN BEGIN
  301.     ANSIWrite(ANSI_St);
  302.     ANSI_St:='';
  303.     EXIT;
  304.   END;
  305. END;
  306.  
  307. Procedure AnsiWriteL (MyStr : String);
  308. Var
  309.   Dummy : Byte;
  310. Begin
  311.   If Length(MyStr) > 0 Then
  312.   Begin
  313.     For Dummy := 1 to Length(MyStr) do
  314.       Ansi (MyStr[Dummy]);
  315.   end;
  316.   Ansi (#10);
  317.   Ansi (#13);
  318. End;
  319.  
  320. Procedure AnsiWriteN (MyStr : String);
  321. Var
  322.   Dummy : Byte;
  323. Begin
  324.   If Length(MyStr) > 0 Then
  325.   Begin
  326.     For Dummy := 1 to Length(MyStr) do
  327.       Ansi (MyStr[Dummy]);
  328.   end;
  329. End;
  330.  
  331. (*************************************************************)
  332.  Procedure Convert_To_ANSI (var MyStr : String);
  333. (*************************************************************)
  334. Var
  335.   DummyInt : Integer;
  336.   AnsiStr : String;
  337. Begin
  338.   DummyInt := 0;
  339.   Repeat
  340.     if Pos ('`', MyStr) <> 0 then
  341.     begin
  342.       DummyInt := Pos('`', MyStr) + 2;
  343.         Case MyStr[DummyInt] of
  344.           '0': AnsiStr := #27 + '[0;30;';
  345.           '1': AnsiStr := #27 + '[0;34;';
  346.           '2': AnsiStr := #27 + '[0;32;';
  347.           '3': AnsiStr := #27 + '[0;36;';
  348.           '4': AnsiStr := #27 + '[0;31;';
  349.           '5': AnsiStr := #27 + '[0;35;';
  350.           '6': AnsiStr := #27 + '[0;33;';
  351.           '7': AnsiStr := #27 + '[0;37;';
  352.           '8': AnsiStr := #27 + '[1;30;';
  353.           '9': AnsiStr := #27 + '[1;34;';
  354.           'A': AnsiStr := #27 + '[1;32;';
  355.           'B': AnsiStr := #27 + '[1;36;';
  356.           'C': AnsiStr := #27 + '[1;31;';
  357.           'D': AnsiStr := #27 + '[1;35;';
  358.           'E': AnsiStr := #27 + '[1;33;';
  359.           'F': AnsiStr := #27 + '[1;37;';
  360.         end;
  361.       DummyInt := DummyInt - 1;
  362.         Case MyStr[DummyInt] of
  363.           '0': AnsiStr := AnsiStr + '40m';
  364.           '1': AnsiStr := AnsiStr + '44m';
  365.           '2': AnsiStr := AnsiStr + '42m';
  366.           '3': AnsiStr := AnsiStr + '46m';
  367.           '4': AnsiStr := AnsiStr + '41m';
  368.           '5': AnsiStr := AnsiStr + '45m';
  369.           '6': AnsiStr := AnsiStr + '43m';
  370.           '7': AnsiStr := AnsiStr + '47m';
  371.         end;
  372.       Delete (MyStr, DummyInt - 1, 3);
  373.       Insert (AnsiStr, MyStr, DummyInt - 1);
  374.     End;
  375.   Until Pos ('`', MyStr) = 0;
  376. End;
  377.  
  378.  
  379.  
  380. END.
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.