gforth: OpenGL Graphics Lesson 13
Tim Trussell
by Timothy Trussell
---[ Information ]---------------------------------------------------
This column will be posted to the Taygeta Forth Achive site:
ftp://ftp.taygeta.com/pub/Forth/Archive/tutorials/gforth-sdl-opengl/
in the file:
opengl-lesson13.zip
along with all required source files.
It may take a little time for the files to be moved to the above
directory, so keep checking until they have been placed there.
---[ Where We Are ]--------------------------------------------------
Read thru the Tutorial for Lesson 13 at
for the description of what is going on with this code.
---[ Additions ]-----------------------------------------------------
Additions to the mini-opengl libcc interface for this lesson are:
gl-call-lists ( n type *lists -- )
Execute a list of display lists.
Parameters <n> and <type> are integer values, and <*lists> is a
32-bit pointer to the array of name offsets.
n: Specifies the number of display lists to be executed.
type: Specifies the type of values in lists. Symbolic constants
GL_BYTE, GL_UNSIGNED_BYTE, GL_SHORT, GL_UNSIGNED_SHORT,
GL_INT, GL_UNSIGNED_INT, GL_FLOAT, GL_2_BYTES, GL_3_BYTES
and GL_4_BYTES are accepted.
lists: Specifies the address of an array of name offsets in the
display list. The pointer type is void because the offsets
can be bytes, shorts, ints, or floats, depending on the
value of type.
gl-delete-lists ( list range -- )
Delete a contiguous group of display lists.
Parameters <list> and <range> are integer values.
list: Specifies the integer name of the first display list to
delete.
range: Specifies the number of display lists to delete.
gl-list-base ( base -- )
Set the display-list base for gl-call-lists.
Parameter <base> is an integer value.
base: Specifies an integer offset that will be added to
glCallLists offsets to generate display-list names. The
initial value is 0.
gl-pop-attrib ( -- )
Pop the server attribute stack.
gl-push-attrib ( mask -- )
Push the server attribute stack.
Parameter <mask> is an integer value.
gl-raster-pos-2f ( x y -- )
Specify the raster position for pixel operations
Parameters <x> and <y> are floating point values.
(In gforth, as these are passed by value, there is no conversion
necessary to make these values into 32-bit floats from the normal
gforth 64-bit floating point value.)
gl-xusexfont ( font first count listbase -- )
Create bitmap display lists from an X font
Parameter <font> is a 32-bit pointer to a Font Struct.
<first>, <count> and <listbase> are integer values.
font: Specifies the font from which character glyphs are to be
taken.
Note: <font> is treated as a 32-bit pointer; the C++ compiler
burps when an <a> parameter is used in the libcc
definition, but works correctly with an <n> parameter,
which is why this parameter is an <n> in the libcc file.
first: Specifies the index of the first glyph to be taken.
count: Specifies the number of glyphs to be taken.
listBase: Specifies the index of the first display list to be
generated.
--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
The following functions are from the X11 package, and are used to
access specific components of the X server - in the case of this
Lesson, the fonts.
What is X11?
http://en.wikipedia.org/wiki/X_Window_System
gives a description of the X systems. If SDL and OpenGL did not
exist, these Tutorials would be about implementing an X interface in
gforth.
--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
x-closedisplay ( *display -- status )
Closes the connection to the X server.
Parameter <*display> is a 32-bit pointer to a Display struct
that serves as the connection to the X server and that contains
all the information about that X server.
x-freefont ( *display *font_struct -- status )
Deletes the association between the font resource ID and the
specified font and frees the XFontStruct structure. The font
itself will be freed when no other resource references it. The
data and the font should not be referenced again.
Parameter <*display> is a 32-bit pointer to a Display struct
that serves as the connection to the X server and that contains
all the information about that X server.
Parameter <*font_struct> is the font structure returned by the
call to x-loadqueryfont.
x-loadqueryfont ( *display *name -- *font_struct )
Provides the most common way for accessing a font.
XLoadQueryFont() both opens (loads) the specified font and
returns a pointer to the appropriate XFontStruct structure. If
the font name is not in the Host Portable Character Encoding, the
result is implementation dependent. If the font does not exist,
XLoadQueryFont() returns NULL.
Parameter <*display> is a 32-bit pointer to a Display struct
that serves as the connection to the X server and that contains
all the information about that X server.
Parameter <*name> specifies the name of the font, which is a
null-terminated string.
Return value <*font_struct> is a 32-bit pointer to an XFontStruct
structure which contains all of the information for the font and
consists of the font-specific information as well as a pointer to
an array of XCharStruct structures for the characters contained
in the font.
x-opendisplay ( display_name -- *display )
Parameter <*display> is a 32-bit pointer that specifies the
hardware display name, which determines the display and
communications domain to be used. On a POSIX-conformant system,
if the display_name is NULL, it defaults to the value of the
DISPLAY environment variable.
Return value <*display> is a 32-bit pointer to a Display struct
that serves as the connection to the X server and that contains
all the information about that X server.
If successful, x-opendisplay returns a pointer to a Display
structure, which is defined in X11/Xlib.h.
If x-opendisplay does not succeed, it returns NULL.
---[ Installation ]--------------------------------------------------
If you are placing all of the Lessons in one directory, copy these
three files to that directory:
opengl-lesson13.fs - Code Addendum 1
opengllib-1.13.fs - Code Addendum 2
mini-opengl-1.13.fs - Code Addendum 3
This Lesson requires the mini-sdl-1.01.fs file from Lesson 6, as well
as all of the usual constants definition files.
For the files from the opengl-lesson13.zip, extract them to wherever
you wish to place them, or extract the above three files and the data
directory into the directory you have placed the previous Lesson
files.
To use the LibUtil script, set the flag in opengllib-1.13.fs:
1 constant UseLibUtil
and then run the script to install the files to the ~/.gforth dirs:
cd <your-directory> <cr>
./libutil.sh -ra <cr>
./libutil.sh -i <cr>
gforth
include opengl-lesson13.fs
lesson13
If you prefer not to use the LibUtil script, set the flag to:
0 constant UseLibUtil
and then you can execute the Lesson code with:
cd <your-directory> <cr>
gforth
include opengl-lesson13.fs
lesson13
---[ Next Up ]-------------------------------------------------------
Lesson 16 - Cool looking fog
----------------------------------------------------[End Lesson13]---
Tim Trussell
\ gforth: OpenGL Graphics Lesson 13
\ ===================================================================
\ File: opengl-lesson13.fs
\ Author: Jeff Molofee
\ Linux Version: Ti Leggett
\ gForth Version: Timothy Trussell, 07/31/2010
\ Description: Bitmap fonts
\ Forth System: gforth-0.7.0
\ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-24
\ C++ Compiler: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5)
\ ===================================================================
\ NeHe Productions
\ http://nehe.gamedev.net/
\ ===================================================================
\ OpenGL Tutorial Lesson 12
\ ===================================================================
\ This code was created by Jeff Molofee '99
\ (ported to Linux/SDL by Ti Leggett '01)
\ Visit Jeff at http://nehe.gamedev.net/
\ ===================================================================
\ ---[ Marker ]------------------------------------------------------
\ Allows for easy removal of a previous loading of the program, for
\ re-compilation of changes.
\ If ---marker--- exists, execute it to restore the dictionary.
[IFDEF] ---marker---
---marker---
[ENDIF]
\ ---[ New Marker ]--------------------------------------------------
\ Set a marker point in the dictionary.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
\ If/when the program is re-loaded, everything in the dictionary
\ after this point will be unlinked (removed). Essentially 'forget'.
\ Does NOT affect linked libcc code, however.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
\ Some programmers prefer to exit/re-enter gforth to ensure that they
\ are starting with a clean slate each time. Your choice.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
marker ---marker---
\ Set markers for base free dictionary memory, and start time
unused constant free-dictionary-memory
utime 2constant compilation-start-time
\ ---[ Set Number Base ]---------------------------------------------
\ Set the numeric system to base 10
decimal
\ ---[ Prototype Listing ]-------------------------------------------
\ : zprint { *str -- }
\ : zstring ( *str len -- *str )
\ : SF, ( r -- )
\ : Initialize-SDL ( -- )
\ : Get-Video-Info ( -- )
\ : Compile-Video-Flags ( -- )
\ : Check-HW-Surfaces ( -- )
\ : Check-HW-Blits ( -- )
\ : Init-Double-Buffering ( -- )
\ : Init-Video ( -- )
\ : Init-Caption ( -- )
\ : Init-Keyboard ( -- )
\ : ResizeWindow { _width _height -- boolean }
\ : Help-Msg ( -- )
\ : lesson09 ( -- )
\ ------------------------------------------------[End Prototypes]---
cr cr .( Loading Tutorial...) cr
\ ---[ opengl-exit-flag ]--------------------------------------------
\ Boolean flag set by HandleKeyPress if the ESC key is pressed.
\ Will be used in a begin..while..repeat loop in the main function.
FALSE value opengl-exit-flag
\ ---[ screen ]------------------------------------------------------
\ Pointer for working SDL surface
0 value screen
\ ---[ Screen Dimensions ]-------------------------------------------
\ These specify the size/depth of the SDL display surface
640 constant screen-width
480 constant screen-height
16 constant screen-bpp
\ ===[ Ancilliary Support Routines ]=================================
\ These are support routines that help with the normal programming.
\ ---[ zprint ]------------------------------------------------------
\ Displays a zero-terminated string
: zprint { *str -- }
begin
*str C@ 0<>
while
*str C@ emit
*str 1+ to *str
repeat
;
\ ---[ zstring ]-----------------------------------------------------
\ Most SDL and OpenGL functions that require string data also require
\ that those strings be in a zero-delimited format. The Forth method
\ of passing strings is to pass the address followed by the length of
\ the string to the stack.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
\ To convert a Forth string to a zero-delimited string requires that
\ we add a character to the Forth string (at the end) which is then
\ passed to the zstring function, which changes that character to a
\ NULL (0) value, and drops the length parameter from the stack.
\ I add the character "0" to the end, since it signifies visually the
\ additional character that is to be converted.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
\ Example:
\ s" data/my_funky_picture.bmp" Load-Picture
\ becomes
\ s" data/my_funky_picture.bmp0" zstring Load-Picture
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
: zstring ( *str len -- *str ) over + 1- 0 swap C! ;
\ ---[ SF, ]---------------------------------------------------------
\ Allocate and store a short float - 4 bytes - to the dictionary.
\ Suggested by Anton Ertl 06/03/2010 - Thanks Anton!
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
\ <here> returns the address of the next free dictionary byte
\ <1 sfloats> calculates the size of an sfloat variable - 4 bytes
\ <allot> allocates space at the next free dictionary address
\ <SF!> stores the floating point value at the address <here>,
\ which is already on the stack.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
: SF, ( r -- ) here 1 sfloats allot SF! ;
\ ===[ Load Graphics Framework ]=====================================
\ This loads the opengllib-1.xx.fs file, which contains all of the
\ OpenGL scene generation code functions.
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
\ -- Loads the OpenGL and SDL libcc interface dependancy files
\ -- Loads the high-level OpenGL code
\ --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
require opengllib-1.13.fs
\ ===[ gforth BaseCode ]=============================================
\ The following functions are "common" to all of the tutorials, and
\ comprise the basic framework for all of the tutorials in the series
0 value videoflags \ pointer to video hardware info array
0 value isActive \ "focus" indicator for the mouse
0 value VideoInfo \ pointer to video mode data
\ Create an event structure for accessing the SDL Event subsystems
create event here sdl-event% nip dup allot 0 fill
\ Initialize the SDL Video subsystem
: Initialize-SDL ( -- )
SDL_INIT_EVERYTHING sdl-init 0< if
cr ." Video Initialization failed: "
sdl-geterror zprint cr
bye
then
;
\ Load information about the video hardware in the computer
: Get-Video-Info ( -- )
sdl-getvideoinfo dup to VideoInfo 0= if
cr ." Video query failed: " sdl-geterror zprint cr
bye
then
;
\ Build a flag variable specifying the video characteristics to set
: Compile-Video-Flags ( -- )
SDL_OPENGL \ enable OpenGL in SDL
SDL_GL_DOUBLEBUFFER OR \ Enable double buffering
SDL_HWPALETTE OR \ Store the palette in hardware
SDL_RESIZABLE OR \ Enable window resizing
to videoflags \ save the flags
;
\ Add flag for if hardware surfaces can be created
: Check-HW-Surfaces ( -- )
VideoInfo sdl-video-info-hw-available @ 0<> if
SDL_HWSURFACE
else
SDL_SWSURFACE
then
videoflags OR to videoflags
;
\ Add flag for if hardware-to-hardware blits is available
: Check-HW-Blits ( -- )
VideoInfo sdl-video-info-blit-hw @ 0<> if
videoflags SDL_HWACCEL OR to videoflags
then
;
\ Enable double buffering
: Init-Double-Buffering ( -- )
SDL_GL_DOUBLEBUFFER 1 sdl-gl-set-attribute
;
\ Create an SDL surface and open the display window
: Init-Video ( -- )
screen-width screen-height screen-bpp videoflags sdl-set-video-mode
dup 0= if \ verify a surface was created
drop \ window not created, error out
cr ." Video mode set failed: " sdl-geterror zprint cr
bye \ exit to terminal window
then
to screen \ save pointer to surface
;
\ Put a title onto the window caption bar
: Init-Caption ( -- )
s" gforth/OpenGL: NeHe Lesson 130" zstring NULL sdl-wm-set-caption
;
\ Enable the keyboard repeat functionality
: Init-Keyboard ( -- )
100 SDL_DEFAULT_REPEAT_INTERVAL sdl-enable-keyrepeat if
sdl-quit
cr ." Setting keyboard repeat failed: " sdl-geterror zprint cr
bye
then
;
\ Reset our viewport after a window resize
: ResizeWindow { _width _height -- boolean }
_height 0= if \ protect from divide by zero
1 to _height
then
\ set up the viewport
0 0 _width _height gl-viewport
\ Change to the projection matrix and set our viewing volume
GL_PROJECTION gl-matrix-mode
\ Reset the matrix
gl-load-identity
\ Set our perspective - the F/ calcs the aspect ratio of w/h
45e _width S>F _height S>F F/ 0.1e 100e glu-perspective
\ Make sure we are changing the model view and not the projection
GL_MODELVIEW gl-matrix-mode
\ Reset the matrix
gl-load-identity
\ Return a good value
TRUE
;
\ Display keyboard/mouse help information
: Help-Msg ( -- )
page
0 \ init line count
." Keyboard Functions:" 1+
cr ." ESC - exits program" 1+
cr ." F1 - toggles fullscreen/windowed screen" 1+
cr 1+
cr ." Mouse Functions:" 1+
cr ." Move off window to pause demo" 1+
cr ." Move onto window to resume demo" 1+
cr ." Resize window by dragging frame" 1+
cr ." Minimize/Maximize/Exit with window buttons" 1+
cr 1+
to fps-line \ where to display the fps at
;
: lesson13 ( -- )
Initialize-SDL \ Init the SDL subsystem
Get-Video-Info \ Get the video info from SDL
Compile-Video-Flags \ Compile the flags to pass to
SDL_SetVideoMode
Check-HW-Surfaces \ Check if surfaces can be stored in memory
Check-HW-Blits \ Check if hardware blits can be done
Init-Double-Buffering \ Set up OpenGL double buffering
Init-Video \ create SDL surface; open window
Init-Caption \ set the window title
caption
Init-Keyboard \ enable key repeat functionality
InitGL FALSE = if \ initialize OpenGL
sdl-quit \ on error, close down and exit
cr ." Could not initialize OpenGL." cr
bye
then
screen-width screen-height ResizeWindow drop \ resize the window
Reset-FPS-Counter \ initialize the counter with sdl-get-ticks
Help-Msg \ display the keyboard function info
begin \ wait for events
opengl-exit-flag 0= \ repeat until this flag set TRUE
while
begin
event sdl-pollevent \ are there any pending events?
while
event sdl-event-type c@ \ yes, process the events
case
SDL_ACTIVEEVENT of \ application visibility event occurred
event sdl-active-event-gain C@ if
TRUE \ gained focus - draw in window again
else
FALSE \ lost focus - stop drawing in window
then
to isActive
endof
SDL_VIDEORESIZE of \ window resize event occurred
event sdl-resize-event-width @ \ get new width
event sdl-resize-event-height @ \ get new height
screen-bpp \ use current bpp
videoflags \ get flags
sdl-set-video-mode \ attempt to create a new window
dup 0= if \ error out if not successful
drop
sdl-quit
cr ." Could not get a surface after resize: "
sdl-geterror zprint cr
bye
then
to screen \ success! save new pointer
event sdl-resize-event-width @
event sdl-resize-event-height @
ResizeWindow drop \ calculate new perspective
endof
SDL_KEYDOWN of \ key press event occurred
event HandleKeyPress
endof
SDL_KEYUP of \ key release event occurred
event HandleKeyRelease
endof
SDL_QUIT of \ window close box clicked, or ALT-F4 pressed
TRUE to opengl-exit-flag
endof
endcase
repeat \ until no more events are in the queue
isActive if \ if we have mouse focus, draw the scene
DrawGLScene drop
then
5 sdl-delay \ delay to allow the demo screen to be seen
repeat \ until opengl-exit-flag is set to TRUE
Shutdown \ close down the SDL systems gracefully
TRUE to isActive \ reset for next program run
;
\ Display the amount of dictionary space used during compilation
free-dictionary-memory unused -
cr .( Compilation Size: ) . .( bytes)
\ Display the time taken during compilation
utime compilation-start-time d- 1 1000 m*/
cr .( Compilation Time: ) d. .( msec) cr
cr .( gforth/OpenGL: NeHe Lesson 13)
cr .( type "lesson13" to execute) cr
Tim Trussell
\ gforth: OpenGL Graphics Lesson 13
\ ===================================================================
\ File: opengllib-1.13.fs
\ Author: Jeff Molofee
\ Linux Version: Ti Leggett
\ gForth Version: Timothy Trussell, 07/31/2010
\ Description: Bitmap fonts
\ Forth System: gforth-0.7.0
\ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-24
\ C++ Compiler: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5)
\ ===================================================================
\ NeHe Productions
\ http://nehe.gamedev.net/
\ ===================================================================
\ OpenGL Tutorial Lesson 12
\ ===================================================================
\ This code was created by Jeff Molofee '99
\ (ported to Linux/SDL by Ti Leggett '01)
\ Visit Jeff at http://nehe.gamedev.net/
\ ===================================================================
\ ---[ UseLibUtil ]--------------------------------------------------
\ Conditional compilation of the libcc interfaces:
\ -- Set to 1 if you use the LibUtil script to copy the files to
\ the ~/.gforth directory.
\ -- Set to 0 to use the files from the Lesson directory (PWD).
0 constant UseLibUtil
UseLibUtil [if]
require ~/.gforth/opengl-libs/mini-opengl-current.fs
require ~/.gforth/opengl-libs/mini-sdl-current.fs
require ~/.gforth/opengl-libs/sdlkeysym.fs
[else]
require mini-opengl-1.13.fs
require mini-sdl-1.01.fs
require sdlkeysym.fs
[then]
\ ---[ Prototype Listing ]-------------------------------------------
\ : concat-string { *str _len *dst -- }
\ : IntToStr ( n -- *str len )
\ : KillFont ( -- )
\ : BuildFont ( -- )
\ : glPrint ( *str _len -- )
\ : HandleKeyPress ( &event -- )
\ : HandleKeyRelease ( &event -- )
\ : InitGL ( -- boolean )
\ : ShutDown ( -- )
\ : Reset-FPS-Counter ( -- )
\ : Display-FPS ( -- )
\ : DrawGLScene ( -- boolean )
\ ------------------------------------------------[End Prototypes]---
\ ---[ Variable Declarations ]---------------------------------------
variable baselist \ base display list for the font set
fvariable count1 \ 1st counter used to move text and for coloring
fvariable count2 \ 2nd counter used to move text and for coloring
\ ---[ Variable Initializations ]------------------------------------
0 baselist !
0e count1 F!
0e count2 F!
255 constant string-len
create temp-string here string-len 1+ dup allot 0 fill
\ ---[ concat-string ]---
\ A basic string concatenation function, to add one string to another
: concat-string { *str _len *dst -- }
*str *dst 1+ *dst C@ + _len cmove
*dst C@ _len + *dst C! \ use *dst[0] as length byte
;
\ ---[ IntToStr ]---
\ Converts an integer value to a string; returns addr/len
: IntToStr ( n -- *str len ) 0 <# #S #> ;
\ ===[ Back to our regularly scheduled code ]========================
\ ---[ KillFont ]----------------------------------------------------
\ Recover memory from our list of characters
: KillFont ( -- )
baselist @ 96 gl-delete-lists
;
\ ---[ BuildFont ]---------------------------------------------------
\ Builds our font lists
\ Accesses X11 library functions.
\ XOpenDisplay is referenced in glx.h->xlib.h as an extern definition
: BuildFont ( -- )
0 0 0 { _dpy _finfo _status -- }
96 gl-gen-lists baselist !
\ Get our current display so we can get the fonts
0 x-opendisplay to _dpy
\ Get the font information
_dpy s" -adobe-helvetica-medium-r-normal--18-*-*-*-p-*-iso8859-10"
zstring x-loadqueryfont to _finfo
_finfo 0= if
cr ." First font selection failed. Trying again." cr
\ The helvetica font was not found - try for a fixed font
_dpy s" fixed0" zstring x-loadqueryfont to _finfo
_finfo 0= if
cr ." Second font selection failed." cr
else
cr ." Using <fixed> font." cr
TRUE to _status
then
else
cr ." Using <helvetica> font." cr
TRUE to _status
then
\ If _status==TRUE, we have a font, so continue
_status if
_finfo cell + @ 32 96 baselist @ gl-xusexfont
\ Release the font, freeing the memory
_dpy _finfo x-freefont drop
then
\ Close the X display now we are done with it
_dpy x-closedisplay drop
\ Return status code
_status
;
\ ---[ glPrint ]-----------------------------------------------------
\ Print our GL text to the screen.
\ The passed string should have an extra character appended to the
\ end, so the string can be zero-delimited string by *this* function
\ - not by the calling function. We want to have the string length
\ on the stack when glPrint is called.
: glPrint ( *str _len -- )
\ skip if string length==0
dup 0> if
dup >R \ save length
zstring \ convert to zero-delimited string
GL_LIST_BIT gl-push-attrib \ push the display list bits
baselist @ 32 - gl-list-base \ Set base character to 32
R> GL_UNSIGNED_BYTE rot gl-call-lists \ Draw the text
gl-pop-attrib \ Pop the display list bits
else
2DROP
then
;
\ ---[ Keyboard Flags ]----------------------------------------------
\ Flags needed to prevent constant toggling if the keys that they
\ represent are held down during program operation.
\ By checking to see if the specific flag is already set, we can then
\ choose to ignore the current keypress event for that key.
0 value key-ESC
0 value key-F1
\ ---[ HandleKeyPress ]----------------------------------------------
\ function to handle key press events:
\ ESC exits the program
\ F1 toggles between fullscreen and windowed modes
: HandleKeyPress ( &event -- )
sdl-keyboard-event-keysym sdl-keysym-sym uw@
case
SDLK_ESCAPE of TRUE to opengl-exit-flag endof
SDLK_F1 of key-F1 FALSE = if \ skip if being held down
screen sdl-wm-togglefullscreen drop
TRUE to key-F1 \ set key pressed flag
then
endof
endcase
;
\ ---[ HandleKeyRelease ]--------------------------------------------
\ Function to handle key release events
\ I have added all of the key flags, even though not all are being
\ accessed in the HandleKeyPress function.
: HandleKeyRelease ( &event -- )
sdl-keyboard-event-keysym sdl-keysym-sym uw@
case
SDLK_ESCAPE of FALSE to key-ESC endof
SDLK_F1 of FALSE to key-F1 endof
endcase
;
\ ---[ InitGL ]------------------------------------------------------
\ general OpenGL initialization function
: InitGL ( -- boolean )
\ Enable smooth shading
GL_SMOOTH gl-shade-model
\ Set the background black
0e 0e 0e 0e gl-clear-color
\ Depth buffer setup
1e gl-clear-depth
\ Enable depth testing
GL_DEPTH_TEST gl-enable
\ Type of depth test to do
GL_LEQUAL gl-depth-func
\ Really nice perspective calculations
GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST gl-hint
\ Return a good value
BuildFont
\ returns result from BuildFont
;
\ ---[ ShutDown ]----------------------------------------------------
\ Close down the system gracefully ;-)
: ShutDown ( -- )
FALSE to opengl-exit-flag \ reset this flag for next time
KillFont \ clean up font list
sdl-quit \ close down the SDL systems
;
fvariable fps-seconds
fvariable fps-count
0 value fps-ticks
0 value fps-t0
0 value fps-frames
0 value fps-line
\ ---[ Reset-FPS-Counter ]-------------------------------------------
: Reset-FPS-Counter ( -- )
sdl-get-ticks to fps-t0
0 to fps-frames
;
\ ---[ Display-FPS ]-------------------------------------------------
: Display-FPS ( -- )
sdl-get-ticks to fps-ticks
fps-ticks fps-t0 - 1000 >= if
fps-ticks fps-t0 - S>F 1000e F/ fps-seconds F!
fps-frames S>F fps-seconds F@ F/ fps-count F!
0 fps-line at-xy 50 spaces \ clear previous fps display
0 fps-line at-xy \ display new fps count
fps-frames . ." frames in "
fps-seconds F@ F>S . ." seconds = "
fps-count F@ F>S . ." FPS" cr
fps-ticks to fps-t0
0 to fps-frames
then
;
\ ---[ DrawGLScene ]-------------------------------------------------
\ Here goes our drawing code
: DrawGLScene ( -- boolean )
\ Clear the screen and the depth buffer
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR gl-clear
gl-load-identity
\ Move into the screen 1 unit
0e 0e -1e gl-translate-f
\ Pulsing colors based on text position
1e count1 F@ FCOS F*
1e count2 F@ FSIN F*
1e 0.5e count1 F@ count2 F@ F+ FCOS F* F- gl-color-3f
\ Position the text on the screen
-0.45e 0.05e count1 F@ FCOS F* F+
0.35e count2 F@ FSIN F*
gl-raster-pos-2f
\ Build the text string to display
\ zero temp string length - where we will build our string at
0 temp-string !
\ Copy the main text to the temp string
s" Active OpenGL Text With NeHe - " temp-string concat-string
\ Convert the whole part of count1 to a string and concat it
count1 F@ F>S IntToStr temp-string concat-string
\ Add a character to allow for zero-delimiting the string
s" 0" temp-string concat-string
\ Print the text to the screen
temp-string dup 1+ swap C@ glPrint
count1 F@ 0.051e F+ count1 F! \ increase the first counter
count2 F@ 0.005e F+ count2 F! \ increase the second counter
\ Draw it to the screen
sdl-gl-swap-buffers
fps-frames 1+ to fps-frames \ Gather our frames per second count
Display-FPS \ Display the FPS count to the terminal window
Tim Trussell
\ gforth: OpenGL Graphics Lesson 13
\ ===================================================================
\ File: mini-opengl-1.13.fs
\ Author: Timothy Trussell
\ Date: 07/31/2010
\ Description: OpenGL libcc interface for NeHe OpenGL Tutorial 13
\ Forth System: gforth-0.7.0
\ Assembler: Built-in FORTH assembler
\ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-24
\ C++ Compiler: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5)
\ ===================================================================
\ function calls that are required for use with the gforth version of
\ the NeHe OpenGL Tutorial Lessons.
\ ===================================================================
UseLibUtil [if]
c-library mini_opengl_lib
[else]
c-library mini_opengl_lib13
[then]
s" GL" add-lib
s" GLU" add-lib
\c #if defined(__APPLE__) && defined(__MACH__)
\c #include <OpenGL/gl.h>
\c #include <OpenGL/glu.h>
\c #include <OpenGL/glx.h>
\c #else
\c #include <GL/gl.h>
\c #include <GL/glu.h>
\c #include <GL/glx.h>
\c #endif
\ Initial Entries for Lesson 01
c-function gl-clear glClear n -- void
c-function gl-clear-color glClearColor r r r r -- void
c-function gl-clear-depth glClearDepth r -- void
c-function gl-enable glEnable n -- void
c-function gl-depth-func glDepthFunc n -- void
c-function gl-hint glHint n n -- void
c-function gl-load-identity glLoadIdentity -- void
c-function gl-matrix-mode glMatrixMode n -- void
c-function gl-shade-model glShadeModel n -- void
c-function gl-viewport glViewport n n n n -- void
c-function glu-perspective gluPerspective r r r r -- void
\ Additions for Lesson 02
c-function gl-begin glBegin n -- void
c-function gl-end glEnd -- void
c-function gl-translate-f glTranslatef r r r -- void
c-function gl-vertex-3f glVertex3f r r r -- void
\ Additions for Lesson 03
c-function gl-color-3f glColor3f r r r -- void
\ Additions for Lesson 04
c-function gl-rotate-f glRotatef r r r r -- void
\ Additions for Lesson 05
\ -- none
\ Additions for Lesson 06
c-function gl-bind-texture glBindTexture n n -- void
c-function gl-gen-textures glGenTextures n a -- void
c-function gl-tex-coord-2f glTexCoord2f r r -- void
c-function gl-tex-image-2d glTexImage2D n n n n n n n n a -- void
c-function gl-tex-parameter-i glTexParameteri n n n -- void
\ Additions for Lesson 07
c-function gl-disable glDisable n -- void
c-function gl-light-fv glLightfv n n a -- void
c-function gl-normal-3f glNormal3f r r r -- void
c-function glu-build-2d-mipmaps gluBuild2DMipmaps n n n n n n a --
void
\ Additions for Lesson 08
c-function gl-blend-func glBlendFunc n n -- void
c-function gl-color-4f glColor4f r r r r -- void
\ Additions for Lesson 09
c-function gl-color-4ub glColor4ub n n n n -- void
\ Additions for Lesson 10
\ -- none
\ Additions for Lesson 11
c-function gl-polygon-mode glPolygonMode n n -- void
\ Additions for Lesson 12
c-function gl-call-list glCallList n -- void
c-function gl-color-3fv glColor3fv a -- void
c-function gl-end-list glEndList -- void
c-function gl-gen-lists glGenLists n -- n
c-function gl-new-list glNewList n n -- void
\ Additions for Lesson 13
c-function gl-call-lists glCallLists n n a -- void
c-function gl-delete-lists glDeleteLists n n -- void
c-function gl-list-base glListBase n -- void
c-function gl-pop-attrib glPopAttrib -- void
c-function gl-push-attrib glPushAttrib n -- void
c-function gl-raster-pos-2f glRasterPos2f r r -- void
c-function gl-xusexfont glXUseXFont n n n n -- void
c-function x-closedisplay XCloseDisplay a -- n
c-function x-freefont XFreeFont a a -- n
c-function x-loadqueryfont XLoadQueryFont a a -- a
c-function x-opendisplay XOpenDisplay a -- a
end-c-library
include glconstants.fs