OSDN Git Service

core.lisp: created cli interface and json maps
authorGiulio De Stasio <giuliodestasio98@gmail.com>
Sun, 8 Jan 2023 21:17:50 +0000 (22:17 +0100)
committerGiulio De Stasio <giuliodestasio98@gmail.com>
Sun, 8 Jan 2023 21:17:50 +0000 (22:17 +0100)
18 files changed:
.gitignore [new file with mode: 0644]
Makefile
core.lisp
data.lisp
graphics/grid.lisp
graphics/inputs.lisp
graphics/menu.lisp
graphics/package.lisp
graphics/render.lisp
graphics/view.lisp
layers/interactions.lisp
layers/models.lisp
layers/package.lisp
layers/screens.lisp
parameters.lisp
rulp.desktop [new file with mode: 0755]
start.lisp
system.asd

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..a711d7a
--- /dev/null
@@ -0,0 +1,8 @@
+TAGS
+.hg/*
+.hgignore
+TODOs.org
+*.~undo-tree~
+lab/*
+*.orig
+rulp
index c62504d..d213e0f 100644 (file)
--- 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)/
index f739442..fad577b 100644 (file)
--- a/core.lisp
+++ b/core.lisp
 (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 <giuliodestasio98@gmail.com>")
+   :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 <MAP> ..."
+   :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 <MAP>"
+   :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"))
+  )
index 10f7e8a..68d1fc7 100644 (file)
--- a/data.lisp
+++ b/data.lisp
 ;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 (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
index dd90454..e2a11ac 100644 (file)
@@ -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)
                                        (+ (* 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
index 6212224..eb91754 100644 (file)
@@ -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"))
 
              (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"
index a0897d1..efe4fdf 100644 (file)
@@ -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 <https://www.gnu.org/licenses/>.
+
 (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)))))
index e0ae234..dc7efe8 100644 (file)
@@ -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)
index 927f421..0447bf7 100644 (file)
         (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))))
index 07b8944..d4fdecc 100644 (file)
@@ -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)
        (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)
                 (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+)
                  (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))
                )))))
index b5a3f66..3f5892b 100644 (file)
@@ -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."
index 3eabd76..3e3b312 100644 (file)
@@ -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)
    ))
 
   (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))))
index 5774943..bfeb6cf 100644 (file)
@@ -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")
index 6260a1b..6129bf4 100644 (file)
@@ -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))
   )
 
index a8e04aa..dcaf388 100644 (file)
@@ -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 (executable)
index 0000000..a0cc059
--- /dev/null
@@ -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
index caa19f4..3d621e0 100644 (file)
@@ -1,3 +1,3 @@
 (load "system.asd")
 (require :rulp)
-(core:main)
+(core::start-pipe "media/test.json")
index 608d8db..232f58a 100644 (file)
@@ -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")))