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
.gitignore
View File
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/.
BlitzMax/.gitignore
+6
View File
@@ -0,0 +1,6 @@
# Binary Files
*.o
*.a
*.exe
*/.bmx
*/.indevIDE
BlitzMax/Sirius Online Launcher/#Old/FileHash.bmx
+124
View File
@@ -0,0 +1,124 @@
Strict
Import BRL.Stream
Import BRL.Retro
Function FileMD5$(filePath$, bufferSize=$400000)
Assert (bufferSize & 63) = 0 Else "bufferSize must be a multiple of 64 bytes"
Local h0 = $67452301, h1 = $EFCDAB89, h2 = $98BADCFE, h3 = $10325476
Local r[] = [7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22,..
5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20,..
4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23,..
6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21]
Local k[] = [$D76AA478, $E8C7B756, $242070DB, $C1BDCEEE, $F57C0FAF, $4787C62A,..
$A8304613, $FD469501, $698098D8, $8B44F7AF, $FFFF5BB1, $895CD7BE,..
$6B901122, $FD987193, $A679438E, $49B40821, $F61E2562, $C040B340,..
$265E5A51, $E9B6C7AA, $D62F105D, $02441453, $D8A1E681, $E7D3FBC8,..
$21E1CDE6, $C33707D6, $F4D50D87, $455A14ED, $A9E3E905, $FCEFA3F8,..
$676F02D9, $8D2A4C8A, $FFFA3942, $8771F681, $6D9D6122, $FDE5380C,..
$A4BEEA44, $4BDECFA9, $F6BB4B60, $BEBFBC70, $289B7EC6, $EAA127FA,..
$D4EF3085, $04881D05, $D9D4D039, $E6DB99E5, $1FA27CF8, $C4AC5665,..
$F4292244, $432AFF97, $AB9423A7, $FC93A039, $655B59C3, $8F0CCC92,..
$FFEFF47D, $85845DD1, $6FA87E4F, $FE2CE6E0, $A3014314, $4E0811A1,..
$F7537E82, $BD3AF235, $2AD7D2BB, $EB86D391]
Local fileStream:TStream = OpenStream(filePath$, True, False)
If fileStream = Null Then Return
Local buffer:Byte Ptr = MemAlloc(bufferSize)
Local bitCount:Long, dataTop = bufferSize
Repeat
Local bytesRead = fileStream.Read(buffer, bufferSize)
If fileStream.EOF()
dataTop = (((bytesRead + 8) Shr 6) + 1) Shl 6
If dataTop > bufferSize
buffer = MemExtend(buffer, bufferSize, dataTop)
EndIf
bitCount :+ (bytesRead Shl 3)
For Local b = (bytesRead + 1) Until (dataTop - 8)
buffer[b] = 0
Next
buffer[bytesRead] = $80
LEPokeLong(buffer, dataTop - 8, bitCount)
Else
bitCount :+ (bufferSize Shl 3)
EndIf
For Local chunkStart=0 Until (dataTop Shr 2) Step 16
Local a = h0, b = h1, c = h2, d = h3
For Local i=0 To 15
Local f = d ~ (b & (c ~ d))
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + LEPeekInt(buffer, (chunkStart + i) Shl 2)), r[i]) + b
a = t
Next
For Local i=16 To 31
Local f = c ~ (d & (b ~ c))
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + LEPeekInt(buffer, (chunkStart + (((5 * i) + 1) & 15)) Shl 2)), r[i]) + b
a = t
Next
For Local i=32 To 47
Local f = b ~ c ~ d
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + LEPeekInt(buffer, (chunkStart + (((3 * i) + 5) & 15)) Shl 2)), r[i]) + b
a = t
Next
For Local i=48 To 63
Local f = c ~ (b | ~d)
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + LEPeekInt(buffer, (chunkStart + ((7 * i) & 15)) Shl 2)), r[i]) + b
a = t
Next
h0 :+ a ; h1 :+ b
h2 :+ c ; h3 :+ d
Next
Until fileStream.EOF()
fileStream.Close()
MemFree(buffer)
Return (LEHex(h0) + LEHex(h1) + LEHex(h2) + LEHex(h3)).ToLower()
End Function
Function Rol(val, shift)
Return (val Shl shift) | (val Shr (32 - shift))
End Function
Function LEPeekInt(buffer:Byte Ptr, offset)
Return (buffer[offset + 3] Shl 24) | (buffer[offset + 2] Shl 16) | ..
(buffer[offset + 1] Shl 8) | buffer[offset]
End Function
Function LEPokeLong(buffer:Byte Ptr, offset, value:Long)
For Local b=7 To 0 Step -1
buffer[offset + b] = (value Shr (b Shl 3)) & $ff
Next
End Function
Function LEHex$(val)
Local out$ = Hex(val)
Return out$[6..8] + out$[4..6] + out$[2..4] + out$[0..2]
End Function
BlitzMax/Sirius Online Launcher/#Old/Patcher.old.bmx
+197
View File
@@ -0,0 +1,197 @@
'Function DebugProgressCB:Int(data:Object,dltotal:Double,dlnow:Double,ultotal:Double,ulnow:Double)
' DebugLog "dltotal="+Int(dltotal)+",dlnow="+Int(dlnow)+",ultotal="+Int(ultotal)+",ulnow="+Int(ulnow)
'EndFunction
Rem
Type TTaskPatchCheck Extends TTaskPatch
Field m_stFile:String
Field m_stHash:String
Field l_bValid:Byte = True
Method Run()
' Retrieve Hash
Local stHash:String = FileMD5(m_stFile).ToUpper();l_fProgress = 0.5
' Compare Hash
If stHash <> m_stHash Then
l_bValid = False
oPatchListMutex.Lock()
oPatchList.AddLast(m_stFile)
oPatchListMutex.Unlock()
EndIf
l_fProgress = 1.0
EndMethod
Function Create:TTask(File:String, Hash:String)
Local oTask:TTaskPatchCheck = New TTaskPatchCheck
oTask.m_stFile = File
oTask.m_stHash = Hash
Return oTask
EndFunction
EndType
Type TTaskPatchFile Extends TTaskPatch
Field m_stFile:String
Method Run()
Local oCurl:TCurlEasy = New TCurlEasy
oCurl.setOptInt(CURLOPT_FOLLOWLOCATION, 1)
oCurl.setOptString(CURLOPT_USERAGENT, "Sirius Online Launcher")
oCurl.setOptString(CURLOPT_REFERER, TPatcher_Server)
oCurl.setOptString(CURLOPT_URL, TPatcher_Server + m_stFile)
oCurl.setWriteString()
EndMethod
Function Create:TTask(File:String)
Local oTask:TTaskPatchFile = New TTaskPatchFile
oTask.m_stFile = File
Return oTask
EndFunction
EndType
Rem
Import BRL.LinkedList
Const TPatcher_MaxParallelTasks:Int = 4
Const TPatcher_Server:String = "http://sirius-online.us.to/patch/"
Type TPatcher
' TCurlMulti Instance for non-blocking IO.
Field oCurlMulti:TCurlMulti = TCurlMulti.Create()
' List of available tasks and active tasks.
Field oTasks:TList = (New TList)
Field oTaskSlots:TTaskSlot[] = New TTaskSlot[TPatcher_MaxParallelTasks]
Field oTasksDone:TList = (New TList)
Method New()
For Local i:Int = 0 Until TPatcher_MaxParallelTasks
oTaskSlots[i].oCurl = oCurlMulti.newEasy()
next
oTasks.AddLast(TTask_PatchInfo.Create())
EndMethod
' Main loop for TPatcher
Method Perform()
Local runningHandles:Int
If oTaskSlots[0].oTask <> Null or oTaskSlots[1].oTask <> Null or oTaskSlots[2].oTask <> Null or oTaskSlots[3].oTask <> Null Then
Local iResult:Int = CURLM_OK
Repeat
iResult = oCurlMulti.multiPerform(runningHandles)
For Local slot:Int = 0 Until TPatcher_MaxParallelTasks
If oTaskSlots[slot].oTask = Null And oTasks.Count() > 0 Then
oTaskSlots[slot].oTask = TTask(oTasks.RemoveLast())
oTaskSlots[slot].oTask.Initialize(Self, oTaskSlots[slot].oCurl)
ElseIf oTaskSlots[slot].oTask <> Null Then
If oTaskSlots[slot].oTask.bComplete = True Then
oTasksDone.AddLast(oTaskSlots[slot].oTask)
oTaskSlots[slot].oTask = Null
' Restore TCurlEasy to useable state.
oCurlMulti.multiRemove(oTaskSlots[slot].oCurl)
oTaskSlots[slot].oCurl.cleanup()
oCurlMulti.multiAdd(oTaskSlots[slot].oCurl)
EndIf
Endif
Next
Until iResult <> CURLM_CALL_MULTI_PERFORM
Else
oCurlMulti.cleanup()
EndIf
EndMethod
EndType
Type TTaskSlot
Field oTask:TTask
Field oCurl:TCurlEasy
EndType
Type TTask Abstract
Field oPatcher:TPatcher = Null
Field stName:String = "Unknown"
Field bComplete:Byte = False
Field fProgress:Float = 0.0
Method Initialize(oPatcher:TPatcher, oCurl:TCurlEasy)
Self.oPatcher = oPatcher
oCurl.setWriteCallback(_HandleWriteCallback, Self)
oCurl.setProgressCallback(_HandleProgressCallback, Self)
EndMethod
Method HandleProgressCallback:Int(dltotal:Double, dlnow:Double, ultotal:Double, ulnow:Double)
fProgress = dlnow / dltotal
If dlnow = dltotal Then bComplete = True
EndMethod
Method HandleWriteCallback:Int(buffer:Byte Ptr, size:Int)
EndMethod
Function _HandleProgressCallback:Int(Data:Object, dltotal:Double, dlnow:Double, ultotal:Double, ulnow:Double)
Local Task:TTask = TTask(Data)
Return Task.HandleProgressCallback(dltotal, dlnow, ultotal, ulnow)
EndFunction
Function _HandleWriteCallback(buffer:Byte Ptr, size:Int, Data:Object)
Local Task:TTask = TTask(Data)
Return Task.HandleWriteCallback(buffer, size)
EndFunction
EndType
Type TTask_PatchInfo Extends TTask
Method New()
Self.stName = "Retrieving Patch Information"
EndMethod
Method Initialize(oPatcher:TPatcher, oCurl:TCurlEasy)
Super.Initialize(oPatcher, oCurl)
oCurl.setOptInt(CURLOPT_FOLLOWLOCATION, 1)
oCurl.setOptString(CURLOPT_USERAGENT, "Sirius Online Launcher")
oCurl.setOptString(CURLOPT_REFERER, TPatcher_Server)
oCurl.setOptString(CURLOPT_URL, TPatcher_Server + "info")
oCurl.setWriteString()
EndMethod
Method HandleProgressCallback:Int(dltotal:Double, dlnow:Double, ultotal:Double, ulnow:Double)
Super.HandleProgressCallback()
If bComplete = True Then
EndIf
EndMethod
Function Create:TTask()
Return (New TTask_PatchInfo)
EndFunction
EndType
Type TTask_File Extends TTask
Field stHash:String
Field stFile:String
Method Initialize(oPatcher:TPatcher, oCurl:TCurlEasy)
Super.Initialize(oPatcher, oCurl)
oCurl.setOptInt(CURLOPT_FOLLOWLOCATION, 1)
oCurl.setOptString(CURLOPT_USERAGENT, "Sirius Online Launcher")
oCurl.setOptString(CURLOPT_REFERER, TPatcher_Server + "info")
'Local oFileStream:TStream =
oCurl.setWriteString()
EndMethod
Method HandleProgressCallback:Int(dltotal:Double, dlnow:Double, ultotal:Double, ulnow:Double)
Super.HandleProgressCallback()
EndMethod
Function Create:TTask(File:String, Hash:String)
Local oTask:TTask_File = New TTask_File
oTask.stHash = Hash
oTask.stFile = File
oCurl.setOptString(CURLOPT_URL, TPatcher_Server + oTask.File)
Return oTask
EndFunction
EndType
EndRem
BlitzMax/Sirius Online Launcher/#Old/ThreadPool.bmx
+242
View File
@@ -0,0 +1,242 @@
SuperStrict
Import BRL.Threads
Import BRL.LinkedList
Import BRL.StandardIO
Const DEF_THREADPOOL_MINTHREADS:Int = 1
Const DEF_THREADPOOL_MAXTHREADS:Int = 4
Type TThreadPool
' Threads
Field m_oThreads:TList = New TList
Field m_iMinThreads:Int = DEF_THREADPOOL_MINTHREADS
Field m_iMaxThreads:Int = DEF_THREADPOOL_MAXTHREADS
' Task Queue
Field m_oTaskList:TList = New TList
Field m_oTaskMutex:TMutex = TMutex.Create()
' Construction
Function Create:TThreadPool(iMinThreads:Int = DEF_THREADPOOL_MINTHREADS, iMaxThreads:Int = DEF_THREADPOOL_MAXTHREADS)
Local oThreadPool:TThreadPool = New TThreadPool
oThreadPool.SetLimits(iMinThreads, iMaxThreads)
Return oThreadPool
EndFunction
' Destruction
Method Destroy()
For Local oThreadWorker:TThreadWorker = EachIn m_oThreads
oThreadWorker.ForceDestroy()
Next
m_oThreads.Clear()
m_oTaskList.Clear()
EndMethod
' Change the thread limits, for example when the game configuration changes. Effective immediately or after
Method SetLimits(iMinThreads:Int = DEF_THREADPOOL_MINTHREADS, iMaxThreads:Int = DEF_THREADPOOL_MAXTHREADS)
m_iMinThreads = iMinThreads
If (iMaxThreads < iMinThreads) Then iMaxThreads = iMinThreads
m_iMaxThreads = iMaxThreads
EndMethod
' Add new Task to the queue.
Method AddTask(oTask:TTask)
m_oTaskMutex.Lock()
m_oTaskList.AddLast(oTask)
m_oTaskMutex.Unlock()
EndMethod
' Distributes work across threads, destroys and spawns threads
Method Update:Int()
Local iThreadCount:Int = m_oThreads.Count()
' Spawn more Threads if we don't have at least m_iMinThreads
If iThreadCount < m_iMinThreads Then
Local iSpawnCount:Int = m_iMinThreads - iThreadCount
For Local spawn:Int = 1 To iSpawnCount
m_oThreads.AddLast(New TThreadWorker)
iThreadCount :+ 1
Next
EndIf
For Local oThreadWorker:TThreadWorker = EachIn m_oThreads
' Loosely enforce m_iMaxThreads by destroying unused Threads.
If iThreadCount > m_iMaxThreads And oThreadWorker.m_oAvailable.TryLock() = True Then
If oThreadWorker.m_oTask = Null Then
oThreadWorker.m_oAvailable.Unlock()
oThreadWorker.Destroy()
m_oThreads.Remove(oThreadWorker)
iThreadCount :- 1
Exit
EndIf
EndIf
' Distribute available work.
m_oTaskMutex.Lock()
If m_oTaskList.Count() > 0 And oThreadWorker.m_oAvailable.TryLock() = True Then
oThreadWorker.m_oAvailable.Unlock()
Local oTask:TTask = TTask(m_oTaskList.RemoveFirst())
If oThreadWorker.AssignTask(oTask) = False Then m_oTaskList.AddLast(oTask)
EndIf
m_oTaskMutex.Unlock()
' Destroy Threads that have been waiting too long on Work, given that they are unneeded.
If iThreadCount > m_iMinThreads And oThreadWorker.m_oAvailable.TryLock() = True Then
oThreadWorker.m_oAvailable.Unlock()
If oThreadWorker.m_oTask = Null And (MilliSecs() - oThreadWorker.m_lTaskTime) > 5000 Then
m_oThreads.Remove(oThreadWorker)
oThreadWorker.Destroy()
iThreadCount :- 1
EndIf
EndIf
Next
' Spawn more Threads if we did not hit m_iMaxThreads and there is still work left.
m_oTaskMutex.Lock()
If m_oTaskList.Count() > 0 And iThreadCount < m_iMaxThreads Then
Local iSpawnCount:Int = Min(m_oTaskList.Count(), m_iMaxThreads - iThreadCount)
For Local spawn:Int = 1 To iSpawnCount
m_oThreads.AddLast(New TThreadWorker)
iThreadCount :+ 1
Next
EndIf
m_oTaskMutex.Unlock()
Return iThreadCount
EndMethod
Method CountTasks:Int()
Local retVal:Int = 0
m_oTaskMutex.Lock()
retVal = m_oTaskList.Count()
m_oTaskMutex.Unlock()
Return retVal
EndMethod
Method CountActiveTasks:Int()
Local retVal:Int = 0
For Local oThreadWorker:TThreadWorker = EachIn m_oThreads
oThreadWorker.m_oAvailable.Lock()
If oThreadWorker.m_oTask <> Null Then retVal :+ 1
oThreadWorker.m_oAvailable.Unlock()
Next
Return retVal
EndMethod
EndType
Type TThreadWorker
Field m_oThread:TThread
' Used to make the Thread sleep and work.
Field m_oAvailable:TMutex
Field m_oCondVar:TCondVar
' Contains Task and the time it was assigned at.
Field m_oTask:TTask
Field m_lTaskTime:Long
Field d_iCount:Int
' Construction
Method New()
m_oAvailable = TMutex.Create()
m_oCondVar = TCondVar.Create()
m_oThread = TThread.Create(Execute, Self)
m_lTaskTime = MilliSecs()
EndMethod
' Destruction
Method Destroy()
While AssignTask(oTaskTerminate) = False
Delay 10
Wend
m_oThread.Wait() 'broken?
m_oThread.Detach()
EndMethod
Method ForceDestroy()
m_oThread.Detach()
EndMethod
' Task Management
Method AssignTask:Int(oTask:TTask)
If m_oAvailable.TryLock() = True And m_oTask = Null Then
m_oTask = oTask
m_lTaskTime = MilliSecs()
m_oAvailable.Unlock()
m_oCondVar.Signal()
Return True
EndIf
Return False
EndMethod
' Thread Wrapper Function
Function Execute:Object(Data:Object)
Local oThreadWorker:TThreadWorker = TThreadWorker(Data)
Local oTask:TTask = Null
oThreadWorker.m_oAvailable.Lock()
Repeat
oThreadWorker.m_oCondVar.Wait(oThreadWorker.m_oAvailable)
If oThreadWorker.m_oTask <> Null Then
oThreadWorker.d_iCount :+ 1
oTask = oThreadWorker.m_oTask
oThreadWorker.m_oAvailable.Unlock()
oTask.Run()
oThreadWorker.m_oAvailable.Lock()
oThreadWorker.m_oTask = Null
EndIf
Until oTask = oTaskTerminate
oThreadWorker.m_oAvailable.Unlock()
EndFunction
EndType
Type TTask Abstract
' Called when a thread is working on this item.
Method Run()
EndMethod
EndType
Type TTaskTerminate Extends TTask
EndType
Global oTaskTerminate:TTask = New TTaskTerminate
Type TTaskPtr Extends TTask
Field m_pFunc:Object(data:Object)
Field m_pData:Object
Field m_pReturn:Object
' Construction
Function Create:TTask(pFunc:Object(data:Object), pData:Object)
Local oTWPtr:TTaskPtr = New TTaskPtr
oTWPtr.SetFunction(pFunc)
oTWPtr.SetData(pData)
Return oTWPtr
EndFunction
' Called when a thread is working on this item.
Method Run()
m_pReturn = m_pFunc(m_pData)
EndMethod
' Set the Function executed by Run()
Method SetFunction(pFunc:Object(data:Object))
m_pFunc = pFunc
EndMethod
' Set the Data passed to the Function.
Method SetData(pData:Object)
m_pData = pData
EndMethod
' Retrieve the return value of the executed Function
Method GetReturn:Object()
Return m_pReturn
EndMethod
EndType
Global PrintMutex:TMutex = TMutex.Create()
Function _Print(Str:String)
PrintMutex.Lock()
Print(Str)
PrintMutex.Unlock()
EndFunction
BlitzMax/Sirius Online Launcher/Clock.c
+14
View File
@@ -0,0 +1,14 @@
#include <brl.mod/blitz.mod/blitz.h>
#include <time.h>
int getClocksPerSecond_() {
return CLOCKS_PER_SEC;
}
int getClock_() {
return (int)clock();
}
int getClockDiff_(int clockStart, int clockEnd) {
return ((clock_t)clockEnd - (clock_t)clockStart);
}
BlitzMax/Sirius Online Launcher/GFX/FNT/TranscendsGames.otf
BIN
View File
Binary file not shown.
BlitzMax/Sirius Online Launcher/GFX/LNC/BARxPROGRESS.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 817 B

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxACCOUNT.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxCHECK.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxCLOSE.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.2 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxEULATOS.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxPATCH.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxPLAY.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxRESTART.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxSUPPORT.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 56 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/BTNxWEBSITE.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 56 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/GUIxSTYLE.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 85 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/LAUxPATxA.fw.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 160 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/LAUxPATxA.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 30 KiB

BlitzMax/Sirius Online Launcher/GFX/LNC/LAUxPATxB.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 677 KiB

BlitzMax/Sirius Online Launcher/Launcher.bmx
+488
View File
@@ -0,0 +1,488 @@
SuperStrict
' Modules and Includes -----------------------------------------------------------------------------------------------------------------------------------------
Framework BRL.Blitz
Import BRL.StandardIO
Import BRL.Timer
Import BRL.Max2D
Import BRL.GLMax2D
Import BRL.Event
Import BRL.EventQueue
Import PUB.FreeProcess
Import MaxGUI.MaxGUI
Import MaxGUI.Drivers
' Libraries
Import "TGUI.bmx"
Import "Max2DExtended.bmx"
' Resources -----------------------------------------------------------------------------------------------------------------------------------------------------
' Binary Resources
Incbin "GFX/LNC/GUIxSTYLE.png"
Incbin "SFX/M/launcher.ogg"
' Initialization ------------------------------------------------------------------------------------------------------------------------------------------------
SetGraphicsDriver(GLMax2DDriver())
' Create Timers to reduce CPU load.
Global tmrRender:TTimer = CreateTimer(20) ' One for rendering the GUI
Global tmrUpdate:TTimer = CreateTimer(100) ' And one for working.
' Create the Window and Canvas for the Patcher, set the Graphics Driver to OpenGL and enable polled input.
Global gdgPatcher:TGadget = CreateWindow("Sirius Online", 0, 0, 720, 460, Desktop(), WINDOW_CLIENTCOORDS | WINDOW_CENTER | WINDOW_HIDDEN)
Global gdgCanvas:TGadget = CreateCanvas(0, 0, ClientWidth(gdgPatcher), ClientHeight(gdgPatcher), gdgPatcher)
SetGraphics(gdgCanvas) ' Change OpenGL Context to the Canvas.
EnablePolledInput(gdgCanvas) ' Enable input handling for the Canvas.
DebugLog TShader.CheckCompatability()
End
Rem
' Load our GUI Style and split it into the required images.
Global guiStyle:TPixmap = LoadPixmap("GFX/LNC/GUIxSTYLE.png")
If guiStyle = Null Then guiStyle = LoadPixmap("incbin::GFX/LNC/GUIxSTYLE.png")
Global guiWindowBackground:TImage = LoadImage(guiStyle.Window(0, 0, 32, 32), FILTEREDIMAGE)
Global guiWindowShade:TImage[] = New TImage[2]
guiWindowShade[0] = LoadImage(guiStyle.Window(32, 0, 16, 16), FILTEREDIMAGE)
guiWindowShade[1] = LoadImage(guiStyle.Window(32, 16, 16, 16), FILTEREDIMAGE)
Global guiWindowTitleBar:TImage[] = New TImage[2]
guiWindowTitleBar[0] = LoadImage(guiStyle.Window(48, 0, 16, 16), FILTEREDIMAGE)
guiWindowTitleBar[1] = LoadImage(guiStyle.Window(48, 16, 16, 16), FILTEREDIMAGE)
Global guiSymbols:TImage[] = New TImage[8]
guiSymbols[0] = LoadImage(guiStyle.Window(64, 0, 16, 16), FILTEREDIMAGE) 'Close
guiSymbols[1] = LoadImage(guiStyle.Window(80, 0, 16, 16), FILTEREDIMAGE) 'Minimize
guiSymbols[2] = LoadImage(guiStyle.Window(96, 0, 16, 16), FILTEREDIMAGE) 'Maximize
guiSymbols[3] = LoadImage(guiStyle.Window(112, 0, 16, 16), FILTEREDIMAGE) 'Restore
guiSymbols[4] = LoadImage(guiStyle.Window(64, 16, 16, 16), FILTEREDIMAGE)
guiSymbols[5] = LoadImage(guiStyle.Window(80, 16, 16, 16), FILTEREDIMAGE)
guiSymbols[6] = LoadImage(guiStyle.Window(96, 16, 16, 16), FILTEREDIMAGE)
guiSymbols[7] = LoadImage(guiStyle.Window(112, 16, 16, 16), FILTEREDIMAGE)
Global guiButtonNormal:TImage[] = New TImage[3]
guiButtonNormal[0] = LoadImage(guiStyle.Window(0, 32, 16, 16), FILTEREDIMAGE)
guiButtonNormal[1] = LoadImage(guiStyle.Window(0, 48, 16, 16), FILTEREDIMAGE)
guiButtonNormal[2] = LoadImage(guiStyle.Window(0, 64, 16, 16), FILTEREDIMAGE)
Global guiButtonShaped:TImage[] = New TImage[3]
guiButtonShaped[0] = LoadImage(guiStyle.Window(16, 32, 16, 16), FILTEREDIMAGE)
guiButtonShaped[1] = LoadImage(guiStyle.Window(16, 48, 16, 16), FILTEREDIMAGE)
guiButtonShaped[2] = LoadImage(guiStyle.Window(16, 64, 16, 16), FILTEREDIMAGE)
Global guiProgressBar:TImage[] = New TImage[3]
guiProgressBar[0] = LoadImage(guiStyle.Window(16, 80, 16, 16), FILTEREDIMAGE)
guiProgressBar[1] = LoadImage(guiStyle.Window(16, 96, 16, 16), FILTEREDIMAGE)
guiProgressBar[2] = LoadImage(guiStyle.Window(16, 112, 16, 16), FILTEREDIMAGE)
EndRem
' Show the Patcher Window
ShowGadget gdgPatcher
' GUI Values
Const guiTitleHeight:Int = 24
Global guiWidth:Int = ClientWidth(gdgPatcher)
Global guiHeight:Int = ClientHeight(gdgPatcher)
Global guiActive:Int = True
' Main Loop -----------------------------------------------------------------------------------------------------------------------------------------------------
Repeat
WaitEvent()
Select EventSource()
Case tmrRender
SetGraphics CanvasGraphics(gdgCanvas);Cls
Rem
' Draw GUI
SetColor(255, 255, 255); SetAlpha(1.0); SetBlend(SOLIDBLEND); SetScale(1.0, 1.0); SetRotation(0.0)
' Title Bar and Title
DrawTiledImage guiWindowTitleBar[guiActive], 0, 0, guiWidth, guiTitleHeight, 0, 0, 16, 16,,,,4,4,4,4, True, MODE_SCALEUPX | MODE_SCALEUPY
DrawText(GadgetText(gdgPatcher), 4, guiTitleHeight / 2 - (12 / 2))
' Content Background
DrawSubImageRectEx guiWindowBackground, 0, guiTitleHeight, guiWidth, guiHeight - guiTitleHeight, 0, 0, 32, 32,,,, MODE_REPEATX | MODE_REPEATY
SetBlend SHADEBLEND
DrawTiledImage guiContent[guiActive], 0, guiTitleHeight, guiWidth, guiHeight - guiTitleHeight, 0, 0, 16, 16,,,, 4, 4, 4, 4, True, MODE_REPEATX | MODE_REPEATY | MODE_SCALEUPX | MODE_SCALEUPY
EndRem
' Show the now rendered GUI
Flip False
Case gdgPatcher
Select EventID()
Case EVENT_WINDOWMODE, EVENT_WINDOWSIZE
' Update GUI Values {
guiWidth = ClientWidth(gdgPatcher)
guiHeight = ClientWidth(gdgPatcher)
' }
End Select
End Select
Forever
End
Rem
' Files
Import "Patcher.bmx"
'=====> Constants
?Win32
Const LAUNCHER_NAME:String = "Launcher.exe"
?Linux
Const LAUNCHER_NAME:String = "Launcher.bin"
?MacOS
Const LAUNCHER_NAME:String = "Launcher.app"
?
'=====> Parse Arguments
Global stProgram:String = AppArgs[0]
Global stProgramPath:String = ExtractDir(AppArgs[0])
Global stProgramName:String = StripDir(AppArgs[0])
Global bPatchLauncher:Byte = False
Global iPatchRetries:Int = 30
For Local stArgument:String = EachIn AppArgs[1..]
Local stArgName:String, stArgValue:String
' Skip arguments not starting with a dash
If stArgument[0..1] <> "-" Then Continue
Local iValuePos:Int = stArgument.Find("=")
If iValuePos >= 0 Then
stArgName = stArgument[1..iValuePos]
stArgValue = stArgument[iValuePos..]
Else
stArgName = stArgument[1..]
stArgValue = "1"
EndIf
Select stArgName
Case "patch"
bPatchLauncher = Byte(stArgValue)
Case "retry"
iPatchRetries = Int(stArgValue)
End Select
Next
'=====> Use parsed Arguments
'--> Patch the Launcher
If bPatchLauncher = True Then
Local iRetryCount:Int = 0
Local oRetryTimer:TTimer = TTimer.Create(10)
' Copy the newly downloaded Launcher file
If stProgramName <> LAUNCHER_NAME Then
If FileType(LAUNCHER_NAME) = FILETYPE_FILE Then
Repeat
oRetryTimer.Wait()
iRetryCount :+ 1
Until (DeleteFile(LAUNCHER_NAME) = True) or (iRetryCount > iPatchRetries)
EndIf
If FileType(LAUNCHER_NAME) = 0 Then
Repeat
oRetryTimer.Wait()
iRetryCount :+ 1
Until (CopyFile(stProgramName, LAUNCHER_NAME) = True) or (iRetryCount > iPatchRetries)
If FileType(LAUNCHER_NAME) = FILETYPE_FILE Then
Local oProcess:TProcess = CreateProcess(LAUNCHER_NAME)
TProcess.ProcessList.Remove oProcess
End
Else
Notify("Error: Failed to replace Launcher", True)
End
EndIf
Else
Notify("Error: Failed to delete old Launcher", True)
End
EndIf
EndIf
EndIf
' Resources: Create Variables that store resources.
Global riMainBackground:Int, imMainBackground:TImage;LoadResource("GFX/LNC/LAUxPATxB.png",, imMainBackground, riMainBackground)
Global riMainForeground:Int, imMainForeground:TImage;LoadResource("GFX/LNC/LAUxPATxA.png",, imMainForeground, riMainForeground)
Global riProgressBar:Int, imProgressBar:TImage; LoadResource("GFX/LNC/BARxPROGRESS.png",, imProgressBar, riProgressBar)
Global riButtonClose:Int, imButtonClose:TImage; LoadResource("GFX/LNC/BTNxCLOSE.png",, imButtonClose, riButtonClose)
Global riButtonAccount:Int, imButtonAccount:TImage; LoadResource("GFX/LNC/BTNxACCOUNT.png",, imButtonAccount, riButtonAccount)
Global riButtonWebsite:Int, imButtonWebsite:TImage; LoadResource("GFX/LNC/BTNxWEBSITE.png",, imButtonWebsite, riButtonWebsite)
Global riButtonSupport:Int, imButtonSupport:TImage; LoadResource("GFX/LNC/BTNxSUPPORT.png",, imButtonSupport, riButtonSupport)
Global riButtonEULATOS:Int, imButtonEULATOS:TImage; LoadResource("GFX/LNC/BTNxEULATOS.png",, imButtonEULATOS, riButtonEULATOS)
Global riButtonCheck:Int, imButtonCheck:TImage; LoadResource("GFX/LNC/BTNxCHECK.png",, imButtonCheck, riButtonCheck)
Global riButtonPatch:Int, imButtonPatch:TImage; LoadResource("GFX/LNC/BTNxPATCH.png",, imButtonPatch, riButtonPatch)
Global riButtonPlay:Int, imButtonPlay:TImage; LoadResource("GFX/LNC/BTNxPLAY.png",, imButtonPlay, riButtonPlay)
Global riButtonRestart:Int, imButtonRestart:TImage; LoadResource("GFX/LNC/BTNxRESTART.png",, imButtonRestart, riButtonRestart)
Global rfSmallFont:Int, fnSmallFont:TImageFont; LoadFontResource("GFX/FNT/TranscencsGames.otf", 10,, fnSmallFont, rfSmallFont)
Global rfMediumFont:Int, fnMediumFont:TImageFont;LoadFontResource("GFX/FNT/TranscencsGames.otf", 12,, fnMediumFont, rfMediumFont)
Global rfBigFont:Int, fnBigFont:TImageFont; LoadFontResource("GFX/FNT/TranscencsGames.otf", 14,, fnBigFont, rfBigFont)
' Buttons
Const BTN_STT_NORMAL:Int = 0, BTN_STT_HOVER:Int = 1, BTN_STT_DOWN:Int = 2, BTN_STT_ACTION:Int = 3
Global stButtonClose:Int = BTN_STT_NORMAL
Global stButtonAccount:Int = BTN_STT_NORMAL
Global stButtonWebsite:Int = BTN_STT_NORMAL
Global stButtonSupport:Int = BTN_STT_NORMAL
Global stButtonEULATOS:Int = BTN_STT_NORMAL
Global stButtonCheck:Int = BTN_STT_NORMAL
Global stButtonPatch:Int = BTN_STT_NORMAL
Global stButtonPlay:Int = BTN_STT_NORMAL
Global stButtonRestart:Int = BTN_STT_NORMAL
' PatchLog
Global oPatchLog:TList = New TList
' Patcher
Global oPatcher:TPatcher = TPatcher.Create()
ShowGadget(gdPatcherWindow)
EndRem
Rem
'=====> Mainloop
Local relMouseX:Int, relMouseY:Int, bDragging:Byte
Repeat
WaitEvent()
Select EventSource()
Case tmTimer ' Core timer that is basically our main loop.
'=====> User-input
Local MX:Int = MouseX(), MY:Int = MouseY()
Local MD1:Int = MouseDown(1), MH1:Int = MouseHit(1)
stButtonClose = GetButtonState(stButtonClose, 684, 0, 24, 18, MX, MY, MD1)
stButtonWebsite = GetButtonState(stButtonWebsite, 618, 330, 96, 16, MX, MY, MD1)
stButtonSupport = GetButtonState(stButtonSupport, 618, 348, 96, 16, MX, MY, MD1)
stButtonAccount = GetButtonState(stButtonAccount, 618, 366, 96, 16, MX, MY, MD1)
stButtonEULATOS = GetButtonState(stButtonEULATOS, 618, 384, 96, 16, MX, MY, MD1)
' React on the close button by sending a WindowCloseEvent
If stButtonClose = BTN_STT_ACTION Then PostEvent(TEvent.Create(EVENT_WINDOWCLOSE, gdPatcherWindow, 0, 0, 0, 0, Null))
If stButtonWebsite = BTN_STT_ACTION Then OpenURL("http://www.sirius.vektor-studios.com/")
If stButtonSupport = BTN_STT_ACTION Then OpenURL("http://www.sirius.vektor-studios.com/#contact")
If stButtonAccount = BTN_STT_ACTION Then OpenURL("http://www.sirius.vektor-studios.com/")
If stButtonEULATOS = BTN_STT_ACTION Then OpenURL("http://www.sirius.vektor-studios.com/")
' State based checking
Select oPatcher.GetState()
Case TPatcher.STATE_PATCHINFO
stButtonCheck = GetButtonState(stButtonCheck, 312, 441, 96, 16, MX, MY, MD1)
If stButtonCheck = BTN_STT_ACTION Then oPatcher.Advance()
Case TPatcher.STATE_PREPATCH
stButtonPatch = GetButtonState(stButtonPatch, 312, 441, 96, 16, MX, MY, MD1)
If stButtonPatch = BTN_STT_ACTION Then oPatcher.Advance()
Case TPatcher.STATE_COMPLETE
stButtonPlay = GetButtonState(stButtonPlay, 312, 441, 96, 16, MX, MY, MD1)
If stButtonPlay = BTN_STT_ACTION Then oPatcher.Advance()
Case TPatcher.STATE_LAUNCHER
stButtonRestart = GetButtonState(stButtonRestart, 312, 441, 96, 16, MX, MY, MD1)
If stButtonRestart = BTN_STT_ACTION Then oPatcher.Advance()
EndSelect
' Window Dragging
If bDragging = False And (MH1 = True And (MY >= 0 And MY < 32) And (MX >= 0 And MX < 720)) Then
bDragging = True
relMouseX = MX;relMouseY = MY
ElseIf bDragging = True And MD1 = True Then
SetGadgetShape(gdPatcherWindow, GadgetX(gdPatcherWindow) - (relMouseX - MX), GadgetY(gdPatcherWindow) - (relMouseY - MY), 720, 460)
relMouseX = MX + (relMouseX - MX);relMouseY = MY + (relMouseY - MY) 'Magic o.o - I don't understand why this works this way, but not when using :+ notation.
Else
bDragging = False
EndIf
'=====> Rendering
SetGraphics CanvasGraphics(gdRenderCanvas)
Cls
' Draw Back- & Foreground
SetBlend ALPHABLEND;SetMaskColor 0, 0, 0
SetColor 255, 255, 255;SetAlpha 1.0
SetOrigin 0, 0;SetTransform 0, 1, 1
If imMainBackground <> Null Then DrawImage(imMainBackground, 0, 0)
If imMainForeground <> Null Then DrawImage(imMainForeground, 0, 0)
' Window Close Button
DrawButtonState(stButtonClose, 684, 0, 24, 18, imButtonClose, "X")
' Buttons
DrawButtonState(stButtonWebsite, 618, 330, 96, 16, imButtonWebsite, "Website")
DrawButtonState(stButtonSupport, 618, 348, 96, 16, imButtonSupport, "Support")
DrawButtonState(stButtonAccount, 618, 366, 96, 16, imButtonAccount, "Account")
DrawButtonState(stButtonEULATOS, 618, 384, 96, 16, imButtonEULATOS, "EULA/TOS")
' State based drawing.
Select oPatcher.GetState()
Case TPatcher.STATE_PATCHINFO
DrawButtonState(stButtonCheck, 312, 441, 96, 16, imButtonCheck, "Check")
Case TPatcher.STATE_PREPATCH
DrawButtonState(stButtonPatch, 312, 441, 96, 16, imButtonPatch, "Patch")
Case TPatcher.STATE_COMPLETE
DrawButtonState(stButtonPlay, 312, 441, 96, 16, imButtonPlay, "Play")
Case TPatcher.STATE_LAUNCHER
DrawButtonState(stButtonRestart, 312, 441, 96, 16, imButtonRestart, "Restart")
Case TPatcher.STATE_PATCHINFO, TPatcher.STATE_CHECKING, TPatcher.STATE_PATCHING
DrawProgressBar(8, 442, 704, 12, oPatcher.GetProgress(), imProgressBar)
EndSelect
' Draw Patcher Tasklog
SetBlend ALPHABLEND;SetMaskColor 0, 0, 0
SetColor 255, 255, 255;SetAlpha 0.66;SetImageFont fnSmallFont
SetOrigin 0, 0;SetTransform 0, 1, 1
SetViewport 11, 332, 600, 100
Local iLogNum:Int = 1, oLogEntry:TLink = oPatcher.m_oTaskList.FirstLink()
While (iLogNum < 9) And (oLogEntry <> Null)
Local stLine:String = String(oLogEntry.Value())
If stLine[0..1] = "n" Then SetColor 204, 244, 255
If stLine[0..1] = "e" Then SetColor 255, 222, 204
If stLine[0..1] = "g" Then SetColor 204, 255, 204
If stLine[0..1] = "h" Then SetColor 222, 222, 255
DrawText stLine[1..], 11, 430 - iLogNum * 12
oLogEntry = oLogEntry.NextLink()
iLogNum :+ 1
Wend
SetViewport 0, 0, 720, 460; SetColor 255,255,255; SetImageFont Null
Flip False
Case tmPatch
'=====> Patcher
oPatcher.Update()
If oPatcher.GetShutdown() <> Null Then
Local oProcess:TProcess = CreateProcess(oPatcher.GetShutdown())
TProcess.ProcessList.Remove oProcess
PostEvent(TEvent.Create(EVENT_WINDOWCLOSE, gdPatcherWindow, 0, 0, 684, 0, Null))
EndIf
Case tmResource
LoadResource("GFX/LNC/LAUxPATxB.png",, imMainBackground, riMainBackground)
LoadResource("GFX/LNC/LAUxPATxA.png",, imMainForeground, riMainForeground)
LoadResource("GFX/LNC/BARxPROGRESS.png",, imProgressBar, riProgressBar)
LoadResource("GFX/LNC/BTNxCLOSE.png",, imButtonClose, riButtonClose)
LoadResource("GFX/LNC/BTNxACCOUNT.png",, imButtonAccount, riButtonAccount)
LoadResource("GFX/LNC/BTNxWEBSITE.png",, imButtonWebsite, riButtonWebsite)
LoadResource("GFX/LNC/BTNxSUPPORT.png",, imButtonSupport, riButtonSupport)
LoadResource("GFX/LNC/BTNxEULATOS.png",, imButtonEULATOS, riButtonEULATOS)
LoadResource("GFX/LNC/BTNxCHECK.png",, imButtonCheck, riButtonCheck)
LoadResource("GFX/LNC/BTNxPATCH.png",, imButtonPatch, riButtonPatch)
LoadResource("GFX/LNC/BTNxPLAY.png",, imButtonPlay, riButtonPlay)
LoadFontResource("GFX/FNT/TranscencsGames.otf", 10,, fnSmallFont, rfSmallFont)
LoadFontResource("GFX/FNT/TranscencsGames.otf", 12,, fnMediumFont, rfMediumFont)
LoadFontResource("GFX/FNT/TranscencsGames.otf", 14,, fnBigFont, rfBigFont)
Case gdPatcherWindow
Select EventID()
Case EVENT_WINDOWCLOSE
'=====> End the patcher.
End
End Select
EndSelect
Forever
'=====> Functions
Function PointInsideRect:Byte(PX:Int, PY:Int, RX:Int, RY:Int, RW:Int, RH:Int)
If PX >= RX And PX < RX + RW Then
If PY >= RY And PY < RY + RH Then
Return True
EndIf
EndIf
Return False
EndFunction
Function GetButtonState:Byte(BS:Int, BX:Int, BY:Int, BW:Int, BH:Int, MX:Int, MY:Int, MB:Int)
Local retVal:Int = BS
If PointInsideRect(MX, MY, BX, BY, BW, BH) = True Then
If BS = BTN_STT_NORMAL Then
retVal = BTN_STT_HOVER
ElseIf BS = BTN_STT_HOVER And MB = True Then
retVal = BTN_STT_DOWN
ElseIf BS = BTN_STT_DOWN And MB = False Then
retVal = BTN_STT_ACTION
ElseIf BS = BTN_STT_ACTION Then
retVal = BTN_STT_HOVER
EndIf
Else
retVal = BTN_STT_NORMAL
EndIf
Return retVal
EndFunction
Function DrawBorder(X:Int, Y:Int, W:Int, H:Int)
DrawLine X, Y, X+W, Y
DrawLine X+W, Y, X+W, Y+H
DrawLine X+W, Y+H, X, Y+H
DrawLine X, Y+H, X, Y
EndFunction
Function DrawButtonState(BS:Int, BX:Int, BY:Int, BW:Int, BH:Int, imButton:TImage, Text:String = "")
SetBlend ALPHABLEND; SetAlpha 1.0; SetColor 255, 255, 255
SetTransform 0, 1, 1;SetOrigin 0, 0; SetImageFont Null
Select BS
Case BTN_STT_NORMAL
If imButton <> Null Then
DrawSubImageRect(imButton, BX, BY, BW, BH, 0, 0, BW, BH, 0, 0, 0)
Else
SetColor 0, 0, 0;DrawRect BX, BY, BW, BH
SetColor 255, 255, 255;DrawBorder(BX,BY,BW,BH)
DrawText Text, BX + BW/2 - TextWidth(Text)/2, BY + BH/2 - TextHeight(Text)/2
EndIf
Case BTN_STT_HOVER
If imButton <> Null Then
DrawSubImageRect(imButton, BX, BY, BW, BH, 0, BH, BW, BH, 0, 0, 0)
Else
SetColor 0, 0, 0;DrawRect BX, BY, BW, BH
SetColor 204, 225, 255;DrawBorder(BX,BY,BW,BH)
DrawText Text, BX + BW/2 - TextWidth(Text)/2, BY + BH/2 - TextHeight(Text)/2
EndIf
Case BTN_STT_DOWN, BTN_STT_ACTION
If imButton <> Null Then
DrawSubImageRect(imButton, BX, BY, BW, BH, 0, BH*2, BW, BH, 0, 0, 0)
Else
SetColor 0, 0, 0;DrawRect BX, BY, BW, BH
SetColor 102, 123, 188;DrawBorder(BX,BY,BW,BH)
DrawText Text, BX + BW/2 - TextWidth(Text)/2, BY + BH/2 - TextHeight(Text)/2
EndIf
EndSelect
EndFunction
Function DrawProgressBar(X:Int, Y:Int, W:Int, H:Int, fProgress:Float, imProgressBar:TImage)
SetBlend ALPHABLEND; SetAlpha 1.0; SetColor 255, 255, 255
SetTransform 0, 1, 1;SetOrigin 0, 0
If imProgressBar = Null Then
SetColor 255, 255, 255;DrawBorder(X,Y,W,H)
SetColor 0, 0, 0;DrawRect X+1,Y+1,W-2,H-2
SetColor 204, 225, 255;SetAlpha 0.75 + Sin(MilliSecs()/5) * 0.25;DrawRect X, Y, W * fProgress, H
Else
DrawSubImageRect(imProgressBar, X, Y, W, H, 0, 0, W, H, 0, 0, 0)
SetAlpha 0.75 + Sin(MilliSecs()/5) * 0.25
Local iLength:Int = (W-6) * fProgress
DrawSubImageRect(imProgressBar, X, Y, 3, H, 0, H, 3, H, 0, 0, 0)
DrawSubImageRect(imProgressBar, X+3, Y, iLength, H, 3, H, iLength, H, 0, 0, 0)
DrawSubImageRect(imProgressBar, X+3+iLength, Y, 3, H, W-3, H, 3, H, 0, 0, 0)
EndIf
EndFunction
Function LoadResource(URL:String, Flags:Int = - 1, ImagePtr:TImage Var, InfoPtr:Int Var)
Local iModTime:Int = FileTime(URL)
If iModTime <> InfoPtr Then
ImagePtr = LoadImage(URL, Flags)
InfoPtr = iModTime
EndIf
EndFunction
Function LoadFontResource(URL:String, Size:Int, Style:Int = SMOOTHFONT, FontPtr:TImageFont Var, InfoPtr:Int Var)
Local iModTime:Int = FileTime(URL)
If iModTime <> InfoPtr Then
FontPtr = LoadImageFont(URL, Size, Style)
InfoPtr = iModTime
EndIf
EndFunction
EndRem
BlitzMax/Sirius Online Launcher/Max2DExtended.bmx
+300
View File
@@ -0,0 +1,300 @@
SuperStrict
Import BRL.Max2D
Import BRL.TextStream
Import PUB.OpenGL
Import PUB.Glew
Const MODE_REPEATX:Byte = $00000001 ' Repeat.
Const MODE_REPEATY:Byte = $00000010
Const MODE_MIRRORX:Byte = $00000100 ' Mirror every second repeat.
Const MODE_MIRRORY:Byte = $00001000
Const MODE_SCALEUPX:Byte = $00010000 ' Scale up to fit the destination area if the source doesn't fit exactly in.
Const MODE_SCALEUPY:Byte = $00100000
Const MODE_SCALEDOWNX:Byte = $01000000 ' Similar to MODE_SCALEUP*, except that it scales down to fit.
Const MODE_SCALEDOWNY:Byte = $10000000
Function DrawSubImageRectEx:Int(img:TImage, ..
dstX:Float, dstY:Float, dstW:Float, dstH:Float, ..
srcX:Float, srcY:Float, srcW:Float, srcH:Float, ..
hndX:Float=0, hndY:Float=0, frame:Int=0, bFlags:Byte=0)
Assert img <> Null Else "Image does Not exist"
Local bRepeatX:Byte = ((bFlags & MODE_REPEATX) <> 0)
Local bRepeatY:Byte = ((bFlags & MODE_REPEATY) <> 0)
Local bMirrorX:Byte = ((bFlags & MODE_MIRRORX) <> 0)
Local bMirrorY:Byte = ((bFlags & MODE_MIRRORY) <> 0)
Local bScaleUpX:Byte = ((bFlags & MODE_SCALEUPX) <> 0)
Local bScaleUpY:Byte = ((bFlags & MODE_SCALEUPY) <> 0)
Local bScaleDownX:Byte = ((bFlags & MODE_SCALEDOWNX) <> 0)
Local bScaleDownY:Byte = ((bFlags & MODE_SCALEDOWNY) <> 0)
Local lXRepeat:Float = 1, lXScale:Float = 1
If bRepeatX Then
lXRepeat = dstW / srcW
If bScaleUpX Then
lXRepeat = Floor(lXRepeat)
lXScale = (dstW / srcW) / lXRepeat
ElseIf bScaleDownX Then
lXRepeat = Ceil(lXRepeat)
lXScale = (dstW / srcW) / lXRepeat
EndIf
Else
lXScale = dstW / srcW
EndIf
Local lYRepeat:Float = 1, lYScale:Float = 1
If bRepeatY Then
lYRepeat = dstH / srcH
If bScaleUpY Then
lYRepeat = Floor(lYRepeat)
lYScale = (dstH / srcH) / lYRepeat
ElseIf bScaleDownY Then
lYRepeat = Ceil(lYRepeat)
lYScale = (dstH / srcH) / lYRepeat
EndIf
Else
lYScale = dstH / srcH
EndIf
Local lXSize:Float = srcW * lXScale, lYSize:Float = srcH * lYScale
Local lM2DScaleXOrig:Float, lM2DScaleYOrig:Float
Local lM2DScaleX:Float, lM2DScaleY:Float
GetScale(lM2DScaleXOrig, lM2DScaleYOrig)
GetScale(lM2DScaleX, lM2DScaleY)
' Cache some variables, so that we don't waste CPU time
Local lXRepeatFl:Int = Floor(lXRepeat), lXRepeatOverflow:Float = lXRepeat - lXRepeatFl
Local lYRepeatFl:Int = Floor(lYRepeat), lYRepeatOverflow:Float = lYRepeat - lYRepeatFl
For Local lYIndex:Int = 0 To lYRepeatFl
Local lYSizeMul:Float = 1
Local lYPos:Float = dstY + lYIndex * lYSize
If bMirrorY Then lM2DScaleY :* -1
If (lYIndex = lYRepeatFl) Then lYSizeMul = lYRepeatOverflow
For Local lXIndex:Int = 0 To lXRepeatFl
Local lXSizeMul:Float = 1
Local lXPos:Float = dstX + lXIndex * lXSize
If bMirrorX Then lM2DScaleX :* -1
If (lXIndex = lXRepeatFl) Then lXSizeMul = lXRepeatOverflow
SetScale lM2DScaleX, lM2DScaleY
DrawSubImageRect(img, lXPos, lYPos, lXSize * lXSizeMul, lYSize * lYSizeMul, srcX, srcY, srcW * lXSizeMul, srcH * lYSizeMul, hndX, hndY, frame)
Next
Next
SetScale(lM2DScaleXOrig, lM2DScaleYOrig)
EndFunction
Function DrawTiledImage:Int(img:TImage, dstX:Float, dstY:Float, dstW:Float, dstH:Float, srcX:Float, srcY:Float, srcW:Float, srcH:Float, hndX:Float=0, hndY:Float=0, frame:Int=0, lft:Float, top:Float, rgt:Float, btm:Float, bBackground:Byte=True, bFlags:Byte=MODE_REPEATX | MODE_REPEATY)
DrawSubImageRect(img, dstX, dstY, lft, top, srcX, srcY, lft, top, hndX, hndY, frame)
DrawSubImageRect(img, dstX + dstW - rgt, dstY, rgt, top, srcX + srcW - rgt, srcY, rgt, top, hndX, hndY, frame)
DrawSubImageRect(img, dstX, dstY + dstH - btm, lft, top, srcX, srcY + srcH - btm, lft, btm, hndX, hndY, frame)
DrawSubImageRect(img, dstX + dstW - rgt, dstY + dstH - btm, rgt, top, srcX + srcW - rgt, srcY + srcH - btm, rgt, btm, hndX, hndY, frame)
' Left
DrawSubImageRectEx(img, dstX, dstY + top, lft, dstH - top - btm, srcX, srcY + top, lft, srcH - top - btm, hndX, hndY, frame, bFlags)
' Right
DrawSubImageRectEx(img, dstX + dstW - rgt, dstY + top, rgt, dstH - top - btm, srcX + srcW - rgt, srcY + top, rgt, srcH - top - btm, hndX, hndY, frame, bFlags)
' Top
DrawSubImageRectEx(img, dstX + lft, dstY, dstW - lft - rgt, top, srcX + lft, srcY, srcW - lft - rgt, top, hndX, hndY, frame, bFlags)
' Bottom
DrawSubImageRectEx(img, dstX + lft, dstY + dstH - btm, dstW - lft - rgt, btm, srcX + lft, srcY + srcH - btm, srcW - lft - rgt, btm, hndX, hndY, frame, bFlags)
If bBackground Then DrawSubImageRectEx(img, dstX + lft, dstY + top, dstW - lft - rgt, dstH - top - btm, srcX + lft, srcY + top, srcW - lft - rgt, srcH - top - btm, hndX, hndY, frame, bFlags)
End Function
' Max2D Shader Support ---------------------------------------------------------
Type TShader
' Functions ----------------------------------------------------------------
Function Create:TShader()
Return (New TShader)
EndFunction
Function CreateVertex:TShader(oVertexCode:String)
Local oShader:TShader = TShader.Create()
oShader.Load(oVertexCode, True)
Return oShader
EndFunction
Function CreateFragement:TShader(oFragmentCode:String)
Local oShader:TShader = TShader.Create()
oShader.Load(oFragmentCode, True)
Return oShader
EndFunction
Function CreateCombined:TShader(oVertexCode:String, oFragmentCode:String)
Local oShader:TShader = TShader.Create()
oShader.Load(oVertexCode, True)
oShader.Load(oFragmentCode, False)
Return oShader
EndFunction
Function CheckForErrors:Int(ShaderObject:Int, ErrorString:String Var, Compiled:Int = True)
Local Successful:Int
If Compiled Then
glGetShaderiv (ShaderObject, GL_COMPILE_STATUS, Varptr Successful)
Else
glGetProgramiv(ShaderObject, GL_LINK_STATUS, Varptr Successful)
EndIf
If Not Successful Then
Local ErrorLength:Int
glGetObjectParameterivARB(ShaderObject, GL_OBJECT_INFO_LOG_LENGTH_ARB, Varptr ErrorLength)
Local Message:Byte Ptr = MemAlloc(ErrorLength), Dummy:Int
glGetInfoLogARB(ShaderObject, ErrorLength, Varptr Dummy, Message)
ErrorString = String.FromCString(Message)
MemFree(Message)
Return True
EndIf
Return False
End Function
Function CheckCompatability:Int()
Local Extensions:String = String.FromCString(Byte Ptr glGetString(GL_EXTENSIONS))
Local GLVersion:String = String.FromCString(Byte Ptr glGetString(GL_VERSION))
Local GLVersionInt:Int = GLVersion[.. 3].Replace(".", "").ToInt()
DebugLog Extensions
If Extensions.Find("GL_ARB_shader_objects" ) >= 0 And ..
Extensions.Find("GL_ARB_vertex_shader" ) >= 0 And ..
Extensions.Find("GL_ARB_fragment_shader") >= 0 or GLVersionInt >= 20 Then
Return True
EndIf
Return False
End Function
' Variables ----------------------------------------------------------------
Field iProgramObject:Int ' Shader Program Object
Field tError:String ' Shader Compile Errors & Warnings
' Members ------------------------------------------------------------------
Method New()
Self.iProgramObject = glCreateProgram()
EndMethod
Method Delete()
glDeleteProgram(Self.iProgramObject)
EndMethod
'' Retrieves the error that happened during loading or linking.
' @return <String> Error log retrieved from the
Method GetError:String()
Return Self.tError
EndMethod
'' Loads a new shader and, if successful, attaches it to the program.
' @param <String> tShaderCode A string containing the shader code.
' @param <Bool> bIsVertexShader Is this code a vertex Shader
' @return <Bool> Success
Method Load:Byte(tShaderCode:String, bIsVertexShader:Byte = True)
Local liShaderObject:Int
If tShaderCode = Null Then Return False
If tShaderCode.length = 0 Then Return False
' Create a new Shader Object, either for Vertex or Fragment processing.
If bIsVertexShader Then
liShaderObject = glCreateShader(GL_VERTEX_SHADER)
Else
liShaderObject = glCreateShader(GL_FRAGMENT_SHADER)
EndIf
If liShaderObject = 0 Then Return False
' Load the shader source into the compiler.
Local lbShaderCodePtr:Byte Ptr = tShaderCode.ToCString()
Local liShaderLength:Int = tShaderCode.length
glShaderSource(liShaderObject, 1, VarPtr lbShaderCodePtr, VarPtr liShaderLength)
MemFree(lbShaderCodePtr)
' Compile the shader and check for errors
glCompileShader(liShaderObject)
If (TShader.CheckForErrors(liShaderObject, Self.tError, True) = False) Then
glAttachShader(iProgramObject, liShaderObject)
glDeleteShader(liShaderObject)
Return True
EndIf
glDeleteShader(liShaderObject)
EndMethod
'' Links the attached shaders to the program, if successful.
' @return <Bool> Success
Method Link:Byte()
glLinkProgramARB(Self.iProgramObject)
Return (TShader.CheckForErrors(Self.iProgramObject, Self.tError, False) = False)
EndMethod
'' Enable the this program and disable all other programs.
' @return <Bool> Success
Method Enable:Byte()
glUseProgramObjectARB(Self.iProgramObject)
Return (TShader.CheckForErrors(Self.iProgramObject, Self.tError, False) = False)
End Method
'' Disable the all programs.
' @return <Bool> Success
Method Disable:Byte()
glUseProgramObjectARB(0)
Return (TShader.CheckForErrors(Self.iProgramObject, Self.tError, False) = False)
End Method
'' Uniform Management
Method GetUniformLocation:Int(tUniform:String)
Return glGetUniformLocationARB(Self.iProgramObject, tUniform)
End Method
Method SetUniform1F(tUniform:String, fValue1:Float)
glUniform1f(GetUniformLocation(tUniform), fValue1)
EndMethod
Method SetUniform2F(tUniform:String, fValue1:Float, fValue2:Float)
glUniform2f(GetUniformLocation(tUniform), fValue1, fValue2)
EndMethod
Method SetUniform3F(tUniform:String, fValue1:Float, fValue2:Float, fValue3:Float)
glUniform3f(GetUniformLocation(tUniform), fValue1, fValue2, fValue3)
EndMethod
Method SetUniform4F(tUniform:String, fValue1:Float, fValue2:Float, fValue3:Float, fValue4:Float)
glUniform4f(GetUniformLocation(tUniform), fValue1, fValue2, fValue3, fValue4)
EndMethod
Method SetUniform1I(tUniform:String, iValue1:Int)
glUniform1i(GetUniformLocation(tUniform), iValue1)
EndMethod
Method SetUniform2I(tUniform:String, iValue1:Int, iValue2:Int)
glUniform2i(GetUniformLocation(tUniform), iValue1, iValue2)
EndMethod
Method SetUniform3I(tUniform:String, iValue1:Int, iValue2:Int, iValue3:Int)
glUniform3i(GetUniformLocation(tUniform), iValue1, iValue2, iValue3)
EndMethod
Method SetUniform4I(tUniform:String, iValue1:Int, iValue2:Int, iValue3:Int, iValue4:Int)
glUniform4i(GetUniformLocation(tUniform), iValue1, iValue2, iValue3, iValue4)
EndMethod
Method SetUniform1UI(tUniform:String, iValue1:Int)
glUniform1ui(GetUniformLocation(tUniform), iValue1)
EndMethod
Method SetUniform2UI(tUniform:String, iValue1:Int, iValue2:Int)
glUniform2ui(GetUniformLocation(tUniform), iValue1, iValue2)
EndMethod
Method SetUniform3UI(tUniform:String, iValue1:Int, iValue2:Int, iValue3:Int)
glUniform3ui(GetUniformLocation(tUniform), iValue1, iValue2, iValue3)
EndMethod
Method SetUniform4UI(tUniform:String, iValue1:Int, iValue2:Int, iValue3:Int, iValue4:Int)
glUniform4ui(GetUniformLocation(tUniform), iValue1, iValue2, iValue3, iValue4)
EndMethod
EndType
BlitzMax/Sirius Online Launcher/README.md
+9
View File
@@ -0,0 +1,9 @@
Sirius Online Launcher
=======================
Originally supposed to be the official launcher, it was later dumped as contact died off to the lead developer due to him going from 100mbit to potato quality internet. He didn't like the idea that it would check for an update and download it, instead of letting you play directly. Neither did he like the way the updates were handled, hash based checking for new files seemed to not go over well to him.
The project contains some things from the forums for BlitzMax, as well as my try at adding some extra support to Max2D. Remember Blitz3D? The 2D system in BlitzMax is basically the same, except worse.
License
=======
Sirius Online Launcher 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/.
BlitzMax/Sirius Online Launcher/SFX/M/launcher.ogg
BIN
View File
Binary file not shown.
BlitzMax/Sirius Online Launcher/SFX/UI/MxCL.wav
BIN
View File
Binary file not shown.
BlitzMax/Sirius Online Launcher/SFX/UI/MxOV.ogg
BIN
View File
Binary file not shown.
BlitzMax/Sirius Online Launcher/SFX/UI/MxRE.wav
BIN
View File
Binary file not shown.
BlitzMax/Sirius Online Launcher/TDigest.bmx
+285
View File
@@ -0,0 +1,285 @@
Strict
Import BRL.Retro
Function MD5$(in:String Var)
Local h0 = $67452301, h1 = $EFCDAB89, h2 = $98BADCFE, h3 = $10325476
Local r[] = [7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22,..
5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20,..
4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23,..
6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21]
Local k[] = [$D76AA478, $E8C7B756, $242070DB, $C1BDCEEE, $F57C0FAF, $4787C62A,..
$A8304613, $FD469501, $698098D8, $8B44F7AF, $FFFF5BB1, $895CD7BE,..
$6B901122, $FD987193, $A679438E, $49B40821, $F61E2562, $C040B340,..
$265E5A51, $E9B6C7AA, $D62F105D, $02441453, $D8A1E681, $E7D3FBC8,..
$21E1CDE6, $C33707D6, $F4D50D87, $455A14ED, $A9E3E905, $FCEFA3F8,..
$676F02D9, $8D2A4C8A, $FFFA3942, $8771F681, $6D9D6122, $FDE5380C,..
$A4BEEA44, $4BDECFA9, $F6BB4B60, $BEBFBC70, $289B7EC6, $EAA127FA,..
$D4EF3085, $04881D05, $D9D4D039, $E6DB99E5, $1FA27CF8, $C4AC5665,..
$F4292244, $432AFF97, $AB9423A7, $FC93A039, $655B59C3, $8F0CCC92,..
$FFEFF47D, $85845DD1, $6FA87E4F, $FE2CE6E0, $A3014314, $4E0811A1,..
$F7537E82, $BD3AF235, $2AD7D2BB, $EB86D391]
Local intCount = (((in$.length + 8) Shr 6) + 1) Shl 4
Local data[intCount]
For Local c=0 Until in$.length
data[c Shr 2] = data[c Shr 2] | ((in$[c] & $FF) Shl ((c & 3) Shl 3))
Next
data[in$.length Shr 2] = data[in$.length Shr 2] | ($80 Shl ((in$.length & 3) Shl 3))
data[data.length - 2] = (Long(in$.length) * 8) & $FFFFFFFF
data[data.length - 1] = (Long(in$.length) * 8) Shr 32
For Local chunkStart=0 Until intCount Step 16
Local a = h0, b = h1, c = h2, d = h3
For Local i=0 To 15
Local f = d ~ (b & (c ~ d))
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + i]), r[i]) + b
a = t
Next
For Local i=16 To 31
Local f = c ~ (d & (b ~ c))
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + (((5 * i) + 1) & 15)]), r[i]) + b
a = t
Next
For Local i=32 To 47
Local f = b ~ c ~ d
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + (((3 * i) + 5) & 15)]), r[i]) + b
a = t
Next
For Local i=48 To 63
Local f = c ~ (b | ~d)
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + ((7 * i) & 15)]), r[i]) + b
a = t
Next
h0 :+ a ; h1 :+ b
h2 :+ c ; h3 :+ d
Next
Return (LEHex(h0) + LEHex(h1) + LEHex(h2) + LEHex(h3))
End Function
Function MD5Bank:String(inbank:TBank Var)
Local h0 = $67452301, h1 = $EFCDAB89, h2 = $98BADCFE, h3 = $10325476
Local r[] = [7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22,..
5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20,..
4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23,..
6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21]
Local k[] = [$D76AA478, $E8C7B756, $242070DB, $C1BDCEEE, $F57C0FAF, $4787C62A,..
$A8304613, $FD469501, $698098D8, $8B44F7AF, $FFFF5BB1, $895CD7BE,..
$6B901122, $FD987193, $A679438E, $49B40821, $F61E2562, $C040B340,..
$265E5A51, $E9B6C7AA, $D62F105D, $02441453, $D8A1E681, $E7D3FBC8,..
$21E1CDE6, $C33707D6, $F4D50D87, $455A14ED, $A9E3E905, $FCEFA3F8,..
$676F02D9, $8D2A4C8A, $FFFA3942, $8771F681, $6D9D6122, $FDE5380C,..
$A4BEEA44, $4BDECFA9, $F6BB4B60, $BEBFBC70, $289B7EC6, $EAA127FA,..
$D4EF3085, $04881D05, $D9D4D039, $E6DB99E5, $1FA27CF8, $C4AC5665,..
$F4292244, $432AFF97, $AB9423A7, $FC93A039, $655B59C3, $8F0CCC92,..
$FFEFF47D, $85845DD1, $6FA87E4F, $FE2CE6E0, $A3014314, $4E0811A1,..
$F7537E82, $BD3AF235, $2AD7D2BB, $EB86D391]
Local intCount = (((inbank.Size() + 8) Shr 6) + 1) Shl 4
Local data[intCount]
Local inPtr:Byte Ptr = inbank.Buf()
For Local c=0 Until inbank.Size()
data[c Shr 2] = data[c Shr 2] | ((inPtr[c] & $FF) Shl ((c & 3) Shl 3))
Next
data[inbank.Size() Shr 2] = data[inbank.Size() Shr 2] | ($80 Shl ((inbank.Size() & 3) Shl 3))
data[data.length - 2] = (Long(inbank.Size()) * 8) & $FFFFFFFF
data[data.length - 1] = (Long(inbank.Size()) * 8) Shr 32
For Local chunkStart=0 Until intCount Step 16
Local a = h0, b = h1, c = h2, d = h3
For Local i=0 To 15
Local f = d ~ (b & (c ~ d))
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + i]), r[i]) + b
a = t
Next
For Local i=16 To 31
Local f = c ~ (d & (b ~ c))
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + (((5 * i) + 1) & 15)]), r[i]) + b
a = t
Next
For Local i=32 To 47
Local f = b ~ c ~ d
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + (((3 * i) + 5) & 15)]), r[i]) + b
a = t
Next
For Local i=48 To 63
Local f = c ~ (b | ~d)
Local t = d
d = c ; c = b
b = Rol((a + f + k[i] + data[chunkStart + ((7 * i) & 15)]), r[i]) + b
a = t
Next
h0 :+ a ; h1 :+ b
h2 :+ c ; h3 :+ d
Next
Return (LEHex(h0) + LEHex(h1) + LEHex(h2) + LEHex(h3))
End Function
Function SHA1$(in$)
Local h0 = $67452301, h1 = $EFCDAB89, h2 = $98BADCFE, h3 = $10325476, h4 = $C3D2E1F0
Local intCount = (((in$.length + 8) Shr 6) + 1) Shl 4
Local data[intCount]
For Local c=0 Until in$.length
data[c Shr 2] = (data[c Shr 2] Shl 8) | (in$[c] & $FF)
Next
data[in$.length Shr 2] = ((data[in$.length Shr 2] Shl 8) | $80) Shl ((3 - (in$.length & 3)) Shl 3)
data[data.length - 2] = (Long(in$.length) * 8) Shr 32
data[data.length - 1] = (Long(in$.length) * 8) & $FFFFFFFF
For Local chunkStart=0 Until intCount Step 16
Local a = h0, b = h1, c = h2, d = h3, e = h4
Local w[] = data[chunkStart..chunkStart + 16]
w = w[..80]
For Local i=16 To 79
w[i] = Rol(w[i - 3] ~ w[i - 8] ~ w[i - 14] ~ w[i - 16], 1)
Next
For Local i=0 To 19
Local t = Rol(a, 5) + (d ~ (b & (c ~ d))) + e + $5A827999 + w[i]
e = d ; d = c
c = Rol(b, 30)
b = a ; a = t
Next
For Local i=20 To 39
Local t = Rol(a, 5) + (b ~ c ~ d) + e + $6ED9EBA1 + w[i]
e = d ; d = c
c = Rol(b, 30)
b = a ; a = t
Next
For Local i=40 To 59
Local t = Rol(a, 5) + ((b & c) | (d & (b | c))) + e + $8F1BBCDC + w[i]
e = d ; d = c
c = Rol(b, 30)
b = a ; a = t
Next
For Local i=60 To 79
Local t = Rol(a, 5) + (b ~ c ~ d) + e + $CA62C1D6 + w[i]
e = d ; d = c
c = Rol(b, 30)
b = a ; a = t
Next
h0 :+ a ; h1 :+ b ; h2 :+ c
h3 :+ d ; h4 :+ e
Next
Return (Hex(h0) + Hex(h1) + Hex(h2) + Hex(h3) + Hex(h4)).ToLower()
End Function
Function SHA256$(in$)
Local h0 = $6A09E667, h1 = $BB67AE85, h2 = $3C6EF372, h3 = $A54FF53A
Local h4 = $510E527F, h5 = $9B05688C, h6 = $1F83D9AB, h7 = $5BE0CD19
Local k[] = [$428A2F98, $71374491, $B5C0FBCF, $E9B5DBA5, $3956C25B, $59F111F1,..
$923F82A4, $AB1C5ED5, $D807AA98, $12835B01, $243185BE, $550C7DC3,..
$72BE5D74, $80DEB1FE, $9BDC06A7, $C19BF174, $E49B69C1, $EFBE4786,..
$0FC19DC6, $240CA1CC, $2DE92C6F, $4A7484AA, $5CB0A9DC, $76F988DA,..
$983E5152, $A831C66D, $B00327C8, $BF597FC7, $C6E00BF3, $D5A79147,..
$06CA6351, $14292967, $27B70A85, $2E1B2138, $4D2C6DFC, $53380D13,..
$650A7354, $766A0ABB, $81C2C92E, $92722C85, $A2BFE8A1, $A81A664B,..
$C24B8B70, $C76C51A3, $D192E819, $D6990624, $F40E3585, $106AA070,..
$19A4C116, $1E376C08, $2748774C, $34B0BCB5, $391C0CB3, $4ED8AA4A,..
$5B9CCA4F, $682E6FF3, $748F82EE, $78A5636F, $84C87814, $8CC70208,..
$90BEFFFA, $A4506CEB, $BEF9A3F7, $C67178F2]
Local intCount = (((in$.length + 8) Shr 6) + 1) Shl 4
Local data[intCount]
For Local c=0 Until in$.length
data[c Shr 2] = (data[c Shr 2] Shl 8) | (in$[c] & $FF)
Next
data[in$.length Shr 2] = ((data[in$.length Shr 2] Shl 8) | $80) Shl ((3 - (in$.length & 3)) Shl 3)
data[data.length - 2] = (Long(in$.length) * 8) Shr 32
data[data.length - 1] = (Long(in$.length) * 8) & $FFFFFFFF
For Local chunkStart=0 Until intCount Step 16
Local a = h0, b = h1, c = h2, d = h3, e = h4, f = h5, g = h6, h = h7
Local w[] = data[chunkStart..chunkStart + 16]
w = w[..64]
For Local i=16 To 63
w[i] = w[i - 16] + (Ror(w[i - 15], 7) ~ Ror(w[i - 15], 18) ~ (w[i - 15] Shr 3))..
+ w[i - 7] + (Ror(w[i - 2], 17) ~ Ror(w[i - 2], 19) ~ (w[i - 2] Shr 10))
Next
For Local i=0 To 63
Local t0 = (Ror(a, 2) ~ Ror(a, 13) ~ Ror(a, 22)) + ((a & b) | (b & c) | (c & a))
Local t1 = h + (Ror(e, 6) ~ Ror(e, 11) ~ Ror(e, 25)) + ((e & f) | (~e & g)) + k[i] + w[i]
h = g ; g = f ; f = e ; e = d + t1
d = c ; c = b ; b = a ; a = t0 + t1
Next
h0 :+ a ; h1 :+ b ; h2 :+ c ; h3 :+ d
h4 :+ e ; h5 :+ f ; h6 :+ g ; h7 :+ h
Next
Return (Hex(h0) + Hex(h1) + Hex(h2) + Hex(h3) + Hex(h4) + Hex(h5) + Hex(h6) + Hex(h7)).ToLower()
End Function
Function Rol(val, shift)
Return (val Shl shift) | (val Shr (32 - shift))
End Function
Function Ror(val, shift)
Return (val Shr shift) | (val Shl (32 - shift))
End Function
Function LEHex$(val)
Local out$ = Hex(val)
Return out$[6..8] + out$[4..6] + out$[2..4] + out$[0..2]
End Function
BlitzMax/Sirius Online Launcher/TGUI.bmx
+184
View File
@@ -0,0 +1,184 @@
SuperStrict
Import BRL.LinkedList
Import BRL.Map
Import BRL.Graphics
Import BRL.GLGraphics
Import BRL.Max2D
Import BRL.GLMax2D
Import BRL.Pixmap
Import Pub.OpenGL
Import "Max2DExtended.bmx"
Import BRL.BMPLoader
Import BRL.JPGLoader
Import BRL.PNGLoader
Import BRL.TGALoader
'-------------------------------------------------------------------------------
Type TGUI
' Variables ----------------------------------------------------------------
' Skinning
Field oSkinImageSet:TPixmap = Null
' GUI Area
Field oRootGadget:TGUIGadget = New TGUIGadget
' Functions ----------------------------------------------------------------
Function Create:TGUI(X:Float, Y:Float, W:Float, H:Float, Skin:Object)
Local loGUI:TGUI = New TGUI
Return loGUI
EndFunction
' Members ------------------------------------------------------------------
Method New()
Self.oRootGadget = (New TGUIGadget)
EndMethod
Method Destroy()
Self.oRootGadget = Null
EndMethod
Method Update:Int(fDelta:Float)
oRootGadget.Update(fDelta)
EndMethod
Method Render:Int(fDelta:Float)
oRootGadget.Render(fDelta)
EndMethod
'' Changes the
Method SetRootGadget:TGUIGadget(oRootGadget:TGUIGadget)
If oRootGadget = Null Or oRootGadget.Insane() Then Return Null
Local loRootWindow:TGUIGadget = Self.oRootGadget
Self.oRootGadget = oRootGadget
Return loRootWindow
EndMethod
Method GetRootGadget:TGUIGadget()
Return oRootGadget
EndMethod
EndType
'-------------------------------------------------------------------------------
Type TGUIGadget
' Constants ----------------------------------------------------------------
Const COORD_ABSOLUTE:Byte = 0
Const COORD_RELATIVE:Byte = 1
' Variables ----------------------------------------------------------------
' Gadget Coordinates
Field bLocalCoordType:Byte[] = New Byte[4]
Field dLocalCoord:Double[] = New Double[4]
Field dCoord:Double[] = New Double[4]
' Parent and Childs
Field oParentGUI:TGUI = Null
Field oParent:TGUIGadget = Null
Field oChildList:TList = New TList
' Members ------------------------------------------------------------------
'' Deconstructor for TGUIGadget
' Automatically removed itself from the parent and releases all pointers to chils
Method Delete()
' Unregister from parent gadget and release all pointers to childs.
SetParent(Null)
Self.oChildList.Clear()
' Destroy objects in reverse order.
Self.bCoordType = Null
Self.dCoord = Null
Self.dLocalCoord = Null
Self.oChildList = Null
EndMethod
'' Checks if the Gadget went insane due to invalid usage or other influence.
' @return <Bool> True if the TGUIGadget went insane, otherwise false.
Method Insane:Byte()
If Self.bCoordType = Null Then Return True
If Self.dCoord = Null Then Return True
If Self.dLocalCoord = Null Then Return True
If Self.oChildList = Null Then Return True
EndMethod
'' Updates the GUIGadget and any other objects in it.
' @return <Int>
Method Update:Int(fDelta:Float)
EndMethod
Method Render:Int(fDelta:Float)
EndMethod
' Parent Management
Method SetParent(oParent:TGUIGadget)
If Self.oParent <> Null Then Self.oParent.RemoveChild(Self)
If oParent <> Null Then oParent.AddChild(Self)
EndMethod
Method GetParent:TGUIGadget()
Return Self.oParent
EndMethod
' Child Management
Method IsChild:Int(oChild:TGUIGadget)
If oChild = Null Then Return False
Return Self.oChildList.Contains(oChild)
EndMethod
Method AddChild:Int(oChild:TGUIGadget)
If oChild <> Null Then
If IsChild(oChild) Then
Return True
Else
Return (Self.oChildList.AddLast(oChild) <> Null)
EndIf
EndIf
EndMethod
Method RemoveChild:Int(oChild:TGUIGadget)
If oChild <> Null Then
If IsChild(oChild) Then
Return True
Else
Return Self.oChildList.Remove(oChild)
EndIf
EndIf
EndMethod
Method GetChildAtIndex:TGUIGadget(iIndex:Int)
If iIndex <> -1 Then
Local liChildCount:Int = Self.oChildList.Count()
If iIndex >= 0 And iIndex < liChildCount Then
Return Self.oChildList.ValueAtIndex(iIndex)
Else
Return Null
EndIf
Else
Return Self.oChildList.Last()
EndIf
EndMethod
Method SetChildIndex:Int(oChild:TGUIGadget, iIndex:Int)
If oChild <> Null Then
If IsChild(oChild) Then
Local liChildCount:Int = Self.oChildList.Count()
If iIndex >= 0 And iIndex < liChildCount Then
'Local loChild:TGUIGadget = Self.oChildList.ValueAtIndex(iIndex)
'Local lChild:TGUIGadget = Self.oChildList.ValueAtIndex(iIndex)
'Self.oChildList.Insert
EndIf
EndIf
EndIf
EndMethod
' Signal Handlers ----------------------------------------------------------
EndType
'-------------------------------------------------------------------------------
Public
Type TGUIWindow Extends TGUIGadget
'-------------------------------------------------------------------------------
EndType
BlitzMax/Sirius Online Launcher/TPatcher.bmx
+435
View File
@@ -0,0 +1,435 @@
SuperStrict
Import BaH.libcurl
Import BRL.Bank
Import BRL.FileSystem
Import BRL.LinkedList
Import BRL.StandardIO
Import BRL.Stream
Import BRL.Timer
Import "Clock.c"
Import "Digest.bmx"
Type TPatcher
Const STATE_DEFAULT:Byte = 0
Const STATE_PATCHINFO:Byte = 1
Const STATE_CHECKING:Byte = 2
Const STATE_PREPATCH:Byte = 3
Const STATE_PATCHING:Byte = 4
Const STATE_COMPLETE:Byte = 5
Const STATE_LAUNCHER:Byte = 6
Const SSTATE_ENTER:Byte = 0
Const SSTATE_WORK:Byte = 1
Const SSTATE_LEAVE:Byte = 2
Const SERVER:String = "http://sirius-online.us.to/patch/"
' State-based Patcher
Field m_bState:Byte = TPatcher.STATE_DEFAULT
Field m_bSubState:Byte = TPatcher.SSTATE_ENTER
' lib/cURL is used for downloading of data.
Field m_oCurlMulti:TCurlMulti = Null
Field m_oCurl:TCurlEasy = Null
Field m_fCurlProgress:Float
' State: All
Field m_oTaskList:TList = New TList
Field m_fProgress:Float = 0
' State: Patchinfo, Checking, Patching
Field m_oFileHashList:TList = New TList
Field m_iFileCount:Int = 0
' State: Checking, Patching
Field m_oFileLoader:TAsyncLoader = New TAsyncLoader
Field m_oFileHashPair:TFileHash = Null
' State: Patching
Field m_oFileList:TList = New TList
Field m_oFile:String, m_oFileDL:String
Field m_oFileStream:TStream
' Construction
Method New()
EndMethod
Function Create:TPatcher()
Local oPatcher:TPatcher = New TPatcher
Return oPatcher
EndFunction
' Deconstruction
Method Destroy()
m_oCurlMulti.multiCleanup()
m_oCurl.cleanup()
EndMethod
' Basically the Main Loop of the Patcher, handles everything. Call GetShutdown:String() if you want to know when the patcher is telling you to run an executable and close.
Method Update()
' Check
Select m_bState
Case TPatcher.STATE_DEFAULT
If m_bSubState = TPatcher.SSTATE_ENTER Then
m_oCurlMulti = TCurlMulti.Create()
m_oCurl = m_oCurlMulti.newEasy()
m_oCurl.setOptInt(CURLOPT_FOLLOWLOCATION, 1)
m_oCurl.setOptInt(CURLOPT_CRLF, False)
m_oCurl.setOptString(CURLOPT_USERAGENT, "Sirius Online Launcher")
m_oCurl.setOptString(CURLOPT_REFERER, TPatcher.SERVER)
m_oCurl.setOptString(CURLOPT_URL, TPatcher.SERVER + "info")
m_oCurl.setProgressCallback(TPatcher.ProgressCallback, Self)
m_oCurl.setWriteString()
m_oTaskList.AddFirst("n[WAIT] Getting patch information...")
m_bSubState = TPatcher.SSTATE_WORK
EndIf
If m_bSubState = TPatcher.SSTATE_WORK Then
Local iResult:Int = Perform()
m_fProgress = m_fCurlProgress
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("g[" + RSet(String(Int(m_fProgress * 100)), 3) + "%] Retrieving patch information...")
If iResult = CURLM_OK Then
If m_fCurlProgress = 1.0 And m_iCurlMultiHandles = 0 Then
m_bSubState = TPatcher.SSTATE_LEAVE
EndIf
Else
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("g[FAIL] Retrieving patch information... ("+CurlError(iResult)+")")
SetState(TPatcher.STATE_COMPLETE)
EndIf
EndIf
If m_bSubState = TPatcher.SSTATE_LEAVE Then
m_oCurlMulti.multiRemove(m_oCurl)
m_oCurlMulti.multiCleanup()
m_oCurlMulti = Null
Local oCurlRCode:Int = m_oCurl.getInfo().responseCode()
Local stResult:String = m_oCurl.toString()
m_oCurl.cleanup()
m_oCurl = Null
If oCurlRCode <> 404 Then
m_oFileHashList.Clear()
If stResult.length > 0 Then
Local stFileHashArr:String[] = stResult.Split("~n")
For Local stFileHashPair:String = EachIn stFileHashArr
If stFileHashPair.length > 0 And stFileHashPair[0..1] <> "#" Then ' Ignore Comments
Local stPairArr:String[] = stFileHashPair.Split(":")
m_oFileHashList.AddLast(TFileHash.Create(stPairArr[0], stPairArr[1]))
EndIf
Next
m_iFileCount = m_oFileHashList.Count()
m_oFileList.Clear()
SetState(TPatcher.STATE_PATCHINFO) ' Got Patchinfo, and it had information.
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("g[ OK ] Retrieving patch information... done.")
Else
SetState(TPatcher.STATE_COMPLETE)
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("e[FAIL] Retrieving patch information... invalid information file.")
EndIf
Else
SetState(TPatcher.STATE_COMPLETE)
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("e[FAIL] Retrieving patch information... file not found.")
EndIf
EndIf
Case TPatcher.STATE_CHECKING
If m_bSubState = TPatcher.SSTATE_ENTER Then ' Used to load a new File
m_oFileHashPair = TFileHash(m_oFileHashList.RemoveFirst())
If m_oFileHashPair <> Null Then
m_oFileLoader.Initialize(m_oFileHashPair.stName)
m_oTaskList.AddFirst("n[WAIT] Checking '" + m_oFileHashPair.stName + "'...")
m_bSubState = TPatcher.SSTATE_WORK
Else
m_bSubState = TPatcher.SSTATE_LEAVE
EndIf
EndIf
If m_bSubState = TPatcher.SSTATE_WORK Then
If m_oFileLoader.m_bComplete = 0 Then
m_oFileLoader.Process(2, 1024)
m_fProgress = ((m_iFileCount - (m_oFileHashList.Count() + 1)) / Float(m_iFileCount)) + m_oFileLoader.m_fProgress * (1.0 / m_iFileCount)
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("g[" + RSet(String(Int(m_fProgress * 100)), 3) + "%] Checking '" + m_oFileHashPair.stName + "'...")
Else
If m_oFileLoader.m_bComplete = 1
If m_oFileLoader.m_oBank <> Null Then
Local stHash:String = MD5Bank(m_oFileLoader.m_oBank).ToUpper()
If stHash <> m_oFileHashPair.stHash Then
m_oFileList.AddLast(m_oFileHashPair.stName)
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("h[ OK ] Checking '" + m_oFileHashPair.stName + "'... requires update.")
Else
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("g[ OK ] Checking '" + m_oFileHashPair.stName + "'... up to date.")
EndIf
Else
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("e[FAIL] Checking '" + m_oFileHashPair.stName + "'... (File in use?)")
EndIf
Else
m_oFileList.AddLast(m_oFileHashPair.stName)
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("h[ OK ] Checking '" + m_oFileHashPair.stName + "'... missing.")
EndIf
m_bSubState = TPatcher.SSTATE_ENTER
m_oFileLoader.Cleanup()
EndIf
EndIf
If m_bSubState = TPatcher.SSTATE_LEAVE Then
If m_oFileList.Count() > 0 Then
m_iFileCount = m_oFileList.Count()
SetState(TPatcher.STATE_PREPATCH)
Else
SetState(TPatcher.STATE_COMPLETE)
EndIf
EndIf
Case TPatcher.STATE_PATCHING
If m_bSubState = TPatcher.SSTATE_ENTER Then
Local m_oEntry:Object = m_oFileList.RemoveFirst()
If m_oEntry <> Null Then
m_oFile = String(m_oEntry);m_oFileDL = m_oFile + ".part"
CreateDir(ExtractDir(m_oFile), True)
m_oFileStream = WriteFile(m_oFileDL)
If m_oFileStream <> Null Then
m_oCurlMulti = TCurlMulti.Create()
m_oCurl = m_oCurlMulti.newEasy()
m_oCurl.setOptInt(CURLOPT_FOLLOWLOCATION, 1)
m_oCurl.setOptInt(CURLOPT_CRLF, False)
m_oCurl.setOptString(CURLOPT_USERAGENT, "Sirius Online Launcher")
m_oCurl.setOptString(CURLOPT_REFERER, TPatcher.SERVER + "info")
m_oCurl.setOptString(CURLOPT_URL, TPatcher.SERVER + m_oFile)
m_oCurl.setWriteStream(m_oFileStream)
m_oCurl.setProgressCallback(TPatcher.ProgressCallback, Self)
m_oTaskList.AddFirst("n[WAIT] Downloading '" + m_oFile + "'...")
m_bSubState = TPatcher.SSTATE_WORK
EndIf
Else
SetState(TPatcher.STATE_DEFAULT)
EndIf
EndIf
If m_bSubState = TPatcher.SSTATE_WORK Then
Local iResult:Int = Perform()
m_fProgress = ((m_iFileCount - (m_oFileList.Count() + 1)) / Float(m_iFileCount)) + m_fCurlProgress * (1.0 / m_iFileCount)
If iResult = CURLM_OK Then
m_oFileStream.Flush()
If m_fCurlProgress = 1.0 And m_iCurlMultiHandles = 0 Then
m_oCurlMulti.multiRemove(m_oCurl)
m_oCurlMulti.multiCleanup()
Local oCurlRCode:Int = m_oCurl.getInfo().responseCode()
m_oCurl.cleanup()
' Cleanup(1)
m_oCurl = Null
m_oCurlMulti = Null
m_oFileStream.Close()
m_oFileStream = Null
If oCurlRCode <> 404 Then
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("g[ OK ] Downloading '" + m_oFile + "'...")
' Rename files
If m_oFile <> "Launcher.exe" Then
RenameFile(m_oFile, m_oFile + ".old")
If RenameFile(m_oFileDL, m_oFile) Then
DeleteFile(m_oFile + ".old")
Else
RenameFile(m_oFile + ".old", m_oFile)
EndIf
Else' If we patched the launcher, tell the parent program to start the new one.
RenameFile(m_oFileDL, "-" + m_oFile)
m_oFileList.Clear() ' Clear the list to be sure
SetState(TPatcher.STATE_LAUNCHER)
EndIf
Else
DeleteFile(m_oFileDL)
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("e[FAIL] Downloading '" + m_oFile + "'... file not found.")
EndIf
'Cleanup (2)
m_oFileDL = Null
m_oFile = Null
If m_oFileList.Count() = 0 Then
m_bSubState = TPatcher.SSTATE_LEAVE
Else
m_bSubState = TPatcher.SSTATE_ENTER
EndIf
Else
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("n[" + RSet(String(Int(m_fCurlProgress * 100)), 3) + "%] Downloading '" + m_oFile + "'...")
EndIf
Else
m_oFileStream.Close()
m_oTaskList.RemoveFirst()
m_oTaskList.AddFirst("e[FAIL] Downloading '" + m_oFile + "'... " + CurlError(iResult))
EndIf
EndIf
If m_bSubState = TPatcher.SSTATE_LEAVE And m_bState = TPatcher.STATE_PATCHING Then
SetState(TPatcher.STATE_DEFAULT)
EndIf
EndSelect
EndMethod
Method Advance()
Select m_bState
Case TPatcher.STATE_PATCHINFO
SetState(TPatcher.STATE_CHECKING)
Case TPatcher.STATE_PREPATCH
SetState(TPatcher.STATE_PATCHING)
Case TPatcher.STATE_COMPLETE
m_stProcessToRun = "ExeFile.exe"
Case TPatcher.STATE_LAUNCHER
m_stProcessToRun = "-Launcher.exe 1"
EndSelect
EndMethod
Field m_iCurlMultiHandles:Int, m_bCurlMultiState:Byte = 0
Method Perform:Int()
Local iResult:Int = 0
iResult = MultiPerform()
Select m_bCurlMultiState
Case 0, 2
m_bCurlMultiState = (m_bCurlMultiState + 1) Mod 3
Case 1
If m_oCurlMulti.multiSelect(0.1) <> -1 And m_iCurlMultiHandles Then
iResult = MultiPerform()
If m_iCurlMultiHandles = 0 Then m_bCurlMultiState = 2
EndIf
EndSelect
Return iResult
EndMethod
Method MultiPerform:Int()
Local iResult:Int = m_oCurlMulti.multiPerform(m_iCurlMultiHandles)
While iResult = CURLM_CALL_MULTI_PERFORM
iResult = m_oCurlMulti.multiPerform(m_iCurlMultiHandles)
Wend
Return iResult
EndMethod
' State Management
Method SetState(bState:Byte)
m_bState = bState
m_bSubState = TPatcher.SSTATE_ENTER
m_fProgress = 0.0
EndMethod
Method GetState:Byte()
Return m_bState
EndMethod
' Information
Method GetProgress:Float()
Return m_fProgress
EndMethod
Field m_stProcessToRun:String = NUll
Method GetShutdown:String()
Return m_stProcessToRun
EndMethod
' Callbacks
Function ProgressCallback:Int(oPatcherObj:Object, dDownloadTotal:Double, dDownloadNow:Double, dUploadTotal:Double, dUploadNow:Double)
If dDownloadTotal = 0 And dDownloadNow = 0 And dUploadTotal = 0 And dUploadNow = 0 Then TPatcher(oPatcherObj).m_fCurlProgress = 0.0;Return 0
TPatcher(oPatcherObj).m_fCurlProgress = (dDownloadNow / dDownloadTotal)
EndFunction
EndType
Type TFileHash
Field stName:String, stHash:String
Function Create:TFileHash(stName:String, stHash:String)
Local oFH:TFileHash = New TFileHash
oFH.stName = stName
oFH.stHash = stHash
Return oFH
EndFunction
EndType
Type TAsyncLoader
Field m_oBank:TBank
Field m_oStream:TStream, m_iFileSize:Int
Field m_fProgress:Float, m_bComplete:Byte
Method Initialize(stFile:String)
If FileType(stFile) = FILETYPE_FILE Then
m_oStream = ReadFile(stFile)
If m_oStream <> Null Then
m_iFileSize = FileSize(stFile)
m_oBank = CreateBank(m_iFileSize)
If m_oBank <> Null Then
m_fProgress = 0.0
m_bComplete = False
Else
m_oStream.Close()
EndIf
Else
m_fProgress = 1.0
m_bComplete = -2
EndIf
Else
m_fProgress = 1.0
m_bComplete = -2
EndIf
EndMethod
Method Process(iMs:Float, iBufferSize:Int = 1024)
Local iClockStart:Int = getClock()
If (m_oStream <> Null And m_oBank <> Null) And m_oStream.Eof() = False Then
Local iClockNow:Int = getClock()
Repeat
Local iRemaining:Int = Min(m_iFileSize - m_oStream.Pos(), iBufferSize)
m_oBank.Read(m_oStream, m_oStream.Pos(), iRemaining)
iClockNow = getClock()
Until m_oStream.Eof() = True or getClockDiff(iClockStart, iClockNow) > (iMs / 1000.0 * getClocksPerSecond())
m_fProgress = m_oStream.Pos() / Float(m_iFileSize)
m_bComplete = m_oStream.Eof()
If m_oStream.Eof() = True Then
m_oStream.Close()
m_oStream = Null
EndIf
ElseIf m_bComplete = 0 Then
m_fProgress = 1.0
m_bComplete = -1
EndIf
EndMethod
Method Cleanup()
m_oBank = Null
EndMethod
EndType
Function DebugClock(Text:String)
DebugLog getClock() + ":" + Text
EndFunction
Extern "c"
Function getClocksPerSecond:Int()="getClocksPerSecond_"
Function getClock:Int()="getClock_"
Function getClockDiff:Int(clockStart:Int, clockEnd:Int)="getClockDiff_"
EndExtern
BlitzMax/Sirius Online Server/BlitzNet.bmx
+1139
View File
File diff suppressed because it is too large Load Diff
BlitzMax/Sirius Online Server/README.md
+8
View File
@@ -0,0 +1,8 @@
Sirius Online Server
=======================
This project was supposed to be the official server software for Sirius Online, before the idea of multiplayer was dumped completely. Talk about sticking to the project plan. Oh wait, there was none. Why did I join that trainwreck of a team. Anyway, the server was designed to be somewhat efficient at its job of calculating and transferring. It supports up to 65535 players and will re-use Ids where possible instead of constantly incrementing. This makes memory management really easy, but join times are sometimes higher than normal. The project uses Xaymar.IOQueue, something which no longer exists. All it did was store packets to be sent off at a later point in time. Networking was done using UDP and TCP, i think. No idea anymore, don't care either, I'm now using Unreal Engine 4 for game development.
License
=======
Sirius Online Server 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/.
BlitzMax/Sirius Online Server/Server.bmx
+639
View File
@@ -0,0 +1,639 @@
SuperStrict
'--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
Framework BRL.Blitz
Import BRL.Threads
Import BRL.Timer
Import "BlitzNet.bmx"
'--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
' Fix GC weirdness
OnEnd(GCCollect)
Local Server:BNetServer = New BNetServer
Server.Open(27000, 27001, 8)
While
Server.Update()
Wend
Server.Close()
'----------------------------------------------------------------
'-- Types
'----------------------------------------------------------------
'Type Server
' Field m_Server:BNetServer
'End Type
Rem
Const VersionMajor:Byte = 0
Const VersionMinor:Byte = 40
Const Net_VersionMajor:Byte = 0
Const Net_VersionMinor:Byte = 1
' Network Initiation
Global InfoSocket:TSocket = TSocket.CreateTCP()
Global DataSocket:TSocket = TSocket.CreateUDP()
' Set up Information Socket.
Const SOCKET_INFO_PORT:Short = 27000
Const SOCKET_DATA_PORT:Short = 27001
If InfoSocket.Bind(SOCKET_INFO_PORT) Then
InfoSocket.SetTCPNoDelay(True)
Else
InfoSocket.Close()
Print "[ERR] Unable to bind Information Socket to port " + SOCKET_INFO_PORT + ". Make sure it is not in use."
End
EndIf
InfoSocket.Listen(128)
' Set up Data Socket.
If Not DataSocket.Bind(SOCKET_DATA_PORT) Then
DataSocket.Close()
Print "[ERR] Unable to bind Data Socket to port " + SOCKET_DATA_PORT + ". Make sure it is not in use."
End
EndIf
'END OF: Network Initiation
' Timers
Const DataTicks:Int = 5
Local l_LoopTimer:TTimer = TTimer.Create(120)
' Network Packet Buffer
Const NetPacketBufferSize:Int = 64
Local NetPacketBuffer:TBank = TBank.Create(NetPacketBufferSize)
Local NetPacketBufferStream:TBankStream = TBankStream.Create(NetPacketBuffer)
Local NetPacketQueueTCP:TList = (New TList)
Local NetPacketQueueTCPSwap:TList = (New TList)
Local NetPacketQueueUDP:TList = (New TList)
Local NetPacketQueueUDPSwap:TList = (New TList)
Repeat
Local l_LoopTime:Int = MilliSecs()
' Check for data on InfoSockets {
' Check for new connections. {
Local l_NewSocket:TSocket
Repeat
l_NewSocket = InfoSocket.Accept(0)
If l_NewSocket <> Null Then
Local l_NewPlayer:TPlayer = TPlayer.Create(l_NewSocket)
If l_NewPlayer <> Null Then
Print RSet(l_NewPlayer.m_UniqueId, 6) + ": Connected from " + DottedIP(l_NewSocket.RemoteIp()) + ":" + l_NewSocket.RemotePort() + "."
Else
l_NewSocket.Close()
Print "Server: New player tried connecting, but we are full."
EndIf
EndIf
Until l_NewSocket = Null
' }
' Check if a pregame client sent his login information {
For Local l_PGPlayer:TPlayer = EachIn TPlayer.PreGame
If l_PGPlayer.m_InfoSocket.Connected() = False Then
Print RSet(l_PGPlayer.m_UniqueId, 6) + ": Closed connection."
l_PGPlayer.Destroy();Continue
EndIf
While l_PGPlayer.m_InfoSocket.ReadAvail() > 0
Local l_ReadLength:Int = l_PGPlayer.m_InfoSocket.Recv(NetPacketBuffer._buf, 1);NetPacketBufferStream.Seek(0)
If l_ReadLength = 1
Local l_PacketId:Byte = NetPacketBufferStream.ReadByte()
Select l_PacketId
Case TInfoLogin.Id
l_PGPlayer.m_InfoSocket.Recv(NetPacketBuffer._buf, TInfoLogin.Size);NetPacketBufferStream.Seek(0)
Local l_InfoLogin:TInfoLogin = TInfoLogin(TInfoLogin.Read(NetPacketBufferStream))
If l_InfoLogin Then
' Retrieve Information from Packet
l_PGPlayer.m_Name = l_InfoLogin.m_Name
l_PGPlayer.m_Position[0] = l_InfoLogin.m_Position[0]
l_PGPlayer.m_Position[1] = l_InfoLogin.m_Position[1]
l_PGPlayer.m_Position[2] = l_InfoLogin.m_Position[2]
' Create UDP Socket for Client.
l_PGPlayer.m_DataSocket = TSocket.CreateUDP()
l_PGPlayer.m_DataSocket.Connect(l_PGPlayer.m_InfoSocket.RemoteIp(), l_InfoLogin.m_PunchPort)
' Send information to this client (order is important!).
Local l_InfoLogin:TInfoLogin = (New TInfoLogin)
l_InfoLogin.m_UniqueId = l_PGPlayer.m_UniqueId
l_InfoLogin.m_Name = l_PGPlayer.m_Name
'Local l_InfoUpdate:TInfoUpdate = (New TInfoUpdate)
'l_InfoUpdate.m_UniqueId = l_PGPlayer.m_UniqueId
'l_InfoUpdate.m_Name = l_PGPlayer.m_Name
'NetPacketBufferStream.Seek(0)
'Local l_Size:Int = l_InfoUpdate.Write(NetPacketBufferStream)
'l_PGPlayer.m_InfoSocket.Send(NetPacketBuffer._buf, l_Size)
' Add Player to ingame list.
TPlayer.PreGame.Remove(l_PGPlayer)
TPlayer.InGame.AddLast(l_PGPlayer)
Print RSet(l_PGPlayer.m_UniqueId, 6) + ": Logged in at " + l_PGPlayer.m_Position[0] + ":" + l_PGPlayer.m_Position[1] + ":" + l_PGPlayer.m_Position[2] + "."
Else
Print RSet(l_PGPlayer.m_UniqueId, 6) + ": CheckSum did not match with ours, Client is probably outdated."
l_PGPlayer.Destroy();Exit
EndIf
EndSelect
Else
Print RSet(l_PGPlayer.m_UniqueId, 6) + ": Unable to read first byte, socket might be corrupted. Dropping client."
l_PGPlayer.Destroy();Exit
EndIf
Wend
' If we still have no login packet, check if they are supposed to be dropped by timeout.
If l_PGPlayer.m_InfoSocket And (l_LoopTime - l_PGPlayer.m_Time) > 5000 Then
Print RSet(l_PGPlayer.m_UniqueId, 6) + ": Did not login, dropped."
l_PGPlayer.Destroy();Continue
EndIf
Next
' }
' Check if an ingame client sent packets. {
While DataSocket.ReadAvail() > 0
Local l_ReadLength:Int = DataSocket.Recv(NetPacketBuffer._buf, 1);NetPacketBufferStream.Seek(0)
If l_ReadLength = 1
Local l_PacketId:Byte = NetPacketBufferStream.ReadByte()
Select l_PacketId
Case TDataUpdate.Id
l_ReadLength = DataSocket.Recv(NetPacketBuffer._buf, NetPacketBufferSize)
Local l_DataUpdate:TDataUpdate = TDataUpdate(TDataUpdate.Read(NetPacketBufferStream))
Local l_Player:TPlayer = TPlayer.UIDToPlayer[l_DataUpdate.m_UniqueId]
If l_Player And l_Player.m_DataSocket Then ' Player exists and is logged in.
If DataSocket.RemoteIp() = l_Player.m_DataSocket.RemoteIp() And DataSocket.RemotePort() = l_Player.m_DataSocket.RemotePort() Then ' It is the same player.
If l_DataUpdate.m_Changed & TPlayer.CHANGED_POSX <> 0 Then l_Player.m_Position[0] = l_DataUpdate.m_Position[0]
If l_DataUpdate.m_Changed & TPlayer.CHANGED_POSY <> 0 Then l_Player.m_Position[1] = l_DataUpdate.m_Position[1]
If l_DataUpdate.m_Changed & TPlayer.CHANGED_POSZ <> 0 Then l_Player.m_Position[2] = l_DataUpdate.m_Position[2]
If l_DataUpdate.m_Changed & TPlayer.CHANGED_ROTX <> 0 Then l_Player.m_Rotation[0] = l_DataUpdate.m_Rotation[0]
If l_DataUpdate.m_Changed & TPlayer.CHANGED_ROTY <> 0 Then l_Player.m_Rotation[1] = l_DataUpdate.m_Rotation[1]
If l_DataUpdate.m_Changed & TPlayer.CHANGED_ROTZ <> 0 Then l_Player.m_Rotation[2] = l_DataUpdate.m_Rotation[1]
If l_DataUpdate.m_Changed & TPlayer.CHANGED_VEL <> 0 Then
l_Player.m_Velocity[0] = l_DataUpdate.m_Velocity[0]
l_Player.m_Velocity[1] = l_DataUpdate.m_Velocity[1]
l_Player.m_Velocity[2] = l_DataUpdate.m_Velocity[2]
EndIf
Else
Print "Server: Recieved update for another player from " + DottedIP(DataSocket.RemoteIp()) + ":" + DataSocket.RemotePort() + "."
EndIf
EndIf
EndSelect
EndIf
Wend
' }
' Check if an ingame client sent packets or packets need sending. {
For Local l_IGPlayer:TPlayer = EachIn TPlayer.InGame
Local l_Skip:Byte = False
If l_IGPlayer = Null Then Print "Fatal Error: Ran into ingame client, which apparently doesn't exist. Skipping."; Continue
' Check if the Player still has his TCP Socket open, otherwise drop him.
If l_IGPlayer.m_InfoSocket.Connected() = False Then
Print RSet(l_IGPlayer.m_UniqueId, 6) + ": Closed connection."
' Create InfoLogout packet.
Local l_InfoLogout:TInfoLogout = New TInfoLogout
l_InfoLogout.m_UniqueId = l_IGPlayer.m_UniqueId
' Remove the player from nearby other players.
NetPacketBufferStream.Seek(0)
Local l_Size:Int = l_InfoLogout.Write(NetPacketBufferStream)
For Local l_IGPlayerKnown:TPlayer = EachIn l_IGPlayer.__KnownPlayers:TList
l_IGPlayerKnown.m_InfoSocket.Send(NetPacketBuffer._buf, l_Size)
l_IGPlayerKnown.__KnownPlayers.Remove(l_IGPlayer)
Next
l_IGPlayer.Destroy();Continue
EndIf
' TCP: Do we have any incoming data from this player?
While l_IGPlayer.m_InfoSocket.ReadAvail() > 0
Local l_ReadLength:Int = l_IGPlayer.m_InfoSocket.Recv(NetPacketBuffer._buf, 1);NetPacketBufferStream.Seek(0)
If l_ReadLength = 1
Local l_PacketId:Byte = NetPacketBufferStream.ReadByte()
NetPacketBufferStream.Seek(0)
Select l_PacketId
Case TInfoLogin.Id
l_IGPlayer.m_InfoSocket.Recv(NetPacketBuffer._buf, TInfoLogin.Size)
Case TInfoLogout.Id
l_IGPlayer.m_InfoSocket.Recv(NetPacketBuffer._buf, TInfoLogout.Size)
Local l_InfoLogout:TInfoLogout = TInfoLogout(TInfoLogout.Read(NetPacketBufferStream))
l_InfoLogout.m_UniqueId = l_IGPlayer.m_UniqueId
' Send information to other clients.
NetPacketQueueTCPSwap.AddLast(l_InfoLogout)
Print RSet(l_IGPlayer.m_UniqueId, 6) + ": Logged out."
l_IGPlayer.Destroy();l_Skip = True;Exit
EndSelect
EndIf
Wend
If l_Skip = True Then Continue
' TCP: Do we have any data for this player? If so then send it out.
If NetPacketQueueTCP.Count() > 0 Then
For Local l_Packet:TNetPacket = EachIn NetPacketQueueTCP
NetPacketBufferStream.Seek(0)
l_IGPlayer.m_InfoSocket.Send(NetPacketBuffer._buf, l_Packet.Write(NetPacketBufferStream))
Next
EndIf
' UDP: If a DataUpdate is needed, send it.
If l_IGPlayer.m_TicksOnline Mod DataTicks Then
For Local l_IGPlayer2:TPlayer = EachIn TPlayer.InGame
If l_IGPlayer2 = l_IGPlayer Then Continue
If l_IGPlayer.IsInRange(l_IGPlayer2) Then ' Is this player even in range? If yes, continue
If Not l_IGPlayer.IsKnown(l_IGPlayer2) Then ' This client is new to him, need to introduce him first.
Local l_InfoLogin:TInfoLogin = (New TInfoLogin)
l_InfoLogin.m_UniqueId = l_IGPlayer2.m_UniqueId
l_InfoLogin.m_Name = l_IGPlayer2.m_Name
l_InfoLogin.m_Position[0] = l_IGPlayer2.m_Position[0]
l_InfoLogin.m_Position[1] = l_IGPlayer2.m_Position[1]
l_InfoLogin.m_Position[2] = l_IGPlayer2.m_Position[2]
l_InfoLogin.m_Rotation[0] = l_IGPlayer2.m_Rotation[0]
l_InfoLogin.m_Rotation[1] = l_IGPlayer2.m_Rotation[1]
l_InfoLogin.m_Rotation[2] = l_IGPlayer2.m_Rotation[2]
NetPacketBufferStream.Seek(0)
l_IGPlayer.m_InfoSocket.Send(NetPacketBuffer._buf, l_InfoLogin.Write(NetPacketBufferStream))
EndIf
Local l_DataUpdate:TDataUpdate = l_IGPlayer.GetDataUpdate(l_IGPlayer)
If l_DataUpdate Then
NetPacketBufferStream.Seek(0)
l_IGPlayer.m_DataSocket.Send(NetPacketBuffer._buf, l_DataUpdate.Write(NetPacketBufferStream))
EndIf
Else
If l_IGPlayer.IsKnownEx(l_IGPlayer2) Then ' This client is known to him, need to remove him.
Local l_InfoLogout:TInfoLogout = (New TInfoLogout)
l_InfoLogout.m_UniqueId = l_IGPlayer2.m_UniqueId
NetPacketBufferStream.Seek(0)
l_IGPlayer.m_InfoSocket.Send(NetPacketBuffer._buf, l_InfoLogout.Write(NetPacketBufferStream))
EndIf
EndIf
Next
EndIf
' UDP: Do we have any data for this player? If so then send it out.
If NetPacketQueueUDP.Count() > 0 Then
For Local l_Packet:TNetPacket = EachIn NetPacketQueueUDP
NetPacketBufferStream.Seek(0)
l_IGPlayer.m_DataSocket.Send(NetPacketBuffer._buf, l_Packet.Write(NetPacketBufferStream))
Next
EndIf
l_IGPlayer.m_TicksOnline :+ 1
Next
' }
' }
' Swap Network Packet Queue.
NetPacketQueueTCP.Swap(NetPacketQueueTCPSwap)
NetPacketQueueUDP.Swap(NetPacketQueueUDPSwap)
NetPacketQueueTCPSwap.Clear()
NetPacketQueueUDPSwap.Clear()
l_LoopTimer.Wait()
Until False
DataSocket.Close()
InfoSocket.Close()
End
'--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
Type TPlayer
'! Array that tells us if an Id is in use. Toggle the bit you were using if an object is created or dies.
Global UniqueIds:Byte[] = (New Byte[8192])
Global UIDToPlayer:TPlayer[] = (New TPlayer[65536])
'! List of active players
Global PreGame:TList = (New TList)
Global InGame:TList = (New TList)
' Constants {
Const NAME_LENGTH:Int = 16
Const CHANGED_POSX:Byte = $00000001
Const CHANGED_POSY:Byte = $00000010
Const CHANGED_POSZ:Byte = $00000100
Const CHANGED_ROTX:Byte = $00001000
Const CHANGED_ROTY:Byte = $00010000
Const CHANGED_ROTZ:Byte = $00100000
Const CHANGED_VEL:Byte = $01000000
Const CHANGED_SHOOT:Byte = $10000000
' }
' Identification
Field m_UniqueId:Short
Field m_Name:Byte[]
' Ship Data
Field m_Changed:Byte
Field m_Position:Float[]
Field m_Rotation:Short[]
Field m_Velocity:Short[]
' Network Data
Field m_InfoSocket:TSocket
Field m_DataSocket:TSocket
Field m_Time:Int
Field m_TicksOnline:Int
' Initialize and Create new Players {
Method New()
' Some Network Data
m_Time = MilliSecs()
m_TicksOnline = 0
' Identification
m_Name = New Byte[TPlayer.NAME_Length]
m_UniqueID = 0
' Ship Data
m_Position = New Float[3]
m_Rotation = New Short[3]
m_Velocity = New Short[3]
TPlayer.PreGame.AddLast(Self)
EndMethod
Function Create:TPlayer(p_InfoSocket:TSocket)
' Make sure the Socket is still alive.
If p_InfoSocket <> Null And p_InfoSocket.Connected() Then
Local l_Player:TPlayer = (New TPlayer)
' Find a Unique ID that is not yet in use.
Local l_UniqueId:Int = 0
While l_UniqueId < 8192
Local l_SubUniqueId:Byte = 0
While l_SubUniqueId < 8
If (TPlayer.UniqueIds[l_UniqueId] & (1 shl l_SubUniqueId)) = 0 Then
' Mark UniqueId as used.
TPlayer.UniqueIds[l_UniqueId] :| (1 shl l_SubUniqueId)
l_Player.m_UniqueId = l_UniqueId * 8 + l_SubUniqueId
' Exit Loops.
l_UniqueId = 65535;l_SubUniqueId = 7
EndIf
l_SubUniqueId :+ 1
Wend
l_UniqueId :+ 1
Wend
If l_UniqueId = 65536 Then ' We have a Unique Id if we hit the unsigned limit for Short.
TPlayer.UIDToPlayer[l_Player.m_UniqueId] = l_Player
l_Player.m_InfoSocket = p_InfoSocket
Return l_Player
EndIf
EndIf
EndFunction
' }
' Deinitalize and Destroy old Players {
Method Destroy()
' Mark UniqueId as unused.
TPlayer.UniqueIds[Int(m_UniqueId / 8)] :& ~(1 Shl (m_UniqueId Mod 8))
TPlayer.UIDToPlayer[m_UniqueId] = Null
' Try and remove from both Player lists.
TPlayer.PreGame.Remove(Self)
TPlayer.InGame.Remove(Self)
' Close remaining Sockets.
If m_InfoSocket Then m_InfoSocket.Close()
If m_DataSocket Then m_DataSocket.Close()
' Destroy Data
m_Name = Null
m_Position = Null
m_Rotation = Null
m_Velocity = Null
m_InfoSocket = Null
m_DataSocket = Null
EndMethod
' }
' Update {
Method Update(p_Multiplier:Float)
Local m_OPositionX:Float = m_Position[0]
Local m_OPositionY:Float = m_Position[1]
Local m_OPositionZ:Float = m_Position[2]
m_Position[0] :+ m_Velocity[0] * p_Multiplier
m_Position[1] :+ m_Velocity[1] * p_Multiplier
m_Position[2] :+ m_Velocity[2] * p_Multiplier
If m_Position[0] <> m_OPositionX Then m_Changed :| TPlayer.CHANGED_POSX
If m_Position[1] <> m_OPositionY Then m_Changed :| TPlayer.CHANGED_POSY
If m_Position[2] <> m_OPositionZ Then m_Changed :| TPlayer.CHANGED_POSZ
EndMethod
' }
' Packets {
Const Range:Int = 3000
Method IsInRange:Byte(p_Player:TPlayer)
Local l_Distance:Float = Abs(p_Player.m_Position[0] - m_Position[0]) + Abs(p_Player.m_Position[1] - m_Position[1]) + Abs(p_Player.m_Position[2] - m_Position[2])
If l_Distance < TPlayer.Range Then Return True
Return False
EndMethod
Field __KnownPlayers:TList = New TList
Method IsKnown:Byte(p_Player:TPlayer)
If Not __KnownPlayers.Contains(p_Player) Then
__KnownPlayers.AddLast(p_Player)
Return False
EndIf
Return True
EndMethod
Method IsKnownEx:Byte(p_Player:TPlayer)
If __KnownPlayers.Contains(p_Player) Then
__KnownPlayers.Remove(p_Player)
Return True
EndIf
Return False
EndMethod
Method GetDataUpdate:TDataUpdate(p_Player:TPlayer)
Local l_Distance:Float = Abs(p_Player.m_Position[0] - m_Position[0]) + Abs(p_Player.m_Position[1] - m_Position[1]) + Abs(p_Player.m_Position[2] - m_Position[2])
If l_Distance < TPlayer.Range And m_Changed Then
Local l_DataUpdate:TDataUpdate = New TDataUpdate
Local l_Changed:Byte = $00000000
l_Changed = m_Changed & (TPlayer.CHANGED_POSX | TPlayer.CHANGED_POSY | TPlayer.CHANGED_POSZ)
If l_Distance < 2000 Then l_Changed = m_Changed & (TPlayer.CHANGED_ROTX | TPlayer.CHANGED_ROTY | TPlayer.CHANGED_ROTZ)
If l_Distance < 1000 Then l_Changed = m_Changed & TPlayer.CHANGED_VEL
l_DataUpdate.m_UniqueId = m_UniqueId
l_DataUpdate.m_Changed = m_Changed
l_DataUpdate.m_Position[0] = m_Position[0]
l_DataUpdate.m_Position[1] = m_Position[1]
l_DataUpdate.m_Position[2] = m_Position[2]
l_DataUpdate.m_Rotation[0] = m_Rotation[0]
l_DataUpdate.m_Rotation[1] = m_Rotation[1]
l_DataUpdate.m_Rotation[2] = m_Rotation[2]
l_DataUpdate.m_Velocity[0] = m_Velocity[0]
l_DataUpdate.m_Velocity[1] = m_Velocity[1]
l_DataUpdate.m_Velocity[2] = m_Velocity[2]
Return l_DataUpdate
EndIf
Return Null
EndMethod
' }
EndType
' Basic Network Packet
Type TNetPacket
Field m_UniqueId:Short
Function Read:TNetPacket(p_Stream:TStream)
EndFunction
Method Write(p_Stream:TStream)
EndMethod
EndType
Type TInfoLogin Extends TNetPacket
Const Id:Byte = 0
Const Size:Int = 34
Global Version:Short = Net_VersionMajor Shl 8 + Net_VersionMinor
Field m_Name:Byte[] = New Byte[TPlayer.NAME_LENGTH]
Field m_Position:Float[] = New Float[3]
Field m_Rotation:Float[] = New Float[3]
Field m_PunchPort:Short
Function Read:TNetPacket(p_Stream:TStream)
Local l_UPDPort:Short = p_Stream.ReadShort()
Local l_Version:Short = p_Stream.ReadShort()
If l_Version = TInfoLogin.Version Then
Local l_Packet:TInfoLogin = New TInfoLogin
p_Stream.ReadBytes(l_Packet.m_Name, TPlayer.NAME_LENGTH)
l_Packet.m_Position[0] = p_Stream.ReadFloat()
l_Packet.m_Position[1] = p_Stream.ReadFloat()
l_Packet.m_Position[2] = p_Stream.ReadFloat()
l_Packet.m_Rotation[0] = p_Stream.ReadFloat()
l_Packet.m_Rotation[1] = p_Stream.ReadFloat()
l_Packet.m_Rotation[2] = p_Stream.ReadFloat()
l_Packet.m_PunchPort = l_UDPPort
Return l_Packet
EndIf
EndFunction
Method Write:Int(p_Stream:TStream)
Local l_Pos:Int = p_Stream.Pos()
p_Stream.WriteByte(TInfoLogin.Id)
p_Stream.WriteShort(m_UniqueId)
p_Stream.WriteShort(TInfoLogin.Version)
p_Stream.WriteBytes(m_Name, TPlayer.NAME_LENGTH)
p_Stream.WriteFloat(m_Position[0])
p_Stream.WriteFloat(m_Position[1])
p_Stream.WriteFloat(m_Position[2])
p_Stream.WriteFloat(m_Rotation[0])
p_Stream.WriteFloat(m_Rotation[1])
p_Stream.WriteFloat(m_Rotation[2])
Return p_Stream.Pos() - l_Pos
EndMethod
EndType
Type TInfoLogout Extends TNetPacket
Const Id:Byte = 1
Const Size:Int = 2
Function Read:TNetPacket(p_Stream:TStream)
Local l_Packet:TInfoLogout = New TInfoLogout
Return l_Packet
EndFunction
Method Write:Int(p_Stream:TStream)
Local l_Pos:Int = p_Stream.Pos()
p_Stream.WriteByte(TInfoLogout.Id)
p_Stream.WriteShort(m_UniqueId)
Return p_Stream.Pos() - l_Pos
EndMethod
EndType
Type TInfoUpdate Extends TNetPacket
Const Id:Byte = 2
Const Size:Int = 18
Field m_Name:Byte[] = New Byte[TPlayer.NAME_LENGTH]
Function Read:TNetPacket(p_Stream:TStream)
Local l_Packet:TInfoUpdate = New TInfoUpdate
l_Packet.m_UniqueId = p_Stream.ReadShort() ~ p_Stream.ReadShort()
p_Stream.ReadBytes(l_Packet.m_Name, TPlayer.NAME_LENGTH)
Return l_Packet
EndFunction
Method Write:Int(p_Stream:TStream)
Local l_Pos:Int = p_Stream.Pos()
p_Stream.WriteByte(TInfoUpdate.Id)
p_Stream.WriteShort(m_UniqueId)
p_Stream.WriteBytes(m_Name, TPlayer.NAME_LENGTH)
Return p_Stream.Pos() - l_Pos
EndMethod
EndType
Type TDataUpdate Extends TNetPacket
Const Id:Byte = 3
Const Size:Int = 3
Field m_Changed:Byte
Field m_Position:Float[] = New Float[3]
Field m_Rotation:Float[] = New Float[3]
Field m_Velocity:Float[] = New Float[3]
Function Read:TNetPacket(p_Stream:TStream)
Local l_Packet:TDataUpdate = New TDataUpdate
l_Packet.m_UniqueId = p_Stream.ReadShort()
l_Packet.m_Changed = p_Stream.ReadByte()
If l_Packet.m_Changed & TPlayer.CHANGED_POSX <> 0 Then l_Packet.m_Position[0] = p_Stream.ReadFloat()
If l_Packet.m_Changed & TPlayer.CHANGED_POSY <> 0 Then l_Packet.m_Position[1] = p_Stream.ReadFloat()
If l_Packet.m_Changed & TPlayer.CHANGED_POSZ <> 0 Then l_Packet.m_Position[2] = p_Stream.ReadFloat()
If l_Packet.m_Changed & TPlayer.CHANGED_ROTX <> 0 Then l_Packet.m_Rotation[0] = Min(Max(p_Stream.ReadShort() / 32767.0, -1.0), 1.0) * 180.0
If l_Packet.m_Changed & TPlayer.CHANGED_ROTY <> 0 Then l_Packet.m_Rotation[1] = Min(Max(p_Stream.ReadShort() / 32767.0, -1.0), 1.0) * 180.0
If l_Packet.m_Changed & TPlayer.CHANGED_ROTZ <> 0 Then l_Packet.m_Rotation[2] = Min(Max(p_Stream.ReadShort() / 32767.0, -1.0), 1.0) * 180.0
If l_Packet.m_Changed & TPlayer.CHANGED_VEL <> 0 Then
l_Packet.m_Velocity[0] = Min(Max(p_Stream.ReadShort() / 32767.0, -1.0), 1.0) * 128.0
l_Packet.m_Velocity[1] = Min(Max(p_Stream.ReadShort() / 32767.0, -1.0), 1.0) * 128.0
l_Packet.m_Velocity[2] = Min(Max(p_Stream.ReadShort() / 32767.0, -1.0), 1.0) * 128.0
EndIf
Return l_Packet
EndFunction
Method Write:Int(p_Stream:TStream)
Local l_Pos:Int = p_Stream.Pos()
p_Stream.WriteByte(TDataUpdate.Id)
p_Stream.WriteShort(m_UniqueId)
p_Stream.WriteByte(m_Changed)
If m_Changed & TPlayer.CHANGED_POSX <> 0 Then p_Stream.WriteFloat(m_Position[0])
If m_Changed & TPlayer.CHANGED_POSY <> 0 Then p_Stream.WriteFloat(m_Position[1])
If m_Changed & TPlayer.CHANGED_POSZ <> 0 Then p_Stream.WriteFloat(m_Position[2])
If m_Changed & TPlayer.CHANGED_ROTX <> 0 Then p_Stream.WriteShort(Min(Max(m_Rotation[0] / 180.0, -1), 1) * 32767)
If m_Changed & TPlayer.CHANGED_ROTY <> 0 Then p_Stream.WriteShort(Min(Max(m_Rotation[1] / 180.0, -1), 1) * 32767)
If m_Changed & TPlayer.CHANGED_ROTZ <> 0 Then p_Stream.WriteShort(Min(Max(m_Rotation[2] / 180.0, -1), 1) * 32767)
If m_Changed & TPlayer.CHANGED_VEL <> 0 Then
p_Stream.WriteShort(Min(Max(m_Velocity[0] / 128.0, -1.0), 1.0) * 32767)
p_Stream.WriteShort(Min(Max(m_Velocity[1] / 128.0, -1.0), 1.0) * 32767)
p_Stream.WriteShort(Min(Max(m_Velocity[2] / 128.0, -1.0), 1.0) * 32767)
EndIf
Return p_Stream.Pos() - l_Pos
EndMethod
EndType
'--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
EndRem
BlitzMax/xaymar.config/README.md
+9
View File
@@ -0,0 +1,9 @@
xaymar.config
=======================
An easy way to load configurations from so called 'DataPaks'. DataPaks were inspired by Minecraft's NBT format and were able to store any arbitrary data. It's still more efficient to have a dedicated format instead of DataPaks, but it helps with compatability across versions. As far as I remember, this is thread-safe.
Documentation at: http://www.blitzforum.de/forum/viewtopic.php?p=388595#388595
License
=======
xaymar.config 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/.
BlitzMax/xaymar.config/config.bmx
+366
View File
@@ -0,0 +1,366 @@
SuperStrict
Import xaymar.datapak
Module xaymar.config
ModuleInfo "License: Public Domain"
ModuleInfo "Original Author: Michael Dirks <support@levelnull.de>"
ModuleInfo "Purpose: Easily read and write configuration files by using xaymar.datapak."
Type TConfig
Field __MainDP:TDataPak
Field __CurrentDP:TDataPak
Method CreateConfig(name:String="Master")
__CurrentDP = Null
If __MainDP <> Null
__MainDP.Destroy()
__MainDP = Null
End If
__MainDP = TDataPak.Create(name)
End Method
Method OpenConfig(url:String,pwd:String="")
__CurrentDP = Null
If __MainDP <> Null
__MainDP.Destroy()
__MainDP = Null
End If
__MainDP = TDataPak.FromFile(url,pwd)
End Method
Method SaveConfig(url:String,pwd:String="")
__MainDP.ToFile(url, TDP_FLAG_COMPRESSED | TDP_FLAG_PASSWORDED, pwd)
End Method
Method CloseConfig()
__CurrentDP = Null
__MainDP.Destroy()
__MainDP = Null
End Method
Method IsConfigOpen:Int()
Return (__MainDP <> Null)
End Method
Method CreateGroup(name:String)
If __MainDP <> Null
Local TVarDP:TDataPakType[] = Null
If __MainDP.GetDataByName(name) <> Null Then
TVarDP = __MainDP.GetDataByName(name)
End If
If TVarDP <> Null And TVarDP[0].GetType() = TDP_CONTAINER
__CurrentDP = TDataPak(TVarDP[0])
Else
__CurrentDP = __MainDP.AddDataContainer(name)
End If
Else
Throw TConfigException.Create("No Config open.")
End If
End Method
Method OpenGroup(name:String)
If __MainDP <> Null
Local TVarDP:TDataPakType[] = Null
If __MainDP.GetDataByName(name) <> Null Then
TVarDP = __MainDP.GetDataByName(name)
End If
If TVarDP <> Null And TVarDP[0].GetType() = TDP_CONTAINER
__CurrentDP = TDataPak(TVarDP[0])
Else
Throw TConfigException.Create("Group '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Config open.")
End If
End Method
Method CloseGroup()
__CurrentDP = Null
End Method
Method IsGroupOpen:Int()
Return (__CurrentDP <> Null)
End Method
Method GetGroupByte:Byte(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_BYTE
Return TDataPakByte(TVarDP).GetData()
Else
Throw TConfigException.Create("Byte '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupShort:Short(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_SHORT
Return TDataPakShort(TVarDP).GetData()
Else
Throw TConfigException.Create("Short '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupInt:Int(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_INT
Return TDataPakInt(TVarDP).GetData()
Else
Throw TConfigException.Create("Int '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupLong:Long(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_LONG
Return TDataPakLong(TVarDP).GetData()
Else
Throw TConfigException.Create("Long '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupFloat:Float(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_FLOAT
Return TDataPakFloat(TVarDP).GetData()
Else
Throw TConfigException.Create("Float '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupDouble:Double(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_DOUBLE
Return TDataPakDouble(TVarDP).GetData()
Else
Throw TConfigException.Create("Double '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupString:String(name:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_STRING
Return TDataPakString(TVarDP).GetData()
Else
Throw TConfigException.Create("String '"+name+"' does not exist.")
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupByteEx:Byte(name:String, def:Byte)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_BYTE
Return TDataPakByte(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupShortEx:Short(name:String, def:Short)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_SHORT
Return TDataPakShort(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupIntEx:Int(name:String, def:Int)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_INT
Return TDataPakInt(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupLongEx:Long(name:String, def:Long)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_LONG
Return TDataPakLong(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupFloatEx:Float(name:String, def:Float)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_FLOAT
Return TDataPakFloat(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupDoubleEx:Double(name:String, def:Double)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_DOUBLE
Return TDataPakDouble(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method GetGroupStringEx:String(name:String, def:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_STRING
Return TDataPakString(TVarDP).GetData()
Else
Return def
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupByte(name:String,data:Byte)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_BYTE
TDataPakByte(TVarDP).SetData(data)
Else
__CurrentDP.AddDataByte(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupShort(name:String,data:Short)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_SHORT
TDataPakShort(TVarDP).SetData(data)
Else
__CurrentDP.AddDataShort(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupInt(name:String,data:Int)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_INT
TDataPakInt(TVarDP).SetData(data)
Else
__CurrentDP.AddDataInt(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupLong(name:String,data:Long)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_LONG
TDataPakLong(TVarDP).SetData(data)
Else
__CurrentDP.AddDataLong(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupFloat(name:String,data:Float)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_FLOAT
TDataPakFloat(TVarDP).SetData(data)
Else
__CurrentDP.AddDataFloat(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupDouble(name:String,data:Double)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_DOUBLE
TDataPakDouble(TVarDP).SetData(data)
Else
__CurrentDP.AddDataDouble(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
Method SetGroupString(name:String,data:String)
If __CurrentDP <> Null
Local TVarDP:TDataPakType = Null, TVarDPA:TDataPakType[] = __CurrentDP.GetDataByName(name)
If TVarDPA.Length > 0 Then TVarDP = TVarDPA[0]
If TVarDP <> Null And TVarDP.GetType() = TDP_STRING
TDataPakString(TVarDP).SetData(data)
Else
__CurrentDP.AddDataString(name,data)
End If
Else
Throw TConfigException.Create("No Group selected.")
End If
End Method
End Type
Type TConfigException
Field Error:String
Method ToString:String()
Return Error
End Method
Function Create:TConfigException(Error:String)
Local TCE:TConfigException = New TConfigException
TCE.Error = Error
Return TCE
End Function
End Type
BlitzMax/xaymar.datapak/README.md
+11
View File
@@ -0,0 +1,11 @@
xaymar.datapak
=======================
A newer iteration of DataCollector, named DataPaks. It was inspired by Minecraft's NBT format and as such has similar features. It supports many types, as well as arrays of such types (in case you don't want to name each entry, useful for inventories). Saved and loaded archives can be passworded and compressed, it is up to you to use that feature. The project includes two examples, which just show how to use the module.
First iteration at: http://www.blitzforum.de/forum/viewtopic.php?t=36694
Documentation at: http://www.blitzforum.de/forum/viewtopic.php?p=388429#388429
License
=======
xaymar.datapak 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/.
BlitzMax/xaymar.datapak/datapak.bmx
+1089
View File
File diff suppressed because it is too large Load Diff
BlitzMax/xaymar.datapak/example1.bmx
+35
View File
@@ -0,0 +1,35 @@
Framework brl.retro
Import xaymar.datapak
'Advanced: Create a new Container
Local DPCnt:TDataPak = New TDataPak
DPCnt.SetName("MyContainer")
'Advanced: Add A new String (or any other Type: Byte, Short, Int, Long, Float, Double, Container)
Local DPStr:TDataPakString = New TDataPakString
DPStr.SetName("MyString")
DPStr.SetData("Hello :D")
DPCnt.AddData(DPStr)
'Easy: Add A new String (or any other Type: Byte, Short, Int, Long, Float, Double, Container)
DPCnt.AddDataString("MyString2", "Hallo :D")
'Easy: Safe to File
'Uncompressed & Unpassworded [sdp = Standard Data Pak]
DPCnt.ToFile("Test.sdp")
'Compressed & Unpassworded [cdp = Compressed Data Pak]
DPCnt.ToFile("Test.cdp", TDP_FLAG_COMPRESSED)
'Uncompressed & Passworded [pdp = Passworded Data Pak]
DPCnt.ToFile("Test.pdp", TDP_FLAG_PASSWORDED, "MyPassword")
'Compressed & Passworded [mdp = Merged Data Pak]
DPCnt.ToFile("Test.mdp", TDP_FLAG_PASSWORDED | TDP_FLAG_COMPRESSED, "MyPassword")
'Easy: Loading from File
'Uncompressed & Unpassworded [sdp = Standard Data Pak]
Local DPCntS:TDataPak = TDataPak.FromFile("Test.sdp")
'Compressed & Unpassworded [cdp = Compressed Data Pak]
Local DPCntC:TDataPak = TDataPak.FromFile("Test.cdp")
'Uncompressed & Passworded [pdp = Passworded Data Pak]
Local DPCntP:TDataPak = TDataPak.FromFile("Test.pdp", "MyPassword")
'Compressed & Passworded [mdp = Merged Data Pak]
Local DPCntM:TDataPak = TDataPak.FromFile("Test.mdp", "MyPassword")
BlitzMax/xaymar.datapak/example2.bmx
+27
View File
@@ -0,0 +1,27 @@
Framework brl.retro
Import xaymar.datapak
'Testing consistency of DataPaks
Local DPCnt:TDataPak = New TDataPak
DPCnt.SetName("My Container")
DPCnt.AddDataByte("My Byte", 127)
DPCnt.AddDataShort("My Short", 256)
DPCnt.AddDataInt("My Int", 65536)
DPCnt.AddDataLong("My Long", 618317896391:Long)
DPCnt.AddDataFloat("My Float", 1.23456789)
DPCnt.AddDataDouble("My Double", 1.2345678912345:Double)
DPCnt.AddDataString("My String", "Totally not yours!")
Local DPSCnt:TDataPak = DPCnt.AddDataContainer("My SubContainer")
DPSCnt.AddDataByte("Sub Byte", 127)
DPSCnt.AddDataShort("Sub Short", 256)
DPSCnt.AddDataInt("Sub Int", 65536)
DPSCnt.AddDataLong("Sub Long", 618317896391:Long)
DPSCnt.AddDataFloat("Sub Float", 1.23456789)
DPSCnt.AddDataDouble("Sub Double", 1.2345678912345:Double)
DPSCnt.AddDataString("Sub String", "Totally not hub!")
DPCnt.ToFile("Consistency.sdp")
DPCnt.ToFile("Consistency.cdp", TDP_FLAG_COMPRESSED)
DPCnt.ToFile("Consistency.pdp", TDP_FLAG_PASSWORDED, "ThisIsATotallyUnsecurePasswordWithUnknownLengthToYouBecauseIDidn'tTellYouItsLength!")
DPCnt.ToFile("Consistency.mdp", TDP_FLAG_COMPRESSED | TDP_FLAG_PASSWORDED, "ThisIsATotallyUnsecurePasswordWithUnknownLengthToYouBecauseIDidn'tTellYouItsLength!")
BlitzMax/xaymar.desktop/README.md
+8
View File
@@ -0,0 +1,8 @@
xaymar.desktop
=======================
An attempt at rendering to the desktop. Failed, mind you. The module it references no longer exists, no idea what it even added.
License
=======
xaymar.desktop 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/.
BlitzMax/xaymar.desktop/Test01.bmx
+104
View File
@@ -0,0 +1,104 @@
SuperStrict
Framework BRL.StandardIO
Import Xaymar.Desktop
Import Pub.DirectX
Import Pub.Win32
Import MaxGUI.Win32MaxGUIEx
Extern "win32"
Function GetLastError() = "GetLastError@0"
EndExtern
Global d3dx9Lib:Int = LoadLibraryA( "d3dx9" )
DebugLog GetLastError()
If d3dx9Lib Then
Global D3DXAssembleShader:Int(pSrcData:Byte Ptr, SrcDataLen:Int, pDefines:Byte Ptr, pInclude:Byte Ptr, FLAGS:Int, ppShader:ID3DXBuffer Var, ppErrorMsgs:ID3DXBuffer Var)"win32"=GetProcAddress( d3dx9Lib,"D3DXAssembleShader" )
Global D3DXSaveSurfaceToFile:Int(pConstString:Byte Ptr, DestFormat:Int, pSurface:Byte Ptr, pSrcPalette:Byte Ptr, pSrcRect:Byte Ptr)"win32"=GetProcAddress( d3dx9Lib, "D3DXSaveSurfaceToFile" )
EndIf
Local l_Displays:TList = GetDisplayList()
For Local l_Display:Rect = EachIn l_Displays
Print "[" + l_Display.Left + ", " + l_Display.Top + "]:[" + l_Display.Right + ", " + l_Display.Bottom + "]"
Next
Local l_Display:Rect = Rect(l_Displays.ValueAtIndex(0))
Local l_D3D:IDirect3D9 = Direct3DCreate9( 32 )
If Not l_D3D Then
Print "0x00000001"
Else
Local l_D3DCaps:D3DCAPS9 = New D3DCAPS9
If l_D3D.GetDeviceCaps(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, l_D3DCaps) < 0
Print "0x00000002"
Else
Local l_D3DPresentParam:D3DPRESENT_PARAMETERS = New D3DPRESENT_PARAMETERS
l_D3DPresentParam.BackBufferWidth = (l_Display.Right - l_Display.Left)
l_D3DPresentParam.BackBufferHeight = (l_Display.Bottom - l_Display.Top)
l_D3DPresentParam.BackBufferCount = 1
l_D3DPresentParam.BackBufferFormat = D3DFMT_UNKNOWN
l_D3DPresentParam.MultiSampleType = D3DMULTISAMPLE_NONE
l_D3DPresentParam.SwapEffect = D3DSWAPEFFECT_DISCARD
l_D3DPresentParam.hDeviceWindow = Null
l_D3DPresentParam.Windowed = True
l_D3DPresentParam.Flags = D3DPRESENTFLAG_LOCKABLE_BACKBUFFER | D3DPRESENTFLAG_VIDEO
l_D3DPresentParam.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE
Local l_WindowName:String = "Null"
Local l_hWnd:Int = CreateWindowExW(0, TWindowsGUIDriver.ClassName(), l_WindowName, 0, 0, 0, 1, 1, Null, Null, Null, Null)
If l_hWnd = 0 Then
Print GetLastError()
Print "0x00000003"
Else
Local l_D3DDevice:IDirect3DDevice9 = Null
If l_D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, l_hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, l_D3DPresentParam, l_D3DDevice) < 0
Print "0x00000004"
Else
Local l_DesktopRT:IDirect3DSurface9 = Null
Local l_RecordRT:IDirect3DSurface9 = Null
If l_D3DDevice.GetRenderTarget(0, l_DesktopRT) < 0
Print "0x00000005"
Else
Local l_D3DDisplayMode:D3DDISPLAYMODE = New D3DDISPLAYMODE
If l_D3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, l_D3DDisplayMode) < 0
Print "0x00000006"
Else
If l_D3DDevice.CreateOffscreenPlainSurface(l_D3DDisplayMode.Width, l_D3DDisplayMode.Height, l_D3DDisplayMode.Format, D3DPOOL_SYSTEMMEM, l_RecordRT, Null) < 0
Print "0x00000007"
Else
If l_D3DDevice.GetRenderTargetData(l_DesktopRT, l_RecordRT) < 0
Print "0x00000008"
Else
Local File:String = "C:\Dokumente und Einstellungen\Teilnehmer\Desktop\" + MilliSecs() + ".png"
Local FileCStr:Byte Ptr = File.ToCString()
Print D3DXSaveSurfaceToFile(FileCStr, 3, Byte Ptr(l_RecordRT), Null, Null)
If D3DXSaveSurfaceToFile(FileCStr, 3, Byte Ptr(l_RecordRT), Null, Null) <> 0
Print "0x00000009"
Else
Print "Success?"
EndIf
MemFree FileCStr
EndIf
l_RecordRT.Release_
EndIf
l_D3DDisplayMode = Null
EndIf
l_DesktopRT.Release_
EndIf
EndIf
DestroyWindow l_hWnd
EndIf
EndIf
l_D3D.Release_
EndIf
Rem
//copy the render target to the destination surface.
hr = Device->GetRenderTargetData(pRenderTarget, pDestTarget);
//save its contents to a bitmap file.
hr = D3DXSaveSurfaceToFile(file,
D3DXIFF_BMP,
pDestTarget,
NULL,
NULL);
BlitzMax/xaymar.resource/README.md
+11
View File
@@ -0,0 +1,11 @@
xaymar.resource
=======================
I created this back when multi-threading was highly praised for the features it could give you. This allows you to load anything asynchronous and still know how far the loading process is. Easily extendable as it was designed to work flawlessly with as many types as possible. Requires threading, otherwise it will just be synchronous.
Supports both basic BRL modules as well as xaymar.datapak, which allows you to load large files without the program hanging up for a while. Thank god for threading!
Documentation at: http://www.blitzforum.de/forum/viewtopic.php?p=390021#390021
License
=======
xaymar.resource 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/.
BlitzMax/xaymar.resource/brl-support.bmx
+166
View File
@@ -0,0 +1,166 @@
'!BRL.Audio + AudioSample
Import brl.audio
Import brl.audiosample
Type TSoundResource Extends TResource
Field Flags:Int
Method SetSound(Name:String, File:String, Flags:Int=-1)
Self.Flags = Flags
Set(Name,File)
EndMethod
Method _Load()
Self.Resource = LoadSound(Self.File, Self.Flags)
EndMethod
End Type
Type TAudioSampleResource Extends TResource
Method _Load()
Self.Resource = LoadAudioSample(Self.File)
End Method
End Type
'!BRL.Bank + BRL.BankStream
Import brl.bank
Type TBankResource Extends TResource
Method _Load()
Self.Resource = LoadBank(Self.File)
End Method
Method _Save()
SaveBank(TBank(Self.Resource), Self.File)
End Method
End Type
'!BRL.Font
Import brl.font
Type TFontResource Extends TResource
Field Size:Int
Field Style:Int
Method SetFont(Name:String, File:String, Size:Int, Style:Int=SMOOTHFONT)
Self.Size = Size
Self.Style = Style
Set(Name,File)
EndMethod
Method _Load()
Self.Resource = LoadFont(Self.File, Self.Size, Self.Style)
End Method
End Type
'BRL.Max2D
Import brl.max2d
Type TImageResource Extends TResource
Field Flags:Int = -1
Field Animated:Int = False
Field CellWidth:Int = 0
Field CellHeight:Int = 0
Field FirstCell:Int = 0
Field CellCount:Int = 0
Method SetImage(Name:String, File:String, Flags:Int=-1)
Self.Flags = Flags
Self.Animated = False
Set(Name,File)
End Method
Method SetAnimImage(Name:String, File:String, CellWidth:Int, CellHeight:Int, FirstCell:Int, CellCount:Int, Flags:Int=-1)
Self.Flags = Flags
Self.Animated = True
Self.CellWidth = CellWidth
Self.CellHeight = CellHeight
Self.FirstCell = FirstCell
Self.CellCount = CellCount
Set(Name,File)
EndMethod
Method _Load()
If Self.Animated = False
Self.Resource = LoadImage(Self.File, Self.Flags)
Else
Self.Resource = LoadAnimImage(Self.File, Self.CellWidth, Self.CellHeight, Self.FirstCell, Self.CellCount, Self.Flags)
EndIf
EndMethod
End Type
'BRL.Pixmap
Import brl.pixmap
Import brl.bmploader
Import brl.jpgloader
Import brl.pngloader
Import brl.tgaloader
Type TPixmapResource Extends TResource
Field IsPNG:Int
Field Parameter:Int
Method SetPixmapJPG(Name:String, File:String, Quality:Int=75)
Self.IsPNG = False
Self.Parameter = Quality
Set(Name, File)
End Method
Method SetPixmapPNG(Name:String, File:String, Compression:Int=5)
Self.IsPNG = True
Self.Parameter = Compression
Set(Name, File)
End Method
Method _Load()
Self.Resource = LoadPixmap(Self.File)
End Method
Method _Save()
If IsPNG = True
SavePixmapPNG(TPixmap(Self.Resource), Self.File, Self.Parameter)
Else
SavePixmapJPeg(TPixmap(Self.Resource), Self.File, Self.Parameter)
EndIf
End Method
End Type
'BRL.Stream
Import brl.stream
Type TByteArrayResource Extends TResource
Method _Load()
Self.Resource = LoadByteArray(Self.File)
End Method
Method _Save()
SaveByteArray(Byte[](Self.Resource), Self.File)
End Method
End Type
Type TObjectResource Extends TResource
Method _Load()
Self.Resource = LoadObject(Self.File)
End Method
Method _Save()
SaveObject(Self.Resource, Self.File)
End Method
End Type
Type TStringResource Extends TResource
Method _Load()
Self.Resource = LoadString(Self.File)
End Method
Method _Save()
SaveString(String(Self.Resource), Self.File)
End Method
End Type
Type TStreamResource Extends TResource
Field Readable:Int = False
Field Writeable:Int = False
Method SetStream(Name:String, File:String, Readable:Int, Writeable:Int)
Readable = Readable
Writeable = Writeable
Set(Name, File)
End Method
Method _Load()
Self.Resource = OpenStream(Self.File, Self.Readable, Self.Writeable)
End Method
Method _Save()
FlushStream(TStream(Self.Resource))
End Method
End Type
'BRL.TextStream
Import brl.textstream
Type TTextResource Extends TResource
Method _Load()
Self.Resource = LoadText(Self.File)
End Method
End Type
BlitzMax/xaymar.resource/datapak-support.bmx
+37
View File
@@ -0,0 +1,37 @@
'Xaymar.DataPak
Import xaymar.datapak
Type TDataPakResource Extends TResource
Field Password:String
Field Compressed:Int
Field Stream:TStream
Method SetDataPak(Name:String, URL:Object, Password:String="", Compressed:Int=False)
Self.Password = Password
Self.Compressed = Compressed
If TStream(URL) <> Null Then
Self.Stream = TStream(URL)
Set(Name, "")
ElseIf String(URL) <> Null Then
Self.Stream = Null
Set(Name, String(URL))
EndIf
End Method
Method _Load()
If Stream = Null
Self.Resource = TDataPak.FromFile(Self.File, Self.Password)
Else
Self.Resource = TDataPak.FromStream(Self.Stream)
End If
End Method
Method _Save()
Local _Flags:Byte
If Self.Password <> "" Then _Flags :+ TDP_FLAG_PASSWORDED
If Self.Compressed <> 0 Then _Flags :+ TDP_FLAG_COMPRESSED
If Stream = Null
TDataPak(Self.Resource).ToFile(Self.File, _Flags, Self.Password)
Else
TDataPak(Self.Resource).ToStream(Self.Stream)
End If
End Method
End Type
BlitzMax/xaymar.resource/example-NoThreading.bmx
+106
View File
@@ -0,0 +1,106 @@
'Xaymar.Resource: Test 01
' Loading of Images and Sounds
SuperStrict
Import xaymar.resource
Import xaymar.brlaudio
Import xaymar.brlmax2d
Import brl.audio
Import brl.max2d
Graphics(800,600,0,60)
SetVirtualResolution(100,100)
Global MyResource:TResourceManager = New TResourceManager
Local imgDir:String[] = LoadDir("data/img/")
For Local fileImg:String = EachIn imgDir
Local _Res:TImageResource = New TImageResource
_Res.SetImage(fileImg, "data/img/"+fileImg)
MyResource.AddResource(_Res)
Next
Local sndDir:String[] = LoadDir("data/snd/")
For Local fileSnd:String = EachIn sndDir
Local _Res:TSoundResource = New TSoundResource
_Res.SetSound(fileSnd, "data/snd/"+fileSnd)
MyResource.AddResource(_Res)
Next
Local _ExitLoad:Int = False
Repeat
Cls
Local _BarPerc:Float = Float(MyResource.GetCount(TRM_LOADED)) / Float(MyResource.GetCount(TRM_ALL))
Local _BarPercLoad:Float = Float(MyResource.GetCount(TRM_LOADING)) / Float(MyResource.GetCount(TRM_ALL))
Local _BarPercError:Float = Float(MyResource.GetCount(TRM_ERROR)) / Float(MyResource.GetCount(TRM_ALL))
Local _BarColorMod:Float = 0.5+Sin( Float(MilliSecs()) / Float(1000/360) )*0.5
SetBlend ALPHABLEND
SetColor 102+153*_BarColorMod, 102+153*_BarColorMod, 102+153*_BarColorMod
DrawLine( 5, 90, 95, 90)
DrawLine( 5, 90, 5, 95)
DrawLine( 5, 95, 95, 95)
DrawLine(95, 90, 95, 95)
SetAlpha 0.9+0.1*_BarColorMod
SetColor 51, 255, 51
DrawRect( 6, 91, 89*_BarPerc, 4)
SetAlpha 0.8+0.2*_BarColorMod
SetColor 255, 255, 51
DrawRect( 6+89*_BarPerc, 91, 89*_BarPercLoad, 4)
SetAlpha 0.7+0.3*_BarColorMod
SetColor 255, 51, 51
DrawRect( 6+89*_BarPerc+89*_BarPercLoad, 91, 89*_BarPercError, 4)
SetColor 255,255,255
SetAlpha 1.0*_BarColorMod*_BarPerc
DrawRect( 5.5, 90.5, 90, 5)
SetAlpha 0.8
SetVirtualResolution(GraphicsWidth(),GraphicsHeight())
DrawText("Complete %:"+Int(_BarPerc*100),0,0)
DrawText("Loading %:"+Int(_BarPercLoad*100),0,15)
DrawText("Errored %:"+Int(_BarPercError*100),0,30)
If MyResource.GetResource(TRM_NONE) <> Null
DrawText(MyResource.GetResource(TRM_NONE).File,800*0.05,600*0.80)
Else
DrawText("Done, Press any key to continue...",800*0.05,600*0.80)
EndIf
SetVirtualResolution(100,100)
Flip
Local LRCode:Int = MyResource.LoadResource()
MyResource.Update() 'Update Count
If AppTerminate()
End
End If
If LRCode = TRM_LS_NORESOURCE
For Local I:Int = 0 To 255
If KeyDown(I) = True
_ExitLoad = True
End If
Next
End If
Until _ExitLoad = True
SetVirtualResolution(GraphicsWidth(),GraphicsHeight())
Print "Resource List:"
For Local _Res:TResource = EachIn MyResource.GetResources(TRM_ALL)
Select _Res._State
Case TRM_LOADED, TRM_SAVED
Print " SUCCESS: ["+_Res.Name+"]"+_Res.File
Case TRM_LOADING, TRM_SAVING
Print " STUCK: ["+_Res.Name+"]"+_Res.File
Case TRM_ERROR, TRM_NONE
Print " FAILED: ["+_Res.Name+"]"+_Res.File + " //"+_Res.Exception.ToString()
End Select
Next
End
BlitzMax/xaymar.resource/resource.bmx
+299
View File
@@ -0,0 +1,299 @@
SuperStrict
?Threaded
Import brl.threads
?
Import brl.linkedlist
Module xaymar.resource
ModuleInfo "License: Public Domain"
ModuleInfo "Original Author: Michael Dirks <support@levelnull.de>"
ModuleInfo "Purpose: Load your Files the better way! (Threading supported)"
Const TRM_SAVED:Int = -2
Const TRM_SAVING:Int = -1
Const TRM_NONE:Int = +0
Const TRM_LOADING:Int = +1
Const TRM_LOADED:Int = +2
Const TRM_ERROR:Int = $FF
Const TRM_ALL:Int = $FE
Const TRM_LS_ERROR:Int = 0
Const TRM_LS_SUCCESS:Int = 1
Const TRM_LS_NORESOURCE:Int = 2
Type TRLException
Method ToString:String()
Return "An Error appeared during Loading/Saving the Object."
End Method
End Type
Type TResourceManager
'Members
Field _ResList:TList = New TList
Field _ResourceLoaderFunc(Res:TResource)
Field _ResourceSaverFunc(Res:TResource)
'Members: Stats
Field _SavingRes:Int, _SavedRes:Int
Field _TotalRes:Int, _ErrorRes:Int
Field _LoadingRes:Int, _LoadedRes:Int
'Threaded Members
?Threaded Field _ResMutex:TMutex = CreateMutex()
?
'Methods
Method New();SetLoaderFunc(TResourceLoaderFunc);SetSaverFunc(TResourceSaverFunc);End Method
Method Remove()
?Threaded _ResMutex.Lock()
?
_ResList.Clear()
_ResList = Null
?Threaded _ResMutex.Unlock()
_ResMutex.Close()
_ResMutex = Null
?
End Method
Method SetLoaderFunc(LoaderFunc:Byte Ptr)
_ResourceLoaderFunc = LoaderFunc
End Method
Method SetSaverFunc(SaverFunc:Byte Ptr)
_ResourceSaverFunc = SaverFunc
End Method
Method Update()
?Threaded _ResMutex.Lock()
?
_TotalRes = _ResList.Count()
_LoadingRes = 0;_SavingRes = 0
_LoadedRes = 0;_SavedRes = 0
_ErrorRes = 0;
For Local _Res:TResource = EachIn _ResList
Select _Res._State
Case TRM_LOADING
_LoadingRes :+ 1
Case TRM_LOADED
_LoadedRes :+ 1
Case TRM_SAVING
_SavingRes :+ 1
Case TRM_SAVED
_SavedRes :+ 1
Case TRM_NONE
Default
_ErrorRes :+ 1
End Select
Next
?Threaded _ResMutex.Unlock()
?
End Method
Method GetCount:Int(Which:Int)
Select Which
Case TRM_NONE
Return _TotalRes-_LoadedRes-_LoadingRes-_SavedRes-_SavingRes-_ErrorRes
Case TRM_LOADING
Return _LoadingRes
Case TRM_LOADED
Return _LoadedRes
Case TRM_SAVING
Return _SavingRes
Case TRM_SAVED
Return _SavedRes
Case TRM_ERROR
Return _ErrorRes
Case TRM_ALL
Return _TotalRes
Default
Return 0
End Select
EndMethod
Method AddResource(Res:TResource)
?Threaded _ResMutex.Lock()
?
_ResList.AddLast(Res)
Res._State = TRM_NONE
?Threaded _ResMutex.Unlock()
?
End Method
Method RemoveResourceName(Name:String)
?Threaded _ResMutex.Lock()
?
For Local _Res:TResource = EachIn _ResList
If _Res.Name = Name Then
_ResList.Remove(_Res)
_Res = Null
End If
Next
?Threaded _ResMutex.Unlock()
?
End Method
Method RemoveResource(Res:TResource)
?Threaded _ResMutex.Lock()
?
_ResList.Remove(Res)
?Threaded _ResMutex.Unlock()
?
End Method
Method ClearResource(Which:Int=TRM_ALL)
?Threaded _ResMutex.Lock()
?
_ResList.Clear()
?Threaded _ResMutex.Unlock()
?
End Method
Method GetResourceName:TResource(Name:String, Which:Int=TRM_ALl)
Local _rRes:TResource
?Threaded _ResMutex.Lock()
?
For Local _Res:TResource = EachIn _ResList
If _Res.Name = Name And (_Res._State = Which Or Which = TRM_ALL)
_rRes = _Res
Exit
EndIf
Next
?Threaded _ResMutex.Unlock()
?
Return _rRes
End Method
Method GetResourcesName:TResource[](Name:String, Which:Int=TRM_ALL)
Local _rList:TList = New TList
?Threaded _ResMutex.Lock()
?
For Local _Res:TResource = EachIn _ResList
If _Res.Name = Name And (_Res._State = Which Or Which = TRM_ALL)
_rList.AddLast(_Res)
EndIf
Next
?Threaded _ResMutex.Unlock()
?
Return TResource[](_rList.ToArray())
End Method
Method GetResource:TResource(Which:Int=TRM_ALl)
Local _rRes:TResource
?Threaded _ResMutex.Lock()
?
For Local _Res:TResource = EachIn _ResList
If (_Res._State = Which Or Which = TRM_ALL)
_rRes = _Res
Exit
EndIf
Next
?Threaded _ResMutex.Unlock()
?
Return _rRes
End Method
Method GetResources:TResource[](Which:Int=TRM_ALL)
Local _rList:TList = New TList
?Threaded _ResMutex.Lock()
?
For Local _Res:TResource = EachIn _ResList
If (_Res._State = Which Or Which = TRM_ALL)
_rList.AddLast(_Res)
EndIf
Next
?Threaded _ResMutex.Unlock()
?
Return TResource[](_rList.ToArray())
End Method
Method LoadResource:Int(Which:Int=TRM_NONE)
Local _Res:TResource = GetResource(Which), _rVal:Int
If _Res = Null
Return TRM_LS_NORESOURCE
Else
?Threaded _ResMutex.Lock()
?
_Res._State = TRM_LOADING
?Threaded _ResMutex.Unlock()
?
_ResourceLoaderFunc(_Res)
?Threaded _ResMutex.Lock()
?
If _Res.Exception = Null And _Res.Resource <> Null
_Res._State = TRM_LOADED
_rVal = TRM_LS_SUCCESS
Else
If _Res.Exception = Null
_Res.Exception = New TRLException
End If
_Res._State = TRM_ERROR
_rVal = TRM_LS_ERROR
End If
?Threaded _ResMutex.Unlock()
?
Return _rVal
End If
End Method
Method SaveResource:Int(Which:Int=TRM_NONE)
Local _Res:TResource = GetResource(Which), _rVal:Int
If _Res = Null
Return TRM_LS_NORESOURCE
Else
?Threaded _ResMutex.Lock()
?
_Res._State = TRM_SAVING
?Threaded _ResMutex.Unlock()
?
_ResourceSaverFunc(_Res)
?Threaded _ResMutex.Lock()
?
If _Res.Exception = Null
_Res._State = TRM_SAVED
_rVal = TRM_LS_SUCCESS
Else
_Res._State = TRM_ERROR
_rVal = TRM_LS_ERROR
End If
?Threaded _ResMutex.Unlock()
?
Return _rVal
End If
End Method
End Type
Type TResource
Field _State:Int
Field Name:String, File:String
Field Resource:Object, Exception:Object
Method New();EndMethod
Method Set(Name:String, File:String)
Self.Name = Name
Self.File = File
Self.Resource = Null
Self.Exception = Null
End Method
Method Remove()
Self.Resource = Null
Self.Exception = Null
Self.File = Null
Self.Name = Null
End Method
Method _Load();End Method
Method _Save();End Method
End Type
Function TResourceLoaderFunc(Res:TResource)
Try
Res._Load()
Catch E:Object
Res.Exception = E
Res.Resource = Null
EndTry
End Function
Function TResourceSaverFunc(Res:TResource)
Try
Res._Save()
Catch E:Object
Res.Exception = E
Res.Resource = Null
EndTry
End Function
HLSL & GLSL Shaders/Flowing Water (GLSL)/DiffuseMap_01.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 938 KiB

HLSL & GLSL Shaders/Flowing Water (GLSL)/Flowmap_01.fw.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 49 KiB

HLSL & GLSL Shaders/Flowing Water (GLSL)/Flowmap_02.fw.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 49 KiB

Some files were not shown because too many files have changed in this diff Show More