PurePunch Contest July-August 2014

djes · Post by **djes** » Sun Aug 31, 2014 2:24 pm

Last hours to post your code !

djes · Post by **djes** » Mon Sep 01, 2014 11:17 am

It's time to vote !

http://www.purebasic.fr/english/viewtop ... 98#p452098

User_Russian · Post by **User_Russian** » Mon Sep 01, 2014 3:39 pm

djes wrote:full Raspberry Pi kit to the winner !

What a wonderful prize!

Why is it not there before it is written?

I would would take part in contest.

djes · Post by **djes** » Mon Sep 01, 2014 3:55 pm

User_Russian wrote:
djes wrote:full Raspberry Pi kit to the winner !
What a wonderful prize!
Why is it not there before it is written? I would would take part in contest.

It has been said and written since the first day of the contest...

Tenaja · Post by **Tenaja** » Tue Sep 02, 2014 12:06 am

Complete with photo!

Little John · Post by **Little John** » Tue Sep 02, 2014 5:06 am

djes wrote:
User_Russian wrote:
djes wrote:full Raspberry Pi kit to the winner !
What a wonderful prize!
Why is it not there before it is written? I would would take part in contest.
It has been said and written since the first day of the contest...

But you probably didn't send him a personal invitation, did you?

djes · Post by **djes** » Tue Sep 02, 2014 7:57 am

Little John wrote:
djes wrote:
User_Russian wrote:
djes wrote:full Raspberry Pi kit to the winner !
What a wonderful prize!
Why is it not there before it is written? I would would take part in contest.
It has been said and written since the first day of the contest...
But you probably didn't send him a personal invitation, did you?

Damn' ! Completely forgotten ! No excuse

graph100 · Post by **graph100** » Fri Sep 05, 2014 7:02 pm

HI !

Since it finished, I post here the code of my punch in 'readable' version, since the punched one isn't humanly useful

-> Moonlander nightmare : (should be linux / mac / windows compatible)

Code: Select all

;{ structure

InitSprite()
InitKeyboard()
UsePNGImageDecoder()

Structure _pointD_
	x.d
	y.d
	
	s.d
	v.d
EndStructure

Structure _moteur_
	x.d
	y.d
	
	a.d
	l.d
	
	b.d
	m.d
	
	u.d
	v.d
EndStructure


Structure _obj_
	; position et Mouvement du centre de gravité
	x.d
	y.d
	
	a.d ; angle
	
	
	v.d ; vitesse horizontale
	u.d ; vitesse verticale
	w.d ; vitesse de rotation
	
	m.d ; masse
	I.d ; moment d'inertie
	
	c.d ; carburant
	s.d ; score
	
	List f._moteur_()
	
EndStructure

Structure _mur_dim_
	l.d
	a.d
	
	m.d
EndStructure

Structure _mur_
	x.d
	y.d
	
	List mur._mur_dim_()
EndStructure


Define _lander_._obj_, _mon_mur_._mur_, _baril_._pointD_



;}



;{ fenetre

OpenWindow(0, 0, 0, 800, 600, "MoonLander", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, 800, 600)
KeyboardMode(1)

;SpriteQuality(#PB_Sprite_BilinearFiltering)
LoadSprite(0, "M.png")
CopySprite(0, 1, #PB_Sprite_PixelCollision)
ClipSprite(1, 61, 38, 15, 25)
ClipSprite(0, 2, 21, 55, 42)

For i = 0 To 9
	CopySprite(0, 10 + i)
	ClipSprite(10 + i, 80, 3 + i * 6, 5, 7)
	ZoomSprite(10 + i, 10, 14)
Next

CopySprite(0, 9, #PB_Sprite_PixelCollision) ; sprite pour la collision des points
ClipSprite(9, 80, 9, 13, 7)
ZoomSprite(9, 26, 14)

CopySprite(0, 6) ; SCORE
ClipSprite(6, 56, 3, 25, 7)
ZoomSprite(6, 50, 14)

CopySprite(0, 7) ; FUEL
ClipSprite(7, 60, 9, 21, 7)
ZoomSprite(7, 42, 14)

CopySprite(0, 8) ; SPACE
ClipSprite(8, 1, 9, 53, 9)
ZoomSprite(8, 212, 36)

CreateSprite(4, 10, 10)

Procedure _DisplayNB_(n, x, y)
	i = Int(Log10(n))
	p = Pow(10,i)
	
	For j = i To 0 Step -1
		r.l = Int(n/p)
		n - r * p
		p / 10
		
		DisplaySprite(10 + r, x, y)
		x + 8
	Next
EndProcedure


;}

#_puissance_moteur_ = 5000.0
#_G_ = 9.8 ; g = 1 pixels.sec-2 -> 0.02 pixel / frame

Macro TransformSprite_linux(sprite, _x1, _y1, _x2, _y2, _x3, _y3, _x4, _y4)
	CompilerIf #PB_Compiler_OS = #PB_OS_Windows
		TransformSprite(sprite, _x1, _y1, _x2, _y2, _x3, _y3, _x4, _y4)
	CompilerElse
		; Linux
		TransformSprite(sprite, _x4, _y1, _x2, (_y1)-(_y3)+(_y4), _x3, (_y1)-(_y2)+(_y4), _x1, _y4)
	CompilerEndIf
EndMacro

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
	Macro SpritePixelCollision_linux
		SpritePixelCollision
	EndMacro
CompilerElse
	Macro SpritePixelCollision_linux
		; Linux
		SpriteCollision
	EndMacro
CompilerEndIf

_DEB_:

NewList _score_._pointD_()

;{ Init Lander

ClearStructure(_lander_, _obj_)
InitializeStructure(_lander_, _obj_)
_lander_\x = 400
_lander_\y = 300
_lander_\m = 1206
_lander_\I = 43172 ;_lander_\m * Pow(20,2) / 2 ; cylindre de rayon 100

_lander_\c = #_puissance_moteur_ * 10000;*10

*md._moteur_ = AddElement(_lander_\f())
*md\a = 0.715743;58966888008
*md\l = 30.479501;308256342
*md\b = -#PI / 2

*mg._moteur_ = AddElement(_lander_\f())
*mg\a = 2.425849;0639209129
*mg\l = 30.479501;308256342
*mg\b = -#PI / 2

*mc._moteur_ = AddElement(_lander_\f())
*mc\a = #PI/2
*mc\l = 5
*mc\b = -#PI / 2
*mc\m = 0

;}

;{ Init MUR

InitializeStructure(_mon_mur_, _mur_)
_mon_mur_\x = -10
_mon_mur_\y = 300

*_elem_o_._mur_dim_ = AddElement(_mon_mur_\mur())
*_elem_o_\a = 0
*_elem_o_\l = 300
*_elem_o_\m = 50

;}

_time_ = ElapsedMilliseconds()

_CREER_BARIL_ = 50
_CREER_SCORE_ = 5
_CRASH_ = 0

Repeat
	_count_ + 1
	
	Repeat
		_event_ = WindowEvent()
	Until _event_ = 0 Or #PB_Event_CloseWindow
	
	ExamineKeyboard()
	
	If KeyboardPushed(#PB_Key_Escape)
		_event_ = #PB_Event_CloseWindow
	EndIf
	
	
	_dt_.d = (ElapsedMilliseconds() - _time_) / 1000
	_time_ = ElapsedMilliseconds()
	
	*md\m = 0
	*mg\m = 0
	*mc\m = 0
	
	If _CRASH_
		_dt_ = 0
		
		
		If KeyboardPushed(#PB_Key_Space)
			Goto _DEB_
		EndIf
	Else
		If KeyboardPushed(#PB_Key_Up)
			*md\m = #_puissance_moteur_ / 0.5
			*mg\m = #_puissance_moteur_ / 0.5
			
		EndIf
		If KeyboardPushed(#PB_Key_Left)
			*md\m + #_puissance_moteur_ / 1
		EndIf
		
		If KeyboardPushed(#PB_Key_Right)
			*mg\m + #_puissance_moteur_ / 1
		EndIf
		
		If KeyboardPushed(#PB_Key_Down)
			*mc\m = #_puissance_moteur_ / 0.1
		EndIf
	EndIf
	
	;}
	
	;{ physique
	
	
	_ax_.d = 0 ; sert à stocker les forces x
	_ay_.d = 0 ; sert à stocker les forces y
	
	_cz_.d = 0 ; sert à stocker le couple
	
	
	; maj des pos des moteurs
	ForEach _lander_\f()
		*_m_._moteur_ = _lander_\f()
		
		_lander_\c - *_m_\m
		
		If _lander_\c < 0
			_lander_\c = 0
			
			Break
		EndIf
		
		_tmp_.d = _lander_\a + *_m_\a
		*_m_\x = *_m_\l * Cos(_tmp_)
		*_m_\y = *_m_\l * Sin(_tmp_)
		
		_tmp_ = _lander_\a + *_m_\b
		*_m_\u = *_m_\m * Cos(_tmp_)
		*_m_\v = *_m_\m * Sin(_tmp_)
		
		_ax_ + *_m_\u
		_ay_ + *_m_\v
		
		_cz_ + *_m_\x * *_m_\v - *_m_\u * *_m_\y
	Next
	
	; Forces
	_ax_ = _ax_ / _lander_\m
	_ay_ = _ay_ / _lander_\m + #_G_
	
	_cz_ = _cz_ / _lander_\I
	
	; ajout
	_lander_\u + _ax_ * _dt_
	_lander_\v + _ay_ * _dt_
	_lander_\w + _cz_ * _dt_
	
	_lander_\a + _lander_\w * _dt_
	
	_tmp_ = _lander_\u * _dt_
	_baril_\x - _tmp_
	_mon_mur_\x - _tmp_
	
	_tmp_ = _lander_\v * _dt_
	_baril_\y - _tmp_
	_mon_mur_\y - _tmp_
	
	;}
	
	;{ dessin
	
	ClearScreen(0)
	
	RotateSprite(0, _lander_\a * 180/#PI, #PB_Absolute)
	DisplayTransparentSprite(0, _lander_\x - 27, _lander_\y - 21)
	GrabSprite(2, _lander_\x - 34, _lander_\y - 34, 68, 68, #PB_Sprite_PixelCollision)
	
	
	
	ClearScreen($FFFFFF)
	
	;{ mur
	
	Repeat
		
		If _offset_x_.d >=-200 And _offset_x_ <= 1000 And _offset_y_.d >= -200 And _offset_y_ <= 800
			
			*_elem_._mur_dim_ = AddElement(_mon_mur_\mur())
			*_elem_\a = *_elem_o_\a + (Random(20)-10) / #PI / 10
			*_elem_\l = *_elem_o_\l + Random(20) - 10
			
			If *_elem_\l < 100 : *_elem_\l = 100 : EndIf
			If *_elem_\l > 400 : *_elem_\l = 400 : EndIf
			
			_CREER_BARIL_-1
			_CREER_SCORE_-1
			
			*_elem_\m = Random(20)+40
			*_elem_ = *_elem_o_
		EndIf
		
		_offset_x_ = _mon_mur_\x
		_offset_y_ = _mon_mur_\y
		
		ForEach _mon_mur_\mur()
			_tmp_ = _mon_mur_\mur()\a + #PI/2
			x.d = _offset_x_ + _mon_mur_\mur()\l * Cos(_tmp_)/2
			y.d = _offset_y_ + _mon_mur_\mur()\l * Sin(_tmp_)/2
			
			_tmp_ = _mon_mur_\mur()\a - #PI/2
			x1.d = _offset_x_ + _mon_mur_\mur()\l * Cos(_tmp_)/2
			y1.d = _offset_y_ + _mon_mur_\mur()\l * Sin(_tmp_)/2
			
			_offset_x_ = _offset_x_ + _mon_mur_\mur()\m * Cos(_mon_mur_\mur()\a)
			_offset_y_ = _offset_y_ + _mon_mur_\mur()\m * Sin(_mon_mur_\mur()\a)
			
			If ListIndex(_mon_mur_\mur()) > 0
				TransformSprite_linux(4, x, y, ox.d, oy.d, ox1.d, oy1.d, x1, y1)
				DisplaySprite(4, 0, 0)
			EndIf
			
			ox = x
			oy = y
			ox1 = x1
			oy1 = y1
		Next
		
		If _CREER_BARIL_ < 0
			_CREER_BARIL_ = 30
			
			_tmp_ = _mon_mur_\mur()\l - 60
			_tmp_ = (Random(_tmp_) - _tmp_ / 2)
			_baril_\x = _offset_x_ + _tmp_ * Cos(_mon_mur_\mur()\a + #PI/2)
			_baril_\y = _offset_y_ + _tmp_ * Sin(_mon_mur_\mur()\a + #PI/2)
			
			_baril_\s = 1
		EndIf
		
		If _CREER_SCORE_ < 0
			_CREER_SCORE_ = 5
			
			LastElement(_score_())
			AddElement(_score_())
			
			_tmp_ = _mon_mur_\mur()\l - 60
			_tmp_ = (Random(_tmp_) - _tmp_ / 2)
			
			_score_()\x = _offset_x_ + _tmp_ * Cos(_mon_mur_\mur()\a + #PI/2)
			_score_()\y = _offset_y_ + _tmp_ * Sin(_mon_mur_\mur()\a + #PI/2)
			
			_score_()\v = 100 * Abs(_tmp_) / (_mon_mur_\mur()\l / 2 - 50)
			
			_score_()\s = 1
		EndIf
		
		; Suppression des murs trop loin
		If ListSize(_mon_mur_\mur()) > 40
			FirstElement(_mon_mur_\mur())
			_mon_mur_\x = _mon_mur_\x + _mon_mur_\mur()\m * Cos(_mon_mur_\mur()\a)
			_mon_mur_\y = _mon_mur_\y + _mon_mur_\mur()\m * Sin(_mon_mur_\mur()\a)
			
			DeleteElement(_mon_mur_\mur())
			*_elem_o_ = LastElement(_mon_mur_\mur())
		EndIf
		
	Until _offset_x_ <-200 Or _offset_x_ > 1000 Or _offset_y_ < -200 Or _offset_y_ > 800
	
	;}
	
	
	StartDrawing(ScreenOutput())
	
	;{ Détection des bords
	
	For i = 0 To 15
		_tmp_ = i*2*#PI/15
		
		If Point(400 + 22*Cos(_tmp_), 300 + 22*Sin(_tmp_))
			_CRASH_ = #True
		EndIf
	Next
	
	If Point(400 + 34*Cos(0.64+_lander_\a), 300 + 34*Sin(0.64+_lander_\a)) Or Point(400 + 34*Cos(2.5+_lander_\a), 300 + 34*Sin(2.5+_lander_\a))
		_CRASH_ = #True
	EndIf
	
	;}
	
	;{ dessin des moteurs
	
	If _lander_\c
		ForEach _lander_\f()
			For i = -5 To 5
				_tmp_ = _lander_\a + _lander_\f()\b + i/10
				LineXY(_lander_\x + _lander_\f()\x, _lander_\y + _lander_\f()\y, _lander_\x + _lander_\f()\x - _lander_\f()\m * Cos(_tmp_) / (#_puissance_moteur_/10), _lander_\y + _lander_\f()\y - _lander_\f()\m * Sin(_tmp_) / (#_puissance_moteur_/10), $88FF)
			Next
		Next
	EndIf
	
	;}
	
	StopDrawing()
	
	; Affichage vaisseau
	DisplayTransparentSprite(2, _lander_\x - 34, _lander_\y - 34)
	
	;{ Baril
	
	If _baril_\s
		If SpritePixelCollision_linux(1, _baril_\x - 7, _baril_\y - 12, 2, _lander_\x - 34, _lander_\y - 34)
			_lander_\c + 5000*#_puissance_moteur_
			
			_baril_\s	= 0
		EndIf
		
		DisplayTransparentSprite(1, _baril_\x - 7, _baril_\y - 12)
	EndIf
	
	;}
	
	;{ points
	
	ForEach _score_()
		_score_()\x - _lander_\u * _dt_
		_score_()\y - _lander_\v * _dt_
		
		If _score_()\s
			If SpritePixelCollision_linux(9, _score_()\x - 6, _score_()\y - 3, 2, _lander_\x - 34, _lander_\y - 34)
				_score_()\s	= 0
				
				_lander_\s + _score_()\v
			EndIf
			
			_DisplayNB_(_score_()\v, _score_()\x - 6, _score_()\y - 3)
		EndIf
	Next
	
	;}
	
	; UI
	DisplaySprite(6, 400-48, 5)
	_DisplayNB_(_lander_\s, 400, 5)
	
	DisplaySprite(7, 400-40, 19)
	_DisplayNB_(_lander_\c / #_puissance_moteur_, 400, 19)
	
	If _CRASH_ And _count_%50 < 30
		DisplaySprite(8, 294, 282)
	EndIf
	
	FlipBuffers()
	
	;}
	
Until  _event_ = #PB_Event_CloseWindow

And the Fluid game Engine (version adapted for the punch demo)

Code: Select all

;{ initialisation


CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
	#Red = $0000FF
	#White = $FFFFFF
	#Blue= $FF0000
	#Green = $00FF00
	
	Structure POINT
		x.l
		y.l
	EndStructure
CompilerEndIf


Structure POINT_d
	x.d
	y.d
EndStructure

Structure RGB
	r.a
	g.a
	b.a
	a.a
EndStructure

Structure tableau
	Array tab.d(0, 0)
EndStructure

Macro Tableau_init(_adr_, _struct_)
	_adr_ = AllocateMemory(SizeOf(_struct_))
	InitializeStructure(_adr_, _struct_)
EndMacro

Macro Tableau_Free(_adr_, _struct_)
	ClearStructure(_adr_, _struct_)
	FreeMemory(_adr_)
EndMacro


Structure Tab_dim
	
	Viscosite.d ; fluide
	
	W.l
	H.l
	
	; Calculs
	dim_w.l ; = w + 1 ; Dim 0 et n+1 sont là pour les conditions limites
	dim_h.l ; = h + 1
	
	max_wh.d ; max(W, H)
EndStructure


Structure Fluide
	Param.Tab_dim ; Paramètres, DOIT etre mis en 1er
	
	; Tableaux des vitesses du fluide
	*u.tableau
	*v.tableau
	
	*u_prec.tableau
	*v_prec.tableau
	
EndStructure

Structure ObjectDiscret
	x.d
	y.d
	
	vit.POINT_d
EndStructure




Structure Source_Vitesse
	Pos.POINT
	dir.POINT_d ; pixels / seconde
	
	vitesse.d ; indicatif, ne sert pas dans les calculs, mais pour affichage
EndStructure


Structure SIM_FL
	Fluide.Fluide
	
	List Object_discret.ObjectDiscret()
	
	dt.d ; s entre chaque simulation
	
	List Source_Vitesses.Source_Vitesse()
	
EndStructure




Procedure Fluide_Init(*obj.Fluide, Largeur.l, Hauteur.l, Viscosite.d)
	With *obj
		
		\Param\W= Largeur
		\Param\H = Hauteur
		
		If \Param\W > \Param\H
			\Param\max_wh = \Param\W
		Else
			\Param\max_wh = \Param\H
		EndIf
		
		\Param\Viscosite = Viscosite
		
		\Param\Dim_w = \Param\w + 1
		\Param\Dim_h = \Param\h + 1
		
		Tableau_init(\u, tableau)
		Tableau_init(\v, tableau)
		
		Tableau_init(\u_prec, tableau)
		Tableau_init(\v_prec, tableau)
		
		Dim \u\tab(\Param\Dim_w, \Param\Dim_h)
		Dim \v\tab(\Param\Dim_w, \Param\Dim_h)
		Dim \u_prec\tab(\Param\Dim_w, \Param\Dim_h)
		Dim \v_prec\tab(\Param\Dim_w, \Param\Dim_h)
		
	EndWith
EndProcedure


Procedure.i AjouterSource_Flux(*obj.SIM_FL, x.l, y.l, dir_x.d, dir_y.d)
	Protected *new_vit.Source_Vitesse = AddElement(*obj\Source_Vitesses())
	
	*new_vit\Pos\x = x
	*new_vit\Pos\y =y
	
	*new_vit\dir\x = dir_x
	*new_vit\dir\y = dir_y
	
	*new_vit\vitesse = Sqr(*new_vit\dir\x * *new_vit\dir\x + *new_vit\dir\y * *new_vit\dir\y)
	
	ProcedureReturn *new_vit
EndProcedure

Procedure Source_Init(*obj.SIM_FL)
	
	ClearList(*obj\Source_Vitesses())
	
EndProcedure


Procedure Ajouter_ObjectDiscret(*obj.SIM_FL, x.l, y.l)
	AddElement(*obj\Object_discret())
	
	*obj\Object_discret()\x = x
	*obj\Object_discret()\y = y
EndProcedure


;}


;{ Simulation

Procedure FS_SetBoundaryCondition(*obj.Tab_dim, MODE.l, Array x.d(2))
	With *obj
		
		; MODE = 0 : lorsque x() = dens()
		; MODE = 1 : lorsque x() = u()
		; MODE = 2 : lorsque x() = v()
		
		Protected i
		
		If MODE = 2
			For i = 1 To \W
				
				x(i, 0) = - x(i, 1)
				x(i, \dim_h) = - x(i, \H)
				
			Next
		Else
			For i = 1 To \W
				
				x(i, 0) = x(i, 1)
				x(i, \dim_h) = x(i, \H)
				
			Next
		EndIf
		
		If MODE = 1
			For i = 1 To \H
				
				x(0, i) = - x(1, i)
				x(\dim_w, i) = - x(\W, i)
				
			Next
		Else
			For i = 1 To \H
				
				x(0, i) = x(1, i)
				x(\dim_w, i) = x(\W, i)
				
			Next
		EndIf
		
		; Les coins
		x(0, 0) = 0.5 * (x(1, 0) + x(0, 1))
		x(0, \dim_h) = 0.5 * (x(1, \dim_h) + x(0, \H))
		x(\dim_w, 0) = 0.5 * (x(\W, 0) + x(\dim_w, 1))
		x(\dim_w, \dim_h) = 0.5 * (x(\W, \dim_h) + x(\dim_w, \H))
		
	EndWith
EndProcedure



Procedure FS_LinSolve(*obj.Tab_dim, MODE.l, Array x.d(2), Array x0.d(2), a.d, c.d)
	With *obj
		
		Protected.l i, j, k
		
		For k = 0 To 20
			
			For i = 1 To \W
				For j = 1 To \H
					
					x(i, j) = (x0(i, j) + a * (x(i-1, j) + x(i+1, j) + x(i, j-1) + x(i, j+1))) / c
					
				Next
			Next
			
			FS_SetBoundaryCondition(*obj, MODE, x())
			
		Next
		
	EndWith
EndProcedure

Procedure FS_AddSource(*obj.Tab_dim, Array x.d(2), Array s.d(2), dt.d)
	With *obj
		
		Protected i, j
		
		
		For i = 0 To \dim_w
			For j = 0 To \dim_h
				
				x(i, j) = x(i, j) + dt.d * s(i, j)
				
			Next
		Next
		
	EndWith
EndProcedure


Procedure FS_Diffusion(*obj.Tab_dim, MODE.l, Array x.d(2), Array x0.d(2), diffusion.d, dt.d)
	With *obj
		
		Protected.d a = dt * diffusion * \W * \H
		
		FS_LinSolve(*obj, MODE, x(), x0(), a, 1 + 4  * a)
		
	EndWith
EndProcedure

Procedure FS_Advection(*obj.Tab_dim, MODE.l, Array d.d(2), Array d0.d(2), Array u.d(2), Array v.d(2), dt.d)
	With *obj
		
		Protected.l i, j, i0, j0, i1, j1
		Protected.d x, y, s0, t0, s1, t1, dt0_u, dt0_v
		
		; dt0 = dt * N ; mais ici j'ai pris un rectangle et non pas un carré !
		dt0_u = dt * \max_wh
		dt0_v = dt * \max_wh
		
		
		For i = 1 To \W
			For j = 1 To \H
				
				x = i - dt0_u * u(i, j)
				y = j - dt0_v * v(i, j)
				
				If x < 0.5 : x = 0.5 : EndIf
				If x > \W + 0.5 : x = \W + 0.5 : EndIf
				i0 = Round(x, #PB_Round_Down)
				i1 = i0 + 1
				
				If y < 0.5 : y = 0.5 : EndIf
				If y > \H + 0.5 : y = \H + 0.5 : EndIf
				j0 = Round(y, #PB_Round_Down)
				j1 = j0 + 1
				
				s1 = x - i0
				s0 = 1 - s1
				t1 = y - j0
				t0 = 1 - t1
				
				d(i, j) = s0 * (t0 * d0(i0, j0) + t1 * d0(i0, j1)) + s1 * (t0 * d0(i1, j0) + t1 * d0(i1, j1))
				
			Next
		Next
		
		FS_SetBoundaryCondition(*obj, MODE, d())
		
		
	EndWith
EndProcedure

Procedure FS_Projection(*obj.Tab_dim, Array u.d(2), Array v.d(2), Array p.d(2), Array div.d(2))
	With *obj
		
		Protected.l i, j
		
		For i = 1 To \W
			For j = 1 To \H
				
				; ici on change le /N qui apparait dans le code original, pour voir comment ça se comporte avec un rectangle
; 				div(i, j) = -0.5 * ((u(i+1, j) - u(i-1, j)) / *obj\W + (v(i, j+1) - v(i, j-1)) / *obj\H)
				div(i, j) = -0.5 * ((u(i+1, j) - u(i-1, j) + v(i, j+1) - v(i, j-1)) / *obj\max_wh)
				
				p(i, j) = 0
			Next
		Next
		
		FS_SetBoundaryCondition(*obj, 0, div())
		FS_SetBoundaryCondition(*obj, 0, p())
		
		
		FS_LinSolve(*obj, 0, p(), div(), 1, 4) ; boom !! prend ça !
		
		
		For i = 1 To \W
			For j = 1 To \H
				
				u(i, j) = u(i, j) - 0.5 * \W * (p(i+1, j) - p(i-1, j))
				v(i, j) = v(i, j) - 0.5 * \H * (p(i, j+1) - p(i, j-1))
				
			Next
		Next
		
		FS_SetBoundaryCondition(*obj, 1, u())
		FS_SetBoundaryCondition(*obj, 2, v())
		
	EndWith
EndProcedure


Procedure FS_Advection_ObjectDiscret(*obj.ObjectDiscret, *fluide.Fluide, Array u.d(2), Array v.d(2), dt.d)
	With *obj
		
		Protected.l i, j, i0, j0, i1, j1
		Protected.d x, y, s0, t0, s1, t1, dt0_u, dt0_v
		
		dt0_u = dt * *fluide\Param\max_wh
		dt0_v = dt * *fluide\Param\max_wh
		
		
		i0 = Round(\x, #PB_Round_Down)
		i1 = i0 + 1
		
		j0 = Round(\y, #PB_Round_Down)
		j1 = j0 + 1
		
		s1 = \x - i0
		s0 = 1 - s1
		t1 = \y - j0
		t0 = 1 - t1
		
		\vit\x = dt0_u * (s0 * (t0 * u(i0, j0) + t1 * u(i0, j1)) + s1 * (t0 * u(i1, j0) + t1 * u(i1, j1)))
		\vit\y = dt0_v * (s0 * (t0 * v(i0, j0) + t1 * v(i0, j1)) + s1 * (t0 * v(i1, j0) + t1 * v(i1, j1)))
		
		\x = \x + \vit\x
		\y = \y + \vit\y
		
		If \x < 1 : \x = 1 : EndIf
		If \x > *fluide\Param\W : \x = *fluide\Param\W : EndIf
		
		If \y < 1 : \y = 1 : EndIf
		If \y > *fluide\Param\H : \y = *fluide\Param\H : EndIf
		
		
		
	EndWith
EndProcedure


Procedure Fluide_Sim_Velocite(*obj.SIM_FL)
	
	FS_AddSource(*obj\Fluide, *obj\Fluide\u\tab(), *obj\Fluide\u_prec\tab(), *obj\dt)
	FS_AddSource(*obj\Fluide, *obj\Fluide\v\tab(), *obj\Fluide\v_prec\tab(), *obj\dt)
	
	If *obj\Fluide\Param\Viscosite
		Swap *obj\Fluide\u_prec, *obj\Fluide\u
		Swap *obj\Fluide\v_prec, *obj\Fluide\v
		
		FS_Diffusion(*obj\Fluide, 1, *obj\Fluide\u\tab(), *obj\Fluide\u_prec\tab(), *obj\Fluide\Param\Viscosite, *obj\dt)
		FS_Diffusion(*obj\Fluide, 2, *obj\Fluide\v\tab(), *obj\Fluide\v_prec\tab(), *obj\Fluide\Param\Viscosite, *obj\dt)
	EndIf
	
	FS_Projection(*obj\Fluide, *obj\Fluide\u\tab(), *obj\Fluide\v\tab(), *obj\Fluide\u_prec\tab(), *obj\Fluide\v_prec\tab())
	
	Swap *obj\Fluide\u_prec, *obj\Fluide\u
	Swap *obj\Fluide\v_prec, *obj\Fluide\v
	
	FS_Advection(*obj\Fluide, 1, *obj\Fluide\u\tab(), *obj\Fluide\u_prec\tab(), *obj\Fluide\u_prec\tab(), *obj\Fluide\v_prec\tab(), *obj\dt)
	FS_Advection(*obj\Fluide, 2, *obj\Fluide\v\tab(), *obj\Fluide\v_prec\tab(), *obj\Fluide\u_prec\tab(), *obj\Fluide\v_prec\tab(), *obj\dt)
	
	FS_Projection(*obj\Fluide, *obj\Fluide\u\tab(), *obj\Fluide\v\tab(), *obj\Fluide\u_prec\tab(), *obj\Fluide\v_prec\tab())
	
EndProcedure

Procedure Fluide_Sim_Object(*obj.SIM_FL)
	
	ForEach *obj\Object_discret()
		FS_Advection_ObjectDiscret(*obj\Object_discret(), *obj\Fluide, *obj\Fluide\u\tab(), *obj\Fluide\v\tab(), *obj\dt)
	Next
	
EndProcedure

;}


;{ INIT

Define sim.SIM_FL
Fluide_Init(sim\Fluide, 50, 50, 0)

AjouterSource_Flux(sim, 25, 25, 50, 10)

For i=15 To 35
	Ajouter_ObjectDiscret(sim, 10, i)
Next
;}


;{ Affichage

OpenWindow(0, 0, 0, 520,520, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)

CanvasGadget(0, 0, 0, 520,520, #PB_Canvas_Keyboard)

Tps_Loop_mini.d = 0.040
time = ElapsedMilliseconds()
Repeat
	Repeat
		event = WindowEvent()
	Until event = 0 Or event = #PB_Event_CloseWindow
	
	
	;{ mise à jour du delta de temps et stabilisation des FPS
	
	sim\dt = (ElapsedMilliseconds() - time) / 1000
	
	tps.d = sim\dt
	
	If sim\dt < Tps_Loop_mini
		Delay(1000 * (Tps_Loop_mini - sim\dt))
		
		sim\dt = (ElapsedMilliseconds() - time) / 1000 ; on reprend le temps total de la boucle, delay compris
	Else
		sim\dt = Tps_Loop_mini ; temps fixe
	EndIf
	
	time = ElapsedMilliseconds()
	
	;}
	
	
	
	;{ SIMULATION
	
	Dim sim\Fluide\u_prec\tab(sim\Fluide\Param\dim_w, sim\Fluide\Param\dim_h)
	Dim sim\Fluide\v_prec\tab(sim\Fluide\Param\dim_w, sim\Fluide\Param\dim_h)
	
	ForEach sim\Source_Vitesses()
		With sim\Source_Vitesses()
			sim\Fluide\u_prec\tab(\Pos\x, \Pos\y) = \dir\x
			sim\Fluide\v_prec\tab(\Pos\x, \Pos\y) = \dir\y
			
			Debug \dir\x
		EndWith
	Next
	
	
	Fluide_Sim_Velocite(sim)
	Fluide_Sim_Object(sim)
	
	;}
	
	
	;{ dessin
	
	StartDrawing(CanvasOutput(0))
	
	Box(0, 0, 800, 600, 0)
	
	For i = 0 To sim\Fluide\Param\dim_w
		For j = 0 To sim\Fluide\Param\dim_h
			
			LineXY(10*i, 10*j, 10*i+100 * sim\Fluide\u\tab(i,j), 10*j+100 * sim\Fluide\v\tab(i,j), #Red)
			
		Next
	Next
	
	ForEach sim\Object_discret()
		Circle(sim\Object_discret()\x * 10, sim\Object_discret()\y * 10, 3, #Green)
	Next
	
	; DrawText(550, 10, "tps = " + sim\dt)
	
	StopDrawing()
	
	;}
	
	
Until event = #PB_Event_CloseWindow


;}

End

DK_PETER · Post by **DK_PETER** » Sat Sep 06, 2014 8:33 am

graph100 wrote:HI !
Since it finished, I post here the code of my punch in 'readable' version, since the punched one isn't humanly useful

You're absolutely right.

Planetbust:

Code: Select all

;Planetbuster - readable code
InitEngine3D():InitSprite():InitKeyboard():InitMouse()

Structure _ms
  id.i
  ms.i
  ma.i
  tx.i
  us.i
EndStructure

Global cam.i, crs.i, hud.i
Global Dim sp._ms(200)
Global Sco.i = 500, Score.i=0, tim.i, time.i=200, gco.i=$E2D354
Global w = 1024, h = 768

Procedure.i Hideit(id.i)
      HideEntity(sp(id)\id,1)
      sp(x)\us=1
      score+1
  ProcedureReturn 0
EndProcedure

Procedure reset()
  For x = 0 To 200
    HideEntity(sp(x)\id,0)
    sp(x)\us=0
    score=0
    time=200
  Next
EndProcedure

Procedure.f rd()
  ProcedureReturn (-1000+(1000--1000)*Random(100000)/100000)
EndProcedure

Procedure.i Plan()
  For num = 0 To 200
    sp(num)\ms = num
    CreateSphere(num, Random(50,20), 30, 30)
    sp(num)\us = 0
    sp(num)\tx = num
    CreateTexture(num, 99, 99)
    StartDrawing(TextureOutput(sp(num)\tx))
    Box(0, 0, 99, 99, RGB(Random(255,90), Random(255,90), Random(255,90)))
    sco=RGBA(Random(255,50),Random(255,50),Random(255,50),Random(255,120))
    For x=0 To 50
      Ellipse(Random(98,1), Random(98,1), Random(10,2), Random(10,2), sco)
    Next x
    StopDrawing()
    sp(num)\ma = num
    CreateMaterial(num, TextureID(sp(num)\tx))
    ScaleMaterial(sp(num)\ma, 0.2, 0.2)
    ScrollMaterial(sp(num)\ma, -0.2, 0, #PB_Material_Animated)
    sp(num)\id = num
    CreateEntity(num, MeshID(sp(num)\ms), MaterialID(sp(num)\ma), rd(), rd(), rd(), 2)
  Next num
EndProcedure

Procedure.i DrawTabl(Index.i=0)
  Select Index
    Case 0
      If IsSprite(500)
        FreeSprite(500)
      EndIf
      CreateSprite(500, 120, 20)
      StartDrawing(SpriteOutput(500))
      DrawText(0,0,"Score: " + Str(Score),gco,0)
      StopDrawing()
    Case 1
      If IsSprite(501)
        FreeSprite(501)
      EndIf
      CreateSprite(501, 120, 20)
      StartDrawing(SpriteOutput(501))
      DrawText(0,0,"Count down: " + Str(time),gco,0)
      StopDrawing()
  EndSelect
EndProcedure

OpenWindow(0, 0, 0, w, h, "Planetbuster", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, w, h, 0, 0, 0, #PB_Screen_WaitSynchronization)
cam=CreateCamera(#PB_Any,0, 0, 100, 100)
hud=CreateSprite(#PB_Any, w, h)
StartDrawing(SpriteOutput(hud))
DrawingMode(#PB_2DDrawing_Outlined)
Box(w/4,h/4,w/2,h/2,gco)
LineXY(0,0,w/4,h/4,gco)
LineXY(w/4,h-h/4,0,h,gco)
LineXY(w,0,w-w/4,h/4,gco)
LineXY(w-w/4,h-h/4,w,h,gco)
StopDrawing()
TransparentSpriteColor(hud,0)
crs=CreateSprite(#PB_Any,30,30)
StartDrawing(SpriteOutput(crs))
DrawingMode(#PB_2DDrawing_Outlined)
Box(0,0,30,30,gco)
StopDrawing()
TransparentSpriteColor(crs,0)
Plan()
DrawTabl()
tm=ElapsedMilliseconds()
Repeat
  Repeat
    ev=WindowEvent()
  Until ev=0
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_W)>0
    xkey=1
  ElseIf KeyboardPushed(#PB_Key_S) > 0
    xkey=-1
  Else
    xkey=0
  EndIf
  If KeyboardPushed(#PB_Key_A)>0
    ykey=1
  ElseIf KeyboardPushed(#PB_Key_D) > 0
    ykey=-1
  Else
    ykey=0
  EndIf
  RotateCamera(cam,xkey,ykey,0,#PB_Relative):RenderWorld()
  If ElapsedMilliseconds()-tm > 200
    time-1
    If time < 0 
      MessageRequester("","" + Str(Score)):reset()
    EndIf
    tm=ElapsedMilliseconds()
  EndIf
  ExamineMouse()
  If MouseButton(#PB_MouseButton_Left) > 0
    Ret = MouseRayCast(Cam, MouseX()+15, MouseY()+15, 2)
    If ret > 0
      ret = Hideit(ret)
    EndIf
  EndIf
  DrawTabl(0)
  DrawTabl(1)
  DisplayTransparentSprite(crs, MouseX(), MouseY())
  DisplayTransparentSprite(hud, 0, 0)
  DisplayTransparentSprite(500, w/4, 50)
  DisplayTransparentSprite(501, w-w/4, 50)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Collect eggs:

Code: Select all

InitSprite():InitKeyboard()
Structure spp
  id.i
  x.i
  y.i
EndStructure
Global win.i, bg.i, wag.spp, Dim e.spp(15), Quit=0,score.i=0,lifes.i=5
Procedure reset()
  score=0:lifes=5
  For x=0 To 14
    e(x)\x = 20+Random(990)
    e(x)\y=0-Random(600)
  Next x
EndProcedure
OpenWindow(0,0,0,1024,768,"Egg",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,1024,768,0,0,0,#PB_Screen_WaitSynchronization)
For h=0 To 14
  e(h)\id=CreateSprite(#PB_Any,20,35,#PB_Sprite_PixelCollision)
  e(h)\x=20+Random(990)
  e(h)\y=0-Random(1200)
  StartDrawing(SpriteOutput(e(h)\id))
Box(0,0,20,35,$0)
Ellipse(10,17,9,16,$EEEEEE)
StopDrawing()
TransparentSpriteColor(e(h)\id,0)
Next h
bg=CreateImage(#PB_Any,1024,768)
StartDrawing(ImageOutput(bg))
Box(0,0,1024,768,$B96B21)
Box(0,500,1024,268,$4B9C3D)
For z=0 To 6000
  rx=Random(1023,1)
  ry=490+Random(274,1)
  LineXY(rx,ry,rx,ry+Random(15),$4BA93D)
Next z
StopDrawing()
wag\id=CreateSprite(#PB_Any,60,30,#PB_Sprite_PixelCollision)
colwa=$344450
StartDrawing(SpriteOutput(wag\id))
Box(0,0,60,30,0)
LineXY(0,0,20,20,colwa)
LineXY(20,20,40,20,colwa)
LineXY(60,0,40,20,colwa)
FillArea(30,10,colwa,colwa)
Circle(20,20,3,colwa)
Circle(40,20,3,colwa)
StopDrawing()
TransparentSpriteColor(wag\id,0)
Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  DrawImage(ImageID(bg),0,0)
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(0,0,"SCORE: " + Str(score))
  DrawText(900,0,"LIFES: " + Str(lifes))
StopDrawing()
Repeat:ev=WindowEvent()
  If ev=#PB_Event_CloseWindow
    Quit=1
  EndIf
Until ev=0
For h=0 To 14
  If e(h)\y>768:lifes - 1
    e(h)\x = 20 + Random(1000)
  e(h)\y=0-Random(1200)
Else
  e(h)\y+1
EndIf:
If SpriteCollision(wag\id,wag\x,740,e(h)\id,e(h)\x,e(h)\y)
  score+1
  e(h)\x=20+Random(1000)
  e(h)\y=0-Random(600)
EndIf
DisplayTransparentSprite(e(h)\id, e(h)\x, e(h)\y)
Next h
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Left) And wag\x>0
  wag\x-8
EndIf
If KeyboardPushed(#PB_Key_Right) And wag\x<964
  wag\x+8
EndIf
DisplayTransparentSprite(wag\id,wag\x,740)
If lifes<0
  MessageRequester("Splat!!","Good going!")
  reset()
EndIf
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or Quit=1

Heightmap:

Code: Select all

;Since it doesn't have to be 50 lines anymore
;added a little bit of extras

UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()

InitSprite()
InitKeyboard()

Structure ImageData
  List r.i()
  List g.i()
  List b.i()
  List a.i()
  im.i
  hm.i
  RedImg.i
  GreenImg.i
  BlueImg.i
  GreyImg.i
EndStructure

Global im.ImageData
Global Win.i, Scr.i, Depth.i, Name.s, CurrentIndex.i = 0
Global spr.i, Threshold.i = 140, MinThreshold.i = 40

Declare.i GetImage()
Declare.i SplitImage()
Declare.i TestHeight(Index.i = 0)
Declare.i TestHeightChange(ChangeValue.i = 0)
Declare.i ResetAll()
Declare.i OpenScr()
Declare.i ChangeColorUp(color.i)
Declare.i ChangeColorDown(color.i)


Procedure.i ResetAll()
  If IsImage(im\im)
    FreeImage(im\im)
  EndIf
  If IsImage(im\hm)
    FreeImage(im\hm)
  EndIf
  If IsImage(im\BlueImg)
    FreeImage(im\BlueImg)
  EndIf
  If IsImage(im\GreenImg)
    FreeImage(im\GreenImg)
  EndIf
  If IsImage(im\RedImg)
    FreeImage(im\RedImg)
  EndIf
  If IsImage(im\GreyImg)
    FreeImage(im\GreyImg)
  EndIf
  ClearList(im\b())
  ClearList(im\g())
  ClearList(im\r())
  ClearList(im\a())
  
  ProcedureReturn #True
EndProcedure

Procedure.i GetImage()
  Protected patt.s
  
  ret = ResetAll()
  patt = "All image files (*.png,*.bmp,*.jpg,*.tif,*.tga)|*.png;*.bmp;*.jpg;*.tif;*.tga"
  
  name = OpenFileRequester("Open image", "", patt, 0)
  If Name <> ""
    im\im = LoadImage(#PB_Any, Name)
    If IsImage(im\im) > 0
      Depth = ImageDepth(im\im)
      
      im\BlueImg = CopyImage(im\im, #PB_Any)
      im\GreenImg = CopyImage(im\im, #PB_Any)
      im\RedImg  = CopyImage(im\im, #PB_Any)
      im\GreyImg = CopyImage(im\im, #PB_Any)
    EndIf
  EndIf
EndProcedure

Procedure.i SplitImage()
  Protected col.i
  If IsImage(im\im) = 0
    ProcedureReturn #False
  EndIf
  
  StartDrawing(ImageOutput(im\im))
  DrawingMode(#PB_2DDrawing_AllChannels)
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      AddElement(im\r())
      AddElement(im\g())
      AddElement(im\b())
      col = Point(x,y)
      im\r() = Red(col)
      im\g() = Green(col)
      im\b() = Blue(col)
      If depth = 32
        AddElement(im\a())
        im\a() = Alpha(col)
      EndIf
    Next x
  Next y
  StopDrawing()
  
  FirstElement(im\b())
  StartDrawing(ImageOutput(im\BlueImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      Plot(x, y, RGB(0, 0, im\b()))
      NextElement(im\b())
    Next x
  Next y
  StopDrawing()
  
  FirstElement(im\r())
  StartDrawing(ImageOutput(im\RedImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      Plot(x, y, RGB(im\r(), 0, 0))
      NextElement(im\r())
    Next x
  Next y
  StopDrawing()
  
  FirstElement(im\g())
  StartDrawing(ImageOutput(im\GreenImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      Plot(x, y, RGB(0, im\g(),0))
      NextElement(im\g())
    Next x
  Next y
  StopDrawing()
  
  FirstElement(im\b())
  StartDrawing(ImageOutput(im\BlueImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      Plot(x, y, RGB(0, 0, im\b()))
      NextElement(im\b())
    Next x
  Next y
  StopDrawing()
  
  
  ProcedureReturn #True
EndProcedure    


Procedure.i TestHeight(Index.i = 0)
  CurrentIndex = Index
  Select index
    Case 0
      FirstElement(im\r())
      StartDrawing(ImageOutput(im\GreyImg))
      For y = 0 To ImageHeight(im\im)-1
        For x = 0 To ImageWidth(im\im)-1
          Plot(x, y, RGB(im\r(), im\r(), im\r()))
          NextElement(im\r())
        Next x
      Next y
      StopDrawing()
    Case 1
      FirstElement(im\g())
      StartDrawing(ImageOutput(im\GreyImg))
      For y = 0 To ImageHeight(im\im)-1
        For x = 0 To ImageWidth(im\im)-1
          Plot(x, y, RGB(im\g(), im\g(),im\g()))
          NextElement(im\g())
        Next x
      Next y
      StopDrawing()
    Case 2
      FirstElement(im\b())
      StartDrawing(ImageOutput(im\GreyImg))
      For y = 0 To ImageHeight(im\im)-1
        For x = 0 To ImageWidth(im\im)-1
          Plot(x, y, RGB(im\b(), im\b(), im\b()))
          NextElement(im\b())
        Next x
      Next y
      StopDrawing()
  EndSelect
  
  ProcedureReturn #True
EndProcedure


Procedure.i TestHeightChange(ChangeValue.i = 0)
  Protected newval.i = 0, ocolor.i
  
  StartDrawing(ImageOutput(im\GreyImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      
      ocolor = Point(x,y)
      
      Select CurrentIndex
        Case 0
          newpoint = Red(ocolor)
        Case 1
          newpoint = Green(ocolor)
        Case 2
          newpoint = Blue(ocolor)
      EndSelect
      
      If ChangeValue = 0
        If newpoint - 20 >= Threshold
          newval = newpoint - 20
        Else
          newval = newpoint
        EndIf
      Else
        If newpoint + 20 < Threshold
          newval = newpoint + 20
        Else
          newval = newpoint 
        EndIf
      EndIf
      Plot(x, y, RGB(newval, newval, newval))
    Next x
  Next y
  StopDrawing()
  
  ProcedureReturn #True
EndProcedure



Procedure.i OpenScr()
  Win = OpenWindow(#PB_Any, 0, 0, 1920, 1080,"Grey colors", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  Scr = OpenWindowedScreen(WindowID(Win), 0, 0, 1920,1080,#False, 0, 0, #PB_Screen_SmartSynchronization)
EndProcedure


Procedure.i ChangeColorUp(color.i)
  FirstElement(im\b())
  StartDrawing(ImageOutput(im\GreyImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      Plot(x, y, RGB(im\b(), im\b(), im\b()))
      NextElement(im\b())
    Next x
  Next y
  StopDrawing()
EndProcedure

Procedure.i ChangeColorDown(color.i)
  FirstElement(im\b())
  StartDrawing(ImageOutput(im\GreyImg))
  For y = 0 To ImageHeight(im\im)-1
    For x = 0 To ImageWidth(im\im)-1
      Plot(x, y, RGB(im\b(), im\b(), im\b()))
      NextElement(im\b())
    Next x
  Next y
  StopDrawing()
EndProcedure


Global Quit.i = 0, fn.i, fnb.i

OpenScr()
fnb = LoadFont(#PB_Any, "Arial", 14, #PB_Font_Italic)
fn = LoadFont(#PB_Any, "Arial", 14, #PB_Font_Italic)

spr = CreateSprite(#PB_Any, ScreenWidth(), 200)
StartDrawing(SpriteOutput(spr))
Box(0,0,ScreenWidth(),30, $000000)
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(FontID(fn))
DrawText(0, 0, " F2 = Open Image", $AAdd77, $0) 
DrawText(0, 20, " F3 = Save image", $AAdd77, $0)
DrawText(0, 40, " F5 = Split image", $AAdd77, $0)
DrawText(0, 60, " F6 = Red2Gray", $AAdd77, $0)
DrawText(0, 80, " F7 = Green2Grey", $AAdd77, $0)
DrawText(0, 100," F8 = Blue2Grey", $AAdd77, $0)
DrawText(0, 120," -  = Darken ", $AAdd77, $0)
DrawText(0, 140," +  = Lighten", $AAdd77, $0)
DrawText(0, 160," Up arrow = Increase threshold", $AAdd77, $0)
DrawText(0, 180," Down arrow = Decrease threshold", $AAdd77, $0)
StopDrawing()
TransparentSpriteColor(spr,0)

Repeat
  
  ClearScreen(0)
  
  If IsImage(im\GreyImg)
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(im\GreyImg), 0, 0, ScreenWidth()/2, ScreenHeight()/2)
    DrawText(0, 0, "Threshold = " + Str(Threshold), $FFAAEE, 0)
    StopDrawing()
  EndIf
  If IsImage(im\BlueImg) > 0
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(im\BlueImg), ScreenWidth()/2, 0, ScreenWidth()/2, ScreenHeight()/2)
    StopDrawing()
  EndIf
  If IsImage(im\GreenImg) > 0
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(im\GreenImg), 0, ScreenHeight()/2, ScreenWidth()/2, ScreenHeight()/2)
    StopDrawing()
  EndIf
  If IsImage(im\RedImg) > 0
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(im\RedImg), ScreenWidth()/2, ScreenHeight()/2, ScreenWidth()/2, ScreenHeight()/2)
    StopDrawing()
  EndIf
  
  Repeat
    ev = WindowEvent()
    If ev = #PB_Event_CloseWindow
      Quit = 1
    EndIf
  Until ev = 0
  
  ExamineKeyboard()
  
  If KeyboardReleased(#PB_Key_F2)
    ret = GetImage()
  EndIf
  If KeyboardReleased(#PB_Key_F5)
    ret = SplitImage()
  EndIf
  If KeyboardReleased(#PB_Key_F6)
    ret = TestHeight(0)
    CurrentIndex = 0
  EndIf
  If KeyboardReleased(#PB_Key_F7)
    ret = TestHeight(1)
    CurrentIndex = 1
  EndIf
  If KeyboardReleased(#PB_Key_F8)
    ret = TestHeight(2)
    CurrentIndex = 2
  EndIf
  
  If KeyboardReleased(#PB_Key_Add)
    ret = TestHeightChange(1)
  EndIf
  
  If KeyboardReleased(#PB_Key_Subtract)
    ret = TestHeightChange(0)
  EndIf
  
  If KeyboardPushed(#PB_Key_Up)
    If Threshold + 1 < 256
      threshold + 1
    EndIf
  EndIf
  If KeyboardPushed(#PB_Key_Down)
    If Threshold - 1 > 0
      threshold - 1
    EndIf
  EndIf
  
  
  If KeyboardReleased(#PB_Key_F3)
    ret = SaveImage(im\GreyImg, Name + "_Grey.jpg", #PB_ImagePlugin_JPEG,#PB_Image_FloydSteinberg)
    MessageRequester("Saved", "Image:" + Name + "_Grey.jpg is saved",#PB_MessageRequester_Ok)
  EndIf
  
  DisplayTransparentSprite(spr,0, ScreenHeight()-330)
  FlipBuffers()
  
Until KeyboardReleased(#PB_Key_Escape) Or Quit = 1

PureBasic Forums - English

PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014