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 (ignorable 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 |
---|