diff options
author | Kartik K. Agaram <vc@akkartik.com> | 2014-12-23 23:38:16 -0800 |
---|---|---|
committer | Kartik K. Agaram <vc@akkartik.com> | 2014-12-23 23:52:37 -0800 |
commit | ef55a4146609051c0a4cb1ca46693f620bd12118 (patch) | |
tree | 8d3ff0314afe2f5f227669afbfedd0b7c56fad27 | |
parent | 4630b4aee88e312f2682eb17b98d0144e48fd7d5 (diff) | |
download | mu-ef55a4146609051c0a4cb1ca46693f620bd12118.tar.gz |
443 - simple graphics primitives
http://docs.racket-lang.org/graphics/Mouse_Operations.html Like with the text mode primitives, we still don't have a story for writing white-box tests for code using these.
-rw-r--r-- | graphics.mu | 20 | ||||
-rw-r--r-- | mu.arc | 17 |
2 files changed, 37 insertions, 0 deletions
diff --git a/graphics.mu b/graphics.mu new file mode 100644 index 00000000..c4520c8f --- /dev/null +++ b/graphics.mu @@ -0,0 +1,20 @@ +; open a viewport, print coordinates of mouse clicks +; currently need to ctrl-c to exit after closing the viewport +(function main [ + (graphics-on) + { begin + (pos:integer-integer-pair click?:boolean <- mouse-position) + { begin + (break-if click?:boolean) + (loop 2:blocks) + } + (x:integer <- get pos:integer-integer-pair 0:offset) + (y:integer <- get pos:integer-integer-pair 1:offset) + (print-primitive x:integer) + (print-primitive ((", " literal))) + (print-primitive y:integer) + (print-primitive (("\n" literal))) + (loop) + } + (graphics-off) +]) diff --git a/mu.arc b/mu.arc index c3527369..79f5586b 100644 --- a/mu.arc +++ b/mu.arc @@ -323,6 +323,8 @@ typeinfo.operand!address)) ($:require "charterm/main.rkt") +($:require graphics/graphics) +(= Viewport nil) ; run instructions from 'routine*' for 'time-slice' (def run-for-time-slice (time-slice) @@ -518,6 +520,21 @@ console-off (do1 nil (if ($.current-charterm) ($.close-charterm))) + ; graphics + graphics-on + (do1 nil + ($.open-graphics) + (= Viewport ($.open-viewport "practice" 300 300))) + graphics-off + (do1 nil + ($.close-graphics) + (= Viewport nil)) + mouse-position + (aif ($.ready-mouse-click Viewport) + (let posn ($.mouse-click-posn it) + (list (annotate 'record (list ($.posn-x posn) ($.posn-y posn))) t)) + (list nil nil)) + ; user-defined functions next-input (let idx caller-arg-idx.routine* |