Skip to content

Instantly share code, notes, and snippets.

@tonyg

tonyg/2d.rkt

Last active April 8, 2024 03:41
Show Gist options
  • Save tonyg/5425736 to your computer and use it in GitHub Desktop.
Save tonyg/5425736 to your computer and use it in GitHub Desktop.
Download ZIP
Playing with OpenGL in Racket
Raw
2d.rkt
#lang send-exp racket/gui
(require sgl/gl)
(require sgl/gl-vectors)
(require pict)
(define texture%
(class object%
(init [(initial-bitmap bitmap)])
(field [width 0]
[height 0]
[textures #f])
(define {get-width self} width)
(define {get-height self} height)
(define {bind-texture self}
(when (not textures) (error 'bind-texture "Attempt to use disposed texture%"))
(glBindTexture GL_TEXTURE_2D (gl-vector-ref textures 0)))
(define {load-from-bitmap! self bitmap}
(when textures {dispose self})
(set! textures (glGenTextures 1))
{bind-texture self}
(define image-data
(let ()
(set! width {get-width bitmap})
(set! height {get-height bitmap})
(define dc (new bitmap-dc% [bitmap bitmap]))
(define pixels (* width height))
(define vec (make-gl-ubyte-vector (* pixels 4)))
(define data (make-bytes (* pixels 4)))
{get-argb-pixels dc 0 0 width height data #f #t}
(for ((i (in-range pixels)))
(for ((j (in-range 4)))
(gl-vector-set! vec (+ (* i 4) j) (bytes-ref data (+ (* i 4) (- 3 j))))))
vec))
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR)
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
(glTexImage2D GL_TEXTURE_2D 0 4 width height 0 GL_BGRA GL_UNSIGNED_BYTE image-data))
(define {dispose self}
(when textures
(glDeleteTextures textures)
(set! textures #f)))
(super-new)
(load-from-bitmap! initial-bitmap)))
(define sim-time
(let ((start-time (current-inexact-milliseconds)))
(lambda ()
(- (current-inexact-milliseconds) start-time))))
(define glcanvas%
(class canvas%
(inherit refresh with-gl-context swap-gl-buffers)
(define *texture*
(delay
(new texture%
[bitmap
(pict->bitmap (cc-superimpose (colorize (disk 100) "white")
(text "yo" 'default 72)))])))
(define init? #f)
(define-values (bg-r bg-g bg-b) (values 0.9 0.9 0.9))
(define near-depth 10) ;; 2.5D
(define far-depth 15) ;; 2.5D
(define (lerp a b v) (+ (* v a) (* (- 1 v) b)))
(define/override (on-paint)
(with-gl-context
(lambda ()
(unless init?
(glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA)
;; (glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_ALPHA)
(glEnable GL_BLEND)
;; Standard Init
(glEnable GL_TEXTURE_2D)
(set! init? #t))
(let ((bg-cycle-divisor (/ 1000.0 1)))
(glClearColor (lerp bg-r 0 (sin (+ 0 (/ (sim-time) bg-cycle-divisor))))
(lerp bg-g 0 (sin (+ (* pi 2/3) (/ (sim-time) bg-cycle-divisor))))
(lerp bg-b 0 (sin (+ (* pi 4/3) (/ (sim-time) bg-cycle-divisor))))
1.0))
(glClear GL_COLOR_BUFFER_BIT)
(glLoadIdentity)
(glTranslated 0 0 (- near-depth))
{bind-texture (force *texture*)}
(define (face x y w h layer #:color [color '(1 1 1)])
(define blend (- 1 (abs layer)))
(define z (lerp far-depth near-depth layer))
(define cx (/ (+ x w) 2))
(define cy (/ (+ y h) 2))
(define ww (* w (/ near-depth z)))
(define hh (* h (/ near-depth z)))
(define xx (- cx (/ ww 2)))
(define yy (- cy (/ hh 2)))
(match color
[(list r g b)
(glColor4d (lerp r 0 blend)
(lerp g 0 blend)
(lerp b 0 blend)
(lerp 1 0 blend))])
(glPushMatrix)
(glTranslated cx cy 0)
(glRotated (/ (sim-time) 10) 0 0 -1)
(glTranslated (- cx) (- cy) 0)
(glBegin GL_QUADS)
(glNormal3d 0 0 -1)
(glTexCoord2i 0 0)
(glVertex3d xx yy 0)
(glTexCoord2i 1 0)
(glVertex3d (+ xx ww) yy 0)
(glTexCoord2i 1 1)
(glVertex3d (+ xx ww) (+ yy hh) 0)
(glTexCoord2i 0 1)
(glVertex3d xx (+ yy hh) 0)
(glEnd)
(glPopMatrix))
(let* ((layer-divisor (/ 1000.0 3))
(layer (expt (sin (/ (sim-time) layer-divisor)) 10))
(w {get-width (force *texture*)})
(h {get-height (force *texture*)}))
(face 010 110 w h layer #:color (list 1 0 0))
(face 410 110 w h layer #:color (list 0 0 1))
(face (+ 210 (* (sin (/ (sim-time) 500.0)) 200))
(+ 110 (* (sin (/ (sim-time) 120.0)) 100))
(* w 2)
(* h 2)
0)
(face 210 110 w h (- layer) #:color (list 0 1 0)))
(glFlush)
(swap-gl-buffers)))
(queue-callback (lambda () (refresh)) #f))
(define/override (on-size width height)
(with-gl-context
(lambda ()
(glViewport 0 0 width height)
(glMatrixMode GL_PROJECTION)
(glLoadIdentity)
;; (gluPerspective 45 (/ width height) 0.1 100)
(glOrtho 0 width height 0 0.1 100)
(glMatrixMode GL_MODELVIEW)
(glLoadIdentity)))
(refresh))
(define/override (on-char key)
(define key-code {get-key-code key})
(cond
[(and {get-control-down key} (equal? key-code #\q))
{show {get-top-level-window this} #f}]
[(equal? key-code 'release) (void)]
[else
(with-gl-context
(lambda ()
(define p (cc-superimpose (colorize (disk 100) "white")
(text (format "~a" key-code) 'default 72)))
{load-from-bitmap! (force *texture*) (pict->bitmap p)}))])
(refresh))
(super-new (style '(gl no-autoclear)))))
(module+ main
(define frame (new frame%
[style '(no-resize-border no-caption no-system-menu hide-menu-bar)]
[label "OpenGL Window"]
[width 640]
[height 480]))
(define glcanvas (new glcanvas% [parent frame]))
(unless {ok? {get-gl-context {get-dc glcanvas}}}
(error 'gl-run "OpenGL context failed to initialize"))
{focus glcanvas}
{show frame #t})
Raw
glui.rkt
#lang racket/base
;; Experimentation with OpenGL for widgetry.
(require racket/class)
(require racket/gui/base)
(require sgl)
(require sgl/gl-vectors)
(define c%
(class canvas%
(inherit refresh with-gl-context swap-gl-buffers)
(super-new)
;; (define/override (on-paint)
;; (define dc (send this get-dc))
;; (send dc set-brush "black" 'solid)
;; (send dc draw-rectangle 0 0 (send this get-width) (send this get-height)))
(define view-rotx 20.0)
(define view-roty 30.0)
(define view-rotz 0.0)
(define/public (STEP)
;; (set! view-rotx (+ view-rotx 1))
(set! view-roty (+ view-roty 2))
(set! view-rotz (+ view-rotz 1))
(refresh)
(sleep/yield 1/60)
(queue-callback (lambda _ (send this STEP)) #f))
(define/override (on-paint)
(with-gl-context
(lambda ()
(gl-clear-color 0.0 0.0 0.0 0.0)
(gl-clear 'color-buffer-bit 'depth-buffer-bit)
(gl-push-matrix)
(gl-rotate view-rotx 1.0 0.0 0.0)
(gl-rotate view-roty 0.0 1.0 0.0)
(gl-rotate view-rotz 0.0 0.0 1.0)
(define (face xr yr zr)
(gl-push-matrix)
(gl-rotate xr 1.0 0.0 0.0)
(gl-rotate yr 0.0 1.0 0.0)
(gl-rotate zr 0.0 0.0 1.0)
(gl-translate 0 0 1)
(gl-color 1 1 0) (gl-rect 0 0 1 1)
(gl-color 1 0 0) (gl-rect -1 -1 0 0)
(gl-color 0 1 0) (gl-rect -1 0 0 1)
(gl-color 0 0 1) (gl-rect 0 -1 1 0)
(gl-pop-matrix))
(face 0 0 0)
(face 90 0 0)
(face 0 90 0)
(face 0 180 0)
(face 90 180 0)
(face 0 270 0)
;; (gl-begin 'quads)
;; (gl-normal 0 0 1)
;; (gl-vertex -1 -1 1)
;; (gl-vertex 1 -1 1)
;; (gl-vertex 1 1 1)
;; (gl-vertex -1 1 1)
;; (gl-end)
(gl-pop-matrix)
(swap-gl-buffers)
(gl-flush))))
(define/override (on-event e)
(when (is-a? e mouse-event%)
(when (eq? (send e get-event-type) 'left-down)
(exit 0))))
(define/override (on-size width height)
(with-gl-context
(lambda ()
(gl-viewport 0 0 width height)
(gl-matrix-mode 'projection)
(gl-load-identity)
(let ((h (/ height width)))
(gl-frustum -1.0 1.0 (- h) h 5.0 60.0))
(gl-matrix-mode 'modelview)
(gl-load-identity)
(gl-translate 0.0 0.0 -40.0)
(gl-light-v 'light0 'position (vector->gl-float-vector
(vector 5.0 5.0 10.0 0.0)))
(gl-enable 'cull-face)
(gl-enable 'lighting)
(gl-enable 'light0)
(gl-enable 'depth-test)
;;(gl-material-v 'front 'ambient-and-diffuse (vector->gl-float-vector (vector 1 1 0 1)))
;;(gl-material-v 'front 'specular (vector->gl-float-vector (vector 1 1 1 1)))
;;(gl-material-v 'front 'emission (vector->gl-float-vector (vector 0 0 0 1)))
(gl-color-material 'front 'ambient-and-diffuse)
(gl-enable 'color-material)
))
(refresh))
))
(module+ main
(define-values (W H) (get-display-size #t))
(define f (new frame%
[style '(no-resize-border
no-caption
no-system-menu
hide-menu-bar)]
[label "glui"]
[width W]
[height H]))
(define c (new c%
[parent f]
[style '(gl)]))
(send f show #t)
(send f center 'both)
(send c STEP))
Raw
hacked-up-alpha.rkt
#lang send-exp racket/gui
(require sgl/gl
sgl/gl-vectors)
(define (bitmap->gl-vector bmp)
(let* ((dc (instantiate bitmap-dc% (bmp)))
(pixels (* (send bmp get-width) (send bmp get-height)))
(vec (make-gl-ubyte-vector (* pixels 3)))
(data (make-bytes (* pixels 4)))
(i 0))
(send dc get-argb-pixels 0 0 (send bmp get-width) (send bmp get-height) data)
(let loop ()
(when (< i pixels)
(gl-vector-set! vec (* i 3) (bytes-ref data (+ (* i 4) 1)))
(gl-vector-set! vec (+ (* i 3) 1) (bytes-ref data (+ (* i 4) 2)))
(gl-vector-set! vec (+ (* i 3) 2) (bytes-ref data (+ (* i 4) 3)))
(set! i (+ i 1))
(loop)))
(send dc set-bitmap #f)
(list (send bmp get-width) (send bmp get-height) vec)))
(define *texture*
(bitmap->gl-vector
(make-object bitmap% "chromelauncher2beta_screenshot2.jpg" 'unknown #f)))
(define glcanvas%
(class canvas%
(inherit refresh with-gl-context swap-gl-buffers)
(define *xrot* 0)
(define *yrot* 0)
(define *zrot* 0)
(define init? #f)
(define/override (on-paint)
(with-gl-context
(lambda ()
(unless init?
;; (glShadeModel GL_SMOOTH)
;; (glClearColor 0.0 0.0 0.0 0.5)
;; (glClearDepth 1)
;; (glEnable GL_DEPTH_TEST)
;; (glDepthFunc GL_LEQUAL)
;; (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
(define res *texture*)
;; Same texture, three smoothing styles...
(init-textures 3)
(unless (gl-load-texture (list-ref res 2) (list-ref res 0) (list-ref res 1)
GL_NEAREST GL_NEAREST 0)
(error "Couldn't load texture"))
(unless (gl-load-texture (list-ref res 2) (list-ref res 0) (list-ref res 1)
GL_LINEAR GL_LINEAR 1)
(error "Couldn't load texture"))
(unless (gl-load-texture (list-ref res 2) (list-ref res 0) (list-ref res 1)
GL_LINEAR GL_LINEAR_MIPMAP_NEAREST 2)
(error "Couldn't load texture"))
;; Set-up alpha blending 50% transparency
(glColor4d 1 1 1 0.5)
(glBlendFunc GL_SRC_ALPHA GL_ONE)
(glEnable GL_BLEND)
;; Standard Init
(glEnable GL_TEXTURE_2D)
(glShadeModel GL_SMOOTH)
(glClearColor 0.0 0.0 0.0 0.5)
(glClearDepth 1)
(glEnable GL_DEPTH_TEST)
(glDepthFunc GL_LEQUAL)
(glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
;; default light
(glEnable GL_LIGHT0)
(glEnable GL_LIGHTING)
(set! init? #t))
;; erase the background
(glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
;; turn blending on/off
(if #t (glEnable GL_BLEND) (glDisable GL_BLEND))
;; draw cube.
(glLoadIdentity)
(glTranslated 0 0 -5)
(glRotated *xrot* 1 0 0)
(glRotated *yrot* 0 1 0)
(glRotated *zrot* 0 0 1)
(glBindTexture GL_TEXTURE_2D (get-texture 0))
(glBegin GL_QUADS)
; front
(glNormal3d 0 0 1)
(glTexCoord2i 0 0)
(glVertex3i -1 -1 1)
(glTexCoord2i 1 0)
(glVertex3i 1 -1 1)
(glTexCoord2i 1 1)
(glVertex3i 1 1 1)
(glTexCoord2i 0 1)
(glVertex3i -1 1 1)
; back
(glNormal3d 0 0 -1)
(glTexCoord2i 1 0)
(glVertex3i -1 -1 -1)
(glTexCoord2i 1 1)
(glVertex3i 1 -1 -1)
(glTexCoord2i 0 1)
(glVertex3i 1 1 -1)
(glTexCoord2i 0 0)
(glVertex3i -1 1 -1)
; top
(glNormal3d 0 1 0)
(glTexCoord2i 0 1)
(glVertex3i -1 1 -1)
(glTexCoord2i 0 0)
(glVertex3i 1 1 -1)
(glTexCoord2i 1 0)
(glVertex3i 1 1 1)
(glTexCoord2i 1 1)
(glVertex3i -1 1 1)
; bottom
(glNormal3d 0 -1 0)
(glTexCoord2i 1 1)
(glVertex3i -1 -1 -1)
(glTexCoord2i 0 1)
(glVertex3i -1 -1 1)
(glTexCoord2i 0 0)
(glVertex3i 1 -1 1)
(glTexCoord2i 1 0)
(glVertex3i 1 -1 -1)
; right
(glNormal3d 1 0 0)
(glTexCoord2i 1 0)
(glVertex3i 1 -1 -1)
(glTexCoord2i 1 1)
(glVertex3i 1 -1 1)
(glTexCoord2i 0 1)
(glVertex3i 1 1 1)
(glTexCoord2i 0 0)
(glVertex3i 1 1 -1)
;left
(glNormal3d -1 0 0)
(glTexCoord2i 0 0)
(glVertex3i -1 -1 -1)
(glTexCoord2i 1 0)
(glVertex3i -1 1 -1)
(glTexCoord2i 1 1)
(glVertex3i -1 1 1)
(glTexCoord2i 0 1)
(glVertex3i -1 -1 1)
(glEnd)
(set! *xrot* (+ *xrot* 0.3))
(set! *yrot* (+ *yrot* 0.2))
(set! *zrot* (+ *zrot* 0.4))
(glFlush)
(swap-gl-buffers)))
(queue-callback (lambda () (refresh)) #f))
(define/override (on-size width height)
(with-gl-context
(lambda ()
(glViewport 0 0 width height)
(glMatrixMode GL_PROJECTION)
(glLoadIdentity)
(gluPerspective 45 (/ width height) 0.1 100)
(glMatrixMode GL_MODELVIEW)
(glLoadIdentity)))
(refresh))
(define/override (on-char key)
(log-info "Key: ~v" (send key get-key-code))
(refresh))
(super-new (style '(gl no-autoclear)))))
;; (define texture%
;; (class object%
;; (define textures (glGenTextures 1))
;; (super-new)
(define *textures* '())
(define (init-textures count)
(set! *textures* (glGenTextures count)))
(define (gl-load-texture image-vector width height min-filter mag-filter ix)
(glBindTexture GL_TEXTURE_2D (gl-vector-ref *textures* ix))
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER min-filter)
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER mag-filter)
(let* ((new-width 128)
(new-height 128)
(new-img-vec (make-gl-ubyte-vector (* new-width new-height 3))))
(gluScaleImage GL_RGB
width height GL_UNSIGNED_BYTE image-vector
new-width new-height GL_UNSIGNED_BYTE new-img-vec)
(if (or (= min-filter GL_LINEAR_MIPMAP_NEAREST)
(= mag-filter GL_LINEAR_MIPMAP_NEAREST))
(gluBuild2DMipmaps GL_TEXTURE_2D 3 new-width new-height GL_RGB GL_UNSIGNED_BYTE new-img-vec)
(glTexImage2D GL_TEXTURE_2D 0 3 new-width new-height 0 GL_RGB GL_UNSIGNED_BYTE new-img-vec))))
(define (get-texture ix)
(gl-vector-ref *textures* ix))
(module+ main
(define frame (new frame%
[label "OpenGL Window"]
[width 640]
[height 480]))
(define glcanvas (new glcanvas% [parent frame]))
(unless (send (send (send glcanvas get-dc) get-gl-context) ok?)
(error 'gl-run "OpenGL context failed to initialize"))
(send frame show #t))
Raw
main.rkt
#lang send-exp racket/gui
(require sgl/gl)
(require sgl/gl-vectors)
(require pict)
(define texture%
(class object%
(init [(initial-bitmap bitmap)])
(field [width 0]
[height 0]
[textures #f])
(define {get-width self} width)
(define {get-height self} height)
(define {bind-texture self}
(when (not textures) (error 'bind-texture "Attempt to use disposed texture%"))
(glBindTexture GL_TEXTURE_2D (gl-vector-ref textures 0)))
(define {load-from-bitmap! self bitmap}
(when textures {dispose self})
(set! textures (glGenTextures 1))
{bind-texture self}
(define image-data
(let ()
(set! width {get-width bitmap})
(set! height {get-height bitmap})
(define dc (new bitmap-dc% [bitmap bitmap]))
(define pixels (* width height))
(define vec (make-gl-ubyte-vector (* pixels 4)))
(define data (make-bytes (* pixels 4)))
{get-argb-pixels dc 0 0 width height data}
(for ((i (in-range pixels)))
(for ((j (in-range 4)))
(gl-vector-set! vec (+ (* i 4) j) (bytes-ref data (+ (* i 4) (- 3 j))))))
vec))
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR)
(glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
(glTexImage2D GL_TEXTURE_2D 0 4 width height 0 GL_BGRA GL_UNSIGNED_BYTE image-data))
(define {dispose self}
(when textures
(glDeleteTextures textures)
(set! textures #f)))
(super-new)
(load-from-bitmap! initial-bitmap)))
(define sim-time
(let ((start-time (current-inexact-milliseconds)))
(lambda ()
(- (current-inexact-milliseconds) start-time))))
(define glcanvas%
(class canvas%
(inherit refresh with-gl-context swap-gl-buffers)
(define *xrot* 0)
(define *yrot* 0)
(define *zrot* 0)
(define *texture*
(delay
(new texture%
[bitmap (make-object bitmap% "chromelauncher2beta_screenshot2.jpg" 'unknown #f)])))
(define init? #f)
(define/override (on-paint)
(with-gl-context
(lambda ()
(unless init?
(glEnable GL_COLOR_MATERIAL)
(glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
(glEnable GL_BLEND)
;; Standard Init
(glEnable GL_TEXTURE_2D)
(glShadeModel GL_SMOOTH)
(glClearColor 0.9 0.9 0.9 1.0)
(glClearDepth 1)
(glEnable GL_DEPTH_TEST)
(glDepthFunc GL_LEQUAL)
(glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
;; default light
(glEnable GL_LIGHT0)
(glEnable GL_LIGHTING)
(set! init? #t))
(glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
;; draw cube.
(glLoadIdentity)
(glTranslated 0 0 -5)
(glRotated *xrot* 1 0 0)
(glRotated *yrot* 0 1 0)
(glRotated *zrot* 0 0 1)
{bind-texture (force *texture*)}
(glBegin GL_QUADS)
;; (face [[top left corner point]] [[normal vec]] [[x axis vec]] [[width]] [[height]])
(define (face x1 y1 z1 nx0 ny0 nz0 xx0 xy0 xz0 w h)
(define (vlen x y z) (sqrt (+ (* x x) (* y y) (* z z))))
(define (cross x1 y1 z1 x2 y2 z2) (values (- (* y1 z2) (* z1 y2))
(- (* z1 x2) (* x1 z2))
(- (* x1 y2) (* y1 x2))))
(define (scale s x y z) (values (* x s) (* y s) (* z s)))
(define (norm x y z) (let ((l (vlen x y z)))
(if (zero? l)
(values 0 0 1)
(scale (/ l) x y z))))
(define-values (nx ny nz) (norm nx0 ny0 nz0))
(define-values (xx xy xz) (norm xx0 xy0 xz0))
(define-values (yx yy yz) (cross xx xy xz nx ny nz))
(define (v x y)
(glVertex3d (+ x1 (* xx (wobble x)) (* yx y))
(+ y1 (* xy x) (* yy (wobble y)))
(+ z1 (* xz x) (* yz y))))
(glNormal3d nx ny nz)
(glTexCoord2i 0 0)
(v 0 0)
(glTexCoord2i 1 0)
(v w 0)
(glTexCoord2i 1 1)
(v w h)
(glTexCoord2i 0 1)
(v 0 h))
(define (wobble v)
(define s (sin (/ (sim-time) 333.3)))
(+ v (abs s)))
(glColor4d 1 0 0 1)
(face -1 +1 +1 0 0 +1 +1 0 0 2 2)
(glColor4d 1 0 1 1)
(face +1 +1 -1 0 0 -1 -1 0 0 2 2)
(glColor4d 0 1 0 1)
(face +1 +1 +1 +1 0 0 0 0 -1 2 2)
(glColor4d 0 1 1 1)
(face -1 +1 -1 -1 0 0 0 0 +1 2 2)
(glColor4d 0 0 1 1)
(face -1 +1 -1 0 +1 0 +1 0 0 2 2)
(glColor4d 1 1 1 1)
(face -1 -1 +1 0 -1 0 +1 0 0 2 2)
(glEnd)
(set! *xrot* (+ *xrot* 0.3))
(set! *yrot* (+ *yrot* 0.2))
(set! *zrot* (+ *zrot* 0.4))
(glFlush)
(swap-gl-buffers)))
(queue-callback (lambda () (refresh)) #f))
(define/override (on-size width height)
(with-gl-context
(lambda ()
(glViewport 0 0 width height)
(glMatrixMode GL_PROJECTION)
(glLoadIdentity)
(gluPerspective 45 (/ width height) 0.1 100)
;; (glOrtho 0 width height 0 0.1 100)
(glMatrixMode GL_MODELVIEW)
(glLoadIdentity)))
(refresh))
(define/override (on-char key)
(define key-code {get-key-code key})
(cond
[(and {get-control-down key} (equal? key-code #\q))
{show {get-top-level-window this} #f}]
[(equal? key-code 'release) (void)]
[else
(with-gl-context
(lambda ()
(define p (cc-superimpose (colorize (disk 100) "white")
(text (format "~a" key-code) 'default 72)))
{load-from-bitmap! (force *texture*) (pict->bitmap p)}))])
(refresh))
(super-new (style '(gl no-autoclear)))))
(module+ main
(define frame (new frame%
[label "OpenGL Window"]
[width 640]
[height 480]))
(define glcanvas (new glcanvas% [parent frame]))
(unless {ok? {get-gl-context {get-dc glcanvas}}}
(error 'gl-run "OpenGL context failed to initialize"))
{focus glcanvas}
{show frame #t})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment