home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / xtable.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  139 lines
  1. ############################################################################
  2. #
  3. #    File:     xtable.icn
  4. #
  5. #    Subject:  Program to show character code translations
  6. #
  7. #    Author:   Robert J. Alexander, modified by Alan Beale
  8. #
  9. #    Date:     July 20, 1991
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  Program to print various character translation tables.  See
  18. #  procedure help() for the capabilities.
  19. #
  20. ############################################################################
  21. #
  22. #  Links: options, colmize, hexcvt, ebcdic
  23. #
  24. ############################################################################
  25.  
  26. link options, colmize, hexcvt, ebcdic
  27.  
  28. global Graphic, Conv
  29.  
  30. procedure main(arg)
  31.    local opt
  32.  
  33.    opt := options(arg,"acedo")
  34.    Conv := if \opt["d"] then "d" else if \opt["o"] then "o"
  35.    init()
  36.    every write(colmize(
  37.      if \opt["a"] then ASCII()
  38.      else if \opt["e"] then EBCDIC()
  39.      else if \opt["c"] then ASCIICtrl()
  40.      else help()
  41.    ))
  42. end
  43.  
  44. procedure help()
  45.    write("Usage: xtable -<option>")
  46.    write("Options:")
  47.    write("\ta: ASCII table")
  48.    write("\tc: ASCII control char table")
  49.    write("\te: EBCDIC table")
  50.    write("\td: decimal numbers")
  51.    write("\te: octal numbers")
  52. end
  53.  
  54. procedure init()
  55.    Graphic := cset(Ascii128()[33:-1])
  56. end
  57.  
  58. procedure ASCII()
  59.    local c,i,lst,a128
  60.    lst := []
  61.    a128 := Ascii128()
  62.    every c := !a128 do {
  63.       i := AsciiOrd(c)
  64.       if not any(Graphic,c) then {
  65.      c := image(c)[2:-1]
  66.      if match("\\x",c) then next
  67.      }
  68.       put(lst,"|  " || convert(i) || " " || c)
  69.       }
  70.    return lst
  71. end
  72.  
  73. procedure ASCIICtrl()
  74.    local a,c,ctrls,i,lst,a128
  75.    ctrls := "\^ \^!\^"\^#\^$\^%\^&\^'\^(\^)\^*\^+\^,\^-\^.\^/_
  76.      \^0\^1\^2\^3\^4\^5\^6\^7\^8\^9\^:\^;\^<\^=\^>\^?\^@_
  77.      \^A\^B\^C\^D\^E\^F\^G\^H\^I\^J\^K\^L\^M_
  78.      \^N\^O\^P\^Q\^R\^S\^T\^U\^V\^W\^X\^Y\^Z_
  79.      \^[\^\\^]\^^\^_\^`_
  80.      \^a\^b\^c\^d\^e\^f\^g\^h\^i\^j\^k\^l\^m_
  81.      \^n\^o\^p\^q\^r\^s\^t\^u\^v\^w\^x\^y\^z_
  82.      \^{\^|\^}\^~"
  83.    lst := []
  84.    a128 := Ascii128()
  85.    a := create !a128[33:-1]
  86.    every c := !ctrls do {
  87.       i := AsciiOrd(c)
  88.       put(lst,"|  " || convert(i) || " ^" || @a)
  89.       }
  90.    return lst
  91. end
  92.  
  93. procedure EBCDIC()
  94.    local EBCDICMap,c,i,lst
  95.    EBCDICMap := repl(".",64) ||                    # 00 - 3F
  96.      " ...........<(+|&.........!$*);^" ||     # 40 - 5F
  97.      "-/.........,%_>?.........`:#@'=\"" ||    # 60 - 7F
  98.      ".abcdefghi.......jklmnopqr......" ||     # 80 - 9F
  99.      ".~stuvwxyz...[...............].." ||     # A0 - BF
  100.      "{ABCDEFGHI......}JKLMNOPQR......" ||     # C0 - CF
  101.      "\\.STUVWXYZ......0123456789......"       # E0 - FF
  102.    lst := []
  103.    i := -1
  104.    every c := !EBCDICMap do {
  105.       i +:= 1
  106.       if i = 16r4B | "." ~== c then
  107.         put(lst,"|  " || convert(i) || " " || c)
  108.       }
  109.    return lst
  110. end
  111.  
  112. procedure convert(n)
  113.    return case Conv of {
  114.       "d": right(n,3,"0")
  115.       "o": octstring(n,3)
  116.       default: hexstring(n,2)
  117.       }
  118. end
  119.  
  120. #
  121. #  octstring() -- Returns a string that is the octal
  122. #  representation of the argument.
  123. #
  124. procedure octstring(i,n)
  125.    local s
  126.    i := integer(i) | fail
  127.    if i = 0 then s := "0"
  128.    else {
  129.     s := ""
  130.     while i ~= 0 do {
  131.         s := iand(i,7) || s
  132.         i := ishift(i,-3)
  133.         }
  134.     }
  135.    s := right(s,\n,"0")
  136.    return s
  137. end
  138.  
  139.