PurePunch Contest July-August 2014

[djes]

Thanks kvitaliy !

[idle]

We haven't had a purepunch for awhile!
Here's a brief time absorbing cellular challenge

Code: Select all

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :Osmosis  
;* Author   : idle
;* Date     : 4/7/2014
;* Notes   :Your a tiny cell lost in the petri dish full of preditors: the trick is finding where you are before you loose
;*                :Arrow keys move you round, escape ends , R resets  
;*****************************************************************************
Structure ball:x.d:vx.d:y.d:vy.d:r.d:m.d:sprite.i:EndStructure:Global ri,bo 
Global NewList bb.ball():Global Dim sp(12):Global *player.ball,st,time
Procedure CircleToCircle(*b.ball,*b1.ball):dx.d=*b\x-*b1\x:dy.d=*b\y-*b1\y
dist.d=Sqr(dx*dx+dy*dy):t.d=*b\r+*b1\r:If dist<t:fd.d=(dist-t)/dist:m0.d=*b\m
m1.d=*b1\m:x0.d=*b\x-*b\vx:x1.d=*b1\x-*b1\vx:y0.d=*b\y-*b\vy:y1.d=*b1\y-*b1\vy
dx=*b\x-*b1\x:dy=*b\y-*b1\y:nx.d=dx/t:ny.d=dy/t
p.d=(2*(x0*nx+y0*ny)-(x1*nx+y1*ny))/(m0+m1)*(1/(2*#PI)):dx=x0-(p*m1*nx)
dy=y0-(p*m1*ny):*b\vx=*b\x-dx:*b\vy=*b\y-dy:dx=x1+(p*m0*nx):dy=y1+(p*m0*ny)
*b1\vx=*b1\x-dx:*b1\vy=*b1\y-dy:ProcedureReturn 1:EndIf:EndProcedure
Procedure up():Protected dx.d,dy.d:ForEach bb():dx=(bb()\x-bb()\vx)
dy=(bb()\y-bb()\vy):bb()\vx=bb()\x:bb()\vy=bb()\y:bb()\x+dx:bb()\y+dy
If bb()\x-bb()\r<0:bb()\vx=0+bb()\r:bb()\x=bb()\vx:bb()\x-dx
ElseIf bb()\x+bb()\r>ri:bb()\vx=ri-bb()\r:bb()\x=bb()\vx:bb()\x-dx:EndIf
If bb()\y-bb()\r<=0:bb()\vy=0+bb()\r:bb()\y=bb()\vy:bb()\y-dy
ElseIf bb()\y+bb()\r>=bo:bb()\vy=bo-bb()\r:bb()\y=bb()\vy:bb()\y-dy:EndIf:Next
EndProcedure:Procedure Reset():ClearList(bb()):For a=1 To 100:AddElement(bb())
If a=1:r=18:*player=@bb():Else:r=Random(20,3):EndIf:vx.d=(-1+Random(2))*0.5
vy.d=(-1+Random(2))*0.5 : bb()\x=Random(ri-r,r):bb()\y=Random(bo-r,r)
bb()\vx=bb()\x+vx:bb()\vy=bb()\y+vy:bb()\r=r:bb()\m=#PI*r*r:s=Random(1,0)
If a=1:s=3:EndIf:bb()\sprite=sp(s):Next:st=ElapsedMilliseconds():time=0
EndProcedure:Procedure RunWorld():Protected*bt.ball,ft.d,su.d,ag.d
Repeat:Repeat:EV=WindowEvent():If EV=#PB_Event_CloseWindow:End:EndIf:ag+0.1    
Until EV=0:FirstElement(bb()):ExamineKeyboard():If KeyboardPushed(#PB_Key_Up)
bb()\y-0.01:bb()\m-1:ElseIf KeyboardPushed(#PB_Key_Down):bb()\y+0.01
bb()\m-1:EndIf:If KeyboardPushed(#PB_Key_Left):bb()\x-0.01:bb()\m-1
ElseIf KeyboardPushed(#PB_Key_Right):bb()\x+0.01:bb()\m-1
ElseIf KeyboardInkey()="r":Reset():EndIf:For a=1 To 5:up():ForEach bb()
*bt=@bb():While NextElement(bb()):r= CircleToCircle(@bb(),*bt):If r
If bb()\r>=*bt\r
bb()\m+2:*bt\m-2:Else:*bt\m+2:bb()\m-2:EndIf:bb()\r=Sqr(bb()\m/#PI)
*bt\r=Sqr(*bt\m/#PI):EndIf:Wend:ChangeCurrentElement(bb(),*bt):Next:Next
ClearScreen(0):ZoomSprite(sp(12),ri*2,ri*2):RotateSprite(sp(12),ag,0)
DisplayTransparentSprite(sp(12),0-ri/2,0-ri/2):su=-*player\m:ForEach bb() 
r=bb()\r:If bb()\m>0:su+bb()\m:ZoomSprite(bb()\sprite,bb()\r*2,bb()\r*2)
RotateSprite(sp(2),bb()\x-bb()\vx,1):ZoomSprite(sp(2),bb()\r*1.8,bb()\r*1.8)
rt=bb()\r*0.9:DisplayTransparentSprite(sp(2),bb()\x-rt,bb()\y-rt,127)   
DisplayTransparentSprite(bb()\sprite,bb()\x-bb()\r,bb()\y-bb()\r,127)   
Else: If *player=@bb():If Not time:time=(ElapsedMilliseconds()-st)/1000  
MessageRequester("osmosis","You got absorbed IN "+Str(time)+" seconds") 
EndIf:Else:DeleteElement(bb()):EndIf:EndIf:Next:If *player\m>su:If Not time 
time=(ElapsedMilliseconds()-st)/1000 
MessageRequester("osmosis","You became the largest In "+Str(time)+" seconds") 
EndIf:EndIf:FlipBuffers():Until  KeyboardPushed(#PB_Key_Escape):EndProcedure    
InitSprite():InitKeyboard():UsePNGImageDecoder():ri=800:bo=600
OpenWindow(0,0,0,ri,bo,"Osmosis"):OpenWindowedScreen(WindowID(0),0,0,ri,bo)
For a=0 To 3:sp(a)=LoadSprite(-1,"osmosis.png",8)
ClipSprite(sp(a),a*128,0,128,128):Next
sp(12)=LoadSprite(-1,"osmosis.png")
ClipSprite(sp(12),0,128,512,384):reset():RunWorld() 

image link
https://www.dropbox.com/s/3gbeo8ionh7fktd/osmosis.png

[Bananenfreak]

Really cool game, I like it

EDIT: One more question:
Do spacecharacters also count as 1 character per line?

[idle]

Really cool game, I like it

EDIT: One more question:
Do spacecharacters also count as 1 character per line?

Thanks, all the punches are good. Hopefully there'll be a lot more entries to come.

I think spaces have counted in previous punches but you'll have to ask djes to clarify

[DK_PETER]

Code: Select all

;I'm not participating, I'm NOT a competitive guy!!!!
;Just wanted to add a small game.Move it,if you want it somewhere else :-)
;Collect the eggs...
;navigate using left and right arow keys
;Have fun!
InitSprite():InitKeyboard()
Macro dsp(id,x,y):DisplayTransparentSprite(id,x,y):EndMacro
Macro kp(key):KeyboardPushed(key):EndMacro
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,2)
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(600):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)
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(600):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:dsp(e(h)\id,e(h)\x, e(h)\y)
Next h:ExamineKeyboard():If kp(#PB_Key_Left) And wag\x>0:wag\x-8:EndIf
If kp(#PB_Key_Right) And wag\x<964:wag\x+8:EndIf:dsp(wag\id,wag\x,740)
If lifes<0:MessageRequester("Splat!!","Good going!"):reset():EndIf
FlipBuffers():Until KeyboardPushed(#PB_Key_Escape) Or Quit=1

Edit:removed redundant line

[djes]

Really cool game, I like it

EDIT: One more question:
Do spacecharacters also count as 1 character per line?

Yes !

[djes]

I'm not participating, I'm NOT a competitive guy!!!!
Just wanted to add a small game.Move it,if you want it somewhere else

Thank you ! Anyway, you have 'til 31-08 if you wanna change

[Bananenfreak]

@DK_Peter:
Cool game, but to hard ^^ (33 eggs collected)

@idle:
My program is finished, but in this state it´s too large.
I have to shorten it.

[falsam]

Where is the Turtle : Code update

http://www.purebasic.fr/english/viewtop ... 78#p447478

Improved design: Adding 3 sprites (Number of lives, number of turtles found and remaining time)

[DK_PETER]

@DK_Peter:
Cool game, but to hard ^^ (33 eggs collected)

Thanks. Yes, it is hard and yet you beat me by 4 points.

[DK_PETER]

I'm not participating, I'm NOT a competitive guy!!!!
Just wanted to add a small game.Move it,if you want it somewhere else

Thank you ! Anyway, you have 'til 31-08 if you wanna change

Thanks djes. I'm sure. All I'm hoping for, is to see some great code here.
Let some other coder win the prizes.

Code: Select all

;By DK_PETER.
;This is the game planetbuster. Clear as many planets
;as possible before time runs out. Navigate with WSAD and mouse
;to shoot (left mouse button).
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
Macro ems():ElapsedMilliseconds():EndMacro:Macro ra():Random(255,50):EndMacro
Macro lx(x,y,x1,y1,c):LineXY(x,y,x1,y1,c):EndMacro:wc=#PB_Window_ScreenCentered
Macro kp(k):KeyboardPushed(k):EndMacro:Macro MIT:MaterialID:EndMacro
Macro CRSPR(wi,hi):CreateSprite(#PB_Any,wi,hi):EndMacro
Macro PROR:ProcedureReturn:EndMacro:Macro SCM:ScaleMaterial:EndMacro
Macro CRTX(wi,he):CreateTexture(#PB_Any,wi,he):EndMacro
Macro col():RGB(Random(255,90),Random(255,90),Random(255,90)):EndMacro
Macro DTS(id,x,y):DisplayTransparentSprite(id,x,y):EndMacro
Macro TPC(id,c):TransparentSpriteColor(id,c):EndMacro
Macro SDSO(id):StartDrawing(SpriteOutput(id)):EndMacro
Macro SDTO(id):StartDrawing(TextureOutput(id)):EndMacro
Structure _ms:id.i:ms.i:ma.i:tx.i:us.i:EndStructure
Global cam.i,crs.i,hud.i,w.i=1024,h.i=768,NewList sp._ms(),gco.i=$E2D354
Global Sco.i,Score.i=0,tim.i,time.i=200,sce=#PB_Screen_SmartSynchronization
Procedure.i Hideit(id.i):ForEach sp():If sp()\id=id And sp()\us=0
HideEntity(sp()\id,1):sp()\us=1:score+1:Break:EndIf:Next:ProcedureReturn 0
EndProcedure:Procedure reset():ForEach sp():HideEntity(sp()\id,0):sp()\us=0
score=0:time=200:Next:EndProcedure:Procedure.f rd()
PROR (-1000+(1000--1000)*Random(100000)/100000):EndProcedure:Procedure.i Plan()
For num=0 To 200:AddElement(sp()):sp()\ms=CreateSphere(#PB_Any,Random(50,20),_+
30,30):sp()\us=0:sp()\tx=CRTX(99,99):StartDrawing(TextureOutput(sp()\tx))
Box(0,0,99,99,col()):sco=RGBA(ra(),ra(),ra(),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()\ma=CreateMaterial(#PB_Any,TextureID(sp()\tx))
SCM(sp()\ma,0.2,0.2):ScrollMaterial(sp()\ma,-0.2,0,#PB_Material_Animated)
sp()\id=CreateEntity(#PB_Any,MeshID(sp()\ms),MIT(sp()\ma),rd(),rd(),rd(),2)
Next num:EndProcedure:Procedure.i DrawTabl(Index.i=0):Select Index:Case 0
If IsSprite(Sco):FreeSprite(Sco):EndIf:Sco=CreateSprite(#PB_Any, 120, 20)
SDSO(Sco):DrawText(0,0,"Score: " + Str(Score),gco,0):StopDrawing():Case 1
If IsSprite(tim):FreeSprite(tim):EndIf:tim=CreateSprite(#PB_Any, 120, 20)
SDSO(tim):DrawText(0,0,"Count down: " + Str(time),gco,0):StopDrawing()
EndSelect:EndProcedure:OpenWindow(0,0,0,w,h,"Planetbuster",wc)
OpenWindowedScreen(WindowID(0),0,0,w,h,0,0,0,sce)
cam=CreateCamera(#PB_Any,0,0,100,100):hud=CRSPR(w,h):SDSO(hud)
DrawingMode(#PB_2DDrawing_Outlined):Box(w/4,h/4,w/2,h/2,gco)
lx(0,0,w/4,h/4,gco):lx(w/4,h-h/4,0,h,gco):lx(w,0,w-w/4,h/4,gco)
lx(w-w/4,h-h/4,w,h,gco):StopDrawing():TPC(hud,0):crs=CRSPR(30,30):SDSO(crs)
DrawingMode(#PB_2DDrawing_Outlined):Box(0,0,30,30,gco):StopDrawing():TPC(crs,0)
Plan():DrawTabl():tm=ems():Repeat:Repeat:ev=WindowEvent():Until ev=0
ExamineKeyboard():If kp(#PB_Key_W)>0:xkey=1:ElseIf kp(#PB_Key_S) > 0:xkey=-1
Else:xkey=0:EndIf:If kp(#PB_Key_A)>0:ykey=1:ElseIf kp(#PB_Key_D) > 0:ykey=-1
Else:ykey=0:EndIf:RotateCamera(cam,xkey,ykey,0,#PB_Relative):RenderWorld()
If ems()-tm>200:time-1:If time<0:MessageRequester("","" + Str(Score)):reset()
EndIf:tm=ems():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):DTS(crs,MouseX(),MouseY()):DTS(hud,0,0)
DTS(Sco,w/4,50):DTS(tim,w-w/4,50):FlipBuffers():Until kp(#PB_Key_Escape)

[graph100]

Hi !

Here's my first code. Not to great because the main functionality take so much place that I couldn't add the game part
That was a test to see if I could reduce my fluid engine to the punch... Well, It's possible, in 50 line (expanded code take 525 lines)

[V 2] : DisableDebbuger is done in the code, so it lag less. Though it wil still tax ancient machine
Add back some code feature that allowed to have a constant simulation step (dt), it was taken out because of lack of line, but I found a way...
[V 3] : Added multiple Objects in the fluid
[V 4] : 2nd code to support linux and mac (the constante are too long to punch it in 1 code ...)

Windows Version

Code: Select all

;******************************************************************************* 
;* 
;* July-August 2014 PurePunch contest 
;* PureBasic 5.22 
;* 50 lines of 80 chars, 2 months delay 
;* 
;* Name : Fluid Dynamics Game Engine  
;* Author : Graph100 
;* Date : 07/07/2014 
;* Notes : Made from reading Jos Stam's article 
;* "Real-Time Fluid Dynamics for Games" 
;*  
;* Version 3 Windows
;******************************************************************************* 
DisableDebugger:Macro M:Macro:EndMacro:M E:End:End#M:M A1:Array:EndMacro;#######
M N:Next:E#M:M F(i,j,k):For i=j To k:E#M:M St:Structure:E#M:M P:Procedure:E#M;##
M El:ElapsedMilliseconds():E#M:M Ti(a,s):a=AllocateMemory(SizeOf(s));###########
Initialize#St(a,s):EndMacro:Macro AO(o,f,a,b):Define.d x,y,s0,t0,s1,t1,t0u,t0v;#
t0u=s\t*f\m:t0v=s\t*f\m:i0=Round(o\x,0):j0=Round(o\y,0):i1=i0+1:j1=j0+1;########
s1=o\x-i0:s0=1-s1:t1=o\y-j0:t0=1-t1:o\u=t0u*(s0*(t0*a(i0,j0)+t1*a(i0,j1))+;#####
s1*(t0*a(i1,j0)+t1*a(i1,j1))):o\v=t0v*(s0*(t0*b(i0,j0)+t1*b(i0,j1))+s1*(t0*b(i1,
j0)+t1*b(i1,j1))):o\x=o\x+o\u:o\y=o\y+o\v:If o\x<1:o\x=1:E#If:If o\x>f\W:o\x=f\W
E#If:If o\y<1:o\y=1:E#If:If o\y>f\H:o\y=f\H:E#If:EndMacro:M AF(o,a,b,c,d);######
AddElement(o):o\x=a:o\y=b:o\u=c:o\v=d:o\g=Sqr(c*c+d*d):EndMacro:M AOb(o,a,b);###
AddElement(o):o\x=a:o\y=b:EndMacro:St t:A1 t.d(0,0):E#St:St Fl:a.d:W.l:H.l:e.l;#
f.l:m.d:*u.t:*v.t:*s.t:*t.t:E#St:St Ob:x.d:y.d:u.d:v.d:E#St:St Sv:x.l:y.l:u.d;##
v.d:g.d:E#St:St Sf:F.Fl:t.d:List O.Ob():List Sv.Sv():E#St:P BC(*o.Fl,Mo,;#######
A1 x.d(2)):If Mo=2:F(i,1,*o\W):x(i,0)=-x(i,1):x(i,*o\f)=-x(i,*o\H):N:Else:F(i,1,
*o\W):x(i,0)=x(i,1):x(i,*o\f)=x(i,*o\H):N:E#If:If Mo=1:F(i,1,*o\H):x(0,i)=-x(1,;
i):x(*o\e,i)=-x(*o\W,i):N:Else:F(i,1,*o\H):x(0,i)=x(1,i):x(*o\e,i)=x(*o\W,i):N;#
E#If:x(0,0)=(x(1,0)+x(0,1))/2:x(0,*o\f)=(x(1,*o\f)+x(0,*o\H))/2:x(*o\e,0)=(0+;##
x(*o\W,0)+x(*o\e,1))/2:x(*o\e,*o\f)=(x(*o\W,*o\f)+x(*o\e,*o\H))/2:E#P;##########
P LS(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),a.d,c.d):F(k,0,20):F(i,1,*o\W):F(j,1,*o\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:N:N:BC(*o,MO,x()):N;#
E#P:P AD(*o.Fl,A1 x.d(2),A1 s.d(2),t.d):F(i,0,*o\e):F(j,0,*o\f):x(i,j)=x(i,j)+;#
t.d*s(i,j):N:N:E#P:P Di(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),d.d,t.d):a.d=t*d**o\W**o\H
LS(*o,MO,x(),x0(),a,1+4*a):E#P:P Av(*o.Fl,MO,A1 d.d(2),A1 d0.d(2),A1 u.d(2),;###
A1 v.d(2),t.d):t0_u.d=t**o\m:t0_v.d=t**o\m:F(i,1,*o\W):F(j,1,*o\H):x.d=i+;######
-t0_u*u(i,j):y.d=j-t0_v*v(i,j):If x<0.5:x=0.5:E#If:If x>*o\W+0.5:x=*o\W+0.5:E#If
i0=Round(x,0):i1=i0+1:If y<0.5:y=0.5:E#If:If y>*o\H+0.5:y=*o\H+0.5:E#If:j0=0+;##
Round(y,0):j1=j0+1:s1.d=x-i0:s0.d=1-s1:t1.d=y-j0:t0.d=1-t1:d(i,j)=s0*(t0*d0(i0,;
j0)+t1*d0(i0,j1))+s1*(t0*d0(i1,j0)+t1*d0(i1,j1)):N:N:BC(*o,MO,d()):E#P;#########
P Pr(*o.Fl,A1 u.d(2),A1 v.d(2),A1 q.d(2),A1 dv.d(2)):F(i,1,*o\W):F(j,1,*o\H);###
dv(i,j)=-((u(i+1,j)-u(i-1,j)+v(i,j+1)-v(i,j-1))/*o\m)/2:q(i,j)=0:N:N:BC(*o,0,;##
dv()):BC(*o,0,q()):LS(*o,0,q(),dv(),1,4):F(i,1,*o\W):F(j,1,*o\H):u(i,j)=u(i,j)+;
-*o\W*(q(i+1,j)-q(i-1,j))/2:v(i,j)=v(i,j)-*o\H*(q(i,j+1)-q(i,j-1))/2:N:N:BC(*o,;
1,u()):BC(*o,2,v()):E#P:Define s.Sf:s\F\W=50:s\F\H=50:s\F\m=s\F\H:If s\F\W>s\F\H
s\F\m=s\F\W:EndIf:s\F\e=s\F\w+1:s\F\f=s\F\h+1:Ti(s\F\u,t):Ti(s\F\v,t):Ti(s\F\s,;
t):Ti(s\F\t,t):Dim s\F\u\t(s\F\e,s\F\f):Dim s\F\v\t(s\F\e,s\F\f):AF(s\Sv(),25,;#
25,40,10):Goto j:GRAPH100: :OpenWindow(0,0,0,520,520,"",$C80001):CanvasGadget(0,
0,0,520,520,4):te=El:Repeat:Repeat:ev=WindowEvent():Until ev=0 Or ev=13116;#####
s\t=(El-te)/1000:If s\t<0.04:Delay(1000*(0.04-s\t)):s\t=(El-te)/1000:Else:s\t=0+
0.04:E#If:te=El:Dim s\F\s\t(s\F\e,s\F\f):Dim s\F\t\t(s\F\e,s\F\f):ForEach s\Sv()
s\F\s\t(s\Sv()\x,s\Sv()\y)=s\Sv()\u:s\F\t\t(s\Sv()\x,s\Sv()\y)=s\Sv()\v:N;######
AD(s\F,s\F\u\t(),s\F\s\t(),s\t):AD(s\F,s\F\v\t(),s\F\t\t(),s\t):If s\F\a;#######
Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Di(s\F,1,s\F\u\t(),s\F\s\t(),s\F\a,s\t);######
Di(s\F,2,s\F\v\t(),s\F\t\t(),s\F\a,s\t):E#If:Pr(s\F,s\F\u\t(),s\F\v\t(),;#######
s\F\s\t(),s\F\t\t()):Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Av(s\F,1,s\F\u\t(),;#####
s\F\s\t(),s\F\s\t(),s\F\t\t(),s\t):Av(s\F,2,s\F\v\t(),s\F\t\t(),s\F\s\t(),;#####
s\F\t\t(),s\t):Pr(s\F,s\F\u\t(),s\F\v\t(),s\F\s\t(),s\F\t\t()):ForEach s\O();###
AO(s\O(),s\F,s\F\u\t,s\F\v\t):N:StartDrawing(CanvasOutput(0)):Box(0,0,800,600,0)
F(i,0,s\F\e):For j=0 To s\F\f:LineXY(10*i,10*j,10*i+100*s\F\u\t(i,j),10*j+;#####
100*s\F\v\t(i,j),$FF):N:N:ForEach s\O():Circle(s\O()\x*10,s\O()\y*10,3,$FF00):N;
StopDrawing():Until ev=13116:End :j: :F(i,15,35):AOb(s\O(),10,i):N:Goto GRAPH100

Linux / mac Version

Code: Select all

;******************************************************************************* 
;* 
;* July-August 2014 PurePunch contest 
;* PureBasic 5.22 
;* 50 lines of 80 chars, 2 months delay 
;* 
;* Name : Fluid Dynamics Game Engine  
;* Author : Graph100 
;* Date : 07/07/2014 
;* Notes : Made from reading Jos Stam's article 
;* "Real-Time Fluid Dynamics for Games" 
;*  
;* Version 3 Linux / Mac
;******************************************************************************* 
DisableDebugger:Macro M:Macro:EndMacro:M E:End:End#M:M A1:Array:EndMacro;#######
M N:Next:E#M:M F(i,j,k):For i=j To k:E#M:M St:Structure:E#M:M P:Procedure:E#M;##
M El:ElapsedMilliseconds():E#M:M Ti(a,s):a=AllocateMemory(SizeOf(s));###########
Initialize#St(a,s):EndMacro:Macro AO(o,f,a,b):Define.d x,y,s0,t0,s1,t1,t0u,t0v;#
t0u=s\t*f\m:t0v=s\t*f\m:i0=Round(o\x,0):j0=Round(o\y,0):i1=i0+1:j1=j0+1;########
s1=o\x-i0:s0=1-s1:t1=o\y-j0:t0=1-t1:o\u=t0u*(s0*(t0*a(i0,j0)+t1*a(i0,j1))+;#####
s1*(t0*a(i1,j0)+t1*a(i1,j1))):o\v=t0v*(s0*(t0*b(i0,j0)+t1*b(i0,j1))+s1*(t0*b(i1,
j0)+t1*b(i1,j1))):o\x=o\x+o\u:o\y=o\y+o\v:If o\x<1:o\x=1:E#If:If o\x>f\W:o\x=f\W
E#If:If o\y<1:o\y=1:E#If:If o\y>f\H:o\y=f\H:E#If:EndMacro:M AF(o,a,b,c,d);######
AddElement(o):o\x=a:o\y=b:o\u=c:o\v=d:o\g=Sqr(c*c+d*d):EndMacro:M AOb(o,a,b);###
AddElement(o):o\x=a:o\y=b:EndMacro:St t:A1 t.d(0,0):E#St:St Fl:a.d:W.l:H.l:e.l;#
f.l:m.d:*u.t:*v.t:*s.t:*t.t:E#St:St Ob:x.d:y.d:u.d:v.d:E#St:St Sv:x.l:y.l:u.d;##
v.d:g.d:E#St:St Sf:F.Fl:t.d:List O.Ob():List Sv.Sv():E#St:P BC(*o.Fl,Mo,;#######
A1 x.d(2)):If Mo=2:F(i,1,*o\W):x(i,0)=-x(i,1):x(i,*o\f)=-x(i,*o\H):N:Else:F(i,1,
*o\W):x(i,0)=x(i,1):x(i,*o\f)=x(i,*o\H):N:E#If:If Mo=1:F(i,1,*o\H):x(0,i)=-x(1,;
i):x(*o\e,i)=-x(*o\W,i):N:Else:F(i,1,*o\H):x(0,i)=x(1,i):x(*o\e,i)=x(*o\W,i):N;#
E#If:x(0,0)=(x(1,0)+x(0,1))/2:x(0,*o\f)=(x(1,*o\f)+x(0,*o\H))/2:x(*o\e,0)=(0+;##
x(*o\W,0)+x(*o\e,1))/2:x(*o\e,*o\f)=(x(*o\W,*o\f)+x(*o\e,*o\H))/2:E#P;##########
P LS(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),a.d,c.d):F(k,0,20):F(i,1,*o\W):F(j,1,*o\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:N:N:BC(*o,MO,x()):N;#
E#P:P AD(*o.Fl,A1 x.d(2),A1 s.d(2),t.d):F(i,0,*o\e):F(j,0,*o\f):x(i,j)=x(i,j)+;#
t.d*s(i,j):N:N:E#P:P Di(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),d.d,t.d):a.d=t*d**o\W**o\H
LS(*o,MO,x(),x0(),a,1+4*a):E#P:P Av(*o.Fl,MO,A1 d.d(2),A1 d0.d(2),A1 u.d(2),;###
A1 v.d(2),t.d):t0_u.d=t**o\m:t0_v.d=t**o\m:F(i,1,*o\W):F(j,1,*o\H):x.d=i+;######
-t0_u*u(i,j):y.d=j-t0_v*v(i,j):If x<0.5:x=0.5:E#If:If x>*o\W+0.5:x=*o\W+0.5:E#If
i0=Round(x,0):i1=i0+1:If y<0.5:y=0.5:E#If:If y>*o\H+0.5:y=*o\H+0.5:E#If:j0=0+;##
Round(y,0):j1=j0+1:s1.d=x-i0:s0.d=1-s1:t1.d=y-j0:t0.d=1-t1:d(i,j)=s0*(t0*d0(i0,;
j0)+t1*d0(i0,j1))+s1*(t0*d0(i1,j0)+t1*d0(i1,j1)):N:N:BC(*o,MO,d()):E#P;#########
P Pr(*o.Fl,A1 u.d(2),A1 v.d(2),A1 q.d(2),A1 dv.d(2)):F(i,1,*o\W):F(j,1,*o\H);###
dv(i,j)=-((u(i+1,j)-u(i-1,j)+v(i,j+1)-v(i,j-1))/*o\m)/2:q(i,j)=0:N:N:BC(*o,0,;##
dv()):BC(*o,0,q()):LS(*o,0,q(),dv(),1,4):F(i,1,*o\W):F(j,1,*o\H):u(i,j)=u(i,j)+;
-*o\W*(q(i+1,j)-q(i-1,j))/2:v(i,j)=v(i,j)-*o\H*(q(i,j+1)-q(i,j-1))/2:N:N:BC(*o,;
1,u()):BC(*o,2,v()):E#P:Define s.Sf:s\F\W=50:s\F\H=50:s\F\m=s\F\H:If s\F\W>s\F\H
s\F\m=s\F\W:EndIf:s\F\e=s\F\w+1:s\F\f=s\F\h+1:Ti(s\F\u,t):Ti(s\F\v,t):Ti(s\F\s,;
t):Ti(s\F\t,t):Dim s\F\u\t(s\F\e,s\F\f):Dim s\F\v\t(s\F\e,s\F\f):AF(s\Sv(),25,;#
25,40,10):Goto j:GRAPH100: :OpenWindow(0,0,0,520,520,"",0000068):CanvasGadget(0,
0,0,520,520,4):te=El:Repeat:Repeat:ev=WindowEvent():Until ev=0 Or ev=2;#########
s\t=(El-te)/1000:If s\t<0.04:Delay(1000*(0.04-s\t)):s\t=(El-te)/1000:Else:s\t=0+
0.04:E#If:te=El:Dim s\F\s\t(s\F\e,s\F\f):Dim s\F\t\t(s\F\e,s\F\f):ForEach s\Sv()
s\F\s\t(s\Sv()\x,s\Sv()\y)=s\Sv()\u:s\F\t\t(s\Sv()\x,s\Sv()\y)=s\Sv()\v:N;######
AD(s\F,s\F\u\t(),s\F\s\t(),s\t):AD(s\F,s\F\v\t(),s\F\t\t(),s\t):If s\F\a;#######
Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Di(s\F,1,s\F\u\t(),s\F\s\t(),s\F\a,s\t);######
Di(s\F,2,s\F\v\t(),s\F\t\t(),s\F\a,s\t):E#If:Pr(s\F,s\F\u\t(),s\F\v\t(),;#######
s\F\s\t(),s\F\t\t()):Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Av(s\F,1,s\F\u\t(),;#####
s\F\s\t(),s\F\s\t(),s\F\t\t(),s\t):Av(s\F,2,s\F\v\t(),s\F\t\t(),s\F\s\t(),;#####
s\F\t\t(),s\t):Pr(s\F,s\F\u\t(),s\F\v\t(),s\F\s\t(),s\F\t\t()):ForEach s\O();###
AO(s\O(),s\F,s\F\u\t,s\F\v\t):N:StartDrawing(CanvasOutput(0)):Box(0,0,800,600,0)
F(i,0,s\F\e):For j=0 To s\F\f:LineXY(10*i,10*j,10*i+100*s\F\u\t(i,j),10*j+;#####
100*s\F\v\t(i,j),$FF):N:N:ForEach s\O():Circle(s\O()\x*10,s\O()\y*10,3,$FF00):N;
StopDrawing():Until ev=00002:End :j: :F(i,15,35):AOb(s\O(),10,i):N:Goto GRAPH100

[Bananenfreak]

@graph100: Really cool! But it takes very much power...

[graph100]

Thanks, try to run it with the Debugger OFF
On my computer it will go from 9% to 2% load.

--> I will add the command in the code, thx for reminding me this

Just to add the context, this code is a light version of this thread : Dynamique des Fluides, Simulation

[Bananenfreak]

So, it´s finished, I´m finished (with me and my program). My program finished me

It´s a program that allows you to calculate COM (Center of mass) in relation to your COM (Center of mesh). Poorly, it can´t set COM (Center of Mesh) to COM (Center of mass), this is not possible (now).

Code: Select all

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :  COM
;* Author   :  Bananenfreak
;* Date     :  04.07.2014
;* Notes    :  Use left and right to rotate camera, mousewheel to zoom. Load a mesh and calculate its COM.
;*
;*****************************************************************************
EnableExplicit
Structure Vektor3:x.d:y.d:z.d:EndStructure:Global.Vektor3 c,cam:Define.i Qt,et
Global NewList Orte.s():Enumeration:#plent:#ent:EndEnumeration:Enumeration:#ln0
#ln1:#ln2:EndEnumeration:Enumeration:#Tx_Or:#Sr_O:#Bn_O:#T_X:#S_X:#BX
#T_Y:#Str_Y:#BY:#TZ:#SZ:#Bn_Z:#Bn_Do:EndEnumeration:Procedure.w MWD()
Protected x.w:x=(EventwParam()>>16)&$FFFF:ProcedureReturn -(x/120):EndProcedure
Procedure COMCal(pl.s):Protected.b dasn:Protected.i mh,vC,z:Protected.Vektor3 cS
Protected.s path,nm:Dim vertex.PB_MeshVertex(0):ForEach Orte():If Orte()=pl
dasn=1:Break:EndIf:Next:If Not dasn:AddElement(Orte()):Orte()=pl:EndIf
path=GetPathPart(pl):Macro A(b):MessageRequester("Error - COM",b):EndMacro
If Not Add3DArchive(Left(path,Len(path)-1),0):A("Wrong Path"):ProcedureReturn
EndIf:Parse3DScripts():nm=GetFilePart(pl):mh=LoadMesh(#PB_Any,nm):If Not mh
A("Not a mesh."):ProcedureReturn:EndIf:vC=MeshVertexCount(mh):ReDim vertex(vC-1)
GetMeshData(mh,0,vertex(),1,0,vC-1):For z=0 To vC-1:cS\x=cS\x+vertex(z)\x
cS\y=cS\y+vertex(z)\y:cS\z=cS\z+vertex(z)\z:Next:c\x=cS\x/vC:c\y=cS\y/vC
c\z=cS\z/vC:SetGadgetText(#S_X,StrD(c\x)):SetGadgetText(#Str_Y,StrD(c\y))
SetGadgetText(#SZ,StrD(c\z)):CreateEntity(#ent,MeshID(mh),0)
CreateLine3D(#ln0,-1000,c\y,c\z,RGB(255,0,0),1000,c\y,c\z,RGB(255,0,0))
CreateLine3D(#ln1,c\x,-1000,c\z,RGB(255,0,0),c\x,1000,c\z,RGB(255,0,0))
CreateLine3D(#ln2,c\x,c\y,-1000,RGB(255,0,0),c\x,c\y,1000,RGB(255,0,0))
EndProcedure:Procedure AddOrt():Protected.s path:path=OpenFileRequester("Pick!",
"","OGRE-Mesh (*.mesh)|*.mesh",0,0):SetGadgetText(#Sr_O, path):EndProcedure
Procedure Fenster():OpenWindow(0,0,0,1000,500,"COM-Calculator", 1|13107200)
OpenWindowedScreen(WindowID(0),10,10,500,480,0,500,500):TextGadget(#Tx_Or,550,
20,80,40,"Location:"):StringGadget(#Sr_O,640,20,300,40,""):ButtonGadget(#Bn_O,
950,20,40,40,"..."):TextGadget(#T_X,550,120,80,40,"COM - X:"):StringGadget(#S_X,
640,120,280,40,""):ButtonGadget(#BX,930,120,60,40,"Copy"):TextGadget(#T_Y,550,
170,80,40,"COM - Y:"):StringGadget(#Str_Y,640,170,280,40,""):ButtonGadget(#BY,
930,170,60,40,"Copy"):TextGadget(#TZ,550,220,80,40,"COM - Z:"):StringGadget(#SZ,
640,220,280,40,""):ButtonGadget(#Bn_Z,930,220,60,40,"Copy"):ButtonGadget(#Bn_Do,
550,450,100,40,"Calculate!"):EndProcedure:Procedure Msm():If MWD()>0:cam\x/0.75
cam\y/0.75:cam\z/0.75:Else:cam\x*0.75:cam\y*0.75:cam\z*0.75:EndIf:MoveCamera(0,
cam\x,cam\y,cam\z,0):EndProcedure:If InitEngine3D():InitSprite():InitKeyboard()
Add3DArchive("/",0):Parse3DScripts():Fenster():CreateLight(0,$FFFFFF,30,20,30)
WorldShadows(3,200,RGB(51,51,51),4096):AmbientColor($333333):CreatePlane(0,100,
100,100,100,100,100):CreateTexture(0,128,128):StartDrawing(TextureOutput(0))
Box(0,0,128,128,$FFFFFF):Box(64,0,64,64,$FF0000):Box(0,64,64,64,$FF0000)
StopDrawing():CreateMaterial(0,TextureID(0)):CreateEntity(0,MeshID(0),
MaterialID(0)):EntityRenderMode(0,0):CreateNode(0):CreateCamera(0,0,0,100,100)
cam\x=100:cam\y=100:cam\z=100:MoveCamera(0,cam\x,cam\y,cam\z,0):CameraLookAt(0,
0,0,0):CameraBackColor(0,RGB(50,50,250)):AttachNodeObject(0,CameraID(0)):Repeat
Repeat:et=WindowEvent():Select et:Case 13100:Select EventGadget():Case #Bn_Do
If IsEntity(#ent):FreeEntity(#ent):EndIf:COMCal(GetGadgetText(#Sr_O)):Case #Bn_O
AddOrt():Case #BX:SetClipboardText(Str(c\x)):Case #BY:SetClipboardText(Str(c\y))
Case #Bn_Z:SetClipboardText(Str(c\z)):EndSelect:Case 522:Msm():Case 13116:Qt=1
EndSelect:Until et=0:If ExamineKeyboard():If KeyboardPushed(203):RotateNode(0,0,
-5,0,1):ElseIf KeyboardPushed(205):RotateNode(0,0,5,0,1):EndIf:EndIf
RenderWorld():FlipBuffers():Until KeyboardPushed(1) Or Qt=1:EndIf
End