diff --git a/lab/cocoa-speak.ss b/lab/cocoa-speak.ss new file mode 100755 index 0000000..6e57a63 --- /dev/null +++ b/lab/cocoa-speak.ss @@ -0,0 +1,38 @@ +#!/usr/bin/env ikarus --r6rs-script + +(import (ikarus) (objc) (Cocoa helpers)) + +(define-class NSSpeechSynthesizer) + +(define (get-voice-name) + (if (= 2 (length (command-line))) + (cadr (command-line)) + #f)) + +(define (make-speaker voice) + (define base-string "com.apple.speech.synthesis.voice.") + (define (synthesizer x) + [$ [$ NSSpeechSynthesizer alloc] + initWithVoice: + (and x (nsstring (string-append base-string x)))]) + (define (voice->synthesizer voice) + (or (synthesizer voice) + (begin + (printf "~a is not available\n" voice) + (synthesizer #f)) + (error #f "cannot initialize voice"))) + (let ([st (voice->synthesizer voice)]) + (lambda (x) + [$ st startSpeakingString: (nsstring x)]))) + +(define speak (make-speaker (get-voice-name))) + +(speak "may I help you?") +(let loop () + (printf "> ") + (let ([x (get-line (current-input-port))]) + (unless (eof-object? x) + (speak x) + (loop)))) +(newline) + diff --git a/lab/hello-cocoa.ss b/lab/hello-cocoa.ss index b3d3d68..280b61d 100755 --- a/lab/hello-cocoa.ss +++ b/lab/hello-cocoa.ss @@ -2,11 +2,6 @@ (import (ikarus) (objc) (Cocoa) (Cocoa helpers)) -(define (nsstring x) - [$ [$ NSString alloc] - initWithCharactersNoCopy: x - length: (string-length x) - freeWhenDone: #t]) (define pool [$ [$ NSAutoreleasePool alloc] init]) @@ -67,6 +62,7 @@ [$ win setTitle: (nsstring "Hello Ikarus")] [$ win makeKeyAndOrderFront: win] +;[$ win setAlphaValue: 0.5] ; cute [$ NSApp run] [$ pool release] diff --git a/lib/Cocoa/helpers.ss b/lib/Cocoa/helpers.ss index c27b36e..d0ed0f4 100644 --- a/lib/Cocoa/helpers.ss +++ b/lib/Cocoa/helpers.ss @@ -1,6 +1,6 @@ (library (Cocoa helpers) - (export make-app) - (import (ikarus) (ikarus system $foreign)) + (export make-app nsstring) + (import (ikarus) (Cocoa) (objc) (ikarus system $foreign)) (define (make-app) (define kProcessTransformToForegroundApplication 1) @@ -19,6 +19,14 @@ (transform-process-type p kProcessTransformToForegroundApplication) (set-front-process p) (free p))) + + + (define (nsstring x) + [$ [$ NSString alloc] + initWithCharactersNoCopy: x + length: (string-length x) + freeWhenDone: #t]) + ) diff --git a/lib/objc.ss b/lib/objc.ss index 65f27d6..5527a0b 100644 --- a/lib/objc.ss +++ b/lib/objc.ss @@ -6,6 +6,11 @@ define-object string->char* get-selector + get-class-list + get-class + class-methods + class-name + method-name $) (import (ikarus) @@ -124,10 +129,7 @@ (define (method-name x) (check 'method-name method? x) - (string-append - (selector-name (method-selector x)) - " " - (method-types x))) + (selector-name (method-selector x))) @@ -377,7 +379,8 @@ (define (convert-incoming t x) (case t - [(object) (make-object x)] + [(object) + (if (nil? x) #f (make-object x))] [(char) x] [(void) (void)] [else (error 'convert-incoming "invalid type" t)])) @@ -412,6 +415,7 @@ [(lazy-object? x) (pointer-ref (lazy-object-ptr x) 0)] [(class? x) (class-ptr x)] + [(not x) (integer->pointer 0)] [else (error 'convert-output "cannot convert to object" x)])] [(float) (cond diff --git a/scheme/last-revision b/scheme/last-revision index 6e2eace..eff9e16 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1613 +1616