 |
» |
|
|
|
In this program, there are six different calls to NLSCANMOVE.
In every call, parameters are passed to NLSCANMOVE. Since the
upshift/downshift table and the character attributes table are optional
parameters, they may be omitted. For performance reasons
(if NLSCANMOVE is called frequently), they should be passed to the
intrinsic after being read in by the appropriate calls to NLINFO.
1 $CONTROL USLINIT
2 BEGIN
3 LOGICAL ARRAY
4 L'UPSHIFT (0:127),
5 L'DOWNSHIFT (0:127),
6 L'CHARSET (0:127),
7 L'ERROR (0:1),
8 L'INSTRING (0:34),
9 L'OUTSTRING (0:34),
10 L'PRINT (0:34),
11 L'LANGUAGE (0:7);
12
13 BYTE ARRAY
14 B'INSTRING(*) = L'INSTRING,
15 B'OUTSTRING(*) = L'OUTSTRING,
16 B'PRINT(*) = L'PRINT;
17
18 BYTE POINTER
19 BP'PRINT;
20
21 INTEGER
22 LANGNUM,
23 NUM'CHAR,
24 LGTH,
25 LENGTH;
26
27 LOGICAL
28 FLAGS;
29
30 DEFINE
31 LOWER'CASE = FLAGS.(15:1)#,
32 UPPER'CASE = FLAGS.(14:1)#,
33 NUMERIC'CHAR = FLAGS.(13:1)#,
34 SPECIAL'CHAR = FLAGS.(12:1)#,
35
36 WHILE'UNTIL = FLAGS.(11:1)#,
37
38 UPSHIFT'FLAG = FLAGS.(10:1)#,
39 DOWNSHIFT'FLAG = FLAGS.(9:1)#,
40
|
41 ERROR'CHECK = IF L'ERROR(0) <> 0 THEN
42 QUIT #,
43
44 CCNE = IF <> THEN
45 QUIT #,
46
47 DISPLAY = MOVE B'PRINT := #,
48
49 ON'STDLIST = ,2;
50 @BP'PRINT := TOS;
51 LGTH := LOGICAL(@BP'PRINT) -
52 LOGICAL(@B'PRINT);
53 PRINT(L'PRINT, -LGTH, 0) #;
54
55
56 INTRINSIC
57 READ,
58 QUIT,
59 PRINT,
60 NLINFO,
61 NLSCANMOVE;
62
63
64 << Start of main code.
65 Initializing the arrays.>>
66
67 MOVE B'INSTRING
68 := "abCDfg6ijkaSXbVcGjGf1f$E!SPO6dLe\1a23%&7",2;
69 MOVE * := "a 123&i12fSXgVhklKLabCDASPO6i";
70
71 MOVE L'OUTSTRING := " ";
72 MOVE L'OUTSTRING(1) := L'OUTSTRING,(39);
73
74 MOVE L'LANGUAGE := " ";
75 MOVE L'LANGUAGE(1) := L'LANGUAGE,(7);
76
77 << The user is asked to enter a language name or
78
79 DISPLAY
80 "ENTER A LANGUAGE NAME OR NUMBER (MAX. 16 CHARACTERS):"
81 ON'STDLIST;
82
83 READ(L'LANGUAGE,-16);
84
85 << NLINFO item 22 returns the corresponding language
86 number in integer format for this language.>>
87
88 NLINFO(22,L'LANGUAGE,LANGNUM,L'ERROR);
89 IF L'ERROR(0) <> 0 THEN
|
90 BEGIN
91 IF L'ERROR(0) = 1 THEN
92 BEGIN
93 DISPLAY
94 "NL/3000 IS NOT INSTALLED"
95 ON'STDLIST;
96 QUIT (1001);
97 END
98 ELSE
99 IF L'ERROR(0) = 2 THEN
100 BEGIN
101 DISPLAY
102 "THIS LANGUAGE IS NOT CONFIGURED"
103 ON'STDLIST;
104 QUIT (1002);
105 END
106 ELSE
107 QUIT (1000 + L'ERROR(0));
108 END;
109
110
111 << Obtain the character attributes table using
112 NLINFO item 12.>>
113
114 NLINFO(12,L'CHARSET,LANGNUM,L'ERROR);
115 ERROR'CHECK (2000 + L'ERROR(0));
116
117 << Obtain the upshift table using NLINFO item 15.>>
118
119 NLINFO(15,L'UPSHIFT,LANGNUM,L'ERROR);
120 ERROR'CHECK (3000 + L'ERROR(0));
121
122 << Obtain the downshift table using NLINFO item 16.>>
123
124 NLINFO(16,L'DOWNSHIFT,LANGNUM,L'ERROR);
125 ERROR'CHECK (4000 + L'ERROR(0));
126
127 << Print the character string used in all examples (instring).>>
128
129 DISPLAY
130 "THE FOLLOWING STRING IS USED IN ALL EXAMPLES:"
131 ON'STDLIST;
132 DISPLAY B'INSTRING,(70) ON'STDLIST;
133
|
134 EXAMPLE'1'1:
135 << The string passed in the array instring is moved and
136 UPSHIFTED to the array outstring.
137 Note: The 'until flag' is set. Therefore, the operation
138 continues until one of the ending criteria is true.
139 If no ending condition was set the
140 operation continues for the number of characters
141 contained in length.>>
142
143 LENGTH := 70;
144
145 FLAGS := 0;
146
147 WHILE'UNTIL := 1;
148 UPSHIFT'FLAG := 1;
149
150 NUM'CHAR := NLSCANMOVE(B'INSTRING, B'OUTSTRING, FLAGS,
151 LENGTH, LANGNUM, L'ERROR, L'CHARSET, L'UPSHIFT);
152 ERROR'CHECK (5000 + L'ERROR(0));
153
154 DISPLAY "UPSHIFTED: (EXAMPLE 1-1)" ON'STDLIST;
155 DISPLAY B'OUTSTRING,(NUM'CHAR) ON'STDLIST;
156
157 EXAMPLE'1'2:
158 << Note: The 'while flag' is set. Therefore, the operation will
159 continue while one of the end criteria is true. Since
160 all conditions are set, one of them will be always
161 true and the operation continues for the number of
162 characters contained in length. This example performs
163 the same operation as EXAMPLE 1-1.>>
164
165 MOVE L'OUTSTRING := " ";
166 MOVE L'OUTSTRING(1) := L'OUTSTRING,(39);
167
168 FLAGS := 0;
169
170 LOWER'CASE := 1;
171 UPPER'CASE := 1;
172 SPECIAL'CHAR := 1;
173 NUMERIC'CHAR := 1;
174
175 WHILE'UNTIL := 0;
176 UPSHIFT'FLAG := 1;
177
178 NUM'CHAR := NLSCANMOVE(B'INSTRING, B'OUTSTRING, FLAGS,
179 LENGTH, LANGNUM, L'ERROR, L'CHARSET, L'UPSHIFT);
180 ERROR'CHECK (6000 + L'ERROR(0));
181
182 DISPLAY "UPSHIFTED: (EXAMPLE 1-2)" ON'STDLIST;
183 DISPLAY B'OUTSTRING,(NUM'CHAR) ON'STDLIST;
184
|
185 EXAMPLE'2'1:
186 << The string contained in instring should be scanned for the
187 first occurrence of a special character. All characters
188 before the first special are moved to outstring.
189 Note: The 'until flag' is set and the ending condition is
190 set to 'special character'. Therefore, the operation
191 continues until the first special character is found or
192 until the number of characters contained in length
193 is processed.>>
194
195
196 MOVE L'OUTSTRING := " ";
197 MOVE L'OUTSTRING(1) := L'OUTSTRING,(39);
198
199 FLAGS := 0;
200
201 SPECIAL'CHAR := 1;
202
203 WHILE'UNTIL := 1;
204 UPSHIFT'FLAG := 0;
205
206 NUM'CHAR := NLSCANMOVE(B'INSTRING, B'OUTSTRING, FLAGS,
207 LENGTH, LANGNUM, L'ERROR, L'CHARSET, L'UPSHIFT);
208 ERROR'CHECK (7000 + L'ERROR (0));
209
210 DISPLAY "SCAN/MOVE UNTIL SPECIAL: (EXAMPLE 2-1)"
211 ON'STDLIST;
212 DISPLAY B'OUTSTRING,(NUM'CHAR) ON'STDLIST;
213
214 EXAMPLE'2'2:
215 << Note: The 'while flag' is set and all ending criteria
216 except for special characters are set. Therefore, the
217 operation continues while an uppercase, a lowercase, or
218 a numeric character is found. When a special
219 character is found or the number of characters
220 contained in length is processed, the operation will
221 terminate.
222 This is the same operation as in EXAMPLE 2-1.>>
223
224 MOVE L'OUTSTRING := " ";
225 MOVE L'OUTSTRING(1) := L'OUTSTRING,(39);
226
227 FLAGS := 0;
228
|
229 LOWER'CASE := 1;
230 UPPER'CASE := 1;
231 SPECIAL'CHAR := 0;
232 NUMERIC'CHAR := 1;
233
234 WHILE'UNTIL := 0;
235 UPSHIFT'FLAG := 0;
236
237 NUM'CHAR := NLSCANMOVE(B'INSTRING, B'OUTSTRING, FLAGS,
238 LENGTH, LANGNUM, L'ERROR, L'CHARSET, L'UPSHIFT);
239 ERROR'CHECK (8000 + L'ERROR(0));
240
241 DISPLAY "SCAN/MOVE WHILE ALPHA OR NUM: (EXAMPLE 2-2)"
242 ON'STDLIST;
243 DISPLAY B'OUTSTRING,(NUM'CHAR) ON'STDLIST;
244
245 EXAMPLE'3'1:
246 << The data contained in instring should be scanned for the
247 first occurrence of a numeric or a special character.
248 All characters preceding the first special or numeric character
249 are moved to outstring.
250 Note: The 'until flag' is set and the ending conditions are
251 set to 'special character' and to 'numeric character'.
252 Therefore, the operation runs until the first
253 special or numeric character is found, or
254 until the number of characters contained in length
255 is processed.>>
256
257
258 MOVE L'OUTSTRING := " ";
259 MOVE L'OUTSTRING(1) := L'OUTSTRING,(39);
260
261 FLAGS := 0;
262
263 SPECIAL'CHAR := 1;
264 NUMERIC'CHAR := 1;
265
266 WHILE'UNTIL := 1;
267 DOWNSHIFT'FLAG := 1;
268
269 NUM'CHAR := NLSCANMOVE(B'INSTRING, B'OUTSTRING, FLAGS,
270 LENGTH, LANGNUM, L'ERROR, L'CHARSET, L'DOWNSHIFT);
271 ERROR'CHECK (9000 + L'ERROR(0));
272
273 DISPLAY
274 "SCAN/MOVE/DOWNSHIFT UNTIL NUM. OR SPEC.: (EXAMPLE 3-1)"
275 ON'STDLIST;
276 DISPLAY B'OUTSTRING,(NUM'CHAR) ON'STDLIST;
277
|
278 EXAMPLE'3'2:
279 << Note: The 'while flag' is set and the ending criteria for
280 uppercase and lowercase characters are set.
281 Therefore, the operation continues while an uppercase or
282 a lowercase character is found. When a special
283 or numeric character is found or the number of
284 characters contained in length is processed, the
285 operation will terminate.
286 This is the same operation as in EXAMPLE 3-1.>>
287
288 MOVE L'OUTSTRING := " ";
289 MOVE L'OUTSTRING(1) := L'OUTSTRING,(39);
290
291 FLAGS := 0;
292
293 LOWER'CASE := 1;
294 UPPER'CASE := 1;
295
296 WHILE'UNTIL := 0;
297 DOWNSHIFT'FLAG := 1;
298
299 NUM'CHAR := NLSCANMOVE(B'INSTRING, B'OUTSTRING, FLAGS,
300 LENGTH, LANGNUM, L'ERROR, L'CHARSET, L'DOWNSHIFT);
301 ERROR'CHECK (1000 + L'ERROR(0));
302
303 DISPLAY
304 "SCAN/MOVE/DOWNSHIFT WHILE ALPHA: (EXAMPLE 3-2)"
305 ON'STDLIST;
306 DISPLAY B'OUTSTRING,(NUM'CHAR) ON'STDLIST;
307
308 END.
|
Executing the program results in the following:
:RUN PROGRAM
ENTER A LANGUAGE NAME OR NUMBER (MAX. 16 CHARACTERS):
GERMAN
THE FOLLOWING STRING IS USED IN ALL EXAMPLES:
abCDfg6ijkaSXbVcGjGf1f$E!SPO6dLe\1a23%&7a 123&i12fSXgVhklKLabCDASPO6i
UPSHIFTED: (EXAMPLE 1-1)
ABCDFG6IJKASXBRCGJGF1F$E!SP[6DXE\1A23%&7A 123&I12FSXGRHKLKLABCDASP[6I
UPSHIFTED: (EXAMPLE 1-2)
ABCDFG6IJKASXBRCGJGF1F$E!SP[6DXE\1A23%&7A 123&I12FSXGRHKLKLABCDASP[6I
SCAN/MOVE UNTIL SPECIAL: (EXAMPLE 2-1)
abCDfg6ijkaSXbVcGjGf1f
SCAN/MOVE WHILE ALPHA OR NUM: (EXAMPLE 2-2)
abCDfg6ijkaSXbVcGjGf1f
SCAN/MOVE/DOWNSHIFT UNTIL NUM. OR SPEC.: (EXAMPLE 3-1)
abcdfg
SCAN/MOVE/DOWNSHIFT WHILE ALPHA: (EXAMPLE 3-2)
abcdfg
END OF PROGRAM
|
:RUN PROGRAM
ENTER A LANGUAGE NAME OR NUMBER (MAX. 16 CHARACTERS):
NATIVE-3000
THE FOLLOWING STRING IS USED IN ALL EXAMPLES:
abCDfg6ijkaSXbVcGjGf1f$E!SPO6dLe\1a23%&7a 123&i12fSXgVhklKLabCDASPO6i
UPSHIFTED: (EXAMPLE 1-1)
ABCDFG6IJKASXBVCGJGF1F$E!SPO6DLE\1A23%&7A 123&I12FSXGVHKLKLABCDASPO6I
UPSHIFTED: (EXAMPLE 1-2)
ABCDFG6IJKASXBVCGJGF1F$E!SPO6DLE\1A23%&7A 123&I12FSXGVHKLKLABCDASPO6I
SCAN/MOVE UNTIL SPECIAL: (EXAMPLE 2-1)
abCDfg6ijka
SCAN/MOVE WHILE ALPHA OR NUM: (EXAMPLE 2-2)
abCDfg6ijka
SCAN/MOVE/DOWNSHIFT UNTIL NUM. OR SPEC.: (EXAMPLE 3-1)
abcdfg
SCAN/MOVE/DOWNSHIFT WHILE ALPHA: (EXAMPLE 3-2)
abcdfg
END OF PROGRAM
:
|
|
