Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13845
Modified Files: package.lisp pal.lisp vector.lisp Log Message: Added :VMIRROR and :HMIRROR options to DRAW-IMAGE. Added RECTANGLES-OVERLAP-P.
--- /project/pal/cvsroot/pal/package.lisp 2007/10/31 22:38:22 1.22 +++ /project/pal/cvsroot/pal/package.lisp 2007/11/14 00:04:34 1.23 @@ -459,5 +459,6 @@ #:v-dot #:v-magnitude #:v-normalize #:v-distance #:v-truncate #:v-direction #:closest-point-to-line #:point-in-line-p #:lines-intersection - #:distance-from-line #:circle-line-intersection #:point-inside-rectangle-p + #:distance-from-line #:circle-line-intersection + #:point-inside-rectangle-p #:rectangles-overlap-p #:circles-overlap-p #:point-inside-circle-p)) \ No newline at end of file --- /project/pal/cvsroot/pal/pal.lisp 2007/10/31 22:38:22 1.40 +++ /project/pal/cvsroot/pal/pal.lisp 2007/11/14 00:04:34 1.41 @@ -515,14 +515,16 @@ array)))
-(defunct draw-image (image pos &key angle scale valign halign) - (image image vec pos (or boolean number) angle (or boolean number) scale symbol halign symbol valign) +(defunct draw-image (image pos &key angle scale valign halign vmirror hmirror) + (image image vec pos (or boolean number) angle (or boolean number) scale symbol halign symbol valign symbol vmirror symbol hmirror) (set-image image) (let ((width (image-width image)) (height (image-height image)) - (tx2 (pal-ffi:image-tx2 image)) - (ty2 (pal-ffi:image-ty2 image))) - (if (or angle scale valign halign) + (tx1 (if hmirror (pal-ffi:image-tx2 image) 0f0)) + (ty1 (if vmirror (pal-ffi:image-ty2 image) 0f0)) + (tx2 (if hmirror 0f0 (pal-ffi:image-tx2 image))) + (ty2 (if vmirror 0f0 (pal-ffi:image-ty2 image)))) + (if (or angle scale valign halign) (with-transformation () (translate pos) (when angle @@ -540,26 +542,26 @@ (:middle (- (/ height 2f0))) (otherwise 0f0)))) (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f 0f0 0f0) + (pal-ffi:gl-tex-coord2f tx1 ty1) (pal-ffi:gl-vertex2f x y) - (pal-ffi:gl-tex-coord2f tx2 0f0) + (pal-ffi:gl-tex-coord2f tx2 ty1) (pal-ffi:gl-vertex2f (+ x width) y) (pal-ffi:gl-tex-coord2f tx2 ty2) (pal-ffi:gl-vertex2f (+ x width) (+ y height)) - (pal-ffi:gl-tex-coord2f 0f0 ty2) + (pal-ffi:gl-tex-coord2f tx1 ty2) (pal-ffi:gl-vertex2f x (+ y height))))) (let* ((x (vx pos)) (y (vy pos)) (width (+ x width)) (height (+ y height))) (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f 0f0 0f0) + (pal-ffi:gl-tex-coord2f tx1 ty1) (pal-ffi:gl-vertex2f x y) - (pal-ffi:gl-tex-coord2f tx2 0f0) + (pal-ffi:gl-tex-coord2f tx2 ty1) (pal-ffi:gl-vertex2f width y) (pal-ffi:gl-tex-coord2f tx2 ty2) (pal-ffi:gl-vertex2f width height) - (pal-ffi:gl-tex-coord2f 0f0 ty2) + (pal-ffi:gl-tex-coord2f tx1 ty2) (pal-ffi:gl-vertex2f x height))))))
@@ -897,8 +899,8 @@ font (tag 'default-font)))))
-(defun draw-fps () - (draw-text (prin1-to-string (get-fps)) (v 0 0))) +(defun draw-fps (&optional font) + (draw-text (prin1-to-string (get-fps)) (v 0 0) font))
(defun message (&rest messages) (setf *messages* (append *messages* (list (format nil "~{~S ~}" messages)))) --- /project/pal/cvsroot/pal/vector.lisp 2007/10/30 20:43:10 1.10 +++ /project/pal/cvsroot/pal/vector.lisp 2007/11/14 00:04:34 1.11 @@ -12,12 +12,12 @@
(declaim (inline component)) (defunct component (x) - (number x) + (number x) (coerce x 'component))
(declaim (inline v)) (defunct v (x y) - (component x component y) + (component x component y) (make-vec :x x :y y))
(declaim (inline vf)) @@ -29,24 +29,24 @@
(declaim (inline rad)) (defunct rad (degrees) - (component degrees) + (component degrees) (* (/ pi 180) degrees))
(declaim (inline deg)) (defunct deg (radians) - (component radians) + (component radians) (* (/ 180 pi) radians))
(declaim (inline angle-v)) (defunct angle-v (angle) - (component angle) + (component angle) (v (sin (rad angle)) (- (cos (rad angle)))))
(declaim (inline v-angle)) (defunct v-angle (vec) - (vec vec) + (vec vec) (mod (deg (atan (vx vec) (if (zerop (vy vec)) least-negative-short-float @@ -54,49 +54,49 @@ 360))
(defunct v-random (length) - (number length) + (number length) (v* (angle-v (random 360.0)) length))
(declaim (inline v-round)) (defunct v-round (v) - (vec v) + (vec v) (v (round (vx v)) (round (vy v))))
(declaim (inline v-floor)) (defunct v-floor (v) - (vec v) + (vec v) (v (floor (vx v)) (floor (vy v))))
(declaim (inline v=)) (defunct v= (a b) - (vec a vec b) + (vec a vec b) (and (= (vx a) (vx b)) (= (vy a) (vy b))))
(declaim (inline v+!)) (defunct v+! (a b) - (vec a vec b) + (vec a vec b) (setf (vx a) (+ (vx a) (vx b))) (setf (vy a) (+ (vy a) (vy b))) nil)
(declaim (inline v+)) (defunct v+ (a b) - (vec a vec b) + (vec a vec b) (vf (+ (vx a) (vx b)) (+ (vy a) (vy b))))
(declaim (inline v-)) (defunct v- (a b) - (vec a vec b) + (vec a vec b) (vf (- (vx a) (vx b)) (- (vy a) (vy b))))
(declaim (inline v-!)) (defunct v-! (a b) - (vec a vec b) + (vec a vec b) (setf (vx a) (- (vx a) (vx b))) (setf (vy a) (- (vy a) (vy b))) nil) @@ -104,47 +104,47 @@
(declaim (inline v*!)) (defunct v*! (v m) - (component m) + (component m) (setf (vx v) (* (vx v) m)) (setf (vy v) (* (vy v) m)) nil)
(declaim (inline v*)) (defunct v* (v m) - (vec v component m) + (vec v component m) (vf (* (vx v) m) (* (vy v) m)))
(declaim (inline v/)) (defunct v/ (v d) - (vec v component d) + (vec v component d) (vf (/ (vx v) d) (/ (vy v) d)))
(declaim (inline v/!)) (defunct v/! (v d) - (vec v component d) + (vec v component d) (setf (vx v) (/ (vx v) d)) (setf (vy v) (/ (vy v) d)) nil)
(declaim (inline v-max)) (defunct v-max (a b) - (vec a vec b) + (vec a vec b) (if (< (v-magnitude a) (v-magnitude b)) b a))
(declaim (inline v-min)) (defunct v-min (a b) - (vec a vec b) + (vec a vec b) (if (< (v-magnitude a) (v-magnitude b)) a b))
(defunct v-rotate (v a) - (vec v component a) + (vec v component a) (let ((a (rad a))) (v (- (* (cos a) (vx v)) (* (sin a) (vy v))) @@ -153,20 +153,20 @@
(declaim (inline v-dot)) (defunct v-dot (a b) - (vec a vec b) + (vec a vec b) (+ (* (vx a) (vx b)) (* (vy a) (vy b))))
(declaim (inline v-magnitude)) (defunct v-magnitude (v) - (vec v) + (vec v) (the component (sqrt (the component (+ (expt (vx v) 2) (expt (vy v) 2))))))
(defunct v-normalize (v) - (vec v) + (vec v) (let ((m (v-magnitude v))) (if (/= m 0f0) (vf (/ (vx v) m) @@ -174,23 +174,23 @@ (vf 0f0 0f0))))
(defunct v-direction (from-vector to-vector) - (vec from-vector vec to-vector) + (vec from-vector vec to-vector) (v-normalize (v- to-vector from-vector)))
(defunct v-distance (v1 v2) - (vec v1 vec v2) + (vec v1 vec v2) (v-magnitude (v- v1 v2)))
(defunct v-truncate (v l) - (vec v component l) + (vec v component l) (v* (v-normalize v) l))
(defunct closest-point-to-line (a b p) - (vec a vec b vec p) + (vec a vec b vec p) (let* ((dir (v- b a)) (diff (v- p a)) (len (v-dot dir dir))) @@ -204,14 +204,14 @@ a)))))
(defunct point-in-line-p (a b p) - (vec a vec b vec p) + (vec a vec b vec p) (let ((d (v-direction a b))) (if (< (abs (+ (v-dot d (v-direction a p)) (v-dot d (v-direction b p)))) .00001) t nil)))
(defunct lines-intersection (la1 la2 lb1 lb2) - (vec la1 vec la2 vec lb1 vec lb2) + (vec la1 vec la2 vec lb1 vec lb2) (let ((x1 (vx la1)) (y1 (vy la1)) (x2 (vx la2)) @@ -237,7 +237,7 @@ nil))))))
(defunct circle-line-intersection (a b co r) - (vec a vec b vec co component r) + (vec a vec b vec co component r) (let ((cp (closest-point-to-line a b co))) (if cp (if (<= (v-distance co cp) r) @@ -246,14 +246,14 @@ nil)))
(defunct distance-from-line (a b p) - (vec a vec b vec p) + (vec a vec b vec p) (let ((cp (closest-point-to-line a b p))) (if cp (v-distance cp p) nil)))
(defunct point-inside-rectangle-p (topleft width height point) - (vec topleft vec point component width component height) + (vec topleft vec point component width component height) (let* ((x1 (vx topleft)) (y1 (vy topleft)) (x2 (+ x1 width)) @@ -264,12 +264,24 @@ (> y y1) (< y y2)) t nil)))
+ +(defun rectangles-overlap-p (a a-width a-height b b-width b-height) + (let ((ax (vx a)) + (ay (vy a)) + (bx (vx b)) + (by (vy b))) + (not (or (> ax (+ bx b-width)) + (< (+ ax a-width) bx) + (> ay (+ by b-height)) + (< (+ ay a-height) by))))) + + (declaim (inline point-inside-circle-p)) (defunct point-inside-circle-p (co r p) - (vec co vec p component r) + (vec co vec p component r) (<= (v-distance co p) r))
(declaim (inline circles-overlap-p)) (defunct circles-overlap-p (c1 r1 c2 r2) - (vec c1 vec c2 component r1 component r2) + (vec c1 vec c2 component r1 component r2) (<= (v-distance c1 c2) (+ r2 r1))) \ No newline at end of file