Графическое приложение генерации лабиринтов для решения сложных проблем средствами языка ЛИСП

Министерство образования и  науки, молодежи и спорта Украины

Институт информатики и искусственного интеллекта ДонНТУ

 

 

Д080403.1.01.06/173.ЛР

 

 

 

 

 

 

 

ЛАБОРАТОРНАЯ РАБОТА №2

по  дисциплине «Функциональное и логическое программирование»

на  тему «Графическое приложение генерации лабиринтов для решения сложных проблем средствами языка ЛИСП»

 

 

 

 

 

 

 

Проверили:

_____________ ст. пр. Гудаев О.А.

       ^{(дата, подпись)}

_____________ асс. Литвин С.С.

       ^{(дата, подпись)}

Выполнила:

_____________ ст. гр. ПО-09в

       ^{(дата, подпись)}      Семенова А.П.

 

 

 

 

 

 

 

 

 

 

 

 

2011

Цель: изучить основы программирования на языке ЛИСП. Получить практические навыки составления программ решения сложных проблем на ЛИСПе в символьном виде.

 

Задание: сгенерировать чертеж двухмерного лабиринта, модифицировав его классическую архитектуру фрактальной формой. Фрактальную форму лабиринта рассчитать по чудо-формуле Габриэля Ламе и Йохана Желиса. Чертеж лабиринта построить графическими средствами языка ЛИСП.

 

Номер варианта: 69

 

№ п/п	Периметр лабиринта	Архитектура лабиринта	Параметры линий
69	Треугольник	Полуримский	«Папоротник», a=1, b=1, n1=1, n2=1, n3=1, m=4, f=cos(fi)

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

ЛИСТИНГ ПРОГРАММЫ 

; Создаем графическое окно

(setf win1 (open-stream

                       'bitmap-window

                       *lisp-main-window*

                       :io

                       :title "Лабораторная работа №2 - Создание лабиринта"

                       :window-exterior (make-box 0 0 625 600))

)

 

; Формула для рисования папоротника

(defun figure_F (a b n1 n2 n3 m f fi)

      (* (cos fi) (/ 1 (expt  (+ (expt (abs (* (/ 1 a) (cos (* fi (/ m 4))))) n2) (expt (abs (* (/ 1 b) (sin (* fi (/ m 4))))) n3)) (/ 1 n1))))

 )

 

; Функции преобразования координат  с учетом угла

(defun to_x (r fi)

      (* r ( cos  fi))

)

(defun to_y (r fi)

      (* r (sin  fi))

)

 

; Функция, выполняющая рисование  папоротника с учетом ограничений

(defun drawFigure (scale cx cy xT yT flag)

      (let* ((a 1) (b a) (n1 1) (n2 n1) (n3 n1) (m 4) (f (cos 0)) (r 0) (x 0) (y 0))

           (move-to win1

                (make-position

                     (+ cx (round (/ (to_x (figure_F a b n1 n2 n3 m f 0) 0) scale)))

                     (- cy (round (/ (to_y (figure_F a b n1 n2 n3 m f 0) 0) scale)))

                )

           )

           (loop for i from 1 to 360 do

              (setq fi (* i (/ pi 180)))

              (setq r (figure_F a b n1 n2 n3 m f fi))

              (setq x (+ cx (round (/ (to_x r fi) scale))))

              (setq y (- cy (round (/ (to_y r fi) scale))))

              (cond

                   ; ограничения для рисования в  верхней левой части

                   ((= flag 1) (if (or (>= x (- xT 8)) (>= y (+ yT 297))) (setq is_move 1)

                                          (if (and (>= x (- xT 43)) (>= y (+ yT 258))) (setq is_move 1) (setq is_move 0))))

                   ; ограничения для рисования в верхней правой части

                   ((= flag 2) (if (or (<= x (+ xT 8)) (>= y (+ yT 298))) (setq is_move 1)

                                          (if (and (<= x (+ xT 43)) (>= y (+ yT 258))) (setq is_move 1) (setq is_move 0))))

                   ; ограничения для рисования в нижней части

                   ((= flag 3) (if (or (<= y (+ yT 315)) (>= y (+ yT 499))) (setq is_move 1)

                                          (if (and (<= x (+ xT 43)) (>= x (- xT 43)) (<= y (+ yT 355))) (setq is_move 1) (setq is_move 0))))

                   (t (setq is_move 0))

               )

               (cond

                    ((= is_move 0) (draw-to win1 (make-position x y)))

                    ((= is_move 1) (move-to win1 (make-position x y)))

               )

           )

       )

)

 

; Функция, выполняющая рисование  черного треугольника

(defun draw-triangle (xT yT)

      (cond

             ; проверяем координаты вершины  треугольника

             ((or (< xT 250) (< yT 0)) (print "Вершина треугольника задана неправильно!!!" win1))

             (t

                 ; задаем начальные значения переменным

                 (let* ((xR (+ xT 250)) (yLR (+ yT 500)) (xL (- xT 250)) (ci (+ yT 7)) (cj (+ xL 7)) (c-j (- xR 7)))

                      (set-foreground-color win1 black)

                      (set-line-width win1 3)

                      ; рисуем контуры треугольника

                      (draw-line win1 (make-position xT yT) (make-position (+ xL 1) yLR))

                      (draw-line win1 (make-position xT yT) (make-position (- xR 1) yLR))

                      (draw-line win1 (make-position xL yLR) (make-position xR yLR))

                      ; заполняем внутренности треугольника линиями толщиной в 10 пикселей

                      (set-line-width win1 10)

                      (loop

                           (cond ((> cj (+ xT 10)) (return t)))

                           (draw-line win1 (make-position xT ci) (make-position cj (- yLR 5)))

                          (draw-line win1 (make-position xT ci) (make-position c-j (- yLR 5)))

                           (setq ci (+ ci 7))

                           (setq cj (+ cj 7))

                           (setq c-j (- c-j 7))

                       )

                 )

             )

       )

)

 

; Функция, рисующая полуримский лабиринт

(defun draw-labyrinth (xT yT)

      (set-line-width win1 1)

      (set-foreground-color win1 white)

      (fill-box win1 (make-box (- xT 6) (- yT 1) (+ xT 7) (+ yT 300)))

      (fill-box win1 (make-box (- xT 160) (+ yT 300) (+ xT 160) (+ yT 314)))

      (fill-box win1 (make-box (- xT 40) (+ yT 260) (+ xT 40) (+ yT 353)))

      (set-foreground-color win1 black)

)

 

; Функция, выполняющая повторное  наведение некоторых сторон треугольника

(defun draw-borders (xT yT pos)

      (set-foreground-color win1 black)

      (set-line-width win1 2)

      (cond

             ((= pos 1)     ; набор линий для верхней левой части

                   (draw-line win1 (make-position (- x 150) (+ y 299)) (make-position (- x 7) (+ y 13)))

              )

             ((= pos 2)     ; набор линий для верхней правой части

                   (draw-line win1 (make-position (+ x 150) (+ y 299)) (make-position (+ x 8) (+ y 13)))

              )

             ((= pos 3)     ; набор линий для нижней части

                   (draw-line win1 (make-position (+ x 250) (+ y 501)) (make-position (+ x 158) (+ y 314)))

                   (draw-line win1 (make-position (- x 250) (+ y 501)) (make-position (- x 158) (+ y 314)))

              )

             (t nil)

      )

      (set-line-width win1 1)

)

 

 

; * * * * * Строим треугольник и  полуримский лабиринт * * * * *

 

; >>> Координаты вершины треугольника

(setq x 300)

(setq y 25)

 

; >>> Количество фигур (n,n,2n)

(setq n 20)

 

; рисуем треугольник

(draw-triangle x y)

 

; рисуем полуримский лабиринт

(draw-labyrinth x y)

 

 

; * * * * * Заполнение треугольника фигурами * * * * *

 

(set-foreground-color win1 white)

(set-line-width win1 2)

(loop for i from 1 to n do

  (setq size (/ (+ (* (random 6) 2) 7) 1000))

  (setq f_y (+ (* (random 40) 6) (+ y 35)))

  (setq f_x (+ (* (random 20) 5) (- x 140)))

  (drawFigure size f_x f_y x y 1)

)

(draw-borders x y 1)

 

(set-foreground-color win1 white)

(set-line-width win1 2)

(loop for i from 1 to n do

  (setq size (/ (+ (* (random 6) 2) 7) 1000))

  (setq f_y (+ (* (random 40) 6) (+ y 35)))

  (setq f_x (+ (* (random 20) 5) (+ x 40)))

  (drawFigure size f_x f_y x y 2)

)

(draw-borders x y 2)

 

(set-foreground-color win1 white)

(set-line-width win1 2)

(loop for i from 1 to (* n 2) do

  (setq size (/ (+ (* (random 6) 2) 7) 1000))

  (setq f_y (+ (* (random 30) 5) (+ y 350)))

  (setq f_x (+ (* (random 100) 5) (- x 250)))

  (drawFigure size f_x f_y x y 3)

)

(draw-borders x y 3)

ЭКРАННЫЕ  ФОРМЫ

Рисунок 1.1 — Результат работы программы