structs

main.lsp

(defun put_frm (frame father slots_info children)
  (setf (get frame `frm_name) frame)
  (setf (get frame `father) father)
  (setf (get frame `info) slots_info)
  (setf (get frame `child_list) children)
  (setf (get father `child_list)
        (put_to_list frame (get father `child_list))) ;связь с отцом
  (cond ((not (null children)) (put_frm_child frame children))))

                                        ;Функция включения в список объекта, если он там отсутствует
(defun put_to_list (X Y)
  (cond ((not (member X Y)) (cons X Y))
        (t Y)))

;Обработка списка дочерних фреймов (предв. создаются с пустой инф-й по слотам, указывая только связь с отцовским фреймом)
(defun put_frm_child (frame children)
  (let ((first (car children))
        (other (cdr children)))
    (setf (get (car children) `frm_name) (car children))
    (setf (get (car children) `father) frame)
    (setf (get (car children) `info) nil)
    (setf (get (car children) `child_list) nil)
    (cond
      ((not (null (cdr children))) (put_frm_child frame (cdr children))))))

(defun add_frm (fr_struct new_fr slots_info children father)
  (cond ((and (not (equal (get fr_struct `frm_name) father)) (null (get  fr_struct `child_list)))
            nil)            ;некуда вставить!
            ((equal (get fr_struct `frm_name) father)       ; если нашли отца -
            (put_frm new_fr father slots_info children)) ;  вставляем
            (t           ;иначе спускаемся ниже – в доч.фреймы и снова проверяем – не отец ли это нов.фр
          (add_frm_child (get fr_struct `child_list) new_fr slots_info children father))))
;Функция обработки списка дочерних фреймов при добавлении нового фрейма в существующую иерархию
(defun add_frm_child (children new_fr slots child_newfr father)
   (cond ((null children) nil)
        ((not (add_frm (car children) new_fr slots child_newfr father))
                       (add_frm_child (cdr children) new_fr slots child_newfr father))
        (t  (add_frm (car children) new_fr slots child_newfr father))))

(defun made_frm (y)
    (print "введите имя нового фрейма")
    (setq name (read))
    (print "введите отца")
    (setq father (read))
    (setq y nil)
    (loop (print "для ввода информации по фрейму выберите необходимый параметр (введите цифру):
            1 producer
            2 country
            3 age
            4 окончить ввод")
        (setq x (read))
        (cond
            ((eq x 1) (setq y (pairlis `(producer) (list (read)) y)))
            ((eq x 2) (setq y (pairlis `(country) (list (read)) y)))
            ((eq x 3) (setq y (pairlis `(age) (list (read)) y)))
            ((eq x 4) (return y))))

    (add_frm father name y nil father))

(defun prosm (deti)
	(cond((null deti) nil)
		   (t (format t "~%  ~A"(car chl)) (format t "~% ~A" (get (car chl) 'child_list)) (struct(cdr chl)))))

(defun tab (current count)
  (if (= count 0)
      current
     (cons "-" (tab current (- count 1)))))

(defun show-struct-list (l)
  (defun show-el (el deep)
    (format t "~{~a~}"  (tab nil deep))
    (format t "~a ~%" el))
  (traverse-struct-list 'show-el l 0))

(defun show-all (l)
  (defun show-fields (el deep)
    (when (= deep 3)
      (print (assoc 'rating (get el 'info)))))
  (traverse-struct-list 'show-fields l 0))

(defun add-rating-to-all (l)
  (defun add-rating (el deep)
    (when (= deep 3)
      (setf (get el 'info) (cons '(rating . 5) (get el 'info)))))
  (traverse-struct-list 'show-fields l 0))

(defun traverse-struct-list (visit-fn chl deep)
  (cond ((null chl) nil)
        (t
         ;; Работа с текущим элементом
         (funcall visit-fn (car chl) deep)
         ;; Обход детей
         (let ((child-list (get (car chl) 'child_list)))
           (if child-list
               (traverse-struct-list visit-fn child-list (+ 1 deep))))
         ;; Обход остальных элементов списка
         (traverse-struct-list visit-fn (cdr chl) deep))))

    ;(format t "~%  ~A"(caadr(symbol-plist 'thriller)))
    ;(format t "~%    ~A"(cadr(symbol-plist 'action_movie)))
    ;(format t "~%    ~A"(caadr(symbol-plist 'detective)))

    ;(print (format t "~%   ~A" (cadr(symbol-plist 'action_movie))))

    ;(format t "~%   ~A" (cadr(symbol-plist 'detective)))

                    ; (symbol-plist 'comedy)
                  ;   (print (symbol-plist 'horror)))

(defun menu ()
    (loop (print "menu:
        1 create frame
        2 see information
        3 see structure
        4 stop input")
      (setq x (read))
      (setq y nil)
			(setq chl (get 'film 'child_list))
            (cond
			    ((eq x 1) (made_frm y))
			    ((eq x 2) (prosm ))
			    ((eq x 3) (show-struct-list chl))
			    ((eq x 4) (return y)))
			))


(put_frm  `film  nil  `(it_is_a_film)  `(thriller comedy horror))
(add_frm  `film  `thriller  `(worried excitement )  `(action_movie detective) 'film)
(add_frm  `film  `comedy  `(fun relax)  `(biography melodrama) 'film)
(add_frm  `film  `horror  `(suspense fear)  `(vampire cannibal) 'film)

(add_frm  `film  `The_39_Steps `((producer . Hitchcock) (country . Britain) (age . 12+)) nil 'detective)
(add_frm  `film  `Foreign_Correspondent `((producer . Hitchcock) (country . USA) (age . 12+)) nil 'action_movie)
(add_frm  `film  `AZAZAZAZAA `((producer . Hitchcock) (country . USA) (age . 12+)) nil 'action_movie)

(add_frm  `film  `1+1 `((producer . Nakache) (country . France) (age . 16+)) nil 'biography)
(add_frm  `film  `Feast `((producer . Hitchcock) (country . USA) (age . 0+)) nil 'melodrama)

(add_frm  `film  `The_Silence_of_the_Lambs `((producer . Demme) (country . USA) (age . 18+)) nil 'cannibal)
(add_frm  `film  `Vampyres `((producer . Matellano) (country . Spain) (age . 18+)) nil 'vampire)

; dobavit' i udalit' infu fo frame