Board Logo
« Snow Balls »

Welcome Guest. Please Login or Register.
Sep 25th, 2017, 7:20pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ


« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: Snow Balls  (Read 678 times)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Snow Balls
« Thread started on: Nov 1st, 2016, 07:42am »

Hi Rod! It just so happens I was working on a version of Paint Balls called Snow Balls. Ha! what a coincidence.

Code:
' Snow Balls.txt for JB [B+=MGA] 2016-11-01
' a variation on Paint Balls, try one color but at various sizes

' Goal: Test a version of UnDo by tracking x, y, size.
' Success - you can undo all the way back to the beginning!

' The bmp pictures can be saved as Snow Balls date_time stamp.bmp

' The last saved array is called Snow Balls.dat,
' that is the one that will be loaded from Array Load menu.
' If you want to save several arrays, you could rename them
' then rename them back to Snow Balls.dat to rework them.


global H$, XMAX, YMAX, size, ballIndex, nBalls, nBm1, sky$, white$

H$ = "gr"
XMAX = 1200 '< actual drawing space needed
YMAX = 700  '< actual drawing space needed
size = 100
nBalls = 500
nBm1 = nBalls - 1
sky$ = "130 180 220"
white$ = "220 220 245"
nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 100
UpperLeftY = 40

menu #gr, "Menu", "Size", resize, "Clear", CLR, "Undo", undo, "Save Picture", save
menu #gr, "Array", "Load", loadArr, "Save", saveArr
open "Snow Balls" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lBU"
#gr "down"
call CLR
wait

' Window procedures in order of appearance above

sub resize
    t$ = "Snow Ball Size" + chr$(13)
    c$ = "Current size is " + str$(size)
    p$ = " pixel radius.  Enter new size desired (max is screen height/2)."
    prompt t$ + c$ + p$; inp$
    test = val(inp$)
    if test > 0 and test < YMAX/2 then size = test
end sub

sub CLR
    call clrScreen
    call clrBalls
end sub

sub undo
    if ballIndex > 0 then
        ballIndex = ballIndex - 1
        call rebuild
    end if
end sub

sub save
    #gr "getbmp scr 0 0 ";XMAX;" ";YMAX
    d$ = date$("yyyy/mm/dd")
    d$ = mid$(d$, 1, 4) + "-" + mid$(d$, 6, 2) + "-" + mid$(d$, 9, 2)
    t$ = time$()
    t$ = mid$(t$, 1, 2) + "_" + mid$(t$, 4, 2)
    bmpsave "scr", "Snow Ball " + d$ + "-" + t$ + ".bmp"
end sub

sub loadArr
    'make sure a file exits
    open "Snow Balls.dat" for append as #1
    print #1, ""
    close #1
    open "Snow Balls.dat" for input as #1
    ballIndex = 0
    while eof(#1) = 0
        input #1, fline$
        if trim$(fline$) <> "" then
            ballX(ballIndex) = val(word$(fline$, 1))
            ballY(ballIndex) = val(word$(fline$, 2))
            ballS(ballIndex) = val(word$(fline$, 3))
            ballIndex = ballIndex + 1
        end if
    wend
    close #1
    call rebuild
end sub

sub saveArr
    open "Snow Balls.dat" for output as #1
    for i = 0 to ballIndex -1
        print #1, str$(ballX(i)) + " " + str$(ballY(i)) + " " + str$(ballS(i))
    next
    close #1
end sub

sub quit H$
    close #H$
    end
end sub

sub lBU H$, x, y
    call ball x, y, size
    if ballIndex < nBalls then
        ballX(ballIndex) = x
        ballY(ballIndex) = y
        ballS(ballIndex) = size
        ballIndex = ballIndex + 1
    end if
end sub

'=================================== supplementary procedures

sub clrScreen
    #gr "fill ";sky$
    #gr "backcolor "; white$
    #gr "color "; white$
    #gr "place "; 0; " "; YMAX - 100;
    #gr "boxfilled "; XMAX + 1; " "; YMAX + 1
end sub

sub clrBalls
    ballIndex = 0
    dim ballX(nBm1), ballY(nBm1), ballS(nBm1)
end sub

sub ball x, y, s
    for r = s to 0 step -1
        cc = int(r/s * 100) + 155
        #gr "color ";cc;" ";cc;" ";cc
        #gr "backcolor ";cc;" ";cc;" ";cc
        #gr "place ";x;" ";y;"; circlefilled ";r
    next
end sub

sub rebuild
    if ballIndex > 0 then
        call clrScreen
        for i = 0 to ballIndex -1
            call ball ballX(i), ballY(i), ballS(i)
        next
    end if
end sub
 


And here is a Frosty, use for your array file to get started (and see my picture).

Snow Balls.dat (in same folder as Snow Balls JB code):
Code:
543 472 200
533 269 100
527 165 50
527 160 4
526 162 8
504 158 5
548 155 5
511 182 5
516 187 5
522 188 5
528 188 5
533 187 5
540 183 5
47 580 40
420 225 40
664 237 40
379 272 40
345 308 40
701 226 40
739 208 40
745 185 25
749 149 25
753 119 25
342 331 25
360 353 25
376 374 25
78 605 25
43 621 25
 


For the kids (in all of us)!
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #1 on: Nov 3rd, 2016, 03:02am »

Snow Balls 2, sets up for Snow Machine.

Make something with Snow Balls 2 and Array > Save to create two files for Snow machine one is a background.bmp and the other is a data array of origins and sizes of the snow balls to be recreated as virtual screen in Snow Machine.

Snow Machine will put the scene in a snow storm with snow accumulating on the snow balls. There will also be foreground snow and background snow that keeps the storm going when all the mid-level snow has accumulated on the snow balls...

Code:
' Snow Balls 2.txt
' from Snow Balls for JB [B+=MGA] 2016-11-01
' a variation on Paint Balls, try one color but at various sizes

' Goal: Test a version of UnDo by tracking x, y, size.
' Success - you can undo all the way back to the beginning!

' The bmp pictures can be saved as Snow Balls date_time stamp.bmp

' The last saved array is called Snow Balls ARRAY.dat,
' that is the one that will be loaded from Array Load menu.
' If you want to save several arrays, you could rename them
' then rename them back to Snow Balls.dat to rework them.

' To work with Snow Machine, both the ARRAY and BMP files will be saved
' when save the array


'2016-11-02 snow balls 2 too gray ?
' save bmp increase x + 8, y + 32
' Setup now for dat and bmp file to run in Snow Machine

global H$, XMAX, YMAX, size, ballIndex, nBalls, nBm1, sky$, white$

H$ = "gr"
XMAX = 1200 '< actual drawing space needed
YMAX = 700  '< actual drawing space needed
size = 100
nBalls = 500
nBm1 = nBalls - 1
sky$ = "130 180 220"
white$ = "220 220 245"
nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 100
UpperLeftY = 40

menu #gr, "Menu", "Size", resize, "Clear", CLR, "Undo", undo, "Save Picture", save
menu #gr, "Array", "Load", loadArr, "Save", saveArr
open "Snow Balls" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lBU"
#gr "down"
call CLR
wait

' Window procedures in order of appearance above

sub resize
    t$ = "Snow Ball Size" + chr$(13)
    c$ = "Current size is " + str$(size)
    p$ = " pixel radius.  Enter new size desired (max is screen height/2)."
    prompt t$ + c$ + p$; inp$
    test = val(inp$)
    if test > 0 and test < YMAX/2 then size = test
end sub

sub CLR
    call clrScreen
    call clrBalls
end sub

sub undo
    if ballIndex > 0 then
        ballIndex = ballIndex - 1
        call rebuild
    end if
end sub

sub save
    #gr "getbmp scr 0 0 ";XMAX + 8;" ";YMAX + 32
    d$ = date$("yyyy/mm/dd")
    d$ = mid$(d$, 1, 4) + "-" + mid$(d$, 6, 2) + "-" + mid$(d$, 9, 2)
    t$ = time$()
    t$ = mid$(t$, 1, 2) + "-" + mid$(t$, 4, 2)
    bmpsave "scr", "Snow Balls " + d$ + " " + t$ + ".bmp"
end sub

sub loadArr
    'make sure a file exits
    open "Snow Balls ARRAY.dat" for append as #1
    print #1, ""
    close #1
    open "Snow Balls ARRAY.dat" for input as #1
    ballIndex = 0
    while eof(#1) = 0
        input #1, fline$
        if trim$(fline$) <> "" then
            ballX(ballIndex) = val(word$(fline$, 1))
            ballY(ballIndex) = val(word$(fline$, 2))
            ballS(ballIndex) = val(word$(fline$, 3))
            ballIndex = ballIndex + 1
        end if
    wend
    close #1
    call rebuild
end sub

sub saveArr
    #gr "getbmp scr 0 0 ";XMAX + 8;" ";YMAX + 32
    bmpsave "scr", "Snow Balls Background.bmp"
    open "Snow Balls ARRAY.dat" for output as #1
    for i = 0 to ballIndex -1
        print #1, str$(ballX(i)) + " " + str$(ballY(i)) + " " + str$(ballS(i))
    next
    close #1
end sub

sub quit H$
    close #H$
    end
end sub

sub lBU H$, x, y
    call ball x, y, size
    if ballIndex < nBalls then
        ballX(ballIndex) = x
        ballY(ballIndex) = y
        ballS(ballIndex) = size
        ballIndex = ballIndex + 1
    end if
end sub

'=================================== supplementary procedures

sub clrScreen
    #gr "fill ";sky$
    #gr "backcolor "; white$
    #gr "color "; white$
    #gr "place "; 0; " "; YMAX - 100;
    #gr "boxfilled "; XMAX + 1; " "; YMAX + 1
end sub

sub clrBalls
    ballIndex = 0
    dim ballX(nBm1), ballY(nBm1), ballS(nBm1)
end sub

sub ball x, y, s
    for r = s to 0 step -1
        cc = int(r/s * 50) + 200
        #gr "color ";cc;" ";cc;" ";cc
        #gr "backcolor ";cc;" ";cc;" ";cc
        #gr "place ";x;" ";y;"; circlefilled ";r
    next
end sub

sub rebuild
    if ballIndex > 0 then
        call clrScreen
        for i = 0 to ballIndex -1
            call ball ballX(i), ballY(i), ballS(i)
        next
    end if
end sub

 
« Last Edit: Nov 3rd, 2016, 03:06am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #2 on: Nov 3rd, 2016, 03:10am »

Snow Machine:

Code:
' Snow Machine.txt for JB [B+=MGA] 2016-11-03

' Goal: take Snow Balls Background.bmp and Snow Balls ARRAY.dat
' made with Snow Balls 2 and create a snow scene that accumulates
' snow on things made with Snow Balls.

global datFile$, bmpFile$
datFile$ = "Snow Balls ARRAY.dat"
bmpFile$ = "Snow Balls Background.bmp"

global H$, XMAX, YMAX, nf, fd, nf2, nf3, r2, r3

H$ = "gr"
XMAX = 1200 '< actual drawing space needed
YMAX = 680  '< actual drawing space needed

'to get ball positions and sizes
dim ballX(100), ballY(100), ballS(100)

'for tracking where the snow is each xy = 1 has snow
dim sXY(XMAX, YMAX) 'virtual screen
dim snowLine(XMAX)  'accumulate snow line

'setup snow
r = 4  'middle layer, Snow Balls that acuumulate snow
nf = 300
dim fx(nf), fy(nf), ifrozen(nf)
'fd flake diameter is global and needed in sub loadArr
fd = 2 * r
sw = fd + 2
sh = fd + 2
for i = 1 to nf
    fx(i) = rand(0, XMAX)
    fy(i) = rand(0, YMAX)
next

r2 = 6 'foreground snow
nf2 = 25
dim ffx(nf2), ffy(nf2)
for i = 1 to nf2
    ffx(i) = rand(0, XMAX)
    ffy(i) = rand(0, YMAX)
next

r3 = 2 'background snow
nf3 = 100
dim fffx(nf3), fffy(nf3)
for i = 1 to nf3
    fffx(i) = rand(0, XMAX)
    fffy(i) = rand(0, YMAX)
next

' use the Snow Balls ARRAY.dat file
call loadArr

'background bmp from Snow Balls bmp created with ARRAY file
loadbmp "backgrd", bmpFile$

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 100
UpperLeftY = 40

open "Snow Machine" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "background backgrd"

'debug check that Snow Balls image overlayed in black, success!
'Note: this is still OK with a different YMAX
'#gr "drawsprites"
'#gr "color 0 0 0"
'for y = 0 to YMAX
'for x = 0 to XMAX
'    scan
'    if sXY(x,y) = 1 then #gr "set ";x;" ";y
'next
'next
'now if we drawsprites again will the black be covered? Yep!
'#gr "drawsprites"

'proceed with the snow machine, make sprites
'draw snow flakes that will accumulate over Snow Balls
#gr "cls"
#gr "color 0 0 0"
#gr "backcolor 0 0 0"
#gr "place ";0;" ";sh
#gr "boxfilled ";sw;" ";2 * sh
#gr "color 250 250 250"
#gr "backcolor 250 250 250"
#gr "place ";r+1;" ";sh+r+1
#gr "circlefilled ";r
#gr "color 0 0 0"
#gr "backcolor 0 0 0"
#gr "place ";r+1;" ";r+1
#gr "circlefilled ";r
for i = 1 to nf
    scan
    #gr "getbmp f";i;" 0 0 ";sw;" ";2*sh
    #gr "addsprite f";i;" f";i
    #gr "spritexy f";i;" ";fx(i);" ";fy(i)
next

'foreground snow sprites
sw = r2 * 2 + 2
sh = r2 * 2 + 2
#gr "cls"
#gr "color 0 0 0"
#gr "backcolor 0 0 0"
#gr "place ";0;" ";sh
#gr "boxfilled ";sw;" ";2 * sh
#gr "color 250 250 250"
#gr "backcolor 250 250 250"
#gr "place ";r2+1;" ";sh+r2+1
#gr "circlefilled ";r2
#gr "color 0 0 0"
#gr "backcolor 0 0 0"
#gr "place ";r2+1;" ";r2+1
#gr "circlefilled ";r2
for i = 1 to nf2 'fore ground
    scan
    #gr "getbmp ff";i;" 0 0 ";sw;" ";2*sh
    #gr "addsprite ff";i;" ff";i
    #gr "spritexy ff";i;" ";ffx(i);" ";ffy(i)
next

'background snow sprites
sw = r3 * 2 + 2
sh = r3 * 2 + 2
#gr "cls"
#gr "color 0 0 0"
#gr "backcolor 0 0 0"
#gr "place ";0;" ";sh
#gr "boxfilled ";sw;" ";2 * sh
#gr "color 250 250 250"
#gr "backcolor 250 250 250"
#gr "place ";r3+1;" ";sh+r3+1
#gr "circlefilled ";r3
#gr "color 0 0 0"
#gr "backcolor 0 0 0"
#gr "place ";r3+1;" ";r3+1
#gr "circlefilled ";r3
for i = 1 to nf3 'fore ground
    scan
    #gr "getbmp fff";i;" 0 0 ";sw;" ";2*sh
    #gr "addsprite fff";i;" fff";i
    #gr "spritexy fff";i;" ";fffx(i);" ";fffy(i)
next

timer 100, frame
wait


' Window procedures in order of appearance above

sub loadArr
    open datFile$ for input as #1
    ballIndex = 0
    while eof(#1) = 0
        input #1, fline$
        if trim$(fline$) <> "" then
            ballX(ballIndex) = val(word$(fline$, 1))
            ballY(ballIndex) = val(word$(fline$, 2))
            ballS(ballIndex) = val(word$(fline$, 3))
            ballIndex = ballIndex + 1
        end if
    wend
    close #1

    'virtual screen > array
    'now lets track where the snow balls are
    for ball = 0 to ballIndex -1  'draw circles of 1's to rep balls
        'just like handmade filled circles
        'x = ballX(ball) y = ballY(ball) r = ballS(ball)
        rsq = ballS(ball) * ballS(ball)
        for cx = ballS(ball) to 0 step -1
            cy = int(sqr(rsq - cx * cx))
            x1 = ballX(ball) + cx : x2 = ballX(ball) - cx
            y2 = ballY(ball) + cy : y1 = ballY(ball) - cy
            for yy = y1 to y2
                if x1 >=0 and x1 <= XMAX and yy >=0 and yy <= YMAX then sXY(x1, yy) = 1
                if x2 >=0 and x2 <= XMAX and yy >=0 and yy <= YMAX then sXY(x2, yy) = 1
            next
        next
    next 'ball
    'get snowLine
    for x = 0 to XMAX
        for y = 0 to YMAX
            if sXY(x, y) = 1 then snowLine(x) = y : exit for
        next
    next
    'adjust the snowLine for the current radius
    '(so the sprites dont have to be adjusted x,y offsets to center)
    'move the snow line up fd and shift right half of fd
    for x = 0 to XMAX
        if snowLine(x) <> 0 then snowLine(x) = snowLine(x) - fd
    next
    shift = .5 * fd
    for x = shift to XMAX
        snowLine(x - shift) = snowLine(x)
    next
end sub

sub quit H$
    timer 0
    unloadbmp "backgrd"
    close #H$
    end
end sub

sub frame
    for i = 1 to nf
        scan
        if fy(i) + fd > YMAX then 'recycle the flake
            fy(i) = 0 : fx(i) = rand(0, XMAX)
        else 'above or below snowline?
            if snowLine(fx(i)) <> 0 then
                if fy(i) + fd < snowLine(fx(i)) then 'advance the flake
                    fy(i) = fy(i) + fd
                else ' freeze the flake and raise the snow line
                    if ifrozen(i) <> 1 then 'not frozen in place yet
                        fy(i) = snowLine(fx(i)) 'accumulate snow!
                        snowLine(fx(i)) = snowLine(fx(i)) - .66 * fd
                        ifrozen(i) = 1 'frozen now
                    end if
                end if
            else 'no snowline here
                fy(i) = fy(i) + fd
            end if
        end if
        #gr "spritexy f";i;" ";fx(i);" ";fy(i)
    next
    for i = 1 to nf2 'foreground snow
        scan
        if ffy(i) + 2 * r2 > YMAX then
            ffy(i) = 0 : ffx(i) = rand(0, XMAX)
        else
            ffy(i) = ffy(i) + 2 * r2
        end if
        #gr "spritexy ff";i;" ";ffx(i);" ";ffy(i)
    next
    for i = 1 to nf3 'background snow, another use of sXY
        scan
        if fffy(i) + r3 > YMAX - 100 then
            fffy(i) = 0 : fffx(i) = rand(0, XMAX)
        else
            fffy(i) = fffy(i) + r3
        end if
        #gr "spritexy fff";i;" ";fffx(i);" ";fffy(i)

        'this hangs program without error message
        '                    so much for background snow
        'Too Much Snow? Yes that was it!!!!
        if sXY(fffx(i), fffy(i)) = 1 then
            #gr "spritevisible fff";i;" off"
        else
            #gr "spritevisible fff";i;" on"
        end if

    next
    #gr "drawsprites"
end sub

'=================================== supplementary procedures

function rand(n1, n2)
    if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
    rand = int((hi - lo + 1) * rnd(0)) + lo
end function

 
User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3089
xx Re: Snow Balls
« Reply #3 on: Nov 3rd, 2016, 04:11am »

Yes, very nicely done. One or two goes to get it going because I didn't follow the instructions smiley I would draw a snow ball man programmatically eliminating the need for two programs.

Really nice snow effect and realistic accumulation.
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #4 on: Nov 3rd, 2016, 1:05pm »

cheesy I don't follow directions well myself, probably why I write my own programs rather than have to learn someone's system.

It would make things simpler, if I embed Snow Balls 2 into Snow Machine because Snow Machine, at present, is completely dependent on Snow Balls 2 files. Whereas, Snow Balls and Snow Balls 2 (with lighter colored snow balls) are completely independent.

There's an idea, doing the drawing by program and saving the drawing instructions to map out "mask" of midground drawing and snowLines. Thus, one can unflatten the 2D to fore, middle and background levels, 2D+

« Last Edit: Nov 3rd, 2016, 1:12pm by bplus » User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3553
xx Re: Snow Balls
« Reply #5 on: Nov 3rd, 2016, 1:54pm »

Nice snow.
somehow I see horizontal line of snowlets in background layer - ?
EDIT
fixed by "-100" in setting up background layer
Code:
for i = 1 to nf3
    fffx(i) = rand(0, XMAX)
    fffy(i) = rand(0, YMAX- 100 )
next
 

(in sub frame, lower 100 pixels was converted to 0'th row creating visible line)


EDIT
gosh it hits timer+sub bug
- I triggered it then I tried to move window
« Last Edit: Nov 3rd, 2016, 2:08pm by tsh73 » User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #6 on: Nov 3rd, 2016, 2:13pm »

on Nov 3rd, 2016, 1:54pm, tsh73 wrote:
Nice snow.
somehow I see horizontal line of snowlets in background layer - ?
EDIT
fixed by "-100" in setting up background layer
Code:
for i = 1 to nf3
    fffx(i) = rand(0, XMAX)
    fffy(i) = rand(0, YMAX- 100 )
next
 

(in sub frame, lower 100 pixels was converted to 0'th row creating visible line)

EDIT
gosh it hits timer+sub bug
- I triggered it then I tried to move window


Oh, yes! good.

At my house, we dont try and move our windows. (joke) ;)

So I have rediscovered another old bug. It's nice to come along late and benefit from people's experience. :)
« Last Edit: Nov 3rd, 2016, 2:17pm by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #7 on: Nov 4th, 2016, 07:59am »

Ha! It turns out I don't need a timer at all!

This does the trick:
Code:
while 1
    scan
    call frame
wend
 


I can grab the title bar and shake Window, it self corrects. I can max/min and snow continues on....

I did try timer embedded in frame sub and it fixed moving window problem but it also made snowfall jerky.

I also have an idea for a very different approach to snow accumulation that should solve problem of running out of sprite flakes.
« Last Edit: Nov 4th, 2016, 09:21am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #8 on: Nov 4th, 2016, 09:25am »

OMG!

This generic snow flake sprite generator works!
Code:
sub makeNameRadiusNumberFlakeSprites flakeName$, flakeRadius, flakeNumber
    sw = flakeRadius * 2 + 2
    sh = flakeRadius * 2 + 2
    #gr "cls"
    #gr "color 0 0 0"
    #gr "backcolor 0 0 0"
    #gr "place ";0;" ";sh
    #gr "boxfilled ";sw;" ";2 * sh
    #gr "color 250 250 250"
    #gr "backcolor 250 250 250"
    #gr "place ";flakeRadius + 1;" ";sh+flakeRadius + 1
    #gr "circlefilled ";flakeRadius
    #gr "color 0 0 0"
    #gr "backcolor 0 0 0"
    #gr "place ";flakeRadius + 1;" ";flakeRadius + 1
    #gr "circlefilled ";flakeRadius
    for i = 1 to flakeNumber
        scan
        #gr "getbmp ";flakeName$;i;" 0 0 ";sw;" ";2 * sh
        #gr "addsprite ";flakeName$;i;" ";flakeName$;i
        'this next line will be amazing if it works, no sweat if doesn't
        #gr "spritexy ";flakeName$;i;" ";flakeName$;"ArrX(";i;") ";flakeName$;"ArrY(";i;")"
    next
end sub

 


I can replace 3 blocks of code with one generic sprite maker and make several more z levels of snow!
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #9 on: Nov 6th, 2016, 10:35am »

Snow Balls version 3:
New Ball Drawing Method
Fully integrated now with Snow Machine (v2 not posted) that has 5 layers of snow and new snow accumulation method.

Code:
' Snow Balls 3.txt for JB [B+=MGA] 2016-11-06 update
' started from JB [B+=MGA] 2016-11-01 a variation on Paint Balls, 
' try one color but at various sizes with goal to try a version on Undo.

' version 3 Has vastly improved ball sizing drawing method and Snow 
' Machine 2 improvements over first version have been completely 
' assimulated into one program.

global H$, XMAX, YMAX, ballIndex, nBalls, w2, h2  'universally needed
global sky$, white$, lastX, lastY 'just Snow Balls drawing
global FRM, LAYERS, goSnow 'just Snow Machine

H$ = "gr"   ' window handle
XMAX = 1200 ' actual drawing space needed
YMAX = 700  ' actual drawing space needed
nBalls = 500  ' set limit to number of balls draw that can undo
sky$ = "130 180 220"    'Snow Balls sky
white$ = "220 220 245"  'Snow Balls ground

FRM = 1        'Snow Machine Frame counter
LAYERS = 12    'Snow Machine snow accumulation counter
goSnow = 0     'Snow Machine toggles on/off true/false

'for tracking where the snow balls  and snow accum 
dim sXY(XMAX, YMAX) 'virtual screen
dim snowLine(XMAX + 5) 'top line, oversize for checking beyond screen
dim lowLine(XMAX + 5)  'bottom line
dim oLine(XMAX + 5)    'original line

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 52  '>>>> fix: not 32, add 20 for menu bar!
UpperLeftX = 100
UpperLeftY = 40

menu #gr, "Screen", "Clear", CLR, "Undo", undo, "Save Picture", save
menu #gr, "File", "Load", loadArr, "Save", saveArr
menu #gr, "Snow Machine", "ON", snow, "OFF", noSnow
open "Snow Balls" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonDown lBD"
#gr "when leftButtonMove lBMove"
#gr "when leftButtonUp lBU"
#gr "when characterInput charIn"
#gr "home"                  '< get drawing area
#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
'notice "Screen size:" + chr$(13) + "w2 * 2 = ";w2*2;" h2 * 2 = ";h2*2
'>>> now reports 1200 x 700
#gr "down"

'setup snow: 5 snow levels 1 =foreground to  5 =background
'Arrays are already Global, so don't have to pass all this to subs
'lR = level Radius of Snow Flakes, lN = level Number of Flakes
dim lR(5), lN(5)

for level = 1 to 5 'front to back, dim allot of arrays...

    lR(level) = 6 - level 'formula for radius
    
    '8, 16, 32, 64, 128 keep < 500 sprites ~ 256 + 5*20 = 356
    lN(level) = 2 ^ (level + 2) + 20 'formula for level flake numbers
    
    'thanks to tsh73, don't setup flakes that creates a line at top 
    select case level
    case 1 : dim l1fArrX(lN(1)), l1fArrY(lN(1))
        for i = 1 to lN(1)
            l1fArrX(i) = rand(0, XMAX)
            l1fArrY(i) = rand(0, YMAX - 20)
        next
    case 2 : dim l2fArrX(lN(2)), l2fArrY(lN(2))
        for i = 1 to lN(2)
            l2fArrX(i) = rand(0, XMAX)
            l2fArrY(i) = rand(0, YMAX - 40)
        next

    'snow will accumulate on this level, so track frozen flakes
    case 3 : dim l3fArrX(lN(3)), l3fArrY(lN(3)), ifrozen(lN(3))
        for i = 1 to lN(3)
            l3fArrX(i) = rand(0, XMAX)
            l3fArrY(i) = rand(0, YMAX - 60)
        next
    case 4 : dim l4fArrX(lN(4)), l4fArrY(lN(4))
        for i = 1 to lN(4)
            l4fArrX(i) = rand(0, XMAX)
            l4fArrY(i) = rand(0, YMAX - 80)
        next
    case 5 : dim l5fArrX(lN(5)), l5fArrY(lN(5))
        for i = 1 to lN(5)
            l5fArrX(i) = rand(0, XMAX)
            l5fArrY(i) = rand(0, YMAX - 100)
        next
    end select
    flakeName$ = "l";level;"f"
    call makeFlakeSprites flakeName$, lR(level), lN(level)
next

call CLR 'which dims ball stuff and sets up screen for drawing
wait

' ========== Window procedures in order of appearance above

sub CLR
if goSnow <> 1 then
    call clrScreen
    call clrBalls
end if
end sub

sub undo
if goSnow <> 1 then
    if ballIndex > 0 then
        ballIndex = ballIndex - 1
        call rebuild
    end if
end if    
end sub

sub save
	'OK while snow machine going?
    #gr "getbmp scrn 0 0 ";w2 * 2;" ";h2 * 2
    d$ = date$("yyyy/mm/dd")
    d$ = mid$(d$, 1, 4) + "-" + mid$(d$, 6, 2) + "-" + mid$(d$, 9, 2)
    t$ = time$()
    t$ = mid$(t$, 1, 2) + "-" + mid$(t$, 4, 2)
    bmpsave "scr", "Snow Balls " + d$ + "_" + t$ + ".bmp"
end sub

sub snow
if goSnow <> 1 then
    #gr "getbmp scrn 0 0 ";w2 * 2;" ";h2 * 2
    #gr "background scrn"
    call loadSnowArr
    'make sprites visible (snowing another scene, turn off for bg1-12)
    for level = 1 to 5
        for i = 1 to lN(level)
            #gr "spritevisible l";level;"f";i;" on"
        next
    next
    goSnow = 1
    while goSnow  'esc or q or menu OFF to exit
        scan
        call frame
        FRM = FRM + 1
    wend

    'clear out everything for another potential snow scene
    dim sXY(XMAX, YMAX)    
    dim snowLine(XMAX + 5)
    dim lowLine(XMAX + 5)
    dim oLine(XMAX + 5)
    for level = 1 to 5 'front to back
        select case level
        case 1 
            for i = 1 to lN(1)
                l1fArrX(i) = rand(0, XMAX)
                l1fArrY(i) = rand(0, YMAX - 20)
            next
        case 2
            for i = 1 to lN(2)
                l2fArrX(i) = rand(0, XMAX)
                l2fArrY(i) = rand(0, YMAX - 40)
            next
        case 3 
            for i = 1 to lN(3)
                l3fArrX(i) = rand(0, XMAX)
                l3fArrY(i) = rand(0, YMAX - 60)
            next
        case 4
            for i = 1 to lN(4)
                l4fArrX(i) = rand(0, XMAX)
                l4fArrY(i) = rand(0, YMAX - 80)
            next
        case 5
            for i = 1 to lN(5)
                l5fArrX(i) = rand(0, XMAX)
                l5fArrY(i) = rand(0, YMAX - 100)
            next
        end select
    next
    for i = 1 to LAYERS
        unloadbmp "bg";i
    next
    for level = 1 to 5
        for i = 1 to lN(level)
            #gr "spritevisible l";level;"f";i;" off"
        next
    next
    #gr "discard"
    FRM = 1
    call CLR
end if
end sub

sub noSnow
    goSnow = 0
end sub

sub loadArr
if goSnow <> 1 then
    'make sure a file exists
    open "Snow Balls ARRAY.dat" for append as #1
    print #1, ""
    close #1
    open "Snow Balls ARRAY.dat" for input as #1
    ballIndex = 0
    while eof(#1) = 0
        input #1, fline$
        if trim$(fline$) <> "" then
            ballX(ballIndex) = val(word$(fline$, 1))
            ballY(ballIndex) = val(word$(fline$, 2))
            ballS(ballIndex) = val(word$(fline$, 3))
            ballIndex = ballIndex + 1
        end if
    wend
    close #1
    call rebuild
end if
end sub

sub saveArr
if goSnow <> 1 then
    #gr "getbmp scrn 0 0 ";w2 * 2;" ";h2 * 2
    bmpsave "scrn", "Snow Balls Background.bmp"
    open "Snow Balls ARRAY.dat" for output as #1
    for i = 0 to ballIndex -1
        print #1, str$(ballX(i)) + " " + str$(ballY(i)) + " " + str$(ballS(i))
    next
    close #1
end if
end sub

sub quit H$
	'I don't think setting goSnow to 0 will unload all bmps, so no exit
	if goSnow then 
		Notice "Turn off Snow Machine!"
		exit sub
	end if
    unloadbmp "scrn"
    close #H$
    end
end sub

sub lBD H$, x, y  'left button mouse down
if goSnow <> 1 then
    lastX = x : lastY = y
    #gr "getbmp scrn 0 0 ";XMAX;" ";YMAX
end if    
end sub

sub lBMove H$, mx, my
if goSnow <> 1 then
    r = sqr((lastX - mx)^2 + (lastY - my)^2)
    if r > 1 then
        #gr "discard"
        #gr "drawbmp scrn 0 0"
        #gr "color white"
        #gr "place ";mx;" ";my
        #gr "circle ";r
    end if
end if    
end sub

sub lBU H$, mx, my  'left button up
if goSnow <> 1 then
    r = sqr((lastX - mx)^2 + (lastY - my)^2)
    #gr "discard"
    #gr "drawbmp scrn 0 0"
    if r > 1 then
        call ball mx, my, r
        if ballIndex < nBalls then
            ballX(ballIndex) = mx
            ballY(ballIndex) = my
            ballS(ballIndex) = r
            ballIndex = ballIndex + 1
        end if
    end if
end if    
end sub

sub charIn H$, k$
    if k$ = "q" then goSnow = 0
    if k$ = chr$(27) then goSnow = 0
end sub

'================= supplementary procedures Snow Balls

sub clrScreen
    #gr "fill ";sky$
    #gr "backcolor "; white$
    #gr "color "; white$
    #gr "place "; 0; " "; YMAX - 100;
    #gr "boxfilled "; XMAX + 1; " "; YMAX + 1
end sub

sub clrBalls
    ballIndex = 0
    dim ballX(nBalls), ballY(nBalls), ballS(nBalls)
end sub

sub ball x, y, s
    for r = s to 0 step -1
        cc = int(r/s * 50) + 200
        #gr "color ";cc;" ";cc;" ";cc
        #gr "backcolor ";cc;" ";cc;" ";cc
        #gr "place ";x;" ";y;"; circlefilled ";r
    next
end sub

sub rebuild
    if ballIndex > 0 then
        call clrScreen
        for i = 0 to ballIndex -1
            call ball ballX(i), ballY(i), ballS(i)
        next
    end if
end sub
 
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #10 on: Nov 6th, 2016, 10:37am »

Well I guess I have to post in 2 parts:

Here is the rest:
Code:
' ================   procedures Snow Machine

sub loadSnowArr
    notice "Loading and configuring data" + chr$(13)+ "Please wait..."

    'virtual screen > array
    'now lets track where the snow balls are
    for ball = 0 to ballIndex -1  'draw circles of 1's to rep balls
        'just like handmade filled circles
        'x = ballX(ball) y = ballY(ball) r = ballS(ball)
        rsq = ballS(ball) * ballS(ball)
        for cx = ballS(ball) to 0 step -1
            cy = int(sqr(rsq - cx * cx))
            x1 = ballX(ball) + cx : x2 = ballX(ball) - cx
            y2 = ballY(ball) + cy : y1 = ballY(ball) - cy
            for yy = y1 to y2
                if x1 >=0 and x1 <= XMAX and yy >=0 and yy <= YMAX then sXY(x1, yy) = 1
                if x2 >=0 and x2 <= XMAX and yy >=0 and yy <= YMAX then sXY(x2, yy) = 1
            next
        next
    next

    'get snowLine
    for x = 0 to XMAX
        for y = 0 to YMAX
            if sXY(x, y) = 1 then
                oLine(x) = y
                exit for
            end if
        next
    next

    ''debug (after loadARR call) check that Snow Balls image overlayed
    ''Note: this is still OK with a different YMAX
    '#gr "drawsprites"
    '#gr "color 0 0 0"
    'for y = 0 to YMAX
    'for x = 0 to XMAX
    '    scan
    '    if sXY(x,y) = 1 then #gr "set ";x;" ";y
    'next
    'next
    ''now if we drawsprites again will the black be covered? Yep!
    '#gr "drawsprites"  '===== end debug test

    #gr "color white"
    for i = 1 to LAYERS
        #gr "drawsprites"
        for x = 0 to XMAX
            if oLine(x) <> 0 then
                snowLine(x) = oLine(x) - i
                lowLine(x) = oLine(x) + .8 * i
                #gr "line ";x;" ";lowLine(x);" ";x;" ";snowLine(x)
            end if
        next
        #gr "getbmp bg";i;" 0 0 ";XMAX;" ";YMAX
    next

    ''debug test alignments of bg to backgrd ==== OK
    'for i = 1 to 20
    '    if i mod 2 then
    '        #gr "background scrn"
    '    else
    '        r = rand(1, LAYERS)
    '        #gr "background bg";r
    '    end if
    '    #gr "drawsprites"
    '    call pause 300
    'next

    'end debug ============== end debug test

    for i = 0 to XMAX
        snowLine(i) = oLine(i)
        lowLine(i) = oLine(i)
    next
    #gr "background scrn"
end sub

sub makeFlakeSprites flakeName$, flakeRadius, flakeNumber
    sw = flakeRadius * 2 + 2
    sh = flakeRadius * 2 + 2
    #gr "cls"
    #gr "color 0 0 0"
    #gr "backcolor 0 0 0"
    #gr "place ";0;" ";sh
    #gr "boxfilled ";sw;" ";2 * sh
    #gr "color 250 250 250"
    #gr "backcolor 250 250 250"
    #gr "place ";flakeRadius + 1;" ";sh+flakeRadius + 1
    #gr "circlefilled ";flakeRadius
    #gr "color 0 0 0"
    #gr "backcolor 0 0 0"
    #gr "place ";flakeRadius + 1;" ";flakeRadius + 1
    #gr "circlefilled ";flakeRadius
    for i = 1 to flakeNumber
        scan
        #gr "getbmp ";flakeName$;i;" 0 0 ";sw;" ";2 * sh
        #gr "addsprite ";flakeName$;i;" ";flakeName$;i
        'this next line will be amazing if it works, no sweat if doesn't
        #gr "spritexy ";flakeName$;i;" ";flakeName$;"ArrX(";i;") ";flakeName$;"ArrY(";i;")"
    next
end sub

sub frame
    #gr "discard"
    'adjust snow levels according to frame, free the frozen too!
    if FRM mod 100 = 0 then
        bkg = FRM / 100
        if bkg > 0 and bkg < LAYERS + 1 then
            #gr "background bg";bkg
            'reset snowLine and free the frozen
            for i = 0 to XMAX
                if oLine(i) <> 0 then
                    snowLine(i) = oLine(i) - bkg
                    lowLine(i) = oLine(i) + .8 * bkg
                end if
            next
            'finally randomize l3f
            for i = 1 to lN(3)
                ifrozen(i) = 0
                l3fArrX(i) = rand(0, XMAX)
                l3fArrY(i) = rand(0, YMAX - 60)
            next
        end if 'bkg in range
    end if 'snow accum frm
    for level = 1 to 5
        scan
        for i = 1 to lN(level)
            scan
            select case level
            case 1
                if l1fArrY(i) + 2 * lR(1) > YMAX - 20 then
                    l1fArrY(i) = 0 : l1fArrX(i) = rand(0, XMAX)
                else
                    l1fArrY(i) = l1fArrY(i) + rand(lR(1), 2 * lR(1))
                end if
                #gr "spritexy l1f";i;" ";l1fArrX(i);" ";l1fArrY(i)
            case 2
                if l2fArrY(i) + 2 * lR(2) > YMAX - 40 then
                    l2fArrY(i) = 0 : l2fArrX(i) = rand(0, XMAX)
                else
                    l2fArrY(i) = l2fArrY(i) + rand(lR(2), 2 * lR(2))
                end if
                #gr "spritexy l2f";i;" ";l2fArrX(i);" ";l2fArrY(i)
            case 3
                if l3fArrY(i) + 2 * lR(3) > YMAX - 60 then
                    l3fArrY(i) = 0 : l3fArrX(i) = rand(0, XMAX)
                else

'stick the snow for accumulation
if snowLine(l3fArrX(i) + lR(3)) <> 0 then 'check snowline
    if l3fArrY(i) + 2 * lR(3) < snowLine(l3fArrX(i) + lR(3)) then 'advance flake
        l3fArrY(i) = l3fArrY(i) + rand(lR(3), 2 * lR(3))
    else
        if ifrozen(i) <> 1 then ' not frozen yet
            if rand(0, 1) then
                l3fArrY(i) = snowLine(l3fArrX(i) + lR(3)) - rand(0, lR(3))
            else
                l3fArrY(i) = lowLine(l3fArrX(i) + lR(3)) + rand(-1 * lR(3), -.5 * lR(3))
            end if
            'with background accum, dont change snowLine
            'snowLine(l3fArrX(i) + lR(3)) = snowLine(l3fArrX(i) + lR(3)) - 1.5 * lR(3)
            ifrozen(i) = 1
        end if
    end if
else ' no snowLine carry on
    l3fArrY(i) = l3fArrY(i) + rand(lR(3), 2 * lR(3))
end if

                end if
                #gr "spritexy l3f";i;" ";l3fArrX(i);" ";l3fArrY(i)
            case 4
                if l4fArrY(i) + 2 * lR(4) > YMAX - 80 then
                    l4fArrY(i) = 0 : l4fArrX(i) = rand(0, XMAX)
                else
                    l4fArrY(i) = l4fArrY(i) + rand(lR(4), 2 * lR(4))
                end if
                #gr "spritexy l4f";i;" ";l4fArrX(i);" ";l4fArrY(i)
                if sXY(l4fArrX(i), l4fArrY(i)) = 1 then
                    #gr "spritevisible l4f";i;" off"
                else
                    #gr "spritevisible l4f";i;" on"
                end if
            case 5
                if l5fArrY(i) + 2 * lR(5) > YMAX - 100 then
                    l5fArrY(i) = 0 : l5fArrX(i) = rand(0, XMAX)
                else
                    l5fArrY(i) = l5fArrY(i) + rand(lR(5), 2 * lR(5))
                end if
                #gr "spritexy l5f";i;" ";l5fArrX(i);" ";l5fArrY(i)
                if sXY(l5fArrX(i), l5fArrY(i)) = 1 then
                    #gr "spritevisible l5f";i;" off"
                else
                    #gr "spritevisible l5f";i;" on"
                end if
            end select
        next
    next
    #gr "drawsprites"
    #gr "color white"
end sub

'==============  general supplementary procedures

function rand(n1, n2)
    if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
    rand = int((hi - lo + 1) * rnd(0)) + lo
end function

sub pause mil
    timer mil, [timesup]
    wait
[timesup]
    timer 0
end sub

 
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3553
xx Re: Snow Balls
« Reply #11 on: Nov 7th, 2016, 03:37am »

Looks cool (I had not time yet to look how it works inside).
Small suggestion:
then drawing balls, center them there first mouse click was (commented with '!)
Code:
sub lBMove H$, mx, my
if goSnow <> 1 then
    r = sqr((lastX - mx)^2 + (lastY - my)^2)
    if r > 1 then
        #gr "discard"
        #gr "drawbmp scrn 0 0"
        #gr "color white"
        #gr "place ";lastX;" ";lastY    '!
        #gr "circle ";r
    end if
end if
end sub

sub lBU H$, mx, my  'left button up
if goSnow <> 1 then
    r = sqr((lastX - mx)^2 + (lastY - my)^2)
    #gr "discard"
    #gr "drawbmp scrn 0 0"
    if r > 1 then
        call ball lastX, lastY, r   '!
        if ballIndex < nBalls then
            ballX(ballIndex) = lastX  '!
            ballY(ballIndex) = lastY  '!
            ballS(ballIndex) = r
            ballIndex = ballIndex + 1
        end if
    end if
end if
end sub
 
« Last Edit: Nov 7th, 2016, 03:38am by tsh73 » User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #12 on: Nov 7th, 2016, 09:36am »

Thanks tsh73, I was so impressed by improvement of starting a ball from an edge point and moving mouse around to set origin (and radius with it), I did not consider the way you suggest (I was mostly focused on getting Snow Machine integrated and working over several snow storms).

Yes, easy enough to create a switch and have it both ways! cheesy

I also have a radical change planned for snow accum, throwing out snow lines and doing each ball based on radius, origin and especially order of drawing. The configuration then would be done with the drawing, no long screen analysis just a snowCap for spheres sub procedure is needed.

Anyone want to try their hand with growing a snow cap on a sphere?

Sub snowCap x, y, r
x, y origin, r radius, accum... = based on some fraction of the frame counter and a snowFallLimit, frame is already global FRM.
Level 3 flakes have a radius of 3, that is trickiest part.

BTW, all the things we did with Curvy Writing and Paints Balls has been extremely helpful with Snow Balls, this is much better than something I would come up with alone. Thanks!
« Last Edit: Nov 7th, 2016, 09:48am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #13 on: Nov 7th, 2016, 7:39pm »

Here are some more interesting designs (than circles) for flakes:
Code:
'recurring flake.txt for Just Basic v1.01 [B+=MGA] 2016-11-07
' in case you have not seen enough flakes already

global H$, XMAX, YMAX, PI, DV, THK
H$ = "gr"
XMAX = 500 '< actual drawing space needed
YMAX = 500 '< actual drawing space needed
PI = acs(-1)
THK = 1
nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2
UpperLeftY = (700 - YMAX) / 2

open "Recurring flake" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "color white"
#gr "backcolor black"
while 1
    DV = 2 + rnd(0) 'global dictates density of flake
    THK = rand(1, 5)
    rAng = PI / rand(3, 30)
    rr = 10 + YMAX/4 * rnd(0)
    scan
    #gr "size ";THK
    #gr "fill black"
    #gr "place ";10;" ";20;";|";"DV = ";DV
    call rFlake XMAX/2, YMAX/2, rr, rAng
    #gr "flush"
    call pause 500
wend
wait

sub rFlake x, y, r, rAng
  for a = 0 to 5
    scan
    armX = x + r * cos(a * PI/3 + rAng)
    armY = y + r * sin(a * PI/3 + rAng)
    #gr "line ";x;" ";y;" ";armX;" ";armY
    if r > 4 * THK then call rFlake armX, armY, r/DV, rAng
  next
end sub

sub lButtonUp H$, mx, my
    call quit H$ 
end sub

sub charIn H$, c$ 
    call quit H$
end sub

sub quit H$
    close #H$ 
    end
end sub

sub pause mil
    timer mil, [timesup]
    wait
[timesup]
    timer 0
end sub

function rand(n1, n2)
    if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
    rand = int((hi - lo + 1) * rnd(0)) + lo
end function

 
« Last Edit: Nov 7th, 2016, 7:40pm by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Snow Balls
« Reply #14 on: Nov 8th, 2016, 11:36am »

Simple flake:
Code:
'flakes.txt for Just Basic v1.01 [B+=MGA] 2016-11-08
' recurring flakes too fancy for simple snow flake
' not very realistic either, more a mathematician's flake
' here is simple flake and screen test


global H$, XMAX, YMAX, PI, DEG, RAD
H$ = "gr"
XMAX = 500 '<======================================== actual drawing space needed
YMAX = 500 '<======================================== actual drawing space needed
PI = acs(-1)

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above

open "Simple flake screen test" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill blue"
#gr "color white"
#gr "backcolor white"
#gr "size 2"
for i = 1 to 200
    x = rand(0, XMAX) : y = rand(0, YMAX) : r = rand(1,10)
    call flake x, y, r
next
#gr "flush"
wait

sub flake x, y, r
    ra = PI/3 * rnd(0)
    for a = 0 to 5
        armX = x + r * cos(a * PI/3 + ra)
        armY = y + r * sin(a * PI/3 + ra)
        #gr "line ";x;" ";y;" ";armX;" ";armY
        spikeX = x + .55 * r * cos(a * PI/3 + ra)
        spikeY = y + .55 * r * sin(a * PI/3 + ra)
        endX1 = spikeX + .3 * r * cos(a * PI/3 - 2 * PI/7 + ra)
        endY1 = spikeY + .3 * r * sin(a * PI/3 - 2 * PI/7 + ra)
        endX2 = spikeX + .3 * r * cos(a * PI/3 + 2 * PI/7 + ra)
        endY2 = spikeY + .3 * r * sin(a * PI/3 + 2 * PI/7 + ra)
        #gr "line "; spikeX;" "; spikeY;" "; endX1;" "; endY1
        #gr "line "; spikeX;" "; spikeY;" "; endX2;" "; endY2
    next
end sub

function rand(n1, n2)
    if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
    rand = int((hi - lo + 1) * rnd(0)) + lo
end function

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
    call quit H$          '<=== H$ global window handle
end sub

sub charIn H$, c$   '<=== must have handle and get keypress$
    call quit H$    '<=== H$ global window handle
end sub

'Need line: #gr "trapclose quit"
sub quit H$
    close #H$ '<=== this needs Global H$ = #gr
    end       'Thanks Facundo, close graphic wo error
end sub

 
User IP Logged

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

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls