1 ;;;; Ru*** roLeplay Playground virtual tabletop
2 ;;;; Copyright (C) 2022 Zull
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.
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.
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/>.
17 (defpackage :rulp.entries
19 (:export *entries-list* push pop entry x y width height rectangle click-event
20 render-entry make-plist))
22 (in-package :rulp.entries)
24 (defparameter *entries-list* nil
25 "List of entries, menues who are generated into the window with options")
27 (defgeneric rectangle (entry))
30 ((coordinates :accessor coordinates
33 :documentation "the starting position of the entry generation"
35 (title :accessor title
38 :documentation "title for the entry")
39 (margin :accessor margin
43 :documentation "the margin between the content and the borders of the rectangle")
44 (padding :accessor padding
48 :documentation "the padding between the coordinates and the borders")
49 (action :accessor action
52 :documentation "action when pressed")
53 (contents :accessor contents
57 :documentation "a list of other entries")
58 (text-size :accessor size
62 (content-orientation :accessor orientation
65 :documentation "when :v the contents and title
66 are displaced vertically, when :h the contents are horizontally displayed")))
68 (defmethod x ((obj entry))
69 (car (coordinates obj)))
71 (defmethod y ((obj entry))
72 (cdr (coordinates obj)))
74 ;; (defmethod width ((entry entry))
77 ;; (defmethod height ((entry entry))
80 (defun width-vertical (plist)
82 (labels ((operation (element)
83 (setf i (max i (length (getf element :title)))) ; FIXME: add padding
84 (loop :for x :in (getf element :contents)
91 (defun width-horizontal (plist)
93 (labels ((operation (element)
94 (incf i (length (getf element :title)))
95 (loop :for x :in (getf element :contents)
102 (defun height-vertical (plist)
104 (labels ((operation (element)
106 (loop :for x :in (getf element :contents)
113 (defun height-horizontal (plist) 1)
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))))
119 ;; (defmethod height ((entry entry))
120 ;; "give the number of entries, useful for creating a box containing them all"
121 ;; (length (contents entry)))
123 (defmethod rectangle ((entry entry))
124 (flet ((on-size (a) (* a (text-size y))))
125 (sdl2:make-rect (x entry)
127 (on-size (entry-width y))
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))
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))
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.
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"
153 (defun keep-inside (position size limit)
154 (if (> position (- limit size))
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
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)
192 ;; FIXME: continue with contents
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))))
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))
217 ;; FIXME: to complete with the actual menu
221 (defun select-entry (renderer entry)
222 "given the renderer and an entry, returns the option pressed or return nil if
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"))
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