gforth: OpenGL Graphics Lesson 10
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-lesson10.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 10 at
for the description of what is going on with this code.
---[ Additions ]-----------------------------------------------------
There are no new OpenGL additions to the mini-opengl libcc interface
for this lesson.
---[ Installation ]--------------------------------------------------
If you are placing all of the Lessons in one directory, copy these
three files to that directory:
opengl-lesson10.fs - Code Addendum 1
opengllib-1.10.fs - Code Addendum 2
mini-opengl-1.10.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.
This Lesson also uses an image file which you can retrieve from the
NeHe Lesson 10 page at:
http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=10
or from the opengl-lesson10.zip file that will be posted to the
Taygeta Forth Archives site listed at the start of this column.
For the files from the opengl-lesson10.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.10.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-lesson10.fs
lesson10
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-lesson10.fs
lesson10
---[ Next Up ]-------------------------------------------------------
Lesson 11 - Flag effect (waving texture)
----------------------------------------------------[End Lesson10]---
Tim Trussell
\ gforth: OpenGL Graphics Lesson 10
\ ===================================================================
\ File: opengl-tut10.fs
\ Author: Lionel Brits
\ Linux Version: Ti Leggett
\ gForth Version: Timothy Trussell, 07/25/2010
\ Description: Moving in a 3D world
\ Forth System: gforth-0.7.0
\ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-23
\ C++ Compiler: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5)
\ ===================================================================
\ NeHe Productions
\ http://nehe.gamedev.net/
\ ===================================================================
\ OpenGL Tutorial Lesson 10
\ ===================================================================
\ 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.10.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 100" 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 ." Arrow Keys:" 1+
cr ." Up move forward" 1+
cr ." Down move backward" 1+
cr ." Left turn (camera) to the left" 1+
cr ." Right turn (camera) to the right" 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
;
: lesson10 ( -- )
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
\ 2 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 10)
cr .( type "lesson10" to execute) cr
Tim Trussell
\ gforth: OpenGL Graphics Lesson 10
\ ===================================================================
\ File: opengllib-1.10.fs
\ Author: Jeff Molofee
\ Linux Version: Ti Leggett
\ gForth Version: Timothy Trussell, 07/25/2010
\ Description: Moving in a 3D world
\ Forth System: gforth-0.7.0
\ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-23
\ C++ Compiler: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5)
\ ===================================================================
\ NeHe Productions
\ http://nehe.gamedev.net/
\ ===================================================================
\ OpenGL Tutorial Lesson 10
\ ===================================================================
\ 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.10.fs
require mini-sdl-1.01.fs
require sdlkeysym.fs
[then]
\ ---[ Prototype Listing ]-------------------------------------------
\ : Generate-Texture { *src -- }
\ : Generate-MipMapped-Texture { *src -- }
\ : LoadGLTextures ( -- boolean )
\ : HandleKeyPress ( &event -- )
\ : HandleKeyRelease ( &event -- )
\ : InitGL ( -- boolean )
\ : ShutDown ( -- )
\ : Reset-FPS-Counter ( -- )
\ : Display-FPS ( -- )
\ : DrawGLScene ( -- boolean )
\ ------------------------------------------------[End Prototypes]---
\ ---[ Variable Declarations ]---------------------------------------
\ ---[ Structs ]-----------------------------------------------------
\ Build Our Vertex Structure
struct
FLOAT% field vertex-x \ 3D Coordinates
FLOAT% field vertex-y
FLOAT% field vertex-z
FLOAT% field vertex-u \ Texture Coordinates
FLOAT% field vertex-v
end-struct vertex%
\ Build Our Triangle Structure
struct
vertex% 3 * field vertex[] \ Array Of Three Vertices
end-struct triangle%
\ Build Our Sector Structure
struct
cell% field sector-#tris \ # of triangles in sector
cell% field sector-*tris \ pointer to array of triangles
end-struct sector%
\ ---[ sector1 ]-----------------------------------------------------
\ Contains the number of polygons in the image, and the address of
\ the array in the dictionary.
sector% %allot value sector1 \ our sector
\ ---[ sector-ndx ]--------------------------------------------------
\ Passed the number of the triangle to access, and the specific
\ vertex required, the base address of that vertex set is returned,
\ from which the vertex -x/-y/-z/-u/-v field can be used to get/set
\ the required vertex address.
\ x_m = sector1.triangle[i].vertex[0].x
: sector-ndx { _#tri _#ver -- *tri[#tri].vertex[#ver] }
sector1 sector-*tris @ \ *tri[0]
triangle% nip _#tri * + \ *tri[#tri]
vertex% nip _#ver * + \ *(tri[#tri].vertex[#ver])
;
3 constant NumTextures \ number of textures to use
fvariable y-rot \ Camera rotation variable
fvariable x-pos \ Camera pos variables
fvariable z-pos
fvariable walkbias \ head-bobbin variables
fvariable walkbiasangle
fvariable lookupdown
\ allocate space for <NumTextures> texture pointers
create texture here NumTextures cells dup allot 0 fill
\ ---[ Array Index Functions ]---------------------------------------
\ Index functions to access the arrays
: texture-ndx ( n -- *texture[n] ) NumTextures MOD cells texture + ;
\ ---[ Light Values ]------------------------------------------------
\ The following three arrays are RGBA color shadings.
\ Ambient Light Values
create LightAmbient[] 0.5e SF, 0.5e SF, 0.5e SF, 1e SF,
\ Diffuse Light Values
create LightDiffuse[] 1e SF, 1e SF, 1e SF, 1e SF,
\ Light Position
create LightPosition[] 0e SF, 0e SF, 2e SF, 1e SF,
0 value filter \ which filter to use
pi 180e F/ fconstant PiOver180 \ for converting to radians
\ ---[ Polygon Definitions ]-----------------------------------------
\ This data definition area holds the contents of the world.txt file
\ that is included in the Lesson 10 source archive.
create [sector-data]
\ Store all of the polygon info into the dictionary.
\ Each group of three lines is a single triangle% struct
0 \ init polygon counter
\ x y z u v
-3e F, 0e F, -3e F, 0e F, 6e F, \ Floor 1
-3e F, 0e F, 3e F, 0e F, 0e F,
3e F, 0e F, 3e F, 6e F, 0e F, 1+ \ increment poly count
-3e F, 0e F, -3e F, 0e F, 6e F,
3e F, 0e F, -3e F, 6e F, 6e F,
3e F, 0e F, 3e F, 6e F, 0e F, 1+ \ after each struct
-3e F, 1e F, -3e F, 0e F, 6e F, \ Ceiling 1
-3e F, 1e F, 3e F, 0e F, 0e F,
3e F, 1e F, 3e F, 6e F, 0e F, 1+
-3e F, 1e F, -3e F, 0e F, 6e F,
3e F, 1e F, -3e F, 6e F, 6e F,
3e F, 1e F, 3e F, 6e F, 0e F, 1+
-2e F, 1e F, -2e F, 0e F, 1e F, \ A1
-2e F, 0e F, -2e F, 0e F, 0e F,
-0.5e F, 0e F, -2e F, 1.5e F, 0e F, 1+
-2e F, 1e F, -2e F, 0e F, 1e F,
-0.5e F, 1e F, -2e F, 1.5e F, 1e F,
-0.5e F, 0e F, -2e F, 1.5e F, 0e F, 1+
2e F, 1e F, -2e F, 2e F, 1e F, \ A2
2e F, 0e F, -2e F, 2e F, 0e F,
0.5e F, 0e F, -2e F, 0.5e F, 0e F, 1+
2e F, 1e F, -2e F, 2e F, 1e F,
0.5e F, 1e F, -2e F, 0.5e F, 1e F,
0.5e F, 0e F, -2e F, 0.5e F, 0e F, 1+
-2e F, 1e F, 2e F, 2e F, 1e F, \ B1
-2e F, 0e F, 2e F, 2e F, 0e F,
-0.5e F, 0e F, 2e F, 0.5e F, 0e F, 1+
-2e F, 1e F, 2e F, 2e F, 1e F,
-0.5e F, 1e F, 2e F, 0.5e F, 1e F,
-0.5e F, 0e F, 2e F, 0.5e F, 0e F, 1+
2e F, 1e F, 2e F, 2e F, 1e F, \ B2
2e F, 0e F, 2e F, 2e F, 0e F,
0.5e F, 0e F, 2e F, 0.5e F, 0e F, 1+
2e F, 1e F, 2e F, 2e F, 1e F,
0.5e F, 1e F, 2e F, 0.5e F, 1e F,
0.5e F, 0e F, 2e F, 0.5e F, 0e F, 1+
-2e F, 1e F, -2e F, 0e F, 1e F, \ C1
-2e F, 0e F, -2e F, 0e F, 0e F,
-2e F, 0e F, -0.5e F, 1.5e F, 0e F, 1+
-2e F, 1e F, -2e F, 0e F, 1e F,
-2e F, 1e F, -0.5e F, 1.5e F, 1e F,
-2e F, 0e F, -0.5e F, 1.5e F, 0e F, 1+
-2e F, 1e F, 2e F, 2e F, 1e F, \ C2
-2e F, 0e F, 2e F, 2e F, 0e F,
-2e F, 0e F, 0.5e F, 0.5e F, 0e F, 1+
-2e F, 1e F, 2e F, 2e F, 1e F,
-2e F, 1e F, 0.5e F, 0.5e F, 1e F,
-2e F, 0e F, 0.5e F, 0.5e F, 0e F, 1+
2e F, 1e F, -2e F, 0e F, 1e F, \ D1
2e F, 0e F, -2e F, 0e F, 0e F,
2e F, 0e F, -0.5e F, 1.5e F, 0e F, 1+
2e F, 1e F, -2e F, 0e F, 1e F,
2e F, 1e F, -0.5e F, 1.5e F, 1e F,
2e F, 0e F, -0.5e F, 1.5e F, 0e F, 1+
2e F, 1e F, 2e F, 2e F, 1e F, \ D2
2e F, 0e F, 2e F, 2e F, 0e F,
2e F, 0e F, 0.5e F, 0.5e F, 0e F, 1+
2e F, 1e F, 2e F, 2e F, 1e F,
2e F, 1e F, 0.5e F, 0.5e F, 1e F,
2e F, 0e F, 0.5e F, 0.5e F, 0e F, 1+
-0.5e F, 1e F, -3e F, 0e F, 1e F, \ Upper hallway - L
-0.5e F, 0e F, -3e F, 0e F, 0e F,
-0.5e F, 0e F, -2e F, 1e F, 0e F, 1+
-0.5e F, 1e F, -3e F, 0e F, 1e F,
-0.5e F, 1e F, -2e F, 1e F, 1e F,
-0.5e F, 0e F, -2e F, 1e F, 0e F, 1+
0.5e F, 1e F, -3e F, 0e F, 1e F, \ Upper hallway - R
0.5e F, 0e F, -3e F, 0e F, 0e F,
0.5e F, 0e F, -2e F, 1e F, 0e F, 1+
0.5e F, 1e F, -3e F, 0e F, 1e F,
0.5e F, 1e F, -2e F, 1e F, 1e F,
0.5e F, 0e F, -2e F, 1e F, 0e F, 1+
-0.5e F, 1e F, 3e F, 0e F, 1e F, \ Lower hallway - L
-0.5e F, 0e F, 3e F, 0e F, 0e F,
-0.5e F, 0e F, 2e F, 1e F, 0e F, 1+
-0.5e F, 1e F, 3e F, 0e F, 1e F,
-0.5e F, 1e F, 2e F, 1e F, 1e F,
-0.5e F, 0e F, 2e F, 1e F, 0e F, 1+
0.5e F, 1e F, 3e F, 0e F, 1e F, \ Lower hallway - R
0.5e F, 0e F, 3e F, 0e F, 0e F,
0.5e F, 0e F, 2e F, 1e F, 0e F, 1+
0.5e F, 1e F, 3e F, 0e F, 1e F,
0.5e F, 1e F, 2e F, 1e F, 1e F,
0.5e F, 0e F, 2e F, 1e F, 0e F, 1+
-3e F, 1e F, 0.5e F, 1e F, 1e F, \ Left hallway - Lw
-3e F, 0e F, 0.5e F, 1e F, 0e F,
-2e F, 0e F, 0.5e F, 0e F, 0e F, 1+
-3e F, 1e F, 0.5e F, 1e F, 1e F,
-2e F, 1e F, 0.5e F, 0e F, 1e F,
-2e F, 0e F, 0.5e F, 0e F, 0e F, 1+
-3e F, 1e F, -0.5e F, 1e F, 1e F, \ Left hallway - Hi
-3e F, 0e F, -0.5e F, 1e F, 0e F,
-2e F, 0e F, -0.5e F, 0e F, 0e F, 1+
-3e F, 1e F, -0.5e F, 1e F, 1e F,
-2e F, 1e F, -0.5e F, 0e F, 1e F,
-2e F, 0e F, -0.5e F, 0e F, 0e F, 1+
3e F, 1e F, 0.5e F, 1e F, 1e F, \ Right hallway - Lw
3e F, 0e F, 0.5e F, 1e F, 0e F,
2e F, 0e F, 0.5e F, 0e F, 0e F, 1+
3e F, 1e F, 0.5e F, 1e F, 1e F,
2e F, 1e F, 0.5e F, 0e F, 1e F,
2e F, 0e F, 0.5e F, 0e F, 0e F, 1+
3e F, 1e F, -0.5e F, 1e F, 1e F, \ Right hallway - Hi
3e F, 0e F, -0.5e F, 1e F, 0e F,
2e F, 0e F, -0.5e F, 0e F, 0e F, 1+
3e F, 1e F, -0.5e F, 1e F, 1e F,
2e F, 1e F, -0.5e F, 0e F, 1e F,
2e F, 0e F, -0.5e F, 0e F, 0e F, 1+
value #Polygons
[sector-data] sector1 sector-*tris ! \ Initialize sector1 fields
#Polygons sector1 sector-#tris !
\ ---[ LoadGLTextures ]----------------------------------------------
\ function to load in bitmap as a GL texture
: Generate-Texture { *src -- }
GL_TEXTURE_2D 0 3
*src sdl-surface-w @ \ width of texture image
*src sdl-surface-h @ \ height of texture image
0 GL_BGR \ pixel mapping orientation
GL_UNSIGNED_BYTE
*src sdl-surface-pixels @ \ address of texture data
gl-tex-image-2d \ finally generate it
;
: Generate-MipMapped-Texture { *src -- }
GL_TEXTURE_2D 3
*src sdl-surface-w @ \ width of texture image
*src sdl-surface-h @ \ height of texture image
GL_BGR \ pixel mapping orientation
GL_UNSIGNED_BYTE
*src sdl-surface-pixels @ \ address of texture data
glu-build-2d-mipmaps \ finally generate it
;
: LoadGLTextures ( -- status )
FALSE { _status -- status } \ init return value
s" data/mud.bmp0" zstring sdl-loadbmp dup 0<> if
>R \ image loaded successfully
TRUE to _status \ set return value
3 texture gl-gen-textures \ create the texture
\ Load in texture 1
GL_TEXTURE_2D 0 texture-ndx @ gl-bind-texture \ texture[0]
\ Generate texture 1
R@ Generate-Texture
\ Nearest Filtering
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST gl-tex-parameter-
i
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST gl-tex-parameter-
i
\ Load in texture 2
GL_TEXTURE_2D 1 texture-ndx @ gl-bind-texture \ texture[1]
\ Linear Filtering
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR gl-tex-parameter-
i
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR gl-tex-parameter-
i
\ Generate texture 2
R@ Generate-Texture
\ Load in texture 3
GL_TEXTURE_2D 2 texture-ndx @ gl-bind-texture \ texture[2]
\ MipMapped Filtering
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR_MIPMAP_NEAREST
gl-tex-parameter-i
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR gl-tex-parameter-
i
\ Generate MipMapped texture 3
R@ Generate-MipMapped-Texture
R> sdl-freesurface
else
drop \ unable to load image
cr ." Error: texture image could not be loaded!" cr
then
_status \ exit with return value: 0=fail;-1=ok
;
\ ---[ 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
0 value key-Up
0 value key-Dn
0 value key-Right
0 value key-Left
\ ---[ HandleKeyPress ]----------------------------------------------
\ function to handle key press events:
\ ESC exits the program
\ F1 toggles between fullscreen and windowed modes
\ Up move forward
\ Down move backward
\ Right turns camera to the right
\ Left turns camera to the left
: 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
SDLK_UP of
x-pos F@
y-rot F@ PiOver180 F* FSIN 0.05e F*
F- x-pos F!
z-pos F@
y-rot F@ PiOver180 F* FCOS 0.05e F*
F- z-pos F!
walkbiasangle F@ 359e F>= if
0e
else
walkbiasangle F@ 10e F+
then
FDUP walkbiasangle F!
\ Cause the 'player' to bounce
PiOver180 F* FSIN 20e F/ walkbias F!
endof
SDLK_DOWN of
x-pos F@
y-rot F@ PiOver180 F* FSIN 0.05e F*
F+ x-pos F!
z-pos F@
y-rot F@ PiOver180 F* FCOS 0.05e F*
F+ z-pos F!
walkbiasangle F@ 1e F<= if
359e
else
walkbiasangle F@ 10e F-
then
FDUP walkbiasangle F!
\ Cause the 'player' to bounce
PiOver180 F* FSIN 20e F/ walkbias F!
endof
SDLK_RIGHT of y-rot F@ 1.5e F- y-rot F! endof
SDLK_LEFT of y-rot F@ 1.5e F+ y-rot F! 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
SDLK_UP of FALSE to key-Up endof
SDLK_DOWN of FALSE to key-Dn endof
SDLK_RIGHT of FALSE to key-Right endof
SDLK_LEFT of FALSE to key-Left endof
endcase
;
\ ---[ InitGL ]------------------------------------------------------
\ general OpenGL initialization function
: InitGL ( -- boolean )
\ Load in the texture
LoadGLTextures 0= if
false
else
\ Enable texture mapping
GL_TEXTURE_2D gl-enable
\ 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
\ Set up the ambient light
GL_LIGHT1 GL_AMBIENT LightAmbient[] gl-light-fv
\ Set up the diffuse light
GL_LIGHT1 GL_DIFFUSE LightDiffuse[] gl-light-fv
\ Position the light
GL_LIGHT1 GL_POSITION LightPosition[] gl-light-fv
\ Enable Light One
GL_LIGHT1 gl-enable
0e lookupdown F!
0e walkbias F!
0e walkbiasangle F!
\ Full brightness, 50% Alpha
1e 1e 1e 0.5e gl-color-4f
\ Blending translucency based on source alpha value
GL_SRC_ALPHA GL_ONE gl-blend-func
\ Return a good value
TRUE
then
;
\ ---[ ShutDown ]----------------------------------------------------
\ Close down the system gracefully ;-)
: ShutDown ( -- )
FALSE to opengl-exit-flag \ reset this flag for next time
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
fvariable x-m
fvariable y-m
fvariable z-m
fvariable u-m
fvariable v-m
fvariable x-trans
fvariable z-trans
fvariable y-trans
fvariable SceneRotY
: DrawGLScene ( -- boolean )
x-pos F@ fnegate x-trans F!
z-pos F@ fnegate z-trans F!
walkbias F@ 0.25e F- y-trans F!
360e y-rot F@ F- SceneRotY F!
\ Clear the screen and the depth buffer
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR gl-clear
gl-load-identity \ restore matrix
\ Rotate up and down to look up and down
lookupdown F@ 1e 0e 0e gl-rotate-f
\ Rotate depending on direction 'player' is facing
SceneRotY F@ 0e 1e 0e gl-rotate-f
\ Translate the scene based on 'player' position
x-trans F@ y-trans F@ z-trans F@ gl-translate-f
\ Select a texture based on filter
GL_TEXTURE_2D filter texture-ndx @ gl-bind-texture
\ Process each triangle
sector1 sector-#tris @ 0 do
GL_TRIANGLES gl-begin
\ Normal pointing forward
0e 0e 1e gl-normal-3f
\ Vertices of first point
i 0 sector-ndx vertex-u F@
i 0 sector-ndx vertex-v F@
gl-tex-coord-2f \ set texture coordinate
i 0 sector-ndx vertex-x F@
i 0 sector-ndx vertex-y F@
i 0 sector-ndx vertex-z F@
gl-vertex-3f \ set the vertice
\ Vertices of second point
i 1 sector-ndx vertex-u F@
i 1 sector-ndx vertex-v F@
gl-tex-coord-2f \ set texture coordinate
i 1 sector-ndx vertex-x F@
i 1 sector-ndx vertex-y F@
i 1 sector-ndx vertex-z F@
gl-vertex-3f \ set the vertice
\ Vertices of third point
i 2 sector-ndx vertex-u F@
i 2 sector-ndx vertex-v F@
gl-tex-coord-2f \ set texture coordinate
i 2 sector-ndx vertex-x F@
i 2 sector-ndx vertex-y F@
i 2 sector-ndx vertex-z F@
gl-vertex-3f \ set the vertice
gl-end
loop
\ 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 10
\ ===================================================================
\ File: mini-opengl-1.10.fs
\ Author: Timothy Trussell
\ Date: 07/25/2010
\ Description: OpenGL libcc interface for NeHe OpenGL Tutorial 10
\ Forth System: gforth-0.7.0
\ Assembler: Built-in FORTH assembler
\ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-23
\ 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_lib10
[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 #else
\c #include <GL/gl.h>
\c #include <GL/glu.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
end-c-library
include glconstants.fs