|
|
||
| Home | SwiftForth Archive | SwiftX Archive | |
I'm not sure what more I can do to figure this out, so I'll throw
this out to you all and see if anyone has any advice...
I've attached a translation of C code I found in a GLUT tutorial at
http://www.lighthouse3d.com/opengl/glut. The C code works fine, as
do many other OpenGL examples I have found elsewhere. I've done
about as much debugging as I can do, short of tracing the
glutMainLoop, and all the stack parameters appear to be correct and I
no longer get any crashes or exceptions. Yet, the GLUT window
doesn't have any contents. It simply captures what is below it. I
get the same behavior, I now find, from Charles Melice's GLLight.f
example, so there must be something about my environment that is
causing this, yet the C versions work fine.
I am running SwiftForth 3.0.7 under Virtual PC on a PowerBook G4. I
even tried SwiftForth version 2.0.2. I am using Windows XP, service
pack 2, with all the latest updates. It says I am running at 133 MHz
with 512 MB of RAM. The display settings are at "Highest (32 bit)"
which probably is not the same as the "16 bit true color mode" that
GLLight says is the minimum, but why do all the C examples work
fine? I am using Nate Robins' latest glut32.dll, version 3.7.6,
binary or recompiled from his source. I am able to run similar code
on Mac OSX with MacForth and gforth. It's only Windows that appears
to be giving me this problem, but I haven't tried it on gforth in
cygwin yet.
If anyone has any advice, I'd sure appreciate it.
Here's my code:
\ GLUT Stroke Font - Adapted by Dennis Ruffer from the GLUT Tutorial
by Lighthouse 3D
\ The full C++ version can be found at: http://www.lighthouse3d.com/
opengl/glut
\ Demonstrates using OpenGL calls from SwiftForth
\ Provides very heavy exercise of Callbacks
\ For more information on OpenGL, see http://www.opengl.org/ or
www.apple.com
\ You must get the glut32.dll from http://www.xmission.com/~nate/
glut.html
REQUIRES FPMATH
[DEFINED] NUMERICS [IF] .( Please turn Hardware stack use on!) cr
abort [THEN]
\ Otherwise, we have to allocate the numeric stack in every callback
function.
CODE 1dfparms ( f: x -- ) ( s: -- xl xh )
1 >fs \ make sure data on hardware stack
8 # EBP SUB \ make room for double
0 [EBP] QWORD FSTP \ convert
4 [EBP] EBX XCHG \ swap xh and old tos
RET END-CODE
CODE 1sfparms ( f: x -- ) ( s: -- x )
1 >fs \ make sure data on hardware stack
4 # EBP SUB \ room for 1 integers and tos
0 [EBP] DWORD FSTP \ convert x
0 [EBP] EBX XCHG \ swap x and old tos
RET END-CODE
WINDOWS-INTERFACE OPEN-PACKAGE
PUBLIC
: _IMPORT: ( n -- ) C/PASCAL OFF RETURNS-DATA OFF _IMPORT: ;
: IMPORT: ( n -- ) C/PASCAL OFF RETURNS-DATA ON _IMPORT: ;
: CB: ( xt n -- ) \ Usage: xt n CB: <name>
CREATE
RUNCB ,CALL DUP
[+ASM] CELLS # RET NOP [-ASM]
0= IF [+ASM] NOP NOP [-ASM] THEN \ Fix bug in 3.0.6 & 7
( xt) , ;
END-PACKAGE
LIBRARY glut32.dll
\ GLUT initialization sub-API.
2 _IMPORT: glutInit \ void APIENTRY glutInit(int *argcp, char
**argv);
1 _IMPORT: glutInitDisplayMode \ void APIENTRY glutInitDisplayMode
(unsigned int mode);
2 _IMPORT: glutInitWindowPosition \ void APIENTRY
glutInitWindowPosition(int x, int y);
2 _IMPORT: glutInitWindowSize \ void APIENTRY glutInitWindowSize
(int width, int height);
0 _IMPORT: glutMainLoop \ void APIENTRY glutMainLoop(void);
\ GLUT window sub-API.
1 IMPORT: glutCreateWindow \ int APIENTRY glutCreateWindow(const
char *title);
0 _IMPORT: glutSwapBuffers \ void APIENTRY glutSwapBuffers(void);
\ GLUT menu sub-API.
1 IMPORT: glutCreateMenu \ int APIENTRY glutCreateMenu(void (*)
(int));
2 _IMPORT: glutAddMenuEntry \ void APIENTRY glutAddMenuEntry(const
char *label, int value);
1 _IMPORT: glutAttachMenu \ void APIENTRY glutAttachMenu(int button);
\ GLUT window callback sub-API.
1 _IMPORT: glutDisplayFunc \ void APIENTRY glutDisplayFunc(void
(*func)(void));
1 _IMPORT: glutReshapeFunc \ void APIENTRY glutReshapeFunc(void
(*func)(int width, int height));
1 _IMPORT: glutKeyboardFunc \ void APIENTRY glutKeyboardFunc(void
(*func)(unsigned char key, int x, int y));
1 _IMPORT: glutMouseFunc \ void APIENTRY glutMouseFunc(void (*func)
(int button, int state, int x, int y));
1 _IMPORT: glutMotionFunc \ void APIENTRY glutMotionFunc(void
(*func)(int x, int y));
1 _IMPORT: glutIdleFunc \ void APIENTRY glutIdleFunc(void (*func)
(void));
1 _IMPORT: glutSpecialFunc \ void APIENTRY glutSpecialFunc(void
(*func)(int key, int x, int y));
1 _IMPORT: glutSpecialUpFunc \ void APIENTRY glutSpecialUpFunc(void
(*func)(int key, int x, int y));
\ GLUT font sub-API
2 _IMPORT: glutStrokeCharacter \ void APIENTRY glutStrokeCharacter
(void *font, int character);
\ GLUT device control sub-API.
1 _IMPORT: glutIgnoreKeyRepeat \ void APIENTRY glutIgnoreKeyRepeat
(int ignore);
\ To get around the fact that Microsoft DLLs only allow functions
\ to be exported and not data addresses (as Unix DSOs support), the
\ GLUT API constants such as GLUT_STROKE_ROMAN have to get passed
\ through a case statement to get mapped to the actual data structure
\ address.
\ Stroke font constants (use these in GLUT program).
0 constant GLUT_STROKE_ROMAN
1 constant GLUT_STROKE_MONO_ROMAN
LIBRARY glu32.dll
8 _IMPORT: gluPerspective \ void gluPerspective (GLdouble fovy,
GLdouble aspect, GLdouble zNear, GLdouble zFar);
18 _IMPORT: gluLookAt \ void gluLookAt (GLdouble eyeX, GLdouble
eyeY, GLdouble eyeZ, GLdouble centerX, GLdouble centerY, GLdouble
centerZ, GLdouble upX, GLdouble upY, GLdouble upZ);
LIBRARY OpenGL32.dll
1 _IMPORT: glClear \ void glClear (GLbitfield mask);
1 _IMPORT: glDisable \ void glDisable (GLenum cap);
1 _IMPORT: glEnable \ void glEnable (GLenum cap);
0 IMPORT: glGetError \ GLenum glGetError (void);
1 _IMPORT: glLineWidth \ void glLineWidth (GLfloat width);
0 _IMPORT: glLoadIdentity \ void glLoadIdentity (void);
1 _IMPORT: glMatrixMode \ void glMatrixMode (GLenum mode);
0 _IMPORT: glPopMatrix \ void glPopMatrix (void);
0 _IMPORT: glPushMatrix \ void glPushMatrix (void);
6 _IMPORT: glScaled \ void glScaled (GLdouble x, GLdouble y,
GLdouble z);
3 _IMPORT: glTranslatef \ void glTranslatef (GLfloat x, GLfloat y,
GLfloat z);
4 _IMPORT: glViewport \ void glViewport (GLint x, GLint y,
GLsizei width, GLsizei height);
\ Display mode bit masks.
0 constant GLUT_RGB
2 constant GLUT_DOUBLE
16 constant GLUT_DEPTH
\ Mouse buttons.
0 constant GLUT_LEFT_BUTTON
2 constant GLUT_RIGHT_BUTTON
\ directional keys
100 constant GLUT_KEY_LEFT
101 constant GLUT_KEY_UP
102 constant GLUT_KEY_RIGHT
103 constant GLUT_KEY_DOWN
$00004000 constant GL_COLOR_BUFFER_BIT \ mask
$00000100 constant GL_DEPTH_BUFFER_BIT \ mask
$1701 constant GL_PROJECTION
$1700 constant GL_MODELVIEW
$0B71 constant GL_DEPTH_TEST
\ Some globals
fvariable angle 0e angle f!
fvariable deltaAngle 0e deltaAngle f!
fvariable ratio
fvariable x 0.0e x f!
fvariable y 1.75e y f!
fvariable z 30.0e z f!
fvariable lx 0.0e lx f!
fvariable ly 0.0e ly f!
fvariable lz -1.0e lz f!
variable deltaMove 0 deltaMove !
variable font GLUT_STROKE_ROMAN font !
: GLUTLookAt ( -- )
x f@ 1dfparms y f@ 1dfparms z f@ 1dfparms
x f@ lx f@ f+ 1dfparms
y f@ ly f@ f+ 1dfparms
z f@ lz f@ f+ 1dfparms
0e 1dfparms 1e 1dfparms 0e 1dfparms gluLookAt
;
:noname ( w h -- ) HWND MSG
dup 0= if 1+ then \ Prevent a divide by zero, when window is too
short
over s>d d>f dup s>d d>f f/ ratio f!
GL_PROJECTION glMatrixMode \ Reset the coordinate system before
modifying
glLoadIdentity
0 0 2swap glViewport \ Set the viewport to be the entire window
45e 1dfparms ratio f@ 1dfparms 1e 1dfparms 10000e 1dfparms
gluPerspective \ Set the clipping volume
GL_MODELVIEW glMatrixMode
glLoadIdentity
GLUTLookAt
; 0 CB: changeSize
: initScene ( -- )
GL_DEPTH_TEST glEnable
4.0e 1sfparms glLineWidth
;
: orientMe ( F: angle -- )
fdup fsin lx f!
fcos lz f!
glLoadIdentity
GLUTLookAt
;
: moveMeFlat ( i -- )
s>d d>f fdup
lx f@ f* 0.1e f* x f@ f+ x f!
lz f@ f* 0.1e f* z f@ f+ z f!
glLoadIdentity
GLUTLookAt
;
: renderStrokeCharacter ( font str len F: x y z -- )
glPushMatrix
frot 1sfparms fswap 1sfparms 1sfparms glTranslatef
bounds do dup i c@ glutStrokeCharacter
loop drop glPopMatrix
;
:noname ( -- )
deltaMove @ ?dup if moveMeFlat then
deltaAngle f@ f0= 0= if
angle f@ deltaAngle f@ f+ fdup angle f!
orientMe
then
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT or glClear
glPushMatrix
-400e 150e -800e font @ s" 3D Tech" renderStrokeCharacter
-400e 0e -800e font @ s" GLUT Tutorial" renderStrokeCharacter
glPopMatrix
glutSwapBuffers
pause
; 0 CB: renderScene
:noname ( key x y -- ) HWND case
GLUT_KEY_LEFT of -0.001e deltaAngle f! endof
GLUT_KEY_RIGHT of 0.001e deltaAngle f! endof
GLUT_KEY_UP of 1 deltaMove ! endof
GLUT_KEY_DOWN of -1 deltaMove ! endof
endcase
; 0 CB: pressKey
:noname ( key x y -- ) HWND case
GLUT_KEY_LEFT of 0.0e deltaAngle f! endof
GLUT_KEY_RIGHT of 0.0e deltaAngle f! endof
GLUT_KEY_UP of 0 deltaMove ! endof
GLUT_KEY_DOWN of 0 deltaMove ! endof
endcase
; 0 CB: releaseKey
:noname ( option -- ) HWND font ! ; 0 CB: processMenuEvents
: createMenus ( -- )
processMenuEvents glutCreateMenu drop
Z" Roman" GLUT_STROKE_ROMAN glutAddMenuEntry
Z" Mono Roman" GLUT_STROKE_MONO_ROMAN glutAddMenuEntry
GLUT_RIGHT_BUTTON glutAttachMenu
;
:noname ( key x y -- ) HWND 27 = if bye then ; 0 CB: processNormalKeys
create argc 1 ,
here ,Z" /SwiftForth" create argv ,
: WindowTitle ( -- adr ) Z" SnowMen from Lighthouse3D" ;
8192 task GLWindow
: MAIN ( -- )
argc argv glutInit \ Initialize glut
GLUT_RGB GLUT_DEPTH or GLUT_DOUBLE or glutInitDisplayMode \ Set
display mode
\ Set window size & position
100 100 glutInitWindowPosition
640 360 glutInitWindowSize
WindowTitle glutCreateWindow drop \ Create the window w/ title
initScene
processNormalKeys glutKeyboardFunc
1 glutIgnoreKeyRepeat
pressKey glutSpecialFunc
releaseKey glutSpecialUpFunc
createMenus
renderScene glutDisplayFunc
renderScene glutIdleFunc
changeSize glutReshapeFunc
GLWindow activate
glutMainLoop
;
----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and
bug reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Wed Jan 17 2007 - 09:43:45 PST
This archive was generated by hypermail 2.2.0 : Tue Dec 02 2008 - 03:04:41 PST