home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
01e
/
max130.zip
/
ANIMAL.MAX
next >
Wrap
Text File
|
1988-10-30
|
5KB
|
203 lines
; This program is based (loosely) on a program
; that was available on Dartmouth Time Sharing.
tclear ()
$replace ("TRUE" "1")
$replace ("FALSE" "0")
$replace ("ANIMAL_FILE" "animal.lst")
put ("loading animal()")
Function animal
Begin
print_usage ()
set (ld restore_knowledge ())
While
more_questions (ld)
EndWhile
save_knowledge (ld)
End
EndFunction
put ("loading more_questions()")
Function more_questions
Begin
set (ld argv (1))
ask_question (ld)
If get_response ()
Then
return (process_yes_response (ld))
EndThen
Else
return (process_no_response (ld))
EndElse
EndIf
End
EndFunction
put ("loading ask_question()")
Function ask_question
Begin
set (ld argv (1))
set (question lstcget (ld))
If ne (strsub (question strlen (question)) "?")
Then
put (question "?")
EndThen
Else
put (question)
EndElse
EndIf
End
EndFunction
put ("loading get_response()")
Function get_response
Begin
Loop
get (response)
set (response struc (strsub (response 1 1)))
Case response
When "Y"
Do
return (TRUE)
EndDo
EndWhen
When "N"
Do
return (FALSE)
EndDo
EndWhen
Default
Do
put ("Please answer yes or no.")
EndDo
EndDefault
EndCase
EndLoop
End
EndFunction
put ("loading process_yes_response()")
Function process_yes_response
Begin
set (ld argv (1))
If lstnval (ld)
Then
lstnext (ld)
return (TRUE)
EndThen
Else
put ("I guessed it.")
return (FALSE)
EndElse
EndIf
End
EndFunction
put ("loading process_no_response()")
Function process_no_response
Begin
set (ld argv (1))
If lstsval (ld)
Then
lstsub (ld)
return (TRUE)
EndThen
Else
get_new_question (ld)
return (FALSE)
EndElse
EndIf
End
EndFunction
put ("loading get_new_question()")
Function get_new_question
Begin
set (ld argv (1))
put ("I give up.")
put ("What animal did you have in mind?")
get (animal_name)
put ("Enter a question that has a yes answer for")
put (" " animal_name)
put ("and distinguishes it from other animals.")
get (animal_question)
lstspsh (ld animal_question)
set (animal_question format ("Is it a %s?", animal_name))
lstcpsh (ld animal_name)
End
EndFunction
put ("loading restore_knowledge()")
Function restore_knowledge
Begin
set (fd open (ANIMAL_FILE "r"))
If lt (fd 0)
Then
set (ld initialize_list ())
EndThen
Else
set (ld lstread (fd))
EndElse
EndIf
close (fd)
lsthead (ld)
return (ld)
End
EndFunction
put ("loading save_knowledge()")
Function save_knowledge
Begin
set (ld argv (1))
set (fd open (ANIMAL_FILE "wc"))
If lt (fd 0)
Then
put ("Cannot open " ANIMAL_FILE " for writing.")
EndThen
Else
lstwrite (ld fd)
close (fd)
EndElse
EndIf
lstfre (ld)
End
EndFunction
put ("loading initialize_list()")
Function initialize_list
Begin
set (ld lstcre ("Does it have wings?" "Is it a bird?"))
return (ld)
End
EndFunction
put ("loading print_usage()")
Function print_usage
Begin
put ("Think of an animal. I will ask simple yes or no")
put ("questions and try to guess it. If I can't guess it")
put ("then I will give up and ask you what your animal was")
put ("and what distinguishes it from other animals. I will")
put ("remember that information and use it next time.")
put ("\nWould you like to continue?")
If not (get_response ())
Then
exit ()
EndThen
EndIf
End
EndFunction