Page 1 of 9
PurePunch Contest #2
Posted: Sun May 31, 2009 9:47 pm
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.
Thanks to all competitors!
Will it be possible to do better for the
next contest?
---------------------------------------------------------------------------------
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!
Posted: Sun May 31, 2009 10:53 pm
by idle
that'll be challenging!
Posted: Sun May 31, 2009 11:19 pm
by djes
idle wrote:that'll be challenging!
You can do it

Posted: Mon Jun 01, 2009 12:09 am
by idle
Oh I will!

time for a bit of sorcery
Posted: Mon Jun 01, 2009 4:55 am
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
Posted: Mon Jun 01, 2009 10:59 am
by djes
Yes! You did it!
Posted: Mon Jun 01, 2009 11:13 am
by idle
I couldn't resist it though it took me a few hours to squash it in!
Posted: Mon Jun 01, 2009 3:37 pm
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()
Posted: Mon Jun 01, 2009 4:01 pm
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()
Posted: Mon Jun 01, 2009 6:16 pm
by Hades
Nice idea, djes.
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
Posted: Mon Jun 01, 2009 6:51 pm
by Anonymous
Hades wrote:Nice idea, djes.
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

Posted: Mon Jun 01, 2009 7:01 pm
by Hades
Cpl.Bator wrote:Nice but , 80 characters per line , not 81

I've had some trouble to count too, but those are max. 80 characters.

Posted: Mon Jun 01, 2009 9:08 pm
by djes

Woo, the level is high!
Posted: Mon Jun 01, 2009 9:36 pm
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.

Posted: Mon Jun 01, 2009 10:17 pm
by idle
@Hades
Words fail me, incredible!