PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Merry Christmas to all of you.

https://www.purebasic.fr/english/viewtopic.php?t=57761

Page 1 of 1

Merry Christmas to all of you.

Posted: Sun Dec 22, 2013 8:52 pm
by DK_PETER
Greetings folks!

(MODULE - For PB 5.20 and up only)

Code is a bit messy, but I'm extremely busy doing a lot of gfx and coding
for my own pleasure. So don't expect master coding, okay? :-)

Here's an example screenshot of what is displayed:

You can add your own music and pictures.

The code:

Script: Filename: DKPSnow.particle

Code: Select all

particle_system Snow
{
	quota	40000
	material	PE/lensflare
	particle_width	1
	particle_height	1
	cull_each	true
	renderer	billboard
	billboard_type	oriented_self

	emitter Box
	{
		angle	19.18
		colour	1 1 1 1
		colour_range_start	1 1 1 1
		colour_range_end	1 1 1 1
		direction	0 -1 0
		emission_rate	1000
		position	0 0 -100
		velocity	3
		velocity_min	30
		velocity_max	51.64
		time_to_live	5
		time_to_live_min 6
		time_to_live_max 10
		duration	0
		duration_min	0
		duration_max	0
		repeat_delay	0
		repeat_delay_min 0
		repeat_delay_max 0
		width	300
		height	300
		depth	300
	}
}
Script: Filename: materials.material

Code: Select all

material PE/lensflare
{
	technique
	{
		pass
		{
			lighting off
			depth_write off
			scene_blend add

			texture_unit
			{
				texture flare.png
			}
		}
	}
}
Main Code:

Code: Select all

;Just some quick fun
;Merry Christmas to you all
;Best regards
;Peter AKA DK_PETER

DeclareModule _SnowWorld
	UseJPEGImageDecoder()
	UsePNGImageDecoder()
	UseTGAImageDecoder()
	UseTIFFImageDecoder()
	UseOGGSoundDecoder()
	UseFLACSoundDecoder()
	
	Declare.i InitBasics(I3D = 0, ISPRITE = 1, IKEY = 1, IMOUSE = 1, ISOUND = 0 )
	Declare.i SetScreenRes(Width.i = 1024, Height.i = 768, Title.s = "", FullScreen.i = #False)
	Declare   SetupTitle(Title.s = "")
	Declare   SetupSound(SoundFile.s = "")
	Declare.i AssignImages(imgPath.s)
	Declare   RunSnow()
EndDeclareModule

Module _SnowWorld
	
	Structure _Mesh_Data
		Id.i
		Mes.i
		Tex.i
		Mat.i
	EndStructure
	
	Structure _Default_Data
		Win.i
		Title.s
		Width.i
		Height.i
		Snd.i
		FullScr.i
		Cam.i
		mLgt.i
		node.i
		cNode.i
	EndStructure
	
	Structure Entity_Mesh_Data
		Part._Mesh_Data
		Pla._Mesh_Data
		Moon._Mesh_Data
		aSun._Mesh_Data
		SnowMan._Mesh_Data
		cBalloon._Mesh_Data
		cBoard._Mesh_Data
		List Build._Mesh_Data()
	EndStructure
	
	Declare.s addSlash(path.s)
	Declare Set3DPaths()
	Declare MakeSnow()
	Declare MakeTown()
	Declare.i MakeSnowMaterial()
	Declare.i MakeBuildingMaterial()
	Declare.i MakeMoon()
	Declare.i MakeSun()
	Declare.i MakeSign()
	Declare.i DoPicture()
	
	Global Def._Default_Data
	Global NewList pic.s()
	Global ent.Entity_Mesh_Data
	
	Procedure.i InitBasics(I3D = 0, ISPRITE = 1, IKEY = 1, IMOUSE = 1, ISOUND = 0 )
		If I3D = 1 And InitEngine3D() = 0
			MessageRequester("InitEngine3D", "Unable to initialize engine3D")
			ProcedureReturn #False
		EndIf
		If ISPRITE = 1 And InitSprite() = 0
			MessageRequester("InitSprite", "Unable to initialize sprite")
			ProcedureReturn #False
		EndIf
		If IKEY = 1 And InitKeyboard() = 0
			MessageRequester("InitKeyboard", "Unable to initialize keyboard")
			ProcedureReturn #False
		EndIf
		If IMOUSE = 1 And InitMouse() = 0
			MessageRequester("InitMouse", "Unable to initialize mouse")
			ProcedureReturn #False
		EndIf
		If ISOUND = 1 And InitSound() = 0
			MessageRequester("InitSound", "Unable to initialize sound")
			ProcedureReturn #False
		EndIf
		ProcedureReturn #True
	EndProcedure
	
	Procedure Set3DPaths()
		Add3DArchive("texture",#PB_3DArchive_FileSystem)
		Add3DArchive("script", #PB_3DArchive_FileSystem)
		Parse3DScripts()
	EndProcedure
	
	Procedure SetScreenRes(Width.i = 1024, Height.i = 768, Title.s = "", FullScreen.i = #False)
		Protected Res.i
		Def\Width 	= Width
		Def\Height 	= Height
		Def\FullScr = FullScreen
		AntialiasingMode(#PB_AntialiasingMode_x6)
		If FullScreen = #False
			Def\Win = OpenWindow(#PB_Any, 0, 0, Width, Height, Title, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
			Res = OpenWindowedScreen(WindowID(Def\Win), 0, 0, Def\Width, Def\Height, #False, 0, 0,#PB_Screen_SmartSynchronization)
		Else
			Res = OpenScreen(Def\Width, Def\Height, 32, Title, #PB_Screen_SmartSynchronization)
		EndIf
		WorldShadows(#PB_Shadow_Additive, 50)
		Set3DPaths()
		Def\Cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
		MoveCamera(Def\Cam, 0, 2, 100)
		Def\mLgt = CreateLight(#PB_Any, $BBBBBB, -350, 500, 1000, #PB_Light_Directional)
 		Def\node = CreateNode(#PB_Any, 0, 0, 0)
 		AttachNodeObject(Def\node, LightID(Def\mLgt))
	EndProcedure
	
	Procedure SetupTitle(Title.s = "")
		Def\Title = Title
	EndProcedure
	
	Procedure SetupSound(SoundFile.s = "")
		Def\Snd = LoadSound(#PB_Any, SoundFile)
	EndProcedure
	
	Procedure.i AssignImages(imgPath.s)
		Protected dir.i
		ClearList(pic())
		dir = ExamineDirectory(#PB_Any, imgPath,"*")
		While NextDirectoryEntry(dir)
			If DirectoryEntryType(dir) = #PB_DirectoryEntry_File
				Select LCase(GetExtensionPart(DirectoryEntryName(dir)))
					Case "jpg", "bmp", "png", "tga", "tif"
						AddElement(pic())
						pic() = addSlash(imgPath) + DirectoryEntryName(dir)
				EndSelect
			EndIf
		Wend
		
	EndProcedure
	
	Procedure.s addSlash(path.s)
		If Right(path,1) = "\"
			ProcedureReturn path
		Else
			ProcedureReturn path + "\"
		EndIf
	EndProcedure
	
	
	Procedure MakeTown()
		Protected Geo.i, tmpScale.i
		Geo = CreateStaticGeometry(#PB_Any, 100, 20, 100, #True)
		With ent\pla
			\Mes = CreatePlane(#PB_Any, 100, 100, 2, 2, 1, 1)	
			BuildMeshShadowVolume(\Mes)
			TransformMesh(\Mes, 1, 1, 1, 3, 1, 3, 0, 0, 0)
			\Mat = MakeSnowMaterial()
			\Id  = CreateEntity(#PB_Any, MeshID(\Mes),MaterialID(\Mat))
			AddStaticGeometryEntity(Geo, EntityID(\Id),0,0,0)
		EndWith
		With ent\Build()
			For x = 0 To 100 Step 5
				For z = 0 To 100 Step 5
					AddElement(ent\Build())
						tmpScale = Random(5,1)	
						\Mes = CreateCube(#PB_Any, 1)
						TransformMesh(\Mes, 1, 1, 1, 1, tmpScale, 1, 0, 0, 0)
						\Mat = MakeBuildingMaterial()
						\Id  = CreateEntity(#PB_Any,MeshID(\Mes),MaterialID(MakeBuildingMaterial()))
						AddStaticGeometryEntity(Geo, EntityID(\Id), -50 + x, (tmpScale/2), -50 + z)
				Next z
			Next x
		EndWith
		BuildStaticGeometry(Geo)
	EndProcedure
	
	Procedure MakeBuildingMaterial()
		Protected tex.i, mat.i, ran.i, col.i
		tex = CreateTexture(#PB_Any, 100, 100)
		StartDrawing(TextureOutput(tex))
		Box(0, 0, 100, 100, $444444)
		For x = 0 To 100 Step 2
			LineXY(x, 0, x, 100, $222222)
			LineXY(0, x, 100, x, $222222)
		Next x
		For x = 10 To 90 Step 5
			For y = 10 To 90 Step 5
				ran = Random(500,1)
				Select ran
					Case 1 To 249
						col = $0
					Case 250 To 400
						col = $FF4444
					Case 401 To 500
						col = $884400
				EndSelect
				Box(x, y, 3, 3, col)
			Next y
		Next x
		Box(0, 0, 100, 5, $FFFFFF)
		StopDrawing()
		mat = CreateMaterial(#PB_Any, TextureID(tex))
		ProcedureReturn mat
	EndProcedure
	
	Procedure MakeSnow()
		With ent\Part
			\tex = LoadTexture(#PB_Any, "flare.png") 			
			\mat = CreateMaterial(#PB_Any, TextureID(\tex))	
			MaterialShadingMode(\mat, #PB_Material_Phong)
			\Id = GetScriptParticleEmitter(#PB_Any, "Snow")
		EndWith
	EndProcedure
	
	Procedure MakeSnowMaterial()
		Protected tex.i, mat.i
		tex = CreateTexture(#PB_Any, 100, 100)
		StartDrawing(TextureOutput(tex))
		Box(0, 0, 100, 100, $FFFFFF)
		DrawingMode(#PB_2DDrawing_AlphaBlend)
		For x = 0 To 100
			Circle(Random(80,20), Random(80,20), Random(3,1), $4FEEEEEE)
		Next x
		StopDrawing()
		mat = CreateMaterial(#PB_Any, TextureID(tex))
		ProcedureReturn mat
	EndProcedure
	
	Procedure MakeMoon()
		With ent\Moon
			\Mes = CreateSphere(#PB_Any, 20,80,80)
			\Tex = CreateTexture(#PB_Any, 100, 100)
			StartDrawing(TextureOutput(\Tex))
			Box(0, 0, 100, 100, $FFFFFF)
			DrawingMode(#PB_2DDrawing_AlphaBlend)
			For x = 0 To 20
				Circle(Random(80,20), Random(80,20),Random(10,5),$0CCCCCCC)
			Next x
			StopDrawing()
			\Mat = CreateMaterial(#PB_Any, TextureID(\Tex))
			MaterialShininess(\Mat, 10)
			ScrollMaterial(\Mat, -0.05,0,#PB_Material_Animated)
			\Id = CreateEntity(#PB_Any, MeshID(\Mes), MaterialID(\Mat))
			MoveEntity(\Id, 700, -500, -1000)
	 		AttachNodeObject(Def\node, EntityID(\Id))
		EndWith
	EndProcedure
	
	Procedure.i MakeSun()
		With ent\aSun
			\Mes = CreateSphere(#PB_Any, 40,80,80)
			\Tex = CreateTexture(#PB_Any, 100, 100)
			StartDrawing(TextureOutput(\Tex))
			Box(0, 0, 100, 100, $00FFFF)
			DrawingMode(#PB_2DDrawing_AlphaBlend)
			For x = 0 To 10
				Circle(Random(80,20), Random(80,20),Random(10,5),$0F00CCCC)
			Next x
			StopDrawing()
			\Mat = CreateMaterial(#PB_Any, TextureID(\Tex))
			MaterialShininess(\Mat, 200)
			SetMaterialColor(\Mat, #PB_Material_SelfIlluminationColor, $00FFFF)
			ScrollMaterial(\Mat, -0.05,0,#PB_Material_Animated)
			\Id = CreateEntity(#PB_Any, MeshID(\Mes), MaterialID(\Mat))
			MoveEntity(\Id, -350, 500, 1000)
	 		AttachNodeObject(Def\node, EntityID(\Id))
		EndWith
	EndProcedure
	
	Procedure.i MakeSign()
		With ent\cBalloon
			\Mes = CreateSphere(#PB_Any, 10,50,50)
			TransformMesh(\Mes, 0,0,0,6,1,1,0,0,0)
			\Tex = CreateTexture(#PB_Any, 160,140)
			StartDrawing(TextureOutput(\Tex))
			Box(0, 0, 160, 140, $FFFFFF)
			For x = 0 To 140 Step 10
				LineXY(0, x, 160, x, $AAAAAA)
			Next x
			DrawingMode(#PB_2DDrawing_Transparent)
			DrawText(0, 65, "3D Picture demo ", $0000FF)
			StopDrawing()
			\Mat = CreateMaterial(#PB_Any,TextureID(\Tex))
			ScrollMaterial(\Mat, -0.1, 0, #PB_Material_Animated)
			\Id = CreateEntity(#PB_Any, MeshID(\Mes),MaterialID(\Mat), 0, 110, -200)
		EndWith
		With ent\cBoard
			\Mes = CreatePlane(#PB_Any, 1000,1000,1,1,1,1)
			\Id  = CreateEntity(#PB_Any,MeshID(\Mes), #PB_Material_None,0 ,160, -2000)
			RotateEntity(\Id, 90, 0, 180)
		EndWith
	EndProcedure
	
	Procedure.i DoPicture() 
		Static newpic.i  
		Static num.i = 0

		If IsImage(newpic)  
			FreeImage(newpic)
		EndIf

		If num + 1 > ListSize(pic())-1
			num = 0
		Else
			num + 1
		EndIf	
		SelectElement(pic(), num)
		newpic = LoadImage(#PB_Any,pic())
		With ent\cBoard
			If IsMaterial(\Mat)
				FreeMaterial(\Mat)
			EndIf
			If IsTexture(\Tex)
				FreeTexture(\Tex)
			EndIf
			\Tex = CreateTexture(#PB_Any,500,500)
			StartDrawing(TextureOutput(\Tex))
			DrawImage(ImageID(newpic),0, 0, 500,500)
			StopDrawing()
			\Mat = CreateMaterial(#PB_Any,TextureID(\Tex))
			SetEntityMaterial(\Id, MaterialID(\Mat))
		EndWith
	EndProcedure
	
	Procedure RunSnow()
		Protected Quit.i = 0, PicCount.i = -1, Start.i
		
		If ListSize(pic()) > 0
			PicCount = 0
		EndIf
		SkyBox("Stars.jpg")
		MakeTown()
		MakeMoon()
		MakeSun()
		MakeSign()
		MakeSnow()
		
		If IsSound(Def\Snd)
			PlaySound(Def\Snd,#PB_Sound_Loop)
		EndIf
		
		Start = ElapsedMilliseconds()
		
		Repeat
			If Def\FullScr = #False
				Repeat
					ev = WindowEvent()
					If ev = #PB_Event_CloseWindow
						Quit = 1
					EndIf
				Until ev = 0
			EndIf
			
			If PicCount = 0
				If ElapsedMilliseconds() - Start > 8000
					DoPicture()
					start = ElapsedMilliseconds()
				EndIf
			EndIf

			RotateNode(Def\node, -0.05,-0.05, 0, #PB_Relative)

			ExamineKeyboard()
			RenderWorld()
			FlipBuffers()
		Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
	EndProcedure
	
EndModule

_SnowWorld::InitBasics(1,1,1,1,1)
_SnowWorld::SetScreenRes(1024, 768, "Picture Demo", #False)
_SnowWorld::SetupSound("Music\1.ogg")
_SnowWorld::AssignImages("picture")
_SnowWorld::RunSnow()
Best regards
Peter

Re: Merry Christmas to all of you.

Posted: Sun Dec 22, 2013 10:52 pm
by rsts
Most impressive! :shock:

And a very Merry Christmas to you.

(Only wish I could provide a gift as impressive)

cheers

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 7:23 am
by applePi
Merry Christmas to you also DK_PETER, a great present , and a giant outdoor cinema for all the city for free. i have waited to the end, there is a yellow moon.

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 8:48 am
by Bananenfreak
Merry Christmas DK_Peter and you´ve made a nice example :)

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 9:59 am
by davido
Tried to run this code but received a compiler error: DX9 subsystem cannot be found.
I have DX11 on my system.
Is there any simple way I can make it run?

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 10:47 am
by applePi
Hi davido, try changing the subsystem to opengl, i have tried it and it works.
Image

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 12:22 pm
by davido
Hi applePi,

Thank you for pointing me in the right direction. Have got it working now. :D

@DK_PETER
Very nice work. Thank you.

Happy Christmas! Everyone.

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 12:58 pm
by DK_PETER
Thanks guys :-)
davido wrote:Tried to run this code but received a compiler error: DX9 subsystem cannot be found.
I have DX11 on my system.
Is there any simple way I can make it run?
Sorry for the inconvenience davido (and everyone else trying the demo to no avail).

The Dx9 subsystem is not necessary. I use it for MP3D testing and simply forgot to clear it from
Compiler options. Just empty/clear the line in 'Library subsystem' and it should work nicely.
Even though adding 'OpenGl' to the Library Subsystem works, it shouldn't be necessary.

Buuut what the heck..It works anyway and that's the important part. ;-)

Best regards
Peter

Re: Merry Christmas to all of you.

Posted: Mon Dec 23, 2013 3:32 pm
by davido
Hi DK_PETER,

Thank you for the explanation.

The 'inconvenience' was worth it as I learned something new, courtesy of applePi. :D
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited