mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 00:44:23 +00:00
287 lines
10 KiB
Plaintext
287 lines
10 KiB
Plaintext
$eject
|
|
check$choice: procedure(index,mindex) byte;
|
|
/* does this modifier go with this
|
|
option? */
|
|
declare
|
|
index byte,
|
|
mindex byte;
|
|
|
|
return(opt$mod(index).modifier(mindex));
|
|
|
|
end check$choice;
|
|
|
|
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
|
|
|
|
|
* * * Option scanner * * *
|
|
|
|
|
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
|
|
|
|
|
separator: procedure(character) byte;
|
|
|
|
/* determines if character is a
|
|
delimiter and which one */
|
|
declare k byte,
|
|
character byte;
|
|
|
|
k = 1;
|
|
loop: if delimiters(k) = end$list then return(0);
|
|
if delimiters(k) = character then return(k); /* null = 25 */
|
|
k = k + 1;
|
|
go to loop;
|
|
|
|
end separator;
|
|
|
|
opt$scanner: procedure(list$ptr,off$ptr) byte;
|
|
|
|
/* list$ptr - pointer to list of known strings
|
|
off$ptr - pointer to offsets into known string
|
|
list
|
|
buf$ptr - pointer to input string
|
|
|
|
Scans the known string list for an occurrance of the input
|
|
string. If the input string is not found in the known list
|
|
then return(0). Otherwise, return the index of the known string
|
|
that matches the input.
|
|
|
|
1. Find the known string that matches the input string on the
|
|
first letter.
|
|
|
|
do i = 1 to #known_strings
|
|
if Known_string(i,1) = input(1) then do
|
|
|
|
if length(Known_string(i)) < end_of_input
|
|
then return(0)
|
|
|
|
do j = 2 to end_of_input
|
|
|
|
if Known_string(i,j) ~= input(j) then
|
|
go to again
|
|
end
|
|
|
|
go to 2
|
|
end
|
|
again: end
|
|
|
|
return (0) !no matchs
|
|
|
|
2. Test to see if the input string does not match another Known
|
|
string. This may happen if the input string is not a
|
|
unique sub-string of the Known string, ie., DI is a
|
|
sub-string of DIRECTORY and DISK.
|
|
|
|
index = i
|
|
|
|
do i = index+1 to #known_strings
|
|
do j = 1 to end of input
|
|
|
|
if Known_string(i,j) ~= input(j) then
|
|
go to next
|
|
end
|
|
|
|
return(0) !not unique
|
|
next: end;
|
|
|
|
return(index) !unique substring
|
|
|
|
P.Balma 10/82 */
|
|
|
|
declare
|
|
buff based buf$ptr (1) byte,
|
|
off$ptr address,
|
|
list$ptr address;
|
|
|
|
declare
|
|
i byte,
|
|
j byte,
|
|
list based list$ptr (1) byte,
|
|
offsets based off$ptr (1) byte,
|
|
wrd$pos byte,
|
|
character byte,
|
|
letter$in$word byte,
|
|
found$first byte,
|
|
start byte,
|
|
index byte,
|
|
save$index byte,
|
|
(len$new,len$found) byte,
|
|
valid byte;
|
|
|
|
/*****************************************************************************/
|
|
/* internal subroutines */
|
|
/*****************************************************************************/
|
|
|
|
check$in$list: procedure;
|
|
/* find known string that has a match with
|
|
input on the first character. Set index
|
|
= invalid if none found. */
|
|
|
|
declare i byte;
|
|
|
|
i = start;
|
|
wrd$pos = offsets(i);
|
|
do while list(wrd$pos) <> end$list;
|
|
i = i + 1;
|
|
index = i;
|
|
if list(wrd$pos) = character then return;
|
|
wrd$pos = offsets(i);
|
|
end;
|
|
/* could not find character */
|
|
index = 0;
|
|
return;
|
|
end check$in$list;
|
|
|
|
setup: procedure;
|
|
character = buff(0);
|
|
call check$in$list;
|
|
letter$in$word = wrd$pos;
|
|
/* even though no match may have occurred, position
|
|
to next input character. */
|
|
i = 1;
|
|
character = buff(1);
|
|
end setup;
|
|
|
|
test$letter: procedure;
|
|
/* test each letter in input and known string */
|
|
|
|
letter$in$word = letter$in$word + 1;
|
|
|
|
/* too many chars input? 0 means
|
|
past end of known string */
|
|
if list(letter$in$word) = end$of$string then valid = false;
|
|
else
|
|
if list(letter$in$word) <> character then valid = false;
|
|
|
|
i = i + 1;
|
|
character = buff(i);
|
|
|
|
end test$letter;
|
|
|
|
skip: procedure;
|
|
/* scan past the offending string;
|
|
position buf$ptr to next string...
|
|
skip entire offending string;
|
|
ie., falseopt=mod, [note: comma or
|
|
space is considered to be group
|
|
delimiter] */
|
|
character = buff(i);
|
|
delimiter = separator(character);
|
|
do while ((delimiter <> 2) and (delimiter <> 4) and (delimiter <> 5)
|
|
and (delimiter <> 25));
|
|
i = i + 1;
|
|
character = buff(i);
|
|
delimiter = separator(character);
|
|
end;
|
|
endbuf = i;
|
|
buf$ptr = buf$ptr + endbuf + 1;
|
|
return;
|
|
end skip;
|
|
|
|
eat$blanks: procedure;
|
|
|
|
declare charac based buf$ptr byte;
|
|
|
|
do while(delimiter := separator(charac)) = SPACE;
|
|
buf$ptr = buf$ptr + 1;
|
|
end;
|
|
|
|
end eat$blanks;
|
|
|
|
/*****************************************************************************/
|
|
/* end of internals */
|
|
/*****************************************************************************/
|
|
|
|
|
|
/* start of procedure */
|
|
call eat$blanks;
|
|
start = 0;
|
|
call setup;
|
|
|
|
/* match each character with the option
|
|
for as many chars as input
|
|
Please note that due to the array
|
|
indices being relative to 0 and the
|
|
use of index both as a validity flag
|
|
and as a index into the option/mods
|
|
list, index is forced to be +1 as an
|
|
index into array and 0 as a flag*/
|
|
|
|
do while index <> 0;
|
|
start = index;
|
|
delimiter = separator(character);
|
|
|
|
/* check up to input delimiter */
|
|
|
|
valid = true; /* test$letter resets this */
|
|
do while delimiter = 0;
|
|
call test$letter;
|
|
if not valid then go to exit1;
|
|
delimiter = separator(character);
|
|
end;
|
|
|
|
go to good;
|
|
|
|
/* input ~= this known string;
|
|
get next known string that
|
|
matches */
|
|
exit1: call setup;
|
|
end;
|
|
/* fell through from above, did
|
|
not find a good match*/
|
|
endbuf = i; /* skip over string & return*/
|
|
call skip;
|
|
return(0);
|
|
|
|
/* is it a unique match in options
|
|
list? */
|
|
good: endbuf = i;
|
|
len$found = endbuf;
|
|
save$index = index;
|
|
valid = false;
|
|
next$opt:
|
|
start = index;
|
|
call setup;
|
|
if index = 0 then go to finished;
|
|
|
|
/* look at other options and check
|
|
uniqueness */
|
|
|
|
len$new = offsets(index + 1) - offsets(index) - 1;
|
|
if len$new = len$found then do;
|
|
valid = true;
|
|
do j = 1 to len$found;
|
|
call test$letter;
|
|
if not valid then go to next$opt;
|
|
end;
|
|
end;
|
|
else go to nextopt;
|
|
/* fell through...found another valid
|
|
match --> ambiguous reference */
|
|
call skip; /* skip input field to next delimiter*/
|
|
return(0);
|
|
|
|
finished: /* unambiguous reference */
|
|
buf$ptr = buf$ptr + endbuf;
|
|
call eat$blanks;
|
|
if delimiter <> 0 then buf$ptr = buf$ptr + 1;
|
|
else delimiter = SPACE;
|
|
|
|
return(save$index);
|
|
|
|
end opt$scanner;
|
|
|
|
error$prt: procedure;
|
|
declare i byte,
|
|
t address,
|
|
char based t byte;
|
|
|
|
t = buf$ptr - endbuf - 1;
|
|
do i = 1 to endbuf;
|
|
call printchar(char);
|
|
t = t + 1;
|
|
end;
|
|
|
|
end error$prt;
|
|
|