/[the-feebs-war]/images.lisp
ViewVC logotype

Contents of /images.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (show annotations)
Sun Feb 17 20:29:26 2008 UTC (6 years, 2 months ago) by gmilare
File size: 4730 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 (in-package :the-feebs-war)
23
24 ;;; This file is an extension of system.lisp which handles vision
25
26
27
28 ;;; -*- Vision Calculation -*-
29
30 (defstruct feeb-image
31 name facing peeking)
32
33 (defstruct fireball-image
34 direction)
35
36 (defstruct (proximity
37 (:conc-name nil))
38 my-square
39 rear-square
40 left-square
41 right-square)
42
43
44 ;;; Computes what the feeb is seeing
45
46 (defun compute-vision (feeb)
47 (let ((proximity (feeb-proximity feeb))
48 (vision (feeb-vision feeb))
49 (vision-left (feeb-vision-left feeb))
50 (vision-right (feeb-vision-right feeb))
51 (facing (feeb-facing feeb))
52 vision-dx
53 vision-dy
54 (x (feeb-x-position feeb))
55 (y (feeb-y-position feeb)))
56 ;; First fill in proximity info.
57 (setf (my-square proximity)
58 (mapcar (rcurry #'imagify feeb :proximity)
59 (aref *maze* x y))
60 (left-square proximity)
61 (mapcar (rcurry #'imagify feeb :proximity)
62 (aref *maze* (+ x (left-dx facing)) (+ y (left-dy facing))))
63 (right-square proximity)
64 (mapcar (rcurry #'imagify feeb :proximity)
65 (aref *maze* (+ x (right-dx facing)) (+ y (right-dy facing))))
66 (rear-square proximity)
67 (mapcar (rcurry #'imagify feeb :proximity)
68 (aref *maze* (+ x (behind-dx facing)) (+ y (behind-dy facing)))))
69 ;; The vision vector starts in the square the feeb is facing.
70 (setf x (+ x (forward-dx facing))
71 y (+ y (forward-dy facing)))
72 ;; Figure out which direction to scan in.
73 (case (feeb-peeking feeb)
74 (:peek-left (setf facing (left-of facing)))
75 (:peek-right (setf facing (right-of facing))))
76 (setf vision-dx (forward-dx facing)
77 vision-dy (forward-dy facing))
78 ;; compute vision, vision-left and vision-right
79 (do* ((x x (+ x vision-dx))
80 (y y (+ y vision-dy))
81 (left-wall-x (+ x (left-dx facing)) (+ left-wall-x vision-dx))
82 (left-wall-y (+ y (left-dy facing)) (+ left-wall-y vision-dy))
83 (right-wall-x (+ x (right-dx facing)) (+ right-wall-x vision-dx))
84 (right-wall-y (+ y (right-dy facing)) (+ right-wall-y vision-dy))
85 (index 0 (1+ index)))
86 ((wallp (aref *maze* x y))
87 (setf (aref vision index) (list :rock)
88 (aref vision-left index) (list :unknown)
89 (aref vision-right index) (list :unknown)
90 (feeb-line-of-sight feeb) index))
91 (setf (aref vision index)
92 (mapcar (rcurry #'imagify feeb :vision)
93 (aref *maze* x y))
94 (aref vision-left index)
95 (mapcar (rcurry #'imagify feeb :left-vision)
96 (aref *maze* left-wall-x left-wall-y))
97 (aref vision-right index)
98 (mapcar (rcurry #'imagify feeb :right-vision)
99 (aref *maze* right-wall-x right-wall-y))))))
100
101
102 ;;; This transforms what the feeb is seeing;
103
104 (defgeneric imagify (feeb type thing)
105 (:documentation "Defines how FEEB sees or feels THING.
106 TYPE could be :vision, :left-vision :right-vision or :proximity")
107 (:method (thing feeb type)
108 thing)
109
110 (:method ((thing feeb) feeb (type (eql :vision)))
111 (make-feeb-image :name (feeb-name thing)
112 :facing (feeb-facing thing)
113 :peeking (feeb-peeking thing)))
114
115 (:method ((thing feeb) feeb (type (eql :proximity)))
116 (make-feeb-image :name (feeb-name thing)
117 :facing (feeb-facing thing)
118 :peeking (feeb-peeking thing)))
119
120 (:method ((thing fireball) feeb (type (eql :vision)))
121 (make-fireball-image :direction (fireball-direction thing)))
122
123 (:method ((thing fireball) feeb (type (eql :proximity)))
124 (make-fireball-image :direction (fireball-direction thing)))
125
126 (:method (thing feeb (type (eql :left-vision)))
127 (if (eq :rock thing)
128 :rock))
129
130 (:method (thing feeb (type (eql :right-vision)))
131 (if (eq :rock thing)
132 :rock))
133
134 (:method ((thing feeb) feeb (type (eql :left-vision)))
135 (and (feeb-p thing)
136 (= (feeb-facing feeb) (left-of (feeb-facing thing)))
137 (feeb-peeking thing)))
138
139 (:method ((thing feeb) feeb (type (eql :right-vision)))
140 (and (feeb-p thing)
141 (= (feeb-facing feeb) (right-of (feeb-facing thing)))
142 (feeb-peeking thing)))
143
144 ) ; end of imagify generic function

  ViewVC Help
Powered by ViewVC 1.1.5