[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Sat Jul 21 16:34:16 UTC 2007
Update of /project/pal/cvsroot/pal
In directory clnet:/tmp/cvs-serv30525
Modified Files:
ffi.lisp pal-macros.lisp pal.asd pal.lisp todo.txt vector.lisp
Log Message:
Added automatic coercion of numerical arguments.
--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/19 18:51:37 1.11
+++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/21 16:34:16 1.12
@@ -467,6 +467,7 @@
(assert (typep resource 'resource)))
(defmethod free-resource :after (resource)
+ (pal::reset-tags-holding-this-resource resource)
(setf *resources* (remove resource *resources*)))
(defmethod free-resource ((resource music))
--- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/19 16:37:25 1.8
+++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/21 16:34:16 1.9
@@ -6,7 +6,6 @@
(defvar *tags* (make-hash-table :test 'eq))
-
(defmacro define-tags (&body tags)
`(progn
,@(mapcar (lambda (r)
@@ -20,6 +19,13 @@
(setf (cdr v) nil))
*tags*))
+(defun reset-tags-holding-this-resource (resource)
+ (maphash (lambda (k v)
+ (declare (ignore k))
+ (when (eq resource (cdr v))
+ (setf (cdr v) nil)))
+ *tags*))
+
(defun tag (name)
(declare (type symbol name))
(let ((resource (gethash name *tags*)))
@@ -31,6 +37,34 @@
(the resource (setf (cdr resource) r))))
(error "Named resource ~a not found" name))))
+(defun coerce-form-for (to-type value)
+ `(,value ,(case to-type
+ ((u8 u11 u16 integer fixnum) `(truncate ,value))
+ (component `(coerce ,value 'component))
+ (single-float `(coerce ,value 'single-float))
+ (double-float `(coerce ,value 'double-float))
+ (float `(coerce ,value 'float)))))
+
+
+(defmacro defunct (name lambda-list declarations &body body)
+ (let* ((decls (loop for (a b) on declarations by #'cddr collecting
+ `(type ,a ,b)))
+ (coerced (remove-if (lambda (decl)
+ (null (second decl)))
+ (mapcar (lambda (decl)
+ (coerce-form-for (second decl) (third decl)))
+ decls))))
+ (if coerced
+ `(defun ,name ,lambda-list
+ (let (, at coerced)
+ (declare , at decls)
+ , at body))
+ `(defun ,name ,lambda-list
+ (declare , at decls)
+ , at body))))
+
+
+
(defmacro with-resource ((resource init-form) &body body)
`(let ((,resource ,init-form))
(prog1 (progn
@@ -69,11 +103,11 @@
,(when pos
`(translate ,pos))
,(when angle
- `(pal-ffi:gl-rotatef ,angle 0f0 0f0 1f0))
+ `(rotate ,angle))
,(when scale
(let ((s (gensym)))
`(let ((,s ,scale))
- (pal-ffi:gl-scalef ,s ,s 1f0))))
+ (scale ,s ,s))))
(prog1 (progn
, at body)
(pal-ffi:gl-pop-matrix))))
--- /project/pal/cvsroot/pal/pal.asd 2007/07/13 21:30:59 1.2
+++ /project/pal/cvsroot/pal/pal.asd 2007/07/21 16:34:16 1.3
@@ -9,11 +9,11 @@
((:file "ffi"
:depends-on ("package"))
(:file "vector"
- :depends-on ("package"))
+ :depends-on ("pal-macros"))
(:file "pal-macros"
- :depends-on ("ffi" "vector"))
+ :depends-on ("ffi"))
(:file "pal"
- :depends-on ("pal-macros"))
+ :depends-on ("pal-macros" "vector"))
(:file "package"))
:depends-on ("cffi"))
--- /project/pal/cvsroot/pal/pal.lisp 2007/07/19 18:51:37 1.17
+++ /project/pal/cvsroot/pal/pal.lisp 2007/07/21 16:34:16 1.18
@@ -1,8 +1,5 @@
;; Notes:
-;; tags-resources-free
-;; raise on top on windows
;; smoothed polygons, guess circle segment count
-;; defunct
;; calculate max-texture-size
;; fix the fps
@@ -113,6 +110,7 @@
(declaim (inline clamp))
(defun clamp (min v max)
+ (declare (number min max))
(max min (min max v)))
(defun relt (sequence)
@@ -171,10 +169,12 @@
;; Events
(declaim (inline key-pressed-p))
-(defun key-pressed-p (keysym)
+(defunct key-pressed-p (keysym)
+ (symbol keysym)
(gethash keysym *pressed-keys*))
-(defun keysym-char (keysym)
+(defunct keysym-char (keysym)
+ (symbol keysym)
(code-char (cffi:foreign-enum-value 'pal-ffi:sdl-key keysym)))
(declaim (inline get-mouse-pos))
@@ -197,13 +197,13 @@
(defun wait-keypress ()
(let ((key nil))
(event-loop
- (:key-down-fn (lambda (k)
- (setf key k)
- (return-from event-loop key))))
+ (:key-down-fn (lambda (k)
+ (setf key k)
+ (return-from event-loop key))))
(event-loop
- (:key-up-fn (lambda (k)
- (when (eq key k)
- (return-from event-loop key)))))
+ (:key-up-fn (lambda (k)
+ (when (eq key k)
+ (return-from event-loop key)))))
key))
@@ -234,9 +234,9 @@
(if (or (eq t *cursor*) (eq nil *cursor*))
(when *messages*
(with-default-settings
- (draw-messages)))
+ (draw-messages)))
(with-default-settings
- (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*))
+ (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*))
(draw-messages)))
(pal-ffi:gl-swap-buffers))
@@ -253,22 +253,23 @@
(truncate 1000 *fps*))
(declaim (inline clear-screen))
-(defun clear-screen (r g b)
- (declare (type u8 r g b))
+(defunct clear-screen (r g b)
+ (u8 r u8 g u8 b)
(pal-ffi:gl-clear-color (/ r 255f0)
(/ g 255f0)
(/ b 255f0)
1f0)
(pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+))
-(defun set-mouse-pos (x y)
+(defunct set-mouse-pos (x y)
+ (u16 x u16 y)
(pal-ffi:warp-mouse x y)
(setf *mouse-x* x
*mouse-y* y))
(defun set-cursor (image &optional offset)
- (declare (type (or image boolean) image))
- (assert (or (image-p image) (typep image 'boolean)))
+ (assert (and (or (null offset) (vec-p offset))
+ (or (image-p image) (typep image 'boolean))))
(when offset
(setf *cursor-offset* offset))
(cond
@@ -281,7 +282,8 @@
(pal-ffi:show-cursor nil)))
image)
-(defun push-clip (x y width height)
+(defunct push-clip (x y width height)
+ (u16 x u16 y u16 width u16 height)
(pal-ffi:gl-scissor x y width height)
(pal-ffi:gl-enable pal-ffi:+gl-scissor-test+)
(push (vector x y width height) *clip-stack*))
@@ -299,7 +301,8 @@
;; State
(declaim (inline set-blend-mode))
-(defun set-blend-mode (mode)
+(defunct set-blend-mode (mode)
+ (symbol mode)
(case mode
((nil) (pal-ffi:gl-disable pal-ffi:+gl-blend+))
(:blend (pal-ffi:gl-enable pal-ffi:+gl-blend+)
@@ -308,18 +311,18 @@
(pal-ffi:gl-blendfunc pal-ffi:+gl-src-alpha+ pal-ffi:+gl-one+))))
(declaim (inline rotate))
-(defun rotate (angle)
- (declare (type single-float angle))
+(defunct rotate (angle)
+ (single-float angle)
(pal-ffi:gl-rotatef angle 0f0 0f0 1f0))
(declaim (inline scale))
-(defun scale (x y)
- (declare (type single-float x y))
+(defunct scale (x y)
+ (single-float x single-float y)
(pal-ffi:gl-scalef x y 1f0))
(declaim (inline translate))
-(defun translate (vec)
- (declare (type vec vec))
+(defunct translate (vec)
+ (vec vec)
(pal-ffi:gl-translatef (vx vec) (vy vec) 0f0))
(declaim (inline reset-blend-mode))
@@ -328,13 +331,13 @@
(set-blend-color 255 255 255 255))
(declaim (inline set-blend-color))
-(defun set-blend-color (r g b a)
- (declare (type u8 r g b a))
+(defunct set-blend-color (r g b a)
+ (u8 r u8 g u8 b u8 a)
(pal-ffi:gl-color4ub r g b a))
(declaim (inline set-image))
-(defun set-image (image)
- (declare (type image image))
+(defunct set-image (image)
+ (image image)
(unless (eq image *current-image*)
(setf *current-image* image)
(pal-ffi:gl-bind-texture pal-ffi:+gl-texture-2d+ (pal-ffi::image-texture image))))
@@ -445,7 +448,8 @@
(pal-ffi::free-surface surface)
image))
-(defun screen-to-array (pos width height)
+(defunct screen-to-array (pos width height)
+ (vec pos u16 width u16 height)
(let ((array (make-array (list width height))))
(cffi:with-foreign-object (image :unsigned-char (* width height 3))
(pal-ffi:gl-read-pixels (truncate (vx pos))
@@ -466,8 +470,9 @@
255)))
array)))
-(defun draw-image (image pos &key angle scale valign halign)
- (declare (type image image) (type vec pos) (type (or boolean single-float) angle scale) (type symbol halign valign))
+
+(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)
(set-image image)
(let ((width (image-width image))
(height (image-height image))
@@ -512,9 +517,8 @@
(pal-ffi:gl-vertex2f x (+ y height)))))))
-
-(defun draw-image* (image from-pos to-pos width height)
- (declare (type image image) (type vec from-pos to-pos) (type u11 width height))
+(defunct draw-image* (image from-pos to-pos width height)
+ (image image vec from-pos vec to-pos u11 width u11 height)
(set-image image)
(let* ((vx (vx from-pos))
(vy (vy from-pos))
@@ -535,47 +539,47 @@
(pal-ffi:gl-vertex2f vx-to (+ vy-to height)))))
(declaim (inline draw-line))
-(defun draw-line (la lb r g b a &key (size 1.0f0) (smoothp))
- (declare (type vec la lb) (type u8 r g b a) (type single-float size))
+(defunct draw-line (la lb r g b a &key (size 1.0f0) (smoothp))
+ (vec la vec lb single-float size u8 r u8 g u8 b u8 a boolean smoothp)
(with-line-settings smoothp size r g b a
- (with-gl pal-ffi:+gl-lines+
- (pal-ffi:gl-vertex2f (vx la) (vy la))
- (pal-ffi:gl-vertex2f (vx lb) (vy lb)))))
+ (with-gl pal-ffi:+gl-lines+
+ (pal-ffi:gl-vertex2f (vx la) (vy la))
+ (pal-ffi:gl-vertex2f (vx lb) (vy lb)))))
(declaim (inline draw-arrow))
-(defun draw-arrow (la lb r g b a &key (size 1.0f0) smoothp)
- (declare (type vec la lb) (type u8 r g b a) (type single-float size))
+(defunct draw-arrow (la lb r g b a &key (size 1.0f0) smoothp)
+ (vec la vec lb u8 r u8 g u8 b u8 a single-float size boolean smoothp)
(with-line-settings smoothp size r g b a
- (let ((d (v* (v-direction la lb) (+ size 8f0))))
- (with-gl pal-ffi:+gl-lines+
- (pal-ffi:gl-vertex2f (vx la) (vy la))
- (pal-ffi:gl-vertex2f (vx lb) (vy lb))
- (pal-ffi:gl-vertex2f (vx lb) (vy lb))
- (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0)))
- (vy (v+ lb (v-rotate d 140f0))))
- (pal-ffi:gl-vertex2f (vx lb) (vy lb))
- (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0)))
- (vy (v+ lb (v-rotate d -140f0))))))))
+ (let ((d (v* (v-direction la lb) (+ size 8f0))))
+ (with-gl pal-ffi:+gl-lines+
+ (pal-ffi:gl-vertex2f (vx la) (vy la))
+ (pal-ffi:gl-vertex2f (vx lb) (vy lb))
+ (pal-ffi:gl-vertex2f (vx lb) (vy lb))
+ (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0)))
+ (vy (v+ lb (v-rotate d 140f0))))
+ (pal-ffi:gl-vertex2f (vx lb) (vy lb))
+ (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0)))
+ (vy (v+ lb (v-rotate d -140f0))))))))
(declaim (inline draw-point))
-(defun draw-point (pos r g b a &key (size 1f0) smoothp)
- (declare (type vec pos) (type u8 r g b a) (type single-float size))
+(defunct draw-point (pos r g b a &key (size 1f0) smoothp)
+ (vec pos u8 r u8 g u8 b u8 a single-float size boolean smoothp)
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(if smoothp
(pal-ffi:gl-enable pal-ffi:+gl-point-smooth+)
(pal-ffi:gl-disable pal-ffi:+gl-point-smooth+))
(pal-ffi:gl-point-size size)
- (set-blend-color r g b a)
+ (pal-ffi:gl-color4ub r g b a)
(with-gl pal-ffi:+gl-point+
(pal-ffi:gl-vertex2f (vx pos) (vy pos)))
(pal-ffi:gl-pop-attrib))
-(defun draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep smoothp)
- (declare (type vec pos) (type boolean absolutep) (type float size) (type u11 width height) (type u8 r g b a) (type (or image boolean) fill))
+(defunct draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep smoothp)
+ (vec pos u16 width u16 height u8 r u8 g u8 b u8 a (or symbol image) fill single-float size boolean absolutep boolean smoothp)
(cond
((image-p fill)
(draw-polygon (list pos
@@ -587,28 +591,28 @@
:absolutep absolutep))
((eq nil fill)
(with-line-settings smoothp size r g b a
- (with-gl pal-ffi:+gl-line-loop+
- (pal-ffi:gl-vertex2f (vx pos) (vy pos))
- (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos))
- (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos))
- (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height))
- (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height))
- (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))
- (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))))
+ (with-gl pal-ffi:+gl-line-loop+
+ (pal-ffi:gl-vertex2f (vx pos) (vy pos))
+ (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos))
+ (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos))
+ (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height))
+ (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height))
+ (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))
+ (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))))
(t
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
- (set-blend-color r g b a)
+ (pal-ffi:gl-color4ub r g b a)
(pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height))
(pal-ffi:gl-pop-attrib))))
-(defun draw-polygon (points r g b a &key (fill t) absolutep (size 1f0) smoothp)
- (declare (type list points) (type u8 r g b a) (type (or image boolean) fill))
+(defunct draw-polygon (points r g b a &key (fill t) absolutep (size 1f0) smoothp)
+ (list points u8 r u8 g u8 b u8 a (or image boolean) fill single-float size)
(cond
((image-p fill)
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+))
(set-image fill)
- (set-blend-color r g b a)
+ (pal-ffi:gl-color4ub r g b a)
(with-gl pal-ffi:+gl-polygon+
(let ((dx (vx (first points)))
(dy (vy (first points))))
@@ -628,20 +632,20 @@
(pal-ffi:gl-pop-attrib))
((eq nil fill)
(with-line-settings smoothp size r g b a
- (with-gl pal-ffi:+gl-line-loop+
- (dolist (p points)
- (pal-ffi:gl-vertex2f (vx p) (vy p))))))
+ (with-gl pal-ffi:+gl-line-loop+
+ (dolist (p points)
+ (pal-ffi:gl-vertex2f (vx p) (vy p))))))
(t
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))
- (set-blend-color r g b a)
+ (pal-ffi:gl-color4ub r g b a)
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(with-gl pal-ffi:+gl-polygon+
(dolist (p points)
(pal-ffi:gl-vertex2f (vx p) (vy p))))
(pal-ffi:gl-pop-attrib))))
-(defun draw-polygon* (points &key image tex-coords colors)
- (declare (type list points tex-coords colors) (type (or boolean image) image))
+(defunct draw-polygon* (points &key image tex-coords colors)
+ (list points list tex-coords list colors (or boolean image) image)
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))
(cond
((and image tex-coords)
@@ -678,7 +682,8 @@
(pal-ffi:gl-vertex2f (vx p) (vy p))))))
(pal-ffi:gl-pop-attrib))
-(defun draw-circle (pos radius r g b a &key (fill t) absolutep (size 1f0) smoothp (segments 30))
+(defunct draw-circle (pos radius r g b a &key (fill t) absolutep (size 1f0) smoothp (segments 30))
+ (vec pos single-float radius u8 r u8 g u8 b u8 a (or image symbol) fill boolean absolutep single-float size boolean smoothp fixnum segments)
(declare (type vec pos) (type fixnum segments))
(draw-polygon (loop for a from 0 to (* 2 pi) by (/ (* 2 pi) segments) collecting
(v+ pos
@@ -700,7 +705,7 @@
(let ((channel (pal-ffi:play-channel -1 (pal-ffi:sample-chunk sample) (if (numberp loops)
loops
0))))
- (pal-ffi:set-position channel angle (- 255 volume))
+ (pal-ffi:set-position channel (truncate angle) (- 255 volume))
channel))
(defun set-sample-volume (sample volume)
@@ -716,10 +721,11 @@
(defun play-music (music &key (loops t) (volume 255))
"Volume 0-255. Loops is: t = forever, nil = once, number = number of loops"
- (pal-ffi:volume-music (1+ (truncate volume 2)))
- (pal-ffi:play-music (pal-ffi:music-music music) (cond ((eq loops t) -1)
- ((null loops) 0)
- (t loops))))
+ (let ((loops (truncate loops)))
+ (pal-ffi:volume-music (1+ (truncate volume 2)))
+ (pal-ffi:play-music (pal-ffi:music-music music) (cond ((eq loops t) -1)
+ ((null loops) 0)
+ (t loops)))))
(defun set-music-volume (volume)
"Volume 0-255"
@@ -795,8 +801,8 @@
(pal-ffi:gl-vertex2f 0f0 height)))
(translate (v (+ (glyph-width g) (glyph-xoff g)) 0)))
-(defun draw-text (text pos &optional font)
- (declare (type vec pos) (type simple-string text) (type (or font boolean) font))
+(defunct draw-text (text pos &optional font)
+ (vec pos simple-string text (or font boolean) font)
(with-transformation (:pos pos)
(let* ((font (if font
font
@@ -807,14 +813,14 @@
(pal-ffi:gl-call-list (+ first-dl (char-code char)))))))
(declaim (inline get-font-height))
-(defun get-font-height (&optional font)
- (declare (type (or font boolean) font))
+(defunct get-font-height (&optional font)
+ ((or font boolean) font)
(pal-ffi:font-height (if font
font
(tag 'default-font))))
-(defun get-text-size (text &optional font)
- (declare (type (or font boolean) font) (type simple-string text))
+(defunct get-text-size (text &optional font)
+ ((or font boolean) font simple-string text)
(values (let ((glyphs (pal-ffi:font-glyphs (if font
font
(tag 'default-font)))))
--- /project/pal/cvsroot/pal/todo.txt 2007/07/19 18:51:37 1.12
+++ /project/pal/cvsroot/pal/todo.txt 2007/07/21 16:34:16 1.13
@@ -4,6 +4,8 @@
- Implement image mirroring.
+- Image tiles and animation.
+
- Box/box/line/circle etc. overlap functions, faster v-dist.
- Improved texture handling.
@@ -14,11 +16,6 @@
- I would really like to see it run on OS X.
-- Simple and transparent animation system for images.
-
-- Using fullscreen mode on Windows some times results in screen flickering
- between desktop and PAL screen, usually fixed by alt-tabbing. Should be fixed.
-
- The problems with Linux and some gfx drivers should be somehow fixed.
- Documentation and tutorials.
--- /project/pal/cvsroot/pal/vector.lisp 2007/07/18 19:26:31 1.4
+++ /project/pal/cvsroot/pal/vector.lisp 2007/07/21 16:34:16 1.5
@@ -3,132 +3,147 @@
(in-package :pal)
-#+CL-HAS-FULL-NUMERIC-TOWER-DAMMIT (deftype component () 'number)
-#-CL-HAS-FULL-NUMERIC-TOWER-DAMMIT (deftype component () 'single-float)
+
+(deftype component () 'single-float)
(defstruct (vec (:conc-name v))
(x 0 :type component) (y 0 :type component))
(declaim (inline component))
-(defun component (x)
+(defunct component (x)
+ (number x)
(coerce x 'component))
(declaim (inline v))
-(defun v (x y)
- (make-vec :x (component x) :y (component y)))
+(defunct v (x y)
+ (component x component y)
+ (make-vec :x x :y y))
(declaim (inline vf))
(defun vf (x y)
+ (declare (type component x) (type component y))
(make-vec :x x :y y))
+
+
(declaim (inline rad))
-(defun rad (degrees)
- (declare (type component degrees))
+(defunct rad (degrees)
+ (number degrees)
(component (* (/ pi 180) degrees)))
-(defun deg (radians)
- (declare (type component radians))
+(declaim (inline deg))
+(defunct deg (radians)
+ (number radians)
(component (* (/ 180 pi) radians)))
-(defun angle-v (angle)
- (declare (type component angle))
+(declaim (inline angle-v))
+(defunct angle-v (angle)
+ (number angle)
(v (sin (rad angle)) (- (cos (rad angle)))))
(declaim (inline vec-angle))
-(defun v-angle (vec)
- (declare (type vec vec))
+(defunct v-angle (vec)
+ (vec vec)
(mod (deg (atan (vx vec)
(if (zerop (vy vec))
least-negative-short-float
(- (vy vec)))))
360))
-(defun v-random (length)
+(defunct v-random (length)
+ (number length)
(v* (angle-v (random 360.0)) length))
(declaim (inline v-round))
-(defun v-round (v)
- (declare (type vec v))
+(defunct v-round (v)
+ (vec v)
(v (round (vx v)) (round (vy v))))
(declaim (inline v-floor))
-(defun v-floor (v)
- (declare (type vec v))
+(defunct v-floor (v)
+ (vec v)
(v (floor (vx v)) (floor (vy v))))
(declaim (inline v=))
-(defun v= (a b)
+(defunct v= (a b)
+ (vec a vec b)
(and (= (vx a) (vx b))
(= (vy a) (vy b))))
(declaim (inline v+!))
-(defun v+! (a b)
+(defunct v+! (a b)
+ (vec a vec b)
(setf (vx a) (+ (vx a) (vx b)))
(setf (vy a) (+ (vy a) (vy b)))
nil)
(declaim (inline v+))
-(defun v+ (a b)
+(defunct v+ (a b)
+ (vec a vec b)
(vf (+ (vx a) (vx b))
(+ (vy a) (vy b))))
(declaim (inline v-))
-(defun v- (a b)
+(defunct v- (a b)
+ (vec a vec b)
(vf (- (vx a) (vx b))
(- (vy a) (vy b))))
(declaim (inline v-!))
-(defun v-! (a b)
+(defunct v-! (a b)
+ (vec a vec b)
(setf (vx a) (- (vx a) (vx b)))
(setf (vy a) (- (vy a) (vy b)))
nil)
(declaim (inline v*!))
-(defun v*! (v m)
- (declare (type component m))
+(defunct v*! (v m)
+ (component m)
(setf (vx v) (* (vx v) m))
(setf (vy v) (* (vy v) m))
nil)
(declaim (inline v*))
-(defun v* (v m)
- (declare (type component m))
+(defunct v* (v m)
+ (vec v component m)
(vf (* (vx v) m)
(* (vy v) m)))
(declaim (inline v/))
-(defun v/ (v d)
- (declare (type component d))
+(defunct v/ (v d)
+ (vec v component d)
(vf (/ (vx v) d)
(/ (vy v) d)))
(declaim (inline v/!))
-(defun v/! (v d)
- (declare (type component d))
+(defunct v/! (v d)
+ (vec v component d)
(setf (vx v) (/ (vx v) d))
(setf (vy v) (/ (vy v) d))
nil)
(declaim (inline v-max))
-(defun v-max (a b)
+(defunct v-max (a b)
+ (vec a vec b)
(if (< (v-magnitude a) (v-magnitude b))
b a))
(declaim (inline v-min))
-(defun v-min (a b)
+(defunct v-min (a b)
+ (vec a vec b)
(if (< (v-magnitude a) (v-magnitude b))
a b))
-(defun v-rotate (v a)
- (declare (type component a) (type vec v))
+(defunct v-rotate (v a)
+ (vec v component a)
(let ((a (rad a)))
(vf (- (* (cos a) (vx v))
(* (sin a) (vy v)))
@@ -136,43 +151,44 @@
(* (cos a) (vy v))))))
(declaim (inline v-dot))
-(defun v-dot (a b)
+(defunct v-dot (a b)
+ (vec a vec b)
(+ (* (vx a) (vx b))
(* (vy a) (vy b))))
(declaim (inline v-magnitude))
-(defun v-magnitude (v)
- (declare (type vec v))
+(defunct v-magnitude (v)
+ (vec v)
(the component (sqrt (the component
(+ (expt (vx v) 2)
(expt (vy v) 2))))))
-(declaim (inline v-normalize))
-(defun v-normalize (v)
+(defunct v-normalize (v)
+ (vec v)
(if (/= (v-magnitude v) 0.0)
(vf (/ (vx v) (v-magnitude v))
(/ (vy v) (v-magnitude v)))
(vf 0.0 0.0)))
-
-(defun v-direction (from-vector to-vector)
+(defunct v-direction (from-vector to-vector)
+ (vec from-vector vec to-vector)
(v-normalize (v- to-vector from-vector)))
-
-(declaim (inline v-distance))
-(defun v-distance (v1 v2)
- (declare (type vec v1 v2))
+(defunct v-distance (v1 v2)
+ (vec v1 vec v2)
(v-magnitude (v- v1 v2)))
-(defun v-truncate (v l)
+
+(defunct v-truncate (v l)
+ (vec v component l)
(v* (v-normalize v) l))
-(defun closest-point-to-line (a b p)
- (declare (type vec a b p))
+(defunct closest-point-to-line (a b p)
+ (vec a vec b vec p)
(let* ((dir (v- b a))
(diff (v- p a))
(len (v-dot dir dir)))
@@ -185,16 +201,15 @@
b)
a)))))
-(declaim (inline point-in-line))
-(defun point-in-line (a b p)
- (declare (type vec a b p))
+(defunct point-in-line (a b 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)))
-(defun lines-intersection (la1 la2 lb1 lb2)
- (declare (type vec la1 la2 lb1 lb2))
+(defunct lines-intersection (la1 la2 lb1 lb2)
+ (vec la1 vec la2 vec lb1 vec lb2)
(let ((x1 (vx la1))
(y1 (vy la1))
(x2 (vx la2))
@@ -219,8 +234,8 @@
p
nil))))))
-(defun circle-line-intersection (a b co r)
- (declare (type vec a b co) (type component r))
+(defunct circle-line-intersection (a b co 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)
@@ -228,15 +243,15 @@
nil)
nil)))
-(defun distance-from-line (a b p)
- (declare (type vec a b p))
+(defunct distance-from-line (a b p)
+ (vec a vec b vec p)
(let ((cp (closest-point-to-line a b p)))
(if cp
(v-distance cp p)
nil)))
-(defun point-inside-rectangle (topleft width height pos)
- (declare (type (or component fixnum) width height) (type vec pos topleft))
+(defunct point-inside-rectangle (topleft width height pos)
+ (vec topleft vec pos component width component height)
(let* ((x1 (vx topleft))
(y1 (vy topleft))
(x2 (+ x1 width))
@@ -248,11 +263,11 @@
t nil)))
(declaim (inline point-inside-circle))
-(defun point-inside-circle (co r p)
- (declare (type vec co p) (type component r))
+(defunct point-inside-circle (co r p)
+ (vec co vec p component r)
(<= (v-distance co p) r))
(declaim (inline circles-overlap))
-(defun circles-overlap (c1 r1 c2 r2)
- (declare (vec c1 c2) (component r1 r2))
+(defunct circles-overlap (c1 r1 c2 r2)
+ (vec c1 vec c2 component r1 component r2)
(<= (v-distance c1 c2) (+ r2 r1)))
\ No newline at end of file
More information about the Pal-cvs
mailing list