Text 46870, 440 rader
Skriven 2008-06-24 17:32:19 av Dustin Cook (1:129/305)
     Kommentar till en text av Ed Vance
Ärende: Re: Emergence BASIC v1.62
=================================
EV> Dustin,

Hi Ed, are you by chance the same Ed who used to run EBBS?

EV> On my 486 pc I can run QBasic type programs, but I don't have the
EV> VisualBasic software, in fact VisualBasic is hard for me to understand.


It's visualbasic like oriented, but you can get a grasp on it pretty easily, 
the online help system is awesome.

EV> From my reading in the QuikBasic Echo I have learned how to do a little
EV> Structured Basic that has No Line Numbers like BASICA has.
EV> 


Exactly. :) All basic like languages of today ignore line numbers, if you've 
gotten used to quickbasic, and it sounds like you have, you should be able to 
enter Emergence Basic well.

EV> Tell me a little more about Emergence BASIC v1.62, thanks.

Well, here's source code to eliza program:

http://www.ionicwind.com/forums/index.php/topic,2412.0.html

'Simple version of Eliza the AI psyschiatrist
'IBPro console programme
'Jolly Roger April 2005
'Speech added on April 2008 ^^_

AUTODEFINE "OFF"

IDispatch speech
string text[10]

speech = CreateComObject("Sapi.SpVoice","")
if speech <> NULL
    goto startprog
else
    PRINT "Sapi object not available"
    do:until inkey$ <> ""
    END
endif

label startprog

DEF inputtext$,response$:STRING
DEF 
pronounsearchstring$[100],pronounreplacement$[100],responsestartphrase$[100]:S
TRING
DEF randomresponse$[100],keyphrase$[100],keyphraseresponse$[100]:STRING
DEF preprocesssearchstring$[100],preprocessreplacement$[100]:STRING
DEF previousresponses$[10],lastinputtext$:STRING
DEF numberofpronounreplacementstrings,numberofpreprocessstrings:UINT
DEF numberofrandomresponses,numberofkeyphrases,nextrandomresponse,n:UINT
DEF numberofresponsestartphrases,repetition:UINT
nextrandomresponse=0
lastinputtext$=""
FOR n=0 TO 9
  previousresponses$[n]=""
NEXT n
OPENCONSOLE
GOSUB readdata

text = "Type what you want to say then press return."
textTospeech(text)

text = "Press return without entering any text to exit."
textTospeech(text)
PRINT:PRINT
text = "Hello, I am Eliza your computer psychiatrist. How can I help you?"
textTospeech(text)

DO
  INPUT inputtext$
  'Strip spaces from start and end
  inputtext$=LTRIM$(RTRIM$(inputtext$))
  'Check if user entered the same text last time
  repetition=0
  IF inputtext$=lastinputtext$ and inputtext$<>""
     text = "You just said that."
     
     textTospeech(text)
     repetition=1
  ENDIF
  lastinputtext$=inputtext$
  IF inputtext$<>"" & repetition=0
    'Preprocess inputtext$ so easier to analyse
    GOSUB preprocessinputtext
    'Try to find response based on keyphrase
    response$=searchforkeyphrases()
    IF response$=""
       'Can't find response related to user input so use random response
       'Use these in order to avoid repetition
       response$=randomresponse$[nextrandomresponse]
       nextrandomresponse=nextrandomresponse+1
       IF nextrandomresponse>numberofrandomresponses-1 THEN 
nextrandomresponse=0
    ENDIF
    'Print the response
    'PRINT LTRIM$(response$)
     text = LTRIM$(response$)
     textTospeech(text)
    'Update the list of the ten most recent responses
    FOR n=8 TO 0 STEP -1
       previousresponses$[n+1]=previousresponses$[n]
    NEXT n
    previousresponses$[0]=response$
  ENDIF
UNTIL inputtext$=""
textTospeech("bye bye!")
speech->release()
CLOSECONSOLE
END
 
SUB preprocessinputtext
   'Pre process inputtext$ to make analysis easier
   DEF searchstring,position,charactercode,searchstringlength:UINT
   'Remove all characters bar numbers and letters from end of inputtext$
   FOR position=LEN(inputtext$) TO 1 STEP -1
      charactercode=ASC(MID$(UCASE$(inputtext$),position,1))
      IF (charactercode<48 | (charactercode>57 & charactercode<65) | 
charactercode>90)
         'Found non alphanumeric character
         inputtext$=LEFT$(inputtext$,LEN(inputtext$)-1)
      ELSE
         position=1
      ENDIF
   NEXT position
   'Add space to beginning and end (required for string searches)
   inputtext$=" "+inputtext$+" "
   'Replace all characters bar numbers,letters or apostrophe with 
space+character+space
   position=1
   DO
      charactercode=ASC(MID$(UCASE$(inputtext$),position,1))
      IF charactercode<48 | (charactercode>57 & charactercode<65) | 
charactercode>90
         'Found non alphanumeric character
         IF charactercode<>39
           'Character isn't an apostrophe so replace
           inputtext$=LEFT$(inputtext$,position-1)+" "+CHR$(charactercode)+" 
"+MID$(inputtext$,position+1)
           position=position+2
         ENDIF
      ENDIF
      position=position+1
   UNTIL position>LEN(inputtext$)
   'Replace all double spaces with a single space
   DO
     position=INSTR(inputtext$,"  ")
     IF position>0
        inputtext$=LEFT$(inputtext$,position)+MID$(inputtext$,position+2)
     ENDIF
   UNTIL position=0
  'Find any preprocessing search strings and replace them
  position=1
  DO
    FOR searchstring=0 TO numberofpreprocessstrings-1
       searchstringlength=LEN(preprocesssearchstring$[searchstring])
       IF 
MID$(UCASE$(inputtext$),position,searchstringlength)=preprocesssearchstring$[s
earchstring]
          'Found a search string.Replace it with corresponding replacement 
string
          
inputtext$=LEFT$(inputtext$,position-1)+preprocessreplacement$[searchstring]+R
IGHT$(inputtext$,(LEN(inputtext$)-searchstringlength-position+1))
          position=position+LEN(preprocessreplacement$[searchstring])-2
          searchstring=numberofpreprocessstrings-1 :'Leave FOR-NEXT loop when 
get to NEXT
       ENDIF
    NEXT searchstring
    position=INSTR(inputtext$," ",position+1)
  UNTIL position=0 :'No more spaces
RETURN
ENDSUB

SUB replacepronouns(texttoalter$:STRING),STRING
  'Replaces pronouns (eg I am->you are) in texttoalter$ to form end of 
response
  DEF currentposn,pronoun:UINT
  DEF pronounsearchstringlength,position:UINT
  DEF alteredtext$:STRING
  alteredtext$=texttoalter$
  'Check for a full stop-only use text before it
  position=INSTR(alteredtext$,".")
  IF position<>0 THEN alteredtext$=LEFT$(alteredtext$,position-1)
  'Scan alteredtext$ for pronouns
  currentposn=1
  DO
    FOR pronoun=0 TO numberofpronounreplacementstrings-1
       pronounsearchstringlength=LEN(pronounsearchstring$[pronoun])
       IF 
MID$(UCASE$(alteredtext$),currentposn,pronounsearchstringlength)=pronounsearch
string$[pronoun]
          'Found a pronoun search string.Replace it with corresponding 
replacement pronoun string
          
alteredtext$=LEFT$(alteredtext$,currentposn-1)+pronounreplacement$[pronoun]+MI
D$(alteredtext$,currentposn+pronounsearchstringlength)
          currentposn=currentposn+LEN(pronounreplacement$[pronoun])-2
          pronoun=numberofpronounreplacementstrings-1 :'Leave FOR-NEXT loop 
when get to NEXT
       ENDIF
    NEXT pronoun
    currentposn=INSTR(alteredtext$," ",currentposn+1)
  UNTIL currentposn=0 | currentposn=LEN(alteredtext$):'No more spaces
  RETURN LTRIM$(alteredtext$)
ENDSUB

SUB searchforkeyphrases(),STRING
  DEF responsetext$:STRING
  DEF phrase,position,responserecentlyused,startphrase:UINT
  responsetext$=""
    FOR phrase=0 TO numberofkeyphrases-1
       position=INSTR(UCASE$(inputtext$),keyphrase$[phrase])
       IF position<>0
          'Found a keyphrase string
          IF LEFT$(keyphraseresponse$[phrase],1)=" "
             'Space at beginning means add a response start phrase here
             FOR startphrase=0 TO numberofresponsestartphrases-1
                responserecentlyused=0
                
responsetext$=responsestartphrase$[startphrase]+keyphraseresponse$[phrase]
                'Check if this response been used recently
                FOR n=0 TO 9
                 IF INSTR(previousresponses$[n],responsetext$)
                   responserecentlyused=1:n=9:responsetext$=""
                 ENDIF
                NEXT n
                IF responserecentlyused=0 THEN 
startphrase=numberofresponsestartphrases-1:'Exit FOR-NEXT loop
             NEXT startphrase
          ELSE
             responsetext$=keyphraseresponse$[phrase]
             'Check if this response been used recently
             responserecentlyused=0
             FOR n=0 TO 9
               IF INSTR(previousresponses$[n],responsetext$)
                 responserecentlyused=1:n=9:responsetext$=""
               ENDIF
            NEXT n
          ENDIF
          IF responserecentlyused=0
            IF RIGHT$(keyphraseresponse$[phrase],1)=" "
              'Response uses part of inputtext$.Alter any pronouns in it
               
responsetext$=responsetext$+replacepronouns(RIGHT$(inputtext$,(LEN(inputtext$)
-position+2-LEN(keyphrase$[phrase]))))
               'Add question mark to end
               responsetext$=RTRIM$(responsetext$)
               responsetext$=responsetext$+"?"
            ENDIF
            phrase=numberofkeyphrases-1 :'Leave FOR-NEXT loop when get to NEXT
          ENDIF
       ENDIF
    NEXT phrase
RETURN responsetext$
ENDSUB

SUB readdata
  DEF text$:STRING
  'Read preprocess strings (used in SUB preprocessinputtext)
  numberofpreprocessstrings=0
  DO
    GETDATA inputpreprocessdata,text$
    IF text$<>""
      preprocesssearchstring$[numberofpreprocessstrings]=" "+text$+" "
      GETDATA inputpreprocessdata,text$
      preprocessreplacement$[numberofpreprocessstrings]=" "+text$+" "
      numberofpreprocessstrings=numberofpreprocessstrings+1
    ENDIF
  UNTIL text$=""
  'Read pronoun replacement strings data (used in SUB replacepronouns)
  numberofpronounreplacementstrings=0
  DO
    GETDATA replacepronoundata,text$
    IF text$<>""
      pronounsearchstring$[numberofpronounreplacementstrings]=" "+text$+" "
      GETDATA replacepronoundata,text$
      pronounreplacement$[numberofpronounreplacementstrings]=" "+text$+" "
      numberofpronounreplacementstrings=numberofpronounreplacementstrings+1
    ENDIF
  UNTIL text$=""
  'Read keyphrase data (used in SUB searchforkeyphrases)
  numberofkeyphrases=0
  DO
    GETDATA keyphrasedata,text$
    IF text$<>""
      keyphrase$[numberofkeyphrases]=text$
      GETDATA keyphrasedata,text$
      keyphraseresponse$[numberofkeyphrases]=text$
      numberofkeyphrases=numberofkeyphrases+1
    ENDIF
  UNTIL text$=""
  'Read response start phrases (used in SUB searchforkeyphrases)
  numberofresponsestartphrases=0
  DO
    GETDATA responsestartphrasedata,text$
    IF text$<>""
      responsestartphrase$[numberofresponsestartphrases]=text$
      numberofresponsestartphrases=numberofresponsestartphrases+1
    ENDIF
  UNTIL text$=""
  'Read random responses (used in main loop)
  numberofrandomresponses=0
  DO
    GETDATA randomresponses,text$
    IF text$<>""
      randomresponse$[numberofrandomresponses]=text$
      numberofrandomresponses=numberofrandomresponses+1
    ENDIF
  UNTIL text$=""
RETURN
ENDSUB

'------------------------- DATA -----------------------------
  'Add more data to improve the programme but leave the last line (DATA "","")
as it is the marker for the end of the data
  DATABEGIN inputpreprocessdata
     'If first phrase in pair is found it will be replaced with the second one
     DATA "DONT","don't", "DO NOT","don't"
     DATA "YOUR A","you are a", "YOUR AN","you are an", "YOURE","you are"
     DATA "I'M","I am", "IM","I am"
     DATA "THEYRE","they are", "THEY'RE","they are"
     DATA "CANNOT","can't", "CANT","can't"
     DATA "THEYLL","they will","THEY'LL","they will"
     DATA "THEYD","they would", "THEY'D","they would"
     DATA "YOULL","you will", "YOU'LL","you will"
     DATA "WE'RE","we are", "IVE","I have", "I'VE","I have"
     DATA "YOUD","you would", "YOU'D","you would"
     DATA "I'D","I would", "I'LL","I will"
     DATA "ITS","it is", "IT'S","it is", "SHES","she is"
     DATA "SHE'S","she is", "HE'S","he is", "HES","he is"
     DATA "SHE'LL","she will", "HE'LL","he will"
     DATA "MUM","mother", "DAD","father"
     DATA "",""
  DATAEND
  DATABEGIN replacepronoundata
    'First phrase in each pair (upper case) will be replaced by second phrase 
in each pair
    DATA "I AM","you are", "I WAS","you were"
    DATA "YOU ARE","I am", "ARE YOU","I am", "YOU WERE","I was"
    DATA "WE ARE","you're", "I","you", "ME","you"
    DATA  "MY","your", "YOUR","my"
    DATA "MINE","yours", "YOURS","mine", "OUR","your"
    DATA "OURS","yours", "YOU","me"
    DATA "MYSELF","yourself", "YOURSELF","myself", "AM","are"
    DATA "COLOR","colour"
    DATA "",""
  DATAEND
  DATABEGIN randomresponses
     DATA "Tell me more."
     DATA "Interesting. Go on."
     DATA "Please elaborate."
     DATA "What makes you say that?"
     DATA "I am not sure I understand you fully."
     DATA "",""
  DATAEND
  DATABEGIN responsestartphrasedata
    DATA "Why do you think","Does it worry you that","Are you sure that"
    DATA "What leads you to believe","How can you be sure"
    DATA "",""
  DATAEND
  DATABEGIN keyphrasedata
    'If first phrase (key phrase) is found then the response is the second 
phrase.
    'If the response (second) phrase ends with a space then the user input 
after the
    'keyphrase will have it's pronouns altered then will be added after it.
    'If the response phrase starts with a space then a response start phrase 
(see just above)
    'will be added before it.
    DATA " I WANT A ","Why do you think you'd be happy if you had a "
    DATA " I WANT TO BE ","Why do you think you'd be happier if you were "
    DATA " I WISH ","Be careful what you wish for."
    DATA " I AM ","How long have you been "
    DATA " DO YOU ","Why do you ask that?"
    DATA " I CAN'T ","Try harder."
    DATA " CAN YOU ","Do you wish that you could "
    DATA " I HATE ","Why do you hate "
    DATA " I NEED ","Why do you think you'd be happier if you had "
    DATA " I LOVE ","What do you love most about "
    DATA " MY GIRLFRIEND "," she "
    DATA " MY BOYFRIEND "," he "
    DATA " MUSIC","What sorts of music do you like?"  :'Because there is no 
space at the end  of the keyphrase it will detect "music","musician","musical"
etc.
    DATA " SEX","It alway seems to come down to sex with you humans."
    DATA " DRUNK ","People often do foolish things when under the influence of
alcohol."
    DATA " MY MOTHER ","Tell me about your relationship with your mother."
    DATA " MY FATHER ","Tell me about your relationship with your father."
    DATA " HE HATES ME ","Do you hate him?"
    DATA " SHE HATES ME ","Do you hate her?"
    DATA " YOU HATE ME ","I don't hate you."
    DATA " THEY HATE ME ","Why do you think that is?"
    DATA " LUCK","Some people believe we make our own luck."
    DATA " I WAS ","Do you wish you were still "
    DATA " YOU WERE ","Do you wish I was still "
    DATA " FOREVER ","Forever is a long time."
    DATA " NEVER ","Are you sure you mean never?"
    DATA " I LIKE "," you like "
    DATA " DREAM ","Do you often remember your dreams?"
    DATA " DREAM ","Dreams are a window into the subconscious."
    DATA " BAD DREAM","Do you often have bad dreams?"
    DATA " NIGHTMARE","Nightmares are often caused by unresolved issues in 
your subconscious."
    DATA " FANTASY ","Some fantasies are unhealthy."
    DATA " FANTASISE ","Perhaps you should concentrate more on the real 
world."
    DATA " I DON'T ","Why don't you "
    DATA " WHY DON`T YOU ","Why would you want me to "
    DATA " WHY CAN`T I ","What makes you think you should be able to "
    DATA " ARE YOU ","Why are you interested in whether I'm "
    DATA " ALWAYS ","Can you think of a specific example?"
    DATA " YOU ARE "," I am "
    DATA " YOUR ","Why are you concerned about my "
    DATA " BECAUSE ","Are you sure that's the reason?"
    DATA " ALIKE ","In what way?"
    DATA " I "," you "
    DATA " HE "," he "
    DATA " SHE "," she "
    DATA " THEY "," they "
    DATA " WE "," we "
    DATA "",""
  DATAEND

SUB textTospeech(string text$)
  PRINT text$
  CallObjectMethod(speech,".Speak(%s)",text$)
 RETURN
ENDSUB

... Installation recommended (not included)

--- Renegade v01-28.8/Alpha
 * Origin: The Titantic BBS Telnet - ttb.slyip.com (1:129/305)