Today I'm posting an example of how you can quickly get started with OpenGL using Chicken Scheme.

I am posting the code in full, but I have commented it pretty well and so everything should be quite simple to understand.

Unless you take out the texture rendering, you will probably want to get SOIL for your distribution (Archers can get it with sudo pacman -S soil).

;;; Lets make a simple OpenGL application using Chicken Scheme!
;;; Thanks to all the egg authors and Chicken Scheme contributors for making this awesomeness possible!

;; Firstly, lets include the eggs that we will use.
;; These are the OpenGL and GLUT eggs (for display),
;; and the Inline egg (described below).
;; These can each be installed using the "chicken-install" command

(use gl glut inline)

;; Now we will define some variables that we will reference later in our code

(define screen-w 800)
(define screen-h 600)

(define mouse-x 0)
(define mouse-y 0)

(define background-color '(0 0 0 0))

;; Using the wonderful inline egg, we can embed some C code directly into the
;; Scheme source and it will be compiled, cached and bound automatically, even
;; while using the interpreter! We're going to use this functionality to add
;; the ability to load textures into OpenGL using the wonderful SOIL library

;; Protip: If you select the lines inside inline in Emacs, you can use the
;; M-x narrow-to-region to show just the C code, and if you use M-x c-mode you
;; can even edit with your regular C keybindings. When you're done just use
;; M-x widen and then M-x scheme-mode to get back to normal. Emacs is awesome!

(inline #<<EOF
// The define guard stops Chicken from trying to read and parse SOIL.h
#ifndef CHICKEN
#include <SOIL.h>

// A simple wrapper to load an OpenGL texture using SOIL with sane parameters
unsigned int LoadGLTexture(char *path) {
    return SOIL_load_OGL_texture(path, SOIL_LOAD_AUTO, SOIL_CREATE_NEW_ID,
                                 SOIL_FLAG_POWER_OF_TWO | SOIL_FLAG_INVERT_Y |
                                 SOIL_FLAG_MULTIPLY_ALPHA | SOIL_FLAG_COMPRESS_TO_DXT |
                                 SOIL_FLAG_DDS_LOAD_DIRECT | SOIL_FLAG_TEXTURE_REPEATS);

// Bind the usleep function available on POSIX systems.
// on Win32 systems, the "Sleep" function is equivalent
int usleep(unsigned int ms);
"-lSOIL" ; Arguments to be provided to compiler and linker

;; This is one of those use cases I talked about in my call-cc article.
;; It provides the ability to break to a REPL by hitting the spacebar

(define return #f)
(define (break-to-repl)
  (printf "~nType (return) to resume rendering~n")
   (lambda (k)
     (set! return (lambda () (k #f)))

;; Now we're going to define two simple functions that can be used when 
;; coding our demos in OpenGL. This includes basic text display and the
;; drawing of a textured quad. Pretty simple but should serve as a good
;; starting point for creating your own stuff!

(define (draw-text text x y #!key (color '(1 1 1 1)))
  (apply gl:Color4f color)
  (gl:PushAttrib gl:ENABLE_BIT)
  (gl:Disable gl:TEXTURE_2D)
  (gl:RasterPos2f x y)
  ;; The cut macro is something I've only just discovered. It essentially returns a function made
  ;; from the parameters provided, however <> is replaced with the argument that is passed to it
  (string-for-each (cut glut:BitmapCharacter glut:BITMAP_8_BY_13 <>) text)

(define (draw-quad t x y w h #!key (color '(1 1 1 1)))
  (apply gl:Color4f color)
  (gl:BindTexture gl:TEXTURE_2D t)
  (gl:Begin gl:QUADS)
   (gl:TexCoord2f 1 1) (gl:Vertex2f x y)
   (gl:TexCoord2f 1 0) (gl:Vertex2f x (+ y h))
   (gl:TexCoord2f 0 0) (gl:Vertex2f (+ x w) (+ y h))
   (gl:TexCoord2f 0 1) (gl:Vertex2f (+ x w) y)

;; Now it's time to do the actual set up. We're going to define the
;; functions we need to open the display and handle any events through
;; callback functions we give to GLUT

(define (setup-display)
  ; These lines take care of setting up the GLUT window
  (glut:InitDisplayMode (bitwise-ior glut:DOUBLE glut:RGBA))
  (glut:InitWindowSize screen-w screen-h)
  (glut:CreateWindow "Chicken Scheme OpenGL | Hit space for REPL")

  ; Enable texturing and set background color
  (gl:Enable gl:TEXTURE_2D)
  (apply gl:ClearColor background-color)

  (gl:Enable gl:BLEND)
  (gl:BlendFunc gl:ONE gl:ONE)

  ; Set up a basic 2D orthogonal projection
  (gl:MatrixMode gl:PROJECTION)
  (gl:Ortho 0 screen-w screen-h 0 -1 1)
  (gl:MatrixMode gl:MODELVIEW))

(define (keyboard-handler key x y)
  ; If escape is pressed exit.
  ; If space is pressed then break to REPL
  (cond ((eq? key #\esc)
        ((eq? key #\space)

(define (idle-handler)
  ; Sleep for 100 microseconds to give up CPU time
  (usleep 100)
  ; And then redisplay

(define (display-handler)
  (gl:Clear (bitwise-ior gl:DEPTH_BUFFER_BIT gl:COLOR_BUFFER_BIT))

  ;; Here's where the drawing happens, so this is probably where
  ;; you'll spend most of your time hacking around. All that
  ;; this demo does however is draw a texture that follows the
  ;; cursor around the screen.

  (draw-text "Hello, OpenGL World!" 10 20)

  (gl:Translatef -50 -50 0)

  (draw-quad texture mouse-x mouse-y 100 100)


(define (passive-motion-handler x y)
  ; Update the mouse x and y positions
  (set! mouse-x x)
  (set! mouse-y y))

;; Cool, now we're ready to run!


; Load a texture
(define texture (LoadGLTexture "circle_gradient.tga"))

; Hook up GLUT events
(glut:KeyboardFunc keyboard-handler)
(glut:PassiveMotionFunc passive-motion-handler)
(glut:IdleFunc idle-handler)
(glut:DisplayFunc display-handler)

; Start the GLUT mainloop, which runs until exit

Make sure you have a texture of some sort sitting in the same directory as the code. I was using circular_gradient.tga.

If you now run this using csi example.csm, you should see a window popup with some text and a simple quad that follows the mouse cursor. If you hit the spacebar the rendering will pause and you will see a REPL in the terminal you launched it from. Inside the REPL you can potentially transform the render loop and do other such fun things. As a simple idea of what you can achieve, make sure you have another texture sitting in the example directory, and then type the following in the REPL:

(set! texture (LoadGLTexture "newtexture.tga"))

If all goes well, your render loop should continue, with the old texture replaced by the new one you just loaded. Pretty nifty!

In a future follow-up to this post I will have a go at adding FreeType font rendering, and using OpenAL for sound, so stay tuned!

(Maybe) Related posts: