Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50416/bound.sai
There are 2 other files named bound.sai in the archive. Click here to see a list.
entry ;
COMMENT
.SEC(BOUND.SAI - BOUNDED I/O UPLOWINCHWL AND GUESSER)
.INDEX(BOUND.SAI - BOUNDED I/O UPLOWINCHWL AND GUESSER)
.;
Begin "BOUND.SAI"

    Require
	"DEFINE.REQ" Source!file ;
Comment

                Richard Gordon and Peter Lemkin
                     Image Processing Unit
                   National Cancer Institute
                 National Institutes of Health
                     Building 36 Room 4D28
                  Bethesda, Maryland 20014 USA



Revised Aug 17, 1976 - fixed guesser , Lemkin
Revised May 27,1976  ADDED PUB STATEMENTS
Revised May 10,1976 Shapiro, Lemkin added Getabl.req
Revised  March 29, 1976, Gordon, added COMMENT PAGEMARK
	Revised Dec 22, 1975 - Peter Lemkin
	Revised Jan 8, 1975 - P. Lemkin, added UPLOWINCHWL, GUESSER
	Revised Jan 12, 1976 - R. Gordon, corrected, DEFINE.REQ added
	Revised Jan 14, 1976 - P. Lemkin, correced GUESSER for exact match
	Revised Jan 29, 1976 - P. Lemkin, make guesser used all of input
				command before guessing
	Revised Jan 30, 1976 - P. Lemkin, fixed GUESSER
	Revised March 4, 1976 - P. Lemkin, added INSPOOL
	Revised March 11, 1976 - R. Gordon, added PUB edit commands
	Revised March 17, 1976 - Lemkin, fixed table to Owns
	Revised March 20, 1976 - Lemkin, each procedure on separate page,
				none case for GUESSER

                       phone 301-496-2394


;
comment
	Five Boolean Procedures BOUND, IBOUND,  SBOUND,  LBOUND
and FBOUND allow convenient teletype input of single parameters
to an interactive SAIL program. They deal with  Real,  Integer,
String and Boolean variables, and file names, respectively. 

	Two additional procedures UPLOWINCHWL and  GUESSER  may
be  used  to  input  upper case teletype input (without doing a
TTYUP) and to guess the identity  of  a  string  when  compared
against a list of legal strings.

	The  External variable INSPOOL is used both as a switch
and as a channel number specification to specify whether or not
input  for  the  BOUND routines and UPLOWINCHWL is to be gotten
from the TTY: (if INSPOOL=0) or from an I/O channel (If  1  leq
INSPOOL leq 16);

COMMENT
.next page;
"	List of procedures
	------------------
The calling specifications are:

External Integer INSPOOL;

Boolean Procedure BOUND( Real a; Reference Real b; Real c;
	 String longmsg,shortmsg);

Boolean Procedure IBOUND( Integer a; Reference Integer b; Integer c;
	String longmsg,shortmsg);

Boolean Procedure SBOUND( Reference String b;
	 String options, longmsg, shortmsg);

Boolean Procedure LBOUND(Reference Boolean a;
	 String longmsg, shortmsg); 

Boolean Procedure FBOUND(Reference String file!name;
	String options, longmsg, shortmsg);

String Procedure UPLOWINCHWL;

String Procedure GUESSER(String actual!cmd;
		 String Array legal!commands);

	Arguments used in procedure calls
	---------------------------------

	a - is a lower bound

	c - is an upper bound

	b - is the returned parameter

	options - is a string of options, separated by commas
	specified in the procedure call in which the users TTY:
	response must be found.

	msg - is a string message prompting the user.

Note that a and c may take on the String values:
	-inf, -INF, inf, and INF to represent plus or minus infinity.

Similarly, options may take on the value: ANY to allow any String.

Each routine returns TRUE if the value of b has been changed,
FALSE if not, except for LBOUND, which returns the value of the
boolean variable. 

Include the following Require statement in your program:
"

Comment

Require "BOUND.REQ" Source!file;
comment GETABL works by analogy with GETCHAN to  get  a  break  table
number for  SBOUND. ;




    Require
	"CVT.REQ" source!file ;
COMMENT
.ss(Internal and External Declarations);

    Internal Integer inspool,inspeof;

    Internal Boolean terse;

    Require "GETABL.REQ" SOURCE!FILE;
COMMENT
.next page
.ss(Procedure SPOOL!INCHWL)
.index(Procedure SPOOL!INCHWL)
.;



COMMENT
.next page
.;
    String Procedure SPOOL!INCHWL;
Comment Get input from the INSPOOL I/O channel if inspool is in
1:16  else get it from the TTY:;
    Begin "spool!inchwl"

	Own Integer table;

	String s;
comment 	get the break table number if not setup;

	If  not table
		Then SETBREAK(table_GETABL,'12,'15,"INS");
comment 	Get the string from the tty: if not eof and not
channel #;
	If  1 leq inspool leq 16
		Then
	Begin "get channel input"
	    s_Input(inspool,table);
	    If  inspeof
	    	Then
	    Begin "close input channel"
		Release(inspool);
		s_Inchwl;
		inspool_0;
	    End "close input channel"
	    	Else outstr(s & crlf);
	End "get channel input"
		Else s_Inchwl;
	Return(s);
    End "spool!inchwl";
COMMENT
.next page
.ss(Procedure BOUND)
.index(Procedure BOUND)
.;



    Internal Boolean Procedure BOUND(  Real a;
				       Reference Real b;
				       Real c;
				       String longmsg,shortmsg  );
    Begin "BOUND"

	Real bnew;

	Boolean changed;

	String Stringin,fullmsg,blanks;

	Integer brchar;

	blanks_
	    "                                                        ";
	If  a="-inf" or a="-INF"
		Then a_minreal;
	If  c="inf" or c="INF"
		Then c_maxreal;
	If  a>c
		Then outstr("error in BOUND, lower bound =" & CVT(a) &
		" upper bound =" & CVT(c));
	while true do
	Begin "check range"
	    outstr(fullmsg_( if  terse and not Equ(shortmsg,null)
			     	Then shortmsg
			     	Else longmsg
	    ) & " <now " & CVT(b) & ">: ");
	    Stringin_SPOOL!INCHWL;
	    bnew_ If  Equ(Stringin,null)
		  	Then b
		  	Else if Equ(Stringin[1 for 4],"-inf")
				or Equ(Stringin[ 1 for 4],"-INF")
			      	Then minreal
			      	Else if Equ(Stringin[1 for 3],"inf")
					or Equ( Stringin[1 for 3],
						"INF")
			  	Then maxreal
			  	Else Realscan(Stringin,brchar);
	    If  bnew<a or bnew>c
	    	Then outstr(CVT(bnew) & " is out of range ("
			& CVT(a) & "," & CVT(c) & ")" & crlf)
	    	Else done
	    "check range";
	End "check range";
	changed_ If  b=bnew
		 	Then false
		 	Else true;
	If  changed
		Then outstr(blanks[1 to length(fullmsg)-9] &
			"new val:" & CVT( bnew) & crlf);
	b_bnew;
	return(changed);
    End "BOUND";

COMMENT
.next page
.ss(Procedure SBOUND)
.index(Procedure SBOUND)
.;



    Internal Boolean Procedure SBOUND(  Reference String b;
					String options,longmsg,shortmsg  );
comment Types out the msg, then inputs String b Requiring that it be
one of the Strings in options, separated by commas;
    Begin "SBOUND"

	String bnew,test,Stringin,optionsscan,fullmsg,blanks;

	Boolean changed;

	Own Integer brchar,table;

	label okay,getstring;

	blanks_
	    "                                                        ";
	If  not table
		Then setbreak(table_GETABL,",",null,"i");

getstring:

	optionsscan_options;
	outstr(fullmsg_( if  terse and not Equ(shortmsg,null)
			 	Then shortmsg
			 	Else longmsg
	) & " <now " & b & ">: ");
	Stringin_SPOOL!INCHWL;
	bnew_ If  Equ(Stringin,null)
	      	Then b
	      	Else Stringin;
	if  Equ(bnew[1 for 1],"&")
		Then bnew_b & bnew[2 to inf];
	if  Equ(bnew[length(bnew) for 1],"&")
		Then bnew_bnew[1 to length(bnew)-1] & b;
	if  Equ(options,"any") or Equ(options,"ANY")
		Then Goto okay
		Else 
		If Equ(options,"not null") or Equ(options,"NOT NULL")
		or Equ(options,"any but null") or Equ(options,
		    "ANY BUT NULL") or Equ(options,"no null") or
			Equ( options,"NO NULL")
	    	Then if Equ(bnew,null)
			Then
		Begin "no null"
		    outstr("null String not allowed" & crlf);
		    Goto getstring;
		End "no null"
			Else Goto okay
	    	Else
	    Begin "checking"
		while not Equ(test_scan(optionsscan,table,brchar),null)
		    do
		Begin "check range"
		    if  Equ(bnew,test)
		    	Then Goto okay;
		End "check range";
		outstr("String <" & Stringin & "> is not one of: " &
		    options & crlf);
		Goto getstring;
	    End "checking";
	okay:changed_ not Equ(b,bnew);
	If  changed
		Then outstr(blanks[1 to length(fullmsg)-9] &
			"new val: " & bnew & crlf);
	b_bnew;
	return(changed);
    End "SBOUND";
COMMENT
.next page
.ss(Procedure IBOUND)
.index(Procedure IBOUND)
.;



    Internal Boolean Procedure IBOUND(  Integer a;
					Reference Integer b;
					Integer c;
					String longmsg,shortmsg  );
    Begin "IBOUND"

	Integer bnew,brchar;

	Boolean changed;

	String Stringin,blanks,fullmsg;

	blanks_
	    "                                                        ";
	if  a="-inf" or a="-INF"
		Then a_mininteger;
	if  c="inf" or c="INF"
		Then c_maxinteger;
	if  a>c
		Then outstr("Error in IBOUND, lower BOUND =" &
			cvs(a) & " upper BOUND =" & cvs(c));
	while true do
	Begin "check range"
	    outstr(fullmsg_( if  terse and not Equ(shortmsg,null)
			     	Then shortmsg
			     	Else longmsg
	    ) & " <now " & cvs(b) & ">: ");
	    Stringin_SPOOL!INCHWL;
	    bnew_ If  Equ(Stringin,null)
		  	Then b
		  	Else if Equ(Stringin[1 for 4],"-inf") or
				Equ(Stringin[ 1 for 4],"-INF")
		      	Then mininteger
		      	Else if Equ(Stringin[1 for 3],"inf") or Equ(
				  Stringin[1 for 3],"INF")
			  	Then maxinteger
			  	Else intscan(Stringin,brchar);
	    if  bnew<a or bnew>c
	    	Then outstr(cvs(bnew) & " is out of range (" & cvs(a) & "," &
		    cvs(c) & ")" & crlf)
	    	Else done ;

	End "check range";
	changed_ if  b=bnew
		 	Then false
		 	Else true;
	if  changed
		Then outstr(blanks[1 to length(fullmsg)-9] &
			"new val: " & cvs( bnew) & crlf);
	b_bnew;
	return(changed);
    End "IBOUND";
COMMENT
.next page
.ss(Procedure LBOUND)
.index(Procedure LBOUND)
.;



    Internal Boolean Procedure LBOUND(  Reference Boolean a;
					String longmsg,shortmsg  );
    Begin "LBOUND"

	String aget;

	aget_ if  a
	      	Then
"yes"	      	Else
"no"		  ;
	SBOUND(aget,"yes,y,YES,Y,ok,OK,okay,OKAY,sure,SURE,yep,YEP," &
	    "true,TRUE,t,T,always,ALWAYS,no,n,NO,N,not,NOT," &
	    "never,NEVER," & "ng,NG,nope,NOPE,false,FALSE,f,F",longmsg,
	    shortmsg);
	a_ if  Equ(aget,"yes") or Equ(aget,"y") or Equ(aget,"YES") or Equ
		   (aget,"Y") or Equ(aget,"ok") or Equ(aget,"OK") or Equ
		   (aget,"okay") or Equ(aget,"OKAY") or Equ(aget,"sure")
		   or Equ(aget,"SURE") or Equ(aget,"yep") or Equ(aget,
		   "YEP") or Equ(aget,"true") or Equ(aget,"TRUE") or Equ
		   (aget,"t") or Equ(aget,"T") or Equ(aget,"always") or
		   Equ(aget,"ALWAYS")
	   	Then true
	   	Else false;
	return(a);
    End "LBOUND";
COMMENT
.next page
.ss(Procedure FBOUND)
.index(Procedure FBOUND)
.;



    Internal Boolean Procedure FBOUND(  Reference String file!name;
					String options,longmsg,shortmsg  );
    Begin "FBOUND"

	Integer channel,flag,brchar,eof;

	SBOUND(file!name,options,longmsg,shortmsg);
	if  not Equ(file!name,null)
		Then
	Begin "find"
	    channel_getchan;
	    open(channel,"dsk",0,0,0,0,brchar,eof);
	    lookup(channel,file!name,flag);
	    release(channel);
	End "find"
		Else flag_true;
	return( not flag);
    End "FBOUND";
COMMENT
.next page
.ss(Procedure UPLOWINCHWL)
.index(Procedure UPLOWINCHWL)
.;



    Internal String Procedure UPLOWINCHWL;
comment ----------------------------------------;
    Begin "ULI"

	String ss,s;

	Integer i;

	s_SPOOL!INCHWL;
	ss_null;
	While length(s) Do
	    If  (i_lop(s)) geq '141 and i leq '172
	    	Then ss_ss & (i-'40)
	    	Else ss_ss & i;
	Return(ss);
    End "ULI";
COMMENT
.next page
.ss(Procedure GUESSER)
.index(Procedure GUESSER)
.;



    Internal String Procedure GUESSER(  String actual!cmd;
					String Array legal!commands  );
comment ----------------------------------------;
Comment
	GUESSER is a modified version of the  RUDDER  procedure
by  the  same  name  which may be used to test whether a string
ACTUAL!CMD is a substring of one or more legal command  strings
in  array  LEGAL!COMMANDS.   User  interaction  is rEquested if
needed to resolve  ambiguous  cases.  The  string  selected  is
output on having to make a guess. It returns the guessed string
if no match was found otherwise it returns the null string.
;

    Begin "GUE"

	Integer i,j,k,l,m,n;

	String sh,tc,lc,best!guess!cmd;

	Integer Array best[1:30],lbest[1:30],border[1:30];
comment 	First test for exact match before try to guess!;

	For i_  1 step 1 until ARRINFO(legal!commands,2) Do
	    If  Equ(actual!cmd,legal!commands[i])
	    	Then Return(actual!cmd);
	n_j_0;
	best!guess!cmd_null;
	l_length(actual!cmd);
comment 	get first 2 letters of input actual!cmd;
	sh_actual!cmd[1 to 3];
comment 	search for potential matches on all of input cmds
letters	letters;
comment 	test all legal commands (i.e. size of the array);

	For i_  1 Step 1 Until arrinfo(legal!commands,2) Do
	Begin "A6"
comment 	copy the i'th command;
	    lc_legal!commands[i];
	    If  Equ(sh,lc[1 to 3])
	    	Then
	    Begin "A1"
comment 	yes, test the rest of input actual!cmd to see if	
subset of i'th actual!cmd;
comment 	make 2nd copy of ith actual!cmd;

		tc_legal!commands[i];
		For k_  4 Step 1 Until l Do
comment 	if not Equal 	Then forget it;
		    If  not Equ(actual!cmd[k For 1],tc[k For 1])
		    	Then Done ;
comment 	compute ordered list of best fits by # chars which
match;
		If  (k-1)>n
			Then n_k-1;
comment 	best[*] gets index i if best so far;
		best[j_j+1]_i;
comment 	save length of match so far as well;
		lbest[j]_k-1;
	    End "A1";
	End "A6";
comment 	test of no match;
	If  j=0
		Then Return(null);
comment 	one match - reset actual!cmd to full actual!cmd name;
	If  j=1
		Then best!guess!cmd_legal!commands[best[1]]
		Else
	Begin "A2"
comment 	more than 1 cmd possible, pick one with best match;
	    setformat(2,0);
	    k_0;
	    For i_  1 Step 1 Until j Do
		If  lbest[i] geq n
			Then
		Begin "A7"
		    k_k+1;
		    l_i;
		End "A7";
	    If  k=1
	    	Then best!guess!cmd_legal!commands[best[l]]
	    	Else
	    Begin "A8"
comment 	several possible actual!cmds with same submatches;
		outstr("THERE ARE " & cvs(k) & " POSSIBLE COMMANDS" &
		    crlf);
		For m_  1 Step 1 Until j Do
		Begin "A3"
comment 	find instances of max possible match;
		    l_0;
		    k_n;
		    For i_  1 Step 1 Until j Do
			If  lbest[i] geq k
				Then
			Begin "A4"
			    k_lbest[i];
			    l_i;
			End "A4";
comment 	if found instance 	Then print it;
		    If  l neq 0
		    	Then
		    Begin "A9"
			lbest[l]_0;
			border[m]_best[l];
			outstr(cvs(m) & " " & legal!commands[best[l]] &
			    crlf);
		    End "A9";
		End "A3";
comment 	now ask which actual!cmd desired;
		outstr("WHICH COMMAND (0 for none) [1] =");
comment 	check for default;
		If  length(sh_SPOOL!INCHWL)=0
			Then Return(null)
			Else
		Begin "A5"
comment 	get and check non-null actual!cmd number;
comment 	if out of bounds, default to # 0;

		    l_intscan(sh,i);
		    If  l leq 0 or l>j
		    	Then Return(null);
		End "A5";
		best!guess!cmd_legal!commands[border[l]];
	    End "A8";
	End "A2";
comment 	if the input actual!cmd is different from the guessed
actual!cmd then return the guessed actual!cmd;
	If  not Equ(best!guess!cmd,actual!cmd)
		Then
	Begin "see if exact match up to length of actual!cmd"
	    For k_  1 step 1 until length(actual!cmd) Do
		If  not Equ(actual!cmd[k for 1],best!guess!cmd[k for 1])
			Then Return(null);
	    Return(best!guess!cmd)
	End "see if exact match up to length of actual!cmd"
		Else return(actual!cmd);
    End "GUE";

End "BOUND.SAI";