graphics/text-rendering.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 (defun coordinate-to-grid-index (value)
  20   "translate a coordinate into the chess coordinate as a string"
  21   (let ((first (format nil "~c" (elt *alphabet* (mod (car value) (length *alphabet*)))))
  22         (second (format nil "~d" (cdr value))))
  23     (concatenate 'string first second)))
  24
  25 (defun tr-parse-string (s)
  26   "Translate a string into the coordinates used to print with tr-write"
  27   (loop :for i :across s
  28         :collect
  29         (position i *tr-string*)))
  30
  31 (defmacro tr-write (value x y width height renderer)
  32   `(let ((value-indexes (tr-parse-string ,value)))
  33      (loop :for character :in value-indexes
  34            :for character-position :from 0 :to (length value-indexes)
  35            :do (let ((source-rectangle (sdl2:make-rect (* character 60) 0 60 130))
  36                      (destination-rectangle (sdl2:make-rect (+ ,x (* character-position ,width)) ,y ,width ,height)))
  37                  (sdl2:render-copy ,renderer *tr-texture*
  38                                    :source-rect source-rectangle
  39                                    :dest-rect destination-rectangle)
  40                  (sdl2:free-rect source-rectangle)
  41                  (sdl2:free-rect destination-rectangle)))))