speech synthesizer demo

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)
+

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]

lib/Cocoa/helpers.ss

@@ -1,6 +1,6 @@
 (library (Cocoa helpers)
-  (export make-app)
+  (export make-app nsstring)
-  (import (ikarus) (ikarus system $foreign))
+  (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])
+
 )
 
 

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)))
-    (selector-name (method-selector x))
-    "  "
-    (method-types 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

scheme/last-revision

@@ -1 +1 @@
-1613
+1616