;;;; You should have received a copy of the GNU General Public License
;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-(in-package :graphics)
+(defpackage :rulp.entries
+ (:use :cl)
+ (:export *entries-list* push pop entry x y width height rectangle click-event
+ render-entry make-plist))
-(defgeneric entry-width (y))
-(defgeneric entry-height (y))
-(defgeneric entry-rectangle (y))
+(in-package :rulp.entries)
+
+(defparameter *entries-list* nil
+ "List of entries, menues who are generated into the window with options")
+
+(defgeneric x (entry))
+(defgeneric y (entry))
+(defgeneric width (entry))
+(defgeneric height (entry))
+(defgeneric rectangle (entry))
(defclass entry ()
- ((coordinate :accessor coordinate
- :initarg :coordinate
- :initform '(0 . 0)
- :documentation "the starting position of the entry generation"
- :type list)
+ ((coordinates :accessor coordinates
+ :initarg :coordinates
+ :initform '(0 . 0)
+ :documentation "the starting position of the entry generation"
+ :type list)
(title :accessor title
:initarg :title
- :initform ""
+ :initform "custom"
:documentation "title for the entry")
- (text-size :accessor text-size
- :initarg :text-size
- :initform 30
- :type number
- :documentation "the font size in the entry")
+ (margin :accessor margin
+ :initarg :margin
+ :initform 5
+ :type number
+ :documentation "the margin between the content and the borders of the rectangle")
+ (padding :accessor padding
+ :initarg :padding
+ :initform 0
+ :type number
+ :documentation "the padding between the coordinates and the borders")
+ (action :accessor action
+ :initarg :action
+ :initform nil
+ :documentation "action when pressed")
(contents :accessor contents
- :initarg :contents
- :initform nil
- :type list
- :documentation "alist containing entry name and related action")))
+ :initarg :contents
+ :initform nil
+ :type list
+ :documentation "a list of other entries")
+ (text-size :accessor size
+ :initarg :size
+ :initform 20
+ :type number)
+ (content-orientation :accessor orientation
+ :initarg :orientation
+ :initform :v
+ :documentation "when :v the contents and title
+are displaced vertically, when :h the contents are horizontally displayed")))
+
+(defmethod x ((entry entry))
+ (car (coordinates entry)))
+
+(defmethod y ((entry entry))
+ (cdr (coordinates entry)))
+
+;; (defmethod width ((entry entry))
+;; 200)
+
+;; (defmethod height ((entry entry))
+;; 200)
+
+(defun width-vertical (plist)
+ (let* ((i 0))
+ (labels ((operation (element)
+ (setf i (max i (length (getf element :title)))) ; FIXME: add padding
+ (loop :for x :in (getf element :contents)
+ :do (operation x))
+ ))
+ (operation plist))
+ i
+ ))
+
+(defun width-horizontal (plist)
+ (let* ((i 0))
+ (labels ((operation (element)
+ (incf i (length (getf element :title)))
+ (loop :for x :in (getf element :contents)
+ :do (operation x))
+ ))
+ (operation plist))
+ i
+ ))
+
+(defun height-vertical (plist)
+ (let* ((i 0))
+ (labels ((operation (element)
+ (1+ i)
+ (loop :for x :in (getf element :contents)
+ :do (operation x))
+ ))
+ (operation plist))
+ i
+ ))
-(defmethod entry-width ((y entry))
- "give the length of the longest menu entry, useful for creating a box containing them all"
- (reduce #'max (loop :for content :in (contents y)
- :collect (length (car content)))))
+(defun height-horizontal (plist) 1)
-(defmethod entry-height ((y entry))
- "give the number of entries, useful for creating a box containing them all"
- (length (contents y)))
+;; (defmethod width ((entry entry))
+;; "give the length of the longest menu entry, useful for creating a box containing them all"
+;; (reduce #'max (loop :for content :in (contents entry))))
-(defmethod entry-rectangle ((y entry))
+;; (defmethod height ((entry entry))
+;; "give the number of entries, useful for creating a box containing them all"
+;; (length (contents entry)))
+
+(defmethod rectangle ((entry entry))
(flet ((on-size (a) (* a (text-size y))))
- (sdl2:make-rect (car (coordinate y))
- (cdr (coordinate y))
+ (sdl2:make-rect (x entry)
+ (y entry)
(on-size (entry-width y))
- (on-size (entry-height y)))))
+ )))
+
+;; NOTE: this method makes the entry class totally useless. It is possible
+;; to replace entries with these plists and use them directly with the macro
+(defmethod make-plist ((entry entry))
+ (list ':entry 'entry
+ ':title (title entry)
+ ':coordinates (coordinates entry)
+ ':padding (padding entry)
+ ':margin (margin entry)
+ ':text-size (size entry)
+ ':action (action entry)
+ ':contents (contents entry)
+ ':orientation (orientation entry))
+ )
+;; NOTE: The idea of replacing the whole class idea with the plist system makes
+;; room for special functions that can create rectangles out of the correct size,
+;; can adjust the text and aid the macro in the rendering process.
+
+(defun n-letter-content (pair)
+ "given a list of two elements, one a string and the other a generic symbol, it returns the
+length of the string. This is used in display-entry, where it is used to find
+the maximum size of a list of options to make the correct dimension for the entry"
+ (length (car pair)))
+
+(defun keep-inside (position size limit)
+ (if (> position (- limit size))
+ (- position size)
+ position
+ ))
+
+(defmacro render-entry (renderer plist)
+ `(let* ((entry-margin (if (numberp (getf ,plist :margin)) (getf ,plist :margin) 0))
+ (entry-padding (if (numberp (getf ,plist :padding)) (getf ,plist :padding) 0))
+ (entry-size (getf ,plist :text-size)) ; NOTE: make error checking instead of redefinition
+ (entry-x (+ entry-margin (car (getf ,plist :coordinates))))
+ (entry-y (+ entry-margin (cdr (getf ,plist :coordinates))))
+ (entry-w (if (eq (getf ,plist :orientation) 'v)
+ (width-vertical ,plist)
+ (width-horizontal ,plist)))
+ (entry-h (if (eq (getf ,plist :orientation) 'v)
+ (height-vertical ,plist)
+ (height-horizontal ,plist))))
+ (setf entry-x (keep-inside entry-x entry-w rulp.graphics:*window-width*))
+ (setf entry-y (keep-inside entry-y entry-h rulp.graphics:*window-height*)) ; BUG: doesn't seems to work
+ ;; (when (> entry-x (- rulp.graphics:*window-width* entry-w))
+ ;; (setf entry-x (- entry-x entry-w)))
+ ;; (when (> entry-y (- rulp.graphics:*window-height* entry-h))
+ ;; (setf entry-y (- entry-y entry-h)))
+ (sdl2:set-render-draw-color ,renderer 255 255 255 255)
+ (sdl2:render-fill-rect ,renderer (rulp.graphics:arrange-rect
+ entry-x
+ entry-y
+ (+ (* 2 entry-padding) (* entry-w entry-size))
+ (+ (* 2 entry-padding) (* entry-h entry-size)))) ; FIXME: fixed size font
+ ;; NOTE: temporary solution, to be extended with the content-rendering
+ ;; function into a rendering engine for nested schemas
+ (sdl2:set-render-draw-color ,renderer 0 0 0 255)
+ (rulp.graphics:tr-write (getf ,plist :title)
+ (+ entry-x entry-padding)
+ (+ entry-y entry-padding)
+ entry-size
+ entry-size
+ ,renderer)
+ ;; FIXME: continue with contents
+ ))
+
+(defmacro display-entry (renderer entry)
+ "macro for creating the actual menu given the renderer and the entry"
+ `(let* ((entry-x (+ (car (coordinate ,entry)) (padding ,entry)))
+ (entry-y (+ (cdr (coordinate ,entry)) (padding ,entry)))
+ (maximum-letters (apply #'max (cons (length (title ,entry)) (mapcar #'n-letter-content (contents ,entry)))))
+ (number-of-elements (1+ (length (contents ,entry))))
+ (entry-h (+ (* number-of-elements (text-size ,entry)) (* 2 (margin ,entry))))
+ (entry-w (+ (* maximum-letters (text-size ,entry)) (* (margin ,entry))))
+ )
+ (when (> entry-x (- *window-width* entry-w))
+ (setf entry-x (- entry-x entry-w)))
+ (when (> entry-y (- *window-height* entry-h))
+ (setf entry-y (- entry-y entry-h)))
+ (sdl2:set-render-draw-color ,renderer 255 255 255 255)
+ (sdl2:render-fill-rect ,renderer (arrange-rect entry-x entry-y entry-w entry-h))
+ (tr-write (title ,entry)
+ (+ entry-x (margin ,entry))
+ (+ entry-y (margin ,entry))
+ (text-size ,entry)
+ (text-size ,entry)
+ ,renderer
+ )
+ ;; FIXME: to complete with the actual menu
+ )
+ )
+
+(defun select-entry (renderer entry)
+ "given the renderer and an entry, returns the option pressed or return nil if
+nothing was pressed"
+ nil)
+
+(defgeneric click-event (entry coordinates)
+ (:documentation "this function is activated when the
+mouse/cursor is pressed with a entry active. From here the method can execute
+command and destroy itself by returning nil. The destruction has to be handled
+by whatever call the entry event"))
+
+;; NOTE: test if the mouse-state-p is enought, to get to this method is a long
+;; run and it could be that mouse-state-p has changed from when was triggered
+(defmethod click-event ((entry entry) coordinates)
+ "event for mouse/cursor action. This function applies events on an element of a
+list"
+ 'destroy
+ )
OSDN Git Service
