Simple animation

[neil]

This is animation by alternating two colors.

Code: Select all

'' Animation by switching 2 colors
type Font
  w as long
  h as long
  d as any ptr
end type

enum
  FB_FONT_8 = 0,
  FB_FONT_14
  FB_FONT_16
end enum

extern Fonts(2)  alias "__fb_font"  as Font

sub EditChar cdecl (byref f as Font, c as ubyte, ...)
	Dim As cva_list args
	cva_start(args,c)
	dim as long y,yend,code
	dim row as ubyte ptr
	yend=f.h

	code=c:code*=f.h:row=f.d+code
	for y = 1 to yend
		*row=cva_arg(args, ubyte)
		row+=1
	next

end sub

screen 12,8,1,1
color 15,0
Cls

editchar (Fonts(FB_FONT_16),asc("@"), 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255)
'' a block character

Dim as UByte i,x,y,n,ct,xt,c1,c2
c1 = 0:c2 = 15:xt = 0:ct = 0

DO
x = 8:y = 4
for n = 1 to 24
for i = 1 to 32

screenlock
color c1:locate y,x:print "@":color c2:Locate y,x + 1:print "@"
screenunlock

x += 2
next
y += 1
xt += 1
if xt = 1 Then x = 9
if xt = 2 Then x = 8:xt = 0

next
ct += 1
if ct = 1 Then c1 = 15:c2 = 0
if ct = 2 Then c1 = 0:c2 = 15:ct = 0

sleep 100,1
Loop until InKey = Chr(27)

[David Watson]

If you have photo-sensitive epilepsy don't try this.

[neil]

This is modified version for a different effect.

Code: Select all

''Modified version 2
'' Animation by switching 2 colors
type Font
  w as long
  h as long
  d as any ptr
end type

enum
  FB_FONT_8 = 0,
  FB_FONT_14
  FB_FONT_16
end enum

extern Fonts(2)  alias "__fb_font"  as Font

sub EditChar cdecl (byref f as Font, c as ubyte, ...)
	Dim As cva_list args
	cva_start(args,c)
	dim as long y,yend,code
	dim row as ubyte ptr
	yend=f.h

	code=c:code*=f.h:row=f.d+code
	for y = 1 to yend
		*row=cva_arg(args, ubyte)
		row+=1
	next

end sub

screen 12,8,1,1
color 15,0
Cls

editchar (Fonts(FB_FONT_16),asc("@"), 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255)
'' a block character

Dim as UByte i,x,y,n,ct,xt,c1,c2
c1 = 0:c2 = 15:xt = 0:ct = 0

DO
x = 8:y = 4
for n = 1 to 24
for i = 1 to 16

screenlock
color c1:locate y,x:print "@@":color c2:Locate y,x + 1:print "@@"
screenunlock

x += 4
next
y += 1
xt += 1
if xt = 1 Then x = 9
if xt = 2 Then x = 8:xt = 0

next
ct += 1
if ct = 1 Then c1 = 15:c2 = 0
if ct = 2 Then c1 = 0:c2 = 15:ct = 0

sleep 1000,1
Loop until InKey = Chr(27)

[neil]

Here's one I have not seen before circle illusion. Each ball is moving in a straight line.
https://www.youtube.com/watch?v=pNe6fsaCVtI

[BasicCoder2]

I wonder how they did that

Code: Select all

const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians


screenres 800,600,32
dim as single xc,yc  'center of main circle
dim as single dx,dy
dim as single xx,yy
yc = 300
xc = 400

do

    for angle as single = 0 to 359
        screenlock
        cls
        circle (xc,yc),130,rgb(255,0,0),,,,f


        
        dx = cos(angle*DtoR)*60
        dy = sin(angle*DtoR)*60
        circle (xc+dx,yc+dy),70,rgb(255,255,0),,,,f
        
        xx = xc+dx
        yy = yc+dy
        'circle (xx,yy),3,rgb(0,0,0),,,,f
        
        for angle1 as single = 0 to 359 step 45
            dx = cos((angle+angle1)*DtoR)*60
            dy = sin((angle+angle1)*DtoR)*60
            circle (xx+dy,yy+dx),10,rgb(25,255,0),,,,f
        next 
        
        'draw the lines in red circle
        for angle2 as single = 0 to 359 step 22.5
            dx = cos(angle2*DtoR)*130
            dy = sin(angle2*DtoR)*130
            line (xc,yc)-(xc+dx,yc+dy),rgb(0,0,0)
        next angle2

        screenunlock
        sleep 2
    next angle

loop until multikey(&H01)

 

[neil]

@BasicCoder2
Nice one. I made a couple of changes.

Code: Select all

const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians


screenres 800,600,32
dim as single xc,yc  'center of main circle
dim as single dx,dy
dim as single xx,yy
yc = 300
xc = 400

do

    for angle as single = 0 to 359
        screenlock
        cls
        circle (xc,yc),130,rgb(255,0,0),,,,f
        
        dx = cos(angle*DtoR)*60
        dy = sin(angle*DtoR)*60
        ''circle (xc+dx,yc+dy),70,rgb(255,255,0),,,,f
        
        xx = xc+dx
        yy = yc+dy
       'circle (xx,yy),3,rgb(0,0,0),,,,f
        
        for angle1 as single = 0 to 359 step 45
            dx = cos((angle+angle1)*DtoR)*60
            dy = sin((angle+angle1)*DtoR)*60
            circle (xx+dy,yy+dx),10,rgb(25,255,0),,,,f
        next 
        
        'draw the lines in red circle
        for angle2 as single = 0 to 359 step 22.5
            dx = cos(angle2*DtoR)*130
            dy = sin(angle2*DtoR)*130
           '' line (xc,yc)-(xc+dx,yc+dy),rgb(0,0,0)
        next angle2

        screenunlock
        sleep 2
    next angle

loop until multikey(&H01)

[dafhi]

BasicCoder2 usually has a great sense of design .. have to give it to him

[neil]

@dafhi
Someone made a 3d version.
https://www.youtube.com/shorts/PMhnJBMt73E

[neil]

Sine wave From rotating Vector Animation.
To see sine wave being drawn press "p" key.
To reverse rotating vector press "space" key.

Code: Select all

Dim As Single dz,z,z2
Dim AS Integer p,x,y,d

Screen 12,8,1,1
z = 4.73: z2 = 2: dz = .01
Line (3, 385)-(637, 477), 6, BF: Line (1, 383)-(640, 480), 14, B
Line (1, 1)-(639, 479), 14, B
Line (29, 395)-(209, 419), 0, BF: Line (30, 396)-(208, 418), 14, B
Line (29, 427)-(475, 451), 0, BF: Line (30, 428)-(474, 450), 14, B
Color 13: Locate 26, 5: Print " Sine Theta = "
Color 14: Locate 28, 5: Print " [P] = Pencil      [Space] = Reverse      [Esc] = Quit"

Do
Select Case Inkey
 Case CHR(80), CHR(112): P = 1 - P: Line (2, 200)-(638, 380), 0, BF
 Case CHR(32): dz = dz * -1
 Case CHR(27):Cls:End
End Select

If p = 1 THEN Pset (z2, y + 199), 14
x = 100 + COS(z) * 80: y = 100 + Sin(z) * 80
z = z + dz: z2 = z2 + .5: If z2 > 636 THEN z2 = 2
IF p = 1 Then Line (z2, y)-(z2, y + 198), 6

Circle (100, 100), 80, 13
Line (100, 20)-(100, 180), 13: Line (20, 100)-(180, 100), 13
Line (100, 100)-(x, y), 14: Line (2, y)-(638, y), 13

Sleep 10

Locate 26, 19: Color 14: PRINT USING "#.####"; Sin(z) * -1
Locate 26, 25: Print "  ";
For d = 1 TO 100: Next
Line (Z2, Y)-(Z2, 380), 0
Line (2, Y)-(638, Y), 0
Line (100, 100)-(X, Y), 0
Loop

[neil]

This is simple animation. This qbasic program was published in a magazine in 1995. I got it to work in FreeBasic.
It's similar to this: https://www.youtube.com/watch?v=VuXSIN9s5LE

Code: Select all

Dim As Ushort x,y,r,i
Dim AS Single cs,c
Screen 20,8,1,1
SetMouse 0,0,0

Do
x = (Rnd * 980) + 44
y = (Rnd * 728)
c = 31:r = 40
cs = c / r / 2.3
For i = 1 TO r
Circle (x, y), i, c
Circle (x, y - 1), i, c
c = c - cs
Next

Sleep 40,1
Locate 48,1:Print
Loop Until Inkey = chr(27)