commit da36120d5c1ac76b0bced11139f2efa3132e7697 parent ddc560762a7641c07281d5f58fb2689c043c8167 Author: Georges Dupéron <jahvascriptmaniac+github@free.fr> Date: Sun, 13 Feb 2011 01:52:44 +0100 Un peu de refactor. Diffstat:
| M | grunt.rkt | | | 31 | ++++++++++++++++++------------- |
1 file changed, 18 insertions(+), 13 deletions(-)
diff --git a/grunt.rkt b/grunt.rkt @@ -1,8 +1,20 @@ #lang racket/gui +;; Prepare a canvas +(define (get-my-canvas on-mouse on-key on-paint) + (define canvas '()) + (define my-canvas% (class canvas% + (define/override (on-event ev) (on-mouse ev canvas)) + (define/override (on-char ev) (on-key ev canvas)) + (super-new))) + (define frame (new frame% [label "Grunt"] [width 200] [height 200])) + (set! canvas (new my-canvas% [parent frame] [paint-callback on-paint])) + (lambda () + (send frame show #t))) + +;; Pens (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) @@ -13,26 +25,19 @@ (send dc set-brush bloc-fill-brush) (send dc draw-rectangle 100 test-block-y 10 10)) -(define (mouse-ev ev) +(define (mouse-ev ev canvas) (display (send ev get-event-type)) (display " ") (display (send ev get-x)) (display " ") (displayln (send ev get-y))) -(define (keyboard-ev ev) +(define (keyboard-ev ev canvas) (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 (get-my-canvas mouse-ev keyboard-ev redraw)) -(define (grunt) - (send frame show #t)) -\ No newline at end of file +(define world '()) +\ No newline at end of file