Happy 15th PureBasic Birthday PurePunch

Developed or developing a new product in PureBasic? Tell the world about it.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Happy 15th PureBasic Birthday PurePunch

Post by ts-soft »

@ar-s
Very good, i love it Image

Tested on linux!
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
majikeyric
Enthusiast
Enthusiast
Posts: 181
Joined: Mon Oct 21, 2013 5:21 pm
Location: France
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by majikeyric »

Bug Hunt (Happy birthday PB compliant edition)

Image

Eat bugs While avoiding bees!
Test your reflexes And timing in this simple yet addicting romp!
Each 5000 points you reach the next level but it becomes harder !

Use cursor keys.

Download the complete archive : http://majikeyric.free.fr/wordpress/?wp ... 90bGluaw==

and Enjoy!

Code: Select all

;*******************************************************************************
;*
;* Birthday Punch : PureBasic 15 years of happiness
;* PureBasic 5.31
;* 192 lines of 80 chars of code or data as you want
;*
;* Name     : Bug Hunt
;* Author   : Majikeyric
;* Date     : 03/10/2015
;* Notes    : original game by Lazy Brain Games
;* 
;* Eat bugs While avoiding bees!
;* Test your reflexes And timing in this simple yet addicting romp!
;* Each 5000 points you reach the next level but it becomes more and more hard!
;*
;* Controls : Cursor Left/Right/Up/Down - Enter to play
;*******************************************************************************
EnableExplicit:#L=640:#H=480:#NbSprites=41:#NbAnimations=12:#NbNiveaux=10;;;;;;;
#Droite=0:#Gauche=1:Enumeration:#Mouche=1:#Libellule:#Guepe:EndEnumeration;;;;;;
Enumeration:#BoucheFermee:#BoucheOuverte:EndEnumeration:Structure Acteur;;;;;;;;
StructureUnion:Type.i:Etat.i:EndStructureUnion:X.f:Y.i:Direction.i:Anim.i;;;;;;;
CompteurAnim.i:IndiceAnim.i:Sprite.i:EndStructure:Macro init:score=0:gameOver=0;
afficheScore=0:niveau=1:vitesse1=(niveau)*0.8:vitesse2=(niveau)*1.6;;;;;;;;;;;;;
indicePattern=0:ligneInsectes=0:joueur\Etat=#BoucheFermee:joueur\X=300;;;;;;;;;;
joueur\Y=368:joueur\Direction=#Gauche:joueur\Anim=7:joueur\CompteurAnim=1;;;;;;;
joueur\IndiceAnim=1:ClearList(insecteAttrape()):For i=0 To 5:For j=0 To 3;;;;;;;
vagueInsectes(i,j)\Type=0:Next:nbInsectesVague(i)=0:Next;;;;;;;;;;;;;;;;;;;;;;;;
tempoPattern=ElapsedMilliseconds():EndMacro;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Global Dim animations.i(#NbAnimations,16),Dim sprites.i(#NbSprites);;;;;;;;;;;;;
Declare.i Anime(*a.Acteur):Define.b quit:Define.i event:Define.i i,j,x,y,l,h,;;;
points,score,gameOver,afficheScore,niveau,tempoPattern,indicePattern,;;;;;;;;;;;
ligneInsectes:Define.i X1Min,X1Max,Y1Min,Y1Max:Define.i X2Min,X2Max,Y2Min,Y2Max;
Define.i posXLangue,posYLangue:Define.b trouve:Define.s score$;;;;;;;;;;;;;;;;;;
Define.f vitesse1,vitesse2:Define joueur.Acteur;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Define Dim vagueInsectes.Acteur(6,4):Define Dim nbInsectesVague(6);;;;;;;;;;;;;;
Define Dim pattern.i(10,16):Define NewList insecteAttrape.Acteur();;;;;;;;;;;;;;
UseOGGSoundDecoder():If InitKeyboard()=0 Or InitSprite()=0 Or InitSound()=0;;;;;
MessageRequester("Error","Initialization error!",#PB_MessageRequester_Ok):EndIf;
OpenWindow(0,0,0,#L,#H,"Bug Hunt by Majikeyric",;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#PB_Window_SystemMenu|#PB_Window_ScreenCentered):OpenWindowedScreen(WindowID(0),
0,0,#L,#H):LoadSound(0,"a.ogg"):LoadFont(0,"Arial",14,#PB_Font_Bold);;;;;;;;;;;;
TransparentSpriteColor(#PB_Default,$ff00ff):LoadImage(0,"a.bmp");;;;;;;;;;;;;;;;
StartDrawing(ScreenOutput()):DrawImage(ImageID(0),0,0):StopDrawing();;;;;;;;;;;;
Restore dataDeb:For i=0 To #NbSprites:Read.i x:Read.i y:Read.i l:Read.i h;;;;;;;
sprites(i)=GrabSprite(#PB_Any,x,y,l,h):ZoomSprite(sprites(i),2*l,2*h):Next;;;;;;
For i=0 To #NbAnimations-1:For j=0 To 15:Read.i animations(i,j):Next:Next;;;;;;;
For i=1 To #NbNiveaux:For j=0 To 15:Read.i pattern(i,j):Next:Next:PlaySound(0,;;
#PB_Sound_Loop):init:quit=#False:Repeat:Repeat:event=WindowEvent();;;;;;;;;;;;;;
If event=#PB_Event_CloseWindow:quit=#True:EndIf:Until event=0:ExamineKeyboard();
If KeyboardPushed(#PB_Key_Escape):quit=#True:EndIf:If Not gameOver;;;;;;;;;;;;;;
If (ElapsedMilliseconds()-tempoPattern)>250:If nbInsectesVague(ligneInsectes)<4;
tempoPattern=ElapsedMilliseconds():trouve=#False:j=0:While Not trouve;;;;;;;;;;;
If vagueInsectes(ligneInsectes,j)\Type=0:trouve=#True:Else:j+1:EndIf:Wend;;;;;;;
If ligneInsectes&1:vagueInsectes(ligneInsectes,j)\X=-48;;;;;;;;;;;;;;;;;;;;;;;;;
vagueInsectes(ligneInsectes,j)\Direction=#Droite:Else;;;;;;;;;;;;;;;;;;;;;;;;;;;
vagueInsectes(ligneInsectes,j)\X=640:vagueInsectes(ligneInsectes,;;;;;;;;;;;;;;;
j)\Direction=#Gauche:EndIf:vagueInsectes(ligneInsectes,j)\Type=pattern(niveau,;;
indicePattern):vagueInsectes(ligneInsectes,j)\Y=8+16+ligneInsectes*48;;;;;;;;;;;
vagueInsectes(ligneInsectes,j)\Anim=(vagueInsectes(ligneInsectes,j)\Type-1)*2+;;
vagueInsectes(ligneInsectes,j)\Direction:vagueInsectes(ligneInsectes,;;;;;;;;;;;
j)\CompteurAnim=1:vagueInsectes(ligneInsectes,j)\IndiceAnim=1;;;;;;;;;;;;;;;;;;;
nbInsectesVague(ligneInsectes)+1:indicePattern+1:indicePattern%16:ligneInsectes+
1:ligneInsectes%6:EndIf:EndIf:For i=0 To 5:For j=0 To 3:If vagueInsectes(i,;;;;;
j)\Type<>0:Anime(@vagueInsectes(i,j)):If vagueInsectes(i,j)\Direction=#Droite;;;
If vagueInsectes(i,j)\Type=#Libellule:vagueInsectes(i,j)\X+vitesse2:Else;;;;;;;;
vagueInsectes(i,j)\X+vitesse1:EndIf:If vagueInsectes(i,j)\X>640:vagueInsectes(i,
j)\Type=0:nbInsectesVague(i)-1:EndIf:Else:If vagueInsectes(i,j)\Type=#Libellule;
vagueInsectes(i,j)\X-vitesse2:Else:vagueInsectes(i,j)\X-vitesse1:EndIf;;;;;;;;;;
If vagueInsectes(i,j)\X<-48:vagueInsectes(i,j)\Type=0:nbInsectesVague(i)-1:EndIf
EndIf:EndIf:Next:Next:If KeyboardPushed(#PB_Key_Right);;;;;;;;;;;;;;;;;;;;;;;;;;
If joueur\Direction=#Gauche:joueur\Direction=#Droite:joueur\X-12;;;;;;;;;;;;;;;;
If joueur\Etat=#BoucheFermee:joueur\Anim=6:Else:joueur\Anim=8:EndIf;;;;;;;;;;;;;
joueur\CompteurAnim=1:Else:joueur\X+8:If joueur\X>640-48:joueur\X=640-48:EndIf;;
EndIf:EndIf:If KeyboardPushed(#PB_Key_Left):If joueur\Direction=#Droite;;;;;;;;;
joueur\Direction=#Gauche:joueur\X+12:If joueur\Etat=#BoucheFermee:joueur\Anim=7;
Else:joueur\Anim=9:EndIf:joueur\CompteurAnim=1:Else:joueur\X-8:If joueur\X<0;;;;
joueur\X=0:EndIf:EndIf:EndIf:Select joueur\Etat:Case #BoucheFermee;;;;;;;;;;;;;;
If KeyboardPushed(#PB_Key_Up):joueur\Etat=#BoucheOuverte;;;;;;;;;;;;;;;;;;;;;;;;
If joueur\Direction=#Droite:joueur\Anim=8:posXLangue=joueur\X+26:Else;;;;;;;;;;;
joueur\Anim=9:posXLangue=joueur\X+6:EndIf:joueur\CompteurAnim=1;;;;;;;;;;;;;;;;;
joueur\IndiceAnim=1:posYLangue=joueur\Y-13:Points=0:EndIf:Case #BoucheOuverte;;;
If KeyboardPushed(#PB_Key_Up):posYLangue-16:If posYLangue<0:posYLangue=0:EndIf;;
EndIf:If KeyboardPushed(#PB_Key_Down):posYLangue+16:If posYLangue>joueur\Y-13;;;
joueur\Etat=#BoucheFermee:If joueur\Direction=#Droite:joueur\Anim=6:Else;;;;;;;;
joueur\Anim=7:EndIf:joueur\CompteurAnim=1:joueur\IndiceAnim=1:score+points;;;;;;
If (niveau<(#NbNiveaux-1)) And ((score/5000)+1=niveau+1):niveau+1;;;;;;;;;;;;;;;
vitesse1=(niveau)*0.8:vitesse2=(niveau)*1.6:EndIf:EndIf:EndIf;;;;;;;;;;;;;;;;;;;
If joueur\Direction=#Droite:posXLangue=joueur\X+26:Else:posXLangue=joueur\X+6;;;
EndIf:ForEach insecteAttrape():insecteAttrape()\X=posXLangue-16;;;;;;;;;;;;;;;;;
If insecteAttrape()\Y<posYLangue:insecteAttrape()\Y=posYLangue;;;;;;;;;;;;;;;;;;
If insecteAttrape()\Y>joueur\Y-12:DeleteElement(insecteAttrape()):EndIf:EndIf;;;
Next:EndSelect:If joueur\Etat=#BoucheOuverte:X1Min=posXLangue+4;;;;;;;;;;;;;;;;;
X1Max=posXLangue+16-4:Y1Min=posYLangue:Y1Max=posYLangue+384-1:For i=0 To 5;;;;;;
For j=0 To 3:If vagueInsectes(i,j)\Type<>0:X2Min=vagueInsectes(i,j)\X;;;;;;;;;;;
Y2Min=vagueInsectes(i,j)\Y+12:X2Max=vagueInsectes(i,j)\X+48-1;;;;;;;;;;;;;;;;;;;
Y2Max=vagueInsectes(i,j)\Y+48-1:If Not (X1Min>X2Max Or X1Max<X2Min Or;;;;;;;;;;;
Y1Min>Y2Max Or Y1Max<Y2Min):If vagueInsectes(i,j)\Type=#Guepe:gameOver=1;;;;;;;;
If joueur\Direction=#Droite:joueur\Anim=10:Else:joueur\Anim=11:EndIf:Else;;;;;;;
AddElement(insecteAttrape()):insecteAttrape()\Sprite=vagueInsectes(i,j)\Sprite;;
If vagueInsectes(i,j)\Direction=#Droite:insecteAttrape()\X=posXLangue-24:Else;;;
insecteAttrape()\X=posXLangue-16:EndIf:If vagueInsectes(i,j)\Y<posYLangue;;;;;;;
insecteAttrape()\Y=posYLangue:Else:insecteAttrape()\Y=vagueInsectes(i,j)\Y:EndIf
If vagueInsectes(i,j)\Type=#Mouche:points+100:Else:Points+500:EndIf;;;;;;;;;;;;;
vagueInsectes(i,j)\Type=0:nbInsectesVague(i)-1:EndIf:EndIf:EndIf:Next:Next:EndIf
EndIf:DisplaySprite(sprites(28),0,0):If Not afficheScore:For i=0 To 5;;;;;;;;;;;
For j=0 To 3:If vagueInsectes(i,j)\Type<>0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DisplayTransparentSprite(vagueInsectes(i,j)\Sprite,vagueInsectes(i,j)\X,;;;;;;;;
vagueInsectes(i,j)\Y):EndIf:Next:Next:If Anime(@joueur) And gameOver;;;;;;;;;;;;
afficheScore=1:EndIf:If joueur\Etat=#BoucheOuverte And Not gameOver;;;;;;;;;;;;;
DisplayTransparentSprite(sprites(27),posXLangue,posYLangue);;;;;;;;;;;;;;;;;;;;;
ForEach insecteAttrape():DisplayTransparentSprite(insecteAttrape()\Sprite,;;;;;;
insecteAttrape()\X,insecteAttrape()\Y):Next:EndIf;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DisplayTransparentSprite(joueur\Sprite,joueur\X,joueur\Y);;;;;;;;;;;;;;;;;;;;;;;
DisplaySprite(sprites(29),0,416):StartDrawing(ScreenOutput());;;;;;;;;;;;;;;;;;;
DrawingMode(#PB_2DDrawing_Transparent):DrawingFont(FontID(0)):score$=Str(score);
DrawText(84,445,RSet(Str(niveau),2,"0"),$48f8):DrawText(496+;;;;;;;;;;;;;;;;;;;;
((48-TextWidth(score$))/2),445,score$,$48f8):StopDrawing():Else;;;;;;;;;;;;;;;;;
DisplayTransparentSprite(sprites(31),128,64):DisplaySprite(sprites(30),0,416);;;
score$=RSet(Str(score),6,"0"):For i=1 To 6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DisplayTransparentSprite(sprites(Asc(Mid(score$,i,1))-16),i*64+66,216):Next;;;;;
If KeyboardPushed(#PB_Key_Return):init:EndIf:EndIf:FlipBuffers():Until quit:End;
Procedure.i Anime(*a.Acteur):Protected.i f,a:f=0:*a\CompteurAnim-1;;;;;;;;;;;;;;
If*a\CompteurAnim=0:a=*a\Anim:*a\CompteurAnim=animations(a,0);;;;;;;;;;;;;;;;;;;
*a\Sprite=sprites(animations(a,*a\IndiceAnim)):*a\IndiceAnim+1:If animations(a,;
*a\IndiceAnim)=0:f=1:*a\IndiceAnim=1:EndIf:EndIf:ProcedureReturn f:EndProcedure;
DataSection: dataDeb:
Data.i 0,0,1,1:Data.i 0,0,24,24:Data.i 24,0,24,24:Data.i 48,
0,24,24:Data.i 72,0,24,24:Data.i 0,24,24,24:Data.i 24,24,24,24:Data.i 0,48,24,24
Data.i 24,48,24,24:Data.i 48,48,24,24:Data.i 72,48,24,24:Data.i 96,48,24,24;;;;;
Data.i 120,48,24,24:Data.i 144,48,24,24:Data.i 168,48,24,24:Data.i 0,72,24,24;;;
Data.i 24,72,24,24:Data.i 48,72,24,24:Data.i 72,72,24,24:Data.i 0,96,24,24;;;;;;
Data.i 24,96,24,24:Data.i 48,96,24,24:Data.i 72,96,24,24:Data.i 0,120,24,24;;;;;
Data.i 24,120,24,24:Data.i 48,120,24,24:Data.i 72,120,24,24:Data.i 312,0,8,192;;
Data.i 320,0,320,208:Data.i 320,208,320,32:Data.i 320,240,320,32:Data.i 0,192,;;
192,32:Data.i 0,224,32,32:Data.i 32,224,32,32:Data.i 64,224,32,32:Data.i 96,224,
32,32:Data.i 128,224,32,32:Data.i 160,224,32,32:Data.i 192,224,32,32:Data.i 224,
224,32,32:Data.i 256,224,32,32:Data.i 288,224,32,32:Data.i 10,15,16,0,0,0,0,0,0,
0,0,0,0,0,0,0:Data.i 10,17,18,0,0,0,0,0,0,0,0,0,0,0,0,0:Data.i 10,23,24,0,0,0,0,
0,0,0,0,0,0,0,0,0:Data.i 10,25,26,0,0,0,0,0,0,0,0,0,0,0,0,0:Data.i 10,19,20,0,0,
0,0,0,0,0,0,0,0,0,0,0:Data.i 10,21,22,0,0,0,0,0,0,0,0,0,0,0,0,0:Data.i 10,4,4,4,
4,4,4,3,4,3,4,4,4,4,4,0:Data.i 10,1,1,1,1,1,1,2,1,2,1,1,1,1,1,0:Data.i 10,6,0,0,
0,0,0,0,0,0,0,0,0,0,0,0:Data.i 10,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0:Data.i 10,11,12,
13,14,11,12,13,14,11,12,13,14,0,0,0:Data.i 10,7,8,9,10,7,8,9,10,7,8,9,10,0,0,0;;
Data.i 1,1,1,3,1,1,3,2,1,1,1,2,3,1,1,1:Data.i 1,1,1,3,1,1,3,2,1,3,1,2,3,1,1,1;;;
Data.i 1,1,1,3,1,1,3,2,3,3,1,2,3,1,1,1:Data.i 1,3,1,3,1,1,3,2,3,3,1,2,3,1,1,1;;;
Data.i 1,3,1,3,1,1,3,2,3,3,1,3,3,1,1,1:Data.i 1,3,1,3,1,1,3,2,3,3,1,3,3,1,1,3;;;
Data.i 1,3,1,3,1,3,1,3,1,3,1,3,1,3,1,3:Data.i 3,3,1,3,3,1,3,3,3,1,3,3,2,3,3,3;;;
Data.i 3,1,3,3,3,3,1,3,3,3,3,3,3,3,3,3:Data.i 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3;;;
EndDataSection;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Happy 15th PureBasic Birthday PurePunch

Post by davido »

@majikeyric,

Very nice game. Thank you. :D
I downloaded your game a few days ago when you first posted it.
I was a bit surprised when it disappeared. Glad you re-posted.
DE AA EB
User avatar
majikeyric
Enthusiast
Enthusiast
Posts: 181
Joined: Mon Oct 21, 2013 5:21 pm
Location: France
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by majikeyric »

Thanks Davido :)
Yes I had to apply a small patch to respect the rules of the contest.
User avatar
ar-s
Enthusiast
Enthusiast
Posts: 340
Joined: Sat Oct 06, 2007 11:20 pm
Location: France

Re: Happy 15th PureBasic Birthday PurePunch

Post by ar-s »

Thanks dudes,
i hope more people than us will create a little stuff for this event. Even just for us :)
@majikeyric, the little dino looks like a bubble bobble hero. (good remember)
~Ar-S~
My Image Hoster for PB users
My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 3.x / 5.7x / 6 - W11 x64 - Ryzen 7 3700x / #Rpi4

Code: Select all

r3p347 : 7ry : un71l d0n3 = 1
User avatar
majikeyric
Enthusiast
Enthusiast
Posts: 181
Joined: Mon Oct 21, 2013 5:21 pm
Location: France
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by majikeyric »

ar-s wrote:@majikeyric, the little dino looks like a bubble bobble hero. (good remember)
You are the second telling me this (bubble bobble) :mrgreen:

In fact it is a frog :D
User avatar
ar-s
Enthusiast
Enthusiast
Posts: 340
Joined: Sat Oct 06, 2007 11:20 pm
Location: France

Re: Happy 15th PureBasic Birthday PurePunch

Post by ar-s »

Dinos & frogs are alike, especially in 8/16bits :mrgreen:
~Ar-S~
My Image Hoster for PB users
My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 3.x / 5.7x / 6 - W11 x64 - Ryzen 7 3700x / #Rpi4

Code: Select all

r3p347 : 7ry : un71l d0n3 = 1
firace
Addict
Addict
Posts: 902
Joined: Wed Nov 09, 2011 8:58 am

Re: Happy 15th PureBasic Birthday PurePunch

Post by firace »

@majikeyric
Wow I didn't expect this to be so good!
Amazing what can be done with so little code.

I've always liked your contributions to this forum as they remind me of my good old (C64) days...

(My high score after a few minutes: 10400) ;)
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2058
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by Andre »

Very nice, majikeyric! :D

The game runs on MacOS too.
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
User avatar
majikeyric
Enthusiast
Enthusiast
Posts: 181
Joined: Mon Oct 21, 2013 5:21 pm
Location: France
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by majikeyric »

Thanks for the kind words :D

Glad to know that it works on Mac OS too!

For me the good old days belong to the present because I'm still very active on retro platforms 8)
User avatar
deseven
Enthusiast
Enthusiast
Posts: 362
Joined: Wed Jan 12, 2011 3:48 pm
Location: Serbia
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by deseven »

TazNormand wrote:
Limit date is shifted to 15 november 2015, 23:59 (11:59 PM) due to lack of competitors (in french and in english forums), so if you needed more time, or if you were hesitating, you can now go on
Thanks, that's really nice because i'm kinda busy with other things.

a little teaser
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: Happy 15th PureBasic Birthday PurePunch

Post by walbus »

Code: Select all

*****************************************************************************
;*
;* Birthday Punch : PureBasic 15 years of happiness
;* PureBasic 5.xx
;* 192 lines of 80 chars of code or data as you want
;*
;* Name     :  Simple Snow
;* Author   : Werner Albus
;* Date     : D17 : M10 : Y2015
;* Notes    : Simple Snow with nice effekts and accumulation
;*
;*****************************************************************************

; Simple snow - by Werner Albus - http://www.quick-aes-256.de - http://www.nachtoptik.de

Define b_snow_add_yy_y.f ,b_snow_add_yy_yy.f ,flakes.f ,flakes_1.f
flakes_start=1       ; Fleakes to start
flakes_max=3000      ; Fleakes max
flakes_1=1.0         ; Rate of increase in snow (float number)
animation_speed=70   ; Animation speed
fall_speed=1         ; <rate of fall
win_x=800            ; Win x
win_y=600            ; Winy
flakes=flakes_start
Global timer_event_1
Procedure timer_events():Select EventTimer()
      Case 1:timer_event_1=1:EndSelect:EndProcedure
ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-win_x/2,
           DesktopHeight(0)/2-win_y/2,win_x,win_y,"Dancing Snow")
If InitSprite() = 0 Or InitKeyboard() = 0 Or 
   OpenWindowedScreen(WindowID(0),0,0,
                      win_x,win_y,0,0,0,#PB_Screen_WaitSynchronization) = 0
MessageRequester("Error", "Can not init Spritesystem",0):End:EndIf
AddWindowTimer(0,1,animation_speed):BindEvent(#PB_Event_Timer,@timer_events())
CreateImage (0,win_x,win_y) ; Create Background
StartDrawing(ImageOutput (0))
DrawingMode ( #PB_2DDrawing_Gradient )
BackColor (0)
FrontColor ($FF901E)
LinearGradient (0,-300,0,1500)
Box (0,0,win_x,win_y)
StopDrawing()
Dim flake (flakes_max,2)
Dim settle(win_x)      ; Addon - settle a little Snow
Dim settle_hat(200)    ; Addon - settle a little Snow on the Hat
For i=0 To flakes_max:flake(i,0)=Random(win_x)
flake(i,1)=-Random(win_y):Next i
Repeat
  If timer_event_1
    timer_event_1=0
    FlipBuffers ()
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(0),0,0)
    Circle(450,win_y-75,15,$EFEFEF) ; Addon - Simple Snowman :-)
    Circle(450,win_y-50,20,$EFEFEF):Circle(450,win_y-72,6,0)
    Circle(450,win_y-75,7,$EFEFEF):Circle(450,win_y-75,2,$0045FF)
    Circle(450,win_y-25,30,$EFEFEF):Circle(450,win_y-55,1,0)
    Circle(443,win_y-80,1,0):Circle(457,win_y-80,1,0)
    Circle(450,win_y-50,1,0):Circle(450,win_y-45,1,0)
    Circle(450,win_y-30,1,0):Circle(450,win_y-25,1,0) ; ----
    If flakes<flakes_max:flakes+flakes_1
    If flakes>flakes_max:flakes=flakes_max:EndIf:EndIf
    For i=0 To flakes:flake(i,0)+-Random(2)+1
      If flake(i,0)>win_x+5:flake(i,0)=Random(win_x):EndIf
      If flake(i,0)<-5:flake(i,0)=Random(win_x):EndIf
      If flake(ii,0)>win_x+5:flake(ii,0)=Random(win_x):EndIf
      If flake(ii,0)<-5:flake(ii,0)=Random(win_x):EndIf
      Select Random(3)
        Case 0:Circle(flake(i,0)+Random(1),flake(i,1)+snow_add_y,Random(1)) 
        Case 1:Circle(flake(i,0)+Random(1),flake(i,1)+snow_add_y,Random(1),$A9A9A9)
        Case 2,3:Circle(flake(i,0)+Random(1),flake(i,1)+snow_add_y,0)
      EndSelect
      flake(i,1)+Random(fall_speed+1)
    If flake(i,1)>win_y:flake(i,1)=0:EndIf:Next i 
    For ii=1 To win_x-1 ; Addon - settle a little Snow -------------
      If Point(ii,win_y-2)=$FFFFFF:settle(ii)=1 :EndIf
      If settle(ii):Circle(ii,win_y-1,1) :EndIf
    Next ii
    For ii = 1 To 3:settle(Random(win_x))=0:Next ii ;--------
    For ii=1 To 26 ; Addon - settle a little Snow on the Hat --
      If Point(ii+436,win_y-100)=$FFFFFF:settle_hat(ii)=1:EndIf
    If settle_hat(ii):Circle(ii+436,win_y-99,1):EndIf:Next ii
    settle_hat(Random(200))=0 ;---------------------------------
    Box(437,win_y-98,26,15,$828282) ;-- Addon Snowman´s Hat --
    StopDrawing()
  EndIf
  Repeat:event=WindowEvent():Select event:Case #PB_Event_CloseWindow :quit=1
EndSelect:Until event=0:Until quit
Last edited by walbus on Sun Oct 18, 2015 1:59 pm, edited 1 time in total.
User avatar
ar-s
Enthusiast
Enthusiast
Posts: 340
Joined: Sat Oct 06, 2007 11:20 pm
Location: France

Re: Happy 15th PureBasic Birthday PurePunch

Post by ar-s »

Nice walbus
~Ar-S~
My Image Hoster for PB users
My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 3.x / 5.7x / 6 - W11 x64 - Ryzen 7 3700x / #Rpi4

Code: Select all

r3p347 : 7ry : un71l d0n3 = 1
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Happy 15th PureBasic Birthday PurePunch

Post by RSBasic »

@walbus
Can you use code button, please?
And here: http://www.purebasic.fr/english/viewtop ... 59#p474659
Thank you. :)
Image
Image
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: Happy 15th PureBasic Birthday PurePunch

Post by walbus »

Oops, oversight, bushed....
Post Reply