Explorar el Código

Add ortho line

Lily Carpenter hace 9 años
padre
commit
13e0e41034
Se han modificado 1 ficheros con 40 adiciones y 0 borrados
  1. 40 0
      src/crypts-and-corpses.lisp

+ 40 - 0
src/crypts-and-corpses.lisp

@@ -375,6 +375,46 @@
375 375
               collect coord into coords
376 376
               finally (return coords))))))
377 377
 
378
+;; trivial-ortho-line and ortho-line written by vydd
379
+;; https://github.com/vydd/
380
+;; Ported from https://github.com/SquidPony/SquidLib/blob/master/squidlib-util/src/main/java/squidpony/squidmath/OrthoLine.java
381
+(defun trivial-ortho-line (start-x start-y end-x end-y)
382
+  (let ((start-x (min start-x end-x))
383
+        (end-x (max start-x end-x))
384
+        (start-y (min start-y end-y))
385
+        (end-y (max start-y end-y)))
386
+    (cond ((and (= start-x end-x) (= start-y end-y)) `((,start-x ,start-y)))
387
+          ((= start-x end-x) (loop for y from start-y upto end-y
388
+                                   collect `(,start-x ,y)))
389
+          ((= start-y end-y) (loop for x from start-x upto end-x
390
+                                   collect `(,x ,start-y))))))
391
+
392
+(defun ortho-line (start-x start-y end-x end-y)
393
+  (if (or (= start-x end-x)
394
+          (= start-y end-y))
395
+      (trivial-ortho-line start-x start-y end-x end-y)
396
+      (let* ((dx (- end-x start-x))
397
+             (dy (- end-y start-y))
398
+             (nx (abs dx))
399
+             (ny (abs dy))
400
+             (sign-x (if (> dx 0) 1 -1))
401
+             (sign-y (if (> dy 0) 1 -1))
402
+             (work-x start-x)
403
+             (work-y start-y)
404
+             (drawn `((,start-x ,start-y))))
405
+        (loop
406
+          with ix = 0
407
+          with iy = 0
408
+          while (or (< ix nx) (< iy ny))
409
+          do (progn
410
+               (if (< (/ (+ 0.5 ix) nx) (/ (+ 0.5 iy) ny))
411
+                   (setf work-x (+ work-x sign-x)
412
+                         ix (1+ ix))
413
+                   (setf work-y (+ work-y sign-y)
414
+                         iy (1+ iy)))
415
+               (push `(,work-x ,work-y) drawn)))
416
+        (nreverse drawn))))
417
+
378 418
 (defun fill-map-from-crawler (map player)
379 419
   (with-slots (width height dungeon mobiles terrain) map
380 420
     (dotimes (x width)