Board Logo
« Spark Discharge »

Welcome Guest. Please Login or Register.
Jan 16th, 2018, 3:38pm


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

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 veryhotthread  Author  Topic: Spark Discharge  (Read 762 times)
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3635
xx Re: Spark Discharge
« Reply #15 on: Aug 23rd, 2017, 1:05pm »

BPlus,
you make me mention "Flux Capacitor" to colleague
(and I did google it after)!

grin
(she is worse with English when me, so it might pass unnoticed)
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: 1255
xx Re: Spark Discharge
« Reply #16 on: Aug 23rd, 2017, 1:41pm »

Yes, it helps if you've seen the movie, "Back to the Future", a number of times.

I wonder how it translates to Russian?
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3635
xx Re: Spark Discharge
« Reply #17 on: Aug 23rd, 2017, 3:08pm »

I've seen but never paid attention to technical details.
I's a magic, right - it has to be believed to work - so why pay too much attention?

Russian Wikipedia says there were several translation for a term.
Google translate gives them as
Quote:
installing energy fluxor (in other translations - streaming accumulator and flow capacitor) in the car DeLorean DMC-12.

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: 1255
xx Re: Spark Discharge
« Reply #18 on: Aug 23rd, 2017, 6:03pm »

Yes science fiction is a sort of magic, it has to be believed for the story to work.

But doesn't it look like it should work? ;-))

« Last Edit: Aug 24th, 2017, 12:17pm by bplus » User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Spark Discharge
« Reply #19 on: Aug 24th, 2017, 06:06am »

A simpler drawn line, it could be better. Also needs a glow to flicker in the background.


Code:
    nomainwin

    WindowWidth = 800
    WindowHeight = 600
    UpperLeftX = (DisplayWidth-WindowWidth)/2
    UpperLeftY = (DisplayHeight-WindowHeight)/2

    open "Spark" for graphics_nsb_nf as #gr
    #gr "trapclose quit"
    #gr "down ; backcolor black ; fill black"


    xS =150
    yS =300
    for s=1 to 2
        for radius =100 to 0 step -1
            level$ =str$( int( 256 -256 *radius /150))
            c$ =level$ +" " +level$ +" " +level$ 
            #gr "color ";     c$
            #gr "backcolor "; c$
            #gr "place "; xS; " "; yS
            xS =xS -0.5
            yS =yS -0.2
            #gr "circlefilled "; radius
        next radius
        xS=650
        yS=300
    next
    #gr "flush one"

    x1=250
    y1=300
    x2=550
    y2=300

    while 1
        timer 56,[done]
        wait

        [done]
        timer 0
        #gr "discard ; color black ; place 250 150 ; boxfilled 550 450"
        call aline x1,y1,x2,y2
        call aline x2,y2,x1,y1
        call aline x1,y1,x2,y2
        call aline x2,y2,x1,y1
        scan
    wend


sub aline xold, yold, xend, yend
    dist = abs(xold-xend)
    if xold>xend then dir=-1 else dir=1
    rg=int(rnd(0)*200+56)
    #gr "color ";rg;" ";rg;" ";int(rnd(0)*56+200)
    while dist>0
        xd=rnd(0)*20*dir
        yd=rnd(0)*20-10
        if dist<50 then
            #gr "line ";xold;" ";yold;" ";xend;" ";yend
            exit while
        end if
        #gr "line ";xold;" ";yold;" ";xold+xd;" ";yold+yd
        yold=yold+yd
        xold=xold+xd
        dist=dist-(xd*dir)
    wend
end sub




sub quit h$
    timer 0
    close #gr
    end
end sub

 
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Spark Discharge
« Reply #20 on: Aug 24th, 2017, 12:47pm »

Hi Rod,

I bet your electric lines are faster than mine, helped by the bee-line to the end point at the last 50 pixels. Plus it's non recursive, so I concede any potential race between our line methods. wink

PS unless the distance < 50 or vertical or nearly vertical then we can compare quality.

PPS Oh! I have idea for more effective background.
« Last Edit: Aug 24th, 2017, 3:21pm by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Spark Discharge
« Reply #21 on: Aug 24th, 2017, 7:16pm »

Looks OK on my system:

Code:
'Electro Static Lines.txt started by Rod 2017-08-24 copied from JB Forum
' bplus mod with background

    nomainwin

    WindowWidth = 800
    WindowHeight = 600
    UpperLeftX = (DisplayWidth-WindowWidth)/2
    UpperLeftY = (DisplayHeight-WindowHeight)/2

    open "Electro Static Lines" for graphics_nsb_nf as #gr
    #gr "trapclose quit"
    #gr "down ; backcolor black ; fill black"

    xS = 400
    yS = 300
    for h = 200 to 0 step -1
        lv = int( 160 - 160 * h/200)
        level$ =str$(lv )
        l2$ = str$(.5*lv)
        c$ ="0 "+l2$+" "+ level$ 
        #gr "color ";     c$
        #gr "backcolor "; c$
        #gr "place "; xS; " "; yS
        #gr "ellipsefilled "; 400;" ";h
    next
    xS = 150
    yS = 300
    for s=1 to 2
        for radius =100 to 0 step -1
            level$ =str$( int( 256 -256 *radius /180))
            c$ =level$ +" " +level$ +" " +level$ 
            #gr "color ";     c$
            #gr "backcolor "; c$
            #gr "place "; xS; " "; yS
            if s = 1 then xS = xS + .9 else xS = xS - .9
            #gr "circlefilled "; radius
        next radius
        xS=650
        yS=300
    next
    #gr "getbmp TriP 0 0 800 600"
    #gr "background TriP"
    #gr "flush one"
    x1=240
    y1=300
    x2=560
    y2=300
    while 1
        #gr "drawsprites"
        call pause 1
        #gr "fill black"
        call aline x1,y1,x2,y2
        call aline x2,y2,x1,y1
        scan
    wend

sub aline xold, yold, xend, yend
    dist = abs(xold-xend)
    if xold>xend then dir=-1 else dir=1
    rg=int(rnd(0)*200+56)
    #gr "color ";rg;" ";rg;" ";int(rnd(0)*56+200)
    while dist>0
        xd=rnd(0)*20*dir
        yd=rnd(0)*20-10
        if dist<50 then
            #gr "line ";xold;" ";yold;" ";xend;" ";yend
            exit while
        end if
        #gr "line ";xold;" ";yold;" ";xold+xd;" ";yold+yd
        yold=yold+yd
        xold=xold+xd
        dist=dist-(xd*dir)
    wend
end sub

sub quit h$
    timer 0
    close #gr
    end
end sub


sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub


 


EDIT: changed light source on spheres
« Last Edit: Aug 24th, 2017, 7:38pm by bplus » User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Spark Discharge
« Reply #22 on: Aug 25th, 2017, 05:27am »

I never find that sprite drawing, even the background, and line drawing mix that well. I wanted less flicker. This is exactly what I was looking for so thanks for the help.


Code:
    nomainwin
    WindowWidth = 800
    WindowHeight = 600
    UpperLeftX = (DisplayWidth-WindowWidth)/2
    UpperLeftY = (DisplayHeight-WindowHeight)/2
    button #gr.button, "Start", [startStop], UL, 350, 490
    open "Electro Static Lines" for graphics_nsb_nf as #gr
    #gr "trapclose quit"
    #gr "down ; backcolor black ; fill black"
    call globe
    #gr "flush"
    #gr "getbmp globe 240 200 320 200"
    call ellipse
    call globe
    #gr "getbmp flash 240 200 320 200"
    #gr "redraw"
    wait

    [startStop]
    if running then
        running=0
        #gr.button "Start"
        #gr "discard ; drawbmp globe 240 200"
    else
        running=1
        #gr.button "Stop"
    end if

    [spark]
    x1=240
    y1=300
    x2=560
    y2=300
    while running=1
        call pause 56
        #gr "discard ; drawbmp flash 240 200"
        call aline x1,y1,x2,y2
        call aline x2,y2,x1,y1
        scan
    wend
    wait


sub ellipse
    xS = 400
    yS = 300
    for h = 200 to 0 step -1
        lv = int( 160 - 160 * h/200)
        level$ =str$(lv )
        l2$ = str$(.5*lv)
        c$ ="0 "+l2$+" "+ level$ 
        #gr "color ";     c$
        #gr "backcolor "; c$
        #gr "place "; xS; " "; yS
        #gr "ellipsefilled "; 400;" ";h
    next
end sub


sub globe
    xS = 150
    yS = 300
    for s=1 to 2
        for radius =100 to 0 step -1
            level$ =str$( int( 256 -256 *radius /180))
            c$ =level$ +" " +level$ +" " +level$ 
            #gr "color ";     c$
            #gr "backcolor "; c$
            #gr "place "; xS; " "; yS
            if s = 1 then xS = xS + .9 else xS = xS - .9
            #gr "circlefilled "; radius
        next radius
        xS=650
        yS=300
    next
end sub

sub aline xold, yold, xend, yend
    dist = abs(xold-xend)
    if xold>xend then dir=-1 else dir=1
    rg=int(rnd(0)*200+56)
    #gr "color ";rg;" ";rg;" ";int(rnd(0)*56+200)
    while dist>0
        xd=rnd(0)*20*dir
        yd=rnd(0)*10-5
        if dist<50 then
            #gr "line ";xold;" ";yold;" ";xend;" ";yend
            exit while
        end if
        #gr "line ";xold;" ";yold;" ";xold+xd;" ";yold+yd
        yold=yold+yd
        xold=xold+xd
        dist=dist-(xd*dir)
    wend
end sub

sub quit h$
    close #gr
    end
end sub

sub pause mil
    t0 = time$("ms")
    while time$("ms") < t0 + mil : wend
end sub



 
« Last Edit: Aug 25th, 2017, 05:50am by Rod » User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Spark Discharge
« Reply #23 on: Aug 25th, 2017, 12:21pm »

Oh yeah, I see, much smoother!

Here is Pentacle Flux Capacitor #3 with many improvements:
Code:
'Pentacle Flux Capacitor 3.txt for JB (B+=MGA) 2017-08-25

global H$, XMAX, YMAX, PI, xc, yc, dist
H$ = "gr" : XMAX = 700 : YMAX = 700
PI = acs(-1) : xc = XMAX/2 : yc = YMAX/2
dim pentacle(4, 1), pentacle2(4, 1)

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2
UpperLeftY = (700 - YMAX) / 2
ttl$ = "press or click any to quit.";space$(27);_
"Pentacle Flux Capacitor #3 AKA Dancing Man..."
open ttl$ for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"
#gr "size 2"  '1 or 2?

call drawPFC3 'sets global points too
#gr "getbmp PFC3 0 0 ";XMAX;" ";YMAX
#gr "background PFC3"

while 1
    scan
    #gr "drawsprites"
    call pause 15  '<< adjust time as needed for your system
    flux$ = str$(100 + rnd(0) * 155) + " "_
        + str$(100 + rnd(0) * 155) + " 255"
    #gr "color ";flux$
    #gr "backcolor ";flux$
    call Lightning xc, yc-90, xc, yc + 10, 135
    for i = 0 to 4
        scan
        xe = pentacle2(i, 0) : ye = pentacle2(i, 1)
        d = rnd(0)*.5*dist+.1*dist
        select case i
        case 0
            call Lightning xc, yc-90, xe, ye, .65*d
            call Lightning xc, yc-90, xe, ye, .65*d
        case 1, 4
            call Lightning xc, yc-70, xe, ye, d
        case 2, 3
            call Lightning xc, yc+10, xe, ye, d
        end select
    next
    call pause 32 '<< adjust time as needed for your system
wend

sub drawPFC3
    '3 main points for array tp()
    pRadius = 40 : cRadius = 1.5 * pRadius
    a3 = 2 * PI / 5 : r = YMAX/2 - cRadius - 20
    ao = -1 * PI / 2 : a = ao
    for rr = YMAX / 2 - 20 to 0 step -1
        call midInk 0, 0, 0, 128, 0, 0, rr / r
        #gr "place ";xc;" ";yc;"; circlefilled ";rr
    next
    for i = 0 to 4
        pentacle(i,0) = xc + r * cos(a)
        pentacle(i,1) = yc + r * sin(a)
        for rr = cRadius to pRadius step -1
            #gr "color ";(rr - pRadius) / (cRadius - pRadius)_
                * 255 * (cRadius - rr + pRadius) / cRadius;" 0 0"
            #gr "backcolor ";(rr - pRadius) / (cRadius - pRadius)_
                * 255 * (cRadius - rr + pRadius) / cRadius;" 0 0"
            xx = pentacle(i, 0) : yy = pentacle(i,1)
            #gr "place ";xx;" ";yy;"; circlefilled ";rr
        next
        a = a + a3
    next
    dist = sqr((pentacle(0, 0)-xc)^2 + (pentacle(0, 1)-yc)^2)
    for point = 0 to 4
        scan
        for dis = 0 to .5 * dist step 10
            scan
            dGray = 255*dis/dist
            xx = pentacle(point, 0) : yy = pentacle(point, 1)
            call midpoint xx, yy, xc, yc, dis/dist, midx, midy
            for r = pRadius * (dist - dis) / dist to 0 step -1
                scan
                call midInk dGray, dGray, dGray,_
                    255, 255, 255, (pRadius - r) / pRadius
                #gr "place ";midx;" ";midy;"; circlefilled ";r
            next
        next
        pentacle2(point, 0) = midx
        pentacle2(point, 1) = midy
    next
end sub

sub Lightning x1,y1,x2,y2,d
    scan
    if d < 10 then
        #gr "line ";x1;" ";y1;" ";x2;" ";y2
    else
        mx = (x2+x1)/2
        my = (y2+y1)/2
        r1 = int(rnd(0)*5) - 2 : r2 = int(rnd(0)*5) - 2
        mx = mx + -.2 * rnd(0) * d * r1
        my = my + -.2 * rnd(0) * d * r2
        call Lightning x1, y1, mx, my, d/2
        call Lightning x2, y2, mx, my, d/2
    end if
end sub

sub midpoint x1, y1, x2, y2, fraction, byref midx, byref midy
    midx = (x2 - x1) * fraction + x1
    midy = (y2 - y1) * fraction + y1
end sub

sub midInk r1, g1, b1, r2, g2, b2, frac
    dr = (r2 - r1) * frac : dg = (g2 - g1) * frac
    db = (b2 - b1) * frac
    #gr "color ";r1 + dr;" ";g1 + dg;" ";b1 + db
    #gr "backcolor ";r1 + dr;" ";g1 + dg;" ";b1 + db
end sub

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$ 
    call quit H$
end sub

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

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

 
« Last Edit: Aug 25th, 2017, 12:30pm by bplus » User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Spark Discharge
« Reply #24 on: Aug 26th, 2017, 03:41am »

Very nice.
User IP Logged

rtr
Member in Training
ImageImage


member is offline

Avatar




PM


Posts: 42
xx Re: Spark Discharge
« Reply #25 on: Aug 26th, 2017, 08:49am »

on Aug 25th, 2017, 12:21pm, bplus wrote:
Here is Pentacle Flux Capacitor #3 with many improvements

Unfortunately your program has a memory leak and if left running continuously will eventually exhaust all the available memory (you can see this if you run Task Manager). The version below fixes this problem:

Code:
'Pentacle Flux Capacitor 3.txt for JB (B+=MGA) 2017-08-25

global H$, XMAX, YMAX, PI, xc, yc, dist
H$ = "gr" : XMAX = 700 : YMAX = 700
PI = acs(-1) : xc = XMAX/2 : yc = YMAX/2
dim pentacle(4, 1), pentacle2(4, 1)

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2
UpperLeftY = (700 - YMAX) / 2
ttl$ = "press or click any to quit.";space$(27);_
"Pentacle Flux Capacitor #3 AKA Dancing Man..."
open ttl$ for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"
#gr "size 2"  '1 or 2?

call drawPFC3 'sets global points too
#gr "getbmp PFC3 0 0 ";XMAX;" ";YMAX
#gr "background PFC3"

while 1
    scan
    #gr "discard"
    #gr "drawsprites"
    call pause 15  '<< adjust time as needed for your system
    flux$ = str$(100 + rnd(0) * 155) + " "_
        + str$(100 + rnd(0) * 155) + " 255"
    #gr "color ";flux$
    call Lightning xc, yc-90, xc, yc + 10, 135
    for i = 0 to 4
        scan
        xe = pentacle2(i, 0) : ye = pentacle2(i, 1)
        d = rnd(0)*.5*dist+.1*dist
        select case i
        case 0
            call Lightning xc, yc-90, xe, ye, .65*d
            call Lightning xc, yc-90, xe, ye, .65*d
        case 1, 4
            call Lightning xc, yc-70, xe, ye, d
        case 2, 3
            call Lightning xc, yc+10, xe, ye, d
        end select
    next
    call pause 32 '<< adjust time as needed for your system
wend

sub drawPFC3
    '3 main points for array tp()
    pRadius = 40 : cRadius = 1.5 * pRadius
    a3 = 2 * PI / 5 : r = YMAX/2 - cRadius - 20
    ao = -1 * PI / 2 : a = ao
    for rr = YMAX / 2 - 20 to 0 step -1
        call midInk 0, 0, 0, 128, 0, 0, rr / r
        #gr "place ";xc;" ";yc;"; circlefilled ";rr
    next
    for i = 0 to 4
        pentacle(i,0) = xc + r * cos(a)
        pentacle(i,1) = yc + r * sin(a)
        for rr = cRadius to pRadius step -1
            #gr "color ";(rr - pRadius) / (cRadius - pRadius)_
                * 255 * (cRadius - rr + pRadius) / cRadius;" 0 0"
            #gr "backcolor ";(rr - pRadius) / (cRadius - pRadius)_
                * 255 * (cRadius - rr + pRadius) / cRadius;" 0 0"
            xx = pentacle(i, 0) : yy = pentacle(i,1)
            #gr "place ";xx;" ";yy;"; circlefilled ";rr
        next
        a = a + a3
    next
    dist = sqr((pentacle(0, 0)-xc)^2 + (pentacle(0, 1)-yc)^2)
    for point = 0 to 4
        scan
        for dis = 0 to .5 * dist step 10
            scan
            dGray = 255*dis/dist
            xx = pentacle(point, 0) : yy = pentacle(point, 1)
            call midpoint xx, yy, xc, yc, dis/dist, midx, midy
            for r = pRadius * (dist - dis) / dist to 0 step -1
                scan
                call midInk dGray, dGray, dGray,_
                    255, 255, 255, (pRadius - r) / pRadius
                #gr "place ";midx;" ";midy;"; circlefilled ";r
            next
        next
        pentacle2(point, 0) = midx
        pentacle2(point, 1) = midy
    next
end sub

sub Lightning x1,y1,x2,y2,d
    scan
    if d < 10 then
        #gr "line ";x1;" ";y1;" ";x2;" ";y2
    else
        mx = (x2+x1)/2
        my = (y2+y1)/2
        r1 = int(rnd(0)*5) - 2 : r2 = int(rnd(0)*5) - 2
        mx = mx + -.2 * rnd(0) * d * r1
        my = my + -.2 * rnd(0) * d * r2
        call Lightning x1, y1, mx, my, d/2
        call Lightning x2, y2, mx, my, d/2
    end if
end sub

sub midpoint x1, y1, x2, y2, fraction, byref midx, byref midy
    midx = (x2 - x1) * fraction + x1
    midy = (y2 - y1) * fraction + y1
end sub

sub midInk r1, g1, b1, r2, g2, b2, frac
    dr = (r2 - r1) * frac : dg = (g2 - g1) * frac
    db = (b2 - b1) * frac
    #gr "color ";r1 + dr;" ";g1 + dg;" ";b1 + db
    #gr "backcolor ";r1 + dr;" ";g1 + dg;" ";b1 + db
end sub

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$ 
    call quit H$
end sub

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

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub 

Richard.

User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Spark Discharge
« Reply #26 on: Aug 26th, 2017, 11:17am »

Oh, a discard in the main loop. OK

Thanks Richard
User IP Logged

B+
Valentin
Full Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 130
xx Re: Spark Discharge
« Reply #27 on: Aug 26th, 2017, 12:37pm »

Oh yes Rod ! With ionization is perfect !
Only oxygen molecules that break down into ozone
« Last Edit: Aug 26th, 2017, 12:39pm by Valentin » User IP Logged

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