picolisp

commit 3bd2f9ee3ac8e4bc0e78d8d6b799fca1c659414a
parent bcd614cc0cc59bc96709f360bd815e2e18b38ed5
Author: Commit-Bot <unknown>
Date:   Thu, 29 Jul 2010 05:30:09 +0000

Automatic commit from picoLisp.tgz, From: Thu, 29 Jul 2010 05:30:09 GMT
Diffstat:
M
doc/refL.html
 | 
10
+++++-----
M
lib/openGl.l
 | 
78
++++++++++++++++++++++++++++++++++++++++++++----------------------------------

2 files changed, 49 insertions(+), 39 deletions(-)
diff --git a/doc/refL.html b/doc/refL.html
@@ -274,11 +274,11 @@ href="refN.html#noLint">noLint</a></code>.
 
 <dt><a name="lisp1"><code>(lisp1 'fun) -> num</code></a>
 <dt><code>.. (lisp9 'fun) -> num</code>
-<dd>Installs a callback function <code>fun</code>, and returns a pointer
-<code>num</code> suitable to be passed to a C function via 'native'. Maximally
-nine callback functions can be installed that way. 'fun' should be a function of
-maximally five numbers, and should return a number. See also <code><a
-href="refN.html#native">native</a></code>.
+<dd>(64-bit version only) Installs a callback function <code>fun</code>, and
+returns a pointer <code>num</code> suitable to be passed to a C function via
+'native'. Maximally nine callback functions can be installed that way. 'fun'
+should be a function of maximally five numbers, and should return a number. See
+also <code><a href="refN.html#native">native</a></code>.
 
 <pre><code>
 (load "lib/native.l")
diff --git a/lib/openGl.l b/lib/openGl.l
@@ -1,8 +1,8 @@
-# 28jul10abu
+# 29jul10abu
 # 27jul10jk
 # (c) Software Lab. Alexander Burger
 
-(load "@lib/math.l")
+(load "@lib/math.l" "@lib/native.l")
 
 ### Constant Definitions ###
 # Primitives
@@ -54,7 +54,7 @@
 (def 'GL_ONE_MINUS_SRC_ALPHA  (hex "00000303"))
 
 # DrawBufferMode
-(def 'GL_FRONT_AND_BACK  		(hex "00000408"))
+(def 'GL_FRONT_AND_BACK       (hex "00000408"))
 
 # GetTarget
 (def 'GL_BLEND                (hex "00000BE2"))
@@ -66,16 +66,16 @@
 (def 'GL_LINE_SMOOTH_HINT     (hex "00000C52"))
 
 # HintMode
-(def 'GL_NICEST					(hex "00001102"))
+(def 'GL_NICEST               (hex "00001102"))
 
 # LightName
 (def 'GL_LIGHT0               (hex "00004000"))
 
 # MaterialParameter
-(def 'GL_AMBIENT_AND_DIFFUSE	(hex "00001602"))
+(def 'GL_AMBIENT_AND_DIFFUSE  (hex "00001602"))
 
 # ShadingModel
-(def 'GL_FLAT               	(hex "00001D00"))
+(def 'GL_FLAT                 (hex "00001D00"))
 (def 'GL_SMOOTH               (hex "00001D01"))
 
 # GLUT API macro definitions -- the display mode definitions
@@ -93,40 +93,54 @@
 (def 'GLUT_LUMINANCE    (hex "0200"))
 
 # Function keys
-(def 'GLUT_KEY_F1		1)
-(def 'GLUT_KEY_F2		2)
-(def 'GLUT_KEY_F3		3)
-(def 'GLUT_KEY_F4		4)
-(def 'GLUT_KEY_F5		5)
-(def 'GLUT_KEY_F6		6)
-(def 'GLUT_KEY_F7		7)
-(def 'GLUT_KEY_F8		8)
-(def 'GLUT_KEY_F9		9)
-(def 'GLUT_KEY_F10	10)
-(def 'GLUT_KEY_F11	11)
-(def 'GLUT_KEY_F12	12)
+(def 'GLUT_KEY_F1    1)
+(def 'GLUT_KEY_F2    2)
+(def 'GLUT_KEY_F3    3)
+(def 'GLUT_KEY_F4    4)
+(def 'GLUT_KEY_F5    5)
+(def 'GLUT_KEY_F6    6)
+(def 'GLUT_KEY_F7    7)
+(def 'GLUT_KEY_F8    8)
+(def 'GLUT_KEY_F9    9)
+(def 'GLUT_KEY_F10   10)
+(def 'GLUT_KEY_F11   11)
+(def 'GLUT_KEY_F12   12)
 
 # Directional keys
-(def 'GLUT_KEY_LEFT			100)
-(def 'GLUT_KEY_UP				101)
-(def 'GLUT_KEY_RIGHT			102)
-(def 'GLUT_KEY_DOWN			103)
-(def 'GLUT_KEY_PAGE_UP		104)
-(def 'GLUT_KEY_PAGE_DOWN	105)
-(def 'GLUT_KEY_HOME			106)
-(def 'GLUT_KEY_END			107)
-(def 'GLUT_KEY_INSERT		108)
+(def 'GLUT_KEY_LEFT        100)
+(def 'GLUT_KEY_UP          101)
+(def 'GLUT_KEY_RIGHT       102)
+(def 'GLUT_KEY_DOWN        103)
+(def 'GLUT_KEY_PAGE_UP     104)
+(def 'GLUT_KEY_PAGE_DOWN   105)
+(def 'GLUT_KEY_HOME        106)
+(def 'GLUT_KEY_END         107)
+(def 'GLUT_KEY_INSERT      108)
 
 # Mouse state definitions
-(def 'GLUT_LEFT_BUTTON		0)
-(def 'GLUT_MIDDLE_BUTTON	1)
-(def 'GLUT_RIGHT_BUTTON		2)
+(def 'GLUT_LEFT_BUTTON     0)
+(def 'GLUT_MIDDLE_BUTTON   1)
+(def 'GLUT_RIGHT_BUTTON    2)
 
 ### OpenGL library interface ###
 (default
    *GluLib "/usr/lib/libGLU.so"
    *GlutLib "/usr/lib/libglut.so" )
 
+### Inline-C functions ###
+(gcc "glut" (list *GlutLib)
+   (glClearColor (Red Green Blue Alpha) "GlClearColor" NIL Red Green Blue Alpha 1.0) )
+
+#include <GL/glut.h>
+#include <GL/glu.h>
+#include <GL/gl.h>
+
+void GlClearColor(long red, long green, long blue, long alpha, int scl) {
+   glClearColor((GLclampf)red / (float)scl, (GLclampf)green / (float)scl,
+                  (GLclampf)blue / (float)scl, (GLclampf)alpha / (float)scl );
+}
+/**/
+
 # Pre-consed fixpoint arguments
 (setq
    "Fix1" (0 . 1.0)
@@ -170,10 +184,6 @@
 (de glEnd ()
    (native `*GlutLib "glEnd") )
 
-(de glClearColor (Red Green Blue Alpha)
-   (set "Fix1" Red  "Fix2" Green  "Fix3" Blue  "Fix4" Alpha)
-   (native `*GlutLib "glClearColor" NIL "Fix1" "Fix2" "Fix3" "Fix4") )
-
 (de glClearDepth (Depth)
    (set "Fix1" Depth)
    (native `*GlutLib "glClearDepth" NIL "Fix1") )