OpenglSceneFrame and console?

[Arnold]

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.

Code: [Select]

   '' 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


[Arnold]

I found my mistake. Only a small change is necessary. I modified the code in my previous post.

[Charles Pegge]

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)

Code: [Select]


  '#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


[Arnold]

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.

[Charles Pegge]

I've decapitalised some of your function names in dialog.inc, so that it can be used with #case capital

[Arnold]

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

Code: [Select]

' 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

'====================================================================


[Charles Pegge]

Hi Roland,

Adding callback will resolve the 64bit problem. (simple fix, but hard to trace!)

Code: [Select]

function WndMessages( sys hWnd, uint wMsg, sys wParam, lParam ) as sys, link WndProcExtra, callback


[Arnold]

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?

[Charles Pegge]

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:

Code: [Select]

  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
  ...