PurePunch Contest #2

RocketRider · Post by **RocketRider** » Thu Jun 04, 2009 6:12 pm

PureStrudel

;***************************************************************************** 
;* 
;* Name   : PureStrudel
;* Author : RocketRider
;* Date   : 04.06.09
;* Notes  : Disable debugger, use DirectX 9 Subsystem
;* 
;*****************************************************************************
InitSprite():OpenWindow(0,0,0,600,600,"",13107201)
OpenWindowedScreen(WindowID(0),0,0,600,600,0,0,0)
Repeat:x=300:y=300:a+1:StartDrawing(ScreenOutput())
For i=1 To 90000 Step 2
x+Sin(i+5.8)*i/100:y+Cos(i)*i/100:x2=x+Sin(i)*1000:y2=y+Cos(i)*1000:i2=Sqr(i)+a
i3.f=Sin((i+a)/100)*1.5
LineXY(x,y,x2,y2,RGB(128+Sin(i2)*10*i3,128+Sin(i2)*10*i3,128+Sin(i2)*10*i3))
Next:StopDrawing():FlipBuffers(0):Until WindowEvent() = 16

Ollivier · Post by **Ollivier** » Thu Jun 04, 2009 10:31 pm

àRocket

Good!

Ollivier

eddy · Post by **eddy** » Fri Jun 05, 2009 2:04 am

Code: Select all

;***************************************************************************** 
;* 
;* Name   : Pixels Emboss 
;* Author : eddy r. 
;* Date   : 05.06.09 
;* Notes  : r=radius w=screenwidth - atan2 short version 
;* 
;***************************************************************************** 
r.f=200:w.f=600:Procedure.f atan2(y.f,x.f):a.f=2*ATan(y/(Sqr(x*x+y*y)+x)) 
ProcedureReturn a:EndProcedure:InitSprite():OpenWindow(0,0,0,w,w,"",$C80001) 
ww=(w-1):OpenWindowedScreen(WindowID(0),0,0,w,w,0,0,0):Repeat:ClearScreen(0) 
StartDrawing(ScreenOutput()):x=WindowMouseX(0):y=WindowMouseY(0):For j=0 To 60 
For i=0 To 60:u.f=i*10:v.f=j*10:m.f=(u-x):n.f=(v-y):d.f=Sqr(m*m+n*n) 
If d<r:d=0.5*r*Sin(0.5*#PI*(1+d/r)):a.f=ATan2(n,m):du=Cos(a)*d 
dv=Sin(a)*d:u+du:v+dv:EndIf:If u>0 And u<ww And v>0 And v<ww:Plot(u,v,$FF) 
EndIf:Next:Next:StopDrawing():FlipBuffers(0):Until WindowEvent()=16

dige · Post by **dige** » Fri Jun 05, 2009 9:09 am

wow wow wow .. that contest rocks!!!
unfortunately, my lonely gray brain cell is overstrained while reading
the sources

einander · Post by **einander** » Fri Jun 05, 2009 11:24 am

Please forget the Shrinker and Expander failed experiments.

Here is a simpler Punch:
;*****************************************************************************
;*
;* Name : Pure Punch Sierpinski Triangles
;* Author : einander
;* Date : 05.06.09
;* Notes : resizeable window
;*
;*****************************************************************************
OpenWindow(0,0,0,800,600,"Pure Punch Sierpinski Triangles",$CC0001)
StartDrawing(WindowOutput(0)):Repeat:W=WindowWidth(0):H=WindowHeight(0)
A=Random(255):b=Random(255):c=Random(255):d=Random(#White):For X=0 To W-1
If WaitWindowEvent(0)=16:End:EndIf:LineXY(X,0,X,H,d):For Y=0 To H-1:R=X&Y:If A<b
If R=X:Plot(X,Y,RGB(A,b,c)):EndIf:EndIf:If b<c:If R=Y:Plot(W-X,Y,RGB(b,c,A))
EndIf:EndIf:If c<d:For i=0 To c:If A&1:If R =i:Plot(X-i,H-Y,d):EndIf:Else:If R=i
Plot(X-i,Y,d):EndIf:EndIf:Next:EndIf:For i=c/3 To 255:If b&1:If R=i
Plot(W-X,Y,RGB(i,A,b)):EndIf:Else:If R=i:Plot(X,H-Y,RGB(b,i,A)):EndIf:EndIf:Next
Next:Next:ForEver

djes · Post by **djes** » Fri Jun 05, 2009 11:38 am

Nice!

No problem for the shrinker and expander, it could be really useful! Have you finished the expander?

einander · Post by **einander** » Fri Jun 05, 2009 12:37 pm

@djes:
I abandoned the Shrinker and Expander ideas as Pure Punch projects when i've found myself in a nightmare fighting against absurd variable names and placing inadequate assignements inside loops to avoid the 80 char limit.

Dobro has a nice expander idea on the french forum, in only 4 lines.
http://www.purebasic.fr/french/viewtopi ... 8&start=30

djes · Post by **djes** » Fri Jun 05, 2009 12:57 pm

Ok, thank you anyway

Ollivier · Post by **Ollivier** » Fri Jun 05, 2009 6:30 pm

Code: Select all

;*****************************************************************************
;*
;* Name : Pure Punch Pink Ghost
;* Author : Ollivier
;* Date : 05.06.09
;* Notes : Add DIRECTX9 option in compiler options if problem
;*
;*****************************************************************************
a.F:Macro P(C):Particle#C:EndMacro:UsePNGImageEncoder():InitEngine3D():v.F
InitSprite():InitKeyboard():Add3DArchive("\",0):OpenScreen(1024,768,32,"")
CreateImage(1,256,256):StartDrawing(ImageOutput(1)):For i=0 To 127:c=i*i*i/7850
Circle(128,128,127-i,RGB(c,c,c)):Next:StopDrawing():SaveImage(1,"PP",$474E50)
LoadTexture(0,"PP"):CreateMaterial(0,TextureID(0)):DisableMaterialLighting(0,1)
MaterialBlendingMode(0,1):Create#P(Emitter)(0,10,1,1,0):P(EmissionRate)(0,100);
P(Size)(0,256,256):P(Material)(0,MaterialID(0)):P(TimeToLive)(0,2,8)
P(Velocity)(0,1,300):F=100:P(ColorRange)(0,$FF0000,$FF):CreateCamera(0,0,0,F,F)
CameraLocate(0,0,0,2000):Repeat:P(EmitterDirection)(0,Cos(a),Sin(a),0):a+1.246
FlipBuffers():ExamineKeyboard():RenderWorld():Until KeyboardPushed(1)

TazNormand · Post by **TazNormand** » Sat Jun 06, 2009 11:57 pm

1st attempt from a PB newbie :

Code: Select all


;*****************************************************************************
;*
;* Name   :  Screen Wave
;* Author : TazNormand
;* Date   : 05 June 2009
;* Notes  : Call WinAPI, so not working on Linux/Mac/Amiga
;*
;***************************************************************************** 

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite():y=-256
InitKeyboard():i=CreateImage(0,w,h) :hDC=StartDrawing(ImageOutput(0))
Ddc=GetDC_(GetDesktopWindow_()):BitBlt_(hDC,0,0,w,h,DDC,0,0,#SRCCOPY)
StopDrawing() :ReleaseDC_(GetDesktopWindow_(),DDC):OpenScreen(w,h,32,"")
CreateSprite(0,w,h):StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h)
StopDrawing():Repeat:ExamineKeyboard():x=(Sin((y)/w*#PI*4)*128)+10
ClipSprite(0,0,y,w,256):DisplaySprite(0,x,y):FlipBuffers():ClearScreen(0):y=y+4
If y=h+32:y=-256:EndIf:Until KeyboardPushed(#PB_Key_Escape):End

TazNormand · Post by **TazNormand** » Sun Jun 07, 2009 10:51 pm

2nd attempt, still uses desktop copy

Code: Select all


;*****************************************************************************
;*
;* Name   :  Ouch !!!
;* Author : TazNormand
;* Date   : 07 June 2009
;* Notes  : Calls Win API, wouldn't work on Mac/linux/Amiga + PB Demo Version
;*
;*****************************************************************************

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite():sx=0:p=8
InitSprite3D():InitKeyboard():i=CreateImage(0,w,h):sy=0:r=32:x=(w-(w/r))/2
hc=StartDrawing(ImageOutput(0)):d=GetDC_(GetDesktopWindow_()):y=(h-(h/r))/2
BitBlt_(hc,0,0,w,h,d,0,0,#SRCCOPY):StopDrawing():
ReleaseDC_(GetDesktopWindow_(),d):OpenScreen(w,h,32,""):CreateSprite(0,w,h,4)
StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h):StopDrawing()
CreateSprite3D(0,0):ZoomSprite3D(0,w/r,h/r):Repeat:ExamineKeyboard():Start3D()
DisplaySprite3D(0,x,y):Stop3D():r-1:If r>1:x=(w-(w/r))/2:y=(h-(h/r))/2
ZoomSprite3D(0,w/r,h/r):sy=y:sx=x:EndIf:If r<1:y=sy:sy+4:x=sx+p:p*-1:EndIf
FlipBuffers():ClearScreen(0):Until KeyboardPushed(#PB_Key_Escape) Or sy>w:End

Post by **idle** » Tue Jun 09, 2009 10:23 am

@TazNormand

Don't feel sorry for those people who don't have windows they can always wine about it, or try to wine about it on macs Darwine!
(wine sounds like whine meaning to complain)

Huitbit · Post by **Huitbit** » Thu Jun 11, 2009 5:04 am

Hi, I'm from the french forum.
This is my first post

!

From the book "Jeux d'action "(for MSX) wrote by Pierre Monsaut in 1985

Code: Select all

;***************************************************************************** 
;* 
;* Name   :  Punch Blitz 
;* Author : Huitbit 
;* Date   : 10 June 2009 
;* Notes  : Old MSX code translated  ;) 
;* 
;***************************************************************************** 
Macro c(a,b):ConsoleLocate(a,b):EndMacro:*z=AllocateMemory(1920):OpenConsole() 
w=v:n.s="   ":EnableGraphicalConsole(1):a.s=" "+Chr(200)+Chr(205)+Chr(206) 
For i=12 To 28:For j=23 To Random(5)+14 Step -1:PokeC(*z+i+j*40,1):c(i,j) 
Print(Chr(178)):Next j:Next i:For y=0 To 23:For x=0 To 38:c(x,y):Print(a) 
If x<37:If Inkey()<>"" And v=0:u=x+1:v=y+1:EndIf:EndIf:If PeekC(*z+x+4+y*40) 
s=40*y+x:For i=y To 22:c(x+1,i):Print(n):c(x+1,i+1):Print(Right(a,3)) 
Delay(99):Next i:c(3,0):Print("SCORE : "+Str(s)):Input():End:EndIf:If v<>0 
If v>23:v=0:EndIf:PokeC(*z+u+w*40,0):c(u,v-1):Print(" "):w=v:If v:c(u,v) 
Print("*"):v=v+1:EndIf:EndIf:Delay(50):Next x:c(39,y):Print(n):Next y 
c(3,0):Print("**MISSION COMPLETED !**"):Input():End

Hasta la vista !

djes · Post by **djes** » Thu Jun 11, 2009 9:07 am

Terrible, love it!

peterb · Post by **peterb** » Fri Jun 12, 2009 10:53 am

Code: Select all

;*****************************************************************************
;*
;* Name   : 3DCube
;* Author : Petr Vavrin (peterb)
;* Date   : 12.06.09
;* Notes  : 
;*
;***************************************************************************** 
InitSprite():o=400:OpenWindow(0,0,0,o,o,"3D cube",$C80001):Dim p(o):Dim a.f(o)
Dim l(o):OpenWindowedScreen(WindowID(0),0,0,o,o,1,0,0):Restore t:For c=0 To 5
Read.b d:Read.w e:For m=0 To 3:i=c*4+m:p(i)=(d>>(m*2)&3-1.5)*5:l(i)=e>>(m*4)&15
Next:Next:DataSection:t:Data.l $0c3221ff,$65f31443,$5887cf76,$30625100,$8473
EndDataSection:While WindowEvent()<>16:ClearScreen(0):sc=ScreenOutput():s+255
StartDrawing(sc):v.f+0.05:w.f+0.01:For c=0 To 7:m=c*3:x=p(m):y=p(m+1):z=p(m+2)
g.f=Sin(v)*y+Cos(v)*z:f.f=o/(40-(Cos(w)*g-Sin(w)*x)):a(m)=(Cos(w)*x+Sin(w)*g)
a(m)*f+o/2:a(m+1)=(Cos(v)*y-Sin(v)*z)*f+o/2:Next:For c=0 To 11:m=c*2:i=l(m)*3-3
j=l(m+1)*3-3:For k=1 To 3:LineXY(a(i)+k,a(i+1),a(j)+k,a(j+1),s-k):Next:Next
DrawText(9,9,"Enjoy this 3DCube",s,0):StopDrawing():FlipBuffers():Delay(15):Wend

PureBasic Forums - English

PurePunch Contest #2

Tribute to MSX

3D Cube