[racket] Strange error with OpenGL in Windows XP

This one should work

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 <tomcoiro at hotmail.com>  
wrote:

>
> I have version 5.2.1 for windows 32-bit
>
> I'm trying to make an OpenGL program for a roguelike, so, I'm trying to  
> get a frame that can be updated and interacted with.
>
> The problem is that after i practically copied gl-frame and gears to get  
> a canvas class going and started trying simple drawing, i realized that  
> when the canvas worked, the frame just freezed (or froze?).
>
> What i mean is, everything works fine, the polygons are drawn, things  
> are in the right color, things are placed where they should, but after  
> that, when the program stops, the frame just stays there, i can't resize  
> it, i can't move it, i can't close it and i can't interact to it by  
> pressing keys (which i think work fine).
>
> For some strange reason, gears does work fine.
>
> In case it's important, i have a VIA S3G UniChrome Pro IGP graphics  
> card, have windows XP and this is my code
>
> #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-ortho 0.0 1.0 0.0 1.0 -1.0 1.0)))
>
> (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)
>   ((cdr (assoc key *key-mappings*))))
>
> (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)))
>       (refresh))
>    (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 on-paint)))
>               (#\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 on-paint))))
>  		 	   		


-- 
---------------------------------------------------------
Tobias Hammer
DLR / Institute of Robotics and Mechatronics
Tel.: 08153/28-1487
Mail: tobias.hammer at dlr.de