/[the-feebs-war]/definitions/extra.lisp
ViewVC logotype

Contents of /definitions/extra.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 15 - (show annotations)
Sat Feb 16 20:01:42 2008 UTC (6 years, 2 months ago) by gmilare
File size: 3109 byte(s)
1 ;;; -*- Common Lisp -*-
2
3 #| Copyright (c) 2007,2008 Gustavo Henrique Milar´┐Ż
4
5 This file is part of The Feebs War.
6
7 The Feebs War is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
11
12 The Feebs War is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with The Feebs War. If not, see <http://www.gnu.org/licenses/>.
19 |#
20
21
22 ;;; Usefull for creating a feeb
23 ;;; These are optimized so someone can use them without
24 ;;; complaining that they slow down your feeb !!!
25
26 (in-package :the-feebs-war)
27
28 (declaim (optimize (speed 3) (safety 0))
29
30 (inline left-of right-of behind
31 forward-dx forward-dy
32 left-dx left-dy
33 right-dx right-dy
34 behind-dx behind-dy
35
36 relative-facing
37
38 wallp chance)
39
40 ((function ((integer 0 3)) (integer 0 3))
41 left-of right-of behind
42 relative-facing)
43
44 ((function ((integer 0 3)) (integer -1 1))
45 forward-dx forward-dy
46 left-dx left-dy
47 right-dx right-dy
48 behind-dx behind-dy)
49
50 ((function (rational) boolean)
51 chance))
52
53 ;;; Directional arithmetic.
54
55 (defun right-of (facing)
56 (mod (+ facing 3) 4))
57
58 (defun left-of (facing)
59 (mod (+ facing 1) 4))
60
61 (defun behind (facing)
62 (mod (+ facing 2) 4))
63
64 (defun relative-facing (my-facing other-facing)
65 (mod (- my-facing other-facing) 4))
66
67 (defun forward-dy (facing)
68 (if (oddp facing)
69 0
70 (rem (1- facing) 4)))
71
72 (defun forward-dx (facing)
73 (if (oddp facing)
74 (rem (- 2 facing) 4)
75 0))
76
77 (defun left-dy (facing)
78 (forward-dy (left-of facing)))
79
80 (defun left-dx (facing)
81 (forward-dx (left-of facing)))
82
83 (defun right-dy (facing)
84 (forward-dy (right-of facing)))
85
86 (defun right-dx (facing)
87 (forward-dx (right-of facing)))
88
89 (defun behind-dy (facing)
90 (forward-dy (behind facing)))
91
92 (defun behind-dx (facing)
93 (forward-dx (behind facing)))
94
95 ;;; Tests
96
97 (defun wallp (thing)
98 (the boolean
99 (eq :rock (car thing))))
100
101 (defun chance (ratio)
102 (< (random (denominator ratio)) (numerator ratio)))
103
104 #|
105 ;;; Handling the vision, vision-left and vision-right objects
106 (defmacro with-visible-elements ((count line-of-sight)
107 ((vis vision) &body vis-body)
108 ((vis-l vision-left) &body vis-l-body)
109 ((vis-r vision-right) &body vis-r-body)
110 &body finalize)
111 (let ((v (gensym))
112 (vl (gensym))
113 (vr (gensym)))
114 `(do* ((,count 1 (1+ ,count))
115 (,v (svref ,vision ,count))
116 (,vl (svref ,vision ,count))
117 (,vr (svref ,vision ,count)))
118 ((= ,count line-of-sight)
119 ,@finalize)
120 (declare (list ,v ,vl ,vr)
121 (fixnum ,count))
122 (dolist (,vis ,v)
123 ,@vis-body)
124 (dolist (,vis-l ,vl)
125 ,@vis-l-body)
126 (dolist (,vis-r ,vr)
127 ,@vis-r-body))))
128 |#

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.5