CL-DoomView  Artifact [9b46718292]

Artifact 9b467182925b512e47d3ec0fdeb47dd1ce37f261c756d41b9af16756c7b0e5a7:

• File src/camera.lisp — part of check-in [da77e5a703] at 2021-01-24 02:44:28 on branch trunk — Refactor code to use SINGLE-FLOATs and structures instead of DOUBLE-FLOATs and CLOS classes. (user: alexa size: 2474)

;;;; CL-DoomView
;;;; 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)

(defstruct camera
  (x 0.00 :type single-float)
  (y 0.0 :type single-float)
  (z 0.0 :type single-float)
  (angle 0.0 :type single-float)
  (sin 0.0 :type single-float)
  (cos 0.0 :type single-float))

(defun update-position (level cam)
  (declare (type doom-map level)
           (type camera cam)
           (optimize (speed 3) (safety 0) (debug 1)))

  ;;
  ;; Yay for lots of ugly type declarations that cause all sorts of (honestly
  ;; useful) notes in SBCL (though I'm amused how many I'm generating here).
  ;;

  (with-slots (keys) *program*
    (with-slots (x y z cos sin angle) cam
      (unless (= (logand keys +left+) 0)
        (incf angle (* 3 (/ +pi+ 180.0)))
        (setf sin (coerce (sin angle) 'single-float))
        (setf cos (cos angle)))

      (unless (= (logand keys +right+) 0)
        (decf angle (* 3 (/ +pi+ 180.0)))
        (setf sin (coerce (sin angle) 'single-float))
        (setf cos (cos angle)))

      (unless (= (logand keys +forward+) 0)
        (incf x (* cos +speed+))
        (incf y (* sin +speed+)))

      (unless (= (logand keys +back+) 0)
        (decf x (* cos +speed+))
        (decf y (* sin +speed+)))

      (unless (= (logand keys +strafe-left+) 0)
        (decf x (* sin +speed+))
        (incf y (* cos +speed+)))

      (unless (= (logand keys +strafe-right+) 0)
        (incf x (* sin +speed+))
        (decf y (* cos +speed+)))

      (let ((new-subsect (point-in-subsector-p level x y)))
        (setf z (coerce (+ (the (unsigned-byte 32) +camera-height+)
                           (the double-float
                                (dwaddle:sector-floor-height (dwaddle::subsector-sector new-subsect))))
                        'single-float))))))