-- Text handling package for use with strings of up to length 255. WITH TEXT_IO ; USE TEXT_IO ; -- make standard text I/O available WITH utils ; USE utils ; -- make utilities available -- text_handler => Text handling package definition. PACKAGE text_handler IS -- Package Types : SUBTYPE ubyte IS INTEGER RANGE 0..255 ; TYPE text ( len : ubyte := 0 ) IS RECORD value : string ( 1..len ) ; END RECORD ; -- Package Procedures : -- set => Set text object to value of given string. PROCEDURE set ( x : OUT text ; y : STRING ) ; -- get => Input a text object from the terminal. PROCEDURE get ( x : OUT text ) ; -- put => Output a text object to the terminal. PROCEDURE put ( x : text ) ; -- Package Functions : -- length => Number of characters in text object ? FUNCTION length ( x : text ) RETURN INTEGER ; -- textch => Character at given position in text object. FUNCTION textch ( x : text ; posn : ubyte ) RETURN CHARACTER ; -- ch_present => Given character in text object at given position ? FUNCTION ch_present ( x : text ; posn : ubyte ; c : CHARACTER ) RETURN BOOLEAN ; -- ltr_present => Case independant version of ch_present. FUNCTION ltr_present ( x : text ; posn : ubyte ; l : CHARACTER ) RETURN BOOLEAN ; -- sub_text => Extract sub-section of a text object. FUNCTION subtext ( x : text ; first, last : ubyte ) RETURN text ; END text_handler ; ------------------------------------------------- -- text_handler => Text handling package body. PACKAGE BODY text_handler IS -- set => Set value part of text record to given string. PROCEDURE set ( x : OUT text ; y : string ) IS BEGIN -- set -- just find length of given string & put into text along with string x := ( y'LENGTH, y ) ; END set ; ------------------------------------------------------- -- get => Input a text value. PROCEDURE get ( x : OUT text ) IS -- Local Variables : in_string : STRING ( 1..255 ) ; ch_count : ubyte := 0 ; BEGIN -- get -- loop inputing characters until end-of-line encountered WHILE NOT end_of_line LOOP ch_count := ch_count + 1 ; GET ( in_string ( ch_count ) ) ; -- uses GET for characters END LOOP ; SKIP_LINE ; -- go on to next line -- now put input string into text record -- a constraint error is possible here if x is constrained & too -- many characters have been input x := ( ch_count, in_string ( 1..ch_count ) ) ; END get ; ------------------------------------------------------- -- put => Output string component of text record. PROCEDURE put ( x : text ) IS BEGIN -- put -- just uses PUT for strings PUT ( x.value ) ; END put ; ------------------------------------------------------- -- length => Return length of string component of text record. FUNCTION length ( x : text ) RETURN INTEGER IS BEGIN -- length -- just return string length attribute RETURN x.value'LENGTH ; END length ; ---------------------------------------------------- -- textch => Obtain character from given position in text string. FUNCTION textch ( x : text ; posn : ubyte ) RETURN CHARACTER IS BEGIN -- textch -- just return indexed character from string component RETURN x.value ( posn ) ; END textch ; ---------------------------------------------------- -- ch_present => Does text contain given character in given position ? FUNCTION ch_present ( x : text ; posn : ubyte ; c : character ) RETURN BOOLEAN IS -- Local Variables : present : BOOLEAN ; -- local storage for result BEGIN -- ch_present -- is specified position within text ? present := posn <= length ( x ) ; IF present THEN -- is specified character at this position in text present := textch ( x, posn ) = c ; END IF ; -- return result RETURN present ; END ch_present ; ------------------------------------------------ -- ltr_present => Is given letter at given position in text ? FUNCTION ltr_present ( x : text ; posn : ubyte ; l : CHARACTER ) RETURN BOOLEAN IS -- Local Variables : present : BOOLEAN ; -- local storage for result BEGIN -- ltr_present -- check for character present as given present := ch_present ( x, posn, l ) ; IF NOT present THEN -- if lower case letter then convert to upper case & check again IF ch_is_lower ( l ) THEN present := ch_present ( x, posn, upper_case ( l ) ) ; -- if upper case letter then convert to lower case & check again ELSIF ch_is_upper ( l ) THEN present := ch_present ( x, posn, lower_case ( l ) ) ; END IF ; END IF ; -- return result RETURN present ; END ltr_present ; ----------------------------------------------- -- subtext => Return specified subsection of given text. FUNCTION subtext ( x : text ; first, last : ubyte ) RETURN text IS -- Local Variables : y : text ; -- local storage for result BEGIN -- subtext -- simply extract relevant part of given text y := ( ( last - first + 1 ), x.value ( first..last ) ) ; -- return result RETURN y ; END subtext ; --------------------------------------------------- END text_handler ; -------------------------------------------------