diff options
Diffstat (limited to 'support/rnototex/argops.pas')
-rw-r--r-- | support/rnototex/argops.pas | 293 |
1 files changed, 293 insertions, 0 deletions
diff --git a/support/rnototex/argops.pas b/support/rnototex/argops.pas new file mode 100644 index 0000000000..8123892abf --- /dev/null +++ b/support/rnototex/argops.pas @@ -0,0 +1,293 @@ +{ MODULE FOR LIST AND TREE OPERATIONS ARGUMENTS } +{ RANDALL VENHOLA JULY 8, 1987 } + + +[INHERIT('SCREENHANDLERS','UTILITYOPS'), environment('argops')] + +MODULE ARGOPS; + +CONST + + maxchars = 31; {# of chars in arg literal } + maxargsinarray = 30; {for conversion to an array of args} + indexofunknowntexcommand = 0; + +TYPE + + pckstr = VARYING [ maxchars ] of char; + + comparisons = (notvalid, lessthan, equal, greaterthan); + + setofcomparisons = set of comparisons; + + argtype = ( dsrverb, int, signedint, stylespecifier, + textpckstr, character, quotedpckstr, nulltype); + + setofargtype = set of argtype; + + argument = record + source : pckstr; + isgeneralization : boolean; + texindex : integer; + class : setofargtype + end; + + argarray = array[1..maxargsinarray] of argument; + + + + +[GLOBAL] FUNCTION argliteral( arg : argument; smooth : boolean ) : pckstr; + +var + s : pckstr; + i,j, firstchar, lastchar : integer; + ch : char; + + procedure findfirstchar( s : pckstr; var firstchar : integer); + begin + firstchar := 1; + while (firstchar < s.length) and (s.body[firstchar] <= blank) do + firstchar := firstchar + 1 + end; + + procedure findlastchar( s : pckstr; var lastchar : integer ); + begin + lastchar := s.length; + while (lastchar > 1) and (s.body[lastchar] <= blank) do + lastchar := lastchar - 1 + end; + +begin + if smooth then + begin + findfirstchar( arg.source, firstchar); + findlastchar( arg.source, lastchar); + j := 0; + for i := firstchar to lastchar do + begin + ch := arg.source.body[i]; + if ch < blank then ch := blank; + if ch in ['a'..'z'] then ch := chr(ord(ch) - ord(blank)); + j := j + 1; + s.body[j] := ch + end; + if (j = 1) and (s.body[1] = blank) then + s.length := 0 + else + s.length := j + end + else + s := arg.source; + argliteral := s +end; + + + + + +[GLOBAL] FUNCTION pckstrisgeneralization( s : pckstr ) : boolean; + label + routineexit; + var + flag : boolean; + begin + flag := false; + if s = '[N]' then + begin + flag := true; + goto routineexit + end; + if s = '[C]' then + begin + flag := true; + goto routineexit + end; + if s = '[Y]' then + begin + flag := true; + goto routineexit + end; + if s = '[T]' then + begin + flag := true; + goto routineexit + end; + if s = '[Q]' then + begin + flag := true; + goto routineexit + end; + routineexit : pckstrisgeneralization := flag +end; + + + + +[GLOBAL] FUNCTION argisgeneralization( arg : argument ) : boolean; +begin + argisgeneralization := arg.isgeneralization +end; + + + + +[GLOBAL] FUNCTION textualmatch( arg1, arg2 : argument) : boolean; +begin + textualmatch := false; + if (arg1.source = '[T]') and (textpckstr in arg2.class) then + textualmatch := true + else + if (arg2.source = '[T]') and (textpckstr in arg1.class) then + textualmatch := true +end; + + + + +[GLOBAL] FUNCTION compareargs( leftarg, rightarg : argument ) : comparisons; +label + routineexit; +var + lefts, rights : pckstr; + equalpckstrs : boolean; + comp : comparisons; + + procedure greaterorlessthancompare; + begin + if lefts < rights then + comp := lessthan + else + comp := greaterthan + end; + + procedure checktexindex; + begin + if (leftarg.texindex = indexofunknowntexcommand) or + (rightarg.texindex = indexofunknowntexcommand) then + comp := equal + else + if leftarg.texindex = rightarg.texindex then + comp := equal + else + greaterorlessthancompare + end; + +begin + if textualmatch( leftarg, rightarg) then + begin + comp := equal; + goto routineexit + end; + if (leftarg.class = [nulltype]) or (rightarg.class = [nulltype]) then + begin + comp := equal; + goto routineexit + end; + lefts := argliteral(leftarg, TRUE); + rights := argliteral(rightarg, TRUE); + equalpckstrs := (lefts = rights); + comp := notvalid; + if leftarg.class * rightarg.class <> [] then + begin + if equalpckstrs then + comp := equal + else + if (leftarg.isgeneralization) or (rightarg.isgeneralization) then + checktexindex + else + greaterorlessthancompare + end + else + greaterorlessthancompare; + routineexit : compareargs := comp +end; + + + + +[GLOBAL] FUNCTION argtexindex( arg : argument ) : integer; +begin + argtexindex := arg.texindex +end; + + + + +[GLOBAL] FUNCTION argclass( arg : argument ) : setofargtype; +begin + argclass := arg.class +end; + + + + +[GLOBAL] PROCEDURE initarg( var arg : argument; classification : setofargtype; + lit : pckstr; index : integer; general : boolean ); +begin + arg.source := lit; + arg.class := classification; + arg.texindex := index; + arg.isgeneralization := general +end; + + + + +[GLOBAL] PROCEDURE reassignargclass( var arg : argument; newclass : setofargtype); +begin + arg.class := newclass +end; + + + + +[GLOBAL] PROCEDURE reassignargtexindex( var arg : argument; newindex:integer); +begin + arg.texindex := newindex +end; + + + +[GLOBAL] PROCEDURE reassignarggeneralization( var arg : argument;general:boolean); +begin + arg.isgeneralization := general +end; + + + + +[GLOBAL] PROCEDURE appendchartoarg( ch : char; var arg : argument ); +begin + if arg.source.length = maxchars then + warningmessage('appendchartoarg','argument too long') + else + begin + arg.source.length := arg.source.length + 1; + arg.source.body[arg.source.length] := ch + end +end; + + + + +[GLOBAL] PROCEDURE extractintegerfromargument( arg : argument; var successful : boolean; + var int : integer; + var signed : boolean ); +var + s : pckstr; +begin + s := argliteral( arg, TRUE); + readv( s, int, error := continue ); + if statusv <> 0 then + successful := false + else + begin + successful := true; + signed := (s.body[1] = '+') or (s.body[1] = '-') + end +end; + + + +END. |