home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / ascii2cp.zip / ascii.cmd next >
OS/2 REXX Batch file  |  2002-05-18  |  19KB  |  387 lines
  1. /* ascii translator */
  2.    signal on novalue name TRAP
  3.    parse arg INPUT                     /* arguments */
  4.    parse upper source . . NAME         /* program name */
  5.  
  6.    AS =     'NUL SOH STX ETX EOT ENQ ACK BEL'   /* DEL aka ^?  (*IX) */
  7.    AS = AS  'BS  HT  LF  VT  FF  CR  SO  SI '   /* HT  aka TAB (all) */
  8.    AS = AS  'DLE DC1 DC2 DC3 DC4 NAK SYN ETB'   /* LF  aka EOL (*IX) */
  9.    AS = AS  'CAN EM  SUB ESC FS  GS  RS  US '   /* SUB aka EOF (DOS) */
  10.    /* DEL (127) handled separately, FF (12) listed too as \xFF (255) */
  11.  
  12.    FLAG = 0 ;  LAST = 0                /* FLAG no range; LAST output */
  13.    BOXM = d2c( 196 )                   /* for dumb terminals use '-' */
  14.    BOXP = d2c( 197 )                   /* for dumb terminals use '+' */
  15.    BOXB = d2c( 179 )                   /* for dumb terminals use '|' */
  16.    SKIP = '00 07 08 09 0A 0D 1A 1B'x   /* char.s interpreted by CON  */
  17.    EXPO = 'NAME WORD AS BOXB BOXM BOXP SKIP'    /* global variables  */
  18.  
  19.    if INPUT = '' then do
  20.       say   ;  say 'usage:' NAME '<argument> [...]'
  21.       X =   'where <argument> can have the form:' BOXB
  22.       say X '  cc    hexadecimal digits 00 .. FE'
  23.       X =   '  c     a printable ASCII character' BOXB
  24.       say X '  cc    ASCII code symbol (e.g. CR)'
  25.       X =   '  \c    C escape sequence (e.g. \r)' BOXB
  26.       say X '  ccc   ASCII code symbol like ACK '
  27.       X =   '  ^c    ^@ .. ^_ or ^? control code' BOXB
  28.       say X '  ..    indicates argument subrange'
  29.       X =   '  ??c   ANSI C trigraphs (e.g. ??/)' BOXB
  30.       say X '  ...   indicates argument subrange'
  31.       X =   '  \ccc  octal  sequence (e.g. \015)' BOXB
  32.       say X '  ALL   list 33 ASCII control codes'
  33.       X =   '  \xcc  C hex. sequence (e.g. \x0D)' BOXB
  34.       say X '  AKA   list other character names '
  35.       X =   '  ccc   3 decimal digits 000 .. 255' BOXB
  36.       say X '  ISO   list 20 ISO C sequences    '
  37.       X =   '  256   256 untranslated characters' BOXB
  38.       say X '  IBM   difference codepage 437/850'
  39.       X = 'For codes above 127 DEL the current'
  40.       say X 'codepage is used.  Caveat: \e is no C.'
  41.       X = 'Except from lists like ALL or 256 the'
  42.       say X 'result shows all translations as in:'
  43.       do X = 7 to 9
  44.          say ASCII( X )
  45.       end
  46.       say copies( BOXM, 76 )
  47.       call charout ,'enter argument(s): '
  48.       parse pull INPUT
  49.    end
  50.    say
  51.    do while INPUT > ''
  52.       parse var INPUT WORD INPUT
  53.       if left( WORD, 1 ) = '"' then do       /* get rid of "?" */
  54.          parse var WORD '"' THIS '"' X       /* (shell escape) */
  55.          if THIS > '' & X = '' then WORD = THIS
  56.       end
  57.       select
  58.          when WORD = '^>' then WORD = '>'    /* shell escape */
  59.          when WORD = '^<' then WORD = '<'    /* shell escape */
  60.          when WORD = '^|' then WORD = '|'    /* shell escape */
  61.          otherwise nop
  62.       end
  63.       THIS = translate( WORD )               /* upper case */
  64.       select
  65.          when WORD = '..'     then FLAG = 1  /* range flag */
  66.          when WORD = '...'    then FLAG = 1  /* range flag */
  67.          when THIS = '256'    then do  /* ----------- */
  68.             do X = -3 to 0    /* 000 .. 015 after 3 header lines */
  69.                say TABLE( X )
  70.             end X
  71.             say TABLE( 16 )   /* 000 .. 015 symbolic: ASCII names */
  72.             say TABLE( 17 )   /* 016 .. 031 symbolic: ASCII names */
  73.             do X = 1 to 15    /* 016 .. 255 graphical  (16 lines) */
  74.                say TABLE( X ) ;  if X = 7 then say TABLE( -1 )
  75.             end X
  76.          end                           /* end of TABLE */
  77.          when THIS = 'ALL'    then do  /* ----------- */
  78.             say SPLIT() SPLIT( 0 )     /* 36 / 2 lines */
  79.             do X = 1 to 31 by 2
  80.                say SPLIT( X ) SPLIT( X + 1 )
  81.             end X
  82.             say SPLIT( 127 ) SPLIT( 255 )
  83.          end                           /* end of ASCII control codes */
  84.          when THIS = 'AKA'    then do  /* ----------- */
  85.             X =   'TAB EOL FF EOF SP DEL NOT RSP'
  86.             do while X > ''
  87.                parse var X THIS X   ;  say ASCII( DECODE( THIS ))
  88.             end
  89.          end                           /* end of alias stuff */
  90.          when THIS = 'ISO'    then do  /* ----------- */
  91.             X =   '  7   8   9  10  11  12  13  27  34  35'
  92.             X = X ' 39  63  91  92  93  94 123 124 125 126'
  93.             say SPLIT() SPLIT( 0 )     /* incl. invalid \e */
  94.             do while X > ''            /* even item number */
  95.                parse var X THIS WORD X
  96.                say SPLIT( THIS ) SPLIT( WORD )
  97.             end
  98.          end                           /* end of ISO C sequences */
  99.          when THIS = 'IBM'    then do  /* ----------- */
  100.             do X = -3 to -1   ;  say TABLE( X ) ;  end X
  101.             say CODES(  9,                        11    13 14    )
  102.             say CODES( 10,                   9                   )
  103.             say CODES( 11,           5 6 7 8            13 14    )
  104.             say CODES( 12,             6 7                    15 )
  105.             say CODES( 13, 0 1 2 3 4 5 6 7 8            13 14    )
  106.             say CODES( 14, 0   2 3 4 5   7 8 9 10 11 12 13 14 15 )
  107.             say CODES( 15, 0   2 3 4 5   7   9    11 12          )
  108.          end                           /* end of codepage 437 */
  109.          otherwise                     /* ----------- */
  110.             THIS = DECODE( WORD )      /* decode input word */
  111.             if FLAG & ( LAST > THIS )  then do X = LAST-2 to THIS by -1
  112.                say ASCII( X )          /* descending range */
  113.             end X
  114.             else if FLAG               then do X = LAST     to THIS
  115.                say ASCII( X )          /*  ascending range */
  116.             end  X
  117.             else do
  118.                say ASCII( THIS )       /* here FF is ambiguous: */
  119.                if translate( WORD ) = 'FF' then say ASCII( 255 )
  120.             end
  121.             FLAG = 0 ;  LAST = THIS + 1
  122.       end                              /* end of select THIS */
  123.    end                                 /* end of do while INPUT > '' */
  124.    exit 0                              /* no error detected */
  125.  
  126. SPLIT:   procedure expose (EXPO) /* ----------------------------- */
  127.    if arg() = 1 then do
  128.       X = ASCII( arg( 1 ))
  129.       parse var X . X.1 ' = ' X.2 ' = ' X.3 ' = ' X.4 ' = ' X.5
  130.       X = 'aka graphical C'
  131.       do while X > ''                  /* get rid of verbose text */
  132.          parse var X Y X   ;  Z = pos( ' =' Y, X.5 )
  133.          if Z = 0 then do
  134.             if Y = 'C' then Y = ' ' ;  Z = pos( '' Y, X.5 )
  135.             if Z > 0 then  X.5 = delstr( X.5, Z, 1 + length( Y ))
  136.          end
  137.          else  X.5 = delstr( X.5, Z, 3 + length( Y ))
  138.       end
  139.       X = right( X.1, 5 ) '|' X.2 '|' X.3 '|' X.4 '|' X.5
  140.    end
  141.    else X = 'ASCII | hex. | dec | oct. | aka'
  142.    return left( X, 39 )
  143.  
  144. CODES:   procedure expose (EXPO) /* ----------------------------- */
  145.    LINE = TABLE( arg( 1 ))
  146.    do I = 0 to 15
  147.       if wordpos( I, arg( 2 )) > 0 then iterate I
  148.       LINE = overlay( ' ', LINE, 14 + 4 * I + 2 * ( 7 < I ))
  149.    end I
  150.    if arg( 1 ) = 9 | arg( 1 ) = 10 then do
  151.       if arg( 1 ) = 9   then I = ' CodePage 437 vs 850 differences'
  152.                         else I = ' (characters 000..154 identical)'
  153.       LINE = overlay( I, LINE, 12 )
  154.    end
  155.    return LINE
  156.  
  157. TABLE:   procedure expose (EXPO) /* ----------------------------- */
  158.    select
  159.       when arg( 1 ) = -3 then do          /* 1st header line: */
  160.          LINE = '    oct   ' || BOXB copies( ' ', 31 ) BOXB || ''
  161.          return LINE '10  11  12  13  14  15  16  17 ' BOXB
  162.       end
  163.       when arg( 1 ) = -2 then do          /* 2nd header line: */
  164.          LINE = 'dec    hex' || BOXB
  165.          LINE = LINE ' 0   1   2   3   4   5   6   7 ' BOXB || ''
  166.          return LINE ' 8   9   A   B   C   D   E   F ' BOXB
  167.       end
  168.       when arg( 1 ) = -1 then do          /* 3rd header line: */
  169.          LINE = copies( BOXM, 10 ) || BOXP || copies( BOXM, 33 )
  170.          return LINE || BOXP || copies( BOXM, 33 ) || BOXP
  171.       end
  172.       when arg( 1 ) <  4 then LINE = '0'  /* octal 000 .. 077 */
  173.       when arg( 1 ) <  8 then LINE = '1'  /* octal 100 .. 177 */
  174.       when arg( 1 ) < 12 then LINE = '2'  /* octal 200 .. 277 */
  175.       when arg( 1 ) < 16 then LINE = '3'  /* octal 300 .. 377 */
  176.       when arg( 1 ) = 16 then do       /* ASCII 000 .. 015 */
  177.          LINE = '  0 000 00' || BOXB || '.'           /* decimal '.' */
  178.          LINE = LINE || subword( AS,  1, 8 ) BOXB ''  /* octal range */
  179.          LINE = LINE || subword( AS,  9, 2 ) || ' .'  /* decimal '.' */
  180.          return LINE || subword( AS, 11, 6 ) '' BOXB  /* octal range */
  181.       end
  182.       when arg( 1 ) = 17 then do       /* ASCII 016 .. 031 */
  183.          LINE = ' 16 020 10' || BOXB || ' '
  184.          LINE = LINE || subword( AS, 17, 4 ) || '.'   /* decimal '.' */
  185.          LINE = LINE || subword( AS, 21, 4 ) BOXB ''  /* octal range */
  186.          LINE = LINE || subword( AS, 25, 6 ) || ' .'  /* decimal '.' */
  187.          return LINE || subword( AS, 31, 2 ) '' BOXB  /* octal range */
  188.       end
  189.       otherwise nop
  190.    end
  191.    LINE =      right( 16 * arg( 1 ), 3 ) LINE
  192.    LINE = LINE || 2 * arg( 1 ) // 8 || '0'
  193.    LINE = LINE d2x( arg( 1 )) || '0' || BOXB
  194.  
  195.    do X = 16 * arg( 1 ) to 16 * arg( 1 ) + 15
  196.       if sign( X // 10 )
  197.          then LINE = LINE || ' '
  198.          else LINE = LINE || '.'       /* decimal marker */
  199.       if 0 < verify( d2c( X ), SKIP )
  200.          then LINE = LINE d2c( X ) || ' '
  201.          else LINE = LINE || '^' || d2c( X + 64 ) ''
  202.       if X // 16 = 7
  203.          then LINE = LINE BOXB         /* octal range */
  204.    end X
  205.    return LINE BOXB
  206.  
  207. ASCII:   procedure expose (EXPO) /* ----------------------------- */
  208.    parse arg D                         /* 0..255 (leading 0 okay) */
  209.    select                              /* A = also known as       */
  210.       when D =   0 then A = '= C \0'
  211.       when D =   7 then A = '= C \a'                  /* Alert */
  212.       when D =   8 then A = '= C \b'                  /* BS */
  213.       when D =   9 then A = '= C \t = aka TAB'
  214.       when D =  10 then A = '= C \n = aka EOL'        /* New line */
  215.       when D =  11 then A = '= C \v'                  /* VT */
  216.       when D =  12 then A = '= C \f'                  /* FF */
  217.       when D =  13 then A = '= C \r'                  /* Return */
  218.       when D =  26 then A = '= aka EOF'               /* only DOS */
  219.       when D =  27 then A = '= aka \e not C'          /* ESC */
  220.       when D =  32 then A = "=      graphical ' '"
  221.       when D =  34 then A = '= C \"'                  /* " */
  222.       when D =  35 then A = '= C ??='                 /* # */
  223.       when D =  39 then A = "= C \'"                  /* ' */
  224.       when D =  63 then A = '= C \?'                  /* ? */
  225.       when D =  91 then A = '= C ??('                 /* [ */
  226.       when D =  92 then A = '= C ??/ = C \\'          /* \ */
  227.       when D =  93 then A = '= C ??)'                 /* ] */
  228.       when D =  94 then A = "= C ??'"                 /* ^ */
  229.       when D = 123 then A = '= C ??<'                 /* { */
  230.       when D = 124 then A = '= C ??!'                 /* | */
  231.       when D = 125 then A = '= C ??>'                 /* } */
  232.       when D = 126 then A = '= C ??-'                 /* ~ */
  233.       when D = 127 then A = "= ^? = graphical '" || d2c(D) || "'"
  234.       when D = 170 then A = '= aka NOT'               /* REXX */
  235.       when D = 255 then A = "=      graphical '" || d2c(D) || "'"
  236.       when D < 256 then A = ''                        /* no AKA */
  237.       otherwise   exit FAIL( D )
  238.    end
  239.    C = " " || d2c( D ) || " "          /* default: character */
  240.    if D = 127 then C = 'DEL'           /* replace symbol */
  241.    if D =  32 then C = ' SP'           /* replace symbol */
  242.    if D = 255 then C = 'RSP'           /* replace symbol */
  243.    if D <  32 then do                  /* replace symbol */
  244.       C = '= ^' || d2c( D + 64 )       /* control code logic */
  245.       if 0 < verify( d2c( D ), SKIP )  /* skip non-printable */
  246.          then C = C "= graphical '" || d2c( D ) || "'"
  247.       A = C A                          /* symbol and AKA */
  248.       C = right( word( AS, D + 1 ), 3 )
  249.    end
  250.    H = right( d2x( D ), 2, '0' ) ;  D = right( D, 3 )
  251.    Q = D // 8  ; O = ( D - Q ) % 8
  252.    P = O // 8  ; O = ( O - P ) % 8
  253.    return 'ASCII' C '= \x' || H '=' D '= \' || O || P || Q A
  254.  
  255. DECODE:  procedure expose (EXPO) /* ----------------------------- */
  256.    parse arg X
  257.    T = translate( X )   ;  R = wordpos( T, AS ) ;  L = length( X )
  258.    select
  259.       when L = 0     then  return 32
  260.       when L = 1     then  return c2d( X )
  261.       when 0 < R     then  return R - 1
  262.       when L = 2 & datatype( T, 'X' )  then return x2d( X )
  263.       when L = 3 & datatype( T, 'W' )  then return X
  264.       when T = 'DEL' then  return 127
  265.       when T = '\A'  then  return   7  /* aka Alarm */
  266.       when T = '\B'  then  return   8  /* BS, BackSpace */
  267.       when T = 'TAB' then  return   9  /* HT, Hor. Tab */
  268.       when T = '\T'  then  return   9  /* aka Tabstop */
  269.       when T = '\N'  then  return  10  /* aka Newline */
  270.       when T = 'EOL' then  return  10  /* only for *IX */
  271.       when T = '\V'  then  return  11  /* VT, Vert. Tab */
  272.       when T = '\F'  then  return  12  /* FF, FormFeed */
  273.       when T = '\R'  then  return  13  /* CR, Return */
  274.       when T = 'EOF' then  return  26  /* only for DOS */
  275.       when T = '\E'  then  return  27  /* ESC (not C) */
  276.       when T = 'SP'  then  return  32  /* SPace, blank */
  277.       when X = '\"'  then  return  34  /* " in strings */
  278.       when X = '??=' then  return  35  /* # ISO 6 bits */
  279.       when X = "\'"  then  return  39  /* ' in char.s */
  280.       when X = '\?'  then  return  63  /* ? literally */
  281.       when X = '??(' then  return  91  /* [ ISO 6 bits */
  282.       when X = '\\'  then  return  92  /* \ un-escaped */
  283.       when X = '??/' then  return  92  /* \ ISO 6 bits */
  284.       when X = '??)' then  return  93  /* ] ISO 6 bits */
  285.       when X = "??'" then  return  94  /* ^ ISO 6 bits */
  286.       when X = '??<' then  return 123  /* { ISO 6 bits */
  287.       when X = '??!' then  return 124  /* | ISO 6 bits */
  288.       when X = '??>' then  return 125  /* } ISO 6 bits */
  289.       when X = '??-' then  return 126  /* ~ ISO 6 bits */
  290.       when X = '^?'  then  return 127  /* only for *IX */
  291.       when T = 'NOT' then  return 170  /* used by REXX */
  292.       when T = 'RSP' then  return 255  /* RSPace (???) */
  293.       otherwise
  294.          parse var X T 2 X
  295.          select                     /* split X in Type & characters */
  296.             when length( X ) < 1 then nop    /* too less  characters */
  297.             when length( X ) > 3 then nop    /* too many  characters */
  298.             when ( T = '^' ) & ( 1 = length( X )) then do
  299.                X = c2d( translate( X )) - 64
  300.                if ( 0 <= X ) & ( X < 32 ) then return X
  301.             end                              /* ^@,A ... Z,[,\,],^,_ */
  302.             when ( translate( T ) = 'X' ) then do
  303.                if datatype( X, 'X' ) then return x2d( X )
  304.             end
  305.             when ( T = '\' ) & ( 'x' = left( X, 1 )) then do
  306.                X = substr( X, 2, 2, '.' )    /* \x00 ... FF (ANSI C) */
  307.                if datatype( X, 'X' ) then return x2d( X )
  308.             end
  309.             when ( T = '\' ) & ( verify( X, '01234567' ) = 0 ) then do
  310.                if X > 377 then exit FAIL( X )
  311.                X = right( X, 3, '0' )        /* \0 ... 377 (octal C) */
  312.                return 64 * left(X,1) + 8 * substr(X,2,1) + right(X,1)
  313.             end
  314.             otherwise nop                    /* drop to exit FAIL(X) */
  315.          end
  316.    end
  317.    exit FAIL( X )
  318.  
  319. FAIL:    procedure expose (EXPO) /* ----------------------------- */
  320.    NAME = WORD 'unknown, try char C, hex XX, dec DDD, oct \OOO, or AKA'
  321.    if trace() <> 'N' then do
  322.       NAME = 'parser state' arg( 1 ) || x2c( 0A ) || NAME
  323.       exit TRAP( NAME )
  324.    end
  325.    say NAME ;  return 1
  326.  
  327. TRAP:                            /* select REXX exception handler */
  328.    call trace 'O' ;  trace N           /* don't trace interactive */
  329.    parse source TRAP                   /* source on separate line */
  330.    TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
  331.    TRAP = TRAP || right( '+++', 10 )   /* = standard trace prefix */
  332.    TRAP = TRAP condition( 'c' ) 'trap:' condition( 'd' )
  333.    select
  334.       when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
  335.          if condition( 'd' ) > ''      /* need an additional line */
  336.             then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
  337.          TRAP = TRAP '(RC' rc || ')'   /* any system error codes  */
  338.          if condition( 'c' ) = 'FAILURE' then rc = -3
  339.       end
  340.       when wordpos( condition( 'c' ), 'HALT SYNTAX'   ) > 0 then do
  341.          if condition( 'c' ) = 'HALT' then rc = 4
  342.          if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
  343.             if condition( 'd' ) <> errortext( rc ) then do
  344.                TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
  345.                TRAP = TRAP errortext( rc )
  346.             end                        /* future condition( 'd' ) */
  347.          end                           /* may use errortext( rc ) */
  348.          else  TRAP = TRAP errortext( rc )
  349.          rc = -rc                      /* rc < 0: REXX error code */
  350.       end
  351.       when condition( 'c' ) = 'NOVALUE'  then rc = -2 /* dubious  */
  352.       when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious  */
  353.       otherwise                        /* force non-zero whole rc */
  354.          if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
  355.          if condition() = '' then TRAP = TRAP arg( 1 )
  356.    end                                 /* direct: TRAP( message ) */
  357.  
  358.    TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
  359.    signal on syntax name TRAP.SIGL     /* throw syntax error 3... */
  360.    if 0 < sigl & sigl <= sourceline()  /* if no handle for source */
  361.       then TRAP = TRAP '*-*' strip( sourceline( sigl ))
  362.       else TRAP = TRAP '+++ (source line unavailable)'
  363. TRAP.SIGL:                             /* ...catch syntax error 3 */
  364.    if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
  365.       TRAP = TRAP '+++ (source line unreadable)'   ;  rc = -rc
  366.    end
  367.    select
  368.       when 0 then do                   /* in pipes STDERR: output */
  369.          parse version TRAP.REXX . .   /* REXX/Personal: \dev\con */
  370.          signal on syntax name TRAP.FAIL
  371.          if TRAP.REXX = 'REXXSAA'      /* fails if no more handle */
  372.             then call lineout 'STDERR'  , TRAP
  373.             else call lineout '\dev\con', TRAP
  374.       end
  375.       when 0 then do                   /* OS/2 PM: RxMessageBox() */
  376.          signal on syntax name TRAP.FAIL
  377.          call RxMessageBox ,           /* fails if not in PMREXX  */
  378.             translate( TRAP, ' ', x2c( 0D )), , 'CANCEL', 'WARNING'
  379.       end                              /* replace any CR by blank */
  380.       otherwise   say TRAP ; trace ?L  /* interactive Label trace */
  381.    end
  382.  
  383.    if condition() = 'SIGNAL' then signal TRAP.EXIT
  384. TRAP.CALL:  return rc                  /* continue after CALL ON  */
  385. TRAP.FAIL:  say TRAP ;  rc = 0 - rc    /* force TRAP error output */
  386. TRAP.EXIT:  exit   rc                  /* exit for any SIGNAL ON  */
  387.