Tweet
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.
' */
'/*
' * model.c
' * This program demonstrates modeling transformations
' */
' Translated and adapted to PowerBASIC by José Roca, 2007
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "freeglut.inc"
$WindowCaption = "model"
' ========================================================================================
SUB Init ()
glClearColor 0.0, 0.0, 0.0, 0.0
glShadeModel %GL_FLAT
END SUB
' ========================================================================================
' ========================================================================================
SUB draw_triangle()
glBegin %GL_LINE_LOOP
glVertex2f 0.0, 25.0
glVertex2f 25.0, -25.0
glVertex2f -25.0, -25.0
glEnd
END SUB
' ========================================================================================
' ========================================================================================
SUB DisplayProc CDECL ()
glClear %GL_COLOR_BUFFER_BIT
glColor3f 1.0, 1.0, 1.0
glLoadIdentity
glColor3f 1.0, 1.0, 1.0
draw_triangle
glEnable %GL_LINE_STIPPLE
glLineStipple 1, &HF0F0
glLoadIdentity
glTranslatef -20.0, 0.0, 0.0
draw_triangle
glLineStipple 1, &HF00F
glLoadIdentity
glScalef 1.5, 0.5, 1.0
draw_triangle
glLineStipple 1, &H8888
glLoadIdentity
glRotatef 90.0, 0.0, 0.0, 1.0
draw_triangle
glDisable %GL_LINE_STIPPLE
glFlush
END SUB
' ========================================================================================
' ========================================================================================
' Redisplay callback procedure
' ========================================================================================
SUB ReshapeProc CDECL (BYVAL w AS LONG, BYVAL h AS LONG)
glViewport 0, 0, w, h
glMatrixMode %GL_PROJECTION
glLoadIdentity
IF w <= h THEN
glOrtho -50.0, 50.0, -50.0 * h / w, _
50.0 * h / w, -1.0, 1.0
ELSE
glOrtho -50.0 * w / h, _
50.0 * w / h, -50.0, 50.0, -1.0, 1.0
END IF
glMatrixMode %GL_MODELVIEW
END SUB
' ========================================================================================
' ========================================================================================
' Keyboard callback procedure
' ========================================================================================
FUNCTION KeyboardProc CDECL (BYVAL nKey AS BYTE, BYVAL x AS LONG, BYVAL y AS LONG) AS LONG
SELECT CASE nKey
CASE 27 ' Escape Key
glutLeaveMainLoop
END SELECT
END FUNCTION
' ========================================================================================
' ========================================================================================
'/* Main Loop
' * Open window with initial window size, title bar,
' * RGBA display mode, and handle input events.
' */
' ========================================================================================
FUNCTION PBMAIN () AS LONG
GlutInit 1, " " ' We need at least one character or it will GPF
glutInitDisplayMode %GLUT_SINGLE OR %GLUT_RGB
glutInitWindowSize 640, 480
glutInitWindowPosition 0, 0
glutCreateWindow $WindowCaption
Init
glutReshapeFunc CODEPTR(ReshapeProc)
glutKeyboardFunc CODEPTR(KeyboardProc)
glutDisplayFunc CODEPTR(DisplayProc)
glutMainLoop
END FUNCTION
' ========================================================================================
Attached Files
Comment