PurePunch Contest #2

Rescator · Post by **Rescator** » Sat Jun 13, 2009 5:26 pm

@djes you might want to get this moved to general as well.
nothing against all the awesome code here but do the really fit under Tips'n'Tricks?

Psychophanta · Post by **Psychophanta** » Sat Jun 13, 2009 9:00 pm

Rescator wrote:do the really fit under Tips'n'Tricks?

Definitely!
Is not a trick to write code with limited space?
Mine:

Code: Select all

;***************************************************************************** 
;* 
;* Name   : Humping workbench 
;* Author : Psychophanta 
;* Date   : 13 June 2009 
;* Notes  : Calls Win API, wouldn't work on Mac/linux/Amiga + PB Demo Version 
;* 
;***************************************************************************** 
Macro _:50*Cos(c.f):EndMacro:Macro q:50*Sin(c):EndMacro:ExamineDesktops()
W=DesktopWidth(0):H=DesktopHeight(0):InitSprite():InitSprite3D():InitKeyboard()
CreateImage(0,W,H):i=StartDrawing(ImageOutput(0))
BitBlt_(i,0,0,W,H,GetDC_(GetDesktopWindow_()),0,0,#SRCCOPY):StopDrawing()
DeleteDC_(i):OpenScreen(W,H,32,"F"):CreateSprite(0,W,H,4)
StartDrawing(SpriteOutput(0)):DrawImage(ImageID(0),0,0):StopDrawing()
CreateSprite3D(0,0):Repeat:ExamineKeyboard():ClearScreen(0):Start3D()
TransformSprite3D(0,_,_*Cos(c),W+_,_*Cos(c),W+q,H+q*Cos(c),q,H+q*Cos(c))
DisplaySprite3D(0,0,0,$FF):Stop3D():c+8E-2:If c>2*#PI:c=0:EndIf
FlipBuffers():Delay(16):Until KeyboardPushed(1)

peterb · Post by **peterb** » Sun Jun 14, 2009 7:58 pm

Code: Select all

;*****************************************************************************
;*
;* Name   : 3D Wave
;* Author : Petr Vavrin (peterb)
;* Date   : 14.06.09
;* Notes  : 
;*
;***************************************************************************** 
Macro _(u,v):If u<28:LineXY(a(c),a(c+1),a(c+v),a(c+v+1),b(c)):EndIf:EndMacro:k.f
o=500:InitSprite():OpenWindow(0,0,0,o,o,""):Dim a(5*o):Dim b(5*o):s=WindowID(0)
OpenWindowedScreen(s,0,0,o,o,1,0,0):l=99:While WindowEvent()<>16:ClearScreen(0)
StartDrawing(ScreenOutput()):If l=99:h=Random(2):i=k-Random(40):j=a.f-Random(8)
l=0:EndIf:a-j/99:k-i/99:l+1:v.f+0.01:w.f+0.003:y=-30:While y<30:x=-30:While x<30
z.f=a*Sin((k*Sqr(x*x+y*y)-p)/57):g.f=Sin(v)*y+Cos(v)*z:cw.f=Cos(w):sw.f=Sin(w)
f.f=o/(99-(cw*g-sw*x)):r=(z+a)*127/a:b(m)=r<<(8*h):a(m)=(cw*x+sw*g)*f+o/2
a(m+1)=(Cos(v)*y-Sin(v)*z)*f+o/2:m+2:x+2:Wend:y+2:Wend:p+9:m=0:For u=1 To 28
For t=1 To 28:c=(t+u*30)*2:_(t,2):_(u,60):Next:Next:StopDrawing():FlipBuffers()
Delay(20):Wend

djes · Post by **djes** » Sun Jun 14, 2009 9:14 pm

Psychophanta, peterb> Funny, these _ macros

I do love these clean and smooth codes

peterb · Post by **peterb** » Sun Jun 14, 2009 11:18 pm

Code: Select all

;*****************************************************************************
;*
;* Name   : Dots
;* Author : Petr Vavrin (peterb)
;* Date   : 15.06.09
;* Notes  : 
;*
;***************************************************************************** 
Macro _(a,b):(Sin(a)+Cos(b)):EndMacro:#p=#PI/180:#n=0.001:k=99:Dim x(k):Dim y(k)
Dim v.f(k):Dim w(k):o=400:InitSprite():OpenWindow(0,0,0,o,o,"",$C80001):s.f=20
h=k:OpenWindowedScreen(WindowID(0),0,0,o,o,1,0,0):While WindowEvent()<>16
ClearScreen(0):StartDrawing(ScreenOutput()):If h=k:e=Random(k):f=Random(k)
g=Random(k):i.f=s-Random(50):h=0:EndIf:h+1:a.f+#n*e:b.f+#n*f:c.f+#n*g:s-i/k
x(0)=_(a,b)*30+o/2:y(0)=_(b,a)*30+o/2:v(0)=c:w(0)=s:l=30:While l:n=l-1:x(l)=x(n)
y(l)=y(n):v(l)=v(n):w(l)=w(n):m=0:While m<360:t.f=m*#p+v(l):u.f=#p-v
Circle(x(l)+_(t,u)*w(l),y(l)+_(u,t)*w(l),10,$ff-(l*8)):m+60:Wend:l-1:Wend
StopDrawing():FlipBuffers():Delay(20):Wend

peterb · Post by **peterb** » Mon Jun 15, 2009 12:21 am

Code: Select all

;*****************************************************************************
;*
;* Name   : Boxes
;* Author : Petr Vavrin (peterb)
;* Date   : 15.06.09
;* Notes  : 
;*
;***************************************************************************** 
o=400:q=20:InitSprite():OpenWindow(0,0,0,o,o,"",$C80001):i=WindowID(0)
OpenWindowedScreen(i,0,0,o,o,1,0,0):While WindowEvent()<>16:ClearScreen(0)
StartDrawing(ScreenOutput()):x=q:While x<o:y=q:While y<o:u.f=Sqr(x*x+y*y)
w=q*Sin((2*u-p)/57):Box(x-w/2,y-w/2,w,w,255):y+q:Wend:x+q:Wend:p+4:StopDrawing()
FlipBuffers():Delay(q):Wend

Psychophanta · Post by **Psychophanta** » Mon Jun 15, 2009 9:01 pm

uhh!! peterb is unbearable, can not beat...
Winner and king!

Post by **Fred** » Mon Jun 15, 2009 9:21 pm

All the codes are really cool !

Post by **idle** » Tue Jun 16, 2009 12:23 am

Julia Set Windowed and full screen below (felt sorry for Cpl.Bator who will protest unless it runs on Linux

Code: Select all

;*****************************************************************************
;*
;* Name   :Julia Set windowed - windows only
;* Author :Idle 
;* Date   :16/06/2009
;* Notes  :Windows Only 
;*         ***** > Disable debugger < *****  
;*        :A / Z = zoom :
;*        :S / X = change Real 
;*        :D / C = change Imaginary 
;*        :UP / DOWN / LEFT / RIGHT = Move
;*        :Esc = quit    
;***************************************************************************** 

Macro _(k):GetAsyncKeyState_(k)&1:EndMacro:Macro e:ElseIf:EndMacro:InitSprite()
Macro ca(a,b):(a-w/2)/(0.5*z*w)+(1/w*(b-(w/2))):EndMacro:Global w=512,z.f=1.0  
Macro F(a,b):For a=0 To b-1:EndMacro:Global cI.f=0.26015,cR.f=-0.72,nR.d,nI.d
Global aR.d,aI.d,px.f=w/2,py.f=px:OpenWindow(0,0,0,w,w,"julia set"):Repeat
StartDrawing(WindowOutput(0)):f(x,w):f(y,w):nR=ca(x,px):nI=ca(y,py):f(i,128)
aR=nR:aI=nI:nR=aR*aR-aI*aI+cR:nI=2*aR*aI+cI:If((nR*nR+nI*nI)>4):Break:EndIf
Next:c=Pow(i,4):Plot(x,y,c):Next:Next:StopDrawing():Delay(20):If _(65):z*2
e _(90):z/2:e _(83):cI+0.001:e _(88):cI-0.001:e _(68):cR+0.001:e _(67)
cR-0.001:e _(39):px+(4/z):e _(37):px-(4/z):e _(38):py-(4/z):e _(40):py+(4/z)
e _(#VK_ESCAPE):q=1:EndIf:Until q=1 Or WindowEvent()=16

full screen cross platform

Code: Select all

;*****************************************************************************
;*
;* Name   :Julia Set Full Screen cross platform 
;* Author :Idle & PeterB 
;* Date   :16/06/2009
;* Notes  :Not Windows Only 
;*         ***** > Disable debugger < *****  
;*        :A / Z = zoom :
;*        :S / X = change Real 
;*        :D / C = change Imaginary 
;*        :UP / DOWN / LEFT / RIGHT = Move
;*        :Esc = quit    
;***************************************************************************** 

Macro _(k):ElseIf KeyboardPushed(k):ch=1:EndMacro:Macro F(a,b):For a=0 To b-1
EndMacro:InitSprite():InitKeyboard():cI.f=0.26015:cR.f=-0.72:a.f=0.001:h=600
w=800:h2=h/2:w2=w/2:s.f=w2:t.f=h/2:z.f=1:OpenScreen(w,h,32,""):ch=1:Repeat
ExamineKeyboard():If ch:StartDrawing(ScreenOutput()):v1.f=z*w2:v2.f=z*h2
u1.f=1/w*(s-w2):u2.f=1/h*(t-h2):f(x,w):f(y,h):R.f=(x-w2)/v1+u1:I.f=(y-h2)/v2+u2
f(j,128):aR.f=R:aI.f=I:R=aR*aR-aI*aI+cR:I=2*aR*aI+cI:If R*R+I*I>4:Break:EndIf
Next:Plot(x,y,Pow(j,4)):Next:Next:StopDrawing():FlipBuffers():ClearScreen(0)
ch=0:EndIf:Delay(5):If 1=2:_(30):z*2:_(44):z/2:_(31):cI+a:_(45):cI-a:_(32):cR+a
_(46):cR-a:_(205):s+(4/z):_(203):s-(4/z):_(200):t-(4/z):_(208):t+(4/z):_(1):q=1
EndIf:Until q=1

djes · Post by **djes** » Tue Jun 16, 2009 2:38 pm

Cool!

Fred> Thank you, for the char counter in the editor too

va!n · Post by **va!n** » Tue Jun 16, 2009 10:50 pm

Windows Version (Exit by pressing ESCAPE):

Code: Select all

;*****************************************************************************
;*
;* Name   : FlipFrac - flipping flat fractal with faked lightsourcing effect                               
;* Author : Thorsten Will - aka 'Mr.Vain of Secretly!'
;* Date   : 16.06.2009                                    
;* Notes  : Entry for the PurePunch Contest #2
;*          The rule is to code something in max 10 lines of 80 characters! 
;*          I did a small graphic effect in just only 5 lines of code! ;-)
;*          Win32 API has been used to check if user pressed the ESCAPE key
;*
;*          P L E A S E   D I S A B L E   T H E   D E B U G G E R  !!! 
;*
;*****************************************************************************  
InitSprite():OpenScreen(640,480,32,""):b=255:Repeat:StartDrawing(ScreenOutput())
For m=0 To 639:For n=0 To 479:c=(64+Random(128))<<16:p.f=(m-320)/(Sin(t.f)*200)
q.f=(n-240)/(Cos(t)*200):x.f=0:y.f=0:For i=0 To 31:u.d=x*x-y*y+p:v.d=2*x*y+q
If(u*u+v*v)>4:Goto E:EndIf:x=u:y=v:Next:c=Cos(t)*200:c=RGB(c,c,b):E:Plot(m,n,c)
Next:Next:StopDrawing():t+0.05:FlipBuffers():Until GetAsyncKeyState_(27):End

Cross Platform Version (automatical exit after some seconds, just change Until t>10] value):

Code: Select all

;*****************************************************************************
;*
;* Name   : FlipFrac - flipping flat fractal with faked lightsourcing effect                               
;* Author : Thorsten Will - aka 'Mr.Vain of Secretly!'
;* Date   : 16.06.2009                                    
;* Notes  : Entry for the PurePunch Contest #2
;*          The rule is to code something in max 10 lines of 80 characters! 
;*          I did a small graphic effect in just only 5 lines of code! ;-)
;*          Exit automatical after some seconds to fit still into 5 lines of code
;*
;*          P L E A S E   D I S A B L E   T H E   D E B U G G E R  !!! 
;*
;*****************************************************************************  
InitSprite():OpenScreen(640,480,32,""):b=255:Repeat:StartDrawing(ScreenOutput())
For m=0 To 639:For n=0 To 479:c=(64+Random(128))<<16:p.f=(m-320)/(Sin(t.f)*200)
q.f=(n-240)/(Cos(t)*200):x.f=0:y.f=0:For i=0 To 31:u.d=x*x-y*y+p:v.d=2*x*y+q
If(u*u+v*v)>4:Goto E:EndIf:x=u:y=v:Next:c=Cos(t)*200:c=RGB(c,c,b):E:Plot(m,n,c)
Next:Next:StopDrawing():t+0.05:FlipBuffers():Until t>10:End

djes · Post by **djes** » Wed Jun 17, 2009 8:19 am

Code: Select all

;*****************************************************************************
;*
;* Name   : PSphere
;* Author : djes
;* Date   : 06/17/2009
;* Notes  : -
;*
;*****************************************************************************
InitSprite():Macro g(t,d):Macro t:d:endmacr:EndMacro:g(d,drawing)o:g(n,Next)o
g(so,ScreenOutput)o:Structure v:x.f:y.f:z.f:c.i:EndStructure:w=511:r=255:k=127
g(q,s())o:g(C(m,l,p),Cos(0.03)*q\m l Sin(0.03)*q\p)o:g(e,EndIf)o:t$="PUREBASIC"
OpenWindow(0,0,0,w,w,""):OpenWindowedScreen(WindowID(0),0,0,w,w,0,0,0)
NewList s.v():LoadFont(1,"Arial",16):Start#D(so()):DrawingFont(FontID(1))
DrawText(10,0,t$,r,0):For y=-r To r:For x=-r To r:z=Sqr($FE01-(x*x)-(y*y))
If z>0:If Point(x&k,y&63)<>0:AddElement(q):If x&1=0:z*-1:e:q\x=x:q\y=y:q\z=z
q\c=-1:e:e:n x:n y:Stop#D():Repeat:FlipBuffer#q:ClearScreen(0):Start#D(so())
ForEach(q):Plot(r+q\x,r+q\y,w):b.f=C(x,-,z):q\z=C(z,+,x):q\x=b:b.f=C(x,-,y)
q\y=C(y,+,x):q\x=b:Plot(r+q\x,r+q\y,q\z):n:Stop#D():Until WindowEvent()=16

Post by **idle** » Wed Jun 17, 2009 9:23 am

that's really cool

peterb · Post by **peterb** » Wed Jun 17, 2009 11:45 pm

Code: Select all

;*****************************************************************************
;*
;* Name   : Multi Waves
;* Author : Petr Vavrin (peterb)
;* Date   : 18.06.09
;* Notes  :
;*
;***************************************************************************** 
Macro q:Random(96)-48:EndMacro:Macro r:Random(10)+1:EndMacro:Dim u(9999):o=400
Macro _(a):LineXY(u(e),u(e+1),u(e+a),u(e+a+1),v(e)<<16):EndMacro:InitSprite()
n=60:OpenWindow(0,0,0,o,o,""):OpenWindowedScreen(WindowID(0),0,0,o,o,1,0,0)
Dim v(9999):While WindowEvent()<>16:If l=0:h=q:oy=q:j=q:ny=q:c=r:a=r:d=r:b=r:p=0
l=300:EndIf:l-1:ClearScreen(0):StartDrawing(ScreenOutput()):m=0:y=-n:While y<n
x=-n:i=y-oy:i*i:k=y-ny:k*k:While x<n:s=x-h:z.f=a*Sin((c*Sqr(s*s+i)-p)/57):s=x-j
f.f=d*Sqr(s*s+k)-p:z+b*Sin(f/57):v(m)=(z+a+b)*127/(a+b):z*0.7:yy.f=0.7*y
f=o/(90-(yy+z)):u(m)=x*f+200:u(m+1)=(yy-z)*f+130:m+2:x+2:Wend:y+2:Wend:p+9:s=1
While s<59:t=1:While t<59:e=(t+s*n)*2:If t<58:_(2):EndIf:If s<58:_(120):EndIf
t+2:Wend:s+2:Wend:StopDrawing():FlipBuffers():Delay(20):Wend

zikitrake · Post by **zikitrake** » Thu Jun 18, 2009 1:52 pm

Here is my

Arkanoid

Code: Select all

;*****************************************************************************
;*
;* Name   : Stupidnoid
;* Author : Zikitrake
;* Date   : 18 June 2009
;* Notes  : Calls Win API, so only for Windows(ReadConsoleOutputCharacter_())
;*
;***************************************************************************** 

Macro P(a,b):ConsoleLocate(a,b):EndMacro:OpenConsole():EnableGraphicalConsole(1)
For y=0 To 5:P(10,y*2):Print(LSet("=",60,"=")):Next:px=20:X=px:Y=23
Dx=1:Dy=-1:Macro ENDE():P(30,11):Print(" GAME OVER "):Input():CloseConsole()
End:EndMacro:Repeat:P(0,0):Print("POINTS:"+Str(PT)):Inkey():k=RawKey()
If k=37 And Px>0:Px-1:EndIf:If k=39 And Px<72:Px+1:EndIf:P(Px,24)
Print(" ------ "):If m>400:P(X,Y):Print(" "):X+Dx:Y+Dy:m=0:EndIf:m+1
PokeW(@coord.l,X):PokeW(@coord+2,Y):NCR.l:B$=" "
ReadConsoleOutputCharacter_(7,B$,1,coord,@NCR):If B$="=":Dy*-1:P(X,Y):Print(" ")
PT+1:EndIf:If B$="-" And Dy=1 :Dy=-1:EndIf:If X>78 Or X<1
Dx*-1:EndIf:If X<1:Dx=1:EndIf:If Y>24:ENDE():EndIf:P(X,Y):Print("o"):Until k=27