Contents of /territories/Source/Utilities/CharsTable

REM > Territories:Utilities.CharsTable

ONERRORONERROROFF:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END

DIM lower% 255, upper% 255, control% 255, plain% 255, value% 255, properties% 32 * 11
PROCTB_Init

ONERRORONERROROFF:PROCTB_Quit:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END

INPUT "Character set: "c$

f% = OPENIN("Territories:Tables." + c$ + ".!Chars")
IF f% = 0 THEN ERROR 1, "Could not open file Territories:Tables." + c$ + ".!Chars"

ONERRORONERROROFF:CLOSE#f%:PROCTB_Quit:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END

PROCTB_File("Territories:Tables." + c$ + ".!Chars")

 FOR b% = 0 TO 32 * 11 STEP 4
  properties%!b% = 0
 NEXT

l% = 0
err% = FALSE

 REPEAT
  l$ = GET$#f%
  l% += 1
 UNTIL LEFT$(l$, 1) <> "#"

 FOR c% = 0 TO 255
  IF FNchar(FNcut(l$)) <> c% THEN PROCTB_Throwback(l%, 1, "Wrong or missing character, should be "+STR$c%): err% = TRUE

  lower%?c% = FNchar(FNcut(l$))
  upper%?c% = FNchar(FNcut(l$))
  control%?c% = FNchar(FNcut(l$))
  plain%?c% = FNchar(FNcut(l$))
  value%?c% = FNchar(FNcut(l$))

  IF LENl$ <> 11 THEN PROCTB_Throwback(l%, 1, "Properties wrong or missing"): err% = TRUE

   FOR p% = 0 TO 10
    IF LEFT$(l$, 1) = "1" THEN properties%?(32 * p% + (c% DIV 8)) = properties%?(32 * p% + (c% DIV 8)) OR (1 << (c% MOD 8))
    l$ = MID$(l$, 2)
   NEXT

  IF EOF#f% AND c% <> 255 THEN PROCTB_Throwback(l%, 1, "Unexpected end of file"): err% = TRUE: GOTO 520

  l$ = GET$#f%
  l% += 1
 NEXT

CLOSE#f%
PROCTB_Quit

IF err% THEN PRINT"Failed due to errors": END

ONERRORONERROROFF:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END

SYS"OS_File", 10, "Territories:Tables." + c$ + ".LowerCase", &FFD,, lower%, lower% + 256
SYS"OS_File", 10, "Territories:Tables." + c$ + ".UpperCase", &FFD,, upper%, upper% + 256
SYS"OS_File", 10, "Territories:Tables." + c$ + ".Control", &FFD,, control%, control% + 256
SYS"OS_File", 10, "Territories:Tables." + c$ + ".Plain", &FFD,, plain%, plain% + 256
SYS"OS_File", 10, "Territories:Tables." + c$ + ".Value", &FFD,, value%, value% + 256
SYS"OS_File", 10, "Territories:Tables." + c$ + ".Property", &FFD,, properties%, properties% + 32 * 11

END

REM 

DEF FNcut(RETURN o$)
LOCAL p$
p$ = LEFT$(o$, INSTR(o$, CHR$9) - 1)
o$ = MID$(o$, INSTR(o$, CHR$9) + 1)
=p$


DEF FNchar(c$)
IF LENc$ = 1 THEN =ASCc$
IF LEFT$(c$, 1) = "." THEN =VAL(MID$(c$, 2))
PROCTB_Throwback(l%, 1, "Character " + c$ + " not understood")
err% = TRUE
=0

REM 

DEF PROCTB_Init
TB_Started% = FALSE
SYS"XOS_CLI", "RMEnsure DDEUtils 0.00 RMLoad System:Modules.DDEUtils"
SYS"XOS_SWINumberFromString",, "DDEUtils_ThrowbackStart" TO ;f%
IF f% AND 1 THEN TB_DDE% = FALSE ELSE TB_DDE% = TRUE
ENDPROC

DEF PROCTB_File(File$)
TB_File$ = File$
ENDPROC

DEF PROCTB_Throwback(Line%, Severity%, Message$)
 IF TB_DDE% THEN
   IF NOT TB_Started% THEN
    SYS"DDEUtils_ThrowbackStart"
    TB_Started% = TRUE
   ENDIF
  SYS"DDEUtils_ThrowbackSend", 1,, TB_File$, Line%, Severity%, Message$
 ELSE
   IF NOT TB_Started% THEN
    PRINT "Errors in file " + TB_File$ + ":"
    TB_Started% = TRUE
   ENDIF
  PRINT "Line " + STR$Line% + ": ";
  IF Severity% = 0 THEN PRINT "Warning: "; ELSE PRINT "Error: ";
  PRINT Message$
 ENDIF
ENDPROC

DEF PROCTB_Quit
IF TB_DDE% AND TB_Started% THEN SYS"DDEUtils_ThrowbackEnd"
ENDPROC
1	REM > Territories:Utilities.CharsTable
2
3	ONERRORONERROROFF:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END
4
5	DIM lower% 255, upper% 255, control% 255, plain% 255, value% 255, properties% 32 * 11
6	PROCTB_Init
7
8	ONERRORONERROROFF:PROCTB_Quit:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END
9
10	INPUT "Character set: "c$
11
12	f% = OPENIN("Territories:Tables." + c$ + ".!Chars")
13	IF f% = 0 THEN ERROR 1, "Could not open file Territories:Tables." + c$ + ".!Chars"
14
15	ONERRORONERROROFF:CLOSE#f%:PROCTB_Quit:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END
16
17	PROCTB_File("Territories:Tables." + c$ + ".!Chars")
18
19	FOR b% = 0 TO 32 * 11 STEP 4
20	properties%!b% = 0
21	NEXT
22
23	l% = 0
24	err% = FALSE
25
26	REPEAT
27	l$ = GET$#f%
28	l% += 1
29	UNTIL LEFT$(l$, 1) <> "#"
30
31	FOR c% = 0 TO 255
32	IF FNchar(FNcut(l$)) <> c% THEN PROCTB_Throwback(l%, 1, "Wrong or missing character, should be "+STR$c%): err% = TRUE
33
34	lower%?c% = FNchar(FNcut(l$))
35	upper%?c% = FNchar(FNcut(l$))
36	control%?c% = FNchar(FNcut(l$))
37	plain%?c% = FNchar(FNcut(l$))
38	value%?c% = FNchar(FNcut(l$))
39
40	IF LENl$ <> 11 THEN PROCTB_Throwback(l%, 1, "Properties wrong or missing"): err% = TRUE
41
42	FOR p% = 0 TO 10
43	IF LEFT$(l$, 1) = "1" THEN properties%?(32 * p% + (c% DIV 8)) = properties%?(32 * p% + (c% DIV 8)) OR (1 << (c% MOD 8))
44	l$ = MID$(l$, 2)
45	NEXT
46
47	IF EOF#f% AND c% <> 255 THEN PROCTB_Throwback(l%, 1, "Unexpected end of file"): err% = TRUE: GOTO 520
48
49	l$ = GET$#f%
50	l% += 1
51	NEXT
52
53	CLOSE#f%
54	PROCTB_Quit
55
56	IF err% THEN PRINT"Failed due to errors": END
57
58	ONERRORONERROROFF:ERROR0,REPORT$+" ("+STR$ERL+"/&"+STR$~ERR+")":END
59
60	SYS"OS_File", 10, "Territories:Tables." + c$ + ".LowerCase", &FFD,, lower%, lower% + 256
61	SYS"OS_File", 10, "Territories:Tables." + c$ + ".UpperCase", &FFD,, upper%, upper% + 256
62	SYS"OS_File", 10, "Territories:Tables." + c$ + ".Control", &FFD,, control%, control% + 256
63	SYS"OS_File", 10, "Territories:Tables." + c$ + ".Plain", &FFD,, plain%, plain% + 256
64	SYS"OS_File", 10, "Territories:Tables." + c$ + ".Value", &FFD,, value%, value% + 256
65	SYS"OS_File", 10, "Territories:Tables." + c$ + ".Property", &FFD,, properties%, properties% + 32 * 11
66
67	END
68
69	REM
70
71	DEF FNcut(RETURN o$)
72	LOCAL p$
73	p$ = LEFT$(o$, INSTR(o$, CHR$9) - 1)
74	o$ = MID$(o$, INSTR(o$, CHR$9) + 1)
75	=p$
76
77
78	DEF FNchar(c$)
79	IF LENc$ = 1 THEN =ASCc$
80	IF LEFT$(c$, 1) = "." THEN =VAL(MID$(c$, 2))
81	PROCTB_Throwback(l%, 1, "Character " + c$ + " not understood")
82	err% = TRUE
83	=0
84
85	REM
86
87	DEF PROCTB_Init
88	TB_Started% = FALSE
89	SYS"XOS_CLI", "RMEnsure DDEUtils 0.00 RMLoad System:Modules.DDEUtils"
90	SYS"XOS_SWINumberFromString",, "DDEUtils_ThrowbackStart" TO ;f%
91	IF f% AND 1 THEN TB_DDE% = FALSE ELSE TB_DDE% = TRUE
92	ENDPROC
93
94	DEF PROCTB_File(File$)
95	TB_File$ = File$
96	ENDPROC
97
98	DEF PROCTB_Throwback(Line%, Severity%, Message$)
99	IF TB_DDE% THEN
100	IF NOT TB_Started% THEN
101	SYS"DDEUtils_ThrowbackStart"
102	TB_Started% = TRUE
103	ENDIF
104	SYS"DDEUtils_ThrowbackSend", 1,, TB_File$, Line%, Severity%, Message$
105	ELSE
106	IF NOT TB_Started% THEN
107	PRINT "Errors in file " + TB_File$ + ":"
108	TB_Started% = TRUE
109	ENDIF
110	PRINT "Line " + STR$Line% + ": ";
111	IF Severity% = 0 THEN PRINT "Warning: "; ELSE PRINT "Error: ";
112	PRINT Message$
113	ENDIF
114	ENDPROC
115
116	DEF PROCTB_Quit
117	IF TB_DDE% AND TB_Started% THEN SYS"DDEUtils_ThrowbackEnd"
118	ENDPROC