Les programmes de papydall

'===================================================================
'                 Animation des courbes de Lissajous
'===================================================================
Const TwoPi = 2*pi
Dim  m%,n%,p%,q%
Dim  x,y,r, s,t

n = 1 : p = 1 : q = 1

mode 3,"Animation des courbes de Lissajous ... Une touche pour sortir ...",800,600
origin 400,300
randomize timer
while true
    m = p
    n = q
    p = q
    q = 1 + Rnd * 20
    For s = 0 To 1 Step .002
        Screenlock
        Cls    
        For t  = 0 To TwoPi Step 1/(10*(15+m*n))
            x = -(1-s)*Sin(m*t) + s*Sin(p*t)
            y =  (1-s)*Cos(n*t) + s*Cos(q*t)
            draw 400*x,300*y
            if inkey() <> "" then end
        Next t
        Screenunlock
        Sleep 1
    Next s
  
wend
'=========================================================================

rem =====================================================================================
rem                             Candle in the wind
rem Ref : https://www.freebasic.net/forum/viewtopic.php?f=3&t=16207&hilit=cloud&start=195
rem =====================================================================================
Dim hi,lo,rhs,lhs
hi = 400 : lo = -200 : rhs = 400 : lhs = -rhs
Const  TwoPi = 2*pi
dim i%,fh
fh = 200      ' flame height
Dim  xc(fh)   ' flame centre
Dim  xw(fh)   ' flame width
Dim  w, wind  ' wind direction

mode 3,"Candle in the wind",800,600 : origin 400,200

For i = 0 To fh
    xw(i) = 3 * i * exp(-i*7/fh)
Next i
screenset 1,0
Randomize
repeat
    paper cl_noir : cls
    pen rgb(250,250,250) : rectangle_fill -080,000,160,200 ' the candle
    Screenlock
    wind = wind + .01 * (Rnd-0.4)
    if wind > twoPi then wind = wind - TwoPi
    w = 0.5 * sin(wind)
    xc(0) = xc(1) * 0.99 + (0.5 - Rnd) * 2
    For i = fh To 1 Step -1
        move xc(i)*i/fh - xw(i) + i*w, i : draw xc(i)*i/fh + xw(i) + i*w, i,rgb(255,255,0)
        xc(i) = xc(i-1)
    Next i
    Screenunlock
    flip
until len(inkey())
rem =========================================================================================

rem ==============================================================================
rem                           Sans_Nom
rem ==============================================================================

def rad = pi/180
dim xres%,yres%
dim x,y,z,dist,k,g
xres = 700 : yres = 700
mode 3,"Sans Nom ... Une touche pour sortir",xres,yres

For z = 0 To 360 Step 0.01
    dist = 200 + 200 * abs(sin(2*z*rad))
    For k = 0 To 400
        x = xres/2 + (dist-k) * Cos(z*rad)
        y = yres/2 + (dist-k) * Sin(z*rad)
        g = abs(100*sin(2*z*rad))
        plot x,y,rgb(0,g,0)
    next k
next z

repeat : until len(inkey())
rem ===============================================================================

rem ===============================================================================
rem       Une paire de pantoufles ?
rem            Par Papydall
rem ===============================================================================
const deg2rad = pi / 180
dim w%,h%,n
w = 1000 : h = 800

mode 3,"C'est une paire de pantoufles ou quoi ?",w,h
paper rgb(200,255,255) : cls
For n = 1 to 160 step 0.1
    pen rgb( abs(n-50),n,abs(n-50))
    ellipse(300+2*n,650-n,250-n/2,150-n/2)
    ellipse(300+2*n,180+n,250-n/2,150-n/2)
next n

repeat : until len(inkey())
rem ===============================================================================
SUB ellipse(x,y,r1,r2)
    dim a    
    move x+r1,y
    for a = 0 to 360 step 0.1  
        draw x + r1*cos(a*deg2rad), y + r2*sin(a*deg2rad)
    next a
END_SUB
rem ============================================================================

rem ============================================================================================
rem                              MR_BUG CURVE
rem ============================================================================================

dim x,y,t,p,w,h
p = pi/2880
w = 800 : h = 600

mode 3,"MR_BUG CURVE",w,h
paper rgb(255,250,0) : cls
for t = 0 to 56 * pi step p
    x = ((524/5 *sin(t + 3) - 2421/20) *Heaviside(27 *pi - t) *Heaviside(t - 23 *pi)_
    + (551/5 *sin(t + 53/18) + 3275/7) *Heaviside(23 *pi - t) *Heaviside(t - 19 *pi)_
    + (985/9 *sin(t + 85/28) + 1421/8) *Heaviside(19 *pi - t) *Heaviside(t - 15 *pi) _
    + (584/5 *sin(t + 23/8) - 3892/9) *Heaviside(15 *pi - t) *Heaviside(t - 11 *pi)_
    + (1138/7 *sin(t + 3) - 895/4) *Heaviside(11 *pi - t) *Heaviside(t - 7 *pi) _
    + (657/4 *sin(t + 3) + 1957/7) *Heaviside(7 *pi - t) *Heaviside(t - 3 *pi) _
    + (-1/8 *sin(1/12 - 115 *t) - 1/4 *sin(10/11 - 113 *t) - 1/4 *sin(1/8 - 112 *t) _
    - 1/5 *sin(3/7 - 106 *t) - 4/7 *sin(1 - 102 *t) - 1/9 *sin(1/3 - 96 *t)_
    - 1/4 *sin(1 - 94 *t) - 5/8 *sin(11/7 - 90 *t) - 5/11 *sin(13/9 - 87 *t) _
    - 2/3 *sin(1/16 - 86 *t) - 1/14 *sin(11/7 - 84 *t) - 1/6 *sin(2/7 - 81 *t) _
    - 3/5 *sin(1 - 80 *t) - 3/4 *sin(3/7 - 68 *t) - 4/5 *sin(3/2 - 67 *t) _
    - 3/4 *sin(6/5 - 52 *t) - 1/4 *sin(7/6 - 48 *t) - 2 *sin(1/19 - 44 *t) _
    - 9/7 *sin(3/2 - 42 *t) - 15/4 *sin(1 - 38 *t) - 12/5 *sin(1/10 - 36 *t) _
    - 27/5 *sin(2/3 - 26 *t) - 57/7 *sin(5/8 - 24 *t) - 321/40 *sin(6/5 - 17 *t)_
    - 43/4 *sin(11/9 - 16 *t) - 79/39 *sin(2/5 - 15 *t) - 25/3 *sin(5/11 - 13 *t)_
    - 202/5 *sin(9/8 - 10 *t) - 256/5 *sin(4/3 - 9 *t) + 3847/5 *sin(t + 8/3) _
    + 805/9 *sin(2 *t + 15/4) + 1621/15 *sin(3 *t + 21/8) + 793/11 *sin(4 *t + 81/20)_
    + 152/3 *sin(5 *t + 2) + 103/4 *sin(6 *t + 29/8) + 215/7 *sin(7 *t + 13/6) _
    + 649/12 *sin(8 *t + 27/13) + 171/5 *sin(11 *t + 9/7) + 197/11 *sin(12 *t + 13/6)_
    + 75/8 *sin(14 *t + 17/7) + 83/5 *sin(18 *t + 35/8) + 221/22 *sin(19 *t + 11/7)_
    + 64/3 *sin(20 *t + 16/7) + 28/5 *sin(21 *t + 1/15) + 21/4 *sin(22 *t + 33/7) _
    + 26/3 *sin(23 *t + 13/9) + 3/4 *sin(25 *t + 10/11) + 41/7 *sin(27 *t + 33/8) _
    + 25/7 *sin(28 *t + 18/5) + 15/7 *sin(29 *t + 15/7) + 47/12 *sin(30 *t + 3/2) _
    + sin(31 *t + 33/8) + 7/4 *sin(32 *t + 50/11) + 3 *sin(33 *t + 9/5) _
    + 5/3 *sin(34 *t + 25/6) + 35/17 *sin(35 *t + 7/6) + 13/5 *sin(37 *t + 5/9)_
    + 31/8 *sin(39 *t + 106/35) + 21/8 *sin(40 *t + 31/8) + 5/3 *sin(41 *t + 1/2) _
    + 17/7 *sin(43 *t + 21/8) + 9/5 *sin(45 *t + 19/8) + 10/7 *sin(46 *t + 3/7) _
    + 2/5 *sin(47 *t + 29/8) + 2/3 *sin(49 *t + 37/8) + 2/5 *sin(50 *t + 11/6) _
    + 9/8 *sin(51 *t + 5/8) + 1/4 *sin(53 *t + 4) + 4/7 *sin(54 *t + 93/23) _
    + 2/3 *sin(55 *t + 19/7) + sin(56 *t + 10/7) + 7/5 *sin(57 *t + 2/3) _
    + 16/11 *sin(58 *t + 29/7) + 5/7 *sin(59 *t + 13/3) + 2/7 *sin(60 *t + 4/5) _
    + 16/17 *sin(61 *t + 3/8) + 3/2 *sin(62 *t + 19/5) + 7/6 *sin(63 *t + 11/8) _
    + 2/7 *sin(64 *t + 7/9) + 6/7 *sin(65 *t + 82/27) + 1/7 *sin(66 *t + 4/7) _
    + 9/10 *sin(69 *t + 16/17) + 4/5 *sin(70 *t + 3) + 2/7 *sin(71 *t + 43/11) _
    + 2/7 *sin(72 *t + 2/3) + 1/3 *sin(73 *t + 29/7) + 3/5 *sin(74 *t + 33/8) _
    + 1/16 *sin(75 *t + 15/16) + 1/3 *sin(76 *t + 5/6) + 1/3 *sin(77 *t + 25/24) _
    + 4/7 *sin(78 *t + 3) + 1/2 *sin(79 *t + 5/4) + 4/7 *sin(82 *t + 37/8) _
    + 1/2 *sin(83 *t + 12/5) + 5/11 *sin(85 *t + 5/2) + 2/7 *sin(88 *t + 7/5) _
    + 4/9 *sin(89 *t + 23/11) + 2/7 *sin(91 *t + 7/6) + 1/17 *sin(92 *t + 15/14) _
    + 1/3 *sin(93 *t + 13/3) + 3/7 *sin(95 *t + 8/5) + 2/7 *sin(97 *t + 23/9) _
    + 3/5 *sin(98 *t + 23/6) + 2/7 *sin(99 *t + 4/3) + 5/11 *sin(100 *t + 1/4) _
    + 1/8 *sin(101 *t + 13/14) + 1/7 *sin(103 *t + 9/4) + 1/4 *sin(104 *t + 23/8) _
    + 1/4 *sin(105 *t + 3) + 1/5 *sin(107 *t + 21/5) + 1/5 *sin(108 *t + 7/4) _
    + 1/6 *sin(109 *t + 2/5) + 1/6 *sin(110 *t + 40/9) + 1/4 *sin(111 *t + 13/6) _
    + 1/5 *sin(114 *t + 22/9) - 867/8) *Heaviside(3 *pi - t) _
    * Heaviside(t + pi)) *Heaviside(sqr(sgn(sin(t/2))))

    y = ((431/4 *sin(t + 23/5) + 2952/7) *Heaviside(27 *pi - t) *Heaviside(t - 23 *pi)_
    + (1149/11 *sin(t + 41/9) - 1412/7) *Heaviside(23 *pi - t) *Heaviside(t - 19 *pi)_
    + (883/8 *sin(t + 23/5) - 4211/8) *Heaviside(19 *pi - t) *Heaviside(t - 15 *pi) _
    + (463/4 *sin(t + 49/11) + 306/5) *Heaviside(15 *pi - t) *Heaviside(t - 11 *pi) _
    + (1489/9 *sin(t + 23/5) - 821/3) *Heaviside(11 *pi - t) *Heaviside(t - 7 *pi)_
    + (1146/7 *sin(t + 32/7) + 1916/9) *Heaviside(7 *pi - t) *Heaviside(t - 3 *pi) _
    + (-1/28 *sin(3/4 - 115 *t) - 1/6 *sin(2/5 - 112 *t) - 1/7 *sin(5/8 - 111 *t) _
    - 2/5 *sin(1 - 102 *t) - 1/11 *sin(3/7 - 100 *t) - 1/6 *sin(6/5 - 99 *t) _
    - 2/5 *sin(8/9 - 94 *t) - 1/4 *sin(2/3 - 92 *t) - 1/3 *sin(3/5 - 87 *t) _
    - 3/5 *sin(11/7 - 83 *t) - 3/7 *sin(1/14 - 74 *t) - 4/7 *sin(3/8 - 72 *t) _
    - 5/8 *sin(3/4 - 63 *t) - 22/21 *sin(3/2 - 62 *t) - 5/6 *sin(1/5 - 60 *t) _
    - 6/5 *sin(4/3 - 47 *t) - 23/22 *sin(8/9 - 43 *t) - 43/14 *sin(4/5 - 40 *t) _
    - 14/9 *sin(1/7 - 34 *t) - 3 *sin(1/10 - 32 *t) - 11/2 *sin(5/7 - 27 *t) _
    - 6 *sin(11/10 - 25 *t) - 289/36 *sin(6/7 - 23 *t) - 14 *sin(4/3 - 20 *t) _
    - 63/4 *sin(4/3 - 19 *t) - 333/5 *sin(2/7 - 5 *t) - 757/6 *sin(3/2 - 3 *t) _
    + 4082/5 *sin(t + 4) + 537/7 *sin(2 *t + 23/7) + 397/7 *sin(4 *t + 25/7) _
    + 35/3 *sin(6 *t + 43/11) + 503/12 *sin(7 *t + 1/2) + 305/6 *sin(8 *t + 6/11)_
    + 133/3 *sin(9 *t + 41/9) + 203/5 *sin(10 *t + 14/3) + 167/7 *sin(11 *t + 38/13)_
    + 66/7 *sin(12 *t + 8/5) + 81/8 *sin(13 *t + 25/6) + 76/9 *sin(14 *t + 65/32)_
    + 54/7 *sin(15 *t + 19/5) + 58/7 *sin(16 *t + 4/5) + 13/2 *sin(17 *t + 8/3) _
    + 176/7 *sin(18 *t + 8/5) + 97/14 *sin(21 *t + 5/6) + 67/7 *sin(22 *t + 37/18) _
    + 68/7 *sin(24 *t + 19/8) + 17/6 *sin(26 *t + 17/5) + 32/5 *sin(28 *t + 1/3)_
    + 11/5 *sin(29 *t + 34/11) + 64/9 *sin(30 *t + 28/9) + 17/9 *sin(31 *t + 23/5)_
    + 14/5 *sin(33 *t + 20/7) + 17/8 *sin(35 *t + 8/3) + sin(36 *t + 4/5) _
    + 2 *sin(37 *t + 12/7) + 13/5 *sin(38 *t + 7/6) + 4 *sin(39 *t + 22/5) _
    + 21/10 *sin(41 *t + 13/7) + 10/9 *sin(42 *t + 3/4) + 3/2 *sin(44 *t + 13/6) _
    + 9/7 *sin(45 *t + 23/5) + 16/15 *sin(46 *t + 33/8) + 19/9 *sin(48 *t + 1) _
    + 4/7 *sin(49 *t + 5/4) + 5/7 *sin(50 *t + 11/3) + 2/3 *sin(51 *t + 17/4) _
    + 1/2 *sin(52 *t + 23/5) + 6/7 *sin(53 *t + 18/7) + 1/2 *sin(54 *t + 11/3) _
    + sin(55 *t + 13/7) + 2/5 *sin(56 *t + 2/3) + 5/3 *sin(57 *t + 5/8) _
    + 10/11 *sin(58 *t + 5/2) + 6/7 *sin(59 *t + 49/11) + 3/4 *sin(61 *t + 1/2)_
    + 7/6 *sin(64 *t + 11/4) + 37/36 *sin(65 *t + 19/5) + 5/7 *sin(66 *t + 18/7) _
    + 2/3 *sin(67 *t + 1/7) + 2/5 *sin(68 *t + 1/11) + 3/7 *sin(69 *t + 19/6) _
    + 4/7 *sin(70 *t + 11/7) + 2/7 *sin(71 *t + 13/3) + 4/7 *sin(73 *t + 29/10) _
    + 1/2 *sin(75 *t + 7/2) + 2/7 *sin(76 *t + 3/5) + 1/3 *sin(77 *t + 22/5) _
    + 10/11 *sin(78 *t + 11/7) + 5/11 *sin(79 *t + 33/7) + 5/9 *sin(80 *t + 5/7) _
    + 5/7 *sin(81 *t + 41/9) + 2/5 *sin(82 *t + 2/7) + 3/4 *sin(84 *t + 16/7) _
    + 3/5 *sin(85 *t + 22/5) + 1/6 *sin(86 *t + 15/7) + 2/7 *sin(88 *t + 16/7) _
    + 1/4 *sin(89 *t + 23/8) + 1/3 *sin(90 *t + 12/7) + 1/7 *sin(91 *t + 1/2) _
    + 2/7 *sin(93 *t + 15/8) + 1/5 *sin(95 *t + 35/12) + 1/4 *sin(96 *t + 17/4) _
    + 5/9 *sin(97 *t + 1) + 1/27 *sin(98 *t + 9/5) + 2/9 *sin(101 *t + 25/7) _
    + 1/21 *sin(103 *t + 15/8) + 3/8 *sin(104 *t + 8/5) + 3/8 *sin(105 *t + 29/7) _
    + 1/5 *sin(106 *t + 33/8) + 2/7 *sin(107 *t + 18/7) + 1/4 *sin(108 *t + 5/3) _
    + 1/5 *sin(109 *t + 13/12) + 1/5 *sin(110 *t + 13/12) + 1/18 *sin(113 *t + 14/3) _
    + 1/5 *sin(114 *t + 1/2) + 241/4) *Heaviside(3 *pi - t) *Heaviside(t + pi))_
    * Heaviside(sqr(sgn(sin(t/2))))
    plot 420+x/04,300+y/04  
next t
move 400,300 : fill rgb(255,0,0)
move 1,1 : fill rgb(255,255,255)

repeat : until len(inkey())

rem ================================================================================================
' la fonction de Heaviside (egalement fonction echelon unite, fonction marche d'escalier),
' du nom de Oliver Heaviside, est la fonction indicatrice de R+.
' C'est donc la fonction H (discontinue en 0) prenant la valeur 1 pour tous les reels positifs et
' la valeur 0 pour les reels strictement negatifs
FUNCTION Heaviside(h)
    if h < 0 then return 0 else return 1
END_FUNCTION
rem =================================================================================================

rem ===============================================================================
rem                                 STARS
rem ===============================================================================
mode 3,"Stars",800,600

dim  angle

repeat  
    screenlock
    cls
    angle = angle + .001
    star(220         ,300, 200, rgb(255,155,055), 30,  1*angle)
    star(220+270     ,300, 100, rgb(255,100,255), 30, -2*angle)
    star(220+270+140 ,300, 050, rgb(000,255,255), 30,  4*angle)
    star(710         ,242, 050, rgb(000,255,000), 05, -4*angle)
    star(740         ,320, 050, rgb(255,255,000), 10,  4*angle)
    screenunlock
until len(inkey())

rem ===============================================================================
sub star(starX,starY,size,col%,num%,rot)
    dim count,rad,px,py,a
    pen col
    For a = 0 + .28 + rot To 2*pi + .1 + .28 + rot Step 2*pi/(2*num)
        count = count + 1
        If count Mod 2 = 0 Then rad = size Else rad = .4 * size
        px = starx + rad * Cos(a)
        py = stary + rad * Sin(a)
        If count = 1 Then Plot px,py Else draw px,py,col
    Next a
    move starx,stary : fill col
end_sub
rem =================================================================================

rem =================================================================================================================

dim  w%,h% , deg1,deg2 ,rad1,rad2, c1,c2,s1,s2 ,x1,x2,y1,y2, xc , yc , rayon

w = 800 : h = 600 : xc = w/2 : yc = h/2 : rad1 = atn(1)/45 : rad2 = atn(1)/22.5 : rayon = 125
mode 3,"No Name",w,h
for deg1 = 0 to 360    
    c1 = cos(deg1*rad1) : s1 = sin(deg1*rad1)  
    x1 = rayon*c1 : y1 = rayon*s1  
    for deg2 = 0 to 360 step .05      
        c2 = cos(deg2*rad2) : s2 = sin(deg2*rad2)              
        x2 = rayon*s2*log(deg2*rad1*s2)*atn(deg2*rad1*s2/s1)*atn(deg2*rad2*c1*s1*c2)*sin(deg2/(s1*c1*s1*c1)*rad1*rad1)
        y2 = rayon*c2*log(deg2*rad1*c2)*atn(deg2*rad1*c2/c1)*atn(deg2*rad2*c1*s1*c2)*sin(deg2/(s1*c1*s1*c1)*rad1*rad1)        
        plot xc+y1+y2,yc+x1+x2              
    next    
next
repeat : until len(inkey())
rem ==================================================================================================================

rem =====================================================================================
rem                             Candle in the wind
rem Ref : https://www.freebasic.net/forum/viewtopic.php?f=3&t=16207&hilit=cloud&start=195
rem =====================================================================================
Dim hi,lo,rhs,lhs
hi = 400 : lo = -200 : rhs = 400 : lhs = -rhs
Const  TwoPi = 2*pi
dim i%,fh
fh = 200      ' flame height
Dim  xc(fh)   ' flame centre
Dim  xw(fh)   ' flame width
Dim  w, wind  ' wind direction

mode 3,"Candle in the wind",800,600 : origin 400,200

For i = 0 To fh
    xw(i) = 3 * i * exp(-i*7/fh)
Next i
screenset 1,0
Randomize
repeat
    paper cl_noir : cls
    pen rgb(250,250,250) : rectangle_fill -080,000,160,200 ' the candle
    Screenlock
    wind = wind + .01 * (Rnd-0.4)
    if wind > twoPi then wind = wind - TwoPi
    w = 0.5 * sin(wind)
    xc(0) = xc(1) * 0.99 + (0.5 - Rnd) * 2
    For i = fh To 1 Step -1
        move xc(i)*i/fh - xw(i) + i*w, i : draw xc(i)*i/fh + xw(i) + i*w, i,rgb(255,255,0)
        xc(i) = xc(i-1)
    Next i
    Screenunlock
    flip
until len(inkey())
rem =========================================================================================

DIM  x%, y%
MODE 3,"Les plus courts sont les meilleurs !",512*2,512
FOR y = 0 TO 512
    FOR x = 0 TO 512*2
        Plot x, y, RGB(x MOD 256, (x MOD 512 XOR y) MOD 256, y MOD 256)
    NEXT
NEXT
WHILE INKEY() = "" : WEND

rem =========================================================================
rem                          Defense de fumer
rem =========================================================================
mode 3,"No smoking",640,480

pen rgb(255,255,255) : rectangle_fill 150,260,250,40
pen rgb(255,000,000) : rectangle_fill 140,260,010,40
pen rgb(175,113,033) : rectangle_fill 400,260,100,40

pen rgb(255,000,000) : arc 320,240, 200
pen rgb(255,000,000) : arc 320,240, 220
move 175,395         : draw 435,75, rgb(255,0,0)
move 195,395         : draw 455,75, rgb(255,0,0)
move 320,240         : fill rgb(255,0,0)
move 111,240         : fill rgb(255,0,0)

while inkey() = "" : wend
rem =========================================================================

const w = 800, h = 600

const rad1 = atn(1) / 45, rad2 = atn(1) / 22.5, rad11 = rad1 * rad1

const rayon = 125

dim deg1, deg2, c1, c2, s1, s2, x1, x2, y1, y2, R%, G%, B%
dim s1c1, d1r1, d2r1, d2r2, d2r1s2, d2r1c2, a

mode 3,"No Name", w, h
origin w \ 2, h \ 2

for deg1 = 0 to 360
    HSVtoRGB deg1, 1, 1, R, G, B
    pen RGB(R, G, B)  
    
    d1r1 = deg1 * rad1
    c1 = cos(d1r1) : s1 = sin(d1r1) : s1c1 = s1 * c1
  
    x1 = rayon * c1 : y1 = rayon * s1  
    
    for deg2 = 0 to 360 step .05
        d2r1 = deg2 * rad1
        d2r2 = deg2 * rad2      
        
        c2 = cos(d2r2)
        s2 = sin(d2r2)

        d2r1s2 = d2r1 * s2
        d2r1c2 = d2r1 * c2

        a = atn(d2r2 * s1c1 * c2) * sin(deg2 / (s1c1 * s1c1) * rad11)
        
        x2 = rayon * s2 * log(d2r1s2) * atn(d2r1s2 / s1) * a
        y2 = rayon * c2 * log(d2r1c2) * atn(d2r1c2 / c1) * a
        
        plot y1 + y2, x1 + x2              
    next
next

repeat : until len(inkey())

rem ====================================================================================
'                         Ported to FBCroco by Papydall from
'                         Abstract animation #598 By albert
' REF : https://www.freebasic.net/forum/viewtopic.php?f=3&t=16207&hilit=cloud&start=3600
rem ====================================================================================

dim xres%,yres%
  xres= 800 : yres = 600
dim  rad1 : rad1=atn(1)/45
dim  deg1,deg1_start,deg1_end, deg1_inc
  deg1_start =  0
  deg1_end   =360
  deg1_inc   =  1
dim rad2 :  rad2=atn(1)/45
dim deg2, deg2_start, deg2_end, deg2_inc
  deg2_start=  0
  deg2_end  =360
  deg2_inc  =  1
dim  c1,  c2, s1,  s2,  x1,  y1,  x2,  y2
dim radius :  radius = 200
dim xctr, yctr
  xctr = xres/2
  yctr = yres/2
dim span  
dim toggle : toggle = 0
dim r%,g%,b%

mode 3,"Abstract Animation #598 ... Une touche pour sortit ...",xres,yres

while inkey() = ""  
    screenlock
    cls
    for deg1 = 0 to 360 step 2 : ' 1
        HSVtoRGB deg1, 1, 1, R, G, B : pen RGB(R, G, B)
      
        c1 = cos(deg1*rad1*span)
        s1 = sin(deg1*rad1*span)
      
        x1 = radius*c1^2
        y1 = radius*s1^5
      
        for deg2 = 0 to 360 step 1 : ' 0.1          
            c2 = cos(deg2 * rad2 * c1 * s1 + c2 + span)
            s2 = sin(deg2 * rad2 * s1 * c1 + s2 + span)
          
            x2 = radius * c2^2 * atn(log(tan(deg2 * rad2 * c2 + span) / 57) / -5)
            y2 = radius * s2^5 *-atn(log(tan(deg2 * rad2 * s2 + span) / 57) / -5)
          
            plot xctr + (y1+y2) , yctr + (x1+x2)
            plot xctr + (x1+x2) , yctr + (y1+y2)
            plot xctr - (y1+y2) , yctr + (x1+x2)
            plot xctr - (x1+x2) , yctr + (y1+y2)
          
            plot xctr - (y1+y2) , yctr - (x1+x2)
            plot xctr - (x1+x2) , yctr - (y1+y2)
            plot xctr + (y1+y2) , yctr - (x1+x2)
            plot xctr + (x1+x2) , yctr - (y1+y2)        
        next
    next  
    screenunlock
    sleep 500      
    'scroll back and forth thru som values to animate
    select  toggle
        case 0
            span = span + .1
            if span >=  + 10 then toggle = 1
        case 1
            span = span - .1
            if span <= 0 then toggle = 0
    end_select  
wend
rem ============================================================================================

rem ======================================================================================
rem                       Adaptation par Papydall en FBCroco
rem                            Code origine en free basic
rem                                Auteur : dodicat
rem ref : https://www.freebasic.net/forum/viewtopic.php?f=3&t=16207&hilit=cloud&start=3945
rem ======================================================================================
randomize timer
def floatrange(f,l)    = (Rnd*((l+1)-(f))+(f))
def map(a,b,x,c,d)     = ((d)-(c))*((x)-(a))/((b)-(a))+(c)
def lngth(x1,y1,x2,y2) = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))
def Rd( c )            = (( c ) Shr 16 And 255 )
def Gr( c )            = (( c ) Shr  8 And 255 )
def Bl( c )            = (( c ) And 255 )

mode 3, "Textured Circles ... Une touche pour sortir ...",1000,600
dim xpos,ypos,rad,a,r,g,b

repeat
   screenlock
   xpos = floatrange(20,1000)
   ypos = floatrange(20,740)
   rad  = floatrange(10,100)
   a    = floatrange(.2,2.2)
   r    = floatrange(100,250)
   g    = floatrange(100,250)
   b    = floatrange(100,250)
   ORB(xpos,ypos,rad,rgb(r,g,b),a)
   screenunlock
   sleep 10
until len(inkey())
rem ================================================================================
FUNCTION incircle(cx,cy,r,mx,my,a)
    dim result
    if a <= 1 then
       result = a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my) <= r*r*a*a
    else
       result = a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my) <= (r)*(r)
    end_if
    return result
END_FUNCTION
rem ================================================================================
sub ORB(cx,cy,r,col%,a)
    dim  result%,red%,green%,blue%,x,y,dist
    for x = cx-r to cx+r
        for y =cy-r to cy+r          
            if  incircle(cx,cy,r,x,y,a) then
                dist  = lngth(cx,cy,x,y)
                red   = map(0,rd(col),dist,255,50)
                green = map(0,gr(col),dist,255,50)
                blue  = map(0,bl(col),dist,255,50)
                plot x,y,rgb(red,green,blue)
           end_if
        next y
    next x
end_sub
rem =================================================================================

rem =======================================================================================
rem                             Adaptation de Papydall
rem ref : https://www.freebasic.net/forum/viewtopic.php?f=3&t=16207&hilit=cloud&start=4005
rem =======================================================================================

Dim  b,x,y,m,n,r,s,p,q,i
Dim  Morph,k
dim  aspect,counter,pi2

morph = 0 : k = 1 : pi2 = 8 * atn(1)

mode 3,"rocking wave morpher" ,800,600
paper rgb(0,0,50) : cls
screenset 1,0
repeat
    counter = counter + .1
    if counter >= pi2 then counter = 0
    aspect = 3 + sin(counter)
    Morph = morph + .1 * k
    If Morph >  35 Then k = -k
    If Morph < -35 Then k = -k
    Cls
    Thing(700,600,400,300,Morph,aspect,6,rgba(255,255,255,0))
    flip    
Until Len(Inkey)
rem =====================================================================================
Sub Thing(w%,h%,posx%,posy%,morph,aspect,grade, col%)
    b = w * w          
    For x  = 0 To w
        s = x * x
        p = Sqr(b-s)
        For i = -P To P Step grade
            r = Sqr(s+i*i)/w
            q = (r - 1) * Sin(morph*r)
            y = i / aspect + q * h
            If i = -p Then m = y : n = y
            If y >  m Then m = y
            If y <  n Then n = y
            If m = y Or n = y Then
               pen col/i
               Plot  x / 2 + posx, Y / 2 + posy
               Plot -x / 2 + posx, Y / 2 + posy
            End_If
        Next
    Next
End_Sub
rem =======================================================================================