Happy 15th PureBasic Birthday PurePunch
Re: Happy 15th PureBasic Birthday PurePunch
@ar-s
Very good, i love it
Tested on linux!
Very good, i love it
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.
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
- majikeyric
- Enthusiast
- Posts: 181
- Joined: Mon Oct 21, 2013 5:21 pm
- Location: France
- Contact:
Re: Happy 15th PureBasic Birthday PurePunch
Bug Hunt (Happy birthday PB compliant edition)
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!
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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Re: Happy 15th PureBasic Birthday PurePunch
@majikeyric,
Very nice game. Thank you.
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.
Very nice game. Thank you.
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
- majikeyric
- Enthusiast
- Posts: 181
- Joined: Mon Oct 21, 2013 5:21 pm
- Location: France
- Contact:
Re: Happy 15th PureBasic Birthday PurePunch
Thanks Davido
Yes I had to apply a small patch to respect the rules of the contest.
Yes I had to apply a small patch to respect the rules of the contest.
Re: Happy 15th PureBasic Birthday PurePunch
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)
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
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
- majikeyric
- Enthusiast
- Posts: 181
- Joined: Mon Oct 21, 2013 5:21 pm
- Location: France
- Contact:
Re: Happy 15th PureBasic Birthday PurePunch
You are the second telling me this (bubble bobble)ar-s wrote:@majikeyric, the little dino looks like a bubble bobble hero. (good remember)
In fact it is a frog
Re: Happy 15th PureBasic Birthday PurePunch
Dinos & frogs are alike, especially in 8/16bits
~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
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
Re: Happy 15th PureBasic Birthday PurePunch
@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)
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)
- Andre
- PureBasic Team
- Posts: 2058
- Joined: Fri Apr 25, 2003 6:14 pm
- Location: Germany (Saxony, Deutscheinsiedel)
- Contact:
Re: Happy 15th PureBasic Birthday PurePunch
Very nice, majikeyric!
The game runs on MacOS too.
The game runs on MacOS too.
- majikeyric
- Enthusiast
- Posts: 181
- Joined: Mon Oct 21, 2013 5:21 pm
- Location: France
- Contact:
Re: Happy 15th PureBasic Birthday PurePunch
Thanks for the kind words
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
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
Re: Happy 15th PureBasic Birthday PurePunch
Thanks, that's really nice because i'm kinda busy with other things.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
a little teaser
Re: Happy 15th PureBasic Birthday PurePunch
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.
Re: Happy 15th PureBasic Birthday PurePunch
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
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
- RSBasic
- Moderator
- Posts: 1218
- Joined: Thu Dec 31, 2009 11:05 pm
- Location: Gernsbach (Germany)
- Contact:
Re: Happy 15th PureBasic Birthday PurePunch
@walbus
Can you use code button, please?
And here: http://www.purebasic.fr/english/viewtop ... 59#p474659
Thank you.
Can you use code button, please?
And here: http://www.purebasic.fr/english/viewtop ... 59#p474659
Thank you.