From: Giulio De Stasio Date: Sun, 8 Jan 2023 21:17:50 +0000 (+0100) Subject: core.lisp: created cli interface and json maps X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;h=2c8c31cd232606b3550c565033487eceb45db886;p=rulp%2Frulp.git core.lisp: created cli interface and json maps --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..a711d7a --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +TAGS +.hg/* +.hgignore +TODOs.org +*.~undo-tree~ +lab/* +*.orig +rulp diff --git a/Makefile b/Makefile index c62504d..d213e0f 100644 --- a/Makefile +++ b/Makefile @@ -13,21 +13,9 @@ DEBIAN-PATH = $(OUTPUT)_$(VERSION)_$(ARCH) # check if RPM_BUILD_ROOT consider also a / at the end or not all: $(OUTPUT) + $(CL) --load system.asd --eval "(progn (require :rulp) (asdf:make :rulp))" $(info "all done") -$(OUTPUT): - $(BUILD) --asdf-tree ~/quicklisp/dists/ \ - --load system.asd \ - --load-system rulp \ - --eval '(defparameter parameters:*rulp-version* "$(VERSION)")' \ - --eval '(defparameter parameters:*rulp-arch* "$(ARCH)")' \ - --eval '(defparameter parameters:*rulp-system* "$(SYSTEM)")' \ - --eval '(defparameter parameters:*rulp-share* "$(SHARE-PATH)")' \ - --eval '(defparameter parameters:*rulp-local* "$(LOCAL-PATH)")' \ - --entry core:main \ - --output $@ -# $(CL) --load system.asd --eval "(progn (require :rulp) (asdf:make :rulp))" - install: install -m 755 $(OUTPUT) $(INSTALL-PATH)/bin/$(OUTPUT) install -m 644 /documentation/* $(DOC-PATH)/ diff --git a/core.lisp b/core.lisp index f739442..fad577b 100644 --- a/core.lisp +++ b/core.lisp @@ -3,25 +3,153 @@ (defparameter *screen-width* 1000) (defparameter *screen-height* 750) -;; apply to load and save +;; Parse json maps +;; here there are the functions that would parse the files. +;; this is useful so it is possible to have all the informations +;; saved in one file. -(defun main () - (let ((name (format nil "Ru*** roLeplay Playground v~A" parameters:*rulp-version*))) +(defun test-correctness-required (file extension) + (unless (probe-file file) + (error "File \"~A\" not found, exits~%" file)) ; test existance + (unless (equal (pathname-type file) extension) + (error "File \"~A\" is not \"~A\", exits~%" file extension)) ; map file is json + t) + +(defun test-correctness-optional (file extension) + (when file + (unless (probe-file file) + (error "File \"~A\" not found, exits~%" file)) ; test existance + (unless (equal (pathname-type file) extension) + (error "File \"~A\" is not \"~A\", exits~%" file extension)) ; map file is json + ) + t) + +;; RULP command +;; This is the main command "rulp", it includes the +;; global options and the subcommands +(defun rulp/handler (cmd) + (clingon:print-usage-and-exit cmd t)) + +(defun rulp/command () + (clingon:make-command + :name "rulp" + :version "0.0.1" + :description "Roleplay playground" + :authors '("Giulio 'Zull' De Stasio ") + :usage "[-i INITFILE] COMMAND" + :license "GPLv3" + :handler #'rulp/handler + :options (rulp/options) + :sub-commands (rulp/sub-commands))) + +(defun rulp/options () + (list + (clingon:make-option :counter + :description "get a verbose output on STDOUT" + :short-name #\v + :long-name "verbose" + :key :rulp/verbose) + (clingon:make-option :string + :description "manually select init file, by default it uses init.lisp" + :short-name #\i + :long-name "init" + :key :rulp/initfile) + )) + +(defun rulp/sub-commands () + "list of the subcommands of rulp" + (list + (view/command) + (editor/command))) + +;; VIEW command +;; this section is for the view/playground. The standard +;; mode of use. This command include the basic functions like include +;; a map and informations about software/hardware rendering +(defun view/options () + "options for the view command" + (list + (clingon:make-option :string + :description "Select the map to load (in JSON format)" + :short-name #\m + :required t + :long-name "map" + :key :view/map) + (clingon:make-option :counter + :description "select software rendering (not working)" + :long-name "software" + :key :view/software) + )) + +(defun view/command () + "create the view command" + (clingon:make-command + :name "view" + :usage "[-s] -m ..." + :description "start the rulp map visualization" + :options (view/options) + :handler #'view/handler + :examples '(("rulp view -m base.json") ("rulp view -m base.json -i newinit.lisp"))) + ) + +(defun view/handler (cmd) + "handling the view" + (let ((mapfile (clingon:getopt cmd :view/map)) + (initfile (clingon:getopt cmd :rulp/initfile)) + (software (clingon:getopt cmd :view/software)) + (name (format nil "Ru*** roLeplay Playground v~A" parameters:+rulp-version+))) + (test-correctness-required mapfile "json") + (test-correctness-optional initfile "lisp") (format t "rulp-~A on ~A-~A~%" - parameters:*rulp-version* - parameters:*rulp-system* - parameters:*rulp-arch*) - (load "init.lisp" :if-does-not-exist nil) - ;; (graphics:playground *screen-width* *screen-height* name) - (bt:make-thread (lambda () (graphics:playground *screen-width* *screen-height* name))) -; (gui:lobby) + parameters:+rulp-version+ + parameters:+rulp-system+ + parameters:+rulp-type+) + (if initfile (load initfile) (load "init.lisp" :if-does-not-exist nil)) + (setf graphics:+plane+ (create-plane-from-json mapfile)) + (graphics:playground name))) + +;; EDITOR command +;; this section modify the view to create a functional +;; map editor. It create a map, collisions and interactive objects +;; to be used later on view mode +(defun editor/options () + (list + (clingon:make-option :string + :description "select map to edit" + :short-name #\m + :long-name "map" + :key :editor/map))) + +(defun editor/command () + (clingon:make-command + :name "editor" + :usage "-m " + :description "start the editor with the selected map" + :options (editor/options) + :handler #'editor/handler + :examples '("rulp editor -m base.png"))) + +(defun editor/handler (cmd) + (let ((selected-map (clingon:getopt cmd :editor/map)) + (selected-init (clingon:getopt cmd :rulp/initfile))) + (format t "test ~A and ~A~%" selected-map selected-init))) + +(defun main () + (let ((rulp-sys (rulp/command))) + (clingon:run rulp-sys) ) - ;(bt:make-thread (lambda () (lobby:editor-gui))) ;; here bt-thread it is just used for execute ltk without troubles - ;; for now it is disabled -; (graphics:add-plane (make-instance 'layers:plane :image (truename "media/board.tga"))) + ) -; (graphics:add-entity (make-instance 'layers:entity :img-path (truename "media/test.png") :size 1)) +;; "Ru■■■ Lisp Playground" -; (bt:make-thread (lambda () (graphics:playground *screen-width* *screen-height* "Ru*** Lisp Playground"))) -) - ;; "Ru■■■ Lisp Playground" +(defun start-pipe (mapfile &optional initfile) + (test-correctness-required mapfile "json") + (test-correctness-optional initfile "lisp") + (format t "rulp-~A on ~A-~A~%" + parameters:+rulp-version+ + parameters:+rulp-system+ + parameters:+rulp-type+) + (if initfile (load initfile) (load "init.lisp" :if-does-not-exist nil)) + (setf graphics:+plane+ (create-plane-from-json mapfile)) + (graphics:playground (format nil "RULP start-pipe")) + ) diff --git a/data.lisp b/data.lisp index 10f7e8a..68d1fc7 100644 --- a/data.lisp +++ b/data.lisp @@ -15,7 +15,26 @@ ;;;; along with this program. If not, see . (in-package :core) +(defun decode-from-json (json-file) + "take a json file path and decode it" + (with-open-file (json-stream json-file) + (json:decode-json json-stream))) +;; this definition is hard coded, when planes will change this +;; function needs to be edited alike. Look for a better and +;; auto modifiable solution. +(defun create-plane-from-json (json-file) + "take a parsed alist and create a plane on those specs" + (let* ((json-position (make-pathname :directory (pathname-directory json-file))) + (alist (decode-from-json json-file)) + (img-path (if (assoc ':image-path alist) + (merge-pathnames json-position (cdr (assoc ':image-path alist))) + (error "Image-path missing from \"~A\", exits~%" json-file))) + (img-path (merge-pathnames json-position (cdr (assoc ':image-path alist)))) + (ret (make-instance 'layers:plane :image img-path))) + (when (assoc ':size alist) (setf (layers:size ret) (cdr (assoc ':size alist)))) + (when (assoc ':grid-dimension alist) (setf (layers:grid-dimension ret) (cdr (assoc ':grid-dimension alist)))) + ret)) ;; posso usare le hash piuttosto che interpretarlo sul momento. Infatti creerò un metodo che ;; analizza json e lo traduce in una tabella hash e una funzione che prende la hash e crea diff --git a/graphics/grid.lisp b/graphics/grid.lisp index dd90454..e2a11ac 100644 --- a/graphics/grid.lisp +++ b/graphics/grid.lisp @@ -48,8 +48,8 @@ (defmacro grid-render (renderer plane &optional (r 0) (g 0) (b 0)) `(let ((x-offset (x ,plane)) (y-offset (y ,plane)) - (x-iterations (/ width (grid-dimension ,plane))) - (y-iterations (/ height (grid-dimension ,plane))) + (x-iterations (/ *window-width* (grid-dimension ,plane))) + (y-iterations (/ *window-height* (grid-dimension ,plane))) (grid-spacing (grid-dimension ,plane))) (progn (sdl2:set-render-draw-color ,renderer ,r ,g ,b 255) @@ -59,14 +59,14 @@ (+ (* i grid-spacing) x-offset) y-offset (+ (* i grid-spacing) x-offset) - (+ (height ,plane) y-offset)) + (+ *window-height* y-offset)) ) (loop :for j :from 1 :to y-iterations :do (sdl2:render-draw-line ,renderer x-offset (+ (* j grid-spacing) y-offset) - (+ (width ,plane) x-offset) + (+ *window-width* x-offset) (+ (* j grid-spacing) y-offset)) )) (sdl2:set-render-draw-color ,renderer 0 0 0 255) @@ -75,8 +75,8 @@ (defmacro indexes-render (renderer plane &optional (r 0) (g 0) (b 0)) `(let ((x-offset (x ,plane)) (y-offset (y ,plane)) - (x-iterations (/ width (grid-dimension ,plane))) - (y-iterations (/ height (grid-dimension ,plane))) + (x-iterations (/ *window-width* (grid-dimension ,plane))) + (y-iterations (/ *window-height* (grid-dimension ,plane))) (grid-spacing (grid-dimension ,plane))) (loop :for k :from 0 :to x-iterations :do (loop :for l :from 0 :to y-iterations diff --git a/graphics/inputs.lisp b/graphics/inputs.lisp index 6212224..eb91754 100644 --- a/graphics/inputs.lisp +++ b/graphics/inputs.lisp @@ -18,6 +18,9 @@ (defparameter +mode+ '+normal-mode+) +(defgeneric select-entry (x y p) + (:documentation "operate with menues, create them, destroy them and apply them")) + (defgeneric activate (x y pressed p) (:documentation "given x y and the button pressed it do actions")) @@ -28,6 +31,19 @@ (apply (cadr key) `(,x ,y ,p)) ))) +(defmethod select-entry (x y (p t)) + "generic version, does nothing" + nil) + +(defmethod select-entry (x y (p plane)) + "starts from plane, it search for entities or entries and then redirect +to the correct method" + (select-entry (x y (find-on-plane x y p))) + ) + +(defmethod select-entry (x y (p entity)) + "an entity is selected" + ) (defmethod select-pointer (x y (p plane)) "with left button it select and deselect entities the map-gplane contain" @@ -40,7 +56,7 @@ (when (sdl2:has-intersect mouse-point (screen-destination obj p)) (setf *pointer* obj-nth))) - )) + )) (defmethod move-entity (x y (p plane)) "with right button it move the entity around the plane" diff --git a/graphics/menu.lisp b/graphics/menu.lisp index a0897d1..efe4fdf 100644 --- a/graphics/menu.lisp +++ b/graphics/menu.lisp @@ -1,51 +1,58 @@ +;;;; Ru*** roLeplay Playground virtual tabletop +;;;; Copyright (C) 2022 Zull +;;;; +;;;; This program is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see . + (in-package :graphics) -(defparameter +menu-position+ nil) -(defparameter +menu-padding-x+ 300) -(defparameter +menu-padding-y+ 30) +(defgeneric entry-width (y)) +(defgeneric entry-height (y)) +(defgeneric entry-rectangle (y)) -(defparameter +menu+ (list - '(t "Toggle letters" (toggle-grid-letters)) - '(t "Toggle grid" (toggle-grid)) - '(+pointer+ "Move" nil) - )) +(defclass entry () + ((coordinate :accessor coordinate + :initarg :coordinate + :initform '(0 . 0) + :documentation "the starting position of the entry generation" + :type list) + (title :accessor title + :initarg :title + :initform "" + :documentation "title for the entry") + (text-size :accessor text-size + :initarg :text-size + :initform 30 + :type number + :documentation "the font size in the entry") + (contents :accessor contents + :initarg :contents + :initform nil + :type list + :documentation "alist containing entry name and related action"))) -(defun display-menu (position) - (when (null +menu-position+) - (setf +menu-position+ position)) - (let ((menu-length (length +menu+))) - (raylib:draw-rectangle-v +menu-position+ - (make-vector2 :x +menu-padding-x+ :y (* menu-length +menu-padding-y+)) - raylib:+white+) - (loop :for e :in +menu+ - :for n :from 0 :to (length +menu+) - :do - (when (eval (car e)) - (raylib:draw-text (cadr e) - (floor (raylib:vector2-x +menu-position+)) - (floor (+ (raylib:vector2-y +menu-position+) (* n +menu-padding-y+))) - 30 - raylib:+black+))) - )) +(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 select-menu (position) - (let* (;(position-x (raylib:vector2-x position)) - (position-y (raylib:vector2-y position)) - (relative-y (- position-y (raylib:vector2-y +menu-position+))) - (value (floor (/ relative-y +menu-padding-y+))) - ) - (when (and (> value -1) (< value (length +menu+))) - (when (eval (car (nth value +menu+))) - (eval (caddr (nth value +menu+))))) - (setf +menu-position+ nil) - (setf +mode+ '+normal-mode+))) +(defmethod entry-height ((y entry)) + "give the number of entries, useful for creating a box containing them all" + (length (contents y))) -;; The menu (kinda) works -;; There are two functions in this file: the display-menu function and the select-menu function. -;; The first is enabled when +menu-mode+ is active and display the menu with it's entries. Select-menu -;; on the other end check if select-menu is pressing something and eval the associated function. -;; in the +menu+ parameter it is possible to add everything in a specific pattern: -;; -;; The first is the condition, if this is t the option is displayed and usable -;; the second is the entry text, if the condition is t the entry text is displayed -;; the third is the eval expression, when pressed the entry this form is evaluated +(defmethod entry-rectangle ((y entry)) + (flet ((on-size (a) (* a (text-size y)))) + (sdl2:make-rect (car (coordinate y)) + (cdr (coordinate y)) + (on-size (entry-width y)) + (on-size (entry-height y))))) diff --git a/graphics/package.lisp b/graphics/package.lisp index e0ae234..dc7efe8 100644 --- a/graphics/package.lisp +++ b/graphics/package.lisp @@ -22,7 +22,9 @@ (in-package :graphics) -(defparameter +plane+ nil) +(defparameter +plane+ nil + "the rendered plane, this variable contain the plane which is gonna be presented +into the main window") (defparameter *renderer* nil "a variable containing the tool to render textures to screen, this is associated @@ -52,18 +54,28 @@ they restart from the beginning" will be used to create text on screen by applying the single letters with render-copy") -(defparameter +mouse-button-left+ 1) -(defparameter +mouse-button-right+ 3) -(defparameter +mouse-button-middle+ 2) +(defparameter +mouse-button-left+ 1 "this binds the left button") +(defparameter +mouse-button-right+ 3 "this binds the right button") +(defparameter +mouse-button-middle+ 2 "this binds the scroll button") (defparameter *mouse-keybinds* (list '(+mouse-button-left+ select-pointer) '(+mouse-button-right+ move-entity) ) - "this is a list of actions connected to mouse presses, this can be edited -here if needed" + "This list associate the button presses to a certain action, the action is evaluated +as shown in graphics/input.lisp" ) -(defparameter *is-grid* t) -(defparameter *is-indexes* t) +(defparameter *is-grid* t + "Parameter for displaying the grid, when nil it does not display a grid, when t +it display a grid as defined by the +plane+") +(defparameter *is-indexes* t + "Parameter for displaying the indexes, when nil it does not display them, when t +it uses the grid to create a chessboard like indexes") + +(defparameter *entries-list* nil + "List of entries, menues who are generated into the window with options") + +(defparameter *window-width* 1001) +(defparameter *window-height* 750) diff --git a/graphics/render.lisp b/graphics/render.lisp index 927f421..0447bf7 100644 --- a/graphics/render.lisp +++ b/graphics/render.lisp @@ -23,9 +23,18 @@ (cons (car list) (remove-nth (1- k) (cdr list))) ))) -(defun make-grid (width height span) +(defun make-grid (span) "create a square grid" - (loop :for i :from 0 :to width :by span - :do (sdl2:render-draw-line *renderer* i 0 i height)) - (loop :for j :from 0 :to height :by span - :do (sdl2:render-draw-line *renderer* 0 j width j))) + (loop :for i :from 0 :to *window-width* :by span + :do (sdl2:render-draw-line *renderer* i 0 i *window-height*)) + (loop :for j :from 0 :to *window-height* :by span + :do (sdl2:render-draw-line *renderer* 0 j *window-width* j))) + +(defun find-on-plane (x y plane) + "find the entity in real-coordinates (x,y) in plane" + (let ((mouse-point (sdl2:make-rect (- x 2) (- y 2) 2 2)) + (entities (entities-list plane))) + (loop :for entity :in entities + :do (when (sdl2:has-intersect mouse-point + (screen-destination entity plane)) + entity)))) diff --git a/graphics/view.lisp b/graphics/view.lisp index 07b8944..d4fdecc 100644 --- a/graphics/view.lisp +++ b/graphics/view.lisp @@ -21,8 +21,8 @@ | ------------------------------------------- |# -(defmacro with-playground ((window renderer &key (title "RuLP") (width 740) (height 480)) &body body) - `(sdl2:with-window (,window :title title :w width :h height :flags '(:resizable)) +(defmacro with-playground ((window renderer &key (title "RuLP")) &body body) + `(sdl2:with-window (,window :title title :w *window-width* :h *window-height* :flags '(:resizable)) (sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated :presentvsync)) ;later add delta (sdl2-image:init '(:png :jpg)) (sdl2-ttf:init) @@ -31,19 +31,14 @@ (sdl2-image:quit) ))) -;(defparameter +grid-span+ 50) - ;; renderer exists only inside this function, so you cannot create a texture outside ;; (at least for now), more on this later os -(defun playground (width height title &optional (fps 60) (debug-info nil)) +(defun playground (title &optional (fps 60) (debug-info nil)) (sdl2:with-init (:video) - (with-playground (window *renderer* :title title :width width :height height) + (with-playground (window *renderer* :title title) (setf *tr-texture* (let* ((font (sdl2-ttf:open-font "media/IBMPlex.ttf" 100)) ;; this line throw fault, works anyway - (font-surface (sdl2-ttf:render-text-solid font - *tr-string* - 0 0 0 0)) - (font-texture (sdl2:create-texture-from-surface *renderer* - font-surface))) + (font-surface (sdl2-ttf:render-text-solid font *tr-string* 0 0 0 0)) + (font-texture (sdl2:create-texture-from-surface *renderer* font-surface))) (sdl2:free-surface font-surface) font-texture)) (sdl2:with-event-loop (:method :poll) @@ -52,9 +47,14 @@ (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-q) (format t "pressed q~%"))) (:mousebuttondown (:x x :y y :state state) - (activate x y state +plane+)) + (loop :for key :in *mouse-keybinds* + :do (when (sdl2:mouse-state-p (eval (car key))) + (apply (cadr key) `(,x ,y ,+plane+)))) + (when +plane+ + (activate x y state +plane+))) (:idle () ;; clean window texture + (sdl2:set-render-draw-color *renderer* 0 0 0 255) (sdl2:render-clear *renderer*) (when +plane+ (sdl2:render-copy *renderer* (texture +plane+) @@ -78,7 +78,23 @@ (sdl2:set-render-draw-color *renderer* 128 250 33 255) (let ((select-rectangle (screen-destination (nth *pointer* (entities-list +plane+)) +plane+))) (sdl2:render-draw-rect *renderer* select-rectangle)) - (sdl2:set-render-draw-color *renderer* 0 0 0 255) ) + ;; entries generation + (loop :for entry :in (reverse *entries-list*) + :do (sdl2:set-render-draw-color *renderer* 255 255 255 255) + (sdl2:render-fill-rect *renderer* (entry-rectangle entry)) + (sdl2:set-render-draw-color *renderer* 0 0 0 255) + (loop :for content :in (contents entry) + :for content-position :from 0 :to (length (contents entry)) + :do (tr-write (car content) + (car (coordinate entry)) + (+ (* content-position (text-size entry)) (cdr (coordinate entry))) + (text-size entry) (text-size entry) *renderer* + )) + ) (sdl2:render-present *renderer*) + ;; updating grids and dimension + (multiple-value-bind (new-width new-height) (sdl2:get-window-size window) + (setf *window-width* new-width) + (setf *window-height* new-height)) ))))) diff --git a/layers/interactions.lisp b/layers/interactions.lisp index b5a3f66..3f5892b 100644 --- a/layers/interactions.lisp +++ b/layers/interactions.lisp @@ -4,9 +4,13 @@ (:documentation "check what actions entities can do and return an alist with a lambda associated")) -(defgeneric movep (e p)) +(defgeneric movep (e p) + (:documentation "the movement function check if the entity can move and then create +a lambda function for the movement action")) (defgeneric usep (e p)) -(defgeneric pokep (e p)) +(defgeneric pokep (e p) + (:documentation "dummy function to test the interaction system, as every function +it can be redefined for whatever reason")) (defmethod interact ((e t) p) "this function returns an associated list of actions the model can take." diff --git a/layers/models.lisp b/layers/models.lisp index 3eabd76..3e3b312 100644 --- a/layers/models.lisp +++ b/layers/models.lisp @@ -8,17 +8,19 @@ :documentation "name of the model, it will be transfered to the entity when generated" :initform "noname" :type string) - (movement :accessor movement - :initarg :movement - :documentation "the speed of the model, it can be used in various ways depending on the game" - :initform 6.0) + (properties :accessor properties + :initarg :properties + :documentation "an a-list of the properties of the entity" + :initform nil) (size :accessor size :initarg :size :documentation "the size of a model, it will be calculated with the grid for the dimension in board" :type integer :initform 1) - (interactions :initform '(movep usep pokep) + (interactions :initform '(pokep) :accessor interactions + :documentation "interactions are function the entity can use, these are +associated with some property" :initarg :interactions) )) @@ -27,6 +29,43 @@ (let* ((return-entity m)) (make-instance 'entity :name (name m) - :movement (movement m) + :propreties (propreties m) :size (size m) :interactions (interactions m)))) + +;; the dice set, this has many uses, it is called by +;; interactions when actions are done, it is called +;; on entity creation for life randomization (the +;; create-entity function eval the supplied data) +(defun dice (dice-type number-dices &key (plus 0)) + "throw the dice-type n times based on number-dices" + (+ 1 plus (loop :for i :from 1 :to number-dices + :sum (random dice-type)))) + +(defun d4 (number-dices &key (plus 0)) + "shortcut for the dice function with d4" + (dice 4 number-dices :plus plus)) +(defun d6 (number-dices &key (plus 0)) + "shortcut for the dice function with d6" + (dice 6 number-dices :plus plus)) +(defun d8 (number-dices &key (plus 0)) + "shortcut for the dice function with d8" + (dice 8 number-dices :plus plus)) +(defun d10 (number-dices &key (plus 0)) + "shortcut for the dice function with d10" + (dice 10 number-dices :plus plus)) +(defun d12 (number-dices &key (plus 0)) + "shortcut for the dice function with d12" + (dice 12 number-dices :plus plus)) +(defun d20 (number-dices &key (plus 0)) + "shortcut for the dice function with d20" + (dice 20 number-dices :plus plus)) +(defun d100 (number-dices &key (plus 0)) + "shortcut for the dice function with d100" + (dice 100 number-dices :plus plus)) + +(defun dice-from-list (list-dices &key (plus 0)) + "throw and sums all the dices from a list, the plus modificator +is added once at the end of the sum (Xd4+Yd6+Zd8+...+p)" + (+ 1 plus (loop :for i :in list-dices + :sum (random i)))) diff --git a/layers/package.lisp b/layers/package.lisp index 5774943..bfeb6cf 100644 --- a/layers/package.lisp +++ b/layers/package.lisp @@ -1,6 +1,6 @@ (defpackage :layers (:use :cl) - (:export screen x y width height rotation path texture surface + (:export screen x y width height rotation path texture surface image-path screen-source screen-destination coordinate size model interactions interact movep usep pokep ;; temporaries @@ -8,3 +8,7 @@ entity ball grid-span displayp)) (in-package :layers) + +;; (defparameter entropy 0 +;; "parameter used for the random number generator, this variable is +;; edited every time one of the dX function is used") diff --git a/layers/screens.lisp b/layers/screens.lisp index 6260a1b..6129bf4 100644 --- a/layers/screens.lisp +++ b/layers/screens.lisp @@ -71,18 +71,6 @@ where the screen should be displayed")) ;; this is what's called entity or plane space. Here when the grid is ;; set to 100 the position (6 . 7) means the 6th square horizontally and ;; 7th square vertically, or 600 pixels horiz. and 700 pixels vert. -;(defmethod x ((s screen) &optional (p t)) -; "returns the x position in real space (or in a grid of 1 pixel span)" -; (car (slot-value s 'coordinate))) -;(defmethod y ((s screen) &optional (p t)) -; "returns the y position in real space (or in a grid of 1 pixel span)" -; (cdr (slot-value s 'coordinate))) -;(defmethod width ((s screen) &optional (p t)) -; "returns the width in real space (or in a grid of 1 pixel span)" -; (car (slot-value s 'size))) -;(defmethod height ((s screen) &optional (p t)) -; "returns the height in real space (or in a grid of 1 pixel span)" -; (cdr (slot-value s 'size))) (defmethod x ((s screen)) "returns the x position in real space (or in a grid of 1 pixel span)" (car (slot-value s 'coordinate))) @@ -108,22 +96,13 @@ where the screen should be displayed")) (defmethod initialize-instance :after ((s screen) &rest args) (setf (surface s) (sdl2-image:load-image (slot-value s 'path)))) -;(defmethod source ((s screen)) -; "return the source rectangle, the portion of texture to display (standard all)" -; nil) - (defmethod screen-source ((s screen)) "return the source rectangle, the portion of texture to display (standard all)" nil) -;; the functions x, y, w and h are meant to be tampered with, in the entity this -;; function will be redifined to account for size and grid size, while planes will -;; use the surface width and height -;(defmethod destination ((s screen) &optional (p nil)) -; "returns the destination rectangle, or where the screen should be displayed" -; (sdl2:make-rect (x s p) (y s p) (width s p) (height s p))) - (defmethod screen-destination ((s screen) (p t)) + "Without a plane of reference screens are printed full size offset of x and y +pixels from the upper left angle of the window" (sdl2:make-rect (x s) (y s) (width s) (height s)) ) diff --git a/parameters.lisp b/parameters.lisp index a8e04aa..dcaf388 100644 --- a/parameters.lisp +++ b/parameters.lisp @@ -8,7 +8,7 @@ ;;; page osdn.net/projects/rulp/ (defpackage parameters (:use :cl) - (:export *rulp-version* *rulp-arch* *rulp-system* *rulp-share* *rulp-local*)) + (:export +rulp-version+ +rulp-type+ +rulp-system+ *rulp-share* *rulp-local*)) (in-package :parameters) @@ -20,9 +20,9 @@ ;; parameters surrounded by pluses (+) are seen as costants, therefore ;; they should be seen as fixed variables like version compatibility ;; references and pathfinding strings. -(defparameter *rulp-version* (slot-value (asdf:find-system 'rulp) 'asdf:version)) -(defparameter *rulp-arch* "unknown") -(defparameter *rulp-system* "unknown") +(defparameter +rulp-version+ (slot-value (asdf:find-system 'rulp) 'asdf:version)) +(defparameter +rulp-type+ (machine-type)) +(defparameter +rulp-system+ (software-type)) (defparameter *rulp-share* "./media/") ; remember to close with a slash here (defparameter *rulp-local* ".") ; subject of change diff --git a/rulp.desktop b/rulp.desktop new file mode 100755 index 0000000..a0cc059 --- /dev/null +++ b/rulp.desktop @@ -0,0 +1,10 @@ +[Desktop Entry] +Type=Application +Name=Ru*** roLeplay Playground +GenericName=Roleplay Playground table +Comment=Play a tabletop roleplay game online +Icon=/home/giulio/Lavori/rulp/media/icon.png +Exec=rulp view -m %f +Path=/home/giulio/Lavori/rulp +Categories=Game +Version=0.0.1 diff --git a/start.lisp b/start.lisp index caa19f4..3d621e0 100644 --- a/start.lisp +++ b/start.lisp @@ -1,3 +1,3 @@ (load "system.asd") (require :rulp) -(core:main) +(core::start-pipe "media/test.json") diff --git a/system.asd b/system.asd index 608d8db..232f58a 100644 --- a/system.asd +++ b/system.asd @@ -22,7 +22,7 @@ :build-operation "program-op" :build-pathname "rulp" :entry-point "core:main" - :depends-on ("sdl2" "sdl2-image" "sdl2-ttf" "cffi-libffi" "alexandria" "cl-cffi-gtk" "bordeaux-threads" "bt-semaphore") + :depends-on ("sdl2" "sdl2-image" "sdl2-ttf" "cffi-libffi" "alexandria" "cl-cffi-gtk" "clingon" "cl-json") :components ((:file "parameters") (:module "layers" :serial t @@ -38,6 +38,7 @@ :components ((:file "package") (:file "text-rendering") (:file "render") + (:file "menu") (:file "inputs") (:file "grid") (:file "view")))