molehill uses the GLU NURBS routines to draw some nice surfaces.
'/* Copyright (c) Mark J. Kilgard, 1995. */
'/* This program is freely distributable without licensing fees
' and is provided without guarantee or warrantee expressed or
' implied. This program is -not- in the public domain. */
'/* molehill uses the GLU NURBS routines to draw some nice surfaces. */
' Translated and adapted to PowerBASIC by José Roca, 2007
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "GLFW.INC"
FUNCTION PBMAIN () AS LONG
LOCAL nWidth, nHeight, running, frames, x, y AS LONG
LOCAL t, t0, fps AS DOUBLE
LOCAL szTitlestr AS ASCIIZ * 200
LOCAL nurb AS DWORD
LOCAL u, v AS LONG
' Initialize GLFW
glfwInit
' Open OpenGL window
IF ISFALSE glfwOpenWindow(640, 480, 0, 0, 0, 0, 16, 0, %GLFW_WINDOW) THEN
glfwTerminate
EXIT FUNCTION
END IF
DIM mat_red_diffuse(3) AS SINGLE
ARRAY ASSIGN mat_red_diffuse() = 0.7, 0.0, 0.1, 1.0
DIM mat_green_diffuse(3) AS SINGLE
ARRAY ASSIGN mat_green_diffuse() = 0.0, 0.7, 0.1, 1.0
DIM mat_blue_diffuse(3) AS SINGLE
ARRAY ASSIGN mat_blue_diffuse() = 0.0, 0.1, 0.7, 1.0
DIM mat_yellow_diffuse(3) AS SINGLE
ARRAY ASSIGN mat_yellow_diffuse() = 0.7, 0.8, 0.1, 1.0
DIM mat_specular(3) AS SINGLE
ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
DIM mat_shininess(0) AS SINGLE
ARRAY ASSIGN mat_shininess() = 100.0
DIM knots(7) AS SINGLE
ARRAY ASSIGN knots() = 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0
DIM pts1(2, 3, 3) AS SINGLE
DIM pts2(2, 3, 3) AS SINGLE
DIM pts3(2, 3, 3) AS SINGLE
DIM pts4(2, 3, 3) AS SINGLE
glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
glEnable %GL_LIGHTING
glEnable %GL_LIGHT0
glEnable %GL_DEPTH_TEST
glEnable %GL_AUTO_NORMAL
glEnable %GL_NORMALIZE
nurb = gluNewNurbsRenderer
gluNurbsProperty nurb, %GLU_SAMPLING_TOLERANCE, 25.0
gluNurbsProperty nurb, %GLU_DISPLAY_MODE, %GLU_FILL
' /* Build control points for NURBS mole hills. */
FOR u = 0 TO 3
FOR v = 0 TO 3
'/* Red. */
pts1(0, v, u) = 2.0 * u
pts1(1, v, u) = 2.0 * v
IF (u=1 OR u = 2) AND (v = 1 OR v = 2) THEN
' /* Stretch up middle. */
pts1(2, v, u) = 6.0
ELSE
pts1(2, v, u) = 0.0
END IF
' /* Green. */
pts2(0, v, u) = 2.0 * (u - 3.0)
pts2(1, v, u) = 2.0 * (v - 3.0)
IF (u=1 OR u = 2) AND (v = 1 OR v = 2) THEN
IF u = 1 AND v = 1 THEN
' /* Pull hard on single middle square. */
pts2(2, v, u) = 15.0
ELSE
' /* Push down on other middle squares. */
pts2(2, v, u) = -2.0
END IF
ELSE
pts2(2, v, u) = 0.0
END IF
' /* Blue. */
pts3(0, v, u) = 2.0 * (u - 3.0)
pts3(1, v, u) = 2.0 * v
IF (u=1 OR u = 2) AND (v = 1 OR v = 2) THEN
IF u = 1 AND v = 2 THEN
' /* Pull up on single middple square. */
pts3(2, v, u) = 11.0
ELSE
' /* Pull up slightly on other middle squares. */
pts3(2, v, u) = 2.0
END IF
ELSE
pts3(2, v, u) = 0.0
END IF
' /* Yellow. */
pts4(0, v, u) = 2.0 * u
pts4(1, v, u) = 2.0 * (v - 3.0)
IF (u=1 OR u = 2 OR u = 3) AND (v = 1 OR v = 2) THEN
IF v = 1 THEN
' /* Push down front middle and right squares. */
pts4(2, v, u) = -2.0
ELSE
' /* Pull up back middle and right squares. */
pts4(2, v, u) = 5.0
END IF
ELSE
pts4(2, v, u) = 0.0
END IF
NEXT
NEXT
' /* Stretch up red's far right corner. */
pts1(2, 3, 3) = 6
' /* Pull down green's near left corner a little. */
pts2(2, 0, 0) = -2
' /* Turn up meeting of four corners. */
pts1(2, 0, 0) = 1
pts2(2, 3, 3) = 1
pts3(2, 0, 3) = 1
pts4(2, 3, 0) = 1
glMatrixMode %GL_PROJECTION
gluPerspective 55.0, 1.0, 2.0, 24.0
glMatrixMode %GL_MODELVIEW
glTranslatef 0.0, 0.0, -15.0
glRotatef 330.0, 1.0, 0.0, 0.0
glNewList 1, %GL_COMPILE
' /* Render red hill. */
glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_red_diffuse(0)
gluBeginSurface nurb
gluNurbsSurface nurb, 8, knots(0), 8, knots(0), _
4 * 3, 3, pts1(0, 0, 0), _
4, 4, %GL_MAP2_VERTEX_3
gluEndSurface nurb
' /* Render green hill. */
glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_green_diffuse(0)
gluBeginSurface nurb
gluNurbsSurface nurb, 8, knots(0), 8, knots(0), _
4 * 3, 3, pts2(0, 0, 0), _
4, 4, %GL_MAP2_VERTEX_3
gluEndSurface nurb
' /* Render blue hill. */
glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_blue_diffuse(0)
gluBeginSurface nurb
gluNurbsSurface nurb, 8, knots(0), 8, knots(0), _
4 * 3, 3, pts3(0, 0, 0), _
4, 4, %GL_MAP2_VERTEX_3
gluEndSurface nurb
' /* Render yellow hill. */
glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_yellow_diffuse(0)
gluBeginSurface nurb
gluNurbsSurface nurb, 8, knots(0), 8, knots(0), _
4 * 3, 3, pts4(0, 0, 0), _
4, 4, %GL_MAP2_VERTEX_3
gluEndSurface nurb
glEndList
' Enable sticky keys
glfwEnable %GLFW_STICKY_KEYS
' Main loop
running = %TRUE
frames = 0
t0 = glfwGetTime
DO WHILE running
' Get time and mouse position
t = glfwGetTime
glfwGetMousePos x, y
' Calculate and display FPS (frames per second)
IF t - t0 > 1.0! OR frames = 0 THEN
fps = frames / (t-t0)
wsprintf szTitlestr, "molehill (%i FPS)", BYVAL fps
glfwSetWindowTitle szTitlestr
t0 = t
frames = 0
END IF
frames = frames + 1
' Get window size (may be different than the requested size)
glfwGetWindowSize nWidth, nHeight
IF nHeight <= 0 THEN nHeight = 1
' Set viewport
glViewport 0, 0, nWidth, nHeight
' Clear the screen and depth buffers
glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
' Call the list
glCallList 1
glFlush
' Swap buffers
glfwSwapBuffers
' Check if the ESC key was pressed or the window was closed
running = NOT glfwGetKey(%GLFW_KEY_ESC) AND glfwGetWindowParam(%GLFW_OPENED)
LOOP
' Close OpenGL window and terminate GLFW
glfwTerminate
END FUNCTION
