PurePunch Contest #2

Share your advanced PureBasic knowledge/code with the community.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

PurePunch Contest #2

Post by djes »

August 2009

Contest is over

The vote has given Hades as winner with 10 points, for its terrific code showing a raytraced scene, beyond MrVain (7 points), with a nice oldschool-style demo, and RocketRider and its PureStrudel (5 points), on a total of 35 points.

This contest has been a real success, showing increased level, and great skills from a lot of people. I think not have been the only one to be really amazed by some entries. :D

Thanks to all competitors!

Will it be possible to do better for the next contest? 8)

---------------------------------------------------------------------------------

June 2009

Here it is the second PurePunch Contest!

The rules have changed :
  • 1° The program will be created using Purebasic 4.30.
    2° The program source will only have 10 lines of 80 characters max per line
    3° You only have one month to create a good utility, or FX, or whatever you want!
At the end of this period (July, the 1st), a poll will be created to vote for the best code. Do your best and it'll be yours!

Post the code in this forum, after adding and completing the following header:

Code: Select all

;*****************************************************************************
;*
;* Name   :  
;* Author : 
;* Date   : 
;* Notes  :
;*
;*****************************************************************************
Good luck to all competitors!
Last edited by djes on Sat Aug 01, 2009 11:01 am, edited 10 times in total.
User avatar
idle
Always Here
Always Here
Posts: 5836
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

that'll be challenging!
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

idle wrote:that'll be challenging!

You can do it ;)
User avatar
idle
Always Here
Always Here
Posts: 5836
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

Oh I will! :lol: time for a bit of sorcery
User avatar
idle
Always Here
Always Here
Posts: 5836
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

take 1:

Code: Select all


;*****************************************************************************
;*
;* Name   :IdleArts Nova Attractor copyright Andrew Ferguson 2009
;* Author :andrew ferguson
;* Date   :01/06/2009
;* Notes  :Disable debugger - windows only change value line 16 "1.2" more faster 
;*        :and lt=dt+6000  
;***************************************************************************** 

Global Dim sr.f(3,2<<14):Macro r(v):Random(v)+1:EndMacro:InitSprite():w=800
l=600:OpenWindow(0,0,0,w,l,""):OpenWindowedScreen(WindowID(0),0,0,w,l,0,0,0)
*px.long:While WindowEvent()!16:StartDrawing(ScreenOutput()):h=DrawingBuffer()
P=DrawingBufferPitch():dt=GetTickCount_():If dt>lt:b=1:ef=R(100):lt=dt+6000
EndIf:For a=1 To 2<<14:If b:ix=R(w):sr(0,a)=ix:iy=R(w):sr(1,a)=iy
sr(2,a)=1/Sqr(ix*ix+iy*iy):EndIf:x.f=sr(0,a):y.f=sr(1,a):z.f=Sqr(x*x+y*y)
m.f=sr(2,a)*z* 1.2 :px=(400+(Sin(x)+Cos(y))*m):py=(300+(Cos(x)-Sin(y))*m)
sr(0,a)+(px/ef):sr(1,a)+(py/ef):sr(2,a)+1/z:If px>1 And py>1:If px<w And py<l
c=m:of=(px*4+(py*p)):*px=h+of:*px\l+RGB(c,c*0.4,c*0.2):rt=0:EndIf:EndIf
Next:b=0:StopDrawing():FlipBuffers():ClearScreen(RGB(0,0,0)):Delay(20):Wend 
Last edited by idle on Mon Jun 01, 2009 11:22 am, edited 2 times in total.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

:D
Yes! You did it!
User avatar
idle
Always Here
Always Here
Posts: 5836
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

I couldn't resist it though it took me a few hours to squash it in!
Anonymous

Post by Anonymous »

Code: Select all

;*****************************************************************************
;*
;* Name   : Automatic Pong
;* Author : Cpl.Bator
;* Date   : 1/06/2009
;* Notes  : Press any key to quit ( not tested on windows but linux )
;*
;***************************************************************************** 
InitSprite():InitKeyboard():OpenScreen(640,480,32,""):Bx.d=320:By.d=240:Bd.b=4
Macro M:Macro:EndMacro:M I:If:EndMacro:M EI:EndIf:EndMacro:M A:And:EndMacro:
M clsw:W=255:EndMacro:M C:Case:EndMacro:H=$FFFFFF:Dy=240:Gy=240:Repeat:Gy=By
ExamineKeyboard():W-1:I W<0:W=0:EI:Select Bd:C 1:Bx+0.5:By+0.5:C 2:Bx-0.5:
By+0.5:C 3:Bx-0.5:By-0.5:C 4:Bx+0.5:By-0.5:EndSelect:I By>476 A Bd=1:Bd=4:
clsw:EI:I By<4 A Bd=4:Bd=1:clsw:EI:I By>476 A Bd=2:Bd=3:clsw:EI:I By<4 A Bd=3:
Bd=2:clsw:EI:I Bx<20 A Bd=2:Bd=1:clsw:EI:I Bx<20 A Bd=3:Bd=4:clsw:EI:Dy=By
I Bx>610 A Bd=1:Bd=2:clsw:EI:I Bx>610 A Bd=4:Bd=3:clsw:EI:O=ScreenOutput()
StartDrawing(O):Circle(Bx,By,4,H):Box(10,Gy-32,10,64,H):Box(610,Dy-32,10,64,H)
StopDrawing():FlipBuffers(2):ClearScreen(RGB(W,W,W)):Until KeyboardInkey()
Last edited by Anonymous on Tue Jun 30, 2009 9:38 pm, edited 1 time in total.
Anonymous

Post by Anonymous »

Code: Select all

;*****************************************************************************
;*
;* Name   : Black Hole
;* Author : Cpl.Bator
;* Date   : 1/06/2009
;* Notes  : Press any key to quit , tested on Linux
;*
;***************************************************************************** 
InitSprite():InitKeyboard():OpenScreen(1024,768,32,"")
Repeat:ExamineKeyboard():StartDrawing(ScreenOutput())
TM = ElapsedMilliseconds():L.d=1024+512*Cos(TM/500):For S = 1 To 20
T.d=(1024+L)/S : C = (S*255)/20: X.d=(S*2)*Cos(TM/1250): Y.d=(S*4)*Sin(TM/550)
Circle((512+X),(384+Y),T,RGB(0,0,255-C)):Next :StopDrawing():FlipBuffers(2)
Until KeyboardInkey()
Last edited by Anonymous on Tue Jun 30, 2009 9:39 pm, edited 1 time in total.
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Nice idea, djes. :D

Code: Select all

;***************************************************************************** 
;* 
;* Name   : µRay 
;* Author : Hades 
;* Date   : 01-05/06/2009 
;* Notes  : Change variable 's' for other resolutions. 
;* 
;***************************************************************************** 
s=700:m=s/2:OpenWindow(0,0,0,s,s,"µRay"):Macro IS:w-4:d=Sqr(x*x+y*y+z*z):x/d:y/d
u-j:z/d:d=x*u+y*v+z*w:q=d*d-u*u-v*v-w*w+1:If q>0:e=1:p=-d-Sqr(q):EndIf:EndMacro
StartDrawing(WindowOutput(0)):t=16:Define.f:f=0.9:Macro F(v,e):For v.l=0 To e-1
EndMacro:l=0.577:j=0.2:F(sy,s):F(sx,s):r=0:g=0:b=0:F(k,t):F(i,t):c=f:u=0:v=0:e=0
x=sx+k/t-m:y=sy+i/t-m:z=s:w=0:IS:If e:o=y*p:n=x*p-j:h=z*p-4:d=n*l-o*l-h*l:If d<0
d=0:EndIf:p=2*d:x*(l-p*n)-y*(l+p*o)-z*(l+p*h):n*4:h*4:a.l=n:q=j*(1-o):o*4:n-a
a=o:o-a:a=h:h-a:n*n+o*o+h*h:a=9*n:c*(d*(1-q)+q):If a=3:x=0.8*Pow(x,9):r+x:g+x
b+x:c*j:EndIf:Else:If y>0:u=x/y:w=z/y:y=i/200-l:a=u+l:a+w:a&1:x=l+k/200:v=1
z=-l:c-0.8*a:IS:c*(1-e+e*p/t):g+c:b+c:Else:b+c:c*(1+y):c*c*c:g+c:EndIf:EndIf:r+c
Next:Next:Plot(sx,sy,RGB(r,g,b)):Next:Next:While WindowEvent()!t:Delay(50):Wend
Micro Ray Tracer
-256 rays per pixel
-soft shadows
-procedural textures
-fake ambient occlusion
Last edited by Hades on Fri Jun 05, 2009 10:39 pm, edited 11 times in total.
Anonymous

Post by Anonymous »

Hades wrote:Nice idea, djes. :D

Code: Select all

;***************************************************************************** 
;* 
;* Name   : uRay
;* Author : Hades
;* Date   : 01/06/2009
;* Notes  : -
;* 
;***************************************************************************** 
Define.f:s=512:m=s/2:lx=1:ly=-1:lz=-1:Macro n(v):d=Sqr(v#x*v#x+v#y*v#y+v#z*v#z)
v#x/d:v#y/d:v#z/d:EndMacro:InitSprite():Macro D(d,a,b):d=a#x*b#x+a#y*b#y+a#z*b#z
EndMacro:n(l):OpenWindow(0,0,0,s,s,"uRay"):Macro T():n(d):oz-2:D(h,d,o):D(q,o,o)
q=h*h-(q-1):If q>0:t=(-h-Sqr(q)):If t>0 And t<p:p=t:ob=1:EndIf:EndIf:EndMacro
StartDrawing(WindowOutput(0)):For v.l=0 To s-1:For u.l=0 To s-1:r=1:g=0:b=0:ox=0
oy=0:oz=0:dx=(u-m)/m:dy=(v-m)/m:dz=1:p=9:ob=0:T():If ob:dx*p:dy*p:dz*p-2:n(d)
D(r,d,l):If r<0:r=0:EndIf:Else:If dy>0:d=1/dy:ox=dx*d:oy=1:oz=dz*d:x.l=ox:z.l=oz
c=0.9:If (x+z)&1:c=0.1:EndIf:ob=0:p=9:dx=lx:dy=ly:dz=lz:T():If ob:c=0:EndIf:r=c
g=c:b=c:Else:c=1+dy:c*c:r=c:g=c:b=1:EndIf:EndIf:Plot(u,v,RGB(r*255,g*255,b*255))
Next:Next:StopDrawing():While WindowEvent()!16:Delay(50):Wend
Nice but , 80 characters per line , not 81 :D
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Cpl.Bator wrote:Nice but , 80 characters per line , not 81 :D
I've had some trouble to count too, but those are max. 80 characters. :wink: :D
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

:shock: Woo, the level is high!
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

I've updated my version to use 79 visible characters, in case an end of line character counts too.
Also there is 16x16 supersampling now to get rid of all that unused space. :D
User avatar
idle
Always Here
Always Here
Posts: 5836
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

@Hades

Words fail me, incredible!
Post Reply