' Direct3D Demonstration
' (C) R.T.Russell 2015, http://lbbooster.com/

nomainwin
WindowWidth=DisplayWidth
WindowHeight=DisplayHeight

open "D3D8.DLL" for DLL as #d3d8
open "OLEAUT32.DLL" for DLL as #oleaut32
if instr(Platform$, "LBB") then
  open "Direct3D Demonstration" for window as #w
else
  open "Direct3D Demonstration" for graphics_nsb as #w
end if
#w "when characterInput [key]"
#w "trapclose [quit]"
hw=hwnd(#w)

calldll #d3d8, "Direct3DCreate8", 120 as long, IDirect3D8 as long

struct D3DDISPLAYMODE,_
  Width as long, Height as long,_
  RefreshRate as long, Format as long
struct parm, Adapter1 as long, pMode as struct

parm.pMode.struct=D3DDISPLAYMODE.struct
r=CallMethod(IDirect3D8, 8, parm.struct) ' ::GetAdapterDisplayMode
D3DDISPLAYMODE.struct=parm.pMode.struct

struct D3DPARMS,_
  BackBufferWidth as long, BackBufferHeight as long,_
  BackBufferFormat as long, BackBufferCount as long,_
  MultiSampleType as long, SwapEffect as long,_
  DeviceWindow as long, Windowed as long,_
  EnableAutoDepthStencil as long,_
  AutoDepthStencilFormat as long,_
  Flags as long, FullScreenRefreshRateInHz as long,_
  FullScreenPresentationInterval as long
D3DPARMS.BackBufferFormat.struct=D3DDISPLAYMODE.Format.struct
D3DPARMS.SwapEffect.struct=1
D3DPARMS.Windowed.struct=1
D3DPARMS.EnableAutoDepthStencil.struct=1
D3DPARMS.AutoDepthStencilFormat.struct=80

struct parm,_
  Adapter as long, DeviceType as long, FocusWindow as ulong,_
  BehaviorFlags as long, PresentationParameters as struct,_
  ReturnedDeviceInterface as struct
struct temp, v as long
parm.DeviceType.struct=1
parm.FocusWindow.struct=hw
parm.BehaviorFlags.struct=32
parm.PresentationParameters.struct=D3DPARMS.struct
parm.ReturnedDeviceInterface.struct=temp.struct
r=CallMethod(IDirect3D8, 15, parm.struct) ' ::CreateDevice
temp.struct=parm.ReturnedDeviceInterface.struct
IDirect3DDevice8=temp.v.struct

' IDirect3DDevice8::SetRenderState
struct parm, State as long, Value as long
parm.State.struct=22 ' D3DRS_CULLMODE
parm.Value.struct=2
r=CallMethod(IDirect3DDevice8, 50, parm.struct)
parm.State.struct=137 ' D3DRS_LIGHTING
parm.Value.struct=0
r=CallMethod(IDirect3DDevice8, 50, parm.struct)
parm.State.struct=7  ' D3DRS_ZENABLE
parm.Value.struct=1
r=CallMethod(IDirect3DDevice8, 50, parm.struct)

triangles=12
vertices=3*triangles
vertexshader=hexdec("52")
vertexsize=28

struct temp, v as long
struct parm,_
  Length as long, Usage as long, FVF as long,_
  Pool as long, VertexBuffer as struct
parm.Length.struct=vertices*vertexsize
parm.FVF.struct=vertexshader
parm.VertexBuffer.struct=temp.struct
r=CallMethod(IDirect3DDevice8, 23, parm.struct) ' ::CreateVertexBuffer
temp.struct=parm.VertexBuffer.struct
IDirect3DVertexBuffer8=temp.v.struct

struct temp, v as long
struct parm,_
  OffsetToLock as long, SizeToLock as long,_
  ppbData as struct, Flags as long
parm.SizeToLock.struct=vertices*vertexsize
parm.ppbData.struct=temp.struct
r=CallMethod(IDirect3DVertexBuffer8, 11, parm.struct) ' ::Lock
temp.struct=parm.ppbData.struct
VertexData=temp.v.struct

for tri = 0 to 11
  read c$ : c = hexdec(c$)
  for ver = tri*3 to tri*3 + 2
    for p=VertexData+ver*vertexsize to VertexData+ver*vertexsize+20 step 4
      read r
      calldll #oleaut32, "VarR4FromR8", r as double, p as long, r as void
    next p
    calldll #oleaut32, "VarUI4FromUI8", c as ulong, 0 as long, p as long, r as void
  next ver
next tri
r=CallMethod(IDirect3DVertexBuffer8, 12, "") ' ::Unlock

struct parm, StreamNumber as long, StreamData as long, Stride as long
parm.StreamData.struct=IDirect3DVertexBuffer8
parm.Stride.struct=vertexsize
r=CallMethod(IDirect3DDevice8, 83, parm.struct) ' ::SetStreamSource

struct parm, Handle as long
parm.Handle.struct=vertexshader
r=CallMethod(IDirect3DDevice8, 76, parm.struct) ' ::SetVertexShader

timer 20, [render]
wait

[key]
select case Inkey$
  case chr$(0)+chr$(37): Xcam = Xcam - 0.5
  case chr$(0)+chr$(39): Xcam = Xcam + 0.5
  case chr$(0)+chr$(38): Ycam = Ycam + 0.5
  case chr$(0)+chr$(40): Ycam = Ycam - 0.5
end select
wait

[render]
yaw=time$("ms") / 2000
roll=time$("ms") / 800

struct parm,_
  Count as long, pRects as long, Flags as long,_
  BackColor as long, Z as long, Stencil as long
parm.Flags.struct=3
parm.BackColor.struct=hexdec("808080")
parm.Z.struct=float(1)
r=CallMethod(IDirect3DDevice8, 36, parm.struct) ' ::Clear
r=CallMethod(IDirect3DDevice8, 34, "") ' ::BeginScene

struct matrix,_
  f11 as long, f12 as long, f13 as long, f14 as long,_
  f21 as long, f22 as long, f23 as long, f24 as long,_
  f31 as long, f32 as long, f33 as long, f34 as long,_
  f41 as long, f42 as long, f43 as long, f44 as long

matrix.f11.struct=float(1)
matrix.f22.struct=float(1)
matrix.f33.struct=float(1)
matrix.f43.struct=float(24) ' Viewing distance
matrix.f44.struct=float(1)
struct parm, State as long, Matrix as struct
parm.State.struct=2 ' view transform
parm.Matrix.struct=matrix.struct
r=CallMethod(IDirect3DDevice8, 37, parm.struct) ' ::SetTransform

fv=0.5  ' Vertical field of view
ar=DisplayWidth / DisplayHeight ' Aspect ratio
zn=1    ' Near clipping plane
zf=1000 ' Far clipping plane
h=1/tan(fv/2)
matrix.f11.struct=float(h/ar)
matrix.f22.struct=float(h)
matrix.f33.struct=float(zf/(zf-zn))
matrix.f44.struct=float(0)
matrix.f34.struct=float(1)
matrix.f43.struct=float(0-zn*zf/(zf-zn))
parm.State.struct=3 ' projection transform
parm.Matrix.struct=matrix.struct
r=CallMethod(IDirect3DDevice8, 37, parm.struct) ' ::SetTransform

for cube = 0 to 4
  Xpos = Xcam + 4*cube - 8
  Ypos = Ycam

  sy=sin(yaw) : cy=cos(yaw)
  sp=sin(pitch) : cp=cos(pitch)
  sr=sin(roll) : cr=cos(roll)
  matrix.f11.struct=float(sy*sp*sr+cy*cr)
  matrix.f12.struct=float(cp*sr)
  matrix.f13.struct=float(cy*sp*sr-sy*cr)
  matrix.f14.struct=0
  matrix.f21.struct=float(sy*sp*cr-cy*sr)
  matrix.f22.struct=float(cp*cr)
  matrix.f23.struct=float(cy*sp*cr+sy*sr)
  matrix.f24.struct=0
  matrix.f31.struct=float(cp*sy)
  matrix.f32.struct=float(0-sp)
  matrix.f33.struct=float(cp*cy)
  matrix.f34.struct=0
  matrix.f41.struct=float(Xpos)
  matrix.f42.struct=float(Ypos)
  matrix.f43.struct=float(Zpos)
  matrix.f44.struct=float(1)
  struct parm, State as long, Matrix as struct
  parm.State.struct=256 ' world transform
  parm.Matrix.struct=matrix.struct
  r=CallMethod(IDirect3DDevice8, 37, parm.struct) ' ::SetTransform

  struct parm,_
    PrimitiveType as long,_
    StartVertex as long, PrimitiveCount as long
  parm.PrimitiveType.struct=4 ' D3DPT_TRIANGLELIST
  parm.PrimitiveCount.struct=triangles
  r=CallMethod(IDirect3DDevice8, 70, parm.struct) ' ::DrawPrimitive
next cube

r=CallMethod(IDirect3DDevice8, 35, "") ' ::EndScene

struct parm,_
  SourceRect as struct, DestRect as struct,_
  DestWindowOverride as long, DirtyRegion as struct
r=CallMethod(IDirect3DDevice8, 15, parm.struct) ' ::Present

' Fix float underflow exception (LB only)
bugfix$=chr$(219)+chr$(227)+chr$(194)+chr$(16)
calldll #user32, "CallWindowProcA", bugfix$ as ptr,_
  0 as long, 0 as long, 0 as long, 0 as long, r as long

wait

[quit]
r=CallMethod(IDirect3DVertexBuffer8, 2, "") ' ::Release
r=CallMethod(IDirect3DDevice8, 2, "") ' ::Release
r=CallMethod(IDirect3D8, 2, "") ' ::Release
close #w
close #oleaut32
close #d3d8
end

' Cube (12 triangles):
data "FF0000FF",  1,-1,-1,  0,-1, 0,  -1,-1,-1,  0,-1, 0,  -1,-1, 1,  0,-1, 0
data "FF0000FF", -1,-1, 1,  0,-1, 0,   1,-1, 1,  0,-1, 0,   1,-1,-1,  0,-1, 0
data "FF00FF00", -1, 1, 1,  0, 1, 0,  -1, 1,-1,  0, 1, 0,   1, 1,-1,  0, 1, 0
data "FF00FF00",  1, 1,-1,  0, 1, 0,   1, 1, 1,  0, 1, 0,  -1, 1, 1,  0, 1, 0
data "FF00FFFF",  1, 1,-1,  1, 0, 0,   1,-1,-1,  1, 0, 0,   1,-1, 1,  1, 0, 0
data "FF00FFFF",  1,-1, 1,  1, 0, 0,   1, 1, 1,  1, 0, 0,   1, 1,-1,  1, 0, 0
data "FFFF0000", -1,-1, 1, -1, 0, 0,  -1,-1,-1, -1, 0, 0,  -1, 1,-1, -1, 0, 0
data "FFFF0000", -1, 1,-1, -1, 0, 0,  -1, 1, 1, -1, 0, 0,  -1,-1, 1, -1, 0, 0
data "FFFF00FF",  1,-1, 1,  0, 0, 1,  -1,-1, 1,  0, 0, 1,  -1, 1, 1,  0, 0, 1
data "FFFF00FF", -1, 1, 1,  0, 0, 1,   1, 1, 1,  0, 0, 1,   1,-1, 1,  0, 0, 1
data "FFFFFF00", -1, 1,-1,  0, 0,-1,  -1,-1,-1,  0, 0,-1,   1,-1,-1,  0, 0,-1
data "FFFFFF00",  1,-1,-1,  0, 0,-1,   1, 1,-1,  0, 0,-1,  -1, 1,-1,  0, 0,-1

function float(n)
struct temp, v as long
calldll #oleaut32, "VarR4FromR8", n as double, temp as struct, r as void
float=temp.v.struct
end function

function CallMethod(object, method, parm$)
code$=chr$(139)+"D$"+chr$(4)+chr$(139)+"T$"+chr$(8)+chr$(139)+"L$" _
+ chr$(16)+"VW"+chr$(139)+"t$"+chr$(20)+chr$(43)+chr$(225)+chr$(139) _
+ chr$(252)+chr$(243)+chr$(164)+chr$(80)+chr$(139)+chr$(0)+chr$(255) _
+ chr$(20)+chr$(144)+chr$(95)+chr$(94)+chr$(194)+chr$(16)+chr$(0)

p$=parm$
n=len(p$)
calldll #user32, "CallWindowProcA", code$ as ptr, object as long,_
  method as long, p$ as ptr, n as long, CallMethod as long
end function