graphics/grid.lisp

   1 ;;;; Ru*** roLeplay Playground virtual tabletop
   2 ;;;; Copyright (C) 2022  Zull
   3 ;;;;
   4 ;;;; This program is free software: you can redistribute it and/or modify
   5 ;;;; it under the terms of the GNU General Public License as published by
   6 ;;;; the Free Software Foundation, either version 3 of the License, or
   7 ;;;; (at your option) any later version.
   8 ;;;;
   9 ;;;; This program is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;;; GNU General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU General Public License
  15 ;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 (in-package :rulp.graphics)
  18
  19 (defparameter +grid-span+ 50)
  20 (defparameter +is-grid-letters+ t)
  21 (defparameter +is-grid+ t)
  22
  23
  24 ; these two functions can be edited when different grids will be added
  25 (defun position-actor-to-view (a)
  26   (* a +grid-span+))
  27 (defun position-view-to-actor (a)
  28   (floor (/ a +grid-span+)))
  29
  30 (defparameter +letters-list+
  31   '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
  32     "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))
  33
  34 ;; this function cycle throughout the letters
  35 (defun letter-cycle (n)
  36   (nth (mod n (length +letters-list+)) +letters-list+))
  37
  38 (defun toggle-grid ()
  39   (if +is-grid+
  40       (setf +is-grid+ nil)
  41       (setf +is-grid+ t)))
  42
  43 ;; NOTE: horrible
  44 (defun toggle-grid-letters ()
  45   (if +is-grid-letters+
  46       (setf +is-grid-letters+ nil)
  47       (setf +is-grid-letters+ t)))
  48
  49 ;; FIXME: the function doesn't consider *viewpoint-zoom*
  50 (defmacro grid-render (renderer &optional (x 0) (y 0) (w 100) (h 100))
  51   "renderize a grid in where required"
  52   `(let ((neg-x (* ,x -1))
  53          (neg-y (* ,y -1))
  54          (plane-x (x *plane*))
  55          (plane-y (y *plane*))
  56          (x-iterations (/ (- ,w ,x) *plane-grid*))
  57          (y-iterations (/ (- ,h ,y) *plane-grid*)))
  58     (progn
  59       ;; (sdl2:set-render-draw-color ,renderer ,red ,green ,blue 255)
  60       (loop :for i :from (ceiling (/ neg-x *plane-grid*)) :to x-iterations
  61             :do
  62                (sdl2:render-draw-line ,renderer
  63                                       (+ (* i *plane-grid*) plane-x)
  64                                       (+ plane-y neg-y)
  65                                       (+ (* i *plane-grid*) plane-x)
  66                                       (+ ,h plane-y neg-y))
  67             )
  68       (loop :for j :from (ceiling (/ neg-y *plane-grid*)) :to y-iterations
  69             :do
  70                (sdl2:render-draw-line ,renderer
  71                                       (+ plane-x neg-x)
  72                                       (+ (* j *plane-grid*) plane-y)
  73                                       (+ plane-x ,w neg-x)
  74                                       (+ (* j *plane-grid*) plane-y))
  75             ))
  76     (sdl2:set-render-draw-color ,renderer 0 0 0 255)
  77      ))
  78
  79 (defmacro indexes-render (renderer &optional (x 0) (y 0) (w 0) (h 0))
  80   `(let ((neg-x (* ,x -1))
  81          (neg-y (* ,y -1))
  82          (x-offset (x *plane*))
  83          (y-offset (y *plane*))
  84          (x-iterations (/ (- ,w ,x) *plane-grid*))
  85          (y-iterations (/ (- ,h ,y) *plane-grid*)))
  86      (loop :for k :from (floor (/ neg-x *plane-grid*)) :to x-iterations
  87            :do (loop :for l :from (floor (/ neg-y *plane-grid*)) :to y-iterations
  88                      :do (tr-write (coordinate-to-grid-index (cons l (+ k 1)))
  89                                    (+ x-offset (* k *plane-grid*))
  90                                    (+ y-offset (* l *plane-grid*))
  91                                    (floor (/ *plane-grid* 3))
  92                                    (floor (/ *plane-grid* 3))
  93                                    ,renderer)))
  94      ;; (sdl2:set-render-draw-color ,renderer 0 255 0 100) ; remember to uncomment both
  95      ;; (sdl2:render-fill-rect ,renderer (sdl2:make-rect ,x ,y ,w ,h)) ; test for x y w and h
  96      ))
  97
  98 ;;; BUG: the coordinates given to the macros are incorrect. The render-fill-rect test
  99 ;;; proven that the coordinates are not faithful of the view point visual. These
 100 ;;; coordinate must be adjusted so the (now commented) render-fill-rect line will
 101 ;;; always fill all the screen