source: trunk/source/examples/tiny.lisp @ 8441

Last change on this file since 8441 was 6251, checked in by gb, 13 years ago

Don't bother using RLET or equivalent to avoid making GCable pointers
for ObjC dispatch function args; trust the compiler to do that for us.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1;;;; -*- Mode: Lisp; Package: CCL -*-
2;;;; tiny.lisp
3;;;;
4;;;; A fairly direct translation into Lisp of the Tiny application (Chapter 4)
5;;;; from "Building Cocoa Applications" by Garfinkel and Mahoney
6;;;;
7;;;; The original Tiny example was meant to illustrate the programmatic use of
8;;;; Cocoa without Interface Builder.  Its purpose here is to illustrate the
9;;;; programmatic use of the Cocoa bridge.
10;;;;
11;;;; Copyright (c) 2003 Randall D. Beer
12;;;;
13;;;; This software is licensed under the terms of the Lisp Lesser GNU Public
14;;;; License , known as the LLGPL.  The LLGPL consists of a preamble and
15;;;; the LGPL. Where these conflict, the preamble takes precedence.  The
16;;;; LLGPL is available online at http://opensource.franz.com/preamble.html.
17;;;;
18;;;; Please send comments and bug reports to <beer@eecs.cwru.edu>
19
20;;; Temporary package and module stuff
21
22(in-package "CCL")
23
24(require "COCOA")
25
26
27;;; Define the DemoView class
28
29(defclass demo-view (ns:ns-view)
30  ()
31  (:metaclass ns:+ns-object))
32
33
34;;; Define the drawRect: method for DemoView
35;;; NOTE: The (THE NS-COLOR ...) forms are currently necessary for full
36;;;       optimization because the SET message has a nonunique type signature
37;;; NOTE: This will be replaced by a DEFMETHOD once ObjC objects have been
38;;;       integrated into CLOS
39;;; NOTE: The (@class XXX) forms will probably be replaced by
40;;;       (find-class 'XXX) once ObjC objects have been integrated into CLOS
41
42(defconstant short-pi (coerce pi 'short-float))
43(defconstant numsides 12)
44
45(objc:defmethod (#/drawRect: :void) ((self demo-view) (rect :<NSR>ect))
46  (declare (ignore rect))
47  (let* ((bounds (#/bounds self))
48         (width (ns:ns-rect-width bounds))
49         (height (ns:ns-rect-height bounds)))
50    (macrolet ((X (tt) `(* (1+ (sin ,tt)) width 0.5))
51               (Y (tt) `(* (1+ (cos ,tt)) height 0.5)))
52      ;; Fill the view with white
53      (#/set (#/whiteColor ns:ns-color))
54      (#_NSRectFill bounds)
55      ;; Trace two polygons with N sides and connect all of the vertices
56      ;; with lines
57      (#/set (#/blackColor ns:ns-color))
58      (loop 
59        for f from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
60        do
61        (loop 
62          for g from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
63          do
64          (#/strokeLineFromPoint:toPoint: ns:ns-bezier-path (ns:make-ns-point (X f) (Y f)) (ns:make-ns-point (X g) (Y g))))))))
65
66
67;;; This performs the actions that would normally be performed by loading
68;;; a nib file.
69
70(defun tiny-setup ()
71  (with-autorelease-pool
72    (let* ((r (ns:make-ns-rect 100 350 400 400))
73           (w (make-instance 
74                   'ns:ns-window
75                   :with-content-rect r
76                   :style-mask (logior #$NSTitledWindowMask 
77                                       #$NSClosableWindowMask 
78                                       #$NSMiniaturizableWindowMask)
79                   :backing #$NSBackingStoreBuffered
80                   :defer t)))
81      (#/setTitle: w "Tiny Window Application")
82      (let ((my-view (make-instance 'demo-view :with-frame r)))
83        (#/setContentView: w my-view)
84        (#/setDelegate: w my-view))
85      (#/makeKeyAndOrderFront: w nil)
86      w)))
87
88
89;;; Neither the windowWillClose method nor the main from the original Tiny
90;;; application is necessary here
Note: See TracBrowser for help on using the repository browser.