PureBasic Forums - English

Posted: **Sun Aug 24, 2008 7:21 pm**

We have started a new thread on the french forum called Pure Punch. Behind that is a recall of an old computer publication called STMag (dedicated to the Atari ST), where were little snippets of GFA BASIC called "GFA Punch".

The only rule, trying to do something nice (useful, fun, etc.) with a Purebasic source containing only :

1° 10 lines of 256 chars per line max or
2° 100 lines with only one command per line or
3° 2560 chars total max.

Except this, everything is possible!
A title would be appreciated, and a clean and readable code is a mark of quality

You can post on our forum, or this one, if the moderators are agreeing... Have fun!

Edit (july, the 2nd 2009):
I have the pleasure to announce :

The winner of the first PurePunch contest is HeX0R ! with a total of 5 votes (from 20)
Congratulations!

Second is CPL.Bator with 4 votes
Nice try!

Thanks to all competitors! Maybe the second PurePunch contest will see your victory

Posted: **Sun Aug 24, 2008 7:31 pm**

whoo 2560 chars? dunno if it fits...

I wrote a little game for the 20liner's contest years ago...
max 20 lines, max 5 colons per line was the rule...

Code: Select all

#pf.f=3.14159265/180:Procedure Flower(x.l,y.l):For i=0 To 5:Circle(x+12*Sin(i*60*#pf),y+12*Cos(i*60*#pf),8,RGB(128,0,48)):Circle(x+12*Sin(i*60*#pf),y+12*Cos(i*60*#pf),7,RGB(255,0,96)):Next
Circle(x,y,6,RGB(255,0,96)):Circle(x,y,5,RGB(255,240,32)):EndProcedure:Procedure Bee(x.l,y.l,f.l):For i=-2 To 1:Circle(x,y-2+4*i,6,RGB(255,240,0))
Circle(x,y+4*i,6,RGB(32,32,0)):Next:Circle(x,y+6,5,RGB(255,192,0)):Circle(x+3,y+5,2,RGB(64,128,255)):Circle(x-3,y+5,2,RGB(64,128,255)):Circle(x-12,y-4-f,8,RGB(240,240,255))
Circle(x+12,y-4-f,8,RGB(240,240,255)):EndProcedure:Procedure Fly(x.l,y.l,f.l):For i=0 To 3:Circle(x+f*Sin((45+i*90)*#pf),y+f*Cos((45+i*90)*#pf),7,RGB(16,160,255)):Circle(x+2*f*Sin((45+i*90)*#pf),y+2*f*Cos((45+i*90)*#pf),7,RGB(16,160,255))
Circle(x+f*Sin((45+i*90)*#pf),y+f*Cos((45+i*90)*#pf),4,RGB(255,240,32)):Circle(x+2*f*Sin((45+i*90)*#pf),y+2*f*Cos((45+i*90)*#pf),4,RGB(255,240,32)):Next:Circle(x,y-6,3,RGB(128,96,0)):Box(x-3,y-6,6,12,RGB(128,96,0)):Circle(x,y+6,3,RGB(128,96,0))
Line(x-1,y-9,-6,-11,RGB(16,200,255)):Line(x,y-9,5,-11,RGB(16,200,255)):Circle(x,y-9,3,RGB(255,96,0)):EndProcedure:If InitSprite() And InitKeyboard() And OpenScreen(800,600,16,"SV"):SetFrameRate(60)
Dim PX(600):Dim FP(4):For n=1 To 600:PX(n)=Random(799):Next:LV=4
Repeat:FX=400:FY=500:LV-1:NW=0:Repeat
ExamineKeyboard():ClearScreen(0,128,0):If KeyboardPushed(200):FY-2:EndIf:If KeyboardPushed(203)
FX-2:EndIf:If KeyboardPushed(205):FX+2:EndIf:If KeyboardPushed(208)
FY+2:EndIf:StartDrawing(ScreenOutput()):DrawingMode(1):PX(0)=Random(799):For n=600 To 1 Step -1
PX(n)=PX(n-1):Box(PX(n),n-1,2,1,RGB(0,192,0)):Next:For n=0 To 4:If Abs(FP(n)-100-FX)<16 And Abs(c+150*n-50-FY)<16:FP(n)=0
SC+10:EndIf:Flower(FP(n)-100,c+150*n-50):Next:Locate(270,10):DrawText("Bubu Butterfly's Spring Vacation")
Locate(270,580):DrawText("Score: "+Right("000000"+Str(SC),6)+" . . . . . Lifes: "+Str(LV)):Fly(FX-DI,FY,6+3*Sin(c/8)):Bee(BX+400+100*Sin(c/20),c*4,4*Sin(c)):If Abs(BX+400+100*Sin(c/20)-(FX-DI))<24 And Abs(c*4-FY)<24:DI=10000
EndIf:c+1:If c>149:For n=4 To 1 Step -1:FP(n)=FP(n-1):Next
FP(0)=150+Random(700):BX=Random(600)-300:If DI=10000:NW=1:DI=0:EndIf
c=0:EndIf:StopDrawing():Delay(8):If KeyboardPushed(1) Or LV<0:EX=1
EndIf:FlipBuffers():Until EX=1 Or NW=1:Until EX=1:EndIf:End

it's 3.8 code I think...

Posted: **Sun Aug 24, 2008 7:45 pm**

It's in the spirit, even if I had to correct your code a bit for PB4 :

Code: Select all

#pf=3.14159265/180:Procedure Flower(x.l,y.l):For i=0 To 5:Circle(x+12*Sin(i*60*#pf),y+12*Cos(i*60*#pf),8,RGB(128,0,48)):Circle(x+12*Sin(i*60*#pf),y+12*Cos(i*60*#pf),7,RGB(255,0,96)):Next
Circle(x,y,6,RGB(255,0,96)):Circle(x,y,5,RGB(255,240,32)):EndProcedure:Procedure Bee(x.l,y.l,f.l):For i=-2 To 1:Circle(x,y-2+4*i,6,RGB(255,240,0))
Circle(x,y+4*i,6,RGB(32,32,0)):Next:Circle(x,y+6,5,RGB(255,192,0)):Circle(x+3,y+5,2,RGB(64,128,255)):Circle(x-3,y+5,2,RGB(64,128,255)):Circle(x-12,y-4-f,8,RGB(240,240,255))
Circle(x+12,y-4-f,8,RGB(240,240,255)):EndProcedure:Procedure Fly(x.l,y.l,f.l):For i=0 To 3:Circle(x+f*Sin((45+i*90)*#pf),y+f*Cos((45+i*90)*#pf),7,RGB(16,160,255)):Circle(x+2*f*Sin((45+i*90)*#pf),y+2*f*Cos((45+i*90)*#pf),7,RGB(16,160,255))
Circle(x+f*Sin((45+i*90)*#pf),y+f*Cos((45+i*90)*#pf),4,RGB(255,240,32)):Circle(x+2*f*Sin((45+i*90)*#pf),y+2*f*Cos((45+i*90)*#pf),4,RGB(255,240,32)):Next:Circle(x,y-6,3,RGB(128,96,0)):Box(x-3,y-6,6,12,RGB(128,96,0)):Circle(x,y+6,3,RGB(128,96,0))
Line(x-1,y-9,-6,-11,RGB(16,200,255)):Line(x,y-9,5,-11,RGB(16,200,255)):Circle(x,y-9,3,RGB(255,96,0)):EndProcedure:If InitSprite() And InitKeyboard() And OpenScreen(800,600,16,"SV"):SetFrameRate(60)
Dim PX(600):Dim FP(4):For n=1 To 600:PX(n)=Random(799):Next:LV=4
Repeat:FX=400:FY=500:LV-1:NW=0:Repeat
ExamineKeyboard():ClearScreen(0):If KeyboardPushed(200):FY-2:EndIf:If KeyboardPushed(203)
FX-2:EndIf:If KeyboardPushed(205):FX+2:EndIf:If KeyboardPushed(208)
FY+2:EndIf:StartDrawing(ScreenOutput()):DrawingMode(1):PX(0)=Random(799):For n=600 To 1 Step -1
PX(n)=PX(n-1):Box(PX(n),n-1,2,1,RGB(0,192,0)):Next:For n=0 To 4:If Abs(FP(n)-100-FX)<16 And Abs(c+150*n-50-FY)<16:FP(n)=0
SC+10:EndIf:Flower(FP(n)-100,c+150*n-50):Next:DrawText(270,10,"Bubu Butterfly's Spring Vacation")
DrawText(270,580,"Score: "+Right("000000"+Str(SC),6)+" . . . . . Lifes: "+Str(LV)):Fly(FX-DI,FY,6+3*Sin(c/8)):Bee(BX+400+100*Sin(c/20),c*4,4*Sin(c)):If Abs(BX+400+100*Sin(c/20)-(FX-DI))<24 And Abs(c*4-FY)<24:DI=10000
EndIf:c+1:If c>149:For n=4 To 1 Step -1:FP(n)=FP(n-1):Next
FP(0)=150+Random(700):BX=Random(600)-300:If DI=10000:NW=1:DI=0:EndIf
c=0:EndIf:StopDrawing():Delay(8):If KeyboardPushed(1) Or LV<0:EX=1
EndIf:FlipBuffers():Until EX=1 Or NW=1:Until EX=1:EndIf:End

Fun and really nice! However, please try to send PB4 code, and to respect the rules. Your code is 2254 bytes long (just look at the length of your ASCII file), so it's OK

Posted: **Sun Aug 24, 2008 7:46 pm**

The Code from Kaeru a bit shorter, i hope

//edit: new shorter Code

Code: Select all

Macro C: Circle:EndMacro:#pf=3.14159265/180:Procedure Flower(x.l,y.l):For i=0 To 5:C(x+12*Sin(i*60*#pf),y+12*Cos(i*60*#pf),8,RGB(128,0,48)):C(x+12*Sin(i*60*#pf),y+12*Cos(i*60*#pf),7,RGB(255,0,96)):Next
C(x,y,6,RGB(255,0,96)):C(x,y,5,RGB(255,240,32)):EndProcedure:Procedure Bee(x.l,y.l,f.l):For i=-2 To 1:C(x,y-2+4*i,6,RGB(255,240,0))
C(x,y+4*i,6,RGB(32,32,0)):Next:C(x,y+6,5,RGB(255,192,0)):C(x+3,y+5,2,RGB(64,128,255)):C(x-3,y+5,2,RGB(64,128,255)):C(x-12,y-4-f,8,RGB(240,240,255))
C(x+12,y-4-f,8,RGB(240,240,255)):EndProcedure:Procedure Fly(x.l,y.l,f.l):For i=0 To 3:C(x+f*Sin((45+i*90)*#pf),y+f*Cos((45+i*90)*#pf),7,RGB(16,160,255)):C(x+2*f*Sin((45+i*90)*#pf),y+2*f*Cos((45+i*90)*#pf),7,RGB(16,160,255))
C(x+f*Sin((45+i*90)*#pf),y+f*Cos((45+i*90)*#pf),4,RGB(255,240,32)):C(x+2*f*Sin((45+i*90)*#pf),y+2*f*Cos((45+i*90)*#pf),4,RGB(255,240,32)):Next:C(x,y-6,3,RGB(128,96,0)):Box(x-3,y-6,6,12,RGB(128,96,0)):C(x,y+6,3,RGB(128,96,0))
Line(x-1,y-9,-6,-11,RGB(16,200,255)):Line(x,y-9,5,-11,RGB(16,200,255)):C(x,y-9,3,RGB(255,96,0)):EndProcedure:If InitSprite() And InitKeyboard() And OpenScreen(800,600,16,"SV"):SetFrameRate(60)
Dim PX(600):Dim FP(4):For n=1 To 600:PX(n)=Random(799):Next:LV=4:Repeat:FX=400:FY=500:LV-1:NW=0:Repeat:ExamineKeyboard():ClearScreen(0):If KeyboardPushed(200):FY-2:EndIf:If KeyboardPushed(203):FX-2:EndIf:If KeyboardPushed(205):FX+2:EndIf:If KeyboardPushed(208)
FY+2:EndIf:StartDrawing(ScreenOutput()):DrawingMode(1):PX(0)=Random(799):For n=600 To 1 Step -1:PX(n)=PX(n-1):Box(PX(n),n-1,2,1,RGB(0,192,0)):Next:For n=0 To 4:If Abs(FP(n)-100-FX)<16 And Abs(c+150*n-50-FY)<16:FP(n)=0
SC+10:EndIf:Flower(FP(n)-100,c+150*n-50):Next:DrawText(270,10,"Bubu Butterfly's Spring Vacation"):DrawText(270,580,"Score: "+Right("000000"+Str(SC),6)+" . . . . . Lifes: "+Str(LV)):Fly(FX-DI,FY,6+3*Sin(c/8)):Bee(BX+400+100*Sin(c/20),c*4,4*Sin(c)):If Abs(BX+400+100*Sin(c/20)-(FX-DI))<24 And Abs(c*4-FY)<24:DI=10000
EndIf:c+1:If c>149:For n=4 To 1 Step -1:FP(n)=FP(n-1):Next:FP(0)=150+Random(700):BX=Random(600)-300:If DI=10000:NW=1:DI=0:EndIf:c=0:EndIf:StopDrawing():Delay(8):If KeyboardPushed(1) Or LV<0:EX=1:EndIf:FlipBuffers():Until EX=1 Or NW=1:Until EX=1:EndIf:End

Posted: **Sun Aug 24, 2008 8:19 pm**

ya sorry, just pasted the old code....

btw: it ran on linux when replacing the literal values for the keys with the constants...

Posted: **Sun Aug 24, 2008 9:29 pm**

Not so nice than yours, but my turn

Code: Select all

Procedure text_line(x1.f, y1.f, x2.f, y2.f)
  Repeat
    ConsoleColor(1 + u.f * 14,0) : ConsoleLocate(x1 + u * (x2 - x1), y1 + u * (y2 - y1))
;    Print(Mid("PUREBASIC", u * 9, 1))
    Print("PUREBASIC") : u + 0.05 
  Until u >= 1
EndProcedure
If OpenConsole()
  EnableGraphicalConsole(1) : Repeat : ClearConsole() : text_line(40 + 30 * Sin(i.f), 10 + 10 * Cos(i), 40 - 30 * Sin(i), 10 - 10 * Cos(i)) : i + 0.1 : Delay(16) : ForEver : CloseConsole() 
EndIf

Posted: **Mon Aug 25, 2008 1:01 pm**

Just a question.

Woldnt it be the same... 10 lines with 256 chars oder 2560 chars at all? (It would be at least easier to read and understand... )

Posted: **Mon Aug 25, 2008 1:30 pm**

Of course, it would be nicer to do 10 lines of nice indented code

; but as macros can not be used without LF, I think we can admit the two things, with a preference to the lines version.

I want to add that it's not just to face a challenge. A good and useful code may be better than a wonderful fx. It's up to you to decide... For example, it would be possible to vote every month for the best punch.

Posted: **Mon Aug 25, 2008 11:25 pm**

it doesn't make any sense to limit the source code on a line basis, the compiler doesn't care, limiting the amount of characters is good though

Edited and reposted code lower down.

Posted: **Mon Aug 25, 2008 11:32 pm**

I agree.
back then (we had such contests also on the C64) the number of chars per line was limited,
on the C64 on 80 chars, so a 10liner/20liner contest was a quite tight limit.
to have better readable code, we could also make a 100liner contest with only one command per line.

nice effect, idle.

Posted: **Mon Aug 25, 2008 11:40 pm**

Nice!

So here's the three possibilities (I'll edit the first post) :

1° 10 lines of 256 chars per line max or
2° 100 lines with only one command per line or
3° 2560 chars total max.

A title would be appreciated

Posted: **Tue Aug 26, 2008 7:45 am**

idle time during work plus a bit more after work

Code: Select all

#o=#PB_Compiler_OS:#w=#PB_OS_Windows:Structure ADt:X.l:Y.l:dx.l:dy.l:sr.S:c.l:EndStructure:Structure vec:X.l:Y.l:EndStructure:Global fps,ct,lt,ND,Xp,Yp,ZX.f=0,ZY.f=20,ZZ.f=22,DT.f=0.01,SN.f=5,SG.f=2.5,MS.f=1.32,GT.f=25,RR.f=15,SV.f=0.1,SA.f=0.1,DS.f=40
Global BE.f=1.25,i1,i2,Dim AD.ADt(1):If OpenWindow(0,0,0,800,600,"idle time",13565953):SetWindowColor(0,RGB(0,0,0)):CompilerIf#o=#w:ShowCursor_(0):CompilerEndIf:LoadFont(1,"Arial",24):i1=CreateImage(#PB_Any,800,600):i2=CreateImage(#PB_Any,800,600)
s.s="PB IDLE TIME":nD=Len(s):ReDim AD.ADt(nD+1):For i=0 To nD:AD(i)\X=400:AD(i)\Y=300:AD(i)\sr=Mid(s,i,1):AD(i)\c=RGB(255,255,255):Next:AD(0)\X=AD(1)\X:AD(0)\Y=AD(1)\Y-SN:CompilerIf#o=#w:SetCursorPos_(400+WindowX(0),300+WindowY(0)):CompilerEndIf
Repeat:EID=WindowEvent():Xp=WindowMouseX(0)-800/2:Yp=WindowMouseY(0)-600/2:ZX+(0.015*(-10*ZX+10*ZY)):ZY+(0.015*(28*ZX-ZY-ZX*ZZ)):ZZ+(0.015*(-8*ZZ/3+ZX*ZY)):x=(ZX*10)+400+Xp:y=(ZZ*10)+50+Yp:If StartDrawing(ImageOutput(i2))
Circle(x,y,ZZ,RGB(Random(255),Random(255),Random(255))):StopDrawing():EndIf:AD(0)\X=WindowMouseX(0):AD(0)\Y=WindowMouseY(0):For i=1 To nD:sp.vec:sp\x=0:sp\y=0:dx=AD(i-1)\X-AD(i)\X:dy=AD(i-1)\Y-AD(i)\Y:len.f=Sqr(dx*dx+dy*dy):If len>SN:t.f=SG*(len-SN)
sp\X+(dx/len)*t:sp\Y+(dy/len)*t:EndIf:rt.vec:rt\x=-AD(i)\dx*RR:rt\y=-AD(i)\dy*RR:ac.vec:ac\x=(sp\X+rt\X)/MS:ac\y=(sp\Y+rt\Y)/MS+GT:AD(i)\dx+(DT*ac\X):AD(i)\dy+(DT*ac\Y):If Abs(AD(i)\dx)<SV And Abs(AD(i)\dy)<SV And Abs(ac\X)<SA And Abs(ac\Y)<SA:AD(i)\dx=0
AD(i)\dy=0:EndIf:AD(i)\X+AD(i)\dx:AD(i)\Y+AD(i)\dy:If AD(i)\Y>=600-DS-1:If AD(i)\dy>0:AD(i)\dy=BE*-AD(i)\dy:EndIf:AD(i)\Y=600-DS-1:EndIf:If AD(i)\X>=800-DS:If AD(i)\dx>0:AD(i)\dx=BE*-AD(i)\dx:EndIf:AD(i)\X=800-DS-1:EndIf:If AD(i)\X<0:If AD(i)\dx < 0
AD(i)\dx=BE*-AD(i)\dx:EndIf:AD(i)\X=0:EndIf:If StartDrawing(ImageOutput(i1)):DrawingMode(1):DrawingFont(FontID(1)):DrawText(AD(i)\X,AD(i)\Y,AD(i)\Sr,AD(i)\c):StopDrawing():EndIf:Next:StartDrawing(ImageOutput(i1)):DrawingMode(2)
DrawImage(ImageID(i2),0,0,800,600):StopDrawing():StartDrawing(WindowOutput(0)):DrawImage(ImageID(i1),0,0,800,600):StopDrawing():FreeImage(i1):i1=CreateImage(#PB_Any,800,600):ct+1:If ElapsedMilliseconds()>lt:fps=ct:ct=0:lt=ElapsedMilliseconds()+1000:EndIf
CompilerIf#o=#w:If WindowMouseY(0) < 50:ShowCursor_(1):Else:ShowCursor_(0):EndIf:CompilerEndIf:SetWindowTitle(0,"Idle time (kinetic spring & lorenz strange attractor doodler) fps=" + Str(fps)):Delay(0):Until EID=16 Or GetAsyncKeyState_(#VK_ESCAPE):EndIf

Posted: **Tue Aug 26, 2008 7:58 am**

Kaeru Gaman wrote:ya sorry, just pasted the old code....

That's great

Posted: **Tue Aug 26, 2008 9:56 am**

Idle> I love it

Posted: **Tue Aug 26, 2008 7:20 pm**

Ok, not very useful (unless you want it for a screensaver) and not particularly nice, unless it's halloween!

Code: Select all

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0)
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) 
OpenWindow(0,0,0,w,h,"",#PB_Window_BorderLess):CreateGadgetList(WindowID(0)) 
ImageGadget(0,0,0,w,h,ImageID(0)):Dim x(w-1):For n=0 To w-1  
x(n)=-1:Next:f=0:Repeat:For n=1 To w:r=Random(w-1)
If x(r)<h:StartDrawing(ImageOutput(0)):x(r)=x(r)+1
Circle(r,x(r),7,255):StopDrawing():EndIf:If x(r)=h
f=1:EndIf:Next:SetGadgetState(0,ImageID(0))
WindowEvent():Until GetAsyncKeyState_(#VK_ESCAPE)Or f=1

PureBasic Forums - English

PurePunch contest #1

PurePunch contest #1