~octaspire/crates2

ref: e55f1389f279a523501a6dc5328c2ea1b56d0669 crates2/src/utils.lisp -rw-r--r-- 3.0 KiB
e55f1389octaspire Add 'Pass Counter' and delayed attach, fix wall collisions 1 year, 4 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
;; Octaspire Crates 2 - Puzzle Game
;; Copyright 2020 octaspire.com
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
(in-package :crates2)

;; Functions

(defun replace-substr-at (input index new)
  "Replace part of INPUT starting at INDEX using sub string NEW"
  (let ((substring-len (length new)))
    (loop for i from 0 to (- substring-len 1)
          do (setf (aref input (+ index i)) (aref new i))))
  input)

(defun find-at (x y z)
  "Get crate at (X,Y,Z) or NIL if location is empty."
  (find-if #'(lambda (crate)
               (if (and (= (crate-x crate) x)
                        (= (crate-y crate) y)
                        (= (crate-z crate) z))
                   crate
                   nil))
           (get-current-level)))

(defun find-at-of-type (x y z type)
  "Get crate of TYPE at (X,Y,Z) or NIL if location is empty or crate is not of TYPE."
  (let ((crate (find-at x y z)))
    (if crate
        (if (subtypep (type-of crate) type)
            crate
            nil)
        nil)))

(defun head-on-collision-p (v1 v2)
  "Predicate telling whether velocities V1 and V2 can cause
head on collision - i.e. if the velocities are in opposite
directions."
  (ecase v1
    (:east  (if (eq v2 :west)  t nil))
    (:west  (if (eq v2 :east)  t nil))
    (:north (if (eq v2 :south) t nil))
    (:south (if (eq v2 :north) t nil))
    (:zero  nil)))

(defun on-which-side-i-am (i other)
  (let ((ix (crate-x i))
        (iy (crate-y i))
        (ox (crate-x other))
        (oy (crate-y other)))
    (if (= iy oy)
        (if (= ix (- ox 1))
            :west
            (if (= ix (+ ox 1))
                :east
                :zero))
        (if (= ix ox)
            (if (= iy (- oy 1))
                :north
                (if (= iy (+ oy 1))
                    :south
                    :zero))
            :zero))))

(defun on-which-side-is-other (i other)
  (let ((side (on-which-side-i-am i other)))
    (ecase side
      (:north :south)
      (:south :north)
      (:east  :west)
      (:west  :east)
      (:zero  :zero))))

(defun move-to (crate x y z)
  (setf (crate-x crate) x)
  (setf (crate-y crate) y)
  (setf (crate-z crate) z))

(defun move-other-to-my-side (i other side)
  "Move crate OTHER to SIDE of crate I"
  (ecase side
    (:north (move-to other (crate-x i) (- (crate-y i) 1) (crate-z i)))
    (:south (move-to other (crate-x i) (+ (crate-y i) 1) (crate-z i)))
    (:east  (move-to other (+ (crate-x i) 1) (crate-y i) (crate-z i)))
    (:west  (move-to other (- (crate-x i) 1) (crate-y i) (crate-z i)))
    (:zero  nil)))