Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,121 +0,0 @@
|
|||
with Lumen.Window;
|
||||
with Lumen.Events;
|
||||
with Lumen.Events.Animate;
|
||||
with GL;
|
||||
with GLU;
|
||||
|
||||
procedure OpenGL is
|
||||
|
||||
The_Window : Lumen.Window.Handle;
|
||||
|
||||
Program_Exit : Exception;
|
||||
|
||||
-- simply exit this program
|
||||
procedure Quit_Handler (Event : in Lumen.Events.Event_Data) is
|
||||
begin
|
||||
raise Program_Exit;
|
||||
end;
|
||||
|
||||
-- Resize the scene
|
||||
procedure Resize_Scene (Width, Height : in Natural) is
|
||||
use GL;
|
||||
use GLU;
|
||||
begin
|
||||
-- reset current viewport
|
||||
glViewport (0, 0, GLsizei (Width), GLsizei (Height));
|
||||
|
||||
-- select projection matrix and reset it
|
||||
glMatrixMode (GL_PROJECTION);
|
||||
glLoadIdentity;
|
||||
|
||||
-- calculate aspect ratio
|
||||
gluPerspective (45.0, GLdouble (Width) / GLdouble (Height), 0.1, 100.0);
|
||||
|
||||
-- select modelview matrix and reset it
|
||||
glMatrixMode (GL_MODELVIEW);
|
||||
glLoadIdentity;
|
||||
end Resize_Scene;
|
||||
|
||||
procedure Init_GL is
|
||||
use GL;
|
||||
use GLU;
|
||||
begin
|
||||
-- smooth shading
|
||||
glShadeModel (GL_SMOOTH);
|
||||
|
||||
-- black background
|
||||
glClearColor (0.0, 0.0, 0.0, 0.0);
|
||||
|
||||
-- depth buffer setup
|
||||
glClearDepth (1.0);
|
||||
-- enable depth testing
|
||||
glEnable (GL_DEPTH_TEST);
|
||||
-- type of depth test
|
||||
glDepthFunc (GL_LEQUAL);
|
||||
|
||||
glHint (GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
|
||||
end Init_GL;
|
||||
|
||||
-- Resize and Initialize the GL window
|
||||
procedure Resize_Handler (Event : in Lumen.Events.Event_Data) is
|
||||
Height : Natural := Event.Resize_Data.Height;
|
||||
Width : Natural := Event.Resize_Data.Width;
|
||||
begin
|
||||
-- prevent div by zero
|
||||
if Height = 0 then
|
||||
Height := 1;
|
||||
end if;
|
||||
|
||||
Resize_Scene (Width, Height);
|
||||
end;
|
||||
|
||||
procedure Draw is
|
||||
use GL;
|
||||
begin
|
||||
-- clear screen and depth buffer
|
||||
glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
|
||||
-- reset current modelview matrix
|
||||
glLoadIdentity;
|
||||
|
||||
-- draw triangle
|
||||
glBegin (GL_TRIANGLES);
|
||||
glColor3f (1.0, 0.0, 0.0);
|
||||
glVertex3f ( 0.0, 1.0, 0.0);
|
||||
glColor3f (0.0, 1.0, 0.0);
|
||||
glVertex3f (-1.0, -1.0, 0.0);
|
||||
glColor3f (0.0, 0.0, 1.0);
|
||||
glVertex3f ( 1.0, -1.0, 0.0);
|
||||
glEnd;
|
||||
end Draw;
|
||||
|
||||
procedure Frame_Handler (Frame_Delta : in Duration) is
|
||||
begin
|
||||
Draw;
|
||||
Lumen.Window.Swap (The_Window);
|
||||
end Frame_Handler;
|
||||
|
||||
begin
|
||||
|
||||
Lumen.Window.Create (Win => The_Window,
|
||||
Name => "OpenGL Demo",
|
||||
Width => 640,
|
||||
Height => 480,
|
||||
Events => (Lumen.Window.Want_Key_Press => True,
|
||||
Lumen.Window.Want_Exposure => True,
|
||||
others => False));
|
||||
|
||||
Resize_Scene (640, 480);
|
||||
Init_GL;
|
||||
|
||||
Lumen.Events.Animate.Select_Events
|
||||
(Win => The_Window,
|
||||
FPS => Lumen.Events.Animate.Flat_Out,
|
||||
Frame => Frame_Handler'Unrestricted_Access,
|
||||
Calls => (Lumen.Events.Resized => Resize_Handler'Unrestricted_Access,
|
||||
Lumen.Events.Close_Window => Quit_Handler'Unrestricted_Access,
|
||||
others => Lumen.Events.No_Callback));
|
||||
|
||||
exception
|
||||
when Program_Exit =>
|
||||
null; -- normal termination
|
||||
end OpenGL;
|
||||
|
|
@ -1,292 +0,0 @@
|
|||
include get.e
|
||||
include dll.e
|
||||
include machine.e
|
||||
include msgbox.e
|
||||
include constants.ew
|
||||
include GLfunc.ew
|
||||
include GLconst.ew
|
||||
|
||||
without warning
|
||||
|
||||
atom hRC, hDC, hWnd, hInstance, ClassName
|
||||
sequence keys keys = repeat(0,256) -- array to hold key presses
|
||||
|
||||
integer active, fullscreen, retval
|
||||
active = TRUE
|
||||
fullscreen = TRUE
|
||||
hRC = NULL
|
||||
hDC = NULL
|
||||
hWnd = NULL
|
||||
hInstance = NULL
|
||||
|
||||
atom rtri, rquad
|
||||
rtri = 0.0
|
||||
rquad = 0.0
|
||||
|
||||
integer dmScreenSettings, WindowRect
|
||||
|
||||
procedure ReSizeGLScene(integer width, integer height)
|
||||
if height = 0 then
|
||||
height = 1
|
||||
end if
|
||||
c_proc(glViewport,{0,0,width,height})
|
||||
c_proc(glMatrixMode,{GL_PROJECTION})
|
||||
c_proc(glLoadIdentity,{})
|
||||
c_proc(gluPerspective,{45.0,width/height,0.1,100.0})
|
||||
c_proc(glMatrixMode,{GL_MODELVIEW})
|
||||
c_proc(glLoadIdentity,{})
|
||||
end procedure
|
||||
|
||||
procedure InitGL()
|
||||
c_proc(glShadeModel,{GL_SMOOTH})
|
||||
c_proc(glClearColor,{0.0,0.0,0.0,0.0})
|
||||
c_proc(glClearDepth,{1.0})
|
||||
c_proc(glEnable,{GL_DEPTH_TEST})
|
||||
c_proc(glDepthFunc,{GL_LEQUAL})
|
||||
c_proc(glHint,{GL_PERSPECTIVE_CORRECTION_HINT,GL_NICEST})
|
||||
end procedure
|
||||
|
||||
function DrawGLScene()
|
||||
c_proc(glClear, {or_bits(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT)})
|
||||
c_proc(glLoadIdentity, {})
|
||||
c_proc(glTranslatef, {-1.5,0.0,-6.0})
|
||||
c_proc(glRotatef, {rtri,0.0,1.0,0.0})
|
||||
c_proc(glBegin, {GL_TRIANGLES})
|
||||
c_proc(glColor3f, {1.0,0.0,0.0})
|
||||
c_proc(glVertex3f, {0.0,1.0,0.0})
|
||||
c_proc(glColor3f, {0.0,1.0,0.0})
|
||||
c_proc(glVertex3f, {-1.0,-1.0,0.0})
|
||||
c_proc(glColor3f, {0.0,0.0,1.0})
|
||||
c_proc(glVertex3f, {1.0,-1.0,0.0})
|
||||
c_proc(glEnd, {})
|
||||
c_proc(glLoadIdentity, {})
|
||||
c_proc(glTranslatef, {1.5,0.0,-6.0})
|
||||
c_proc(glRotatef, {rquad,1.0,0.0,0.0})
|
||||
c_proc(glColor3f, {0.5,0.5,1.0})
|
||||
c_proc(glBegin, {GL_QUADS})
|
||||
c_proc(glVertex3f, {1.0,1.0,0.0})
|
||||
c_proc(glVertex3f, {-1.0,1.0,0.0})
|
||||
c_proc(glVertex3f, {-1.0,-1.0,0.0})
|
||||
c_proc(glVertex3f, {1.0,-1.0,0.0})
|
||||
c_proc(glEnd, {})
|
||||
rtri += 0.2
|
||||
rquad -= 0.15
|
||||
return TRUE
|
||||
end function
|
||||
|
||||
procedure KillGLWindow()
|
||||
if fullscreen then
|
||||
if c_func(ChangeDisplaySettingsA,{NULL,0}) then end if
|
||||
if c_func(ShowCursor,{TRUE}) then end if
|
||||
end if
|
||||
if hRC then
|
||||
if c_func(wglMakeCurrent,{NULL,NULL}) then end if
|
||||
if c_func(wglDeleteContext,{hRC}) then end if
|
||||
hRC = NULL
|
||||
end if
|
||||
if hRC and not c_func(ReleaseDC,{hWnd,hDC}) then
|
||||
hDC = NULL
|
||||
end if
|
||||
if hWnd and not c_func(DestroyWindow,{hWnd}) then
|
||||
hWnd = NULL
|
||||
end if
|
||||
if dmScreenSettings then
|
||||
free(dmScreenSettings)
|
||||
end if
|
||||
free(WindowRect)
|
||||
end procedure
|
||||
|
||||
function WndProc(atom hWnd, integer uMsg, atom wParam, atom lParam)
|
||||
if uMsg = WM_ACTIVATE then
|
||||
if not floor(wParam/#10000) then
|
||||
active = TRUE
|
||||
else
|
||||
active = FALSE
|
||||
end if
|
||||
elsif uMsg = WM_SYSCOMMAND then
|
||||
if wParam = SC_SCREENSAVE then end if
|
||||
if wParam = SC_MONITORPOWER then end if
|
||||
elsif uMsg = WM_CLOSE then
|
||||
c_proc(PostQuitMessage,{0})
|
||||
elsif uMsg = WM_KEYDOWN then
|
||||
keys[wParam] = TRUE
|
||||
elsif uMsg = WM_KEYUP then
|
||||
keys[wParam] = FALSE
|
||||
elsif uMsg = WM_SIZE then
|
||||
ReSizeGLScene(and_bits(lParam,#FFFF),floor(lParam/#10000))
|
||||
end if
|
||||
return c_func(DefWindowProcA,{hWnd, uMsg, wParam, lParam})
|
||||
end function
|
||||
|
||||
integer wc wc = allocate(40)
|
||||
function ClassRegistration()
|
||||
integer WndProcAddress, id
|
||||
id = routine_id("WndProc")
|
||||
if id = -1 then
|
||||
puts(1, "routine_id failed!\n")
|
||||
abort(1)
|
||||
end if
|
||||
WndProcAddress = call_back(id)
|
||||
hInstance = c_func(GetModuleHandleA,{NULL})
|
||||
ClassName = allocate_string("OpenGL")
|
||||
poke4(wc,or_all({CS_HREDRAW, CS_VREDRAW, CS_OWNDC}))
|
||||
poke4(wc+4,WndProcAddress)
|
||||
poke4(wc+8,0)
|
||||
poke4(wc+12,0)
|
||||
poke4(wc+16,hInstance)
|
||||
poke4(wc+20,c_func(LoadIconA,{NULL,IDI_WINLOGO}))
|
||||
poke4(wc+24,c_func(LoadCursorA,{NULL, IDC_ARROW}))
|
||||
poke4(wc+28,NULL)
|
||||
poke4(wc+32,NULL)
|
||||
poke4(wc+36,ClassName)
|
||||
if not c_func(RegisterClassA,{wc}) then
|
||||
retval = message_box("Failed to register class","Error", or_bits(MB_OK,MB_ICONINFORMATION))
|
||||
return FALSE
|
||||
else
|
||||
return TRUE
|
||||
end if
|
||||
end function
|
||||
|
||||
integer regd regd = FALSE
|
||||
procedure CreateGLWindow(atom title, integer width, integer height, integer bits, integer fullscreenflag)
|
||||
atom PixelFormat, pfd, dwExStyle, dwStyle
|
||||
sequence s
|
||||
if regd = FALSE then
|
||||
if ClassRegistration() then
|
||||
regd = TRUE
|
||||
end if
|
||||
end if
|
||||
fullscreen = fullscreenflag
|
||||
if fullscreen then
|
||||
dmScreenSettings = allocate(156)
|
||||
mem_set(dmScreenSettings,0,156)
|
||||
s = int_to_bytes(156)
|
||||
poke(dmScreenSettings + 36,{s[1],s[2]})
|
||||
poke4(dmScreenSettings + 40,or_all({DM_BITSPERPEL,DM_PELSWIDTH,DM_PELSHEIGHT}))
|
||||
poke4(dmScreenSettings + 104, bits)
|
||||
poke4(dmScreenSettings + 108, width)
|
||||
poke4(dmScreenSettings + 112, height)
|
||||
if c_func(ChangeDisplaySettingsA,{dmScreenSettings,CDS_FULLSCREEN}) != DISP_CHANGE_SUCCESSFUL then
|
||||
if message_box("The requested fullscreen mode is not supported by\nyour video card. " &
|
||||
"Use windowed mode instead?","Error", or_bits(MB_YESNO,MB_ICONEXCLAMATION)) = IDYES then
|
||||
else
|
||||
retval = message_box("Program will now close","Error",or_bits(MB_OK,MB_ICONSTOP))
|
||||
end if
|
||||
end if
|
||||
else
|
||||
dmScreenSettings = NULL
|
||||
end if
|
||||
if fullscreen then
|
||||
dwExStyle = WS_EX_APPWINDOW
|
||||
dwStyle = WS_POPUP
|
||||
if c_func(ShowCursor,{FALSE}) then end if
|
||||
else
|
||||
dwExStyle = or_bits(WS_EX_APPWINDOW,WS_EX_WINDOWEDGE)
|
||||
dwStyle = WS_OVERLAPPEDWINDOW
|
||||
end if
|
||||
WindowRect = allocate(16)
|
||||
poke4(WindowRect,0)
|
||||
poke4(WindowRect + 4,width)
|
||||
poke4(WindowRect + 8, 0)
|
||||
poke4(WindowRect + 12, height)
|
||||
if c_func(AdjustWindowRectEx,{WindowRect, dwStyle, FALSE, dwExStyle}) then end if
|
||||
hWnd = c_func(CreateWindowExA,{dwExStyle, --extended window style
|
||||
ClassName, --class
|
||||
title, --window caption
|
||||
or_all({WS_CLIPSIBLINGS,WS_CLIPCHILDREN,dwStyle}), --window style
|
||||
0,
|
||||
0,
|
||||
peek4u(WindowRect + 4) - peek4u(WindowRect),
|
||||
peek4u(WindowRect + 12) - peek4u(WindowRect + 8),
|
||||
NULL,
|
||||
NULL,
|
||||
hInstance,
|
||||
NULL})
|
||||
if hWnd = NULL then
|
||||
KillGLWindow()
|
||||
retval = message_box("Window creation error","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
pfd = allocate(40) --PIXELFORMATDESCRIPTOR
|
||||
mem_set(pfd,0,40)
|
||||
poke(pfd, 40) --size of pfd structure
|
||||
poke(pfd + 2, 1) --version
|
||||
poke4(pfd + 4, or_all({PFD_DRAW_TO_WINDOW,PFD_SUPPORT_OPENGL,PFD_DOUBLEBUFFER})) --properties flags
|
||||
poke(pfd + 8, PFD_TYPE_RGBA) --request an rgba format
|
||||
poke(pfd + 9, 24) --select color depth
|
||||
poke(pfd + 23, 24) --32bit Z-buffer
|
||||
|
||||
hDC = c_func(GetDC,{hWnd}) --create GL device context to match window device context
|
||||
if not hDC then
|
||||
KillGLWindow()
|
||||
retval = message_box("Can't create a GL device context","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
PixelFormat = c_func(ChoosePixelFormat,{hDC,pfd}) --find a pixel format matching PIXELFORMATDESCRIPTOR
|
||||
if not PixelFormat then
|
||||
KillGLWindow()
|
||||
retval = message_box("Can't find a suitable pixel format","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
if not (c_func(SetPixelFormat,{hDC,PixelFormat,pfd})) then --set the pixel format
|
||||
KillGLWindow()
|
||||
retval = message_box("Can't set the pixel format","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
if not c_func(DescribePixelFormat, {hDC,PixelFormat,40,pfd}) then
|
||||
retval = message_box("Can't describe the pixel format","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
hRC = c_func(wglCreateContext,{hDC}) --create GL rendering context
|
||||
if not hRC then
|
||||
KillGLWindow()
|
||||
retval = message_box("Can't create a GL rendering context","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
if not (c_func(wglMakeCurrent,{hDC,hRC})) then --make the GL rendering context active
|
||||
KillGLWindow()
|
||||
retval = message_box("Can't activate the GL rendering context","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
|
||||
end if
|
||||
retval = c_func(ShowWindow,{hWnd,SW_SHOW}) --show the window
|
||||
retval = c_func(SetForegroundWindow,{hWnd}) --set it to always be in foreground
|
||||
retval = c_func(SetFocus,{hWnd}) --give it focus
|
||||
ReSizeGLScene(width, height) --draw the GL scene to match the window size
|
||||
InitGL() --initialize OpenGL
|
||||
end procedure
|
||||
|
||||
integer MSG MSG = allocate(28)
|
||||
integer title title = allocate_string("OpenGL")
|
||||
procedure WinMain()
|
||||
integer done, msg_message
|
||||
done = FALSE
|
||||
if message_box("Would you like to run in fullscreen mode?","Start Fullscreen?",or_bits(MB_YESNO,MB_ICONQUESTION)) = IDNO then
|
||||
fullscreen = FALSE
|
||||
else
|
||||
fullscreen = TRUE
|
||||
end if
|
||||
CreateGLWindow(title,640,480,24,fullscreen)
|
||||
while not done do
|
||||
if c_func(PeekMessageA,{MSG,NULL,0,0,PM_REMOVE}) then
|
||||
msg_message = peek4u(MSG+4)
|
||||
if msg_message = WM_QUIT then
|
||||
done = TRUE
|
||||
else
|
||||
retval = c_func(TranslateMessage,{MSG})
|
||||
retval = c_func(DispatchMessageA,{MSG})
|
||||
end if
|
||||
else
|
||||
if ((active and not DrawGLScene()) or keys[VK_ESCAPE]) then
|
||||
done = TRUE
|
||||
else
|
||||
retval = c_func(SwapBuffers,{hDC})
|
||||
if keys[VK_F1] then
|
||||
keys[VK_F1] = FALSE
|
||||
KillGLWindow()
|
||||
if fullscreen = 0 then
|
||||
fullscreen = 1
|
||||
else
|
||||
fullscreen = 0
|
||||
end if
|
||||
CreateGLWindow(title,640,480,24,fullscreen)
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
end while
|
||||
KillGLWindow()
|
||||
end procedure
|
||||
|
||||
WinMain()
|
||||
Loading…
Add table
Add a link
Reference in a new issue