test-gl.rkt

test-gl.rkt

#lang racket

(require 
  racket/gui
  sgl)


(define c%
  (class canvas%
    (inherit refresh with-gl-context swap-gl-buffers)
    
    (super-new)
    
    (define/override (on-paint)
      (with-gl-context
       (lambda ()
         (gl-push-matrix)
         (gl-color 0 0 1) 
         (gl-rect 0 0 1 1)
         (gl-pop-matrix)
         (swap-gl-buffers)
         (gl-flush))))
    
    (refresh)))

(module+ main
  (define f (new frame%
                 [style '(no-resize-border
                          no-caption)]
                 [label "glui"]
                 [width 1280]
                 [height 1024]))
  (define c (new c%
                 [parent f]
                 [style '(gl)]))
  (send f show #t)
  (send f center 'both))