htdch/draw and htdch/idraw fixed, common code basis

svn: r2759

collects/htdch/draw/Canvas-native-methods.ss

@@ -1,170 +1,12 @@
 #cs
 (module Canvas-native-methods mzscheme
-  (require (lib "draw.ss" "htdp")
+  (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss"))
-           (lib "posn.ss" "lang")
-           (lib "class.ss")
-	   (lib "String.ss" "profj" "libs" "java" "lang")
-           (lib "Throwable.ss" "profj" "libs" "java" "lang")
-           (lib "RuntimeException.ss" "profj" "libs" "java" "lang"))
-  ;(require "Posn.ss")
 
-  ;raises a Java exception with the specified error message
+  (define void-or-true #t)
-  ;raise-error: String -> void
+  (define (imperative w@t+1 w@t) w@t+1)
-  (define (raise-error message)
-    (raise
-     (create-java-exception RuntimeException message 
-                            (lambda (exn str)
-                              (send exn RuntimeException-constructor-java.lang.String str))
-                            (current-continuation-marks))))                                    
   
-  (define-syntax (wrap-start-check stx)
+  (define-values/invoke-unit/sig canvas-native^ canvas-native@ #f support^)
-    (syntax-case stx ()
-      [(_ body)
-       #'(with-handlers 
-	   ((exn:fail? 
-               (lambda (e)
-		 (raise-error
-		   "The method start(int,int) must be called on the canvas before using any drawing methods"))))
-           body)]))
 
-  (define-syntax (define/provide stx)
+  (provide-signature-elements canvas-native^))
-    (syntax-case stx ()
-      [(_ id val)
-       (identifier? #'id)
-       #'(begin
-	   (define id val)
-	   (provide id))]
-      [(_ (id . formals) . rest)
-       #'(begin
-	   (define (id . formals) . rest)
-	   (provide id))]))
 
-  (define Posn-x-get (dynamic-require '(lib "Posn.ss" "htdch" "draw") 'Posn-x-get))
-  (define Posn-y-get (dynamic-require '(lib "Posn.ss" "htdch" "draw") 'Posn-y-get))
-  
-  (define (build-posn posnO)
-    (make-posn (Posn-x-get posnO) (Posn-y-get posnO)))
-  (define (color->symbol colorO)
-    (string->symbol (to-lower-case (send colorO my-name))))
-
-  ;Raises an error if value less than or equal to 0
-  ;check-arg: num string string -> boolean
-  (define (check-arg value method argument)
-    (or (> value 0)
-        (raise-error (format "Method ~a expects an int greater than 0 for ~a argument, given ~a"
-                             method argument value))))
-  
-  (define (to-lower-case s)
-    (letrec ((lower 
-              (lambda (s)
-                (cond
-                  ((null? s) s)
-                  (else (cons (char-downcase (car s))
-                              (lower (cdr s))))))))
-      (list->string (lower (string->list s)))))
-  
-  (define/provide (start-int-int-native this accs gets privates x y)
-    (and (check-arg x "start(int,int)" "first")
-         (check-arg x "start(int,int)" "second")
-         (start x y)))
-  
-  (define/provide (stop-native this accs gets privates) (stop))
-  
-  (define/provide (drawCircle-draw.Posn-int-draw.Color-native this accs gets privates posn r c)
-    (wrap-start-check
-     (and (check-arg r "drawCircle(Posn, int, Color)" "second")
-          (draw-circle (build-posn posn) r (color->symbol c)))))
-  
-  (define/provide (drawDisk-draw.Posn-int-draw.Color-native this accs gets privates posn r c)
-    (wrap-start-check
-     (and (check-arg r "drawDisk(Posn, int, Color)" "second")
-          (draw-solid-disk (build-posn posn) r (color->symbol c)))))
-  
-  (define/provide (drawRect-draw.Posn-int-int-draw.Color-native this accs gets privates posn w h c)
-    (wrap-start-check
-     (and (check-arg w "drawRect(Posn, int, int, Color)" "second")
-          (check-arg h "drawRect(Posn, int, int, Color)" "third")
-          (draw-solid-rect (build-posn posn) w h (color->symbol c)))))
-
-  (define/provide (drawLine-draw.Posn-draw.Posn-draw.Color-native this accs gets privates p0 p1 c)
-    (wrap-start-check
-     (draw-solid-line (build-posn p0) (build-posn p1) (color->symbol c))))
-    
-  (define/provide (drawString-draw.Posn-java.lang.String-native this accs gets privates p s)
-    (wrap-start-check
-     (draw-solid-string (build-posn p) (send s get-mzscheme-string))))
-
-  (define/provide (clearCircle-draw.Posn-int-draw.Color-native this accs gets privates p r c)
-    (wrap-start-check
-     (and (check-arg r "clearCircle(Posn, int, Color)" "second")
-          (clear-circle (build-posn p) r (color->symbol c)))))
-
-  (define/provide (clearDisk-draw.Posn-int-draw.Color-native this accs gets privates p r c)
-    (wrap-start-check
-     (and (check-arg r "clearDisk(Posn, int, Color)" "second")
-          (clear-solid-disk (build-posn p) r (color->symbol c)))))
-
-  (define/provide (clearRect-draw.Posn-int-int-draw.Color-native this accs gets privates p w h c)
-    (wrap-start-check
-     (and (check-arg w "clearRect(Posn, int, int, Color)" "second")
-          (check-arg h "clearRect(Posn, int, int, Color)" "third")
-          (clear-solid-rect (build-posn p) w h (color->symbol c)))))
-
-  (define/provide (clearLine-draw.Posn-draw.Posn-draw.Color-native this accs gets privates p0 p1 c)
-    (wrap-start-check
-     (clear-solid-line (build-posn p0) (build-posn p1) (color->symbol c))))
-
-#|
-  (define/provide (sleepForAWhile-int-native this accs gets privates s)
-    (sleep-for-a-while s))
-  
-  (define/provide (bigBang-double-native this accs gets privates i)
-    (big-bang i this)
-    (on-tick-event
-      (lambda (world)
-	(set! last-world world)
-	(let ([next-world (send world onTick)])
-	  (send last-world erase)
-	  (send next-world draw)
-	  next-world)))
-    (on-key-event
-      (lambda (ke world)
-	(set! last-world world)
-	(let ([next-world (send world onKeyEvent-java.lang.String
-			   (make-java-string (keyevent->string ke)))])
-	  (send last-world erase)
-	  (send next-world draw)
-	  next-world)))
-    #t)
-
-  ;; (union Char Symbol) -> String
-  (define (keyevent->string ke)
-    (if (char? ke) (string ke) (symbol->string ke)))
-  
-  (define/provide (draw-native this accs gets privates)
-    #t)
-
-  (define/provide (erase-native this accs gets privates)
-    #t)
-
-  (define/provide (onTick-native this accs gets privates)
-     this)
-
-  (define/provide (onKeyEvent-java.lang.String-native this accs gets privates ke)
-     this)
-
-  (define last-world #f)
-  
-  (define/provide (endOfTime-native this accs gets privates)
-    (set! last-world (end-of-time))
-    #t)
-
-  (define/provide (endOfWorld-native this accs gets privates)
-    (set! last-world (end-of-time))
-    last-world)
-
-  (define/provide (lastWorld-native this accs gets privates)
-    (if last-world last-world this))
-|#
-)
 

collects/htdch/draw/Canvas.java

@@ -1,26 +1,32 @@
 package draw;
         
 public class Canvas {
+  private int width = 0; 
+  private int height = 0; 
 
-     public native boolean start(int width, int height);
+  public Canvas(int width, int height) { 
+   this.width = width; 
+   this.height = height; 
+  }
     
-     public native boolean stop();
+  // these two are cheats: 
+  protected native boolean copy();
+  protected native boolean stop();
+    // I need to figure out how to accomplish these two things, especially stop,
+    // directly at the Scheme level w/o going thru the Java layer.
+    // BUG: this is actually a bug in ProfessorJ. Making these protected should 
+    // work just fine. Indeed, leaving off the access control qualifier should 
+    // work, too. (That's package protected.) 
      
-     public native boolean drawCircle(Posn p, int r, Color c);
+  public native boolean show();
-
+  public native boolean close();
-     public native boolean drawDisk(Posn p, int r, Color c);
+  public native boolean drawCircle(Posn p, int r, Color c);
-
+  public native boolean drawDisk(Posn p, int r, Color c);
-     public native boolean drawRect(Posn p, int width, int height, Color c);
+  public native boolean drawRect(Posn p, int width, int height, Color c);
-
+  public native boolean drawLine(Posn p0, Posn p1, Color c);
-     public native boolean drawLine(Posn p0, Posn p1, Color c);
+  public native boolean drawString(Posn p, String s);
-
+  public native boolean clearCircle(Posn p, int r, Color c);
-     public native boolean drawString(Posn p, String s);
+  public native boolean clearDisk(Posn p, int r, Color c);
-
+  public native boolean clearRect(Posn p, int width, int height, Color c);
-     public native boolean clearCircle(Posn p, int r, Color c);
+  public native boolean clearLine(Posn p0, Posn p1, Color c);
-
-     public native boolean clearDisk(Posn p, int r, Color c);
-
-     public native boolean clearRect(Posn p, int width, int height, Color c);
-
-     public native boolean clearLine(Posn p0, Posn p1, Color c);
 }    

collects/htdch/draw/World-native-methods.ss

@@ -1,134 +1,12 @@
 #cs
 (module World-native-methods mzscheme
-  (require (lib "draw.ss" "htdp")
+  (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss"))
-           (lib "posn.ss" "lang")
-           (lib "class.ss")
-	   (lib "String.ss" "profj" "libs" "java" "lang")
-           (lib "Throwable.ss" "profj" "libs""java""lang")
-           (lib "RuntimeException.ss" "profj" "libs" "java" "lang"))
-  ;(require "Posn.ss")
   
-  ;raises a Java exception with the specified error message
+  (provide endOfTime-native endOfWorld-native bigBangO-double-native)
-  ;raise-error: String -> void
-  (define (raise-error message)
-    (raise
-     (create-java-exception RuntimeException message 
-                            (lambda (exn str)
-                              (send exn RuntimeException-constructor-java.lang.String str))
-                            (current-continuation-marks))))
 
-  (define-syntax (define/provide stx)
+  (define void-or-true #t)
-    (syntax-case stx ()
+  (define (imperative world@t+1 world@t) world@t+1)
-      [(_ id val)
-       (identifier? #'id)
-       #'(begin
-	   (define id val)
-	   (provide id))]
-      [(_ (id . formals) . rest)
-       #'(begin
-	   (define (id . formals) . rest)
-	   (provide id))]))
   
-  (define Posn-x-get (dynamic-require '(lib "Posn.ss" "htdch" "draw") 'Posn-x-get))
+  (define-values/invoke-unit/sig world-native^ world-native@ #f support^))
-  (define Posn-y-get (dynamic-require '(lib "Posn.ss" "htdch" "draw") 'Posn-y-get))
 
-  (define (build-posn posnO)
-    (make-posn (Posn-x-get posnO) (Posn-y-get posnO)))
-  (define (color->symbol colorO)
-    (string->symbol (to-lower-case (send colorO my-name))))
-  
-  (define (to-lower-case s)
-    (letrec ((lower 
-              (lambda (s)
-                (cond
-                  ((null? s) s)
-                  (else (cons (char-downcase (car s))
-                              (lower (cdr s))))))))
-      (list->string (lower (string->list s)))))
-  
-#|
-  (define/provide (start-int-int-native this accs gets privates x y)
-     (start x y))
-  
-  (define/provide (stop-native this accs gets privates) (stop))
-  
-  (define/provide (drawCircle-draw.Posn-int-draw.Color-native this accs gets privates posn r c)
-     (draw-circle (build-posn posn) r (color->symbol c)))
-  
-  (define/provide (drawDisk-draw.Posn-int-draw.Color-native this accs gets privates posn r c)
-     (draw-solid-disk (build-posn posn) r (color->symbol c)))
-  
-  (define/provide (drawRect-draw.Posn-int-int-draw.Color-native this accs gets privates posn w h c)
-     (draw-solid-rect (build-posn posn) w h (color->symbol c)))
-
-  (define/provide (drawLine-draw.Posn-draw.Posn-draw.Color-native this accs gets privates p0 p1 c)
-     (draw-solid-line (build-posn p0) (build-posn p1) (color->symbol c)))
-
-  (define/provide (drawString-draw.Posn-java.lang.String-native this accs gets privates p s)
-     (draw-solid-string (build-posn p) (send s get-mzscheme-string)))
-
-  (define/provide (clearCircle-draw.Posn-int-draw.Color-native this accs gets privates p r c)
-     (clear-circle (build-posn p) r (color->symbol c)))
-
-  (define/provide (clearDisk-draw.Posn-int-draw.Color-native this accs gets privates p r c)
-     (clear-solid-disk (build-posn p) r (color->symbol c)))
-
-  (define/provide (clearRect-draw.Posn-int-int-draw.Color-native this accs gets privates p w h c)
-     (clear-solid-rect (build-posn p) w h (color->symbol c)))
-
-  (define/provide (clearLine-draw.Posn-draw.Posn-draw.Color-native this accs gets privates p0 p1 c)
-     (clear-solid-line (build-posn p0) (build-posn p1) (color->symbol c)))
-
-  (define/provide (sleepForAWhile-int-native this accs gets privates s)
-    (sleep-for-a-while s))
-|#  
-
-  (define/provide (bigBang-int-int-double-native this accs gets privates width height i)
-    (define theCanvas ((hash-table-get accs 'theCanvas) this))
-    (unless (> width 0)
-      (raise-error
-       (format "The method bigBang(int,int,double) expected first argument to be greather than 0, given ~a" width)))
-    (unless (> height 0)
-      (raise-error
-       (format "The method bigBang(int,int,double) expected second argument to be greater than 0, given ~a" height)))
-
-    (unless (>= i 0)
-      (raise-error 
-       (format "The method bigBang(int,int,double) expected third argument to be 0 or greater, given ~a" i)))
-    (send theCanvas start-int-int width height)
-    (big-bang i this)
-    (on-tick-event
-      (lambda (world)
-	(set! last-world world)
-	(let ([next-world (send world onTick)])
-	  (send last-world erase)
-	  (send next-world draw)
-	  next-world)))
-    (on-key-event
-      (lambda (ke world)
-	(set! last-world world)
-	(let ([next-world (send world onKeyEvent-java.lang.String
-			   (make-java-string (keyevent->string ke)))])
-	  (send last-world erase)
-	  (send next-world draw)
-	  next-world)))
-    #t)
-
-  ;; (union Char Symbol) -> String
-  (define (keyevent->string ke)
-    (if (char? ke) (string ke) (symbol->string ke)))
-
-  (define last-world #f)
-  
-  (define/provide (endOfTime-native this accs gets privates)
-    (set! last-world (end-of-time))
-    #t)
-
-  (define/provide (endOfWorld-native this accs gets privates)
-    (set! last-world (end-of-time))
-    last-world)
-
-  (define/provide (lastWorld-native this accs gets privates)
-    (if last-world last-world this))
-)
 

collects/htdch/draw/World.java

@@ -1,13 +1,37 @@
 package draw;
         
 public abstract class World {
-    public Canvas theCanvas = new Canvas(); 
+    protected Canvas theCanvas;
-    public native boolean bigBang(int width, int height, double s); 
+    protected void putCanvas(Canvas c) { 
-    public native boolean endOfTime();
+	this.theCanvas = c; 
-    public native World endOfWorld();
+    };
-    public native World lastWorld();
+    public boolean bigBang(int width, int height, double s) {
-    public abstract World onTick();
+	if (width <= 0)
-    public abstract World onKeyEvent(String ke); 
+           throw new RuntimeException(
-    public abstract boolean draw();
+	              "The method bigBang(int,int,double) expects " +
-    public abstract boolean erase();
+		       "the first argument to be greather than 0, given " 
+		       + width);
+	if (height <= 0)
+	    throw new RuntimeException(
+                       "The method bigBang(int,int,double) expects " +
+		       "the second argument to be greather than 0, given " 
+		       + height);
+	if (s <= 0)
+	    throw new RuntimeException(
+                       "The method bigBang(int,int,double) expects " +
+		       "the third argument to be greather than 0, given " 
+		       + s);
+	theCanvas = new Canvas(width,height); 
+	return bigBangO(s);
+ };
+ private native boolean bigBangO(double s);
+
+ // --------------------------------------------------------    
+
+ public native boolean endOfTime();
+ public native World endOfWorld();
+ public abstract World onTick();
+ public abstract World onKeyEvent(String ke); 
+ public abstract boolean draw();
+ public abstract boolean erase();
 }    

collects/htdch/idraw/Canvas-native-methods.ss

@@ -1,129 +1,10 @@
 #cs
 (module Canvas-native-methods mzscheme
-  (require (lib "big-draw.ss" "htdp")
+  (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss"))
-           (lib "posn.ss" "lang")
-           (lib "class.ss")
-	   (lib "String.ss" "profj" "libs" "java" "lang")
-           (lib "Throwable.ss" "profj" "libs" "java" "lang")
-           (lib "RuntimeException.ss" "profj" "libs" "java" "lang"))
 
   (define void-or-true (void))
+  (define (imperative w@t+1 w@t) w@t+1)
   
-  ;raises a Java exception with the specified error message
+  (define-values/invoke-unit/sig canvas-native^ canvas-native@ #f support^)
-  ;raise-error: String -> void
-  (define (raise-error message)
-    (raise
-     (create-java-exception RuntimeException message 
-                            (lambda (exn str)
-                              (send exn RuntimeException-constructor-java.lang.String str))
-                            (current-continuation-marks))))                                    
 
-  (define-syntax (wrap-start-check stx)
+  (provide-signature-elements canvas-native^))
-    (syntax-case stx ()
-      [(_ body ...)
-       #'(with-handlers 
-             ((exn:fail? 
-               (lambda (e)
-		 (raise-error
-		   (format "The method show() must be called on the canvas before using any drawing methods [~s]" (exn-message e))))))
-           (begin (begin body ...) void-or-true))]))
-  
-  (define-syntax (define/provide stx)
-    (syntax-case stx ()
-      #;[(_ id val)
-       (identifier? #'id)
-       #'(begin
-	   (define id val)
-	   (provide id))]
-      [(_ (id . formals) . rest)
-       #'(begin
-	   (define (id . formals) . rest)
-	   (provide id))]))
-  
-  (define Posn-x-get (dynamic-require '(lib "Posn.ss" "htdch" "idraw") 'Posn-x-get))
-  (define Posn-y-get (dynamic-require '(lib "Posn.ss" "htdch" "idraw") 'Posn-y-get))
-  
-  (define (build-posn posnO) (make-posn (Posn-x-get posnO) (Posn-y-get posnO)))
-  (define (color->symbol colorO) (string->symbol (to-lower-case (send colorO my-name))))
-
-  ;Raises an error if value less than or equal to 0
-  ;check-arg: num string string -> boolean
-  (define (check-arg value method argument)
-    (or (> value 0)
-        (raise-error (format "Method ~a expects an int >= 0 for ~a argument, given ~a" method argument value))))
-  
-  (define (to-lower-case s)
-    (letrec ((lower 
-              (lambda (s)
-                (cond
-                  ((null? s) s)
-                  (else (cons (char-downcase (car s))
-                              (lower (cdr s))))))))
-      (list->string (lower (string->list s)))))
-  
-  (define/provide (show-native this accs gets privates)
-    ;; Kathy: it looks like I am working around a bug here. 
-    ;; I really wanted to write ([hash-table-get privates 'width] this)
-    ;; but that didn't work at all. 'width is not a key for privates, 
-    ;; even though it is a private field. Then I wanted to write 
-    ;; ([hash-table-get privates 'width] this), just like in World-native-methods. 
-    ;; That failed, too, with an arity error. 
-    (define x (with-method ([g (this Canvas-width-get)]) (g '___)))
-    (define y (with-method ([g (this Canvas-height-get)]) (g '___)))
-    (start-and-export x y privates)
-    void-or-true)
-  
-  (define/provide (close-native this accs gets privates)
-    (wrap-start-check ([hash-table-get privates '%stop])))
-  
-  (define/provide (stop-native this accs gets privates)
-    (wrap-start-check ([hash-table-get privates '%end-of-time])))
-  
-  (define/provide (copy-native this accs gets privates)
-    (wrap-start-check ([hash-table-get privates 'copy])))
-  
-  (define/provide (drawCircle-idraw.Posn-int-idraw.Color-native this accs gets privates posn r c)
-    (wrap-start-check
-     (check-arg r "drawCircle(Posn, int, Color)" "second")
-     ([hash-table-get privates '%draw-circle] (build-posn posn) r (color->symbol c))))
-  
-  (define/provide (drawDisk-idraw.Posn-int-idraw.Color-native this accs gets privates posn r c)
-    (wrap-start-check
-     (check-arg r "drawDisk(Posn, int, Color)" "second")
-     ([hash-table-get privates '%draw-solid-disk] (build-posn posn) r (color->symbol c))))
-  
-  (define/provide (drawRect-idraw.Posn-int-int-idraw.Color-native this accs gets privates posn w h c)
-    (wrap-start-check 
-     (check-arg w "drawRect(Posn, int, int, Color)" "second")
-     (check-arg h "drawRect(Posn, int, int, Color)" "third")
-     ([hash-table-get privates '%draw-solid-rect] (build-posn posn) w h (color->symbol c))))
-
-  (define/provide (drawLine-idraw.Posn-idraw.Posn-idraw.Color-native this accs gets privates p0 p1 c)
-    (wrap-start-check 
-     ([hash-table-get privates '%draw-solid-line] (build-posn p0) (build-posn p1) (color->symbol c))))
-    
-  (define/provide (drawString-idraw.Posn-java.lang.String-native this accs gets privates p s)
-    (define s* (send s get-mzscheme-string))
-    (wrap-start-check
-     ([hash-table-get privates '%draw-string] (build-posn p) s*)))
-
-  (define/provide (clearCircle-idraw.Posn-int-idraw.Color-native this accs gets privates p r c)
-    (wrap-start-check 
-     (check-arg r "clearCircle(Posn, int, Color)" "second")
-     ([hash-table-get privates '%clear-circle] (build-posn p) r (color->symbol c))))
-
-  (define/provide (clearDisk-idraw.Posn-int-idraw.Color-native this accs gets privates p r c)
-    (wrap-start-check 
-     (check-arg r "clearDisk(Posn, int, Color)" "second")
-     ([hash-table-get privates '%clear-solid-disk] (build-posn p) r (color->symbol c))))
-
-  (define/provide (clearRect-idraw.Posn-int-int-idraw.Color-native this accs gets privates p w h c)
-    (wrap-start-check 
-     (check-arg w "clearRect(Posn, int, int, Color)" "second")
-     (check-arg h "clearRect(Posn, int, int, Color)" "third")
-     ([hash-table-get privates '%clear-solid-rect] (build-posn p) w h (color->symbol c))))
-
-  (define/provide (clearLine-idraw.Posn-idraw.Posn-idraw.Color-native this accs gets privates p0 p1 c)
-    (wrap-start-check 
-     ([hash-table-get privates '%clear-solid-line] (build-posn p0) (build-posn p1) (color->symbol c))))
-  )

collects/htdch/idraw/Canvas.java

@@ -1,5 +1,8 @@
 package idraw;
 
+import draw.Color;
+import draw.Posn;
+        
 public class Canvas {
   private int width = 0; 
   private int height = 0; 
@@ -10,13 +13,10 @@ public class Canvas {
   }
     
   // these two are cheats: 
-  public native void copy();
+  protected native void copy();
-  public native void stop();
+  protected native void stop();
-    // I need to figure out how to accomplish these two things, especially stop,
+    // MF: I need to figure out how to accomplish these two things, especially
-    // directly at the Scheme level w/o going thru the Java layer.
+    //     stop, directly at the Scheme level w/o going thru the Java layer.
-    // BUG: this is actually a bug in ProfessorJ. Making these protected should 
-    // work just fine. Indeed, leaving off the access control qualifier should 
-    // work, too. (That's package protected.) 
      
   public native void show();
   public native void close();

collects/htdch/idraw/World-native-methods.ss

@@ -1,10 +1,10 @@
 #cs
 (module World-native-methods mzscheme
-  (require "support.scm" (lib "unitsig.ss"))
+  (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss"))
   
   (provide endOfTime-native endOfWorld-native bigBangO-double-native)
 
   (define void-or-true void)
-  (define (world-return w) w)
+  (define (imperative world@t+1 world@t) world@t)
   
   (define-values/invoke-unit/sig world-native^ world-native@ #f support^))

collects/htdch/idraw/World.java

@@ -1,9 +1,7 @@
 package idraw;
         
 public abstract class World {
-
  public Canvas theCanvas; 
-
  public void bigBang(int width, int height, double s) {
 	if (width <= 0)
            throw new RuntimeException(
@@ -22,13 +20,13 @@ public abstract class World {
 		       + s);
 	theCanvas = new Canvas(width,height); 
 	bigBangO(s);
+	return ; 
     }
-
  private native void bigBangO(double s);
 
  // --------------------------------------------------------    
 
- public native World endOfTime();
+ public native boolean endOfTime();
  public native World endOfWorld();
  public abstract void onTick();
  public abstract void onKeyEvent(String ke); 

collects/htdch/idraw/installer.ss

@@ -11,14 +11,16 @@
                  (compile-java 'file 'file 'full
                                (build-path draw-path file)
                                #f #f)))))
-        (javac "Posn.java")
-        (javac "Color.java")
         (javac "Canvas.java")
         (javac "World.java")
+	#|
+        (javac "Posn.java")
+        (javac "Color.java")
         (javac "Red.java")
         (javac "White.java")
         (javac "Blue.java")
         (javac "Black.java")
         (javac "Green.java")
         (javac "Yellow.java")
+	|#
         ))))

collects/htdch/info.ss

@@ -2,6 +2,4 @@
   (define name "htdch")
   (define compile-subcollections (list (list "htdch" "draw")
 				       (list "htdch" "graphics")
-                                       (list "htdch" "idraw")
+                                       (list "htdch" "idraw"))))
-				       ))
-  )