PurePunch contest #1

Rook Zimbabwe · Post by **Rook Zimbabwe** » Tue Aug 26, 2008 7:37 pm

idel... I get a small pic then the hourglass and it crunks!

it says in the debugger: OPEN WINDOWED SCREEN MUST BE CALLED...etc.

Derek · Post by **Derek** » Tue Aug 26, 2008 7:39 pm

So did I, just take out the keyboard checks in the last line, but you'll have to click on the kill program icon in the editor to stop it.

HeX0R · Post by **HeX0R** » Tue Aug 26, 2008 11:56 pm

/me also wants to play...

Code: Select all

InitSprite():InitMouse():InitKeyboard():OpenWindowedScreen(OpenWindow(0,0,0,800,600,""),0,0,800,600,0,0,0):CreateSprite(0,128,24):StartDrawing(SpriteOutput(0)):For i=0 To 127:LineXY(i,0,i,23,$FFFFFF-(i<<16)):Next:StopDrawing():m=$FFFFFF
For j=1 To 3:CreateSprite(j,64,32):StartDrawing(SpriteOutput(j)):For i=0 To 63:LineXY(i,0,i,31,(255-i*3)<<((j-1)*8)):Next:StopDrawing():Next:CreateSprite(4,32,32):StartDrawing(SpriteOutput(4)):For i=0 To 15:Circle(16,16,16-i,$BB-i*6):Next
StopDrawing():Dim S.l(8,5):While 1:For i=0 To 8:For j=0 To 5:S(i,j)=Random(2)+1:Next:Next:x=300:y=500:a=300:b=550:w.f=Random(100)+50:f=4*Sin(w/64):g=4*Cos(w/64):h=3:p.f=4:u=0:While 1:	While 1:Select WindowEvent():Case 16:End:Case 0:Delay(2)
Break:EndSelect:Wend:ExamineKeyboard():If KeyboardPushed(1):End:ElseIf KeyboardPushed(203):a-5:If a<0:a=0:EndIf:ElseIf KeyboardPushed(205):a+5:If a>671:a=671:EndIf:ElseIf h=0 And KeyboardReleased(59):Break:EndIf:ClearScreen(0):c=1
For i=0 To 8:For j=0 To 5:If S(i,j):r=100+i*65:s=50+j*33:If c And SpriteCollision(S(i,j),r,s,4,x,y):If x<r+2 Or x>r+62:g=-g:Else:f=-f:EndIf:u+S(i,j):S(i,j)=0:c=0:p+0.2:Else:DisplaySprite(S(i,j),r,s):EndIf:EndIf:Next:Next
DisplayTransparentSprite(4,x,y):DisplaySprite(0,a,b):StartDrawing(ScreenOutput()):DrawText(65,11,"1 Point",m,0):DrawText(186,11,"2 Points",m,0):DrawText(306,11,"3 Points",m,0):If h:DrawText(500,11,"Points: "+Str(u)+" Lives: "+Str(h),m,0):Else
DrawText(500,11,"Game over! Points:"+Str(u)+" Press F1 to restart",m,0):EndIf:StopDrawing():DisplaySprite(1,0,5):DisplaySprite(2,120,5):DisplaySprite(3,240,5):FlipBuffers():If h:y-f:x+g:If y+32>=b:If x+16>a And x-112<a:w=(64-x+a)+100
f=p*Sin(w/64):g=p*Cos(w/64):Else:h-1:w=Random(100)+50:x=a+60:f=p*Sin(w/64):g=p*Cos(w/64):EndIf:ElseIf x>=768 Or x<=0:g=-g:ElseIf y<=0:f=-f:EndIf:EndIf:Wend:Wend

djes · Post by **djes** » Wed Aug 27, 2008 12:13 am

Derek> Could be really useful in fact!
HeXor> It's dedicated to me? Sort of provocation as I just finished Purebreaker 3?

djes · Post by **djes** » Thu Aug 28, 2008 8:01 pm

Don't forget to see also on the french forum, there's nice ones : http://www.purebasic.fr/french/viewtopi ... highlight=

djes · Post by **djes** » Fri Aug 29, 2008 9:25 pm

Code: Select all

Macro st : StartDrawing(ScreenOutput()) : EndMacro : Macro ds(m) : DisplaySprite3D(0, 512 - w*5 + x*10 + 20*Sin(i.f + x/20 + y/20), y*10 + 20*Cos(i + x/20 + y/20) + m, y*10) : EndMacro : Goto p
ct: ClearScreen(0) : st: w = TextWidth(t$) : h = TextHeight(t$) : Dim m1(w, h) : DrawText(0, 0, t$, $FF, 0) : For y = 0 To h : For x = 0 To w : m1(x, y) = Point(x, y) : Next x : Next y : Circle(100, 100, 8, $5588FF) : StopDrawing() : Return
p: InitSprite() : InitSprite3D() : InitKeyboard() : OpenScreen(1024, 768, 32, "") : t2$="BIENVENUE" : t$="ALEXANDRE" : Gosub ct : Dim m2(w, h) : Swap t$, t2$ : Swap m1(), m2() : Swap h2, h : Swap w2, w : Gosub ct
GrabSprite(0, 92, 92, 16, 16, #PB_Sprite_Texture) : CreateSprite3D(0, 0) : ClearScreen(0) : st : For y = 0 To 64 : Box( 0,       y, 1024, 128 - y*2, RGB(y*4, 0, 0) ) : Box( 0, 128 + y, 1024, 128 - y*2, RGB(0, y*4, 0) )
Box( 0, 256 + y, 1024, 128 - y*2, RGB(0, 0, y*4) ) : Next y : StopDrawing() : GrabSprite(1, 0,   0, 1024, 128, #PB_Sprite_Texture) : GrabSprite(2, 0, 128, 1024, 128, #PB_Sprite_Texture) : GrabSprite(3, 0, 256, 1024, 128, #PB_Sprite_Texture)
CreateSprite3D(1, 1) : CreateSprite3D(2, 2) : CreateSprite3D(3, 3) : Repeat : ExamineKeyboard() : k ! Asc(KeyboardInkey()) : ClearScreen( RGB(0, 0, k*100) ) : Start3D() : Sprite3DBlendingMode(5, 7) : DisplaySprite3D(1, 0, 320 + 256*Sin(i.f)) 
DisplaySprite3D(2, 0, 320 + 256*Sin(i + 1.57)) :  DisplaySprite3D(3, 0, 320 + 256*Sin(i + 3.14)) : For y = 0 To h : For x = 0 To w : If m1(x, y)<>0 : ds(64) : EndIf : Next x : Next y : For y = 0 To h2 : For x = 0 To w2 : If m2(x, y)<>0 : ds( h*10 + 96) 
EndIf : Next x : Next y : Stop3D() : i+0.075 : FlipBuffers(1) : Until KeyboardPushed(#PB_Key_Escape) : CloseScreen() : End

Derek · Post by **Derek** » Fri Aug 29, 2008 9:42 pm

Reminds me of the copper bars from the amiga days. Nice.

gildev · Post by **gildev** » Sat Aug 30, 2008 1:08 pm

My first PurePunch:

Code: Select all

InitSprite():InitKeyboard():OpenScreen(640,480,32,"PB"):For i=0 To 7:CreateSprite(i,1,1):StartDrawing(SpriteOutput(i)):Plot(0,0,RGB((i+1)*24+31,(i+1)*24+31,(i+1)*24+31)):StopDrawing():Next i:CreateSprite(8,16,16):StartDrawing(SpriteOutput(8))
Box(0,0,16,16,RGB(127,127,63)):LineXY(0,0,14,0,RGB(200,200,100)):LineXY(0,1,13,1,RGB(200,200,100)):LineXY(0,0,0,14,RGB(200,200,100)):LineXY(1,0,1,13,RGB(200,200,100)):LineXY(1,15,15,15,RGB(63,63,31)):LineXY(2,14,14,14,RGB(63,63,31))
LineXY(15,1,15,15,RGB(63,63,31)):LineXY(14,2,14,15,RGB(63,63,31)):StopDrawing():Dim x.w(400):Dim y.w(400):Dim z.w(400):For i=1 To 400:x(i)=Random(639):y(i)=Random(479):z(i)=Random(7)+1:Next i:c.f=0.0174532925:Repeat:ClearScreen(0)
ExamineKeyboard():StartDrawing(ScreenOutput()):For i=0 To 97:Box(0,i*5,640,5,i*65536):Next i:StopDrawing():For i=1 To 400:DisplaySprite(z(i)-1,x(i),y(i)):If x(i)<640:x(i)=x(i)+z(i):Else:x(i)=0:y(i)=Random(479):EndIf:Next i:b=b+2:If b>=180:b=0
EndIf:Restore D:For k=0 To 3:For j=0 To 4:For i=0 To 3:Read a:If a=1:DisplaySprite(8,160+(i+5*k)*16,300+j*16+100*Sin((b+180+i)*c.f)):EndIf:Next i:Next j:Next k:FlipBuffers():Until KeyboardPushed(#PB_Key_Escape):End
DataSection:D:Data.l 1,1,1,0,1,0,0,1,1,1,1,0,1,0,0,0,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,0,1,1,0,1,1,1,0,1,0,0,1,1,1,1,0,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,0,1,1,1,0,1,0,0,0,1,1,1,1:EndDataSection

And my second:

Code: Select all

InitSprite():InitKeyboard():OpenScreen(640,480,32,"PB"):x=640:t$="PUREBASIC IS THE BEST PROGRAMING LANGUAGE IN THE WORLD!!!":LoadFont(1,"Arial",24):c.f=0.0174532925:xo=320:yo=260:Repeat:FlipBuffers():ClearScreen(RGB(0,0,0)):ExamineKeyboard()
StartDrawing(ScreenOutput()):For i=0 To 24:LineXY(0,i,639,i,RGB(0,120-i*5,0)):Next i:DrawingMode(#PB_2DDrawing_Transparent):DrawingFont(FontID(1)):DrawText(x,-6,t$,RGB(255,255,191)):DrawText(x-1,-5,t$,RGB(255,255,191))
DrawText(x+1,-5,t$,RGB(63,63,31)):DrawText(x,-4,t$,RGB(63,63,31)):DrawText(x,-5,t$,RGB(191,191,127)):a=0-TextWidth(t$):For i=0 To 63:LineXY(0,yo-i,639,yo-i,RGB(0,64-i,0)):LineXY(0,yo+i,639,yo+i,RGB(0,64-i,0)):Next i:For j=0 To 40
If j=40:FrontColor(RGB(255,63,0)):Else:FrontColor(RGB(j*5+10,0,0)):EndIf:Restore DS:x1=-30:y1=-100:For i=1 To 16:Read x2:Read y2:LineXY(xo+x1*Cos((b+j)*c.f),yo+y1*Sin((b+j)*c.f),xo+x2*Cos((b+j)*c.f),yo+y2*Sin((b+j)*c.f)):x1=x2:y1=y2:Next i
Next j:b=b+1:If b>=360:b=0:EndIf:StopDrawing():If x>a:x=x-2:Else:x=640:EndIf:For i=0 To 25:GrabSprite(i+1,0,i,640,1,#PB_Sprite_Memory):Next i:For i=0 To 25:DisplayTranslucentSprite(i+1,0,48-i,i*5):Next i:
Until KeyboardPushed(#PB_Key_Escape):End:DataSection:DS:Data.l 10,-140,150,-140,30,-20,90,-20,50,20,-10,20,-90,100,150,100,110,140,-150,140,-30,20,-90,20,-50,-20,10,-20,90,-100,-30,-100:EndDataSection

Djes is a good intromaker!

blueznl · Post by **blueznl** » Sat Aug 30, 2008 1:24 pm

I would suggest to EXCLUDE comments and indenting from the line / character count. If things should be useful, they should be readable...

Heh, perhaps the first thing to do is write a program that qualifies the submission if they follow the rules

djes · Post by **djes** » Mon Sep 01, 2008 12:40 pm

Blueznl> Dobro, our magnificent French moderator has written a little snippet to remove all the ":" but...

I think we should reduce the whole, as it's way too easy!
What do you think of ... 10 lines of only 79 chars?

eddy · Post by **eddy** » Mon Sep 01, 2008 5:13 pm

Baldrick · Post by **Baldrick** » Fri Sep 05, 2008 2:17 pm

@gildev,
2nd effort of urs is quite cute. Nicely done but u should change it to say "PureBasic - Feel the pure power"

Baldrick · Post by **Baldrick** » Sat Sep 06, 2008 8:15 pm

Think this passes ur requirements.

Code: Select all

   Enumeration 
      #Font1 
      #Sp1 
      #Sp1_3d 
   EndEnumeration 
      #Width=800 
      #Height=600 
      #Depth=32 
      Upper=50 
      Lower=#Height-50 
      Left=50
      Right=#Width-50 
      CentreX=#Width/2 
      CentreY=#Height/2 
      PB$="PureBasic"
      FTPP$="Feel the Pure Power"
Macro Die(Title,Message)  
   MessageRequester(Title,Message) 
   End 
EndMacro 
Macro Frame() 
   StartDrawing(ScreenOutput())   
   DrawingFont(FontID(#Font1)) 
   DrawText(CentreX-(TextWidth(PB$)/2),Upper+18,PB$,RGB(Trans/2,(255-Trans)/2,255-Trans),#Black)
    For a=0 To 10 
     LineXY(Left,Upper+a,Right,Upper+a,RGB(Trans/2,200/(a+1),255-(a*24))) 
     LineXY(Left,Lower-a,Right,Lower-a,RGB(Trans/2,200/(a+1),255-(a*24))) 
     LineXY(Upper+a,Left,Upper+a,Lower,RGB(Trans/4,200/(a+1),255-(a*24))) 
     LineXY(Right-a,Left,Right-a,Lower,RGB(Trans/4,200/(a+1),255-(a*24))) 
    Next 
   DrawingFont(#PB_Default) 
   DrawText(CentreX-(TextWidth(FTPP$)/2),Lower-75,FTPP$,RGB(Trans/2,(255-Trans)/2,255-Trans),#Black)
   StopDrawing() 
EndMacro 
Macro Z() 
   Start3D() 
   ZoomSprite3D(#Sp1_3d,Trans,(Trans/2)+50) 
   DisplaySprite3D(#Sp1_3d,CentreX-(Trans/2),CentreY-(Trans/2)+(Trans/4) ,Trans) 
   Stop3D()
EndMacro 
   If Not InitKeyboard()     
    Die("keyboard", "Initialisation fail") 
   EndIf 
   If Not InitSprite() 
    Die("Sprite", "Initialisation fail") 
   EndIf
   If Not InitSprite3D()
    Die("Sprite3D", "Initialisation fail") 
   EndIf
   If Not LoadFont(#Font1,"Arial",72) 
    Die("Font", "Loading fail") 
   EndIf 
   If Not OpenScreen(#Width,#Height,#Depth,"Screen") 
    Die("Screen","Initialisation fail") 
   EndIf    
   If Not CreateSprite(#Sp1,60,90,#PB_Sprite_Texture) 
    Die("Sprite1","Creation fail")  
     Else 
    StartDrawing(SpriteOutput(#Sp1)) 
    DrawingFont(FontID(#Font1)) 
    DrawText(0,0,"Z",#Red,#Black) 
     For a=0 To 7 
      Line(12,48+a,30,0,#Red) 
     Next 
    Box(6,16,5,10,#Black) 
    Box(51,77,6,10,#Black) 
    StopDrawing() 
     If Not CreateSprite3D(#Sp1_3d,#Sp1) 
      Die("Sprite1_3D","Creation fail") 
     EndIf  
   EndIf 
   Repeat 
    Trans+Trans1
     If Trans>252 
      Trans1=-1  
     ElseIf Trans<1 
      Trans1=3 
     EndIf  
    ExamineKeyboard() 
    ClearScreen(#Black) 
    Frame()  
    Z()  
    FlipBuffers() 
   Until KeyboardPushed(#PB_Key_Escape)

Edit: Added the PureBasic wording stuff

liam · Post by **liam** » Mon Sep 08, 2008 3:43 am

wow, i cant believe you can do so much with such little code in PB!
you guys are sick!

Kaeru Gaman · Post by **Kaeru Gaman** » Mon Sep 08, 2008 7:23 am

Baldrick: the edges are just the wrong way round...

liam wrote:you guys are sick!

no!
... in fact this is kinda ol' hardcore programmas styleround....