[racket] Strange error with OpenGL in Windows XP

23 views
Skip to first unread message

Tomás Coiro

unread,
Jul 30, 2012, 11:13:10 PM7/30/12
to us...@racket-lang.org
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

unread,
Aug 2, 2012, 2:30:07 AM8/2/12
to us...@racket-lang.org, Tomás Coiro
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 <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

Reply all
Reply to author
Forward
0 new messages