Notice: Undefined index: moes_p in /home/elpanov/elpanov.com/docs/index.php(3) : eval()'d code on line 1
ElpanovEvgeniy | Геометрический вальс.

Новая версия сайта, доступна здесь.




Геометрический вальс.





eea-gr.gif (215 Кб)


;;	eea-gr.lsp
(defun c:eea-gr (/ A LST N P S X Y)
                ;|
*****************************************************************************************

by ElpanovEvgeniy

Программа для демонстрации использования матриц, совместно с динамической отрисовкой
на экране. 

Дата создания      02.04.2005
последняя редакция 01.10.2006


The program for demonstration use matrixes,
together with dynamic drawing on the screen area.

Date of creation 02.04.2005
Last edition     01.10.2006

(c:eea-gr1)
*****************************************************************************************
|;
 (setq lst '((0. 0.) (0. 1.) (1. 1.) (1. 0.))
       p   (trans (getvar "VIEWCTR") 1 3)
       x   (car p)
       y   (cadr p)
 ) ;_  setq
 (while (= (car (setq p (grread nil 5))) 5)
  (setq p (trans (cadr p) 1 3)
        p (list (- (car p) x) (- (cadr p) y))
        a 0.
        s (/ (getvar "viewsize") 10.)
  ) ;_  setq
  (if (> (abs (car p)) (abs (cadr p)))
   (setq p (list (if (minusp (car p))
                  -1.
                  1.
                 ) ;_  if
                 (if (zerop (car p))
                  0.
                  (/ (cadr p) (abs (car p)))
                 ) ;_  if
           ) ;_  list
   ) ;_  setq
   (setq p (list (if (zerop (cadr p))
                  0.
                  (/ (car p) (abs (cadr p)))
                 ) ;_  if
                 (if (minusp (cadr p))
                  -1.
                  1.
                 ) ;_  if
           ) ;_  list
   ) ;_  setq
  ) ;_  if
  (redraw)
  (grvecs
   (apply
    (function append)
    (cons
     (list 3 '(0 0) p)
     (mapcar
      (function (lambda (l)
                 (apply (function append)
                        (mapcar (function (lambda (x x1) (list 1 x x1)))
                                l
                                (cons (last l) l)
                        ) ;_  mapcar
                 ) ;_  apply
                ) ;_  lambda
      ) ;_  function
      (mapcar (function
               (lambda (n)
                (setq n (list (+ (* (car n) (car p)) (* (cadr n) (cadr p)))
                              (+ (* (car n) (cadr p)) (* (cadr n) (- (car p))))
                        ) ;_  list
                ) ;_  setq
                (mapcar (function (lambda (x1) (mapcar (function +) x1 n))) lst)
               ) ;_  lambda
              ) ;_  function
              '((-2 -2) (-1 -2) (0 -2) (1 -2) (2 -2)
                (-2 -1) (-1 -1) (0 -1) (1 -1) (2 -1)
                (-2  0) (-1  0) (0  0) (1  0) (2  0)
                (-2  1) (-1  1) (0  1) (1  1) (2  1)
                (-2  2) (-1  2) (0  2) (1  2) (2  2)
               )
      ) ;_  mapcar
     ) ;_  mapcar
    ) ;_  cons
   ) ;_  apply
   (list (list (* (cos a) s)
               (* (- (sin a)) s)
               0.
               (- (+ x x) (* x (cos a)) (* y (- (sin a))))
         ) ;_  list
         (list (* (sin a) s)
               (* (cos a) s)
               0.
               (- (+ y y) (* x (sin a)) (* y (cos a)))
         ) ;_  list
         (list 0. 0. s 0.)
         '(0. 0. 0. 1.)
   ) ;_  list
  ) ;_  grvecs
 ) ;_  while
 (redraw)
) ;_  defun
;|«Visual LISP© Format Options»
(80 1 2 2 T " " 80 60 0 0 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;