| Revision | fa16c76c22a769428e764f70bbc72bc2499ff77e (tree) |
|---|---|
| Time | 2022-05-17 17:04:05 |
| Author | Giulio De Stasio <giuliods@user...> |
| Commiter | Giulio De Stasio |
resolved entity selection, added few things
graphics/grid.lisp (diff) graphics/inputs.lisp (diff) graphics/render.lisp (diff) graphics/view.lisp (diff) data.lisp (diff) geometry/package.lisp (diff) layers/models.lisp (diff) layers/screens.lisp (diff) media/IBMPlex.ttf (diff) media/board.tga (diff)
media/test.png (diff) package.lisp (diff)
board.png test.png| @@ -0,0 +1,24 @@ | ||
| 1 | +(in-package :core) | |
| 2 | + | |
| 3 | +;; posso usare le hash piuttosto che interpretarlo sul momento. Infatti creerò un metodo che | |
| 4 | +;; analizza json e lo traduce in una tabella hash e una funzione che prende la hash e crea | |
| 5 | +;; l'oggetto tramite i metodi standard. | |
| 6 | +;; | |
| 7 | +;; (defparameter a (make-hash-table)) ; crea una hash con make-hash-table | |
| 8 | +;; (gethash 'key a) ; recupera la hash con chiave key, questa è settable | |
| 9 | +(defun parse-list (linput) | |
| 10 | + (if (listp (car linput)) | |
| 11 | + (loop :for l :in linput | |
| 12 | + :do | |
| 13 | + (parse-list l)) | |
| 14 | + (FORMAT t "TEXT IS ~A, ~A AND ~A~%" (CAR LINPUT) (CADR LINPUT) (CADDR LINPUT)) ; devi ricordanti che i campi non sono (a b c) ma sono ((a1 . a2) (b1 . b2) (c1 . c2)) | |
| 15 | + )) | |
| 16 | + | |
| 17 | +(defun decompose-alist (alist search-list) | |
| 18 | + (apply 'concatenate 'list | |
| 19 | + (loop :for search-term :in search-list | |
| 20 | + :collect | |
| 21 | + (when (assoc search-term alist) | |
| 22 | + (list search-term | |
| 23 | + (cdr (assoc search-term alist)))) | |
| 24 | + ))) |
| @@ -0,0 +1,73 @@ | ||
| 1 | +(defpackage :geometry | |
| 2 | + (:use :cl) | |
| 3 | + (:export norm v+ v- distance collidep)) | |
| 4 | + | |
| 5 | +;; vectors, norms, distances and balls | |
| 6 | +(defun norm (a) | |
| 7 | + "calculate the norm of a vector" | |
| 8 | + (sqrt (reduce #'+ (map 'list #'* a a))) | |
| 9 | + ) | |
| 10 | + | |
| 11 | +(defun v+ (a b) | |
| 12 | + "vectorial sum of a and b" | |
| 13 | + (unless (eql (length a) (length b)) | |
| 14 | + (error "geometry:[EE] => the data \"~a\" and \"~a\" don't have the same length~%" a b)) | |
| 15 | + (map 'list #'+ a b) | |
| 16 | + ) | |
| 17 | + | |
| 18 | +(defun v- (a b) | |
| 19 | + (unless (eql (length a) (length b)) | |
| 20 | + (error "geometry:[EE] => the data \"~a\" and \"~a\" don't have the same length~%" a b)) | |
| 21 | + (map 'list #'- a b) | |
| 22 | + ) | |
| 23 | + | |
| 24 | +(defun distance (a b) | |
| 25 | + "calculate the distance between two vectors" | |
| 26 | + (norm (v- a b))) | |
| 27 | + | |
| 28 | +(defun collidep (a b) | |
| 29 | + "returns true if two vectors are in the same position" | |
| 30 | + (if (eql (distance a b) 0.0) | |
| 31 | + t | |
| 32 | + nil)) | |
| 33 | + | |
| 34 | +(defgeneric insidep (point b)) | |
| 35 | + | |
| 36 | +(defclass ball () | |
| 37 | + ((center :accessor ball-center | |
| 38 | + :initarg :center | |
| 39 | + :type list | |
| 40 | + :initform '(0 0)) | |
| 41 | + (radius :accessor ball-radius | |
| 42 | + :initarg :radius | |
| 43 | + :type float | |
| 44 | + :initform 6.0))) | |
| 45 | + | |
| 46 | +(defun ball (a r) | |
| 47 | + "create a object ball" | |
| 48 | + (unless (and (listp a) (> r 0)) | |
| 49 | + (error "geometry:[EE] => the data point=\"~a\" is not of type list or radius=\"~a\" is 0 or less" a r)) | |
| 50 | + (make-instance 'ball :center a :radius r)) | |
| 51 | + | |
| 52 | +(defmethod insidep (point (b ball)) | |
| 53 | + "check if a point is inside the ball, it return nil if outside and the distance if inside" | |
| 54 | + (let ((dist (distance (ball-center b) point))) | |
| 55 | + (if (< dist (ball-radius b)) | |
| 56 | + dist | |
| 57 | + nil))) | |
| 58 | + | |
| 59 | +;; list generations and table reshapes | |
| 60 | + | |
| 61 | +(defun from-center (a r) | |
| 62 | + `((- ,a ,r) (- ,a ,r) ((+ ,a ,r) (+ ,a ,r))) | |
| 63 | + ) | |
| 64 | + | |
| 65 | +(defun make-lgrid (x y) | |
| 66 | + (loop :for i :from 0 :to x | |
| 67 | + :collect | |
| 68 | + (loop :for j :from 0 :to y | |
| 69 | + :collect (list (+ i (car p)) (+ i (cadr p))) | |
| 70 | + ))) | |
| 71 | + | |
| 72 | +(defun make-lgrid-from-center (a r) | |
| 73 | + (apply 'make-lgrid (from-center a r))) |
| @@ -1,6 +1,6 @@ | ||
| 1 | 1 | (in-package :graphics) |
| 2 | 2 | |
| 3 | -(defparameter +grid-span+ 70) | |
| 3 | +(defparameter +grid-span+ 50) | |
| 4 | 4 | (defparameter +is-grid+ t) |
| 5 | 5 | (defparameter +is-grid-letters+ t) |
| 6 | 6 |
| @@ -24,12 +24,11 @@ | ||
| 24 | 24 | |
| 25 | 25 | (defun select-pointer (mouse-x mouse-y) |
| 26 | 26 | (let ((mouse-point (sdl2:make-rect mouse-x mouse-y 10 10))) |
| 27 | + (setf +pointer+ nil) | |
| 27 | 28 | (loop :for obj :in +entities-list+ |
| 28 | 29 | :for n :from 0 :to (length +entities-list+) |
| 29 | 30 | :do |
| 30 | - (setf +pointer+ nil) | |
| 31 | - (when (sdl2:has-intersect mouse-point | |
| 32 | - (layers:screen-dest obj +grid-span+)) | |
| 31 | + (when (sdl2:has-intersect mouse-point (layers:screen-dest obj +grid-span+)) | |
| 33 | 32 | (setf +pointer+ n)) |
| 34 | 33 | ))) |
| 35 | 34 | ;; cl-sdl2 doesn't support point-in-rect, which checks if a point is inside a rect, but there |
| @@ -4,6 +4,13 @@ | ||
| 4 | 4 | ;;(defun add-entity (entity) |
| 5 | 5 | ;; (setf +entities-list+ (append +entities-list+ (list (list entity)))) |
| 6 | 6 | ;; (setf (layers:entity-surface entity) (load-surface (layers:entity-icon entity)))) |
| 7 | +(defun remove-nth (n list) | |
| 8 | + "remove the nth element from the list, with negative numbers it starts from the end" | |
| 9 | + (let ((k (mod n (length list)))) | |
| 10 | + (if (< k 1) | |
| 11 | + (cdr list) | |
| 12 | + (cons (car list) (remove-nth (1- k) (cdr list))) | |
| 13 | + ))) | |
| 7 | 14 | |
| 8 | 15 | (defun load-surface (image) |
| 9 | 16 | (sdl2-image:load-image image)) |
| @@ -20,7 +20,7 @@ | ||
| 20 | 20 | (with-playground (window renderer :title title :width width :height height) |
| 21 | 21 | ;; (let *font* ((sdl2-ttf:open-font "media/IBMPlex.ttf" 20)) |
| 22 | 22 | ;; here the list must be created |
| 23 | - (add-plane (make-instance 'layers:plane)) | |
| 23 | + (add-plane (make-instance 'layers:plane :img-path (truename "media/board.tga"))) | |
| 24 | 24 | (add-entity (make-instance 'layers:entity :img-path (truename "media/test.png"))) |
| 25 | 25 | (sdl2:with-event-loop (:method :poll) |
| 26 | 26 | (:quit () t) |
| @@ -0,0 +1,10 @@ | ||
| 1 | +(in-package :layers) | |
| 2 | + | |
| 3 | +(defclass model () | |
| 4 | + ((img-path :accessor model-img-path | |
| 5 | + :initarg :img-path | |
| 6 | + :initform (truename "media/test.png")) | |
| 7 | + (surface :reader model-surface))) | |
| 8 | + | |
| 9 | +(defmethod initialize-instance :after ((m model) &rest args) | |
| 10 | + (setf (slot-value m 'surface) (sdl2-image:load-image (model-img-path m)))) |
| @@ -0,0 +1,72 @@ | ||
| 1 | +(in-package :layers) | |
| 2 | +;; This is the most generic class in the program with model, this class define | |
| 3 | +;; objects to be displayed on screen, whenever they are entities, planes text | |
| 4 | +;; or icons. | |
| 5 | + | |
| 6 | +(defgeneric x (s)) | |
| 7 | +(defgeneric y (s)) | |
| 8 | +(defgeneric (setf x) (value s)) | |
| 9 | +(defgeneric (setf y) (value s)) | |
| 10 | +(defgeneric w (s)) | |
| 11 | +(defgeneric h (s)) | |
| 12 | +(defgeneric (setf w) (value s)) | |
| 13 | +(defgeneric (setf h) (value s)) | |
| 14 | +(defgeneric screen-source (s)) | |
| 15 | +(defgeneric screen-dest (s &optional grid)) | |
| 16 | + | |
| 17 | +(defclass screen () | |
| 18 | + ((texture :accessor screen-texture | |
| 19 | + :initarg :texture | |
| 20 | + :initform nil) | |
| 21 | + (coordinate :accessor screen-coordinate | |
| 22 | + :initarg :coordinate | |
| 23 | + :type sequence | |
| 24 | + :initform (make-array '(2) :initial-contents '(0 0))) | |
| 25 | + (dimension :accessor screen-dimension | |
| 26 | + :initarg :dimension | |
| 27 | + :type sequence | |
| 28 | + :initform (make-array '(2) :initial-contents '(0 0))) | |
| 29 | + (displayp :accessor screen-displayp | |
| 30 | + :initarg :displayp | |
| 31 | + :type boolean | |
| 32 | + :initform t) | |
| 33 | + (rotation :accessor screen-rotation | |
| 34 | + :initarg :rotation | |
| 35 | + :type float | |
| 36 | + :initform 1.0))) | |
| 37 | + | |
| 38 | +(defmethod x ((s screen)) | |
| 39 | + (aref (slot-value s 'coordinate) 0)) | |
| 40 | + | |
| 41 | +(defmethod y ((s screen)) | |
| 42 | + (aref (slot-value s 'coordinate) 1)) | |
| 43 | + | |
| 44 | +(defmethod (setf x) (value (s screen)) | |
| 45 | + (setf (aref (slot-value s 'coordinate) 0) value)) | |
| 46 | + | |
| 47 | +(defmethod (setf y) (value (s screen)) | |
| 48 | + (setf (aref (slot-value s 'coordinate) 1) value)) | |
| 49 | + | |
| 50 | +(defmethod w ((s screen)) | |
| 51 | + (aref (slot-value s 'dimension) 0)) | |
| 52 | + | |
| 53 | +(defmethod h ((s screen)) | |
| 54 | + (aref (slot-value s 'dimension) 1)) | |
| 55 | + | |
| 56 | +(defmethod (setf w) (value (s screen)) | |
| 57 | + (setf (aref (slot-value s 'dimension) 0) value)) | |
| 58 | + | |
| 59 | +(defmethod (setf h) (value (s screen)) | |
| 60 | + (setf (aref (slot-value s 'dimension) 1) value)) | |
| 61 | + | |
| 62 | +;; the default screen does not support tilesets and partial textures, so | |
| 63 | +;; remember to check for a tileset-screen or partial-screen for those | |
| 64 | +(defmethod screen-source ((s screen)) | |
| 65 | + nil) | |
| 66 | + | |
| 67 | +;; this does not support grids, remember to bind to those in the render section. | |
| 68 | +(defmethod screen-dest ((s screen) &optional grid) | |
| 69 | + (sdl2:make-rect (x s) | |
| 70 | + (y s) | |
| 71 | + (w s) | |
| 72 | + (h s))) |
| @@ -0,0 +1,3 @@ | ||
| 1 | +(defpackage :core | |
| 2 | + (:use :cl :json) | |
| 3 | + (:export main)) |
Fork