|
@@ -21,7 +21,8 @@
|
21
|
21
|
(width 99 :type fixnum :read-only t)
|
22
|
22
|
(height 39 :type fixnum :read-only t)
|
23
|
23
|
(dungeon nil :read-only t)
|
24
|
|
- (mobiles (make-hash-table) :type hash-table :read-only t))
|
|
24
|
+ (mobiles (make-hash-table) :type hash-table :read-only t)
|
|
25
|
+ (terrain (make-hash-table) :type hash-table :read-only t))
|
25
|
26
|
|
26
|
27
|
(defmethod initialize-instance :after ((map game-map) &rest initargs)
|
27
|
28
|
(declare (ignore initargs))
|
|
@@ -41,6 +42,10 @@
|
41
|
42
|
((codepoint :initarg :codepoint :initform #x23 :type fixnum)
|
42
|
43
|
(color :initarg :color :initform (color-from-name "grey"))))
|
43
|
44
|
|
|
45
|
+(defclass floor-tile (tile-entity)
|
|
46
|
+ ((codepoint :initarg :codepoint :initform #xb7 :type fixnum)
|
|
47
|
+ (color :initarg :color :initform (color-from-name "grey"))))
|
|
48
|
+
|
44
|
49
|
(defclass viewport (entity)
|
45
|
50
|
((width :initarg :width :type fixnum :initform 99)
|
46
|
51
|
(height :initarg :height :type fixnum :initform 40)
|
|
@@ -123,7 +128,10 @@
|
123
|
128
|
(* (1- (slot-value object 'height)) (game-map-width map))))
|
124
|
129
|
|
125
|
130
|
(defun collision-p (new-location map)
|
126
|
|
- (gethash new-location (game-map-mobiles map)))
|
|
131
|
+ (let ((thing (gethash new-location (game-map-mobiles map)))
|
|
132
|
+ (tile (gethash new-location (game-map-terrain map))))
|
|
133
|
+ (or thing
|
|
134
|
+ (and tile (not (typep tile 'floor-tile))))))
|
127
|
135
|
|
128
|
136
|
(defun bad-move-p (object map old-location new-location)
|
129
|
137
|
(let ((old-effective-location (calculate-effective-location object map old-location))
|
|
@@ -289,6 +297,7 @@
|
289
|
297
|
(<= y y2))
|
290
|
298
|
(terminal-color (slot-value tile 'color))
|
291
|
299
|
(terminal-put x y (slot-value tile 'codepoint)))))))
|
|
300
|
+ (maphash #'write-cell (game-map-terrain map))
|
292
|
301
|
(maphash #'write-cell (game-map-mobiles map)))))
|
293
|
302
|
|
294
|
303
|
(defun nearest-open-tile (location map)
|
|
@@ -367,21 +376,26 @@
|
367
|
376
|
finally (return coords))))))
|
368
|
377
|
|
369
|
378
|
(defun fill-map-from-crawler (map player)
|
370
|
|
- (with-slots (width height dungeon mobiles) map
|
|
379
|
+ (with-slots (width height dungeon mobiles terrain) map
|
371
|
380
|
(dotimes (x width)
|
372
|
381
|
(dotimes (y height)
|
373
|
382
|
(let ((tile (aref (crawler:tile-map dungeon) x y)))
|
374
|
|
- (unless (crawler:walkablep tile)
|
375
|
|
- (let ((wall (make-instance 'wall)))
|
376
|
|
- (set-location wall x y map)
|
377
|
|
- (setf (gethash (calc-location x y map) mobiles) wall)))
|
378
|
|
- (when (eq (crawler:map-feature tile) :stairs-up)
|
379
|
|
- (set-location player x y map)
|
380
|
|
- (setf (gethash (calc-location x y map) mobiles) player)))))))
|
|
383
|
+ (cond
|
|
384
|
+ ((not (crawler:walkablep tile))
|
|
385
|
+ (let ((wall (make-instance 'wall)))
|
|
386
|
+ (set-location wall x y map)
|
|
387
|
+ (setf (gethash (calc-location x y map) terrain) wall)))
|
|
388
|
+ ((eq (crawler:map-feature tile) :stairs-up)
|
|
389
|
+ (set-location player x y map)
|
|
390
|
+ (setf (gethash (calc-location x y map) mobiles) player))
|
|
391
|
+ (:otherwise
|
|
392
|
+ (let ((floor (make-instance 'floor-tile)))
|
|
393
|
+ (set-location floor x y map)
|
|
394
|
+ (setf (gethash (calc-location x y map) terrain) floor)))))))))
|
381
|
395
|
|
382
|
396
|
(defun initialize-map (map player)
|
383
|
|
- (setf (gethash (slot-value player 'location) (game-map-mobiles map)) player)
|
384
|
397
|
(fill-map-from-crawler map player)
|
|
398
|
+ (setf (gethash (slot-value player 'location) (game-map-mobiles map)) player)
|
385
|
399
|
(let* ((location (nearest-open-tile (slot-value player 'location) map))
|
386
|
400
|
(enemy (make-instance 'enemy :location location)))
|
387
|
401
|
(setf (gethash location (game-map-mobiles map)) enemy))
|