Project

General

Profile

cp_coll.p

Eric Faulhaber, 03/05/2021 05:17 PM

Download (3.4 KB)

 
1
define temp-table tt1 no-undo
2
   field codepoint as int
3
   field encoded   as char
4
   index i1 is primary encoded.
5

    
6
define var codepage as char format "x(18)".
7
define var basefile as char format "x(64)".
8
define var i        as int  format "99".
9
define var enc      as char.
10

    
11
define stream outstr.
12

    
13
/*
14
 * Generate a two-digit hex string from an integer. No error checking, simplified
15
 * padding. The only expected inputs are 0 through 255.
16
 */
17
function toHex returns char (num as int):
18
   
19
   def var hex     as char.
20
   def var rawByte as raw.
21
   
22
   do while num > 0:
23
      put-byte(rawByte, 1) = num mod 256.
24
      hex = upper(string(hex-encode(rawByte))) + hex.
25
      num = truncate(num / 256, 0).
26
   end.
27
   
28
   return hex.
29
   
30
end.
31

    
32
/*
33
 * Write the table header to the output stream.
34
 */
35
procedure putHeader:
36

    
37
   put stream outstr
38
      " codepoint | hex | character |  lower   |  upper   " skip
39
      "-----------+-----+-----------+----------+----------" skip.
40
      
41
end.
42

    
43
/*
44
 * Write a row of formatted data to the output stream.
45
 */
46
procedure putRow:
47

    
48
   define input parameter cp  as int.
49
   define input parameter enc as char.
50
   
51
   put stream outstr
52
      cp         format "zzzzzzzzz9" "| " at 12
53
      toHex(cp)  format "XX" at 14   "| " at 18
54
      enc        format "X"  at 20   "| " at 30
55
      lc(enc)    format "X"  at 32   "| " at 41
56
      upper(enc) format "X"  at 43
57
      skip.
58
      
59
end.
60

    
61
/*
62
 * Compose filename from the base name passed into the program.
63
 */
64
function composeFilename returns char (suff as char):
65

    
66
   return basefile + "_" + codepage + "_" + suff + ".txt".
67
   
68
end.
69

    
70
// sanity check that we have a base filename (no extension) as a parameter
71
basefile = session:parameter.
72
if basefile = ? or basefile = "" then do:
73
   message "Program requires a base filename (no extension) as a parameter.".
74
   return error.
75
end.
76

    
77
// sanity check that internal code page is same as stream code page
78
codepage = session:cpinternal.
79
if codepage <> session:cpstream then do:
80
   message "Please ensure cpstream is the same as cpinternal".
81
   message "cpstream =" codepage "; cpinternal =" session:cpinternal.
82
   return error.
83
end.
84

    
85
// clear perm table
86
for each chardata exclusive-lock:
87
   delete chardata.
88
end.
89

    
90
// output data in codepoint order (no database involved)
91
output stream outstr to value(composeFilename("natural_order")).
92
run putHeader.
93
repeat i = 0 to 255:
94
   create tt1.
95
   create chardata.
96
   assign tt1.codepoint = i
97
          tt1.encoded = chr(i)
98
          chardata.codepoint = i
99
          chardata.encoded = chr(i).
100
   run putRow(i, chr(i)).
101
end.
102
output stream outstr close.
103

    
104
// output data sorted by temp-table's codepoint field
105
output stream outstr to value(composeFilename("natural_order_temp")).
106
run putHeader.
107
for each tt1 by tt1.codepoint:
108
   run putRow(tt1.codepoint, tt1.encoded).
109
end.
110
output stream outstr close.
111

    
112
// output data sorted by temp-table's encoded field
113
output stream outstr to value(composeFilename("collation_temp")).
114
run putHeader.
115
for each tt1 by tt1.encoded:
116
   run putRow(tt1.codepoint, tt1.encoded).
117
end.
118
output stream outstr close.
119

    
120
// output data sorted by perm table's encoded field
121
output stream outstr to value(composeFilename("collation_perm")).
122
run putHeader.
123
for each chardata by chardata.encoded:
124
   run putRow(chardata.codepoint, chardata.encoded).
125
end.
126
output stream outstr close.