;;;; Copyright (C) 1993-1996 Id Software, Inc.
;;;; Copyright (C) 2019-2020 Nobuaki Tanaka
;;;; Copyright (C) 2021 Remilia Scarlet
;;;;
;;;; This program is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation, either version 3 of
;;;; the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program. If not, see
;;;; <http://www.gnu.org/licenses/>.
(in-package :cl-doomview)
;;;;
;;;; Geometry-related Functions.
;;;;
;;;; Taken from Managed Doom by Nobuaki Tanaka
;;;;
(defun point-on-side (node x y)
(declare (type bsp-node node)
(type single-float x y)
(optimize (speed 3) (safety 0) (debug 0)))
(when (= (bsp-node-dx node) 0)
(if (<= x (coerce (bsp-node-x node) 'single-float))
(return-from point-on-side (if (> (bsp-node-dy node) 0) :left :right))
(return-from point-on-side (if (< (bsp-node-dy node) 0) :left :right))))
(when (= (bsp-node-dy node) 0)
(if (<= y (coerce (bsp-node-y node) 'single-float))
(return-from point-on-side (if (< (bsp-node-dx node) 0) :left :right))
(return-from point-on-side (if (> (bsp-node-dx node) 0) :left :right))))
(let ((dx 0.0) (dy 0.0) (left 0.0) (right 0.0))
(declare
(type single-float dx dy left right)
(dynamic-extent dx dy left right))
(setf dx (- x (bsp-node-x node)))
(setf dy (- y (bsp-node-y node)))
(setf left (* (bsp-node-dy node) dx))
(setf right (* (bsp-node-dx node) dy))
(if (< right left)
:right
:left)))
(defun point-on-line-side (line x y)
(declare (type linedef line)
(type single-float x y)
(optimize (speed 3) (safety 0) (debug 0)))
(let ((lx (vertex-x (linedef-v1 line)))
(ly (vertex-y (linedef-v1 line)))
(ldx (linedef-dx line))
(ldy (linedef-dy line)))
(declare (type single-float lx ly ldx ldy))
(when (= ldx 0)
(if (<= x lx)
(return-from point-on-line-side (if (> ldy 0) :back :front))
(return-from point-on-line-side (if (< ldy 0) :back :front))))
(when (= ldy 0)
(if (<= y ly)
(return-from point-on-line-side (if (< ldx 0) :back :front))
(return-from point-on-line-side (if (> ldx 0) :back :front))))
(let ((dx 0.0)
(dy 0.0)
(left 0.0) (right 0.0))
(declare (dynamic-extent dx dy left right))
(setf dx (- x lx))
(setf dy (- y ly))
(setf left (* ldy dx))
(setf right (* ldx dy))
(if (< right left)
:front
:back))))
(defun point-in-subsector-p (map x y)
(declare (type doom-map map)
(type single-float x y)
(optimize (speed 3) (safety 0) (debug 0)))
;; Single subsector is a special case.
(when (= (length (map-gl-nodes map)) 0)
(return-from point-in-subsector-p (values (elt (map-gl-subsectors map) 0) 0)))
(let ((node-num (1- (length (map-gl-nodes map)))))
(loop while (not (node-is-subsector-p node-num :gl-nodes-v2)) do
(let* ((node (elt (map-gl-nodes map) node-num))
(side (point-on-side node x y)))
(setf node-num (ecase side
(:right (bsp-node-right-child node))
(:left (bsp-node-left-child node))))))
(let ((idx (node-get-subsector node-num :gl-nodes-v2)))
(values (elt (map-gl-subsectors map) idx)
idx))))
(declaim (inline point->angle))
(defun point->angle (x y)
(declare (type single-float x y)
(optimize (speed 3) (safety 1) (debug 1)))
(when (and (< -0.01 x) (< x 0.01))
(return-from point->angle (if (> y 0) (/ +pi+ 2) (* 3 (/ +pi+ 2)))))
(let ((ret (coerce (atan y x) 'single-float)))
(when (< ret 0)
(incf ret (* 2 +pi+)))
ret))