Osmosis

For everything that's not in any way related to PureBasic. General chat etc...
User avatar
idle
Always Here
Always Here
Posts: 5094
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Osmosis

Post by idle »

Old pure punch entry

you're a little cell lost in a petri dish, become the biggest cell by absorbing smaller cells!
The trick is finding which one you are before you get absorbed! The player is the cell on the right in the png image.

Arrow keys to move around: note you loose mass as you do
R to reset
Esc to quit

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

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 a petri dish full of predators. 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.03    
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):SpriteQuality(#PB_Sprite_BilinearFiltering)
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=1000: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() 
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8433
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Osmosis

Post by netmaestro »

I think I need some psychoanalysis, I can't find myself! Very cool game in a tiny source, well done :mrgreen:
BERESHEIT
User avatar
idle
Always Here
Always Here
Posts: 5094
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Osmosis

Post by idle »

I'm not surprised by that after weeks of lockdown, I might have to shave and bend the mirror to find myself!
Maybe I should point out that the player is the cell on the right in the png image.

.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Olliv
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Sep 22, 2009 10:41 pm

Re: Osmosis

Post by Olliv »

I apologize but the image is stored in dropbox. And dropbox, I am sure Idle, you can do better than them... Unable to access...
User avatar
idle
Always Here
Always Here
Posts: 5094
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Osmosis

Post by idle »

Olliv wrote:I apologize but the image is stored in dropbox. And dropbox, I am sure Idle, you can do better than them... Unable to access...
you can download it without signing in or signing up, there's a drop down arrow on the top right of the page.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Michael Vogel
Addict
Addict
Posts: 2677
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Osmosis

Post by Michael Vogel »

What a fine code - but should also make some PR for https://www.osmos-game.com/ of hemispheregames...
User avatar
idle
Always Here
Always Here
Posts: 5094
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Osmosis

Post by idle »

Michael Vogel wrote:What a fine code - but should also make some PR for https://www.osmos-game.com/ of hemispheregames...
Yes that's the one, I thought it was a cool concept.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Michael Vogel
Addict
Addict
Posts: 2677
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Osmosis

Post by Michael Vogel »

idle wrote:Yes that's the one, I thought it was a cool concept.
It's really a jewel - I've bought the game some years ago for my android tablet - the controling mechanism is marvelous...
...never thought to code something like that in Purebasic (until today) :lol:

Do you think, you'll spent some more time for improvements (I'm not sure at which point someone should get nervous because of legal concerns)?
User avatar
idle
Always Here
Always Here
Posts: 5094
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Osmosis

Post by idle »

I think it should be a classic, It's really simple and it has really great game play. The name kind of says it all Osmos as in Cosmos. No I didn't do much more, it was just homage to the game and it was a good candidate for the 2014 pure punch. Funnily I hadn't actually realised it was spelt Osmos, though that's not surprising as I'm a dyslexic..
Windows 11, Manjaro, Raspberry Pi OS
Image
Post Reply