Menu
▾
▴
[Win32forth-cvs] win32forth-stc/demos/COM D3Dtest.f, NONE, 1.1 EX_ADO.F, NONE, 1.1 EX_D3D.F, NONE, 1.1 EX_DDRAW.F, NONE, 1.1 EX_SAPI.F, NONE, 1.1
|
From: Jos v.d.V. <jo...@us...> - 2007-05-16 20:35:45
|
Update of /cvsroot/win32forth/win32forth-stc/demos/COM In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10247 Added Files: D3Dtest.f EX_ADO.F EX_D3D.F EX_DDRAW.F EX_SAPI.F Log Message: Jos: Tom Dixon's COM demo's. --- NEW FILE: EX_ADO.F --- \ $Id: EX_ADO.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of using ADO \ Thomas Dixon \ This is a very simple sql utility needs fcom 2 7 typelib {EF53050B-882E-4776-B643-EDA472E8E3F2} \ inlude ADO type library _RecordSet ComIFace rec create DSN 1024 allot \ DSN holder create querybuf 1024 allot \ holds the query buffer create cCol 32 allot u" ," cCol uniplace \ Column Delimeter create NL 32 allot crlf$ count >unicode NL uniplace \ New Record Delimeter create nullch 32 allot u" " nullch uniplace \ Null Character Replacement create sqlbuf 0 , 0 , \ holds the returned buffer : DSN! ( str len -- ) \ store the connection string (ODBC) rec @ 0= if rec _RecordSet 1 0 RecordSet call CoCreateInstance abort" Unable to Create ADO Recordset!" then asc>uni 2dup DSN uniplace drop free drop ; : SQLEXEC ( options locktype cursortype -- ) 0 DSN unicount drop 0 8 0 querybuf unicount drop 0 8 rec open abort" Unable to Execute SQL Query!" ; : records>str ( -- str len ) \ converts recordset to string sqlbuf @ ?dup if free drop then 0 sqlbuf ! sqlbuf nullch unicount drop NL unicount drop ccol unicount drop -1 2 rec GetString abort" Unable to convert data to String!" sqlbuf @ dup zunicount uni>asc 2dup sqlbuf cell+ ! sqlbuf ! rot call CoTaskMemFree drop ; : SQL ( str len -- str len ) \ executes a query asc>uni 2dup querybuf uniplace drop free drop adOptionUnspecified adLockUnspecified adOpenDynamic SQLEXEC records>str ; (( \ Here is a simple example I use on my System \ (Assumes 'DBTest' is a dsn on the machine with a table called 'test') s" DSN=DBTest" dsn! \ Load the DSN s" Select * FROM test" SQL cr type \ Execute a query rec close drop \ cleanup )) --- NEW FILE: EX_D3D.F --- \ $Id: EX_D3D.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of using Direct3d (Directx 8.1) \ Thomas Dixon needs fcom 1 0 typelib {E1211242-8E94-11D1-8808-00C04FC2C603} \ Load Directx 8.1 winlibrary dx8vb.dll \ Interfaces IDirectx8 ComIFace dx8 Direct3D8 ComIFace d3d Direct3DDevice8 ComIFace d3dev ID3dx8 Comiface d3dhelper D3DXBuffer ComIFace meshbuf D3DXMesh COMIFace mesh \ Structures D3DDISPLAYMODE d3dmode D3DPRESENT_PARAMETERS d3dpp D3DMATRIX matworld D3DMATERIAL8 meshmat D3DLIGHT8 dlight : setup-d3d ( -- ) dx8 IDirectx8 1 0 Directx8 call CoCreateInstance abort" Unable to get Directx!" d3d dx8 Direct3dCreate abort" Direct3dCreate Failed!" d3dmode D3DADAPTER_DEFAULT d3d GetAdapterDisplayMode abort" Unable to get Mode!" 1 d3dpp windowed ! D3DSWAPEFFECT_COPY_VSYNC d3dpp swapeffect ! d3dmode format @ d3dpp BackBufferFormat ! d3dev d3dpp D3DCREATE_SOFTWARE_VERTEXPROCESSING ( Change "software" to "hardware" for speed) conhndl D3DDEVTYPE_HAL D3DADAPTER_DEFAULT d3d CreateDevice abort" Unable to create device!" d3dhelper ID3DX8 1 0 D3DX8 call CoCreateInstance abort" Unable to get d3dx8!" ; : free-d3d ( -- ) d3dev release drop d3d release drop dx8 release drop ; variable nummat 0 nummat ! D3DVECTOR v1 D3DVECTOR v2 D3DVECTOR v3 : v! ( fz fy fx v -- ) dup sf! dup 4 + sf! 8 + sf! ; : color>cstruct ( fr fg fb fa addr -- ) dup COM D3DCOLORVALUE a sf! dup COM D3DCOLORVALUE b sf! dup COM D3DCOLORVALUE g sf! COM D3DCOLORVALUE r sf! ; : load-demo ( -- ) setup-d3d \ Setup the World Matrix matworld call VB_D3DXMatrixIdentity drop matworld D3DTS_WORLD d3dev SetTransform drop \ Setup the View Matrix -5e0 3e0 0e0 v1 v! \ eye 0e0 0e0 0e0 v2 v! \ at 0e0 1e0 0e0 v3 v! \ look v3 v2 v1 matworld call VB_D3DXMatrixLookAtLH drop matworld D3DTS_VIEW d3dev SetTransform drop \ Setup the Projection Matrix 1000e0 sfs>ds 1e0 sfs>ds dup .785398e0 sfs>ds matworld call VB_D3DXMatrixPerspectiveFovLH drop matworld D3DTS_PROJECTION d3dev SetTransform drop \ Render States (initial) D3DFILL_WIREFRAME D3DRS_FILLMODE d3dev SetRenderState drop 1 D3DRS_CLIPPING d3dev SetRenderState drop D3DCULL_CCW D3DRS_CULLMODE d3dev setRenderState drop \ Setup the Light Source (directional from above) D3DLIGHT_DIRECTIONAL dlight Type ! 1e0 1e0 1e0 0e0 dlight diffuse color>cstruct 0.5e0 dlight Direction x sf! -3e0 dlight Direction y sf! 0.5e0 dlight Direction z sf! 1000e0 dlight Range sf! dlight 0 d3dev setlight abort" Unable to set light source!" 1 D3DRS_LIGHTING d3dev SetRenderState drop 1 0 d3dev LightEnable abort" No Light Sources Supported!" $202020 D3DRS_AMBIENT d3dev setrenderstate drop D3DSHADE_GOURAUD D3DRS_SHADEMODE d3dev SetRenderState drop ; \ Words to load various mesh shapes : load-teapot ( --) mesh @ if mesh release drop then mesh meshbuf d3dev @ d3dhelper CreateTeapot abort" Unable to Load Teapot!" ; : load-sphere ( --) mesh @ if mesh release drop then mesh meshbuf 20 20 1e0 sfs>ds d3dev @ d3dhelper CreateSphere abort" Unable to Load Sphere!" ; : load-torus ( --) mesh @ if mesh release drop then mesh meshbuf 20 20 1e0 sfs>ds .5e0 sfs>ds d3dev @ d3dhelper CreateTorus abort" Unable to Load Sphere!" ; : load-box ( --) mesh @ if mesh release drop then mesh meshbuf 1.0e0 sfs>ds dup dup d3dev @ d3dhelper CreateBox abort" Unable to Load Sphere!" ; \ Matrix! : m! ( f1 f2 ... f16 mat -- ) 0 15 do dup i cells + sf! -1 +loop drop ; \ Rotate (matrix multiply) 0e0 fvalue angle : rotate ( -- ) angle fcos 0e0 angle fsin -1e0 f* 0e0 0e0 1e0 0e0 0e0 angle fsin 0e0 angle fcos 0e0 0e0 0e0 0e0 1e0 matworld m! matworld D3DTS_WORLD d3dev SetTransform drop ; : vclear ( -- ) 0 1e0 sfs>ds $FFFFFF D3DCLEAR_TARGET 0 0 d3dev Clear drop ; : beginScene ( -- ) d3dev beginScene drop ; : endScene ( -- ) d3dev endscene drop ; : Present ( -- ) 0 0 0 0 d3dev Present drop ; \ special effects : wire ( -- ) D3DFILL_WIREFRAME D3DRS_FILLMODE d3dev setrenderstate drop ; : setred ( -- ) D3DFILL_SOLID D3DRS_FILLMODE d3dev SetRenderState drop 1e0 0e0 0e0 1e0 meshmat ambient color>cstruct 1e0 0e0 0e0 1e0 meshmat diffuse color>cstruct meshmat d3dev SetMaterial drop ; : setgreen ( -- ) D3DFILL_SOLID D3DRS_FILLMODE d3dev SetRenderState drop 0e0 1e0 0e0 1e0 meshmat ambient color>cstruct 0e0 1e0 0e0 1e0 meshmat diffuse color>cstruct meshmat d3dev SetMaterial drop ; : setblue ( -- ) D3DFILL_SOLID D3DRS_FILLMODE d3dev SetRenderState drop 0e0 0e0 1e0 1e0 meshmat ambient color>cstruct 0e0 0e0 1e0 1e0 meshmat diffuse color>cstruct meshmat d3dev SetMaterial drop ; : demo ( -- ) load-demo load-teapot begin vclear rotate beginscene 0 mesh drawsubset drop 0.05e0 angle f+ fdup 6.28319e0 f> if 6.28319e0 f- then fto angle key? if false key case 49 of wire endof 50 of setred endof 51 of setgreen endof 52 of setblue endof 53 of load-teapot endof 54 of load-sphere endof 55 of load-torus endof 56 of load-box endof 27 of drop true endof endcase else false then endscene present until free-d3d ; demo (( Instructions for the demo: just run "demo" and you find a rotating teapot in the window. some keys will change the way this demo works. 1 = Wire frame rendering 2 = red filling 3 = green filling 4 = blue filling 5 = teapot shape 6 = sphere shape 7 = torus shape 8 = box shape esc = end demo )) --- NEW FILE: D3Dtest.f --- \ $Id: D3Dtest.f,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of drawing one triangle using Direct3d (Directx 8.1) \ Thomas Dixon needs fcom 1 0 typelib {E1211242-8E94-11D1-8808-00C04FC2C603} \ Load Directx 8.1 \ Interfaces IDirectx8 ComIFace dx8 Direct3D8 ComIFace d3d Direct3DDevice8 ComIFace d3dev \ Structures D3DDISPLAYMODE d3dmode D3DPRESENT_PARAMETERS d3dpp \ custom vertex D3DFVF_XYZRHW D3DFVF_DIFFUSE or value FVF_Custom 20 value vertsize : vertarray ( n -- ) create vertsize * allot does> swap vertsize * + ; : setup-d3d ( -- ) dx8 IDirectx8 1 0 Directx8 call CoCreateInstance abort" Unable to get Directx!" d3d dx8 Direct3dCreate abort" Direct3dCreate Failed!" d3dmode D3DADAPTER_DEFAULT d3d GetAdapterDisplayMode abort" Unable to get Mode!" 1 d3dpp windowed ! D3DSWAPEFFECT_COPY_VSYNC d3dpp swapeffect ! d3dmode format @ d3dpp BackBufferFormat ! d3dev d3dpp D3DCREATE_SOFTWARE_VERTEXPROCESSING ( Change "software" to "hardware" for speed) conhndl D3DDEVTYPE_HAL D3DADAPTER_DEFAULT d3d CreateDevice abort" Unable to create device!" ; : free-d3d ( -- ) d3dev release drop d3d release drop dx8 release drop ; \ Initialize the vertext buffer 3 vertarray vert : vert! ( color rhw fz fy fx vert -- ) 4 0 do dup i cells + sf! loop 4 cells + ! ; $ffff0000 1e0 0.5e0 50.0e0 150.0e0 0 vert vert! $ff00ff00 1e0 0.5e0 250.0e0 250.0e0 1 vert vert! $ff00ffff 1e0 0.5e0 250.0e0 50.0e0 2 vert vert! : tri-list ( listarray n -- ) FVF_Custom d3dev SetVertexShader drop vertsize -rot D3DPT_TRIANGLELIST d3dev DrawPrimitiveUP drop ; : vclear ( -- ) 0 1e0 sfs>ds $FF D3DCLEAR_TARGET 0 0 d3dev Clear drop ; : beginScene ( -- ) d3dev beginScene drop ; : endScene ( -- ) d3dev endscene drop ; : Present ( -- ) 0 0 0 0 d3dev Present drop ; setup-d3d vclear beginscene 0 vert 3 tri-list endscene present free-d3d --- NEW FILE: EX_DDRAW.F --- \ $Id: EX_DDRAW.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of using Direct Draw (Directx) \ Thomas Dixon needs fcom 1 0 typelib {E1211242-8E94-11D1-8808-00C04FC2C602} \ Load Directx7 \ Interfaces IDirectx7 ComIFace dx7 DirectDraw7 ComIFace dd7 DirectDrawSurface7 ComIFace primary \ Structures DDSURFACEDESC2 ddsdl \ define a surface structure Rect winrect : window-mode ( -- ) DDSCL_NORMAL conhndl dd7 SetCooperativeLevel abort" SetCooperativelevel failed!" ; : full-screen ( color width height -- ) DDSCL_FULLSCREEN DDSCL_ALLOWMODEX DDSCL_EXCLUSIVE or or conhndl dd7 setCooperativeLevel abort" SetCooperativeLevel failed!" >r 2>r DDSDM_DEFAULT 0 2r> r> dd7 setdisplaymode abort" Unable to set display mode!" ; : setup-ddraw ( -- ) dx7 IDirectx7 1 0 Directx7 CoCreateInstance abort" Unable to get Directx!" dd7 0 dx7 DirectDrawCreate abort" DirectDrawCreate failed!" 16 480 640 full-screen \ set screen resolutuion (use window-mode to work from a window) DDSD_CAPS ddsdl lFlags ! DDSCAPS_PRIMARYSURFACE ddsdl ddsCaps lCaps ! primary ddsdl dd7 CreateSurface abort" Primary surface failed!" ; : get-rect ( -- ) winrect conhndl dx7 getwindowrect drop ; : rand-circle ( -- ) $FF random 16 lshift $FF random 8 lshift $FF random + + primary setforecolor drop 200 random 480 random 640 random primary drawcircle drop ; : test get-rect 0 do rand-circle loop ; (( \ This is a simple example using directdraw. DirectDraw is optimized for blitting \ in 2D. It is also fast, fairly low-level, and supports hardware acceleration. \ In this example, we don't blit at all, we just draw lots of random circles. )) setup-ddraw 10000 test --- NEW FILE: EX_SAPI.F --- \ $Id: EX_SAPI.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of Speech API \ Thomas Dixon needs FCOM.F \ SAPI 5.0 typelibrary 5 0 typelib {C866CA3A-32F7-11D2-9602-00C04F8EE628} ISpVoice ComIFace voice \ Create voice instance voice ISpVoice 1 0 SpVoice call CoCreateInstance drop 0 0 u" Hello World!" drop voice speak . \ Say it slower -9 voice setrate . 0 0 u" I'm talking slower now." drop voice speak . \ Say it faster 5 voice setrate . 0 0 u" I'm talking fast now." drop voice speak . \ Say it higher 0 voice setrate . \ Example of how to build it as an exe! : main ( -- ) voice ISpVoice 1 0 SpVoice call CoCreateInstance if true s" Unable to Create SPVoice!" ?messagebox bye then 0 0 u" Hello World!" drop voice speak if true s" Unable to Speak!" ?messagebox bye then 0 bye ; \ ' main turnkey speak.exe |
