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

Contents of /images.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5