languages/lua/src/lib/glut.pir

   1 # Copyright (C) 2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 lib/glut.pir - GLUT library
   7
   8 =head1 DESCRIPTION
   9
  10 This file implements the GLUT binding for Lua.
  11
  12 See original on L<http://luagl.wikidot.com/>
  13
  14 This implementation is based on a wrapper over OpenGL,
  15 see F<runtime/parrot/library/OpenGL.pir>.
  16
  17 =over 4
  18
  19 =cut
  20
  21 .HLL 'Lua', 'lua_group'
  22 .namespace [ 'glut' ]
  23
  24 .sub '__onload' :anon :load
  25 #    print "__onload glut\n"
  26     .const .Sub entry = 'luaopen_glut'
  27     set_hll_global 'luaopen_glut', entry
  28 .end
  29
  30 .sub 'luaopen_glut'
  31 #    print "luaopen_glut\n"
  32     load_bytecode 'OpenGL.pir'
  33     load_bytecode 'NCI/call_toolkit_init.pir'
  34
  35     # Import all OpenGL/GLU/GLUT functions
  36     $P0 = get_hll_global ['OpenGL'], '_export_all_functions'
  37     $P0()
  38
  39     .local pmc _lua__GLOBAL
  40     _lua__GLOBAL = get_hll_global '_G'
  41
  42     new $P1, 'LuaString'
  43
  44     .local pmc _glut
  45     new _glut, 'LuaTable'
  46     set $P1, 'glut'
  47     _lua__GLOBAL[$P1] = _glut
  48
  49     $P2 = split "\n", <<'LIST'
  50 CreateWindow
  51 DestroyWindow
  52 DisplayFunc
  53 IdleFunc
  54 Init
  55 InitDisplayMode
  56 InitWindowSize
  57 KeyboardFunc
  58 MainLoop
  59 PostRedisplay
  60 ReshapeFunc
  61 SwapBuffers
  62 LIST
  63     lua_register($P1, _glut, $P2)
  64
  65     .return (_glut)
  66 .end
  67
  68
  69 .include 'opengl_defines.pasm'
  70
  71 =item C<glut.CreateWindow (title)>
  72
  73 =cut
  74
  75 .sub 'CreateWindow'
  76     .param pmc title :optional
  77     .param pmc extra :slurpy
  78     $I0 = lua_isstring(title)
  79     if $I0 goto L1
  80     lua_error("incorrect argument to function 'glut.CreateWindow'")
  81   L1:
  82     $S1 = title
  83     $I0 = glutCreateWindow($S1)
  84     new $P0, 'LuaNumber'
  85     set $P0, $I0
  86     .return ($P0)
  87 .end
  88
  89
  90 =item C<glut.DestroyWindow (window)>
  91
  92 not LuaGL
  93
  94 =cut
  95
  96 .sub 'DestroyWindow'
  97     .param pmc window :optional
  98     .param pmc extra :slurpy
  99     $I0 = lua_isnumber(window)
 100     if $I0 goto L1
 101     lua_error("incorrect argument to function 'glut.DestroyWindow'")
 102   L1:
 103     $I1 = window
 104     glutDestroyWindow($I1)
 105 .end
 106
 107
 108 =item C<glut.DisplayFunc (funcname)>
 109
 110 =cut
 111
 112 .sub 'DisplayFunc'
 113     .param pmc funcname :optional
 114     .param pmc extra :slurpy
 115     $I0 = lua_isstring(funcname)
 116     if $I0 goto L1
 117     lua_error("incorrect argument to function 'glut.DisplayFunc'")
 118   L1:
 119     set_hll_global 'displayFunc.name', funcname
 120     .const .Sub display = 'display'
 121     glutDisplayFunc(display)
 122 .end
 123
 124 .sub 'display' :anon
 125     .local pmc _lua__GLOBAL, funcname
 126     _lua__GLOBAL = get_hll_global '_G'
 127     funcname = get_hll_global 'displayFunc.name'
 128     $P0 = _lua__GLOBAL[funcname]
 129     $I0 = lua_isfunction($P0)
 130     if $I0 goto L2
 131     printerr "Script error: cannot find "
 132     printerr funcname
 133     printerr " function.\n\n"
 134   L2:
 135     push_eh _handler
 136     $P0()
 137     .return ()
 138   _handler:
 139     .local pmc e
 140     .local string s
 141     .get_results (e, s)
 142     printerr "Error running lua script:\n\n  "
 143     printerr s
 144     printerr " \n\n"
 145 .end
 146
 147
 148 =item C<glut.IdleFunc (funcname)>
 149
 150 =cut
 151
 152 .sub 'IdleFunc'
 153     .param pmc funcname :optional
 154     .param pmc extra :slurpy
 155     $I0 = lua_isstring(funcname)
 156     if $I0 goto L1
 157     lua_error("incorrect argument to function 'glut.IdleFunc'")
 158   L1:
 159     set_hll_global 'idleFunc.name', funcname
 160     .const .Sub idle = 'idle'
 161     glutIdleFunc(idle)
 162 .end
 163
 164 .sub 'idle' :anon
 165     .local pmc _lua__GLOBAL, funcname
 166     _lua__GLOBAL = get_hll_global '_G'
 167     funcname = get_hll_global 'idleFunc.name'
 168     $P0 = _lua__GLOBAL[funcname]
 169     $I0 = lua_isfunction($P0)
 170     if $I0 goto L2
 171     printerr "Script error: cannot find "
 172     printerr funcname
 173     printerr " function.\n\n"
 174   L2:
 175     push_eh _handler
 176     $P0()
 177     .return ()
 178   _handler:
 179     .local pmc e
 180     .local string s
 181     .get_results (e, s)
 182     printerr "Error running lua script:\n\n  "
 183     printerr s
 184     printerr " \n\n"
 185 .end
 186
 187
 188 =item C<glut.Init ()>
 189
 190 =cut
 191
 192 .sub 'Init'
 193     .param pmc extra :slurpy
 194     .local pmc argv
 195     new argv, 'ResizableStringArray'
 196     .const .Sub glutInit = 'glutInit'
 197     $P0 = get_hll_global ['NCI'], 'call_toolkit_init'
 198     $P0(glutInit, argv)
 199 .end
 200
 201
 202 =item C<glut.InitDisplayMode ()>
 203
 204 =cut
 205
 206 .sub 'InitDisplayMode'
 207     .param pmc extra :slurpy
 208     $I0 = .GLUT_RGBA | .GLUT_DOUBLE
 209     glutInitDisplayMode($I0)
 210 .end
 211
 212
 213 =item C<glut.InitWindowSize (width, height)>
 214
 215 =cut
 216
 217 .sub 'InitWindowSize'
 218     .param pmc width :optional
 219     .param pmc height :optional
 220     .param pmc extra :slurpy
 221     $I0 = lua_isnumber(width)
 222     unless $I0 goto L1
 223     $I0 = lua_isnumber(height)
 224     unless $I0 goto L1
 225     goto L2
 226   L1:
 227     lua_error("incorrect argument to function 'glut.InitWindowSize'")
 228   L2:
 229     $I1 = width
 230     $I2 = height
 231     glutInitWindowSize($I1, $I2)
 232 .end
 233
 234
 235 =item C<glut.KeyboardFunc (funcname)>
 236
 237 =cut
 238
 239 .sub 'KeyboardFunc'
 240     .param pmc funcname :optional
 241     .param pmc extra :slurpy
 242     $I0 = lua_isstring(funcname)
 243     if $I0 goto L1
 244     lua_error("incorrect argument to function 'glut.KeyboardFunc'")
 245   L1:
 246     set_hll_global 'keyboardFunc.name', funcname
 247     .const .Sub keyboard = 'keyboard'
 248     glutKeyboardFunc(keyboard)
 249 .end
 250
 251 .sub 'keyboard' :anon
 252     .param int key
 253     .param int x
 254     .param int y
 255     .local pmc _lua__GLOBAL, funcname
 256     _lua__GLOBAL = get_hll_global '_G'
 257     funcname = get_hll_global 'keyboardFunc.name'
 258     $P0 = _lua__GLOBAL[funcname]
 259     $I0 = lua_isfunction($P0)
 260     if $I0 goto L2
 261     printerr "Script error: cannot find "
 262     printerr funcname
 263     printerr " function.\n\n"
 264   L2:
 265     new $P1, 'LuaNumber'
 266     set $P1, key
 267     new $P2, 'LuaNumber'
 268     set $P2, x
 269     new $P3, 'LuaNumber'
 270     set $P3, y
 271     push_eh _handler
 272     $P0($P1, $P2, $P3)
 273     .return ()
 274   _handler:
 275     .local pmc e
 276     .local string s
 277     .get_results (e, s)
 278     printerr "Error running lua script:\n\n  "
 279     printerr s
 280     printerr " \n\n"
 281 .end
 282
 283
 284 =item C<glut.MainLoop ()>
 285
 286 =cut
 287
 288 .sub 'MainLoop'
 289     .param pmc extra :slurpy
 290     glutMainLoop()
 291 .end
 292
 293
 294 =item C<glut.PostRedisplay ()>
 295
 296 =cut
 297
 298 .sub 'PostRedisplay'
 299     .param pmc extra :slurpy
 300     glutPostRedisplay()
 301 .end
 302
 303
 304 =item C<glut.ReshapeFunc (funcname)>
 305
 306 =cut
 307
 308 .sub 'ReshapeFunc'
 309     .param pmc funcname :optional
 310     .param pmc extra :slurpy
 311     $I0 = lua_isstring(funcname)
 312     if $I0 goto L1
 313     lua_error("incorrect argument to function 'glut.ReshapeFunc'")
 314   L1:
 315     set_hll_global 'reshapeFunc.name', funcname
 316     .const .Sub reshape = 'reshape'
 317     glutReshapeFunc(reshape)
 318 .end
 319
 320 .sub 'reshape' :anon
 321     .param int width
 322     .param int height
 323     .local pmc _lua__GLOBAL, funcname
 324     _lua__GLOBAL = get_hll_global '_G'
 325     funcname = get_hll_global 'reshapeFunc.name'
 326     $P0 = _lua__GLOBAL[funcname]
 327     $I0 = lua_isfunction($P0)
 328     if $I0 goto L2
 329     printerr "Script error: cannot find "
 330     printerr funcname
 331     printerr " function.\n\n"
 332   L2:
 333     new $P1, 'LuaNumber'
 334     set $P1, width
 335     new $P2, 'LuaNumber'
 336     set $P2, height
 337     push_eh _handler
 338     $P0($P1, $P2)
 339     .return ()
 340   _handler:
 341     .local pmc e
 342     .local string s
 343     .get_results (e, s)
 344     printerr "Error running lua script:\n\n  "
 345     printerr s
 346     printerr " \n\n"
 347 .end
 348
 349 =item C<glut.SwapBuffers ()>
 350
 351 =cut
 352
 353 .sub 'SwapBuffers'
 354     .param pmc extra :slurpy
 355     glutSwapBuffers()
 356 .end
 357
 358
 359 =back
 360
 361 =head1 AUTHORS
 362
 363 Francois Perrad
 364
 365 =cut
 366
 367
 368 # Local Variables:
 369 #   mode: pir
 370 #   fill-column: 100
 371 # End:
 372 # vim: expandtab shiftwidth=4 ft=pir: