summaryrefslogtreecommitdiff
path: root/ipl/progs/xtable.icn
blob: afa9061da012b799a383d5e2e49485c282cdf0d7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
############################################################################
#
#	File:     xtable.icn
#
#	Subject:  Program to show character code translations
#
#	Author:   Robert J. Alexander, modified by Alan Beale
#
#	Date:     July 20, 1991
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  Program to print various character translation tables.  See
#  procedure help() for the capabilities.
#
############################################################################
#
#  Links: options, colmize, hexcvt, ebcdic
#
############################################################################

link options, colmize, hexcvt, ebcdic

global Graphic, Conv

procedure main(arg)
   local opt

   opt := options(arg,"acedo")
   Conv := if \opt["d"] then "d" else if \opt["o"] then "o"
   init()
   every write(colmize(
	 if \opt["a"] then ASCII()
	 else if \opt["e"] then EBCDIC()
	 else if \opt["c"] then ASCIICtrl()
	 else help()
   ))
end

procedure help()
   write("Usage: xtable -<option>")
   write("Options:")
   write("\ta: ASCII table")
   write("\tc: ASCII control char table")
   write("\te: EBCDIC table")
   write("\td: decimal numbers")
   write("\te: octal numbers")
end

procedure init()
   Graphic := cset(Ascii128()[33:-1])
end

procedure ASCII()
   local c,i,lst,a128
   lst := []
   a128 := Ascii128()
   every c := !a128 do {
      i := AsciiOrd(c)
      if not any(Graphic,c) then {
	 c := image(c)[2:-1]
	 if match("\\x",c) then next
	 }
      put(lst,"|  " || convert(i) || " " || c)
      }
   return lst
end

procedure ASCIICtrl()
   local a,c,ctrls,i,lst,a128
   ctrls := "\^ \^!\^"\^#\^$\^%\^&\^'\^(\^)\^*\^+\^,\^-\^.\^/_
	 \^0\^1\^2\^3\^4\^5\^6\^7\^8\^9\^:\^;\^<\^=\^>\^?\^@_
	 \^A\^B\^C\^D\^E\^F\^G\^H\^I\^J\^K\^L\^M_
	 \^N\^O\^P\^Q\^R\^S\^T\^U\^V\^W\^X\^Y\^Z_
	 \^[\^\\^]\^^\^_\^`_
	 \^a\^b\^c\^d\^e\^f\^g\^h\^i\^j\^k\^l\^m_
	 \^n\^o\^p\^q\^r\^s\^t\^u\^v\^w\^x\^y\^z_
	 \^{\^|\^}\^~"
   lst := []
   a128 := Ascii128()
   a := create !a128[33:-1]
   every c := !ctrls do {
      i := AsciiOrd(c)
      put(lst,"|  " || convert(i) || " ^" || @a)
      }
   return lst
end

procedure EBCDIC()
   local EBCDICMap,c,i,lst
   EBCDICMap := repl(".",64) ||                    # 00 - 3F
	 " ...........<(+|&.........!$*);^" ||     # 40 - 5F
	 "-/.........,%_>?.........`:#@'=\"" ||    # 60 - 7F
	 ".abcdefghi.......jklmnopqr......" ||     # 80 - 9F
	 ".~stuvwxyz...[...............].." ||     # A0 - BF
	 "{ABCDEFGHI......}JKLMNOPQR......" ||     # C0 - CF
	 "\\.STUVWXYZ......0123456789......"       # E0 - FF
   lst := []
   i := -1
   every c := !EBCDICMap do {
      i +:= 1
      if i = 16r4B | "." ~== c then
	    put(lst,"|  " || convert(i) || " " || c)
      }
   return lst
end

procedure convert(n)
   return case Conv of {
      "d": right(n,3,"0")
      "o": octstring(n,3)
      default: hexstring(n,2)
      }
end

#
#  octstring() -- Returns a string that is the octal
#  representation of the argument.
#
procedure octstring(i,n)
   local s
   i := integer(i) | fail
   if i = 0 then s := "0"
   else {
	s := ""
	while i ~= 0 do {
	    s := iand(i,7) || s
	    i := ishift(i,-3)
	    }
	}
   s := right(s,\n,"0")
   return s
end