From: anon@att.net
Subject: Example GNAT Ada program for openGl
Date: Sun, 11 Jul 2010 04:22:41 +0000 (UTC)
Date: 2010-07-11T04:22:41+00:00 [thread overview]
Message-ID: <i1bgud$dab$1@news.ett.com.ua> (raw)
-- This program was converted from a C openGL sample program. June 2009
-- No comment because my "C to A" converter does not create comments
-- But it should be easy to understand what going on.
--
-- System: One program file and a single support package (2files)
-- Requires: GNAT, adaopengl, openGL engine
--
-- Spec
--
with openGL ;
with openGL.GLu ;
with openGL.GLut ;
use openGL ;
use openGL.GLu ;
use openGL.GLut ;
package Bitmap_Sub is
DoubleBuffer : Boolean := False ;
type RGB_ARRAY is array ( Natural range <>,
Natural range <> ) of aliased GLfloat ;
RGBMap : RGB_ARRAY := ( ( 0.0, 0.0, 0.0 ),
( 1.0, 0.0, 0.0 ),
( 0.0, 1.0, 0.0 ),
( 1.0, 1.0, 0.0 ),
( 0.0, 0.0, 1.0 ),
( 1.0, 0.0, 1.0 ),
( 0.0, 1.0, 1.0 ),
( 1.0, 1.0, 1.0 ),
( 0.5, 0.5, 0.5 )
) ;
End_Error : exception ;
-- ------------------------------------------------------------------------ --
procedure Reshape ( width : GLint ;
height : GLint ) ;
procedure key ( key_value : GLubyte ;
x : Integer ;
y : Integer ) ;
procedure Draw ;
end Bitmap_Sub ;
--
-- Body
--
with Interfaces.C ;
with Interfaces.C.Strings ;
with openGL ;
with openGL.GLu ;
with openGL.GLut ;
use Interfaces.C ;
use Interfaces.C.Strings ;
use openGL ;
use openGL.GLu ;
use openGL.GLut ;
package body Bitmap_Sub is
type GLubyte_Array is array ( Natural range <> ) of GLubyte ;
type GLfloat_Array is array ( Natural range <> ) of aliased GLfloat ;
OPENGL_WIDTH : constant := 24.0 ;
OPENGL_HEIGHT : constant := 13.0 ;
boxA_Ary : GLfloat_Array := ( 0.0, 0.0, 0.0 ) ;
boxB_Ary : GLfloat_Array := ( -100.0, 0.0, 0.0 ) ;
boxC_Ary : GLfloat_Array := ( 100.0, 0.0, 0.0 ) ;
boxD_Ary : GLfloat_Array := ( 0.0, 95.0, 0.0 ) ;
boxE_Ary : GLfloat_Array := ( 0.0, -105.0, 0.0 ) ;
boxA : GLfloatPtr := boxA_Ary ( 0 )'Access ;
boxB : GLfloatPtr := boxB_Ary ( 0 )'Access ;
boxC : GLfloatPtr := boxC_Ary ( 0 )'Access ;
boxD : GLfloatPtr := boxD_Ary ( 0 )'Access ;
boxE : GLfloatPtr := boxE_Ary ( 0 )'Access ;
OpenGL_bits1_Ary : aliased char_array := ( char'val ( 16#00# ),
char'val ( 16#03# ),
char'val ( 16#00# ),
char'val ( 16#7f# ),
char'val ( 16#fb# ),
char'val ( 16#ff# ),
char'val ( 16#7f# ),
char'val ( 16#fb# ),
char'val ( 16#ff# ),
char'val ( 16#00# ),
char'val ( 16#03# ),
char'val ( 16#00# ),
char'val ( 16#3e# ),
char'val ( 16#8f# ),
char'val ( 16#b7# ),
char'val ( 16#63# ),
char'val ( 16#db# ),
char'val ( 16#b0# ),
char'val ( 16#63# ),
char'val ( 16#db# ),
char'val ( 16#b7# ),
char'val ( 16#63# ),
char'val ( 16#db# ),
char'val ( 16#b6# ),
char'val ( 16#63# ),
char'val ( 16#8f# ),
char'val ( 16#f3# ),
char'val ( 16#63# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#63# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#63# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#3e# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#00# )
) ;
OpenGL_bits1 : GLubytePtr :=
To_Chars_Ptr ( OpenGL_bits1_Ary'Access ) ;
OpenGL_bits2_Ary : aliased char_array := ( char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#ff# ),
char'val ( 16#ff# ),
char'val ( 16#01# ),
char'val ( 16#ff# ),
char'val ( 16#ff# ),
char'val ( 16#01# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#f9# ),
char'val ( 16#fc# ),
char'val ( 16#01# ),
char'val ( 16#8d# ),
char'val ( 16#0d# ),
char'val ( 16#00# ),
char'val ( 16#8d# ),
char'val ( 16#0d# ),
char'val ( 16#00# ),
char'val ( 16#8d# ),
char'val ( 16#0d# ),
char'val ( 16#00# ),
char'val ( 16#cc# ),
char'val ( 16#0d# ),
char'val ( 16#00# ),
char'val ( 16#0c# ),
char'val ( 16#4c# ),
char'val ( 16#0a# ),
char'val ( 16#0c# ),
char'val ( 16#4c# ),
char'val ( 16#0e# ),
char'val ( 16#8c# ),
char'val ( 16#ed# ),
char'val ( 16#0e# ),
char'val ( 16#f8# ),
char'val ( 16#0c# ),
char'val ( 16#00# ),
char'val ( 16#00# )
) ;
OpenGL_bits2 : GLubytePtr :=
To_Chars_Ptr ( OpenGL_bits2_Ary'Access ) ;
logo_bits_Ary : aliased char_array := ( char'val ( 16#00# ),
char'val ( 16#66# ),
char'val ( 16#66# ),
char'val ( 16#ff# ),
char'val ( 16#66# ),
char'val ( 16#66# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#ff# ),
char'val ( 16#3c# ),
char'val ( 16#3c# ),
char'val ( 16#00# ),
char'val ( 16#42# ),
char'val ( 16#40# ),
char'val ( 16#ff# ),
char'val ( 16#42# ),
char'val ( 16#40# ),
char'val ( 16#00# ),
char'val ( 16#41# ),
char'val ( 16#40# ),
char'val ( 16#ff# ),
char'val ( 16#21# ),
char'val ( 16#20# ),
char'val ( 16#00# ),
char'val ( 16#2f# ),
char'val ( 16#20# ),
char'val ( 16#ff# ),
char'val ( 16#20# ),
char'val ( 16#20# ),
char'val ( 16#00# ),
char'val ( 16#10# ),
char'val ( 16#90# ),
char'val ( 16#ff# ),
char'val ( 16#10# ),
char'val ( 16#90# ),
char'val ( 16#00# ),
char'val ( 16#0f# ),
char'val ( 16#10# ),
char'val ( 16#ff# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#00# ),
char'val ( 16#66# ),
char'val ( 16#66# ),
char'val ( 16#ff# ),
char'val ( 16#66# ),
char'val ( 16#66# ),
char'val ( 16#00# )
) ;
logo_bits : GLubytePtr := To_Chars_Ptr ( logo_bits_Ary'Access ) ;
COLOR_BLACK : constant := 0 ;
COLOR_RED : constant := 1 ;
COLOR_GREEN : constant := 2 ;
COLOR_YELLOW : constant := 3 ;
COLOR_BLUE : constant := 4 ;
COLOR_MAGENTA : constant := 5 ;
COLOR_CYAN : constant := 6 ;
COLOR_WHITE : constant := 7 ;
-- ------------------------------------------------------------------------ --
procedure Reshape ( width : GLint ;
height : GLint ) is
begin
glViewport ( 0, 0, width, height ) ;
glMatrixMode ( GL_PROJECTION ) ;
glLoadIdentity ;
gluOrtho2D ( -175.0, 175.0, -175.0, 175.0 ) ;
glMatrixMode ( GL_MODELVIEW ) ;
end Reshape ;
procedure key ( key_value : GLubyte ;
x : Integer ;
y : Integer ) is
begin
case key_value is
when 16#27# =>
raise End_Error ;
when others =>
null ;
end case ;
end key ;
procedure Draw is
procedure SetColor ( C : Natural ) is
begin
if glutGet ( GLUT_WINDOW_RGBA ) = GL_TRUE then
glColor3fv ( RGBMap ( C, 0 )'Access ) ;
else
-- glIndexf ( GLfloat ( C ) ) ;
glIndexi ( C ) ;
end if ;
end SetColor ;
procedure Draw_Bits ( Color : Natural ;
box : GLfloatPtr ) is
begin
SetColor ( Color ) ;
glRasterPos3fv ( box ) ;
glBitmap ( GLsizei ( OPENGL_WIDTH ),
GLsizei ( OPENGL_HEIGHT ),
OPENGL_WIDTH, 0.0,
OPENGL_WIDTH, 0.0,
OpenGL_bits1 ) ;
glBitmap ( GLsizei ( OPENGL_WIDTH ),
GLsizei ( OPENGL_HEIGHT ),
OPENGL_WIDTH, 0.0,
OPENGL_WIDTH, 0.0,
OpenGL_bits2 ) ;
end Draw_Bits ;
mapI : GLfloat_Array := ( 0.0, 1.0 ) ;
mapIR : GLfloat_Array := ( 0.0, 0.0 ) ;
mapIA : GLfloat_Array := ( 1.0, 1.0 ) ;
begin
glClear ( GL_COLOR_BUFFER_BIT ) ;
glPixelMapfv ( GL_PIXEL_MAP_I_TO_R, 2,
mapIR ( 0 )'Unchecked_Access ) ;
glPixelMapfv ( GL_PIXEL_MAP_I_TO_G, 2,
mapI ( 0 )'Unchecked_Access ) ;
glPixelMapfv ( GL_PIXEL_MAP_I_TO_B, 2,
mapI ( 0 )'Unchecked_Access ) ;
glPixelMapfv ( GL_PIXEL_MAP_I_TO_A, 2,
mapIA ( 0 )'Unchecked_Access ) ;
glPixelTransferi ( GL_MAP_COLOR, GL_TRUE);
-- SetColor ( COLOR_White ) ;
glRasterPos3fv ( boxA ) ;
glPixelStorei ( GL_UNPACK_ROW_LENGTH, 24 ) ;
glPixelStorei ( GL_UNPACK_SKIP_PIXELS, 8 ) ;
glPixelStorei ( GL_UNPACK_SKIP_ROWS, 2 ) ;
glPixelStorei ( GL_UNPACK_LSB_FIRST, GL_FALSE ) ;
glPixelStorei ( GL_UNPACK_ALIGNMENT, 1 ) ;
glBitmap ( 16, 12, 16.0, 0.0, 16.0, 0.0, logo_bits ) ;
glPixelStorei ( GL_UNPACK_ROW_LENGTH, 0 ) ;
glPixelStorei ( GL_UNPACK_SKIP_PIXELS, 0 ) ;
glPixelStorei ( GL_UNPACK_SKIP_ROWS, 0 ) ;
glPixelStorei ( GL_UNPACK_LSB_FIRST, GL_TRUE ) ;
glPixelStorei ( GL_UNPACK_ALIGNMENT, 1 ) ;
Draw_Bits ( COLOR_WHITE, boxB ) ;
Draw_Bits ( COLOR_YELLOW, boxC ) ;
Draw_Bits ( COLOR_CYAN, boxD ) ;
Draw_Bits ( COLOR_RED, boxE ) ;
glFlush ;
if DoubleBuffer then
glutSwapBuffers ;
end if ;
end Draw ;
end Bitmap_Sub ;
---
--- main body
---
with Ada.Command_Line ;
with Ada.Text_IO ;
with Interfaces.C ;
with Interfaces.C.Strings ;
with openGL ;
with openGL.GLu ;
with openGL.GLut ;
use openGL ;
use openGL.GLu ;
use openGL.GLut ;
with Bitmap_Sub ;
use Bitmap_Sub ;
procedure Bitmap is
windType : Interfaces.C.unsigned ;
RGB : Boolean := True ;
End_Error : exception ;
-- ------------------------------------------------------------------------ --
procedure Args is
use Ada.Command_Line ;
use Ada.Text_IO;
use Interfaces.C ;
begin
windType := GLUT_RGB or GLUT_SINGLE ;
for Index in 1..Argument_Count loop
if Argument ( Index ) = "-ci" then
RGB := False ;
windType := GLUT_INDEX ;
elsif Argument ( Index ) = "-rgb" then
RGB := True ;
windType := GLUT_RGB ;
elsif Argument ( Index ) = "-sb" then
DoubleBuffer := False ;
windType := windType or GLUT_SINGLE ;
elsif Argument ( Index ) = "-db" then
DoubleBuffer := True ;
windType := windType or GLUT_SINGLE ;
elsif Argument ( Index ) = "-?" then
Put_Line ( "Usage: bitmap2 [-ci|-rgb] [-sb|-db] [-?]" ) ;
raise End_Error ;
else
Put_Line ( "Illegal command line opion: " &
Argument ( Index ) ) ;
raise End_Error ;
end if ;
end loop ;
end Args ;
procedure InitMap is
begin
if not RGB then
for Index in 0..8 loop
glutSetColor ( Index, RGBMap ( Index, 0 ),
RGBMap ( Index, 1 ),
RGBMap ( Index, 2 ) ) ;
end loop ;
end if ;
end InitMap ;
procedure Init is
begin
glClearColor ( 0.0, 0.0, 0.0, 0.0 ) ;
glClearIndex ( 0.0 ) ;
end Init ;
-- ------------------------------------------------------------------------ --
argc : aliased Integer;
pragma Import ( C, argc, "gnat_argc" ) ;
argv : GLubytePtr ;
pragma Import ( C, argv, "gnat_argv" ) ;
use Ada.Text_IO;
use Interfaces.C.Strings ;
begin
Args ;
glutInit ( argc'Access, argv ) ;
glutInitDisplayMode ( windType ) ;
glutInitWindowPosition ( 0, 0 ) ;
glutInitWindowSize ( 300, 300 ) ;
if glutCreateWindow ( New_String ( "Bitmap" ) ) = GL_FALSE then
Put_Line ( "glutCreateWindow Error" ) ;
raise End_Error ;
end if ;
InitMap ;
Init ;
glutReshapeFunc ( Reshape'Access ) ;
glutKeyboardFunc ( Key'Access ) ;
glutDisplayFunc ( Draw'Access ) ;
glutMainLoop ;
exception
when End_Error =>
null ;
when others =>
null ;
end Bitmap ;
reply other threads:[~2010-07-11 4:22 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox