changes:
* gl-init: initialized matrixes
* gl-handlekey: check if key set
* on-paint: remove refresh, it triggered on-paint again -> inifinite,
nonstop redraw
Tobias
================
#lang racket
(require sgl
sgl/gl-vectors
racket/gui)
(define WIDTH 800)
(define HEIGHT 800)
(define-syntax (add-key-maps stx)
(syntax-case stx ()
((_ (key fn) ...)
(syntax (begin
(add-key-mapping key fn) ...)))))
(define gl-init
(lambda ()
(gl-clear-color 0.0 0.0 0.0 0.0)
(gl-clear 'color-buffer-bit)
(gl-color 1.0 1.0 1.0)
(gl-matrix-mode 'projection)
(gl-load-identity)
(gl-ortho 0.0 1.0 0.0 1.0 -1.0 1.0)
(gl-matrix-mode 'modelview)
(gl-load-identity)))
(define (set-gl-init fn)
(set! gl-init fn))
(define gl-draw void)
(define (set-gl-draw fn)
(set! gl-draw fn))
(define *key-mappings* '())
(define (add-key-mapping key fn)
(set! *key-mappings* (cons (cons key fn) *key-mappings*)))
(define (clear-key-mappings)
(set! *key-mappings* '()))
(define (gl-handlekey key)
(define h (assoc key *key-mappings*))
(when h
((cdr h))))
(define init? #f)
(define gl-canvas%
(class* canvas% ()
(inherit refresh with-gl-context swap-gl-buffers)
(define/override (on-size w h)
(with-gl-context
(lambda ()
(gl-viewport 0 0 w h)
(refresh))))
(define/override (on-paint)
(with-gl-context
(lambda ()
(unless init?
(gl-init)
(set! init? #t))
(gl-draw)
(swap-gl-buffers)
(gl-flush))))
(define/override (on-char key)
(gl-handlekey (send key get-key-code))
(refresh))
(super-new (style '(gl no-autoclear)))))
(define frame (new frame% (label "No name game")))
(define canvas (new gl-canvas% (parent frame)
(min-width WIDTH)
(min-height HEIGHT)))
(send frame show #t)
(add-key-maps (#\m (lambda ()
(set-gl-draw
(lambda ()
(gl-begin 'polygon)
(gl-vertex 0.25 0.75 0.0)
(gl-vertex 0.75 0.75 0.0)
(gl-vertex 0.75 0.25 0.0)
(gl-vertex 0.25 0.25 0.0)
(gl-end)))
(send canvas refresh)))
(#\n (lambda ()
(set-gl-draw
(lambda ()
(gl-begin 'polygon)
(gl-vertex 0.4 0.6)
(gl-vertex 0.6 0.6)
(gl-vertex 0.6 0.4)
(gl-vertex 0.4 0.4)
(gl-end)))
(set! init? #f)
(send canvas refresh))))
On Tue, 31 Jul 2012 05:13:10 +0200, Tomás Coiro <tomc...@hotmail.com>
wrote:
--
---------------------------------------------------------
Tobias Hammer
DLR / Institute of Robotics and Mechatronics
Tel.: 08153/28-1487
Mail: tobias...@dlr.de
____________________
Racket Users list:
http://lists.racket-lang.org/users