xaymar/Legacy-Projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add projects including README.md(s), .gitignore(s) and the actual project files.

Browse Source 
Signed-off-by: Michael Fabian Dirks <michael.dirks@project-kube.de>
This commit is contained in:
Michael Fabian Dirks
2014-11-24 18:18:24 +01:00
parent 934da62076
commit 8f3114e377
170 changed files with 22028 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files
BlitzBasic/.gitignore
+8
View File
@@ -0,0 +1,8 @@
# Source Backup Files
*.bb_bak2
*.bb_bak1
# Binary Files
*.exe
*.o
*.a
BlitzBasic/All/Advanced Text/01 Colored Text.bb
+23
View File
@@ -0,0 +1,23 @@
Global sTestTxt$
sTestTxt$ = sTestTxt$ + "|fFF0000H|fFF7E00a|fFFFF00l|f7EFF00l|f00FF00o |f00FF7EW|f00FFFFe|f007EFFl|f0000FFt|f7E00FF!|fFF00FF!|fFF007E!"+Chr(10)
sTestTxt$ = sTestTxt$ + Chr(10)
sTestTxt$ = sTestTxt$ + "|fFFFFFFDies ist ein Text der |fFF0000Rot |f00FF00Grün |fFFFFFFund |f0000FFBlau |fFFFFFFist." + Chr(10)
sTestTxt$ = sTestTxt$ + "|f33FF33Man kann alle mögli|f0000FFchen Farben machen!" + Chr(10)
sTestTxt$ = sTestTxt$ + "|f000000|bFF0000Sogar|b-1-1-1 |bFF7E00der|b-1-1-1 |bFFFF00Hinter|b7EFF00grund|b-1-1-1 |b00FF00kann|b-1-1-1 |b00FF7Egesetzt|b-1-1-1 |b00FFFFwerden|b-1-1-1!" + Chr(10)
sTestTxt$ = sTestTxt$ + "|fAAAAFF|b-1-1-1Dies kann für mehr|f444400|bAAAAFFzeilige Selektion|fAAAAFF|b-1-1-1 verwendet werden!" + Chr(10)
sTestTxt$ = sTestTxt$ + "|fFFFFFFD|fFF7E00amit wäre der |b7E7E7E|fFFFFFFB|fFF7E00eispieltext|b-1-1-1 beendet|fFFFFFF!"
Graphics 400,300,32,2
SetBuffer BackBuffer()
Global timer = CreateTimer(30)
While Not KeyHit(1)
Cls
AdvText(200,150, sTestTxt, MouseX()/200.0, MouseY()/150.0, 1)
Flip 0
WaitTimer timer
Wend
Include "AdvText.bb"
BlitzBasic/All/Advanced Text/AdvText.bb
+193
View File
@@ -0,0 +1,193 @@
;AdvText Function
Dim SplittedString$(0)
Dim sTextLines$(0,1)
Global SplitCount, AdvText_X, AdvText_Y, AdvText_Width, AdvText_Height
Function AdvText(iX, iY, sText$, iCenterX#=0, iCenterY#=0, fLineSpace#=1)
Local iTextLines = 1, iLine = 0
AdvText_X = 0:AdvText_Y = 0:AdvText_Width = 0:AdvText_Height = 0
SplitString(sText, Chr(10))
iTextLines = SplitCount-1
Dim sTextLines$(iTextLines,1)
For iLine = 0 To iTextLines
sTextLines(iLine, 0) = SplittedString$(iLine)
Next
;Parse the Text so that we get only the visible text into the second slot.
Local iLastClr = 1, tabLength = 0
For iLine = 0 To iTextLines
iLastClr = 1
For iPos = 1 To Len(sTextLines(iLine,0))
sChar$ = Mid(sTextLines(iLine,0), iPos, 1)
If sChar = "|" And (Mid(sTextLines(iLine,0), iPos+1, 1) = "f" Or Mid(sTextLines(iLine,0), iPos+1, 1) = "b")
sTextLines(iLine,1) = sTextLines(iLine,1) + Mid(sTextLines(iLine,0),iLastClr,iPos-iLastClr)
iLastClr = iPos+8
ElseIf sChar = Chr(9)
sTextLines(iLine,1) = sTextLines(iLine,1) + Mid(sTextLines(iLine,0),iLastClr,iPos-iLastClr)
iLastClr = iPos
;Remove Tab Character
sTextLines(iLine,0) = Left(sTextLines(iLine,0), iPos-1) + Right(sTextLines(iLine,0), Len(sTextLines(iLine,0))-iPos)
tabLength = (4-(Len(sTextLines(iLine,1)) Mod 4))
For iTabSpace = 1 To tabLength
sTextLines(iLine,0) = Left(sTextLines(iLine,0), iPos-1) + " " + Right(sTextLines(iLine,0), Len(sTextLines(iLine,0))-iPos+1)
Next
ElseIf sChar = Chr(11)
sTextLines(iLine,1) = sTextLines(iLine,1) + Mid(sTextLines(iLine,0),iLastClr,iPos-iLastClr)
iLastClr = iPos
;Remove Tab Character
sTextLines(iLine,0) = Left(sTextLines(iLine,0), iPos-1) + Right(sTextLines(iLine,0), Len(sTextLines(iLine,0))-iPos)
tabLength = (8-(Len(sTextLines(iLine,1)) Mod 8))
For iTabSpace = 1 To tabLength
sTextLines(iLine,0) = Left(sTextLines(iLine,0), iPos-1) + " " + Right(sTextLines(iLine,0), Len(sTextLines(iLine,0))-iPos+1)
Next
ElseIf iPos = Len(sTextLines(iLine,0))
sTextLines(iLine,1) = sTextLines(iLine,1) + Mid(sTextLines(iLine,0),iLastClr,iPos-iLastClr+1)
EndIf
Next
; Return width.
If (AdvText_Width < StringWidth(sTextLines(iLine,1))) Then AdvText_Width = StringWidth(sTextLines(iLine,1))
Next
; Return Height
If (AdvText_Height < (FontHeight()*(iTextLines+1)*fLineSpace)) Then AdvText_Height = (FontHeight()*(iTextLines+1)*fLineSpace)
;Real Text Processing
Local iRedO = ColorRed(), iGreenO = ColorGreen(), iBlueO = ColorBlue() ; Original Foreground Color
Local iRed = ColorRed(), iGreen = ColorGreen(), iBlue = ColorBlue() ;Foreground
Local iBGRed = -1, iBGGreen = -1, iBGBlue = -1 ;Background
Local icX, icY, icsX, scText$, iRealPos
For iLine = 0 To iTextLines
sText$ = sTextLines(iLine,0)
icsX = -(StringWidth(sTextLines(iLine,1))*0.5)*iCenterX
icX = icsX
icY = ( -(FontHeight()*(iTextLines+1)*0.5*fLineSpace*iCenterY) + (iLine * FontHeight() * fLineSpace) )
; Return X and Y starting point.
If (AdvText_X > iX + icX) Then AdvText_X = iX + icX
If (AdvText_Y > iY + icY) Then AdvText_Y = iY + icY
iRealPos = 1
For iPos = 1 To Len(sText)
sChar$ = Mid(sText, iPos, 1)
If sChar = "|" And Mid(sText, iPos+1, 1) = "f" ;Foreground Change
If iBGRed > -1 And iBGGreen > -1 And iBGBlue > -1
Color iBGRed, iBGGreen, iBGBlue
Rect iX+icX, iY+icY, StringWidth(scText), FontHeight()*fLineSpace
EndIf
Color iRed, iGreen, iBlue
Text iX+icX, iY+icY, scText$
icX = icX + StringWidth(scText$)
scText = ""
If Mid(sText, iPos+2, 2) = "-1"
iRed = iRedO
iGreen = iGreenO
iBlue = iBlueO
Else
iRed = HexB(Mid(sText, iPos+2, 2))
iGreen = HexB(Mid(sText, iPos+4, 2))
iBlue = HexB(Mid(sText, iPos+6, 2))
EndIf
sText = Left(sText, iPos)+Mid(sText, iPos+8)
ElseIf sChar = "|" And Mid(sText, iPos+1, 1) = "b" ;Background Change
If iBGRed > -1 And iBGGreen > -1 And iBGBlue > -1
Color iBGRed, iBGGreen, iBGBlue
Rect iX+icX, iY+icY, StringWidth(scText), FontHeight()*fLineSpace
EndIf
Color iRed, iGreen, iBlue
Text iX+icX, iY+icY, scText$
icX = icX + StringWidth(scText$)
scText = ""
If Mid(sText, iPos+2, 2) = "-1"
iBGRed = -1
iBGGreen = -1
iBGBlue = -1
Else
iBGRed = HexB(Mid(sText, iPos+2, 2))
iBGGreen = HexB(Mid(sText, iPos+4, 2))
iBGBlue = HexB(Mid(sText, iPos+6, 2))
EndIf
sText = Left(sText, iPos)+Mid(sText, iPos+8)
Else
scText$ = scText$ + sChar$
iRealPos = iRealPos + 1
EndIf
If iPos = Len(sText)
If iBGRed > -1 And iBGGreen > -1 And iBGBlue > -1
Color iBGRed, iBGGreen, iBGBlue
Rect iX+icX, iY+icY, StringWidth(scText), FontHeight()*fLineSpace
EndIf
Color iRed, iGreen, iBlue
Text iX+icX, iY+icY, scText
scText = ""
EndIf
Next
scText$ = ""
Next
End Function
Function HexB#(Hexzahl$)
Local Integer_Result#
If Left$(Hexzahl$,1)="$" Then Hexzahl$=Mid$(Hexzahl$,2)
For i=1 To Len(Hexzahl$)
tmp1$=Upper$(Mid$(Hexzahl$,i,1)):tmp2=tmp1$
If tmp2=0 And tmp1$<>"0" Then tmp2=Asc(tmp1$)-55
Integer_Result=Integer_Result*16:Integer_Result=Integer_Result+tmp2
Next
Return Integer_Result
End Function
Function SplitString(In$, StringSplitter$ = "|")
Local InLength% = Len(In)
Local SplitLength% = Len(StringSplitter)
Local CountPos%, InPos%, SplitIndex%
Local SplitTest$, LineText$
; Count how many Lines there are and resize Dim.
SplitCount = 0
For CountPos = 1 To InLength-(SplitLength-1)
SplitTest = Mid(In,CountPos,1)
If SplitTest = StringSplitter Then SplitCount = SplitCount + 1
Next
Dim SplittedString(SplitCount)
; Split the Text onto multiple lines.
While Not InPos = Len(In)
; Increment Position
InPos = InPos + 1
; Grab a piece of the text.
SplitTest = Mid(In, InPos, SplitLength)
Local Char$ = Left(SplitTest, 1)
; Check if the current Text matches the splitter or if we are near the end.
If SplitTest = StringSplitter Or InPos = InLength
; Append the current character if it doesn't match the Splitter.
If InPos = InLength And SplitTest <> StringSplitter Then LineText = LineText + Char
; Store the Line.
SplittedString(SplitIndex) = LineText
; Increment split index.
SplitIndex = SplitIndex + 1
; Reset LineText
LineText = ""
Else
LineText = LineText + Char
EndIf
Wend
End Function
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/All/Advanced Text/README.md
+8
View File
@@ -0,0 +1,8 @@
Advanced Text
=======================
This project adds an advanced text function to BlitzBasic. While somewhat slower, it supports many features and if you cache the result you can get quite good results. It was written for a project that needed such features in the chat, but has been abandoned.
License
=======
Advanced Text by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/All/LinkedList Emulation/LinkedListEmulation.bb
+258
View File
@@ -0,0 +1,258 @@
;----------------------------------------------------------------
;-- Types
;----------------------------------------------------------------
Type TList
Field FirstEntry.TListEntry
Field LastEntry.TListEntry
Field Iterator.TListEntry
End Type
Type TListEntry
Field Value%
Field PreviousEntry.TListEntry
Field NextEntry.TListEntry
End Type
;----------------------------------------------------------------
;-- Functions
;----------------------------------------------------------------
Function TList_Create.TList()
Local lList.TList = New TList
lList\FirstEntry = Null
lList\LastEntry = Null
lList\Iterator = Null
Return lList
End Function
Function TList_Destroy(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to destroy non-existing list."
; Delete all entries
pList\Iterator = pList\FirstEntry
While pList\Iterator <> Null
Local lNextEntry.TListEntry = pList\Iterator\NextEntry
Delete pList\Iterator
pList\Iterator = lNextEntry
Wend
End Function
Function TList_Reset(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to reset non-existing list."
pList\Iterator = Null
End Function
Function TList_First%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
pList\Iterator = pList\FirstEntry
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_Last%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
pList\Iterator = pList\LastEntry
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_Next%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
pList\Iterator = pList\Iterator\NextEntry
Else
pList\Iterator = pList\FirstEntry
EndIf
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_Previous%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
pList\Iterator = pList\Iterator\PreviousEntry
Else
pList\Iterator = pList\LastEntry
EndIf
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_HasFirst(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
Return (pList\FirstEntry <> Null)
End Function
Function TList_HasLast(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
Return (pList\LastEntry <> Null)
End Function
Function TList_HasNext(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
Return (pList\Iterator\NextEntry <> Null)
Else
Return (pList\FirstEntry <> Null)
EndIf
End Function
Function TList_HasPrevious(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
Return (pList\Iterator\PreviousEntry <> Null)
Else
Return (pList\LastEntry <> Null)
EndIf
End Function
Function TList_AddFirst(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\FirstEntry <> Null Then
lEntry\NextEntry = pList\FirstEntry
lEntry\NextEntry\PreviousEntry = lEntry
EndIf
pList\FirstEntry = lEntry
If pList\LastEntry = Null Then pList\LastEntry = lEntry
End Function
Function TList_AddLast(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\LastEntry <> Null Then
lEntry\PreviousEntry = pList\LastEntry
lEntry\PreviousEntry\NextEntry = lEntry
EndIf
If pList\FirstEntry = Null pList\FirstEntry = lEntry
pList\LastEntry = lEntry
End Function
Function TList_InsertBefore(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\Iterator\PreviousEntry <> Null Then
lEntry\PreviousEntry = pList\Iterator\PreviousEntry
pList\Iterator\PreviousEntry\NextEntry = lEntry
Else
pList\FirstEntry = lEntry
EndIf
pList\Iterator\PreviousEntry = lEntry
If pList\Iterator\NextEntry = Null Then
pList\LastEntry = lEntry
EndIf
lEntry\NextEntry = pList\Iterator
End Function
Function TList_InsertAfter(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\Iterator\NextEntry <> Null Then
lEntry\NextEntry = pList\Iterator\NextEntry
pList\Iterator\NextEntry\PreviousEntry = lEntry
Else
pList\LastEntry = lEntry
EndIf
pList\Iterator\NextEntry = lEntry
If pList\Iterator\PreviousEntry = Null Then
pList\FirstEntry = lEntry
EndIf
lEntry\PreviousEntry = pList\Iterator
End Function
Function TList_Replace(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
pList\Iterator\Value = Value
End Function
Function TList_DeleteFirst(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\FirstEntry = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = pList\FirstEntry
pList\FirstEntry\NextEntry\PreviousEntry = Null
pList\FirstEntry = pList\FirstEntry\NextEntry
Delete lEntry
If pList\FirstEntry <> Null Then Return pList\FirstEntry\Value
End Function
Function TList_DeleteLast(pList.Tlist)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\LastEntry = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = pList\LastEntry
pList\LastEntry\PreviousEntry\NextEntry = Null
pList\LastEntry = pList\LastEntry\PreviousEntry
Delete lEntry
If pList\LastEntry <> Null Then Return pList\LastEntry\Value
End Function
Function TList_Delete(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
If pList\FirstEntry = pList\Iterator Then pList\FirstEntry = pList\Iterator\NextEntry
If pList\LastEntry = pList\Iterator Then pList\LastEntry = pList\Iterator\PreviousEntry
If pList\Iterator\NextEntry <> Null Then pList\Iterator\NextEntry\PreviousEntry = pList\Iterator\PreviousEntry
If pList\Iterator\PreviousEntry <> Null Then pList\Iterator\PreviousEntry\NextEntry = pList\Iterator\NextEntry
Local lEntry.TListEntry = pList\Iterator
pList\Iterator = pList\Iterator\NextEntry
Delete lEntry
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_DeleteValue(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\FirstEntry <> Null Then
Local lEntry.TListEntry = pList\FirstEntry
While lEntry <> Null
If lEntry\Value = Value Then
If lEntry\PreviousEntry <> Null Then lEntry\PreviousEntry\NextEntry = lEntry\NextEntry
If lEntry\NextEntry <> Null Then lEntry\NextEntry\PreviousEntry = lEntry\PreviousEntry
If pList\FirstEntry = lEntry Then pList\FirstEntry = lEntry\NextEntry
If pList\LastEntry = lEntry Then pList\LastEntry = lEntry\PreviousEntry
Local lDelEntry.TListEntry = lEntry
lEntry = lEntry\NextEntry
Delete lDelEntry
Else
lEntry = lEntry\NextEntry
EndIf
Wend
EndIf
End Function
BlitzBasic/All/LinkedList Emulation/README.md
+9
View File
@@ -0,0 +1,9 @@
LinkedList Emulation
=======================
Since the early BlitzBasic languages didn't have any kind of lists aside from the global ones, I had to make something out of nothing. This library adds the ability to have linked lists inside of those languages.
It was initially ment to use FastPointer or a similar library, but that failed horrifically, as I wasn't able to cast back into the original type and memory leaks happened. It's somewhat fast, but solutions tailored to a single type still work faster 90% of the time.
License
=======
LinkedList Emulation by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/All/Random Stuff/LinkedList.bb
+258
View File
@@ -0,0 +1,258 @@
;----------------------------------------------------------------
;-- Types
;----------------------------------------------------------------
Type TList
Field FirstEntry.TListEntry
Field LastEntry.TListEntry
Field Iterator.TListEntry
End Type
Type TListEntry
Field Value%
Field PreviousEntry.TListEntry
Field NextEntry.TListEntry
End Type
;----------------------------------------------------------------
;-- Functions
;----------------------------------------------------------------
Function TList_Create.TList()
Local lList.TList = New TList
lList\FirstEntry = Null
lList\LastEntry = Null
lList\Iterator = Null
Return lList
End Function
Function TList_Destroy(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to destroy non-existing list."
; Delete all entries
pList\Iterator = pList\FirstEntry
While pList\Iterator <> Null
Local lNextEntry.TListEntry = pList\Iterator\NextEntry
Delete pList\Iterator
pList\Iterator = lNextEntry
Wend
End Function
Function TList_Reset(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to reset non-existing list."
pList\Iterator = Null
End Function
Function TList_First%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
pList\Iterator = pList\FirstEntry
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_Last%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
pList\Iterator = pList\LastEntry
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_Next%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
pList\Iterator = pList\Iterator\NextEntry
Else
pList\Iterator = pList\FirstEntry
EndIf
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_Previous%(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
pList\Iterator = pList\Iterator\PreviousEntry
Else
pList\Iterator = pList\LastEntry
EndIf
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_HasFirst(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
Return (pList\FirstEntry <> Null)
End Function
Function TList_HasLast(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
Return (pList\LastEntry <> Null)
End Function
Function TList_HasNext(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
Return (pList\Iterator\NextEntry <> Null)
Else
Return (pList\FirstEntry <> Null)
EndIf
End Function
Function TList_HasPrevious(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to iterate non-existing list."
If pList\Iterator <> Null Then
Return (pList\Iterator\PreviousEntry <> Null)
Else
Return (pList\LastEntry <> Null)
EndIf
End Function
Function TList_AddFirst(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\FirstEntry <> Null Then
lEntry\NextEntry = pList\FirstEntry
lEntry\NextEntry\PreviousEntry = lEntry
EndIf
pList\FirstEntry = lEntry
If pList\LastEntry = Null Then pList\LastEntry = lEntry
End Function
Function TList_AddLast(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\LastEntry <> Null Then
lEntry\PreviousEntry = pList\LastEntry
lEntry\PreviousEntry\NextEntry = lEntry
EndIf
If pList\FirstEntry = Null pList\FirstEntry = lEntry
pList\LastEntry = lEntry
End Function
Function TList_InsertBefore(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\Iterator\PreviousEntry <> Null Then
lEntry\PreviousEntry = pList\Iterator\PreviousEntry
pList\Iterator\PreviousEntry\NextEntry = lEntry
Else
pList\FirstEntry = lEntry
EndIf
pList\Iterator\PreviousEntry = lEntry
If pList\Iterator\NextEntry = Null Then
pList\LastEntry = lEntry
EndIf
lEntry\NextEntry = pList\Iterator
End Function
Function TList_InsertAfter(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = New TListEntry
lEntry\Value = Value
If pList\Iterator\NextEntry <> Null Then
lEntry\NextEntry = pList\Iterator\NextEntry
pList\Iterator\NextEntry\PreviousEntry = lEntry
Else
pList\LastEntry = lEntry
EndIf
pList\Iterator\NextEntry = lEntry
If pList\Iterator\PreviousEntry = Null Then
pList\FirstEntry = lEntry
EndIf
lEntry\PreviousEntry = pList\Iterator
End Function
Function TList_Replace(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
pList\Iterator\Value = Value
End Function
Function TList_DeleteFirst(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\FirstEntry = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = pList\FirstEntry
pList\FirstEntry\NextEntry\PreviousEntry = Null
pList\FirstEntry = pList\FirstEntry\NextEntry
Delete lEntry
If pList\FirstEntry <> Null Then Return pList\FirstEntry\Value
End Function
Function TList_DeleteLast(pList.Tlist)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\LastEntry = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
Local lEntry.TListEntry = pList\LastEntry
pList\LastEntry\PreviousEntry\NextEntry = Null
pList\LastEntry = pList\LastEntry\PreviousEntry
Delete lEntry
If pList\LastEntry <> Null Then Return pList\LastEntry\Value
End Function
Function TList_Delete(pList.TList)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\Iterator = Null Then RuntimeError "TList: TList: Tried to change non-existing list entry."
If pList\FirstEntry = pList\Iterator Then pList\FirstEntry = pList\Iterator\NextEntry
If pList\LastEntry = pList\Iterator Then pList\LastEntry = pList\Iterator\PreviousEntry
If pList\Iterator\NextEntry <> Null Then pList\Iterator\NextEntry\PreviousEntry = pList\Iterator\PreviousEntry
If pList\Iterator\PreviousEntry <> Null Then pList\Iterator\PreviousEntry\NextEntry = pList\Iterator\NextEntry
Local lEntry.TListEntry = pList\Iterator
pList\Iterator = pList\Iterator\NextEntry
Delete lEntry
If pList\Iterator <> Null Then Return pList\Iterator\Value
End Function
Function TList_DeleteValue(pList.TList, Value%)
If pList = Null Then RuntimeError "TList: Tried to insert into non-existing list."
If pList\FirstEntry <> Null Then
Local lEntry.TListEntry = pList\FirstEntry
While lEntry <> Null
If lEntry\Value = Value Then
If lEntry\PreviousEntry <> Null Then lEntry\PreviousEntry\NextEntry = lEntry\NextEntry
If lEntry\NextEntry <> Null Then lEntry\NextEntry\PreviousEntry = lEntry\PreviousEntry
If pList\FirstEntry = lEntry Then pList\FirstEntry = lEntry\NextEntry
If pList\LastEntry = lEntry Then pList\LastEntry = lEntry\PreviousEntry
Local lDelEntry.TListEntry = lEntry
lEntry = lEntry\NextEntry
Delete lDelEntry
Else
lEntry = lEntry\NextEntry
EndIf
Wend
EndIf
End Function
BlitzBasic/All/Random Stuff/Logger.bb
+27
View File
@@ -0,0 +1,27 @@
Global Logger_Stream
Function Logger_Initialize(File$)
File = "Logs/" + File
CreateDir("./Logs/")
If FileType("./Logs/") <> 2 Then RuntimeError("Unable To create Log File."+Chr(10)+" If the program is running in a protected directory,"+Chr(10)+" consider running it as an administrator.")
Logger_Stream = OpenFile(File)
If Logger_Stream = 0
Logger_Stream = WriteFile(File)
If Logger_Stream = 0 Then RuntimeError("Unable to create log file."+Chr(10)+" If the program is running in a protected directory,"+Chr(10)+" consider running it as an administrator.")
EndIf
End Function
Function Logger_Info(Module$, Message$)
WriteLine Logger_Stream, "[" + CurrentTime() + "] [Info] " + Module + ": " + Message
End Function
Function Logger_Warning(Module$, Message$)
WriteLine Logger_Stream, "[" + CurrentTime() + "] [Warn] " + Module + ": " + Message
End Function
Function Logger_Error(Module$, Message$)
WriteLine Logger_Stream, "[" + CurrentTime() + "] [Errr] " + Module + ": " + Message
End Function
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/All/Random Stuff/NetCode.bb
+665
View File
@@ -0,0 +1,665 @@
;----------------------------------------------------------------
;-- Packet Descriptors
;----------------------------------------------------------------
;-- Any Packet
;Off Size Desc
; 0 1 Packet Id
;-- Login
;Off Size Desc
; 1 2 Unique Id (Server) / UDP Port (Client)
; 3 2 Version
; 5 16 Name (Always 16B, Only allows bytes above 32)
; 21 4F Initial Position X
; 25 4F Initial Position Y
; 29 4F Initial Position Z
; 33 4F Initial Rotation X
; 37 4F Initial Rotation Y
; 41 4F Initial Rotation Z
;-- Logout
;Off Size Desc
; 1 2 Unique Id
;-- Kick
;Off Size Desc
; 1 2 Reason Length
; 3 ^ Reason
;-- Data
; 1 2 Unique Id
; 3 1 Data Flags (See BNET_DATAFLAG_*)
;... 4F Position X
;... 4F Position Y
;... 4F Position Z
;... 2 Rotation X
;... 2 Rotation Y
;... 2 Rotation Z
;... 2 Velocity X
;... 2 Velocity Y
;... 2 Velocity Z
;... 2 Aim X
;... 2 Aim Y
;-- Action (Yet Unsupported)
;----------------------------------------------------------------
;-- Constants
;----------------------------------------------------------------
; BlitzNet Version
Const BNET_VERSION_MAJOR% = 0
Const BNET_VERSION_MINOR% = 1
; Size of Buffer for Network Packets, 64KB should be enough for now.
Const BNET_BUFFER_SIZE% = (64 * 1024)
; Flags for data changes. Only when the bit is set this data is available.
Const BNET_DATAFLAG_POSX = $00000001
Const BNET_DATAFLAG_POSY = $00000010
Const BNET_DATAFLAG_POSZ = $00000100
Const BNET_DATAFLAG_ROTX = $00001000
Const BNET_DATAFLAG_ROTY = $00010000
Const BNET_DATAFLAG_ROTZ = $00100000
Const BNET_DATAFLAG_VELOCITY = $01000000
Const BNET_DATAFLAG_AIM = $10000000
; Packet Ids, for identification of each one.
Const BNET_PACKET_LOGIN = 0
Const BNET_PACKET_LOGOUT = 1
Const BNET_PACKET_KICK = 2
Const BNET_PACKET_DATA = 3
Const BNET_PACKET_ACTION = 4
; How many updates should we send out each minute?
Const BNET_DATA_COUNT = 150
; How many keyframes should we send out each minute?
Const BNET_DATA_COUNT_KEYFRAME = 3
; How much has the value to change to be considered different?
Const BNET_DATA_THRESHOLD_POS# = 1.0
Const BNET_DATA_THRESHOLD_ROT# = 1.0
Const BNET_DATA_THRESHOLD_VEL# = 1.0
Const BNET_DATA_THRESHOLD_AIM# = 1.0
;----------------------------------------------------------------
;-- Globals
;----------------------------------------------------------------
; Connections to Sector Servers.
Global BNet_Sector_TCP% = 0
Global BNet_Sector_UDP% = 0
; Our UniqueId and Player instance so we know which Player is us.
Global BNet_UniqueId% = -1
Global BNet_Player.BNetPlayer = Null
; Buffer for Network Packets.
Global BNet_Buffer% = CreateBank(BNET_BUFFER_SIZE)
; Set to true when Kicked from the server, or similar.
Global BNet_Kick% = False
Global BNet_Kick_Reason$ = "Not Kicked"
; Update Times
Global BNet_Data_Time = 60000 / BNET_DATA_COUNT
Global BNet_Data_Time_KeyFrame = 60000 / BNET_DATA_COUNT_KEYFRAME
Global BNet_Data_LastUpdate = 0
Global BNet_Data_LastKeyFrame = 0
; Array for all known players. Makes access a bit faster.
Dim BNet_Players.BNetPlayer(65535)
;----------------------------------------------------------------
;-- Types
;----------------------------------------------------------------
Type BNetPlayer
Field Name$ = "Invalid Player"
; Position, Rotation, Velocity and Aim
Field PositionX#, PositionY#, PositionZ#
Field RotationX#, RotationY#, RotationZ#
Field VelocityX#, VelocityY#, VelocityZ#
Field AimX#, AimY#
; Internal Data
Field m_UniqueId%
End Type
;----------------------------------------------------------------
;-- Functions
;----------------------------------------------------------------
Function BNet_Initialize()
TCPTimeouts 100, 100
End Function
Function BNet_Connect(Ip$ = "127.0.0.1", IPort% = 27000, DPort = 27001)
BNet_Kick% = False
BNet_Kick_Reason$ = "Not Kicked"
BNet_Sector_TCP = OpenTCPStream(Ip, IPort)
If BNet_Sector_TCP Then
BNet_Sector_UDP = CreateUDPStream()
If BNet_Sector_UDP Then
Return True
Else
CloseTCPStream BNet_Sector_TCP
BNet_Sector_UDP = 0
BNet_Sector_TCP = 0
EndIf
Else
BNet_Sector_UDP = 0
BNet_Sector_TCP = 0
EndIf
Return False
End Function
Function BNet_Disconnect()
If BNet_UniqueId > -1 Then
; Remove all existing players
For Player.BNetPlayer = Each BNetPlayer
Local UniqueId = Player\m_UniqueId
CB_BNet_DeletePlayer(UniqueId, Player)
Delete BNet_Players(UniqueId):BNet_Players(UniqueId) = Null
Next
; Logout
BNet_Logout()
BNet_UniqueId = -1
EndIf
If BNet_Sector_UDP Then CloseUDPStream(BNet_Sector_UDP):BNet_Sector_UDP = 0
If BNet_Sector_TCP Then CloseTCPStream(BNet_Sector_TCP):BNet_Sector_TCP = 0
End Function
Function BNet_Connected()
If BNet_Sector_TCP = 0 Then Return False
If BNet_Sector_UDP = 0 Then Return False
If Eof(BNet_Sector_TCP) <> 0 Then Return False
Return True
End Function
Function BNet_Login(Name$, PosX# = 0, PosY# = 0, PosZ# = 0, RotX# = 0, RotY# = 0, RotZ# = 0)
If BNet_Connected() And BNet_UniqueId = -1 Then
; Packet Id: Login
PokeByte BNet_Buffer, 0, BNET_PACKET_LOGIN
; Write UDP Port
PokeShort BNet_Buffer, 1, UDPStreamPort(BNet_Sector_UDP)
; Write Client Version
PokeShort BNet_Buffer, 3, BNET_VERSION_MAJOR Shl 8 + BNET_VERSION_MINOR
; Write Name
Local NameLength% = Len(Name)
For NamePos = 1 To NameLength:PokeByte BNet_Buffer, (5 + NamePos - 1), Asc(Mid(Name, NamePos, 1)):Next
For NamePos = NameLength To 16:PokeByte BNet_Buffer, (5 + NamePos - 1), 0:Next
; Write Initial Position
PokeFloat BNet_Buffer, 21, PosX
PokeFloat BNet_Buffer, 25, PosY
PokeFloat BNet_Buffer, 29, PosZ
; Write Initial Rotation
PokeFloat BNet_Buffer, 33, RotX
PokeFloat BNet_Buffer, 37, RotX
PokeFloat BNet_Buffer, 41, RotX
; Write to Stream
WriteBytes BNet_Buffer, BNet_Sector_TCP, 0, 47
Return True
Else
Return False
EndIf
End Function
Function BNet_Logout()
If BNet_Connected() And BNet_UniqueId > -1 Then
; Packet Id: Logout
PokeByte BNet_Buffer, 0, BNET_PACKET_LOGOUT
; Write our own UniqueId
PokeShort BNet_Buffer, 1, BNet_UniqueId
; Write to Stream
WriteBytes BNet_Buffer, BNet_Sector_TCP, 0, 3
Return True
Else
Return False
EndIf
End Function
Function BNet_Update()
Local UniqueId, PacketSize, PacketId, DataFlags, Offset, TempPlayer.BNetPlayer
If BNet_Connected() Then
; TCP
While Not Eof(BNet_Sector_TCP) And ReadAvail(BNet_Sector_TCP) > 0
PacketSize = ReadAvail(BNet_Sector_TCP)
If PacketSize > BNET_BUFFER_SIZE Then PacketSize = BNET_BUFFER_SIZE
ReadBytes(BNet_Buffer, BNet_Sector_TCP, 0, PacketSize)
PacketId = PeekByte(BNet_Buffer, 0)
Select PacketId
Case BNET_PACKET_LOGIN
UniqueId = PeekShort(BNet_Buffer, 1)
BNet_Players(UniqueId) = New BNetPlayer
; Read Name
For NamePos = 1 To 16
Local NameChar = PeekByte(BNet_Buffer, (5 + NamePos - 1))
If NameChar < 32 Then Exit
BNet_Players(UniqueId)\Name$ = BNet_Players(UniqueId)\Name$ + Chr(NameChar)
Next
; Read initital Position
BNet_Players(UniqueId)\PositionX = PeekFloat(BNet_Buffer, 21)
BNet_Players(UniqueId)\PositionY = PeekFloat(BNet_Buffer, 25)
BNet_Players(UniqueId)\PositionZ = PeekFloat(BNet_Buffer, 29)
; Read initial Rotation
BNet_Players(UniqueId)\RotationX = PeekFloat(BNet_Buffer, 33)
BNet_Players(UniqueId)\RotationY = PeekFloat(BNet_Buffer, 37)
BNet_Players(UniqueId)\RotationZ = PeekFloat(BNet_Buffer, 41)
; Assign Unique Id
BNet_Players(UniqueId)\m_UniqueId = UniqueId
; Assign local UniqueId if we don't have one.
If BNet_UniqueId > -1 Then
BNet_UniqueId = UniqueId
Else
CB_BNet_CreatePlayer(UniqueId, BNet_Players(BNet_UniqueId))
EndIf
Case BNET_PACKET_LOGOUT
UniqueId = PeekShort(BNet_Buffer, 1)
; A logout packet for ourselves will make us logout.
If BNet_UniqueId = UniqueId Then
BNet_Disconnect():Return True
ElseIf BNet_Players(UniqueId) <> Null Then
; Otherwise, it is another player removed from visible space.
CB_BNet_DeletePlayer(Unique, BNet_Players(UniqueId))
Delete BNet_Players(UniqueId):BNet_Players(UniqueId) = Null
Else
DebugLog "BNet: Logout for non-existing player."
EndIf
Case BNET_PACKET_KICK
BNet_Kick = True
; Read reason for Kick
Local ReasonLength% = PeekShort(BNet_Buffer, 1)
For ReasonPos = 1 To ReasonLength
Local ReasonChar = PeekByte(BNet_Buffer, (3 + ReasonPos - 1))
If ReasonChar < 32 Then Exit
BNet_Kick_Reason = BNet_Kick_Reason + Chr(NameChar)
Next
BNet_Disconnect():Return True
End Select
Wend
; UDP
While Not Eof(BNet_Sector_UDP) And ReadAvail(BNet_Sector_UDP) > 0
PacketSize = ReadAvail(BNet_Sector_UDP)
If PacketSize > BNET_BUFFER_SIZE Then PacketSize = BNET_BUFFER_SIZE
ReadBytes(BNet_Buffer, BNet_Sector_UDP, 0, PacketSize)
PacketId = PeekByte(BNet_Buffer, 0)
Select PacketId
Case BNET_PACKET_DATA
If BNet_UniqueId > -1 Then
UniqueId = PeekShort(BNet_Buffer, 1)
If BNet_Players(UniqueId) <> Null Then
DataFlags = PeekShort(BNet_Buffer, 3)
Offset% = 5
If DataFlags And BNET_DATAFLAGS_POSX Then BNet_Players(UniqueId)\PositionX = PeekInt(BNet_Buffer, Offset):Offset = Offset + 4
If DataFlags And BNET_DATAFLAGS_POSY Then BNet_Players(UniqueId)\PositionY = PeekInt(BNet_Buffer, Offset):Offset = Offset + 4
If DataFlags And BNET_DATAFLAGS_POSZ Then BNet_Players(UniqueId)\PositionZ = PeekInt(BNet_Buffer, Offset):Offset = Offset + 4
If DataFlags And BNET_DATAFLAGS_ROTX Then BNet_Players(UniqueId)\RotationX = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 360.0:Offset = Offset + 2
If DataFlags And BNET_DATAFLAGS_ROTY Then BNet_Players(UniqueId)\RotationY = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 360.0:Offset = Offset + 2
If DataFlags And BNET_DATAFLAGS_ROTZ Then BNet_Players(UniqueId)\RotationZ = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 360.0:Offset = Offset + 2
If DataFlags And BNET_DATAFLAGS_VELOCITY Then
BNet_Players(UniqueId)\VelocityX = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 255.0
BNet_Players(UniqueId)\VelocityY = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 255.0
BNet_Players(UniqueId)\VelocityZ = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 255.0
Offset = Offset + 6
EndIf
If DataFlags And BNET_DATAFLAGS_AIM Then
BNet_Players(UniqueId)\AimX = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 360.0
BNet_Players(UniqueId)\AimY = BNet_FloatFromShort(PeekShort(BNet_Buffer, Offset)) * 360.0
Offset = Offset + 4
EndIf
; Tell Client to update visual stuff
CB_BNet_UpdatePlayer(UniqueId, BNet_Players(UniqueId))
EndIf
EndIf
; Case BNET_PACKET_ACTION
; If BNet_UniqueId > -1 Then
;
; EndIf
End Select
Wend
; If we are logged in, tell the server our current data.
If BNet_UniqueId > -1 Then
Local Time = MilliSecs()
; Send out whatever is needed.
If Time - BNet_Data_LastKeyFrame > BNet_Data_Time_KeyFrame Then
; Force Client to update Player object
CB_BNet_SendUpdate(BNet_UniqueId, BNet_Player)
; Packet Id
PokeByte BNet_Buffer, 0, BNET_PACKET_DATA
; Unique Id
PokeShort BNet_Buffer, 1, BNet_UniqueId
; Data Flags (KeyFrame always has this at 255, since it contains all data)
PokeByte BNet_Buffer, 3, $11111111
; Position
PokeFloat BNet_Buffer, 4, BNet_Player\PositionX
PokeFloat BNet_Buffer, 8, BNet_Player\PositionY
PokeFloat BNet_Buffer,12, BNet_Player\PositionZ
; Rotation
PokeShort BNet_Buffer,16, BNet_ShortFromFloat(BNet_Player\RotationX / 360.0)
PokeShort BNet_Buffer,18, BNet_ShortFromFloat(BNet_Player\RotationY / 360.0)
PokeShort BNet_Buffer,20, BNet_ShortFromFloat(BNet_Player\RotationZ / 360.0)
; Velocity
PokeShort BNet_Buffer,22, BNet_ShortFromFloat(BNet_Player\VelocityX / 256.0)
PokeShort BNet_Buffer,24, BNet_ShortFromFloat(BNet_Player\VelocityY / 256.0)
PokeShort BNet_Buffer,26, BNet_ShortFromFloat(BNet_Player\VelocityZ / 256.0)
; Aim
PokeShort BNet_Buffer,28, BNet_ShortFromFloat(BNet_Player\AimX / 360.0)
PokeShort BNet_Buffer,30, BNet_ShortFromFloat(BNet_Player\AimY / 360.0)
; Send Packet
WriteBytes BNet_Buffer, BNet_Sector_UDP, 0, 32
; Swap Player objects.
TempPlayer = BNet_Player
BNet_Player = BNet_Players(BNet_UniqueId)
BNet_Players(BNet_UnqiueId) = TempPlayer
; Set last keyframe and update time to now.
BNet_Data_LastKeyFrame = Time
BNet_Data_LastUpdate = Time
ElseIf Time - BNet_Data_LastUpdate > BNet_Data_Time Then
DataFlags = 0
Offset = 4
; Force Client to update Player object
CB_BNet_SendUpdate(BNet_UniqueId, BNet_Player)
; Packet Id
PokeByte BNet_Buffer, 0, BNET_PACKET_DATA
; Unique Id
PokeShort BNet_Buffer, 1, BNet_UniqueId
; Position
If Abs(BNet_Player\PositionX - BNet_Players(BNet_UniqueId)\PositionX) > BNET_DATA_THRESHOLD_POS Then
DataFlags = DataFlags Or BNET_DATAFLAG_POSX
PokeFloat BNet_Buffer, Offset, BNet_Player\PositionX:Offset = Offset + 4
EndIf
If Abs(BNet_Player\PositionY - BNet_Players(BNet_UniqueId)\PositionY) > BNET_DATA_THRESHOLD_POS Then
DataFlags = DataFlags Or BNET_DATAFLAG_POSY
PokeFloat BNet_Buffer, Offset, BNet_Player\PositionY:Offset = Offset + 4
EndIf
If Abs(BNet_Player\PositionZ - BNet_Players(BNet_UniqueId)\PositionZ) > BNET_DATA_THRESHOLD_POS Then
DataFlags = DataFlags Or BNET_DATAFLAG_POSZ
PokeFloat BNet_Buffer, Offset, BNet_Player\PositionZ:Offset = Offset + 4
EndIf
; Rotation
If Abs(BNet_Player\RotationX - BNet_Players(BNet_UniqueId)\RotationX) > BNET_DATA_THRESHOLD_POS Then
DataFlags = DataFlags Or BNET_DATAFLAG_ROTX
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\RotationX / 360.0):Offset = Offset + 2
EndIf
If Abs(BNet_Player\RotationY - BNet_Players(BNet_UniqueId)\RotationY) > BNET_DATA_THRESHOLD_POS Then
DataFlags = DataFlags Or BNET_DATAFLAG_ROTY
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\RotationY / 360.0):Offset = Offset + 2
EndIf
If Abs(BNet_Player\RotationZ - BNet_Players(BNet_UniqueId)\RotationZ) > BNET_DATA_THRESHOLD_POS Then
DataFlags = DataFlags Or BNET_DATAFLAG_ROTZ
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\RotationZ / 360.0):Offset = Offset + 2
EndIf
; Velocity
If Abs(BNet_Player\VelocityX - BNet_Players(BNet_UniqueId)\VelocityX) + Abs(BNet_Player\VelocityY - BNet_Players(BNet_UniqueId)\VelocityY) + Abs(BNet_Player\VelocityZ - BNet_Players(BNet_UniqueId)\VelocityZ) > BNET_DATA_THRESHOLD_VEL Then
DataFlags = DataFlags Or BNET_DATAFLAG_VELOCITY
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\VelocityX / 256.0):Offset = Offset + 2
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\VelocityY / 256.0):Offset = Offset + 2
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\VelocityZ / 256.0):Offset = Offset + 2
EndIf
; Aim
If Abs(BNet_Player\AimX - BNet_Players(BNet_UniqueId)\AimX) + Abs(BNet_Player\AimY - BNet_Players(BNet_UniqueId)\AimY) > BNET_DATA_THRESHOLD_AIM Then
DataFlags = DataFlags Or BNET_DATAFLAG_AIM
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\AimX / 360.0):Offset = Offset + 2
PokeFloat BNet_Buffer, Offset, BNet_ShortFromFloat(BNet_Player\AimY / 360.0):Offset = Offset + 2
EndIf
; Data Flags
PokeByte BNet_Buffer, 3, DataFlags
; Send Packet
WriteBytes BNet_Buffer, BNet_Sector_UDP, 0, Offset
; Swap Player objects.
TempPlayer = BNet_Player
BNet_Player = BNet_Players(BNet_UniqueId)
BNet_Players(BNet_UnqiueId) = TempPlayer
; Set last update time to now.
BNet_Data_LastUpdate = Time
EndIf
EndIf
Else
Return False
EndIf
End Function
Function BNet_FloatFromShort#(Value%)
Return BNet_Math_ClipF((Value / 65536.0), 0.0, 1.0)
End Function
Function BNet_ShortFromFloat%(Value#)
Return BNet_Math_ClipF((Value * 65536.0), 0.0, 1.0)
End Function
Function BNet_Math_MinimumF#(Value#, Min#)
If Value < Min Then Return Min
Return Value
End Function
Function BNet_Math_MaximumF#(Value#, Max#)
If Value > Max Then Return Max
Return Value
End Function
Function BNet_Math_ClampF#(Value#, Min#, Max#)
If Value < Min Then Return Min
If Value > Max Then Return Max
Return Value
End Function
Function BNet_Math_ClipF#(Value#, Min#, Max#)
Local Out#, Diff#
Diff = Max - Min:Out = Value - Min
If (Out >= Diff) Or (Out < 0) Then Out = Out - (Floor(Out/Diff) * Diff)
Return Min + Out
End Function
;----------------------------------------------------------------
;-- Callbacks
;----------------------------------------------------------------
;Function CB_BNet_CreatePlayer(UniqueId, Player.BNetPlayer)
;End Function
;Function CB_BNet_UpdatePlayer(UniqueId, Player.BNetPlayer)
;End Function
;Function CB_BNet_DeletePlayer(UniqueId, Player.BNetPlayer)
;End Function
;Function CB_BNet_SendUpdate(UniqueId, Player.BNetPlayer)
;End Function
;----------------------------------------------------------------
;-- Example
;----------------------------------------------------------------
Graphics3D 800, 600, 32, 2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Local FrameTimer = CreateTimer(60)
Local TimeToLogin = MilliSecs()
Dim Players.TPlayer(65535)
Local Player.TPlayer = Null
Global TestX#, TestY#, TestZ#
Global TestRX#, TestRY#, TestRZ#
Global TestVX#, TestVY#, TestVZ#
Global TestAX#, TestAY#
Local ShipVeloLR#, ShipVeloUD#, ShipVeloFB#
Const ShipMaxVeloLR# = 5.0, ShipMaxVeloUD# = 5.0, ShipMaxVeloFB = 30.0
; Init
TestX = Rnd(-2048, 2048)
TestY = Rnd(-2048, 2048)
TestZ = Rnd(-2048, 2048)
TestRX = Rnd(0, 360)
TestRY = Rnd(0, 360)
TestRZ = Rnd(0, 360)
TestVX = 0
TestVY = 0
TestVZ = 0
TestAX = 0
TestAY = 0
Local Cam = CreateCamera()
Local Conv = CreatePivot()
Print "[INF] Connecting..."
BNet_Initialize()
BNet_Connect()
If BNet_Connected() Then
Print "[INF] Logging in..."
BNet_Login("Test " + Rand(0, 65535), TestX, TestY, TestZ, TestRX, TestRY, TestRZ)
Local LoopExit = False
Local Load = False
Repeat
If Load = False And BNet_UniqueId = -1 And (MilliSecs() - TimeToLogin > 30000) Then
Print "[ERR] Failed to login."
LoopExit = True
ElseIf Load = False And BNet_UniqueId > -1 Then
Print "[INF] Logged in."
Player = New TPlayer
Player\Mesh = CreateCone()
Player\Player = BNet_Player
Players(BNet_UniqueId) = Player
EntityParent Cam, Player\Mesh
Load = True
ElseIf Load = True And BNet_UniqueId > -1
; Player Input
; Velocity
ShipVeloFB = BNet_Math_ClampF(ShipVeloFB + (KeyDown(17) - KeyDown(31)) * 2.5, -ShipMaxVeloFB, ShipMaxVeloFB)
ShipVeloLR = BNet_Math_ClampF(ShipVeloLR + (KeyDown(32) - KeyDown(30)) * 1.5, -ShipMaxVeloLR, ShipMaxVeloLR)
ShipVeloUD = BNet_Math_ClampF(ShipVeloUD + (KeyDown(19) - KeyDown(33)) * 1.5, -ShipMaxVeloUD, ShipMaxVeloUD)
; Rotation
If KeyDown(57) Then
If KeyHit(57) Then MoveMouse 512, 384
TestRX = TestRX + ((MouseX() / 512) - 1.0)
TestRY = TestRY + ((MouseY() / 384) - 1.0)
EndIf
TestRZ = TestRZ + (KeyDown(18) - KeyDown(16)) * 1.0
; Update Game
; Slowly scale down Velocity.
ShipVeloFB = ShipVeloFB * 0.9
ShipVeloLR = ShipVeloLR * 0.8
ShipVeloUD = ShipVeloUD * 0.8
; Convert Local Velocity to Global Velocity
TFormPoint ShipVeloLR, ShipVeloUD, ShipVeloFB, Player\Mesh, Conv
TestVX = TFormedX()
TestVY = TFormedY()
TestVZ = TFormedZ()
; Move player by Velocity.
TestX = TestX + TestVX
TestY = TestY + TestVY
TestZ = TestZ + TestVZ
; Draw Game
; Update Local Mesh
PositionEntity Player\Mesh, TestX, TestY, TestZ
RotateEntity Player\Mesh, TestRX, TestRY, TestRZ
; Update conversion point
PositionEntity Conv, TestX, TestY, TestZ
RenderWorld
Flip 0
EndIf
If BNet_Update() Then
LoopExit = True
EndIf
WaitTimer FrameTimer
Until (LoopExit = True)
If BNet_Kick = True Then Print "[INF] Kicked: " + BNet_Kick_Reason Else Print "Logging out."
BNet_Disconnect()
Else
Print "[ERR] Failed to connect."
EndIf
End
Function CB_BNet_CreatePlayer(UniqueId, Player.BNetPlayer)
DebugLog "[INF] New Player: " + Player\Name + "[" + UniqueId + "]"
DebugLog " Pos: " + Player\PositionX + ", " + Player\PositionY + ", " + Player\PositionZ
DebugLog " Rot: " + Player\RotationX + ", " + Player\RotationY + ", " + Player\RotationZ
If Players(UniqueId) = Null Then Players(UniqueId) = New TPlayer
If Players(UniqueId)\Mesh <> 0 Then Players(UniqueId)\Mesh = CreateCone()
Players(UniqueId)\Player = Player
PositionEntity Players(UniqueId)\Mesh, Player\PositionX, Player\PositionY, Player\PositionZ
RotateEntity Players(UniqueId)\Mesh, Player\RotationX, Player\RotationY, Player\RotationZ
End Function
Function CB_BNet_UpdatePlayer(UniqueId, Player.BNetPlayer)
If Players(UniqueId) <> Null Then
DebugLog "[INF] Update Player: " + Player\Name + "[" + UniqueId + "]"
DebugLog " Pos: " + Player\PositionX + ", " + Player\PositionY + ", " + Player\PositionZ
DebugLog " Rot: " + Player\RotationX + ", " + Player\RotationY + ", " + Player\RotationZ
PositionEntity Players(UniqueId)\Mesh, Player\PositionX, Player\PositionY, Player\PositionZ
RotateEntity Players(UniqueId)\Mesh, Player\RotationX, Player\RotationY, Player\RotationZ
Else
DebugLog "[ERR] Player does not exist: " + Player\Name + "[" + UniqueId + "]"
EndIf
End Function
Function CB_BNet_DeletePlayer(UniqueId, Player.BNetPlayer)
If Players(UniqueId) <> Null Then
DebugLog "[INF] Delete Player: " + UniqueId + "," + Player\Name
FreeEntity Players(UniqueId)\Mesh
Delete Players(UniqueId)
Else
DebugLog "[ERR] Player does not exist: " + Player\Name + "[" + UniqueId + "]"
EndIf
End Function
Function CB_BNet_SendUpdate(UniqueId, Player.BNetPlayer)
DebugLog "[INF] Update Self"
Player\PositionX = TestX
Player\PositionY = TestY
Player\PositionZ = TestZ
Player\VelocityX = TestVX
Player\VelocityY = TestVY
Player\VelocityZ = TestVZ
Player\RotationX = TestRX
Player\RotationY = TestRY
Player\RotationZ = TestRZ
Player\AimX = TestAX
Player\AimY = TestAY
End Function
Type TPlayer
Field Mesh
Field Player.BNetPlayer
End Type
BlitzBasic/All/Random Stuff/README.md
+8
View File
@@ -0,0 +1,8 @@
Random Stuff
=======================
Contains remaining projects that don't require their own folder or were modified to fit a specific project. Most of this is from Sirius Online and BlitzHit, so expect nothing to work.
License
=======
Random Stuff by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/All/Random Stuff/Test.bb
+44
View File
@@ -0,0 +1,44 @@
AppTitle "TrueMotion"
Include "TrueMotion.bb"
Graphics3D 1024,768,0,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Local eCamera = CreateCamera()
Local tCube = CreateTexture(128,128)
SetBuffer TextureBuffer(tCube)
Color 255, 255, 0
Rect 0, 0, 64, 64
Rect 64, 64, 64, 64
Color 0, 127, 255
Rect 64, 0, 64, 64
Rect 0, 64, 64, 64
SetBuffer BackBuffer()
Local eCube = CreateCube()
PositionEntity eCube, 0, 0, 3
EntityTexture eCube, tCube
Local tInstance.TrueMotion = TrueMotion_Create(eCamera)
Timer = CreateTimer(60)
Global Msec
While Not KeyHit(1)
Cls
Msec = Msec + 10
RotateEntity eCube, Cos(Msec/4.0)*30, 0, EntityRoll(eCube) + 16
PositionEntity eCube, 0, Sin(Msec/4.0)*2, 4
TrueMotion_RenderWorld(tInstance)
Flip
WaitTimer(Timer)
Wend
End
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/All/Random Stuff/Tradelane.bb
+207
View File
@@ -0,0 +1,207 @@
Type Tradelane
Field P1.TVector, P2.TVector, Dir.TVector
Field From$, Target$
Field FromSpot.Spotmark, TargetSpot.Spotmark
Field Gates.TList, Lasers.TList
Field RingsTop.TList, RingsBot.TList
Field RingsInnerTop.TList, RingsInnerBot.TList
Field TubesTop.TList, TubesBot.TList
Field PivotTubes
Field PivotRings
Field MeshA, MeshB, OBBa, OBBb
Field XTubeA, XTubeB
Field Range
End Type
Const Tradelane_Speed# = 50.0
Const Tradelane_SpeedForce# = 0.125
Const Tradelane_Force# = 0.1
Const Tradelane_GateDistance# = 5000.0
Const Tradelane_Offset# = 144
Const Tradelane_Size# = 115
Function CreateTradelane(StartX,StartY,StartZ, EndX,EndY,EndZ, From$, Target$)
Local T.Tradelane = New Tradelane
Local TempVec.TVector
; Information
T\From = From:T\Target = Target
; Start, End and Direction Vector
T\P1 = TVector_Create(StartX, StartY, StartZ)
T\P2 = TVector_Create(EndX, EndY, EndZ)
TempVec = TVector_Subtract(T\P2, T\P1)
T\Dir = TVector_Normalize(TempVec):Delete TempVec
Local Range# = TVector_Distance(T\P1, T\P2)
; Initialize LinkedLists
T\Gates = TList_Create()
T\Lasers = TList_Create()
T\RingsTop = TList_Create()
T\RingsBot = TList_Create()
T\RingsInnerTop = TList_Create()
T\RingsInnerBot = TList_Create()
T\TubesTop = TList_Create()
T\TubesBot = TList_Create()
T\PivotRings = CreatePivot(PVTxEFFECT)
T\PivotTubes = CreatePivot(PVTxEFFECT)
; Create Spots
T\FromSpot.Spotmark = CreateSpot(T\P1\X, T\P1\Y, T\P1\Z, 21, (From + ">>>" + Target))
T\FromSpot.Spotmark = CreateSpot(T\P2\X, T\P2\Y, T\P2\Z, 21, (Target + ">>>" + From))
; Create OBB Collisions
TVector_Angle(T\Dir)
Local TX#, TY#, TZ#
TX = (T\P1\X + T\P2\X) / 2.0
TY = (T\P1\Y + T\P2\Y) / 2.0
TZ = (T\P1\Z + T\P2\Z) / 2.0
Local TVecUp.TVector = TVector_Rotate(T\Dir, -90, 0, 0)
T\OBBa=CreateOBB(TX, TY, TZ, TVector_Pitch-90, TVector_Yaw, 0, 115, 115, Range/2)
T\OBBb=CreateOBB(TX, TY, TZ, TVector_Pitch-90, TVector_Yaw, 0, 115, 115, Range/2)
MoveEntity T\OBBa, 0, Tradelane_Offset, 0
MoveEntity T\OBBb, 0, -Tradelane_Offset, 0
Delete TVecUp
; Create Gates, Sprites and Rings
Local Count = Ceil(Range / Tradelane_GateDistance)
Local Stp# = Range / Count
For n = 0 To Count
; Calculate Position
TempVec = TVector_MultiplyScalar(T\Dir, n*Stp)
Local Pos.TVector = TVector_Add(T\P1, TempVec)
; Create Mesh
Local Mesh = CopyEntity(TLxMSH, PVTxNORMAL)
PositionEntity Mesh, Pos\X, Pos\Y, Pos\Z
AlignToVector Mesh, T\Dir\X, T\Dir\Y, T\Dir\Z, 0, 1
RotateEntity Mesh, EntityPitch(Mesh, 1), EntityYaw(Mesh, 1), 0, 1
EntityAutoFade Mesh,14500,15000
TList_AddLast(T\Gates, Mesh)
; Create Laser
Local Laser = CopyEntity(TLxMSX, Mesh)
EntityAutoFade Laser,9500,10000
TList_AddLast(T\Lasers, Laser)
; Create Rings
Local RingTop = CopyEntity(TLxENT, Mesh)
Local RingBot = CopyEntity(TLxENT, Mesh)
MoveEntity RingTop, 0, Tradelane_Offset, 0
MoveEntity RingBot, 0, -Tradelane_Offset, 0
ScaleSprite RingTop, 125, 125:SpriteViewMode RingTop, 2:EntityColor RingTop, 64, 198, 255:EntityAlpha RingTop, 0.5:EntityAutoFade RingTop, 4500, 5000:EntityBlend RingTop, 3:EntityFX RingTop, 1+16
ScaleSprite RingBot, 125, 125:SpriteViewMode RingBot, 2:EntityColor RingBot, 255, 0, 0:EntityAlpha RingBot, 0.5:EntityAutoFade RingBot, 4500, 5000:EntityBlend RingBot, 3:EntityFX RingBot, 1+16
TList_AddLast(T\RingsTop, RingTop)
TList_AddLast(T\RingsBot, RingBot)
Local RingInTop = CopyEntity(TLxENT2, Mesh)
Local RingInBot = CopyEntity(TLxENT2, Mesh)
MoveEntity RingInTop, 0, Tradelane_Offset, 0
MoveEntity RingInBot, 0, -Tradelane_Offset, 0
ScaleSprite RingInTop, 125, 125:SpriteViewMode RingInTop, 2:EntityAlpha RingInTop, 0.5:EntityAutoFade RingInTop, 4500, 5000:EntityBlend RingInTop, 3:EntityFX RingInTop, 1+16
ScaleSprite RingInBot, 125, 125:SpriteViewMode RingInBot, 2:EntityAlpha RingInBot, 0.5:EntityAutoFade RingInBot, 4500, 5000:EntityBlend RingInBot, 3:EntityFX RingInBot, 1+16
TList_AddLast(T\RingsInnerTop, RingInTop)
TList_AddLast(T\RingsInnerBot, RingInBot)
; Create Refraction Tubes
If n < Count
Local Tube
Tube = CreateCylinder(24, 0, RingInTop)
ScaleEntity Tube, Tradelane_Size, Stp/2, Tradelane_Size
TurnEntity Tube, -90, 0, 0
MoveEntity Tube, 0, -Stp/2, 0
EntityParent Tube, T\PivotTubes
EntityAutoFade Tube, 5000, 10000
EntityFX Tube, 1+8+16
EntityTexture Tube,StarBTex,0,0
EntityTexture Tube,ProjectTex,0,1
EntityAlpha Tube, 0.35
TList_AddLast(T\TubesTop, Tube)
Tube = CreateCylinder(24, 0, RingInBot)
ScaleEntity Tube, Tradelane_Size, Stp/2, Tradelane_Size
TurnEntity Tube, 90, 0, 0
MoveEntity Tube, 0, Stp/2, 0
EntityParent Tube, T\PivotTubes
EntityAutoFade Tube, 5000, 10000
EntityFX Tube, 1+8+16
EntityTexture Tube,StarBTex,0,0
EntityTexture Tube,ProjectTex,0,1
EntityAlpha Tube, 0.35
TList_AddLast(T\TubesBot, Tube)
EndIf
; Delete remaining temporary data
Delete Pos:Delete TempVec
Next
End Function
Function UpdateTradelane()
;set test on
TLxTST=0
; Create Camera Vector
Local vCam.TVector = New TVector
Local vGate.TVector = New TVector
Local vTmp.TVector = Null
Local vTmp2.TVector = Null
vCam\X = EntityX(cCamera, 1)
vCam\Y = EntityY(cCamera, 1)
vCam\Z = EntityZ(cCamera, 1)
For TL.Tradelane = Each Tradelane
; Rings
TList_Reset(TL\RingsTop):TList_Reset(TL\RingsInnerTop)
TList_Reset(TL\RingsBot):TList_Reset(TL\RingsInnerBot)
TList_Reset(TL\Gates)
While TList_HasNext(TL\Gates)
Local RT = TList_Next(TL\RingsTop)
Local RTI = TList_Next(TL\RingsInnerTop)
Local RB = TList_Next(TL\RingsBot)
Local RBI = TList_Next(TL\RingsInnerBot)
Local Gate = TList_Next(TL\Gates)
TurnEntity RT, 0, 0, -.1
TurnEntity RB, 0, 0, .1
vGate\X = EntityX(Gate, 1)
vGate\Y = EntityY(Gate, 1)
vGate\Z = EntityZ(Gate, 1)
vTmp = TVector_Subtract(vGate, vCam)
vTmp2 = TVector_Normalize(vTmp):Delete vTmp
Local Dot# = TVector_Dot(TL\Dir, vTmp2):Delete vTmp2
If Dot >= 0 Then
EntityColor RT, 64, 198, 255
EntityColor RB, 255, 0, 0
Else
EntityColor RB, 64, 198, 255
EntityColor RT, 255, 0, 0
EndIf
Wend
; Traveling
If EntityInOBB(TL\OBBa,pvShip)
AlignToVector pvShip, TL\Dir\X, TL\Dir\Y, TL\Dir\Z, 0, Tradelane_Force
ShipSpeedZ = (ShipSpeedZ * (1-Tradelane_SpeedForce)) + (Tradelane_Speed * Tradelane_SpeedForce)
TLxTST=1
EndIf
If EntityInOBB(TL\OBBB,pvShip)
AlignToVector pvShip, -TL\Dir\X, -TL\Dir\Y, -TL\Dir\Z, 0, Tradelane_Force
ShipSpeedZ = (ShipSpeedZ * (1-Tradelane_SpeedForce)) + (Tradelane_Speed * Tradelane_SpeedForce)
TLxTST=1
EndIf
Next
Delete vCam:Delete vGate
PositionTexture StarBTex, Sin(MilliSecs() / 10000.0), (MilliSecs() / 10000.0) Mod 1
End Function
;~IDEal Editor Parameters:
BlitzBasic/All/Random Stuff/TrueMotion.bb
+51
View File
@@ -0,0 +1,51 @@
Type TrueMotion
Field Camera% = 0
Field Mesh% = 0
End Type
Function TrueMotion_Create.TrueMotion(Camera%)
;Create TrueMotion Instance
tInstance.TrueMotion = New TrueMotion
; Camera can't be Null or invalid
If Camera = 0 Then
RuntimeError "TrueMotion: Camera is Null."
Else
If EntityClass(Camera) <> "Camera" Then
RuntimeError "TrueMotion: Camera is not of type <Camera>."
Else
tInstance\Camera = Camera
EndIf
EndIf
; Create Mesh
tInstance\Mesh = CreateMesh(tInstance\Camera)
sSurface = CreateSurface(tInstance\Mesh)
AddVertex(sSurface, -1, 1, 0, 0, 0)
AddVertex(sSurface, 1, 1, 0, 1, 0)
AddVertex(sSurface, 1, -1, 0, 1, 1)
AddVertex(sSurface, -1, -1, 0, 0, 1)
AddTriangle(sSurface, 0, 1, 2)
AddTriangle(sSurface, 0, 2, 3)
EntityOrder(tInstance\Mesh, -1)
EntityColor(tInstance\Mesh, 0, 0, 0)
PositionEntity(tInstance\Mesh, 0, 0, 1)
HideEntity(tInstance\Mesh)
Return tInstance
End Function
; Call this before after you have done your changes. It is a good practice to only let this effect affect nearby entities.
Function TrueMotion_RenderWorld(tInstance.TrueMotion, Steps%=12)
ShowEntity(tInstance\Mesh)
EntityAlpha(tInstance\Mesh, 1.0/Steps)
CameraClsMode(tInstance\Camera, 0, 1)
For curStep = 0 To Steps - 1
RenderWorld curStep/Float(Steps)
Next
HideEntity(tInstance\Mesh)
RenderWorld 1
CameraClsMode(tInstance\Camera, 1, 1)
CaptureWorld
End Function
BlitzBasic/All/Random Stuff/VectorMath.bb
+161
View File
@@ -0,0 +1,161 @@
;VectorMath.bb
Type TVector
Field X#,Y#,Z#
End Type
Global VectorForward.TVector = TVector_Create( 0, 0, 1)
Global VectorBackward.TVector = TVector_Create( 0, 0, -1)
Global VectorLeft.TVector = TVector_Create(-1, 0, 0)
Global VectorRight.TVector = TVector_Create( 1, 0, 0)
Global VectorUp.TVector = TVector_Create( 0, 1, 0)
Global VectorDown.TVector = TVector_Create( 0, -1, 0)
Function TVector_Create.TVector(X#,Y#,Z#)
Local R.TVector = New TVector
R\X = X
R\Y = Y
R\Z = Z
Return R
End Function
Function TVector_Copy.TVector(A.TVector)
Return TVector_Create(A\X,A\Y,A\Z)
End Function
Function TVector_Add.TVector(A.TVector, B.TVector)
Local R.TVector = New TVector
R\X = A\X + B\X
R\Y = A\Y + B\Y
R\Z = A\Z + B\Z
Return R
End Function
Function TVector_AddScalar.TVector(A.TVector, B#)
Local R.TVector = New TVector
R\X = A\X + B
R\Y = A\Y + B
R\Z = A\Z + B
Return R
End Function
Function TVector_Subtract.TVector(A.TVector, B.TVector)
Local R.TVector = New TVector
R\X = A\X - B\X
R\Y = A\Y - B\Y
R\Z = A\Z - B\Z
Return R
End Function
Function TVector_SubtractScalar.TVector(A.TVector, B#)
Local R.TVector = New TVector
R\X = A\X - B
R\Y = A\Y - B
R\Z = A\Z - B
Return R
End Function
Function TVector_Multiply.TVector(A.TVector, B.TVector)
Local R.TVector = New TVector
R\X = A\X * B\X
R\Y = A\Y * B\Y
R\Z = A\Z * B\Z
Return R
End Function
Function TVector_MultiplyScalar.TVector(A.TVector, B#)
Local R.TVector = New TVector
R\X = A\X * B
R\Y = A\Y * B
R\Z = A\Z * B
Return R
End Function
Function TVector_Divide.TVector(A.TVector, B.TVector)
Local R.TVector = New TVector
R\X = A\X / B\X
R\Y = A\Y / B\Y
R\Z = A\Z / B\Z
Return R
End Function
Function TVector_DivideScalar.TVector(A.TVector, B#)
Local R.TVector = New TVector
R\X = A\X / B
R\Y = A\Y / B
R\Z = A\Z / B
Return R
End Function
Function TVector_Normalize.TVector(A.TVector, MultiPass%=True)
Local R1.TVector, R.TVector
R = TVector_DivideScalar(A, TVector_Length(A))
If MultiPass Then
R1 = R
R = TVector_DivideScalar(R1, TVector_Length(R1))
Delete R1
EndIf
Return R
End Function
Function TVector_Rotate.TVector(A.TVector, Pitch#, Yaw#, Roll#)
Local M1.TVector = TVector_Create(Cos(Roll) * Cos(Yaw), -Sin(Roll), Sin(Yaw))
Local M2.TVector = TVector_Create(Sin(Roll), Cos(Roll) * Cos(Pitch), -Sin(Pitch))
Local M3.TVector = TVector_Create(-Sin(Yaw), Sin(Pitch), Cos(Yaw) * Cos(Pitch))
Local R.TVector = New TVector
R\X = (A\X * M1\X) + (A\Y * M1\Y) + (A\Z * M1\Z)
R\Y = (A\X * M2\X) + (A\Y * M2\Y) + (A\Z * M2\Z)
R\Z = (A\X * M3\X) + (A\Y * M3\Y) + (A\Z * M3\Z)
Delete M1:Delete M2:Delete M3:Return R
End Function
Function TVector_RotateAround.TVector(A.TVector, B.TVector, Pitch#, Yaw#, Roll#)
Local R1.TVector = TVector_Subtract(A, B)
Local R2.TVector = TVector_Rotate(R1, Pitch, Yaw, Roll)
Local R3.TVector = TVector_Add(R2, B)
Delete R1:Delete R2:Return R3
End Function
Function TVector_RotateAroundScalar.TVector(A.TVector, X#, Y#, Z#, Pitch#, Yaw#, Roll#)
Local B.TVector = TVector_Create(X,Y,Z)
Local R.TVector = TVector_RotateAround(A, B, Pitch, Yaw, Roll)
Delete B:Return R
End Function
Function TVector_Dot#(A.TVector, B.TVector)
Return ((A\X*B\X)+(A\Y*B\Y)+(A\Z*B\Z))
End Function
Function TVector_Cross.TVector(A.TVector, B.TVector)
Local R.TVector = New TVector
R\X = (A\Y*B\Z) - (A\Z*B\Y)
R\Y = (A\Z*B\X) - (A\X*B\Z)
R\Z = (A\X*B\Y) - (A\Y*B\X)
Return R
End Function
Global TVector_Pitch#, TVector_Yaw#
Function TVector_Angle(A.TVector) ; X
TVector_Pitch = VectorPitch(A\X, A\Y, A\Z);-ATan2(A\Y, Sqr((A\X*A\X) + (A\Z*A\Z))) + 90
TVector_Yaw# = VectorYaw(A\X, A\Y, A\Z);ATan2(A\Z, A\X) - 90
End Function
Function TVector_PitchFrom#(A.TVector, B.TVector) ; X
;Return ATan2(A\Y-B\Y, A\Z-B\Z)
Return VectorPitch(A\X-B\X, A\Y-B\Y, A\Z-B\Z)
End Function
Function TVector_YawFrom#(A.TVector, B.TVector) ; Y
;Return ATan2(A\Z-B\Z, A\X-B\X)
Return VectorYaw(A\X-B\X, A\Y-B\Y, A\Z-B\Z)
End Function
;Function TVector_RollFrom#(A.TVector, B.TVector) ; Z
; Return ATan2(A\Y-B\Y, A\X-B\X)
;End Function
Function TVector_Length#(A.TVector)
Return Sqr((A\X*A\X)+(A\Y*A\Y)+(A\Z*A\Z))
End Function
Function TVector_Distance#(A.TVector, B.TVector)
Local X# = (A\X-B\X)
Local Y# = (A\Y-B\Y)
Local Z# = (A\Z-B\Z)
Return Sqr(X*X+Y*Y+Z*Z)
End Function
Function TVector_ToString$(A.TVector)
Return "{X:"+A\X+";Y:"+A\Y+";Z:"+A\Z+"}"
End Function
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/All/Sirius Online Inventory/README.md
+8
View File
@@ -0,0 +1,8 @@
Sirius Online Inventory
=======================
This was ment to be in the Sirius Online project, but the lead devloper never got further than complaining. So it has the side-effect of not working.I planned to optimize it to use as little memory and network bandwidth as possible, but the project was abandoned before I could go that far. Right now, it probably doesn't even work.
License
=======
Sirius Online Inventory by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/All/Sirius Online Inventory/SOInventory.bb
+407
View File
@@ -0,0 +1,407 @@
;----------------------------------------------------------------
;-- Constants
;----------------------------------------------------------------
Const ITEM_MAXIMUMID = 65535
; Item Classes
Const ITEM_CLASS_WEAPON = 1
Const ITEM_CLASS_SHIELD = 2
Const ITEM_CLASS_ARMOR = 3
Const ITEM_CLASS_ENGINE = 4
Const ITEM_CLASS_POWERCORE = 5
Const ITEM_CLASS_RESOURCE = 6
Const ITEM_CLASS_UPGRADE = 7
Const ITEM_CLASS_MININGMODULE = 8
Const ITEM_CLASS_ELITIUM = 255
; Return Codes
Const INVENTORY_RC_OK = 0
Const INVENTORY_RC_INVALIDID = -1
Const INVENTORY_RC_INVALIDAMOUNT = -2
Const INVENTORY_RC_UNKNOWNITEM = -3
Const INVENTORY_RC_ITEMTOOBIG = -4
Const INVENTORY_RC_ITEMNOTFOUND = -5
;----------------------------------------------------------------
;-- Types
;----------------------------------------------------------------
; Item Definition
Type TItem
Field ID%
Field Name$ ; Name of the Item
Field Description$ ; Description of the Item
Field Image ; Handle of the Image for the Item
Field Size% ; Size in cubic decimeters. Divide by 1000 to get the size in cube meters, which is displayed.
Field Rarity% ; Rarity
Field Class% ; Class of the Item.
Field AttributeID0%
Field AttributeID1%
Field AttributeID2%
Field AttributeID3%
; Attributes for Class: Weapon
; - Short/255 Electric Damage (Attribute 0 High)
; - Short/255 Physical Damage (Attribute 0 Low)
; - Short/255 Rate of Fire (Attribute 1 High)
; - Short Energy (Attribute 3 High)
; - Short/255 CPU (Attribute 3 Low)
; Attributes for Class: Shield
; - Int Shield Maximum (Attribute 0)
; - Short/255 Electric Resist (Attribute 1 High)
; - Short/255 Physical Resist (Attribute 1 Low)
; - Short Recharge Amount (Attribute 2 High)
; - Short Recharge Rate (Attribute 2 Low)
; - Short/255 CPU (Attribute 3 Low)
; Attributes for Class: Armor
; - Int Armor Maximum (Attribute 0)
; - Short/255 Speed Modifier (Attribute 1 High)
; - Short/255 Turn Modifier (Attribute 1 Low)
; - Short/255 Signature Mod. (Attribute 2 High)
; Attributes for Class: Engine
; - Short/255 Maximum Speed (Attribute 0 High)
; - Short/255 Maximum Boost (Attribute 0 Low)
; - Short Trace Type (Attribute 2 High)
; - Short/255 Trace Threshold (Attribute 2 Low)
; - Short Energy (Attribute 3 High)
; - Short/255 CPU (Attribute 3 Low)
; Attributes for Class: PowerCore
; - Int Energy Maximum (Attribute 0)
; - Short Energy Amount (Attribute 1 High)
; - Short Energy Rate (Attribute 1 Low)
; - Byte Elec. Signature (Attribute 2 High 1)
; - Byte Scramble Str. (Attribute 2 High 0)
; - Short/255 CPU (Attribute 3 Low)
; Attributes for Class: Resource
; - Byte Processing Tier (Attribute 0 Low 1)
; - Byte Load Type (Attribute 0 Low 0)
; - Int Half-life Time (Attribute 3)
; Attributes for Class: Upgrade
; - Byte/127 Armor Bonus (Attribute 0 High 1)
; - Byte/127 Shield Bonus (Attribute 0 High 0)
; - Byte/127 Speed Bonus (Attribute 0 Low 1)
; - Byte/127 Cargo Bonus (Attribute 0 Low 0)
; - Byte/127 Elec. Sig. Mod. (Attribute 1 High 1)
; - Byte/127 Grav. Sig. Mod. (Attribute 1 High 0)
; - Byte/127 Elec. Dmg. Mod. (Attribute 1 Low 1)
; - Byte/127 Phys. Dmg. Mod. (Attribute 1 Low 0)
; - Byte/127 El. ShRes Mod. (Attribute 2 High 1)
; - Byte/127 Ph. ShRes Mod. (Attribute 2 High 0)
; - Byte/127 El. ArRes Mod. (Attribute 2 Low 1)
; - Byte/127 Ph. ArRes Mod. (Attribute 2 Low 0)
; - Byte Scramble Str. (Attribute 3 High 1)
; - Byte/127 Yield Bonus (Attribute 3 High 0)
; - Byte Energy Max (Attribute 3 Low 1)
; - Byte/127 CPU Modifier (Attribute 3 Low 0)
; Attributes for Class: Mining Module
; -
; Attributes for Class: Elitium
; -
End Type
Dim Items.TItem(ITEM_MAXIMUMID)
; Inventory
Type TInventory
Field Size% ; Size in cubic meters. Divide by 1000 to get the size in cube meters, which is displayed.
Field Used% ; Used space in cubic decimeters. Divide by 1000 to get the size in cube meters, which is displayed.
; Array containing all Items using their ItemID as index.
Field Items.TInventoryItem[ITEM_MAXIMUMID]
End Type
Type TInventoryItem
Field Amount% ; How many of this Item are stored?
End Type
;----------------------------------------------------------------
;-- Functions
;----------------------------------------------------------------
; Create a new inventory.
Function TInventory_Create.TInventory(Size%)
If Size <= 0 Then RuntimeError "TInventory: Size is equal to or less than 0."
Local lInventory.TInventory = New TInventory
lInventory\Size = Size
lInventory\Used = 0
Return lInventory
End Function
; Safely destroy an existing inventory.
Function TInventory_Destroy(pInventory.TInventory)
If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
For lIndex = 0 To (ITEM_MAXIMUMID - 1)
If pInventory\Items[lIndex] <> Null Then
Delete pInventory\Items[lIndex]
pInventory\Items[lIndex] = Null
EndIf
Next
Delete pInventory
End Function
; Retrieve the amount of items in the inventory with the given ItemID.
Function TInventory_GetItemAmount(pInventory.TInventory, ItemID%)
If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
If ItemID >= 0 And ItemID < ITEM_MAXIMUMID Then
If Items(ItemID) <> Null Then
If pInventory\Items[ItemID] <> Null
Return pInventory\Items[ItemID]\Amount
Else
Return INVENTORY_RC_ITEMNOTFOUND
EndIf
Else
Return INVENTORY_RC_UNKNOWNITEM
EndIf
Else
Return INVENTORY_RC_INVALIDID
EndIf
End Function
; Set the amount of items in the inventory with the given ItemID.
Function TInventory_SetItemAmount(pInventory.TInventory, ItemID%, Amount%)
If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
If Amount < 0 Then Return INVENTORY_RC_INVALIDAMOUNT
If ItemID >= 0 And ItemID < ITEM_MAXIMUMID Then
If Items(ItemID) <> Null Then
; Remove current Amount and Size from Inventory
If pInventory\Items[ItemID] <> Null Then
pInventory\Used = pInventory\Used - (Items(ItemID)\Size * pInventory\Items[ItemID]\Amount)
If Amount = 0 Then
Delete pInventory\Items[ItemID]
pInventory\Items[ItemID] = Null
EndIf
EndIf
If Amount > 0
If pInventory\Items[ItemID] = Null pInventory\Items[ItemID] = New TInventoryItem
Local lAmount = Amount
If pInventory\Used + (Items(ItemID)\Size * lAmount) > PInventory\Size Then lAmount = (pInventory\Size - pInventory\Used) / Items(ItemID)\Size
pInventory\Items[ItemID]\Amount = lAmount
pInventory\Used = pInventory\Used + (Items(ItemID)\Size * lAmount)
Return lAmount
Else
Return INVENTORY_RC_OK
EndIf
If pInventory\Items[ItemID] <> Null Then lSize = lSize - (Items(ItemID)\Size * pInventory\Items[ItemID]\Amount)
Else
Return INVENTORY_RC_UNKNOWNITEM
EndIf
Else
Return INVENTORY_RC_INVALIDID
EndIf
End Function
; Add an item to the inventory.
; Returns the amount of items added or a negative value (error code)
Function TInventory_AddItem(pInventory.TInventory, ItemID%, Amount%=1)
If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
If Amount <= 0 Then Return INVENTORY_RC_INVALIDAMOUNT
If ItemID >= 0 And ItemID < ITEM_MAXIMUMID Then
If Items(ItemID ) <> Null Then
Local lAmount = Amount
If pInventory\Used + (lAmount * Items(ItemID)\Size) > pInventory\Size Then lAmount = (pInventory\Size - pInventory\Used) / Items(ItemID)\Size
If lAmount > 0 Then
If pInventory\Items[ItemID] = Null Then pInventory\Items[ItemID] = New TInventoryItem
pInventory\Items[ItemID]\Amount = pInventory\Items[ItemID]\Amount + lAmount
pInventory\Used = pInventory\Used + (lAmount * Items(ItemID)\Size)
EndIf
Return lAmount
Else
Return INVENTORY_RC_UNKNOWNITEM
EndIf
Else
Return INVENTORY_RC_INVALIDID
EndIf
End Function
; Remove an item from the inventory.
; Returns the amount of items removed or a negative value (error code).
Function TInventory_RemoveItem(pInventory.TInventory, ItemID%, Amount%=1)
If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
If Amount <= 0 Then Return INVENTORY_RC_INVALIDAMOUNT
If ItemID >= 0 And ItemID < ITEM_MAXIMUMID Then
If Items(ItemID) <> Null Then
If pInventory\Items[ItemID] <> Null Then
Local lAmount = pInventory\Items[ItemID]\Amount
pInventory\Items[ItemID]\Amount = pInventory\Items[ItemID]\Amount - Amount
If pInventory\Items[ItemID]\Amount <= 0 Then
pInventory\Used = pInventory\Used - (lAmount * Items(ItemID)\Size)
; Delete Item Entry (Reduces Memory Usage)
Delete pInventory\Items[ItemID]:pInventory\Items[ItemID] = Null
Return lAmount
Else
pInventory\Used = pInventory\Used - (Amount * Items(ItemID)\Size)
Return Amount
EndIf
Else
Return INVENTORY_RC_ITEMNOTFOUND
EndIf
Else
Return INVENTORY_RC_UNKNOWNITEM
EndIf
Else
Return INVENTORY_RC_INVALIDID
EndIf
End Function
; For when you edit the inventory without using the above functions.
Function TInventory_RecalculateUsedSpace(pInventory.TInventory)
If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
pInventory\Used = 0
For lIndex = 0 To (ITEM_MAXIMUMID - 1)
If Items(lIndex) <> Null And pInventory\Items[lIndex] <> Null Then
pInventory\Used = pInventory\Used + (pInventory\Items[lIndex]\Amount * Items(lIndex)\Size)
EndIf
Next
End Function
;----------------------------------------------------------------
;-- Extras - Require 'LinkedListEmulation.bb'!
;----------------------------------------------------------------
;Type TInventoryItemLink
; Field ItemID%
; Field Amount%
;End Type
;
; ; Retrieve a LinkedList containing all items in this inventory.
; ; The returned list must be deleted using TInventory_DeleteItemList(...).
; ; Modifications on this list can only be applied to the inventory using TInventory_SetItemList(...).
;Function TInventory_GetItemList.TList(pInventory.TInventory)
; If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
;
; Local lList.TList = TList_Create()
; For lIndex = 0 To (ITEM_MAXIMUMID - 1)
; If Items(lIndex) <> Null And pInventory\Items[lIndex] <> Null Then
; Local lInvItemLink.TInventoryItemLink = New TInventoryItemLink
; lInvItemLink\ItemID = lIndex
; lInvItemLink\Amount = pInventory\Items[lIndex]\Amount
; TList_AddLast(lInvItemLink)
; EndIf
; Next
;
; Return lList
;End Function
;
;Function TInventory_SetItemList(pInventory.TInventory, pList.TList)
; If pInventory = Null Then RuntimeError "TInventory: Inventory does not exist."
; If pList = Null Then RuntimeError "TInventory: List does not exist."
;
; pInventory\Used = 0
; For lIndex = 0 To (ITEM_MAXIMUMID - 1)
; If Items(lIndex) <> Null And pInventory\Items[lIndex] <> Null Then
; Delete pInventory\Items[lIndex]
; pInventory\Items[lIndex] = Null
; EndIf
; Next
;
; Local lInvItemLink.TInventoryItemLink = Object.TInventoryItemLink(TList_First(pList))
; While lInvItemLink <> Null
; If lInvItemLink\ItemID >= 0 And lInvItemLink\ItemID < ITEM_MAXIMUMID Then
; If Items(lInvItemLink\ItemID) <> Null And lInvItemLink\Amount > 0 Then
; pInventory\Items[lInvItemLink\ItemID] = New TInventoryItem
; pInventory\Items[lInvItemLink\ItemID]\Amount = lInvItemLink\Amount
;
; pInventory\Used = pInventory\Used + (lInvItemLink\Amount * Items(lInvItemLink\ItemID)\Size)
; EndIf
; EndIf
; lInvItemLink = Object.TInventoryItemLink(TList_Next(pList))
; Wend
;End Function
;
;Function TInventory_DeleteItemList(pList.TList)
; If pList = Null Then RuntimeError "TInventory: List does not exist."
;
; Local lInvItemLink.TInventoryItemLink = Object.TInventoryItemLink(TList_First(pList))
; While lInvItemLink <> Null
; Delete lInvItemLink
; lInvItemLink = Object.TInventoryItemLink(TList_Delete(pList))
; Wend
;
; TList_Destroy(pList)
;End Function
;----------------------------------------------------------------
;-- Example
;----------------------------------------------------------------
SeedRnd(MilliSecs())
; Test Item
Items(0) = New TItem
Items(0)\Name = "1dm³ Item"
Items(0)\Description = ""
Items(0)\Size = 1
; Test Item
Items(1) = New TItem
Items(1)\Name = "10dm3 Item"
Items(1)\Description = ""
Items(1)\Size = 10
; Test Item
Items(2) = New TItem
Items(2)\Name = "100dm3 Item"
Items(2)\Description = ""
Items(2)\Size = 100
; Test Item
Items(3) = New TItem
Items(3)\Name = "1000dm3 Item"
Items(3)\Description = ""
Items(3)\Size = 1000
Local MyInv.TInventory = TInventory_Create(10000)
While Not KeyHit(1)
Cls
Locate 0,0
PrintInv(MyInv)
If Rand(0,1000) Mod 4 < 2
TInventory_AddItem(MyInv, Rand(0,3), Rand(0,100))
TInventory_RemoveItem(MyInv, Rand(0,3), Rand(0,100))
Else
TInventory_SetItemAmount(MyInv, Rand(0,3), Rand(0,100))
TInventory_SetItemAmount(MyInv, Rand(0,3), Rand(0,100))
EndIf
WaitKey()
Flip 0
Wend
TInventory_Destroy(MyInv)
End
Function PrintInv(Inv.TInventory)
Print "Inventory " + Handle(Inv)
Print " Size: " + (Inv\Size/1000) + "." + (Inv\Size Mod 1000) + " m³"
Print " Used: " + (Inv\Used/1000) + "." + (Inv\Used Mod 1000) + " m³ / " + Int((Inv\Used/Float(Inv\Size))*100) + "%"
Print " Remaining: " + ((Inv\Size - Inv\Used)/1000) + "." + ((Inv\Size - Inv\Used) Mod 1000) + " m³ / " + Int(((Inv\Size - Inv\Used)/Float(Inv\Size))*100) + "%"
Print " Items:"
For lIndex = 0 To (ITEM_MAXIMUMID - 1)
If Items(lIndex) <> Null And TInventory_GetItemAmount(Inv, lIndex) > 0 Then
Print " - " + Items(lIndex)\Name + " x" + TInventory_GetItemAmount(Inv, lIndex)
EndIf
Next
; Alternatively, using Extras
;Local lList.TList = TInventory_GetItemList(Inv)
;Local lEntry.TInventoryItemLink = Object.TInventoryItemLink(TList_First(lList))
;While lEntry <> Null
; Print " - " + Items(lEntry\ItemID)\Name + " x" + lEntry\Amount
; lEntry = Object.TInventoryItemLink(TList_Next(lList))
;Wend
;TInventory_DestroyItemList(lList)
End Function
BlitzBasic/Blitz3D/HelpersAndFixes/HelpersAndFixes.bb
+227
View File
@@ -0,0 +1,227 @@
;[Block] Rendering Functions
Global ERTPos#[2], ERTRot#[2]
Const ES_AxisX = 0, ES_AxisY = 1, ES_AxisZ = 2
;[End Block]
Function EntityRenderToImage(iCam, iEnt, iImg)
Local CP#[2], EP#[2], CR#[2], Buffer = GraphicsBuffer(), SX#, SY#, SZ#, Dist#, IW = ImageWidth(iImg), IH = ImageHeight(iImg), IB = ImageBuffer(iImg)
CP[0] = EntityX(iCam):CP[1] = EntityY(iCam):CP[2] = EntityZ(iCam)
CR[0] = EntityPitch(iCam):CR[1] = EntityYaw(iCam):CR[2] = EntityRoll(iCam)
EP[0] = EntityX(iEnt):EP[1] = EntityY(iEnt):EP[2] = EntityZ(iEnt)
SX = EntityScale(iEnt,ES_AxisX):SY = EntityScale(iEnt,ES_AxisY):SZ = EntityScale(iEnt,ES_AxisZ)
Dist# = Sqr((SX*SX)+(SY*SY)+(SZ*SZ))
PositionEntity iCam, ERTPos[0], ERTPos[1], ERTPos[2]
PositionEntity iEnt, ERTPos[0], ERTPos[1], ERTPos[2]+Dist
RotateEntity iCam, 0, 0, 0
EntityParent iEnt, iCam
RotateEntity iCam, ERTRot[0], ERTRot[1], ERTRot[2]
CameraViewport iCam, 0, 0, IW, IH
RenderWorld
CopyRect 0,0,IW,IH,0,0,Buffer,IB
CameraViewport iCam, 0, 0, GraphicsWidth(), GraphicsHeight()
RotateEntity iCam, 0, 0, 0
EntityParent iEnt, 0
PositionEntity iCam, CP[0],CP[1],CP[2]
PositionEntity iEnt, EP[0],EP[1],EP[2]
RotateEntity iCam, CR[0],CR[1],CR[2]
End Function
Function EntityRenderToTexture(iCam, iEnt, iTex)
Local CP#[2], EP#[2], CR#[2], Buffer = GraphicsBuffer(), SX#, SY#, SZ#, Dist#, IW = TextureWidth(iTex), IH = TextureHeight(iTex), IB = TextureBuffer(iTex)
CP[0] = EntityX(iCam):CP[1] = EntityY(iCam):CP[2] = EntityZ(iCam)
CR[0] = EntityPitch(iCam):CR[1] = EntityYaw(iCam):CR[2] = EntityRoll(iCam)
EP[0] = EntityX(iEnt):EP[1] = EntityY(iEnt):EP[2] = EntityZ(iEnt)
SX = EntityScale(iEnt,ES_AxisX):SY = EntityScale(iEnt,ES_AxisY):SZ = EntityScale(iEnt,ES_AxisZ)
Dist# = Sqr((SX*SX)+(SY*SY)+(SZ*SZ))*0.25 + Sqr(Sqr((SX*SX)+(SY*SY)+(SZ*SZ)))*0.75
PositionEntity iCam, ERTPos[0], ERTPos[1], ERTPos[2]
PositionEntity iEnt, ERTPos[0], ERTPos[1], ERTPos[2]+Dist
RotateEntity iCam, 0, 0, 0
EntityParent iEnt, iCam
RotateEntity iCam, ERTRot[0], ERTRot[1], ERTRot[2]
CameraViewport iCam, 0, 0, IW, IH
;SetBuffer IB ;FastEXT only
RenderWorld
CopyRect 0,0,IW,IH,0,0,Buffer,IB
CameraViewport iCam, 0, 0, GraphicsWidth(), GraphicsHeight()
;SetBuffer Buffer ;FastEXT only
RotateEntity iCam, 0, 0, 0
EntityParent iEnt, 0
PositionEntity iCam, CP[0],CP[1],CP[2]
PositionEntity iEnt, EP[0],EP[1],EP[2]
RotateEntity iCam, CR[0],CR[1],CR[2]
End Function
Function EntityScale#( Entity, Axis )
VX# = GetMatElement( Entity, Axis, 0 )
VY# = GetMatElement( Entity, Axis, 1 )
VZ# = GetMatElement( Entity, Axis, 2 )
Return Sqr( VX#*VX# + VY#*VY# + VZ#*VZ# )
End Function
;[Block] Math Functions
Global HSV#[2], RGB#[2]
;[End Block]
Function Math_MaxMin#(Value#, Max#, Min#)
If Value> Max Then Return Max
If Value < Min Then Return Min
Return Value
End Function
Function Math_Max#(Value#, Max#)
If Value> Max Then Return Max
Return Value
End Function
Function Math_Min#(Value#, Min#)
If Value < Min Then Return Min
Return Value
End Function
Function Math_Clip#(Value#, Low#, High#)
Local Out#, Diff#
Diff = High-Low:Out = Value-Low
If (Out >= Diff) Then Out = Out - Floor(Out/Diff)*Diff
If (Out < 0) Then Out = Out - Floor(Out/Diff)*Diff
Return Low+Out
End Function
Function Math_RGBHSV(R,G,B)
Local maxC#, minC#, delta#, dr#, dg#, db#
R = R/255.0:G = G/255.0:B = B/255.0
maxC = Math_Min(Math_Min(R,G),B)
minC = Math_Max(Math_Max(R,G),B)
delta = maxC - minC
HSV[0] = 0:HSV[1] = 0:HSV[2] = maxC
If delta = 0
HSV[0] = 0:HSV[1] = 0
Else
HSV[1] = delta / maxC
dr = 60*(maxC - R)/delta + 180
dg = 60*(maxC - G)/delta + 180
db = 60*(maxC - B)/delta + 180
If R = maxC
HSV[0] = db - dg
ElseIf G = maxC
HSV[0] = 120 + dr - db
Else
HSV[0] = 240 + dg - dr
EndIf
EndIf
HSV[0] = Math_Clp(HSV[0],0,360)
End Function
Function Math_HSVRGB(H#,S#,V#)
Local m#, n#, f#, i
H = Math_Clp(H,0,360)/60.0
If H = S And S = 0
RGB[0] = V
RGB[1] = V
RGB[2] = V
EndIf
i = Floor(H)
f = H - i
If Not (i Mod 2) Then f = 1 - f
m = V * (1-S)
n = V * (1-S*f)
Select i
Case 6,0
RGB[0] = V*255
RGB[1] = n*255
RGB[2] = m*255
Case 1
RGB[0] = n*255
RGB[1] = V*255
RGB[2] = m*255
Case 2
RGB[0] = m*255
RGB[1] = V*255
RGB[2] = n*255
Case 3
RGB[0] = m*255
RGB[1] = n*255
RGB[2] = V*255
Case 4
RGB[0] = n*255
RGB[1] = m*255
RGB[2] = V*255
Case 5
RGB[0] = V*255
RGB[1] = m*255
RGB[2] = n*255
End Select
End Function
;[Block] String Functions
Dim SplittedString$(1)
Global SplitCount
;[End Block]
Function SplitString(In$, StringSplitter$ = "|")
Local InLength% = Len(In)
Local SplitLength% = Len(StringSplitter)
Local CountPos%, InPos%, SplitIndex%
Local SplitTest$, LineText$
; Count how many Lines there are and resize Dim.
SplitCount = 0
For CountPos = 1 To InLength-(SplitLength-1)
SplitTest = Mid(In,CountPos,1)
If SplitTest = StringSplitter Then SplitCount = SplitCount + 1
Next
Dim SplittedString(SplitCount)
; Split the Text onto multiple lines.
While Not InPos = Len(In)
; Increment Position
InPos = InPos + 1
; Grab a piece of the text.
SplitTest = Mid(In, InPos, SplitLength)
Local Char$ = Left(SplitTest, 1)
; Check if the current Text matches the splitter or if we are near the end.
If SplitTest = StringSplitter Or InPos = InLength
; Append the current character if it doesn't match the Splitter.
If InPos = InLength And SplitTest <> StringSplitter Then LineText = LineText + Char
; Store the Line.
SplittedString(SplitIndex) = LineText
; Increment split index.
SplitIndex = SplitIndex + 1
; Reset LineText
LineText = ""
Else
LineText = LineText + Char
EndIf
Wend
End Function
Function SafeText$(sText$)
Local sSafeText$ = sText
For i = 0 To 31
sSafeText = Replace(sSafeText,Chr(i),"["+i+"]")
Next
Return sSafeText
End Function
Function Replace$(S$,F$,T$,CaseSensitive=0)
Local LF = Len(F), Pos
Pos = 1
While Not Pos > Len(S)-LF+1
Local Check$ = Mid(S,Pos,LF)
If Lower(F) = Lower(Check) And (F = Check Or CaseSensitive=0)
S = Left(S,Pos-1)+T+Mid(S,Pos+LF,-1)
Pos = Pos + Len(T)
EndIf
Pos = Pos + 1
Wend
Return S
End Function
BlitzBasic/Blitz3D/HelpersAndFixes/README.md
+9
View File
@@ -0,0 +1,9 @@
HelpersAndFixes
=======================
A try at adding features to BlitzBasic that didn't exist, without touching C++ or manipulating the DLL file using reverse engineering. Worked quite well, though obviously slower than native code.
Documentation at: http://www.blitzforum.de/forum/viewtopic.php?p=374655#374655
License
=======
HelpersAndFixes by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/Blitz3D/Impostor/CreateImpostorTextures.bb
+282
View File
@@ -0,0 +1,282 @@
Const CfgMeshToRender$ = "D:\Projekte\Blitz3D\Sirius\GFX\ENV\VINxROIDx001.3ds"
Const CfgDiffuseMap$ = "D:\Projekte\Blitz3D\Sirius\GFX\ENV\VINxROIDx001DIFF.png"
Const CfgDiffuseFlags% = (1+256+512)
Const CfgNormalMap$ = "D:\Projekte\Blitz3D\Sirius\GFX\ENV\VINxROIDx001NORM.png"
Const CfgNormalFlags = (1+256+512)
Const CfgFrameSizeX = 128
Const CfgFrameSizeY = 128
Const CfgPitchMin# = -90
Const CfgPitchMax# = 90
Const CfgPitchFrames = 5
Const CfgYawMin# = 0
Const CfgYawMax# = 360
Const CfgYawFrames = 16
Const CfgDistance# = 120
; Includes
Include "FreeImage.bb"
Include "FastExt.bb"
Include "../Advanced Text (Library)/AdvText.bb"
Include "Impostor.bb"
; Set up 3D Scene
Graphics3D 1024, 1024, 32, 2:InitExt()
SetBuffer_ BackBuffer()
; Set up Camera
Global CameraPivot = CreatePivot()
Global Camera = CreateCamera(CameraPivot)
MoveEntity Camera, 0, 0, -CfgDistance
AmbientLight 255, 255, 255
; Set up Impostor data
Local ImpostorMesh% = LoadMesh(CfgMeshToRender)
Local ImpostorDiffuse% = LoadTexture(CfgDiffuseMap, CfgDiffuseFlags)
Local ImpostorNormal% = LoadTexture(CfgNormalMap, CfgNormalFlags)
; Set up final image
Local DiffuseSheet% = CreateImage(CfgFrameSizeX, CfgFrameSizeY, CfgYawFrames * CfgPitchFrames)
Local NormalSheet% = CreateImage(CfgFrameSizeX, CfgFrameSizeY, CfgYawFrames * CfgPitchFrames)
; Set up render target
;Const RTSize% = 2048
Local RenderTarget% = CreateTexture(CfgFrameSizeX, CfgFrameSizeY, 1+256+FE_RENDER+FE_ZRENDER)
CameraViewport Camera, 0, 0, CfgFrameSizeX, CfgFrameSizeY
; Render
SetBuffer TextureBuffer(RenderTarget)
Local YawStep# = (CfgYawMax - CfgYawMin) / CfgYawFrames
Local PitchStep# = (CfgPitchMax - CfgPitchMin) / CfgPitchFrames
Local Yaw, Pitch
For Yaw = 0 To CfgYawFrames - 1
Local RealYaw# = CfgYawMin + (YawStep * Yaw)
For Pitch = 0 To CfgPitchFrames - 1
Local RealPitch# = CfgPitchMin + (PitchStep * Pitch)
Local Frame = Pitch * CfgYawFrames + Yaw
RotateEntity CameraPivot, RealPitch, RealYaw, 0, 1
; Render Diffuse
Cls:EntityTexture ImpostorMesh, ImpostorDiffuse:RenderWorld:CopyRectStretch(0, 0, CfgFrameSizeX, CfgFrameSizeY, 0, 0, CfgFrameSizeX, CfgFrameSizeY, TextureBuffer(RenderTarget), ImageBuffer(DiffuseSheet, Frame))
; Render Normal
Cls:EntityTexture ImpostorMesh, ImpostorNormal:RenderWorld:CopyRectStretch(0, 0, CfgFrameSizeX, CfgFrameSizeY, 0, 0, CfgFrameSizeX, CfgFrameSizeY, TextureBuffer(RenderTarget), ImageBuffer(NormalSheet, Frame))
Next
Next
SetBuffer BackBuffer()
FreeTexture RenderTarget
Local Stream = WriteFile("Preview.imp")
WriteShort Stream, CfgFrameSizeX
WriteShort Stream, CfgFrameSizeY
WriteByte Stream, CfgPitchFrames
WriteFloat Stream, CfgPitchMin
WriteFloat Stream, CfgPitchMax
WriteByte Stream, CfgYawFrames
WriteFloat Stream, CfgYawMin
WriteFloat Stream, CfgYawMax
CloseFile(Stream)
Stream = WriteFile("PreviewNormal.imp")
WriteShort Stream, CfgFrameSizeX
WriteShort Stream, CfgFrameSizeY
WriteByte Stream, CfgPitchFrames
WriteFloat Stream, CfgPitchMin
WriteFloat Stream, CfgPitchMax
WriteByte Stream, CfgYawFrames
WriteFloat Stream, CfgYawMin
WriteFloat Stream, CfgYawMax
CloseFile(Stream)
Function SaveAnimImageSheet(Image%, File$, FramesX%, FramesY%)
Local x, y, img = CreateImage(ImageWidth(Image) * FramesX, ImageHeight(Image) * FramesY)
For x = 0 To FramesX - 1
For y = 0 To FramesY - 1
Local frame = y * FramesX + x
CopyRect 0, 0, ImageWidth(Image), ImageHeight(Image), x * ImageWidth(Image), y * ImageHeight(Image), ImageBuffer(Image, frame), ImageBuffer(img)
Next
Next
FiSaveImage(img, File)
End Function
SaveAnimImageSheet(DiffuseSheet, "Preview.png", CfgYawFrames, CfgPitchFrames)
SaveAnimImageSheet(NormalSheet, "PreviewNormal.png", CfgYawFrames, CfgPitchFrames)
Global ControlHelp1$
ControlHelp1$ = ControlHelp1$ + "Controls:" + Chr(10)
ControlHelp1$ = ControlHelp1$ + Chr(9) + "1 - Mode: Draw Sheet" + Chr(10)
ControlHelp1$ = ControlHelp1$ + Chr(9) + "2 - Mode: Draw Frame" + Chr(10)
ControlHelp1$ = ControlHelp1$ + Chr(9) + "3 - Mode: 3D Preview" + Chr(10)
Global ControlHelp2$
ControlHelp2$ = ControlHelp2$ + "Sheet Mode Controls:" + Chr(10)
ControlHelp2$ = ControlHelp2$ + Chr(9) + "Q - Sheet: Diffuse" + Chr(10)
ControlHelp2$ = ControlHelp2$ + Chr(9) + "W - Sheet: Normal" + Chr(10)
Global ControlHelp3$
ControlHelp3$ = ControlHelp3$ + "Frame Mode Controls:" + Chr(10)
ControlHelp3$ = ControlHelp3$ + Chr(9) + "Q - Sheet: Diffuse" + Chr(10)
ControlHelp3$ = ControlHelp3$ + Chr(9) + "W - Sheet: Normal" + Chr(10)
ControlHelp3$ = ControlHelp3$ + Chr(9) + "A - Previous Frame" + Chr(10)
ControlHelp3$ = ControlHelp3$ + Chr(9) + "D - Next Frame" + Chr(10)
Global ControlHelp4$
ControlHelp4$ = ControlHelp4$ + "3D Mode Controls:" + Chr(10)
ControlHelp4$ = ControlHelp4$ + Chr(9) + "Q - Sheet: Diffuse" + Chr(10)
ControlHelp4$ = ControlHelp4$ + Chr(9) + "W - Sheet: Normal" + Chr(10)
ControlHelp4$ = ControlHelp4$ + Chr(9) + "Mouse - Rotate Camera" + Chr(10)
Local Timer = CreateTimer(30)
Const DrawModeSheet% = 0
Const DrawModeFrame% = 1
Const DrawMode3D% = 2
Local DrawMode% = DrawModeSheet
Local ModeSheet_Image% = DiffuseSheet
Local ModeSheet_XOff% = 0
Local ModeSheet_YOff% = 0
Local ModeFrame_Image% = DiffuseSheet
Local ModeFrame_Frame% = 0
Local Mode3D_DiffImp.Impostor = Impostor_Load("Preview.imp")
Local Mode3D_NormImp.Impostor = Impostor_Load("PreviewNormal.imp")
Local Mode3D_Pitch# = 0
Local Mode3D_Yaw# = 0
Local Mode3D_Pivot = CreatePivot()
Local Mode3D_Camera = CreateCamera(Mode3D_Pivot)
MoveEntity Mode3D_Camera, 0, 0, -100
EntityTexture ImpostorMesh, ImpostorDiffuse:HideEntity Mode3D_NormImp\Pivot
CameraViewport Camera, 0, 256, 512, 512
CameraViewport Mode3D_Camera, 512, 256, 512, 512
MoveEntity Mode3D_DiffImp\Mesh, 1000, 0, 0
MoveEntity Mode3D_NormImp\Mesh, 1000, 0, 0
ScaleEntity Mode3D_DiffImp\Mesh, CfgDistance, CfgDistance, 1
ScaleEntity Mode3D_NormImp\Mesh, CfgDistance, CfgDistance, 1
MoveEntity Mode3D_Pivot, 1000, 0, 0
CameraRange Camera, 0.1, 500
CameraRange Mode3D_Camera, 0.1, 500
;Local tc = CreateCube(Mode3D_Pivot)
EntityTexture Mode3D_DiffImp\Mesh, Mode3D_DiffImp\Sheet, 0, 0
While Not KeyHit(1)
Cls
; 3D - Render
If DrawMode = DrawMode3D
Impostor_Update(Mode3D_Camera)
;EntityTexture Mode3D_DiffImp\Mesh, Mode3D_DiffImp\Sheet, 0, 0
WireFrame KeyDown(57)
RenderWorld
EndIf
; 2D - Rener
AdvText 0, 0, ControlHelp1, 0, 0, 1
; Show Mode specific data.
Select DrawMode
Case DrawModeSheet
; Control
If MouseDown(1) And MouseHit(1) Then
MoveMouse MouseX(), MouseY()
ElseIf MouseDown(1)
ModeSheet_XOff = ModeSheet_XOff + MouseXSpeed()
ModeSheet_YOff = ModeSheet_YOff + MouseYSpeed()
EndIf
If KeyHit(16) Then ModeSheet_Image = DiffuseSheet
If KeyHit(17) Then ModeSheet_Image = NormalSheet
; Render
Local rw = ImageWidth(ModeSheet_Image) * CfgYawFrames
Local rh = ImageHeight(ModeSheet_Image) * CfgPitchFrames
For p = 0 To CfgPitchFrames - 1
For y = 0 To CfgYawFrames - 1
DrawImage ModeSheet_Image, GraphicsWidth() / 2 - rw / 2 + ModeSheet_XOff + ImageWidth(ModeSheet_Image) * y, GraphicsHeight() / 2 - rh / 2 + ModeSheet_YOff + ImageHeight(ModeSheet_Image) * p, y + p * CfgYawFrames
Next
Next
; Show Help
AdvText 0, 50, ControlHelp2, 0, 0, 1
Case DrawModeFrame
; Control
If KeyHit(16) Then ModeFrame_Image = DiffuseSheet
If KeyHit(17) Then ModeFrame_Image = NormalSheet
If KeyHit(30) Then ModeFrame_Frame = ModeFrame_Frame - 1
If KeyHit(32) Then ModeFrame_Frame = ModeFrame_Frame + 1
If ModeFrame_Frame < 0 Then ModeFrame_Frame = CfgPitchFrames * CfgYawFrames - 1
If ModeFrame_Frame = (CfgPitchFrames * CfgYawFrames) Then ModeFrame_Frame = 0
; Render
DrawImage ModeFrame_Image, GraphicsWidth() / 2 - ImageWidth(ModeFrame_Image) / 2, GraphicsHeight() / 2 - ImageHeight(ModeFrame_Image) / 2, ModeFrame_Frame
; Show Help
AdvText 0, 50, ControlHelp3, 0, 0, 1
Case DrawMode3D
; Control
If KeyHit(16) Then
HideEntity Mode3D_NormImp\Pivot
ShowEntity Mode3D_DiffImp\Pivot
EntityTexture ImpostorMesh, ImpostorDiffuse
EndIf
If KeyHit(17) Then
ShowEntity Mode3D_NormImp\Pivot
HideEntity Mode3D_DiffImp\Pivot
EntityTexture ImpostorMesh, ImpostorNormal
EndIf
If MouseDown(1) And MouseHit(1)
MoveMouse 512, 384
ElseIf MouseDown(1)
Mode3D_Pitch = Math_MaxMin(Mode3D_Pitch + MouseYSpeed() / 15.0, 90, -90)
Mode3D_Yaw = Mode3D_Yaw + MouseXSpeed() / 15.0
RotateEntity Mode3D_Pivot, Mode3D_Pitch, Mode3D_Yaw, 0, 1
RotateEntity CameraPivot, Mode3D_Pitch, Mode3D_Yaw, 0, 1
MoveMouse 512, 384
EndIf
If MouseDown(2) And MouseHit(2)
MoveMouse 512, 384
ElseIf MouseDown(2)
MoveEntity Mode3D_Camera, 0, 0, (MouseXSpeed() - MouseYSpeed()) / 15.0
MoveMouse 512, 384
EndIf
; Show Help
AdvText 0, 50, ControlHelp4, 0, 0, 1
End Select
; Switch Mode Hotkeys
If KeyHit(2) Then DrawMode = DrawModeSheet
If KeyHit(3) Then DrawMode = DrawModeFrame
If KeyHit(4) Then DrawMode = DrawMode3D
Flip 0
WaitTimer Timer
Wend
Function Math_MaxMin#(Value#, Max#, Min#)
If Value> Max Then Return Max
If Value < Min Then Return Min
Return Value
End Function
Function Math_Max#(Value#, Max#)
If Value> Max Then Return Max
Return Value
End Function
Function Math_Min#(Value#, Min#)
If Value < Min Then Return Min
Return Value
End Function
Function Math_Clip#(Value#, Low#, High#)
Local Out#, Diff#
Diff = High-Low:Out = Value-Low
If (Out >= Diff) Then Out = Out - Floor(Out/Diff)*Diff
If (Out < 0) Then Out = Out - Floor(Out/Diff)*Diff
Return Low+Out
End Function
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/Blitz3D/Impostor/Cube.imp
BIN
View File
Binary file not shown.
BlitzBasic/Blitz3D/Impostor/Cube.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 94 KiB

BlitzBasic/Blitz3D/Impostor/Example01_Cube.bb
+47
View File
@@ -0,0 +1,47 @@
Include "Impostor.bb"
Graphics3D 1024, 768, 32, 2
SetBuffer BackBuffer()
Local Timer = CreateTimer(60)
;Camera
Local CamPivot = CreatePivot()
Local Cam = CreateCamera(CamPivot)
MoveEntity Cam, 0, 0, -20
; Impostor
Local MyImp.Impostor = Impostor_Load("Cube.imp")
;EntityFX MyImp\Mesh, 16
MoveEntity MyImp\Mesh, 0, 0, 0
ScaleEntity MyImp\Mesh, 10, 10, 10
; Base Cube
Local Flr = CreateCube()
MoveEntity Flr, 0, -10, 0
ScaleEntity Flr, 10, .001, 10
EntityColor Flr, 51, 51, 51
While Not KeyHit(1)
Cls
WireFrame KeyDown(2)
If MouseDown(1) And MouseHit(1)
MoveMouse 512, 384
ElseIf MouseDown(1)
RotateEntity CamPivot, EntityPitch(CamPivot) + MouseYSpeed() / 15.0, EntityYaw(CamPivot) + MouseXSpeed() / 15.0, 0, 1
MoveMouse 512, 384
EndIf
If MouseDown(2) And MouseHit(2)
MoveMouse 512, 384
ElseIf MouseDown(2)
MoveEntity Cam, 0, 0, (MouseXSpeed() - MouseYSpeed()) / 15.0
MoveMouse 512, 384
EndIf
Impostor_Update(Cam)
RenderWorld
Flip 0:WaitTimer Timer
Wend
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/Blitz3D/Impostor/FastExt.bb
+496
View File
@@ -0,0 +1,496 @@
; Include file for FastExt v1.17 library
; (c) 2006-2010 created by MixailV aka Monster^Sage [monster-sage@mail.ru] http://www.fastlibs.com
Const FE_VERSION$ = "1.17"
; íîâûå êîíñòàíòû äëÿ ñîçäàíèÿ òåêñòóðû (ôóíêöèÿ CreateTexture)
; New constants for texture creating (CreateTexture function only)
Const FE_ExSIZE = 2048
Const FE_RENDER = 4096
Const FE_ZRENDER = 8192
; íîâûå êîíñòàíòû äëÿ FX ( ôóíêöèè EntityFX èëè BrushFX )
; New constants for brush Fx ( EntityFX or BrushFX functions only)
Const FE_WIRE = 64 ; ðèñóþòñÿ òîëüêî ëèíèè
Const FE_POINT = 128 ; ðèñóþòñÿ òîëüêî òî÷êè
; Êîíñòàíòû äëÿ ôóíêöèè RenderPostprocess
; RenderPostprocess function constants
Const FE_DOF = 1
Const FE_Glow = 2
Const FE_Blur = 4
Const FE_Inverse = 8
Const FE_Grayscale = 16
Const FE_Contrast = 32
Const FE_BlurDirectional = 64
Const FE_BlurZoom = 128
Const FE_BlurSpin = 256
Const FE_BlurMotion = 512
Const FE_Overlay = 1024
Const FE_Posterize = 2048
Const FE_Rays = 4096
; -------------------- DirectX7 constants (only for TextureBlendCustom function) -----------------------
; Control
Const D3DTOP_DISABLE = 1 ; disables stage
Const D3DTOP_SELECTARG1 = 2 ; the Default
Const D3DTOP_SELECTARG2 = 3
; Modulate
Const D3DTOP_MODULATE = 4 ; multiply args together
Const D3DTOP_MODULATE2X = 5 ; multiply And 1 bit
Const D3DTOP_MODULATE4X = 6 ; multiply And 2 bits
; Add
Const D3DTOP_ADD = 7 ; add arguments together
Const D3DTOP_ADDSIGNED = 8 ; add With -0.5 bias
Const D3DTOP_ADDSIGNED2X = 9 ; As above but left 1 bit
Const D3DTOP_SUBTRACT = 10 ; Arg1 - Arg2, With no saturation
Const D3DTOP_ADDSMOOTH = 11 ; add 2 args, subtract product Arg1 + Arg2 - Arg1*Arg2 = Arg1 + (1-Arg1)*Arg2
; Linear alpha blend: Arg1*(Alpha) + Arg2*(1-Alpha)
Const D3DTOP_BLENDDIFFUSEALPHA = 12 ; iterated alpha
Const D3DTOP_BLENDTEXTUREALPHA = 13 ; texture alpha
Const D3DTOP_BLENDFACTORALPHA = 14 ; alpha from D3DRENDERSTATE_TEXTUREFACTOR Linear alpha blend With pre-multiplied arg1 input: Arg1 + Arg2*(1-Alpha)
Const D3DTOP_BLENDTEXTUREALPHAPM = 15 ; texture alpha
Const D3DTOP_BLENDCURRENTALPHA = 16 ; by alpha of current color
; Specular mapping
Const D3DTOP_PREMODULATE = 17 ; modulate With Next texture before use
Const D3DTOP_MODULATEALPHA_ADDCOLOR = 18 ; Arg1.RGB + Arg1.A*Arg2.RGB COLOROP only
Const D3DTOP_MODULATECOLOR_ADDALPHA = 19 ; Arg1.RGB*Arg2.RGB + Arg1.A COLOROP only
Const D3DTOP_MODULATEINVALPHA_ADDCOLOR = 20 ; (1-Arg1.A)*Arg2.RGB + Arg1.RGB COLOROP only
Const D3DTOP_MODULATEINVCOLOR_ADDALPHA = 21 ; (1-Arg1.RGB)*Arg2.RGB + Arg1.A COLOROP only
; Bump mapping
Const D3DTOP_BUMPENVMAP = 22 ; per pixel env map perturbation
Const D3DTOP_BUMPENVMAPLUMINANCE = 23 ; With luminance channel
; This can do either diffuse Or specular bump mapping With correct input.
; Performs the function (Arg1.R*Arg2.R + Arg1.G*Arg2.G + Arg1.B*Arg2.B)
; where each component has been scaled And offset To make it signed.
; The result is replicated into all four (including alpha) channels.
; This is a valid COLOROP only.
Const D3DTOP_DOTPRODUCT3 = 24
Const FETOP_PROJECT = $010000 ; FastExt constant for 2D projective texturing TextureCoords=0 (UV0)
Const FETOP_PROJECT0 = $010000 ; FastExt constant for 2D projective texturing TextureCoords=0 (UV0)
Const FETOP_PROJECT1 = $020000 ; FastExt constant for 2D projective texturing TextureCoords=1 (UV1)
Const FETOP_PROJECT3D = $050000 ; FastExt constant for 3D projective texturing TextureCoords=0 (UV0)
Const FETOP_PROJECT3D0 = $050000 ; FastExt constant for 3D projective texturing TextureCoords=0 (UV0)
Const FETOP_PROJECT3D1 = $060000 ; FastExt constant for 3D projective texturing TextureCoords=1 (UV1)
; -------------------- DirectX7 constants (only for EntityBlendCustom & BrushBlendCustom functions) -----------------------
Const D3DBLEND_ZERO = 1
Const D3DBLEND_ONE = 2
Const D3DBLEND_SRCCOLOR = 3
Const D3DBLEND_INVSRCCOLOR = 4
Const D3DBLEND_SRCALPHA = 5
Const D3DBLEND_INVSRCALPHA = 6
Const D3DBLEND_DESTALPHA = 7
Const D3DBLEND_INVDESTALPHA = 8
Const D3DBLEND_DESTCOLOR = 9
Const D3DBLEND_INVDESTCOLOR = 10
Const D3DBLEND_SRCALPHASAT = 11
Const D3DBLEND_BOTHSRCALPHA = 12
Const D3DBLEND_BOTHINVSRCALPHA = 13
; íîâûå êîíñòàíòû äëÿ òåêñòóðíûõ ñìåøèâàíèé (ôóíêöèÿ TextureBlend)
; New constants for texture stage blending (TextureBlend function)
Const FE_ALPHACURRENT = (D3DTOP_BLENDCURRENTALPHA Shl 8) Or D3DTOP_SELECTARG1 ; = $1002 ïðîçðà÷íîñòü ïðåäûäóùåé òåêñòóðû äëÿ òåêóùåé
Const FE_ALPHAMODULATE = (D3DTOP_MODULATE Shl 8) Or D3DTOP_MODULATE ; = $0404 óìíîæåíèå ïðîçðà÷íîñòè (èñïîëüçóåì åùå è òåêóùóþ ïðîçðà÷íîñòü)
Const FE_BUMP = (D3DTOP_BUMPENVMAP Shl 8) Or D3DTOP_SELECTARG2 ; = $1603 òåêñòóðà èñêàæåíèé
Const FE_BUMPLUM = (D3DTOP_BUMPENVMAPLUMINANCE Shl 8) Or D3DTOP_SELECTARG2 ; = $1703 òåêñòóðà èñêàæåíèé + êàíàë ÿðêîñòè
Const FE_PROJECT = FETOP_PROJECT Or (D3DTOP_MODULATE Shl 8) Or D3DTOP_MODULATE ; = $010404 òåêñòóðà íàêëàäûâàåòñÿ êàê ïðîåêöèÿ (óìíîæåíèåì)
Const FE_PROJECTSMOOTH = FETOP_PROJECT Or (D3DTOP_ADDSMOOTH Shl 8) Or D3DTOP_MODULATE ; = $010B04 òåêñòóðà íàêëàäûâàåòñÿ êàê ïðîåêöèÿ (ïëàâíûì ñëîæåíèåì)
Const FE_MULTIPLY4X = (D3DTOP_MODULATE4X Shl 8)
Const FE_ADDSIGNED = (D3DTOP_ADDSIGNED Shl 8)
Const FE_ADDSIGNED2X = (D3DTOP_ADDSIGNED2X Shl 8)
Const FE_ADDSMOOTH = (D3DTOP_ADDSMOOTH Shl 8)
Const FE_SUB = (D3DTOP_SUBTRACT Shl 8)
Const FE_SPECULAR0 = (D3DTOP_MODULATEALPHA_ADDCOLOR Shl 8)
Const FE_SPECULAR1 = (D3DTOP_MODULATECOLOR_ADDALPHA Shl 8)
Const FE_SPECULAR2 = (D3DTOP_MODULATEINVALPHA_ADDCOLOR Shl 8)
Const FE_SPECULAR3 = (D3DTOP_MODULATEINVCOLOR_ADDALPHA Shl 8)
; íîâûå êîíñòàíòû äëÿ áðàø (åíòèòè) ñìåøèâàíèé (ôóíêöèÿ BrushBlend è EntityBlend)
; New constants for brush (entity) blending (BrushBlend and EntityBlend function)
Const FE_INVALPHA = $010605
Const FE_INVCOLOR = $010406
Const FE_INVCOLORADD = $010402
Const FE_NOALPHA = $000101
; ãëîáàëüíûé òèï äëÿ ïîëó÷åíèÿ âîçìîæíîñòåé âèäåî-äðàéâåðà
; Global type for Gfx-driver capabilities
Type GfxDriverCapsEx_Type
Field BrushBlendsSrc%
Field BrushBlendsDest%
Field TextureCaps%
Field TextureBlends%
Field TextureMaxStages%
Field TextureMaxWidth%
Field TextureMaxHeight%
Field TextureMaxAspectRatio%
Field ClipplanesMax%
Field LightsMax%
Field Bump%
Field BumpLum%
Field AnisotropyMax%
End Type
Global GfxDriverCapsEx.GfxDriverCapsEx_Type = New GfxDriverCapsEx_Type
Type Matrix3D
Field m11#, m12#, m13#, m14#
Field m21#, m22#, m23#, m24#
Field m31#, m32#, m33#, m34#
Field m41#, m42#, m43#, m44#
End Type
; library system vars
Global FE_PivotSys% = 0
Global FE_InitExtFlag% = 0
Global FE_InitPostprocessFlag% = 0
Global FE_PostprocessTexture1% = 0
Global FE_PostprocessTexture2% = 0
Global FE_PostprocessTexture3% = 0
Global FE_PostprocessTexture4% = 0
Global FE_PostprocessTexture5% = 0
; ãëàâíàÿ ôóíêöèÿ èíèöèàëèçàöèè áèáëèîòåêè, îáÿçàòåëüíî çàïóñêàåòñÿ ïîñëå êîìàíäû Graphics3D
; Main function for library initialising, must call after command Graphics3D
Function InitExt% ()
If FE_VERSION<>ExtVersion() Then
RuntimeError "ERROR! FastExstension library - Incorrect versions for FastExt.dll (v"+ExtVersion()+") And FastExt.bb (v"+FE_VERSION+")"
Else
DebugLog "Init FastExtension library v"+FE_VERSION+"successful"
EndIf
If FE_InitExtFlag=0 Then
FE_InitExtFlag = 1
FE_PivotSys = CreatePivot()
DeInitPostprocess()
InitExt_ ( SystemProperty("Direct3DDevice7"), BackBuffer(), GfxDriverCapsEx )
EndIf
End Function
; ôóíêöèÿ äëÿ ðåíäåðèíãà îäíîãî åíòèòè (âñå åãî ÷èëäû òîæå áóäóò îòðåíäåðåíû, åñëè íå ñêðûòû)
; Function for render single entity or entity with childrens
Function RenderEntity% (entity%, camera%, clearViewport%=0, tween#=1.0)
Return RenderEntity_ (entity, camera, tween, clearViewport, FE_PivotSys)
End Function
; ôóíêöèÿ äëÿ ðåíäåðèíãà ãðóïïû åíòèòåé (âñå åãî ÷èëäû òîæå áóäóò îòðåíäåðåíû, åñëè íå ñêðûòû)
; Function for render group of entities (with childrens, if not hidden)
Function RenderGroup% (group%, camera%, clearViewport%=0, tween#=1.0)
Return RenderGroup_ (group, camera, tween, clearViewport, FE_PivotSys)
End Function
Function TextureAnisotropy% (level%=0, index%=-1)
Return TextureAnisotropy_ (level, index)
End Function
Function TextureLodBias% (bias#=-0.2, index%=-1)
Return TextureLodBias_ (bias, index)
End Function
; Äîïîëüíèòåëüíûå ôóíêöèè äëÿ ÊëèïÏëåéíîâ
; Additional functions for ClipPlanes
Function CreateClipplane% (entity%=0, x1#=0, y1#=0, z1#=0, x2#=0, y2#=0, z2#=1, x3#=1, y3#=0, z3#=0)
If entity<>0 Then
TFormPoint 0, 0, 0,entity,0 : x1 = TFormedX() : y1 = TFormedY() : z1 = TFormedZ()
TFormPoint 0, 0, 1,entity,0 : x2 = TFormedX() : y2 = TFormedY() : z2 = TFormedZ()
TFormPoint 1, 0, 0,entity,0 : x3 = TFormedX() : y3 = TFormedY() : z3 = TFormedZ()
EndIf
Return CreateClipplane_ ( x1, y1, z1, x2, y2, z2, x3, y3, z3 )
End Function
Function AlignClipplane% (plane%, entity%=0, x1#=0, y1#=0, z1#=0, x2#=0, y2#=0, z2#=1, x3#=1, y3#=0, z3#=0)
If entity<>0 Then
TFormPoint 0, 0, 0,entity,0 : x1 = TFormedX() : y1 = TFormedY() : z1 = TFormedZ()
TFormPoint 0, 0, 1,entity,0 : x2 = TFormedX() : y2 = TFormedY() : z2 = TFormedZ()
TFormPoint 1, 0, 0,entity,0 : x3 = TFormedX() : y3 = TFormedY() : z3 = TFormedZ()
EndIf
Return AlignClipplane_ ( plane, x1, y1, z1, x2, y2, z2, x3, y3, z3 )
End Function
; Äîïîëüíèòåëüíûå ôóíêöèè äëÿ Êàìåðû
; Additional functions for Camera
Global MirrorCameraLast% = 0
Global MirrorCameraX# = 0
Global MirrorCameraY# = 0
Global MirrorCameraZ# = 0
Global MirrorCameraAX# = 0
Global MirrorCameraAY# = 0
Global MirrorCameraAZ# = 0
Global MirrorCameraParent% = 0
Function MirrorCamera% (camera%=0, entity%=0)
If camera<>0 Then
MirrorCameraLast = camera
MirrorCameraX# = EntityX(camera,1)
MirrorCameraY# = EntityY(camera,1)
MirrorCameraZ# = EntityZ(camera,1)
MirrorCameraAX# = EntityPitch(camera,1)
MirrorCameraAY# = EntityYaw(camera,1)
MirrorCameraAZ# = EntityRoll(camera,1)
If entity<>0 Then
MirrorCameraParent = ParentEntity(camera)
EntityParent camera, entity, 1
PositionEntity camera, EntityX(camera), -EntityY(camera), EntityZ(camera)
RotateEntity camera, -EntityPitch(camera), EntityYaw(camera), -EntityRoll(camera)
EntityParent camera,0,1
Else
PositionEntity camera, MirrorCameraX, -MirrorCameraY, MirrorCameraZ, 1
RotateEntity camera, -MirrorCameraAX, MirrorCameraAY, -MirrorCameraAZ, 1
EndIf
EndIf
End Function
Function RestoreCamera% (camera%=0)
If camera=0 Then camera=MirrorCameraLast
If camera<>0 Then
PositionEntity camera, MirrorCameraX, MirrorCameraY, MirrorCameraZ, 1
RotateEntity camera, MirrorCameraAX, MirrorCameraAY, MirrorCameraAZ, 1
If MirrorCameraParent<>0 Then EntityParent camera, MirrorCameraParent, 1
EndIf
End Function
; ñòàðûå ôóíêöèè òåïåðü ñ íîâûìè âîçìîæíîñòÿìè
; Old functions with NEW capabilities
Function SetBuffer% (buffer%)
Return SetBuffer_ (buffer)
End Function
Function GetBuffer% ()
Return SetBuffer_ (-1)
End Function
Function ClsColor% (red%, green%, blue%, alpha%=$FF, zValue#=1.0)
Return ClsColor_ (red, green, blue, alpha, zValue)
End Function
Function Cls% (clearColor%=1, clearZBuffer%=1)
Return Cls_ (clearColor, clearZBuffer)
End Function
Function WireFrame% (enable%=0)
Return Wireframe_ (enable)
End Function
Function Bump% (enable%=-1)
Return Bump_ (enable)
End Function
Function FreeTexture% (texture%)
If texture<>0 Then
Return FreeTexture_ (texture, TextureBuffer(texture))
Else
Return 0
EndIf
End Function
Function ColorFilter% (red%=1, green%=1, blue%=1, alpha%=1)
Return ColorFilter_ (red, green, blue, alpha)
End Function
Function TextureBlend% (texture%, blend%)
TextureBlend_ texture, blend
End Function
; íîâûå ôóíêöèÿ äëÿ çàäàíèÿ ÑÂÎÈÕ òåêñòóðíûõ ñìåøèâàíèé (èñïîëüçóéòå òîëüêî D3DTOP_* êîíñòàíòû, ñì. èõ íèæå)
; New function for custom texture blending (use D3DTOP_* constans only, see below)
Function TextureBlendCustom% (texture%, color_operation%, alpha_operation%=0, projection_flag%=0)
If color_operation>24 Then color_operation=24
If color_operation<1 Then color_operation=1
If alpha_operation>24 Then alpha_operation=24
If alpha_operation<0 Then alpha_operation=0
projection_flag = projection_flag And $7
TextureBlend texture, (projection_flag Shl 16) Or (color_operation Shl 8) Or alpha_operation
End Function
; íîâûå ôóíêöèè äëÿ ñîçäàíèÿ ÑÂÎÈÕ ñìåøèâàíèé ïðè ðåíäåðå îáúåêòîâ (èñïîëüçóéòå òîëüêî D3DBLEND_* êîíñòàíòû, ñì. èõ íèæå)
; New functions for custom entity (brush) blending (use D3DBLEND_* constans only, see below)
Function EntityBlendCustom% (entity%, source_blend%=1, destination_blend%=1, alphablending_enable%=0)
If source_blend>13 Then source_blend=13
If source_blend<1 Then source_blend=1
If destination_blend>13 Then destination_blend=13
If destination_blend<1 Then destination_blend=1
If alphablending_enable<>0 Then alphablending_enable=1
EntityBlend entity, (alphablending_enable Shl 16) Or (source_blend Shl 8) Or destination_blend
End Function
Function BrushBlendCustom% (brush%, source_blend%=1, destination_blend%=1, alphablending_enable%=0)
If source_blend>13 Then source_blend=13
If source_blend<1 Then source_blend=1
If destination_blend>13 Then destination_blend=13
If destination_blend<1 Then destination_blend=1
If alphablending_enable<>0 Then alphablending_enable=1
BrushBlend brush, (alphablending_enable Shl 16) Or (source_blend Shl 8) Or destination_blend
End Function
Function ExecAndExit% (file$="", command$="", workingDir$="")
ExecAndExit_ file, command, workingDir
End Function
Function InitPostprocess% ()
Local CurrentBuffer%, smallWidth%, smallHeight%
If FE_InitPostprocessFlag=0
smallWidth = GraphicsWidth()/3 : smallHeight = GraphicsHeight()/3
FE_PostprocessTexture1 = CreateTexture ( GraphicsWidth(), GraphicsHeight(), 1 + 256 + FE_ExSIZE + FE_RENDER + FE_ZRENDER )
FE_PostprocessTexture2 = CreateTexture ( smallWidth, smallHeight, 1 + 256 + FE_ExSIZE + FE_RENDER )
FE_PostprocessTexture3 = CreateTexture ( 16, 16, 1 )
FE_PostprocessTexture4 = CreateTexture ( smallWidth, smallHeight, 1 + 256 + FE_ExSIZE + FE_RENDER )
FE_PostprocessTexture5 = CreateTexture ( GraphicsWidth(), GraphicsHeight(), 1 + 256 + FE_ExSIZE ) ; comment this string if MotionBlur not needed (not used)
CurrentBuffer = SetBuffer (TextureBuffer(FE_PostprocessTexture3))
ClsColor 255,255,255 : Cls : SetBuffer BackBuffer()
If InitPostprocess_ (BackBuffer(), TextureBuffer(FE_PostprocessTexture1), TextureBuffer(FE_PostprocessTexture2), TextureBuffer(FE_PostprocessTexture3), TextureBuffer(FE_PostprocessTexture4), TextureBuffer(FE_PostprocessTexture5))<>0 Then
FE_InitPostprocessFlag = 1
Else
If FE_PostprocessTexture1<>0 Then FreeTexture FE_PostprocessTexture1
If FE_PostprocessTexture2<>0 Then FreeTexture FE_PostprocessTexture2
If FE_PostprocessTexture3<>0 Then FreeTexture FE_PostprocessTexture3
If FE_PostprocessTexture4<>0 Then FreeTexture FE_PostprocessTexture4
If FE_PostprocessTexture5<>0 Then FreeTexture FE_PostprocessTexture5
EndIf
SetBuffer CurrentBuffer
EndIf
Return FE_InitPostprocessFlag
End Function
Function DeInitPostprocess% ()
If FE_InitPostprocessFlag<>0 Then
If FE_PostprocessTexture1<>0 Then FreeTexture FE_PostprocessTexture1
If FE_PostprocessTexture2<>0 Then FreeTexture FE_PostprocessTexture2
If FE_PostprocessTexture3<>0 Then FreeTexture FE_PostprocessTexture3
If FE_PostprocessTexture4<>0 Then FreeTexture FE_PostprocessTexture4
If FE_PostprocessTexture5<>0 Then FreeTexture FE_PostprocessTexture5
FE_InitPostprocessFlag = 0
EndIf
End Function
Function RenderPostprocess% (flags%=0, x%=0, y%=0, width%=0, height%=0)
If InitPostprocess()<>0 Then RenderPostprocess_ flags, x, y, width, height
End Function
Function CustomPostprocessDOF% (near#=10.0, far#=100.0, direction%=1, level%=3, blurRadius#=0.35, quality%=1)
CustomPostprocessDOF_ near, far, direction, level, blurRadius, quality
End Function
Function CustomPostprocessGlow% (alpha#=1.0, darkPasses%=2, blurPasses%=4, blurRadius#=0.35, quality%=1, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessGlow_ alpha, darkPasses, blurPasses, blurRadius, quality, red, green, blue, alphaTexture
End Function
Function CustomPostprocessBlur% (alpha#=1.0, blurPasses%=4, blurRadius#=0.35, quality%=1, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessBlur_ alpha, blurPasses, blurRadius, quality, red, green, blue, alphaTexture
End Function
Function CustomPostprocessInverse% (alpha#=1.0, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessInverse_ alpha, red, green, blue, alphaTexture
End Function
Function CustomPostprocessGrayscale% (alpha#=1.0, brightness#=1.0, inverse%=0, alphaTexture%=0)
CustomPostprocessGrayscale_ alpha, brightness, inverse, alphaTexture
End Function
Function CustomPostprocessContrast% (alpha#=1.0, method%=0, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessContrast_ alpha#, method, red, green, blue, alphaTexture
End Function
Function CustomPostprocessBlurDirectional% (angle#=0, alpha#=1, blurPasses%=4, blurRadius#=0.35, quality%=1, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessBlurDirectional_ angle, alpha, blurPasses, blurRadius, quality, red, green, blue, alphaTexture
End Function
Function CustomPostprocessBlurZoom% (x#=0.5, y#=0.5, zoomFactor#=105, alpha#=1, blurPasses%=4, quality%=1, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessBlurZoom_ x, y, zoomFactor, alpha, blurPasses, quality, red, green, blue, alphaTexture
End Function
Function CustomPostprocessBlurSpin% (x#=0.5, y#=0.5, spinAngle#=4, alpha#=1, blurPasses%=4, quality%=1, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessBlurSpin_ x, y, spinAngle, alpha, blurPasses, quality, red, green, blue, alphaTexture
End Function
Function CustomPostprocessBlurMotion% (alpha#=0.9, originX#=0, originY#=0, handleX#=0.5, handleY#=0.5, scaleX#=100, scaleY#=100, angle#=0, blend%=0, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessBlurMotion_ alpha, originX, originY, handleX, handleY, scaleX, scaleY, angle, blend, red, green, blue, alphaTexture
End Function
Function CustomPostprocessOverlay% (alpha#=0.5, blend%=0, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessOverlay_ alpha, blend, red, green, blue, alphaTexture
End Function
Function CustomPostprocessRays% (centerX#=0.5, centerY#=0.5, zoomFactor#=105, alpha#=1, darkPasses%=2, blurPasses%=4, quality%=1, red%=255, green%=255, blue%=255, alphaTexture%=0)
CustomPostprocessRays_% (centerX, centerY, zoomFactor, alpha, darkPasses, blurPasses, quality, red, green, blue, alphaTexture)
End Function
Function DeInitExt% ()
If FE_InitExtFlag<>0 Then
FE_InitExtFlag = 0
SetBuffer BackBuffer()
FreeEntity FE_PivotSys
DeInitPostprocess
DeInitExt_
EndIf
End Function
BlitzBasic/Blitz3D/Impostor/FreeImage.bb
+1297
View File
File diff suppressed because it is too large Load Diff
BlitzBasic/Blitz3D/Impostor/Impostor.bb
+122
View File
@@ -0,0 +1,122 @@
Const ImpostorVariant = 0
Type Impostor
Field Frames%
Field FrameWidth%, FrameHeight%
Field PitchFrames%, PitchMin#, PitchMax#
Field YawFrames%, YawMin#, YawMax#
Field Sheet%
Field Pivot%, Parent%
Field Mesh%, Surface%
Field YawStep#, PitchStep#
End Type
Function Impostor_Init.Impostor(Parent%=0)
Local Instance.Impostor = New Impostor
Instance\Pivot = CreatePivot(Parent)
Instance\Mesh = CreateMesh(Instance\Pivot)
Instance\Surface = CreateSurface(Instance\Mesh)
Local V0,V1,V2,V3
V0 = AddVertex(Instance\Surface, -1, 1, 0, 1, 0, 0)
V1 = AddVertex(Instance\Surface, 1, 1, 0, 0, 0, 0)
V2 = AddVertex(Instance\Surface, -1, -1, 0, 1, 1, 0)
V3 = AddVertex(Instance\Surface, 1, -1, 0, 0, 1, 0)
AddTriangle Instance\Surface, V0, V2, V1
AddTriangle Instance\Surface, V1, V2, V3
Return Instance
End Function
Function Impostor_Load.Impostor(Path$, Flags%=1+4+16+32+256+512, Parent%=0)
If FileType(Path) <> 1 Then
RuntimeError "Impostor: Given <Path$> is not a file."
Else
Local Stream = ReadFile(Path)
If Stream = 0 Then
RuntimeError "Impostor: Unable to open given <Path$>."
Else
Local Instance.Impostor = Impostor_Init(Parent)
Instance\FrameWidth = ReadShort(Stream)
Instance\FrameHeight = ReadShort(Stream)
Instance\PitchFrames = ReadByte(Stream)
Instance\PitchMin = ReadFloat(Stream)
Instance\PitchMax = ReadFloat(Stream)
Instance\YawFrames = ReadByte(Stream)
Instance\YawMin = ReadFloat(Stream)
Instance\YawMax = ReadFloat(Stream)
Local BaseName$ = Impostor_StripExtension(Path)
Instance\Sheet = LoadAnimTexture(BaseName + "png", Flags, Instance\FrameWidth, Instance\FrameHeight, 0, Instance\PitchFrames * Instance\YawFrames)
If Instance\Sheet = 0 Then RuntimeError "Impostor: Unable to open texture for given <Path$>."
Instance\YawStep = (Instance\YawMax - Instance\YawMin) / Instance\YawFrames
Instance\PitchStep = (Instance\PitchMax - Instance\PitchMin) / Instance\PitchFrames
Return Instance
EndIf
EndIf
End Function
Function Impostor_Create.Impostor(Mesh%, Diffuse%)
End Function
Function Impostor_Update(Camera%)
Local Instance.Impostor = Null
For Instance = Each Impostor
Impostor_UpdateSingle(Camera, Instance)
Next
End Function
Function Impostor_UpdateSingle(Camera%, Impostor.Impostor)
; Calculate current Yaw frame and Pitch frame.
PointEntity Impostor\Mesh, Camera, 0
Local Yaw# = Impostor_Math_MaxMin(EntityYaw(Impostor\Mesh), Impostor\YawMax, Impostor\YawMin) - Impostor\YawMin
Local Pitch# = Impostor_Math_MaxMin(EntityPitch(Impostor\Mesh), Impostor\PitchMax, Impostor\PitchMin) - Impostor\PitchMin
Local YawFrame = Int(Yaw / Impostor\YawStep)
Local PitchFrame = Floor(Pitch / Impostor\PitchStep)
DebugLog YawFrame
EntityTexture Impostor\Mesh, Impostor\Sheet, PitchFrame * Impostor\YawFrames + YawFrame, 0
EntityFX Impostor\Mesh, 16
RotateEntity Impostor\Mesh, Impostor\PitchMin - PitchFrame * Impostor\PitchStep, 180 + Impostor\YawMin + YawFrame * Impostor\YawStep, 0
End Function
Function Impostor_StripExtension$(Path$)
Local RPath$ = Path$
For temp_Pos = Len(Path)-1 To 1 Step -1
If Mid(Path, temp_Pos, 1) = "."
RPath = Left(Path, temp_Pos)
Exit
EndIf
Next
Return RPath
End Function
Function Impostor_Math_MaxMin#(Value#, Max#, Min#)
If Value> Max Then Return Max
If Value < Min Then Return Min
Return Value
End Function
Function Impostor_Math_Max#(Value#, Max#)
If Value> Max Then Return Max
Return Value
End Function
Function Impostor_Math_Min#(Value#, Min#)
If Value < Min Then Return Min
Return Value
End Function
Function Impostor_Math_Clip#(Value#, Low#, High#)
Local Out#, Diff#
Diff = High-Low:Out = Value-Low
If (Out >= Diff) Then Out = Out - Floor(Out/Diff)*Diff
If (Out < 0) Then Out = Out - Floor(Out/Diff)*Diff
Return Low+Out
End Function
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/Blitz3D/Impostor/Impostor.ipf
+18
View File
@@ -0,0 +1,18 @@
[IDEal Project file]
<Settings>
Version="1"
Expanded="True"
Icon=""
MainFile="CreateImpostorTextures.bb"
Compiler="Blitz3D"
CommandLine=""
</Settings>
<Folders>
</Folders>
<Files>
AbsPath="\CreateImpostorTextures.bb" PrjFolder="" Line="0" Column="0" Tip="0" Visible="False"
AbsPath="\Example01_Cube.bb" PrjFolder="" Line="0" Column="0" Tip="0" Visible="False"
AbsPath="\FastExt.bb" PrjFolder="" Line="0" Column="0" Tip="0" Visible="False"
AbsPath="\FreeImage.bb" PrjFolder="" Line="0" Column="0" Tip="0" Visible="False"
AbsPath="\Impostor.bb" PrjFolder="" Line="0" Column="0" Tip="0" Visible="False"
</Files>
BlitzBasic/Blitz3D/Impostor/Preview.imp
BIN
View File
Binary file not shown.
BlitzBasic/Blitz3D/Impostor/Preview.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 MiB

BlitzBasic/Blitz3D/Impostor/PreviewNormal.imp
BIN
View File
Binary file not shown.
BlitzBasic/Blitz3D/Impostor/PreviewNormal.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.2 MiB

BlitzBasic/Blitz3D/Impostor/README.md
+9
View File
@@ -0,0 +1,9 @@
Impostor
=======================
You know those distant objects that don't quite seem like a 3D object, but still turn with the view? That's an impostor, and this was supposed to be a Blitz3D implementation of that. Didn't work out as planned though, so here's the broken version that used FastExt to do its work.
If you don't know where to get FastExt, google will help you.
License
=======
Impostor by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/Blitz3D/Level of Detail/01 Small Test.bb
+41
View File
@@ -0,0 +1,41 @@
Include "LevelOfDetail.bb"
Graphics3D 1024, 768, 0, 2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Timer = CreateTimer(60)
Local eCamera = CreateCamera()
LoD_Initialize()
Local L0 = CreateSphere(16):HideEntity L0
Local L1 = CreateSphere(8):HideEntity L1
Local L2 = CreateSphere(4):HideEntity L2
Local L3 = CreateSphere(2):HideEntity L3
Local L4 = CreateSprite():HideEntity L4
For X = -10 To 10
For Y = -10 To 10
For Z = -10 To 10
Local tEnt.LoDEntity = LoD_Create(L0, L1, L2, L3, L4)
PositionEntity tEnt\Pivot, X*3, Y*3, Z*3
LoD_EntityColor tEnt, Rand(0, 255), Rand(0, 255), Rand(0, 255)
Next
Next
Next
While Not KeyHit(1)
MoveEntity eCamera, KeyDown(32) - KeyDown(30), 0, KeyDown(17) - KeyDown(31)
If MouseDown(1) Then RotateEntity eCamera, EntityPitch(eCamera) + MouseYSpeed()/4.0, EntityYaw(eCamera) -MouseXSpeed()/4.0, 0:MoveMouse 512,384
WireFrame MouseDown(2)
RenderWorld
LoD_Update(eCamera)
Text 0, 0, TrisRendered()
Flip False
; WaitTimer(Timer)
Wend
BlitzBasic/Blitz3D/Level of Detail/LevelOfDetail.bb
+163
View File
@@ -0,0 +1,163 @@
Global LoD_Dist_Lv0# = 32, LoD_Dist_Lv1# = 64, LoD_Dist_Lv2# = 128, LoD_Dist_Lv3# = 256, LoD_Dist_Lv4# = 512
Global LoD_Range# = 8
Type LoDEntity
Field Pivot% = 0
; Levels
Field LoDs%[5]
; Temporary Values
Field Visible%[5]
Field Fade#[5]
End Type
Function LoD_Initialize(Dist_Range# = 8, Dist_Lv0# = 32, Dist_Lv1# = 64, Dist_Lv2# = 128, Dist_Lv3# = 256, Dist_Lv4# = 512)
LoD_Range = Dist_Range
; Distance Limits
LoD_Dist_Lv0 = Dist_Lv0
LoD_Dist_Lv1 = Dist_Lv1
LoD_Dist_Lv2 = Dist_Lv2
LoD_Dist_Lv3 = Dist_Lv3
LoD_Dist_Lv4 = Dist_Lv4
End Function
Function LoD_Create.LoDEntity(Lv0, Lv1, Lv2, Lv3, Lv4)
Local tInstance.LoDEntity = New LoDEntity
tInstance\Pivot = CreatePivot()
; Copy Entities
tInstance\LoDs[0] = CopyEntity(Lv0, tInstance\Pivot):HideEntity tInstance\LoDs[0]
tInstance\LoDs[1] = CopyEntity(Lv1, tInstance\Pivot):HideEntity tInstance\LoDs[1]
tInstance\LoDs[2] = CopyEntity(Lv2, tInstance\Pivot):HideEntity tInstance\LoDs[2]
tInstance\LoDs[3] = CopyEntity(Lv3, tInstance\Pivot):HideEntity tInstance\LoDs[3]
tInstance\LoDs[4] = CopyEntity(Lv4, tInstance\Pivot):HideEntity tInstance\LoDs[4]
Return tInstance
End Function
Function LoD_EntityAlpha(tInstance.LoDEntity, Alpha#, Level=-1)
If (Level = -1) Then
EntityAlpha tInstance\LoDs[0], Alpha
EntityAlpha tInstance\LoDs[1], Alpha
EntityAlpha tInstance\LoDs[2], Alpha
EntityAlpha tInstance\LoDs[3], Alpha
EntityAlpha tInstance\LoDs[4], Alpha
Else
EntityAlpha tInstance\LoDs[Level], Alpha
EndIf
End Function
Function LoD_EntityBlend(tInstance.LoDEntity, Mode%, Level=-1)
If (Level = -1) Then
EntityBlend tInstance\LoDs[0], Mode
EntityBlend tInstance\LoDs[1], Mode
EntityBlend tInstance\LoDs[2], Mode
EntityBlend tInstance\LoDs[3], Mode
EntityBlend tInstance\LoDs[4], Mode
Else
EntityBlend tInstance\LoDs[Level], Mode
EndIf
End Function
Function LoD_EntityColor(tInstance.LoDEntity, Red#, Green#, Blue#, Level=-1)
If (Level = -1) Then
EntityColor tInstance\LoDs[0], Red, Green, Blue
EntityColor tInstance\LoDs[1], Red, Green, Blue
EntityColor tInstance\LoDs[2], Red, Green, Blue
EntityColor tInstance\LoDs[3], Red, Green, Blue
EntityColor tInstance\LoDs[4], Red, Green, Blue
Else
EntityColor tInstance\LoDs[Level], Red, Green, Blue
EndIf
End Function
Function LoD_EntityFX(tInstance.LoDEntity, FX%, Level=-1)
If (Level = -1) Then
EntityFX tInstance\LoDs[0], FX
EntityFX tInstance\LoDs[1], FX
EntityFX tInstance\LoDs[2], FX
EntityFX tInstance\LoDs[3], FX
EntityFX tInstance\LoDs[4], FX
Else
EntityFX tInstance\LoDs[Level], FX
EndIf
End Function
Function LoD_EntityShininess(tInstance.LoDEntity, Shininess#, Level=-1)
If (Level = -1) Then
EntityShininess tInstance\LoDs[0], Shininess
EntityShininess tInstance\LoDs[1], Shininess
EntityShininess tInstance\LoDs[2], Shininess
EntityShininess tInstance\LoDs[3], Shininess
EntityShininess tInstance\LoDs[4], Shininess
Else
EntityShininess tInstance\LoDs[Level], Shininess
EndIf
End Function
Function LoD_EntityTexture(tInstance.LoDEntity, Texture%, Frame%=0, Index%=0, Level=-1)
If (Level = -1) Then
EntityTexture tInstance\LoDs[0], Texture, Frame, Index
EntityTexture tInstance\LoDs[1], Texture, Frame, Index
EntityTexture tInstance\LoDs[2], Texture, Frame, Index
EntityTexture tInstance\LoDs[3], Texture, Frame, Index
EntityTexture tInstance\LoDs[4], Texture, Frame, Index
Else
EntityTexture tInstance\LoDs[Level], Texture, Frame, Index
EndIf
End Function
Function LoD_EntityLoD(tInstance.LoDEntity)
For Level = 0 To 4
If (tInstance\Visible[Level]) Then Return Level
Next
Return 5
End Function
Function LoD_Update(eCamera, bDoFadeOut=False)
For tInstance.LoDEntity = Each LoDEntity
Local Dist# = EntityDistance(eCamera, tInstance\Pivot)
; LoD Level 1 (Very High)
If (Dist > 0) And ((bDoFadeOut And (Dist < LoD_Dist_Lv0 + LoD_Range)) Or (bDoFadeOut = False And (Dist < LoD_Dist_Lv0))) Then
If tInstance\Visible[0] = False Then tInstance\Visible[0] = True:ShowEntity tInstance\LoDs[0]
If bDoFadeOut = True And (Dist > LoD_Dist_Lv0) Then EntityAlpha tInstance\LoDs[0], 1.0 - (Dist - LoD_Dist_Lv0) / LoD_Range
Else
If tInstance\Visible[0] = True Then tInstance\Visible[0] = False:HideEntity tInstance\LoDs[0]
EndIf
; LoD Level 2 (High)
If (Dist > LoD_Dist_Lv0) And ((bDoFadeOut And (Dist < LoD_Dist_Lv1 + LoD_Range)) Or (bDoFadeOut = False And (Dist < LoD_Dist_Lv1))) Then
If tInstance\Visible[1] = False Then tInstance\Visible[1] = True:ShowEntity tInstance\LoDs[1]
If bDoFadeOut = True And (Dist > LoD_Dist_Lv1) Then EntityAlpha tInstance\LoDs[1], 1.0 - (Dist - LoD_Dist_Lv1) / LoD_Range
Else
If tInstance\Visible[1] = True Then tInstance\Visible[1] = False:HideEntity tInstance\LoDs[1]
EndIf
; LoD Level 3 (Normal)
If (Dist > LoD_Dist_Lv1) And ((bDoFadeOut And (Dist < LoD_Dist_Lv2 + LoD_Range)) Or (bDoFadeOut = False And (Dist < LoD_Dist_Lv2))) Then
If tInstance\Visible[2] = False Then tInstance\Visible[2] = True:ShowEntity tInstance\LoDs[2]
If bDoFadeOut = True And (Dist > LoD_Dist_Lv2) Then EntityAlpha tInstance\LoDs[2], 1.0 - (Dist - LoD_Dist_Lv2) / LoD_Range
Else
If tInstance\Visible[2] = True Then tInstance\Visible[2] = False:HideEntity tInstance\LoDs[2]
EndIf
; LoD Level 4 (Low)
If (Dist > LoD_Dist_Lv2) And ((bDoFadeOut And (Dist < LoD_Dist_Lv3 + LoD_Range)) Or (bDoFadeOut = False And (Dist < LoD_Dist_Lv3))) Then
If tInstance\Visible[3] = False Then tInstance\Visible[3] = True:ShowEntity tInstance\LoDs[3]
If bDoFadeOut = True And (Dist > LoD_Dist_Lv3) Then EntityAlpha tInstance\LoDs[3], 1.0 - (Dist - LoD_Dist_Lv3) / LoD_Range
Else
If tInstance\Visible[3] = True Then tInstance\Visible[3] = False:HideEntity tInstance\LoDs[3]
EndIf
; LoD Level 5 (Very Low) (Usually a Sprite)
If (Dist > LoD_Dist_Lv3) And ((bDoFadeOut And (Dist < LoD_Dist_Lv4 + LoD_Range)) Or (bDoFadeOut = False And (Dist < LoD_Dist_Lv4))) Then
If tInstance\Visible[4] = False Then tInstance\Visible[4] = True:ShowEntity tInstance\LoDs[4]
If bDoFadeOut = True And (Dist > LoD_Dist_Lv4) Then EntityAlpha tInstance\LoDs[4], 1.0 - (Dist - LoD_Dist_Lv4) / LoD_Range
Else
If tInstance\Visible[4] = True Then tInstance\Visible[4] = False:HideEntity tInstance\LoDs[4]
EndIf
Next
End Function
BlitzBasic/Blitz3D/Level of Detail/README.md
+8
View File
@@ -0,0 +1,8 @@
Level of Detail
=======================
A library originally ment to add level of detail to Sirius Online, back when it was still using Blitz3D. Works somewhat okay, might require some tweaking. Oct-Tree solutions will work better in most cases, so use at your own risk.
License
=======
Level of Detail by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/Blitz3D/Motion Blur/README.md
+8
View File
@@ -0,0 +1,8 @@
Motion Blur
=======================
This was a test at how good I could make a motion blur effect in Blitz3D, without much success in actual use. Blitz3D likes to resend all data instead of reuse, so frametime increased a lot. Still looks nice on single objects that require such types of blur.
License
=======
Motion Blur by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/Blitz3D/Motion Blur/Version 1 - Render to Screen/01 Moving and Rotating Cube.bb
+42
View File
@@ -0,0 +1,42 @@
AppTitle "TrueMotion"
Include "TrueMotion.bb"
Graphics3D 1024,768,0,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Local eCamera = CreateCamera()
Local tCube = CreateTexture(128,128)
SetBuffer TextureBuffer(tCube)
Color 255, 255, 0
Rect 0, 0, 64, 64
Rect 64, 64, 64, 64
Color 0, 127, 255
Rect 64, 0, 64, 64
Rect 0, 64, 64, 64
SetBuffer BackBuffer()
Local eCube = CreateCube()
PositionEntity eCube, 0, 0, 3
EntityTexture eCube, tCube
Local tInstance.TrueMotion = TrueMotion_Create(eCamera)
Timer = CreateTimer(60)
Global Msec
While Not KeyHit(1)
Cls
Msec = Msec + 10
RotateEntity eCube, Cos(Msec/4.0)*30, 0, EntityRoll(eCube) + 16
PositionEntity eCube, 0, Sin(Msec/4.0)*2, 4
TrueMotion_RenderWorld(tInstance, 32)
Flip
WaitTimer(Timer)
Wend
End
BlitzBasic/Blitz3D/Motion Blur/Version 1 - Render to Screen/TrueMotion.bb
+51
View File
@@ -0,0 +1,51 @@
Type TrueMotion
Field Camera% = 0
Field Mesh% = 0
End Type
Function TrueMotion_Create.TrueMotion(Camera%)
;Create TrueMotion Instance
tInstance.TrueMotion = New TrueMotion
; Camera can't be Null or invalid
If Camera = 0 Then
RuntimeError "TrueMotion: Camera is Null."
Else
If EntityClass(Camera) <> "Camera" Then
RuntimeError "TrueMotion: Camera is not of type <Camera>."
Else
tInstance\Camera = Camera
EndIf
EndIf
; Create Mesh
tInstance\Mesh = CreateMesh(tInstance\Camera)
sSurface = CreateSurface(tInstance\Mesh)
AddVertex(sSurface, -1, 1, 0, 0, 0)
AddVertex(sSurface, 1, 1, 0, 1, 0)
AddVertex(sSurface, 1, -1, 0, 1, 1)
AddVertex(sSurface, -1, -1, 0, 0, 1)
AddTriangle(sSurface, 0, 1, 2)
AddTriangle(sSurface, 0, 2, 3)
EntityOrder(tInstance\Mesh, -1)
EntityColor(tInstance\Mesh, 0, 0, 0)
PositionEntity(tInstance\Mesh, 0, 0, 1)
HideEntity(tInstance\Mesh)
Return tInstance
End Function
; Call this before after you have done your changes. It is a good practice to only let this effect affect nearby entities.
Function TrueMotion_RenderWorld(tInstance.TrueMotion, Steps%=12)
ShowEntity(tInstance\Mesh)
EntityAlpha(tInstance\Mesh, 1.0/Steps)
CameraClsMode(tInstance\Camera, 0, 1)
For curStep = 0 To Steps - 1
RenderWorld curStep/Float(Steps)
Next
HideEntity(tInstance\Mesh)
RenderWorld 1
CameraClsMode(tInstance\Camera, 1, 1)
CaptureWorld
End Function
BlitzBasic/Blitz3D/Motion Blur/Version 2 - Render to Texture (TODO)/01 Moving and Rotating Cube.bb
+42
View File
@@ -0,0 +1,42 @@
AppTitle "TrueMotion"
Include "TrueMotion.bb"
Graphics3D 1024,768,0,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Local eCamera = CreateCamera()
Local tCube = CreateTexture(128,128)
SetBuffer TextureBuffer(tCube)
Color 255, 255, 0
Rect 0, 0, 64, 64
Rect 64, 64, 64, 64
Color 0, 127, 255
Rect 64, 0, 64, 64
Rect 0, 64, 64, 64
SetBuffer BackBuffer()
Local eCube = CreateCube()
PositionEntity eCube, 0, 0, 3
EntityTexture eCube, tCube
Local tInstance.TrueMotion = TrueMotion_Create(eCamera, 32)
Timer = CreateTimer(60)
Global Msec
While Not KeyHit(1)
Cls
Msec = Msec + 10
RotateEntity eCube, Cos(Msec/4.0)*30, 0, EntityRoll(eCube) + 16
PositionEntity eCube, 0, Sin(Msec/4.0)*2, 4
TrueMotion_RenderWorld(tInstance)
Flip
WaitTimer(Timer)
Wend
End
BlitzBasic/Blitz3D/Motion Blur/Version 2 - Render to Texture (TODO)/TrueMotion.bb
+82
View File
@@ -0,0 +1,82 @@
Const TRUEMOTION_STEPS_MAX = 32
Type TrueMotion
Field Camera% = 0
; Settings
Field Steps% = 6
Field SizeW% = 128
Field SizeH% = 128
; Core Stuff
Field Texture% = 0
Field Mesh% = 0
End Type
Function TrueMotion_Create.TrueMotion(Camera%, Steps%=12);, SizeW%=128, SizeH%=128, Steps%=5)
;Create TrueMotion Instance
tInstance.TrueMotion = New TrueMotion
; Camera can't be Null or invalid
If Camera = 0 Then
RuntimeError "TrueMotion: Camera is Null."
Else
If EntityClass(Camera) <> "Camera" Then
RuntimeError "TrueMotion: Camera is not of type <Camera>."
Else
tInstance\Camera = Camera
EndIf
EndIf
; Limit <Steps> into 1-TRUEMOTION_STEPS_MAX to prevent too high values.
If Steps < 1 Then
tInstance\Steps = 1
ElseIf Steps > TRUEMOTION_STEPS_MAX Then
tInstance\Steps = TRUEMOTION_STEPS_MAX
Else
tInstance\Steps = Steps
EndIf
; Limit <SizeW/H> to be 2^n and still below GraphicsWidth and -Height.
If SizeW < 1 Then SizeW = 1
If SizeW > GraphicsWidth() Then SizeW = GraphicsWidth()
tInstance\SizeW = 2^Floor(Log(SizeW)/Log(2))
If SizeH < 1 Then SizeH = 1
If SizeH > GraphicsWidth() Then SizeH = GraphicsHeight()
tInstance\SizeH = 2^Floor(Log(SizeH)/Log(2))
; Create Texture
tInstance\Texture = CreateTexture(tInstance\SizeW, tInstance\SizeH, 305, tInstance\Steps)
; Create Mesh
tInstance\Mesh = CreateMesh(tInstance\Camera)
sSurface = CreateSurface(tInstance\Mesh)
AddVertex(sSurface, -1, 1, 0, 0, 0)
AddVertex(sSurface, 1, 1, 0, 1, 0)
AddVertex(sSurface, 1, -1, 0, 1, 1)
AddVertex(sSurface, -1, -1, 0, 0, 1)
AddTriangle(sSurface, 0, 1, 2)
AddTriangle(sSurface, 0, 2, 3)
EntityFX(tInstance\Mesh, 8)
EntityTexture(tInstance\Mesh, tInstance\Texture, 0)
EntityOrder(tInstance\Mesh, -1)
EntityColor(tInstance\Mesh, 0, 0, 0)
EntityAlpha(tInstance\Mesh, (1.0/(tInstance\Steps)))
PositionEntity(tInstance\Mesh, 0, 0, 1)
HideEntity(tInstance\Mesh)
Return tInstance
End Function
; Call this before after you have done your changes. It is a good practice to only let this effect affect nearby entities.
Function TrueMotion_RenderWorld(tInstance.TrueMotion)
HideEntity(tInstance\Mesh)
CameraClsMode(tInstance\Camera, 1, 1)
For curStep = 0 To tInstance\Steps - 1
RenderWorld curStep/Float(tInstance\Steps)
Next
ShowEntity(tInstance\Mesh)
RenderWorld 1
CaptureWorld
End Function
BlitzBasic/Blitz3D/TiledSprite/Example01.bb
+267
View File
@@ -0,0 +1,267 @@
;--------------------------------------------
; Example
;--------------------------------------------
Include "../Advanced Text (Library)/AdvText.bb"
Include "TiledSprite.bb"
Graphics3D 1280,720,32,2
SetBuffer BackBuffer()
; Background
Local FPlane = CreatePlane(16)
RotateEntity FPlane, 270, 0, 0
PositionEntity FPlane, 0, 0, 256, True
EntityColor FPlane, 128, 128, 128
Local BPlane = CreatePlane(16)
RotateEntity BPlane, 90, 0, 0
PositionEntity BPlane, 0, 0, -256, True
EntityColor BPlane, 0, 128, 190
Local LPlane = CreatePlane(16)
RotateEntity LPlane, 90, 90, 0
PositionEntity LPlane, 256, 0, 0, True
EntityColor LPlane, 0, 128, 190
Local RPlane = CreatePlane(16)
RotateEntity RPlane, 90, 270, 0
PositionEntity RPlane, -256, 0, 0, True
EntityColor RPlane, 0, 128, 190
Local DPlane = CreatePlane(16)
RotateEntity DPlane, 0, 0, 0
PositionEntity DPlane, 0, -256, 0, True
EntityColor DPlane, 0, 128, 0
Local UPlane = CreatePlane(16)
RotateEntity UPlane, 180, 0, 0
PositionEntity UPlane, 0, 256, 0, True
EntityColor UPlane, 0, 128, 190
; Camera
Local eCameraPitch# = 0
Local eCameraYaw# = 0
Local eCameraZoom# = 1
Local eCameraFOV# = 90.0
Local eCameraFOVValue# = Tan( eCameraFOV / 2.0 )
Local eCameraCenter = CreatePivot()
Local eCamera = CreateCamera(eCameraCenter)
Local eCameraLight = CreateLight(3, eCamera)
PositionEntity eCamera, 0, 0, -eCameraZoom, False
CameraRange eCamera, 0.1, 1024
CameraZoom eCamera, 1.0 / eCameraFOVValue
LightConeAngles eCameraLight, 10, 60
LightColor eCameraLight, 64, 128, 255
; Sprite Texture Creation
Global InvTex = LoadTexture("TiledSprite_Test01.fw.png", 1+2+8+16+32+256)
Global InvBrush = CreateBrush(255.0, 255.0, 255.0)
BrushTexture InvBrush, InvTex, 0, 0
BrushFX InvBrush, 1+4+8
; Main Mesh
Global InvMesh = CreateMesh(eCamera)
PositionEntity InvMesh, 0, 0, 1
EntityFX InvMesh, 1+4+8
; Scale the Mesh according to ScreenWidth and FOV(Tan(FOV/2.0)).
Local InvMeshScale# = (1 / (GraphicsWidth()/2.0)) * eCameraFOVValue
ScaleEntity InvMesh, InvMeshScale, InvMeshScale, 1, True
;Hint: Order of Creation is Important for Sprites not sharing a mesh or a surface. If only sharing the surface, order of fill is important.
; Foreground Sprite
Local InvFGSpriteBuilder.TSpriteBuilder = TSpriteBuilder_Create()
TSpriteBuilder_Mesh(InvFGSpriteBuilder, InvMesh)
TSpriteBuilder_Brush(InvFGSpriteBuilder, InvBrush)
TSpriteBuilder_BrushSize(InvFGSpriteBuilder, 256, 256)
TSpriteBuilder_Scale(InvFGSpriteBuilder, 0.5, 0.5)
TSpriteBuilder_Padding(InvFGSpriteBuilder, 0, 0, 128, 128)
TSpriteBuilder_Border(InvFGSpriteBuilder, 32, 32, 32, 32)
TSpriteBuilder_BorderScale(InvFGSpriteBuilder, 0.5, 0.5)
Local InvFGSprite.TSprite = TSprite_Create(InvFGSpriteBuilder)
; Inverted Gradient Sprite
Local InvGradientSpriteBuilder.TSpriteBuilder = TSpriteBuilder_Create()
TSpriteBuilder_Mesh(InvGradientSpriteBuilder, InvMesh)
TSpriteBuilder_Brush(InvGradientSpriteBuilder, InvBrush)
TSpriteBuilder_BrushSize(InvGradientSpriteBuilder, 256, 256)
TSpriteBuilder_Scale(InvGradientSpriteBuilder, 0.5, 0.5)
TSpriteBuilder_Padding(InvGradientSpriteBuilder, 128, 128, 0, 0)
TSpriteBuilder_Border(InvGradientSpriteBuilder, 32, 32, 32, 32)
TSpriteBuilder_BorderScale(InvGradientSpriteBuilder, 0.5, 0.5)
Local InvGradientSprite.TSprite = TSprite_Create(InvGradientSpriteBuilder)
; Gradient Sprite
Local GradientSpriteBuilder.TSpriteBuilder = TSpriteBuilder_Create()
TSpriteBuilder_Mesh(GradientSpriteBuilder, InvMesh)
TSpriteBuilder_Brush(GradientSpriteBuilder, InvBrush)
TSpriteBuilder_BrushSize(GradientSpriteBuilder, 256, 256)
TSpriteBuilder_Scale(GradientSpriteBuilder, 0.5, 0.5)
TSpriteBuilder_Padding(GradientSpriteBuilder, 0, 128, 128, 0)
TSpriteBuilder_Border(GradientSpriteBuilder, 32, 32, 32, 32)
TSpriteBuilder_BorderScale(GradientSpriteBuilder, 0.5, 0.5)
Local GradientSprite.TSprite = TSprite_Create(GradientSpriteBuilder)
; Background Sprite
Local InvBGSpriteBuilder.TSpriteBuilder = TSpriteBuilder_Create()
TSpriteBuilder_Mesh(InvBGSpriteBuilder, InvMesh, 0, True)
TSpriteBuilder_Brush(InvBGSpriteBuilder, InvBrush)
TSpriteBuilder_BrushSize(InvBGSpriteBuilder, 256, 256)
TSpriteBuilder_Scale(InvBGSpriteBuilder, 0.5, 0.5)
TSpriteBuilder_Padding(InvBGSpriteBuilder, 128, 0, 0, 128)
TSpriteBuilder_Border(InvBGSpriteBuilder, 16, 16, 16, 16)
TSpriteBuilder_BorderScale(InvBGSpriteBuilder, 0.5, 0.5)
Local InvBGSprite.TSprite = TSprite_Create(InvBGSpriteBuilder)
; Other
Global FPSTimer = CreateTimer(30)
Local SpriteFillFlags = TSPRITE_BORDER_LFT + TSPRITE_BORDER_RGT + TSPRITE_BORDER_TOP + TSPRITE_BORDER_BTM
Local X#=256,Y#=256,W#=128,H#=128, Change = True
; Loop
While Not KeyHit(1)
Local MsX = MouseX(), MsY = MouseY(), MsZ = MouseZ()
Cls
If Change = True Then
TSprite_Fill(GradientSprite, -GraphicsWidth()/2 + X, -GraphicsHeight()/2 +Y, W, H, 0, SpriteFillFlags)
TSprite_Fill(InvGradientSprite, -GraphicsWidth()/2 + X + 4, -GraphicsHeight()/2 +Y + 4, W - 8, H - 8, 0, SpriteFillFlags)
Change = False
EndIf
WireFrame KeyDown(31)
RenderWorld
; Camera Movement
If MouseDown(1)
If MouseHit(1) Then
MoveMouse GraphicsWidth()/2, GraphicsHeight()/2
Else
eCameraPitch = eCameraPitch + (MouseYSpeed()/4.0)
eCameraYaw = eCameraYaw - (MouseXSpeed()/4.0)
EndIf
RotateEntity eCameraCenter, eCameraPitch, eCameraYaw, 0, True
EndIf
If MouseDown(2)
If MouseHit(2) Then
MoveMouse GraphicsWidth()/2, GraphicsHeight()/2
Else
eCameraZoom = eCameraZoom + (MouseYSpeed()/4.0) + (MouseXSpeed()/4.0)
If eCameraZoom < 1.0 Then eCameraZoom = 1.0
EndIf
PositionEntity eCamera, 0, 0, -eCameraZoom, False
EndIf
; Position & Size
If KeyDown(30) Then
X = MsX
Y = MsY
Change = True
EndIf
If KeyDown(32) Then
If MsX < X+8 Then X = MsX-8
If MsY < Y+8 Then Y = MsY-8
W = MsX - X
H = MsY - Y
If W < 16 Then W = 16
If H < 16 Then H = 16
Change = True
EndIf
; Update Status
If KeyHit(2) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDER_LFT:Change = True
If KeyHit(3) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDER_RGT:Change = True
If KeyHit(4) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDER_TOP:Change = True
If KeyHit(5) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDER_BTM:Change = True
If KeyHit(16) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDEROUT_LFT:Change = True
If KeyHit(17) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDEROUT_RGT:Change = True
If KeyHit(18) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDEROUT_TOP:Change = True
If KeyHit(19) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_BORDEROUT_BTM:Change = True
If KeyHit(6) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_ROUNDDOWN_HORZ:Change = True
If KeyHit(7) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_ROUNDDOWN_VERT:Change = True
If KeyHit(20) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_PARTIAL_HORZ:Change = True
If KeyHit(21) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_PARTIAL_VERT:Change = True
If KeyHit(34) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_PARTIALCUT_HORZ:Change = True
If KeyHit(35) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_PARTIALCUT_VERT:Change = True
If KeyHit(47) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_FORCESINGLE_HORZ:Change = True
If KeyHit(48) Then SpriteFillFlags = SpriteFillFlags Xor TSPRITE_FORCESINGLE_VERT:Change = True
; Show Boundaries
If KeyDown(57)
Color 255,128,0
Rect X, Y, W, H, 0
Color 0,128,255
Rect X+8,Y+8,W-16,H-16,0
Color 255,255,255
EndIf
; Draw Some shit
Viewport X+8, Y+8, W-16, H-16
Local GUIText$ = "This simple technique allows you to fast transparent backgrounds." + Chr(10)
GUIText = GUIText + "I saw this being used in Unity3D to reduce drawcalls made and " + Chr(10)
GUIText = GUIText + "thought it would be a good idea to enhance it in a prototype " + Chr(10)
GUIText = GUIText + "before i reimplement it using new features." + Chr(10) + Chr(10)
GUIText = GUIText + "Maybe this is already used in Draw3D or will be integrated now." + Chr(10)
GUIText = GUIText + "Doesn't matter to me, have fun with this piece of code!" + Chr(10)
AdvText(X+8, Y+8, GUIText)
Viewport 0, 0, GraphicsWidth(), GraphicsHeight()
; Draw Status
If KeyDown(59) Then
Local HelpText$ = "Key Function Status" + Chr(10)
HelpText = HelpText + "-------------------------------" + Chr(10)
HelpText = HelpText + "LMB Move Camera: " + RSet(Int(eCameraPitch*10)/10.0, 8) + ", " + RSet(Int(eCameraYaw*10)/10.0, 8) + Chr(10)
HelpText = HelpText + "RMB Zoom Camera: " + RSet(Int(eCameraZoom*10)/10.0, 8) + Chr(10)
HelpText = HelpText + "Spc Show Boundaries" + Chr(10)
HelpText = HelpText + "A Set Position" + Chr(10)
HelpText = HelpText + "D Set Size" + Chr(10)
HelpText = HelpText + "S Show Wireframe" + Chr(10)
HelpText = HelpText + "1 Border-Lft: "
If SpriteFillFlags And TSPRITE_BORDER_LFT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "2 Border-Rgt: "
If SpriteFillFlags And TSPRITE_BORDER_RGT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "3 Border-Top: "
If SpriteFillFlags And TSPRITE_BORDER_TOP Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "4 Border-Btm: "
If SpriteFillFlags And TSPRITE_BORDER_BTM Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "Q BorderOut-Lft: "
If SpriteFillFlags And TSPRITE_BORDEROUT_LFT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "W BorderOut-Rgt: "
If SpriteFillFlags And TSPRITE_BORDEROUT_RGT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "E BorderOut-Top: "
If SpriteFillFlags And TSPRITE_BORDEROUT_TOP Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "R BorderOut-Btm: "
If SpriteFillFlags And TSPRITE_BORDEROUT_BTM Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "5 RoundDown-Horz: "
If SpriteFillFlags And TSPRITE_ROUNDDOWN_HORZ Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "6 RoundDown-Vert: "
If SpriteFillFlags And TSPRITE_ROUNDDOWN_VERT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "T Partial-Horz: "
If SpriteFillFlags And TSPRITE_PARTIAL_HORZ Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "Z Partial-Vert: "
If SpriteFillFlags And TSPRITE_PARTIAL_VERT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "G PartialCut-Horz: "
If SpriteFillFlags And TSPRITE_PARTIALCUT_HORZ Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "H PartialCut-Vert: "
If SpriteFillFlags And TSPRITE_PARTIALCUT_VERT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "V ForceSingle-Horz: "
If SpriteFillFlags And TSPRITE_FORCESINGLE_HORZ Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
HelpText = HelpText + "B ForceSingle-Vert: "
If SpriteFillFlags And TSPRITE_FORCESINGLE_VERT Then HelpText = HelpText + "|f00FF00On|f-1-1-1" + Chr(10) Else HelpText = HelpText + "|fFF0000Off|f-1-1-1" + Chr(10)
AdvText(10, 0, HelpText)
Else
Text 0, 0, "F1 to show Help"
EndIf
WaitTimer FPSTimer:Flip 0
Wend
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/Blitz3D/TiledSprite/README.md
+9
View File
@@ -0,0 +1,9 @@
TiledSprite
=======================
Blitz3D didn't have a UI solution that worked well. There was Draw3D (& Draw3D2) which claimed to solve it, but in turn caused more issues than I had before it. Mainly the stupid Z-Ordering in Draw3D was annoying, as it didn't solve anything except add more data into RAM and VRAM. And it didn't work well for many things, such as skinned windows with stretched or repeating background, etc.
This library adds some neat little functions that allow you to create a "Tiled Sprite". It does that by cutting up the original texture using new vertices instead of adding more textures to memory or using a fancy shader.
License
=======
TiledSprite by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/Blitz3D/TiledSprite/TiledSprite.bb
+537
View File
@@ -0,0 +1,537 @@
;--------------------------------------------
; Constants
;--------------------------------------------
Const TSPRITE_BORDER_LFT% = 1 ; Enable border on the left side.
Const TSPRITE_BORDER_RGT% = 2 ; Enable border on the right side.
Const TSPRITE_BORDER_TOP% = 4 ; Enable border on the top side.
Const TSPRITE_BORDER_BTM% = 8 ; Enable border on the bottom side.
Const TSPRITE_BORDEROUT_LFT% = 16 ; Push the border outside the boundaries on the left side.
Const TSPRITE_BORDEROUT_RGT% = 32 ; Push the border outside the boundaries on the right side.
Const TSPRITE_BORDEROUT_TOP% = 64 ; Push the border outside the boundaries on the top side.
Const TSPRITE_BORDEROUT_BTM% = 128 ; Push the border outside the boundaries on the bottom side.
Const TSPRITE_ROUNDDOWN_HORZ% = 256 ; Round down instead of up horizontally (Disabled by TSPRITE_PARTIAL_HORZ).
Const TSPRITE_ROUNDDOWN_VERT% = 512 ; Round down instead of up vertically (Disabled by TSPRITE_PARTIAL_VERT).
Const TSPRITE_PARTIAL_HORZ% = 1024 ; Allow Partial scaling (last-element) instead of scaling all elements horizontally.
Const TSPRITE_PARTIAL_VERT% = 2048 ; Allow Partial scaling (last-element) instead of scaling all elements vertically.
Const TSPRITE_PARTIALCUT_HORZ% = 4096 ; Changes the mode of the Partial modifier to cutting, so that it doesn't scale horizontally.
Const TSPRITE_PARTIALCUT_VERT% = 8192 ; Changes the mode of the Partial modifier to cutting, so that it doesn't scale vertically.
Const TSPRITE_FORCESINGLE_HORZ% = 16384 ; Force to use only a single tile horizontally (for gradients and such).
Const TSPRITE_FORCESINGLE_VERT% = 32768 ; Force to use only a single tile vertically (for gradients and such).
Const HINT_LEFT% = 0
Const HINT_TOP% = 1
Const HINT_RIGHT% = 2
Const HINT_BOTTOM% = 3
;--------------------------------------------
; Types
;--------------------------------------------
Type TSprite
; Texture (Use this for animations).
Field mTexture% = 0
Field mTextureBrush% = 0
; Mesh & Surface
Field mMesh% = 0
Field mSurface% = 0
Field mShareSurface% = False
; Padding & Border
Field mPadding%[4]
Field mBorder%[4]
; Outer & Inner Coordinates in Pixels
Field mOuter%[4] ; Relative to mTexture in Pixels
Field mInner%[4] ; Relative to mTexture in Pixels
; Outer & Inner UV Coordinates in Texels
Field mOuterUV#[4] ;Relative to mTexture in Texels
Field mInnerUV#[4] ;Relative to mTexture in Texels
; Scale
Field mScale#[2]
Field mBorderScale#[2]
End Type
Type TSpriteBuilder
; Texture
Field Width% = 0
Field Height% = 0
Field TextureBrush% = 0
; Mesh & Surface
Field Mesh% = 0
Field MeshSurface% = 0
Field SharedSurface% = False
; Padding
Field PaddingLeft% = 0
Field PaddingTop% = 0
Field PaddingRight% = 0
Field PaddingBottom% = 0
; Border
Field BorderLeft% = 0
Field BorderTop% = 0
Field BorderRight% = 0
Field BorderBottom% = 0
; Scale
Field ScaleX# = 1
Field ScaleY# = 1
Field BorderScaleX# = 1
Field BorderScaleY# = 1
; Internal Flags
Field OwnBrush% = True
Field OwnMesh% = True
Field OwnMeshSurface% = True
End Type
;--------------------------------------------
; Functions
;--------------------------------------------
; TSpriteBuilder
Function TSpriteBuilder_Create.TSpriteBuilder()
Local SpriteBuilder.TSpriteBuilder = New TSpriteBuilder
SpriteBuilder\TextureBrush = CreateBrush(1.0, 1.0, 1.0)
SpriteBuilder\Mesh = CreateMesh()
SpriteBuilder\MeshSurface = CreateSurface(SpriteBuilder\Mesh)
Return SpriteBuilder
End Function
Function TSpriteBuilder_Padding.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, PaddingLeft%, PaddingTop%, PaddingRight%, PaddingBottom%)
If SpriteBuilder <> Null Then
SpriteBuilder\PaddingLeft = PaddingLeft
SpriteBuilder\PaddingTop = PaddingTop
SpriteBuilder\PaddingRight = PaddingRight
SpriteBuilder\PaddingBottom = PaddingBottom
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_Scale.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, ScaleX#, ScaleY#)
If SpriteBuilder <> Null Then
SpriteBuilder\ScaleX = ScaleX
SpriteBuilder\ScaleY = ScaleY
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_Border.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, BorderLeft%, BorderTop%, BorderRight%, BorderBottom%)
If SpriteBuilder <> Null Then
SpriteBuilder\BorderLeft = BorderLeft
SpriteBuilder\BorderTop = BorderTop
SpriteBuilder\BorderRight = BorderRight
SpriteBuilder\BorderBottom = BorderBottom
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BorderScale.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, BorderScaleX#, BorderScaleY#)
If SpriteBuilder <> Null Then
SpriteBuilder\BorderScaleX = BorderScaleX
SpriteBuilder\BorderScaleY = BorderScaleY
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_Brush.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Brush%)
If SpriteBuilder <> Null And Brush <> 0 Then
If SpriteBuilder\OwnBrush = True And SpriteBuilder\TextureBrush <> 0 Then FreeBrush SpriteBuilder\TextureBrush
SpriteBuilder\TextureBrush = Brush
If SpriteBuilder\MeshSurface <> 0 Then PaintSurface SpriteBuilder\MeshSurface, SpriteBuilder\TextureBrush
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushSize.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, BrushW%, BrushH%)
If SpriteBuilder <> Null And SpriteBuilder\TextureBrush <> 0 Then
SpriteBuilder\Width = BrushW
SpriteBuilder\Height = BrushH
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushAlpha.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Alpha#)
If SpriteBuilder <> Null And SpriteBuilder\TextureBrush <> 0 Then
BrushAlpha SpriteBuilder\TextureBrush, Alpha
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushBlend.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Blend%)
If SpriteBuilder <> Null And SpriteBuilder\TextureBrush <> 0 Then
BrushBlend SpriteBuilder\TextureBrush, Blend
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushColor.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Red#, Green#, Blue#)
If SpriteBuilder <> Null And SpriteBuilder\TextureBrush <> 0 Then
BrushColor SpriteBuilder\TextureBrush, Red, Green, Blue
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushFX.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, FX%)
If SpriteBuilder <> Null And SpriteBuilder\TextureBrush <> 0 Then
BrushFX SpriteBuilder\TextureBrush, FX
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushShininess.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Shininess#)
If SpriteBuilder <> Null And SpriteBuilder\TextureBrush <> 0 Then
BrushShininess SpriteBuilder\TextureBrush, Shininess
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_BrushTexture.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Texture%, Frame% = 0, Index% = 0)
If SpriteBuilder <> Null And Texture <> 0 Then
BrushTexture SpriteBuilder\TextureBrush, Texture, Frame, Index
SpriteBuilder\Width = TextureWidth(Texture)
SpriteBuilder\Height = TextureHeight(Texture)
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_Mesh.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, Mesh% = 0, MeshSurface% = 0, ShareSurface = False)
If SpriteBuilder <> Null Then
If SpriteBuilder\OwnMesh Then FreeEntity SpriteBuilder\Mesh
If Mesh = 0 Then
SpriteBuilder\Mesh = CreateMesh()
SpriteBuilder\OwnMesh = True
Else
SpriteBuilder\Mesh = Mesh
SpriteBuilder\OwnMesh = False
EndIf
TSpriteBuilder_MeshSurface(SpriteBuilder, MeshSurface, ShareSurface)
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_MeshSurface.TSpriteBuilder(SpriteBuilder.TSpriteBuilder, MeshSurface% = 0, ShareSurface% = False)
If SpriteBuilder <> Null And SpriteBuilder\Mesh <> 0 Then
If MeshSurface = 0 Then
If SpriteBuilder\OwnMeshSurface = False Then SpriteBuilder\MeshSurface = CreateSurface(SpriteBuilder\Mesh, SpriteBuilder\TextureBrush)
SpriteBuilder\OwnMeshSurface = True
ElseIf MeshSurface <> 0 Then
SpriteBuilder\MeshSurface = MeshSurface
SpriteBuilder\OwnMeshSurface = False
EndIf
If SpriteBuilder\TextureBrush <> 0 Then PaintSurface SpriteBuilder\MeshSurface, SpriteBuilder\TextureBrush
SpriteBuilder\SharedSurface = ShareSurface
Return SpriteBuilder
EndIf
Return Null
End Function
Function TSpriteBuilder_Reset.TSpriteBuilder(SpriteBuilder.TSpriteBuilder)
If SpriteBuilder <> Null Then
If SpriteBuilder\OwnMesh Then FreeEntity SpriteBuilder\Mesh
If SpriteBuilder\OwnBrush Then FreeBrush SpriteBuilder\TextureBrush
Delete SpriteBuilder
Return New TSpriteBuilder
EndIf
End Function
; TSprite
Function TSprite_Create.TSprite(SpriteBuilder.TSpriteBuilder)
If SpriteBuilder <> Null And SpriteBuilder\Mesh <> 0 And SpriteBuilder\MeshSurface <> 0 And SpriteBuilder\TextureBrush <> 0 Then
Local Sprite.TSprite = New TSprite
Local Width# = SpriteBuilder\Width
Local Height# = SpriteBuilder\Height
; Mesh & Surface.
Sprite\mMesh = SpriteBuilder\Mesh
Sprite\mSurface = SpriteBuilder\MeshSurface
Sprite\mShareSurface = SpriteBuilder\SharedSurface
; Texture.
Sprite\mTextureBrush = SpriteBuilder\TextureBrush
; Padding.
Sprite\mPadding[0] = SpriteBuilder\PaddingLeft
Sprite\mPadding[1] = SpriteBuilder\PaddingTop
Sprite\mPadding[2] = SpriteBuilder\PaddingRight
Sprite\mPadding[3] = SpriteBuilder\PaddingBottom
; Border.
Sprite\mBorder[0] = SpriteBuilder\BorderLeft
Sprite\mBorder[1] = SpriteBuilder\BorderTop
Sprite\mBorder[2] = SpriteBuilder\BorderRight
Sprite\mBorder[3] = SpriteBuilder\BorderBottom
; Scale.
Sprite\mScale[0] = SpriteBuilder\ScaleX
Sprite\mScale[1] = SpriteBuilder\ScaleY
Sprite\mBorderScale[0] = SpriteBuilder\BorderScaleX
Sprite\mBorderScale[1] = SpriteBuilder\BorderScaleY
; Calculate Outer Limits.
Sprite\mOuter[0] = Sprite\mPadding[0]
Sprite\mOuter[1] = Sprite\mPadding[1]
Sprite\mOuter[2] = Width - Sprite\mPadding[2]
Sprite\mOuter[3] = Height - Sprite\mPadding[3]
; Calculate Inner Limits.
Sprite\mInner[0] = Sprite\mOuter[0] + Sprite\mBorder[0]
Sprite\mInner[1] = Sprite\mOuter[1] + Sprite\mBorder[1]
Sprite\mInner[2] = Sprite\mOuter[2] - Sprite\mBorder[2]
Sprite\mInner[3] = Sprite\mOuter[3] - Sprite\mBorder[3]
; Convert Outer Limits to valid UV coordinates.
Sprite\mOuterUV[0] = Sprite\mOuter[0] / Width
Sprite\mOuterUV[1] = Sprite\mOuter[1] / Height
Sprite\mOuterUV[2] = Sprite\mOuter[2] / Width
Sprite\mOuterUV[3] = Sprite\mOuter[3] / Height
; Convert Inner Limits to valid UV coordinates.
Sprite\mInnerUV[0] = Sprite\mInner[0] / Width
Sprite\mInnerUV[1] = Sprite\mInner[1] / Height
Sprite\mInnerUV[2] = Sprite\mInner[2] / Width
Sprite\mInnerUV[3] = Sprite\mInner[3] / Height
Return Sprite
EndIf
Return Null
End Function
Function TSprite_Fill(Sprite.TSprite, X#, Y#, Width#, Height#, Z#=0, Modes%=0)
Local TileX%, TileXPos#, TileXPosE#, TileWidth#, TileHMult#, TileCountH#, TileCountH2, TempHMult#, TileUVLeft#, TileUVRight#
Local TileY%, TileYPos#, TileYPosE#, TileHeight#, TileVMult#, TileCountV#, TileCountV2, TempVMult#, TileUVTop#, TileUVBottom#
If Sprite <> Null And Sprite\mSurface <> 0 And Width > 0 And Height > 0 Then
If Sprite\mShareSurface = False Then ClearSurface(Sprite\mSurface)
; Translate Mode into easily used variables.
Local BorderLft = ((Modes And TSPRITE_BORDER_LFT) > 0)
Local BorderRgt = ((Modes And TSPRITE_BORDER_RGT) > 0)
Local BorderTop = ((Modes And TSPRITE_BORDER_TOP) > 0)
Local BorderBtm = ((Modes And TSPRITE_BORDER_BTM) > 0)
Local BorderOutLft = (-1 + ((Modes And TSPRITE_BORDEROUT_LFT) > 0))
Local BorderOutRgt = (-1 + ((Modes And TSPRITE_BORDEROUT_RGT) > 0))
Local BorderOutTop = (-1 + ((Modes And TSPRITE_BORDEROUT_TOP) > 0))
Local BorderOutBtm = (-1 + ((Modes And TSPRITE_BORDEROUT_BTM) > 0))
Local RoundDownH = ((Modes And TSPRITE_ROUNDDOWN_HORZ) > 0)
Local RoundDownV = ((Modes And TSPRITE_ROUNDDOWN_VERT) > 0)
Local PartialH = ((Modes And TSPRITE_PARTIAL_HORZ) > 0)
Local PartialV = ((Modes And TSPRITE_PARTIAL_VERT) > 0)
Local PartialCutH = ((Modes And TSPRITE_PARTIALCUT_HORZ) > 0)
Local PartialCutV = ((Modes And TSPRITE_PARTIALCUT_VERT) > 0)
Local ForceSingleH = ((Modes And TSPRITE_FORCESINGLE_HORZ) > 0)
Local ForceSingleV = ((Modes And TSPRITE_FORCESINGLE_VERT) > 0)
; Calculate scaled sizes.
Local SpriteBorder#[4]
SpriteBorder[0] = (Sprite\mBorder[0] * Sprite\mBorderScale[0]) * BorderLft
SpriteBorder[2] = (Sprite\mBorder[2] * Sprite\mBorderScale[0]) * BorderRgt
SpriteBorder[1] = (Sprite\mBorder[1] * Sprite\mBorderScale[0]) * BorderTop
SpriteBorder[3] = (Sprite\mBorder[3] * Sprite\mBorderScale[0]) * BorderBtm
Local SpriteSize#[2]
SpriteSize[0] = (Sprite\mInner[2]-Sprite\mInner[0])*Sprite\mScale[0]
SpriteSize[1] = (Sprite\mInner[3]-Sprite\mInner[1])*Sprite\mScale[1]
; Calculate real values.
Local RealWidth# = Width + (SpriteBorder[0] * BorderOutLft) + (SpriteBorder[2] * BorderOutRgt)
Local RealHeight# = Height + (SpriteBorder[1] * BorderOutTop) + (SpriteBorder[3] * BorderOutBtm)
; Recalculate scaled border if we are below minimum size.
Local BorderScale#[4], BorderMaximum#[2], SizeScale#[2]
BorderMaximum[0] = ((SpriteBorder[0] * -BorderOutLft) + (SpriteBorder[2] * -BorderOutRgt))
BorderMaximum[1] = ((SpriteBorder[1] * -BorderOutTop) + (SpriteBorder[3] * -BorderOutBtm))
If Width < BorderMaximum[0] Then
SizeScale[0] = (Width / BorderMaximum[0])
SpriteBorder[0] = SpriteBorder[0] * SizeScale[0]
SpriteBorder[2] = SpriteBorder[2] * SizeScale[0]
RealWidth = 0
EndIf
If Height < BorderMaximum[1] Then
SizeScale[1] = (Height / BorderMaximum[1])
SpriteBorder[1] = SpriteBorder[1] * SizeScale[1]
SpriteBorder[3] = SpriteBorder[3] * SizeScale[1]
RealHeight = 0
EndIf
; Calculate Position
Local RealX# = X - (SpriteBorder[0] * BorderOutLft)
Local RealY# = -(Y - (SpriteBorder[1] * BorderOutTop))
; Calculate tiles.
If ForceSingleH = 0 Then
If RealWidth > 0 Then TileCountH = RealWidth / SpriteSize[0] Else TileCountH = 0
Else
TileCountH = 1
EndIf
If ForceSingleV = 0 Then
If RealHeight > 0 Then TileCountV = RealHeight / SpriteSize[1] Else TileCountV = 0
Else
TileCountV = 1
EndIf
If PartialH = 1 Or RoundDownH = 0 Then TileCountH2 = Ceil(TileCountH) Else TileCountH2 = Floor(TileCountH)
If PartialV = 1 Or RoundDownV = 0 Then TileCountV2 = Ceil(TileCountV) Else TileCountV2 = Floor(TileCountV)
If PartialH = 1 Then TileWidth = (RealWidth / TileCountH) Else TileWidth = (RealWidth / TileCountH2)
If PartialV = 1 Then TileHeight = (RealHeight / TileCountV) Else TileHeight = (RealHeight / TileCountV2)
If (TileCountH2 < 0) Then TileCountH2 = 0 Else TileCountH2 = TileCountH2 - 1
If (TileCountV2 < 0) Then TileCountV2 = 0 Else TileCountV2 = TileCountV2 - 1
; Calculate Partial scale
If PartialH = 1 Then TileHMult = TileCountH - TileCountH2
If PartialV = 1 Then TileVMult = TileCountV - TileCountV2
; Draw Corners
If SpriteBorder[1] > 0 Then
If (BorderTop And BorderLft And SpriteBorder[0] > 0) Then TSprite_CreateQuad(Sprite\mSurface, RealX - SpriteBorder[0], RealX, RealY + SpriteBorder[1], RealY, 0, 0, Sprite\mOuterUV[0], Sprite\mInnerUV[0], Sprite\mOuterUV[1], Sprite\mInnerUV[1])
If (BorderTop And BorderRgt And SpriteBorder[2] > 0) Then TSprite_CreateQuad(Sprite\mSurface, RealX + RealWidth, RealX + RealWidth + SpriteBorder[2], RealY + SpriteBorder[1], RealY, Z, Z, Sprite\mInnerUV[2], Sprite\mOuterUV[2], Sprite\mOuterUV[1], Sprite\mInnerUV[1])
EndIf
If SpriteBorder[3] > 0 Then
If (BorderBtm And BorderLft And SpriteBorder[0] > 0) Then TSprite_CreateQuad(Sprite\mSurface, RealX - SpriteBorder[0], RealX, RealY - RealHeight, RealY - RealHeight - SpriteBorder[3], Z, Z, Sprite\mOuterUV[0], Sprite\mInnerUV[0], Sprite\mInnerUV[3], Sprite\mOuterUV[3])
If (BorderBtm And BorderRgt And SpriteBorder[2] > 0) Then TSprite_CreateQuad(Sprite\mSurface, RealX + RealWidth, RealX + RealWidth + SpriteBorder[2], RealY - RealHeight, RealY - RealHeight - SpriteBorder[1], Z, Z, Sprite\mInnerUV[2], Sprite\mOuterUV[2], Sprite\mInnerUV[3], Sprite\mOuterUV[3])
EndIf
For TileX% = 0 To TileCountH2
; Horizontal coordinates and UV.
TileXPos = RealX + (TileX * TileWidth)
TileXPosE = TileXPos + TileWidth
TileUVLeft = Sprite\mInnerUV[0]
TileUVRight = Sprite\mInnerUV[2]
; Support for partial horizontal tiles.
If PartialH And TileX = TileCountH2 Then
TileXPosE = TileXPos + (TileWidth * TileHMult)
If PartialCutH Then TileUVRight = (TileUVLeft * (1-TileHMult)) + (TileUVRight * TileHMult)
EndIf
For TileY% = 0 To TileCountV2
; Vertical coordinates and UV.
TileYPos = RealY - (TileY * TileHeight)
TileYPosE = TileYPos - TileHeight
TileUVTop = Sprite\mInnerUV[1]
TileUVBottom = Sprite\mInnerUV[3]
; Support for partial vertical tiles.
If PartialV And TileY = TileCountV2 Then
TileYPosE = TileYPos - (TileHeight * TileVMult)
If PartialCutV Then TileUVBottom = (TileUVTop * (1-TileVMult)) + (TileUVBottom * TileVMult)
EndIf
; Tiles
TSprite_CreateQuad(Sprite\mSurface, TileXPos, TileXPosE, TileYPos, TileYPosE, Z, Z, TileUVLeft, TileUVRight, TileUVTop, TileUVBottom)
Next
; Horizontal Border
If (BorderTop) Then TSprite_CreateQuad(Sprite\mSurface, TileXPos, TileXPosE, RealY + SpriteBorder[1], RealY, Z, Z, TileUVLeft, TileUVRight, Sprite\mOuterUV[1], Sprite\mInnerUV[1])
If (BorderBtm) Then TSprite_CreateQuad(Sprite\mSurface, TileXPos, TileXPosE, RealY - RealHeight, RealY - RealHeight - SpriteBorder[3], Z, Z, TileUVLeft, TileUVRight, Sprite\mInnerUV[3], Sprite\mOuterUV[3])
Next
For TileY% = 0 To TileCountV2
; Vertical coordinates and UV.
TileYPos = RealY - (TileY * TileHeight)
TileYPosE = TileYPos - TileHeight
TileUVTop = Sprite\mInnerUV[1]
TileUVBottom = Sprite\mInnerUV[3]
; Support for partial vertical tiles.
If PartialV And TileY = TileCountV2 Then
TileYPosE = TileYPos - (TileHeight * TileVMult)
If PartialCutV Then TileUVBottom = (TileUVTop * (1-TileVMult)) + (TileUVBottom * TileVMult)
EndIf
; Vertical Border
If (BorderLft) Then TSprite_CreateQuad(Sprite\mSurface, RealX - SpriteBorder[0], RealX, TileYPos, TileYPosE, Z, Z, Sprite\mOuterUV[0], Sprite\mInnerUV[0], TileUVTop, TileUVBottom)
If (BorderRgt) Then TSprite_CreateQuad(Sprite\mSurface, RealX + RealWidth, RealX + RealWidth + SpriteBorder[2], TileYPos, TileYPosE, Z, Z, Sprite\mInnerUV[2], Sprite\mOuterUV[2], TileUVTop, TileUVBottom)
Next
EndIf
End Function
Function TSprite_CreateQuad(Surface%, X0#, X1#, Y0#, Y1#, Z0#, Z1#, U0# = 0, U1# = 0, V0# = 0, V1# = 0, W0# = 0, W1# = 0, TurnOrder% = 0, ShareVertices% = True)
Local TrisOut% = 0
Local vTL, vBL, vTR, vBR
vTL = AddVertex(Surface, X0, Y0, Z0, U0, V0, W0)
vTR = AddVertex(Surface, X1, Y0, (Z0+Z1)/2, U1, V0, (W0+W1)/2)
vBL = AddVertex(Surface, X0, Y1, (Z0+Z1)/2, U0, V1, (W0+W1)/2)
vBR = AddVertex(Surface, X1, Y1, Z1, U1, V1, W1)
If ShareVertices Then
If (TurnOrder) Then
TrisOut = TrisOut + AddTriangle(Surface, vBL, vTL, vTR) Shl 16
TrisOut = TrisOut + AddTriangle(Surface, vBL, vTR, vBR)
Else
TrisOut = TrisOut + AddTriangle(Surface, vTL, vTR, vBR) Shl 16
TrisOut = TrisOut + AddTriangle(Surface, vTL, vBR, vBL)
EndIf
Else
If TurnOrder Then
Local vTR2, vBL2
vTR2 = AddVertex(Surface, X1, Y0, (Z0+Z1)/2, U1, V0, (W0+W1)/2)
vBL2 = AddVertex(Surface, X0, Y1, (Z0+Z1)/2, U0, V1, (W0+W1)/2)
TrisOut = TrisOut + AddTriangle(Surface, vBL, vTL, vTR) Shl 16
TrisOut = TrisOut + AddTriangle(Surface, vBL2, vTR2, vBR)
Else
Local vTL2, vBR2
vTL2 = AddVertex(Surface, X0, Y0, Z0, U0, V0, W0)
vBR2 = AddVertex(Surface, X1, Y1, Z1, U1, V1, W1)
TrisOut = TrisOut + AddTriangle(Surface, vTL, vTR, vBR) Shl 16
TrisOut = TrisOut + AddTriangle(Surface, vTL2, vBR2, vBL)
EndIf
EndIf
Return TrisOut
End Function
Function TSprite_CreateQuadEx(Surface%, X0#, X1#, Y0#, Y1#, Z0#, Z1#, U0# = 0, U1# = 0, V0# = 0, V1# = 0, W0# = 0, W1# = 0, ShareVertices% = True)
Local vTL, vTR, vCC, vBL, vBR
vTL = AddVertex(Surface, X0, Y0, Z0, U0, V0, W0)
vTR = AddVertex(Surface, X1, Y0, (Z0+Z1)/2, U1, V0, (W0+W1)/2)
vCC = AddVertex(Surface, (X0+X1)/2, (Y0+Y1)/2, (Z0+Z1)/2, (U0+U1)/2, (V0+V1)/2, (W0+W1)/2)
vBL = AddVertex(Surface, X0, Y1, (Z0+Z1)/2, U0, V1, (W0+W1)/2)
vBR = AddVertex(Surface, X1, Y1, Z1, U1, V1, W1)
If ShareVertices Then
AddTriangle(Surface, vTL, vTR, vCC)
AddTriangle(Surface, vBL, vTL, vCC)
AddTriangle(Surface, vTR, vBR, vCC)
AddTriangle(Surface, vBL, vBR, vCC)
Else
Local vTL2, vTR2, vBL2, vBR2, vCC2, vCC3, vCC4
vTL2 = AddVertex(Surface, X0, Y0, Z0, U0, V0, W0)
vTR2 = AddVertex(Surface, X1, Y0, (Z0+Z1)/2, U1, V0, (W0+W1)/2)
vBL2 = AddVertex(Surface, X0, Y1, (Z0+Z1)/2, U0, V1, (W0+W1)/2)
vBR2 = AddVertex(Surface, X1, Y1, Z1, U1, V1, W1)
vCC2 = AddVertex(Surface, (X0+X1)/2, (Y0+Y1)/2, (Z0+Z1)/2, (U0+U1)/2, (V0+V1)/2, (W0+W1)/2)
vCC3 = AddVertex(Surface, (X0+X1)/2, (Y0+Y1)/2, (Z0+Z1)/2, (U0+U1)/2, (V0+V1)/2, (W0+W1)/2)
vCC4 = AddVertex(Surface, (X0+X1)/2, (Y0+Y1)/2, (Z0+Z1)/2, (U0+U1)/2, (V0+V1)/2, (W0+W1)/2)
AddTriangle(Surface, vTL, vTR, vCC)
AddTriangle(Surface, vBL, vTL2, vCC2)
AddTriangle(Surface, vTR2, vBR, vCC3)
AddTriangle(Surface, vBL2, vBR2, vCC4)
EndIf
End Function
;~IDEal Editor Parameters:
;~F#1C#36#5D#65#70#79#84#8D#98#A2#AA#B2#BA#C2#CA#D5#E6#F7#102#1D3
;~F#1F8
;~C#Blitz3D
BlitzBasic/Blitz3D/TiledSprite/TiledSprite_Test01.fw.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 336 KiB

BlitzBasic/Userlib/BlitzUtility/BlitzUtility.bb
+85
View File
@@ -0,0 +1,85 @@
;----------------------------------------------------------------
;-- Types
;----------------------------------------------------------------
Type BU_Rectangle
Field X,Y
Field X2,Y2
End Type
Type BU_Point
Field X,Y
End Type
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Global
;----------------------------------------------------------------
Global Utility_Rect.BU_Rectangle = New BU_Rectangle
Global Utility_Point.BU_Point = New BU_Point
Global Utility_PrivateProfileBuffer = CreateBank(65535)
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Functions
;----------------------------------------------------------------
Function Utility_LockPointerToWindow(hwnd=0)
If hwnd = 0 Then
Utility_Rect\X = 0
Utility_Rect\Y = 0
Utility_Rect\X2 = BUApi_GetSystemMetrics(78)
Utility_Rect\Y2 = BUApi_GetSystemMetrics(79)
BUApi_ClipCursor(Utility_Rect)
Else
;Grab TopLeft
Utility_Point\X = 0
Utility_Point\Y = 0
BUApi_ClientToScreen(hwnd, Utility_Point)
Utility_Rect\X = Utility_Point\X
Utility_Rect\Y = Utility_Point\Y
;Grab BottomRight
Utility_Point\X = GraphicsWidth()
Utility_Point\Y = GraphicsHeight()
BUApi_ClientToScreen(hwnd, Utility_Point)
Utility_Rect\X2 = Utility_Point\X
Utility_Rect\Y2 = Utility_Point\Y
BUApi_ClipCursor(Utility_Rect)
EndIf
End Function
Function Utility_BorderlessWindowmode(Title$="", MonitorId=0)
Local hWnd = SystemProperty("AppHwnd")
If hWnd = 0 Then hWnd = BUApi_FindWindow("Blitz Runtime Class", Title)
If hWnd = 0 Then RuntimeError("Unable to create borderless window.")
Utility_EnumerateDisplays()
Local dispCnt = Utility_GetDisplayCount()
If MonitorId < 0 Then MonitorId = 0
If MonitorId >= dispCnt Then MonitorId = dispCnt -1
Local rct.BU_Rectangle = New BU_Rectangle
Utility_GetDisplay(MonitorId, rct)
BUApi_SetWindowLong hWnd, -16, $01000000
BUApi_SetWindowPos hWnd, 0, rct\X, rct\Y, rct\X2, rct\Y2, 64
End Function
Function Utility_GetIniString$(File$, Section$, Key$, Def$)
Local wLen% = BUApi_GetPrivateProfileString(Section, Key, Def, Utility_PrivateProfileBuffer, 65535, File)
If wLen > 0 Then
Local wOut$ = ""
Local wPos = 1
While (wPos < wLen)
wOut = wOut + Chr(PeekByte(Utility_PrivateProfileBuffer, wPos - 1))
wPos=wPos+1
Wend
Return wOut
EndIf
End Function
Function Utility_SetIniString(File$, Section$, Key$, Value$)
Return (BUApi_SetPrivateProfileString(Section, Key, Value, File) = 1)
End Function
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/Userlib/BlitzUtility/BlitzUtility.cpp
+137
View File
@@ -0,0 +1,137 @@
/*----------------------------------------------------------------*\
| Linker Options: -static-libgcc -static-libstdc++
| Linker Libraries: user32
\*----------------------------------------------------------------*/
#Include <windows.h>
struct Display {
int left;
int top;
int right;
int bottom;
Display* nextDisplay;
Display* prevDisplay;
};
Display* firstDisplay = NULL;
Display* lastDisplay = NULL;
BOOL CALLBACK _EnumerateDisplaysProcedure(HMONITOR hMonitor, HDC hdcMonitor, LPRECT lprcMonitor, LPARAM dwData);
STDAPIV_(void) Utility_EnumerateDisplays() {
/* Clean up the Linked List first. */
if (firstDisplay) {
Display* displayPointer = firstDisplay;
while(displayPointer) {
Display* thisDisplay = displayPointer;
displayPointer = displayPointer->nextDisplay;
delete thisDisplay;
}
firstDisplay = NULL;
lastDisplay = NULL;
}
EnumDisplayMonitors(NULL, NULL, _EnumerateDisplaysProcedure, 0);
}
BOOL CALLBACK _EnumerateDisplaysProcedure(HMONITOR hMonitor, HDC hdcMonitor, LPRECT lprcMonitor, LPARAM dwData) {
Display* thisDisplay = new Display;
ZeroMemory(thisDisplay,sizeof(thisDisplay));
if (!firstDisplay) firstDisplay = thisDisplay;
if (!lastDisplay) {
lastDisplay = thisDisplay;
} else {
lastDisplay->nextDisplay = thisDisplay;
thisDisplay->prevDisplay = lastDisplay;
}
thisDisplay->left = lprcMonitor->left;
thisDisplay->top = lprcMonitor->top;
thisDisplay->right = lprcMonitor->right;
thisDisplay->bottom = lprcMonitor->bottom;
lastDisplay = thisDisplay;
return TRUE;
}
STDAPIV_(int) Utility_GetDisplayCount() {
int displayCount = 0;
Display* displayPointer = firstDisplay;
while (displayPointer) {
displayCount++;
displayPointer = displayPointer->nextDisplay;
}
return displayCount;
}
STDAPIV_(void) Utility_GetDisplay(int displayId, LPRECT display) {
int displayCount = 0;
Display* displayPointer = firstDisplay;
while (displayPointer) {
if ((displayCount == displayId) && (display) && (displayPointer)) {
display->left = displayPointer->left;
display->top = displayPointer->top;
display->right = displayPointer->right;
display->bottom = displayPointer->bottom;
}
displayCount++;
displayPointer = displayPointer->nextDisplay;
}
}
LRESULT CALLBACK _CloseWindowProcedure(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam);
struct WindowUserData {
Int oldWindowProcedure;
Int oldUserData;
Int closeCount;
};
STDAPIV_(void) Utility_InstallCloseHandler(HWND hwnd) {
If (hwnd) {
WindowUserData* hwndData = New WindowUserData;
ZeroMemory(hwndData, sizeof(hwndData));
hwndData->oldWindowProcedure = SetWindowLong(hwnd, GWL_WNDPROC, (LONG)&_CloseWindowProcedure);
hwndData->oldUserData = SetWindowLong(hwnd, GWL_USERDATA, (LONG)hwndData);
}
}
STDAPIV_(void) Utility_UninstallCloseHandler(HWND hwnd) {
If (hwnd) {
WindowUserData* hwndData = (WindowUserData*)GetWindowLong(hwnd, GWL_USERDATA);
If (hwndData) {
SetWindowLong(hwnd, GWL_USERDATA, hwndData->oldUserData);
SetWindowLong(hwnd, GWL_WNDPROC, hwndData->oldWindowProcedure);
Delete hwndData;
}
}
}
STDAPIV_(Int) Utility_GetCloseCount(HWND hwnd) {
If (hwnd) {
WindowUserData* hwndData = (WindowUserData*)GetWindowLong(hwnd, GWL_USERDATA);
If (hwndData) {
Int toReturn = hwndData->closeCount;
hwndData->closeCount = 0;
Return toReturn;
}
}
Return 0;
}
LRESULT CALLBACK _CloseWindowProcedure(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
WindowUserData* hwndData = (WindowUserData*)GetWindowLong(hwnd, GWL_USERDATA);
If (hwndData) {
switch(uMsg) {
Case WM_CLOSE:
Case WM_DESTROY:
hwndData->closeCount++;
Return False;
Default:
Return CallWindowProc((WNDPROC)hwndData->oldWindowProcedure, hwnd, uMsg, wParam, lParam);
}
} Else {
Return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
}
BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved) {return TRUE;}
BlitzBasic/Userlib/BlitzUtility/BlitzUtility.decls
+20
View File
@@ -0,0 +1,20 @@
.lib "User32.dll"
BUApi_SetWindowLong%(hwnd%, nIndex%, dwNewLong%):"SetWindowLongA"
BUApi_GetWindowLong%(hwnd%, index%):"GetWindowLongA"
BUApi_SetWindowPos%(hwnd%, hWndInsertAfter%, x%, y%, cx%, cy%, wFlags%):"SetWindowPos"
BUApi_ClientToScreen%(hwnd%, point*):"ClientToScreen"
BUApi_ClipCursor%(rect*):"ClipCursor"
BUApi_GetSystemMetrics%(index%):"GetSystemMetrics"
BUApi_FindWindow%(class$, title$):"FindWindowA"
.lib "Kernel32.dll"
BUApi_GetPrivateProfileString%(lpszAppName$, lpszKeyName$, lpszDefault$, lpReturnedString*, nSize%, lpszFileName$):"GetPrivateProfileStringA"
BUApi_SetPrivateProfileString%(lpszAppName$, lpszKeyName$, lpszString$, lpszFileName$):"WritePrivateProfileStringA"
.lib "BlitzUtility.dll"
Utility_InstallCloseHandler(hwnd%):"Utility_InstallCloseHandler"
Utility_UninstallCloseHandler(hwnd%):"Utility_UninstallCloseHandler"
Utility_GetCloseCount%(hwnd%):"Utility_GetCloseCount"
Utility_EnumerateDisplays():"Utility_EnumerateDisplays"
Utility_GetDisplayCount%():"Utility_GetDisplayCount"
Utility_GetDisplay(id%, rectangle*):"Utility_GetDisplay"
BlitzBasic/Userlib/BlitzUtility/README.md
+9
View File
@@ -0,0 +1,9 @@
BlitzUtility
=======================
The beaty of C++ and how fast you can do something in it. I didn't want to mess around with unsafe pointers and invalid stacks in BlitzBasic, so instead I just wrote it in C++ and made the code public.
Documentation at: http://www.blitzforum.de/forum/viewtopic.php?p=405650#405650
License
=======
BlitzUtility by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.
BlitzBasic/Userlib/InputEx/InputEx.bb
+322
View File
@@ -0,0 +1,322 @@
;----------------------------------------------------------------
;-- Userlib
;----------------------------------------------------------------
;.lib "User32.dll"
;User32_FindWindow%(class$, title$):"FindWindowA"
;User32_GetActiveWindow%():"GetActiveWindow"
;User32_GetCursorPosition%(point*):"GetCursorPos"
;User32_ScreenToClient%(hwnd%, point*):"ScreenToClient"
;User32_MapVirtualKeyEx%(code%, mapType%, dwhkl%):"MapVirtualKeyExA"
;User32_GetAsyncKeyState%(vkey%):"GetAsyncKeyState"
;
;.lib " "
;InputEx_Init()
;InputEx_Update()
;InputEx_VKeyTime%(VirtualKey%)
;InputEx_VKeyDownEx%(VirtualKey%)
;InputEx_VKeyDown%(VirtualKey%)
;InputEx_VKeyHitEx%(VirtualKey%)
;InputEx_VKeyHit%(VirtualKey%)
;InputEx_KeyTime%(ScanCode%)
;InputEx_KeyDownEx%(ScanCode%)
;InputEx_KeyDown%(ScanCode%)
;InputEx_KeyHitEx%(ScanCode%)
;InputEx_KeyHit%(ScanCode%)
;InputEx_MouseTime%(Button%)
;InputEx_MouseDownEx%(Button%)
;InputEx_MouseDown%(Button%)
;InputEx_MouseHitEx%(Button%)
;InputEx_MouseHit%(Button%)
;KeyTime%(Key%)
;KeyDownEx%(Key%)
;KeyHitEx%(Key%)
;MouseTime%(Button%)
;MouseDownEx%(Button%)
;MouseHitEx%(Button%)
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Types
;----------------------------------------------------------------
Type Point
Field X,Y
End Type
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Globals
;----------------------------------------------------------------
Global InputEx_Window = SystemProperty("AppHWND"), InputEx_ForMe = True
Global InputEx_Mouse.Point = New Point
Global InputEx_Width = GraphicsWidth()
Global InputEx_Height = GraphicsHeight()
Dim InputEx_State(256)
Dim InputEx_StateTime(256)
Dim InputEx_StateUpdates(256)
Dim InputEx_Hits(256)
Dim InputEx_VSCAsVK(256)
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Functions
;----------------------------------------------------------------
Function InputEx_Init(applicationTitle$="")
;@desc: Call this when your program starts to allow InputEx to work.
;If Not InputEx_Window Then InputEx_Window = User32_FindWindow("Blitz Runtime Class", applicationTitle)
InputEx_Window = SystemProperty("AppHWND")
User32_GetCursorPosition(InputEx_Mouse)
User32_ScreenToClient(InputEx_Window, InputEx_Mouse)
InputEx_ForMe = (User32_GetActiveWindow() = InputEx_Window)
If Not ((InputEx_Mouse\X >= 0) And (InputEx_Mouse\Y >= 0) And (InputEx_Mouse\X < GraphicsWidth()) And (InputEx_MouseY < GraphicsHeight())) Then InputEx_ForMe = False
For VSC = 0 To 255
InputEx_VSCAsVK(VSC) = User32_MapVirtualKeyEx(VSC, 1, 0)
Next
End Function
Function InputEx_SetResolution(Width, Height)
InputEx_Width = Width
InputEx_Height = Height
End Function
Function InputEx_Update()
;@desc: Call this once per frame to update InputExs values.
Local InputEx_StateNew
Local InputEx_Time = MilliSecs()
User32_GetCursorPosition(InputEx_Mouse)
User32_ScreenToClient(InputEx_Window, InputEx_Mouse)
InputEx_ForMe = (User32_GetActiveWindow() = InputEx_Window)
If Not ((InputEx_Mouse\X >= 0) And (InputEx_Mouse\Y >= 0) And (InputEx_Mouse\X < InputEx_Width) And (InputEx_Mouse\Y < InputEx_Height)) Then InputEx_ForMe = False
;If InputEx_ForMe Then ;Are those signals even for us?
For VK = 0 To 255
InputEx_StateNew = (User32_GetAsyncKeyState(VK) <> 0)
; Generic Update Structure
If (InputEx_StateNew = 1) And (InputEx_State(VK) = 0) Then
InputEx_Hits(VK) = InputEx_Hits(VK) + 1 ; Register as new key hit.
InputEx_State(VK) = 1 ; Set State to down.
InputEx_StateUpdates(VK) = 0 ; Reset updatecount.
InputEx_StateTime(VK) = InputEx_Time ; Set time at which the state changed.
ElseIf (InputEx_StateNew = 0) And (InputEx_State(VK) = 1) Then
InputEx_State(VK) = 0 ; Set State to up.
InputEx_StateUpdates(VK) = 0 ; Reset Updatecount.
InputEx_StateTime(VK) = InputEx_Time ; Set time at which the state changed.
Else
If (InputEx_State(VK) = 1) Then
InputEx_StateUpdates(VK) = InputEx_StateUpdates(VK) + 1 ; Increase updatecount because button is down.
Else
InputEx_StateUpdates(VK) = InputEx_StateUpdates(VK) - 1 ; Decrease updatecount because button is up.
EndIf
EndIf
Next
;Else ;No
For VK = 0 To 255
InputEx_State(VK) = 0
InputEx_StateTime(VK) = InputEx_Time
Next
;EndIf
;Some may ask why i didn't put the If into the loop, this is the answer:
;If I put it outside the loop, it's one less task for the CPU to do for every iteration. Thus increasing speed.
;If I put it inside the loop, it's one more task for the CPU to do for every iteration. Thus decreasing speed.
End Function
Function InputEx_VKeyTime(VirtualKey)
;@desc: This tells you when the last state of the key was recieved in milliseconds.
;@returns: Time in milliseconds when the state of the key was registered.
Return InputEx_StateTime(VirtualKey)
End Function
Function InputEx_VKeyDownEx(VirtualKey)
;@desc: This tells you the amount of updates a key has been down for(positive) or the amount of updates a key has been up for(negative).
;@returns: Updates the key has been down for.
Return InputEx_StateUpdates(VirtualKey)
End Function
Function InputEx_VKeyDown(VirtualKey)
;@desc: This tells you if a key is down or not.
;@returns: The keys state.
Return InputEx_State(VirtualKey)
End Function
Function InputEx_VKeyHitEx(VirtualKey, Reduce=1)
;@desc: This tells you the amount of hits a key has recieved, while reducing the amount by <Reduce>.
;@returns: How many times the key has been hit.
Local Hits = InputEx_Hits(VirtualKey)
InputEx_Hits(VirtualKey) = InputEx_Hits(VirtualKey) - Reduce
Return Hits
End Function
Function InputEx_VKeyHit(VirtualKey)
;@desc: This tells you the amount of hits a key has recieved since the last call and setting the amount to zero.
;@returns: How many times the key has been hit.
Local Hits = InputEx_Hits(VirtualKey)
InputEx_Hits(VirtualKey) = 0
Return Hits
End Function
Function InputEx_KeyTime(ScanCode)
;@desc: See [InputEx_VKeyTime].
Return InputEx_VKeyTime(InputEx_VSCAsVK(ScanCode))
End Function
Function InputEx_KeyDownEx(ScanCode)
;@desc: See [InputEx_VKeyDownEx].
Return InputEx_VKeyDownEx(InputEx_VSCAsVK(ScanCode))
End Function
Function InputEx_KeyDown(ScanCode)
;@desc: See [InputEx_VKeyDown].
Return InputEx_VKeyDown(InputEx_VSCAsVK(ScanCode))
End Function
Function InputEx_KeyHitEx(ScanCode)
;@desc: See [InputEx_VKeyHitEx].
Return InputEx_VKeyHitEx(InputEx_VSCAsVK(ScanCode))
End Function
Function InputEx_KeyHit(ScanCode)
;@desc: See [InputEx_VKeyHit].
Return InputEx_VKeyHit(InputEx_VSCAsVK(ScanCode))
End Function
Function InputEx_MouseTime(Button)
;@desc: See [InputEx_VKeyTime].
Select Button
Case 1,2
Return InputEx_VKeyTime(Button)
Case 3,4,5
Return InputEx_VKeyTime(Button+1)
End Select
End Function
Function InputEx_MouseDownEx(Button)
;@desc: See [InputEx_VKeyDownEx].
Select Button
Case 1,2
Return InputEx_VKeyDownEx(Button)
Case 3,4,5
Return InputEx_VKeyDownEx(Button+1)
End Select
End Function
Function InputEx_MouseDown(Button)
;@desc: See [InputEx_VKeyDown].
Select Button
Case 1,2
Return InputEx_VKeyDown(Button)
Case 3,4,5
Return InputEx_VKeyDown(Button+1)
End Select
End Function
Function InputEx_MouseHitEx(Button)
;@desc: See [InputEx_VKeyHitEx].
Select Button
Case 1,2
Return InputEx_VKeyHitEx(Button)
Case 3,4,5
Return InputEx_VKeyHitEx(Button+1)
End Select
End Function
Function InputEx_MouseHit(Button)
;@desc: See [InputEx_VKeyHit].
Select Button
Case 1,2
Return InputEx_VKeyHit(Button)
Case 3,4,5
Return InputEx_VKeyHit(Button+1)
End Select
End Function
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Helper Functions for ease of use.
;----------------------------------------------------------------
Function MouseTime(Button)
Return InputEx_MouseTime(Button)
End Function
Function MouseDownEx(Button)
Return InputEx_MouseDownEx(Button)
End Function
Function MouseDown(Button)
Return InputEx_MouseDown(Button)
End Function
Function MouseHitEx(Button)
Return InputEx_MouseHitEx(Button)
End Function
Function MouseHit(Button)
Return InputEx_MouseHit(Button)
End Function
Function KeyTime(Key)
Return InputEx_KeyTime(Key)
End Function
Function KeyDownEx(Key)
Return InputEx_KeyHitEx(Key)
End Function
Function KeyDown(Key)
Return InputEx_KeyDown(Key)
End Function
Function KeyHitEx(Key)
Return InputEx_KeyHitEx(Key)
End Function
Function KeyHit(Key)
Return InputEx_KeyHit(Key)
End Function
;----------------------------------------------------------------
;----------------------------------------------------------------
;-- Example
;----------------------------------------------------------------
;Graphics 400,300,32,2
;SetBuffer BackBuffer()
;User32_ShowWindow(SystemProperty("AppHWND"), 1)
;
;Local Behaviour
;
;InputEx_Init()
;While Not KeyDown(1)
; InputEx_Update()
;
; Cls
;
; If KeyHit(2) Then Behaviour = 0
; If KeyHit(3) Then Behaviour = 1
;
; Select Behaviour
; Case 0
; Color 255,204,204
; Text 0, 0,"Behaviour: Normal (Press 2 to change to 'Extended')"
; Text 0,15,"Mouse L: "+MouseDown(1)+" "+MouseTime(1)
; Text 0,30,"Mouse R: "+MouseDown(2)+" "+MouseTime(2)
; Text 0,45,"Mouse M: "+MouseDown(3)+" "+MouseTime(3)
; Text 0,60,"Mouse X1: "+MouseDown(4)+" "+MouseTime(4)
; Text 0,75,"Mouse X2: "+MouseDown(5)+" "+MouseTime(5)
; Case 1
; Color 204,204,255
; Text 0, 0,"Behaviour: Extended (Press 1 to change to 'Normal')"
; Text 0,15,"Mouse L: "+MouseDownEx(1)+" "+MouseTime(1)
; Text 0,30,"Mouse R: "+MouseDownEx(2)+" "+MouseTime(2)
; Text 0,45,"Mouse M: "+MouseDownEx(3)+" "+MouseTime(3)
; Text 0,60,"Mouse X1: "+MouseDownEx(4)+" "+MouseTime(4)
; Text 0,75,"Mouse X2: "+MouseDownEx(5)+" "+MouseTime(5)
; End Select
;
; Flip
;Wend
;
;End
;----------------------------------------------------------------
;~IDEal Editor Parameters:
;~C#Blitz3D
BlitzBasic/Userlib/InputEx/InputEx.decls
+32
View File
@@ -0,0 +1,32 @@
.lib "User32.dll"
User32_FindWindow%(class$, title$):"FindWindowA"
User32_GetActiveWindow%():"GetActiveWindow"
User32_GetCursorPosition%(point*):"GetCursorPos"
User32_ScreenToClient%(hwnd%, point*):"ScreenToClient"
User32_MapVirtualKeyEx%(code%, mapType%, dwhkl%):"MapVirtualKeyExA"
User32_GetAsyncKeyState%(vkey%):"GetAsyncKeyState"
.lib " "
InputEx_Init()
InputEx_Update()
InputEx_VKeyTime%(VirtualKey%)
InputEx_VKeyDownEx%(VirtualKey%)
InputEx_VKeyDown%(VirtualKey%)
InputEx_VKeyHitEx%(VirtualKey%)
InputEx_VKeyHit%(VirtualKey%)
InputEx_KeyTime%(ScanCode%)
InputEx_KeyDownEx%(ScanCode%)
InputEx_KeyDown%(ScanCode%)
InputEx_KeyHitEx%(ScanCode%)
InputEx_KeyHit%(ScanCode%)
InputEx_MouseTime%(Button%)
InputEx_MouseDownEx%(Button%)
InputEx_MouseDown%(Button%)
InputEx_MouseHitEx%(Button%)
InputEx_MouseHit%(Button%)
KeyTime%(Key%)
KeyDownEx%(Key%)
KeyHitEx%(Key%)
MouseTime%(Button%)
MouseDownEx%(Button%)
MouseHitEx%(Button%)
BlitzBasic/Userlib/InputEx/README.md
+9
View File
@@ -0,0 +1,9 @@
InputEx
=======================
You know what is great to do? Extend the functionality of a shitty language! This userlibrary adds the ability to use the entire keyboard and mouse buttons, even allowing you to read the time of access, how long it's been active etc. Only downside is that it relies on GetAsyncKeyState.
Documentation at: http://www.blitzforum.de/forum/viewtopic.php?p=405648#405648
License
=======
BlitzUtility by Michael Fabian Dirks is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/.