Recent Posts

Pages: [1] 2 3 ... 10
1
Programs / Re: Gears
« Last post by bplus on Yesterday at 10:50:18 AM »
To speed up, you can reduce screen size OR scale the pixel drawing up to boxes. Either way, there is less calculations.
Of course, you can also rotate the gears faster and slower as demo'd already. ;-))

Here is doing it with scaling, the smaller the scale the bigger the fire but the blurrier the picture. Try any scale >0 and <=1:
Code: [Select]
_TITLE "Gears Afire! SCALED.bas for QB64 by B+ started  2018-05-25"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

CONST xmax = 800
CONST ymax = 600
DIM SHARED pi
pi = _PI

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM SHARED p&(300) 'pallette thanks harixxx
FOR i = 1 TO 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
NEXT

WHILE 1
    CLS
    LOCATE 5, 23: PRINT "***  GEARS AFIRE! NOW SCALED TO YOUR SPECIFICATIONS ***"
    LOCATE 10, 35: PRINT "Please enter a scale from 0 to 1,"
    LOCATE 11, 10: PRINT "the lower the scale the less pixels used the bigger the fire and blurrier it gets. "
    LOCATE 13, 20: INPUT "(0 or any number > 1 quits) Enter your scale choice now > "; scale
    _DISPLAY
    IF NOT (scale > 0 AND scale <= 1) THEN END
    CLS

    LOCATE 10, 18: PRINT "Please wait 30 seconds to watch the _LIMIT changes for graphics speed."
    LOCATE 15, 41: PRINT "press any for show..."
    _DISPLAY
    'SLEEP      'WTF???
    k$ = ""
    WHILE LEN(k$) = 0: k$ = INKEY$: _LIMIT 500: WEND


    rscale = 1 / scale
    xxmax = scale * xmax
    yymax = scale * ymax

    REDIM SHARED f(xxmax, yymax) 'fire array tracks flames

    'gear up
    sq = 20
    nt1 = 12
    r1 = gearRadius(nt1, sq)
    nt2 = nt1 * 2
    r2 = gearRadius(nt2, sq)
    iA2 = pi / nt2
    acc = 1: d = 1

    start = TIMER
    WHILE TIMER - start < 30 'main show
        CLS
        PRINT "Scale, _LIMIT:"; scale; ","; acc
        rao = rao + pi / 180
        gear 600 * scale + 1, 300 * scale + 1, nt1, sq * scale, rao
        gear (600 - r1 - r2 - sq - 6) * scale + 1, 300 * scale + 1, nt2, sq * scale, -.5 * rao - iA2
        FOR y = 1 TO yymax - 2 'fire based literally on 4 pixels below it like cellular automata
            FOR x = 1 TO xxmax - 1
                v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
                IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
                IF v > 294 THEN f(x, y) = 300
                LINE (x * rscale, y * rscale)-STEP(rscale, rscale), p&(f(x, y)), BF
            NEXT
        NEXT
        acc = acc + d
        IF acc < 1 THEN acc = 1: d = d * -1
        IF acc > 100 THEN acc = 100: d = d * -1
        _DISPLAY
        _LIMIT acc
    WEND
WEND


FUNCTION gearRadius (nteeth, sqtooth)
    gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
END FUNCTION

SUB gear (x, y, nteeth, sqtooth, raOffset)
    radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
    FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + (radius + sqtooth) * COS(ra + raOffset)
        y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth - 4
    NEXT
    FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + radius * COS(ra + raOffset)
        y2 = y + radius * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth + 4
    NEXT
END SUB

SUB thic (x1, y1, x2, y2, thick)
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    a = _ATAN2(y2 - y1, x2 - x1)
    FOR i = 0 TO t2 STEP .5
        x3 = x1 + i * COS(a + _PI(.5))
        y3 = y1 + i * SIN(a + _PI(.5))
        x4 = x1 + i * COS(a - _PI(.5))
        y4 = y1 + i * SIN(a - _PI(.5))
        x5 = x2 + i * COS(a + _PI(.5))
        y5 = y2 + i * SIN(a + _PI(.5))
        x6 = x2 + i * COS(a - _PI(.5))
        y6 = y2 + i * SIN(a - _PI(.5))
        'fireLine x3, y3, x4, y4
        fireLine x4, y4, x6, y6
        'fireLine x6, y6, x5, y5
        fireLine x5, y5, x3, y3
    NEXT
END SUB

SUB fireLine (x, y, x1, y1)
    d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
    a = _ATAN2(y1 - y, x1 - x)
    FOR i = 0 TO d
        xx = INT(x + i * COS(a) + .5)
        yy = INT(y + i * SIN(a) + .5)
        f(xx, yy) = rand(200, 300)
    NEXT
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

2
Programs / Re: Gears
« Last post by Ashish on Yesterday at 03:45:14 AM »
Now, this is something cool!
For speeding up, you can try reducing screen size.
3
Programs / Re: Gears
« Last post by bplus on Yesterday at 12:31:58 AM »
Hi Fellippe,

For you, I will show you one of my blunders but kind of cool too! It may show why you do have to go a little slow with fire.

Code: [Select]
_TITLE "Ferris Wheels Afire!.bas for QB64 by B+ started  2018-05-24"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

CONST xmax = 800
CONST ymax = 600
DIM SHARED pi
pi = _PI
CONST bhr = 20
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

DIM SHARED f(xmax, ymax) 'fire array tracks flames
DIM SHARED p&(300) 'pallette thanks harixxx
FOR i = 1 TO 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
NEXT

'gear up
sq = 20
nt1 = 12
r1 = gearRadius(nt1, sq)
nt2 = nt1 * 2
r2 = gearRadius(nt2, sq)
iA2 = pi / nt2
acc = 300: d = -1
WHILE 1 'main show
    CLS
    rao = rao + pi / acc
    gear 600, 300, nt1, sq, rao
    gear 600 - r1 - r2 - sq - 6, 300, nt2, sq, -.5 * rao - iA2
    FOR y = 1 TO ymax - 2 'fire based literally on 4 pixels below it like cellular automata
        FOR x = 1 TO xmax - 1
            v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
            IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
            IF v > 294 THEN f(x, y) = 300
            PSET (x, y), p&(f(x, y))
        NEXT
    NEXT
    acc = acc + d * 2
    IF acc < 6 THEN acc = 6: d = d * -1
    IF acc > 300 THEN acc = 300: d = d * -1
    _DISPLAY
WEND

FUNCTION gearRadius (nteeth, sqtooth)
    gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
END FUNCTION

SUB gear (x, y, nteeth, sqtooth, raOffset)
    radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
    FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + (radius + sqtooth) * COS(ra + raOffset)
        y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth - 4
    NEXT
    FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + radius * COS(ra + raOffset)
        y2 = y + radius * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth + 4
    NEXT
END SUB

SUB thic (x1, y1, x2, y2, thick)
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    a = _ATAN2(y2 - y1, x2 - x1)
    FOR i = 0 TO t2 STEP .5
        x3 = x1 + t2 * COS(a + _PI(.5))
        y3 = y1 + t2 * SIN(a + _PI(.5))
        x4 = x1 + t2 * COS(a - _PI(.5))
        y4 = y1 + t2 * SIN(a - _PI(.5))
        x5 = x2 + t2 * COS(a + _PI(.5))
        y5 = y2 + t2 * SIN(a + _PI(.5))
        x6 = x2 + t2 * COS(a - _PI(.5))
        y6 = y2 + t2 * SIN(a - _PI(.5))
        fireLine x3, y3, x4, y4
        fireLine x4, y4, x6, y6
        fireLine x6, y6, x5, y5
        fireLine x5, y5, x3, y3
    NEXT
END SUB

SUB fireLine (x, y, x1, y1)
    d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
    a = _ATAN2(y1 - y, x1 - x)
    FOR i = 0 TO d
        xx = INT(x + i * COS(a) + .5)
        yy = INT(y + i * SIN(a) + .5)
        f(xx, yy) = rand(200, 300)
    NEXT
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

4
Programs / Re: Gears
« Last post by FellippeHeitor on Yesterday at 12:08:05 AM »
Speed up? I wish! You did wait to see the gears speed up and slow down and speed up.... right?

Hmm didn't. Low fps at start put me off. Looked in code for usual _delay and upon not finding it I assumed it was loooow fps
5
Programs / Re: Gears
« Last post by bplus on May 24, 2018, 11:19:41 PM »
Speed up? I wish! You did wait to see the gears speed up and slow down and speed up.... right?

Maybe Steve or someone could do memory tricks, I am drawing lines pixel by pixel in a psuedo screen array.

I did consider scaling the f for fire array.

Append: ha! I could get rid of that extra parameter thick, not used in fireLine!

Append again, possibly could be done with POINT before clearing screen, that way all the hand draw stuff could be done with built-in commands. You do need some "slow" to let the fire effect "accumulate" in the pixels in surrounding area.
6
Programs / Re: Gears
« Last post by FellippeHeitor on May 24, 2018, 10:50:36 PM »
Now that's what I call a crossover.

Can it be made any faster though?
7
Programs / Re: Gears
« Last post by bplus on May 24, 2018, 10:48:02 PM »
Gears Afire!
Code: [Select]
_TITLE "Gears afire!.bas for QB64 by B+ started  2018-05-24"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

CONST xmax = 800
CONST ymax = 600
DIM SHARED pi
pi = _PI
CONST bhr = 20
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

DIM SHARED f(xmax, ymax) 'fire array tracks flames
DIM SHARED p&(300) 'pallette thanks harixxx
FOR i = 1 TO 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
NEXT

'gear up
sq = 20
nt1 = 12
r1 = gearRadius(nt1, sq)
nt2 = nt1 * 2
r2 = gearRadius(nt2, sq)
iA2 = pi / nt2
acc = 300: d = -1
WHILE 1 'main show
    CLS
    rao = rao + pi / acc
    gear 600, 300, nt1, sq, rao
    gear 600 - r1 - r2 - sq - 6, 300, nt2, sq, -.5 * rao - iA2
    FOR y = 1 TO ymax - 2 'fire based literally on 4 pixels below it like cellular automata
        FOR x = 1 TO xmax - 1
            v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
            IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
            IF v > 294 THEN f(x, y) = 300
            PSET (x, y), p&(f(x, y))
        NEXT
    NEXT
    acc = acc + d * 2
    IF acc < 6 THEN acc = 6: d = d * -1
    IF acc > 300 THEN acc = 300: d = d * -1
    _DISPLAY
WEND

FUNCTION gearRadius (nteeth, sqtooth)
    gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
END FUNCTION

SUB gear (x, y, nteeth, sqtooth, raOffset)
    radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
    FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + (radius + sqtooth) * COS(ra + raOffset)
        y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth - 4
    NEXT
    FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + radius * COS(ra + raOffset)
        y2 = y + radius * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth + 4
    NEXT
END SUB

SUB thic (x1, y1, x2, y2, thick)
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    a = _ATAN2(y2 - y1, x2 - x1)
    FOR i = 0 TO t2 STEP .5
        x3 = x1 + i * COS(a + _PI(.5))
        y3 = y1 + i * SIN(a + _PI(.5))
        x4 = x1 + i * COS(a - _PI(.5))
        y4 = y1 + i * SIN(a - _PI(.5))
        x5 = x2 + i * COS(a + _PI(.5))
        y5 = y2 + i * SIN(a + _PI(.5))
        x6 = x2 + i * COS(a - _PI(.5))
        y6 = y2 + i * SIN(a - _PI(.5))
        'fireLine x3, y3, x4, y4
        fireLine x4, y4, x6, y6
        'fireLine x6, y6, x5, y5
        fireLine x5, y5, x3, y3
    NEXT
END SUB

SUB fireLine (x, y, x1, y1)
    d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
    a = _ATAN2(y1 - y, x1 - x)
    FOR i = 0 TO d
        xx = INT(x + i * COS(a) + .5)
        yy = INT(y + i * SIN(a) + .5)
        f(xx, yy) = rand(200, 300)
    NEXT
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

EDIT: removed an unused parameter in fileLine
8
Off-Topic / Re: QBasic Forum - Network54 Server Offline
« Last post by Pete on May 24, 2018, 01:11:29 PM »
Darn that Murphy! I made a post yesterday, and shortly after that, it went down again.

My hunch is they are finally migrating forums, but I don't see why they need to take the server offline to do so, unless they boo-booed and are trying to salvage whatever went wrong.

They have a ton of stuff to copy and move. I think they finally gave up on communications because of all the questions people have been submitting.

There will probably be a lot of links that no longer work, pages missing, sub-forums not transferred and if so, they will be inundated with a lot more communications. If the migration doesn't go well, people will be very upset, however, everyone had fair warning about the changes, and could have paid to transfer their existing forums to another service provider. Network54 is so archaic it just wouldn't seem as simple as transferring a board like this one.

On the bright side, if Tapatalk didn't buy out N54, N54 would have just shut down. Of course if something goes wrong or has gone wrong in that deal, that will happen anyway. The only proof I have that the migration is going to take place is some forums that were already transferred to a web index unlisted beta forum. I haven't provided the URL because all posts to it would be overwritten and lost, replaced by the N54 forum posts if/when this migration actually occurs.

Pete
9
Off-Topic / Re: QBasic Forum - Network54 Server Offline
« Last post by FellippeHeitor on May 24, 2018, 11:07:35 AM »
Hm, still can't reach it...
10
Off-Topic / Re: QBasic Forum - Network54 Server Offline
« Last post by Pete on May 24, 2018, 02:44:37 AM »
And as Murphy's Law would have it, once I complained it was missing, it comes back. All I had to do was take a nap. My wife says that's when I do my best work, anyway... Shut up, Bill!

Pete
Pages: [1] 2 3 ... 10