PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PurePunch contest #1

https://www.purebasic.fr/english/viewtopic.php?t=33883

Page 2 of 5

Posted: Tue Aug 26, 2008 7:37 pm
by Rook Zimbabwe
idel... I get a small pic then the hourglass and it crunks!

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

Posted: Tue Aug 26, 2008 7:39 pm
by Derek
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.

Posted: Tue Aug 26, 2008 11:56 pm
by HeX0R
/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

Posted: Wed Aug 27, 2008 12:13 am
by djes
Derek> Could be really useful in fact!
HeXor> It's dedicated to me? Sort of provocation as I just finished Purebreaker 3? :P

Posted: Thu Aug 28, 2008 8:01 pm
by djes
Don't forget to see also on the french forum, there's nice ones : http://www.purebasic.fr/french/viewtopi ... highlight= :D

Posted: Fri Aug 29, 2008 9:25 pm
by djes

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

Posted: Fri Aug 29, 2008 9:42 pm
by Derek
Reminds me of the copper bars from the amiga days. Nice. :D

Posted: Sat Aug 30, 2008 1:08 pm
by gildev
My first PurePunch:
Image

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:
Image

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! :wink:

Posted: Sat Aug 30, 2008 1:24 pm
by blueznl
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 :-)

Posted: Mon Sep 01, 2008 12:40 pm
by djes
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? :)

Posted: Mon Sep 01, 2008 5:13 pm
by eddy
:wink:

Image

Posted: Fri Sep 05, 2008 2:17 pm
by Baldrick
@gildev,
2nd effort of urs is quite cute. Nicely done but u should change it to say "PureBasic - Feel the pure power" :mrgreen:

Posted: Sat Sep 06, 2008 8:15 pm
by Baldrick
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

Posted: Mon Sep 08, 2008 3:43 am
by liam
wow, i cant believe you can do so much with such little code in PB!
you guys are sick! :shock:

Posted: Mon Sep 08, 2008 7:23 am
by Kaeru Gaman
Baldrick: the edges are just the wrong way round...
liam wrote:you guys are sick! :shock:
no!
... in fact this is kinda ol' hardcore programmas styleround....
All times are UTC+01:00
Page 2 of 5

Powered by phpBB® Forum Software © phpBB Limited