[english]Inline assembler convert real to float and OpenGL

LIBRARY 1,"kernel32"
' params: dstAddress%, srcAddress%, nBytes%
COMMAND "copy","RtlMoveMemory",1,"III","stdcall"

LIBRARY 2,"user32"
' params: pProcAddress%, hWin%, hMSG%, wParam%, lParam%
COMMAND "CallWindowProc","CallWindowProcA",2,"IIIII","stdcall"
' params: hWIN%, hDC%
COMMAND "ReleaseDC","ReleaseDC",2,"II","stdcall"

LIBRARY 3,"gdi32"
' params: hDC%
COMMAND "SwapBuffers","SwapBuffers",3,"I","stdcall"
' params: hDC%, nFormat%, adr(PIXELFORMATDESCRIPTOR)
COMMAND "SetPixelFormat","SetPixelFormat",3,"III","stdcall"

LIBRARY 4,"opengl32"
' params: hDC%, hRC%
COMMAND "wglMakeCurrent","wglMakeCurrent",4,"II","stdcall"
' params: hRC%
COMMAND "wglDeleteContext" ,"wglDeleteContext",4,"I","stdcall"
' params: left%, bottom%, width%, height%
COMMAND "glViewport" ,"glViewport",4,"IIII","stdcall"
' params: (float) red, green, blue, alpha
COMMAND "glClearColor","glClearColor",4,"IIII","stdcall"
' params: GL_XXX_BUFFER_BITS (color,depth,stencil ...)
COMMAND "glClear","glClear",4,"I","stdcall"
' params: GL_XXX
COMMAND "glEnable","glEnable",4,"I","stdcall"
' params: GL_XXX
COMMAND "glDisable","glDisable",4,"I","stdcall"

' params: primitive% GL_XXX (points,lines,triangles,quads, ...
COMMAND "glBegin","glBegin",4,"I","stdcall"
' params: none
COMMAND "glEnd","glEnd",4,"","stdcall"
' params: real x,y,z
COMMAND "glVertex3d","glVertex3d",4,"RRR","stdcall"

LIBRARY 5,"winmm"
' params adr(adr("file.wav")), flag%
COMMAND "sndPlaySound","sndPlaySoundA",5,"II","stdcall"

label labRealToFloat,main,timerProc
label resize,close


labRealToFloat:    : ' convert a Panoramic real (double) to float
data "55"          : ' push  ebp
data "89","e5"      : ' mov    ebp,esp
data "8b","75","0c" : ' mov    esi,DWORD PTR [ebp+0xc]
data "dd","06"      : ' fld    QWORD PTR [esi]
data "8b","75","08" : ' mov    esi,DWORD PTR [ebp+0x8]
data "d9","1e"      : ' fstp  DWORD PTR [esi]
data "5d"          : ' pop    ebp
data "c2","10","00" : ' ret    0x10
data ""

dim opcode$,asmRealToFloat$,pRealToFloat%

' put the hex opcodes from data lines
' in string asmRealToFloat$
restore_label labRealToFloat
read opcode$
while len(opcode$)>0
  asmRealToFloat$ = asmRealToFloat$ + chr$(hex(opcode$))
  read opcode$
end_while
' get address of the assembler code p =*p
pRealToFloat% = adr(asmRealToFloat$)
copy adr(pRealToFloat%),pRealToFloat%,4

' jump over the functions
goto main

' convert a real number to float and store it as integer
fnc Float(real)
  dim_local float%
  CallWindowProc pRealToFloat%,adr(float%),adr(real),0,0
  result float%
end_fnc

' create OpenGL render context hRC% from device context hDC%
' with 24 bit color buffer 24 bit depth buffer and 8 bit stencil buffer
fnc InitOpenGL(hDC%)
  dim_local res%,hRC%,type$,p%,ptr%
  if hDC%<>0
    type$ = string$(40,chr$(0))
    p% = adr(type$)
    copy adr(ptr%), p%, 4      : ' ptr = *p
   
    poke ptr%,40 : ptr%=ptr% + 2 : ' WORD  wSize sizeof(tagPIXELFORMATDESCRIPTOR)
    poke ptr%, 1 : ptr%=ptr% + 2 : ' WORD  wVersion
    poke ptr%,37 : ptr%=ptr% + 4 : ' DWORD dwFlag  DOUBLEBUFFER 1 or DRAW_TO_WINDOW 4 or SUPPORT_OPENGL 32
    poke ptr%, 0 : ptr%=ptr% + 1 : ' BYTE  iPixelType  PFD_TYPE_RGBA
    poke ptr%,24 : ptr%=ptr% +14 : ' BYTE  cColorBits
    poke ptr%,24 : ptr%=ptr% + 1 : ' BYTE  cDepthBits
    poke ptr%, 8 : ptr%=ptr% + 2 : ' BYTE  cStencilBits
    poke ptr%, 0 : ptr%=ptr% + 1 : ' BYTE  iLayerType PFD_MAIN_PLANE
         
    copy adr(ptr%), p%, 4 : ' ptr = *p
    dll_on "gdi32"
      res% = dll_Call2("ChoosePixelFormat",hDC%,ptr%)
    dll_off 
    if res%<>0
      SetPixelFormat hDC%,res%,ptr%
      dll_on "opengl32"
        hRC% = dll_call1("wglCreateContext",hDC%)
      dll_off
      if hRC%<>0
        wglMakeCurrent hDC%,hRC%
      end_if
    end_if       
  end_if
 
  result hRC%
 
end_fnc

'
' main
'
main:
dim Form%
on_resize Form%,resize
on_close  Form%,close

 
' full_space Form%

dim hWIN%,hDC%,hRC%

dim RederTarget% : RederTarget% = number_objects+1
' container RederTarget%
panel RederTarget% 
gosub resize
   
dim Button% : Button% = number_objects+1
button Button% : parent Button%,RederTarget%
left Button%,50
top  Button%,50
caption Button%,"OpenGL"

hWIN% = handle(RederTarget%)
dll_on "user32"
  hDC% = dll_call1("GetDC",hWIN%)
dll_off
if hDC% = 0 then stop : ' TERMINATE

' init OpenGL render context from device context
hRC% = InitOpenGL(hDC%)
if hRC%=0 then stop : ' TERMINATE

glViewport 0,0,width(RederTarget%),height(RederTarget%)
SwapBuffers hDC%

dim tmr% : tmr% = number_objects+1
timer tmr%
timer_interval tmr%,1000/60
on_timer      tmr%,timerProc

dim w

' go in main message loop
end

close:
  ' unbind the OpenGL render context
  wglMakeCurrent 0,0
  ' delete the render context
  wglDeleteContext hRC%
  ' release the device context
  ReleaseDC hWIN%,hDC%
  return 

resize:
  left  RederTarget%,50
  top    RederTarget%,50
  width  RederTarget%,width_client(Form%)-100
  height RederTarget%,height_client(Form%)-100
  return

timerProc:
  glClearColor Float(0.5 + sin(w)*0.5),0,0,Float(1.0)
  glClear hex("4000") : ' GL_COLOR_BUFFER_BITS 
  SwapBuffers hDC%
  w = w + 0.1
  return