summaryrefslogtreecommitdiff
path: root/support/rnototex/flagops.pas
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/rnototex/flagops.pas
Initial commit
Diffstat (limited to 'support/rnototex/flagops.pas')
-rw-r--r--support/rnototex/flagops.pas675
1 files changed, 675 insertions, 0 deletions
diff --git a/support/rnototex/flagops.pas b/support/rnototex/flagops.pas
new file mode 100644
index 0000000000..60603cc7d6
--- /dev/null
+++ b/support/rnototex/flagops.pas
@@ -0,0 +1,675 @@
+[INHERIT('UTILITYOPS','ARGOPS'), environment('flagops')]
+
+MODULE FLAGOPS;
+
+CONST
+
+ tab = 9;
+ ncharsintab = 8;
+
+TYPE
+
+dsrflagtype = record
+ representation : char;
+ turnedon : boolean
+ end;
+
+
+dsrflagclasses = (notaflag, control, uppercase, lowercase, quote,
+space, underline, bold, overstrike, hyphenate, break, period, capitalize,
+endfootnote, comment, substitute);
+
+flagtabletype = array[dsrflagclasses] of dsrflagtype;
+
+tabrecordtype = record
+ tabread : boolean;
+ charcountintab : integer
+ end;
+
+styletype = (undetermined, decimal, octal, hexidecimal, romanupper, romanlower,
+ romanmixed, letterupper, letterlower, lettermixed, nostyle);
+
+enhancmentstates = (notenhanced, singlecharenhanced, enhancmentlocked);
+
+
+
+VAR
+
+ lastinputchar, currentchar : [EXTERNAL] char;
+ capitalizetext, lowercasetext : [EXTERNAL] boolean;
+ inputcontainstexcommands : [EXTERNAL] boolean;
+ inliteral : [EXTERNAL] boolean;
+ totallines, totalchars : [EXTERNAL] integer;
+ flagtable : [EXTERNAL] flagtabletype;
+ tabrecord : [EXTERNAL] tabrecordtype;
+ LOG : [EXTERNAL] text;
+ columncounter : [EXTERNAL] integer;
+ infootnote : [EXTERNAL] boolean;
+ boldactive : [EXTERNAL] enhancmentstates;
+ underlineactive : [EXTERNAL] enhancmentstates;
+ startnofillagain : [EXTERNAL] boolean;
+ fill : [EXTERNAL] boolean;
+ listnestlevel : [EXTERNAL] integer;
+
+
+
+[GLOBAL] PROCEDURE beginnofill( var outfile : text );
+begin
+ if (fill) and (listnestlevel = 0) then
+ begin
+ writeln(outfile,'{\obeylines \obeyspaces % - begin no fill');
+ fill := false
+ end
+ else
+ begin
+ writeln(outfile,'% - RNOTOTEX obeylines, obeyspaces already active');
+ writeln( log,'% - RNOTOTEX obeylines, obeyspaces already active')
+ end
+end;
+
+
+
+
+[GLOBAL] PROCEDURE endnofill( var outfile : text );
+begin
+ if (not fill) and (listnestlevel = 0) then
+ begin
+ writeln(outfile,'} % - end of no fill');
+ fill := true
+ end
+ else
+ begin
+ writeln(outfile,'% - RNOTOTEX obeylines, obeyspaces not active');
+ writeln( log,'% - RNOTOTEX obeylines, obeyspaces not active')
+ end
+end;
+
+
+
+
+
+
+[GLOBAL] PROCEDURE writeflagname( var outfile : text; f : dsrflagclasses );
+begin
+ case f of
+ notaflag : write(outfile,'?????');
+ control : write(outfile,'CONTROL');
+ uppercase : write(outfile,'UPPERCASE');
+ lowercase : write(outfile,'LOWERCASE');
+ quote : write(outfile,'QUOTE');
+ space : write(outfile,'SPACE');
+ underline : write(outfile,'UNDERLINE');
+ bold : write(outfile,'BOLD');
+ overstrike : write(outfile,'OVERSTRIKE');
+ hyphenate : write(outfile,'HYPYENATE');
+ capitalize : write(outfile,'CAPITALIZE');
+ endfootnote : write(outfile,'END FOOTNOTE');
+ comment : write(outfile,'COMMENT');
+ substitute : write(outfile,'SUBSTITUTE')
+ end
+end;
+
+
+
+
+
+
+[GLOBAL] FUNCTION isastylespecifier( arg : argument ) : styletype;
+label
+ routineexit;
+var
+ s : pckstr;
+ classification : styletype;
+begin
+ s := argliteral( arg, TRUE );
+ classification := undetermined;
+ if (s.body[1] = 'D') and (s.length = 1) then
+ begin
+ classification := decimal;
+ goto routineexit
+ end;
+ if (s.body[1] = 'O') and (s.length = 1) then
+ begin
+ classification := octal;
+ goto routineexit
+ end;
+ if (s.body[1] = 'H') and (s.length = 1) then
+ begin
+ classification := hexidecimal;
+ goto routineexit
+ end;
+ if (s.body = 'RU') and (s.length = 2) then
+ begin
+ classification := romanupper;
+ goto routineexit
+ end;
+ if (s.body = 'RL') and (s.length = 2) then
+ begin
+ classification := romanlower;
+ goto routineexit
+ end;
+ if (s.body = 'RM') and (s.length = 2) then
+ begin
+ classification := romanmixed;
+ goto routineexit
+ end;
+ if (s.body = 'LU') and (s.length = 2) then
+ begin
+ classification := letterupper;
+ goto routineexit
+ end;
+ if (s.body = 'LL') and (s.length = 2) then
+ begin
+ classification := letterlower;
+ goto routineexit
+ end;
+ if (s.body = 'LM') and (s.length = 2) then
+ begin
+ classification := lettermixed;
+ goto routineexit
+ end;
+ routineexit : isastylespecifier := classification
+end;
+
+
+
+[GLOBAL] PROCEDURE initflagtable;
+var
+ f : dsrflagclasses;
+begin
+ for f := notaflag to substitute do
+ case f of
+ notaflag : begin
+ flagtable[f].representation := blank;
+ flagtable[f].turnedon := false
+ end;
+ control : begin
+ flagtable[f].representation := '.';
+ flagtable[f].turnedon := true
+ end;
+ uppercase : begin
+ flagtable[f].representation := '^';
+ flagtable[f].turnedon := true
+ end;
+ lowercase : begin
+ flagtable[f].representation := '\';
+ flagtable[f].turnedon := true
+ end;
+ quote : begin
+ flagtable[f].representation := '_';
+ flagtable[f].turnedon := true
+ end;
+ space : begin
+ flagtable[f].representation := '#';
+ flagtable[f].turnedon := true
+ end;
+ underline : begin
+ flagtable[f].representation := '&';
+ flagtable[f].turnedon := true
+ end;
+ bold : begin
+ flagtable[f].representation := '*';
+ flagtable[f].turnedon := false
+ end;
+ overstrike : begin
+ flagtable[f].representation := '%';
+ flagtable[f].turnedon := false
+ end;
+ hyphenate : begin
+ flagtable[f].representation := '=';
+ flagtable[f].turnedon := false
+ end;
+ break : begin
+ flagtable[f].representation := '|';
+ flagtable[f].turnedon := false
+ end;
+ period : begin
+ flagtable[f].representation := '+';
+ flagtable[f].turnedon := false
+ end;
+ capitalize : begin
+ flagtable[f].representation := '<';
+ flagtable[f].turnedon := false
+ end;
+ endfootnote : begin
+ flagtable[f].representation := '!';
+ flagtable[f].turnedon := false
+ end;
+ comment : begin
+ flagtable[f].representation := '!';
+ flagtable[f].turnedon := true
+ end;
+ substitute : begin
+ flagtable[f].representation := '$';
+ flagtable[f].turnedon := false
+ end
+ end { case }
+end; {initflagtable}
+
+
+
+
+[GLOBAL] FUNCTION flagclass( ch : char ) : dsrflagclasses;
+var
+ class : dsrflagclasses;
+ foundclass : boolean;
+begin
+ class := control;
+ foundclass := false;
+ while (class <> substitute) and ( not foundclass) do
+ if (ch = flagtable[class].representation) and (flagtable[class].turnedon)then
+ foundclass := true
+ else
+ class := succ(class);
+ if foundclass then
+ if inliteral then
+ if class = control then
+ flagclass := control
+ else
+ flagclass := notaflag
+ else
+ flagclass := class
+ else
+ flagclass := notaflag
+end;
+
+
+
+
+[GLOBAL] PROCEDURE initcharreader(var f : text );
+begin
+ reset(f);
+ lastinputchar := blank;
+ read(f, currentchar);
+ totallines := 0;
+ totalchars := 0;
+ columncounter := 1;
+ if ord(currentchar) = tab then
+ begin
+ tabrecord.tabread := true;
+ tabrecord.charcountintab := ncharsintab
+ end
+ else
+ begin
+ tabrecord.tabread := false;
+ tabrecord.charcountintab := 0
+ end
+end;
+
+
+
+
+[GLOBAL] PROCEDURE getnextchar( var f : text; var gotten : boolean );
+
+ function nexttabcolumn( startingcolumn : integer ) : integer;
+ var
+ i : integer;
+ begin
+ i := startingcolumn;
+ repeat
+ i := i + 1
+ until (i-1) mod ncharsintab = 0;
+ nexttabcolumn := i;
+ writeln(log,'nexttabcolumn input = ',startingcolumn:1,', output = ',i:1)
+ end;
+
+begin
+ gotten := false;
+ if NOT eof(f) then
+ if NOT eoln(f) then
+ with tabrecord do
+ begin
+ lastinputchar := currentchar;
+ gotten := true;
+ columncounter := columncounter + 1;
+ if (tabread) and (charcountintab > 0) then
+ begin
+ currentchar := blank;
+ charcountintab := charcountintab - 1;
+ if charcountintab = 0 then tabread := false
+ end
+ else
+ begin
+ totalchars := totalchars + 1;
+ read( f, currentchar );
+ if currentchar < blank then
+ begin
+ if ord(currentchar) = tab then
+ begin
+ tabread := true;
+ charcountintab := nexttabcolumn( columncounter ) - columncounter-1;
+ writeln(log,'charcountintab = ',charcountintab)
+ end;
+ currentchar := blank
+ end
+ end
+ end
+end;
+
+
+
+[GLOBAL] PROCEDURE startunderline( var outfile : text; class : enhancmentstates);
+begin
+ if class <> notenhanced then
+ case underlineactive of
+ notenhanced : begin
+ write(outfile,'\underline{');
+ underlineactive := class
+ end;
+ singlecharenhanced : nullstatement;
+ enhancmentlocked : nullstatement
+ end;
+ underlineactive := class
+end;
+
+
+
+
+[GLOBAL] PROCEDURE stopunderline( var outfile : text );
+begin
+ case underlineactive of
+ notenhanced : nullstatement;
+ singlecharenhanced : begin
+ write(outfile,'} ');
+ underlineactive := notenhanced
+ end;
+ enhancmentlocked : nullstatement
+ end
+end;
+
+
+
+
+[GLOBAL] PROCEDURE startbold( var outfile : text; class : enhancmentstates);
+begin
+ if class <> notenhanced then
+ case boldactive of
+ notenhanced : begin
+ write(outfile,'{\bf ');
+ boldactive := class
+ end;
+ singlecharenhanced : nullstatement;
+ enhancmentlocked : nullstatement
+ end;
+ boldactive := class
+end;
+
+
+
+
+[GLOBAL] PROCEDURE stopbold( var outfile : text );
+begin
+ case boldactive of
+ notenhanced : nullstatement;
+ singlecharenhanced : begin
+ write(outfile,'} ');
+ boldactive := notenhanced
+ end;
+ enhancmentlocked : nullstatement
+ end
+end;
+
+
+
+
+
+[GLOBAL] PROCEDURE passblanks( var infile, outfile : text; writethem : boolean );
+var
+ gotten, keeppassing : boolean;
+begin
+ keeppassing := true;
+ gotten := true;
+ repeat
+ if (currentchar = blank) and (gotten) then
+ begin
+ if writethem then write(outfile, blank );
+ getnextchar(infile, gotten)
+ end
+ else
+ keeppassing := false
+ until NOT keeppassing
+end;
+
+
+
+[GLOBAL] PROCEDURE texwrite( var f : text; ch : char );
+const
+ maxtrys = 2;
+var
+ ntrys : integer;
+ written : boolean;
+begin
+ ntrys := 0;
+ written := false;
+ repeat
+ if (inputcontainstexcommands) or (inliteral) then
+ write(f, ch, error := continue)
+ else
+ if ch >= blank then
+ if ch in ['#','$','%','&','_','^','{','}','~'] then
+ write(f, '\',ch, error := continue)
+ else
+ if ch = '\' then
+ write(f,'\backslash ', error := continue)
+ else
+ write(f, ch, error := continue);
+ if status(f) > 0 then
+ begin
+ writeln(f, error := continue);
+ ntrys := ntrys + 1
+ end
+ else
+ written := true
+ until (written) or (ntrys > maxtrys);
+ if ntrys > maxtrys then
+ errorexit('TEXWRITE','error writing to output')
+end;
+
+
+
+[GLOBAL] PROCEDURE writecurrentchar( var infile, outfile : text );
+var
+ gotten : boolean;
+begin
+ if capitalizetext then
+ currentchar := capchar( currentchar );
+ if lowercasetext then
+ currentchar := lcchar( currentchar );
+ case flagclass(currentchar) of
+ notaflag : begin
+ stopunderline( outfile );
+ stopbold( outfile );
+ texwrite(outfile, currentchar)
+ end;
+ control : begin
+ stopunderline( outfile );
+ stopbold( outfile );
+ texwrite(outfile, currentchar)
+ end;
+ uppercase : begin
+ getnextchar(infile, gotten);
+ if gotten then
+ case flagclass(currentchar) of
+ underline : startunderline( outfile, enhancmentlocked);
+ bold : startbold( outfile, enhancmentlocked );
+ otherwise texwrite(outfile, capchar(currentchar))
+ end
+ end;
+ lowercase : begin
+ getnextchar(infile, gotten);
+ if gotten then
+ case flagclass(currentchar) of
+ underline : begin
+ if underlineactive <> notenhanced then
+ write(outfile,'} ');
+ underlineactive := notenhanced
+ end;
+ bold : begin
+ if boldactive <> notenhanced then
+ write(outfile,'} ');
+ boldactive := notenhanced
+ end;
+ otherwise texwrite(outfile, lcchar(currentchar))
+ end
+ end;
+ quote : begin
+ getnextchar(infile, gotten);
+ if gotten then
+ texwrite(outfile, currentchar )
+ end;
+ space : write(outfile,'\ ');
+ underline : begin
+ getnextchar(infile, gotten );
+ if gotten then
+ begin
+ startunderline( outfile, singlecharenhanced);
+ texwrite(outfile, currentchar)
+ end
+ else
+ texwrite(outfile, currentchar)
+ end;
+ bold : begin
+ getnextchar(infile, gotten);
+ if gotten then
+ begin
+ startbold( outfile, singlecharenhanced);
+ texwrite(outfile, currentchar)
+ end
+ else
+ texwrite(outfile, currentchar)
+ end;
+ overstrike : begin
+ getnextchar(infile, gotten);
+ if gotten then
+ begin
+ startbold( outfile, singlecharenhanced);
+ texwrite(outfile, currentchar)
+ end
+ else
+ texwrite(outfile, currentchar)
+ end;
+ hyphenate : write(outfile,'--');
+ break : writeln(outfile,'\linebreak');
+ period : write(outfile,'\nonfrenchspacing ');
+ capitalize : begin
+ getnextchar( infile, gotten);
+ if gotten then
+ texwrite(outfile, capchar(currentchar))
+ end;
+ endfootnote : begin
+ if (columncounter = 1) and (infootnote) then
+ begin
+ if not fill then
+ endnofill( outfile );
+ writeln(outfile,'} % - end of footnote');
+ writeln( log,'} % - end of footnote');
+ infootnote := false;
+ if startnofillagain then
+ begin
+ startnofillagain := false;
+ beginnofill( outfile )
+ end
+ end
+ else
+ texwrite(outfile, currentchar)
+ end;
+ comment : begin
+ if flagclass(lastinputchar) = control then
+ write(outfile,'% ')
+ else
+ texwrite(outfile,currentchar)
+ end;
+ substitute : texwrite(outfile, currentchar)
+ end { case }
+end;
+
+
+
+
+[GLOBAL] PROCEDURE newline( var infile, outfile : text; putcrlf : boolean );
+var
+ gotten : boolean;
+begin
+ if eoln(infile) then
+ begin
+ readln(infile);
+ totallines := totallines + 1;
+ columncounter := 1
+ end;
+ if putcrlf then
+ writeln(outfile);
+ while (eoln(infile)) and (not eof(infile)) do
+ begin
+ readln(infile);
+ writeln(outfile);
+ columncounter := 1;
+ totallines := totallines + 1
+ end;
+ if not eof(infile) then
+ begin
+ read(infile, currentchar);
+ totalchars := totalchars + 1;
+ lastinputchar := blank
+ end;
+ if ord(currentchar) = tab then
+ begin
+ tabrecord.charcountintab := ncharsintab;
+ tabrecord.tabread := true
+ end
+ else
+ begin
+ tabrecord.charcountintab := 0;
+ tabrecord.tabread := false
+ end;
+ if currentchar < blank then currentchar := blank
+end;
+
+
+
+
+
+
+[GLOBAL] PROCEDURE changeflagchar( flag : dsrflagclasses; newchar:char);
+begin
+ flagtable[flag].representation := newchar;
+ write(log,'[internal flag representation change for ');
+ writeflagname(log, flag);
+ writeln(log,' to "',newchar,'"]')
+end;
+
+
+
+[GLOBAL] PROCEDURE turnflagon( flag : dsrflagclasses );
+begin
+ flagtable[flag].turnedon := true;
+ write(log,'[internal flag ');
+ writeflagname(log, flag);
+ writeln(log,' enabled]')
+end;
+
+
+
+[GLOBAL] PROCEDURE turnflagoff( flag : dsrflagclasses );
+begin
+ flagtable[flag].turnedon := false;
+ write(log,'[internal flag ');
+ writeflagname(log, flag);
+ writeln(log,' disabled]')
+end;
+
+
+
+
+[GLOBAL] PROCEDURE texwritearg( var outfile : text; arg : argument );
+var
+ s : pckstr;
+ i, l : integer;
+begin
+ s := argliteral( arg, false );
+ l := length( s );
+ for i := 1 to l do texwrite(outfile, s.body[i]);
+ write(outfile, blank)
+end;
+
+
+END.