home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 155.TEXTOPS.PAS < prev    next >
Pascal/Delphi Source File  |  1988-06-30  |  10KB  |  312 lines
  1. UNIT TextOps;
  2.  
  3. INTERFACE
  4. USES
  5. {$IFDEF DOSCrt}
  6.    DOSCrt,
  7. {$ELSE}
  8.    Crt,
  9. {$ENDIF}
  10.    Extended_Reals;
  11.  
  12. CONST
  13.    BELL      = #7;
  14.    BACKSPACE = #8;
  15.    ENTER     = #13;
  16.    ESC       = #27;
  17.    NULL      = #0;         { first  code of extended scan codes }
  18.    Left      = #75;        { second code of extended scan code  }
  19.    Right     = #77;        { second code of extended scan code  }
  20.    Up        = #72;        { second code of extended scan code  }
  21.    Down      = #80;        { second code of extended scan code  }
  22.    PgUp      = #73;        { second code of extended scan code  }
  23.    PgDn      = #81;        { second code of extended scan code  }
  24.    F1        = #59;        { second code of F1  function key    }
  25.    F2        = #60;        { second code of F2  function key    }
  26.    F3        = #61;        { second code of F3  function key    }
  27.    F4        = #62;        { second code of F4  function key    }
  28.    F5        = #63;        { second code of F5  function key    }
  29.    F6        = #64;        { second code of F6  function key    }
  30.    F7        = #65;        { second code of F7  function key    }
  31.    F8        = #66;        { second code of F8  function key    }
  32.    F9        = #67;        { second code of F9  function key    }
  33.    F10       = #68;        { second code of F10 function key    }
  34.  
  35.  
  36. PROCEDURE WriteXY (s:string; x,y:integer);
  37.  
  38. PROCEDURE VertLine  (x0,y1,y2 : INTEGER);
  39.  
  40. PROCEDURE HorizLine (x1,x2,y0 : INTEGER);
  41.  
  42. PROCEDURE frame (leftx, uppery, rightx, lowery: INTEGER);
  43.  
  44. PROCEDURE String_To_Value (     st    : string;
  45.                             VAR value : REAL;
  46.                             VAR units : string);
  47.  
  48. PROCEDURE Value_To_String (     value  : REAL;
  49.                                 NumDig : byte;
  50.                             VAR st     : string);
  51.  
  52. PROCEDURE DrawBorder ( x1 : BYTE;
  53.                        y1 : BYTE;
  54.                        x2 : BYTE;
  55.                        y2 : BYTE);
  56.  
  57. FUNCTION EXIST (filename : string) : BOOLEAN;
  58.  
  59. (****************************************************************************)
  60.  
  61. IMPLEMENTATION
  62.  
  63. PROCEDURE WriteXY (s:string; x,y:integer);
  64.  
  65.    BEGIN   {WriteXY}
  66.       GotoXY (x,y);
  67.       Write (s);
  68.    END;   {WriteXY}
  69.  
  70.  
  71. {----------------------------------------------------------------------------}
  72.  
  73. PROCEDURE VertLine  (x0,y1,y2 : INTEGER);
  74.  
  75.    CONST
  76.       Vertical = '│';           { char (179) }
  77.  
  78.    VAR
  79.       i : INTEGER;
  80.  
  81.    BEGIN   {VertLine}
  82.       FOR i:=y1 TO y2 DO BEGIN
  83.          GotoXY (x0,i);
  84.          Write (Vertical);
  85.       END;   {FOR}
  86.    END;   {VertLine}
  87.  
  88. {----------------------------------------------------------------------------}
  89.  
  90. PROCEDURE HorizLine (x1,x2,y0 : INTEGER);
  91.  
  92.    CONST
  93.       Horizontal = '─';           { char (196) }
  94.  
  95.    VAR
  96.       i : INTEGER;
  97.  
  98.    BEGIN   {NorizLine}
  99.       GotoXY (x1,y0);
  100.       FOR i:=x1 TO x2 DO BEGIN
  101.          Write (Horizontal);
  102.       END;   {FOR}
  103.    END;   {HorizLine}
  104.  
  105. CONST
  106.    windows = 2;
  107.    wtab    : array [0..windows,1..4] of byte {x0,y0,x1,y1}
  108.            = ((  1, 1,  80, 25 ),
  109.               ( 20, 5,  60, 20 ),
  110.               (  1, 2,  80, 22 ));
  111.  
  112. {----------------------------------------------------------------------------}
  113.  
  114. PROCEDURE frame (leftx, uppery, rightx, lowery: integer);
  115.  
  116.    VAR
  117.       i : integer;
  118.  
  119.    BEGIN   {frame}
  120.       GotoXY (leftx,uppery);
  121.       WriteXY ('┌',leftx,uppery);        {char(218)}
  122.       FOR i:=(leftx+1) TO (rightx-1) DO
  123.          Write ('─');                      {char(196)}
  124.       Write ('┐');                         {char(191)}
  125.       FOR i:=(uppery+1) TO (lowery-1) DO BEGIN
  126.          WriteXY ('│',leftx,i);          {char(179)}
  127.          WriteXY ('│',rightx,i);         {char(179)}
  128.       END;   {FOR}
  129.       GotoXY (leftx,lowery);
  130.       WriteXY ('└',leftx,lowery);        {char(192)}
  131.       FOR i:=(leftx+1) TO (rightx-1) DO
  132.          Write ('─');                      {char(196)}
  133.       Write ('┘');                         {char(217)}
  134.    END;   {frame}
  135.  
  136. {----------------------------------------------------------------------------}
  137.  
  138. PROCEDURE String_To_Value (     st    : string;
  139.                             VAR value : REAL;
  140.                             VAR units : string
  141.                           );
  142.  
  143.    CONST blank = '   ';
  144.  
  145.    VAR
  146.       j      : integer;
  147.       code   : integer;
  148.       i      : 0..1;
  149.       factor : REAL;
  150.  
  151.    BEGIN   {String_To_Value}
  152.       IF st[1] = '.'
  153.          THEN st:='0'+st
  154.       ELSE IF (st[1] = '-') AND (st[2] = '.')
  155.          THEN BEGIN
  156.             st[1]:='0';
  157.             st:='0'+st;
  158.          END;
  159.       Val (st,value,code);
  160.       IF code = 0
  161.          THEN units:=blank
  162.          ELSE BEGIN
  163.             i:=0;
  164.             CASE st[code] of
  165.                'p': factor:=1e-12;          (* pico  *)
  166.                'n': factor:=1e-09;          (* nano  *)
  167.                'u': factor:=1e-06;          (* micro *)
  168.                'm': factor:=1e-03;          (* milli *)
  169.                'c': factor:=1e-02;          (* centi *)
  170.                'k': factor:=1e+03;          (* kilo  *)
  171.                'M': factor:=1e+06;          (* Mega  *)
  172.                'G': factor:=1e+09;          (* Giga  *)
  173.                'T': factor:=1e+12;          (* Tera  *)
  174.                ELSE BEGIN
  175.                     factor:=1.0;
  176.                     units[1]:=st[code];
  177.                     i:=1;
  178.                END;   {ELSE}
  179.             END;   {CASE}
  180.             Delete (st,code,1);
  181.             Val (st,value,code);
  182.             IF code <> 0
  183.                THEN BEGIN
  184.                   FOR j:=1 TO length(st)-code+1 DO
  185.                      units [j+i]:=st[j+code-1];
  186.                   Delete (st,code,length(st)-code+1);
  187.                   Val (st,value,code);
  188.                END   {THEN}
  189.                ELSE units:=blank;
  190.             value:=value*factor;
  191.          END;   {ELSE}
  192.    END;   {String_To_Value}
  193.  
  194.  
  195. {----------------------------------------------------------------------------}
  196.  
  197. PROCEDURE Value_To_String (     value  : REAL;     (* Value to be converted *)
  198.                                 NumDig : byte;     (* Precision to be shown *)
  199.                             VAR st     : string    (* Converted value       *)
  200.                           );
  201.  
  202.    VAR
  203.       mult     : STRING [1];      (* Multiplier; i.e. p,n,u,m, ,k,M,G,T     *)
  204.       x        : INTEGER;         (* Position of exponent in string         *)
  205.       factor   : REAL;
  206.       negative : BOOLEAN;
  207.  
  208.    BEGIN   {Value_To_String}
  209.       IF NumDig < 4 then NumDig:=4;
  210.       IF value < 0
  211.          THEN negative:=true
  212.          ELSE negative:=false;
  213.       factor:=ABS(value);
  214.       x:=-15;
  215.       IF value = 0
  216.          THEN x:=0
  217.       ELSE IF (factor*exp(-x*ln(10)) >= 1000)
  218.          THEN REPEAT
  219.             INC (x,3);
  220.             factor:=abs(value)*exp(-x*ln(10));
  221.          UNTIL (((1 <= factor) AND (factor < 1000)) OR (x = 15));
  222.       CASE x OF
  223.          -12: mult:='p';
  224.           -9: mult:='n';
  225.           -6: mult:='u';
  226.           -3: mult:='m';
  227.            0: mult:='';
  228.            3: mult:='k';
  229.            6: mult:='M';
  230.            9: mult:='G';
  231.           12: mult:='T';
  232.       END;   {CASE}
  233.       CASE x OF
  234.          -12..12: BEGIN
  235.                      IF factor < 10
  236.                         THEN x:=NumDig-2
  237.                      ELSE IF factor < 100
  238.                         THEN x:=NumDig-3
  239.                      ELSE x:=NumDig-4;
  240.                      str (factor:NumDig:x,st);
  241.                      IF negative
  242.                         THEN st:='-'+st+' '+mult
  243.                         ELSE st:=    st+' '+mult;
  244.                   END;   {CASE -12..12}
  245.          ELSE     BEGIN
  246.                      str (value:(NumDig+6),st);
  247.                      st:=st+' ';
  248.                   END;   {CASE-ELSE}
  249.       END;   {CASE}
  250.    END;   {Value_To_String}
  251.  
  252. {----------------------------------------------------------------------------}
  253.  
  254. PROCEDURE DrawBorder ( x1 : BYTE;
  255.                        y1 : BYTE;
  256.                        x2 : BYTE;
  257.                        y2 : BYTE
  258.                      );
  259.  
  260.    CONST
  261.       TopLeft     = '╔';          {char(201)}
  262.       BottomLeft  = '╚';          {char(200)}
  263.       TopRight    = '╗';          {char(187)}
  264.       BottomRight = '╝';          {char(188)}
  265.       Vertical    = '║';          {char(186)}
  266.       Horizontal  = '═';          {char(205)}
  267.  
  268.    VAR
  269.       i : integer;
  270.  
  271.    BEGIN   {DrawBorder}
  272.       GotoXY (x1,y1); WriteXY (TopLeft,x1,y1);
  273.       GotoXY (x1,y2); Write   (BottomLeft);
  274.       FOR i:=x1+1 TO x2-1 DO BEGIN
  275.          GotoXY (i,y1); Write (Horizontal);
  276.          GotoXY (i,y2); Write (Horizontal);
  277.       END;   {FOR}
  278.       GotoXY (x2,y1); Write (TopRight);
  279.       GotoXY (x2,y2); Write (BottomRight);
  280.       FOR i:=y1+1 TO y2-1 DO BEGIN
  281.          GotoXY (x1,i); Write (Vertical);
  282.          GotoXY (x2,i); Write (Vertical);
  283.       END;   {FOR}
  284.    END;   {DrawBorder}
  285.  
  286.  
  287. {----------------------------------------------------------------------------}
  288.  
  289. FUNCTION EXIST (filename : string) : boolean;
  290.  
  291.    VAR
  292.       OK   : boolean;      (* temporary variable, equal to exist *)
  293.       Name : text;
  294.  
  295.    BEGIN   {EXIST}
  296.       IF length (filename) > 0
  297.          THEN BEGIN
  298.             Assign (Name,filename);
  299.             {$I-} Reset (Name); {$I+}
  300.             OK:=(IOresult=0);
  301.             exist:=OK;
  302.             IF OK THEN Close (Name);
  303.          END   {THEN}
  304.          ELSE EXIST:=false;
  305.    END;   {EXIST}
  306.  
  307.  
  308. (****************************************************************************)
  309.  
  310. BEGIN   {Initialization}
  311. END.   {UNIT Text}
  312.