render/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.render)
  18
  19 (defparameter *renderer* nil
  20   "a variable containing the rendering informations. It is used for all
  21 SDL operations that require graphic acceleration. The variable shall not be
  22 used by itself, the functions in this package will use it for you.")
  23
  24 ;; Color functions
  25 (defun color ()
  26   (sdl2:get-render-draw-color *renderer*))
  27
  28 (defun (setf color) (red green blue alpha)
  29   (sdl2:set-render-draw-color *renderer* red green blue alpha)
  30   )
  31
  32 ;; line function
  33 (defun render-line (x y width height)
  34   "render a line with hardware acceleration on screen"
  35   (sdl2:render-draw-line *renderer* x y width height))
  36
  37 ;; rectangle functions
  38 ;; NOTE: thread unfriendly
  39 (defparameter *cache-rectangle* (sdl2:make-rect 0 0 10 10)
  40   "This is a helper rectangle, used to define and draw squares whenever
  41   necessary without creating and destroying rectangles. Use this with
  42 the rectangle function.")
  43
  44 (defun make-rectangle (x y width height)
  45   (sdl2:make-rect x y width height))
  46
  47 (defun move-rectangle (x y width height rectangle)
  48   "setup a rectangle and return it"
  49   (setf (sdl2:rect-x rectangle) x)
  50   (setf (sdl2:rect-y rectangle) y)
  51   (setf (sdl2:rect-width rectangle) width)
  52   (setf (sdl2:rect-height rectangle) height)
  53   rectangle)
  54
  55 (defun rectangle (x y width height)
  56   (move-rectangle x y width height *cache-rectangle*))
  57
  58 (defun render-square (x y width height &key (fill nil))
  59   "render a square with hardware acceleration on screen"
  60   (if fill
  61       (sdl2:render-fill-rect *renderer* (move-rectangle x y width height *cache-rectangle*))
  62       (sdl2:render-draw-rect *renderer* (move-rectangle x y width height *cache-rectangle*))))
  63
  64 ;; texture functions
  65 ;; NOTE: Thread unfrendly
  66 (defparameter *texture-cache-rectangles*
  67   (cons (sdl2:make-rect 0 0 10 10)
  68         (sdl2:make-rect 0 0 10 10))
  69   "These rectangles are cache used by render-texture to renderize without
  70   creating and destroying them every time")
  71
  72 (defun render-texture (source-list
  73                        destination-list
  74                        texture)
  75   "Given two list of four numbers (x y width height) or empty lists it render
  76 them on screen. When given an empty list it uses the whole source or destination
  77 to print the result. If source-list is nil then the whole texture is displayed,
  78 if destination-list is nil then the selected texture is displayed on the whole
  79 window or destination screen buffer."
  80   (when source-list
  81     (move-rectangle (nth 0 source-list) (nth 1 source-list)
  82                     (nth 2 source-list) (nth 3 source-list)
  83                     (car *texture-cache-rectangles*)))
  84   (when destination-list
  85     (move-rectangle (nth 0 destination-list) (nth 1 destination-list)
  86                     (nth 2 destination-list) (nth 3 destination-list)
  87                     (cdr *texture-cache-rectangles*)))
  88   (sdl2:render-copy *renderer* texture
  89                     :source-rect (if source-list
  90                                      (car *texture-cache-rectangles*)
  91                                      nil)
  92                     :dest-rect (if destination-list
  93                                    (cdr *texture-cache-rectangles*)
  94                                    nil)))
  95
  96 ;; collision detection
  97 (defun intersect-square (source-x source-y source-width source-height
  98                          dest-x dest-y dest-width dest-height)
  99   (move-rectangle source-x source-y source-width source-height (car *texture-cache-rectangles*))
 100   (move-rectangle dest-x dest-y dest-width dest-height (cdr *texture-cache-rectangles*))
 101   (sdl2:intersect-rect (car *texture-cache-rectangles*) (cdr *texture-cache-rectangles*)))
 102
 103 (defun intersect-point (source-x source-y source-width source-height
 104                         point-x point-y)
 105   (intersect-square source-x source-y source-width source-height point-x point-y 10 10))
 106
 107 (defun load-texture (path)
 108   (let* ((temporary-surface nil))
 109     (setf temporary-surface (sdl2-image:load-image path))
 110     (prog1
 111         (sdl2:create-texture-from-surface *renderer* temporary-surface)
 112       (sdl2:free-surface temporary-surface))
 113     )
 114   )
 115
 116 (defun texture-width (texture)
 117   (sdl2:texture-width texture))
 118
 119 (defun texture-height (texture)
 120   (sdl2:texture-height texture))
 121
 122 (defun destroy-texture (texture)
 123   (sdl2:destroy-texture texture))