Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add generic Objective-C interface, sound, dates, device status, more …

…scripts.
  • Loading branch information...
commit b2d01479d45e37c91b896840a0908c8bdc4aaeaf 1 parent f91139f
@feeley authored
View
BIN  examples/iOS/Icon-512.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  examples/iOS/Icon-72.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  examples/iOS/Icon-Small-50.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  examples/iOS/Icon-Small.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  examples/iOS/Icon-Small@2x.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  examples/iOS/Icon-unscaled-alpha.tiff
Binary file not shown
View
BIN  examples/iOS/Icon-unscaled.key
Binary file not shown
View
BIN  examples/iOS/Icon-unscaled.tiff
Binary file not shown
View
BIN  examples/iOS/Icon.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  examples/iOS/Icon@2x.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
8 examples/iOS/Prefix.pch
@@ -0,0 +1,8 @@
+//
+// Prefix header
+//
+
+#ifdef __OBJC__
+ #import <Foundation/Foundation.h>
+ #import <UIKit/UIKit.h>
+#endif
View
1  examples/iOS/ViewController.m
@@ -450,6 +450,7 @@ - (IBAction)touch_down:(id)sender {
CFPreferencesGetAppBooleanValue(CFSTR("keyboard"),
CFSTR("/var/mobile/Library/Preferences/com.apple.preferences.sounds"),
NULL);
+
if (keyboardSounds != 0)
AudioServicesPlaySystemSound(1104); // keyboard "tock" sound
}
View
6 examples/iOS/make-scaled-icons
@@ -2,9 +2,12 @@
scale_icon()
{
- pngtopnm Icon-unscaled.png | pamscale -xsize=$1 -ysize=$1 | pnmtopng > $2
+ pngtopnm Icon-unscaled-alpha.png | pamscale -xsize=$1 -ysize=$1 > $2.alpha.pnm
+ pngtopnm Icon-unscaled.png | pamscale -xsize=$1 -ysize=$1 | pnmtopng -alpha $2.alpha.pnm > $2
+ rm -f $2.alpha.pnm
}
+tifftopnm Icon-unscaled-alpha.tiff | pnmtopng > Icon-unscaled-alpha.png
tifftopnm Icon-unscaled.tiff | pnmtopng > Icon-unscaled.png
scale_icon 57 Icon.png
@@ -13,3 +16,4 @@ scale_icon 72 Icon-72.png
scale_icon 29 Icon-Small.png
scale_icon 58 Icon-Small@2x.png
scale_icon 50 Icon-Small-50.png
+scale_icon 512 Icon-512.png
View
7 examples/iOS/makefile.in
@@ -1,4 +1,4 @@
-# makefile for iOS example, Time-stamp: <2011-03-25 08:30:36 feeley>
+# makefile for iOS example, Time-stamp: <2011-04-01 22:04:46 feeley>
# Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
@@ -69,8 +69,9 @@ program.scm program.h \
Prefix.pch main.m \
AppDelegate.m AppDelegate.h ViewController.m ViewController.h \
AccessoryView.xib MainWindow.xib ViewController.xib \
-Icon-72.png Icon-Small-50.png Icon-Small.png Icon-Small@2x.png \
-Icon.png Icon@2x.png Icon-unscaled.key Icon-unscaled.tiff make-scaled-icons \
+Icon-72.png Icon-Small-50.png Icon-Small.png Icon-Small@2x.png Icon-512.png \
+Icon.png Icon@2x.png Icon-unscaled.key Icon-unscaled.tiff \
+Icon-unscaled-alpha.tiff make-scaled-icons \
Info.plist
GENDISTFILES =
View
359 examples/iOS/program.scm
@@ -28,7 +28,37 @@
set-webView-content
open-URL
set-pref
- get-pref))
+ get-pref
+
+ string->Class
+ Class->string
+ string->SEL
+ SEL->string
+ send0
+ send1
+ send2
+ id->string
+ string->id
+ id->bool
+ bool->id
+ id->int
+ int->id
+ id->float
+ float->id
+ id->double
+ double->id
+
+ date
+
+ device-status
+ UDID
+
+ AudioServicesPlayAlertSound
+ AudioServicesPlaySystemSound
+ kSystemSoundID_FlashScreen
+ kSystemSoundID_Vibrate
+ kSystemSoundID_UserPreferredAlert
+ ))
(declare
(standard-bindings)
@@ -40,12 +70,136 @@
;;;----------------------------------------------------------------------------
-;; Make "~~" path equal to the program's .app directory.
+;; Make the current-directory and the "~~" path equal to the program's
+;; .app directory.
(define app-dir (path-directory (car (command-line))))
(set! ##os-path-gambcdir (lambda () app-dir))
+(current-directory app-dir)
+
+;;;----------------------------------------------------------------------------
+
+;; Interface with Objective-C.
+
+(c-declare #<<c-declare-end
+
+#include <objc/objc.h>
+
+const char *class_getName(Class cls);
+id objc_getClass(const char *name);
+id objc_msgSend(id self, SEL op, ...);
+
+id retain_id(id x)
+{
+ if (x != nil)
+ [x retain];
+ return x;
+}
+
+___SCMOBJ release_id(void *ptr)
+{
+ id x = ___CAST(id,ptr);
+ if (x != nil)
+ [x release];
+ return ___FIX(___NO_ERR);
+}
+
+Class retain_Class(Class x)
+{
+ if (x != nil)
+ [x retain];
+ return x;
+}
+
+___SCMOBJ release_Class(void *ptr)
+{
+ Class x = ___CAST(Class,ptr);
+ if (x != nil)
+ [x release];
+ return ___FIX(___NO_ERR);
+}
+
+c-declare-end
+)
+
+(c-define-type id (pointer (struct "objc_object") (id Class) "release_id"))
+(c-define-type Class (pointer (struct "objc_class") (Class id) "release_Class"))
+(c-define-type SEL (pointer (struct "objc_selector") (SEL)))
+
+(define string->Class
+ (c-lambda (nonnull-char-string) Class
+ "___result = retain_Class(objc_getClass(___arg1));"))
+
+(define Class->string
+ (c-lambda (Class) nonnull-char-string
+ "___result = ___CAST(char*,class_getName(___arg1));")) ;;;TODO: remove cast
+
+(define string->SEL
+ (c-lambda (nonnull-UTF-8-string) SEL
+ "___result = sel_registerName(___arg1);"))
+
+(define SEL->string
+ (c-lambda (SEL) nonnull-UTF-8-string
+ "___result = ___CAST(char*,sel_getName(___arg1));")) ;;;TODO: remove cast
+
+;; Message sending (with 0, 1 and 2 parameters).
+
+(define send0
+ (c-lambda (id SEL) id
+ "___result = retain_id(___CAST(id (*)(id, SEL),objc_msgSend)(___arg1, ___arg2));"))
+
+(define send1
+ (c-lambda (id SEL id) id
+ "___result = retain_id(___CAST(id (*)(id, SEL, id),objc_msgSend)(___arg1, ___arg2, ___arg3));"))
+
+(define send2
+ (c-lambda (id SEL id id) id
+ "___result = retain_id(___CAST(id (*)(id, SEL, id, id),objc_msgSend)(___arg1, ___arg2, ___arg3, ___arg4));"))
+
+;; Type conversions.
+
+(define id->string
+ (c-lambda (id) nonnull-UTF-8-string
+ "___result = ___CAST(char*,[___CAST(NSString*,___arg1) UTF8String]);")) ;;;TODO: remove cast
+
+(define string->id
+ (c-lambda (nonnull-UTF-8-string) id
+ "___result = retain_id([NSString stringWithUTF8String: ___arg1]);"))
+
+(define id->bool
+ (c-lambda (id) bool
+ "___result = [___CAST(NSNumber*,___arg1) boolValue];"))
+
+(define bool->id
+ (c-lambda (bool) id
+ "___result = retain_id([NSNumber numberWithBool:___arg1]);"))
+
+(define id->int
+ (c-lambda (id) int
+ "___result = [___CAST(NSNumber*,___arg1) intValue];"))
+
+(define int->id
+ (c-lambda (int) id
+ "___result = retain_id([NSNumber numberWithInt:___arg1]);"))
+
+(define id->float
+ (c-lambda (id) float
+ "___result = [___CAST(NSNumber*,___arg1) floatValue];"))
+
+(define float->id
+ (c-lambda (float) id
+ "___result = retain_id([NSNumber numberWithFloat:___arg1]);"))
+
+(define id->double
+ (c-lambda (id) double
+ "___result = [___CAST(NSNumber*,___arg1) doubleValue];"))
+
+(define double->id
+ (c-lambda (double) id
+ "___result = retain_id([NSNumber numberWithDouble:___arg1]);"))
+
;;;----------------------------------------------------------------------------
;; Implement conversions between NSString* and Scheme strings.
@@ -82,7 +236,7 @@ ___SCMOBJ SCMOBJ_to_NSStringSTAR(___SCMOBJ src, NSString **dst, int arg_num)
buf[i] = c;
}
- result = [NSString stringWithCharacters:buf length:len];
+ result = retain_id([NSString stringWithCharacters:buf length:len]);
___free_mem(buf);
}
@@ -103,7 +257,7 @@ ___SCMOBJ NSStringSTAR_to_SCMOBJ(NSString *src, ___SCMOBJ *dst, int arg_num)
int i;
int len = [src length];
- result = ___alloc_scmobj (___sSTRING, len<<___LCS, ___STILL);
+ result = ___alloc_scmobj(___sSTRING, len<<___LCS, ___STILL);
if (___FIXNUMP(result))
return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num);
@@ -148,6 +302,95 @@ c-declare-end
;;;----------------------------------------------------------------------------
+;; Interface with NSDate Class.
+
+(define NSDate (string->Class "NSDate"))
+(define alloc (string->SEL "alloc"))
+(define init (string->SEL "init"))
+(define description (string->SEL "description"))
+
+(define (date)
+ (id->string (send0 (send0 (send0 NSDate alloc) init) description)))
+
+;;;----------------------------------------------------------------------------
+
+;; Interface with UIDevice Class.
+
+(define currentDevice-batteryLevel
+ (c-lambda () float
+ "___result = [[UIDevice currentDevice] batteryLevel];"))
+
+(define currentDevice-batteryMonitoringEnabled
+ (c-lambda () bool
+ "___result = [UIDevice currentDevice].batteryMonitoringEnabled;"))
+
+(define currentDevice-batteryMonitoringEnabled-set!
+ (c-lambda (bool) void
+ "[UIDevice currentDevice].batteryMonitoringEnabled = ___arg1;"))
+
+(define currentDevice-multitaskingSupported
+ (c-lambda () bool
+ "___result = [UIDevice currentDevice].multitaskingSupported;"))
+
+(define currentDevice-model
+ (c-lambda () NSString*
+ "___result = [[UIDevice currentDevice] model];"))
+
+(define currentDevice-name
+ (c-lambda () NSString*
+ "___result = [[UIDevice currentDevice] name];"))
+
+(define currentDevice-systemName
+ (c-lambda () NSString*
+ "___result = [[UIDevice currentDevice] systemName];"))
+
+(define currentDevice-systemVersion
+ (c-lambda () NSString*
+ "___result = [[UIDevice currentDevice] systemVersion];"))
+
+(define currentDevice-uniqueIdentifier
+ (c-lambda () NSString*
+ "___result = [[UIDevice currentDevice] uniqueIdentifier];"))
+
+(define (device-status)
+ (currentDevice-batteryMonitoringEnabled-set! #t)
+ (list (currentDevice-batteryLevel)
+ (currentDevice-batteryMonitoringEnabled)
+ (currentDevice-multitaskingSupported)
+ (currentDevice-model)
+ (currentDevice-name)
+ (currentDevice-systemName)
+ (currentDevice-systemVersion)
+ (currentDevice-uniqueIdentifier)))
+
+(define (UDID)
+ (currentDevice-uniqueIdentifier))
+
+;;;----------------------------------------------------------------------------
+
+;; Interface with AudioToolbox.
+
+(c-declare #<<c-declare-end
+
+#import <AudioToolbox/AudioToolbox.h>
+
+c-declare-end
+)
+
+(c-define-type SystemSoundID unsigned-int32)
+
+(define AudioServicesPlayAlertSound
+ (c-lambda (SystemSoundID) void "AudioServicesPlayAlertSound"))
+
+(define AudioServicesPlaySystemSound
+ (c-lambda (SystemSoundID) void "AudioServicesPlaySystemSound"))
+
+(define kSystemSoundID_FlashScreen #x00000FFE)
+(define kSystemSoundID_Vibrate #x00000FFF)
+(define kSystemSoundID_UserPreferredAlert #x00001000)
+
+;;;----------------------------------------------------------------------------
+
;; Interface with ViewController.
(c-declare #<<c-declare-end
@@ -208,14 +451,54 @@ c-declare-end
(c-define (heartbeat) () double "heartbeat" "extern"
;; make sure other threads get to run
- (thread-yield!)
+ (##thread-heartbeat!)
;; check if there has been any REPL output
(let ((output (read-line repl-port #f)))
(if (string? output)
(add-output-to-textView output)))
- 0.1) ;; return interval until next heartbeat
+ ;; return interval until next heartbeat
+ (next-heartbeat-interval))
+
+(define (next-heartbeat-interval)
+
+ (##declare (not interrupts-enabled))
+
+ (let* ((run-queue
+ (macro-run-queue))
+ (runnable-threads?
+ (##not
+ (let ((root (macro-btq-left run-queue)))
+ (and (##not (##eq? root run-queue))
+ (##eq? (macro-btq-left root) run-queue)
+ (##eq? (macro-btq-right root) run-queue))))))
+ (if runnable-threads?
+
+ (begin
+ ;; There are other threads that can run, so request
+ ;; to call "heartbeat" real soon to run those threads.
+ 0.0001)
+
+ (let* ((next-sleeper
+ (macro-toq-leftmost run-queue))
+ (sleep-interval
+ (if (##eq? next-sleeper run-queue)
+ +inf.0
+ (begin
+ ;; There is a sleeping thread, so figure out in
+ ;; how much time it needs to wake up.
+ (##flonum.max
+ (##flonum.- (macro-thread-timeout next-sleeper)
+ (##current-time-point))
+ 0.0))))
+ (next-condvar
+ (macro-btq-deq-next run-queue))
+ (io-interval
+ (if (##eq? next-condvar run-queue)
+ 1.0 ;; I/O is not pending, just relax
+ 0.02))) ;; I/O is pending, so come back soon
+ (##flonum.min sleep-interval io-interval)))))
(c-define (eval-string str) (NSString*) NSString* "eval_string" "extern"
(let ()
@@ -768,6 +1051,12 @@ c-declare-end
<head>
<style TYPE="text/css">
<!--
+body.splash {
+ background-image: -webkit-gradient(linear, left top, left bottom, from(#fffb8b), to(#fffef0));
+}
+body.editor {
+ background-image: -webkit-gradient(linear, left top, left bottom, from(#a0a0a0), to(#f0f0f0));
+}
div.button {
display: inline-block;
color: white;
@@ -788,7 +1077,6 @@ textarea.script {
width: 100%;
margin: 5px;
}
-}
-->
</style>
</head>
@@ -802,7 +1090,7 @@ common-html-header-end
(define splash-page-content-head #<<splash-page-content-head-end
-<body>
+<body class="splash">
<p>
Welcome to <strong>Gambit REPL</strong>, a Scheme development environment built with the <a href="event:visit-wiki">Gambit Scheme programming system</a>.
</p>
@@ -825,10 +1113,10 @@ After the "<strong><code>&gt;</code></strong>" prompt enter your command then RE
1267650600228229401496703205376<br>
&gt; (reverse (string-&gt;list "hello"))<br>
(#\o #\l #\l #\e #\h)<br>
-&gt; \ for (int i=1;i<=3;i++) pp(i);<br>
+&gt; \for (int i=1;i<=3;i++) pp(i*i);<br>
1<br>
-2<br>
-3<br>
+4<br>
+9<br>
&gt; (exit)<br>
</code>
</strong>
@@ -899,10 +1187,11 @@ EOF
#<<EOF
;; Show "Hello!" for a few seconds.
-(set-webView-content "<h1>Hello!</h1>")
-
+(set-webView-content #<<END
+<h1>Hello!</h1>
+END
+)
(thread-sleep! 5) ;; wait 5 seconds
-
(edit) ;; return to this page
EOF
@@ -931,6 +1220,44 @@ EOF
EOF
#<<EOF
+;; Show date for a few seconds.
+
+(set-webView-content (date))
+
+(thread-sleep! 5) ;; wait 5 seconds
+(edit) ;; return to this page
+EOF
+
+#<<EOF
+;; Show status for a few seconds.
+
+(set-webView-content
+ (string-append
+ "<pre>\n"
+ (with-output-to-string
+ ""
+ (lambda ()
+ (pretty-print
+ (device-status))))
+ "</pre>\n"))
+
+(thread-sleep! 5) ;; wait 5 seconds
+(edit) ;; return to this page
+EOF
+
+#<<EOF
+;; Metronome.
+(let* ((t (current-time))
+ (s (time->seconds t)))
+ (let loop ((i 0))
+ (let ((x (+ s (* 0.4 i))))
+ (thread-sleep! (seconds->time x)))
+ (AudioServicesPlaySystemSound
+ (if (= 0 (modulo i 4)) 1057 1104))
+ (if (< i 10) (loop (+ i 1)))))
+EOF
+
+#<<EOF
;; List app directory content.
(define (tree p)
@@ -979,6 +1306,8 @@ EOF
(set! script-db predefined-scripts)
(save-script-db))
+(reset-scripts);;;;;;;;;;;;;;;;;;;;;;;;
+
(define (get-script-db)
(if (not script-db)
(set! script-db
@@ -1026,7 +1355,7 @@ edit-page-content-tail-end
(list "<div class=\"button\" onClick=\"if (confirm('Are you sure you want to delete this script?')) window.location='event:delete:" index "';\">Delete</div>\n"))
"</center>\n")))
- (let loop ((scripts scripts) (i 0) (accum '("<body>\n")))
+ (let loop ((scripts scripts) (i 0) (accum '("<body class=\"editor\">\n")))
(if (pair? scripts)
(let ((s (car scripts)))
(loop (cdr scripts) (+ i 1) (cons (html s i) accum)))
View
4 include/stamp.h
@@ -2,5 +2,5 @@
* Time stamp of last source code repository commit.
*/
-#define ___STAMP_YMD 20110325
-#define ___STAMP_HMS 124526
+#define ___STAMP_YMD 20110417
+#define ___STAMP_HMS 235025
Please sign in to comment.
Something went wrong with that request. Please try again.