home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pibsoft / terminal / source / settrtab.mod < prev    next >
Encoding:
Text File  |  1988-02-07  |  11.3 KB  |  341 lines
  1. (*----------------------------------------------------------------------*)
  2. (*          Set_Translate_Table --- Set Character Translation Table     *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Set_Translate_Table( File_Name : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Set_Translate_Table                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Gets character translation table                     *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Set_Translate_Table( File_Name : AnyStr );                    *)
  16. (*                                                                      *)
  17. (*           File_Name --- file to read translate table from, if        *)
  18. (*                         specified.                                   *)
  19. (*                                                                      *)
  20. (*      Calls:   Clear_Window                                           *)
  21. (*               Save_Screen                                            *)
  22. (*               Draw_Menu_Frame                                        *)
  23. (*               Restore_Screen                                         *)
  24. (*               Reset_Global_Colors                                    *)
  25. (*               Read_Kbd_Old                                           *)
  26. (*                                                                      *)
  27. (*----------------------------------------------------------------------*)
  28.  
  29. VAR
  30.    TrTab_File      : TEXT;
  31.    I               : INTEGER;
  32.    J               : INTEGER;
  33.    K               : INTEGER;
  34.    L_Char          : INTEGER;
  35.    H_Pos           : INTEGER;
  36.    TrTab_Menu      : Menu_Type;
  37.    Done            : BOOLEAN;
  38.    Ch              : CHAR;
  39.    TrTab_Base      : INTEGER;
  40.    Last_Char       : INTEGER;
  41.    X               : INTEGER;
  42.    Y               : INTEGER;
  43.    S               : STRING[4];
  44.  
  45. (*----------------------------------------------------------------------*)
  46. (*      Display_Translate_Table -- Display Translate_Table              *)
  47. (*----------------------------------------------------------------------*)
  48.  
  49. PROCEDURE Display_Translate_Table;
  50.  
  51. VAR
  52.    I: INTEGER;
  53.    J: INTEGER;
  54.  
  55. BEGIN (* Display_Translate_Table *)
  56.  
  57.    GoToXY( 6 , 7 );
  58.  
  59.    L_Char     := 0;
  60.  
  61.    FOR I := 0 TO 15 DO
  62.       BEGIN
  63.  
  64.          GoToXY( 2 , I + 7 );
  65.  
  66.          FOR J := 0 TO 7 DO
  67.             BEGIN
  68.                L_Char :=  ( J * 16 ) + I;
  69.                WRITE( ( TrTab_Base + L_Char):3, '=',
  70.                       ORD(TrTab[CHR(L_Char + TrTab_Base)]):3,'  ');
  71.             END;
  72.  
  73.       END;
  74.  
  75.    GoToXY( 6 , 7 );
  76.  
  77. END   (* Display_Translate_Table *);
  78.  
  79.  
  80. (*----------------------------------------------------------------------*)
  81.  
  82. BEGIN (* Set_Translate_Table *)
  83.  
  84.                                    (* Announce translate table definition *)
  85.  
  86.    Draw_Titled_Box( Saved_Screen, 10, 10, 65, 15,
  87.                     'Read Translate Table Definitions' );
  88.  
  89.    WRITELN;
  90.    WRITE('File with definitions? ');
  91.  
  92.    Translate_File_Name := File_Name;
  93.  
  94.    IF Length( Translate_File_Name ) > 0 THEN
  95.       BEGIN
  96.          WRITELN(Translate_File_Name);
  97.          Window_Delay;
  98.       END
  99.    ELSE
  100.       BEGIN
  101.          Read_Edited_String( Translate_File_Name );
  102.          WRITELN;
  103.       END;
  104.  
  105.    IF ( Translate_File_Name = CHR( ESC ) ) THEN
  106.       BEGIN
  107.          Restore_Screen_And_Colors( Saved_Screen );
  108.          EXIT;
  109.       END;
  110.  
  111.    IF LENGTH( Translate_File_Name ) <= 0 THEN
  112.       BEGIN (* Get translation definitions from keyboard *)
  113.  
  114.                                    (* Restore previous screen          *)
  115.  
  116.          Restore_Screen_And_Colors( Saved_Screen );
  117.  
  118.          Save_Screen( Saved_Screen );
  119.          Draw_Menu_Frame( 2, 1, 79, 24, Menu_Frame_Color, Menu_Title_Color,
  120.                           Menu_Text_Color, 'Translate Table Definitions' );
  121.  
  122.          Clear_Window;
  123.          WRITELN(' Use arrows to move up/down/left/right.');
  124.          WRITELN(' Hit ESC to quit editing and save definitions.');
  125.          WRITELN(' To change character, just type new value, and hit CR.');
  126.          WRITELN(' Hit S to toggle between first and second 128 characters ');
  127.  
  128.                                    (* Display current definitions    *)
  129.  
  130.          TrTab_Base := 0;
  131.  
  132.          Display_Translate_Table;
  133.  
  134.          Done      := FALSE;
  135.          L_Char    := 0;
  136.          I         := 1;
  137.          J         := 1;
  138.          H_Pos     := 6;
  139.          Last_Char := 127;
  140.                                    (* Get new definitions *)
  141.          REPEAT
  142.  
  143.             Read_Kbd_Old( Ch );
  144.  
  145.             IF ( Ch = CHR( ESC ) ) THEN
  146.                IF PibTerm_KeyPressed THEN
  147.                   BEGIN  (* Escape sequence found *)
  148.  
  149.                      Read_Kbd_Old( Ch );
  150.  
  151.                      CASE ORD( Ch ) OF
  152.  
  153.                         U_Arrow:  IF J > 1  THEN
  154.                                      J := J - 1
  155.                                   ELSE
  156.                                      IF I > 1 THEN
  157.                                         BEGIN
  158.                                            J := 16;
  159.                                            I := I - 1;
  160.                                         END;
  161.  
  162.                         D_Arrow:  IF J < 16 THEN
  163.                                      J := J + 1
  164.                                   ELSE
  165.                                      IF I < 8 THEN
  166.                                         BEGIN
  167.                                            J := 1;
  168.                                            I := I + 1;
  169.                                         END;
  170.  
  171.                         R_Arrow:  IF I < 8  THEN
  172.                                      I := I + 1
  173.                                   ELSE
  174.                                      IF J < 16 THEN
  175.                                         BEGIN
  176.                                            I := 1;
  177.                                            J := J + 1;
  178.                                         END;
  179.  
  180.                         L_Arrow:  IF I > 1  THEN
  181.                                      I := I - 1
  182.                                   ELSE
  183.                                      IF J > 1 THEN
  184.                                         BEGIN
  185.                                            I := 8;
  186.                                            J := J - 1;
  187.                                         END;
  188.  
  189.                         ELSE ;
  190.  
  191.                      END (* CASE *);
  192.  
  193.                      L_Char := ( J - 1 ) * 8 + I - 1;
  194.                      H_Pos  := 6 + ( ( I - 1 ) * 9 );
  195.  
  196.                      GoToXY( H_Pos , J + 6 );
  197.  
  198.                   END   (* Escape sequence found *)
  199.  
  200.                ELSE                (* Lone escape *)
  201.                   Done := TRUE
  202.                                    (* "S" means toggle display *)
  203.  
  204.             ELSE IF UpCase( Ch ) = 'S' THEN
  205.                BEGIN
  206.                   TrTab_Base := 128 - TrTab_Base;
  207.                   Last_Char  := TrTab_Base + 127;
  208.                   Display_Translate_Table;
  209.                   I          := 1;
  210.                   J          := 1;
  211.                   H_Pos      := 6;
  212.                END
  213.                                    (* Should be digit *)
  214.             ELSE
  215.                BEGIN (* digit *)
  216.  
  217.                   X  := WhereX;
  218.                   Y  := WhereY;
  219.                   S  := Ch;
  220.  
  221.                   WRITE('   ');
  222.  
  223.                   Ch := Edit_String( S, 4, X, X + 1, Y, 4, FALSE, 0 );
  224.  
  225.                   K := 0;
  226.  
  227.                   IF ( Ch <> CHR( ESC ) ) THEN
  228.                      FOR X := 1 TO LENGTH( S ) DO
  229.                         IF ( S[X] IN ['0'..'9'] ) THEN
  230.                            K := K * 10 + ORD( S[X] ) - ORD('0');
  231.  
  232.                   IF ( K >= 0 ) AND ( K <= 255 ) THEN
  233.                      TrTab[CHR(L_Char + TrTab_Base)] := CHR(K);
  234.  
  235.                   GoToXY( H_Pos - 4  , J + 6 );
  236.                   WRITE( ( TrTab_Base + L_Char):3, '=', K:3,'  ');
  237.                   GoToXY( H_Pos , J + 6 );
  238.  
  239.                END  (* Digit *);
  240.  
  241.          UNTIL  Done;
  242.  
  243.          Clear_Window;
  244.          GoToXY( 2 , 5 );
  245.          WRITE('Enter file name to write definitions to (CR to exit): ');
  246.          Read_Edited_String( Translate_File_Name );
  247.          WRITELN;
  248.  
  249.          IF Translate_File_Name = CHR( ESC ) THEN
  250.             Translate_File_Name := '';
  251.  
  252.          IF LENGTH( Translate_File_Name ) > 0 THEN
  253.             BEGIN
  254.  
  255.                IF ( POS( '.', Translate_File_Name ) = 0 ) THEN
  256.                   Translate_File_Name := Translate_File_Name + '.TRA';
  257.  
  258.                ASSIGN( TrTab_File , Translate_File_Name );
  259.                   (*!I-*)
  260.                REWRITE( TrTab_File );
  261.                   (*!I+*)
  262.  
  263.                IF Int24Result <> 0 THEN
  264.                   BEGIN (* File bad *)
  265.  
  266.                      GoToXY( 2 , 5 );
  267.                      WRITE('*** File ',Translate_File_Name,' can''t be opened.');
  268.                      ClrEol;
  269.  
  270.                      Window_Delay;
  271.  
  272.                   END   (* File bad *)
  273.                ELSE
  274.                   BEGIN (* File OK, definition written *)
  275.  
  276.                      FOR I := 0 TO 255 DO
  277.                         WRITELN( TrTab_File, I:3, ' ', ORD(TrTab[CHR(I)]) );
  278.  
  279.                      CLOSE( TrTab_File );
  280.  
  281.                      GoToXY( 2 , 5 );
  282.  
  283.                      WRITE('Translation table definition written to ',
  284.                             Translate_File_Name );
  285.  
  286.                      ClrEol;
  287.  
  288.                      Window_Delay;
  289.  
  290.                   END   (* File OK, definition written *);
  291.  
  292.             END;
  293.  
  294.       END   (* Get translation table definition from keyboard *)
  295.    ELSE
  296.       BEGIN (* Get definition from file *)
  297.  
  298.          IF ( POS( '.' , Translate_File_Name ) = 0 ) THEN
  299.             Translate_File_Name := Translate_File_Name + '.TRA';
  300.  
  301.          ASSIGN( TrTab_File , Translate_File_Name );
  302.              (*!I-*)
  303.          RESET ( TrTab_File );
  304.              (*!I+*)
  305.  
  306.          IF Int24Result <> 0 THEN
  307.             BEGIN (* File bad *)
  308.                WRITELN;
  309.                WRITELN('*** File ',Translate_File_Name,' can''t be found.');
  310.                Window_Delay;
  311.             END   (* File bad *)
  312.          ELSE
  313.             BEGIN (* File OK, read definition *)
  314.  
  315.                REPEAT
  316.                       (*!I-*)
  317.                   READLN( TrTab_File , I, J );
  318.                       (*!I+*)
  319.                   IF Int24Result = 0 THEN
  320.                      IF ( I >= 0 ) AND ( I <= 255 ) AND
  321.                         ( J >= 0 ) AND ( J <= 255 ) THEN
  322.                         TrTab[CHR(I)] := CHR( J );
  323.  
  324.                UNTIL( EOF( TrTab_File ) );
  325.  
  326.                WRITELN('Translation table definition loaded.');
  327.  
  328.                Window_Delay;
  329.  
  330.                CLOSE( TrTab_File );
  331.  
  332.             END   (* File OK, read definition *);
  333.  
  334.       END   (* Get definition from file *);
  335.  
  336.                                    (* Restore previous screen          *)
  337.  
  338.    Restore_Screen_And_Colors( Saved_Screen );
  339.  
  340. END   (* Set_Translate_Table *);
  341.