glutdemo.pp 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168
  1. {
  2. GL units for Free Pascal - GLUT demo
  3. 1999 Sebastian Guenther, [email protected]
  4. You may use this source as starting point for your own programs; consider it
  5. as Public Domain.
  6. }
  7. {$MODE objfpc}
  8. {$H+}
  9. {$MACRO ON}
  10. {$ifdef win32}
  11. {$define extdecl := stdcall;}
  12. {$endif}
  13. {$ifdef linux}
  14. {$define extdecl := cdecl;}
  15. {$endif}
  16. program GLUTDemo;
  17. uses
  18. GL, GLU,GLUT;
  19. const
  20. FPCImg: array[0..4, 0..10] of Byte =
  21. ((1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1),
  22. (1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0),
  23. (1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0),
  24. (1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0),
  25. (1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1));
  26. var
  27. counter: Integer;
  28. const
  29. colors: array[0..7, 0..2] of Single =
  30. ((0, 0, 0), (0, 0, 1), (0, 1, 0), (0, 1, 1),
  31. (1, 0, 0), (1, 0, 1), (1, 1, 0), (1, 1, 1));
  32. corners: array[0..7, 0..2] of Single =
  33. ((-1, -1, -1), (+1, -1, -1), (+1, +1, -1), (-1, +1, -1),
  34. (-1, -1, +1), (+1, -1, +1), (+1, +1, +1), (-1, +1, +1));
  35. procedure DrawCube;
  36. procedure DrawSide(i1, i2, i3, i4: Integer);
  37. begin
  38. glColor4f (colors [i1, 0], colors [i1, 1], colors [i1, 2], 0.5);
  39. glVertex3f(corners[i1, 0], corners[i1, 1], corners[i1, 2]);
  40. glColor4f (colors [i2, 0], colors [i2, 1], colors [i2, 2], 0.5);
  41. glVertex3f(corners[i2, 0], corners[i2, 1], corners[i2, 2]);
  42. glColor4f (colors [i3, 0], colors [i3, 1], colors [i3, 2], 0.5);
  43. glVertex3f(corners[i3, 0], corners[i3, 1], corners[i3, 2]);
  44. glVertex3f(corners[i4, 0], corners[i4, 1], corners[i4, 2]);
  45. end;
  46. begin
  47. glBegin(GL_QUADS);
  48. DrawSide(4, 5, 6, 7); // Front
  49. DrawSide(3, 2, 1, 0); // Back
  50. DrawSide(2, 3, 7, 6); // Top
  51. DrawSide(0, 1, 5, 4); // Bottom
  52. DrawSide(4, 7, 3, 0); // Left
  53. DrawSide(1, 2, 6, 5); // Right
  54. glEnd;
  55. end;
  56. procedure DisplayWindow; extdecl
  57. var
  58. x, y: Integer;
  59. begin
  60. Inc(counter);
  61. glClearColor(0, 0, 0.2, 1);
  62. glClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT);
  63. glPushMatrix;
  64. glTranslatef(0, 0, Sin(Single(counter) / 20.0) * 5.0 - 5.0);
  65. glRotatef(Sin(Single(counter) / 200.0) * 720.0, 0, 1, 0);
  66. glRotatef(counter, 0, 0, 1);
  67. for y := 0 to 4 do
  68. for x := 0 to 10 do
  69. if FPCImg[y, x] > 0 then begin
  70. glPushMatrix;
  71. glRotatef(x * Sin(Single(counter) / 5.0), 0, 1, 0);
  72. glRotatef(y * Sin(Single(counter) / 12.0) * 4.0, 0, 0, 1);
  73. glTranslatef((x - 5) * 1, (2 - y) * 1, 0);
  74. glScalef(0.4, 0.4, 0.4);
  75. glRotatef(counter, 0.5, 1, 0);
  76. DrawCube;
  77. glPopMatrix;
  78. end;
  79. glPopMatrix;
  80. Inc(counter);
  81. glutSwapBuffers;
  82. end;
  83. procedure OnTimer(value: Integer); extdecl
  84. begin
  85. glutPostRedisplay;
  86. glutTimerFunc(20, @OnTimer, 0);
  87. end;
  88. begin
  89. WriteLn('Dumping unresolved GL* function names; having unresolved functions ');
  90. WriteLn('is NOT a problem as long as the application doesn''t use them!');
  91. WriteLn('(Most unresolved functions will be propietary extensions which');
  92. WriteLn(' should be an official GL extension)');
  93. WriteLn;
  94. GLDumpUnresolvedFunctions := True;
  95. GLUDumpUnresolvedFunctions := True;
  96. GLUTDumpUnresolvedFunctions := True;
  97. if not InitGl then begin
  98. WriteLn('OpenGL is not supported on this system');
  99. Halt(2);
  100. end;
  101. if not InitGLU then begin
  102. WriteLn('Couldn''t load GLU module');
  103. Halt(3);
  104. end;
  105. if not InitGLUT then begin
  106. WriteLn('Couldn''t load GLUT module');
  107. Halt(5);
  108. end;
  109. glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE or GLUT_DEPTH);
  110. glutCreateWindow('Free Pascal GLUT demo');
  111. glutDisplayFunc(@DisplayWindow);
  112. glutTimerFunc(20, @OnTimer, 0);
  113. WriteLn;
  114. WriteLn('GL info:');
  115. WriteLn(' Vendor: ', glGetString(GL_VENDOR));
  116. WriteLn(' Renderer: ', glGetString(GL_RENDERER));
  117. WriteLn(' Version: ', glGetString(GL_VERSION));
  118. WriteLn(' Extensions: ', glGetString(GL_EXTENSIONS));
  119. // Enable backface culling
  120. glEnable(GL_CULL_FACE);
  121. // Set up depth buffer
  122. glEnable(GL_DEPTH_TEST);
  123. glDepthFunc(GL_LESS);
  124. // Set up projection matrix
  125. glMatrixMode(GL_PROJECTION);
  126. glLoadIdentity;
  127. gluPerspective(90, 1.3, 0.1, 100);
  128. glMatrixMode(GL_MODELVIEW);
  129. glLoadIdentity;
  130. glTranslatef(0, 0, -5.5);
  131. glutMainLoop;
  132. end.