demonastery.org

;;;
;;; 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>
#endif

// 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);
EOF
"-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")
  (call/cc
   (lambda (k)
     (set! return (lambda () (k #f)))
     (repl))))


;; 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)
  (gl:PopAttrib))

(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)
  (gl:End))


;; 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)
  (gl:TexEnvf gl:TEXTURE_ENV gl:TEXTURE_ENV_MODE gl:MODULATE)
  (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:LoadIdentity)
  (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)
         (exit))
        ((eq? key #\space)
         (break-to-repl))))

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

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

  ;; 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)

  (glut:SwapBuffers))

(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!

(setup-display)

; 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
(glut:MainLoop)

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