Top Prev Next Up Down
Source code of Chesslist
(Must be precompiled before compiled with
gnatmake)
001| with
Ada.Text_IO; use Ada.Text_IO;
002| with Ada.Strings.Unbounded; use
Ada.Strings.Unbounded;
003| with Ada.Command_Line;
004| with Y2018.Text.Core; use
Y2018.Text.Core;
005| with Y2018.Text.Core.STR; use
Y2018.Text.Core.STR;
006| with Y2018.Text.Core.UTF; use
Y2018.Text.Core.UTF;
007| with Y2018.Text.Util; use
Y2018.Text.Util;
008| with Y2018.Text.Util.InFileUTF8;
009| with Y2018.Text.Jets; use
Y2018.Text.Jets;
010| with Y2018.Text.Jets.MatchPack;
011| with Y2018.Text.Jets.PatternPack;
012| with Y2018.Text.Core.CVarPack; use
Y2018.Text.Core.CVarPack;
013| with GNAT.Source_Info;
014| -- with DSECT;
015| procedure Chesslist is
016|
__gblk:Y2018.Text.Util.InFileUTF8.self;
017| __r:CVar;
018| __lncnt:Integer:=0;
019| __blklen:Integer:=50;
020| __gc:CFix:=" "c;
021| __i:Integer:=1;
022| __in_name:Unbounded_String;
023| __ut_name:Unbounded_String;
024| __m :
Y2018.Text.Jets.MatchPack.Match_TY;
025| __p0:PatternPack.Pattern_AC:=new
PatternPack.Pattern;
026| __p1n:PatternPack.Pattern_AC:=new
PatternPack.Pattern;
027| __p0_C:CFix:="^(-[\w]+)$"c;
028|
__p1n_C:CFix:="^(-[\w]+):([\d]+)$"c;
029|
030| __ut : File_Type;
031| __c:CodePoint;
032|
__c_nul:CodePoint:=CodePoint'Val(16#2654#); i_nul:Integer:=0; --
WHITE KING
033| __c_b:CodePoint:=
CodePoint'Val(16#2655#); i_b:Integer:=0; -- WHITE QUEEN
034| __c_f:CodePoint:=
CodePoint'Val(16#2656#); i_f:Integer:=0; -- WHITE ROOK
035| __c_n:CodePoint:=
CodePoint'Val(16#2657#); i_n:Integer:=0; -- WHITE BISHOP
036| __c_t:CodePoint:=
CodePoint'Val(16#2658#); i_t:Integer:=0; -- WHITE KNIGHT
037| __c_r:CodePoint:=
CodePoint'Val(16#2659#); i_r:Integer:=0; -- WHITE PAWN
038|
__c_nel:CodePoint:=CodePoint'Val(16#265F#); i_nel:Integer:=0; --
BLACK PAWN
039| __c_cc:CodePoint:=
CodePoint'Val(16#265A#); i_cc:Integer:=0; -- BLACK KING
040| __c_cf:CodePoint:=
CodePoint'Val(16#265B#); i_cf:Integer:=0; -- BLACK QUEEN
041| __c_cs:CodePoint:=
CodePoint'Val(16#265C#); i_cs:Integer:=0; -- BLACK ROOK
042| __c_cn:CodePoint:=
CodePoint'Val(16#265D#); i_cn:Integer:=0; -- BLACK BISHOP
043| __c_xx:CodePoint:=
CodePoint'Val(16#265E#); warn:Integer:=0; -- BLACK KNIGHT
044| __c_rc:CodePoint:=
CodePoint'Val(16#FFFD#); i_rc:Integer:=0; -- REPLACEMENT CHARACTER
045| __rcy:Boolean:=FALSE;
046| __NUS:constant
Ada.Strings.Unbounded.Unbounded_String:=Null_Unbounded_String;
047| __nextPos:Integer;
048| __cnt:Integer;
049| begin
050| __if
Ada.Command_Line.Argument_Count = 0 then
051| _____Put_line(" List any file to
an editor friendly list file.");
052| _____Put_line(" All control
characters are replaced by CHESS symbols.");
053| _____Put_line(" Line length is
fixed to the value of -blk parameter (default 50),");
054| _____Put_line(" 'line length' is
the number of UTF-8 characters on a single line.");
055| _____Put_line(" All non-UTF8
characters are replaced by BLACK KNIGHT symbol.");
056| _____Put_line(" " & c_nul
&" "& c_b &" "& c_f &" "& c_n &" "&
c_t &" "& c_r &" "& c_nel &" "& c_cc &"
"& c_cf &" "& c_cs &" "& c_cn &" "&
c_xx);
057| _____Put_line(" Syntax:");
058| _____Put_line(" Chesslist
{<option>}* <input_file> {<output_file>}");
059| _____Put_line(" if no
<output_file> then name of <output_file> is chess.lst");
060| _____Put_line(" Options:");
061| _____Put_line(" -blk:<line
length> -- length of line in output");
062| _____Put_line(" -r -- replace
characters with a code value over 16#FFFF#");
063| _____return;
064| __end if;
065| __PatternPack.compileM(p0,p0_C);
066| __PatternPack.compileM(p1n,p1n_C);
067| __while i <=
Ada.Command_Line.Argument_Count loop
068| _____declare
069|
________argCF:CFix:=UTF.To21(Ada.Command_Line.Argument(i));
070| _____begin
071| ________if
PatternPack.matches(p0,1,nextPos,argCF,m) then
072|
___________cnt:=Y2018.Text.Jets.MatchPack.size(m);
073| ___________declare
074|
______________r:Y2018.Text.Jets.I_A_ARRAY(0 .. cnt - 1);
075| ___________begin
076|
______________Y2018.Text.Jets.MatchPack.getMatch(m,r);
077| ______________if subIA(argCF,r(1))
= "-r"c then
078| _________________rcy:=TRUE;
079| ______________else
080| _________________raise
Program_Error with GNAT.Source_Info.Source_Location & " " &
GNAT.Source_Info.Enclosing_Entity & ": Unknown arg :" &
argCF;
081| ______________end if;
082| ___________end;
083| ________elsif
PatternPack.matches(p1n,1,nextPos,argCF,m) then
084|
___________cnt:=Y2018.Text.Jets.MatchPack.size(m);
085| ___________declare
086|
______________r:Y2018.Text.Jets.I_A_ARRAY(0 .. cnt - 1);
087| ___________begin
088|
______________Y2018.Text.Jets.MatchPack.getMatch(m,r);
089| ______________if subIA(argCF,r(1))
= "-blk"c then
090|
_________________blklen:=Integer'Value("" & subIA(argCF,r(2)));
091| _________________if blklen < 1
then
092| ____________________raise
Program_Error with GNAT.Source_Info.Source_Location & " " &
GNAT.Source_Info.Enclosing_Entity & ": Invalid -blk value";
093| _________________end if;
094| ______________else
095| _________________raise
Program_Error with GNAT.Source_Info.Source_Location & " " &
GNAT.Source_Info.Enclosing_Entity & ": Unknown arg :" &
argCF;
096| ______________end if;
097| ___________end;
098| ________elsif Length(in_name) = 0
then
099| ___________in_name:=NUS &
UTF.To8(argCF);
100| ________elsif Length(ut_name) = 0
then
101| ___________ut_name:=NUS &
UTF.To8(argCF);
102| ________else
103| ___________raise Program_Error
with GNAT.Source_Info.Source_Location & " " &
GNAT.Source_Info.Enclosing_Entity & ": Unknown arg :" &
argCF;
104| ________end if;
105| _____end;
106| _____i:=i+1;
107| __end loop;
108| __if Length(in_name) = 0 then
109| _____raise Program_Error with
GNAT.Source_Info.Source_Location & " " &
GNAT.Source_Info.Enclosing_Entity & ": No input file";
110| __end if;
111| __if Length(ut_name) = 0 then
112| _____ut_name:=NUS &
"chess.lst";
113| __end if;
114| __Create (File => ut,Mode =>
Out_File,Name => To_String(ut_name));
115| __
116|
__Y2018.Text.Util.InFileUTF8.open(gblk,To_String(in_name));
117| __while not
Y2018.Text.Util.InFileUTF8.eof(gblk) loop
118| _____r:=Null_CVar;
119| _____while not
Y2018.Text.Util.InFileUTF8.eof(gblk) loop
120| ________declare
121| ___________vc:CodePoint;
122| ___________e:RS_TY;
123| ___________us:CVar;
124| ________begin
125|
___________e:=Y2018.Text.Util.InFileUTF8.read(gblk,us);
126| ___________declare
127| ______________v:CFix:=To_CFix(us);
128| ___________begin
129| ______________vc:=v(1);
130| ___________end;
131| ___________c:=vc;
132|
___________gc:=Y2018.Text.Core.Str.GET_GC(vc);
133| ___________if rcy then
134| ______________if vc >
CodePoint'Val(16#FFFF#) then
135| _________________c:=c_rc;
136| _________________i_rc:=i_rc + 1;
137| ______________end if;
138| ___________end if;
139| ___________if not (e = RS_NONE)
then
140| ______________c:=c_xx;
141| ______________warn:=warn + 1;
142| ___________elsif gc = "Cc"c then
143| ______________c:=c_cc;
144| ______________i_cc:=i_cc + 1;
145| ___________elsif gc = "Cf"c then
146| ______________c:=c_cf;
147| ______________i_cf:=i_cf + 1;
148| ___________elsif gc = "Cs"c then
149| ______________c:=c_cs;
150| ______________i_cs:=i_cs + 1;
151| ___________elsif gc = "Cn"c or gc
= " "c then
152| ______________c:=c_cn;
153| ______________i_cn:=i_cn + 1;
154| ___________else
155| ______________null;
156| ___________end if;
157| ___________case vc is
158| ______________when
CodePoint'Val(16#00#) => -- nul
159| _________________c:=c_nul;
160| _________________i_nul:=i_nul + 1;
161| ______________when
CodePoint'Val(16#08#) => -- \b
162| _________________c:=c_b;
163| _________________i_b:=i_b + 1;
164| ______________when
CodePoint'Val(16#0C#) => -- \f
165| _________________c:=c_f;
166| _________________i_f:=i_f + 1;
167| ______________when
CodePoint'Val(16#0A#) => -- \n
168| _________________c:=c_n;
169| _________________i_n:=i_n + 1;
170| ______________when
CodePoint'Val(16#0D#) =>-- \r
171| _________________c:=c_r;
172| _________________i_r:=i_r + 1;
173| ______________when
CodePoint'Val(16#09#) => -- \t
174| _________________c:=c_t;
175| _________________i_t:=i_t + 1;
176| ______________when
CodePoint'Val(16#85#) => -- NEL Next line
177| _________________c:=c_nel;
178| _________________i_nel:=i_nel + 1;
179| ______________when others =>
180| _________________null;
181| ___________end case;
182| ___________--
183| ___________r:=r & c;
184| ________end;
185| ________if Length(r)>=blklen
then
186| ___________exit;
187| ________end if;
188| _____end loop;
189| _____Put_line(ut,"" & r);
190| _____lncnt:=lncnt + 1;
191| __end loop;
192|
__Y2018.Text.Util.InFileUTF8.close(gblk);
193| __close(ut);
194| __Put_line("input " &
To_String(in_name));
195| __Put_line("output " &
To_String(ut_name));
196| __Put_line("lines" &
Integer'Image(lncnt));
197| __Put_line("null" &
Integer'Image(i_nul) & " " & c_nul);
198| __Put_line("backspace" &
Integer'Image(i_b) & " " & c_b);
199| __Put_line("form_feed" &
Integer'Image(i_f) & " " & c_f);
200| __Put_line("line_feed" &
Integer'Image(i_n) & " " & c_n);
201| __Put_line("horizontal_tabulation"
& Integer'Image(i_t) & " " & c_t);
202| __Put_line("carriage_return" &
Integer'Image(i_r) & " " & c_r);
203| __Put_line("next_line" &
Integer'Image(i_nel) & " " & c_nel);
204| __Put_line("Cc control" &
Integer'Image(i_cc) & " " & c_cc);
205| __Put_line("Cf format" &
Integer'Image(i_cf) & " " & c_cf);
206| __Put_line("Cs surrogate" &
Integer'Image(i_cs) & " " & c_cs);
207| __Put_line("Cn not_assigned" &
Integer'Image(i_cn) & " " & c_cn);
208| __if rcy then
209| _____Put_line("Replaced " &
Integer'Image(i_rc) & " " & c_rc);
210| __end if;
211| __if warn > 0 then
212| _____Put_line(Standard_Error,"**
WARNING, not an UTF-8 file**" & Integer'Image(warn) & " "
& c_xx);
213| __end if;
214| end Chesslist;