Ok, the idea is not really new. But perhaps it interests anyone. I have written a plugin for FreeBASIC, that uses the functions of dbpro.
The first tests ran so far error-free. Now I have rewritten in FreeBASIC the L-Type demo. Have split it into several files and use some of the advantages of FreeBasic.
The L-Type Project with source and executable can be download here.
DBPro-Utilities
[2015-06-16] - most recent
FreeBasic Plugin-Files
[2015-06-16] -> most recent
* lot of bugfixes
* Add ReleasePacker GUI
* fixed ReleasePacker (cl)
[2015-05-26] -> [OBSOLETE]
* Add DarkPhysics
* Add BlitzTerrain
Some bugfixes
[2015-05-12] -> [OBSOLETE]
* Add Advanced2D-Plugin
* Add AdvancedSPRITES-Plugin
* Add D3DFunc-Plugin
* Add SparkWrapper-Plugin
Some bugfixes.
[2015-05-04] -> [OBSOLETE]
* Add Release-Packer [rp.exe in tools Directory]
* Add ImageKitV2 with an Example
* Add Project Folder with currently 3 Projects( IKV2-Sample, LType2, ParticleView )
[2015-04-23] -> [OBSOLETE]
* Add 3 new Preset Functions
Sub dbPresetDisplay( _width As UInteger, _height As UInteger, _bpp As UInteger, _type As UInteger )
Sub dbPresetApplication( _instance As HINSTANCE, _title As ZString )
Sub dbPresetWindow( _parent As HWND, _this As HWND, _style As UInteger, _styleEx As UInteger )
* Add folowing Matrix1Util Plugins
- Matrix1Util_02
- Matrix1Util_05
- Matrix1Util_08
- Matrix1Util_09
- Matrix1Util_12
- Matrix1Util_18
- Matrix1Util_19
- Matrix1Util_30
- Matrix1Util_32
- Matrix1Util_33
* New Template to develop DBPro-Win-Application
To use this plugin show
here.
And here some code from the Project.
If there any interest for this plugin, I will develop it further.
LType2.bas
#Include "dbpro/dbprostart.bi"
#include "lt_common.bi"
Declare Sub DisplayStrap()
Declare Sub NewGame()
Declare Sub DrawHUD()
Dim g_Player As TPlayer Ptr
Dim g_Skybox As TSkybox Ptr
Dim g_Landscape As TLandscape Ptr
Dim g_Scuds As TScuds Ptr
Dim g_Explosion As TExplosion Ptr
Dim g_GProp As TGameProp
If LT2_Init()=0 Then End
g_GProp.iElapsed = 0
g_GProp.iOldTime = dbTimer()
While DBProLoop = 1
Dim As Integer ti = dbTimer()
g_GProp.iElapsed = ti - g_GProp.iOldTime
g_GProp.iOldTime = ti
If g_GProp.bGameOver=0 Then
g_Player->Control
Else
g_GProp.iTimeout -= g_GProp.iElapsed
g_Player->Hit
If g_GProp.iTimeout <= 0 Then
NewGame
EndIf
EndIf
g_Explosion->Update
g_Player->Animate
g_Skybox->Update
g_Landscape->Update
g_Scuds->Update
DrawHUD
' update strap
DisplayStrap
'dbText 0,0, Str(g_Player->dSpeed)
' scene update
dbSync
Wend
End
Sub NewGame()
dbHideParticles PFXID_EXPLOSION
g_GProp.bGameOver = 0
g_Landscape->NewMatrix
g_Player->dPosX = 0
g_Player->dPosY = 0
'dbShowObject OBJID_PLAYER
dbShowObject OBJID_SHIPEXHAUST
g_Player->PlayerReset
g_Scuds->ScudsReset
End Sub
Sub DisplayStrap()
Static strap_pos As Integer
strap_pos -= 1
If strap_pos < -dbImageWidth(IMGID_STRAPPROMPT) Then strap_pos = g_GProp.uiScreenWidth + 50
dbSprite IMGID_STRAPBLANK, 0, g_GProp.uiScreenHeight - dbImageHeight(IMGID_STRAPBLANK), IMGID_STRAPBLANK
dbSprite IMGID_STRAPPROMPT, strap_pos, g_GProp.uiScreenHeight - dbImageHeight(IMGID_STRAPPROMPT), IMGID_STRAPPROMPT
End Sub
Sub DrawHUD()
Dim As Integer bm = g_Player->dBestMiles
dbText 0,0, "FUEL"
dbText 0,16, "MILES"
dbText g_GProp.uiScreenWidth-dbTextWidth("BEST MILES"), 0, "BEST MILES"
dbText g_GProp.uiScreenWidth-dbTextWidth( Str(bm) ), 16, Str(bm)
Dim As Double size, colsize, milessize
size = (g_GProp.uiScreenWidth - 48.0 - 88.0) / 100.0 * g_Player->dFuel
colsize = (255.0 / 100.0) * g_Player->dFuel
dbBox 48, 2, 48 + size, 14, dbRgb(128, 0, 0), dbRgb(128, 0, 0), dbRgb(colsize, colsize, 0), dbRgb(colsize, colsize, 0)
milessize = g_Player->dMiles / 100.0
If milessize > 100.0 Then milessize = 100.0
size = (g_GProp.uiScreenWidth - 48.0 - 88.0) / 100.0 * milessize
colsize = (205.0 / 100.0) * milessize + 50
dbBox 48, 18, 48 + size, 30, dbRgb(0, 50, 0), dbRgb(0, 50, 0), dbRgb(0, colsize, 0), dbRgb(0, colsize, 0)
End Sub
LT_InitFunc.bas
#Include "dbpro/dbprostart.bi"
#Include "lt_common.bi"
Sub LT2_InitStrap()
dbLoadImage "media\gfx\prompt.bmp", IMGID_STRAPPROMPT
dbLoadImage "media\gfx\strapblank.bmp", IMGID_STRAPBLANK
End Sub
Function LT2_Init() As Byte
If initDBPro() = 0 Then Return 0
dbSyncOn : dbSyncRate 60
If dbCheckDisplayMode(1024, 768, 32) = 1 Then dbSetDisplayMode(1027, 768, 32) Else Return 0
dbMaximizeWindow
dbDrawSpritesLast
dbAutocamOff
g_GProp.uiScreenWidth = dbScreenWidth()
g_GProp.uiScreenHeight = dbScreenHeight()
' Loading screen
dbLoadBitmap "media\gfx\backdrop.jpg", 1
dbCopyBitmap 1, 0, 0, 640, 480, 0, 0, 0, g_GProp.uiScreenWidth, g_GProp.uiScreenHeight
dbSync : dbDeleteBitmap 1
LT2_InitStrap
g_Skybox = New TSkybox
dbSetCameraRange 1, 10000
dbSetCameraFov 30
dbPositionCamera 0, 0, -1000
dbRotateCamera 0, 0, 0
g_Explosion = New TExplosion
g_Player = New TPlayer
g_Scuds = New TScuds
g_Landscape = New TLandscape
g_Landscape->NewMatrix
Return 1
End Function
LT_Landscape.bas
#Include "dbpro/dbprostart.bi"
#Include "lt_common.bi"
Constructor TLandscape
' Create landscape
dbLoadImage "media\ground\ground.bmp", IMGID_GROUND
dbMakeMatrix MTXID_GROUND, 3000, 1500, 15, 15
dbPrepareMatrixTexture MTXID_GROUND, 1, 1, 1
dbPositionMatrix MTXID_GROUND, -750, -300, 0
End Constructor
Destructor TLandscape
dbDeleteMatrix MTXID_GROUND
dbDeleteImage IMGID_GROUND
End Destructor
Sub TLandscape.NewMatrix()
Dim As Double h, tr, n
For x As Integer = 0 To 15
dbSetMatrixHeight MTXID_GROUND, x, 0, 0
For z As Integer = 1 To 14
h = dbCos((z-7) * 20) * 100.0
h = h+tr
If x<13 Then h = 250.0
n = 0.25+(dbRnd(10)*0.75)
n = n * dbCos((z-8)*20)
dbSetMatrixHeight MTXID_GROUND, x, z, h
dbSetMatrixNormal MTXID_GROUND, x, z, n, n, n
Next
dbSetMatrixHeight MTXID_GROUND, x, 14, 0
tr = tr+(dbRnd(50)-25)
Next
dbUpdateMatrix MTXID_GROUND
End Sub
Sub TLandscape.Update()
Dim As Double h, mh, platy
' Control ground wrapping
wrap = wrap + wrapspeed
If wrap >= 400.0 Then
' shift old ground
wrap = wrap-400.0
dbShiftMatrixLeft MTXID_GROUND : dbShiftMatrixLeft MTXID_GROUND
' create new ground
mh = dbRnd(500)
dbSetMatrixHeight MTXID_GROUND, 13, 0, 0
dbSetMatrixHeight MTXID_GROUND, 14, 0, 0
For z As Integer = 1 To 13
h = mh*dbCos((z-7) * 20)
dbSetMatrixHeight MTXID_GROUND, 13, z, h
dbSetMatrixHeight MTXID_GROUND, 14, z, h
If z=5 Then platy=h
mh = mh+(dbRnd(20)-10)
Next
dbSetMatrixHeight MTXID_GROUND, 13, 14, 0
dbSetMatrixHeight MTXID_GROUND, 14, 14, 0
dbUpdateMatrix MTXID_GROUND
' if random chance for new scud
If dbRnd(3) = 0 Then
' place scud
g_Scuds->NewScud (3000-750)-500,-300+platy,500
EndIf
EndIf
dbPositionMatrix MTXID_GROUND, -750-200-wrap, -300, 0
End Sub