PurePunch Contest #2

Share your advanced PureBasic knowledge/code with the community.
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Hades wrote: Edit: Added antialiasing. Now 256 rays per pixel.
:shock: Very impressive :shock:
User avatar
Kaeru Gaman
Addict
Addict
Posts: 4826
Joined: Sun Mar 19, 2006 1:57 pm
Location: Germany

Post by Kaeru Gaman »

:shock: incredible!

... far off competition.


perhaps a bit intimidating to the others...
oh... and have a nice day.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

In demomaking, the design is sometimes best appreciated than the code :P
And remind that the contest is not limited to something visual :)
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Kaeru Gaman wrote: perhaps a bit intimidating to the others...
I hope that isn't the case. I've already seen a lot of really nice things from pure punch. Animated stuff and even small games.
While that ray traced picture might look nice, there really isn't much to it. It's just something I'm doing all the time.
I would have trouble to create a lot of things I have seen here, so keep 'em coming. :D
Ollivier
Enthusiast
Enthusiast
Posts: 281
Joined: Mon Jul 23, 2007 8:30 pm
Location: FR

Post by Ollivier »

Code: Select all

;*****************************************************************************
;*
;* Name   : Crazy waves
;* Author : Ollivier
;* Date   : 02/06/09
;* Notes  : Cf http://www.purebasic.fr/french/viewtopic.php?t=9437
;*
;*****************************************************************************
Q=600:Dim SX.F(Q):Dim SY.F(Q):Dim SA.F(Q):Dim SR.F(Q):#Z=4:Dim SV.F(Q)
InitSprite():#N=3:InitMouse():#B=2:ExamineDesktops():DW=DesktopWidth(0)
DH=DesktopHeight(0):OpenScreen(DW,DH,DesktopDepth(0),""):CreateSprite(0,DW,DH)
CreateSprite(1,#Z,#Z):StartDrawing(SpriteOutput(1)):Box(0, 0, #Z, #Z,#White)
StopDrawing():X.F=SX(0):Y.F=SY(0):For CA=0 To Q:SX(CA)=DW/2:SY(CA)=DH/2
SA(CA)=Random(628)/100:SV(CA)=Random(800)/100:Next CA:Repeat:Delay(1)
ExamineMouse():FlipBuffers():DisplaySprite(0,0,0):For I=0 To Q:X=SX(I):Y=SY(I)
DisplaySprite(1,X,Y):DX.F=(4999*X+DW/2)/5000:DY.F=(4999*Y+DH/2)/5000
V.F=Sqr(DX*DX+DY*DY):VS.F=SV(I)*(100/V):SX(I)=DX+(Cos(SA(I))*VS):SR(I)+0.0001
SY(I)=DY-(Sin(SA(I))*VS):SA(I)+Sin(SR(I))*(10/V):Next:Until MouseButton(2)
Anonymous

Post by Anonymous »

Code: Select all

;*****************************************************************************
;*
;* Name   : Bump-Mapping 640x480
;* Author : Cpl.Bator
;* Date   : 2/06/2009
;* Notes  : Tested on linux , program quit automatically
;*
;***************************************************************************** 
Macro R:For:EndMacro:Macro T:Next:EndMacro:S=512:W=640:H=480:W2=320:H2=240
Macro N:EndIf:EndMacro:InitSprite():OpenScreen(W,H,32,""):Dim L(S,S):g=64
R y=0 To S:R x=0 To S:Nxl.f=(x-(S/2))/(S/4):Nyl.f=(y-(S/2))/(S/4):Nzl.f:v.f
Nzl=1-Sqr((Nxl*Nxl)+(Nyl*Nyl)):If Nzl<=0:Nzl=0:N:L(x,y)=(200 * NZl):T x:T y
Dim B(1000,1000):R i = 0 To 79:R y= 0 To 63:R x= 0 To 63:C=(x*256/g)!(y*256/g)
B(x+dx,y+dy)=RGB(C,C,C):T:T:dx+g:If dx=W:dx=0:dy+g:N:T:Repeat:ClearScreen(0)
v+0.1:LX.f=W2+160*Cos(v):LY.f=H2+120*Sin(v/2):StartDrawing(ScreenOutput())
R y=1 To 479:R x=1 To 639:NX=(B(x+1,y)-B(x-1,y)):NY=(B(x,y+1)-B(x,y-1))
NLX.f=X-LX:NLY.f=Y-LY:NX=(NX+NLX)+(S/2):NY=(NY+NLY)+(S/2):NX%512:NY%512
C=L(NX,NY)<<8:Plot(x,y,C):T x:T y:StopDrawing():FlipBuffers():Until v>50
:D
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Code: Select all

;*****************************************************************************
;*
;* Name   :Punch Shrinker 
;* Author :einander
;* Date   :june 3 - 2009
;* Notes  :Concatenate lines, strip comments and validate Pure Punch files. 
;*         New file named as original + "_S.PB"
;***************************************************************************** 
F.s="Punch Shrinker":OpenWindow(0,0,0,600,400,F,$1CF0000):b.s:#R=Chr(34):T.s
F=OpenFileRequester("Load file","","PB|*.pb|All|*.*",0):SP.s=Chr(32):S2.s=SP+SP
#C=Chr(58):#M=Chr(10):If ReadFile(0,F):While Eof(0)=0:A.s=Trim(ReadString(0))
While FindString(A,S2,1):A=ReplaceString(A,S2,SP):Wend:P=FindString(A,Chr(59),1)
If P:P1=FindString(A,#R,1):If P1=0 Or P<P1 Or P>FindString(A,#R,P1+1)
A=Trim(Left(A,P-1)):EndIf:EndIf:L=Len(A):If L:If L>80 Or n>10
MessageRequester("Stop at "+Str(n),T,0):End:ElseIf Len(b+A)>80:T+b:b=#M+A:n+1
ElseIf A<>#C:If b:b+#C+A:Else:b=A:EndIf:EndIf:EndIf:Wend:CloseFile(0)
If CreateFile(0,F+"_SHRINK.PB"):If b:T+b:EndIf:WriteData(0, @T, Len(T))
MessageRequester("Saved "+F+"_SHRINK.PB-"+Str(n+1)+" Lines",T,0):EndIf:EndIf:End
:wink:
Last edited by einander on Thu Jun 04, 2009 12:36 am, edited 3 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 »

Strange, some codes don't seems valid, even if they have >= 80 chars per line.
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

:?:
@djes: Can you post an example of not valid code?
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Works fine here. Did you test the latest one? Otoh the older ones should have been fine to... Strange.
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Added check to replace double spaces (see previous post).
I've forgot JaPBe's autoformat, that adds empty spaces at line start.

Here is the trivial complementary Expander.
Sorry for the horrible variable names, but with normal ones, the file grows over Punch limits...

Now it can shrink and expand Hades beautiful example.

Code: Select all

;*****************************************************************************
;*
;* Name   : Pure Punch Expander
;* Author : einander
;* Date   : june 3 - 2009
;* Notes  : Complementary for Pure Punch Shrinker
;*          Replace double quotes for Line feeds 
;*
;*****************************************************************************
#C=Chr(58):#L=Chr(10):OpenWindow(0,0,0,600,400,"PB Line Shrinker",$1CF0000)
F.s= OpenFileRequester("Load PB file","","PB|*.pb|All(*.*)|*.*",0)
If ReadFile(0,F):While Eof(0) = 0:A$=Trim(ReadString(0))
P=FindString(A$,Chr(59),1):If P:P1=FindString(A$,Chr(34),1)
If P1=0 Or P<P1 Or P>FindString(A$,Chr(34),P1+1):A$=Trim(Left(A$,P-1)):EndIf
EndIf:L=Len(A$):If L>80 Or n>9:MessageRequester("Stop at "+Str(n+1),T$+B$,0)
End:ElseIf Len(B$+A$)>79:T$+B$:B$=#L+A$:n+1:ElseIf L And A$<>#C:If B$:B$+#C+A$
Else:B$=A$:EndIf:EndIf:Wend:CloseFile(0):If CreateFile(0,F+"_SHRINKED.PB" )
T$+B$:WriteData(0, @T$, Len(T$)):CloseFile(0)
MessageRequester("File OK: Saved "+Str(n+1)+" Lines",T$,0):EndIf:EndIf:End

User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

Shrinker works by now, but the expander is the same code...

Hades> No problem on your code! :)
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

I'm sorry, I've done it again. :(
I've posted a new version, and it is reported as bad by your shrinker (Stop at 11).Should be fine though, or am I missing something?
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

Hades wrote:I'm sorry, I've done it again. :(
I've posted a new version, and it is reported as bad by your shrinker (Stop at 11).Should be fine though, or am I missing something?
For me, your code is... Perfect 8)
Post Reply