Changeset 7353 for branches

Timestamp:

Oct 5, 2007, 5:41:57 AM (17 years ago)

Author:

af

Message:

Implement a drawing view, add a demo (tiny.lisp)

Also, fix a few things:

• Titles in windows weren't correct.
• Extract the content-view functions from window into a mixin.

Location:

branches/easygui/ccl/examples/cocoa/easygui

Files:

• easygui.asd (modified) (1 diff)
• new-cocoa-bindings.lisp (modified) (2 diffs)
• package.lisp (modified) (1 diff)
• tiny.lisp (added)
• views.lisp (modified) (10 diffs)

branches/easygui/ccl/examples/cocoa/easygui/easygui.asd

@@ -28 +28 @@
                  (:file "action-targets" :depends-on ("views"))
                  ;;; example:
-                 (:file "currency-converter" :depends-on ("new-cocoa-bindings"))))
+                 (:file "tiny" :depends-on ("action-targets"))
+                 (:file "currency-converter" :depends-on ("action-targets"))))

branches/easygui/ccl/examples/cocoa/easygui/new-cocoa-bindings.lisp

@@ -1 +1 @@
 (in-package :easygui)
+
+;;; Helper types:
 
 (defclass eg-point ()
@@ -21 +23 @@
   (ns:make-ns-range (range-start range) (range-end range)))
 
+(defclass eg-rectangle ()
+     ((x :initarg :x :reader rectangle-x)
+      (y :initarg :y :reader rectangle-y)
+      (width :initarg :width :reader rectangle-width)
+      (height :initarg :height :reader rectangle-height)))
+
+(defun rectangle (x y width height)
+  (assert (>= x 0))
+  (assert (>= y 0))
+  (assert (>= width 0))
+  (assert (>= height 0))
+  (make-instance 'eg-rectangle :x x :y y :width width :height height))
+
+(defun rectangle-nsrect (r)
+  (ns:make-ns-rect (rectangle-x r) (rectangle-y r)
+                   (rectangle-width r) (rectangle-height r)))
+
+(defun nsrect-rectangle (r)
+  (rectangle (ns:ns-rect-x r) (ns:ns-rect-y r)
+             (ns:ns-rect-width r) (ns:ns-rect-height r)))
+
+;;;
 (defclass easy-cocoa-object ()
-     ((ref :accessor cocoa-ref)))
+     ((ref :initarg :cocoa-ref :accessor cocoa-ref)))
 
 (defvar *window-position-default-x* 200)

branches/easygui/ccl/examples/cocoa/easygui/package.lisp

@@ -2 +2 @@
   (:use :cl)
   (:import-from :ccl with-autorelease-pool @selector lisp-string-from-nsstring +null-ptr+)
-  (:export #:point #:range #:window
+  (:export #:point #:range #:rectangle #:window
+           #:point-x #:point-y #:rectangle-x #:rectangle-y #:rectangle-width
+           #:rectangle-height
            ;; view classes
            #:view #:static-text-view #:text-input-view #:password-input-view
            #:push-button-view
-           #:form-view #:form-cell-view #:box-view
+           #:form-view #:form-cell-view #:box-view #:drawing-view
            ;; operators
+           #:cocoa-ref
            #:add-subviews #:window-show #:set-window-title
+           #:content-view
            #:initialize-view #:action #:view-text
            #:add-entry #:add-entries #:editable-p
+           #:draw-view-rectangle
            #:entry-text #:nth-cell #:selection))
 

branches/easygui/ccl/examples/cocoa/easygui/views.lisp

@@ -18 +18 @@
      ((text :initarg :text)))
 (defclass view-text-via-stringvalue-mixin (view-text-mixin) ())
-(defclass view-text-via-title-mixin (view-text-mixin) ())
+(defclass view-text-via-title-mixin (view-text-mixin)
+     ((text :initarg :title)))
 
 (defmethod view-text ((view view-text-via-stringvalue-mixin))
@@ -57 +58 @@
                (ns:ns-range-length range)))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; the actual views (when adding one,
+(defclass content-view-mixin ()
+     (content-view))
+
+(defmethod initialize-view :after ((view content-view-mixin))
+  (setf (slot-value view 'content-view)
+        (make-instance 'view
+           :cocoa-ref (dcc (#/contentView (cocoa-ref view))))))
+
+(defmethod content-view ((view content-view-mixin))
+  (assert (eql (cocoa-ref (slot-value view 'content-view))
+               (dcc (#/contentView (cocoa-ref view)))))
+  (slot-value view 'content-view))
+
+(defmethod (setf content-view) (new-content-view (view content-view-mixin))
+  (setf (slot-value view 'content-view) new-content-view)
+  (dcc (#/setContentView: (cocoa-ref view) (cocoa-ref new-content-view))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; the actual views (when adding a new class,
 ;;; consider *view-class-to-ns-class-map*):
 
@@ -66 +84 @@
       (frame-inited-p :initform nil)))
 
-(defclass window (view)
+(defclass window (content-view-mixin view-text-via-title-mixin view)
      ((text :initarg :title :initform "" :reader window-title)
       (zoomable-p :initarg :zoomable-p :initform t :reader window-zoomable-p)
@@ -73 +91 @@
       (resizable-p :initarg :resizable-p :initform t
                    :reader window-resizable-p)
-      (closable-p :initarg :closable-p :initform t :reader window-closable-p)
-      (content-view :initform nil :reader window-content-view)))
+      (closable-p :initarg :closable-p :initform t :reader window-closable-p)))
 
 (defclass static-text-view (view view-text-via-stringvalue-mixin) ())
@@ -99 +116 @@
 
 (defclass form-cell-view (view editable-mixin view-text-via-stringvalue-mixin)
-     ((ref :initarg :cocoa-ref)))
-
-(defclass box-view (view) ())
+     ())
+
+(defclass box-view (content-view-mixin view) ())
+
+(defclass drawing-view (view) ())
 
 (defparameter *view-class-to-ns-class-map*
@@ -110 +129 @@
                 (form-view . ns:ns-form)
                 (form-cell-view . ns:ns-form-cell)
-                (box-view . ns:ns-box)))
+                (box-view . ns:ns-box)
+                (drawing-view . cocoa-drawing-view)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -124 +144 @@
   "Initializes the view via the class-to-ns-class map."
   (when (slot-boundp view 'ref)
-    (format *trace-output* "hey, it's bound! (on ~A)~%" view)
     (return-from initialize-view nil))
   (let ((ns-view-class (cdr (assoc (class-name (class-of view))
-                                   *view-class-to-ns-class-map*))))
+                                   *view-class-to-ns-class-map*
+                                   :test #'subtypep))))
     (when ns-view-class
       (setf (cocoa-ref view)
@@ -165 +185 @@
                                 :style-mask style-mask
                                 :backing #$NSBackingStoreBuffered ; TODO?
-                                :defer nil))
-       ;; initialize the content-view proxy object
-       (setf (slot-value win 'content-view)
-             (make-instance 'view))
-       (setf (cocoa-ref (window-content-view win))
-             (dcc (#/contentView (cocoa-ref win)))))))
+                                :defer nil)))))
 
 (defmethod initialize-view :after ((view text-input-view))
@@ -206 +221 @@
 ;;; view hierarchies:
 
-(defmethod add-1-subview :around ((view view) (window window))
-  (add-1-subview view (window-content-view window)))
+(defmethod add-1-subview :around ((view view) (cw-view content-view-mixin))
+  (add-1-subview view (content-view cw-view)))
 
 (defmethod add-1-subview :around ((view view) (super-view view))
@@ -262 +277 @@
   (view-text (nth-cell index view)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Drawing:
+
+(defclass cocoa-drawing-view (ns:ns-view)
+     ((easygui-view :initarg :eg-view :reader easygui-view-of))
+  (:metaclass ns:+ns-view))
+
+(defmethod initialize-view :after ((view drawing-view))
+  (setf (slot-value (cocoa-ref view) 'easygui-view) view))
+
+(objc:defmethod (#/drawRect: :void) ((self cocoa-drawing-view)
+                                     (rect :<NSR>ect))
+  (draw-view-rectangle (easygui-view-of self) (nsrect-rectangle rect)))
+
+(defgeneric draw-view-rectangle (view rectangle)
+  (:method ((view drawing-view) rectangle)
+    (declare (ignore view rectangle))
+    nil))