Changes between Initial Version and Version 1 of GradientWindow


Ignore:
Timestamp:
Oct 29, 2007, 4:07:24 AM (14 years ago)
Author:
rme
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • GradientWindow

    v1 v1  
     1If you still crave red even after reading the example from the CocoaBridge topic,
     2here's an even more elaborate example.
     3
     4The point of this example is to demonstrate a non-trivial use of the OpenMCL
     5foreign function interface.
     6
     7(The `(float ... ccl::+cgfloat-zero+)` business is necessary because a `CGFloat` is
     8a single float on 32-bit systems, and a double-float on 64-bit systems, and we want
     9the same source code to work on both.)
     10
     11{{{
     12(defcallback red-black-ramp (:address info (:array :<CGF>loat) in (:array :<CGF>loat) out :void)
     13  (declare (ignore info))
     14  (let ((w (paref in (:array :<CGF>loat) 0)))
     15    (setf (paref out (:array :<CGF>loat) 0) (float (- 1.0 (abs (- 1.0 (* w 2.0)))) ccl::+cgfloat-zero+)
     16          (paref out (:array :<CGF>loat) 1) (float (- 1.0 (abs (+ (* 1.0 (- 1.0 w)) (* 0.878 w)))) ccl::+cgfloat-zero+)
     17          (paref out (:array :<CGF>loat) 2) (float 0.0 ccl::+cgfloat-zero+)
     18          (paref out (:array :<CGF>loat) 3) (float 1.0 ccl::+cgfloat-zero+))))
     19
     20(defun rgb-function (eval-fn)
     21  (let* ((zero (float 0.0 ccl::+cgfloat-zero+))
     22         (one (float 1.0 ccl::+cgfloat-zero+)))
     23    (rlet ((domain (:array :<CGF>loat 2))
     24           (range (:array :<CGF>loat 8)))
     25     
     26      ;; Shadings parameterize the input between 0 (the starting point
     27      ;; of the shading) and 1 (the ending point of the shading).
     28      (setf (paref domain (:array :<CGF>loat) 0) zero
     29            (paref domain (:array :<CGF>loat) 1) one)
     30     
     31      ;; The range of the output colors.  For an RGB color space, there
     32      ;; are four (start, end) pairs: one for each R, G, B, A component.
     33      (setf
     34       ;; red
     35       (paref range (:array :<CGF>loat) 0) zero
     36       (paref range (:array :<CGF>loat) 1) one
     37       ;; green
     38       (paref range (:array :<CGF>loat) 2) zero
     39       (paref range (:array :<CGF>loat) 3) one
     40       ;; blue
     41       (paref range (:array :<CGF>loat) 4) zero
     42       (paref range (:array :<CGF>loat) 5) one
     43       ;; alpha
     44       (paref range (:array :<CGF>loat) 6) zero
     45       (paref range (:array :<CGF>loat) 7) one)
     46     
     47      (rlet ((callbacks :<CGF>unction<C>allbacks))
     48            (setf (pref callbacks :<CGF>unction<C>allbacks.version) 0
     49                  (pref callbacks :<CGF>unction<C>allbacks.release<I>nfo) +null-ptr+
     50                  (pref callbacks :<CGF>unction<C>allbacks.evaluate) eval-fn)
     51            (#_CGFunctionCreate +null-ptr+ 1 domain 4 range callbacks)))))
     52
     53(defclass gradient-view (ns:ns-view)
     54  ()
     55  (:metaclass ns:+ns-object))
     56
     57(objc:defmethod (#/drawRect: :void) ((self gradient-view) (rect :<NSR>ect))
     58  (#_NSRectFill (#/bounds self))
     59  (let* ((extend-start 1)
     60         (extend-end 1)
     61         (color-space (#_CGColorSpaceCreateDeviceRGB))
     62         (fn (rgb-function red-black-ramp))
     63         (shading nil)
     64         (context (#/graphicsPort (#/currentContext ns:ns-graphics-context))))
     65    (let ((p0 (ns:make-ns-point 20 20))
     66          (p1 (ns:make-ns-point 100 280)))
     67      (setq shading (#_CGShadingCreateAxial color-space p0 p1 fn
     68                                            extend-start extend-end)))
     69    (#_CFRelease color-space)
     70    (#_CFRelease fn)
     71    (#_CGContextDrawShading context shading)
     72    (#_CGShadingRelease shading)))
     73
     74(defun show-gradient-window ()
     75  (ccl::with-autorelease-pool
     76   (let* ((rect (ns:make-ns-rect 0 0 300 300))
     77          (w (make-instance 'ns:ns-window
     78                            :with-content-rect rect
     79                            :style-mask (logior #$NSTitledWindowMask
     80                                               #$NSClosableWindowMask
     81                                               #$NSMiniaturizableWindowMask)
     82                            :backing #$NSBackingStoreBuffered
     83                            :defer t)))
     84     (#/setTitle: w #@"Red Gradient")
     85     (#/setContentView: w (#/autorelease (make-instance 'gradient-view)))
     86     (#/center w)
     87     (#/orderFront: w nil)
     88     (#/contentView w))))
     89}}}
     90
     91Load the file containing these forms, evaluate `(show-gradient-window)` and you'll
     92see a window with a red gradient in it.
     93