GitLab's annual major release is around the corner. Along with a lot of new and exciting features, there will be a few breaking changes. Learn more here.

Verified Commit 58d478c6 authored by Andrew Kravchuk's avatar Andrew Kravchuk
Browse files

Merge branch 'develop' into master

parents 36e3c609 63067aec
Pipeline #137764998 passed with stage
in 1 minute and 54 seconds
......@@ -6,6 +6,37 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
## [Unreleased]
## [0.1.0] - 2020-04-20
### Added
- DSL-like entitites initialization.
- HP and mana subsystems as well as player's HP and mana orbs.
- Mob system.
- Support for Aseprite cel user data.
- Combat system.
- Ability to do target lock by not releasing mouse button, just like in D2.
- Mob health bar.
- Non-interruptible sprite animations.
- Abitily to override config options in call to START-ENGINE.
- Prefab preloading.
- Sound system.
- ECS improvements.
- Simple item system.
### Changed
- Next animation handling.
- Set default parameters for sprites.
### Removed
- Unnecessary camera component.
### Fixed
- Minor deployment-related fixes.
- Fixed character movement speed maths.
- Fixed bug causing memory faults on secondary start attempts after caught conditions.
- Fixed bug when the character was registered as colliding with some stuff when it really wasn't.
- Fixed bug when the player character would start moving when it was not asked to.
- Fixed bug when the player character would keep moving when it was not asked to.
## [0.0.1] - 2020-04-10
### Added
- Aseprite format parser.
......
(asdf:defsystem :d2clone-kit
:version "0.0.1"
:version "0.1.0"
:description "Generic Diablo 2 clone game engine."
:homepage "https://lockie.gitlab.io/d2clone-kit"
:author "Andrew Kravchuk <awkravchuk@gmail.com>"
......@@ -10,6 +10,7 @@
:cl-csv
:cl-inflector
:cl-liballegro
:cl-ppcre
:deeds
:float-features
:livesupport
......@@ -42,20 +43,23 @@
(:file "map-system")
(:file "collision-system")
(:file "sprite-system")
(:file "sound-system")
(:file "hp-system")
(:file "mana-system")
(:file "character-system")
(:file "combat-system")
(:file "item-system")
(:file "mob-system")
(:file "player-system")
(:file "renderer")
(:file "d2clone-kit"))
;; :around-compile (lambda (next)
;; (proclaim '(optimize
;; (debug 0)
;; (safety 0)
;; (compilation-speed 0)
;; (speed 3)))
;; (funcall next))
:defsystem-depends-on (:deploy)
:build-operation "deploy:deploy-op"
:build-pathname "d2clone"
:entry-point "d2clone-kit:demo")
:around-compile (lambda (next)
(when (find :release *features*)
(proclaim '(optimize
(speed 3)
(debug 0)
(compilation-speed 0)
(safety 1))))
(funcall next)))
(pushnew :deeds-no-startup *features*)
......@@ -64,6 +64,14 @@
(layer-id 0 :type fixnum)
(data nil :type (vector (unsigned-byte 8))))
(defstruct (ase-user-data-chunk (:include ase-chunk (type 'user-data)))
(cel-id 0 :type fixnum)
(text "" :type string)
(red 0 :type unsigned-byte)
(green 0 :type unsigned-byte)
(blue 0 :type unsigned-byte)
(alpha 0 :type unsigned-byte))
(defstruct ase-frame
(duration 0 :type fixnum)
(chunks nil :type (vector (or ase-chunk null))))
......@@ -76,8 +84,8 @@
(defgeneric read-chunk (type stream))
(defvar *layer-id*)
(declaim (type fixnum *layer-id*))
(defvar *layer-id*)
(defmethod read-chunk ((type (eql #x2004)) stream)
(read-binary 'word stream) ;; flags
......@@ -126,8 +134,13 @@
(deftype sprite-dimension ()
`(integer 0 ,(isqrt (truncate most-positive-fixnum 4))))
(declaim (type fixnum *cel-id*))
(defvar *cel-id*)
(defmethod read-chunk ((type (eql #x2005)) stream)
(let ((layer-id (read-binary 'word stream)))
(when (zerop layer-id)
(incf *cel-id*))
(read-binary 'word stream) ;; X position
(read-binary 'word stream) ;; Y position
(read-binary 'byte stream) ;; opacity
......@@ -160,6 +173,23 @@
(make-ase-tag :from from :to to :name name))))
(make-ase-tags-chunk :tags tags)))
(defmethod read-chunk ((type (eql #x2020)) stream)
(let ((flags (read-binary 'dword stream))
(text "")
(r 0) (g 0) (b 0) (a 0))
(unless (zerop (logand flags 1))
(setf text (read-binary 'ase-string stream)))
(unless (zerop (logand flags 2))
(setf
r (read-binary 'byte stream)
g (read-binary 'byte stream)
b (read-binary 'byte stream)
a (read-binary 'byte stream)))
(make-ase-user-data-chunk
:cel-id *cel-id*
:text text
:red r :green g :blue b :alpha a)))
(defmethod read-chunk (type stream)
(declare (ignore type stream))
nil)
......@@ -169,6 +199,7 @@
(defun load-aseprite (stream)
(let* ((*layer-id* 0)
(*cel-id* -1)
(header (read-binary 'ase-binary-header stream)))
(unless (= (ase-binary-header-magic header) +header-magic+)
(error "Invalid ASE file"))
......
......@@ -7,8 +7,6 @@
(target :initform nil))
(:documentation "Handles camera entity."))
(defcomponent camera camera)
(defhandler camera-system quit (event)
(setf (slot-value system 'entity) -1))
......
......@@ -13,7 +13,7 @@
(debug-entity -1 :type fixnum))
(defmethod make-component ((system character-system) entity &rest parameters)
(destructuring-bind (&key (speed 0.05d0) target-x target-y) parameters
(destructuring-bind (&key (speed 2d0) target-x target-y) parameters
(with-character entity (s x y path debug-entity)
(setf s speed)
(setf x target-x)
......@@ -90,7 +90,7 @@
Returns simple array containing conses of x and y path node world coordinates.
Note: if goal point is not walkable, this function will stuck."
(declare (optimize (speed 3) (safety 0)))
(declare (optimize (speed 3)))
(multiple-value-bind (goal-col goal-row)
(tile-index goal-x goal-y)
(multiple-value-bind (initial-x initial-y)
......@@ -153,6 +153,15 @@ Note: if goal point is not walkable, this function will stuck."
:element-type 'cons
:initial-contents result))))))))
(declaim
(inline face-target)
(ftype (function (double-float double-float double-float double-float) double-float)
face-target))
(defun face-target (character-x character-y target-x target-y)
"Returns the angle that the character at CHARACTER-X, CHARACTER-Y should be facing to look
at point TARGET-X, TARGET-Y."
(atan (* (- target-y character-y) 0.5d0) (- target-x character-x)))
(declaim (inline follow-path) (ftype (function (fixnum)) follow-path))
(defun follow-path (character-entity)
(with-coordinate character-entity ()
......@@ -163,7 +172,30 @@ Note: if goal point is not walkable, this function will stuck."
(setf path new-path
target-x (car target)
target-y (cdr target)
angle (atan (* (- target-y y) 0.5d0) (- target-x x))))))))
angle (face-target x y target-x target-y)))))))
(declaim
(ftype (function ((or null fixnum) double-float double-float double-float double-float)
(values double-float double-float)) closest-walkable-point))
(defun closest-walkable-point (character-entity x y target-x target-y)
"Returns walkable point closest to target on line from X, Y to TARGET-X, TARGET-Y."
;; TODO : when there's some obstacle between, that's a problem
(let ((new-target-x target-x)
(new-target-y target-y))
(loop
:with dx := (- new-target-x x) :and dy := (* (- new-target-y y) 0.5d0)
:with a := (atan dy dx) :and r := (sqrt (+ (* dx dx) (* dy dy)))
:for (col row) := (multiple-value-list (tile-index new-target-x new-target-y))
:while (collidesp col row :character character-entity)
:do (setf r (- r 0.5d0)
new-target-x (+ x (* r (cos a)))
new-target-y (+ y (* 2d0 r (sin a))))
:finally
(return
(multiple-value-bind (col row)
(tile-index new-target-x new-target-y)
(tile-pos (coerce col 'double-float)
(coerce row 'double-float)))))))
;; TODO : some sort of generic SoA class/macro with getter/setter functions
(declaim
......@@ -171,22 +203,9 @@ Note: if goal point is not walkable, this function will stuck."
(defun set-character-target (entity new-target-x new-target-y)
"Sets character ENTITY new movement target to NEW-TARGET-X, NEW-TARGET-Y."
(with-coordinate entity ()
(let ((new-target-x new-target-x)
(new-target-y new-target-y))
(loop ;; make sure new target is walkable
:with dx := (- new-target-x x) :and dy := (* (- new-target-y y) 0.5d0)
:with a := (atan dy dx) :and r := (sqrt (+ (* dx dx) (* dy dy)))
:for (col row) := (multiple-value-list (tile-index new-target-x new-target-y))
:while (collidesp col row)
:do (setf r (- r 0.5d0)
new-target-x (+ x (* r (cos a)))
new-target-y (+ y (* 2d0 r (sin a))))
:finally
(multiple-value-setq (new-target-x new-target-y)
(multiple-value-bind (col row)
(tile-index new-target-x new-target-y)
(tile-pos (coerce col 'double-float)
(coerce row 'double-float)))))
(multiple-value-bind (new-target-x new-target-y)
;; make sure new target is walkable
(closest-walkable-point entity x y new-target-x new-target-y)
(with-character entity ()
(when (or (zerop (length path))
(destructuring-bind (current-target-x . current-target-y)
......@@ -196,42 +215,78 @@ Note: if goal point is not walkable, this function will stuck."
current-target-x current-target-y)
1d0)))
(setf path (a* x y new-target-x new-target-y))
(unless (zerop (length path))
(follow-path entity)))))))
(if (zerop (length path))
(setf target-x new-target-x
target-y new-target-y)
(follow-path entity)))))))
(declaim
(inline approx-equal)
(ftype (function (double-float double-float &optional double-float) boolean) approx-equal))
(defun approx-equal (a b &optional (epsilon 0.01d0))
(defun approx-equal (a b &optional (epsilon 0.05d0))
(< (abs (- a b)) epsilon))
(declaim
(inline next-tile)
(ftype (function (angle fixnum fixnum) (values fixnum fixnum))
next-tile))
(defun next-tile (angle x y)
(declare (angle angle))
(when (minusp angle)
(setf angle (+ angle (* 2 pi))))
(ecase (round (* 4 angle) pi)
((0 8) (values (1+ x) y))
(1 (values (+ x (mod y 2)) (1+ y)))
(2 (values x (+ y 2)))
(3 (values (- x (- 1 (mod y 2))) (1+ y)))
(4 (values (1- x) y))
(5 (values (- x (- 1 (mod y 2))) (1- y)))
(6 (values x (- y 2)))
(7 (values (+ x (mod y 2)) (1- y)))))
(declaim
(inline stop-entity)
(ftype (function (fixnum)) stop-entity))
(defun stop-entity (entity)
"Stops the ENTITY from moving."
(with-coordinate entity ()
(with-character entity ()
(setf target-x x
target-y y
path (make-array 0)))))
(defmethod system-update ((system character-system) dt)
(with-characters
(with-coordinate entity ()
(with-sprite entity ()
(if (and (approx-equal target-x x speed) (approx-equal target-y y speed))
(if (zerop (length path))
(when (eq stance 'walk)
(switch-stance entity 'idle))
(follow-path entity))
(let ((direction-x (* 0.5d0 speed (cos angle)))
(direction-y (* 0.5d0 speed (sin angle) (/ *tile-width* *tile-height*))))
;; TODO : this check is kinda redundant
;; (but left here to check dynamic collisions later)
;; also it still sometimes stuck when it shouldnt (on corners)
(cond
((multiple-value-call #'collidesp
(tile-index (+ x direction-x)
(+ y direction-y)))
(setf target-x x
target-y y
path (make-array 0))
(switch-stance entity 'idle))
(t
(incf x (* 2d0 direction-x))
(incf y (* 2d0 direction-y))
(unless (eq stance 'walk)
(switch-stance entity 'walk))))))))))
(when (stance-interruptible-p entity)
(with-coordinate entity ()
(with-sprite entity ()
(let ((delta (* dt speed)))
(if (not (approx-equal angle (face-target x y target-x target-y)))
(if (zerop (length path))
(when (eq stance :walk)
(switch-stance entity :idle))
(follow-path entity))
(let ((direction-x (* delta (cos angle)))
(direction-y (* delta (sin angle) (/ *tile-width* *tile-height*))))
(cond
((and
(not (equal
(multiple-value-list (tile-index x y))
(multiple-value-list (tile-index (+ x direction-x)
(+ y direction-y)))))
(multiple-value-call #'collidesp
(multiple-value-call #'next-tile
angle (tile-index x y))))
(stop-entity entity)
(switch-stance entity :idle))
(t
(let ((old-x x)
(old-y y))
(incf x direction-x)
(incf y direction-y)
(issue character-moved
:entity entity :old-x old-x :old-y old-y :new-x x :new-y y))
(switch-stance entity :walk)))))))))))
(defmethod system-draw ((system character-system) renderer)
(flet ((path-node-pos (x y)
......
......@@ -3,14 +3,13 @@
(defclass collision-system (system)
((name :initform 'collision)
(collision-map :initform nil))
(collision-map :initform nil)
(characters-collision-map :initform nil))
(:documentation "Handles object collisions.
To make tile collide (e.g. be non-walkable by characters), set custom
boolean property *collides* to *true* in Tiled tileset."))
;; TODO : take into account characters?.. character movement event?..
;; TODO : delete component event?..
;; TODO : optimize this by packing coordinates into single fixnum (31 bits ought to be enough for anyone)
......@@ -32,20 +31,69 @@ boolean property *collides* to *true* in Tiled tileset."))
:do (when (tile-property tiles-properties tile 'collides)
(setf
(sparse-matrix-ref collision-map
(list (+ x start-x) (+ y start-y)))
(cons (+ x start-x) (+ y start-y)))
t))))))))))
(defmethod collides ((sytem collision-system) x y)
(defhandler collision-system component-created (event entity system-name)
:filter '(eq system-name 'character)
(with-slots (characters-collision-map) system
(unless characters-collision-map
(setf characters-collision-map (make-sparse-matrix)))
(multiple-value-bind (col row)
(with-coordinate entity ()
(tile-index x y))
(setf (sparse-matrix-ref characters-collision-map (cons col row)) entity))))
(defhandler collision-system character-moved (event entity old-x old-y new-x new-y)
(multiple-value-bind (old-col old-row)
(tile-index old-x old-y)
(multiple-value-bind (new-col new-row)
(tile-index new-x new-y)
(unless (and (= old-x new-x) (= old-y new-y))
(with-slots (characters-collision-map) system
(sparse-matrix-remove characters-collision-map (cons old-col old-row))
(setf (sparse-matrix-ref characters-collision-map (cons new-col new-row)) entity))))))
(defhandler collision-system entity-died (event entity)
(with-coordinate entity ()
(multiple-value-bind (col row)
(tile-index x y)
(with-slots (characters-collision-map) system
(sparse-matrix-remove characters-collision-map (cons col row))))))
(defmethod character-at ((system collision-system) x y)
"Returns character entity at ingeter map coordinates X, Y or NIL if there's no character there."
(sparse-matrix-ref (slot-value system 'characters-collision-map) (cons x y)))
(defmethod collides ((sytem collision-system) x y &key (character nil))
"Returns whether tile located at integer map coordinates X, Y does collide with other objects
using collision system SYSTEM."
(sparse-matrix-ref (slot-value system 'collision-map) (list x y)))
using collision system SYSTEM.
CHARACTER, when non-NIL, specifies character entity to check for collisions with other characters."
(with-slots (collision-map characters-collision-map) system
(let ((point (cons x y)))
(or
(sparse-matrix-ref collision-map point)
(if character
(let ((entity (sparse-matrix-ref characters-collision-map point)))
(if entity (not (= character entity)) nil))
nil)))))
(declaim
(inline collidesp)
(ftype (function (fixnum fixnum) boolean) collidesp))
(defun collidesp (x y)
"Returns whether tile located at integer map coordinates X, Y does collide with other objects."
(sparse-matrix-ref (slot-value (system-ref 'collision) 'collision-map) (list x y)))
(ftype (function (fixnum fixnum &key (:character (or fixnum null))) boolean) collidesp))
(defun collidesp (x y &key (character nil))
"Returns whether tile located at integer map coordinates X, Y does collide with other objects.
CHARACTER, when non-NIL, specifies character entity to check for collisions with other characters."
(with-slots (collision-map characters-collision-map) (system-ref 'collision)
(let ((point (cons x y)))
(or
(sparse-matrix-ref collision-map point)
(if character
(let ((entity (sparse-matrix-ref characters-collision-map point)))
(if entity (not (= character entity)) nil))
nil)))))
(defhandler collision-system quit (event)
(setf (slot-value system 'collision-map) nil))
(with-slots (collision-map characters-collision-map) system
(setf collision-map nil
characters-collision-map nil)))
(in-package :d2clone-kit)
(defclass combat-system (system)
((name :initform 'combat)
(order :initform 1))
(:documentation "Handles close combat."))
(defcomponent combat combat
(target -1 :type fixnum)
(attack-range 1.5d0 :type double-float)
(min-damage 1d0 :type double-float) ;; TODO : use rl-pcg dice rolls here?..
(max-damage nil :type double-float))
(defmethod make-component ((system combat-system) entity &rest parameters)
(declare (ignore system entity parameters))
(destructuring-bind (&key (attack-range 1.5d0) (min-damage 1d0) max-damage) parameters
(with-combat entity (target entity-attack-range entity-min-damage entity-max-damage)
(setf entity-attack-range attack-range
entity-min-damage min-damage
entity-max-damage max-damage))))
(defun attack (attacker-entity target-entity)
"Initiates a close combat attack of TARGET-ENTITY by ATTACKER-ENTITY."
(unless (= attacker-entity target-entity) ;; prevent self-harm lol
(with-sprite attacker-entity ()
(unless (eq stance :swing)
(with-combat attacker-entity ()
(setf target target-entity))))))
(defconstant +stun-threshold+ 0.08d0)
(defmethod system-update ((system combat-system) dt)
(with-combats
(unless (or (minusp target) (deadp entity))
(with-sprite entity ()
(with-coordinate entity (current-x current-y)
(with-coordinate target (attack-target-x attack-target-y)
(with-character entity ()
(cond
;; track target
((> (euclidean-distance attack-target-x attack-target-y current-x current-y)
attack-range)
(destructuring-bind (final-target-x . final-target-y)
(if (length= 0 path)
(cons current-x current-y)
(simple-vector-peek path))
(unless (and (= final-target-x attack-target-x)
(= final-target-y attack-target-y))
(set-character-target entity attack-target-x attack-target-y)
(when (length= 0 path)
(setf target -1)))))
;; start the blow
(t
(stop-entity entity)
(setf angle (face-target current-x current-y attack-target-x attack-target-y))
(switch-stance entity :swing)))
;; land the blow
(when (and (not (minusp target)) ;; zero-length path case
(eq stance :swing)
(= frame (car (last (gethash :swing stances)))))
(when (<= (euclidean-distance target-x target-y current-x current-y)
attack-range)
(with-hp target (target-max-hp target-current-hp)
(let ((damage (+ min-damage (random (- max-damage min-damage)))))
(set-hp target (- target-current-hp damage))
(when (> damage (* target-max-hp +stun-threshold+))
(unless (zerop target-current-hp)
(switch-stance target :hit))
(with-combat target (targets-target)
(setf targets-target -1))))))
(setf target -1)))))))))
......@@ -66,6 +66,7 @@ See WITH-SYSTEM-CONFIG-OPTIONS"
(display vsync :type boolean :default nil)
(display fps :type boolean :default nil)
(display multisampling :type fixnum :default 0)
(display font :type string :default "")
(debug grid :type list :default nil)
(debug sprite :type list :default nil)
(debug cursor :type list :default nil)
......
......@@ -12,37 +12,6 @@ Returns T when EVENT is not :DISPLAY-CLOSE."
(defunl game-loop (event-queue &key (repl-update-interval 0.3))
"Runs game loop."
;; TODO : init systems DSL style someplace else
(make-instance 'coordinate-system)
(make-instance 'debug-system)
(make-instance 'sprite-batch-system)
(make-instance 'collision-system)
(let ((camera-entity (make-entity)))
(make-component (make-instance 'camera-system) camera-entity)
(make-component (system-ref 'coordinate) camera-entity :x 0d0 :y 0d0))
(let ((map-entity (make-entity)))
(make-component (system-ref 'coordinate) map-entity :x 0d0 :y 0d0)
(make-component (make-instance 'map-system) map-entity :prefab 'map))
(let ((map-entity (make-entity)))
(make-component (system-ref 'coordinate) map-entity :x -10d0 :y 0d0)
(make-component (system-ref 'map) map-entity :prefab 'map2))
(let ((map-entity (make-entity)))
(make-component (system-ref 'coordinate) map-entity :x 0d0 :y -10d0)
(make-component (system-ref 'map) map-entity :prefab 'map3))
(let ((sprite-entity (make-entity)))
(make-component (make-instance 'sprite-system) sprite-entity :prefab 'heroine)
(toggle-layer sprite-entity 'head t)
(toggle-layer sprite-entity 'clothes t)
(make-component (make-instance 'player-system) sprite-entity)
(setf (camera-target) sprite-entity)
(make-component (make-instance 'character-system) sprite-entity :target-x 0d0 :target-y 0d0)
(make-component (system-ref 'coordinate) sprite-entity :x 0d0 :y 0d0))
;; (let ((char-entity (make-entity)))
;; (make-component (system-ref 'sprite) char-entity :prefab 'heroine)
;; (toggle-layer char-entity 'clothes t) ;; всадник без головы кек
;; (make-component (system-ref 'coordinate) char-entity :x 0d0 :y 0d0)
;; (make-component (make-instance 'character-system) char-entity :target-x 3d0 :target-y 3d0))