A little oopsie had crept into the example above (screen width) - fixed.
Here's an extended version:
Code:
;Point font Extended
;By DK_PETER
DeclareModule _Font
Declare.i Init()
Declare.i Resolution(width.i = -1, height.i = -1)
Declare.i Run()
EndDeclareModule
Module _Font
#DIV = 50.0
Structure _Obj
id.i
ma.i
ms.i
tx.i
EndStructure
Global ob._Obj
Structure _Gad
txt.i
create.i
save.i
font.i
spac.i
laye.i
olin.i
mat.i
EndStructure
Global g._Gad
Structure _bVar
ev.i
w.i
h.i
win.i
scr.i
cam.i
quit.i
fon.i
tmfon.i
EndStructure
Global b._bVar
Structure _Nav
x.f
y.f
z.f
EndStructure
Global n._Nav
Declare.i CreateButton()
Declare.i FontButton()
Declare.i SaveButton()
Declare.i Create(Im.i)
Declare.i OutLine()
Declare.i DoFont()
Declare.i Layers()
Declare.i SpaceBetween()
Declare.i CreateTextures()
Global ol.i = #False, Spacing.f = 0.05, layer.i = 1
Macro RanCol
RGB(Random(255,10), Random(255,50), Random(255,10))
EndMacro
Procedure.i Init()
Protected Ready.i = #True
If InitEngine3D(#PB_Engine3D_DebugLog) = 0
MessageRequester("Engine error!", "Unable to initialize the engine")
ProcedureReturn #False
EndIf
If InitSprite() = 0
MessageRequester("Sprite error!", "Unable to initialize the Sprite")
ProcedureReturn #False
EndIf
If InitKeyboard() = 0
MessageRequester("Keyboard error", "Unable To initialize keyboard")
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i Resolution(width.i = -1, height.i = -1)
Protected num.i, x.i, ypos.i
num = ExamineDesktops()
If width = -1
For x = 0 To num - 1
b\w + DesktopWidth(x)
Next
Else
b\w = width
EndIf
If height = -1
b\h = DesktopHeight(0)
Else
b\h = height
EndIf
ypos = b\h / 20
b\win = OpenWindow(#PB_Any, 0, 0, b\w, b\h, "Point Font Mesh creator V0.01 - by DK_PETER (Arrow keys to rotate and +/- keys to zoom)", #PB_Window_ScreenCentered)
b\scr = OpenWindowedScreen(WindowID(b\win), 0, 0, b\w, b\h-ypos)
g\txt = StringGadget(#PB_Any, 5, b\h - ypos, 300, 30, "")
g\font = ButtonGadget(#PB_Any, 308, b\h - ypos, 100, 30, "Font")
g\create = ButtonGadget(#PB_Any, 410, b\h - ypos, 100, 30, "Create")
g\save = ButtonGadget(#PB_Any, 512, b\h - ypos, 100, 30, "Save")
g\laye = StringGadget(#PB_Any, 614, b\h - ypos, 20, 30, Str(layer), #PB_String_Numeric|#ES_CENTER)
g\spac = StringGadget(#PB_Any, 638, b\h - ypos, 40, 30, StrF(Spacing, 2), #PB_String_Numeric|#ES_CENTER)
g\olin = CheckBoxGadget(#PB_Any, 684, b\h - ypos, 80, 30, "Outlined")
g\mat = ButtonGadget(#PB_Any, 770, b\h - ypos, 100, 30, "Add Material")
GadgetToolTip(g\laye, "Type number of layers (1 to 6)")
GadgetToolTip(g\spac, "Type space number between layers(0.001 to 2.00)")
GadgetToolTip(g\txt, "Type text to convert")
GadgetToolTip(g\mat, "Adds a random material to entity")
BindGadgetEvent(g\create, @CreateButton())
BindGadgetEvent(g\font, @FontButton())
BindGadgetEvent(g\save, @SaveButton())
BindGadgetEvent(g\laye, @Layers())
BindGadgetEvent(g\spac, @SpaceBetween())
BindGadgetEvent(g\olin, @OutLine())
BindGadgetEvent(g\mat, @CreateTextures())
b\fon = LoadFont(#PB_Any, "Arial", 72, #PB_Font_Bold)
b\tmfon = LoadFont(#PB_Any, "Arial", 12,#PB_Font_Bold)
SetGadgetFont(g\txt, FontID(b\tmfon))
SetGadgetText(g\txt, "TEXT TEST!")
;Window part_done...
b\cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
EndProcedure
Procedure.i Run()
Repeat
Repeat
b\ev = WindowEvent()
If b\ev = #PB_Event_CloseWindow : b\quit = #True : EndIf
Until b\ev = 0
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Up)
n\x = -1
ElseIf KeyboardPushed(#PB_Key_Down)
n\x = 1
Else
n\x = 0
EndIf
If KeyboardPushed(#PB_Key_Left)
n\y = 1
ElseIf KeyboardPushed(#PB_Key_Right)
n\y = -1
Else
n\y = 0
EndIf
If KeyboardPushed(#PB_Key_Add)
n\z = 0.5
ElseIf KeyboardPushed(#PB_Key_Subtract)
n\z = -0.5
Else
n\z = 0
EndIf
If IsEntity(ob\id)
MoveEntity(ob\id, 0, 0, n\z)
RotateEntity(ob\id, n\x, n\y, 0, #PB_Relative)
EndIf
RenderWorld()
FlipBuffers()
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape) Or b\quit = #True
EndProcedure
Procedure.i CreateButton()
Protected ret.i
im = DoFont()
ret = Create(im)
EndProcedure
Procedure.i FontButton()
Protected res.i
res = FontRequester("Arial", 12, 0)
If res
If IsFont(b\fon) : FreeFont(b\fon) : EndIf
If IsFont(b\tmfon) : FreeFont(b\tmfon) : EndIf
b\fon = LoadFont(#PB_Any,SelectedFontName(), SelectedFontSize(), SelectedFontStyle())
b\tmfon = LoadFont(#PB_Any,SelectedFontName(), 10, SelectedFontStyle())
SetGadgetFont(g\txt, FontID(b\tmfon))
EndIf
EndProcedure
Procedure.i SpaceBetween()
Protected sp.f = ValF(GetGadgetText(g\spac))
If sp < 0.0 : sp = 0.0 : SetGadgetText(g\spac, "0.0") : EndIf
If sp > 2.0 : sp = 2.0 : SetGadgetText(g\spac, "2.0") : EndIf
Spacing = sp
EndProcedure
Procedure.i SaveButton()
Protected ret.i, nam.s
nam = SaveFileRequester("Save mesh", "font", "Mesh (*.mesh)|*.mesh",0)
If nam <> ""
SaveMesh(ob\ms, nam + ".mesh")
EndIf
EndProcedure
Procedure.i DoFont()
Protected tm.i, im.i, tx.s = GetGadgetText(g\txt)
tm = CreateImage(#PB_Any, 10, 10)
StartDrawing(ImageOutput(tm))
DrawingFont(FontID(b\fon))
w = TextWidth(tx)
h = TextHeight(tx)
StopDrawing()
FreeImage(tm)
im = CreateImage(#PB_Any, w, h, 32, 0)
StartDrawing(ImageOutput(im))
DrawingFont(FontID(b\fon))
DrawingMode(#PB_2DDrawing_Transparent)
If ol = #True
DrawText(0, 0, tx, $FF00FF)
DrawText(6, 0, tx, $FF00FF)
DrawText(0, 4, tx, $FF00FF)
DrawText(6, 4, tx, $FF00FF)
DrawText(3, 2, tx, $0)
Else
DrawText(0, 0, tx, $FF00FF)
EndIf
StopDrawing()
ProcedureReturn im
EndProcedure
Procedure.i OutLine()
If GetGadgetState(g\olin) = #PB_Checkbox_Checked
ol = #True
Else
ol = #False
EndIf
EndProcedure
Procedure.i Layers()
Protected Index.i
If GetGadgetText(g\laye) = "" : SetGadgetText(g\laye, "1") : EndIf
Index = Val(GetGadgetText(g\laye))
If Index = 0 : Index = 1 : EndIf
If index > 6 : index = 6 : EndIf
layer = Index
EndProcedure
Procedure.i CreateTextures()
Protected x.i
If IsEntity(ob\id) > 0
If IsMaterial(ob\ma) > 0 : FreeMaterial(ob\ma) : EndIf
If IsTexture(ob\ma) > 0 : FreeTexture(ob\tx) : EndIf
ob\tx = CreateTexture(#PB_Any, 128, 128)
StartDrawing(TextureOutput(ob\tx))
If Random(100, 0) < 50
If Random(100,50) < 50
For x = 0 To 128 Step 2
Box(x, 0, 2, 128, RanCol)
Next x
Else
For x = 0 To 128 Step 2
Box(0, x, 128, 2, RanCol)
Next x
EndIf
Else
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(RanCol) : BackColor(RanCol)
BoxedGradient(0, 0, 128, 128)
Box(0, 0, 128, 128)
EndIf
StopDrawing()
ob\ma = CreateMaterial(#PB_Any, TextureID(ob\tx))
MaterialBlendingMode(ob\ma, #PB_Material_Add)
SetEntityMaterial(ob\id, MaterialID(ob\ma))
EndIf
EndProcedure
Procedure.i Create(Im.i)
Protected w.i, h.i, x.i, y.i, dw.f, dh.f, cx.i, begin.f, pos.f
w = ImageWidth(Im) : h = ImageHeight(Im)
If IsEntity(ob\id) : FreeEntity(ob\id) : EndIf
If IsMesh(ob\ms) : FreeMesh(ob\ms) : EndIf
If IsMaterial(ob\ma) : FreeMaterial(ob\ma) : EndIf
If IsTexture(ob\tx) : FreeTexture(ob\tx) : EndIf
Protected Dim c.i(w, h)
StartDrawing(ImageOutput(Im))
For y = 1 To h-1
For x = 1 To w-1
If Point(x,y) = $FF00FF
c(x,y) = 1
Else
c(x,y) = 0
EndIf
Next x
Next y
StopDrawing()
dw = ((w/2)*-1)/#DIV
dh = ((h/2)*-1)/#DIV
begin = ((Spacing * Layer) / 2) * -1
ob\ms = CreateMesh(#PB_Any, #PB_Mesh_PointList)
For cx = 1 To layer
pos = begin + (Spacing*cx)
For y = 1 To h
For x = 1 To w
If c(x, y) = 1
MeshVertexPosition(dw+x/#DIV, dh+y/#DIV, pos)
EndIf
Next x
Next y
Next cx
BuildMeshTangents(ob\ms)
FinishMesh(ob\ms)
UpdateMeshBoundingBox(ob\ms)
CreateEntity(ob\id, MeshID(ob\ms), #PB_Material_None, 0, 0, -20)
RotateEntity(ob\id, 180, 0, 0)
FreeImage(Im)
ProcedureReturn #True
EndProcedure
EndModule
If _Font::Init() = #True
_Font::Resolution()
_Font::Run()
EndIf
FAQ
Search
Register
Login
