;-----------------------------------------------------------------------------------
; Функция проверки (не)вхождения точки в контур, описываемый координатами его вершин
; (C)KAI, 2003,2009 г. (413-2) 65-05-10 Магадан. http://geol-dh.narod.ru/
;-----------------------------------------------------------------------------------
(defun IS_IN_CONTOUR (pt lstpt pres / inters_pt on_edge inside dirflag dirflag_s bcontour xp yp 
                                      ptinfin imax i ptnext ptcurr calc xf yf xs ys yp0 ys0 yf0 intpt)
  ; pt = тестируемая (исходная) точка (координата Z игнорируется!)
  ; lstpt = список точек контура, контур должен содержать более трех точек (координата Z игнорируется!)
  ; pres = точность сравнения точек и координат на равенство (рекомендуется 0.00000000001)

  ; ссылка на функции: NOT_DUPLICATE (Функция исключения дублирующих членов списка, идущих подряд)
  
  ; Проверки должны быть выполнены до вызова функции
  ; Должны проверяться: допустимость типов, количество точек контура, наличие значений
  ; Допускается одно пересечение контура (например, контур в виде восьмерки)
  ; Незамкнутый контур автоматически замыкается.

  ; Благодарность за алгоритм: моей дочери Ольге, Першину Сергею, Зуеву Сергею, а также
  ; Илье Кантору (http://algolist.manual.ru/maths/geom/belong/poly2d.php)
  ; Точка лежит в контуре, если некий луч пересекает отрезки контура нечетное количество раз.
  
  ; В программе используется горизонтальный луч, направленный от точки влево

  ; Одинаковые точки, идущие подряд, в списке не допускаются
  ;   снижаем на порядок точность (чтобы наверняка убрать лишние точки)
  (setq lstpt (NOT_DUPLICATE lstpt (* pres 10)))
  ; Эта проверка на всякий случай (например, на случай наличия сдвоенных точек в списке из 3 точек)
  (if (not (and pt lstpt pres (> (length lstpt) 2)))
    (progn
      (princ (strcat "\n" "No enough data. Не достаточно данных для проверки вхождения точки в контур."))
      (EXIT)
    )
  )
  ; замыкающая точка автоматически добавляется, на концах списка будут абсолютно одинаковые точки
  (if (equal (car lstpt) (last lstpt) pres)
    (setq lstpt (reverse (cdr (reverse lstpt)))); отбрасываем последнюю точку
  )
  (setq lstpt (append lstpt (list (car lstpt)))); добавляем в конец списка первую точку

  (setq imax (length lstpt))
  (setq bcontour T); флаг выхода из цикла (точка задана на отрезке контура или в узле)
  (setq pt (list (car pt) (cadr pt)));переводим в двумерную
  (setq xp (car pt))
  (setq yp (cadr pt))
  (setq ptinfin (list -1.0e7 yp)); левая точка луча. СТРОКА ИЗМЕНЕНА 12.04.2009
  (setq i 0)
  ; Проверяем все отрезки контура, если не встретится случай принадлежности исходной точки
  ;  отрезку контура
  (while (and bcontour (setq ptnext (nth (1+ i) lstpt)));конечная точка текущего отрезка
    (setq ptcurr (nth i lstpt));начальная точка текущего отрезка
    (setq ptcurr (list (car ptcurr) (cadr ptcurr)));переводим точку в двумерную
    (setq ptnext (list (car ptnext) (cadr ptnext)))
    (setq calc T);флаг расчета (анализа)
    (setq xf (car ptcurr))
    (setq yf (cadr ptcurr))
    (setq xs (car ptnext))
    (setq ys (cadr ptnext))
    ; 1. Проверяем, принадлежит ли искомая узлу контура
    (if (or (equal pt ptnext pres)(equal pt ptcurr pres))
      (progn
        (setq calc nil); последующие операторы цикла выполнять не нужно
        (setq bcontour nil); выход из цикла, задача решена
        (setq on_edge "VERTEX"); тип точки на контуре
        (if (equal pt ptnext pres)
          (setq inters_pt ptnext); присваиваем точное значение из списка (а не искомой точки pt)
          (setq inters_pt ptcurr)
        )
      )
    )
    ; 2. Если текущий отрезок контура горизонтален
    (if (and calc (equal yf ys pres))
      (progn
        ;если искомая точка лежит на текущем горизонтальном отрезке
        (if (and (equal yf yp pres) (or (and (<= xf xp) (<= xp xs)) (and (>= xf xp) (>= xp xs))))
          (setq calc nil
                bcontour nil
                on_edge "EDGE"
                inters_pt pt
          );setq
          (progn
            ; если точки отрезка лежит левее искомой точки, но на том же горизонте
            ; p.s. Анализ этого случая в алгоритмах не упоминался, пришлось ввести его
            (if (and (equal yf yp pres) (or (< xf xp) (< xs xp)))
              (progn
                ; флаг направления предыдущего участка сохраняем, вдруг будут несколько
                ;   горизонтальных отрезков подряд
                ; Если предыдущий отрезок не горизонтальный и пересекается лучем (для 1-го участка)
                (if (and (= i 0) 
                         (< xf xp)
                         (not (equal yp (setq yp0 (cadr (nth (- (length lstpt) 2) lstpt))) pres)))
                  (if (< yp0 yp)
                    (setq dirflag "FROM DOWN")
                    (setq dirflag "FROM UP")
                  )
                )
                ; Если предыдущий отрезок не горизонтальный и пересекается лучем
                ;   (для последующих участков)
                (if (and (> i 0) 
                         (< xf xp)
                         (not (equal yp (setq yp0 (cadr (nth (1- i) lstpt))) pres)))
                  (if (< yp0 yp)
                    (setq dirflag "FROM DOWN")
                    (setq dirflag "FROM UP")
                  )
                )
                ; флаг направления последующего участка сохраняем, вдруг будут несколько
                ;   горизонтальных отрезков подряд
                ; Если последующий отрезок не горизонтальный (для последнего участка)
                (if (and (= imax i) (< xf xp) (not (equal yp (setq ys0 (cadr (nth 2 lstpt))) pres)))
                  (progn
                    (if (< ys0 yp)
                      (setq dirflag_s "FROM DOWN")
                      (setq dirflag_s "FROM UP")
                    )
                  )
                )
                ; Если последующий отрезок не горизонтальный
                (if (and (< xf xp) (not (equal yp (setq ys0 (cadr (nth (+ 2 i) lstpt))) pres)))
                  (progn
                    (if (< ys0 yp)
                      (setq dirflag_s "FROM DOWN")
                      (setq dirflag_s "FROM UP")
                    )
                  )
                )
                ; Анализ флагов направления
                (if (and dirflag dirflag_s (/= dirflag dirflag_s))
                  (setq inside (not inside);инвертирование флага пересечения луча контура
                        calc nil
                        dirflag nil dirflag_s nil
                  );setq
                )
              )
              ; луч заведомо не пересекает этот отрезок и далее можно проверок не делать
              (progn
                (setq calc nil); последующие операторы цикла выполнять не нужно
              )
            )  
          )
        )
      )
    )
    ; 3. Анализ случая пересечения луча узла контура по первой точке отрезка
    ;    (вторую точку отрезка проверим на следующей итерации)
    (if (and calc (and (equal yf yp pres) (< xf xp)))
      (progn
        ; для первого отрезка предыдущей точкой будет предпоследняя точка списка
        (if (= i 0)
          (setq yf0 (cadr (nth (- (length lstpt) 2) lstpt)))
          (setq yf0 (cadr (nth (1- i) lstpt)))
        )
        ;вершины по разные стороны от луча?
        (if (or (and (and (> yf0 yp) (< ys yp)) (not (equal yf0 yp pres)))
                (and (and (< yf0 yp) (> ys yp)) (not (equal yf0 yp pres))))
          (setq inside (not inside);инвертирование флага пересечения луча контура
                calc nil
          );setq
        )
      )
    )
    ; 4. Остается проверить случай, когда луч пересекает наклонный отрезок между вершинами
    (if (and calc (setq intpt (inters ptnext ptcurr pt ptinfin)))
      (progn
        (if (equal intpt pt pres); если точка пересечения точно на отрезке
          (setq calc nil; to skip next operators
                bcontour nil ;end of while
                on_edge "EDGE"
                inters_pt intpt
          );setq
          (progn
            (if (not (or (and (equal ys yp pres) (< xs xp)) (and (equal yf yp pres) (< xf xp))))
              (setq inside (not inside));инвертирование флага пересечения луча контура
            )
          )
        )
      )
    )
    (setq i (1+ i))
  );while
  
  ; если точка лежит на контуре или в узле, значит она принадленит контуру
  ; устанавливаем принудительно значение флага четности пересечений
  (if inters_pt
    (setq inside T)
  )
  ; точка истинно будет внутри контура при inters_pt=nil (анализировать при необходимости)
  
  ;возврат значений списком из:
  ; 1. флага вхождения точки в контур [nil or T]
  ; 2. Координаты точки на контуре (узла контура) или nil [список координат].
  ;    Координаты искомой точки заменяются координатами узла или найденной точки пересечения
  ;    (за исключением пересечения на горизонтальном участке).
  ; 3. Расшифровка где именно лежит точка на контуре [строка], выдаваемые значения: "VERTEX" либо "EDGE"
  (list inside inters_pt on_edge)
);end of ******** IS_IN_CONTOUR *******