{***********************************************************************
 
Pascal ELIZA program for PDP-11, modified Swedish Pascal.
 
Date 17-June-79
 
 
		- Program files:
			ELIZA.PAS
			STRING.PAS
		- Data files:
			  DOCTOR.KEY
			  DOCTOR.NUM
			  DOCTOR.CON
			  DOCTOR.RPL
 
	RESTRICTIONS	- Not to be used by paranoid users
 
	ABSTRACT	-
 
	The original ELIZA program was written in LISP by
	Joseph Weizenbaum (MIT).  This program was inspired
	by Steve North's article (Creative Computing).
 
	This Pascal program is a translation of John Guidi's
	PL/I program distributed on the DECUS New Orleans 79 tape.
 
	The text files are from the fall 78 DECUS tapes.
	Congratulations ye who wrote the doctor program in TECO,
	and thanks for the text files.
 
	When compiling this program, disregard the 142 errors.
 
************************************************************************
 
	There are 4 files required:
	1) DOCTOR.KEY - This file contains a list of all the
	   keywords which ELIZA can recognize.
	2) DOCTOR.RPL - This file contains a list of all the
	   replies which ELIZA knows.
	3) DOCTOR.NUM - For each keyword, the corresponding
	   record in this file contains the index of the first
	   reply for this keyword, and the number of replies
	   available.
	4) DOCTOR.CON - This file contains conjugates, and the
	   conjugate's pair in the next record.
 
***********************************************************************}
 
Program ELIZA (tty);
 
const
    NKEYW = 51;		{ Number of keywords }
    NCONJ = 15;		{ Number of conjugate pairs }
    NREPL = 144;	{ Number of available replies }
 
    LKEYW = 15;		{ Maximum length of keywords }
    LCONJ = 10;		{ Maximum length of conjugates }
    LREPL = 80;		{ Maximum length of replies }
 
type
    stringk = record
	size:	integer;
	len:	integer;
	ch:	array [1..LKEYW] of char
	end;
 
    stringc = record
	size:	integer;
	len:	integer;
	ch:	array [1..LCONJ] of char
	end;
 
    stringr = record
	size:	integer;
	len:	integer;
	ch:	array [1..LREPL] of char
	end;
 
    kcr = ( K, C, R );
 
    string = record
	case kcr of
	K: ( strk: stringk );
	C: ( strc: stringc );
	R: ( strr: stringr )
	end;
 
var
    i, j:	integer;
    finished:	boolean;
    conpos:	integer;
    repid:	array [1..NKEYW] of integer;
    reptot:	array [1..NKEYW] of integer;
    repuse:	array [1..NKEYW] of integer;
    keyword:	array [1..NKEYW] of stringk;
    conjug:	array [1..NCONJ,1..2] of stringc;
    reply:	array [1..NREPL] of stringr;
    shutup:	stringk;
    response:	stringr;
    keyid:	integer;
    f:		text;
 
 
{ External Procedures }
 
function length ( var s: string ): integer; extern;
 
procedure clear ( var s: string ); extern;
 
procedure concatenate ( {in/out} var s: string;
			{in}	 var t: string ); extern;
 
function search ( {in}	var s: string;
			var t: string;
			    start: integer): integer; extern;
 
procedure writestring ( {in} var f: text;
			     var s: string); extern;
 
procedure delete ( {in/out} var s: string;
		   {in}         start: integer;
				span: integer); extern;
 
procedure insert ( {in/out} var s: string;
		   {in}     var t: string;
				p: integer); extern;
 
 
{*************************** SEED THE ARRAYS ****************************}
 
begin
 
{ Seed the keyword array from the keyword file. }
 
reset (f, 'DOCTOR.KEY' );
for i:=1 to NKEYW-1 do
    begin
    read (f, keyword[i].ch);
    keyword[i].size := LKEYW;
    keyword[i].len  := length(keyword[i]) + 1 ;
    readln (f)
    end;
read (f, keyword[NKEYW].ch);
keyword[NKEYW].size := LKEYW;
keyword[NKEYW].len  := length(keyword[NKEYW]) + 1 ;
 
{ Seed the conjugate array }
 
reset (f, 'DOCTOR.CON');
for i:=1 to NCONJ do
    begin
    read (f, conjug[i,1].ch);
    readln (f);
    read (f, conjug[i,2].ch);
    conjug[i,1].size := LCONJ;
    conjug[i,2].size := LCONJ;
    conjug[i,1].len  := length(conjug[i,1]) + 1 ;
    conjug[i,2].len  := length(conjug[i,2]) + 1 ;
    readln (f)
    end;
 
{ Read in the replies }
 
reset (f, 'DOCTOR.RPL' );
for i:=1 to NREPL-1 do
    begin
    read (f, reply[i].ch);
    reply[i].size := LREPL;
    reply[i].len  := length(reply[i]) + 1 ;
    readln (f)
    end;
read (f, reply[NREPL].ch);
reply[NREPL].size := LREPL;
reply[NREPL].len  := length(reply[NREPL]) + 1 ;
 
 
{ Read in the reply pointer arrays.  REPID[i] is the index of
  the first of a group of replies in the reply array for the
  ith keyword.  REPTOT[i] indicates the total number of replies
  available for the ith keyword.  REPUSE[i] is the relative index
  within the available group of replies that is to be used next.
  It is bumped by with each use of a reply.  (Keeps the conversation
  from getting too dull!)					}
 
reset (f, 'DOCTOR.NUM' );
for i:=1 to NKEYW do
    begin
    read (f,repid[i], reptot[i]);
    repuse[i] := 0 ;
    end;
 
{***************************************************************}
 
shutup.size := LKEYW;
shutup.ch := ' SHUT UP       ';
shutup.len  := 9;
 
response.size := LREPL;
 
finished := false;
 
 
{ Output our opening statement }
writeln ('This is the PDP-11 Eliza program, what''s your problem?');
 
{*************** HERE IS WHERE THE WORK IS DONE ****************}
 
{	1) PROMPT THE USER, OBTAIN HIS RESPONSE			}
{	2) REMOVE ANY APHOSTROPHES FROM USERS RESPONSE		}
{	3) PAD BOTH SIDES OF USERS RESPONSE			}
{	4) CONVERT LOWERCASE CHARACTERS TO UPPERCASE		}
{	5) SEARCH KEYWORD ARRAY FOR THE FIRST MATCH		}
{	6) CONJUGATE STRING TO RIGHT OF USERS RESPONSE IF KEYWORD FOUND }
{	7) GET REPLY STRING USING VALUES IN REPID (START OF REPLIES), }
{	   REPUSE (REPLY TO USE), AND REPTOT (NUMBER OF REPLIES AVAILABLE) }
{	8) CONCATENATE USERS RESPONSE STRING TO REPLY STRING IF NEEDED }
{	9) CONVERT LOWERCASE REPLY STRING TO UPPERCASE CHARACTERS }
 
 
repeat
    { Prompt the patient and read his response }
    write ('-');   break;
    readln;    read (response.ch);
    response.len := length(response);
 
 
    if response.len > 0 then
    begin
 
    { Pad both sides of response with spaces }
    for i:= response.len downto 1 do
	response.ch[succ(i)] := response.ch[i];
    response.ch[1] := ' ';
    response.ch[response.len+2] := ' ';
    response.len := response.len + 2 ;
 
 
    { Make sure that response is all uppercase }
    for i:=1 to response.len do
	if (response.ch[i] >= 'a') and (response.ch[i] <= 'z') then
	    response.ch[i] := chr(ord(response.ch[i])-ord('a')+ord('A'));
 
 
 
    { Get rid of all non-alphabetics from his response }
    i := 1 ;
    while i <= response.len do
	begin
	if ((response.ch[i]<'A') or (response.ch[i]>'Z')) and
	   (response.ch[i] <> ' ')    then
	    begin
	    for j:=i to response.len do
		response.ch[j] := response.ch[succ(j)];
	    response.len := pred(response.len)
	    end;
	i := succ(i)
	end;
 
    { Look for the shutup phrase in the response }
 
    finished :=  search(response,shutup,1) > 0 ;
 
 
    { At this point we have the patient's response.  We must now
      search the keyword array for the first match.  Note!  This is
      why the keywords are stored in the array in order of importance. }
    keyid := 0 ;
    j := 0 ;
    while (j=0) and (keyid<NKEYW) do
	begin
	keyid := succ(keyid);
	j := search(response,keyword[keyid],1)
	end;
 
 
    { If we've found a keyword, j>0.  If j=0, no keyword found.
      Take the right part of the string and conjugate it if
      necessary.						}
 
    if j>0 then
	delete ( response, 1, j+keyword[keyid].len-2 );
 
 
    { Now search for any conjugates in the remaining string }
    { and replace each by its conjugate pair.		    }
 
    for i := 1 to NCONJ do
    while  search(response,conjug[i,1],1) > 0  do
	begin
	conpos := search(response,conjug[i,1],1);
	delete (response, conpos, conjug[i,1].len);
	insert (response, conjug[i,2], conpos)
	end;
 
 
    { 1.  Get repid[keyid].  This is the index of the first 
	  element of the reply array for the matched keyword.
      2.  Get reptot[keyid].  This is the number of available
	  replies for this keyword match.
      3.  Check repuse[keyid] to see what the last reply was.
      4.  Create the reply string and output it.		}
 
    i := repid[keyid] + repuse[keyid];
    if finished then i := 92 ; { Give reply to 'shut up' }
    { Bump the repuse up if there are more replies, otherwise
      set it back to the begining (0).				}
    repuse[keyid] := succ(repuse[keyid]);
    if repuse[keyid] = reptot[keyid] then repuse[keyid] := 0;
    if reply[i].ch[reply[i].len-1] = '*' then
	begin
	reply[i].len := reply[i].len - 2; {Temporarily remove '*'}
	insert (response, reply[i], 1);
	reply[i].len := reply[i].len + 2
	end
    else
	response := reply[i];
 
 
    { Now make certain that response is all uppercase characters }
    for i := 1 to response.len do
	if (response.ch[i]>='a') and (response.ch[i]<='z') then
	    response.ch[i] := chr(ord(response.ch[i])-ord('a')+ord('A'));
 
 
    { Output the response }
 
    writestring ( tty, response );     writeln ( tty )
 
    end  { if response.len > 0 }
 
    until finished ;
 
writeln ('Good bye.')
end.