graphics/render.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 (defgeneric texture (s))
  20 (defgeneric surface (s))
  21
  22 (defparameter courtesy-rectangle (sdl2:make-rect 0 0 10 10)
  23   "creating and destroying rectangles waste resources and leaving them in ram is even worse. Do not use this
  24 rectangle directly, but use the arrange-rect")
  25
  26 (defun arrange-rect (x y w h)
  27   (progn
  28     (setf (sdl2:rect-x courtesy-rectangle) x)
  29     (setf (sdl2:rect-y courtesy-rectangle) y)
  30     (setf (sdl2:rect-width courtesy-rectangle) w)
  31     (setf (sdl2:rect-height courtesy-rectangle) h)
  32     courtesy-rectangle)
  33   )
  34
  35 (defmethod texture ((s screen))
  36   "returns the screen texture, useful for accelerated enviroinments"
  37   (unless (slot-value s 'texture)
  38     (setf (slot-value s 'texture) (sdl2:create-texture-from-surface rulp.render:*renderer* (surface s)))
  39     (sdl2:free-surface (slot-value s 'surface))
  40     (setf (slot-value s 'surface) nil))
  41   (slot-value s 'texture))
  42
  43 (defmethod surface ((s screen))
  44   "returns the screen sdl2 surface, create if there is none"
  45   (unless (slot-value s 'surface)
  46     (setf (slot-value s 'surface) (sdl2-image:load-image (slot-value s 'path))))
  47   (slot-value s 'surface))
  48
  49 (defun remove-nth (n list)
  50   "given a list it returns the same list without the nth element"
  51   (let ((k (mod n (length list))))
  52     (if (< k 1)
  53         (cdr list)
  54         (cons (car list) (remove-nth (1- k) (cdr list)))
  55        )))
  56
  57 (defun make-grid (span)
  58   "create a square grid"
  59   (loop :for i :from 0 :to *window-width* :by span
  60         :do (sdl2:render-draw-line rulp.render:*renderer* i 0 i *window-height*))
  61   (loop :for j :from 0 :to *window-height* :by span
  62         :do (sdl2:render-draw-line rulp.render:*renderer* 0 j *window-width* j)))
  63
  64 (defun find-on-plane (x y plane)
  65   "find the entity in real-coordinates (x,y) in plane"
  66   (let ((mouse-point (sdl2:make-rect (- x 2) (- y 2) 2 2))
  67         (entities (entities-list plane)))
  68     (loop :for entity :in entities
  69           :do (when (sdl2:has-intersect mouse-point
  70                                         (screen-destination entity plane))
  71                 entity))))
  72
  73 ;; BUG: when the system loads it doesn't fill the variable
  74 ;; *execute-in-viewpoint* therefore this function is never executed
  75 (defchain render-plane-and-entities :viewpoint
  76 ;;   "using *plane* and *entities-list* the macro display on the current rendering texture
  77 ;; the plane 'as is' and the entities with the grid-layout function"
  78   (when *plane*
  79     ;; NOTE: add error for non-screen planes
  80     (display *plane* t)
  81     (loop :for entity :in (entities-list *plane*)
  82           :do
  83              (when (displayp entity)
  84                (display entity (plane-grid *plane*))
  85                )))                                        ; FIXME: create a grid-layout function
  86   )