NewsForumsCodeLogsGallerySpecsSearch

Code archives/3D Graphics - Effects/Funky 3D titlescreen

This code has been declared by its author to be Public Domain code.

Download source code

Funky 3D titlescreen by _332007
This is a 3D titlescreen I made for an older project that will never see light of day. So, I decided to post this code here. It's a small piece of code that basically stamps your game title as text on a bunch of 3D yellow pucks. After it ran the 650 frames, it then ends the program. But in the original code, it was looping between the title screen and the main game menu.

NOTE: This is old rookie code. 
AppTitle "MAZEGAME"

;----------------------------------------------------------------------------------------
; Define Global things
;----------------------------------------------------------------------------------------
Graphics3D 1024,768,32,1
Global fontsize# = 168
Global ptr_fnt = LoadFont("Arial",fontsize#/2,True,False,False)
Global scrollcycle = 0

Global doing_nothing_fps = 0
Global camera%, ptr_light%

Dim sin_tb#(1079),cos_tb#(1079)
For i=0 To 1079: sin_tb#(i)=Sin(i): cos_tb#(i)=Cos(i): Next
;Dim getcos(3),getsin(3): getcos(0)=1: getcos(2)=-1: getsin(1)=1: getsin(3)=-1

init_title_screen()
While GetKey() = 0
   IntitleLoop()
   RenderWorld
   Flip 1
   scrollcycle = scrollcycle + 1 : If scrollcycle > 359 Then scrollcycle = scrollcycle - 360
   If doing_nothing_fps > 650 Then Exit
Wend
close_title_screen()
End


;----------------------------------------------------------------------------------------
; title screen management
;----------------------------------------------------------------------------------------
Function init_title_screen()
   doing_nothing_fps = 0
   camera = CreateCamera()

   ptr_light = CreateLight()
   LightColor ptr_light,0,0,0
   RotateEntity ptr_light,90,0,0
   AmbientLight 0,0,0

   t_obj.object_info = New object_info
   t_obj\ptr = CreateTexture(fontsize# * 2,fontsize#,256)
   t_obj\object_type = 2
   SetBuffer TextureBuffer(t_obj\ptr)
   ClsColor 255,255,0
   Cls
   Color 255, 0, 0
   SetFont ptr_fnt
   Text fontsize# * 1.5,fontsize# * 0.75,"MAZEGAME",True,True
   t_tex = t_obj\ptr
   SetBuffer BackBuffer()

   For z = 1 To 6
      For x = -z To z
         For y = -z To z
            t_obj.object_info = New object_info
            t_obj\ptr = CreateCylinder(36 - z * 4)
            t_obj\object_type = 1
            RotateEntity t_obj\ptr,15 * x,0,-15 * y
            ScaleEntity t_obj\ptr,8,2,8
            PositionEntity t_obj\ptr,32 * x, 32 * y,32 * z
            EntityTexture t_obj\ptr,t_tex,0,1 
         Next
      Next
   Next

   CameraFogMode camera,1
   CameraFogRange camera,64,224

End Function

Function IntitleLoop()
   Local lc#
   If doing_nothing_fps <= 250 Then
      lc = doing_nothing_fps 
      AmbientLight lc,lc,lc
   EndIf
   If doing_nothing_fps >= 400 Then
      lc = (650 - doing_nothing_fps)
      AmbientLight lc,lc,lc
   EndIf

   lx = (cos_tb#(scrollcycle * 2) * 30)
   ly = (sin_tb#(scrollcycle * 2) * 30)
   LightColor ptr_light, lx * 8, ly * 8, ly * 8
   PositionEntity ptr_light,lx,ly,0

   If doing_nothing_fps < 500 Then
      PositionEntity camera,0,0,(cos_tb#(scrollcycle * 2 + 120) * 15)
      For t_obj.object_info = Each object_info
         If t_obj\object_type = 1 Then
            TurnEntity t_obj\ptr,0,sin_tb#(scrollcycle * 2 + 270) * 2, sin_tb#(scrollcycle * 2) * 2.5
         EndIf
      Next
   EndIf

   doing_nothing_fps = doing_nothing_fps + 1
End Function

Function close_title_screen()
   For t_obj.object_info = Each object_info
      If t_obj\object_type = 1 Then
         FreeEntity t_obj\ptr
      ElseIf t_obj\object_type = 2 Then
         FreeTexture t_obj\ptr
      EndIf
      Delete t_obj.object_info
   Next

End Function

Type object_info
   Field ptr
   Field xpos#
   Field ypos#
   Field zpos#
   Field object_type%
End Type

Comments

Yo! Wazzup?2007
No matter what I change the font to, I get an Error Message, "Font does not exist." (I did try saving the file)


Ked2007
With mine I had a MAV unless it was in debug mode.


Bankie2007
Wot Ked sed. Works in debug mode.


big10p2007
I still get a MAV in debug. Moving the Graphics3D call to before the LoadFont command fixed things, though.


_332007
OOps :D Fixed. I've also fixed the size of the text appearing on the pucks.


*2007
graphics3d in blitz3d always frees up all graphics, textures and fonts


John Blackledge2007
1) Change CreateCylinder(.. to CreateSphere(..
2) Comment out the EntityTexture... line.
3) Add below:
EntityColor t_obj\ptr,Rnd(255),Rnd(255),Rnd(255)

! SMARTIES !


_332007
4) modify the ScaleEntity to ... ScaleEntity t_obj\ptr,8,3,8

Neat!


Code Archives Forum