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 (defmacro render-plane-and-entities (renderer)
  74   "using *plane* and *entities-list* the macro display on the current rendering texture
  75 the plane 'as is' and the entities with the grid-layout function"
  76   `(when *plane*
  77      ;; NOTE: add error for non-screen planes
  78      (display *plane*)
  79      ;; (sdl2:render-copy ,renderer (texture *plane*)
  80      ;;                   :source-rect nil
  81      ;;                   :dest-rect (screen-destination *plane* t))
  82      (loop :for entity :in *entities-list*
  83            :do
  84               (when (displayp entity)
  85                 (multiple-value-bind (coordinates size) (grid-layout (car (coordinate entity))
  86                                                                      (cdr (coordinate entity))
  87                                                                      :size (size entity))
  88                   (sdl2:render-copy ,renderer (texture entity)
  89                                     :source-rect nil ; NOTE: not general
  90                                     :dest-rect (arrange-rect (car coordinates) (cdr coordinates) size size)))) ; FIXME: create a grid-layout function
  91            )
  92      )
  93   )