PureBasic Forums - English

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

Snowman by the Lake

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

Page 1 of 1

Snowman by the Lake

Posted: Mon Dec 23, 2013 8:49 am
by BasicallyPure
Lake scenery with snowman and trees, showing reflection in water.
Animated snowflakes.
This should work on all operating systems but it doesn't on Linux for some reason.

Press 'Space' to generate new scenery.
Press 'Escape' to end.

Sample screen capture, click to enlarge image.
Image

Code: Select all

; Snowman by the Lake
; by BasicallyPure
; 01.09.2014
; PB 5.21 
;
; thanks to walbus for the snowman
; thanks to J. Baker for the snowflake
;
; press 'Escape' to end
; press 'Space' to generate new scenery

EnableExplicit

#MainWin    = 0
#MaxFlakes  = 250
#BackSprite = 0
;images
#MoonImage  = 0
#SmallTree  = 1
#LargeTree  = 2
;
#Smooth     = 64 ; must be power of 2, shoreline smoothing

Structure SnowCalculations
   SnowX.d
   SnowY.d
   SnowS.i ; flake size
   SnowV.d ; Y velocity
EndStructure

Global Dim Snow.SnowCalculations(#MaxFlakes)
Global Xmax, Ymax
Global Dim Shore(0)

Procedure MOVE_SNOW()
   Static SnowSprite.i, wind.d, windScale.d, bias.i = 15
   
   windScale + Random(32) - bias
   If windScale > 1500 : bias = 17 : EndIf
   If windScale < -300 : bias = 15 : EndIf
   
   wind = windScale / 4000
   
   DisplaySprite(#BackSprite,0,0)
   
   For SnowSprite = 1 To #MaxFlakes
      With Snow(SnowSprite)
         
         DisplayTransparentSprite(SnowSprite, \SnowX, \SnowY, Random(255, 64)) ; twinkle effect
         RotateSprite(SnowSprite, 0.2 * \SnowS, #PB_Relative)
         
         \SnowX + wind *\SnowS
         \SnowY + \SnowV
         
         If \SnowX > Xmax : \SnowX = 0 : EndIf
         If \SnowX < 0 : \SnowX = Xmax : EndIf
         
         If \SnowY > Ymax ; if the snow reaches the bottom, send back to top
            \SnowY = 0
            \SnowX = Random(Xmax)
            \SnowS = Random(14, 2) ;snow size
            \SnowV = \SnowS / 6 
            ZoomSprite(SnowSprite, \SnowS, \SnowS)
         EndIf
         
      EndWith
   Next SnowSprite
EndProcedure

Procedure CREATE_TREE(nImg)
   Static treeWidth = 250, treeHeight = 350
   Protected x, y, n, midX, Ylim, Xlim, lx, ux
   Protected dev = 2
   Protected trunkHeight = 30 + Random(20)
   Protected seglim = 11
   Protected tc = $FF081808 + (nImg<<1 * $08)<< 8 + Random($10)<<8 + Random($10)<<16 + Random($10)
   
   If IsImage(nImg) : FreeImage(nImg) : EndIf
   CreateImage(nImg,TreeWidth,TreeHeight,32,#PB_Image_Transparent)
   
   StartDrawing(ImageOutput(nImg))
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      midX = OutputWidth()/2
      Ylim = OutputHeight()- trunkHeight
      Xlim = OutputWidth() - 1
      
      Repeat
         While dev < seglim
            lx = midX-dev : If lx < 0    : lx = 0    : EndIf
            ux = midX+dev : If ux > Xlim : ux = Xlim : EndIf
            For x = lx To ux
               Plot(x,y, tc + Random(16)<<16 + Random(32)<<8 + Random(16))
            Next x
            Plot(lx,y,$FF002000) : Plot(ux,y,$FF002000) ; tree outline
            y+1
            If y > Ylim : Break 2 : EndIf
            dev + Random(8) - 3
            If dev < 2 : dev = 4 + Random(2): EndIf
         Wend
         dev * 0.8
         seglim + 6
      ForEver
      
      Box(midX-10,Ylim,20,trunkHeight,$FF001126)
   StopDrawing()
   
   If nImg = #SmallTree ; make tree smaller
      ResizeImage(nImg,TreeWidth >> 1,TreeHeight >> 1,#PB_Image_Raw)
   EndIf
EndProcedure

Procedure SNOWMAN(x,y)
   Static sc = $D2D2D2
   Circle(x,y-75,15,sc)  ; Addon - Simple Snowman :-)
   Circle(x,y-50,20,sc)  : Circle(x,y-72,6,0)
   Circle(x,y-75,7, sc)  : Circle(x,y-75,2,$45FF)
   Circle(x,y-25,30,sc)  : Circle(x,y-55,1,0)
   Circle(x-7,y-80,1,0)  : Circle(x+7,y-80,1,0)
   Circle(x,y-50, 1, 0)  : Circle(x,y-45,1,0)
   Circle(x,y-30, 1, 0)  : Circle(x,y-25,1,0)
   Box(x-25,y-90,50,3,0) : Box(x-10,y-110,20,20,0)
EndProcedure
   
Procedure DRAW_BACKSPRITE()
   Static a,b,d,i,s,x,yy,tImg
   Static Dim SM(#Smooth-1), mask = #Smooth-1
   Protected bias=3, t=$EC0FEC, m=Ymax/3, y=m
   Protected AvgIdx, AvgSum, ShoreAv
   
   Macro SetBoundaries()
      a = m-Random(40/d,5) : b = m+Random(80/d,5)
   EndMacro
   
   StartDrawing(SpriteOutput(#BackSprite))
      Box(0,0,Xmax,Ymax,$280000)
      
      For x = 1 To 500 ; stars
         i=Random(255,32)
         Plot(Random(Xmax),Random(Ymax>>1),RGB(i,i,i))
      Next x
      
      DrawAlphaImage(ImageID(#MoonImage),Random(Xmax-80),Random(Ymax>>2,80))
      
      For d = 1 To 4 : s = 5-d
         t = (t + $191019) & $FFFFFF
         SetBoundaries()
         
         For x = 0 To Xmax
            If d < 4
               For yy = y To Ymax
                  Plot(x,yy,t!(Random(15)<<16+Random(15)<<8+Random(15)))
               Next yy
            Else ; draw shore line
               AvgSum - SM(AvgIDX & mask)
               SM(AvgIDX & mask) = y
               AvgSum + y
               AvgIDX + 1
               ShoreAv = AvgSum / #Smooth ; this is the moving average
               Shore(x) = ShoreAv : Plot(x,ShoreAv,0) ; draw & store the shore line
            EndIf
            y + s * Sign(Random(8) - bias)
            If y < 0 : y = 0 : EndIf
            If y > b
               bias = 5
               SetBoundaries()
            ElseIf y < a
               bias = 3
               SetBoundaries()
            EndIf
         Next x
         
         m + (Ymax - m) * 0.15
         y = m
         
         If d < 3 ; add some trees
            For i = 1 To Random(24-d*8,12-d*4)
               If d = 1
                  tImg = #SmallTree
               Else
                  tImg = #LargeTree
               EndIf
               StopDrawing() : CREATE_TREE(tImg) : StartDrawing(SpriteOutput(#BackSprite))
                  
               DrawAlphaImage(ImageID(tImg),Random(Xmax-ImageWidth(tImg)),y-ImageHeight(tImg) + Random(80,40))
            Next i
         EndIf
         
         If d = 3 ; initalize smoothing buffer
            For i = 0 To mask : SM(i) = y : Next i
            AvgSum = y * #Smooth
         EndIf
      Next d
      
      x = 50 + Random(Xmax-100)
      SNOWMAN(x,Shore(x)-15)
      
      For x = 0 To Xmax ; mirror
         For y = Shore(x)+1 To Ymax
            d = Shore(x)<<1 - y
            If d < 0 : d = 0 : EndIf
            t = Point(x,d)
            Plot(x,y,RGB(Red(t)*0.7,Green(t)*0.7,Blue(t)|$10*0.7))
         Next y
      Next x
      
   StopDrawing()
   
EndProcedure

Procedure INIT_GUI()
   Protected SnowSprite, nImg, dw, dh, hWin
   ExamineDesktops() : dw = DesktopWidth(0) : dh = DesktopHeight(0)
   hWin = OpenWindow(#MainWin,0,0,dw,dh,"Snow",#PB_Window_BorderLess)
   
   If hWin <> 0
      If InitSprite()=0 Or InitKeyboard()=0 Or OpenWindowedScreen(hWin,0,0,dw, dh)=0
         hWin = 0
      Else
         Xmax = dw - 1 : Ymax = dh - 1
         UsePNGImageDecoder()
         
         ReDim Shore(Xmax)
         
         CompilerIf #PB_Compiler_OS = #PB_OS_Windows
            SetCursorPos_(dw,0)
         CompilerEndIf
         
         ; create the snow sprites
         For SnowSprite = 1 To #MaxFlakes
            CatchSprite(SnowSprite, ?flake_png_start, #PB_Sprite_AlphaBlending)
            With Snow(SnowSprite)
               \SnowX = Random(Xmax)
               \SnowY = Random(Ymax)
               \SnowS = Random(14, 2) ;snow size
               \SnowV = \SnowS / 6    ; velocity proportional to size
               ZoomSprite(SnowSprite, \SnowS, \SnowS)
            EndWith
         Next SnowSprite
         
         CatchImage(#MoonImage,?moon_png_start)
         
         CreateSprite(#BackSprite,Xmax+1,Ymax+1)
         DRAW_BACKSPRITE()
         
      EndIf
   EndIf
   
   ProcedureReturn hWin
   
EndProcedure

Procedure EVENT_LOOP()
   Protected event, run = #True
   
   While run = #True
      ExamineKeyboard()
      
      If KeyboardPushed(#PB_Key_Escape)
         run = #False
      EndIf
      
      If KeyboardReleased(#PB_Key_Space)
         DRAW_BACKSPRITE()
      EndIf
      
      Repeat
         event = WindowEvent()
         If event = #PB_Event_CloseWindow
            run = #False
         EndIf
      Until event = 0
      
      MOVE_SNOW()
      FlipBuffers()
   Wend
   
EndProcedure

If INIT_GUI()
   EVENT_LOOP()
EndIf

DataSection
   flake_png_start:
   ; size : 1244 bytes
   Data.q $0A1A0A0D474E5089,$524448490D000000,$2000000020000000,$7A7A730000000608,$47527301000000F4
   Data.q $0000E91CCEAE0042,$FF0044474B620600,$93A7BDA0FF00FF00,$7359487009000000,$130B0000130B0000
   Data.q $000000189C9A0001,$0ADA07454D497407,$5EC42DDA3B31121B,$544144495C040000,$55946C4B97BDC358
   Data.q $A74ED37EE77FC714,$4829680B16876DF6,$0BA07C42C7C4C134,$2B95C2E267612A35,$85C63136B8905D13
   Data.q $00B9DC2E31B1D91B,$1B80D06E00988656,$CC80A89D50242621,$DF5E600FA614B438,$63E96334D4F0BBFD
   Data.q $3DEE6E772F937A6A,$1DCFFCE73FF39EE7,$E923DD5AB5587F68,$424A3B59247B4923,$18766CD90A4BB7BB
   Data.q $00D857576E180C78,$F98C02D808781102,$69DDCB97280CF37A,$536E40E3E5F84E9A,$6492481D1D1D180D
   Data.q $57FF0602EC09D802,$FB9292B292252403,$AFB0FD0EF202E91C,$7AC9A3D1E8E7ABEF,$4971A48769272C93
   Data.q $A482E924BE9465B9,$EB1AB7F692F3A4BA,$38B1D56CED25C63A,$E606EC0031D8AB32,$797B2599B3379D25
   Data.q $F972DF39F0E80860,$BAEBF02F40D3C083,$1FA01980F7666043,$59492ED25F780778,$92B39D2FCB9013A0
   Data.q $7EB9703E02ED24BA,$5666021F5BEB96E0,$64F21C0838117494,$5DC0603F7E33C6FB,$26F002E227BAFE3F
   Data.q $C56668B81EF80070,$2DE0305C86B1DEFB,$CF61C5F8026013E0,$1749F98715033F02,$C7E9A69EFC657869
   Data.q $C601B133331C9249,$4933E92832A54AB3,$49DF495549529233,$3A48AF4916D24D7A,$753E92D3FBE6A925
   Data.q $66F84AACCC9D15B9,$9D63D3406A04EA48,$9179E9B811CA6FF1,$BFDFDFDF303AFDF1,$CE31EB7572CCFEAA
   Data.q $01E807BD7AF57D01,$1A606E812603729E,$73D57D7DDB62EED8,$67A69A5CF8C62862,$2A8166079A498D25
   Data.q $D4941D7FD2CCCF70,$0EDBFCDB07B9F40D,$377B54E23E318B6C,$397B94EA93D5B084,$09F8137424E33C04
   Data.q $8C7CF006F115E5B8,$5702284217202FF1,$5A81173E9FC0EB80,$249367D34D217806,$BA0118146D9DEAD9
   Data.q $44210CEC63160842,$ABDA27A4E049C92F,$38027002E6475EC0,$842078C623BA09ED,$E8DC278018C633B0
   Data.q $432718C72803702A,$249ABB56AD4CA508,$5B8B74AE6A37CE49,$8C63E60018421C3C,$DEA74DC7B9F4210A
   Data.q $87BC8AAF1DE17E3B,$CCBACC0A421081F5,$431400B8C633703C,$66CD9B9708425708,$450F0EC72F0524D9
   Data.q $C718C77607901B8F,$A4C48ECBD999CD24,$47218E2CA8E1BD9F,$6CE338A1EA3C01AE,$9D5AB574C00A045A
   Data.q $ECFCE6005AEAEAEA,$A48F52428DCECB7F,$92C3A4BCB9B9B9FE,$4B2A486A48AA4BAE,$9A486EBE6373F31A
   Data.q $A488D24474925495,$B2D6988F8B3D4901,$EFFA2CCC9D94CB0C,$5015EDEDED9B3305,$643D97CC39F638F2
   Data.q $4A4E33AFBACD9B34,$5B33156664065009,$646B329495B17D70,$BA1CF7CF9F6011C2,$1CF21CDFA4B6F02C
   Data.q $9798CCE833C3DB70,$E88E23742621BD34,$B7A4E92D7D25119F,$263FE1DD5EB3AAE1,$4973E920BB3F4BE9
   Data.q $78F7172ADD122B23,$E7380AFAD1CF7963,$81F79170F80FB015,$EF022F82CE0FC0C3,$8618BB7C017CB57A
   Data.q $CF61E00EA4B15335,$017F59C08FC0D3E2,$CF3E24A57B8F0075,$C8DC3FC4670D21BB,$D6359982A4876001
   Data.q $84E035E9EE720BD3,$725D24D5EC969599,$F25B56664BE7CD6F,$B892BCE0A9233E62,$A14285241F9AC6AE
   Data.q $74717CB96B9C5EE6,$A8AD6E8B49666B7A,$B6F50A142C572392,$7B8E92DD7B0AF15A,$613D6EB29EF71DC2
   Data.q $8C6364F952BC5695,$69E8EDB39F698157,$84254CCCCCC17FFB,$BB33250842FA0250,$935D257B490F66CD
   Data.q $743683611D5DB7B4,$E144CDC04B96C700,$37FF2BB594D4D4D0,$8A413BB5248ACC71,$444E454900000000
   Data.b $AE,$42,$60,$82
   flake_png_end:
EndDataSection

DataSection
  moon_png_start:
    ; size : 5482 bytes
    Data.q $0A1A0A0D474E5089,$524448490D000000,$5000000050000000,$F2118E0000000608,$41444931150000AD
    Data.q $5EAC69DCEDDA7854,$8B41D3D5F006DBD3,$BF8AA679E79E79AA,$454901FA1A890899,$44D048BE22207C44
    Data.q $12242213F978C624,$A8250C4841221891,$52DA679E6A1AA6B9,$EADFEEFDDA1AD28A,$CE795791BC9E4EB9
    Data.q $ECE79E764ACE4969,$1EEBAD75EEB5ED67,$E960CA433ED6BDD6,$CBDBFC02DA590CAA,$2CBB0041965D8020
    Data.q $B2EC010659760083,$CBB0041965D8020C,$2EC0106597600832,$68360D83700752CB,$9B66DAE2AF6BDAF6
    Data.q $0E8659AE6B9ACA6D,$6F32F7FDFF7E5A1D,$EF96DFB7EDF2BCDE,$E547D1F47CBEFFBF,$CC66339FACDF37CD
    Data.q $A7E9F969FA7E9F28,$9380454BFCBA969F,$5962713899A93A4E,$CC6534D34AF5BD6F,$BF287E1F87E53198
    Data.q $97E5F97EBD5BF6FD,$F7EE620AA8D46A32,$559787C3E194F4F4,$90C8643EFEA55956,$7A1E8794DF37CDF2
    Data.q $C80D4BA5E97A5CA8,$5CD4ED3B4EF1D625,$AED7B5ED6515C571,$3288C4623380528C,$563F8FE3F2C8E472
    Data.q $582C17F777D401E6,$FD6A1585615EFF50,$BA3D1E8CB5FD7F5F,$75FD7F5FC813EEFE,$F7BDEF794E673399
    Data.q $FDBF6E5CBF2FCBCA,$CFB67780E60A25F6,$D949725C9734FB3E,$55BD6F5BCBEDFB7E,$8280840D065984D9
    Data.q $FDBCAB359ACFEE51,$F32ABEAFABE5DBF6,$1972BCAF2B2FCFE7,$5D633A9E056C763B,$AB2AD6B5AD65BAAB
    Data.q $0A18998FAD6ABAAE,$32994CB65D9765F0,$C8044B45D1745CA5,$5DD7735065A4EB01,$F07CACDB36CD9577
    Data.q $CB29AECAAA7D07C1,$01E04F92654CB32C,$1561C0AF3FCFF3EB,$7ABEAFABE0060276,$6F9BE6CAEDBB6ED9
    Data.q $01036A93E4F93E5E,$97E5F97755EC400B,$1DE4006998016DAF,$01BCEF3BCE51DC77,$4261309F1A407205
    Data.q $08E25057E7F9FE73,$5586C361B6C68314,$61C4EB5B9DCEE660,$51262EB5FBFEFFBC,$194D9D6A005CF573
    Data.q $B8AE2B7FB55C6E37,$B5ED796170B85962,$0565B96E5B1B6AD7,$0531BFAE7F9FE7EC,$96C7B1EC7DB5200A
    Data.q $BDFB58C80DA6D369,$FB3ECD15EFF9FFD1,$82D782D79FCCA7FC,$32996C8D46A35063,$16E32D3D706182AA
    Data.q $682CA5859A6C8CB6,$F1BC6F3D86FCE32A,$D4C2E96A4803AD46,$7EDFB7ECB8DE378D,$BCAF2BF202C0C995
    Data.q $8CFAFD7F5FD73F52,$1B0D055AB6ADAB7A,$2609B26C9BA586FD,$AFFB78FBF706D696,$3523C8FC3CD29EC1
    Data.q $79ACCB567339990C,$CD05A7B436062D95,$0C86C027EA7ABD67,$8C6155417DFA1F69,$8FDF525627A8DB63
    Data.q $D9760028AAB8FE3F,$2B4AD2BBEF3E9765,$563BAAA0781E0795,$9E801BFB7D3DCA03,$272EBBAEEBEFA6D3
    Data.q $A9EA72BAEEBBAE56,$FAD8D2FD882BF6A7,$E54BD2F4BCD06E1B,$BD6F5E83A8BF2F8B,$8659517C5F97CBF5
    Data.q $31188DA02C069809,$7505447C311BDEBC,$577DDF77CBAFACF6,$374DD36BB179E181,$01B385026619AAAD
    Data.q $BFAFEBCBB3D9ECE0,$FD85EA85E1785E5E,$8701A032A9DF19E6,$DC377F60DA5871CD,$13960F83E0F2C370
    Data.q $A1BAEC40DFB13C4F,$63D8F63CDB18F6DD,$B54640EDE9F4FA65,$A280B2A301599A0C,$805BC328865B0BC2
    Data.q $E1FA7F800A918800,$1AC6B1AC2024CAC7,$044EBADEB7AD8815,$7EB50A2114FF65F5,$9F1639532A779DE7
    Data.q $B1E34C44D9A1E780,$B0E056673399D3D9,$A9CD2A6F53BEF013,$AAEC405FBE3F1F8D,$71FE30960DD07691
    Data.q $EF1163820035840C,$FC55406185DB1EE8,$6D1B46ECF0938AEE,$7F1A9BF86559EF54,$BA13D5A55587E1F8
    Data.q $0199CD55BBEEFBBC,$49C4012B63754393,$F3F6AE5B96E58C99,$726FE013559F67D9,$3978FE3F8FD00790
    Data.q $06ABB106BA5394E5,$A2F9ED845434965A,$395181801A405955,$B10110C5005186EA,$4351560A1C4C1B01
    Data.q $7ACC3D44302AADDF,$7A90A13D6BA7E9FA,$4E79C6C6004DAF06,$D439373C7063C05D,$A759D675A644F84F
    Data.q $6932B0EC3B0F626F,$857797E5F972A4D2,$691E4791F87EDFC1,$20BCA8D629824678,$113638235D863030
    Data.q $28196EC5160E0158,$9940EB57D5F57B55,$9E5587660A60CF01,$78BE162C6D51FF11,$AED6753805008816
    Data.q $51D8BCF309904DE7,$9BED064C93640368,$2FBBEEFB2FC836E0,$9E0F5BF871B7FA9B,$5C5F17C5CD09C270
    Data.q $C182060025180C57,$10C270277D50041A,$069EA0CC7DD7554C,$A5D8A989F2031805,$3613AD5467F0A2FE
    Data.q $E73DDB1054400501,$D042269004036D6F,$2A82A252B0F93EAD,$360C1588CCB80B6B,$0AD802C97205A3EA
    Data.q $03551418060B60D3,$2FF9183B000C8008,$6C206B3D6FB2FCBF,$80D700562B62461C,$2A30FB13E8D8EEA2
    Data.q $6034AD86263F52F6,$ED8B6F1FD349A0F1,$C5C9BB0C313766DA,$BBA981E189990111,$F27232C92D132409
    Data.q $5BFDCF73DCE5C9E4,$D6F5BD6E87E5FC58,$8EC302600190B846,$27CD018278401809,$60539E0C2309B050
    Data.q $D69AA78030040CCF,$00093280818318C6,$E07EFCCB06B0A404,$CFB9DE779D960781,$B4BE9ED5DA0F32BB
    Data.q $B09030059E3932E9,$010B00A65FD8FDD6,$F0345E3F8FE3D64D,$BCC6B40F4BF8F197,$83320DAAA7A9EA79
    Data.q $A01AEC5C18821384,$300FA8B8007DC830,$7602015752550CF3,$419818E0355E2E02,$FB6B43D0F438402B
    Data.q $C79097B841C4A698,$1A4B8FD3FEA46084,$2136C9B803C0DB4C,$B0389C4E27193A61,$5B6C20635EF1B600
    Data.q $600D03384898B2D6,$00A185D9658EC618,$6FBB03599063984C,$1ECEFBCF380098A0,$709AB0FAC062CB26
    Data.q $1338064717D3A409,$00DB5126AAA48990,$BFAED2DA2B335A8B,$E739F73C684D1B2D,$84BFB9EE7B9E539C
    Data.q $28E1A0556E5762C9,$6FFBF01220040A74,$56B7E5DAC1E1B4E7,$C2C665EE8FCBD1F8,$CA33998CCBA31596
    Data.q $67A7BAC09B71BD7B,$2B5FC816FCCC0B48,$2ECB25576B0D86DB,$4A060E9256A8470A,$F03169924035A8BD
    Data.q $0DA5C7B2A3D8F63D,$54713C92269BB040,$480293656B01224A,$A0883A8CF1F427BF,$0C0F27C9F27C130D
    Data.q $8EE3B35B76DDB780,$2CC0CE18496F563B,$AAD7B5DC0369EF0F,$6165480B07695675,$CCBB3282DABFEC5D
    Data.q $646A391B74B20169,$9AC80C9D75361669,$013563885179F800,$6C4D511F47026D68,$81810B120C602004
    Data.q $48A72424DB01EA71,$636D3F623B56312D,$21988442738F807C,$A898D3B4ED392985,$A668262BB165C6C5
    Data.q $6DF9D7F81302C98E,$02D33B1467B2DF74,$5755D572B63C0298,$45BD4B19D91959A9,$623A18037D859259
    Data.q $26F687030F1E5F58,$A9EE18075636B21D,$E418E604CC0419C3,$6709D1CA01B564B7,$69CF0999F1E264E2
    Data.q $5D8D9EEF81115D5B,$7FDFF7005FEC416C,$E3ACADEF7BDEE6FF,$FCB61C6BC6680145,$AD8AE2073A51950A
    Data.q $F5AC1F93C9AB50CA,$AAD79FDEB1FDCEE6,$CC6B3A4E9E6F4F5B,$53FCF93E5B2B1598,$F72CEB19230DD7ED
    Data.q $A07C9AF132D486A2,$30845016EC616281,$8172BB5FD46132FA,$D554BA9F26FE4871,$04B098EAF2067484
    Data.q $7802FF4C731CC7FC,$44711C4734370DC3,$7D825483B10CDCED,$6CF3D33B00D2D249,$056A6046EF00048B
    Data.q $0FC3AC0DFD3E24F0,$08739F02C00EBC3F,$3BCC77EEF8F61333,$8E27A9C4EAA3A8EA,$9099CB00752E72A4
    Data.q $FA64EF4C7ED47F4B,$177F645D64A013EE,$6478BFAF80326F81,$6C2C594CA653105B,$1D1AD369B4D2AB16
    Data.q $C4D555A9D4EA7212,$206F032DBC84F166,$455869B1EEEF926C,$A8C30FD508182068,$03049EF9C19A6590
    Data.q $BB7EA4833DD75415,$BA960D860D6BBAEE,$32BDF984DA964BEA,$402C917E499437BB,$D49D13588922324B
    Data.q $7F9FF693213B2659,$C007FAB4AED2F9FE,$4952BAF38CC68056,$40C2D4F3346784D4,$0D5026E0670262CC
    Data.q $3C4C1B0CD3E20033,$23001648AD5A01A5,$A6D79F6C2F9A9999,$69200338AB0DB1B6,$7DACE8026721F12F
    Data.q $318C8B6B7F240B81,$43B5F265EAADB103,$D5B3E31A2C9AB266,$6CF73DCF7001FE8C,$4BEA46368AD97264
    Data.q $54BD04B19B18C793,$C48475C4C0C2C30E,$70C4BD4DB33C1E28,$3835778B684E177E,$0D54FB0277AF558C
    Data.q $00663E7A6BCF015B,$F53FA3331CF7DAF0,$32794EF9ED4F1300,$048ED1D5A30DFA49,$A0D6C007FA84EB44
    Data.q $1D3E863DD813F636,$80689DB25541A327,$82F1EB32E52967EE,$A3426BB14A8B75D9,$CE92D432B47D1F47
    Data.q $581BCF276ABB58E4,$C862617C93884B00,$75D9C736C3A93B84,$E5DA8A9649959BCA,$7BB05B7782584C3C
    Data.q $E7C53FE6BDB7BDEF,$BC61A9349A4C2B4F,$964E639D10380F25,$088AA494C4A6D973,$A53C19A39BAB28C7
    Data.q $7019BF0389CC40FB,$3C544C7035007572,$6D2000671EC9B9D7,$A38F7C300A613E79,$5001467133DAC64A
    Data.q $D5084D4366898A7B,$FED2EEFBBEED64CD,$ABAAF007BA3C8DA5,$30DD903AF2446AAE,$5263F6C893D86048
    Data.q $00B67B21224B0449,$3153840C94A47763,$653683CCC09601DB,$8E20319E7F50B18E,$515138325EECDB48
    Data.q $0526300426301B9E,$003224C49ADE4918,$E01E046428322FA9,$05E04CF5147A67DD,$EEFAFEBFAE505C17
    Data.q $30EC1B6BDAF6BC01,$0009A60A13CC3370,$3911E28D46276C88,$B06381602C19BF19,$26C4DA2BC18A02C0
    Data.q $C6CA804C05031619,$DA2B46C9F067987A,$6D7EC20346986137,$3001501F5263967A,$93F06C9FAF932EA9
    Data.q $D62DBA1B6B21E331,$06C40620AD3F9B99,$09AC61EC77C8EB9D,$01EE26710784C3AA,$CAD45CB13DF57790
    Data.q $1AEA8940267478A0,$56601BED20C18070,$C28C250FAF830A23,$FA33DBF9C05AD8BC,$D985C4D2C2C9AC03
    Data.q $B4812F68B1940072,$C3F0F28761D876DF,$5C2B4FE48AD62F0F,$52D4F7164D65D976,$6B2100C242C122B1
    Data.q $BC7C5491060B84CB,$C3A822DADFC5709C,$4EA20CACBD5D6640,$623A9F4C654AEA43,$E66EAD16BB0610A3
    Data.q $CFCC2B7631307ED6,$E42B1BC66D289984,$007C64C6CB3F7A4A,$8E2AB6ADAB665097,$D803DDE9FA7E9CA5
    Data.q $72B31320B56342CE,$EA4240D913175AEF,$3330347788C02090,$BE3358C3D540D3EF,$6C8FB635545B16C5
    Data.q $711063D87D8A5820,$A4DC004127FD494A,$12F76DA40053DCC4,$6444D7DE2B1365D7,$8007E9ADB17C8FF7
    Data.q $4DE72609BFD2A0D9,$71E00F7681C4DD37,$C5F17AC1D8D71DC7,$D613F5002571AB17,$540B0665C491D564
    Data.q $251503212932CBCC,$0B85810658E48720,$8D5843B3663CF440,$1597982581F4AEAD,$FE13800070A4B604
    Data.q $095C393D630A97E8,$CE497B4BBBEB3C4F,$0EB4F27D5BE8D9C6,$3803DD95E5795CA4,$350984C266D8EC76
    Data.q $3333A207B3DEE37E,$A33BF2B624C263AB,$D93AA503320D566D,$0890B8186060C466,$AC1D4E0CAB600050
    Data.q $6896C9AC9DC6F4EC,$74B2434DFDBB0926,$0648C9DF14C25F23,$0D9B130698EFAC13,$5E1785DA1CB4C4F8
    Data.q $6C01EEC6F1BC6E58,$9DFAECFB3ECE6C85,$9F64F93E4F46A607,$E9044F537A46D49A,$33F65C6B3211265C
    Data.q $FD679C0ECBD4BA82,$25064D4C22C2326E,$83AB8014C52CE6D9,$0385643E4F7A0BE1,$FD11AB3F009DAA34
    Data.q $849AA01B425EAFBB,$E73CD5AB908AD5CE,$338CE3395007BA6F,$FEFFBB844EF3C21A,$193C64CC89C2FBFB
    Data.q $980B3D03624B0955,$4405DE0DB06202AC,$B92A0CF1E4DF92A1,$13AB2E547F62CF3B,$E001679E7133E8A0
    Data.q $E75329D3AB2DECB9,$5CECB2E781113D5A,$DA39271D4869E074,$0DE546D800FF7FF5,$AB48494A49003881
    Data.q $C4CAC97CF1290212,$378454E9D47D27D0,$4544A1E5B42627D9,$7C394FB1BA87D400,$DF89AD8EF96059E9
    Data.q $E01E4FF5C30B5692,$D446D379D94C9BF8,$25861276999CFB57,$3A5FF4F2B55616C8,$80008FDA8D66F9CB
    Data.q $53A3CE3572510141,$6CA3982A50038035,$01724DF8969C4A00,$84AACFB140140600,$160314C25406CB3D
    Data.q $BF0C385FE72100CE,$C5626B6C73D54B65,$7BC571FA47228EAC,$D070845026408677,$F1F8CA801FF50741
    Data.q $212827D19D861BE3,$A642195162C4E379,$5B6EDBB6E8244E24,$0E1BAB6840471907,$C2726C77CA00E4C0
    Data.q $863ECF4C375144CA,$0A00E31CDE77D1D8,$9EB4395C42681320,$69D9F59547204FAD,$95E4A58524CCC8EF
    Data.q $6759D672DF636848,$C340701C07802FF5,$09418A0920181A5B,$E244E26B0AACB253,$1ACA6A73612CCC58
    Data.q $77812F6AF4138319,$98D2A1B429B53BB6,$FB3DB3668603C495,$89C6AC4E6CF77E20,$6CBC99207B33EFA8
    Data.q $D001E4D101D0F29D,$5B005FE969AD2AFB,$8B0311D1885F5027,$559A0712BF648401,$3A32AD720901852A
    Data.q $F13C4F1B501346CF,$FC2449EC82C9DF44,$A09397648E39DDE1,$B6C104988262484D,$C05470424964CF78
    Data.q $E035D47F60E068C1,$68CE19D86BBBDEFD,$FD0CADAC85265F47,$6EAE371B8CA72BBF,$573A631795DE13AC
    Data.q $156A08012849040A,$CFB3E41A261EAF03,$B2A5A093F067DB3E,$7363FD89EC3679EE,$12C992212B697AA3
    Data.q $7F9BD5B9BAED5390,$498C8810CEB1C9CC,$C87DC9D930C8E426,$1B6C3690FDD48721,$452D24DF035B0018
    Data.q $63A8B5D8F3A0084D,$A8100CDD4C336682,$C9240CB01D7C9798,$BE94C4ABE9CACC02,$F4C751D6F3EA1133
    Data.q $C5F57E0B8A83F095,$95F24F95143564C4,$C97D4BF38C8C9DDC,$C2A0030371A3DEDD,$89336613C788C723
    Data.q $9AF3C22EB08810CA,$8B0A5E92B00604C0,$C0BF1C98D9C9E992,$8C91B56484DA3088,$C9FB0F20DA52D249
    Data.q $EF20341B543B65C1,$26802366295364A6,$7296E5B96FD766E8,$9484C9CC0E6799E6,$C15C1F07C1CD1076
    Data.q $9C06158688123360,$4A807067AA819BDC,$40244D962A19E76C,$6864E9D580C2FF64,$38E262884C0040B2
    Data.q $0586B3DAFA302021,$D0BCEFABD8959676,$E67D53624968B7E3,$2A00B034C75E9CE5,$7362847A338D50AD
    Data.q $92EF2CC3556F0D7A,$CDB78C0055B4E985,$5B58E64047D8B3D1,$40C1FA906E060856,$312D1544FD2BE9A0
    Data.q $9904C9452ACD369D,$C61ACE47649DFC84,$E6B9AECE363E7004,$DB7659D59D3D819A,$419755998CC6B76D
    Data.q $C98324C000021228,$84C193EA6B51471B,$8F0AD6366C9506B9,$39611394032F51B2,$81C101BF970DAF91
    Data.q $E713F30F58D9C2F0,$FB3000EA1E126D61,$47D1F475485026D8,$8D282D299603992F,$11FD9806344B3780
    Data.q $427985E2CE56635C,$BD929524E67B6C8B,$D36B5923B59064DB,$84C8D920C7032A8A,$949DBCFEC386092C
    Data.q $FE59EFBFD349B8F5,$F695A117993EBD61,$62E4791E47F61B14,$983B4A802BF5C0ED,$0880380C65A84306
    Data.q $0BE102C740B3866D,$C6192A56A9D20DC1,$6FD90409CDAC2150,$6839C7761F9CE620,$E7671ECACF08C93B
    Data.q $1E9D1BA392C93B0D,$A60009A44C152736,$3CDAC5EAFABEAEBE,$B2A136011500101A,$5ACBED894D7E4FC0
    Data.q $62048330D85DE738,$2932756EC53622BC,$2039E1C3928853DE,$367EEC4F3E020269,$E1B2E0203C9EFDDD
    Data.q $BEEFBBF952F23C0E,$4A80180C708FB17B,$1024C04E0D235E0B,$18A3A1CB24B329E2,$F62760A019592579
    Data.q $A867ABAAF9D11124,$1F1323095331F6B6,$8D99930799301362,$309900113F6A7D76,$2FBA58E3AD5F2BD5
    Data.q $5E5AA868671674DA,$8E094C9B2EFE4D37,$8090A4DDEB212A73,$B02D088D8E4AA063,$2148E24006F2930C
    Data.q $81B9D32B39DB4B8B,$F336151359E89B14,$4BF2C3A779DE77D6,$ADD9DA5BFFAF55FF,$D6F372C73966C87B
    Data.q $DEC9C0FB7DEFEF51,$97EA24C7808067B8,$32B394C728615753,$80EF8B0CEFB5DE09,$752403355E67D6CB
    Data.q $BBB91C1FA735024E,$FE1B2F39FEFBBEEF,$CC2E013A9F9A7151,$9C19343AC944CAC8,$61BD9300E278BED8
    Data.q $8C7A292F7440823B,$7361BF0CD1C89894,$C034BAF17985834E,$BD80F5E2FDFD64AB,$657173AB49AEDF0E
    Data.q $E44A1FF3ACF897B9,$303092C208564ADC,$FF97F72818BCB327,$A1F3BCF16B0DA1DA,$F6A0ECF2A7D5DF5D
    Data.q $9F66F9BE6F200FD2,$1588A0FFAE17E0FF,$E19935DE32D43785,$E495D86222F33E24,$000A3853097B4E69
    Data.q $FAF63862860C8CE6,$CC4392EE9273673B,$53A9D4EE2AF14EBF,$B45B3FE44B9C6C07,$680290364404D420
    Data.q $B8CE6B631F59FB16,$CF30C38C15997F50,$C543D560F9395587,$272EC18781B6B4A9,$DF1F019EE7B9EF69
    Data.q $6F1AA0ED2B1FFB12,$70E394006B0E0393,$5C72F30B305147D9,$3A9090E4CA134B17,$8B9A4C8022E3B1BC
    Data.q $00CF33CCFFE1B009,$D2BFFE4F6FFDDFF3,$C08EA1C0DAAAC37A,$447385AC540C2AC3,$A186014311313B0E
    Data.q $EF67D8AED39EB039,$4B3C7C4BE9F4FA64,$8C428C72294F7FFD,$12D89E072025106C,$26B4519CA03EA8E3
    Data.q $0C754B9FB5F6C9F6,$A00EB4A8FF0008FF,$7FB9E369051CBCC1,$654DFEA148FFACA4,$965D8020CB2EC010
    Data.q $597600832CBB0041,$65D8020CB2EC0106,$60FDBFF2CBB00419,$0000CBFADB515006,$42AE444E45490000
    Data.b $60,$82
  moon_png_end:
EndDataSection

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 8:53 am
by Bananenfreak
Really cool, sir 8)

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 9:09 am
by netmaestro
Looks good! That's the good news. The bad news is I pressed space a couple of times and it errored out on Point() is outside the drawing area on line 110. I reran the program and pressed space about 50 times and it didn't happen again.

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 9:27 am
by ts-soft
Looks good :D

There is a small bug at line 133: change

Code: Select all

CompilerIf #PB_OS_Windows
to

Code: Select all

CompilerIf #PB_Compiler_OS = #PB_OS_Windows

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 9:46 am
by davido
Very nice.

Happy Christmas!

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 10:55 am
by rsts
Very nice.
Thanks for sharing.
And a Merry Christmas to you :D

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 6:09 pm
by BasicallyPure
netmaestro wrote:Looks good! That's the good news. The bad news is I pressed space a couple of times and it errored out on Point() is outside the drawing area on line 110. I reran the program and pressed space about 50 times and it didn't happen again.
fixed. (I think)
ts-soft wrote:There is a small bug at line 133
fixed.

BP

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 6:18 pm
by kvitaliy
Sorry, but let me add a little music:

Code: Select all

; Snowman by the Lake
; by BasicallyPure
; 12.22.2013
; PB 5.21
;
; thanks to walbus for the snowman
; thanks to J. Baker for the snowflake
;
; press 'Escape' to end
; press 'Space' to generate new scenery

EnableExplicit

#MainWin = 0
#MaxFlakes = 250
#BackSprite = 0

Structure SnowCalculations
   SnowX.d
   SnowY.d
   SnowS.i ; flake size
   SnowV.d ; Y velocity
EndStructure

Global Dim Snow.SnowCalculations(#MaxFlakes)
Global Xmax, Ymax
Global Dim Shore(0)
Global hMidiOut

Procedure PlayNote(notN.i,dlit.i)
        Define nota.s
        nota.s ="$65" + Hex(notN) + "9F"
        midiOutShortMsg_( hMidiOut,Val(nota)) ;6567325
        Sleep_(dlit)
      EndProcedure
      
      If midiOutOpen_(@hMIDIout, 0, 0, 0, 0) = #MMSYSERR_NOERROR
        Global Musik.b=1
      EndIf
      
      
Procedure MOVE_SNOW()
   Static SnowSprite.i, wind.d, windScale.d, bias.i = 15
   
   windScale + Random(32) - bias
   If windScale > 1500 : bias = 17 : EndIf
   If windScale < -300 : bias = 15 : EndIf
   
   wind = windScale / 4000
   
   DisplaySprite(#BackSprite,0,0)
   
   For SnowSprite = 1 To #MaxFlakes
      With Snow(SnowSprite)
         
         DisplayTransparentSprite(SnowSprite, \SnowX, \SnowY, Random(255, 64)) ; twinkle effect
         RotateSprite(SnowSprite, 0.2 * \SnowS, #PB_Relative)
         
         \SnowX + wind *\SnowS
         \SnowY + \SnowV
         
         If \SnowX > Xmax : \SnowX = 0 : EndIf
         If \SnowX < 0 : \SnowX = Xmax : EndIf
         
         If \SnowY > Ymax ; if the snow reaches the bottom, send back to top
            \SnowY = 0
            \SnowX = Random(Xmax)
            \SnowS = Random(14, 2) ;snow size
            \SnowV = \SnowS / 6
            ZoomSprite(SnowSprite, \SnowS, \SnowS)
         EndIf
         
      EndWith
    Next SnowSprite
       
EndProcedure

Procedure SNOWMAN(x,y)
   Circle(x,y-75,15,$EFEFEF) ; Addon - Simple Snowman :-)
   Circle(x,y-50,20,$EFEFEF) : Circle(x,y-72,6,0)
   Circle(x,y-75,7, $EFEFEF) : Circle(x,y-75,2,$45FF)
   Circle(x,y-25,30,$EFEFEF) : Circle(x,y-55,1,0)
   Circle(x-7,y-80,1, 0)     : Circle(x+7,y-80,1,0)
   Circle(x,y-50,1, 0)       : Circle(x,y-45,1,0)
   Circle(x,y-30,1, 0)       : Circle(x,y-25,1,0)
   Box(x-25,y-90,50,3,0)     : Box(x-10,y-110,20,20,0)
EndProcedure
   
Procedure DRAW_BACKSPRITE()
   Static a,b,d,s,x,yy
   Protected bias=3, t=$EC0FEC, m=Ymax/3, y=m
   
   StartDrawing(SpriteOutput(#BackSprite))
      Box(0,0,Xmax,Ymax,$400000)
     
      For d = 1 To 4
         t = (t + $191019) & $FFFFFF
         a = m-Random(50/d,5) : b = m+Random(50/d,5)
         s = 5-d
         For x = 0 To Xmax
            If d < 4
               For yy = y To Ymax
                  Plot(x,yy,t!(Random(15)<<16+Random(15)<<8+Random(15)))
               Next yy
            Else
               Shore(x) = y : Plot(x,y,0) ; draw & store the shore line
            EndIf
            y + s * Sign(Random(8) - bias)
            If y < 0 : y = 0 : EndIf
            If y > b Or y < a
               bias = 8 - bias
               a = m-Random(50/d,5) : b = m+Random(50/d,5)
            EndIf
         Next x
         m + (Ymax - m) * 0.15
         y = m
      Next d
     
      x = 50 + Random(Xmax-100)
      SNOWMAN(x,Shore(x)-20)
     
      For x = 0 To Xmax ; mirror
         For y = Shore(x) To Ymax
            t = Point(x,Shore(x)<<1 - y)
            Plot(x,y,RGB(Red(t)*0.7,Green(t)*0.7,Blue(t)*0.7))
         Next y
      Next x
     
   StopDrawing()
   
EndProcedure

Procedure INIT_GUI()
   Protected SnowSprite, dw, dh, hWin
   ExamineDesktops() : dw = DesktopWidth(0) : dh = DesktopHeight(0)
   hWin = OpenWindow(#MainWin,0,0,dw,dh,"Snow",#PB_Window_BorderLess)
   
   If hWin <> 0
      If InitSprite()=0 Or InitKeyboard()=0 Or OpenWindowedScreen(hWin,0,0,dw, dh)=0
         hWin = 0
      Else
         Xmax = dw - 1 : Ymax = dh - 1
         UsePNGImageDecoder()
         
         ReDim Shore(Xmax)
         
         CompilerIf #PB_Compiler_OS = #PB_OS_Windows
            SetCursorPos_(dw,0)
         CompilerEndIf
         
         CreateSprite(#BackSprite,Xmax+1,Ymax+1)
         DRAW_BACKSPRITE()
         
         ; create the snow sprites
         For SnowSprite = 1 To #MaxFlakes
            CatchSprite(SnowSprite, ?flake_png_start, #PB_Sprite_AlphaBlending)
            With Snow(SnowSprite)
               \SnowX = Random(Xmax)
               \SnowY = Random(Ymax)
               \SnowS = Random(14, 2) ;snow size
               \SnowV = \SnowS / 6    ; velocity proportional to size
               ZoomSprite(SnowSprite, \SnowS, \SnowS)
            EndWith
         Next SnowSprite
         
      EndIf
   EndIf
   
   ProcedureReturn hWin
   
EndProcedure

Procedure EVENT_LOOP()
   Protected event, run = #True
   
   While run = #True
      ExamineKeyboard()
     
      If KeyboardPushed(#PB_Key_Escape)
         run = #False
      EndIf
     
      If KeyboardReleased(#PB_Key_Space)
        If Musik    
PlayNote(52,200)
PlayNote(52,200)
PlayNote(52,200)
Delay(200)
PlayNote(52,200)
PlayNote(52,200)
PlayNote(52,200)
Delay(200)
PlayNote(52,200)
PlayNote(55,200)
PlayNote(48,200)
PlayNote(50,200)
PlayNote(52,200)
Delay(200)
PlayNote(53,200)
PlayNote(53,200)
PlayNote(53,200)
PlayNote(53,200)

PlayNote(53,200)
PlayNote(52,200)
PlayNote(52,200)

PlayNote(52,200)
PlayNote(50,200)
PlayNote(50,200)
PlayNote(52,200)
PlayNote(50,200)
PlayNote(55,800)
      
        EndIf
        
         DRAW_BACKSPRITE()
      EndIf
     
      Repeat
         event = WindowEvent()
         If event = #PB_Event_CloseWindow
            run = #False
         EndIf
      Until event = 0
     
      MOVE_SNOW()
      FlipBuffers()
   Wend
   
EndProcedure

If INIT_GUI()
     EVENT_LOOP()
EndIf

DataSection
   flake_png_start:
   ; size : 1244 bytes
   Data.q $0A1A0A0D474E5089,$524448490D000000,$2000000020000000,$7A7A730000000608,$47527301000000F4
   Data.q $0000E91CCEAE0042,$FF0044474B620600,$93A7BDA0FF00FF00,$7359487009000000,$130B0000130B0000
   Data.q $000000189C9A0001,$0ADA07454D497407,$5EC42DDA3B31121B,$544144495C040000,$55946C4B97BDC358
   Data.q $A74ED37EE77FC714,$4829680B16876DF6,$0BA07C42C7C4C134,$2B95C2E267612A35,$85C63136B8905D13
   Data.q $00B9DC2E31B1D91B,$1B80D06E00988656,$CC80A89D50242621,$DF5E600FA614B438,$63E96334D4F0BBFD
   Data.q $3DEE6E772F937A6A,$1DCFFCE73FF39EE7,$E923DD5AB5587F68,$424A3B59247B4923,$18766CD90A4BB7BB
   Data.q $00D857576E180C78,$F98C02D808781102,$69DDCB97280CF37A,$536E40E3E5F84E9A,$6492481D1D1D180D
   Data.q $57FF0602EC09D802,$FB9292B292252403,$AFB0FD0EF202E91C,$7AC9A3D1E8E7ABEF,$4971A48769272C93
   Data.q $A482E924BE9465B9,$EB1AB7F692F3A4BA,$38B1D56CED25C63A,$E606EC0031D8AB32,$797B2599B3379D25
   Data.q $F972DF39F0E80860,$BAEBF02F40D3C083,$1FA01980F7666043,$59492ED25F780778,$92B39D2FCB9013A0
   Data.q $7EB9703E02ED24BA,$5666021F5BEB96E0,$64F21C0838117494,$5DC0603F7E33C6FB,$26F002E227BAFE3F
   Data.q $C56668B81EF80070,$2DE0305C86B1DEFB,$CF61C5F8026013E0,$1749F98715033F02,$C7E9A69EFC657869
   Data.q $C601B133331C9249,$4933E92832A54AB3,$49DF495549529233,$3A48AF4916D24D7A,$753E92D3FBE6A925
   Data.q $66F84AACCC9D15B9,$9D63D3406A04EA48,$9179E9B811CA6FF1,$BFDFDFDF303AFDF1,$CE31EB7572CCFEAA
   Data.q $01E807BD7AF57D01,$1A606E812603729E,$73D57D7DDB62EED8,$67A69A5CF8C62862,$2A8166079A498D25
   Data.q $D4941D7FD2CCCF70,$0EDBFCDB07B9F40D,$377B54E23E318B6C,$397B94EA93D5B084,$09F8137424E33C04
   Data.q $8C7CF006F115E5B8,$5702284217202FF1,$5A81173E9FC0EB80,$249367D34D217806,$BA0118146D9DEAD9
   Data.q $44210CEC63160842,$ABDA27A4E049C92F,$38027002E6475EC0,$842078C623BA09ED,$E8DC278018C633B0
   Data.q $432718C72803702A,$249ABB56AD4CA508,$5B8B74AE6A37CE49,$8C63E60018421C3C,$DEA74DC7B9F4210A
   Data.q $87BC8AAF1DE17E3B,$CCBACC0A421081F5,$431400B8C633703C,$66CD9B9708425708,$450F0EC72F0524D9
   Data.q $C718C77607901B8F,$A4C48ECBD999CD24,$47218E2CA8E1BD9F,$6CE338A1EA3C01AE,$9D5AB574C00A045A
   Data.q $ECFCE6005AEAEAEA,$A48F52428DCECB7F,$92C3A4BCB9B9B9FE,$4B2A486A48AA4BAE,$9A486EBE6373F31A
   Data.q $A488D24474925495,$B2D6988F8B3D4901,$EFFA2CCC9D94CB0C,$5015EDEDED9B3305,$643D97CC39F638F2
   Data.q $4A4E33AFBACD9B34,$5B33156664065009,$646B329495B17D70,$BA1CF7CF9F6011C2,$1CF21CDFA4B6F02C
   Data.q $9798CCE833C3DB70,$E88E23742621BD34,$B7A4E92D7D25119F,$263FE1DD5EB3AAE1,$4973E920BB3F4BE9
   Data.q $78F7172ADD122B23,$E7380AFAD1CF7963,$81F79170F80FB015,$EF022F82CE0FC0C3,$8618BB7C017CB57A
   Data.q $CF61E00EA4B15335,$017F59C08FC0D3E2,$CF3E24A57B8F0075,$C8DC3FC4670D21BB,$D6359982A4876001
   Data.q $84E035E9EE720BD3,$725D24D5EC969599,$F25B56664BE7CD6F,$B892BCE0A9233E62,$A14285241F9AC6AE
   Data.q $74717CB96B9C5EE6,$A8AD6E8B49666B7A,$B6F50A142C572392,$7B8E92DD7B0AF15A,$613D6EB29EF71DC2
   Data.q $8C6364F952BC5695,$69E8EDB39F698157,$84254CCCCCC17FFB,$BB33250842FA0250,$935D257B490F66CD
   Data.q $743683611D5DB7B4,$E144CDC04B96C700,$37FF2BB594D4D4D0,$8A413BB5248ACC71,$444E454900000000
   Data.b $AE,$42,$60,$82
   flake_png_end:
EndDataSection

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 7:33 pm
by J. Baker
Very nice! :D

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 8:57 pm
by walbus
Great
looking very good :D

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 9:43 pm
by J. Baker
Continuous music for OS X and Windows. Mac users will need wilbert's lib...
http://www.purebasic.fr/english/viewtop ... libpbcocoa

Code: Select all

; Snowman by the Lake
; by BasicallyPure
; 12.22.2013
; PB 5.21
;
; thanks to walbus for the snowman
; thanks to J. Baker for the snowflake
;
; press 'Escape' to end
; press 'Space' to generate new scenery

;EnableExplicit

#MainWin = 0
#MaxFlakes = 250
#BackSprite = 0

Structure SnowCalculations
   SnowX.d
   SnowY.d
   SnowS.i ; flake size
   SnowV.d ; Y velocity
EndStructure

Global Dim Snow.SnowCalculations(#MaxFlakes)
Global Xmax, Ymax
Global Dim Shore(0)
Global hMidiOut

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      Procedure PlayNote(MidiNote.b, length.u)
        Midi_SendEvent(144, MidiNote, 127)
        Delay(length)
      EndProcedure
      
      Global Musik.b = 1
CompilerElse  
      Procedure PlayNote(notN.i,dlit.i)
        Define nota.s
        nota.s ="$65" + Hex(notN) + "9F"
        midiOutShortMsg_( hMidiOut,Val(nota)) ;6567325
        sleep_(dlit)
      EndProcedure
      
      If midiOutOpen_(@hMIDIout, 0, 0, 0, 0) = #MMSYSERR_NOERROR
        Global Musik.b=1
      EndIf
CompilerEndIf  

Procedure Thread(Parameter)
  Repeat
    PlayNote(52,200)
    PlayNote(52,200)
    PlayNote(52,200)
    Delay(200)
    PlayNote(52,200)
    PlayNote(52,200)
    PlayNote(52,200)
    Delay(200)
    PlayNote(52,200)
    PlayNote(55,200)
    PlayNote(48,200)
    PlayNote(50,200)
    PlayNote(52,200)
    Delay(200)
    PlayNote(53,200)
    PlayNote(53,200)
    PlayNote(53,200)
    PlayNote(53,200)
    
    PlayNote(53,200)
    PlayNote(52,200)
    PlayNote(52,200)
    
    PlayNote(52,200)
    PlayNote(50,200)
    PlayNote(50,200)
    PlayNote(52,200)
    PlayNote(50,200)
    PlayNote(55,800)
    Delay(1000)
   ForEver 
EndProcedure


Procedure MOVE_SNOW()
   Static SnowSprite.i, wind.d, windScale.d, bias.i = 15
   
   windScale + Random(32) - bias
   If windScale > 1500 : bias = 17 : EndIf
   If windScale < -300 : bias = 15 : EndIf
   
   wind = windScale / 4000
   
   DisplaySprite(#BackSprite,0,0)
   
   For SnowSprite = 1 To #MaxFlakes
      With Snow(SnowSprite)
         
         DisplayTransparentSprite(SnowSprite, \SnowX, \SnowY, Random(255, 64)) ; twinkle effect
         RotateSprite(SnowSprite, 0.2 * \SnowS, #PB_Relative)
         
         \SnowX + wind *\SnowS
         \SnowY + \SnowV
         
         If \SnowX > Xmax : \SnowX = 0 : EndIf
         If \SnowX < 0 : \SnowX = Xmax : EndIf
         
         If \SnowY > Ymax ; if the snow reaches the bottom, send back to top
            \SnowY = 0
            \SnowX = Random(Xmax)
            \SnowS = Random(14, 2) ;snow size
            \SnowV = \SnowS / 6
            ZoomSprite(SnowSprite, \SnowS, \SnowS)
         EndIf
         
      EndWith
    Next SnowSprite
       
EndProcedure

Procedure SNOWMAN(x,y)
   Circle(x,y-75,15,$EFEFEF) ; Addon - Simple Snowman :-)
   Circle(x,y-50,20,$EFEFEF) : Circle(x,y-72,6,0)
   Circle(x,y-75,7, $EFEFEF) : Circle(x,y-75,2,$45FF)
   Circle(x,y-25,30,$EFEFEF) : Circle(x,y-55,1,0)
   Circle(x-7,y-80,1, 0)     : Circle(x+7,y-80,1,0)
   Circle(x,y-50,1, 0)       : Circle(x,y-45,1,0)
   Circle(x,y-30,1, 0)       : Circle(x,y-25,1,0)
   Box(x-25,y-90,50,3,0)     : Box(x-10,y-110,20,20,0)
EndProcedure
   
Procedure DRAW_BACKSPRITE()
   Static a,b,d,s,x,yy
   Protected bias=3, t=$EC0FEC, m=Ymax/3, y=m
   
   StartDrawing(SpriteOutput(#BackSprite))
      Box(0,0,Xmax,Ymax,$400000)
     
      For d = 1 To 4
         t = (t + $191019) & $FFFFFF
         a = m-Random(50/d,5) : b = m+Random(50/d,5)
         s = 5-d
         For x = 0 To Xmax
            If d < 4
               For yy = y To Ymax
                  Plot(x,yy,t!(Random(15)<<16+Random(15)<<8+Random(15)))
               Next yy
            Else
               Shore(x) = y : Plot(x,y,0) ; draw & store the shore line
            EndIf
            y + s * Sign(Random(8) - bias)
            If y < 0 : y = 0 : EndIf
            If y > b Or y < a
               bias = 8 - bias
               a = m-Random(50/d,5) : b = m+Random(50/d,5)
            EndIf
         Next x
         m + (Ymax - m) * 0.15
         y = m
      Next d
     
      x = 50 + Random(Xmax-100)
      SNOWMAN(x,Shore(x)-20)
     
      For x = 0 To Xmax ; mirror
         For y = Shore(x) To Ymax
            t = Point(x,Shore(x)<<1 - y)
            Plot(x,y,RGB(Red(t)*0.7,Green(t)*0.7,Blue(t)*0.7))
         Next y
      Next x
     
   StopDrawing()
   
EndProcedure

Procedure INIT_GUI()
   Protected SnowSprite, dw, dh, hWin
   ExamineDesktops() : dw = DesktopWidth(0) : dh = DesktopHeight(0)
   hWin = OpenWindow(#MainWin,0,0,dw,dh,"Snow",#PB_Window_BorderLess)
   
   If hWin <> 0
      If InitSprite()=0 Or InitKeyboard()=0 Or OpenWindowedScreen(hWin,0,0,dw, dh)=0
         hWin = 0
      Else
         Xmax = dw - 1 : Ymax = dh - 1
         UsePNGImageDecoder()
         
         ReDim Shore(Xmax)
         
         CompilerIf #PB_Compiler_OS = #PB_OS_Windows
            SetCursorPos_(dw,0)
         CompilerEndIf
         
         CreateSprite(#BackSprite,Xmax+1,Ymax+1)
         DRAW_BACKSPRITE()
         
         ; create the snow sprites
         For SnowSprite = 1 To #MaxFlakes
            CatchSprite(SnowSprite, ?flake_png_start, #PB_Sprite_AlphaBlending)
            With Snow(SnowSprite)
               \SnowX = Random(Xmax)
               \SnowY = Random(Ymax)
               \SnowS = Random(14, 2) ;snow size
               \SnowV = \SnowS / 6    ; velocity proportional to size
               ZoomSprite(SnowSprite, \SnowS, \SnowS)
            EndWith
         Next SnowSprite
         
      EndIf
   EndIf
   
   If Musik    
       CreateThread(@Thread(), 0)
   EndIf
   
   ProcedureReturn hWin
   
EndProcedure

Procedure EVENT_LOOP()
   Protected event, run = #True
   
   While run = #True
      ExamineKeyboard()
     
      If KeyboardPushed(#PB_Key_Escape)
         run = #False
      EndIf
     
      If KeyboardReleased(#PB_Key_Space)
        
         DRAW_BACKSPRITE()
      EndIf
      
      Repeat
         event = WindowEvent()
         If event = #PB_Event_CloseWindow
            run = #False
         EndIf
      Until event = 0
     
      MOVE_SNOW()
      FlipBuffers()
   Wend
   
EndProcedure

If INIT_GUI()
     EVENT_LOOP()
EndIf

DataSection
   flake_png_start:
   ; size : 1244 bytes
   Data.q $0A1A0A0D474E5089,$524448490D000000,$2000000020000000,$7A7A730000000608,$47527301000000F4
   Data.q $0000E91CCEAE0042,$FF0044474B620600,$93A7BDA0FF00FF00,$7359487009000000,$130B0000130B0000
   Data.q $000000189C9A0001,$0ADA07454D497407,$5EC42DDA3B31121B,$544144495C040000,$55946C4B97BDC358
   Data.q $A74ED37EE77FC714,$4829680B16876DF6,$0BA07C42C7C4C134,$2B95C2E267612A35,$85C63136B8905D13
   Data.q $00B9DC2E31B1D91B,$1B80D06E00988656,$CC80A89D50242621,$DF5E600FA614B438,$63E96334D4F0BBFD
   Data.q $3DEE6E772F937A6A,$1DCFFCE73FF39EE7,$E923DD5AB5587F68,$424A3B59247B4923,$18766CD90A4BB7BB
   Data.q $00D857576E180C78,$F98C02D808781102,$69DDCB97280CF37A,$536E40E3E5F84E9A,$6492481D1D1D180D
   Data.q $57FF0602EC09D802,$FB9292B292252403,$AFB0FD0EF202E91C,$7AC9A3D1E8E7ABEF,$4971A48769272C93
   Data.q $A482E924BE9465B9,$EB1AB7F692F3A4BA,$38B1D56CED25C63A,$E606EC0031D8AB32,$797B2599B3379D25
   Data.q $F972DF39F0E80860,$BAEBF02F40D3C083,$1FA01980F7666043,$59492ED25F780778,$92B39D2FCB9013A0
   Data.q $7EB9703E02ED24BA,$5666021F5BEB96E0,$64F21C0838117494,$5DC0603F7E33C6FB,$26F002E227BAFE3F
   Data.q $C56668B81EF80070,$2DE0305C86B1DEFB,$CF61C5F8026013E0,$1749F98715033F02,$C7E9A69EFC657869
   Data.q $C601B133331C9249,$4933E92832A54AB3,$49DF495549529233,$3A48AF4916D24D7A,$753E92D3FBE6A925
   Data.q $66F84AACCC9D15B9,$9D63D3406A04EA48,$9179E9B811CA6FF1,$BFDFDFDF303AFDF1,$CE31EB7572CCFEAA
   Data.q $01E807BD7AF57D01,$1A606E812603729E,$73D57D7DDB62EED8,$67A69A5CF8C62862,$2A8166079A498D25
   Data.q $D4941D7FD2CCCF70,$0EDBFCDB07B9F40D,$377B54E23E318B6C,$397B94EA93D5B084,$09F8137424E33C04
   Data.q $8C7CF006F115E5B8,$5702284217202FF1,$5A81173E9FC0EB80,$249367D34D217806,$BA0118146D9DEAD9
   Data.q $44210CEC63160842,$ABDA27A4E049C92F,$38027002E6475EC0,$842078C623BA09ED,$E8DC278018C633B0
   Data.q $432718C72803702A,$249ABB56AD4CA508,$5B8B74AE6A37CE49,$8C63E60018421C3C,$DEA74DC7B9F4210A
   Data.q $87BC8AAF1DE17E3B,$CCBACC0A421081F5,$431400B8C633703C,$66CD9B9708425708,$450F0EC72F0524D9
   Data.q $C718C77607901B8F,$A4C48ECBD999CD24,$47218E2CA8E1BD9F,$6CE338A1EA3C01AE,$9D5AB574C00A045A
   Data.q $ECFCE6005AEAEAEA,$A48F52428DCECB7F,$92C3A4BCB9B9B9FE,$4B2A486A48AA4BAE,$9A486EBE6373F31A
   Data.q $A488D24474925495,$B2D6988F8B3D4901,$EFFA2CCC9D94CB0C,$5015EDEDED9B3305,$643D97CC39F638F2
   Data.q $4A4E33AFBACD9B34,$5B33156664065009,$646B329495B17D70,$BA1CF7CF9F6011C2,$1CF21CDFA4B6F02C
   Data.q $9798CCE833C3DB70,$E88E23742621BD34,$B7A4E92D7D25119F,$263FE1DD5EB3AAE1,$4973E920BB3F4BE9
   Data.q $78F7172ADD122B23,$E7380AFAD1CF7963,$81F79170F80FB015,$EF022F82CE0FC0C3,$8618BB7C017CB57A
   Data.q $CF61E00EA4B15335,$017F59C08FC0D3E2,$CF3E24A57B8F0075,$C8DC3FC4670D21BB,$D6359982A4876001
   Data.q $84E035E9EE720BD3,$725D24D5EC969599,$F25B56664BE7CD6F,$B892BCE0A9233E62,$A14285241F9AC6AE
   Data.q $74717CB96B9C5EE6,$A8AD6E8B49666B7A,$B6F50A142C572392,$7B8E92DD7B0AF15A,$613D6EB29EF71DC2
   Data.q $8C6364F952BC5695,$69E8EDB39F698157,$84254CCCCCC17FFB,$BB33250842FA0250,$935D257B490F66CD
   Data.q $743683611D5DB7B4,$E144CDC04B96C700,$37FF2BB594D4D4D0,$8A413BB5248ACC71,$444E454900000000
   Data.b $AE,$42,$60,$82
   flake_png_end:
EndDataSection

Re: Snowman by the Lake

Posted: Mon Dec 23, 2013 10:18 pm
by BasicallyPure
Thanks to kvitaliy and J. Baker for the music addition.

I have made a slight change to the reflection 'mirror' coding.
I think the water looks nicer with this change.
You may want to update your copy of the code if you like it.

Code: Select all

      For x = 0 To Xmax ; mirror
         For y = Shore(x) To Ymax
            d = Shore(x)<<1 - y
            If d < 0 : d = 0 : EndIf
            t = Point(x,d)
            Plot(x,y,RGB(Red(t)*0.7,Green(t)*0.7,Blue(t)|$10*0.7)) ; <--- this line changed
         Next y
      Next x
If anyone knows how to mirror an image around an irregular line (shore line) please show me how.
Notice the reflection is distorted, especially noticeable with the snowman.
This was not my intent but it looks ok for this purpose.
BP

Re: Snowman by the Lake

Posted: Tue Dec 24, 2013 7:31 am
by BasicallyPure
Added moon and stars.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited