From ddc560762a7641c07281d5f58fb2689c043c8167 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <jahvascriptmaniac+github@free.fr>
Date: Fri, 11 Feb 2011 21:47:18 +0100
Subject: [PATCH] =?UTF-8?q?Quelques=20essais=20avec=20racket/gui=20(assez?=
 =?UTF-8?q?=20compliqu=C3=A9=E2=80=A6).?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .gitignore |  1 +
 grunt.rkt  | 38 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 grunt.rkt

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b25c15b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*~
diff --git a/grunt.rkt b/grunt.rkt
new file mode 100644
index 0000000..6a8c7f8
--- /dev/null
+++ b/grunt.rkt
@@ -0,0 +1,38 @@
+#lang racket/gui
+
+(define black-pen (make-object pen% "BLACK" 1 'solid))
+(define transparent-brush (make-object brush% "BLACK" 'transparent))
+
+(define bloc-border-pen black-pen)
+(define bloc-fill-brush transparent-brush)
+
+(define test-block-y 100)
+
+(define (redraw canvas dc)
+  (send dc set-pen bloc-border-pen)
+  (send dc set-brush bloc-fill-brush)
+  (send dc draw-rectangle 100 test-block-y 10 10))
+
+(define (mouse-ev ev)
+  (display (send ev get-event-type))
+  (display " ")
+  (display (send ev get-x))
+  (display " ")
+  (displayln (send ev get-y)))
+
+(define (keyboard-ev ev)
+  (when (eq? (send ev get-key-code) 'down)
+    (set! test-block-y (+ test-block-y 10))
+    (send (send canvas get-dc) clear)
+    (send canvas on-paint)))
+      
+(define my-canvas% (class canvas%
+                     (define/override (on-event ev) (mouse-ev ev))
+                     (define/override (on-char ev) (keyboard-ev ev))
+                     (super-new)))
+
+(define frame (new frame% [label "Grunt"] [width 200] [height 200]))
+(define canvas (new my-canvas% [parent frame] [paint-callback redraw]))
+
+(define (grunt)
+  (send frame show #t))
\ No newline at end of file