commit 87c5e2c95b7590b86f20a408740225c8693faab2
parent cb5b25128c92aafe375d7909eeafa738b59d5a84
Author: Commit-Bot <unknown>
Date: Thu, 22 Jul 2010 17:49:25 +0000
Automatic commit from picoLisp.tgz, From: Thu, 22 Jul 2010 17:49:25 GMT
Diffstat:
4 files changed, 364 insertions(+), 3 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXsep10 picoLisp-3.0.4
+ OpenGL (64-bit) in "lib/openGl.l"
Faster bignum division (64-bit)
* 29jun10 picoLisp-3.0.3
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -1,4 +1,4 @@
-04jul10abu
+22jul10abu
(c) Software Lab. Alexander Burger
@@ -9,3 +9,5 @@ A. In the 64-bit version bignum division is now faster by a factor between 20
and 60. That version had used an inefficient algorithm (bitwise shifts),
which was now replaced by Knuth's wordwise division algorithm (as is used
32-bit version).
+
+B. An OpenGL library (64-bit) is now part of the standard release.
diff --git a/lib/openGl.l b/lib/openGl.l
@@ -0,0 +1,358 @@
+# 22jul10abu
+# 22jul10jk
+# (c) Software Lab. Alexander Burger
+
+(load "@lib/math.l" "@lib/native.l")
+
+### Constant Definitions ###
+# Primitives
+(def 'GL_POINTS (hex "0000"))
+(def 'GL_LINES (hex "0001"))
+(def 'GL_LINE_LOOP (hex "0002"))
+(def 'GL_LINE_STRIP (hex "0003"))
+(def 'GL_TRIANGLES (hex "0004"))
+(def 'GL_TRIANGLE_STRIP (hex "0005"))
+(def 'GL_TRIANGLE_FAN (hex "0006"))
+(def 'GL_QUADS (hex "0007"))
+(def 'GL_QUAD_STRIP (hex "0008"))
+(def 'GL_POLYGON (hex "0009"))
+
+# Matrix Mode
+(def 'GL_MATRIX_MODE (hex "0BA0"))
+(def 'GL_MODELVIEW (hex "1700"))
+(def 'GL_PROJECTION (hex "1701"))
+(def 'GL_TEXTURE (hex "1702"))
+
+# glPush/PopAttrib bits
+(def 'GL_CURRENT_BIT (hex "00000001"))
+(def 'GL_POINT_BIT (hex "00000002"))
+(def 'GL_LINE_BIT (hex "00000004"))
+(def 'GL_POLYGON_BIT (hex "00000008"))
+(def 'GL_POLYGON_STIPPLE_BIT (hex "00000010"))
+(def 'GL_PIXEL_MODE_BIT (hex "00000020"))
+(def 'GL_LIGHTING_BIT (hex "00000040"))
+(def 'GL_FOG_BIT (hex "00000080"))
+(def 'GL_DEPTH_BUFFER_BIT (hex "00000100"))
+(def 'GL_ACCUM_BUFFER_BIT (hex "00000200"))
+(def 'GL_STENCIL_BUFFER_BIT (hex "00000400"))
+(def 'GL_VIEWPORT_BIT (hex "00000800"))
+(def 'GL_TRANSFORM_BIT (hex "00001000"))
+(def 'GL_ENABLE_BIT (hex "00002000"))
+(def 'GL_COLOR_BUFFER_BIT (hex "00004000"))
+(def 'GL_HINT_BIT (hex "00008000"))
+(def 'GL_EVAL_BIT (hex "00010000"))
+(def 'GL_LIST_BIT (hex "00020000"))
+(def 'GL_TEXTURE_BIT (hex "00040000"))
+(def 'GL_SCISSOR_BIT (hex "00080000"))
+(def 'GL_ALL_ATTRIB_BITS (hex "000FFFFF"))
+
+# AlphaFunction
+(def 'GL_LESS (hex "00000201"))
+
+# BlendingFactorDest
+(def 'GL_SRC_ALPHA (hex "00000302"))
+(def 'GL_ONE_MINUS_SRC_ALPHA (hex "00000303"))
+
+# DrawBufferMode
+(def 'GL_FRONT_AND_BACK (hex "00000408"))
+
+# GetTarget
+(def 'GL_BLEND (hex "00000BE2"))
+(def 'GL_COLOR_MATERIAL (hex "00000B57"))
+(def 'GL_CULL_FACE (hex "00000B44"))
+(def 'GL_DEPTH_TEST (hex "00000B71"))
+(def 'GL_LIGHTING (hex "00000B50"))
+(def 'GL_LINE_SMOOTH (hex "00000B20"))
+(def 'GL_LINE_SMOOTH_HINT (hex "00000C52"))
+
+# HintMode
+(def 'GL_NICEST (hex "00001102"))
+
+# LightName
+(def 'GL_LIGHT0 (hex "00004000"))
+
+# MaterialParameter
+(def 'GL_AMBIENT_AND_DIFFUSE (hex "00001602"))
+
+# ShadingModel
+(def 'GL_FLAT (hex "00001D00"))
+(def 'GL_SMOOTH (hex "00001D01"))
+
+# GLUT API macro definitions -- the display mode definitions
+(def 'GLUT_RGB (hex "0000"))
+(def 'GLUT_RGBA (hex "0000"))
+(def 'GLUT_INDEX (hex "0001"))
+(def 'GLUT_SINGLE (hex "0000"))
+(def 'GLUT_DOUBLE (hex "0002"))
+(def 'GLUT_ACCUM (hex "0004"))
+(def 'GLUT_ALPHA (hex "0008"))
+(def 'GLUT_DEPTH (hex "0010"))
+(def 'GLUT_STENCIL (hex "0020"))
+(def 'GLUT_MULTISAMPLE (hex "0080"))
+(def 'GLUT_STEREO (hex "0100"))
+(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)
+# 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)
+
+# Mouse state definitions
+(def 'GLUT_LEFT_BUTTON 0)
+(def 'GLUT_MIDDLE_BUTTON 1)
+(def 'GLUT_RIGHT_BUTTON 2)
+
+
+### OpenGL library interface ###
+(de *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)
+ (glColor3f (Red Green Blue) "GlColor3f" NIL Red Green Blue 1.0)
+ (glOrtho (Left Right Bottom Top Near Far) "GlOrtho" NIL Left Right Bottom Top Near Far 1.0)
+ (glVertex3f (X Y Z) "GlVertex3f" NIL X Y Z 1.0)
+ (glutDisplayFunc () "GlutDisplayFunc")
+ (glutCreateMenu () "GlutCreateMenu")
+ (glutKeyboardFunc () "GlutKeyboardFunc")
+ (glutMotionFunc () "GlutMotionFunc")
+ (glutMouseFunc () "GlutMouseFunc")
+ (glutReshapeFunc () "GlutReshapeFunc")
+ (glutSpecialFunc () "GlutSpecialFunc")
+ (glutTimerFunc () "GlutTimerFunc") )
+
+#include <GL/glut.h>
+#include <GL/glu.h>
+#include <GL/gl.h>
+
+extern long lisp(char*,long,long,long,long,long);
+
+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 );
+}
+
+void GlColor3f(long red, long green, long blue, int scl) {
+ glColor3f(
+ (double)red / (double)scl,
+ (double)green / (double)scl,
+ (double)blue / (double)scl );
+}
+
+void GlOrtho(long left, long right, long bottom, long top, long near, long far, long scl) {
+ glOrtho(
+ (double)left / (double)scl,
+ (double)right / (double)scl,
+ (double)bottom / (double)scl,
+ (double)top / (double)scl,
+ (double)near / (double)scl,
+ (double)far / (double)scl );
+}
+
+void GlVertex3f(long vx, long vy, long vz, int scl) {
+ glVertex3f(
+ (double)vx / (double)scl,
+ (double)vy / (double)scl,
+ (double)vz / (double)scl );
+}
+
+static void displayCallback(void) {
+ lisp("displayCallback", 0, 0, 0, 0, 0);
+}
+void GlutDisplayFunc(void) {glutDisplayFunc(displayCallback);}
+
+static void createMenuCallback(int val) {
+ lisp("createMenuCallback", val, 0, 0, 0, 0);
+}
+void GlutCreateMenu(void) {glutCreateMenu(createMenuCallback);}
+
+static void keyboardCallback(unsigned char key, int xv, int yv) {
+ lisp("keyboardCallback", key, xv, yv, 0, 0);
+}
+void GlutKeyboardFunc(void) {glutKeyboardFunc(keyboardCallback);}
+
+static void motionCallback(int xv, int yv) {
+ lisp("motionCallback", xv, yv, 0, 0, 0);
+}
+void GlutMotionFunc(void) {glutMotionFunc(motionCallback);}
+
+static void mouseCallback(int button, int state, int xv, int yv) {
+ lisp("mouseCallback", button, state, xv, yv, 0);
+}
+void GlutMouseFunc(void) {glutMouseFunc(mouseCallback);}
+
+static void reshapeCallback(int width, int height) {
+ lisp("reshapeCallback", width, height, 0, 0, 0);
+}
+void GlutReshapeFunc(void) {glutReshapeFunc(reshapeCallback);}
+
+static void specialCallback(int key, int xv, int yv) {
+ lisp("specialCallback", key, xv, yv, 0, 0);
+}
+void GlutSpecialFunc(void) {glutSpecialFunc(specialCallback);}
+
+static void timerCallback(int val) {
+ lisp("timerCallback", val, 0, 0, 0, 0);
+}
+void GlutTimerFunc(int msec, int val) {glutTimerFunc(msec, timerCallback, val);}
+/**/
+
+
+### Native functions ###
+(de glutInit ()
+ (native `*GlutLib "glutInit" NIL '(NIL (8) . 0)) )
+
+(de glutInitDisplayMode (N)
+ (native `*GlutLib "glutInitDisplayMode" NIL N) )
+
+(de glutInitWindowPosition (Width Height)
+ (native `*GlutLib "glutInitWindowPosition" NIL Width Height) )
+
+(de glutInitWindowSize (Width Height)
+ (native `*GlutLib "glutInitWindowSize" NIL Width Height) )
+
+(de glutCreateWindow (Name)
+ (native `*GlutLib "glutCreateWindow" NIL Name) )
+
+(de glMatrixMode (Mode)
+ (native `*GlutLib "glMatrixMode" NIL Mode) )
+
+(de glLoadIdentity ()
+ (native `*GlutLib "glLoadIdentity") )
+
+(de glClear (Mask)
+ (native `*GlutLib "glClear" NIL Mask) )
+
+(de glBegin (Mode)
+ (native `*GlutLib "glBegin" NIL Mode) )
+
+(de glEnd ()
+ (native `*GlutLib "glEnd") )
+
+(de glEnable (Num)
+ (native `*GlutLib "glEnable" NIL Num) )
+
+(de glDisable (Num)
+ (native `*GlutLib "glDisable" NIL Num) )
+
+(de glBlendFunc (SFactor DFactor)
+ (native `*GlutLib "glBlendFunc" NIL SFactor DFactor) )
+
+(de glHint (Target Mode)
+ (native `*GlutLib "glHint" NIL Target Mode) )
+
+(de glLineWidth (Width)
+ (native `*GlutLib "glLineWidth" NIL Width) )
+
+(de glFlush ()
+ (native `*GlutLib "glFlush") )
+
+#(de gluPerspective (Fovy Aspect ZNear ZFar)
+# (native `*GlutLib "gluPerspective" NIL Fovy Aspect ZNear ZFar) )
+# Why does the above give me this:
+# [DLL] /usr/lib/libglut.so: undefined symbol: gluPerspective
+
+(de glutMainLoop ()
+ (native `*GlutLib "glutMainLoop") )
+
+(de glutAddMenuEntry (Name Val)
+ (native `*GlutLib "glutAddMenuEntry" NIL Name Val) )
+
+(de glutAttachMenu (Button)
+ (native `*GlutLib "glutAttachMenu" NIL Button) )
+
+(de glutPostRedisplay ()
+ (native `*GlutLib "glutPostRedisplay") )
+
+
+### Callbacks ###
+# Keep references in global symbols, to protect from garbage collection
+
+# Display Function
+(de displayPrg Prg
+ (setq *GlutDisplayPrg Prg)
+ (glutDisplayFunc) )
+
+(de displayCallback ()
+ (run *GlutDisplayPrg) )
+
+# CreateMenu Function
+(de createMenu (Fun)
+ (setq *CreateMenuFunc Fun)
+ (glutCreateMenu) )
+
+(de createMenuCallback (Val)
+ (*CreateMenuFunc Val) )
+
+# Keyboard Function
+(de keyboardFunc (Fun)
+ (setq *GlutKeyboardFunc Fun)
+ (glutKeyboardFunc) )
+
+(de keyboardCallback (Key Xv Yv)
+ (*GlutKeyboardFunc Key Xv Yv) )
+
+# Motion Function
+(de motionFunc (Fun)
+ (setq *GlutMotionFunc Fun)
+ (glutMotionFunc) )
+
+(de motionCallback (Xv Yv)
+ (*GlutMotionFunc Xv Yv) )
+
+# Mouse Function
+(de mouseFunc (Fun)
+ (setq *GlutMouseFunc Fun)
+ (glutMouseFunc) )
+
+(de mouseCallback (Button State Xv Yv)
+ (*GlutMouseFunc Button State Xv Yv) )
+
+# Reshape Function
+(de reshapeFunc (Fun)
+ (setq *GlutReshapeFunc Fun)
+ (glutReshapeFunc) )
+
+(de reshapeCallback (Width Height)
+ (*GlutReshapeFunc Width Height) )
+
+# Special Function
+(de specialFunc (Fun)
+ (setq *GlutSpecialFunc Fun)
+ (glutSpecialFunc) )
+
+(de specialCallback (Key Xv Yv)
+ (*GlutSpecialFunc Key Xv Yv) )
+
+# Timer Function
+(de timerFunc (Msec Fun Val)
+ (setq *GlutTimerFunc Fun)
+ (glutTimerFunc Msec Val) )
+
+(de timerCallback (Val)
+ (*GlutTimerFunc Val) )
+
+# vi:et:ts=3:sw=3
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 21jul10abu
+# 22jul10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 3 6)
+(de *Version 3 0 3 7)
# vi:et:ts=3:sw=3
