Приложение А

Приложение А. Полный текст программы на языке micro-LISP файл FUN.LSP define mainwmake-window ДОКТОР true define mmenuwmake-window МЕНЮ true define menufwmake-window ФАЙЛЫ true define menudbwmake-window БазаДанных true define menucwmake-window ДИАГНОСТИКА true define viewwmake-window ПРОСМОТР true define addiwmake-window ДОБАВЛЕНИЕ БОЛЕЗНИ true define addswmake-window ДОБАВЛЕНИЕ СИМПТОМОВ true define rediwmake-window РЕДАКТИРОВАНИЕ БОЛЕЗНИ true define redswmake-window РЕДАКТИРОВАНИЕ СИМПТОМА true define deliwmake-window УДАЛЕНИЕ БОЛЕЗНИ true define delswmake-window УДАЛЕНИЕ СИМПТОМА true define submenuwmake-window Работа с true define menulwmake-window Введите ИМЯ ФАЙЛА true define f define symptom define itis define yes define no define start window-set-position mainw 1 1 window-set-size mainw 23 78 window-clear mainw mainmenu Главное меню define mainmenu define ch Window-Set-Position mmenuw 3 15 Window-Set-Size mmenuw 1 47 Window-Clear mmenuw display 1.Files 2.DataBase 3.Diagnosticka 4.Quit mmenuw do i 0 i 0 i 5i Window-Set-Cursor mainw 22 30 display Ваш выбор mainw set ch read-char mainw Window-Set-Cursor mainw 22 30 display mainw cond eq ch 1 menufiles eq ch 2 menudb eq ch 3 menucons eq ch 4 exit Меню Файлов define menufiles define ch Window-Set-Position menufw 5 16 Window-Set-Size menufw 4 8 Window-Clear menufw Window-Set-Cursor menufw 1 1 display 1.LOAD menufw Window-Set-Cursor menufw 2 1 display 2.SAVE menufw do i 0 i 0 i 5i Window-Set-Cursor mainw 22 30 display ВАШ ВЫБОР mainw set ch read-char mainw Window-Set-Cursor mainw 22 30 display mainw cond eq ch 1 loading eq ch 2 saving eq ch ESCAPE Window-Delete menufw mainmenu Меню БазыДанных define menudb define ch Window-Set-Position menudbw 5 26 Window-Set-Size menudbw 6 10 Window-Clear menudbw Window-Set-Cursor menudbw 1 1 display 1.ADD menudbw Window-Set-Cursor menudbw 2 1 display 2.DELETE menudbw Window-Set-Cursor menudbw 3 1 display 3.REDACT menudbw Window-Set-Cursor menudbw 4 1 display 4.VIEW menudbw do i 0 i 0 i 5i Window-Set-Cursor mainw 22 30 display ВАШ ВЫБОР mainw set ch read-char mainw Window-Set-Cursor mainw 22 30 display mainw cond eq ch 1 adding menudb eq ch 2 deleting menudb eq ch 3 redacting menudb eq ch 4 viewing menudb eq ch ESCAPE Window-Delete menudbw mainmenu Загрузка файла define loading Window-Set-Position menulw 20 20 Window-Set-Size menulw 1 40 Window-Clear menulw Window-Set-Cursor menulw 1 3 set f read-line menulw Window-Delete menulw with-input-from-file f lambda set symptom read set itis read flush-input Запись файла define saving Window-Set-Position menulw 20 20 Window-Set-Size menulw 1 40 Window-Clear menulw Window-Set-Cursor menulw 2 3 set f read-line menulw Window-Delete menulw with-output-to-file f lambda write symptom write itis Меню диагностики define menucons Window-Set-Position menucw 6 10 Window-Set-Size menucw 17 57 Window-Clear menucw experting itis window-delete menucw define experting spisill cond null spisill board display НЕВОЗМОЖНО ОПРЕДЕЛИТЬ ДИАГНОЗ menucw wait menucw set yes set no expill cadar spisill caar spisill t experting cdr spisill define expill spisnum ill define nums define s cond null spisnum window-clear menucw window- set-cursor menucw 1 1 display У ВАС menucw display ill menucw display . menucw set nums findsym ill itis set yes set no logout nums t set s findsym car spisnum symptom yesno s spisnum ill define into y a cond eq a д set yes append yes list y t set no append no list y define yesno y spisnum ill define ans cond member y no nil member y yes expill cdr spisnum ill t and board display СИМПТОМ menucw display y menucw display ДН menucw set ans read menucw into y ans eq д ans expill cdr spisnum ill define logout nums cond null nums wait menucw t newline menucw display menucw display findsym car nums symptom menucw logout cdr nums define board define gr set gr window-get-cursor menucw if car gr 18 newline menucw begin window-clear menucw window-set-cursor menucw 1 1 define findsym n spissym if equal caar spissym n cadar spissym findsym n cdr spissym define wait wname cond eq read-char wname ESCAPE t t wait wname Просмотр define viewing Window- Set-Position vieww 11 15 Window-Set-Size vieww 12 47 Window-Clear vieww viewill itis window-delete vieww define viewill spisill cond null spisill t t window-set-cursor vieww 1 2 display БОЛЕЗНЬ vieww display caar spisill vieww viewsym cadar spisill viewill cdr spisill define viewsym spisnum cond null spisnum wait vieww window-clear vieww t newline vieww display vieww display findsym car spisnum symptom vieww viewsym cdr spisnum Вспомогательное подменю define submenu Window-Set-Position submenuw 11 25 Window-Set-Size submenuw 4 14 Window-Clear submenuw window-set-cursor submenuw 1 1 display 1.БОЛЕЗНЯМИ submenuw window-set-cursor submenuw 2 1 display 2.СИМПТОМАМИ submenuw Добавление define adding define ch submenu Window-Set-Cursor mainw 22 30 display ВАШ ВЫБОР mainw set ch read-char mainw Window-Set-Cursor mainw 22 30 display mainw window-delete submenuw cond eq ch 1 Window-Set-Position addiw 6 10 Window-Set-Size addiw 17 57 Window-Clear addiw addill window-delete addiw eq ch 2 Window-Set-Position addsw 6 10 Window-Set-Size addsw 17 57 Window-Clear addsw addsym window-delete addsw eq ch ESCAPE t adding define ill define sym Добавление болезни define addill define n window-set-cursor addiw 1 1 display Введите название новой БОЛЕЗНИ addiw set ill read-line addiw display Чтобы ЗАКОНЧИТЬ вводить симптомы НАБЕРИТЕ end addiw newline addiw set n caar last-pair symptom set itis append itis list list ill addsyms n 1 addiw Добавление симптомов define addsym define n define nums window-set-cursor addsw 1 2 display БОЛЕЗНЬ addsw set ill read-line addsw display Чтобы ЗАКОНЧИТЬ вводить симптомы НАБЕРИТЕ end addsw newline addsw set n caar last-pair symptom set nums findsym ill itis set itis delete list ill nums itis set itis append itis list list ill addsyms n 1 nums addsw define addsyms nn spisnum nums nwin display СИМПТОМ nwin set sym read-line nwin if equal sym end append nums spisnum begin set symptom append symptom list list nn sym addsyms nn 1 append spisnum list nn nums nwin Редактирование define redacting define ch submenu Window-Set-Cursor mainw 22 30 display ВАШ ВЫБОР mainw set ch read-char mainw Window-Set-Cursor mainw 22 30 display mainw window-delete submenuw cond eq ch 1 Window-Set-Position rediw 11 10 Window-Set-Size rediw 6 57 Window-Clear rediw redill window-delete rediw eq ch 2 Window-Set-Position redsw 11 10 Window-Set-Size redsw 8 57 Window-Clear redsw redsym window-delete redsw eq ch ESCAPE t redacing Редактирование болезни define redill define nums define ill1 window-set-cursor rediw 1 1 display Введите БОЛЕЗНЬ, название которой хотите rediw newline rediw display ИСПРАВИТЬ rediw set ill read-line rediw newline rediw display Введите ИСПРАВЛЕННОЕ название rediw set ill1 read-line rediw set nums findsym ill itis set itis delete list ill nums itis set itis append itis list list ill1 nums Редактирование симптома define redsym define n1 define nums define sym1 window-set-cursor redsw 1 1 display Введите БОЛЕЗНЬ, СИМПТОМ которой хотите redsw newline redsw display ИСПРАВИТЬ redsw set ill read-line redsw newline redsw display Введите СИМПТОМ, который хотите redsw newline redsw display ИСПРАВИТЬ redsw set sym read-line redsw display Введите ИСПРАВЛЕННОЕ ЗНАЧЕНИЕ redsw set sym1 read-line redsw set nums findsym ill itis set n1 sub sym symptom nums set symptom delete list n1 sym symptom set symptom append symptom list list n1 sym1 define sub x spis spisx let n findindex x spis cond memb n spisx n t sub x cdr spis spisx define findindex x spis cond equal cadar spis x caar spis t findindex x cdr spis define memb a l cond null l nil equal a car l t t memb a cdr l Удаление define deleting define ch submenu Window-Set-Cursor mainw 22 30 display ВАШ ВЫБОР mainw set ch read-char mainw Window-Set-Cursor mainw 22 30 display mainw window-delete submenuw cond eq ch 1 Window-Set-Position deliw 11 10 Window-Set-Size deliw 4 57 Window-Clear deliw delill window-delete deliw eq ch 2 Window-Set-Position delsw 6 10 Window-Set-Size delsw 17 57 Window-Clear delsw delsym window-delete delsw eq ch ESCAPE t deleting Удаление болезни define delill define nums window-set-cursor deliw 1 2 display Введите название БОЛЕЗНИ, которую хотите deliw newline deliw display УДАЛИТЬ deliw set ill read-line deliw set nums findsym ill itis set itis delete list ill nums itis delsyms nums define delsyms spisnums cond null spisnums t t set symptom delete list car spisnums findsym car spisnums symptom symptom delsyms cdr spisnums Удаление симптомов define delsym define nums window-set-cursor delsw 1 2 display Введите название БОЛЕЗНИ, СИМПТОМЫ которой хотите delsw newline delsw display УДАЛИТЬ delsw set ill read-line delsw display Чтобы ЗАКОНЧИТЬ вводить симптомы НАБЕРИТЕ end delsw newline delsw set nums findsym ill itis subdel nums ill define n0 define subdel spisnums ill display СИМПТОМ delsw set sym read-line delsw if equal sym end t begin set n0 sub sym symptom spisnums set symptom delete list n0 sym symptom set itis delete list ill spisnums itis set itis append itis list list ill del n0 spisnums subdel del n0 spisnums ill define del x l cond null l nil equal x car l cdr l t cons car l del x cdr l