Oxygen Basic
Programming => Problems & Solutions => Topic started by: Arnold on February 14, 2019, 04:48:40 AM
-
Hi Charles,
I found this little example by Frankolinux, which with only small modifications will work with the latest Oxygenbasic too:
https://www.oxygenbasic.org/forum/index.php?topic=638.msg5413#msg5413
My intention is to apply dialogs.inc in order to add a menu and a help dialog, I do not yet know if this is possible. But I realized that the console seems not to be shown when I apply OpenglSceneFrame. The console will only open when the app is finished.
Did I forget an option to open the console outside of the OpenGl window? There is ConsoleG.inc, must I use this include file? I would like to follow the messages in some way.
In the following code maybe in line 144 the path for crate.jpg must be adapted.
BTW: what is the purpose of mincreate?
Roland
Edit: I found my bug and changed the code accordingly.
'' OPENGL NEHE Example Chapter 7 (nearly same content) for oxygen basic,
'' modificated by frank brübach alias frankolinox, 21.march.2013
''
#case capital
def NULL null
$ FileName "Nehe7_OSF.exe"
'uses rtl32
'uses rtl64
% review
uses dialogs
string title = "Nehe 7 or Cube Rotation + Gdiplus_Texture Loading"
uses OpenglSceneFrame
sys GdiplusToken
sys texn[16]
'CREATE OPENGL TEXTURE
'=====================
type ColorPixel
byte red,green,blue,alpha
=
dword colorx
end type
'------------------------------------------------------
Sub MakeTexture(sys pPixelArray, TextureWidth, TextureHeight, Texnum )
'======================================================
'
string LOCAL strTextureData AS STRING
glBindTexture GL_TEXTURE_2D, texNum
glEnable GL_TEXTURE_2D
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
glTexImage2D GL_TEXTURE_2D, 0, 4, TextureWidth, TextureHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, pPixelArray
'
'---------------- important for all 6 faces to show in openGL scene --------- //
glClearDepth 1.0
' Specify the value used for depth-buffer comparisons
glDepthFunc GL_LESS
' Enable depth comparisons and update the depth buffer
glEnable GL_DEPTH_TEST
' Select smooth shading
glShadeModel GL_SMOOTH
'
'---------------- important for all 6 faces to show in openGL scene --------- //
End Sub
'============================
'GDIPLUS TEXTURE IMAGE LOADER
'============================
'-----------------------------------------------------
function loadTexture(string wszfilename, sys textureWidth, sys textureHeight, string*strTextureData) as sys
'=====================================================
'
sys hstatus,pImage,pThumb,token
sys width,height,picflip,picdim,ref,xw,yw,xww,yww
macro swap(a,b)
scope
let _v_ = a : a=b : b= _v_
end scope
end macro
'
GdiplusStartupInput StartupInput
StartupInput.GdiplusVersion = 1
hStatus=GdiplusStartup token, StartupInput, byval 0
'
if hStatus then
mbox "Error initializing GDIplus: " hex hStatus
exit function
end if
hStatus = GdipLoadImageFromFile wszfilename, pImage
if hStatus != 0 then mbox "Cannot load: " wszfilename
hStatus = GdipGetImageThumbnail pImage, textureWidth, textureHeight, pThumb, NULL, NULL
picflip=pthumb
hStatus = GdipImageRotateFlip (picflip,6) ' RotateNoneFlipY =6 invert
colorpixel colpix
strTextureData=nuls 4*textureWidth*textureHeight
xww=textureWidth-1
yww=xww
picdim=*strTextureData
for yw=0 to yww ' first y: right flip direction
for xw=0 to xww
GdipBitmapGetPixel picflip, xw, yw, colpix.colorx
swap colpix.red, colpix.blue
*picdim=colpix.colorx
picdim+=4 'increase
next
next
'
'Cleanup
'
if pThumb then GdipDisposeImage pThumb
if pImage then GdipDisposeImage pImage
return hStatus
GdiplusShutdown token
end Function
'-----------------------
sub Initialize(sys hWnd)
'=======================
'GDIPLUS
'=======
string txt
sys hr
GdiplusStartupInput StartupInput
StartupInput.GdiplusVersion = 1
hr=GdiplusStartup GdiplusToken, StartupInput, byval 0
'
if hr then
mbox "Error initializing GDIplus: " hex hr
exit function
end if
'
'Prepare Textures
'----------------
'
glGenTextures 2, texn
'
static sys res=512
string txt, imgs[1]=""
'Perhaps the path must be adapted
loadTexture "D:/Oxygenbasic/examples/images/crate.jpg",res,res, imgs[1]
MakeTexture *imgs[1],res,res,texn[1]
'
SetTimer hWnd,1,10,NULL
end sub
sub Release(sys hWnd)
'====================
killTimer hwnd, 1
glDeleteTextures 1, texn
GdiplusShutdown GdiplusToken
'
end sub
sub scene(sys hWnd)
'==================
'
static single ang1, angi1=1
static single sx,sy,sz
sys xrot,xspeed,yrot,yspeed
static float rotation = 0
'
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glClearColor 0, 0, 0, 0 '0.5, 0, 0, 0
glLoadIdentity
'
'ACTIVATE TEXTURE
'----------------
'
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D,texn[1]
'
sx=0.2 : sy=0.16 : sz=-1
'
'MOVEMENT
'--------
'
'glrotatef ang1, 0,0,1
single x=cos(rad(ang1))*.1 ,y=sin(rad(ang1))*.1,z=0
glTranslatef x+0, y+0, z-5
glRotatef rotation, 0, 1, 0 ''glRotatef rotation, 0.2, 1, 0.2
rotation+=.5
if rotation > 360 then
rotation -= 360
end if
'
'DRAW SHAPE
'----------
'
'this quad is drawn clockwise
'
glbegin GL_QUADS
'
' Front Face
glNormal3f 0.0 , 0.0 , 1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f -1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f 1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f 1.0 , 1.0 , 1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f -1.0 , 1.0 , 1.0
' Back Face
glNormal3f 0.0 , 0.0 , -1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f -1.0 , -1.0 , -1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f -1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f 1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f 1.0 , -1.0 , -1.0
' Top Face
''glNormal3f 0.0 , 1.0 , 0.0
glTexCoord2f 0.0 , 1.0 : glVertex3f -1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f -1.0 , 1.0 , 1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f 1.0 , 1.0 , 1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f 1.0 , 1.0 , -1.0
' Bottom Face
''glNormal3f 0.0 ,-1.0 , 0.0
glTexCoord2f 1.0 , 1.0 : glVertex3f -1.0 , -1.0 , -1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f 1.0 , -1.0 , -1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f 1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f -1.0 , -1.0 , 1.0
' Right face
''glNormal3f 1.0 , 0.0 , 0.0
glTexCoord2f 1.0 , 0.0 : glVertex3f 1.0 , -1.0 , -1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f 1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f 1.0 , 1.0 , 1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f 1.0 , -1.0 , 1.0
' Left Face
''glNormal3f -1.0 , 0.0 , 0.0
glTexCoord2f 0.0 , 0.0 : glVertex3f -1.0 , -1.0 , -1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f -1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f -1.0 , 1.0 , 1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f -1.0 , 1.0 , -1.0
glEnd
'xrot = xrot + xspeed
'yrot = yrot + yspeed
glend
'
glDisable GL_TEXTURE_2D
'
'
'UPDATE ROTATION ANGLES
'----------------------
'
'ang1+=angi1 : if ang1>=360 then ang1-=360
'
'
end sub
function WndMessages( sys hWnd, uint wMsg, sys wParam, lparam ) as sys, link WndProcExtra
============================================================================
select wMsg
===========
case WM_CREATE
printl "in WndMessages"
if mincreate then return
end select
end function
printl "Enter ..."
waitkey
end
-
I found my mistake. Only a small change is necessary. I modified the code in my previous post.
-
Hi Roland,
Here is an example with menus and a console for monitoring messages. It catches WM_KEYDOWN messages.
The first CreateWindow is used to select the pixel mode with multisampling (smoothing)
'#compact
includepath "$\inc\"
$ FileName "t.exe"
'include "RTL32.inc"
'include "RTL64.inc"
'
uses console
% MultiSamples 4
% ExplicitMain
% title "Pick / move objects / right-click for menu"
% fontA "Arial",FW_SEMIBOLD
'macro keydown
'case 27 : 'no action
'case 32 : 'no action
'end macro
'
include "OpenglSceneFrame.inc"
'
'includepath "$\examples\opengl\"
include "glo2\shapes.inc"
include "glo2\materials.inc"
%TPM_LEFTBUTTON 0x0000
%TPM_RIGHTBUTTON 0x0002
%TPM_LEFTALIGN 0x0000
'SCENE GLOBALS
==============
indexbase 1
sys texn[16] 'ARRAY OF TEXTURE NUMBERS
sys GdiplusToken '
float ang1 'ANIMATION ANGLE
sys cmd 'COMMAND MESSAGE WPARAM
sys cube,sphere,tors,helix 'SHAPES
sys picknext
%cone -1
function WndMessages( sys hWnd, wMsg, wParam, lparam ) as sys, link WndProcExtra
============================================================================
'
static sys hMenu,hSubMenu,hSubMenu1,hCursorMenu
static String szAppName
static POINT pt
'
select wMsg
===========
case WM_CREATE
'
if mincreate then return
'
hMenu = CreateMenu
hSubMenu = CreateMenu
hSubMenu1= CreateMenu
AppendMenu hSubMenu1, MF_STRING, 4021, "Shiny Red"
AppendMenu hSubMenu1, MF_STRING, 4022, "Shiny Black"
AppendMenu hSubMenu1, MF_STRING, 4023, "Steel"
AppendMenu hSubMenu1, MF_STRING, 4024, "Bronze"
AppendMenu hSubMenu1, MF_STRING, 4025, "Silver"
AppendMenu hSubMenu1, MF_STRING, 4026, "Gold"
AppendMenu hSubMenu , MF_POPUP, hSubMenu1, "&Materials"
'
hSubMenu1= CreateMenu
AppendMenu hSubMenu1, MF_STRING, 4041, "Cube"
AppendMenu hSubMenu1, MF_STRING, 4042, "Cone"
AppendMenu hSubMenu1, MF_STRING, 4043, "Sphere"
AppendMenu hSubMenu1, MF_STRING, 4044, "Torus"
AppendMenu hSubMenu1, MF_STRING, 4045, "Helix"
AppendMenu hSubMenu , MF_POPUP, hSubMenu1, "&Shapes"
' AppendMenu hSubMenu , MF_SEPARATOR, 0, null
AppendMenu hSubMenu , MF_STRING, 4005, "E&xit"
'
AppendMenu hMenu, MF_POPUP, hSubMenu, "&Objects"
'
' CheckMenuItem hMenu,4022, MF_CHECKED
' EnableMenuItem hMenu,4024, MF_DISABLED or MF_GRAYED
'
hCursorMenu = GetSubMenu(hMenu, 0)
'
case WM_COMMAND
if wparam = 4005 then 'Exit
SendMessage hwnd, WM_CLOSE, 0, 0
end if
cmd=wParam
case WM_KEYDOWN
output "keydown " wparam cr
cmd=12
act=1
case WM_KEYUP
cmd=12
case WM_RBUTTONUP
GetClientRect crect
GetCursorPos(pt)
TrackPopupMenu(hCursorMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
pt.x, pt.y, 0, hwnd, null)
bright=0 : return 1
end select
end function
=================
class SceneObject
=================
'
float p.x,p.y,p.z 'POSITION
float sc,rz,ry 'PROPORTIONS
float sm 'SMOOTHING
sys n 'FACETS
sys shape
'
float a.x,a.y,a.z 'ORIENTATION
float ax,ay,az 'ANCHOR ROTATION
float bx,by,bz 'ANCHOR POSITION
'
Materials*ma
'
method set(float px,py,pz,psc,prz,pry,psm,pn)
p.x=px : p.y=py : p.z=pz : sc=psc : rz=prz : ry=pry
sm=psm
n=pn
end method
'
method set(materials*m)
@this.ma=@m
end method
'
method set(sys sh)
shape=sh
end method
'
method Render()
if @ma then ma.act
glPushMatrix
gltranslatef p.x,p.y,p.z
glrotatef a.x,1,0,0 'rotate yz : PITCH
glrotatef a.y,0,1,0 'rotate xz : YAW
glrotatef a.z,0,0,1 'rotate xy : ROLL
glscalef sc,sc,sc
if shape=-1
ConeFaces n,rz,ry,sm
elseif shape>0
glCallList shape
end if
a.y+=1 : if a.y=360 then a.y=0
glPopMatrix
end method
'
method anchor()
ax=a.x : ay=a.y : az=a.z
bx=p.x : by=p.y : bz=p.z
end method
'
method move(single mx,my,mz)
p.x=bx+mx : p.y=by+my : p.z=bz+mz
limit
end method
'
method rotate(single mx,my,mz)
a.x=ax+mx : a.y=ay+my : a.z=az+mz
end method
'
method limit()
float d=-p.z,id=-1/p.z
if p.x*id<-0.5 then p.x=-.5*d
if p.y*id<-0.4 then p.y=-.4*d
if p.z>-1.0 then p.z=-1.0
if p.x*id>.5 then p.x=.5*d
if p.y*id>.4 then p.y=.4*d
end method
'
method drag()
float dx,dy,dz
dx=mposx-sposx
dy=sposy-mposy
if key[VK_CONTROL]
'a.z=-dx : a.x=-dy
'rotate(-0.5*dy,0.0,-0.5*dx)
rotate(-0.5*dy,0.0,0.0)
elseif key[VK_SHIFT]
dx=mposx-sposx
dz=(mposy-sposy)/crect.right
move 0,0,20*dz
else
dx=mposx-sposx
dy=sposy-mposy
dz=-p.z/crect.right
move dx*dz,dy*dz,0
end if
end method
'
end class
========================
sub initialize(sys hWnd)
========================
'
GDIplus 1
'
cube=CompileList : CubeForm : glEndList
sphere=CompileList : Spheric 1,1,6 : glEndList
tors=CompileList : torus 1.,.20 : glEndList
helix=CompileList : toroid 1.,.25,.8,.16,5.,6. : glEndList
end sub
=====================
sub Release(sys hwnd)
=====================
'
DeleteAllGlCompiled
Gdiplus 0
end sub
===================
sub scene(sys hWnd)
===================
'
static single ra,ri,angi1=.5
'
'
ActiveFrame
glClearColor 0.5, 0.5, 0.7, 0.0
Fog 0.5, 0.5, 0.7, 0.035 'rgb and density
BeginPick
'
StandardLighting li
StandardMaterial ma
'glEnable GL_TEXTURE_2D
'
sys t1=texn[1] 'texture
'
'
static SceneObject c[100]
'
'INITIAL DATA
if c.sc=0
'
'shape x y z sc rz ry sm n
'
c[6].set 6.5, -0.9, -16.0, 0.5, 0, 4. , 0, 4
c[5].set 2.5, -0.9, -8.0 , 0.5, 0, 2. , 0, 10
c[4].set 0.5, -0.9, -4.0 , 0.5, 0, 3. , 0, 15
c[3].set -0.5, -0.6, -2.0 , 0.5,.5, 1. , 1, 30
c[2].set -0.5, -0.1, -2.0 , .25,1., 2. , 1, 30
c[1].set -0.5, 0.4, -2.0 , .25,0., 2. , 1, 30
'
c[6].set cube
c[5].set helix
c[4].set cone
c[3].set tors
c[2].set sphere
c[1].set cone
'
c[6].set RedShinyMaterial
c[5].set BlackShinyMaterial
c[4].set SteelMaterial
c[3].set BronzeMaterial
c[2].set SilverMaterial
c[1].set GoldMaterial
picknext=7
end if
'
'PICK OR RENDER MODE
'
int a=lastkey-48
select a
case 1 to 6 : picked=a 'number keys 1..6
end select
'
MoveObjectWithKeys c[picked], 0.01, 1.0
'
'
'RESPOND TO MENU SELECTION
'
if cmd
if picked
if cmd=12
if bleft or bright
c[picked].anchor
sposx=mposx : sposy=mposy
end if
goto ncmd
end if
materials *m
select cmd
case 4021 : @m=@RedShinyMaterial
case 4022 : @m=@BlackShinyMaterial
case 4023 : @m=@SteelMaterial
case 4024 : @m=@BronzeMaterial
case 4025 : @m=@SilverMaterial
case 4026 : @m=@GoldMaterial
end select
if @m
c[picked].set m
goto ncmd
end if
end if
sys shape
select cmd
case 4041 : shape=cube
case 4042 : shape=cone
case 4043 : shape=sphere
case 4044 : shape=tors
case 4045 : shape=helix
end select
if shape then
if picked=0 then
if picknext<=100 then
picked=picknext
c[picked].set -0.0, -0.0, -5.0 , 0.5,.5, 1. , 1, 30
c[picked].set SilverMaterial
picknext++
end if
end if
if picked then c[picked].set shape
end if
end if
ncmd:
cmd=0 'FINISHED WITH COMMAND
'
'RENDER OBJECTS
'
sys i
SceneObject *cc
for i=1,i<picknext
PickLabel i
@cc=@c[i]
if bleft
if picked=i
cc.drag
end if
else
cc.anchor
end if
cc.render
next
'
'PRINTING INFO / LABELS
'
'glDisable GL_TEXTURE_2D
glDisable GL_LIGHTING
if picked
glPushMatrix
glLoadIdentity
gltranslatef -.5,.35,-1.0
float w,h
glscalef .07,.07,.01
GetWordArea "Shape:",w,h
if pick
PutBoxArea w,h
else
glColor3f .99,.99,.00
gprint "Shape: "
glColor3f .99,.99,.99
gprint picked
end if
glPopMatrix
end if
'
EndPick
'
end sub
MainWindow width,height,WS_OVERLAPPEDWINDOW
-
Thank you Charles. In this example and in WndMenus.o2bas you apply the function WindowMessages with link to WndProcExtra. This is a very interesting combination. It should be possible to create dialogs within WindowMessages and I am experimenting a little bit with the options.
-
I've decapitalised some of your function names in dialog.inc, so that it can be used with #case capital
-
Hi Charles,
here I come to my limits with using console.inc, although I think I can narrow down the problem. I completed the Nehe Tutorial No 7 and added Menu and Key actions. Probably I did it not the best way and I did not exhaust all the possibilities of OxygenSceneFrame, but it is only a draft at the moment.
The app works quite nice in 32-bit, but in 64-bit I will get an error: "SetMenu hMenu failed!". If I comment out: initMenu(hWnd) in about line 319, the keys like F1 or Ctrl-O will not work nevertheless in 64-bit. If I apply: printl "wMsg = " wMsg in about line 313, most of the time wMsg prints 0, which is not correct.
After more testing I found that the demos \examples\OpenGl\MenuObj.o2bas and \other WndMenus.o2bas do also not work in 64-bit, so I assume it is a problem with the option: , link WndProcExtra? Perhaps a cast must be used somewhere? But at the moment I have no idea what is missing and if the reason is really the link option.
Roland
' OPENGL NEHE tutorial Example Chapter 7
$ FileName "Nehe7_OSF.exe"
'uses rtl32
'uses rtl64
uses FileDialog
#case capital
def NULL null
% review
uses dialogs
% ExplicitMain
% title = "Nehe Tutorial 7 with OpenglSceneFrame"
uses OpenglSceneFrame
string fn=""
sys HelpDlg
'Ids for menu
#define IDM_Load 1110
#define IDM_Exit 1111
#define IDM_Reset 1112
#define IDM_Help 1113
#define IDM_Right 1114
#define IDM_Left 1115
#define IDM_Up 1116
#define IDM_Down 1117
#define IDM_PgUp 1118
#define IDM_PgDown 1119
'Ids for text controls in Help
% IDC_LText1=1131
% IDC_LText2=1132
float xspeed=0
float yspeed=0
float z_depth=5
bool light
GLfloat LightAmbient[]= { 0.5f, 0.5f, 0.5f, 1.0f }
GLfloat LightDiffuse[]= { 1.0f, 1.0f, 1.0f, 1.0f }
GLfloat LightPosition[]= { 0.0f, 0.0f, 2.0f, 1.0f }
int filter // Which Filter To Use
width=500 : height=300
MainWindow width,height,WS_OVERLAPPEDWINDOW
printl "Enter ..."
waitkey
end
declare sub initMenu(sys hWnd)
==========================================================================
sys GdiplusToken
sys texn[16]
'CREATE OPENGL TEXTURE
'=====================
type ColorPixel
byte red,green,blue,alpha
=
dword colorx
end type
'------------------------------------------------------
Sub MakeTexture(sys pPixelArray, TextureWidth, TextureHeight, *Texnum )
'======================================================
'
string strTextureData
glEnable GL_TEXTURE_2D
// Create Nearest Filtered Texture
glBindTexture(GL_TEXTURE_2D, TexNum[0])
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST)
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST)
glTexImage2D GL_TEXTURE_2D, 0, 4, TextureWidth, TextureHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, pPixelArray
// Create Linear Filtered Texture
glBindTexture GL_TEXTURE_2D, TexNum[1]
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
glTexImage2D GL_TEXTURE_2D, 0, 4, TextureWidth, TextureHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, pPixelArray
// Create MipMapped Texture
glBindTexture(GL_TEXTURE_2D, TexNum[2])
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR)
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR_MIPMAP_NEAREST)
gluBuild2DMipmaps GL_TEXTURE_2D, 4, TextureWidth, TextureHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixelArray
'
'---------------- important for all 6 faces to show in openGL scene --------- //
glClearDepth 1.0
' Specify the value used for depth-buffer comparisons
glDepthFunc GL_LESS
' Enable depth comparisons and update the depth buffer
glEnable GL_DEPTH_TEST
' Select smooth shading
glShadeModel GL_SMOOTH
'
'---------------- important for all 6 faces to show in openGL scene --------- //
glLightfv(GL_LIGHT1, GL_AMBIENT, LightAmbient) // Setup The Ambient Light
glLightfv(GL_LIGHT1, GL_DIFFUSE, LightDiffuse) // Setup The Diffuse Light
glLightfv(GL_LIGHT1, GL_POSITION,LightPosition) // Position The Light
glEnable(GL_LIGHT1) // Enable Light One
End Sub
'============================
'GDIPLUS TEXTURE IMAGE LOADER
'============================
'-----------------------------------------------------
function loadTexture(string wszfilename, sys textureWidth, sys textureHeight, string*strTextureData) as sys
'=====================================================
'
sys hstatus,pImage,pThumb,token
sys width,height,picflip,picdim,ref,xw,yw,xww,yww
macro swap(a,b)
scope
let _v_ = a : a=b : b= _v_
end scope
end macro
'
GdiplusStartupInput StartupInput
StartupInput.GdiplusVersion = 1
hStatus=GdiplusStartup token, StartupInput, byval 0
'
if hStatus then
mbox "Error initializing GDIplus: " hex hStatus
exit function
end if
if len(fn) then
hStatus = GdipLoadImageFromFile wszfilename, pImage
if hStatus != 0 then mbox "Cannot load: " wszfilename
hStatus = GdipGetImageThumbnail pImage, textureWidth, textureHeight, pThumb, NULL, NULL
end if
picflip=pthumb
hStatus = GdipImageRotateFlip (picflip,6) ' RotateNoneFlipY =6 invert
colorpixel colpix
strTextureData=nuls 4*textureWidth*textureHeight
xww=textureWidth-1
yww=xww
picdim=*strTextureData
for yw=0 to yww ' first y: right flip direction
for xw=0 to xww
GdipBitmapGetPixel picflip, xw, yw, colpix.colorx
swap colpix.red, colpix.blue
*picdim=colpix.colorx
picdim+=4 'increase
next
next
'
'Cleanup
'
if pThumb then GdipDisposeImage pThumb
if pImage then GdipDisposeImage pImage
return hStatus
GdiplusShutdown token
end Function
'-----------------------
sub Initialize(sys hWnd)
'=======================
'GDIPLUS
'=======
string txt
sys hr
GdiplusStartupInput StartupInput
StartupInput.GdiplusVersion = 1
hr=GdiplusStartup GdiplusToken, StartupInput, byval 0
'
if hr then
mbox "Error initializing GDIplus: " hex hr
exit function
end if
'
'Prepare Textures (in IDM_Load)
'----------------
'
'
SetTimer hWnd,1,10,NULL
end sub
sub Release(sys hWnd)
'====================
killTimer hwnd, 1
glDeleteTextures 1, texn
GdiplusShutdown GdiplusToken
'
end sub
static float xrotation = 0
static float yrotation = 0
sub scene(sys hWnd)
'==================
'
static single ang1
static single sx,sy,sz
'
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glClearColor 0, 0, 0, 0 '0.5, 0, 0, 0
glLoadIdentity
'
'ACTIVATE TEXTURE
'----------------
'
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D,texn[filter]
'
sx=0.2 : sy=0.16 : sz=-1
'
'MOVEMENT
'--------
'
single x=cos(rad(ang1))*.1 ,y=sin(rad(ang1))*.1,z=0
glTranslatef x+0, y+0, z-z_depth
glRotatef xrotation, 0, 1, 0
xrotation+=xspeed
if xrotation > 360 then
xrotation -= 360
end if
glRotatef yrotation, 1, 0, 0
yrotation+=yspeed
if yrotation > 360 then
yrotation -= 360
end if
'
'DRAW SHAPE
'----------
'
'this quad is drawn clockwise
'
glbegin GL_QUADS
'
' Front Face
glNormal3f 0.0 , 0.0 , 1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f -1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f 1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f 1.0 , 1.0 , 1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f -1.0 , 1.0 , 1.0
' Back Face
glNormal3f 0.0 , 0.0 , -1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f -1.0 , -1.0 , -1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f -1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f 1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f 1.0 , -1.0 , -1.0
' Top Face
''glNormal3f 0.0 , 1.0 , 0.0
glTexCoord2f 0.0 , 1.0 : glVertex3f -1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f -1.0 , 1.0 , 1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f 1.0 , 1.0 , 1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f 1.0 , 1.0 , -1.0
' Bottom Face
''glNormal3f 0.0 ,-1.0 , 0.0
glTexCoord2f 1.0 , 1.0 : glVertex3f -1.0 , -1.0 , -1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f 1.0 , -1.0 , -1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f 1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f -1.0 , -1.0 , 1.0
' Right face
''glNormal3f 1.0 , 0.0 , 0.0
glTexCoord2f 1.0 , 0.0 : glVertex3f 1.0 , -1.0 , -1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f 1.0 , 1.0 , -1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f 1.0 , 1.0 , 1.0
glTexCoord2f 0.0 , 0.0 : glVertex3f 1.0 , -1.0 , 1.0
' Left Face
''glNormal3f -1.0 , 0.0 , 0.0
glTexCoord2f 0.0 , 0.0 : glVertex3f -1.0 , -1.0 , -1.0
glTexCoord2f 1.0 , 0.0 : glVertex3f -1.0 , -1.0 , 1.0
glTexCoord2f 1.0 , 1.0 : glVertex3f -1.0 , 1.0 , 1.0
glTexCoord2f 0.0 , 1.0 : glVertex3f -1.0 , 1.0 , -1.0
glEnd
glend
'
glDisable GL_TEXTURE_2D
'
'
end sub
function WndMessages( sys hWnd, uint wMsg, sys wParam, lParam ) as sys, link WndProcExtra
============================================================================
string sep=chr(0)
string ImgFilter=
"images"+sep+"*.bmp;*.jpg;*.jpeg;*.png;*.ico;*.tif;*tiff;*.gif"+sep+
"all files"+sep+"*.*"+sep+sep
'printl "wMsg = " wMsg
select wMsg
===========
case WM_CREATE
if mincreate then return
initMenu(hWnd)
case WM_COMMAND
select case loword(wParam) 'id
case IDM_Exit
SendMessage hwnd, WM_CLOSE, 0, 0
return 1 'indicate this message has been intercepted / no further action
'
case IDM_Load
'Prepare Textures
'----------------
glGenTextures 2, texn
static sys res=512
string imgs[1]=""
fn=GetFileName("", 0, ImgFilter)
LoadTexture fn, res,res, imgs[1]
MakeTexture *imgs[1],res,res,texn
case IDM_Reset
xspeed=0
yspeed=0
z_depth=5
xrotation=0
yrotation=0
case IDM_Help
'Create Help Window if not already exist
if IsWindow(HelpDlg) = 0 then
Dialog( 0, 0, 200, 150, "Buttons used:",
WS_OVERLAPPED or WS_SYSMENU or DS_CENTER or WS_VISIBLE or DS_SETFONT,
8, "MS Sans Serif" )
Ltext( "", IDC_LText1, 5, 5, 50, 120 )
Ltext( "", IDC_LText2, 55, 5,110, 120 )
HelpDlg = CreateModelessDialog( hwnd, @HelpDlgProc, 0 )
else
ShowWindow(HelpDlg, SW_SHOW)
end if
end select
case WM_KEYDOWN
printl wParam
select case loword(wParam)
case VK_F1
SendMessage(hWnd, WM_COMMAND, IDM_Help,0)
case VK_RIGHT
xspeed+=0.2
case VK_LEFT
xspeed-=0.2
case VK_UP
yspeed+=0.2
case VK_DOWN
yspeed-=0.2
case VK_NEXT 'PgDown
z_depth+=0.2
case VK_PRIOR 'PgUP
z_depth-=0.2
case vk_L
if light then light=false else light=true
if not light then glDisable(GL_LIGHTING) else glEnable(GL_LIGHTING)
case vk_F
filter+=1
if (filter>2) then filter=0
end select
case WM_CHAR
printl wParam
select case loword(wParam)
case 15 'Ctrl-O
SendMessage(hWnd, WM_COMMAND, IDM_Load,0)
case 18 'Ctrl-R
SendMessage(hWnd, WM_COMMAND, IDM_Reset,0)
end select
end select
end function
sub initMenu(sys hwnd)
sys hMenu
MENU(hMenu)
BEGIN
POPUP "&File"
BEGIN
MENUITEM "&Load Image..." tab "Ctrl+O", IDM_Load
MENUITEM "SEPARATOR"
MENUITEM "E&xit" tab "Alt+F4", IDM_Exit
ENDMenu
POPUP "&View"
BEGIN
MENUITEM "&Reset" tab "Ctrl+R", IDM_Reset
ENDMenu
POPUP "&Help"
BEGIN
MENUITEM "&Key Options" tab "F1", IDM_Help
ENDMenu
ENDMenu
if SetMenu( hWnd, hMenu ) = 0 then
mbox "SetMenu hMenu failed!"
end if
end sub
'====================================================================
function HelpDlgProc( sys hDlg, uint uMsg, sys wParam, lParam) as sys callback
string Result
sys hLText1=GetDlgItem(hDlg, IDC_LText1)
sys hLText2=GetDlgItem(hDlg, IDC_LText2)
select case uMsg
case WM_INITDIALOG
string HelpText1 =
"
F1
Ctrl-O
Ctrl-R
Left, Right
Up, Down
Page Up
Page Down
F
L
Alt-F4
ESC
"
string HelpText2 =
"
This Help
Load an image
Reset to original state
+/- rotate speed horizontal
+/- rotate speed vertical
Zoom Out
Zoom In
Change Filter (0-2)
Lighting on / off
quit
quit
"
SetWindowText (hLText1, HelpText1)
SetWindowText (hLText2, HelpText2)
case WM_CLOSE
'Hide Help Window
ShowWindow(hDlg, SW_HIDE)
end select
return 0
end function
'====================================================================
-
Hi Roland,
Adding callback will resolve the 64bit problem. (simple fix, but hard to trace!)
function WndMessages( sys hWnd, uint wMsg, sys wParam, lParam ) as sys, link WndProcExtra, callback
-
Thank you Charles. This is a brilliant solution and it works for 32-bit and 64-bit. And although this is logical I would not have found it. In the Oxygen distribution I found some examples which apply 'link'. I assume it is ok if I use the link option with callback only if the parent function also uses callback?
-
Hi Roland,
The calling convention is assumed to be external when calling a sys value (WndProcExtra). This is only critical in 64bit mode.
from OpengglSceneFrame.inc:
function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
================================================================
static sys a
'globals sys hDC,hRC
'
if WndProcExtra
a=call WndProcExtra(hwnd,uMsg,wParam,lParam)
if a then exit function
end if
select umsg
...