This is a kludged up version of stephanh's planet.rkt demo, included with his RacketGL module, intended to demonstrate that my GL context sharing changes to Racket actually work. you should only need them, http://planet.racket-lang.org/package-source/stephanh/RacketGL.plt/1/4/examples/earth.png and my improved racket.

2planet.rkt

;; Extremely simply OpenGL demo.
;; Draw a "planet" (OK, a textured sphere).

#lang racket/gui

(require ffi/unsafe)
(require (planet "rgl.rkt" ("stephanh" "RacketGL.plt" 1 4)))
(require ffi/vector)
(require "viewer.rkt")

(define texture #f)

(define (make-circle first last step)
  (let ((factor (/ pi 180.0)))
    (for/list ((i (in-range first (+ last step) step)))
      (let ((phi (* factor (modulo i 360))))
        (cons (cos phi) (sin phi))))))

(define (make-sphere step)
  (let ((xy-list (make-circle 0 360 step))
        (rz-list (make-circle -90 90 step)))
    (for/list ((rz (in-list rz-list)))
      (let ((r (car rz)) (z (cdr rz)))
      (for/list ((xy (in-list xy-list)))
        (let ((x (car xy)) (y (cdr xy)))
          (vector (* r x) (* r y) z)))))))

(define (flatten-grid grid)
  (list->f32vector
    (for*/list ((row (in-list grid))
                (xyz (in-list row))
                (item (in-vector xyz)))
               (exact->inexact item))))

(define (make-grid-indices nrows ncols)
  (define (pos->index row col)
    (+ col (* row ncols)))
  (list->u32vector
  (for*/list ((row (in-range (- nrows 1)))
              (col (in-range (- ncols 1)))
              (i (in-list
                   (list
                     (pos->index row col)
                     (pos->index row (+ col 1))
                     (pos->index (+ row 1) (+ col 1))
                     (pos->index (+ row 1) col)))))
             i)))

(define (make-texcoords nrows ncols)
  (list->f32vector
    (for*/list ((row (in-range nrows))
                (col (in-range ncols))
                (item (list 
                        (/ (- ncols col) ncols)
                        (/ row nrows))))
               (exact->inexact item))))



(define sphere (make-sphere 15))
(define vertex-array (flatten-grid sphere))
(define nrows (length sphere))
(define ncols (length (car sphere)))
(define indices (make-grid-indices nrows ncols))
(define texcoord-array (make-texcoords nrows ncols))

(define display-list #f)

(define (init)
  (when (not texture)
     (set! texture (load-texture "earth.png")))

  (glBindTexture GL_TEXTURE_2D texture)
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT)
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT)
  (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)


  (when (not display-list)
     (set! display-list (glGenLists 1))

     (glNewList display-list GL_COMPILE)
                                        ; Let's be "modern" and use the array functions (introduced in OpenGL 1.1).
                                        ; Note that you need to ask GL everything 3 times:
                                        ; 1. Here is an array I'd like you to draw...
     (let-values (((type cptr) (gl-vector->type/cpointer vertex-array)))
       (glVertexPointer 3 type 0 cptr)
       (glNormalPointer type 0 cptr))
     (let-values (((type cptr) (gl-vector->type/cpointer texcoord-array)))
       (glTexCoordPointer 2 type 0 cptr))
                                        ; 2. Yes, I really want you to use it, I was not simply fooling around.
     (glEnableClientState GL_VERTEX_ARRAY)
     (glEnableClientState GL_NORMAL_ARRAY)
     (glEnableClientState GL_TEXTURE_COORD_ARRAY)
                                        ; 3. Allright, now draw the silly thing already!
     (let-values (((type cptr len) (gl-vector->type/cpointer/length indices)))
       (glDrawElements GL_QUADS len type cptr))
     
                                        ; Clean up state.
     (glDisableClientState GL_TEXTURE_COORD_ARRAY)
     (glDisableClientState GL_VERTEX_ARRAY)
     (glDisableClientState GL_NORMAL_ARRAY)
     
     (glEndList)))

(define (draw)
  (glEnable GL_LIGHTING)
  (glEnable GL_LIGHT0)
  (glEnable GL_DEPTH_TEST)
  (glEnable GL_NORMALIZE)
  (glEnable GL_CULL_FACE)

  (glBindTexture GL_TEXTURE_2D texture)
  (glEnable GL_TEXTURE_2D)

  (glCallList display-list))


(define boring-config (new gl-config%))
(define canvas (view draw init boring-config))
(define first-context
  (send (send canvas get-dc) get-gl-context))

(define config (new gl-config%))
(send config set-share-context first-context)
(view draw init config)

viewer.rkt

;; A simple viewer window for OpenGL.
;; Allows user to rotate and zoom the scene.
#lang racket/gui

(require (planet "rgl.rkt" ("stephanh" "RacketGL.plt" 1 3)))

(provide view)

(define gl-viewer%
  (class canvas%
    (super-new)
    (inherit with-gl-context swap-gl-buffers refresh)

    (init-field draw)
    (init-field (setup void))

    (define setup-called #f)

    (define/override (on-size width height)
      (with-gl-context
       (lambda ()
         (glViewport 0 0 width height)
         (glMatrixMode GL_PROJECTION)
         (glLoadIdentity)
         (if (< width height)
           (let ((h (/ height width)))
             (glFrustum -1.0 1.0 (- h) h 8.0 12.0))
           (let ((h (/ width height)))
             (glFrustum (- h) h -1.0 1.0 8.0 12.0)))
         (glMatrixMode GL_MODELVIEW)
         (glLoadIdentity)
         (glTranslated 0.0 0.0 -10.0))))

    (define x-rotation 0)
    (define y-rotation 0)
    (define zoom 1)
 
    (define/override (on-paint)
      (with-gl-context               
        (lambda ()
          (unless setup-called
            (setup)
            (set! setup-called #t))
          (glClearColor 0.0 0.0 0.3 0.0) ; darkish blue
          (glClear (bitwise-ior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
          (glPushMatrix)
          (glScaled zoom zoom zoom)
          (glRotated y-rotation 1 0 0)
          (glRotated x-rotation 0 1 0)
          (draw)
          (glPopMatrix)))
      (swap-gl-buffers))

    (define handle-motion void)

    (define/override (on-event event)
      (let ((x (send event get-x))
            (y (send event get-y)))
        (case (send event get-event-type)
          ((left-down)
           (set! handle-motion
             (let ((old-x x) (old-y y))
               (lambda (new-x new-y)
                 (set! x-rotation (+ x-rotation (- new-x old-x)))
                 (set! y-rotation (+ y-rotation (- new-y old-y)))
                 (set! old-x new-x)
                 (set! old-y new-y)
                 (refresh)))))
          ((left-up)
           (set! handle-motion void))
          ((motion) (handle-motion x y)))))

    (define/override (on-char event)
      (case (send event get-key-code)
        ((#\+) (set! zoom (* zoom 4/3)) (refresh))
        ((#\-) (set! zoom (/ zoom 4/3)) (refresh))
        ((wheel-up) (set! zoom (* zoom 9/8)) (refresh))
        ((wheel-down) (set! zoom (/ zoom 9/8)) (refresh))))))


(define (show-gl-info frame canvas)
  (let-values (((renderer version vendor)
                (send canvas with-gl-context
                      (lambda () 
                        (values
                          (glGetString GL_RENDERER)
                          (glGetString GL_VERSION)
                          (glGetString GL_VENDOR))))))
    (define label
      (format "RENDERER: ~a~%VERSION: ~a~%VENDOR: ~a"
              renderer version vendor))
    (define dialog (new dialog% [parent frame] [label "OpenGL info"]))          
    (define msg (new message%
                     [parent dialog]
                     [label label]))
    (define extensions-list (new list-box% 
                                 [parent dialog] 
                                 [label "EXTENSIONS:"]
                                 [style '(single vertical-label)]
                                 [choices
                                   (sort
                                     (for/list ((ext (in-set (gl-extensions))))
                                       (symbol->string ext))
                                     string<?)]))
    (send dialog show #t)))


(define (view draw (setup void) (config #f))
  (define frame 
    (new frame% 
         [label "OpenGL viewer"]
         [width 300]
         [height 300]))

  (define menubar
    (new menu-bar% [parent frame]))

  (define help-menu
    (new menu% [parent menubar] [label "&Help"]))

  (define c
    (new gl-viewer% 
         (style '(gl no-autoclear)) 
         (parent frame) 
         (gl-config config)
         (draw draw) (setup setup)))
  (printf "context: ~a~n" (send config get-share-context))

  (define gl-info-item
    (new menu-item% [parent help-menu] [label "GL info"]
         [callback (lambda (i e) (show-gl-info frame c))]))

  (send frame show #t)

  c)