Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv15409/mcclim/Backends/beagle Modified Files: cocoa-util.lisp Log Message: Some tidying up of code. Rearranged EVENTS.LISP somewhat in preparation of better key event handling. Minor changes to rounding and coercing of coordinates in Beagle. Date: Sat May 28 21:56:05 2005 Author: drose Index: mcclim/Backends/beagle/cocoa-util.lisp diff -u mcclim/Backends/beagle/cocoa-util.lisp:1.2 mcclim/Backends/beagle/cocoa-util.lisp:1.3 --- mcclim/Backends/beagle/cocoa-util.lisp:1.2 Tue Jul 13 19:37:56 2004 +++ mcclim/Backends/beagle/cocoa-util.lisp Sat May 28 21:56:04 2005 @@ -23,57 +23,24 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;(in-package :clim-cocoa) - (in-package :ccl) -;(require "OBJC-SUPPORT") - -;; Should be using "with-autorelease-pool" somewhere... but for now, take it out because -;; something isn't working... - -;; Make an NSColor object that is the desired colour provided as a parameter, and with -;; the opacity provided in the key argument (defaults to 1.0 (opaque)). -;;;(defun make-ns-color (desired-color &key (alpha 1.0)) -;;; (cl-user::debug-log 1 "cocoa-util.lisp: -> MAKE-NS-COLOR() - TYPE-OF (desired-color): ~A~%" -;;; (type-of desired-color)) -;;; (cl-user::debug-log 1 "cocoa-util: Entered MAKE-NS-COLOR, desired colour = ~S~%" desired-color) -;;; (multiple-value-bind (r g b) -;;; (clim:color-rgb desired-color) -;;; (send (@class ns-color) :color-with-calibrated-red r -;;; :green g -;;; :blue b -;;; :alpha alpha))) - - -;; Given a CLIM event-mask, generate a Cocoa event-mask -;;;(defun clim-event-mask->cocoa-event-mask (event-mask) -;;; (cl-user::debug-log 1 "cocoa-util: Entered CLIM-EVENT-MASK->COCOA-EVENT-MASK (stubbed)~%") -;;; event-mask) - -;; Tell an NSWindow what events to respond to -;;;(defun set-ns-window-event-mask (window event-mask) -;;; (cl-user::debug-log 1 "cocoa-util: Entered SET-NS-WINDOW-EVENT-MASK~%") -;;; (send window :next-event-matching-mask event-mask)) ;; Make an NSRect structure with the origin at (x, y) and with the width and height ;; specified. (defun make-ns-rect (x y width height) - (make-record :<NSR>ect :origin.x (+ (coerce x 'short-float) 0.5) - :origin.y (+ (coerce y 'short-float) 0.5) - :size.width (coerce width 'short-float) - :size.height (coerce height 'short-float))) + "Make a Cocoa NSRect structure with the origin at (x, y) and with the +width and height specified. The memory for any structure created with +this method must be released by the user (using (#_free))." + (make-record :<NSR>ect :origin.x x + :origin.y y + :size.width width + :size.height height)) (defun make-ns-point (x y) - (make-record :<NSP>oint :x (+ (coerce x 'short-float) 0.5) - :y (+ (coerce y 'short-float) 0.5))) - -;; Get the *NSApp* reference -;;;(defun get-ns-app () -;;; *NSApp*) - -;; Send the NSWindow provided a setFrame: message -;;;(defun window-set-frame (window rect &key (display t)) -;;; (send window :set-frame rect :display display)) + "Make a Cocoa NSPoint structure populated with x and y provided. +The memory for any structure created with this method must be released +by the user (using (#_free))." + (make-record :<NSP>oint :x x :y y)) ;; Stolen from Bosco "main.lisp" (defun description (c)