Code: Select all
;Point font
;By DK_PETER
DeclareModule _Font
Declare.i Init()
Declare.i Resolution(width.i = -1, height.i = -1)
Declare.i Run()
EndDeclareModule
Module _Font
Structure _Obj
id.i
ms.i
EndStructure
Global ob._Obj
Structure _Gad
txt.i
create.i
save.i
font.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 DoFont()
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
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 = width
EndIf
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-100)
g\txt = StringGadget(#PB_Any, 5, b\h-90, 300, 30, "")
g\font = ButtonGadget(#PB_Any, 308, b\h-90, 100, 30, "Font")
g\create = ButtonGadget(#PB_Any, 410, b\h-90, 100, 30, "Create")
g\save = ButtonGadget(#PB_Any, 512, b\h-90, 100, 30, "Save")
GadgetToolTip(g\txt, "Type text to convert")
BindGadgetEvent(g\create, @CreateButton())
BindGadgetEvent(g\font, @FontButton())
BindGadgetEvent(g\save, @SaveButton())
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 = -0.5
ElseIf KeyboardPushed(#PB_Key_Down)
n\x = 0.5
Else
n\x = 0
EndIf
If KeyboardPushed(#PB_Key_Left)
n\y = 0.5
ElseIf KeyboardPushed(#PB_Key_Right)
n\y = -0.5
Else
n\y = 0
EndIf
If KeyboardPushed(#PB_Key_Add)
n\z = 0.1
ElseIf KeyboardPushed(#PB_Key_Subtract)
n\z = -0.1
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 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
tm = CreateImage(#PB_Any, 10, 10)
StartDrawing(ImageOutput(tm))
DrawingFont(FontID(b\fon))
w = TextWidth(GetGadgetText(g\txt))
h = TextHeight(GetGadgetText(g\txt))
StopDrawing()
FreeImage(tm)
im = CreateImage(#PB_Any, w+3, h+3, 32, 0)
StartDrawing(ImageOutput(im))
DrawingFont(FontID(b\fon))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(1, 1, GetGadgetText(g\txt), $FF00FF)
StopDrawing()
ProcedureReturn im
EndProcedure
Procedure.i Create(Im.i)
Protected w.i, h.i, x.i, y.i, dw.f, dh.f
w = ImageWidth(Im) : h = ImageHeight(Im)
;Free old...
If IsEntity(ob\id) : FreeEntity(ob\id) : EndIf
If IsMesh(ob\ms) : FreeMesh(ob\ms) : EndIf
Protected Dim c.i(w, h)
StartDrawing(ImageOutput(Im))
For y = 0 To h-1
For x = 0 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)/30
dh = ((h/2)*-1)/30
ob\ms = CreateMesh(#PB_Any, #PB_Mesh_PointList)
For y = 1 To h
For x = 1 To w
If c(x, y) = 1
MeshVertexPosition(dw+x/30, dh+y/30, 0.05)
MeshVertexPosition(dw+x/30, dh+y/30,-0.05) ;comment this out for one layer only
EndIf
Next x
Next y
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