mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 17:04:19 +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;
|
||
|
||
|