Announcement

**José Roca** · 4 Feb 2013, 02:13 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  aargb.c
' *  This program draws shows how to draw anti-aliased lines. It draws
' *  two diagonal lines to form an X; when 'r' is typed in the window,
' *  the lines are rotated in opposite directions.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "aargb"

GLOBAL rotAngle AS SINGLE

' ========================================================================================
'/*  Initialize antialiasing for RGBA mode, including alpha
' *  blending, hint, and line width.  Print out implementation
' *  specific info on line width granularity and width.
' */
' ========================================================================================
SUB Init ()

   DIM values(1) AS SINGLE

   glGetFloatv %GL_LINE_WIDTH_GRANULARITY, values(0)
   glGetFloatv %GL_LINE_WIDTH_RANGE, values(0)
   glEnable %GL_LINE_SMOOTH
   glEnable %GL_BLEND
   glBlendFunc %GL_SRC_ALPHA, %GL_ONE_MINUS_SRC_ALPHA
   glHint %GL_LINE_SMOOTH_HINT, %GL_DONT_CARE
   glLineWidth 1.5
   glClearColor 0.0, 0.0, 0.0, 0.0

END SUB
' ========================================================================================

' ========================================================================================
'/*  Draw 2 diagonal lines to form an X
' */
' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT

   glColor3f 0.0, 1.0, 0.0
   glPushMatrix
   glRotatef -rotAngle, 0.0, 0.0, 0.1
   glBegin %GL_LINES
      glVertex2f -0.5, 0.5
      glVertex2f 0.5, -0.5
   glEnd
   glPopMatrix

   glColor3f 0.0, 0.0, 1.0
   glPushMatrix
   glRotatef rotAngle, 0.0, 0.0, 0.1
   glBegin %GL_LINES
      glVertex2f 0.5, 0.5
      glVertex2f -0.5, -0.5
   glEnd
   glPopMatrix

   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      gluOrtho2D -1.0, 1.0, _
         -1.0 * h / w, 1.0 * h / w
   ELSE
      gluOrtho2D -1.0 * w / h, _
         1.0 * w / h, -1.0, 1.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
      CASE ASC("R"), ASC("r")
         rotAngle = rotAngle + 20.0
         IF rotAngle >= 360.0 THEN rotAngle = 0.0
         glutPostRedisplay
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  RGBA display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:20 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*  accanti.c
' *  Use the accumulation buffer to do full-scene antialiasing
' *  on a scene with orthographic parallel projection.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "accanti"

%ACSIZE = 8

TYPE jitter_point
  x AS SINGLE
  y AS SINGLE
END TYPE

GLOBAL j8()  AS jitter_point

GLOBAL mat_ambient() AS SINGLE
GLOBAL mat_specular() AS SINGLE
GLOBAL light_position() AS SINGLE
GLOBAL lm_ambient() AS SINGLE

GLOBAL torus_diffuse() AS SINGLE
GLOBAL cube_diffuse() AS SINGLE
GLOBAL sphere_diffuse() AS SINGLE
GLOBAL octa_diffuse() AS SINGLE

' ========================================================================================
SUB InitArrays ()

   ' /* 8 jitter points */
   REDIM j8(7) AS jitter_point
   j8(0).x = -0.334818 : j8(0).y =  0.435331
   j8(1).x =  0.286438 : j8(1).y = -0.393495
   j8(2).x =  0.459462 : j8(2).y =  0.141540
   j8(3).x = -0.414498 : j8(3).y = -0.192829
   j8(4).x = -0.183790 : j8(4).y =  0.082102
   j8(5).x = -0.079263 : j8(5).y = -0.317383
   j8(6).x =  0.102254 : j8(6).y =  0.299133
   j8(7).x =  0.164216 : j8(7).y = -0.054399

   REDIM mat_ambient(3) AS SINGLE
   REDIM mat_specular(3) AS SINGLE
   REDIM light_position(3) AS SINGLE
   REDIM lm_ambient(3) AS SINGLE

   ARRAY ASSIGN mat_ambient() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN light_position() = 0.0, 0.0, 10.0, 1.0
   ARRAY ASSIGN lm_ambient() = 0.2, 0.2, 0.2, 1.0

   REDIM torus_diffuse(3) AS SINGLE
   REDIM cube_diffuse(3) AS SINGLE
   REDIM sphere_diffuse(3) AS SINGLE
   REDIM octa_diffuse(3) AS SINGLE

   ARRAY ASSIGN torus_diffuse() = 0.7, 0.7, 0.0, 1.0
   ARRAY ASSIGN cube_diffuse() = 0.0, 0.7, 0.7, 1.0
   ARRAY ASSIGN sphere_diffuse() = 0.7, 0.0, 0.7, 1.0
   ARRAY ASSIGN octa_diffuse() = 0.7, 0.4, 0.4, 1.0

END SUB
' ========================================================================================

' ========================================================================================
'/*  Initialize antialiasing for RGBA mode, including alpha
' *  blending, hint, and line width.  Print out implementation
' *  specific info on line width granularity and width.
' */
' ========================================================================================
SUB Init ()

   InitArrays

   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialf %GL_FRONT, %GL_SHININESS, 50.0
   glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
   glLightModelfv %GL_LIGHT_MODEL_AMBIENT, lm_ambient(0)

   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0
   glEnable %GL_DEPTH_TEST
   glShadeModel %GL_FLAT

   glClearColor 0.0, 0.0, 0.0, 0.0
   glClearAccum 0.0, 0.0, 0.0, 0.0

END SUB
' ========================================================================================

' ========================================================================================
SUB displayObjects ()

   glPushMatrix
   glRotatef 30.0, 1.0, 0.0, 0.0

   glPushMatrix
   glTranslatef -0.80, 0.35, 0.0
   glRotatef 100.0, 1.0, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, torus_diffuse(0)
   glutSolidTorus 0.275, 0.85, 16, 16
   glPopMatrix

   glPushMatrix
   glTranslatef -0.75, -0.50, 0.0
   glRotatef 45.0, 0.0, 0.0, 1.0
   glRotatef 45.0, 1.0, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, cube_diffuse(0)
   glutSolidCube 1.5
   glPopMatrix

   glPushMatrix
   glTranslatef 0.75, 0.60, 0.0
   glRotatef 30.0, 1.0, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, sphere_diffuse(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   glPushMatrix
   glTranslatef 0.70, -0.90, 0.25
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, octa_diffuse(0)
   glutSolidOctahedron
   glPopMatrix

   glPopMatrix

END SUB
' ========================================================================================

' ========================================================================================
'/*  Draw 2 diagonal lines to form an X
' */
' ========================================================================================
SUB DisplayProc CDECL ()

   DIM viewport(3) AS LONG
   DIM jitter AS LONG

   glGetIntegerv %GL_VIEWPORT, viewport(0)

   glClear %GL_ACCUM_BUFFER_BIT
   FOR jitter = 0 TO %ACSIZE - 1
      glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
      glPushMatrix
'/*	Note that 4.5 is the distance in world space between
' *	left and right and bottom and top.
' *	This formula converts fractional pixel movement to
' *	world coordinates.
' */
      glTranslatef j8(jitter).x * 4.5 / viewport(2), _
                   j8(jitter).y * 4.5 / viewport(3), 0.0
      displayObjects
      glPopMatrix
      glAccum %GL_ACCUM, 1.0 / %ACSIZE
   NEXT
   glAccum %GL_RETURN, 1.0
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -2.25, 2.25, -2.25 * h / w, 2.25 * h / w, -10.0, 10.0
   ELSE
      glOrtho -2.25 * w / h, 2.25 * w / h, -2.25, 2.25, -10.0, 10.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  RGBA display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_ACCUM OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:21 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*  accpersp.c
' *  Use the accumulation buffer to do full-scene antialiasing
' *  on a scene with perspective projection, using the special
' *  routines accFrustum() and accPerspective().
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "accpersp"

%ACSIZE = 8
MACRO PI = 3.14159265358979323846

TYPE jitter_point
  x AS SINGLE
  y AS SINGLE
END TYPE

GLOBAL j8()  AS jitter_point

GLOBAL mat_ambient() AS SINGLE
GLOBAL mat_specular() AS SINGLE
GLOBAL light_position() AS SINGLE
GLOBAL lm_ambient() AS SINGLE

GLOBAL torus_diffuse() AS SINGLE
GLOBAL cube_diffuse() AS SINGLE
GLOBAL sphere_diffuse() AS SINGLE
GLOBAL octa_diffuse() AS SINGLE

' ========================================================================================
SUB InitArrays ()

   ' /* 8 jitter points */
   REDIM j8(7) AS jitter_point
   j8(0).x = -0.334818 : j8(0).y =  0.435331
   j8(1).x =  0.286438 : j8(1).y = -0.393495
   j8(2).x =  0.459462 : j8(2).y =  0.141540
   j8(3).x = -0.414498 : j8(3).y = -0.192829
   j8(4).x = -0.183790 : j8(4).y =  0.082102
   j8(5).x = -0.079263 : j8(5).y = -0.317383
   j8(6).x =  0.102254 : j8(6).y =  0.299133
   j8(7).x =  0.164216 : j8(7).y = -0.054399

   REDIM mat_ambient(3) AS SINGLE
   REDIM mat_specular(3) AS SINGLE
   REDIM light_position(3) AS SINGLE
   REDIM lm_ambient(3) AS SINGLE

   ARRAY ASSIGN mat_ambient() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN light_position() = 0.0, 0.0, 10.0, 1.0
   ARRAY ASSIGN lm_ambient() = 0.2, 0.2, 0.2, 1.0

   REDIM torus_diffuse(3) AS SINGLE
   REDIM cube_diffuse(3) AS SINGLE
   REDIM sphere_diffuse(3) AS SINGLE
   REDIM octa_diffuse(3) AS SINGLE

   ARRAY ASSIGN torus_diffuse() = 0.7, 0.7, 0.0, 1.0
   ARRAY ASSIGN cube_diffuse() = 0.0, 0.7, 0.7, 1.0
   ARRAY ASSIGN sphere_diffuse() = 0.7, 0.0, 0.7, 1.0
   ARRAY ASSIGN octa_diffuse() = 0.7, 0.4, 0.4, 1.0

END SUB
' ========================================================================================

' ========================================================================================
'/* accFrustum()
' * The first 6 arguments are identical to the glFrustum() call.
' *
' * pixdx and pixdy are anti-alias jitter in pixels.
' * Set both equal to 0.0 for no anti-alias jitter.
' * eyedx and eyedy are depth-of field jitter in pixels.
' * Set both equal to 0.0 for no depth of field effects.
' *
' * focus is distance from eye to plane in focus.
' * focus must be greater than, but not equal to 0.0.
' *
' * Note that accFrustum() calls glTranslatef().  You will
' * probably want to insure that your ModelView matrix has been
' * initialized to identity before calling accFrustum().
' */
' ========================================================================================
SUB accFrustum(BYVAL nLeft AS DOUBLE, BYVAL nRight AS DOUBLE, BYVAL nBottom AS DOUBLE, _
   BYVAL nTop AS DOUBLE, BYVAL nNear AS DOUBLE, BYVAL nFar AS DOUBLE, BYVAL pixdx AS DOUBLE, _
   BYVAL pixdy AS DOUBLE, BYVAL eyedx AS DOUBLE, BYVAL eyedy AS DOUBLE, BYVAL nFocus AS DOUBLE)

   LOCAL xwsize, ywsize AS DOUBLE
   LOCAL dx, dy AS DOUBLE
   DIM   viewport(3) AS LONG

   glGetIntegerv %GL_VIEWPORT, viewport(0)

   xwsize = nRight - nLeft
   ywsize = nTop - nBottom

   dx = -(pixdx*xwsize/viewport(2) + eyedx*nNear/nFocus)
   dy = -(pixdy*ywsize/viewport(3) + eyedy*nNear/nFocus)

   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   glFrustum nLeft + dx, nRight + dx, nBottom + dy, nTop + dy, nNear, nFar
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity
   glTranslatef -eyedx, -eyedy, 0.0

END SUB
' ========================================================================================

' ========================================================================================
'/* accPerspective()
' *
' * The first 4 arguments are identical to the gluPerspective() call.
' * pixdx and pixdy are anti-alias jitter in pixels.
' * Set both equal to 0.0 for no anti-alias jitter.
' * eyedx and eyedy are depth-of field jitter in pixels.
' * Set both equal to 0.0 for no depth of field effects.
' *
' * focus is distance from eye to plane in focus.
' * focus must be greater than, but not equal to 0.0.
' *
' * Note that accPerspective() calls accFrustum().
' */
' ========================================================================================
SUB accPerspective(BYVAL fovy AS DOUBLE, BYVAL aspect AS DOUBLE, _
   BYVAL nNear AS DOUBLE, BYVAL nFar AS DOUBLE, BYVAL pixdx AS DOUBLE, BYVAL pixdy AS DOUBLE, _
   BYVAL eyedx AS DOUBLE, BYVAL eyedy AS DOUBLE, BYVAL nFocus AS DOUBLE)

   LOCAL fov2, nLeft, nRight, nBottom, nTop AS DOUBLE

   fov2 = ((fovy * PI) / 180.0) / 2.0

   nTop = nNear / (COS(fov2) / (fov2))
   nBottom = -nTop

   nRight = nTop * aspect
   nLeft = -nRight

   accFrustum (nLeft, nRight, nBottom, nTop, nNear, nFar, _
               pixdx, pixdy, eyedx, eyedy, nFocus)

END SUB
' ========================================================================================

' ========================================================================================
'/*  Initialize lighting and other values.
' */
' ========================================================================================
SUB Init()

   InitArrays

   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialf %GL_FRONT, %GL_SHININESS, 50.0
   glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
   glLightModelfv %GL_LIGHT_MODEL_AMBIENT, lm_ambient(0)

   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0
   glEnable %GL_DEPTH_TEST
   glShadeModel %GL_FLAT

   glClearColor 0.0, 0.0, 0.0, 0.0
   glClearAccum 0.0, 0.0, 0.0, 0.0

END SUB
' ========================================================================================

' ========================================================================================
SUB displayObjects ()

   glPushMatrix
   glTranslatef 0.0, 0.0, -5.0
   glRotatef 30.0, 1.0, 0.0, 0.0

   glPushMatrix
   glTranslatef -0.80, 0.35, 0.0
   glRotatef 100.0, 1.0, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, torus_diffuse(0)
   glutSolidTorus 0.275, 0.85, 16, 16
   glPopMatrix

   glPushMatrix
   glTranslatef -0.75, -0.50, 0.0
   glRotatef 45.0, 0.0, 0.0, 1.0
   glRotatef 45.0, 1.0, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, cube_diffuse(0)
   glutSolidCube 1.5
   glPopMatrix

   glPushMatrix
   glTranslatef 0.75, 0.60, 0.0
   glRotatef 30.0, 1.0, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, sphere_diffuse(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   glPushMatrix
   glTranslatef 0.70, -0.90, 0.25
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, octa_diffuse(0)
   glutSolidOctahedron
   glPopMatrix

   glPopMatrix

END SUB
' ========================================================================================

' ========================================================================================
'/*  Draw 2 diagonal lines to form an X
' */
' ========================================================================================
SUB DisplayProc CDECL ()

   DIM viewport(3) AS LONG
   DIM jitter AS LONG

   glGetIntegerv %GL_VIEWPORT, viewport(0)

   glClear %GL_ACCUM_BUFFER_BIT
   FOR jitter = 0 TO %ACSIZE - 1
      glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
      accPerspective 50.0, _
         viewport(2)/viewport(3), _
         1.0, 15.0, j8(jitter).x, j8(jitter).y, 0.0, 0.0, 1.0
      displayObjects
      glAccum %GL_ACCUM, 1.0 / %ACSIZE
   NEXT
   glAccum %GL_RETURN, 1.0
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  RGBA display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_ACCUM OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:22 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  alpha.c
' *  This program draws several overlapping filled polygons
' *  to demonstrate the effect order has on alpha blending results.
' *  Use the 't' key to toggle the order of drawing polygons.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "alpha"

GLOBAL leftFirst AS LONG

' ========================================================================================
'/*  Initialize alpha blending function.
' */
 ' ========================================================================================
SUB Init ()

   leftFirst = %GL_TRUE

   glEnable %GL_BLEND
   glBlendFunc %GL_SRC_ALPHA, %GL_ONE_MINUS_SRC_ALPHA
   glShadeModel %GL_FLAT
   glClearColor 0.0, 0.0, 0.0, 0.0

END SUB
' ========================================================================================

' ========================================================================================
SUB drawLeftTriangle()

   ' /* draw yellow triangle on LHS of screen */
   glBegin %GL_TRIANGLES
      glColor4f 1.0, 1.0, 0.0, 0.75
      glVertex3f 0.1, 0.9, 0.0
      glVertex3f 0.1, 0.1, 0.0
      glVertex3f 0.7, 0.5, 0.0
   glEnd

END SUB
' ========================================================================================

' ========================================================================================
SUB drawRightTriangle()

   ' /* draw cyan triangle on RHS of screen */
   glBegin %GL_TRIANGLES
      glColor4f 0.0, 1.0, 1.0, 0.75
      glVertex3f 0.9, 0.9, 0.0
      glVertex3f 0.3, 0.5, 0.0
      glVertex3f 0.9, 0.1, 0.0
   glEnd

END SUB
' ========================================================================================

' ========================================================================================
'/*  Draw 2 diagonal lines to form an X
' */
' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT

   IF leftFirst THEN
      drawLeftTriangle
      drawRightTriangle
   ELSE
      drawRightTriangle
      drawLeftTriangle
   END IF

   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      gluOrtho2D 0.0, 1.0, 0.0, 1.0 * h / w
   ELSE
      gluOrtho2D 0.0, 1.0 * w / h, 0.0, 1.0
   END IF

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
      CASE ASC("T"), ASC("t")
         IF leftFirst = %TRUE THEN leftFirst = %FALSE ELSE leftFirst = %TRUE
         glutPostRedisplay
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:24 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  alpha3D.c
' *  This program demonstrates how to intermix opaque and
' *  alpha blended polygons in the same scene, by using
' *  glDepthMask.  Press the 'a' key to animate moving the
' *  transparent object through the opaque object.  Press
' *  the 'r' key to reset the scene.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "alpha3D"

MACRO MAXZ = 8.0
MACRO MINZ = -8.0
MACRO ZINC = 0.4

GLOBAL solidZ AS SINGLE
GLOBAL transparentZ AS SINGLE
GLOBAL sphereList, cubeList AS DWORD
GLOBAL mat_specular() AS SINGLE
GLOBAL mat_shininess() AS SINGLE
GLOBAL position() AS SINGLE
GLOBAL mat_solid() AS SINGLE
GLOBAL mat_zero() AS SINGLE
GLOBAL mat_transparent() AS SINGLE
GLOBAL mat_emission() AS SINGLE

' ========================================================================================
'/*  Initialize alpha blending function.
' */
 ' ========================================================================================
SUB Init ()

   solidZ = MAXZ
   transparentZ = MINZ

   REDIM mat_specular(3)
   REDIM mat_shininess(0)
   REDIM position (3)

   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 0.15
   ARRAY ASSIGN mat_shininess() = 100.0
   ARRAY ASSIGN position() = 0.5, 0.5, 1.0, 0.0

   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
   glLightfv %GL_LIGHT0, %GL_POSITION, position(0)

   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0
   glEnable %GL_DEPTH_TEST

   sphereList = glGenLists(1)
   glNewList sphereList, %GL_COMPILE
      glutSolidSphere 0.4, 16, 16
   glEndList

   cubeList = glGenLists(1)
   glNewList cubeList, %GL_COMPILE
      glutSolidCube 0.6
   glEndList

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   REDIM mat_solid(3)
   REDIM mat_zero(3)
   REDIM mat_transparent(3)
   REDIM mat_emission(3)

   ARRAY ASSIGN mat_solid() = 0.75, 0.75, 0.0, 1.0
   ARRAY ASSIGN mat_zero() = 0.0, 0.0, 0.0, 1.0
   ARRAY ASSIGN mat_transparent() = 0.0, 0.8, 0.8, 0.6
   ARRAY ASSIGN mat_emission() = 0.0, 0.3, 0.3, 0.6

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT

   glPushMatrix
      glTranslatef -0.15, -0.15, solidZ
      glMaterialfv %GL_FRONT, %GL_EMISSION, mat_zero(0)
      glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_solid(0)
      glCallList sphereList
   glPopMatrix

   glPushMatrix
      glTranslatef 0.15, 0.15, transparentZ
      glRotatef 15.0, 1.0, 1.0, 0.0
      glRotatef 30.0, 0.0, 1.0, 0.0
      glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
      glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_transparent(0)
      glEnable %GL_BLEND
      glDepthMask %GL_FALSE
      glBlendFunc %GL_SRC_ALPHA, %GL_ONE
      glCallList cubeList
      glDepthMask %GL_TRUE
      glDisable %GL_BLEND
   glPopMatrix

   glutSwapBuffers

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -1.5, 1.5, -1.5 * h / w, _
              1.5 * h / w, -10.0, 10.0
   ELSE
      glOrtho -1.5 * w / h, _
              1.5 * w / h, -1.5, 1.5, -10.0, 10.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
SUB animate()

   IF solidZ <= MINZ OR transparentZ >= MAXZ THEN
      glutIdleFunc %NULL
   ELSE
      solidZ = solidZ - ZINC
      transparentZ = transparentZ + ZINC
      glutPostRedisplay
   END IF

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
      CASE ASC("A"), ASC("a")
         solidZ = MAXZ
         transparentZ = MINZ
         glutIdleFunc CODEPTR(animate)
      CASE ASC("R"), ASC("r")
         solidZ = MAXZ
         transparentZ = MINZ
         glutPostRedisplay
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:25 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*  bezcurve.c
' *  This program uses evaluators to draw a Bezier curve.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "bezcurve"

GLOBAL ctrlpoints() AS SINGLE

' ========================================================================================
'/*  Initialize alpha blending function.
' */
 ' ========================================================================================
SUB Init ()

   REDIM ctrlpoints(2, 3)
   ctrlpoints(0, 0) = -4.0 : ctrlpoints(1, 0) = -4.0 : ctrlpoints(2, 0) = 0.0
   ctrlpoints(0, 1) = -2.0 : ctrlpoints(1, 1) =  4.0 : ctrlpoints(2, 1) = 0.0
   ctrlpoints(0, 2) =  2.0 : ctrlpoints(1, 2) = -4.0 : ctrlpoints(2, 2) = 0.0
   ctrlpoints(0, 3) =  4.0 : ctrlpoints(1, 3) =  4.0 : ctrlpoints(2, 3) = 0.0

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_FLAT
   glMap1f %GL_MAP1_VERTEX_3, 0.0, 1.0, 3, 4, ctrlpoints(0, 0)
   glEnable %GL_MAP1_VERTEX_3

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   LOCAL i AS LONG

   glClear %GL_COLOR_BUFFER_BIT
   glColor3f 1.0, 1.0, 1.0
   glBegin %GL_LINE_STRIP
      FOR i = 0 TO 30
         glEvalCoord1f i / 30.0
      NEXT
   glEnd
   ' /* The following code displays the control points as dots. */
   glPointSize 5.0
   glColor3f 1.0, 1.0, 0.0
   glBegin %GL_POINTS
      FOR i = 0 TO 3
'         glVertex3fv ctrlpoints(i, 0)
         glVertex3fv ctrlpoints(0, i)
      NEXT
   glEnd
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -5.0, 5.0, -5.0 * h / w, _
               5.0 * h / w, -5.0, 5.0
   ELSE
      glOrtho -5.0 * w / h, _
               5.0 * w / h, -5.0, 5.0, -5.0, 5.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:27 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*  bezmesh.c
' *  This program renders a lighted, filled Bezier surface,
' *  using two-dimensional evaluators.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "bezmesh"

GLOBAL ctrlpoints() AS SINGLE
GLOBAL ambient() AS SINGLE
GLOBAL position() AS SINGLE
GLOBAL mat_diffuse() AS SINGLE
GLOBAL mat_specular() AS SINGLE
GLOBAL mat_shininess() AS SINGLE

' ========================================================================================
SUB InitArrays ()

   REDIM ctrlpoints(2, 3, 3)

   ctrlpoints(0, 0, 0) = -1.5 : ctrlpoints(1, 0, 0) = -1.5 : ctrlpoints(2, 0, 0) =  4.0
   ctrlpoints(0, 1, 0) = -0.5 : ctrlpoints(1, 1, 0) = -1.5 : ctrlpoints(2, 1, 0) =  2.0
   ctrlpoints(0, 2, 0) =  0.5 : ctrlpoints(1, 2, 0) = -1.5 : ctrlpoints(2, 2, 0) = -1.0
   ctrlpoints(0, 3, 0) =  1.5 : ctrlpoints(1, 3, 0) = -1.5 : ctrlpoints(2, 3, 0) =  2.0

   ctrlpoints(0, 0, 1) = -1.5 : ctrlpoints(1, 0, 1) = -0.5 : ctrlpoints(2, 0, 1) =  1.0
   ctrlpoints(0, 1, 1) = -0.5 : ctrlpoints(1, 1, 1) = -0.5 : ctrlpoints(2, 1, 1) =  3.0
   ctrlpoints(0, 2, 1) =  0.5 : ctrlpoints(1, 2, 1) = -0.5 : ctrlpoints(2, 2, 1) =  0.0
   ctrlpoints(0, 3, 1) =  1.5 : ctrlpoints(1, 3, 1) = -0.5 : ctrlpoints(2, 3, 1) = -1.0

   ctrlpoints(0, 0, 2) = -1.5 : ctrlpoints(1, 0, 2) = -0.5 : ctrlpoints(2, 0, 2) =  4.0
   ctrlpoints(0, 1, 2) = -0.5 : ctrlpoints(1, 1, 2) = -0.5 : ctrlpoints(2, 1, 2) =  0.0
   ctrlpoints(0, 2, 2) =  0.5 : ctrlpoints(1, 2, 2) = -0.5 : ctrlpoints(2, 2, 2) =  3.0
   ctrlpoints(0, 3, 2) =  1.5 : ctrlpoints(1, 3, 2) = -0.5 : ctrlpoints(2, 3, 2) =  4.0

   ctrlpoints(0, 0, 3) = -1.5 : ctrlpoints(1, 0, 3) = 1.5 : ctrlpoints(2, 0, 3) = -2.0
   ctrlpoints(0, 1, 3) = -0.5 : ctrlpoints(1, 1, 3) = 1.5 : ctrlpoints(2, 1, 3) = -2.0
   ctrlpoints(0, 2, 3) =  0.5 : ctrlpoints(1, 2, 3) = 1.5 : ctrlpoints(2, 2, 3) =  0.0
   ctrlpoints(0, 3, 3) =  1.5 : ctrlpoints(1, 3, 3) = 1.5 : ctrlpoints(2, 3, 3) = -1.0

   REDIM ambient(3)
   REDIM position(3)
   REDIM mat_diffuse(3)
   REDIM mat_specular(3)
   REDIM mat_shininess(0)

   ARRAY ASSIGN ambient() = 0.2, 0.2, 0.2, 1.0
   ARRAY ASSIGN position() = 0.0, 0.0, 2.0, 1.0
   ARRAY ASSIGN mat_diffuse() = 0.6, 0.6, 0.6, 1.0
   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN mat_shininess() = 50.0


END SUB
' ========================================================================================

' ========================================================================================
SUB InitLights ()

   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0

   glLightfv %GL_LIGHT0, %GL_AMBIENT, ambient(0)
   glLightfv %GL_LIGHT0, %GL_POSITION, position(0)

   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   glPushMatrix
   glRotatef 85.0, 1.0, 1.0, 1.0
   glEvalMesh2 %GL_FILL, 0, 20, 0, 20
   glPopMatrix
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
SUB Init ()

   InitArrays

   glClearColor 0.0, 0.0, 0.0, 0.0
   glEnable %GL_DEPTH_TEST
   glMap2f %GL_MAP2_VERTEX_3, 0, 1, 3, 4, _
           0, 1, 12, 4, ctrlpoints(0, 0, 0)
   glEnable %GL_MAP2_VERTEX_3
   glEnable %GL_AUTO_NORMAL
   glMapGrid2f 20, 0.0, 1.0, 20, 0.0, 1.0
   InitLights      ' /* for lighted version only */

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -4.0, 4.0, -4.0 * h / w, 4.0 * h / w, -4.0, 4.0
   ELSE
      glOrtho -4.0 * w / h, 4.0 * w / h, -4.0, 4.0, -4.0, 4.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:28 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*  bezsurf.c
' *  This program renders a wireframe Bezier surface,
' *  using two-dimensional evaluators.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "bezsurf"

GLOBAL ctrlpoints() AS SINGLE
GLOBAL ambient() AS SINGLE
GLOBAL position() AS SINGLE
GLOBAL mat_diffuse() AS SINGLE
GLOBAL mat_specular() AS SINGLE
GLOBAL mat_shininess() AS SINGLE

' ========================================================================================
SUB InitArrays ()

   REDIM ctrlpoints(2, 3, 3)

   ctrlpoints(0, 0, 0) = -1.5 : ctrlpoints(1, 0, 0) = -1.5 : ctrlpoints(2, 0, 0) =  4.0
   ctrlpoints(0, 1, 0) = -0.5 : ctrlpoints(1, 1, 0) = -1.5 : ctrlpoints(2, 1, 0) =  2.0
   ctrlpoints(0, 2, 0) =  0.5 : ctrlpoints(1, 2, 0) = -1.5 : ctrlpoints(2, 2, 0) = -1.0
   ctrlpoints(0, 3, 0) =  1.5 : ctrlpoints(1, 3, 0) = -1.5 : ctrlpoints(2, 3, 0) =  2.0

   ctrlpoints(0, 0, 1) = -1.5 : ctrlpoints(1, 0, 1) = -0.5 : ctrlpoints(2, 0, 1) =  1.0
   ctrlpoints(0, 1, 1) = -0.5 : ctrlpoints(1, 1, 1) = -0.5 : ctrlpoints(2, 1, 1) =  3.0
   ctrlpoints(0, 2, 1) =  0.5 : ctrlpoints(1, 2, 1) = -0.5 : ctrlpoints(2, 2, 1) =  0.0
   ctrlpoints(0, 3, 1) =  1.5 : ctrlpoints(1, 3, 1) = -0.5 : ctrlpoints(2, 3, 1) = -1.0

   ctrlpoints(0, 0, 2) = -1.5 : ctrlpoints(1, 0, 2) = -0.5 : ctrlpoints(2, 0, 2) =  4.0
   ctrlpoints(0, 1, 2) = -0.5 : ctrlpoints(1, 1, 2) = -0.5 : ctrlpoints(2, 1, 2) =  0.0
   ctrlpoints(0, 2, 2) =  0.5 : ctrlpoints(1, 2, 2) = -0.5 : ctrlpoints(2, 2, 2) =  3.0
   ctrlpoints(0, 3, 2) =  1.5 : ctrlpoints(1, 3, 2) = -0.5 : ctrlpoints(2, 3, 2) =  4.0

   ctrlpoints(0, 0, 3) = -1.5 : ctrlpoints(1, 0, 3) = 1.5 : ctrlpoints(2, 0, 3) = -2.0
   ctrlpoints(0, 1, 3) = -0.5 : ctrlpoints(1, 1, 3) = 1.5 : ctrlpoints(2, 1, 3) = -2.0
   ctrlpoints(0, 2, 3) =  0.5 : ctrlpoints(1, 2, 3) = 1.5 : ctrlpoints(2, 2, 3) =  0.0
   ctrlpoints(0, 3, 3) =  1.5 : ctrlpoints(1, 3, 3) = 1.5 : ctrlpoints(2, 3, 3) = -1.0

   REDIM ambient(3)
   REDIM position(3)
   REDIM mat_diffuse(3)
   REDIM mat_specular(3)
   REDIM mat_shininess(0)

   ARRAY ASSIGN ambient() = 0.2, 0.2, 0.2, 1.0
   ARRAY ASSIGN position() = 0.0, 0.0, 2.0, 1.0
   ARRAY ASSIGN mat_diffuse() = 0.6, 0.6, 0.6, 1.0
   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN mat_shininess() = 50.0

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   LOCAL i, j AS LONG

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   glColor3f 1.0, 1.0, 1.0
   glPushMatrix
   glRotatef 85.0, 1.0, 1.0, 1.0
   FOR j = 0 TO 8
      glBegin %GL_LINE_STRIP
      FOR i = 0 TO 30
         glEvalCoord2f i / 30.0, j / 8.0
      NEXT
      glEnd
      glBegin %GL_LINE_STRIP
      FOR i = 0 TO 30
         glEvalCoord2f j / 8.0, i / 30.0
      NEXT
      glEnd
   NEXT
   glPopMatrix
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
SUB Init ()

   InitArrays

   glClearColor 0.0, 0.0, 0.0, 0.0
   glMap2f %GL_MAP2_VERTEX_3, 0, 1, 3, 4, _
           0, 1, 12, 4, ctrlpoints(0, 0, 0)
   glEnable %GL_MAP2_VERTEX_3
   glMapGrid2f 20, 0.0, 1.0, 20, 0.0, 1.0
   glEnable %GL_DEPTH_TEST
   glShadeModel %GL_FLAT

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -4.0, 4.0, -4.0 * h / w, 4.0 * h / w, -4.0, 4.0
   ELSE
      glOrtho -4.0 * w / h, 4.0 * w / h, -4.0, 4.0, -4.0, 4.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:29 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  clip.c
' *  This program demonstrates arbitrary clipping planes.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "clip"

GLOBAL eqn() AS DOUBLE
GLOBAL eqn2() AS DOUBLE

' ========================================================================================
SUB Init ()

   REDIM eqn(3)
   REDIM eqn2(3)

   ARRAY ASSIGN eqn()  = 0.0, 1.0, 0.0, 0.0
   ARRAY ASSIGN eqn2() = 1.0, 0.0, 0.0, 0.0

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_FLAT

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT

   glColor3f 1.0, 1.0, 1.0
   glPushMatrix
   glTranslatef 0.0, 0.0, -5.0

   '/*    clip lower half -- y < 0          */
   glClipPlane %GL_CLIP_PLANE0, eqn(0)
   glEnable %GL_CLIP_PLANE0
   '/*    clip left half -- x < 0           */
   glClipPlane %GL_CLIP_PLANE1, eqn2(0)
   glEnable %GL_CLIP_PLANE1

   glRotatef 90.0, 1.0, 0.0, 0.0
   glutWireSphere 1.0, 20, 16
   glPopMatrix

   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   gluPerspective 60.0, w / h, 1.0, 20.0
   glMatrixMode %GL_MODELVIEW

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_INDEX
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:30 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  colormat.c
' *  After initialization, the program will be in
' *  ColorMaterial mode.  Interaction:  pressing the
' *  mouse buttons will change the diffuse reflection values.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "colormat"

GLOBAL diffuseMaterial() AS SINGLE

' ========================================================================================
SUB Init ()

   REDIM diffuseMaterial(3)
   ARRAY ASSIGN diffuseMaterial() = 0.5, 0.5, 0.5, 1.0

   DIM mat_specular(3) AS SINGLE
   DIM light_position(2) AS SINGLE

   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_SMOOTH
   glEnable %GL_DEPTH_TEST
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, diffuseMaterial(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialf %GL_FRONT, %GL_SHININESS, 25.0
   glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0

   glColorMaterial %GL_FRONT, %GL_DIFFUSE
   glEnable %GL_COLOR_MATERIAL

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   glutSolidSphere 1.0, 20, 16
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -1.5, 1.5, -1.5 * h / w, _
         1.5 * h / w, -10.0, 10.0
   ELSE
      glOrtho -1.5 * w / h, _
         1.5 * w / h, -1.5, 1.5, -10.0, 10.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
SUB MouseProc CDECL (BYVAL nButton AS LONG, BYVAL nState AS LONG, BYVAL x AS LONG, BYVAL y AS LONG)

   SELECT CASE nButton
      CASE %GLUT_LEFT_BUTTON
         IF nState = %GLUT_DOWN THEN
            diffuseMaterial(0) = diffuseMaterial(0) + 0.1
            IF diffuseMaterial(0) > 1.0 THEN
               diffuseMaterial(0) = 0.0
            END IF
            glColor4fv diffuseMaterial(0)
            glutPostRedisplay
         END IF
      CASE %GLUT_MIDDLE_BUTTON
         IF nState = %GLUT_DOWN THEN
            diffuseMaterial(1) = diffuseMaterial(1) + 0.1
            IF diffuseMaterial(1) > 1.0 THEN
               diffuseMaterial(1) = 0.0
            END IF
            glColor4fv diffuseMaterial(0)
            glutPostRedisplay
         END IF
      CASE %GLUT_RIGHT_BUTTON
         IF nState = %GLUT_DOWN THEN
            diffuseMaterial(2) = diffuseMaterial(2) + 0.1
            IF diffuseMaterial(2) > 1.0 THEN
               diffuseMaterial(2) = 0.0
            END IF
            glColor4fv diffuseMaterial(0)
            glutPostRedisplay
         END IF
   END SELECT

END SUB
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMouseFunc    CODEPTR(MouseProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:31 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  cube.c
' *  This program demonstrates a single modeling transformation,
' *  glScalef() and a single viewing transformation, gluLookAt().
' *  A wireframe cube is rendered.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "cube"

' ========================================================================================
SUB Init ()

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_FLAT

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT
   glColor3f 1.0, 1.0, 1.0
   glLoadIdentity           ' /* clear the matrix */
         ' /* viewing transformation  */
   gluLookAt 0.0, 0.0, 5.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0
   glScalef 1.0, 2.0, 1.0    ' /* modeling transformation */
   glutWireCube 1.0
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   glFrustum -1.0, 1.0, -1.0, 1.0, 1.5, 20.0
   glMatrixMode %GL_MODELVIEW

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_INDEX
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:32 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  dof.c
' *  This program demonstrates use of the accumulation buffer to
' *  create an out-of-focus depth-of-field effect.  The teapots
' *  are drawn several times into the accumulation buffer.  The
' *  viewing volume is jittered, except at the focal point, where
' *  the viewing volume is at the same position, each time.  In
' *  this case, the gold teapot remains in focus.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "dof"

TYPE jitter_point
  x AS SINGLE
  y AS SINGLE
END TYPE

GLOBAL j8()  AS jitter_point

MACRO PI = 3.14159265358979323846
GLOBAL teapotList AS DWORD
GLOBAL ambient() AS SINGLE
GLOBAL diffuse() AS SINGLE
GLOBAL specular() AS SINGLE
GLOBAL position() AS SINGLE
GLOBAL lmodel_ambient() AS SINGLE
GLOBAL local_view() AS SINGLE

' ========================================================================================
SUB InitArrays ()

   ' /* 8 jitter points */
   REDIM j8(7) AS jitter_point
   j8(0).x = -0.334818 : j8(0).y =  0.435331
   j8(1).x =  0.286438 : j8(1).y = -0.393495
   j8(2).x =  0.459462 : j8(2).y =  0.141540
   j8(3).x = -0.414498 : j8(3).y = -0.192829
   j8(4).x = -0.183790 : j8(4).y =  0.082102
   j8(5).x = -0.079263 : j8(5).y = -0.317383
   j8(6).x =  0.102254 : j8(6).y =  0.299133
   j8(7).x =  0.164216 : j8(7).y = -0.054399

   REDIM ambient(3) AS SINGLE
   REDIM specular(3) AS SINGLE
   REDIM diffuse(3) AS SINGLE
   REDIM position(3) AS SINGLE

   ARRAY ASSIGN ambient() = 0.0, 0.0, 0.0, 1.0
   ARRAY ASSIGN diffuse() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN position() = 0.0, 3.0, 3.0, 0.0

   REDIM lmodel_ambient(3) AS SINGLE
   REDIM local_view(0) AS SINGLE

   ARRAY ASSIGN lmodel_ambient() = 0.2, 0.2, 0.2, 1.0
   ARRAY ASSIGN local_view() = 0.0

END SUB
' ========================================================================================

' ========================================================================================
'/* accFrustum()
' * The first 6 arguments are identical to the glFrustum() call.
' *
' * pixdx and pixdy are anti-alias jitter in pixels.
' * Set both equal to 0.0 for no anti-alias jitter.
' * eyedx and eyedy are depth-of field jitter in pixels.
' * Set both equal to 0.0 for no depth of field effects.
' *
' * focus is distance from eye to plane in focus.
' * focus must be greater than, but not equal to 0.0.
' *
' * Note that accFrustum() calls glTranslatef().  You will
' * probably want to insure that your ModelView matrix has been
' * initialized to identity before calling accFrustum().
' */
' ========================================================================================
SUB accFrustum(BYVAL nLeft AS DOUBLE, BYVAL nRight AS DOUBLE, BYVAL nBottom AS DOUBLE, _
   BYVAL nTop AS DOUBLE, BYVAL nNear AS DOUBLE, BYVAL nFar AS DOUBLE, BYVAL pixdx AS DOUBLE, _
   BYVAL pixdy AS DOUBLE, BYVAL eyedx AS DOUBLE, BYVAL eyedy AS DOUBLE, BYVAL nFocus AS DOUBLE)

   LOCAL xwsize, ywsize AS DOUBLE
   LOCAL dx, dy AS DOUBLE
   DIM   viewport(3) AS LONG

   glGetIntegerv %GL_VIEWPORT, viewport(0)

   xwsize = nRight - nLeft
   ywsize = nTop - nBottom

   dx = -(pixdx*xwsize/viewport(2) + eyedx*nNear/nFocus)
   dy = -(pixdy*ywsize/viewport(3) + eyedy*nNear/nFocus)

   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   glFrustum nLeft + dx, nRight + dx, nBottom + dy, nTop + dy, nNear, nFar
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity
   glTranslatef -eyedx, -eyedy, 0.0

END SUB
' ========================================================================================

' ========================================================================================
'/* accPerspective()
' *
' * The first 4 arguments are identical to the gluPerspective() call.
' * pixdx and pixdy are anti-alias jitter in pixels.
' * Set both equal to 0.0 for no anti-alias jitter.
' * eyedx and eyedy are depth-of field jitter in pixels.
' * Set both equal to 0.0 for no depth of field effects.
' *
' * focus is distance from eye to plane in focus.
' * focus must be greater than, but not equal to 0.0.
' *
' * Note that accPerspective() calls accFrustum().
' */
' ========================================================================================
SUB accPerspective(BYVAL fovy AS DOUBLE, BYVAL aspect AS DOUBLE, _
   BYVAL nNear AS DOUBLE, BYVAL nFar AS DOUBLE, BYVAL pixdx AS DOUBLE, BYVAL pixdy AS DOUBLE, _
   BYVAL eyedx AS DOUBLE, BYVAL eyedy AS DOUBLE, BYVAL nFocus AS DOUBLE)

   LOCAL fov2, nLeft, nRight, nBottom, nTop AS DOUBLE

   fov2 = ((fovy * PI) / 180.0) / 2.0

   nTop = nNear / (COS(fov2) / (fov2))
   nBottom = -nTop

   nRight = nTop * aspect
   nLeft = -nRight

   accFrustum (nLeft, nRight, nBottom, nTop, nNear, nFar, _
               pixdx, pixdy, eyedx, eyedy, nFocus)

END SUB
' ========================================================================================

' ========================================================================================
SUB Init ()

   InitArrays

   glLightfv %GL_LIGHT0, %GL_AMBIENT, ambient(0)
   glLightfv %GL_LIGHT0, %GL_DIFFUSE, diffuse(0)
   glLightfv %GL_LIGHT0, %GL_POSITION, position(0)

   glLightModelfv %GL_LIGHT_MODEL_AMBIENT, lmodel_ambient(0)
   glLightModelfv %GL_LIGHT_MODEL_LOCAL_VIEWER, local_view(0)

   glFrontFace %GL_CW
   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0
   glEnable %GL_AUTO_NORMAL
   glEnable %GL_NORMALIZE
   glEnable %GL_DEPTH_TEST

   glClearColor 0.0, 0.0, 0.0, 0.0
   glClearAccum 0.0, 0.0, 0.0, 0.0
   ' /*  make teapot display list */
   teapotList = glGenLists(1)
   glNewList teapotList, %GL_COMPILE
   glutSolidTeapot 0.5
   glEndList

END SUB
' ========================================================================================

' ========================================================================================
SUB renderTeapot (BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE, _
   BYVAL ambr AS SINGLE, BYVAL ambg AS SINGLE, BYVAL ambb AS SINGLE, _
   BYVAL difr AS SINGLE, BYVAL difg AS SINGLE, BYVAL difb AS SINGLE, _
   BYVAL specr AS SINGLE, BYVAL specg AS SINGLE, BYVAL specb AS SINGLE, BYVAL shine AS SINGLE)

   DIM matx(3) AS SINGLE

   glPushMatrix
   glTranslatef x, y, z
   matx(0) = ambr : matx(1) = ambg : matx(2) = ambb : matx(3) = 1.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, matx(0)
   matx(0) = difr : matx(1) = difg : matx(2) = difb
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, matx(0)
   matx(0) = specr : matx(1) = specg : matx(2) = specb
   glMaterialfv %GL_FRONT, %GL_SPECULAR, matx(0)
   glMaterialf %GL_FRONT, %GL_SHININESS, shine * 128.0
   glCallList teapotList
   glPopMatrix

END SUB
' ========================================================================================

' ========================================================================================
'/*  display() draws 5 teapots into the accumulation buffer
' *  several times; each time with a jittered perspective.
' *  The focal point is at z = 5.0, so the gold teapot will
' *  stay in focus.  The amount of jitter is adjusted by the
' *  magnitude of the accPerspective() jitter; in this example, 0.33.
' *  In this example, the teapots are drawn 8 times.  See jitter.h
' */
' ========================================================================================
 SUB DisplayProc CDECL ()

   LOCAL jitter AS LONG
   DIM viewport(3) AS LONG

   glGetIntegerv %GL_VIEWPORT, viewport(0)
   glClear %GL_ACCUM_BUFFER_BIT

   FOR jitter = 0 TO 7
      glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
      accPerspective 45.0, _
         viewport(2) / viewport(3), _
         1.0, 15.0, 0.0, 0.0, _
         0.33 * j8(jitter).x, 0.33 * j8(jitter).y, 5.0

      ' /*   ruby, gold, silver, emerald, and cyan teapots   */
      renderTeapot -1.1, -0.5, -4.5, 0.1745, 0.01175, _
                   0.01175, 0.61424, 0.04136, 0.04136, _
                   0.727811, 0.626959, 0.626959, 0.6
      renderTeapot -0.5, -0.5, -5.0, 0.24725, 0.1995, _
                   0.0745, 0.75164, 0.60648, 0.22648, _
                   0.628281, 0.555802, 0.366065, 0.4
      renderTeapot 0.2, -0.5, -5.5, 0.19225, 0.19225, _
                   0.19225, 0.50754, 0.50754, 0.50754, _
                   0.508273, 0.508273, 0.508273, 0.4
      renderTeapot 1.0, -0.5, -6.0, 0.0215, 0.1745, 0.0215, _
                   0.07568, 0.61424, 0.07568, 0.633, _
                   0.727811, 0.633, 0.6
      renderTeapot 1.8, -0.5, -6.5, 0.0, 0.1, 0.06, 0.0, _
                   0.50980392, 0.50980392, 0.50196078, _
                   0.50196078, 0.50196078, 0.25
      glAccum %GL_ACCUM, 0.125
   NEXT
   glAccum %GL_RETURN, 1.0
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  color index display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_ACCUM OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:33 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  double.c
' *  This is a simple double buffered program.
' *  Pressing the left mouse button rotates the rectangle.
' *  Pressing the middle mouse button stops the rotation.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "double"

GLOBAL spin AS SINGLE

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT
   glPushMatrix
   glRotatef spin, 0.0, 0.0, 1.0
   glColor3f 1.0, 1.0, 1.0
   glRectf -25.0, -25.0, 25.0, 25.0
   glPopMatrix

   glutSwapBuffers

END SUB
' ========================================================================================

' ========================================================================================
SUB spinDisplay CDECL ()

   spin = spin + 2.0
   IF spin > 360.0 THEN
      spin = spin - 360.0
   END IF
   glutPostRedisplay

END SUB
' ========================================================================================

' ========================================================================================
SUB Init ()

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_FLAT

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   glOrtho -50.0, 50.0, -50.0, 50.0, -1.0, 1.0
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
SUB MouseProc CDECL (BYVAL nButton AS LONG, BYVAL nState AS LONG, BYVAL x AS LONG, BYVAL y AS LONG)

   SELECT CASE nButton
      CASE %GLUT_LEFT_BUTTON
         IF nState = %GLUT_DOWN THEN
            glutIdleFunc(CODEPTR(spinDisplay))
         END IF
      CASE %GLUT_MIDDLE_BUTTON, %GLUT_RIGHT_BUTTON
         IF nState = %GLUT_DOWN THEN
            glutIdleFunc(%NULL)
         END IF
   END SELECT

END SUB
' ========================================================================================

' ========================================================================================
'/*
' *  Request double buffer display mode.
' *  Register mouse input callback functions
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_DOUBLE OR %GLUT_INDEX
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMouseFunc    CODEPTR(MouseProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:35 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  drawf.c
' *  Draws the bitmapped letter F on the screen (several times).
' *  This demonstrates use of the glBitmap() call.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "drawf"
GLOBAL rasters() AS BYTE


' ========================================================================================
SUB Init ()

   REDIM rasters(23)
   ARRAY ASSIGN rasters() = &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, _
   &Hff, &H00, &Hff, &H00, &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, &Hff, &Hc0, &Hff, &Hc0

   glPixelStorei %GL_UNPACK_ALIGNMENT, 1
   glClearColor 0.0, 0.0, 0.0, 0.0

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT
   glColor3f 1.0, 1.0, 1.0
   glRasterPos2i 20, 20
   glBitmap 10, 12, 0.0, 0.0, 11.0, 0.0, rasters(0)
   glBitmap 10, 12, 0.0, 0.0, 11.0, 0.0, rasters(0)
   glBitmap 10, 12, 0.0, 0.0, 11.0, 0.0, rasters(0)
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   glOrtho 0, w, 0, h, -1.0, 1.0
   glMatrixMode %GL_MODELVIEW

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  RGBA display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:36 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  fog.c
' *  This program draws 5 red spheres, each at a different
' *  z distance from the eye, in different types of fog.
' *  Pressing the f key chooses between 3 types of
' *  fog:  exponential, exponential squared, and linear.
' *  In this program, there is a fixed density value, as well
' *  as fixed start and end values for the linear fog.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "fog"

GLOBAL fogMode AS LONG

' ========================================================================================
SUB Init ()

   DIM position(3) AS SINGLE
   DIM matx(2) AS SINGLE
   DIM fogColor(3) AS SINGLE

   ARRAY ASSIGN position() = 0.5, 0.5, 3.0, 0.0

   glEnable %GL_DEPTH_TEST

   glLightfv %GL_LIGHT0, %GL_POSITION, position(0)
   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0
      ARRAY ASSIGN matx() = 0.1745, 0.01175, 0.01175
      glMaterialfv %GL_FRONT, %GL_AMBIENT, matx(0)
      matx(0) = 0.61424 : matx(1) = 0.04136 : matx(2) = 0.04136
      glMaterialfv %GL_FRONT, %GL_DIFFUSE, matx(0)
      matx(0) = 0.727811 : matx(1) = 0.626959 : matx(2) = 0.626959
      glMaterialfv %GL_FRONT, %GL_SPECULAR, matx(0)
      glMaterialf %GL_FRONT, %GL_SHININESS, 0.6 * 128.0

   glEnable %GL_FOG
      ARRAY ASSIGN fogColor() = 0.5, 0.5, 0.5, 1.0

      fogMode = %GL_EXP
      glFogi %GL_FOG_MODE, fogMode
      glFogfv %GL_FOG_COLOR, fogColor(0)
      glFogf %GL_FOG_DENSITY, 0.35
      glHint %GL_FOG_HINT, %GL_DONT_CARE
      glFogf %GL_FOG_START, 1.0
      glFogf %GL_FOG_END, 5.0

   glClearColor 0.5, 0.5, 0.5, 1.0  ' /* fog color */

END SUB
' ========================================================================================

' ========================================================================================
SUB renderSphere (BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE)

   glPushMatrix
   glTranslatef x, y, z
   glutSolidSphere 0.4, 16, 16
   glPopMatrix

END SUB
' ========================================================================================

' ========================================================================================
'/* Draws 5 spheres at different z positions.
' */
' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   renderSphere -2.0, -0.5, -1.0
   renderSphere -1.0, -0.5, -2.0
   renderSphere  0.0, -0.5, -3.0
   renderSphere  1.0, -0.5, -4.0
   renderSphere  2.0, -0.5, -5.0
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -2.5, 2.5, -2.5 * h / w, _
         2.5 * h / w, -10.0, 10.0
   ELSE
      glOrtho -2.5 * w / h, _
         2.5 * w / h, -2.5, 2.5, -10.0, 10.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
      CASE ASC("f"), ASC("F")
         IF fogMode = %GL_EXP THEN
            fogMode = %GL_EXP2
         ELSEIF fogMode = %GL_EXP2 THEN
            fogMode = %GL_LINEAR
         ELSEIF fogMode = %GL_LINEAR THEN
            fogMode = %GL_EXP
         END IF
         glFogi %GL_FOG_MODE, fogMode
         glutPostRedisplay
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  RGBA display mode, depth buffer, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:37 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' * hello.c
' * This is a simple, introductory OpenGL program.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

' ========================================================================================
SUB DisplayProc CDECL ()

   ' /* clear all pixels  */
   glClear %GL_COLOR_BUFFER_BIT

   '/* draw white polygon (rectangle) with corners at
   ' * (0.25, 0.25, 0.0) and (0.75, 0.75, 0.0)
   ' */
   glColor3f 1.0, 1.0, 1.0
   glBegin %GL_POLYGON
      glVertex3f 0.25, 0.25, 0.0
      glVertex3f 0.75, 0.25, 0.0
      glVertex3f 0.75, 0.75, 0.0
      glVertex3f 0.25, 0.75, 0.0
   glEnd

   '/* don't wait
   ' * start processing buffered OpenGL routines
   ' */
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
SUB Init ()

   ' /* select clearing color 	*/
   glClearColor 0.0, 0.0, 0.0, 0.0

   ' /* initialize viewing values  */
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   glOrtho 0.0, 1.0, 0.0, 1.0, -1.0, 1.0

END SUB
' ========================================================================================

' ========================================================================================
'/*
' * Declare initial window size, position, and display mode
' * (single buffer and RGBA).  Open window with "hello"
' * in its title bar.  Call initialization routines.
' * Register callback function to display graphics.
' * Enter main loop and process events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow "hello"
   Init
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:38 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  light.c
' *  This program demonstrates the use of the OpenGL lighting
' *  model.  A sphere is drawn using a grey material characteristic.
' *  A single light source illuminates the object.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "light"

' ========================================================================================
'/*  Initialize material property, light source, lighting model,
' *  and depth buffer.
' */
' ========================================================================================
SUB Init ()

   DIM mat_specular(3) AS SINGLE
   DIM mat_shininess(0) AS SINGLE
   DIM light_position(3) AS SINGLE

   ARRAY ASSIGN mat_specular()   = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN mat_shininess()  = 50.0
   ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_SMOOTH

   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
   glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)

   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0
   glEnable %GL_DEPTH_TEST

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   glutSolidSphere 1.0, 20, 16
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= h THEN
      glOrtho -1.5, 1.5, -1.5 * h / w, _
         1.5 * h / w, -10.0, 10.0
   ELSE
      glOrtho -1.5 * w / h, _
         1.5 * w / h, -1.5, 1.5, -10.0, 10.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:39 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' *  lines.c
' *  This program demonstrates geometric primitives and
' *  their attributes.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "lines"

MACRO drawOneLine(x1,y1,x2,y2)
   glBegin %GL_LINES
   glVertex2f x1, y1
   glVertex2f x2, y2
   glEnd
END MACRO

' ========================================================================================
SUB Init ()

   glClearColor 0.0, 0.0, 0.0, 0.0
   glShadeModel %GL_FLAT

END SUB
' ========================================================================================

' ========================================================================================
SUB DisplayProc CDECL ()

   LOCAL i AS LONG

   glClear %GL_COLOR_BUFFER_BIT

   ' /* select white for all lines  */
   glColor3f 1.0, 1.0, 1.0

   ' /* in 1st row, 3 lines, each with a different stipple  */
   glEnable %GL_LINE_STIPPLE

   glLineStipple 1, &H0101  ' /*  dotted  */
   drawOneLine(50.0, 125.0, 150.0, 125.0)
   glLineStipple 1, &H00FF  ' /*  dashed  */
   drawOneLine(150.0, 125.0, 250.0, 125.0)
   glLineStipple 1, &H1C47  ' /*  dash/dot/dash  */
   drawOneLine(250.0, 125.0, 350.0, 125.0)

   ' /* in 2nd row, 3 wide lines, each with different stipple */
   glLineWidth 5.0
   glLineStipple 1, &H0101  ' /*  dotted  */
   drawOneLine(50.0, 100.0, 150.0, 100.0)
   glLineStipple 1, &H00FF  ' /*  dashed  */
   drawOneLine(150.0, 100.0, 250.0, 100.0)
   glLineStipple 1, &H1C47  ' /*  dash/dot/dash  */
   drawOneLine(250.0, 100.0, 350.0, 100.0)
   glLineWidth 1.0

   '/* in 3rd row, 6 lines, with dash/dot/dash stipple  */
   '/* as part of a single connected line strip         */
   glLineStipple 1, &H1C47  ' /*  dash/dot/dash  */
   glBegin %GL_LINE_STRIP
   FOR i = 0 TO 6
      glVertex2f 50.0 + (i * 50.0), 75.0
   NEXT
   glEnd

   ' /* in 4th row, 6 independent lines with same stipple  */
   FOR i = 0 TO 5
      drawOneLine(50.0 + (i * 50.0), 50.0, _
         50.0 + ((i + 1) * 50.0), 50.0)
   NEXT

   '/* in 5th row, 1 line, with dash/dot/dash stipple    */
   '/* and a stipple repeat factor of 5                  */
   glLineStipple 5, &H1C47  ' /*  dash/dot/dash  */
   drawOneLine(50.0, 25.0, 350.0, 25.0)

   glDisable %GL_LINE_STIPPLE
   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   gluOrtho2D 0.0, w, 0.0, h

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

**José Roca** · 4 Feb 2013, 02:40 PM

Code:

'/*
' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
' * ALL RIGHTS RESERVED
' * Permission to use, copy, modify, and distribute this software for
' * any purpose and without fee is hereby granted, provided that the above
' * copyright notice appear in all copies and that both the copyright notice
' * and this permission notice appear in supporting documentation, and that
' * the name of Silicon Graphics, Inc. not be used in advertising
' * or publicity pertaining to distribution of the software without specific,
' * written prior permission.
' *
' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
' *
' * US Government Users Restricted Rights
' * Use, duplication, or disclosure by the Government is subject to
' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
' * clause at DFARS 252.227-7013 and/or in similar or successor
' * clauses in the FAR or the DOD or NASA FAR Supplement.
' * Unpublished-- rights reserved under the copyright laws of the
' * United States.  Contractor/manufacturer is Silicon Graphics,
' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
' *
' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
' */

'/*
' * material.c
' * This program demonstrates the use of the GL lighting model.
' * Several objects are drawn using different material characteristics.
' * A single light source illuminates the objects.
' */

' Translated and adapted to PowerBASIC by José Roca, 2007

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"

$WindowCaption = "material"

GLOBAL listName AS DWORD

' ========================================================================================
'/*  Initialize z-buffer, projection matrix, light source,
' *  and lighting model.  Do not specify a material property here.
' */
' ========================================================================================
SUB Init ()

   DIM ambient(3) AS SINGLE
   DIM diffuse(3) AS SINGLE
   DIM specular(3) AS SINGLE
   DIM position(3) AS SINGLE
   DIM lmodel_ambient(3) AS SINGLE
   DIM local_view(0) AS SINGLE

   ARRAY ASSIGN ambient() = 0.0, 0.0, 0.0, 1.0
   ARRAY ASSIGN diffuse() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN position() = 0.0, 3.0, 2.0, 0.0
   ARRAY ASSIGN lmodel_ambient() = 0.4, 0.4, 0.4, 1.0
   ARRAY ASSIGN local_view() = 0.0

   glClearColor 0.0, 0.1, 0.1, 0.0
   glEnable %GL_DEPTH_TEST
   glShadeModel %GL_SMOOTH

   glLightfv %GL_LIGHT0, %GL_AMBIENT, ambient(0)
   glLightfv %GL_LIGHT0, %GL_DIFFUSE, diffuse(0)
   glLightfv %GL_LIGHT0, %GL_POSITION, position(0)
   glLightModelfv %GL_LIGHT_MODEL_AMBIENT, lmodel_ambient(0)
   glLightModelfv %GL_LIGHT_MODEL_LOCAL_VIEWER, local_view(0)

   glEnable %GL_LIGHTING
   glEnable %GL_LIGHT0

END SUB
' ========================================================================================

' ========================================================================================
'/*  Draw twelve spheres in 3 rows with 4 columns.
' *  The spheres in the first row have materials with no ambient reflection.
' *  The second row has materials with significant ambient reflection.
' *  The third row has materials with colored ambient reflection.
' *
' *  The first column has materials with blue, diffuse reflection only.
' *  The second column has blue diffuse reflection, as well as specular
' *  reflection with a low shininess exponent.
' *  The third column has blue diffuse reflection, as well as specular
' *  reflection with a high shininess exponent (a more concentrated highlight).
' *  The fourth column has materials which also include an emissive component.
' *
' *  glTranslatef() is used to move spheres to their appropriate locations.
' */
' ========================================================================================
SUB DisplayProc CDECL ()

   DIM no_mat(3) AS SINGLE
   DIM mat_ambient(3) AS SINGLE
   DIM mat_ambient_color(3) AS SINGLE
   DIM mat_diffuse(3) AS SINGLE
   DIM mat_specular(3) AS SINGLE
   DIM no_shininess(0) AS SINGLE
   DIM low_shininess(0) AS SINGLE
   DIM high_shininess(0) AS SINGLE
   DIM mat_emission(3) AS SINGLE

   ARRAY ASSIGN no_mat() = 0.0, 0.0, 0.0, 1.0
   ARRAY ASSIGN mat_ambient() = 0.7, 0.7, 0.7, 1.0
   ARRAY ASSIGN mat_ambient_color() = 0.8, 0.8, 0.2, 1.0
   ARRAY ASSIGN mat_diffuse() = 0.1, 0.5, 0.8, 1.0
   ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
   ARRAY ASSIGN no_shininess() = 0.0
   ARRAY ASSIGN low_shininess() = 5.0
   ARRAY ASSIGN high_shininess() = 100.0
   ARRAY ASSIGN mat_emission() = 0.3, 0.2, 0.2, 0.0

   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT

   '/*  draw sphere in first row, first column
   ' *  diffuse reflection only; no ambient or specular
   ' */
   glPushMatrix
   glTranslatef -3.75, 3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in first row, second column
   ' *  diffuse and specular reflection; low shininess; no ambient
   ' */
   glPushMatrix
   glTranslatef -1.25, 3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, low_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in first row, third column
   ' *  diffuse and specular reflection; high shininess; no ambient
   ' */
   glPushMatrix
   glTranslatef 1.25, 3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, high_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in first row, fourth column
   ' *  diffuse reflection; emission; no ambient or specular reflection
   ' */
   glPushMatrix
   glTranslatef 3.75, 3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in second row, first column
   ' *  ambient and diffuse reflection; no specular
   ' */
   glPushMatrix
   glTranslatef -3.75, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in second row, second column
   ' *  ambient, diffuse and specular reflection; low shininess
   ' */
   glPushMatrix
   glTranslatef -1.25, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, low_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in second row, third column
   ' *  ambient, diffuse and specular reflection; high shininess
   ' */
   glPushMatrix
   glTranslatef 1.25, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, high_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in second row, fourth column
   ' *  ambient and diffuse reflection; emission; no specular
   ' */
   glPushMatrix
   glTranslatef 3.75, 0.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in third row, first column
   ' *  colored ambient and diffuse reflection; no specular
   ' */
   glPushMatrix
   glTranslatef -3.75, -3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in third row, second column
   ' *  colored ambient, diffuse and specular reflection; low shininess
   ' */
   glPushMatrix
   glTranslatef -1.25, -3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, low_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in third row, third column
   ' *  colored ambient, diffuse and specular reflection; high shininess
   ' */
   glPushMatrix
   glTranslatef 1.25, -3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, high_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   '/*  draw sphere in third row, fourth column
   ' *  colored ambient and diffuse reflection; emission; no specular
   ' */
   glPushMatrix
   glTranslatef 3.75, -3.0, 0.0
   glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
   glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
   glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
   glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
   glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
   glutSolidSphere 1.0, 16, 16
   glPopMatrix

   glFlush

END SUB
' ========================================================================================

' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)

   glViewport 0, 0, w, h
   glMatrixMode %GL_PROJECTION
   glLoadIdentity
   IF w <= (h * 2) THEN
      glOrtho -6.0, 6.0, -3.0 * (h * 2) / w, _
         3.0 * (h * 2) / w, -10.0, 10.0
   ELSE
      glOrtho -6.0 * w / (h * 2), _
         6.0 * w / (h * 2), -3.0, 3.0, -10.0, 10.0
   END IF
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

END SUB
' ========================================================================================

' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS  LONG) AS LONG

   SELECT CASE nKey
      CASE 27   ' Escape Key
         glutLeaveMainLoop
   END SELECT

END FUNCTION
' ========================================================================================

' ========================================================================================
'/*  Main Loop
' *  Open window with initial window size, title bar,
' *  RGBA display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   GlutInit 1, " "   ' We need at least one character or it will GPF
   glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB OR %GLUT_DEPTH
   glutInitWindowSize 640, 480
   glutInitWindowPosition 0, 0
   glutCreateWindow $WindowCaption
   Init
   glutReshapeFunc  CODEPTR(ReshapeProc)
   glutKeyboardFunc CODEPTR(KeyboardProc)
   glutDisplayFunc  CODEPTR(DisplayProc)
   glutMainLoop

END FUNCTION
' ========================================================================================

Attached Files

Announcement

freeglut 2.8.0 Headers

freeglut 2.8.0 Headers

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment