extra/gtk-samples/opengl/opengl.factor

   1 ! Copyright (C) 2010 Anton Gorenko.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.strings gdk.gl.ffi gobject.ffi gtk.ffi gtk.gl.ffi
   4 io.encodings.utf8 kernel locals opengl.gl ;
   5 IN: gtk-samples.opengl
   6
   7 ! This sample is based on
   8 ! http://code.valaide.org/content/simple-opengl-sample-using-gtkglext
   9
  10 :: on-configure ( sender event user-data -- result )
  11     sender gtk_widget_get_gl_context :> gl-context
  12     sender gtk_widget_get_gl_window :> gl-drawable
  13
  14     gl-drawable gl-context gdk_gl_drawable_gl_begin dup
  15     [
  16         0 0 200 200 glViewport
  17         gl-drawable gdk_gl_drawable_gl_end
  18     ] when ;
  19
  20 :: on-expose ( sender event user-data -- result )
  21     sender gtk_widget_get_gl_context :> gl-context
  22     sender gtk_widget_get_gl_window :> gl-drawable
  23
  24     gl-drawable gl-context gdk_gl_drawable_gl_begin dup
  25     [
  26         GL_COLOR_BUFFER_BIT glClear
  27
  28         GL_TRIANGLES glBegin
  29         1.0 0.0 0.0 glColor3f
  30         0 1 glVertex2i
  31         0.0 1.0 0.0 glColor3f
  32         -1 -1 glVertex2i
  33         0.0 0.0 1.0 glColor3f
  34         1 -1 glVertex2i
  35         glEnd
  36
  37         gl-drawable gdk_gl_drawable_is_double_buffered 1 =
  38         [ gl-drawable gdk_gl_drawable_swap_buffers ]
  39         [ glFlush ] if
  40
  41         gl-drawable gdk_gl_drawable_gl_end
  42     ] when ;
  43
  44 :: opengl-win ( -- window )
  45     GTK_WINDOW_TOPLEVEL gtk_window_new :> window
  46
  47     window
  48     [ "OpenGL" utf8 string>alien gtk_window_set_title ]
  49     [ 200 200 gtk_window_set_default_size ]
  50     [ GTK_WIN_POS_CENTER gtk_window_set_position ] tri
  51
  52     GDK_GL_MODE_RGBA gdk_gl_config_new_by_mode :> gl-config
  53
  54     window gl-config f t GDK_GL_RGBA_TYPE
  55     gtk_widget_set_gl_capability drop
  56
  57     window "configure-event" utf8 string>alien
  58     [ on-configure ] GtkWidget:configure-event f
  59     g_signal_connect drop
  60
  61     window "expose-event" utf8 string>alien
  62     [ on-expose ] GtkWidget:expose-event f
  63     g_signal_connect drop
  64
  65     window ;
  66
  67 :: opengl-main ( -- )
  68     f f gtk_init
  69     f f gtk_gl_init
  70     opengl-win :> window
  71
  72     window "destroy" utf8 string>alien
  73     [ 2drop gtk_main_quit ] GtkObject:destroy
  74     f f 0 g_signal_connect_data drop
  75
  76     window gtk_widget_show_all
  77
  78     gtk_main ;
  79
  80 MAIN: opengl-main
  81