~hwkrus/f03gl/trunk : revision 56

1

MODULE OpenGL_glut

2

3

! Derived from ../FreeGLUT.h using

4

! ../h_interfaces.pl -v --bozinit --scalar -i ../FreeGLUT.h

5

2

6

USE OpenGL_kinds

3

7

IMPLICIT NONE

4

8

PRIVATE

15

19

! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN

16

20

! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

17

21

22

!

23

! version: Ubuntu 11.04 Raring: 2.6.0-4ubuntu1

24

!

18

25

19

26

! freeglut_std.h

20

27

!

42

49

! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

43

50

44

51

52

! Under windows, we have to differentiate between static and dynamic libraries

53

! Discussion by FreeGLUT developers suggests that

54

! Visual C++ specific code involving pragmas may

55

! need to move to a separate header. 24th Dec 2003

56

57

! pragmas or to 1 to exclude library pragmas.

58

! The default behavior depends on the compiler/platform.

59

60

61

! Windows static library

62

63

64

65

! Windows shared library (DLL)

66

67

68

69

70

71

! Drag in other Windows libraries as required by FreeGLUT

72

73

45

74

! Non-Windows definition of FGAPI and FGAPIENTRY

46

75

76

47

77

! The freeglut and GLUT API versions

48

78

INTEGER(GLenum), PARAMETER, PUBLIC :: FREEGLUT = 1

49

79

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_API_VERSION = 4

50

80

INTEGER(GLenum), PARAMETER, PUBLIC :: FREEGLUT_VERSION_2_0 = 1

51

81

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_XLIB_IMPLEMENTATION = 13

52

82

83

! Always include OpenGL and GLU headers

84

53

85

! GLUT API macro definitions -- the special key codes:

54

86

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_KEY_F1 = z'0001'

55

87

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_KEY_F2 = z'0002'

109

141

! GLUT API macro definitions -- fonts definitions

110

142

!

111

143

! Steve Baker suggested to make it binary compatible with GLUT:

112

! /*

113

! I don't really know if it's a good idea... But here it goes:

114

144

115

! Those pointers will be used by following definitions:

116

145

117

146

! GLUT API macro definitions -- the glutGet parameters

118

147

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_WINDOW_X = z'0064'

152

181

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_DISPLAY_MODE = z'01F8'

153

182

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_ELAPSED_TIME = z'02BC'

154

183

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_WINDOW_FORMAT_ID = z'007B'

155

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_STATE = z'007C'

156

184

157

185

! GLUT API macro definitions -- the glutDeviceGet parameters

158

186

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_HAS_KEYBOARD = z'0258'

298

326

INTERFACE

299

327

SUBROUTINE glutInitDisplayString(displayMode) BIND(C,NAME="glutInitDisplayString")

300

328

IMPORT

301

! CHARACTER, INTENT(IN) :: displayMode

329

! CHARACTER(C_CHAR), INTENT(IN) :: displayMode

302

330

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: displayMode

303

331

END SUBROUTINE glutInitDisplayString

304

332

END INTERFACE

321

349

FUNCTION glutCreateWindow(title) BIND(C,NAME="glutCreateWindow")

322

350

IMPORT

323

351

INTEGER(GLint) :: glutCreateWindow

324

! CHARACTER, INTENT(IN) :: title

352

! CHARACTER(C_CHAR), INTENT(IN) :: title

325

353

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: title

326

354

END FUNCTION glutCreateWindow

327

355

END INTERFACE

368

396

INTERFACE

369

397

SUBROUTINE glutSetWindowTitle(title) BIND(C,NAME="glutSetWindowTitle")

370

398

IMPORT

371

! CHARACTER, INTENT(IN) :: title

399

! CHARACTER(C_CHAR), INTENT(IN) :: title

372

400

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: title

373

401

END SUBROUTINE glutSetWindowTitle

374

402

END INTERFACE

378

406

INTERFACE

379

407

SUBROUTINE glutSetIconTitle(title) BIND(C,NAME="glutSetIconTitle")

380

408

IMPORT

381

! CHARACTER, INTENT(IN) :: title

409

! CHARACTER(C_CHAR), INTENT(IN) :: title

382

410

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: title

383

411

END SUBROUTINE glutSetIconTitle

384

412

END INTERFACE

606

634

INTERFACE

607

635

SUBROUTINE glutAddMenuEntry(label, value) BIND(C,NAME="glutAddMenuEntry")

608

636

IMPORT

609

! CHARACTER, INTENT(IN) :: label

637

! CHARACTER(C_CHAR), INTENT(IN) :: label

610

638

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: label

611

639

INTEGER(GLint), VALUE :: value

612

640

END SUBROUTINE glutAddMenuEntry

617

645

INTERFACE

618

646

SUBROUTINE glutAddSubMenu(label, subMenu) BIND(C,NAME="glutAddSubMenu")

619

647

IMPORT

620

! CHARACTER, INTENT(IN) :: label

648

! CHARACTER(C_CHAR), INTENT(IN) :: label

621

649

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: label

622

650

INTEGER(GLint), VALUE :: subMenu

623

651

END SUBROUTINE glutAddSubMenu

628

656

INTERFACE

629

657

SUBROUTINE glutChangeToMenuEntry(item, label, value) BIND(C,NAME="glutChangeToMenuEntry")

630

658

IMPORT

631

! CHARACTER, INTENT(IN) :: label

659

! CHARACTER(C_CHAR), INTENT(IN) :: label

632

660

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: label

633

661

INTEGER(GLint), VALUE :: item, value

634

662

END SUBROUTINE glutChangeToMenuEntry

639

667

INTERFACE

640

668

SUBROUTINE glutChangeToSubMenu(item, label, value) BIND(C,NAME="glutChangeToSubMenu")

641

669

IMPORT

642

! CHARACTER, INTENT(IN) :: label

670

! CHARACTER(C_CHAR), INTENT(IN) :: label

643

671

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: label

644

672

INTEGER(GLint), VALUE :: item, value

645

673

END SUBROUTINE glutChangeToSubMenu

1098

1126

IMPORT

1099

1127

INTEGER(GLint) :: glutBitmapLength

1100

1128

! CHARACTER, INTENT(IN) :: string

1101

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: string

1129

CHARACTER, DIMENSION(*), INTENT(IN) :: string

1102

1130

TYPE(C_PTR), VALUE :: font

1103

1131

END FUNCTION glutBitmapLength

1104

1132

END INTERFACE

1110

1138

IMPORT

1111

1139

INTEGER(GLint) :: glutStrokeLength

1112

1140

! CHARACTER, INTENT(IN) :: string

1113

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: string

1141

CHARACTER, DIMENSION(*), INTENT(IN) :: string

1114

1142

TYPE(C_PTR), VALUE :: font

1115

1143

END FUNCTION glutStrokeLength

1116

1144

END INTERFACE

1287

1315

INTERFACE

1288

1316

SUBROUTINE glutGameModeString(string) BIND(C,NAME="glutGameModeString")

1289

1317

IMPORT

1290

! CHARACTER, INTENT(IN) :: string

1318

! CHARACTER(C_CHAR), INTENT(IN) :: string

1291

1319

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: string

1292

1320

END SUBROUTINE glutGameModeString

1293

1321

END INTERFACE

1432

1460

FUNCTION glutExtensionSupported(extension) BIND(C,NAME="glutExtensionSupported")

1433

1461

IMPORT

1434

1462

INTEGER(GLint) :: glutExtensionSupported

1435

! CHARACTER, INTENT(IN) :: extension

1463

! CHARACTER(C_CHAR), INTENT(IN) :: extension

1436

1464

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: extension

1437

1465

END FUNCTION glutExtensionSupported

1438

1466

END INTERFACE

1446

1474

END INTERFACE

1447

1475

1448

1476

1477

!

1478

! Win32 has an annoying issue where there are multiple C run-time

1479

! libraries (CRTs). If the executable is linked with a different CRT

1480

! from the GLUT DLL, the GLUT DLL will not share the same CRT static

1481

! data seen by the executable. In particular, atexit callbacks registered

1482

! in the executable will not be called if GLUT calls its (different)

1483

! exit routine). GLUT is typically built with the

1484

! "/MD" option (the CRT with multithreading DLL support), but the Visual

1485

! C++ linker default is "/ML" (the single threaded CRT).

1486

!

1487

! One workaround to this issue is requiring users to always link with

1488

! the same CRT as GLUT is compiled with. That requires users supply a

1489

! non-standard option. GLUT 3.7 has its own built-in workaround where

1490

! the executable's "exit" function pointer is covertly passed to GLUT.

1491

! GLUT then calls the executable's exit function pointer to ensure that

1492

! any "atexit" calls registered by the application are called if GLUT

1493

! needs to exit.

1494

!

1495

! Note that the __glut*WithExit routines should NEVER be called directly.

1496

1497

! to get the prototype for exit()

1498

1499

! void __glutInitWithExit(int *argcp, char **argv, void (__cdecl *exitfunc)(int))

1500

PUBLIC __glutInitWithExit

1501

INTERFACE

1502

SUBROUTINE __glutInitWithExit(argcp, argv, exitfunc) BIND(C,NAME="__glutInitWithExit")

1503

IMPORT

1504

! INTEGER(GLint), DIMENSION(*) :: argcp

1505

INTEGER(GLint) :: argcp

1506

TYPE(C_PTR), INTENT(IN) :: argv

1507

! void exitfunc(int)

1508

INTERFACE

1509

SUBROUTINE exitfunc(arg1) BIND(C)

1510

IMPORT

1511

INTEGER(GLint), VALUE :: arg1

1512

END SUBROUTINE exitfunc

1513

END INTERFACE

1514

END SUBROUTINE __glutInitWithExit

1515

END INTERFACE

1516

1517

! int __glutCreateWindowWithExit(const char *title, void (__cdecl *exitfunc)(int))

1518

PUBLIC __glutCreateWindowWithExit

1519

INTERFACE

1520

FUNCTION __glutCreateWindowWithExit(title, exitfunc) BIND(C,NAME="__glutCreateWindowWithExit")

1521

IMPORT

1522

INTEGER(GLint) :: __glutCreateWindowWithExit

1523

! CHARACTER(C_CHAR), INTENT(IN) :: title

1524

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: title

1525

! void exitfunc(int)

1526

INTERFACE

1527

SUBROUTINE exitfunc(arg1) BIND(C)

1528

IMPORT

1529

INTEGER(GLint), VALUE :: arg1

1530

END SUBROUTINE exitfunc

1531

END INTERFACE

1532

END FUNCTION __glutCreateWindowWithExit

1533

END INTERFACE

1534

1535

! int __glutCreateMenuWithExit(void (* func)(int), void (__cdecl *exitfunc)(int))

1536

PUBLIC __glutCreateMenuWithExit

1537

INTERFACE

1538

FUNCTION __glutCreateMenuWithExit(arg1arg2arg3exitfunc) BIND(C,NAME="__glutCreateMenuWithExit")

1539

IMPORT

1540

INTEGER(GLint) :: __glutCreateMenuWithExit

1541

INTEGER(GLint), VALUE :: arg3

1542

! void exitfunc(int)

1543

INTERFACE

1544

SUBROUTINE exitfunc(arg1) BIND(C)

1545

IMPORT

1546

INTEGER(GLint), VALUE :: arg1

1547

END SUBROUTINE exitfunc

1548

END INTERFACE

1549

END FUNCTION __glutCreateMenuWithExit

1550

END INTERFACE

1551

1552

! ???, , PUBLIC :: FGUNUSED=__attribute__((unused))

1553

INTEGER(GLenum), PARAMETER, PUBLIC :: glutInit = glutInit_ATEXIT_HACK

1554

INTEGER(GLenum), PARAMETER, PUBLIC :: glutCreateWindow = glutCreateWindow_ATEXIT_HACK

1555

INTEGER(GLenum), PARAMETER, PUBLIC :: glutCreateMenu = glutCreateMenu_ATEXIT_HACK

1556

1557

1558

! ** END OF FILE **

1559

1560

1561

1562

!

1563

! version: Ubuntu 11.04 Raring: 2.6.0-4ubuntu1

1564

!

1565

1566

1449

1567

! freeglut_ext.h

1450

1568

!

1451

1569

! The non-GLUT-compatible extensions to the freeglut library include file

1472

1590

! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

1473

1591

1474

1592

1593

! Additional GLUT Key definitions for the Special key function

1594

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_KEY_NUM_LOCK = z'006D'

1595

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_KEY_BEGIN = z'006E'

1596

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_KEY_DELETE = z'006F'

1597

1475

1598

! GLUT API Extension macro definitions -- behaviour when the user clicks on an "x" to close a window

1476

1599

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_ACTION_EXIT = 0

1477

1600

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_ACTION_GLUTMAINLOOP_RETURNS = 1

1488

1611

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_FORCE_DIRECT_CONTEXT = 3

1489

1612

1490

1613

! GLUT API Extension macro definitions -- the glutGet parameters

1614

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_STATE = z'007C'

1615

1491

1616

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_ACTION_ON_WINDOW_CLOSE = z'01F9'

1492

1617

1493

1618

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_WINDOW_BORDER_WIDTH = z'01FA'

1498

1623

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_RENDERING_CONTEXT = z'01FD'

1499

1624

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_DIRECT_RENDERING = z'01FE'

1500

1625

1626

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_FULL_SCREEN = z'01FF'

1627

1501

1628

! New tokens for glutInitDisplayMode.

1502

1629

! Only one GLUT_AUXn bit may be used at a time.

1503

1630

! Value 0x0400 is defined in OpenGLUT.

1631

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_AUX = z'1000'

1632

1504

1633

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_AUX1 = z'1000'

1505

1634

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_AUX2 = z'2000'

1506

1635

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_AUX3 = z'4000'

1507

1636

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_AUX4 = z'8000'

1508

1637

1638

! Context-related flags, see freeglut_state.c

1639

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_MAJOR_VERSION = z'0200'

1640

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_MINOR_VERSION = z'0201'

1641

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_FLAGS = z'0202'

1642

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_INIT_PROFILE = z'0203'

1643

1644

! Flags for glutInitContextFlags, see freeglut_init.c

1645

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_DEBUG = z'0001'

1646

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_FORWARD_COMPATIBLE = z'0002'

1647

1648

1649

! Flags for glutInitContextProfile, see freeglut_init.c

1650

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_CORE_PROFILE = z'0001'

1651

1509

1652

! Process loop function, see freeglut_main.c

1510

1653

! void glutMainLoopEvent( void )

1511

1654

PUBLIC glutMainLoopEvent

1523

1666

END SUBROUTINE glutLeaveMainLoop

1524

1667

END INTERFACE

1525

1668

1669

! void glutExit ( void )

1670

PUBLIC glutExit

1671

INTERFACE

1672

SUBROUTINE glutExit() BIND(C,NAME="glutExit")

1673

IMPORT

1674

END SUBROUTINE glutExit

1675

END INTERFACE

1676

1677

1678

! Window management functions, see freeglut_window.c

1679

! void glutFullScreenToggle( void )

1680

PUBLIC glutFullScreenToggle

1681

INTERFACE

1682

SUBROUTINE glutFullScreenToggle() BIND(C,NAME="glutFullScreenToggle")

1683

IMPORT

1684

END SUBROUTINE glutFullScreenToggle

1685

END INTERFACE

1686

1526

1687

1527

1688

! Window-specific callback functions, see freeglut_callbacks.c

1528

1689

! void glutMouseWheelFunc( void (* callback)( int, int, int, int ) )

1590

1751

END SUBROUTINE glutSetOption

1591

1752

END INTERFACE

1592

1753

1754

! int * glutGetModeValues(GLenum mode, int * size)

1755

PUBLIC glutGetModeValues

1756

INTERFACE

1757

FUNCTION glutGetModeValues(mode, size) BIND(C,NAME="glutGetModeValues")

1758

IMPORT

1759

*** int* :: glutGetModeValues

1760

INTEGER(GLenum), VALUE :: mode

1761

! INTEGER(GLint), DIMENSION(*) :: size

1762

INTEGER(GLint) :: size

1763

END FUNCTION glutGetModeValues

1764

END INTERFACE

1765

1593

1766

! A.Donev: User-data manipulation

1594

1767

! void* glutGetWindowData( void )

1595

1768

PUBLIC glutGetWindowData

1655

1828

SUBROUTINE glutBitmapString(font, string) BIND(C,NAME="glutBitmapString")

1656

1829

IMPORT

1657

1830

! CHARACTER, INTENT(IN) :: string

1658

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: string

1831

CHARACTER, DIMENSION(*), INTENT(IN) :: string

1659

1832

TYPE(C_PTR), VALUE :: font

1660

1833

END SUBROUTINE glutBitmapString

1661

1834

END INTERFACE

1666

1839

SUBROUTINE glutStrokeString(font, string) BIND(C,NAME="glutStrokeString")

1667

1840

IMPORT

1668

1841

! CHARACTER, INTENT(IN) :: string

1669

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: string

1842

CHARACTER, DIMENSION(*), INTENT(IN) :: string

1670

1843

TYPE(C_PTR), VALUE :: font

1671

1844

END SUBROUTINE glutStrokeString

1672

1845

END INTERFACE

1739

1912

FUNCTION glutGetProcAddress(procName) BIND(C,NAME="glutGetProcAddress")

1740

1913

IMPORT

1741

1914

TYPE(C_FUNPTR) :: glutGetProcAddress

1742

! CHARACTER, INTENT(IN) :: procName

1915

! CHARACTER(C_CHAR), INTENT(IN) :: procName

1743

1916

CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: procName

1744

1917

END FUNCTION glutGetProcAddress

1745

1918

END INTERFACE

1746

1919

1747

1920

1921

! Joystick functions, see freeglut_joystick.c

1922

! USE OF THESE FUNCTIONS IS DEPRECATED !!!!!

1923

! contact the "freeglut" developer community at freeglut-developer@lists.sourceforge.net,

1924

! switch to the OpenGLUT library, or else port your joystick functionality over to PLIB's

1925

! "js" library.

1926

1927

! Initialization functions, see freeglut_init.c

1928

! void glutInitContextVersion( int majorVersion, int minorVersion )

1929

PUBLIC glutInitContextVersion

1930

INTERFACE

1931

SUBROUTINE glutInitContextVersion(majorVersion, minorVersion) BIND(C,NAME="glutInitContextVersion")

1932

IMPORT

1933

INTEGER(GLint), VALUE :: majorVersion, minorVersion

1934

END SUBROUTINE glutInitContextVersion

1935

END INTERFACE

1936

1937

! void glutInitContextFlags( int flags )

1938

PUBLIC glutInitContextFlags

1939

INTERFACE

1940

SUBROUTINE glutInitContextFlags(flags) BIND(C,NAME="glutInitContextFlags")

1941

IMPORT

1942

INTEGER(GLint), VALUE :: flags

1943

END SUBROUTINE glutInitContextFlags

1944

END INTERFACE

1945

1946

! void glutInitContextProfile( int profile )

1947

PUBLIC glutInitContextProfile

1948

INTERFACE

1949

SUBROUTINE glutInitContextProfile(profile) BIND(C,NAME="glutInitContextProfile")

1950

IMPORT

1951

INTEGER(GLint), VALUE :: profile

1952

END SUBROUTINE glutInitContextProfile

1953

END INTERFACE

1954

1955

1956

! GLUT API macro definitions -- the display mode definitions

1957

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_CAPTIONLESS = z'0400'

1958

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_BORDERLESS = z'0800'

1959

INTEGER(GLenum), PARAMETER, PUBLIC :: GLUT_SRGB = z'1000'

1960

1961

1962

! ** END OF FILE **

1963

1964

1965

1966

1967

! ** END OF FILE **

1968

1748

1969

1749

1970

! Font variables in GLUT_fonts.c

1750

1971

TYPE(C_PTR), BIND(C), PUBLIC, PROTECTED :: GLUT_STROKE_ROMAN, &

1754

1975

GLUT_BITMAP_HELVETICA_18

1755

1976

1756

1977

! A special callback function for compatibility with f90gl

1757

TYPE(C_FUNPTR), PUBLIC, SAVE, BIND(C) :: GLUT_NULL_FUNC=C_NULL_FUNPTR

1978

TYPE(C_FUNPTR), PUBLIC, SAVE :: GLUT_NULL_FUNC=C_NULL_FUNPTR

1758

1979

1759

1980

CONTAINS

1760

1981