After getting into some trouble with "commercial" sprite libraries i decided to try my own. in fact there are only some text functions avaiable yet. Maybe it's something usefull. If you can improve this, please post.
; 3d Text functions
; moonworx entertainment
; http://www.moonworx.de
Graphics3D 1024, 768, 32
SetBuffer BackBuffer()
;Global Plane%
; Constants defining general position of a textobject
Const TXT_TOP% = 1
Const TXT_CENTER% = 2
Const TXT_LEFT% = 3
Const TXT_RIGHT% = 4
Const TXT_BOTTOM% = 5
; Type contains hud definitions
Type mHud
Field Piv% ; Piv
Field Cam% ; Attached camera
Field Width# ; Width
Field Height# ; Height
Field ScaleX# ; X-scale
Field ScaleY# ; Y-scale
Field Visible% ; Visible flag
Field Alpha# ; Alpha
Field Zoom# ; Camerazoom
Field Order% ; Z-order
End Type
Type mLayer
Field Hud%
Field Piv%
Field Mesh%
Field Width#
Field Height#
Field Surface%
Field Font%
Field Parent%
End Type
; Type contains texture definitions
Type mTexture
Field Texture% ; Texture file handle
Field TexWidth# ; Texture width
Field TexHeight# ; Texture height
Field TexFlags% ; Texture flags
End Type
; Type contain font definitions
Type mFont
Field Texture% ; a mTexture type handle
Field CharSize% ; the uniform size of a charsquare within the texture
Field CharUV#
Field Clip%
End Type
Type mText
Field Id%
Field Layer%
Field Txt$
Field Kerning#
Field ScaleX#
Field ScaleY#
Field Rebuild%
End Type
Global Light% ;= CreateLight ()
Global Camera% ;= CreateCamera()
Global CamPiv%
;!=================================================================================================
; Public Function
; Loads a texture in memory and creates a new mTexture type
; File$ = a valid file path
; Flags% = texture flags
; return = mTexture type handle
;!=================================================================================================
Function m_TextureLoad% ( File$, Flags%=2+256 )
Local This.mTexture
This.mTexture = New mTexture
This\Texture = LoadTexture ( File, Flags )
If This\Texture = 0 RuntimeError "m_TextureLoad : " + File + " : No such file !"
This\TexWidth = TextureWidth ( This\Texture )
This\TexHeight = TextureHeight ( This\Texture )
This\TexFlags = Flags
Return Handle ( This )
End Function
;!=================================================================================================
; Public function
; Creates a mTexture type from an already loaded texture
; thus enabling the use of an external resource packer for this texture
; Texture% = a texture handle
; Flags% = texture flags
; return = mTexture type Handle
;!=================================================================================================
Function m_TextureSet% ( Texture%, Flags%=2+256 )
Local This.mTexture
This.mTexture = New mTexture
This\Texture = Texture
If This\Texture = 0 RuntimeError "m_TextureSet : No such texture ! "
This\TexWidth = TextureWidth ( This\Texture )
This\TexHeight = TextureHeight ( This\Texture )
ClearTextureFilters
This\TexFlags = Flags
Return Handle ( This )
End Function
;!=================================================================================================
; Public function
; Retrieves the texture handle from a mTexture type handle
; TextureID% = a mTexture type handle
; return = the texture handle
;!=================================================================================================
Function m_TextureHandle.mTexture ( TextureID% )
Local This.mTexture = Object.mTexture( TextureID )
If This = Null RuntimeError "m_TextureHandle : " + TextureID + " : No such mTexture !"
Return This
End Function
;!=================================================================================================
; Public function
; Creates a font object from a previous defined mTexture type
; this mTexture type should contain a texture holding all 256 ASCII Codes with equal width and height
; all in all it creates a special type of texture
; return = the font handle
;!=================================================================================================
Function m_FontLoad% ( TextureID% )
Local Tmp.mTexture = Object.mTexture ( TextureID )
If Tmp = Null RuntimeError "m_FontLoad : " + TextureID + " : No such mTexture !"
This.mFont = New mFont
This\Texture = Tmp\Texture
This\CharSize = Tmp\TexWidth/ 16
This\CharUV = Float ( This\CharSize ) / Tmp\TexWidth
This\Clip = Tmp\TexWidth / This\CharSize
Return Handle ( This )
End Function
;!=================================================================================================
; Public function
; Creates a font at runtime and saves out to harddisk.
; The Texture contains all 256 ASCII codes with equal width and height
; return = the font handle
;!=================================================================================================
Function m_FontCreate% ( Font$="System", Height%=32, Bold%=False, Size%=512 )
Local TmpFont% = LoadFont ( Font, Height, Bold )
Local TmpTex% = CreateImage ( Size, Size )
Local MaxWidth%, MaxHeight%
Local Offset%
SetFont TmpFont
For i = 0 To 255
Width% = StringWidth ( Chr (i))
Height% = StringHeight ( Chr (i))
If Width > MaxWidth MaxWidth = Width
If Height > MaxHeight MaxHeight = Height
Next
Offset = Size/16
SetBuffer ImageBuffer ( TmpTex )
For i = 0 To 255
Char$ = Chr(i)
If x > Size - Offset
x = 0
y = y + Offset
EndIf
Text x + MaxWidth/2,y,Char, True, False
x = x + Offset
Next
SaveImage ( Tmptex, "Texture.bmp" )
FreeImage TmpTex
FreeFont TmpFont
SetBuffer BackBuffer ()
End Function
;!=================================================================================================
; Public function
; Creates a layer object and assigns a previous defined mTexture type / font
; this layer holds the actual mesh data
; return = the font handle
;!=================================================================================================
Function m_HudCreate% ( Camera%, Zoom#=1.0, Dist#=5.0 )
If EntityClass(Camera) <> "Camera" RuntimeError "m_HudCreate : No such camera !"
Local GW# = GraphicsWidth()
Local GH# = GraphicsHeight()
Local Aspect# = GW/GH
This.mHud = New mHud
This\Piv = CreatePivot (); (Camera)
EntityParent This\Piv,Camera,0
PositionEntity This\Piv,0,0,Dist * Zoom
This\Width = Dist * Zoom
This\Height = This\Width / Aspect
This\Visible = 1
This\Alpha = 1.0
This\Zoom = Zoom
Return Handle ( This )
End Function
;!=================================================================================================
; Public function
; Creates a layer object and assigns a previous defined mTexture type / font
; this layer holds the actual mesh data
; return = the font handle
;!=================================================================================================
Function m_LayerCreate% ( HudId%, FontId% )
Local Parent.mHud = Object.mHud( HudId )
If Parent = Null RuntimeError "m_LayerCreate : " + HudId + " : No such mHud !"
;Local TmpTex.mTexture = Object.mTexture( TextureId )
Local TmpFnt.mFont = Object.mFont ( FontId )
Local Brush = CreateBrush ()
BrushTexture Brush, TmpFnt\Texture
;If TmpTex = Null RuntimeError "m_LayerCreate : " + TextureId + " : No such mTexture !"
This.mLayer = New mLayer
This\Hud = HudId
This\Mesh = CreateMesh()
This\Surface = CreateSurface ( This\Mesh, Brush )
This\Font = FontId
This\Parent = Parent\Piv
EntityParent This\Mesh, Parent\Piv,0
EntityOrder This\Mesh,-999
NameEntity This\Mesh, Handle ( This )
EntityFX This\Mesh, 1+8
FreeBrush Brush
Return Handle ( This )
End Function
;!=================================================================================================
;
;
;!=================================================================================================
Function m_LayerHandle.mLayer ( LayerId% )
Local This.mLayer = Object.mLayer ( LayerId )
If This = Null RuntimeError "m_LayerHandle: " + LayerId + " : No such mLayer !"
Return This
End Function
;!=================================================================================================
; Public function
; Creates a layer object and assigns a previous defined mTexture type / font
; this layer holds the actual mesh data
; return = the font handle
;!=================================================================================================
Function m_TextCreate% ( LayerId%, Txt$, ScaleX#=.25, ScaleY#=.25, Kerning#=.75 )
Local Layer.mLayer = Object.mLayer ( LayerId )
If Layer = Null RuntimeError "m_TextCreate : No such mLayer !"
This.mText = New mText
This\Txt = Txt
This\Layer = LayerId
This\Kerning# = Kerning
This\ScaleX# = ScaleX
This\ScaleY# = ScaleY
m_Render ( This )
Return Handle ( This )
End Function
;!=================================================================================================
; Public function
;!=================================================================================================
Function m_TextSet% ( TxtId%, Txt$ )
Local This.mText = Object.mText ( TxtId% )
If This = Null RuntimeError "m_TextSet : No such mText !"
This\Txt = Txt
This\Rebuild = True
End Function
;!=================================================================================================
; Public function
;!=================================================================================================
Function m_TextPosition ( TxtId%, AlignX%=TXT_CENTER, AlignY%=TXT_CENTER, OffsetX#=0, OffsetY#=0 )
Local X#,Y#
Local This.mText = Object.mText ( TxtId )
If This = Null RuntimeError "m_TextPosition : No such mText !"
Local Lr.mLayer = Object.mLayer ( This\Layer )
Local Hu.mHud = Object.mHud ( Lr\Hud )
Select AlignX
Case TXT_LEFT
X = -Hu\Width + Lr\Width/2
Case TXT_CENTER
X = 0
Case TXT_RIGHT
X = Hu\Width - Lr\Width/2
End Select
Select AlignY
Case TXT_TOP
Y = Hu\Height - Lr\Height/2
Case TXT_CENTER
Y = 0
Case TXT_BOTTOM
Y = -Hu\Height + Lr\Height/2
End Select
PositionEntity Lr\Mesh,X+OffsetX,Y+OffsetY,0
End Function
;!=================================================================================================
; Public function
;!=================================================================================================
Function m_HudUpdate ()
For This.mText = Each mText
If This\Rebuild = True
m_Render ( This )
EndIf
Next
End Function
;!=================================================================================================
; Private function
;!=================================================================================================
Function m_Render ( This.mText )
Local Layer.mLayer = Object.mLayer ( This\Layer )
Local Font.mFont = Object.mFont ( Layer\Font )
Local StartX# = 0.0
Local StartY# = 0.0
Local X# = StartX
Local Y# = StartY
Local W#,H#
ClearSurface ( Layer\Surface )
For i = 1 To Len(This\Txt$)
Char% = Asc(Mid(This\Txt$, i, 1))
If Char% = 13
Y = Y - 1
X = StartX
i = i + 1
Char% = Asc(Mid(This\Txt$, i, 1))
EndIf
While Char% >= Font\Clip
Lines# = Lines + 1
Char% = Char% - Font\Clip
Wend
V# = Lines/Font\Clip
U# = Float(Char%)/Font\Clip
Lines = 0
Vert = AddVertex (Layer\Surface, X, Y,Z,U,V) ; TOP-LEFT
U = U + Font\CharUV
AddVertex (Layer\Surface, X+1,Y,Z,U,V) ; TOP-RIGHT
V = V + Font\CharUV
AddVertex (Layer\Surface, X+1,Y-1, Z,U,V) ; BOTTOM-RIGHT
U = U - Font\CharUV
AddVertex (Layer\Surface, X, Y-1, Z,U,V) ; BOTTOM-LEFT
X = X + This\Kerning
AddTriangle Layer\Surface, Vert, Vert+1, Vert+2
AddTriangle Layer\Surface, Vert+2, Vert+3, Vert
Next
W = MeshWidth ( Layer\Mesh )
H = MeshHeight( Layer\Mesh )
Layer\Width = W * This\ScaleX
Layer\Height = H * This\ScaleY
PositionMesh Layer\Mesh, -(W / 2), H/2,0
ScaleEntity Layer\Mesh, This\ScaleX,This\ScaleY,1
This\Rebuild = False
End Function
;!=================================================================================================
; Public function
; Creates a layer object and assigns a previous defined mTexture type / font
; this layer holds the actual mesh Data
; return = the font handle
;!=================================================================================================
Function PositionEntityFrom2D (usecam, entity, x2d#, y2d#, positionGlobal = 0, camZoom# = 1)
gw = GraphicsWidth ()
gh = GraphicsHeight ()
x# = -((gw / 2) - x2d)
y# = (gh / 2) - y2d
parent = GetParent (entity)
EntityParent entity, usecam
z3d# = Abs (EntityZ (entity))
div# = (gw / (2 / camzoom)) / z3d
PositionEntity entity, x / div, y / div, z3d, positionGlobal
EntityParent entity, parent
End Function
;!=================================================================================================
; Private function
;!=================================================================================================
Function RoundTo# (value#,digit)
Return Int(value*10^digit)/10^digit
End Function
light = CreateLight()
PositionEntity light,10000,10000,-10000
Camera = CreateCamera()
CamPiv = CreatePivot()
EntityParent Camera, CamPiv
PositionEntity Camera, 0, 15, -15
PointEntity Camera, CamPiv
Piv = CreatePivot ()
Cube = CreateCube()
EntityParent CamPiv, Cube
PositionEntity Cube,0,0,10000
m_FontCreate ( "Arial", 32, True )
Tex% = m_Textureload ( "Texture.bmp" )
Font% = m_FontLoad ( Tex )
Hud% = m_HudCreate ( Camera )
Layer% = m_LayerCreate ( Hud, Font )
Layer1% = m_LayerCreate ( Hud, Font )
T1% = m_TextCreate ( Layer, "", .25,.25 )
T2% = m_TextCreate ( Layer1, "Text mesh example - use mouse to move cam", .25, .25 )
m_TextPosition ( T1, TXT_CENTER, TXT_CENTER )
m_TextPosition ( T2, TXT_CENTER, TXT_TOP )
tmp.mLayer = Object.mLayer ( Layer1 )
EntityColor tmp\Mesh,255,0,0
MoveMouse GraphicsWidth()/2, GraphicsHeight()/2
While Not KeyHit ( 1 )
MX = MouseX()
MY = MouseY()
If MY = 0 TranslateEntity Camera, 0, .1, 0
If MY = GraphicsHeight()-1 TranslateEntity Camera, 0, -.1, 0
If MX = 0 TurnEntity CamPiv, 0, .25, 0
If MX = GraphicsWidth()-1 TurnEntity CamPiv, 0, -.25, 0
PositionEntity CamPiv, EntityX ( Piv ), 0, EntityZ ( Piv )
PointEntity Camera, CamPiv
m_TextSet% ( T1, CurrentTime() + Chr(13) + CurrentDate$() )
m_HudUpdate ()
UpdateWorld
RenderWorld
Flip
Wend
ClearWorld
End
----------------------------------
http://www.moonworx.de
|
