graphics/menu.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 (defpackage :rulp.entries
  18   (:use :cl)
  19   (:export *entries-list* push pop entry x y width height rectangle click-event
  20            render-entry make-plist))
  21
  22 (in-package :rulp.entries)
  23
  24 (defparameter *entries-list* nil
  25   "List of entries, menues who are generated into the window with options")
  26
  27 (defgeneric rectangle (entry))
  28
  29 (defclass entry ()
  30     ((coordinates :accessor coordinates
  31                   :initarg :coordinates
  32                   :initform '(0 . 0)
  33                   :documentation "the starting position of the entry generation"
  34                   :type list)
  35      (title :accessor title
  36             :initarg :title
  37             :initform "custom"
  38             :documentation "title for the entry")
  39      (margin :accessor margin
  40              :initarg :margin
  41              :initform 5
  42              :type number
  43              :documentation "the margin between the content and the borders of the rectangle")
  44      (padding :accessor padding
  45               :initarg :padding
  46               :initform 0
  47               :type number
  48               :documentation "the padding between the coordinates and the borders")
  49      (action :accessor action
  50              :initarg :action
  51              :initform nil
  52              :documentation "action when pressed")
  53      (contents :accessor contents
  54                 :initarg :contents
  55                 :initform nil
  56                 :type list
  57                 :documentation "a list of other entries")
  58      (text-size :accessor size
  59                 :initarg :size
  60                 :initform 20
  61                 :type number)
  62      (content-orientation :accessor orientation
  63                           :initarg :orientation
  64                           :initform :v
  65                           :documentation "when :v the contents and title
  66 are displaced vertically, when :h the contents are horizontally displayed")))
  67
  68 (defmethod x ((obj entry))
  69   (car (coordinates obj)))
  70
  71 (defmethod y ((obj entry))
  72   (cdr (coordinates obj)))
  73
  74 ;; (defmethod width ((entry entry))
  75 ;;   200)
  76
  77 ;; (defmethod height ((entry entry))
  78 ;;   200)
  79
  80 (defun width-vertical (plist)
  81   (let* ((i 0))
  82     (labels ((operation (element)
  83                (setf i (max i (length (getf element :title)))) ; FIXME: add padding
  84                (loop :for x :in (getf element :contents)
  85                      :do (operation x))
  86                ))
  87       (operation plist))
  88     i
  89     ))
  90
  91 (defun width-horizontal (plist)
  92   (let* ((i 0))
  93     (labels ((operation (element)
  94                (incf i (length (getf element :title)))
  95                (loop :for x :in (getf element :contents)
  96                      :do (operation x))
  97                ))
  98       (operation plist))
  99     i
 100     ))
 101
 102 (defun height-vertical (plist)
 103   (let* ((i 0))
 104     (labels ((operation (element)
 105                (1+ i)
 106                (loop :for x :in (getf element :contents)
 107                      :do (operation x))
 108                ))
 109       (operation plist))
 110     i
 111     ))
 112
 113 (defun height-horizontal (plist) 1)
 114
 115 ;; (defmethod width ((entry entry))
 116 ;;   "give the length of the longest menu entry, useful for creating a box containing them all"
 117 ;;   (reduce #'max (loop :for content :in (contents entry))))
 118
 119 ;; (defmethod height ((entry entry))
 120 ;;   "give the number of entries, useful for creating a box containing them all"
 121 ;;   (length (contents entry)))
 122
 123 (defmethod rectangle ((entry entry))
 124   (flet ((on-size (a) (* a (text-size y))))
 125     (sdl2:make-rect (x entry)
 126                     (y entry)
 127                     (on-size (entry-width y))
 128                     )))
 129
 130 ;; NOTE: this method makes the entry class totally useless. It is possible
 131 ;; to replace entries with these plists and use them directly with the macro
 132 (defmethod make-plist ((entry entry))
 133   (list ':entry 'entry
 134         ':title (title entry)
 135         ':coordinates (coordinates entry)
 136         ':padding (padding entry)
 137         ':margin (margin entry)
 138         ':text-size (size entry)
 139         ':action (action entry)
 140         ':contents (contents entry)
 141         ':orientation (orientation entry))
 142   )
 143 ;; NOTE: The idea of replacing the whole class idea with the plist system makes
 144 ;; room for special functions that can create rectangles out of the correct size,
 145 ;; can adjust the text and aid the macro in the rendering process.
 146
 147 (defun n-letter-content (pair)
 148   "given a list of two elements, one a string and the other a generic symbol, it returns the
 149 length of the string. This is used in display-entry, where it is used to find
 150 the maximum size of a list of options to make the correct dimension for the entry"
 151   (length (car pair)))
 152
 153 (defun keep-inside (position size limit)
 154   (if (> position (- limit size))
 155       (- position size)
 156       position
 157     ))
 158
 159 (defmacro render-entry (renderer plist)
 160   `(let* ((entry-margin (if (numberp (getf ,plist :margin)) (getf ,plist :margin) 0))
 161           (entry-padding (if (numberp (getf ,plist :padding)) (getf ,plist :padding) 0))
 162           (entry-size (getf ,plist :text-size)) ; NOTE: make error checking instead of redefinition
 163           (entry-x (+ entry-margin (car (getf ,plist :coordinates))))
 164           (entry-y (+ entry-margin (cdr (getf ,plist :coordinates))))
 165           (entry-w (if (eq (getf ,plist :orientation) 'v)
 166                        (width-vertical ,plist)
 167                        (width-horizontal ,plist)))
 168           (entry-h (if (eq (getf ,plist :orientation) 'v)
 169                        (height-vertical ,plist)
 170                        (height-horizontal ,plist))))
 171      (setf entry-x (keep-inside entry-x entry-w rulp.graphics:*window-width*))
 172      (setf entry-y (keep-inside entry-y entry-h rulp.graphics:*window-height*)) ; BUG: doesn't seems to work
 173      ;; (when (> entry-x (- rulp.graphics:*window-width* entry-w))
 174      ;;   (setf entry-x (- entry-x entry-w)))
 175      ;; (when (> entry-y (- rulp.graphics:*window-height* entry-h))
 176      ;;   (setf entry-y (- entry-y entry-h)))
 177      (sdl2:set-render-draw-color ,renderer 255 255 255 255)
 178      (sdl2:render-fill-rect ,renderer (rulp.graphics:arrange-rect
 179                                        entry-x
 180                                        entry-y
 181                                        (+ (* 2 entry-padding) (* entry-w entry-size))
 182                                        (+ (* 2 entry-padding) (* entry-h entry-size)))) ; FIXME: fixed size font
 183      ;; NOTE: temporary solution, to be extended with the content-rendering
 184      ;; function into a rendering engine for nested schemas
 185      (sdl2:set-render-draw-color ,renderer 0 0 0 255)
 186      (rulp.graphics:tr-write (getf ,plist :title)
 187                              (+ entry-x entry-padding)
 188                              (+ entry-y entry-padding)
 189                              entry-size
 190                              entry-size
 191                              ,renderer)
 192      ;; FIXME: continue with contents
 193      ))
 194
 195 (defmacro display-entry (renderer entry)
 196   "macro for creating the actual menu given the renderer and the entry"
 197   `(let* ((entry-x (+ (car (coordinate ,entry)) (padding ,entry)))
 198           (entry-y (+ (cdr (coordinate ,entry)) (padding ,entry)))
 199           (maximum-letters (apply #'max (cons (length (title ,entry)) (mapcar #'n-letter-content (contents ,entry)))))
 200           (number-of-elements (1+ (length (contents ,entry))))
 201           (entry-h (+ (* number-of-elements (text-size ,entry)) (* 2 (margin ,entry))))
 202           (entry-w (+ (* maximum-letters (text-size ,entry)) (* (margin ,entry))))
 203           )
 204      (when (> entry-x (- *window-width* entry-w))
 205        (setf entry-x (- entry-x entry-w)))
 206      (when (> entry-y (- *window-height* entry-h))
 207        (setf entry-y (- entry-y entry-h)))
 208      (sdl2:set-render-draw-color ,renderer 255 255 255 255)
 209      (sdl2:render-fill-rect ,renderer (arrange-rect entry-x entry-y entry-w entry-h))
 210      (tr-write (title ,entry)
 211                (+ entry-x (margin ,entry))
 212                (+ entry-y (margin ,entry))
 213                (text-size ,entry)
 214                (text-size ,entry)
 215                ,renderer
 216                )
 217      ;; FIXME: to complete with the actual menu
 218      )
 219   )
 220
 221 (defun select-entry (renderer entry)
 222   "given the renderer and an entry, returns the option pressed or return nil if
 223 nothing was pressed"
 224   nil)
 225
 226 (defgeneric click-event (entry coordinates)
 227   (:documentation "this function is activated when the
 228 mouse/cursor is pressed with a entry active. From here the method can execute
 229 command and destroy itself by returning nil. The destruction has to be handled
 230 by whatever call the entry event"))
 231
 232 ;; NOTE: test if the mouse-state-p is enought, to get to this method is a long
 233 ;; run and it could be that mouse-state-p has changed from when was triggered
 234 (defmethod click-event ((entry entry) coordinates)
 235   "event for mouse/cursor action. This function applies events on an element of a
 236 list"
 237   'destroy
 238   )