freeglut 2.8.0 Headers

José Roca · #1 Apr 23rd, 2012, 07:02 AM

freeglut is a completely OpenSourced alternative to the OpenGL Utility Toolkit (GLUT) library. GLUT was originally written by Mark Kilgard to support the sample programs in the second edition OpenGL 'RedBook'. Since then, GLUT has been used in a wide variety of practical applications because it is simple, widely available and highly portable.

GLUT (and hence freeglut) allows the user to create and manage windows containing OpenGL contexts on a wide range of platforms and also read the mouse, keyboard and joystick functions.

freeglut is released under the X-Consortium license.

Website: http://freeglut.sourceforge.net/

Windows binaries: http://www.transmissionzero.co.uk/so...reeglut-devel/

José Roca · #2 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #3 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #4 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #5 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #6 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #7 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #8 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #9 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #10 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #11 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #12 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #13 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #14 Feb 4th, 2013, 03: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
' ========================================================================================

José Roca · #15 Feb 4th, 2013, 03: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
' ========================================================================================

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode