idraw created
svn: r2207
This commit is contained in:
parent
3cdb386436
commit
04b89daa5a
|
@ -1,17 +1,23 @@
|
|||
This `draw' package provides libraries for modeling in a visual world:
|
||||
|
||||
|
||||
+----------+ +----------+
|
||||
| World | +->| Canvas |
|
||||
+----------+ | +----------+
|
||||
| Canvas c |--+ +----------+
|
||||
+----------+ | draw |
|
||||
+----------+ | clear |
|
||||
+----------+
|
||||
|
||||
- abstract class World
|
||||
|
||||
- class Canvas
|
||||
+-----------------------------------+
|
||||
| abstract World |
|
||||
+-----------------------------------+ +---------------------------------------+
|
||||
| Canvas theCanvas |------>| Canvas |
|
||||
+-----------------------------------+ +---------------------------------------+
|
||||
| boolean bigBang(int,int,double) | +---------------------------------------+
|
||||
| boolean endOfTime() | | boolean start(int,int) |
|
||||
| boolean endOfWorld() | | boolean stop() |
|
||||
| World lastWorld() | | boolean drawCircle(Posn,int,Color) |
|
||||
| | | boolean drawDisk(Posn,int,Color) |
|
||||
| abstract World onTick() | | boolean drawRect(Posn,int,int,Color) |
|
||||
| abstract World onKeyEvent(String) | | boolean drawLine(Posn,Posn,Color) |
|
||||
| abstract boolean draw() | | boolean drawString(Posn,String) |
|
||||
| abstract boolean erase( | | boolean clearCircle(Posn,int,Color) |
|
||||
+-----------------------------------+ | boolean clearDisk(Posn,int,Color) |
|
||||
| boolean clearRect(Posn,int,int,Color) |
|
||||
| boolean clearLine(Posn,Posn,Color) |
|
||||
+---------------------------------------+
|
||||
|
||||
- class Posn
|
||||
|
||||
|
|
3
collects/htdch/idraw/Black.java
Normal file
3
collects/htdch/idraw/Black.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public class Black extends Color { }
|
3
collects/htdch/idraw/Blue.java
Normal file
3
collects/htdch/idraw/Blue.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public class Blue extends Color { }
|
129
collects/htdch/idraw/Canvas-native-methods.ss
Normal file
129
collects/htdch/idraw/Canvas-native-methods.ss
Normal file
|
@ -0,0 +1,129 @@
|
|||
#cs
|
||||
(module Canvas-native-methods mzscheme
|
||||
(require (lib "draw.ss" "htdp")
|
||||
(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
|
||||
;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)
|
||||
(syntax-case stx ()
|
||||
[(_ body)
|
||||
#'(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (e)
|
||||
(raise-error
|
||||
(format "The method start(int,int) must be called on the canvas before using any drawing methods")))))
|
||||
body)]))
|
||||
|
||||
(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 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)
|
||||
(void)))
|
||||
|
||||
(define/provide (stop-native this accs gets privates) (stop) (void))
|
||||
|
||||
(define/provide (drawCircle-idraw.Posn-int-idraw.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))
|
||||
(void))))
|
||||
|
||||
(define/provide (drawDisk-idraw.Posn-int-idraw.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))
|
||||
(void))))
|
||||
|
||||
(define/provide (drawRect-idraw.Posn-int-int-idraw.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))
|
||||
(void))))
|
||||
|
||||
(define/provide (drawLine-idraw.Posn-idraw.Posn-idraw.Color-native this accs gets privates p0 p1 c)
|
||||
(wrap-start-check
|
||||
(and (draw-solid-line (build-posn p0) (build-posn p1) (color->symbol c))
|
||||
(void))))
|
||||
|
||||
(define/provide (drawString-idraw.Posn-java.lang.String-native this accs gets privates p s)
|
||||
(wrap-start-check
|
||||
(and
|
||||
(draw-solid-string (build-posn p) (send s get-mzscheme-string))
|
||||
(void))))
|
||||
|
||||
(define/provide (clearCircle-idraw.Posn-int-idraw.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))
|
||||
(void))))
|
||||
|
||||
(define/provide (clearDisk-idraw.Posn-int-idraw.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))
|
||||
(void))))
|
||||
|
||||
(define/provide (clearRect-idraw.Posn-int-int-idraw.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))
|
||||
(void))))
|
||||
|
||||
(define/provide (clearLine-idraw.Posn-idraw.Posn-idraw.Color-native this accs gets privates p0 p1 c)
|
||||
(wrap-start-check
|
||||
(and
|
||||
(clear-solid-line (build-posn p0) (build-posn p1) (color->symbol c))
|
||||
(void))))
|
||||
)
|
||||
|
26
collects/htdch/idraw/Canvas.java
Normal file
26
collects/htdch/idraw/Canvas.java
Normal file
|
@ -0,0 +1,26 @@
|
|||
package idraw;
|
||||
|
||||
public class Canvas {
|
||||
|
||||
public native void start(int width, int height);
|
||||
|
||||
public native void stop();
|
||||
|
||||
public native void drawCircle(Posn p, int r, Color c);
|
||||
|
||||
public native void drawDisk(Posn p, int r, Color c);
|
||||
|
||||
public native void drawRect(Posn p, int width, int height, Color c);
|
||||
|
||||
public native void drawLine(Posn p0, Posn p1, Color c);
|
||||
|
||||
public native void drawString(Posn p, String s);
|
||||
|
||||
public native void clearCircle(Posn p, int r, Color c);
|
||||
|
||||
public native void clearDisk(Posn p, int r, Color c);
|
||||
|
||||
public native void clearRect(Posn p, int width, int height, Color c);
|
||||
|
||||
public native void clearLine(Posn p0, Posn p1, Color c);
|
||||
}
|
3
collects/htdch/idraw/Color.java
Normal file
3
collects/htdch/idraw/Color.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public abstract class Color { }
|
3
collects/htdch/idraw/Green.java
Normal file
3
collects/htdch/idraw/Green.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public class Green extends Color { }
|
10
collects/htdch/idraw/Posn.java
Normal file
10
collects/htdch/idraw/Posn.java
Normal file
|
@ -0,0 +1,10 @@
|
|||
package idraw;
|
||||
|
||||
public class Posn {
|
||||
public int x, y;
|
||||
|
||||
public Posn( int x, int y ) {
|
||||
this.x = x;
|
||||
this.y = y;
|
||||
}
|
||||
}
|
3
collects/htdch/idraw/Red.java
Normal file
3
collects/htdch/idraw/Red.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public class Red extends Color { }
|
3
collects/htdch/idraw/White.java
Normal file
3
collects/htdch/idraw/White.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public class White extends Color { }
|
122
collects/htdch/idraw/World-native-methods.ss
Normal file
122
collects/htdch/idraw/World-native-methods.ss
Normal file
|
@ -0,0 +1,122 @@
|
|||
#cs
|
||||
(module World-native-methods mzscheme
|
||||
(require (lib "draw.ss" "htdp")
|
||||
(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
|
||||
;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)
|
||||
(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))))
|
||||
|
||||
(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)
|
||||
(send world erase)
|
||||
(send world onTick)
|
||||
(send world draw)
|
||||
world))
|
||||
(on-key-event
|
||||
(lambda (ke world)
|
||||
(send world erase)
|
||||
(send world onKeyEvent-java.lang.String (make-java-string (keyevent->string ke)))
|
||||
(send world draw)
|
||||
world))
|
||||
(void))
|
||||
|
||||
;; (union Char Symbol) -> String
|
||||
(define (keyevent->string ke)
|
||||
(if (char? ke) (string ke) (symbol->string ke)))
|
||||
|
||||
(define/provide (endOfTime-native this accs gets privates)
|
||||
(end-of-time)
|
||||
(void))
|
||||
)
|
||||
|
18
collects/htdch/idraw/World.java
Normal file
18
collects/htdch/idraw/World.java
Normal file
|
@ -0,0 +1,18 @@
|
|||
package idraw;
|
||||
|
||||
public abstract class World {
|
||||
|
||||
public Canvas theCanvas = new Canvas();
|
||||
|
||||
public native void bigBang(int width, int height, double s);
|
||||
|
||||
public native void endOfTime();
|
||||
|
||||
public abstract void onTick();
|
||||
|
||||
public abstract void onKeyEvent(String ke);
|
||||
|
||||
public abstract void draw();
|
||||
|
||||
public abstract void erase();
|
||||
}
|
3
collects/htdch/idraw/Yellow.java
Normal file
3
collects/htdch/idraw/Yellow.java
Normal file
|
@ -0,0 +1,3 @@
|
|||
package idraw;
|
||||
|
||||
public class Yellow extends Color { }
|
50
collects/htdch/idraw/doc.txt
Normal file
50
collects/htdch/idraw/doc.txt
Normal file
|
@ -0,0 +1,50 @@
|
|||
This `idraw' package provides libraries for modeling in a visual world:
|
||||
|
||||
+---------------------------------+
|
||||
| abstract World |
|
||||
+---------------------------------+ +------------------------------------+
|
||||
| Canvas theCanvas |------>| Canvas |
|
||||
+---------------------------------+ +------------------------------------+
|
||||
| void bigBang(int,int,double) | +------------------------------------+
|
||||
| void endOfTime() | | void start(int,int) |
|
||||
| | | void stop() |
|
||||
| abstract void onTick() | | void drawCircle(Posn,int,Color) |
|
||||
| abstract void onKeyEvent(String)| | void drawDisk(Posn,int,Color) |
|
||||
| abstract void draw() | | void drawRect(Posn,int,int,Color) |
|
||||
| abstract void erase() | | void drawLine(Posn,Posn,Color) |
|
||||
+---------------------------------+ | void drawString(Posn,String) |
|
||||
| void clearCircle(Posn,int,Color) |
|
||||
| void clearDisk(Posn,int,Color) |
|
||||
| void clearRect(Posn,int,int,Color) |
|
||||
| void clearLine(Posn,Posn,Color) |
|
||||
+------------------------------------+
|
||||
|
||||
- class Posn
|
||||
|
||||
+----------+
|
||||
| Posn |
|
||||
+----------+
|
||||
| int x |
|
||||
| int y |
|
||||
+----------+
|
||||
|
||||
- Color with five subclasses:
|
||||
+ Blue
|
||||
+ Green
|
||||
+ Red
|
||||
+ White
|
||||
+ Yellow
|
||||
|
||||
+-------+
|
||||
| Color |
|
||||
+-------+
|
||||
|
|
||||
/ \
|
||||
---
|
||||
|
|
||||
------------------------------------------
|
||||
| | | | |
|
||||
+-------+ +-------+ +-------+ +-------+ +-------+
|
||||
| Blue | | Green | | Red | | White | | Yellow|
|
||||
+-------+ +-------+ +-------+ +-------+ +-------+
|
||||
|
4
collects/htdch/idraw/info.ss
Normal file
4
collects/htdch/idraw/info.ss
Normal file
|
@ -0,0 +1,4 @@
|
|||
(module info (lib "infotab.ss" "setup")
|
||||
(define name "Imperative Draw Teachpack")
|
||||
(define install-collection "installer.ss")
|
||||
#;(define pre-install-collection "pre-installer.ss"))
|
28
collects/htdch/idraw/installer.ss
Normal file
28
collects/htdch/idraw/installer.ss
Normal file
|
@ -0,0 +1,28 @@
|
|||
(module installer mzscheme
|
||||
(require (lib "compile.ss" "profj"))
|
||||
(provide installer)
|
||||
|
||||
(define (mprintf a)
|
||||
(fprintf a (current-error-port)))
|
||||
|
||||
(define (installer plthome)
|
||||
(let ((draw-path (build-path (collection-path "htdch" "idraw"))))
|
||||
(let ((javac
|
||||
(lambda (file)
|
||||
(parameterize ([current-load-relative-directory draw-path]
|
||||
[current-directory draw-path] )
|
||||
(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 "Red.java")
|
||||
(javac "White.java")
|
||||
(javac "Blue.java")
|
||||
(javac "Black.java")
|
||||
(javac "Green.java")
|
||||
(javac "Yellow.java")
|
||||
))))
|
||||
|
15
collects/htdch/idraw/pre-installer.ss
Normal file
15
collects/htdch/idraw/pre-installer.ss
Normal file
|
@ -0,0 +1,15 @@
|
|||
(module pre-installer mzscheme
|
||||
(require (lib "compile.ss" "profj"))
|
||||
(provide pre-installer)
|
||||
|
||||
(define (pre-installer plthome)
|
||||
(let ((draw-path (build-path (collection-path "htdch" "idraw"))))
|
||||
(let ((javac
|
||||
(lambda (file)
|
||||
(parameterize ([current-load-relative-directory draw-path])
|
||||
(compile-java 'file 'file 'full
|
||||
(build-path draw-path file)
|
||||
#f #f)))))
|
||||
(javac "Posn.java")
|
||||
))))
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
(module info (lib "infotab.ss" "setup")
|
||||
(define name "htdch")
|
||||
(define compile-subcollections (list (list "htdch" "draw")
|
||||
(list "htdch" "graphics")
|
||||
(list "htdch" "graphics")
|
||||
(list "htdch" "idraw")
|
||||
))
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue
Block a user