;; ----------------------------------------------------------------------------
;; FontTool for the IrrlichtWrapper
;; To make it easier to use the new (Irrlich 1.2) AntiAlias-Fonts.
;; (w) 2006 by Michael Taupitz
;; ----------------------------------------------------------------------------

EnableExplicit


;; ////////////////////////////////////////////////////////////////////////////
;; Needed Structures


;; Keep the actual Font-Infos in this Struct.
Structure FontInfoStruct 
  fontid.l 
  fontname.s
  fontsize.l 
  fontcolor.l 
  
  bold.l
  italic.l
  underline.l
  strikeout.l
  hq.l  
EndStructure 


;; Keep the Gadgets in this Structure, to hold them together
Structure GadgetsStruct 
  Img_IrrLogo.l
  Img_Preview.l 
  Combo_TextureWidth.l
  LV_FontList.l
  LV_FontSize.l
  CB_Bold.l 
  CB_Italic.l 
  Btn_About.l
  Btn_Save.l 
  Btn_FontColor.l
  Txt_FontColor.l 
EndStructure 

;Here we keep all the Images we need 
; (the Handle To the Images..)
Structure ImagesStruct 
  IrrLogo.l 
  Preview.l 
  Output.l 
  color.l
EndStructure 


;Structure to keep the important Variable
Structure FontToolStruct
  fontInfo.FontInfoStruct  
  gadgets.GadgetsStruct
  images.ImagesStruct
  textureWidth.l
  windowID.l
  lastpath.s     ; To make the Saving easier
  lastType.s     ; last Filetype....
EndStructure

Structure RGBAstruct 
  Blue.b
  Green.b
  Red.b
  Alpha.b
EndStructure


; Types of Alpha
Enumeration 
  #TGA_ALPHA_NONE             ; No Alpha at all
  #TGA_ALPHA_FULL             ; complete Alpha
  #TGA_ALPHA1                 ; if color = 0 the Alpha (full)
  #TGA_ALPHA8                 ; uses the ALpha-Value from the image
  #TGA_ALPHA_RAMP             ; Ramp alpha a 128 (lower is transparent, higher not)
  #TGA_ALPHA_BRIGHTNESS       ; Uses the Brightness (better Average) as Alpha
  #TGA_ALPHA_HALFTRANSPARENT  ; Sets exactly 'Half-Transparent' ($7f)
EndEnumeration


;; ////////////////////////////////////////////////////////////////////////////
;; Global variables

Global Overall.FontToolStruct 

Define Event.l, GadgetID.l, EventType.l, windowID.l
Define farbe.l

;Needed for the Irrlicht-Logo
UseJPEGImageDecoder()



; Open the Main-Window and set all the Gadgets.
; You have to check the Overall\WindowId after calling this Function,
; to get sure that the Window is created.

Procedure OpenMainWindow()
  Shared Overall;
  Overall\windowID = OpenWindow(#PB_Any, 656, 429, 435, 339, "IrrFontTool IrrWrapper",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
  If Overall\windowID
    If CreateGadgetList(WindowID(Overall\windowID))
      Overall\gadgets\Img_IrrLogo = ImageGadget(#PB_Any, 10, 10, 90, 30, ImageID(CatchImage(#PB_Any, ?IrrLogo)))
      Overall\gadgets\Img_Preview = ImageGadget(#PB_Any, 10, 240, 410, 90, #Null, #PB_Image_Border)
      Overall\gadgets\Combo_TextureWidth = ComboBoxGadget(#PB_Any, 10, 60, 100, 120)
      Overall\gadgets\LV_FontList =  ListViewGadget(#PB_Any, 120, 10, 220, 220)
      Overall\gadgets\LV_FontSize = ListViewGadget(#PB_Any, 350, 10, 70, 220)
      Overall\gadgets\CB_Bold = CheckBoxGadget(#PB_Any, 10, 80, 70, 20, "Bold")      
      Overall\gadgets\CB_Italic = CheckBoxGadget(#PB_Any, 10, 100, 70, 20, "Italic")
      Overall\gadgets\Txt_FontColor = TextGadget(#PB_Any,10,120,70,20,"FontColor")
      Overall\gadgets\Btn_FontColor = ButtonImageGadget(#PB_Any,90,118,20,20,#Null)
      
      Overall\gadgets\Btn_About = ButtonGadget(#PB_Any, 10, 200, 100, 20, "About")
      Overall\gadgets\Btn_Save = ButtonGadget(#PB_Any, 10, 140, 100, 50, "Save Image")
      
    EndIf
  EndIf
EndProcedure



; #############################################################################
; Helper-Function to get the Adress of the Image.

Procedure.l GetImagePtr(ImageNo.l)
  Define *Image.l = 0
  Define ImageID.l
  Define ImageInfo.BITMAP
  Define ImWidth.l, ImHeight.l, ImBytes.l, ImLine.l
  
  ImageID = ImageID(ImageNo)
  If GetObject_(ImageID, SizeOf(BITMAP), @ImageInfo)
    ImWidth  = ImageInfo\bmWidth
    ImHeight = ImageInfo\bmHeight
    ImBytes  = ImageInfo\bmBitsPixel/8
    ImLine   = ImWidth*ImBytes
    *Image   = ImageInfo\bmBits
  EndIf
  ProcedureReturn *Image
EndProcedure 


; #############################################################################
; Helper-Function for the TGA-Encoding.
; Here we can set what 'type' of lpha each pixel is.
;
Procedure _TGAWriter(outfile.l, *iPtr.RGBAstruct, Depth.l, mode.l)
  Select Depth 
    Case 32:  ; Mit alpha      
      WriteByte(outfile,*iPtr\Blue)
      WriteByte(outfile,*iPtr\Green)
      WriteByte(outfile,*iPtr\Red)
      
;      Debug("Red="+Str(*iPtr\red)+",Green="+Str(*iPtr\green)+",Blue="+Str(*iPtr\blue))
              
      Select mode 
        Case #TGA_ALPHA1
          If (*iPtr\Blue + *iPtr\Green + *iPtr\Red) > 0 
            WriteByte(outfile,255)
          Else 
            WriteByte(outfile,0)
          EndIf
         
        Case #TGA_ALPHA8         
            WriteByte(outfile,*iPtr\Alpha)
         
        Case #TGA_ALPHA_RAMP         
          If (*iPtr\Blue + *iPtr\Green + *iPtr\Red)/3 > 128
            WriteByte(outfile,255)
          Else 
            WriteByte(outfile,0)
          EndIf

        Case #TGA_ALPHA_BRIGHTNESS         
          WriteByte(outfile,(*iPtr\Blue + *iPtr\Green + *iPtr\Red)/3)

        Case #TGA_ALPHA_HALFTRANSPARENT
          WriteByte(outfile,127)
         
        Case #TGA_ALPHA_NONE
          WriteByte(outfile,0)

        Case #TGA_ALPHA_FULL
          WriteByte(outfile,255)
          
        Default 
          WriteByte(outfile,0)
        
      EndSelect 
      ProcedureReturn *iPtr+4;                   
    
    
  EndSelect
EndProcedure


; #############################################################################
; Encoding a image as TGA-File. 
; At the Moment it is only possible to create 32 Bit-Transparent Fonts.
; *Attention: It NEED a 32-Bit Image as Input. This is not checked here !

Procedure EncodeTGA(Outputfile$,ImageNo)
  
  Define *iPtr.RGBAstruct
  Define of.l,j.l,i.l
  *iPtr = GetImagePtr(ImageNo)
  ;Wir gehen von 32 Bits aus !!!
  
  of.l = CreateFile(#PB_Any,Outputfile$)
  If of 
      WriteByte(of,0)     ;idlength
      WriteByte(of,0)     ;;colormaptype
      WriteByte(of,2)     ;imagetype 2=rgb
      WriteWord(of,0)      ;colormapindex
      WriteWord(of,0)      ;colormapnumentries
      WriteByte(of,0)      ;colormapsize 

      WriteWord(of,0)      ; xorigin    
      WriteWord(of,0)      ; yorigin    
     
      ;Write Header
      WriteWord(of,ImageWidth(ImageNo))
      WriteWord(of,ImageHeight(ImageNo))   
      WriteByte(of,32)
      WriteByte(of,8)
      

      For j= 0 To ImageHeight(ImageNo) - 1  ; j = 0 corresponds to bottom of image
        For i = 0 To ImageWidth(ImageNo) - 1
        ;For Irrlicht 1.2, the first pixel has to be half-transparent ($7f) when
        ;using ALpha-Channel.
        If j=ImageHeight(ImageNo) - 1 And i=0
          *iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_HALFTRANSPARENT)          
        Else                    
          If (*iPtr\Red=-1 And *iPtr\Green=0 And *iPtr\Blue = 0)
            ;Red Pixels has to be non-Transparent
            *iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_FULL)
          ElseIf (*iPtr\Red=-1 And *iPtr\Green=-1 And *iPtr\Blue = 0)
            ;Yellow Pixels has to be non-Transparent
            *iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_FULL)
          Else     
            ;Otherwise calculate the Alpha from the brightness / Average   
            *iPtr = _TGAWriter(of,*iPtr,32,#TGA_ALPHA_BRIGHTNESS)
          EndIf
        EndIf
        Next
      Next

      CloseFile(of)
      ProcedureReturn #True
    Else
      MessageRequester("Error", "Not A Valid Bitmap Or Could Not Be Decoded In Memory",#PB_MessageRequester_Ok)
  EndIf
  ProcedureReturn #False
EndProcedure

   
; #############################################################################
; Calculate the Correct Texture-Height for the Irrlicht-Texture.
; Wee need a size  ^2
Procedure calculateTextureHeight(Size.l)
	Define ts.l = $01;
	While ts < Size :		ts << 1 :  Wend
	ProcedureReturn ts;
EndProcedure 

; #############################################################################
; This Function creates the Image-Font. It uses the PB-Functions
; TextWidth() and TextHeight() to calculate correct sizezs of the Characters.
Procedure makeFont(mini.l = #False)   
  
  Define font_id.l = 0
  Define style.l = 0
  Define imgTmp.l
  Define isize.l
  Define charstart.l = 32 
  Define charend.l = 381
  Define tx.l = 0
  Define ty.l = 0;
  Define theight.l=0
  Define max_fontheight.l
  Define ibil.l, ibis.s, i.l
  
  
  If Overall\fontInfo\bold = 1 
    style = #PB_Font_Bold
  EndIf
  If Overall\fontInfo\italic = 1 
    style = style | #PB_Font_Italic
  EndIf
  If Overall\fontInfo\underline = 1 
    style = style | #PB_Font_Underline
  EndIf
  If Overall\fontInfo\strikeout = 1 
    style = style | #PB_Font_StrikeOut
  EndIf
  If Overall\fontInfo\hq = 1 
    style = style | #PB_Font_HighQuality
  EndIf

  font_id = LoadFont(#PB_Any,Overall\fontInfo\fontname,Overall\fontInfo\fontsize,style)
  
  If IsImage(Overall\images\Output): FreeImage(Overall\images\Output): EndIf
  
  imgTmp.l = CreateImage(#PB_Any,256,256,32)
  StartDrawing(ImageOutput(imgTmp))


  isize.l = Overall\fontInfo\fontsize * 2.5 
  DrawingFont(FontID(font_id))
  
  If mini 
    charstart= 65
    charend = 70
  EndIf

  ; get maximal fontheight :
  For i=charstart To charend  ; All Characters....
    ibis.s = ibis + Chr(i)
  Next
  max_fontheight.l=TextHeight(ibis)+2
  
  theight.l = 0;
  ; findout textureheight 
  tx.l =0;
  For i=charstart To charend  ; All Characters....
    ibil.l = TextWidth(Chr(i))+2
    If (tx+ibil) > Overall\textureWidth
      tx=ibil
;
      theight=theight+max_fontheight.l
    Else
      tx=tx+ibil
    EndIf
  Next
  
  StopDrawing()
  FreeImage(imgTmp);
  ;Now create the Image and walk print Text....
  Overall\images\Output  = CreateImage(#PB_Any,Overall\textureWidth, calculateTextureHeight(theight+max_fontheight),32 )    
  tx = 0
  ty = 0;
  StartDrawing(ImageOutput(Overall\images\Output))
    Box(0,0,ImageWidth(Overall\images\Output),ImageHeight(Overall\images\Output),RGB(0,0,0) )
    DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
    FrontColor(Overall\fontInfo\fontcolor)
    DrawingFont(FontID(font_id))
  
    For i=charstart To charend  ; All Characters....    
      ibil.l = TextWidth(Chr(i))+2
      
      If (tx+ibil) > Overall\textureWidth
        tx = 0;
        ty=ty+max_fontheight.l      
        DrawText(tx+1,ty+1,Chr(i))
        Plot(tx,ty,#Yellow)
        Plot(tx+ibil,ty+max_fontheight-1,#Red);
        tx=tx+ibil
        
      Else
        DrawText(tx+1,ty+1,Chr(i))
        Plot(tx,ty,#Yellow)
        Plot(tx+ibil,ty+max_fontheight-1,#Red);
        tx=tx+ibil        
      EndIf 
    Next
    
    Plot(0,0,#Yellow)
    Plot(1,0,#Red)
    
  StopDrawing()
  
  ProcedureReturn Overall\images\Output

EndProcedure 

; *** FontList Procedures  ***

Define fontlistgadget.l

Define fontlistid.l =0, foundfontid.l = -1

Procedure EnumFontFamProc( *lpelf.ENUMLOGFONT, *lpntm.NEWTEXTMETRIC, FontType, lParam) ; GetFonts and trans. to List
  Shared fontlistgadget.l,fontlistid.l,foundfontid.l
  Define FontText$,hwnd.l,fontname.s
  ;Debug PeekS(@*lpelf\elfLogFont\lfFaceName[0])
  fontname.s = PeekS(@*lpelf\elfLogFont\lfFaceName[0])
  AddGadgetItem (fontlistgadget,fontlistid,fontname)
     ; more informations can be get from the LOGFONT structure, for example adding following code:
     ; +", Height: "+Str(PeekL(@*lpelf\elfLogFont\lfHeight))+", Width: "+Str(PeekL(@*lpelf\elfLogFont\lfWidth)))
  SetGadgetState(fontlistgadget,0)
  FontText$= GetGadgetText(fontlistgadget)
  SetWindowText_(hwnd, FontText$)
  If fontname = Overall\fontInfo\fontname 
    Debug("find = "+Overall\fontInfo\fontname +" ID="+Str(fontlistid) )
    foundfontid = fontlistid
    SetGadgetState(fontlistgadget,fontlistid)    
  EndIf
  fontlistid+1
  
  ProcedureReturn 1
EndProcedure
Procedure SysInfo_Fonts(gadget.l)
  Shared fontlistgadget.l
  Define hwnd.l,hdc.l 
  fontlistgadget = gadget;
  hwnd = GetDesktopWindow_()
  hdc = GetDC_(hwnd)
  EnumFontFamilies_(hdc, 0, @EnumFontFamProc(), 0)
  ReleaseDC_ (hwnd, hdc)
EndProcedure

Procedure saveBitmapFont()
  Define ip.l,sz.l,ipo.l
  Define StandardFile$,Pattern$,File$,Pattern.l

  Overall\textureWidth = Val(StringField(GetGadgetText(Overall\gadgets\Combo_TextureWidth),1," "))

        
  StandardFile$ = Overall\lastpath   ; anfänglichen Pfad + Dateiname festlegen
  Pattern$ = "Bitmap (*.bitmap)|*.bmp|TGA Transparent (*.tga)|*.tga"
  If Overall\lastType = "bmp"
    Pattern = 0    
  ElseIf Overall\lastType = "tga"
    Pattern = 1
  EndIf
  File$ = SaveFileRequester("Bitte Datei zum Speichern auswählen", StandardFile$, Pattern$, Pattern)
  If File$
    Overall\lastpath = GetPathPart(File$)
    ipo = makeFont(#False)  
    If SelectedFilePattern() = 0
      If GetExtensionPart(File$) <> "bmp"
        File$ = File$+".bmp"
      EndIf
      SaveImage(ipo,File$)  
    EndIf
        
    If SelectedFilePattern() = 1
      If GetExtensionPart(File$) <> "tga"
        File$ = File$+".tga"
      EndIf
      EncodeTGA(File$,ipo)
    EndIf
  EndIf
EndProcedure






Procedure buildFontColor()
  Shared  Overall
  If IsImage(  Overall\images\color) : FreeImage( Overall\images\color):EndIf
  Overall\images\color = CreateImage(#PB_Any,16,16)
  StartDrawing(ImageOutput(Overall\images\color))
    Box(0,0,16,16,Overall\fontInfo\fontcolor)
  StopDrawing()
  SetGadgetState(Overall\gadgets\Btn_FontColor,ImageID(Overall\images\color))  
EndProcedure 

Procedure buildPreview()
  Shared  Overall  
  If IsImage(Overall\images\Preview): FreeImage(Overall\images\Preview) : EndIf  
  Overall\images\Preview.l = makeFont( #True)
  SetGadgetState(Overall\gadgets\Img_Preview,ImageID(Overall\images\Preview))
EndProcedure  

Procedure initAndLoadSettings() 
  Shared Overall,foundfontid.l
  Define id.l, fsize.l,tsize.l
  OpenPreferences(".\FontTool.ini")

  ;Read the Font-Info
  PreferenceGroup("FontInfo")  
  Overall\fontInfo\fontname = ReadPreferenceString("name","Arial")
  Overall\fontInfo\fontsize = ReadPreferenceLong("size",12)
  Overall\fontInfo\fontcolor = ReadPreferenceLong("color",#White)
  Overall\fontInfo\bold = ReadPreferenceLong("bold",0)
  Overall\fontInfo\italic = ReadPreferenceLong("italic",0)
  Overall\fontInfo\underline = ReadPreferenceLong("underline",0)
  Overall\fontInfo\strikeout = ReadPreferenceLong("strikeout",0)
  Overall\fontInfo\hq = ReadPreferenceLong("hq",0)
  
  ;
  PreferenceGroup("Texture")  
  Overall\textureWidth = ReadPreferenceLong("textureWidth",256)

  PreferenceGroup("File")  
  Overall\lastpath = ReadPreferenceString("lastPath",".\")
  Overall\lastType = ReadPreferenceString("lastType",".\")
  
    
  OpenMainWindow()
  ;Find Windows-Font and populate Listview.
  SysInfo_Fonts(Overall\gadgets\LV_FontList)

  ;Put the possible Sizes in the ListView
  Restore fontsizes;
  Read fsize.l 
  id.l=0;
  While fsize > 0  
    AddGadgetItem (Overall\gadgets\LV_FontSize,id,Str(fsize))
    If fsize = Overall\fontInfo\fontsize
      SetGadgetState(Overall\gadgets\LV_FontSize,id)
    EndIf
    
    Read fsize.l   
    id+1
  Wend

  Restore texturesizes;
  Read tsize.l
  id.l = 0 
  While tsize > 0
    AddGadgetItem(Overall\gadgets\Combo_TextureWidth,id,Str(tsize)+" texture width")    
    If tsize = Overall\textureWidth
      SetGadgetState(Overall\gadgets\Combo_TextureWidth,id)
    EndIf
    Read tsize.l   
    id+1
  Wend
  
  SetGadgetState(Overall\gadgets\CB_Bold,Overall\fontInfo\bold)
  SetGadgetState(Overall\gadgets\CB_Italic,Overall\fontInfo\italic)
  SetGadgetState(Overall\gadgets\LV_FontList,foundfontid)

  buildFontColor()
  buildPreview()
EndProcedure 


Procedure freeAndSaveSettings() 
  If CreatePreferences(".\FontTool.ini")
    PreferenceGroup("FontInfo")
    WritePreferenceString("name",Overall\fontInfo\fontname)
    WritePreferenceLong("size",  Overall\fontInfo\fontsize)
    WritePreferenceLong("color", Overall\fontInfo\fontcolor)
    WritePreferenceLong("bold", Overall\fontInfo\bold)
    WritePreferenceLong("italic", Overall\fontInfo\italic)
    WritePreferenceLong("underline", Overall\fontInfo\underline)
    WritePreferenceLong("strikeout", Overall\fontInfo\strikeout)
    WritePreferenceLong("hq", Overall\fontInfo\hq)
    
    PreferenceGroup("Texture")  
    WritePreferenceLong("textureWidth", Overall\textureWidth)

    PreferenceGroup("File")  
    WritePreferenceString("lastPath",Overall\lastpath)
    WritePreferenceString("lastType",Overall\lastType)

    ClosePreferences()
  EndIf
  
  ;FreeImages....
  If IsImage(Overall\images\IrrLogo): FreeImage(Overall\images\IrrLogo): EndIf
  If IsImage(Overall\images\Preview): FreeImage(Overall\images\Preview): EndIf
  If IsImage(Overall\images\Output): FreeImage(Overall\images\Output): EndIf
  If IsImage(Overall\images\color): FreeImage(Overall\images\color): EndIf
  
  ;Close the Window....
  CloseWindow(Overall\windowID)
  

EndProcedure 

;- START 

initAndLoadSettings()


Repeat ; Start of the event loop
  
  Event = WaitWindowEvent() ; This line waits until an event is received from Windows
  
  windowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
  
  GadgetID = EventGadget() ; Is it a gadget event?
  
  EventType = EventType() ; The event type
    
  
  If Event = #PB_Event_Gadget
  
    Select GadgetID     
      Case Overall\gadgets\LV_FontList
        If GetGadgetText(Overall\gadgets\LV_FontList) <> Overall\fontInfo\fontname
          Overall\fontInfo\fontname = GetGadgetText(Overall\gadgets\LV_FontList)
          buildPreview();
        EndIf 
      Case Overall\gadgets\LV_FontSize
        If Val(GetGadgetText(Overall\gadgets\LV_FontSize)) <> Overall\fontInfo\fontsize
          Overall\fontInfo\fontsize = Val(GetGadgetText(Overall\gadgets\LV_FontSize))
          buildPreview();
        EndIf      
      Case Overall\gadgets\CB_Bold
        Overall\fontInfo\bold = GetGadgetState(Overall\gadgets\CB_Bold)
        buildPreview();
      Case Overall\gadgets\CB_Italic
        Overall\fontInfo\italic = GetGadgetState(Overall\gadgets\CB_Italic)
        buildPreview();
      Case Overall\gadgets\Btn_About        
        MessageRequester(PeekS(?requesterTitle),ReplaceString(PeekS(?requesterText),"\n", Chr(10) ),#PB_MessageRequester_Ok)
      Case Overall\gadgets\Btn_Save 
        saveBitmapFont()
      Case Overall\gadgets\Btn_FontColor
        farbe.l = ColorRequester()
        If farbe > -1
          Overall\fontInfo\fontcolor = farbe 
          buildFontColor()    
          buildPreview()    
        EndIf      
    EndSelect 
           
    
  EndIf
  
Until Event = #PB_Event_CloseWindow ; End of the event loop

freeAndSaveSettings()


End
;
DataSection 
IrrLogo: IncludeBinary "irrlichtlogo.jpg"

fontsizes:
  Data.l 4,6,8,9,10,11,12,14,16,18
  Data.l 20,22,24,26,28,36,48,56,68,72
  Data.l -1

texturesizes:
  Data.l 256,512,1024
  Data.l -1

requesterTitle:
  Data.s "About IrrFontTool"
requesterText:
  Data.s "IrrFontTool-Wrapper version 1.2 (c) 2006 by M.Taupitz.\n\nThis tools creates bitmap fonts For using them With the Irrlicht Engine.\nAnd also For the IrrlichWrapper. It Supports Alpha-Channel. "








  
                  
            
                      

           
    

    
    
    






; IDE Options = PureBasic v4.01 (Windows - x86)
; CursorPosition = 603
; FirstLine = 588
; Folding = ---
; EnableUnicode
; EnableXP
; Executable = FontToolWrapper.exe
; jaPBe Version=3.7.2.629
; Build=0
; FirstLine=355
; CursorPosition=384
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF