graphics/view.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 :graphics)
  18 #| -------------------------------------------
  19  | This file manipulate the window and the
  20  | sdl initialization.
  21  | -------------------------------------------
  22  |#
  23
  24 (defmacro with-playground ((window renderer &key (title "RuLP")) &body body)
  25   `(sdl2:with-window (,window :title title :w *window-width* :h *window-height* :flags '(:resizable))
  26      (sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated :presentvsync)) ;later add delta
  27        (sdl2-image:init '(:png :jpg))
  28        (sdl2-ttf:init)
  29        ,@body
  30        (sdl2-ttf:quit)
  31        (sdl2-image:quit)
  32        )))
  33
  34 ;; renderer exists only inside this function, so you cannot create a texture outside
  35 ;; (at least for now), more on this later os
  36 (defun playground (title &optional (fps 60) (debug-info nil))
  37   (sdl2:with-init (:video)
  38     (with-playground (window *renderer* :title title)
  39       (setf *tr-texture* (let* ((font (sdl2-ttf:open-font "media/IBMPlex.ttf" 100)) ;; this line throw fault, works anyway
  40                                 (font-surface (sdl2-ttf:render-text-solid font *tr-string* 0 0 0 0))
  41                                 (font-texture (sdl2:create-texture-from-surface *renderer* font-surface)))
  42                            (sdl2:free-surface font-surface)
  43                            font-texture))
  44       (sdl2:with-event-loop (:method :poll)
  45         (:quit () t)
  46         (:keyup (:keysym keysym)
  47                 (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-q)
  48                   (format t "pressed q~%")))
  49         (:mousebuttondown (:x x :y y :state state)
  50                           (loop :for key :in *mouse-keybinds*
  51                                 :do (when (sdl2:mouse-state-p (eval (car key)))
  52                                       (apply (cadr key) `(,x ,y ,+plane+))))
  53                           (when +plane+
  54                             (activate x y state +plane+)))
  55         (:idle ()
  56                ;; clean window texture
  57                (sdl2:set-render-draw-color *renderer* 0 0 0 255)
  58                (sdl2:render-clear *renderer*)
  59                (when +plane+
  60                  (sdl2:render-copy *renderer* (texture +plane+)
  61                                    :source-rect (screen-source +plane+)
  62                                    :dest-rect (screen-destination +plane+ t))
  63                  (loop :for entities :in (entities-list +plane+)
  64                        :do
  65                           (when (displayp entities)
  66                             (sdl2:render-copy *renderer* (texture entities)
  67                                               :source-rect (screen-source entities)
  68                                               :dest-rect (screen-destination entities +plane+))))
  69                  ;; Grid creation
  70                  (when *is-grid*
  71                    (grid-render *renderer* +plane+))
  72                  ;; Indexes creation
  73                  (when *is-indexes*
  74                    (indexes-render *renderer* +plane+))
  75                  )
  76                ;; pointer section
  77                (when *pointer*
  78                  (sdl2:set-render-draw-color *renderer* 128 250 33 255)
  79                  (let ((select-rectangle (screen-destination (nth *pointer* (entities-list +plane+)) +plane+)))
  80                    (sdl2:render-draw-rect *renderer* select-rectangle))
  81                  )
  82                ;; entries generation
  83                (loop :for entry :in (reverse *entries-list*)
  84                      :do (sdl2:set-render-draw-color *renderer* 255 255 255 255)
  85                          (sdl2:render-fill-rect *renderer* (entry-rectangle entry))
  86                          (sdl2:set-render-draw-color *renderer* 0 0 0 255)
  87                          (loop :for content :in (contents entry)
  88                                :for content-position :from 0 :to (length (contents entry))
  89                                :do (tr-write (car content)
  90                                              (car (coordinate entry))
  91                                              (+ (* content-position (text-size entry)) (cdr (coordinate entry)))
  92                                              (text-size entry) (text-size entry) *renderer*
  93                                              ))
  94                           )
  95                (sdl2:render-present *renderer*)
  96                ;; updating grids and dimension
  97                (multiple-value-bind (new-width new-height) (sdl2:get-window-size window)
  98                  (setf *window-width* new-width)
  99                  (setf *window-height* new-height))
 100                )))))