[pal-cvs] CVS pal

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 (,@coerced) + (declare ,@decls) + ,@body)) + `(defun ,name ,lambda-list + (declare ,@decls) + ,@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 ,@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