Есть пример с использованием GLUT - стандартной кроссплатформенной библиотеки создания Опенгль-окон. (в винде нужен glut.dll, есть на OpenGL.org, под Linux с Wine новых версий заработает сразу, там он уже есть). OpenGL-заголовки в примере не из WinOGL, а из подсистемы Ogl из коллекции
http://www.zinnamturm.eu (там поудобней именование, лишний префикс gl убран, в Обероне он не нужен, т.к. модуль и так префиксуется).
Заголовок GLUT перенесён с дельфовской версии.
Программа рисует многоугольник, по клавишам-цифрам меняет "угольчатость", по Esc выходит.
Писали с Евгением Темиргалеевым.
Линкуется командером
DevLinker.LinkExe SimpleApp.exe :=
National Kernel+ Math F3dSimpleApp$
Код:
MODULE OglSimpleApp;
IMPORT GL := OglOpenGL32, GLUT := OglGLUT, Math, Kernel, WinApi, S := SYSTEM;
TYPE
Triade = ARRAY 3 OF GL.Ubyte;
VAR
width, height: GL.Int;
n, nn: INTEGER;
colors: ARRAY 7 OF Triade;
PROCEDURE [ccall] Display;
VAR ox, oy, x, y, r: REAL;
i: INTEGER;
BEGIN
ox := width / 2; oy := height / 2; r := MIN(width, height) / 2;
GL.ClearColor(0, 0, 0, 1);
GL.Clear(GL.GL_COLOR_BUFFER_BIT);
GL.Begin(GL.GL_POLYGON);
FOR i := 0 TO n - 1 DO
GL.Color3ubv(colors[i MOD 7, 0]);
x := ox + r * Math.Cos(i * 2 * Math.Pi() / n);
y := oy + r * Math.Sin(i * 2 * Math.Pi() / n);
GL.Vertex2f(SHORT(x), SHORT(y))
END;
GL.End;
GL.Finish
END Display;
PROCEDURE [ccall] Reshape (w, h: INTEGER);
BEGIN
width := w; height := h;
GL.Viewport(0, 0, w, h);
GL.MatrixMode(GL.GL_PROJECTION);
GL.LoadIdentity;
GL.Ortho(0, w, 0, h, -1.0, 1.0);
GL.MatrixMode(GL.GL_MODELVIEW);
GL.LoadIdentity
END Reshape;
PROCEDURE [ccall] Keyboard (key: SHORTCHAR; x, y: INTEGER);
BEGIN
CASE key OF
| CHR(27): Kernel.Quit(0)
| CHR(13):
IF (nn >= 3) & (nn <= 360) & (nn # n) THEN n := nn; GLUT.PostRedisplay END;
nn := 0
| '0'..'9':
nn := nn * 10 + ORD(key) - ORD('0')
ELSE
END
END Keyboard;
PROCEDURE Main;
VAR argc: INTEGER;
argv: ARRAY 1 OF WinApi.PtrSTR;
s: ARRAY 16 OF CHAR;
wnd: INTEGER;
BEGIN
argc := 0;
s := "";
argv[0] := S.VAL(WinApi.PtrSTR, S.ADR(s));
GLUT.Init(argc, argv);
GLUT.InitDisplayMode(GLUT.RGB);
GLUT.InitWindowSize(width, height);
wnd := GLUT.CreateWindow("My beauty window");
GLUT.DisplayFunc(Display);
GLUT.ReshapeFunc(Reshape);
GLUT.KeyboardFunc(Keyboard);
GLUT.MainLoop
END Main;
PROCEDURE PutTriade (r, g, b: SHORTINT; OUT t: Triade);
BEGIN
t[0] := SHORT(CHR(r)); t[1] := SHORT(CHR(g)); t[2] := SHORT(CHR(b))
END PutTriade;
PROCEDURE InitColors;
BEGIN
PutTriade(255, 0, 255, colors[0]);
PutTriade(0, 0, 255, colors[1]);
PutTriade(0, 255, 255, colors[2]);
PutTriade(0, 255, 0, colors[3]);
PutTriade(255, 255, 0, colors[4]);
PutTriade(255, 128, 0, colors[5]);
PutTriade(255, 0, 0, colors[6])
END InitColors;
BEGIN
n := 3; width := 400; height := 300;
InitColors;
Main
END OglSimpleApp.
Код:
MODULE OglGLUT['glut32'];
IMPORT GL := OglOpenGL32;
CONST
(* Display mode bit masks *)
RGB* = {};
RGBA* = RGB;
INDEX* = {0};
SINGLE* = {};
DOUBLE* = {1};
ACCUM* = {2};
ALPHA* = {3};
DEPTH* = {4};
STENCIL* = {5};
MULTISAMPLE* = {7};
STEREO* = {8};
LIMINANCE* = {9};
(* Mouse buttons *)
LEFT_BUTTON* = 0;
MIDDLE_BUTTON* = 1;
RIGHT_BUTTON* = 2;
(* Mouse button state *)
DOWN* = 0;
UP* = 1;
(* function keys *)
KEY_F1* = 1;
KEY_F2* = 2;
KEY_F3* = 3;
KEY_F4* = 4;
KEY_F5* = 5;
KEY_F6* = 6;
KEY_F7* = 7;
KEY_F8* = 8;
KEY_F9* = 9;
KEY_F10* = 10;
KEY_F11* = 11;
KEY_F12* = 12;
(* directional keys *)
KEY_LEFT* = 100;
KEY_UP* = 101;
KEY_RIGHT* = 102;
KEY_DOWN* = 103;
KEY_PAGE_UP* = 104;
KEY_PAGE_DOWN* = 105;
KEY_HOME* = 106;
KEY_END* = 107;
KEY_INSERT* = 108;
(* Entry/exit state *)
LEFT* = 0;
ENTERED* = 1;
(* Menu usage state *)
MENU_NOT_IN_USE* = 0;
MENU_IN_USE* = 1;
(* Visibility state *)
NOT_VISIBLE* = 0;
VISIBLE* = 1;
(* Window status state *)
HIDDEN* = 0;
FULLY_RETAINED* = 1;
PARTIALLY_RETAINED* = 2;
FULLY_COVERED* = 3;
(* Color index component selection values *)
RED* = 0;
GREEN* = 1;
BLUE* = 2;
(* Layers for use *)
NORMAL* = 0;
OVERLAY* = 1;
(* Stroke font constants (use these in GLUT program) *)
STROKE_ROMAN* = 0;
STROKE_MONO_ROMAN* = 1;
(* Bitmap font constants (use these in GLUT program) *)
BITMAP_9_BY_15* = 2;
BITMAP_8_BY_13* = 3;
BITMAP_TIMES_ROMAN_10* = 4;
BITMAP_TIMES_ROMAN_24* = 5;
BITMAP_HELVETICA_10* = 6;
BITMAP_HELVETICA_12* = 7;
BITMAP_HELVETICA_18* = 8;
(* glutGet parameters *)
WINDOW_X* = 100;
WINDOW_Y* = 101;
WINDOW_WIDTH* = 102;
WINDOW_HEIGHT* = 103;
WINDOW_BUFFER_SIZE* = 104;
WINDOW_STENCIL_SIZE* = 105;
WINDOW_DEPTH_SIZE* = 106;
WINDOW_RED_SIZE* = 107;
WINDOW_GREEN_SIZE* = 108;
WINDOW_BLUE_SIZE* = 109;
WINDOW_ALPHA_SIZE* = 110;
WINDOW_ACCUM_RED_SIZE* = 111;
WINDOW_ACCUM_GREEN_SIZE* = 112;
WINDOW_ACCUM_BLUE_SIZE* = 113;
WINDOW_ACCUM_ALPHA_SIZE* = 114;
WINDOW_DOUBLEBUFFER* = 115;
WINDOW_RGBA* = 116;
WINDOW_PARENT* = 117;
WINDOW_NUM_CHILDREN* = 118;
WINDOW_COLORMAP_SIZE* = 119;
WINDOW_NUM_SAMPLES* = 120;
WINDOW_STEREO* = 121;
WINDOW_CURSOR* = 122;
SCREEN_WIDTH* = 200;
SCREEN_HEIGHT* = 201;
SCREEN_WIDTH_MM* = 202;
SCREEN_HEIGHT_MM* = 203;
MENU_NUM_ITEMS* = 300;
DISPLAY_MODE_POSSIBLE* = 400;
INIT_WINDOW_X* = 500;
INIT_WINDOW_Y* = 501;
INIT_WINDOW_WIDTH* = 502;
INIT_WINDOW_HEIGHT* = 503;
INIT_DISPLAY_MODE* = 504;
ELAPSED_TIME* = 700;
(* glutDeviceGet parameters *)
HAS_KEYBOARD* = 600;
HAS_MOUSE* = 601;
HAS_SPACEBALL* = 602;
HAS_DIAL_AND_BUTTON_BOX* = 603;
HAS_TABLET* = 604;
NUM_MOUSE_BUTTONS* = 605;
NUM_SPACEBALL_BUTTONS* = 606;
NUM_BUTTON_BOX_BUTTONS* = 607;
NUM_DIALS* = 608;
NUM_TABLET_BUTTONS* = 609;
(* glutLayerGet parameters *)
OVERLAY_POSSIBLE* = 800;
LAYER_IN_USE* = 801;
HAS_OVERLAY* = 802;
TRANSPARENT_INDEX* = 803;
NORMAL_DAMAGED* = 804;
OVERLAY_DAMAGED* = 805;
(* glutVideoResizeGet parameters *)
VIDEO_RESIZE_POSSIBLE* = 900;
VIDEO_RESIZE_IN_USE* = 901;
VIDEO_RESIZE_X_DELTA* = 902;
VIDEO_RESIZE_Y_DELTA* = 903;
VIDEO_RESIZE_WIDTH_DELTA* = 904;
VIDEO_RESIZE_HEIGHT_DELTA* = 905;
VIDEO_RESIZE_X* = 906;
VIDEO_RESIZE_Y* = 907;
VIDEO_RESIZE_WIDTH* = 908;
VIDEO_RESIZE_HEIGHT* = 909;
(* glutGetModifiers return mask *)
ACTIVE_SHIFT* = {0};
ACTIVE_CTRL* = {1};
ACTIVE_ALT* = {2};
(* glutSetCursor parameters *)
(* Basic arrows *)
CURSOR_RIGHT_ARROW* = 0;
CURSOR_LEFT_ARROW* = 1;
(* Symbolic cursor shapes *)
CURSOR_INFO* = 2;
CURSOR_DESTROY* = 3;
CURSOR_HELP* = 4;
CURSOR_CYCLE* = 5;
CURSOR_SPRAY* = 6;
CURSOR_WAIT* = 7;
CURSOR_TEXT* = 8;
CURSOR_CROSSHAIR* = 9;
(* Directional cursors *)
CURSOR_UP_DOWN* = 10;
CURSOR_LEFT_RIGHT* = 11;
(* Sizing cursors *)
CURSOR_TOP_SIDE* = 12;
CURSOR_BOTTOM_SIDE* = 13;
CURSOR_LEFT_SIDE* = 14;
CURSOR_RIGHT_SIDE* = 15;
CURSOR_TOP_LEFT_CORNER* = 16;
CURSOR_TOP_RIGHT_CORNER* = 17;
CURSOR_BOTTOM_RIGHT_CORNER* = 18;
CURSOR_BOTTOM_LEFT_CORNER* = 19;
(* Inherit from parent window *)
CURSOR_INHERIT* = 100;
(* Blank cursor *)
CURSOR_NONE* = 101;
(* Fullscreen crosshair (if available) *)
CURSOR_FULL_CROSSHAIR* = 102;
TYPE
Address* = GL.Address;
PtrSTR* = POINTER TO ARRAY [untagged] OF SHORTCHAR;
(* GLUT Initialization sub-API *)
PROCEDURE Init* ['glutInit'] (VAR argc: INTEGER; VAR argv: ARRAY [untagged] OF PtrSTR);
PROCEDURE InitDisplayMode* ['glutInitDisplayMode'] (mode: SET);
PROCEDURE InitDisplayString* ['glutInitDisplayString'] (string: PtrSTR);
PROCEDURE InitWindowPosition* ['glutInitWindowPosition'] (x, y: INTEGER);
PROCEDURE InitWindowSize* ['glutInitWindowSize'] (width, height: INTEGER);
PROCEDURE MainLoop* ['glutMainLoop'];
(* GLUT Window sub-API *)
PROCEDURE CreateWindow* ['glutCreateWindow'] (title: PtrSTR): INTEGER;
PROCEDURE CreateSubWindow* ['glutCreateSubWindow'] (win, x, y, width, height: INTEGER): INTEGER;
PROCEDURE DestroyWindow* ['glutDestroyWindow'] (win: INTEGER);
PROCEDURE PostRedisplay* ['glutPostRedisplay'];
PROCEDURE PostWindowRedisplay* ['glutPostWindowRedisplay'] (win: INTEGER);
PROCEDURE SwapBuffers* ['glutSwapBuffers'];
PROCEDURE GetWindow* ['glutGetWindow'] (): INTEGER;
PROCEDURE SetWindow* ['glutSetWindow'] (win: INTEGER);
PROCEDURE SetWindowTitle* ['glutSetWindowTitle'] (name: PtrSTR);
PROCEDURE SetIconTitle* ['glutSetIconTitle'] (name: PtrSTR);
PROCEDURE PositionWindow* ['glutPositionWindow'] (x, y: INTEGER);
PROCEDURE ReshapeWindow* ['glutReshapeWindow'] (width, height: INTEGER);
PROCEDURE PopWindow* ['glutPopWindow'];
PROCEDURE PushWindow* ['glutPushWindow'];
PROCEDURE IconifyWindow* ['glutIconifyWindow'];
PROCEDURE ShowWindow* ['glutShowWindow'];
PROCEDURE HideWindow* ['glutHideWindow'];
PROCEDURE FullScreen* ['glutFullScreen'];
PROCEDURE SetCursor* ['glutSetCursor'] (cursor: INTEGER);
PROCEDURE WrapPointer* ['glutWrapPointer'] (x, y: INTEGER);
(* GLUT Overlay sub-API *)
PROCEDURE EstablishOverlay* ['glutEstablishOverlay'];
PROCEDURE RemoveOverlay* ['glutRemoveOverlay'];
PROCEDURE UseLayer* ['glutUseLayer'] (layer: GL.Enum);
PROCEDURE PostOverlayRedisplay* ['glutPostOverlayRedisplay'];
PROCEDURE PostWindowOverlayRedisplay* ['glutPostWindowOverlayRedisplay'] (win: INTEGER);
PROCEDURE ShowOverlay* ['glutShowOverlay'];
PROCEDURE HideOverlay* ['glutHideOverlay'];
(* GLUT Menu sub-API *)
PROCEDURE CreateMenu* ['glutCreateMenu'] (func: PROCEDURE (value: INTEGER)): INTEGER;
PROCEDURE DestroyMenu* ['glutDestroyMenu'] (menu: INTEGER);
PROCEDURE GetMenu* ['glutGetMenu'] (): INTEGER;
PROCEDURE SetMenu* ['glutSetMenu'] (menu: INTEGER);
PROCEDURE AddMenuEntry* ['glutAddMenuEntry'] (name: PtrSTR; value: INTEGER);
PROCEDURE AddSubMenu* ['glutAddSubMenu'] (name: PtrSTR; menu: INTEGER);
PROCEDURE ChangeToMenuEntry* ['glutChangeToMenuEntry'] (entry: INTEGER; name: PtrSTR; value: INTEGER);
PROCEDURE ChangeToSubMenu* ['glutChangeToSubMenu'] (entry: INTEGER; name: PtrSTR; value: INTEGER);
PROCEDURE RemoveMenuItem* ['glutRemoveMenuItem'] (entry: INTEGER);
PROCEDURE AttachMenu* ['glutAttachMenu'] (button: INTEGER);
PROCEDURE DetachMenu* ['glutDetachMenu'] (button: INTEGER);
(* GLUT sub-API *)
PROCEDURE DisplayFunc* ['glutDisplayFunc'] (f: PROCEDURE);
PROCEDURE ReshapeFunc* ['glutReshapeFunc'] (f: PROCEDURE (width, height: INTEGER));
PROCEDURE KeyboardFunc* ['glutKeyboardFunc'] (f: PROCEDURE (key: SHORTCHAR; x, y: INTEGER));
PROCEDURE MouseFunc* ['glutMouseFunc'] (f: PROCEDURE (button, state, x, y: INTEGER));
PROCEDURE MotionFunc* ['glutMotionFunc'] (f: PROCEDURE (x, y: INTEGER));
PROCEDURE PassiveMotionFunc* ['glutPassiveMotionFunc'] (f: PROCEDURE (x, y: INTEGER));
PROCEDURE EntryFunc* ['glutEntryFunc'] (f: PROCEDURE (state: INTEGER));
PROCEDURE VisibilityFunc* ['glutVisibilityFunc'] (f: PROCEDURE (state: INTEGER));
PROCEDURE IdleFunc* ['glutIdleFunc'] (f: PROCEDURE);
PROCEDURE TimerFunc* ['glutTimerFunc'] (msecs: INTEGER; f: PROCEDURE (value: INTEGER); value: INTEGER);
PROCEDURE MenuStateFunc* ['glutMenuStateFunc'] (f: PROCEDURE (status: INTEGER));
PROCEDURE SpecialFunc* ['glutSpecialFunc'] (f: PROCEDURE (key, x, y: INTEGER));
PROCEDURE SpaceballMotionFunc* ['glutSpaceballMotionFunc'] (f: PROCEDURE (x, y, z: INTEGER));
PROCEDURE SpaceballRotateFunc* ['glutSpaceballRotateFunc'] (f: PROCEDURE (x, y, z: INTEGER));
PROCEDURE SpaceballButtonFunc* ['glutSpaceballButtonFunc'] (f: PROCEDURE (button, state: INTEGER));
PROCEDURE ButtonBoxFunc* ['glutButtonBoxFunc'] (f: PROCEDURE (button, state: INTEGER));
PROCEDURE DialsFunc* ['glutDialsFunc'] (f: PROCEDURE (dial, value: INTEGER));
PROCEDURE TabletMotionFunc* ['glutTabletMotionFunc'] (f: PROCEDURE (x, y: INTEGER));
PROCEDURE TabletButtonFunc* ['glutTabletButtonFunc'] (f: PROCEDURE (button, state, x, y: INTEGER));
PROCEDURE MenuStatusFunc* ['glutMenuStatusFunc'] (f: PROCEDURE (status, x, y: INTEGER));
PROCEDURE OverlayDisplayFunc* ['glutOverlayDisplayFunc'] (f: PROCEDURE);
PROCEDURE WindowStatusFunc* ['glutWindowStatusFunc'] (f: PROCEDURE (state: INTEGER));
(* GLUT color index sub-API *)
PROCEDURE SetColor* ['glutSetColor'] (cell: INTEGER; red, green, blue: GL.Float);
PROCEDURE GetColor* ['glutGetColor'] (cell, component: INTEGER): GL.Float;
PROCEDURE CopyColormap* ['glutCopyColormap'] (win: INTEGER);
(* GLUT retrieval sub-API *)
PROCEDURE Get* ['glutGet'] (state: GL.Enum): INTEGER;
PROCEDURE DeviceGet* ['glutDeviceGet'] (info: GL.Enum): INTEGER;
PROCEDURE ExtensionSupported* ['glutExtensionSupported'] (extension: PtrSTR): INTEGER;
PROCEDURE GetModifiers* ['glutGetModifiers'] (): SET;
PROCEDURE LayerGet* ['glutLayerGet'] (info: GL.Enum): INTEGER;
(* GLUT font sub-API *)
PROCEDURE BitmapCharacter* ['glutBitmapCharacter'] (font: Address; character: INTEGER);
PROCEDURE BitmapWidth* ['glutBitmapWidth'] (font: Address; character: INTEGER): INTEGER;
PROCEDURE StrokeCharacter* ['glutStrokeCharacter'] (font: Address; character: INTEGER);
PROCEDURE StrokeWidth* ['glutStrokeWidth'] (font: Address; character: INTEGER): INTEGER;
PROCEDURE BitmapLength* ['glutBitmapLength'] (font: Address; string: PtrSTR): INTEGER;
PROCEDURE StrokeLength* ['glutStrokeLength'] (font: Address; string: PtrSTR): INTEGER;
(* GLUT pre-build models sub-API *)
PROCEDURE WireSphere* ['glutWireSphere'] (radius: GL.Double; slices, stacks: GL.Int);
PROCEDURE SolidSphere* ['glutSolidSphere'] (radius: GL.Double; slices, stacks: GL.Int);
PROCEDURE WireCone* ['glutWireCone'] (base, height: GL.Double; slices, stacks: GL.Int);
PROCEDURE SolidCone* ['glutSolidCone'] (base, height: GL.Double; slices, stacks: GL.Int);
PROCEDURE WireCube* ['glutWireCube'] (sizet: GL.Double);
PROCEDURE SolidCube* ['glutSolidCube'] (size: GL.Double);
PROCEDURE WireTorus* ['glutWireTorus'] (innerRadius, outerRadius: GL.Double; sides, rings: GL.Int);
PROCEDURE SolidTorus* ['glutSolidTorus'] (innerRadius, outerRadius: GL.Double; sides, rings: GL.Int);
PROCEDURE WireDodecahedron* ['glutWireDodecahedron'];
PROCEDURE SolidDodecahedron* ['glutSolidDodecahedron'];
PROCEDURE WireTeapot* ['glutWireTeapot'] (sizet: GL.Double);
PROCEDURE SolidTeapot* ['glutSolidTeapot'] (size: GL.Double);
PROCEDURE WireOctahedron* ['glutWireOctahedron'];
PROCEDURE SolidOctahedron* ['glutSolidOctahedron'];
PROCEDURE WireTetrahedron* ['glutWireTetrahedron'];
PROCEDURE SolidTetrahedron* ['glutSolidTetrahedron'];
PROCEDURE WireIcosahedron* ['glutWireIcosahedron'];
PROCEDURE SolidIcosahedron* ['glutSolidIcosahedron'];
(* GLUT video resize sub-API *)
PROCEDURE VideoResizeGet* ['glutVideoResizeGet'] (param: GL.Enum);
PROCEDURE SetupVideoResizing* ['glutSetupVideoResizing'];
PROCEDURE StopVideoResizing* ['glutStopVideoResizing'];
PROCEDURE VideoResize* ['glutVideoResize'] (x, y, width, height: INTEGER);
PROCEDURE VideoPan* ['glutVideoPan'] (x, y, width, height: INTEGER);
(* GLUT debugging sub-API *)
PROCEDURE ReportErrors* ['glutReportErrors'];
END OglGLUT.
Вход
FAQ
Поиск
