Animations

' Ported from yonatan's code @ https://www.dwitter.net/d/9218 to FB by UEZ build 2020-10-17

' Adaptation pour FBCroco par J. Debord

randomize

const w = 500, h% = 280, w2 = w \ 2, h2 = h \ 2

mode 3, "Banana", w, h

paper &hFFC2DFFF

dim d% = 2500, i%
dim t, x, y, a, b, r, j

repeat
   screenlock
   cls
   i = d
  
   repeat
     j = i / d
     if j > 0.9 then r = 2 else r = 30 * sin(3 * j + 0.3)
     a = r - Sin(i * 2) ^ 8 * 15
     x = w2 + (i - 1000) * sin(t) / 9 + sin(i) * (r - a / 4)
     y = 100 + sin(3 * j) * 75 + cos(i) * r
     b = 7 * a - sin(i ^ 5) ^ 8 * 30
     if b < 0 then b = 0 else if b > 255 then b = 255
     pen RGB(b, b * 0.8, 0)
     rectangle_fill x, y, 6, 6
     i = i - 1
     t = t + 0.000005
   until i < 0

   screenunlock
   sleep 10
until inkey() <> ""

' Ported from Gerard Ferrandez's code @ https://codepen.io/ge1doot/pen/aQPqXX to FB by UEZ build 2020-10-17

' Adaptation pour FBCroco par J. Debord

randomize

const s = 5, w = 40, h = 80, xm = 20, ym = 74

mode 3, "Flame", w * s, h * s

dim mtx%((w + 1) * h)
dim i%, j%, p%, nc%, ncb%
dim r%, g%, b%
dim t, x, y, ap, z

repeat
   screenlock
   cls
   mtx(ym * w + xm) = 8192 * rnd()
   for i = 1 to h - 1
      for j = 1 to w - 1
         p = i * w + j
         ap = p + w - (rnd())
         ncb = mtx(p)
         nc = ((mtx(ap) + mtx(ap + 1) + mtx(ap - w) + mtx(ap - w + 1)) * 0.485 * rnd())
         mtx(p) = nc
         if nc <> ncb then
            z = -ym + i
            x = j * s
            y = i * s
            r = nc * 4
            g = nc * 2
            b = nc * 0.001 * z * z * z
            
            if r < 0 then r = 0 else if r > 255 then r = 255
            if g < 0 then g = 0 else if g > 255 then g = 255
            if b < 0 then b = 0 else if b > 255 then b = 255
            
            pen RGB(r, g, b)
            rectangle_fill x, h * s - y, s, s
         end if
      next
   next
  
   screenunlock
   sleep 10
until inkey() <> ""

rectangle_fill x,h-y, 6, 6

' Ported from yonatan's code @ https://www.dwitter.net/d/9544 to FB by UEZ build 2020-10-17

' Adaptation pour FBCroco par J. Debord

randomize

const w = 500, h = 280, w2 = w \ 2, h2 = h \ 2

mode 3, "Flower", w, h

paper &hFFC2DFFF

dim t, x, y, i, j, q, c
dim c1%*1u, c2%*1u

repeat
   screenlock
   cls
   i = w
   repeat
      j = 1 - i / w
      q =(2 + sin(i * 5)^3) * j * j * j * j * w
      x = w2 + sin(i + t) * q
      c = j * 600
      if c > 255 then c = 255
      c1 = c shl 1
      c2 = c shr 2
      x = w2 + sin(i + t) * q
      y = h - j * 300 - cos(i + t) * q
      pen RGBA(c, c1, c2, &hE0)
      rectangle_fill x, w2 - y + 50, 9, 9
      i = i * 0.9998
      t = t + 0.0000025
   until i <= w2

   screenunlock
   sleep 2
until inkey() <> ""

' Ported from https://www.dwitter.net/d/20304 by danny@hille.dk to FB by UEZ build 2020-10-20

' Adaptation pour FBCroco par J. Debord

randomize

const w = 640, h = 320

mode 3, "Plasma", w, h

dim m, t, x%, y%

repeat
   screenlock
   cls
   for x = w - 1 to 0 step -1
      for y = h - 1 to 0 step -1
         m = sin(y / 64 + x / 64 - sin(tan(t / 9) * 19 * cos(x /  * sin(y / 8))) * 99 + 99
         pen RGB(m, 0, 200 - m)
         rectangle_fill x, y, 1, 1
         t = t + 0.0000001
      next y
   next x
   screenunlock
   sleep 1
until inkey() <> ""

m = sin(y / 64 + x / 64 - sin(tan(t / 9) * 19 * cos(x / 8 )  * sin(y / 8))) * 99 + 99

' **************************************************************
' Tombe la neige
' **************************************************************
' D'apres BasicCoder2 sur le forum FreeBASIC :
' https://www.freebasic.net/forum/viewtopic.php?f=3&t=29050
' **************************************************************

dim x%(100), y%(100), r%(100), c%(100)

mode 3, "Tombe la neige", 640, 480

init()

repeat
  screenlock
  cls
  ciel()
  montagnes()
  arbre()
  neige()
  screenunlock
  sleep 2
  update()
until inkey() <> ""

' **************************************************************

sub init ()

  def rndcol(n) = rnd() * n + 200

  dim i%
  for i = 0 to 100
    x(i) = rnd() * 640
    y(i) = rnd() * 480
    r(i) = rnd() * 2 + 1
    c(i) = rgb(rndcol(16), rndcol(16), rndcol(16))
  next i
end_sub

sub ciel ()
  dim r%, g%, b%, y%
  r = 0 : g = 0 : b = 140
  for y = 640 to 118 step -3
    pen rgb(r, g, b)
    rectangle_fill 0, y, 640, 3
    r = r + 1 : g = g + 1 : b = b + 1
    if b > 255 then b = 255
  next y
end_sub

sub arbre ()
  pen CL_ROUGE
  rectangle_fill 90, 150, 20, 100
  pen CL_VERT
  trace "BM100,130 M+30,+30 M+30,+200 M-60,-30 M-60,+30 M+30,-200 M+30,-30"
  move 100, 300 : fill CL_VERT
end_sub

sub montagnes ()
  pen rgb(56,122,156)
  pie 100, -250, 400
  pie 410, -260, 400
  pie 500, -260, 400
  pen rgb(158,205,235)
  pie 140, -450, 500
  pie 410, -440, 500
  pie 490, -430, 480
end_sub

sub neige ()
  dim i%
  for i = 0 to 100
    pen c(i)
    pie x(i), y(i), r(i)
  next i
end_sub

sub update()
  dim i%
  for i = 0 to 100
    y(i) = y(i) - r(i)
    if y(i) < 100 + rnd() * 60 then y(i) = 480
    x(i) = x(i) + rnd() * 3 - 1
    if x(i) < 0 then x(i) = x(i) + 640
    if x(i) > 640 then x(i) = x(i) - 640
  next i
end_sub

' Dark Planet, Hairy sphere.
' D'apres Richard sur le forum FreeBASIC :
' https://www.freebasic.net/forum/viewtopic.php?f=3&t=28793&start=45#p279973

Const N = 600    ' set number of hairs

Const TwoPi = 2 * Pi
Const angle = Pi * ( 3 - Sqr( 5 ) )

dim lat(N), lon(N), hgt(N)

' precompute points

Randomize
Dim i%
For i = 1 To N
  lat(i) = Asin( 2 * i / ( N + 1 ) - 1 )
  lon(i) = i * angle
  hgt(i) = 0.1 + 0.2 * Rnd  ' hair length
Next i

' setup a graphics screen

const W = 600, H = 600
const FactX = W / 2.8, FactY = H / 2.8
mode 3, "Virus", W, H
origin W \ 2, H \ 2

' display the rotating sphere

Dim beta, x, y, z, xh, yh, zh, t, r = 1
Dim xp%, zp%, xhp%, zhp%

repeat
    For beta = 0 To TwoPi Step 0.003 ' rotation angle
      
        Screenlock
        Cls
      
        For i = 1 To N
        
                x = r * Cos(lat(i)) * Cos(lon(i) + beta)
                z = r * Sin(lat(i))
              
                xh = x * (r + hgt(i))
                zh = z * (r + hgt(i))
              
                xp = x * FactX
                zp = z * FactY

                xhp = xh * FactX
                zhp = zh * FactY

                If Sin(lon(i) + beta) < 0 Then  ' on this side
                    arc xp, zp, 2
                    move xp, zp
                    draw xhp, zhp
                Else
                    t = Sqr(xh * xh + zh * zh)
                    If t > r Then   ' hair is above horizon
                        move xhp / t, zhp / t
                        draw xhp, zhp
                    End If
                End If
              
        Next i
      
        Screenunlock
        Sleep 10

        if inkey() <> "" then exit_repeat
    Next beta
  
until FALSE

'Ported from https://codegolf.dweet.net/a/228 by joeytwiddle to FB by UEZ build 2020-11-07

' Adaptation pour FBCroco par J. Debord

randomize

const w = 960, h = 540, w2 = w \ 2, h2 = h \ 2

dim x%, px, py, k, t, u, v

mode 3, "Chauve-souris", w, h

paper CL_BLANC : cls

pen CL_NOIR

repeat
  screenlock
  cls

  for x = -699 To 699
    k = abs(x)
    u = 125 + 99 * sin(abs(-2 + (k / 35)) ^ 0.6) + (k / 9) ^ 1.3
    v = 725 - k / 2 - (2 - sin(2 * t + 1)) * 35 * (sin(k / 76) ^ 2) ^ 0.5 - u
    px = w2 + (x * (1 + 0.30 * cos(2 * t))) * 0.5
    py = (u + (k - 150) * (0.4 + sin(2 * t + 0.2)) / 1.5) * 0.5
   
    rectangle_fill px, h - py, 2, v * 0.5
 
    t = t + 0.00001
  next x

  screenunlock
  sleep 1
until inkey() <> ""

' Ported from https://www.dwitter.net/d/1968 by nystrand To FB by UEZ build 2021-02-09

' Adaptation pour FBCroco par J. Debord

def col(c) = max(0, min(255, c))

randomize

const w = 960, h = 540, w2 = w \ 2, h2 = h \ 2

dim i%, j%, k%, c%, l%
dim t, x, y, z, d, a, b

mode 3, "Cube 3D", 960, 540

paper CL_NOIR : cls

repeat
  screenlock
  cls

  l = 512
  a = Cos(t)
  b = Sin(t)
  
  repeat
    l = l - 1
    i = l shr 6
    j = (l shr 3) mod 7
    k = l mod 8 - 4
    z = 20 + b * i - a * j
    d = 0.25 * z / a
    x = (k - a * a * i - b * a * j + b / a) * z + 300
    y = (a * i + b * j + a * k) * z + 199
    pen RGBA(col(z * 20), col(z * 10), col(z * 15), min(255, z * 10))
    rectangle_fill x, y, d, d
  until l = 0

  t = t + 0.01666
  screenunlock
  sleep 5
until inkey() <> ""

' Ported from https://www.dwitter.net/d/3267 by New_Core to FB by UEZ build 2021-01-26

' Adaptation pour FBCroco par J. Debord

def fmod(x, y) = x - y * int(x / y)

def map(value, source_start, source_stop, dest_start, dest_stop) = (value - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start

randomize

const w = 960, h = 540, w2 = w \ 2, h2 = h \ 2

dim i%, d% = 150
dim t, z

mode 3, "Balles bondissantes", w, h

paper CL_BLANC : cls

repeat
  screenlock
  cls

  for i = 500 to 0 step -1
    z = 6 * d / (d + fmod((i * i + t * 99), w))
    pen RGBA(Max(255, i), i \ 2, 0, Map(z, 0.545, 6, &h7F, 255))
    pie w2 + z * d * 4 * sin(i), w2 - (z * d * sin(fmod(i * i + t, PI))), z * z * z
  next i
  
  t = t + 0.016
  screenunlock
  sleep 10
until inkey() <> ""

' Ported from https://www.dwitter.net/d/21547 by tomxor To FB by UEZ build 2021-02-01

' Adaptation pour FBCroco par J. Debord

randomize

mode 3, "Un drapeau dans le vent", 700, 700

paper &hFF404040 : cls

dim t, px, py, y, sy, scale = 10
dim i%, c%, x%

repeat
  screenlock : cls
  for i = 6271 to 0 step -1
    x = i mod 98
    y = i / 98
    px = 40 + (x / 2 + x / 48 * cos(x / 8 - y / 8 - t * 7)) * scale
    py = 70 + (y / 2 + x / 6 + x / 12 * sin(x / 16 - t * 3)) * scale
    sy = iif(i, iif(((x / 40 - 1.3) or (y / 10 - 3) / ((x + 1) and 4)), 0.15, 0.9), 43)
    c = max(0, (x - y)) xor min(255, sy * 160)
    pen RGBA(c, c shl 2, c shl 1, &h80)
    rectangle_fill px, 700 - py, scale, sy * scale * 4
  next i
  t = t + 0.016

  screenunlock
  sleep 1
until inkey() <> ""

' Ported from https://www.dwitter.net/d/369 by chet To FB by UEZ build 2021-02-02

' Adaptation pour FBCroco par J. Debord

const w = 500, h = 540, w2 = w \ 2, h2 = h \ 2, h3 = h \ 4

mode 3, "Barres verticales", w, h

paper &hFF404040

dim i% = 255, y%, t

repeat
  screenlock : cls
   
  y = i
  while y > 179
    A(cos(-8 * t + y * 0.1) * y * 0.4, i - y, 255)
    y = y - 1
  wend
  t = t + 0.016

  screenunlock : sleep 1
until inkey() <> ""

end

sub A(z, y%, i%)
   
  dim x%, px, py

  for x = 24 To 0 Step -1
    px = w2 + x + z + i / 2 - 100
    py = h - h3 - y
    pen RGBA(Max(0, i - 9 * x), 0, 0, &hF0)
    rectangle_fill px, py, 1, i
  next x
end_sub

' Ported from https://www.dwitter.net/d/14616 by katkip To FB by UEZ build 2020-12-07

' Adaptation pour FBCroco par J. Debord

const RadToDeg = 180 / Pi

const w = 1000, h = 750, w2 = w \ 2, h2 = h \ 2

dim i%, t = -1000

dim RR%, GG%, BB%

mode 3, "Fractal spirograph", w, h

paper CL_NOIR

repeat
  screenlock :   cls

  for i = 4999 To 0 Step -1
    Rec(w2, h2, t, 200)
    t = t + 0.004
  next i

  screenunlock : sleep 1
until inkey() <> ""

end

sub Rec(a, b, c, d)
  a = a + cos(c) * d
  b = b + sin(c) * d
  if d > 1 then
    Rec(a, b, a * b * c / 1.0E+9 + c * 2, d / 2)
  else
    HSVtoRGB RadToDeg * atan2(b, a), 1, 1, RR, GG, BB
    pen RGB(RR, GG, BB)
    rectangle_fill a, b, 1, 1
  end_if
end_sub

' Ported https://www.dwitter.net/d/21443 by rodrigo.siqueira to FB by UEZ build 2021-01-25

' Adaptation pour FBCroco par J. Debord

const w = 960, h = 540

def Map(value, source_start, source_stop, dest_start, dest_stop) = (value - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start

mode 3, "C'est la jungle !", w, h

paper CL_NOIR : cls

dim t, a, x, y, wx, wy
dim i%, c%

repeat
  if a < w then
    for i = h to 0 step -1
      a = t * 120
      wy = 0.2 - f(a / 1000 - 1.3, i / 990, 90, t)
      c = Map(wy, -1.086, 0.2, 0, 255)
      pen RGB(c shr 4, c, c shr 4)
      rectangle_fill a, i, 2, wy
    next
    t = t + 0.016
  end_if
until inkey() <> ""

end

function f(x, y, n%, t)
  if n > 0 then
    if tan(t * x) * sin(y) * 2 < 2 then return f(x * x - y * y, 2 * x * y + 0.7, n - 2, t + 0.1)
  end_if
  return n / 70
end_function

' Ported from https://www.dwitter.net/d/20076 by smtsjhr to FB by UEZ build

' Adaptation pour FBCroco par J. Debord

const iW = 500, iH = 500, w2 = iW \ 2, h2 = iH \ 2

const iBalls = 399, iZoom = 240, iDepth = 100, iPhase2 = 60, iSwing = 99, iRotSpeed = 2, iRadius = 6

dim i%, g%
dim a, r, t, x, y, rad

mode 3, "Le bout du tunnel ?", iW, iH
 
repeat
  screenlock : cls
  for i = iBalls To 0 Step -1
    r = 1.01 ^ (iZoom - i) * iDepth
    a = i - Timer / iRotSpeed
    x = w2 - r * Sin(a) + iSwing * Sin(i / iPhase2 + Timer)
    y = h2 - r * Cos(a)
    rad = r / iRadius
    g = min(255, r)
    pen RGBA(g, g, g, g - rad Shr 1)
    pie x, y, rad
    pen RGBA(0, 0, 0, (g + rad) Shr 2)
    arc x, y, rad
  next i
  screenunlock : sleep 10
until Inkey() <> ""

' Ported from https://www.dwitter.net/d/21672 by Pascal To FB by UEZ build 2021-02-14

' Adaptation pour FBCroco par J. Debord

const w = 1000, h = 600, w2 = w \ 2, h2 = h \ 2

dim i%
dim t, s, u, v, x, y, z, px, py
dim sinu, cosu, cosv, tanv

def col(c) = Max(0, Min(255, c))

mode 3, "Donut", w, h

paper 0
pen &h80FFFFFF

repeat
  screenlock : cls
  For i = w To 0 Step -1
    u = i + t
    v = t + i / (1 + t / w2 * 0.7)
    sinu = sin(u) : cosu = cos(u) : cosv = cos(v) : tanv = tan(v)
    x = 3 * cosu + cosv
    y = sinu + cosv * tanv - 2
    z = sinu - 5
    s = (9 / z) ^ 5
    px = w2 + w2 * x / z
    py = w2 - y / z * w2
    pen RGBA(col(-z * 20), col(x * 50), col(-y * 80), &h100 - col(-z * 40))
    pie px, py, -s
  Next i

  t = t + 0.0166666
  screenunlock : sleep 2
until Inkey() <> ""

' Ported from https://www.dwitter.net/d/14371 by katkip To FB by UEZ build 2021-03-01

' Adaptation pour FBCroco par J. Debord

const w = 750, h = 750

const DegFact = 3600 / Pi

mode 3, "Carrés animés", w, h

paper 0

dim i%, j%, t, px, py
dim R%, G%, B%

repeat
  screenlock : cls
  for i = 0 To 42
    for j = 0 To 70
      px = j * 30 + Sin(i / 4 + t * 2 + (j + i) / 7) * 100 - 100
      py = i * 30 + Cos(j / 4 + Sin(t) + (j - i) / 7) * 100 - 100
      HSVtoRGB atan2(py, px) * DegFact, 1, 1, R, G, B
      pen RGB(R, G, B)
      rectangle_fill px, py, 20, 20
    next j
  next i
  t = t + 0.0166667
  screenunlock : sleep 5
until inkey() <> ""

' Ported from https://www.dwitter.net/d/14396 by KilledByAPixel To FB by UEZ build 2021-02-25

' Adaptation pour FBCroco par J. Debord

const W = 1000, H = 750

const Hue = 10   ' Teinte (0..360)
const Sat = 0.6  ' Saturation (0..1)

dim t, px, py, q, m, f
dim i%, j%, z% = 132, y%
dim R%, G%, B%

mode 3, "Cubes oscillants", W, H

repeat
  screenlock : cls
  
  for j = 0 to 17
    for i = z to 0 step -1
      q = sin(sin(i * i) * t * 9) * 9
      m = j * 4 - z + q
      y = i \ 17
      f = z * 1.2
      px = (i mod 17) * f + m
      py = y * f + m
      HSVtoRGB Hue, Sat, (j * 3 + q) / 100, R, G, B
      pen RGB(R, G, B)
      rectangle_fill px, py, z, z
    next i
  next j
  
  t = t + 0.0166667

  screenunlock : sleep 10
until inkey() <> ""

' Ported https://www.dwitter.net/d/3613 by New_Core to FB by UEZ build 2021-02-22

' Adaptation pour FBCroco par J. Debord

const w = 1000, h = 750

dim i%, t,tt, x, y, a, b

def col(c) = max(0, min(255, c))

mode 3, "Monstre tentaculaire", w, h

origin w \ 2, h \ 2

paper 0

repeat
  screenlock : cls
  
  for i = 800 to 0 step -1
    a = 30 - i / 28
    b = i / 0.019004 + sin(t - i / 300)
    x = 0.5 * i * sin(b)
    y = 0.5 * i * cos(b)
    pen RGB(col(i), i mod 255, 0)
    rectangle_fill x, y, a, a
  next i

  t = t + 0.01666667

  screenunlock : sleep 5
until inkey() <> ""

' Spinning gears
' D'apres angros47 sur le forum FreeBASIC
' https://freebasic.net/forum/viewtopic.php?t=32084
' Programme original en SmallBasic:
' https://www.syntaxbomb.com/smallbasic/2-gears-turning/msg347057223

dim R, X1, Y1, X2, Y2, a, ao, i%

mode 3, "Spinning gears", 640, 480

paper CL_NOIR

repeat
  screenlock : cls
  for i = 0 to 40
    for a = 0 to 2*Pi step 0.001
      R = 100 + cos(20 * a) * 15
      X1 = cos(a + ao) * R + 220
      Y1 = sin(a + ao) * R / 3 + 240 - i / 2
      R = 50 + sin(-10 * a) * 15
      X2 = cos(A - 2 * ao) * R + 390
      Y2 = sin(A - 2 * ao) * R / 3 + 240 - i / 2
      pen RGB(i * 200 / 40 + 55, 0, 0) : plot X1, Y1
      pen RGB(0, 0, i * 200 / 40 + 55) : plot X2, Y2
      if i = 40 Then
        pen CL_ROUGE_VIF : move 220, 240 - i / 2 : draw X1, Y1
        pen CL_BLEU_VIF  : move 390, 240 - i / 2 : draw X2, Y2
      end_if
    next a
  next i
  ao = ao + 0.1
  screenunlock : sleep 20
until inkey() <> ""