BlitzCoder Code Database

BlitzCoder Essentials

•Home Page
•About BlitzCoder
•Contributors
•Terms of Use
•Email Us

Main Areas

•BlitzCoder Chat
•Discussions
•Articles/Tutorials
•Code Database
•Link Database
•Showcase Area
•Worklogs
•Competitions

Special Areas

•Undocumented

Other Blitz Sites

•Blitz Basic Home
•Blitz Showcase
•BlitzPlay Library

BlitzCoder Code Archives Page

Main Codes Page

"Dynamic Text Creator", by ionstorm

These tools and code, will allow you to create a text than scales with your games resolution, very fast and usefull, well i thought so. If you use it please drop us an email. Email me for the Font and the support files.

Code

;Text Strip Maker
;Ion-Storm / Attics
;December 2002
SetBuffer BackBuffer()

Const KEY_ESCAPE=1

;set the graphics mode
Global nGraphicsWidth% = 1280
Global nGraphicsHeight% = 1024
Graphics3D nGraphicsWidth%, nGraphicsHeight%, 0, 1

; Hold the text, bitmaps, etc. in these so we don't have to draw them again each frame
Type DisplayStrings
     Field sText$          ; Text string to be displayed
     Field ScreenX          ; X position on-screen to display it
     Field ScreenY          ; Y position on-screen to display it
     Field Bitmap          ; handle to the actual bitmap
     Field Active          ; True when this has been displayed this frame.  Used to remove old ones.
End Type

Print "Loading..."

SetBuffer BackBuffer()

;These are hardcoded for the strip created by font bmp maker
; total width is 5376
; it creates 56x43 pixel fonts
Global frameHSize%=43
Global frameWSize%=56
Dim frameWidth(255)

;We need a base Scaling factor
;it assumes that @ 800x600 a 0.25% scaling looks ok.
;therefore 0.25/800 - 0.0003125
;this gives us a base scaling factor so as the resolution goes up so 
;the scale increase. This is a rough figure.
Global baseScalar#=0.0003125

;create an image source for the font 
Global gfxInputFrame=CreateImage(5376,frameHSize%)

;load in the bmp font strip into our InputImage
LoadBuffer (ImageBuffer(gfxInputFrame),"Font.bmp")

; Load in the text widths
file = ReadFile("Font.txt")
For t = 1 To 95
     framewidth(t+31) = ReadLine(file)
Next

; Main loop
While Not KeyDown(KEY_ESCAPE)     
Cls

; Do any 3D graphics stuff
     
     UpdateWorld
     RenderWorld

; Now for the 2D

ResetDisplayTexts() ; so that unused texts can be deleted after this pass

DisplayText "ArxSpace", 10, 10
     
     DisplayText "According to legend (and various religions), thousands", 10, 30
     DisplayText "of years ago the human race lived peacefully together", 10, 40
     DisplayText "on a single planet called Earth. This beautiful planet", 10, 50
     DisplayText "was doomed to destruction by the great rock Turd; an", 10, 60
     DisplayText "enormous asteroid almost as big as the planet itself", 10, 70
     DisplayText "and slowly travelling on a collision course for", 10, 80
     DisplayText "millions of years." , 10, 90
     
     DisplayText "The humans eventually discovered their planet|s fate", 10, 110 ; note that I use | instead of '
     DisplayText "and, having no means to divert this rock, decided that", 10, 120
     DisplayText "the only course of action would be to evacuate the", 10, 130
     DisplayText "planet and try to preserve as much of it as possible.", 10, 140
     
     DisplayText "Combining their resources they built two giant vessels", 10, 160
     DisplayText "in space that would be used to transport as many", 10, 170
     DisplayText "species of plant and animal life as could be managed.", 10, 180
     DisplayText "These vessels were called Arxs, and each would carry", 10, 190
     DisplayText "roughly the same cargo to double the chances of", 10, 200
     DisplayText "survival.  In order to fit as much as possible into", 10, 210
     Displaytext "each Arx, all forms of life were cryogenically frozen", 10, 220
     DisplayText "and packed together along with various human", 10, 230
     DisplayText "technologies, literature, and art.", 10, 240

DisplayText "Over the course of several years, each Arx was filled", 10, 260
     DisplayText "and the humans remaining on Earth grew angry and", 10, 270
     DisplayText "resentful.  Wars were fought over who should stay", 10, 280
     DisplayText "and who should go, so it was decided that a third Arx", 10, 290
     DisplayText "would be built that could accomodate many that would", 10, 300
     DisplayText "have been left behind to die.  Time was running out", 10, 310
     DisplayText "and this Arx had to be built more speedily than its", 10, 320
     DisplayText "two predecessors.  By the time it was completed, the", 10, 330
     DisplayText "other two had long since departed on course for the", 10, 340
     DisplayText "nearby planet called Mars. This third Arx was sealed", 10, 350
     DisplayText "shut just as the sun was blocked out by the arrival of", 10, 360
     DisplayText "the great rock Turd.  Within hours of launching, Turd", 10, 370
     DisplayText "hit the Earth and the resulting shockwave threw the", 10, 380
     DisplayText "Arx off-course, and with a sleeping crew the Arx", 10, 390
     DisplayText "headed for deep space...", 10, 400

DisplayText "Eons later the Arx detected a planet similar to Mars", 10, 420
     DisplayText "and woke the crew.  The humans had no idea where they", 10, 430
     DisplayText "were and what happened to the other Arxs, but had no", 10, 440
     DisplayText "choice but to begin the arduous task of colonising", 10, 450
     DisplayText "this alien world.", 10, 460
     
     DisplayText "Press <ESC> to quit", 10, 490
     
     ; FPS (frame-rate)
     Framecounter_counter = Framecounter_counter + 1
     If Framecounter_time = 0 Then Framecounter_time = MilliSecs()
     If Framecounter_time + 1001 < MilliSecs() Then
          Framecounter_framerate = Framecounter_counter
          Framecounter_counter = 0
          Framecounter_time = MilliSecs()
     EndIf
     DisplayText "FPS: " + Framecounter_framerate, 500, 10

FreeDisplayTexts() ; now delete unused texts
     Flip
Wend
End

Function DisplayText(TextString$, ScreenX, ScreenY)
     ; Adjust screen coordinates so we don't have to worry about resolution when placing the text
     ScreenX = (nGraphicsWidth / 80.0) * (ScreenX / 8.0)
     ScreenY = (nGraphicsHeight / 80.0) * (ScreenY / 8.0)
     
     For DisplayString.DisplayStrings = Each DisplayStrings
          If DisplayString <> Null
               If DisplayString\sText$ = TextString$ And DisplayString\ScreenX = ScreenX And DisplayString\ScreenY = ScreenY
                    ; It's the same one
                    ; Display the text bitmap on-screen
                    DrawImage (DisplayString\Bitmap, DisplayString\ScreenX, DisplayString\ScreenY)
                    DisplayString\Active = True
                    Return ; exit this function now                    
               EndIf
          EndIf
     Next
     ; This text is new
     DisplayString.DisplayStrings = New DisplayStrings
     DisplayString\sText$ = TextString$
     DisplayString\ScreenX = ScreenX
     DisplayString\ScreenY = ScreenY
     
     ;create an image for the output text
     nStringlength%=Len(DisplayString\sText$)     
     DisplayString\Bitmap = CreateImage(frameWSize%*nStringlength%-1,frameHSize%)

For t=1 To nStringlength%
          AscValue%=Asc(Mid$(DisplayString\sText$,t,1))
             CopyRect (AscValue%-32)*frameWSize%, 0, frameWSize%, frameHSize%, TargetPos, 0, ImageBuffer(gfxInputFrame), ImageBuffer(DisplayString\Bitmap)     
          TargetPos = TargetPos + framewidth(AscValue%) + 10
     Next
     ; Scale it for the correct screen resolution
     ScaleImage DisplayString\Bitmap,(nGraphicsWidth%*baseScalar#),(nGraphicsHeight%*baseScalar#)
     ; Display the text bitmap on-screen
     DrawImage (DisplayString\Bitmap, DisplayString\ScreenX, DisplayString\ScreenY)
     DisplayString\Active = True
End Function

Function ResetDisplayTexts()
     ; Reset status of each Display Texts
     For DisplayString.DisplayStrings = Each DisplayStrings
          If DisplayString <> Null
               DisplayString\Active = False
          EndIf
     Next
End Function

Function FreeDisplayTexts()
     ; Remove out of date texts
     For DisplayString.DisplayStrings = Each DisplayStrings
          If DisplayString <> Null
               If DisplayString\Active = False
                    FreeImage DisplayString\Bitmap
                    Delete DisplayString
               EndIf
          EndIf
     Next
End Function

Code software created by Krylar's Kreations