BBC BASIC for Windows
« Snowfall »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 10:18pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Snowfall  (Read 672 times)
David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Snowfall
« Thread started on: Nov 10th, 2016, 11:46pm »

This can be made so much more interesting, in numerous ways.

Code:
      REM "Snowfall" // v1.0 (11-Nov-2016)
      REM Works with BB4W and BBCSDL

      *ESC OFF

      REM Make 5 MB available for this program:
      M% = 5
      HIMEM = LOMEM + M%*&100000
      HIMEM = (HIMEM + 3) AND -4

      BB4W% = (INKEY(-256) == &57)

      IF BB4W% THEN
        GetTicks$ = "GetTickCount"
        SetWindowText$ = "SetWindowText"
      ELSE
        GetTicks$ = "SDL_GetTicks"
        SetWindowText$ = "SDL_SetWindowTitle"
      ENDIF

      ScrW% = 800
      ScrH% = 600
      VDU 23,22,ScrW%;ScrH%;8,16,16,0 : OFF

      REM Create full-screen (or full-window) background bitmap:
      DIM bmp{ a%, w%, h% }
      bmp.w% = ScrW%
      bmp.h% = ScrH%
      bmp.a% = FNcreateBMP32( bmp.w%, bmp.h% )

      PROCInitGLIB( g{}, bmp.w%, bmp.h% )
      g.a% = bmp.a% + 54

      REM Create background image:
      bgImg% = FNmalloc( 4*ScrW%*ScrH% )
      FOR Y% = 0 TO ScrH%-1
        f = 1 - (Y%/(ScrH%-1))^2
        C% = &10000*INT(150*f) OR &100*INT(160*f) OR INT(255*f)
        L% = bgImg%+4*Y%*ScrW%
        FOR I% = L% TO L%+4*(ScrW%-1) STEP 4
          !I% = C%
        NEXT
      NEXT

      REM Create 4x4 snowflake sprites:
      numSnowflakes% = 500
      numFlakeTypes% = 100 : REM By 'type' I mean opacity level
      flakeSize% = 4
      DIM flakeAddr%( numFlakeTypes%-1 )
      FOR I% = 0 TO numFlakeTypes%-1
        flakeAddr%(I%) = FNmalloc(4*flakeSize%^2)
      NEXT I%
      FOR J% = 0 TO numFlakeTypes%-1
        C% = &FFFFFF OR INT((255*J%/(numFlakeTypes%-1)) << 24)
        FOR I% = flakeAddr%(J%) TO flakeAddr%(J%)+4*flakeSize%^2-1 STEP 4
          !I% = C%
        NEXT
      NEXT
      DIM flake{(numSnowflakes%-1) type%, x%, y}
      FOR I% = 0 TO numSnowflakes%-1
        flake{(I%)}.type% = (numFlakeTypes%-1)*I%/(numSnowflakes%-1)
        flake{(I%)}.x% = RND(ScrW%)-1
        flake{(I%)}.y = RND(ScrH%)-1
      NEXT

      frames% = 0
      frameRate% = 0
      SYS GetTicks$ TO time0%

      TIME = 0

      REPEAT
  
        SYS BPlot, g{}, bgImg%, ScrW%, ScrH%, 0, 0
  
        G% = g{}
        P% = PlotAlphaBlend
        FOR I% = 0 TO numSnowflakes%-1
          T% = flake{(I%)}.type%
          SYS P%, G%, flakeAddr%(T%), 4, 4, flake{(I%)}.x%, flake{(I%)}.y
          f = T%/(numFlakeTypes%-1)
          flake{(I%)}.y -= f*2
          IF flake{(I%)}.y < -flakeSize% THEN
            flake{(I%)}.x% = RND(ScrW%)-1
            flake{(I%)}.y = ScrH%-1
          ENDIF
        NEXT
  
        OSCLI "MDISPLAY "+STR$~bmp.a%
  
        frames% += 1
        SYS GetTicks$ TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS SetWindowText$, @hwnd%, STR$frameRate% + " fps"
          SYS GetTicks$ TO time0%
        ENDIF
  
        WAIT 1
  
      UNTIL FALSE
      END

      DEF FNcreateBMP32( W%, H% )
      LOCAL A%, S%
      S% = 54 + 4*W%*H% + 6
      DIM A% S%-1
      A% = ((A% + 3) AND -4) + 2
      A%?0 = ASC"B"
      A%?1 = ASC"M"
      A%!2 = 54 + 4*W%*H%
      A%!6 = 0
      A%!10 = 54
      A%!14 = 40
      A%!18 = W%
      A%!22 = H%
      A%?26 = 1
      A%?28 = 32
      A%!30 = 0
      A%!34 = 4*W%*H%
      A%!38 = 0
      A%!42 = 0
      A%!46 = 0
      A%!50 = 0
      = A%

      REM ============================================================================
      REM ============================================================================
      REM ============================================================================
      REM ============================================================================

      DEFFNGetGLIBVer:="0.01zz"
      DEFPROCInitGLIB(RETURN v{},W%,H%):LOCALS%,Z%:DIMv{a%,w%,h%}
      v.w%=W%
      v.h%=H%
      Z%=FNmalloc(4096)
      S%=FNmalloc(2048)
      $S%="608B5C2424C703FFFFFFFF8B7C24383B7C24280F8DC70000008B74243C3B74242C0F8DB9"
      $S%+="0000008B4C24308B54243483F9007D03F7D99083FA007D03F7DA90F7D93BF90F8E970000"
      $S%+="00F7DA3BF20F8E8D000000F7D9F7DAC70300000000C7430400000000C7430800000000C7"
      $S%+="430C00000000894B10895314897B1889731C8BEF03E93B6C24287E0E2B6C2428296B10C7"
      $S%+="4304FFFFFFFF83FF007D14297B0C017B10C7431800000000C74304FFFFFFFF8BEE03EA3B"
      $S%+="6C242C7E0E2B6C242C296B14C74304FFFFFFFF83FE007D14297308017314C7431C000000"
      $S%+="00C74304FFFFFFFF61C21C0060":gClip=FN`m(S%,0)
      $S%="608BEC81EC800000008B75248BC4FF7538FF7534FF7530FF752CFF7608FF760450E85FFE"
      $S%+="FFFFF70424FFFFFFFF0F85570000008B552C89542434C1642434020FAF5424080354240C"
      $S%+="C1E2020355288B7E04897C2438C1642438020FAF7C241C037C2418C1E702033E8BF28B5C"
      $S%+="24108B4424348B5424388B6C241456578BCBFCF3A55F5E03F003FA4D7FF081C480000000"
      $S%+="61C218008B":BPlot=FN`m(S%,33)
      $S%="608BEC81EC800000008B75248BC4FF7538FF7534FF7530FF752CFF7608FF760450E85FFE"
      $S%+="FFFFF70424FFFFFFFF0F85690000008B552C89542434C1642434020FAF5424080354240C"
      $S%+="C1E2020355288B7E04897C2438C1642438020FAF7C241C037C2418C1E702033E8B5C2410"
      $S%+="33C98B048AA9000000FF740F3D000000FF722725FFFFFF0089048F83C1013BCB7CE00354"
      $S%+="2434037C2438FF4C241475D081C48000000061C218008BF0C1EE180FB66C8A020FB6448F"
      $S%+="022BE80FAFEEC1FD0803C588448F020FB66C8A010FB6448F012BE80FAFEEC1FD0803C588"
      $S%+="448F010FB62C8A0FB6048F2BE80FAFEEC1FD0803C588048FC6448F030083C1013BCB0F8C"
      $S%+="6EFFFFFF03542434037C2438FF4C24140F855AFFFFFF81C48000000061C2180060"
      PlotAlphaBlend=FN`m(S%,33)
      Z%=FNmalloc(4096)
      ENDPROC
      DEFFN`m(S%,O%)
      LOCALA%,I%:A%=FNmalloc(LEN$S%):FORI%=0TOLEN$S%DIV2-1
        A%?I%=EVAL("&"+MID$($S%,2*I%+1,2)):NEXT
      IFO%>0PROC`d(A%,O%,gClip)
      =A%
      DEFPROC`d(B%,O%,C%):LOCALD%,P%:D%=C%-B%-O%-5:P%=B%+O%+1:!P%=D%:ENDPROC
      DEFFNmalloc(N%):LOCALA%:DIM A% N%+7:A%=(A%+7) AND -8:=A%
      REM ****************************************************************************
 
User IP Logged

DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
xx Re: Snowfall
« Reply #1 on: Nov 11th, 2016, 08:28am »

Hi David,

I agree it's of limited visual interest, unless you subscribe to TV channels of a burning fire...

...However there's some interesting code there, that I will be playing with. I like the routine to set up a bitmap yourself, for example, and I'll have a think about your methods of memory allocation.

Could I interest you in adding a few lines of comments, just saying what the less obvious routines do? I think InitGLIB is "hard-coding" some assembler routines (effectively using FN'm to "assemble" them). I like the way you can then use these using SYS to pass parameters - guidance on how/why that works would be nice, since the machine code is pretty opaque...

Why is there a Z%=FNmalloc(4096) at the end of the routine? Doesn't that just throw away a pile of memory, since you'll lose the "handle" to it as you leave? REMming it out doesn't seem to matter, but maybe it does behind the scenes...

Best wishes,

D
User IP Logged

DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
xx Re: Snowfall
« Reply #2 on: Nov 11th, 2016, 1:22pm »

Ooh, I'd missed the significance of "works with BB4W and BBCSDL". Now I understand why you've written your own malloc and CreateBMP routines. So your PlotAlphaBlend is your own version of the Windows API call.

Is this roughly correct as an understanding of what happens?

You define a 32 bit bitmap, which you tell your GLIB about. You can then draw blocks of image data (rather than actual bitmaps) to it using the library.

You make a background image of the blue gradient

You make a set of "sprites" of the snowflake at each level of transparency: basically just a block of data containing the image data (including transparency data).

You define a set of snowflakes, each with its own position data, and index to a level of transparency.

You use BPLot to blast the background image onto your bitmap, at full opacity.

Then you use PlotAlphaBlend to add each snowflake, at the relevant transparency, to your bitmap.

You use the standard BB4W/BBCSDL *MDISPLAY command to copy your working bitmap to the BB4W display.

There are a few places where you seem to have an extra version of some variables - for example, you define P%=PlotAlphaBlend. Is that a legacy issue from development, or because you are passing the address of the routine in the pointer variable? SYS calls don't normally need the address to be passed in P%?

Thanks,
D
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Snowfall
« Reply #3 on: Nov 11th, 2016, 5:15pm »

on Nov 11th, 2016, 08:28am, DDRM wrote:
I agree it's of limited visual interest, unless you subscribe to TV channels of a burning fire...


I think I've actually spent an hour-or-so of my life watching one of those late-night log fires on some German TV channel. But that was a very long time ago. smiley


Quote:
I'll have a think about your methods of memory allocation.


After using DIM to allocate a block of memory, I then ensure that the start address of that memory block is divisible by 8 (although divisibility by 4 would suffice in this case). Certainly if MMX machine code instructions were used in the alpha blending routine (they're not), then (IIRC) divisibility by 8 is a must. Otherwise 4 will do.


Quote:
Could I interest you in adding a few lines of comments, just saying what the less obvious routines do? I think InitGLIB is "hard-coding" some assembler routines (effectively using FN'm to "assemble" them). I like the way you can then use these using SYS to pass parameters - guidance on how/why that works would be nice, since the machine code is pretty opaque...


The version of GLIB appended to the 'Snowfall' program is much reduced from the 'full' version which contains a lot more functionality, but which isn't compatible with BBCSDL. For instance, the full version of GLIB includes an image loader and converter (for loading BMP, JPEG and GIF images and converting them to 'raw' 32bpp ARGB bitmaps). It also includes code for synchronising animation with the monitor's refresh (again, not compatible with BBCSDL). Some other useful functions also had to be dropped.

You won't need reminding, but in case others are wondering... GLIB is a compact 'sprite' plotting library, the motivating idea being that it's minimally functional and small enough to be used with the Trial version of BB4W. Assembly language would have taken up too much memory, so I assembled the assembler code and then formatted the resulting binary machine code into strings.


Quote:
Why is there a Z%=FNmalloc(4096) at the end of the routine? Doesn't that just throw away a pile of memory, since you'll lose the "handle" to it as you leave? REMming it out doesn't seem to matter, but maybe it does behind the scenes...


That's to do with code/data separation - very important for speed purposes. There should be a gap (at least 2Kb, IIRC) between a machine code routine, and data that it accesses (if performance is critical). I'm probably going a bit overboard with 4Kb, but there's so much memory available these days! So I ensure that there are 4Kb 'gaps' either side of the machine code section.


Quote:
Is this roughly correct as an understanding of what happens?


What you go on to describe is correct.


Quote:
There are a few places where you seem to have an extra version of some variables - for example, you define P%=PlotAlphaBlend. Is that a legacy issue from development, or because you are passing the address of the routine in the pointer variable? SYS calls don't normally need the address to be passed in P%?


Accessing the resident static variables (A%, B%, ..., Z%) is slightly faster than accessing other types (notwithstanding BB4W's REM!Faster compiler directive), so I stuff the address of the alpha-blending sprite plotting routine (PlotAlphaBlend) into P%, and the base address of the structure g{} into G%. This speeds up execution a little (but probably only a little). I should have put the P% and G% variable assignments outside the main loop.

Sorry I didn't go into much detail, but must get ready for work now!


David.
--
User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Snowfall
« Reply #4 on: Nov 11th, 2016, 9:25pm »

Here's a blast from the past (many will have already seen this, I think). Try 150 to 200 snowflakes to begin with.


Code:
      REM. Tumbling Snowflakes (1)
      REM. Version 1.2 // 3.1.2013

      REM. Uses only standard BB4W graphics commands
      REM. (Does not use GFXLIB!)

      *ESC OFF

      *FLOAT 64

      ON ERROR PROC_error( REPORT$, TRUE )

      PROC_fixWindowSize

      MODE 8

      WinW% = @vdu%!208
      WinH% = @vdu%!212

      REPEAT
        INPUT '" How many snowflakes? (1 - 300): "flakes%
      UNTIL flakes% > 0 AND flakes% <= 300

      COLOUR 128, 200, 200, 250
      COLOUR 15, 255, 255, 255
      OFF

      pi2 = PI * 2
      scale = 20

      DIM flake{( flakes%-1 ) x, y, dy, a, b, c, da, db, dc, amp, theta, dtheta}
      DIM p(5,2), q(5,2), m(2,2)

      REM. Define 'snowflake' object
      FOR I% = 0 TO 5
        angle = 2*PI/6 * I%
        p(I%, 0) = 2*scale * SIN( angle )
        p(I%, 1) = 2*scale * COS( angle )
        p(I%, 2) = 0
      NEXT I%

      REM. Define initial snowflake params
      FOR I% = 0 TO flakes%-1
        PROC_newSnowflake( I%, FALSE )
      NEXT I%

      GCOL 15

      *REFRESH OFF

      REPEAT
  
        CLS
  
        FOR I% = 0 TO flakes%-1
    
          x = 2 * (flake{(I%)}.x + flake{(I%)}.amp * SINflake{(I%)}.theta)
          y = 2 * flake{(I%)}.y
    
          flake{(I%)}.y += flake{(I%)}.dy
          IF flake{(I%)}.y < -scale THEN
            PROC_newSnowflake( I%, TRUE )
          ENDIF
    
          flake{(I%)}.theta += flake{(I%)}.dtheta
    
          a = flake{(I%)}.a
          b = flake{(I%)}.b
          c = flake{(I%)}.c
    
          flake{(I%)}.a += flake{(I%)}.da
          flake{(I%)}.b += flake{(I%)}.db
          flake{(I%)}.c += flake{(I%)}.dc
    
          sA = SINa
          cA = COSa
          sB = SINb
          cB = COSb
          sC = SINc
          cC = COSc
    
          m() = cB*cC, -cA*sC+sA*sB*cC, sA*sC+cA*sB*cC, \
          \ cB*sC, cA*cC+sA*sB*sC, -sA*cC+cA*sB*sC, \
          \ -sB, sA*cB, cA*cB
    
          q() = p().m()
    
          MOVE x+q(0,0), y+q(0,1)
          MOVE x+q(2,0), y+q(2,1)
          PLOT 85, x+q(4,0), y+q(4,1)
          MOVE x+q(5,0), y+q(5,1)
          MOVE x+q(1,0), y+q(1,1)
          PLOT 85, x+q(3,0), y+q(3,1)
    
        NEXT
  
        *REFRESH
  
      UNTIL INKEY(1)=0
      END
      :
      :
      :
      :
      DEF PROC_newSnowflake( I%, R% )
      flake{( I% )}.x = WinW% * RND(1)
      IF R% THEN
        flake{( I% )}.y = WinH% + scale
      ELSE
        flake{( I% )}.y = WinH% * (1.0 + RND(1))
      ENDIF
      flake{( I% )}.dy = -(0.5 + 3.5*RND(1))
      flake{( I% )}.a = 2*PI * RND(1)
      flake{( I% )}.b = 2*PI * RND(1)
      flake{( I% )}.c = 2*PI * RND(1)
      flake{( I% )}.da = (RND(1)-RND(1)) / 10
      flake{( I% )}.db = (RND(1)-RND(1)) / 10
      flake{( I% )}.dc = (RND(1)-RND(1)) / 10
      flake{(I%)}.amp = 32 * RND(1)
      flake{(I%)}.theta = 2*PI * RND(1)
      flake{(I%)}.dtheta = (RND(1)-RND(1)) / 10
      ENDPROC
      :
      :
      :
      :
      DEF PROC_fixWindowSize
      LOCAL GWL_STYLE, WS_THICKFRAME, WS_MAXIMIZEBOX, ws%
      GWL_STYLE = -16
      WS_THICKFRAME = &40000
      WS_MAXIMIZEBOX = &10000
      SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
      SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws% AND NOT (WS_THICKFRAME+WS_MAXIMIZEBOX)
      ENDPROC
      :
      :
      :
      :
      DEF PROC_error( msg$, L% )
      OSCLI "REFRESH ON" : CLS : ON : *FONT
      COLOUR 128, 0, 0, 0 : COLOUR 128 : CLS
      COLOUR 1, &FF, &FF, &FF
      COLOUR 1
      PRINT TAB(1,1)msg$;
      VDU 7
      IF L% THEN
        PRINT " at line "; ERL;
      ENDIF
      REPEAT : SYS "Sleep", 10 : UNTIL FALSE
      ENDPROC
 



EDIT: Here's links to other blasts from the past. You can run the executables (EXE files), but not the source (.BBC) files unless you have GFXLIB installed (not currently available).

Google Drive:

https://drive.google.com/open?id=0B3j5sIQi9SskZEN6VVJZVkJLZnc
https://drive.google.com/open?id=0B3j5sIQi9SskWVZxSGJuU1ZWRDQ


David.
--
« Last Edit: Nov 11th, 2016, 9:54pm by David Williams » User IP Logged

David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Snowfall
« Reply #5 on: Nov 21st, 2016, 5:43pm »

Now the snow's tumbling...

Requires latest version of GLIB, available from here:

http://pastebin.com/Typpfjtg

Or, along with a compiled EXE, from here:

https://drive.google.com/open?id=0B3j5sIQi9SskakxkcDRDN2dSR1k

Ensure that GLIB is installed in BB4W's LIB folder.


Code:
      REM "Snowfall II"
      REM Requires GLIB v0.23+

      *ESC OFF
      ON ERROR PROCerror( REPORT$ + " at line " + STR$ERL )
      INSTALL @lib$ + "GLIB.BBC"
      PROCFixWindowSize
      MODE 8 : OFF
      PROCInitGLIB(g{}, glib{})
      ON CLOSE PROCCleanup : QUIT
      ON ERROR PROCCleanup : PROCerror( REPORT$ + " at line " + STR$ERL )

      ScrW% = @vdu%!208
      ScrH% = @vdu%!212
      PxlBuf% = FNmalloc( 4*320, -1 )
      DIM inVars{ bmAddr%, bmW%, bmH%, rectX%, rectY%, rectW%, rectH%, keyCol% }
      DIM outVars{ minX%, minY%, maxX%, maxY%, totalPxls%, totalKeyPxls%, totalNonKeyPxls% }
      NumSnowflakeBitmaps% = 32
      NumSnowflakes% = 200
      DIM SnowflakeBitmap{(NumSnowflakeBitmaps%-1) a%, w%, h%}
      DIM Snowflake{(NumSnowflakes%-1) i%, x0, xamp, xt, dxt, y, dy, minY, angle, angleinc, scale}
      inVars.bmAddr% = g.a%
      inVars.bmW% = g.w%
      inVars.bmH% = g.h%
      inVars.rectX% = 0
      inVars.rectY% = 0
      inVars.rectW% = ScrW%
      inVars.rectH% = ScrH%
      inVars.keyCol% = 0
      COLOUR 15, 255, 255, 255 : GCOL 15
      *REFRESH OFF
      FOR J% = 0 TO NumSnowflakeBitmaps%-1
        CLS
        FOR I% = 1 TO 10
          CIRCLE FILL 2*(ScrW%/2+64*(RND(1)-.5)), 2*(ScrH%/2+64*(RND(1)-0.5)), 2*(16+RND(15))
        NEXT I%
        SYS glib.ScanBitmap%, inVars{}, outVars{}
        outVars.minX% -= 4
        outVars.minY% -= 4
        outVars.maxX% += 4
        outVars.maxY% += 4
        X% = outVars.minX%
        Y% = outVars.minY%
        W% = outVars.maxX% - outVars.minX% + 1
        H% = outVars.maxY% - outVars.minY% + 1
        SnowflakeBitmap{(J%)}.a% = -1
        PROCGrab( g{}, glib{}, SnowflakeBitmap{(J%)}.a%, X%, Y%, W%, H%, \
        \ x%, y%, w%, h%, clipFlag%, rejectFlag% )
        SnowflakeBitmap{(J%)}.w% = W%
        SnowflakeBitmap{(J%)}.h% = H%
        FOR I% = 1 TO 3
          SYS glib.BoxBlur%, SnowflakeBitmap{(J%)}.a%, W%, H%, 3, PxlBuf%
        NEXT I%
        SYS glib.CopyToAlphaChannel%, SnowflakeBitmap{(J%)}.a%, W%, H%, 1, 0
        SYS glib.PremultiplyAlpha%, SnowflakeBitmap{(J%)}.a%, W%, H%
      NEXT J%

      CLS : COLOUR 2
      *FONT "TIMES", 96, B
      PRINT '" SNOW"
      *FONT
      COLOUR 7

      SYS glib.ScanBitmap%, inVars{}, outVars{}
      outVars.minX% -= 4
      outVars.minY% -= 4
      outVars.maxX% += 4
      outVars.maxY% += 4
      X% = outVars.minX%
      Y% = outVars.minY%
      snowBmW% = outVars.maxX% - outVars.minX% + 1
      snowBmH% = outVars.maxY% - outVars.minY% + 1
      snowBm% = -1
      PROCGrab( g{}, glib{}, snowBm%, X%, Y%, snowBmW%, snowBmH%, \
      \ x%, y%, w%, h%, clipFlag%, rejectFlag% )

      FOR I% = 0 TO NumSnowflakes%-1
        f = I%/(NumSnowflakes%-1)
        Snowflake{(I%)}.i% = RND(NumSnowflakeBitmaps%)-1
        Snowflake{(I%)}.x0 = 640*RND(1)
        Snowflake{(I%)}.y = 512*RND(1)
        Snowflake{(I%)}.dy = -(0.5 + 1.5*f)
        Snowflake{(I%)}.angle = RND(360)
        Snowflake{(I%)}.angleinc = (0.5 + 1.5*RND(1)) * SGN(RND(1)-0.5)
        Snowflake{(I%)}.scale = (0.125 + f*0.125*RND(1)) * &10000
        Snowflake{(I%)}.minY = -SnowflakeBitmap{( Snowflake{(I%)}.i% )}.h% * Snowflake{(I%)}.scale/&10000
        Snowflake{(I%)}.xamp = 5 + 30*RND(1)
        Snowflake{(I%)}.xt = 2*PI*RND(1)
        Snowflake{(I%)}.dxt = 0.01 + 0.01*f*RND(1)
      NEXT I%

      GetTickCount% = FNSYS_NameToAddress("GetTickCount")

      TIME = 0

      frames% = 0
      frameRate% = 0

      SYS GetTickCount% TO time0%
      REPEAT
        SYS glib.ClrLG%, g{}, &D0D0FF, &000040
        G% = g{}
        P% = glib.PlotRotateScaleBilinear%
        FOR I% = 0 TO NumSnowflakes%-1
          i% = Snowflake{(I%)}.i%
          x = Snowflake{(I%)}.x0 + Snowflake{(I%)}.xamp*SIN(Snowflake{(I%)}.xt)
          SYS P%, G%, SnowflakeBitmap{(i%)}.a%, SnowflakeBitmap{(i%)}.w%, SnowflakeBitmap{(i%)}.h%, \
          \ 16*x, 16*Snowflake{(I%)}.y, &10000*Snowflake{(I%)}.angle, Snowflake{(I%)}.scale
          Snowflake{(I%)}.angle += Snowflake{(I%)}.angleinc
          IF ABSSnowflake{(I%)}.angle >= 360 THEN
            Snowflake{(I%)}.angle -= Snowflake{(I%)}.angle
          ENDIF
          Snowflake{(I%)}.y+=Snowflake{(I%)}.dy
          IF Snowflake{(I%)}.y < Snowflake{(I%)}.minY THEN
            Snowflake{(I%)}.x0 = 640*RND(1)
            Snowflake{(I%)}.y = ScrH%-Snowflake{(I%)}.minY
          ENDIF
          Snowflake{(I%)}.xt += Snowflake{(I%)}.dxt
        NEXT I%
        SYS glib.PlotShadow%, G%, snowBm%, snowBmW%, snowBmH%, (ScrW%-snowBmW%)/2-12, (ScrH%-snowBmH%)/2-12
        SYS glib.PlotBlend%, G%, snowBm%, snowBmW%, snowBmH%, (ScrW%-snowBmW%)/2, (ScrH%-snowBmH%)/2, 220
        PRINT TAB(2,1);frameRate%;" fps"
        PROCDisplay(TRUE)
        frames% += 1
        SYS GetTickCount% TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS GetTickCount% TO time0%
        ENDIF
      UNTIL FALSE
      PROCCleanup
      REPEAT UNTIL INKEY(1)=0
      END

      DEF PROCerror(s$)
      OSCLI "REFRESH ON"
      ON : CLS : COLOUR 7, 160, 160, 160 : COLOUR 7
      PRINT '" " + s$;
      VDU 7
      REPEAT UNTIL INKEY(1)=0
      ENDPROC
 

User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
laugh Re: Snowfall
« Reply #6 on: Nov 21st, 2016, 6:48pm »

Amazing work

And thanks for the snow

I had to put the GLIB in a different directory, and made it local in the INSTALL "GLIB.BBC"
« Last Edit: Nov 21st, 2016, 6:52pm by michael » User IP Logged

I like making program generators and like reinventing the wheel
David Williams
Developer

member is offline

Avatar

meh


PM

Gender: Male
Posts: 452
xx Re: Snowfall
« Reply #7 on: Nov 22nd, 2016, 07:29am »

Now with more, slightly fluffier snow, a snowman, flashing lights and music. To run the program listed below, you'll need the latest version of GLIB (v0.24 beta), available from here:

http://pastebin.com/BZBKQSLi

Or from this Zip folder which contains GLIB, a compiled EXE, and the source code:

https://drive.google.com/open?id=0B3j5sIQi9SskaVlqTlMtREgxUjg

GLIB.BBC needs to go in BB4W's LIB folder.

Code:
      REM "Snowfall III"
      REM Now with more snowflakes, a snowman, coloured lights, and a tune.
      REM Requires GLIB v0.24+

      *ESC OFF
      ON ERROR PROCerror( REPORT$ + " at line " + STR$ERL )
      INSTALL @lib$ + "GLIB.BBC"
      PROCFixWindowSize
      MODE 8 : OFF
      PROCInitGLIB(g{}, glib{})
      ON CLOSE SOUND OFF : PROCCleanup : QUIT
      ON ERROR SOUND OFF : PROCCleanup : PROCerror( REPORT$ + " at line " + STR$ERL )

      DIM g2{} = g{}

      file$ = @tmp$ + "snowman_256x359_gif.GIF"
      file% = OPENIN( file$ )
      IF file% = 0 THEN
        url$ = "https://i.imgbox.com/z7pse7CC.gif"
        PROCurldownload(url$, file$)
      ENDIF
      CLOSE#file%
      snowman% = FNLoadImg( file$, -1 )
      snowmanW% = 256
      snowmanH% = 359

      file$ = @tmp$ + "silent_night_midi.MID"
      file% = OPENIN( file$ )
      IF file% = 0 THEN
        url$ = "http://www.westnet.com/Holiday/midi/09silen&.mid"
        PROCurldownload(url$, file$)
      ENDIF
      CLOSE#file%
      SOUND OFF
      OSCLI "PLAY """+file$+""""

      ScrW% = @vdu%!208
      ScrH% = @vdu%!212
      PxlBuf% = FNmalloc( 4*320, -1 )
      MskBuf% = FNmalloc( 4*256^2, -1 )
      DIM inVars{ bmAddr%, bmW%, bmH%, rectX%, rectY%, rectW%, rectH%, keyCol% }
      DIM outVars{ minX%, minY%, maxX%, maxY%, totalPxls%, totalKeyPxls%, totalNonKeyPxls% }
      NumSnowflakeBitmaps% = 32
      NumSnowflakes% = 300
      NumStars% = 20
      DIM star{( NumStars%-1 ) opacity%, x%, y%, tint%}
      DIM SnowflakeBitmap{(NumSnowflakeBitmaps%-1) a%, w%, h%}
      DIM Snowflake{(NumSnowflakes%-1) i%, x0, xamp, xt, dxt, y, dy, minY, angle, angleinc, scale}
      inVars.bmAddr% = g.a%
      inVars.bmW% = g.w%
      inVars.bmH% = g.h%
      inVars.rectX% = 0
      inVars.rectY% = 0
      inVars.rectW% = ScrW%
      inVars.rectH% = ScrH%
      inVars.keyCol% = 0
      COLOUR 15, 255, 255, 255 : GCOL 15
      *REFRESH OFF

      _PREMULTIPLY = &1
      _INVERT = &8
      _2MRPASS = 0 * (2<<4)
      _3MRPASS = 3<<4
      _3MBBPASS = 3<<6
      _MBBKSIZE5 = 1<<8

      FOR J% = 0 TO NumSnowflakeBitmaps%-1
        CLS
        FOR I% = 1 TO 10
          CIRCLE FILL 2*(ScrW%/2+64*(RND(1)-.5)), 2*(ScrH%/2+64*(RND(1)-0.5)), 2*(16+RND(15))
        NEXT I%
        SYS glib.ScanBitmap%, inVars{}, outVars{}
        outVars.minX% -= 4
        outVars.minY% -= 4
        outVars.maxX% += 4
        outVars.maxY% += 4
        X% = outVars.minX%
        Y% = outVars.minY%
        W% = outVars.maxX% - outVars.minX% + 1
        H% = outVars.maxY% - outVars.minY% + 1
        SnowflakeBitmap{(J%)}.a% = -1
        PROCGrab( g{}, glib{}, SnowflakeBitmap{(J%)}.a%, X%, Y%, W%, H%, \
        \ x%, y%, w%, h%, clipFlag%, rejectFlag% )
        SnowflakeBitmap{(J%)}.w% = W%
        SnowflakeBitmap{(J%)}.h% = H%
        C% = _PREMULTIPLY + _INVERT + _3MRPASS + _MBBKSIZE5 + _3MBBPASS
        PROCCreateAlphaMask(g{}, glib{}, SnowflakeBitmap{(J%)}.a%, W%, H%, 0, C%)
      NEXT J%

      CLS : COLOUR 2
      *FONT "TIMES", 96, B
      PRINT '" 2016"
      *FONT
      COLOUR 7

      SYS glib.ScanBitmap%, inVars{}, outVars{}
      outVars.minX% -= 4
      outVars.minY% -= 4
      outVars.maxX% += 4
      outVars.maxY% += 4
      X% = outVars.minX%
      Y% = outVars.minY%
      snowBmW% = outVars.maxX% - outVars.minX% + 1
      snowBmH% = outVars.maxY% - outVars.minY% + 1
      snowBm% = -1
      PROCGrab( g{}, glib{}, snowBm%, X%, Y%, snowBmW%, snowBmH%, \
      \ x%, y%, w%, h%, clipFlag%, rejectFlag% )

      CLS
      N% = 12
      x0% = 320
      y0% = 256
      Rmax% = 180
      Rmin% = Rmax%/3
      MOVE 2*x0%, 2*(y0%+Rmax%)
      FOR I% = 0 TO 2*N%
        IF (I% MOD 2) = 0 THEN R%=Rmax% ELSE R%=Rmin%
        X% = x0% + R%*SIN(2*PI*I%/(2*N%))
        Y% = y0% + R%*COS(2*PI*I%/(2*N%))
        DRAW 2*X%, 2*Y%
      NEXT I%
      COLOUR 15, 255, 255, 255 : GCOL 15
      FILL 2*x0%, 2*y0%
      SYS glib.ScanBitmap%, inVars{}, outVars{}
      outVars.minX% -= 4
      outVars.minY% -= 4
      outVars.maxX% += 4
      outVars.maxY% += 4
      X% = outVars.minX%
      Y% = outVars.minY%
      starBmW% = outVars.maxX% - outVars.minX% + 1
      starBmH% = outVars.maxY% - outVars.minY% + 1
      starBm% = -1
      PROCGrab( g{}, glib{}, starBm%, X%, Y%, starBmW%, starBmH%, \
      \ x%, y%, w%, h%, clipFlag%, rejectFlag% )
      starW% = 48
      starH% = 48
      star% = FNmalloc( 4*starW%*starH%, -1 )
      g2.a% = star%
      g2.w% = starW%
      g2.h% = starH%
      SYS glib.PlotRotateScaleBilinear%, g2{}, starBm%, starBmW%, starBmH%, \
      \ 16*starW%/2, 16*starH%/2, 0, 0.125*&10000

      FOR I% = 0 TO NumSnowflakes%-1
        f = I%/(NumSnowflakes%-1)
        Snowflake{(I%)}.i% = RND(NumSnowflakeBitmaps%)-1
        Snowflake{(I%)}.x0 = 640*RND(1)
        Snowflake{(I%)}.y = 512*RND(1)
        Snowflake{(I%)}.dy = -(0.5 + 1.5*f)
        Snowflake{(I%)}.angle = RND(360)
        Snowflake{(I%)}.angleinc = (0.5 + 1.5*RND(1)) * SGN(RND(1)-0.5)
        Snowflake{(I%)}.scale = (0.125 + f*0.125*RND(1)) * &10000
        Snowflake{(I%)}.minY = -SnowflakeBitmap{( Snowflake{(I%)}.i% )}.h% * Snowflake{(I%)}.scale/&10000
        Snowflake{(I%)}.xamp = 5 + 30*RND(1)
        Snowflake{(I%)}.xt = 2*PI*RND(1)
        Snowflake{(I%)}.dxt = 0.01 + 0.01*f*RND(1)
      NEXT I%

      GetTickCount% = FNSYS_NameToAddress("GetTickCount")
      SetWindowText% = FNSYS_NameToAddress("SetWindowText")

      FOR I% = 0 TO NumStars%-1 : star{(I%)}.opacity%=0 : NEXT

      TIME = 0

      frames% = 0
      frameRate% = 0

      SYS GetTickCount% TO time0%

      REPEAT
  
        G% = g{}
        P% = glib.PlotRotateScaleRTR%
  
        SYS glib.ClrLG%, G%, &D0D0FF, &000040
  
        SYS glib.Plot%, G%, snowman%, snowmanW%, snowmanH%, (ScrW%-snowmanW%)/2, 0
  
        FOR I% = 0 TO NumSnowflakes%-1
          i% = Snowflake{(I%)}.i%
          x = Snowflake{(I%)}.x0 + Snowflake{(I%)}.xamp*SIN(Snowflake{(I%)}.xt)
          SYS P%, G%, SnowflakeBitmap{(i%)}.a%, SnowflakeBitmap{(i%)}.w%, SnowflakeBitmap{(i%)}.h%, \
          \ 16*x, 16*Snowflake{(I%)}.y, &10000*Snowflake{(I%)}.angle, Snowflake{(I%)}.scale
          Snowflake{(I%)}.angle += Snowflake{(I%)}.angleinc
          IF ABSSnowflake{(I%)}.angle >= 360 THEN
            Snowflake{(I%)}.angle -= Snowflake{(I%)}.angle
          ENDIF
          Snowflake{(I%)}.y+=Snowflake{(I%)}.dy
          IF Snowflake{(I%)}.y < Snowflake{(I%)}.minY THEN
            Snowflake{(I%)}.x0 = 640*RND(1)
            Snowflake{(I%)}.y = ScrH%-Snowflake{(I%)}.minY
          ENDIF
          Snowflake{(I%)}.xt += Snowflake{(I%)}.dxt
        NEXT I%
  
        x0% = (ScrW% - snowBmW%)/2 - 8
        y0% = 380-8
        t = TIME/120
        k = 2*PI
        FOR Y% = 0 TO snowBmH%-1
          f = k*Y%/(snowBmH%-1)
          X% = x0% + 8*SIN(f+t)
          SYS glib.PlotShadow%, G%, snowBm% + 4*snowBmW%*Y%, snowBmW%, 1, X%, y0%+Y%
        NEXT
  
        x0% = (ScrW% - snowBmW%)/2
        y0% = 380
        FOR Y% = 0 TO snowBmH%-1
          f = k*Y%/(snowBmH%-1)
          X% = x0% + 8*SIN(f+t)
          SYS glib.PlotBlend%, G%, snowBm% + 4*snowBmW%*Y%, snowBmW%, 1, X%, y0%+Y%, 200
        NEXT
  
        IF RND(20) = 1 THEN
          FOR I% = 0 TO NumStars%-1
            IF star{(I%)}.opacity% = 0 THEN
              star{(I%)}.opacity% = 255
              star{(I%)}.x% = RND(ScrW%)-starW%/2 - 1
              star{(I%)}.y% = RND(ScrH%)-starH%/2 - 1
              CASE RND(10) OF
                WHEN 1 : star{(I%)}.tint% = &80FF00
                WHEN 2 : star{(I%)}.tint% = &FF8000
                WHEN 3 : star{(I%)}.tint% = &FF80FF
                WHEN 4 : star{(I%)}.tint% = &FF00FF
                WHEN 5 : star{(I%)}.tint% = &FFFF00
                WHEN 6 : star{(I%)}.tint% = &8080FF
                WHEN 7 : star{(I%)}.tint% = &80FF80
                WHEN 8 : star{(I%)}.tint% = &FFA080
                WHEN 9 : star{(I%)}.tint% = &FFFFFF
                WHEN 10 : star{(I%)}.tint% = &FF0000
              ENDCASE
              EXIT FOR
            ENDIF
          NEXT
        ENDIF
  
        FOR I% = 0 TO NumStars%-1
          IF star{(I%)}.opacity% > 0 THEN
            SYS glib.PlotTintBlend%, G%, star%, starW%, starH%, star{(I%)}.x%, star{(I%)}.y%, \
            \ star{(I%)}.tint%, 256, star{(I%)}.opacity%
            star{(I%)}.opacity% -= 4
            IF star{(I%)}.opacity% < 0 THEN star{(I%)}.opacity% = 0
          ENDIF
        NEXT
  
        PROCDisplay(TRUE)
  
        frames% += 1
        SYS GetTickCount% TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS SetWindowText%, @hwnd%, STR$frameRate%+" fps"
          SYS GetTickCount% TO time0%
        ENDIF
  
      UNTIL FALSE
      PROCCleanup
      REPEAT UNTIL INKEY(1)=0
      END

      DEF PROCerror(s$)
      OSCLI "REFRESH ON"
      ON : CLS : COLOUR 7, 160, 160, 160 : COLOUR 7
      PRINT '" " + s$;
      VDU 7
      REPEAT UNTIL INKEY(1)=0
      ENDPROC

      DEF PROCurldownload(url$, file$)
      LOCAL urlmon%, res%
      SYS "LoadLibrary", "urlmon.dll" TO urlmon%
      SYS "GetProcAddress", urlmon%, "URLDownloadToFileA" TO `URLDownloadToFile`
      SYS `URLDownloadToFile`, 0, url$, file$, 0, 0 TO res%
      SYS "FreeLibrary", urlmon%
      IF res% ERROR 100, "Couldn't download "+url$
      ENDPROC
 

User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls