Happy New Year!

[bplus]

Code Select Expand

REM SmallBASIC
REM created: 01/01/2020

CONST ColMax = XMAX \ TXTW("W")
CONST RowMax = YMAX \ TXTH("W") - 3
CONST nR = ColMax \ 10
CONST t = "     Happy New Year Syntax Bomb Forum, ASCII Fireworks Brought To You By Bplus Inspired By Recent Efforts at QB64 Forum, Go In Peace 2020..."

DIM r(1 TO nR)
FOR i = 1 TO nR
    new i
NEXT

REPEAT
    CLS
    COLOR 13
    lc = lc + 1
    IF lc MOD 3 = 0 THEN p = (p + 1) MOD LEN(t)
    LOCATE 2, .25 * ColMax: PRINT MID(t, p + 1, .5 * ColMax);
    rocs = rocs + 1
    IF rocs > nR THEN rocs = nR
    FOR i = 1 TO rocs
        drawRocket i
    NEXT
    SHOWPAGE
    DELAY 10
UNTIL ASC(INKEY) = 27

SUB new (i)
    r(i).x = INT(RND * (ColMax - 20)) + 10
    r(i).y = INT(RowMax) - 3
    r(i).bang = INT(RND * (RowMax - 10))
    r(i).age = 0
    r(i).c = INT(RND * 16)
END SUB

SUB drawRocket (i)
    IF r(i).y > r(i).bang THEN
        COLOR 15
        LOCATE r(i).y, r(i).x: PRINT  "^";
        'LOCATE r(i).y + 1, r(i).x: PRINT "!";
        r(i).y = r(i).y - 1
    ELSE
        r(i).age = r(i).age + 1
        IF r(i).age > 15 THEN
            new i
        ELSE
            COLOR r(i).c
            FOR j = 1 TO 12
                xx = r(i).x +  r(i).age * COS(j * PI / 6)
                yy = r(i).y + .5*r(i).age * SIN(j * PI / 6)
                IF xx > 0 AND xx < ColMax AND yy > 0 AND yy < RowMax   THEN
                    LOCATE yy, xx: PRINT "*";
                END IF
            NEXT
        END IF
    END IF
END SUB



[Aurel [banned]]

Hey Mark...
Happy New Year!

...and great demo 

[3DzForMe]

Happy New Year.... what does the code compile in? Is it small basic.....

[Steve Elliott]

Happy New Year.... what does the code compile in? Is it small basic.....

Well that's what the rem statement says.

[Aurel [banned]]

wow my PC data is different:

Windows 10, 64-bit, 16Gb RAM, CPU Intel i5, 3.4 GHz, Nvidia GeForce GTX 1060 (3Gb).

is that really important?

[bplus]

Hi all! Have to say this simple Ascii is fun! Here is some improvements:

Code Select Expand


REM SmallBASIC
REM created: 01/01/2020
' updated 2020-01-02 with gravity and trails

CONST ColMax = XMAX \ TXTW("W")
CONST RowMax = YMAX \ TXTH("W")
CONST nR = ColMax \ 15
CONST t = "     Happy New Year Syntax Bomb Forum, ASCII Fireworks Brought To You By Bplus Inspired By Recent Efforts at QB64 Forum, Gravity Effect by tsh73 at JB Forum, Go With Peace In 2020..."

DIM r(1 TO nR)
FOR i = 1 TO nR
    new i
NEXT

REPEAT
    CLS
    COLOR 13
    lc = lc + 1
    IF lc MOD 3 = 0 THEN p = (p + 1) MOD LEN(t)
    LOCATE 2, .25 * ColMax: PRINT MID(t, p + 1, .5 * ColMax);
    rocs = rocs + 1
    IF rocs > nR THEN rocs = nR
    FOR i = 1 TO rocs
        drawRocket i
    NEXT
    SHOWPAGE
    DELAY 20
UNTIL ASC(INKEY) = 27

SUB new (i)
    r(i).x = INT(RND * (ColMax - 20)) + 10
    r(i).y = INT(RowMax) - 3
    r(i).bang = INT(RND * (RowMax - 10))
    r(i).age = 0
    r(i).c = INT(RND * 15) + 1
END SUB

SUB drawRocket (i)
    IF r(i).y > r(i).bang THEN
        COLOR 15
        LOCATE r(i).y, r(i).x: PRINT  "^";
        r(i).y = r(i).y - 1
    ELSE
        r(i).age = r(i).age + 1
        IF r(i).age > 25 THEN
            new i
        ELSE
            COLOR r(i).c
            IF r(i).age > 4 THEN start = r(i).age - 4 ELSE start = 1
            FOR a = start TO r(i).age
                FOR j = 1 TO 12
                    xx = r(i).x + 1 * a * COS(j * PI / 6)
                    yy = r(i).y + .5 * a * SIN(j * PI / 6)
                    yy = yy + (r(i).y - a) ^ 2 / 15 '<<<< tsh73 gravity
                    IF xx > 0 AND xx < ColMax AND yy > 0 AND yy < RowMax THEN
                        LOCATE INT(yy), INT(xx)
                        PRINT "*";
                    END IF
                NEXT
            NEXT
        END IF
    END IF
END SUB


I will drop off QB64 version with compiled exe so all may enjoy!
Update: https://www.syntaxbomb.com/index.php/topic,6829.0.html

BTW the speed is about right with SmallBASIC 64 bit version, the new editor is running a 32 bit? I think.

[Steve Elliott]

wow my PC data is different:

Windows 10, 64-bit, 16Gb RAM, CPU Intel i5, 3.4 GHz, Nvidia GeForce GTX 1060 (3Gb).

is that really important?

What the hell are you talking about?  Trying to compile a Small BASIC program in Blitz3D BASIC *is* important - because it won't work now will it?

[3DzForMe]

Okay, I've searched for Small basic compiler - to be fair - less than a minute digging for it tbh, however, I've just also downloaded my PAID for AGK studio - that wins for now.

You can't blame someone for thinking the daddy of development environments (obviously B3D) could potentially turn its hand to something with basic in the title.... or maybe you can - apparently. 

Happy New Year Peeps, be happy

[bplus]

Okay, I've searched for Small basic compiler - to be fair - less than a minute digging for it tbh, however, I've just also downloaded my PAID for AGK studio - that wins for now.

You can't blame someone for thinking the daddy of development environments (obviously B3D) could potentially turn its hand to something with basic in the title.... or maybe you can - apparently. 

Happy New Year Peeps, be happy

SmallBASIC interpreter can be downloaded from here: http://smallbasic.github.io
not to be confused with MS Small Basic.

Good luck with AGK studio, it should win! ;-))

[chrisws]

Hi all! Have to say this simple Ascii is fun! Here is some improvements:
I will drop off QB64 version with compiled exe so all may enjoy!
Update: https://www.syntaxbomb.com/index.php/topic,6829.0.html
BTW the speed is about right with SmallBASIC 64 bit version, the new editor is running a 32 bit? I think.

Great stuff MGA!
I much prefer your fireworks over the real thing.
It's a pity QB64 and SB syntax are so similar yet incompatible.

[Aurel [banned]]

Mark
I will try to run your program in TOY58
just to check is Ed beast still running...

ahh to Steve that isjust my reference to your PC 

[Steve Elliott]

lol I put my computer specs in my signature so if I'm reporting a problem with software, the coder can immediately see what hardware the problem occurs on - graphics card and so on.

[bplus]

Hi all! Have to say this simple Ascii is fun! Here is some improvements:
I will drop off QB64 version with compiled exe so all may enjoy!
Update: https://www.syntaxbomb.com/index.php/topic,6829.0.html
BTW the speed is about right with SmallBASIC 64 bit version, the new editor is running a 32 bit? I think.

Great stuff MGA!
I much prefer your fireworks over the real thing.
It's a pity QB64 and SB syntax are so similar yet incompatible.

Here is a translation back from QB64 of code that started out in SmallBASIC and evolved a bit in QB64 now full circle
64 bit SB recommended:

Code Select Expand


' fireworks.bas for SmallBASIC b+ 2020-01-03
' translate  "Happy Trails 2020.bas" in QB64
' without landscape, water, water reflection and messaging

RANDOMIZE TIMER
CONST lTail = 15

'prepare fire works
nFW = 7
DIM fw(1 TO 10)
FOR i = 1 TO nFW
  initFireWork i
NEXT

'OK start the show
WHILE asc(inkey) <> 27
  for i = 0 to ymax
    line 0, i, xmax, i, rgb(0, 0, 64 * i / ymax)
  next
  'draw fireworks
  FOR f = 1 TO nFW
    IF fw(f).age <= fw(f).life THEN drawfw (f) ELSE initFireWork f
  NEXT
  showpage
WEND

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

SUB drawfw (i)
  'here's how to "save" a bunch of random numbers without data and arrays but tons of redundant calculations
  RANDOMIZE fw(i).seed 'this repeats all random numbers generated by seed in same sequence
  'recreate our firework from scratch!
  red = rand(200, 255)
  green = rand(200, 255)
  blue = rand(200, 255)
  x = rand(1, 4)
  IF x = 1 THEN
    red = 0
  ELSEIF x = 2 THEN
    green = 0
  ELSEIF x = 3 THEN
    blue = 0
  ELSE
    x = rand(1, 4)
    IF x = 1 THEN
      red = 0: green = 0
    ELSEIF x = 2 THEN
      green = 0: blue = 0
    ELSEIF x = 3 THEN
      blue = 0: red = 0
    END IF
  END IF
  ne = rand(80, 300)
  DIM embers(ne)
  FOR e = 0 TO ne
    r = RND * 5
    embers(e).x = r * COS(e * PI * 2/ 101)
    embers(e).y = r * SIN(e * PI * 2/ 101)
  NEXT
  start = fw(i).age - lTail ' don't let tails get longer than lTail const
  IF start < 1 THEN start = 1
  FOR e = 0 TO ne
    cx = fw(i).x: cy = fw(i).y: dx = embers(e).x: dy = embers(e).y
    FOR t = 1 TO fw(i).age
      cx = cx + dx
      cy = cy + dy
      IF t >= start THEN
        'too much like a flower?
        midInk 60, 60, 60, red, green, blue, (t - start) / lTail
        'midInk 60, 60, 60, 128, 160, 150, (t - start) / lTail
        circle cx, cy, (t - start) / (.5 * lTail) FILLED
      END IF
      dx = dx * .99 'air resitance
      dy = dy + .05 'gravity
    NEXT
    COLOR RGB(255, 255, 255)
    cx = cx + dx: cy = cy + dy
    circle cx, cy, (t - start) / (.5 * lTail) FILLED
  NEXT
  fw(i).age = fw(i).age + 1
END SUB

SUB initFireWork (i)
  fw(i).x = rand(.1 * xmax, .9 * xmax)
  fw(i).y = rand(.1 * ymax, .5 * ymax)
  fw(i).seed = rand(0, 32000)
  fw(i).age = 0
  fw(i).life = rand(20, 120)
END SUB

SUB midInk (r1, g1, b1, r2, g2, b2, fr)
  COLOR RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
END SUB


[Dan]

And here is converted version for the Blitzbasic compiler:

Code Select Expand


;SmallBASIC
;created: 01/01/2020
;converted to Blitzbasic by Dan - 4.1.2020

Const XMAX#=640
Const ymax#=480

Graphics XMAX,ymax,32,2
Graphics XMAX,ymax,32,3


Global ColMax# = XMAX# / FontWidth()
Global RowMax# = ymax# / FontHeight()
Global nR# = ColMax# / 15
Global t$ = String(" ",90)+"Happy New Year Syntax Bomb Forum, ASCII Fireworks Brought To You By Bplus Inspired By Recent Efforts at QB64 Forum, Go With Peace In 2020..."
AppTitle "Happy New 2020 Year"
Const r_x=0,r_y=1,r_bang=2,r_age=3,r_c=4
Dim r#(nR,5)

For i = 1 To nR
    iNew (i)
Next

SetBuffer BackBuffer()

Repeat
    Cls
    Color $ff,$ff,$ff
    Line 0,(.25*ColMax)-2,XMAX,(.25*ColMax)-2
    Line 0,(.25*ColMax)+15,XMAX,(.25*ColMax)+15
    Color $ff,0,$ff
    lc = lc + 1
    If lc Mod 3 = 0 Then p = (p + 1) Mod Len(t)
    Text 2, .25 * ColMax, Mid(t, p + 1, ColMax);
    rocs = rocs + 1
    If rocs > nR Then rocs = nR
    For i = 1 To rocs
        drawRocket i
    Next
Delay 1
    Flip(1)
   
Until KeyDown(1)

Function iNew (i)
    r(i,r_x) = Int(Rnd (ColMax) * 10)-20
    r(i,r_y) = Int(RowMax - 3) * 10
    r(i,r_bang) = Int(Rnd (RowMax-10))*10
    r(i,r_age) = 0
    r(i,r_c) = Int(Rnd (15))
End Function

Function drawRocket (i)
Local xx#,yy#
    If r(i,r_y) > r(i,r_bang) Then
        Color $ff,$ff,0
        Text r(i,r_x),r(i,r_y) , "^" ;
        r(i,r_y) = r(i,r_y) - 1
    Else
        r(i,r_age) = r(i,r_age) + 1
        If r(i,r_age) > 200 Then
            iNew (i)
        Else
            Colorful r(i,r_c)
            If r(i,r_age) > 4 Then start = r(i,r_age) - 4 Else start = 1
            For a = start To r(i,r_age)
                For j = 1 To 12
xx = r(i,r_x) + r(i,r_age) * Cos((j*30))
                    yy = r(i,r_y) + .5 * r(i,r_age) * Sin((j*30))
                    If xx > 0 And xx < ColMax*10 And yy > 0 And yy < RowMax*10 Then
                        Text Int(xx), Int(yy), "*"
                    End If
                Next
            Next
        End If
    End If
End Function

Function Colorful(x)
Select x
Case 00 : Color $ff,0,0
Case 01 : Color 0,$ff,0
Case 02 : Color 0,0,$ff
Case 03 : Color $ff,$ff,0
Case 04 : Color  $0,$ff,$ff
Case 05 : Color $FF,0,$ff
Case 06 : Color $80,$ff,0
Case 07 : Color $ff,$0,80
Case 08 : Color $0,$80,$ff
Case 09 : Color $50,$50,$50
Case 10 : Color $ff,$20,$50
Case 11 : Color $80,$30,10
Case 12 : Color $50,$50,$ff
Case 13 : Color $ff,$50,$90
Case 14 : Color $20,$40,$60
Case 15 : Color $80,$a0,$b0
End Select
End Function


Happy new Year :party:

[bplus]

Hi Dan,

I love comparing different Basic approaches to same problem, thanks for glimpse into Blitzbasic.

We did this all the time at Retro, but this board maybe not best for that. I will post my JB version in OTHER, same topic in case you or others like to compare.