Can FB simple animations be run on a website?

New to FreeBASIC? Post your questions here.
Post Reply
TimG
Posts: 5
Joined: Jul 22, 2019 17:13

Can FB simple animations be run on a website?

Post by TimG »

I'm a retired college prof who wrote some animated FB simulations 15 years ago to illustrate tough concepts in statistics. I used them in lectures and distributed them to students for use on their own computers. I often thought of attempting to mount the programs on a website but I have no experience building such sites and never got to it. I'm giving it some thought again, but I wonder if it is even possible. I have read very little on the subject, but I HAVE come across some mention of prohibitions against .exe files on servers because of security risks, the possible use of "sandbox" protections, and services like WebRun. So, my questions are:

1. Can my programs be adapted for presentation on a web site?
2. If so, where should I be looking for guidance on building such a site?
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Can FB simple animations be run on a website?

Post by caseih »

Are you wanting to make the animations be interactive? In other words are you trying to turn your FB programs into web-based programs that take user input from the web page and generate the appropriate animation?

Or are you just wanting to capture the animations and re-play them back in a web page? If so, then probably the best bet is to use screen capture software to record the screen to a movie file that you can post.

If it's the former, you would have to translate your FB algorithms and animating code to Javascript. FB just isn't something that can be made to run in a web browser. Not the easiest task, unless you're already familiar with Javascript.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Can FB simple animations be run on a website?

Post by MrSwiss »

TimG wrote:1. Can my programs be adapted for presentation on a web site?
I whould not do that, the risks of running them "off the Web-Server" is simply to high.
(even WebRun advises against it, they state "Intranet" only, which means site/company internal)

I would zip them up (compression) and offer them for download.
Together with some text (desription of context) and maybe some screen shots.
TimG wrote:2. If so, where should I be looking for guidance on building such a site?
Have a look here: How to Create a Website

Let me tell you this much: those questions are here regarded as "off topic" because,
they don't relate to FreeBASIC as a language, nor to coding in general ...
Knatterton
Posts: 165
Joined: Apr 19, 2019 19:03

Re: Can FB simple animations be run on a website?

Post by Knatterton »

TimG wrote: 1. Can my programs be adapted for presentation on a web site?
The easy way would be probably animated gifs like on this site:

https://giphy.com/explore/animated
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Can FB simple animations be run on a website?

Post by dodicat »

I put some graphics on YouTube a while back.
https://www.youtube.com/watch?v=p2h1GYJ ... e=youtu.be

Here was the graphics part.

Code: Select all

  


Dim Shared As Integer xres,yres
Type pt
    As Single x,y
    As Uinteger col
    As Integer range
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    #define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
End Type
Type Point As pt
Type Wrm
    As Single x,y
    Dim As Single dx,dy
    Dim As Integer kx,ky
    Declare Property length As Single
    Declare Property unit As Wrm
End Type
Operator + (Byref v1 As Wrm,Byref v2 As Wrm) As Wrm
Return Type<Wrm>(v1.x+v2.x,v1.y+v2.y)
End Operator
Operator -(Byref v1 As Wrm,Byref v2 As Wrm) As Wrm
Return Type<Wrm>(v1.x-v2.x,v1.y-v2.y)
End Operator
Operator * (Byval f As Single,Byref v1 As Wrm) As Wrm
Return Type<Wrm>(f*v1.x,f*v1.y)
End Operator

Property Wrm.length As Single
Return Sqr(x*x+y*y)
End Property

Property Wrm.unit As Wrm
Dim n As Single=length
Return Type<Wrm>(x/n,y/n)
End Property


'array changing subs ==========
Sub arrayinsert( a() As Point,index As Integer,insert As Point )
    If index>=Lbound(a) And index<=Ubound(a)+1 Then
        index=index-Lbound(a)
        Redim Preserve a(Lbound(a) To  Ubound(a)+1)
        Dim x As Integer
        For x= Ubound(a) To Lbound(a)+index+1 Step -1
            Swap a(x),a(x-1)
        Next x
        a(Lbound(a)+index)=insert
    End If
End Sub

Sub arraydelete(a() As Point,index As Integer)
    If index>=Lbound(a) And index<=Ubound(a) Then
        Dim x As Integer
        For x=index To Ubound(a)-1
            a(x)=a(x+1)
        Next x
        Redim Preserve a(Lbound(a) To Ubound(a)-1)
    End If
End Sub

Function catmull(p() As Pt,t As Single) As Pt'catmull rom
    #macro set(n)
    0.5 *(     (2 * P(2).n) +_
    (-1*P(1).n + P(3).n) * t +_
    (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
    #endmacro
    Return Type<pt>(set(x),set(y))',set(z))'3D
End Function

Sub Getcatmull(v() As Pt,outarray() As Pt,arraysize As Long=1000)
    Dim As Pt p(1 To 4)
    Redim outarray(0)
    Dim As Single stepsize=(Ubound(v)-Lbound(v)+1)/(arraysize)
    If stepsize>1 Then stepsize=1
    For n As Long=Lbound(v)+1 To Ubound(v)-2 
        p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
        For t As Single=0 To 1 Step stepsize
            Redim Preserve outarray(1 To Ubound(outarray)+1)
            outarray(Ubound(outarray))=catmull(p(),t)
        Next t
    Next n
End Sub

'===========  drawing subs ========================================
Sub DrawSetPoints(a() As Point,col As Uinteger,ydisp As Integer=0)'unused here
    For n As Integer=Lbound(a) To Ubound(a)
        Circle(a(n).x,a(n).y+ydisp),4,col,,,,f
        Draw String(a(n).x,a(n).y+ydisp),Str(n),Rgb(100,100,100)
    Next n
End Sub

Sub DrawArrayPoints(a() As Point,col As Uinteger,ydisp As Integer=0)
    Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
    For z As Integer=Lbound(a)+1 To Ubound(a)
        Line-(a(z).x,a(z).y+ydisp),col
    Next z
    Var x=(Ubound(a)-Lbound(a))\2
    Paint(a(x).x,a(x).y+50+ydisp),col,col
End Sub

Sub AdvanceLayer(p1() As Point,a As Single)
    For n As Integer=Lbound(p1) To Ubound(p1)
        p1(n).x+=a
    Next n
    Var r=p1(Ubound(p1)\2).range
    If a>0 Then
        If p1(Ubound(p1)).x>xres+.2*xres Then
            arraydelete(p1(),Ubound(p1))
            Var p=Type<Point>(-.25*xres,IntRange(-r,r),0,r)
            arrayinsert(p1(),1,p)
        End If
    Else
        If p1(1).x<-.2*xres Then
            arraydelete(p1(),1)
            Var p=Type<Point>(xres+.25*xres,IntRange(-r,r),0,r)
            arrayinsert(p1(),Ubound(p1)+1,p)
        End If
    End If
End Sub

Sub SetLayerRange(p1() As Point,range As Integer)
    For n As Integer=1 To Ubound(p1)
        Var xpos=map(1,Ubound(p1),n,(-.2*xres),(xres+.2*xres))
        p1(n)=Type(xpos,Intrange(-range,range),0,range)
    Next n
End Sub

Sub thickline(x1 As Double,_
    y1 As Double,_
    x2 As Double,_
    y2 As Double,_
    thickness As Double,_
    colour As Uinteger)
    Dim As Double yp,s,h,c
    h=Sqr((x2-x1)^2+(y2-y1)^2)
    s=(y1-y2)/h
    c=(x2-x1)/h
    For yp=0 To thickness Step 1/(thickness)
        Line(x1+(s*yp),y1+(c*yp))-(x2+(s*yp),y2+(c*yp)),colour
    Next yp
End Sub

Function lineto(Byref a As Wrm,Byref b As Wrm,Byval L As Single=1,Byval flag As Integer=0,Byval c As Integer=0,th As Single=2) As  Wrm
    If flag Then  thickLine(a.x,a.y,(a+L*(b-a)).x,(a+L*(b-a)).y,th,c)
    Return a+L*(b-a)
End Function

Sub Worms(wms() As wrm)
    Dim As Uinteger col
    For z As Integer=1 To Ubound(wms,1)
        If wms(z,0).x>5 And wms(z,0).x<800-5  Then 
            If wms(z,0).y>5  And wms(z,0).y<600-5 Then 
                If Instr(Str(Timer),"0000") Then wms(z,0).kx=-wms(z,0).kx
                If Instr(Str(Timer),"111") Then wms(z,0).ky=-wms(z,0).ky
            End If
        End If
        If wms(z,0).x<0  Or wms(z,0).x>800 Then wms(z,0).kx=-wms(z,0).kx
        If wms(z,0).y<200 Or wms(z,0).y>500 Then wms(z,0).ky=-wms(z,0).ky
        wms(z,0).x+=wms(z,0).dx*wms(z,0).kx
        wms(z,0).y+=wms(z,0).dy*wms(z,0).ky
        Var cnt=0
        Circle(wms(z,0).x,wms(z,0).y),3,Rgb(0,0,0),,,,f
        For z2 As Integer=1 To Ubound(wms,2)
            cnt+=1
            If cnt And 1 Then col=Rgb(200,100,0) Else col=Rgb(0,20,0)
            Var d=wms(z,z2-1)-wms(z,z2)
            wms(z,z2)+=.1*d
            d=lineto(wms(z,z2-1),wms(z,z2),1,1,col,cnt)
        Next z2
    Next z 
End Sub

Function resize(im As Any Ptr,sx As Single,sy As Single=1) As Any Ptr
    sy=sx
    #macro ppoint(x1,y1,colour)
    pixel=row+pitch*(y1)+(x1)*4
    (colour)=*pixel
    #endmacro
    #macro ppset(x1,y1,colour)
    pixel=row+pitch*(y1)+(x1)*4
    *pixel=(colour)
    #endmacro
    #macro inimage()
    xpos>=0 And xpos<mx And ypos>=0 And ypos<my
    #endmacro
    Dim As Uinteger c
    Dim As Integer pitch
    Dim As Any Ptr row
    Dim As Uinteger Ptr pixel
    Dim As Integer dx,dy
    Imageinfo im,dx,dy,,pitch,row
    Dim As pt a(dx-1,dy-1)
    For y As Integer=0 To dy-1
        For x As Integer=0 To dx-1
            ppoint(x,y,c)
            a(x,y)=Type<pt>(x,y,c)'
        Next x
    Next y
    Dim As Integer mx,my
    Static As Any Ptr im2:im2=Imagecreate(dx*sx,dy*sy)
    Imageinfo im2,mx,my,,pitch,row
    Dim As Integer xpos,ypos
    For y As Integer=0 To dy-1
        For x As Integer=0 To dx-1
            xpos=(map(0,(dx-1),a(x,y).x,0,mx))
            ypos=(map(0,(dy-1),a(x,y).y,0,my))
            If inimage() Then
                ppset(xpos,ypos,a(x,y).col)
            End If
        Next x
    Next y
    Return im2
End Function

'================  SPEED REGULATOR ================
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function



'================================================
'dim as integer xres,yres
Screenres 800,600,32
Draw String(350,250),"Please wait ..."
Screeninfo xres,yres
Dim As Any Ptr plant(1 To 30)
'create images for a plant
For n As Integer=1 To 30
    plant(n) = Imagecreate(320,400,Rgb(255,0,255))
Next n
Draw String(350,300), "Images done"
'frond creator
Sub frond(Xpos As Integer, Ypos As Integer,_Width As Integer, _Height As Integer,arr() As pt,flag As Integer=0,size As Integer=1000,col As Uinteger=155)
    Dim As Single a(1 To 4)={.85,-.15,.2,0}
    Dim As Single b(1 To 4)={.04,.28,-.26,0}
    Dim As Single c(1 To 4)={-.04,.26,.23,0}
    Dim As Single d(1 To 4)={.85,.24,.22,.16}
    Dim As Single e(1 To 4),p(1 To 4)
    Dim As Single f(1 To 4)={1.6,.44,1.6,0}
    Dim As Single pt = 0, pi, x, y, newx, newy
    Dim As Integer i
    For i  = 1 To 4
        Select Case As Const i
        Case 1:pi=.85
        Case 2,3:pi=.07
        Case 4:pi=.01
        End Select
        pt+=pi
        p(i)=pt
    Next i
    Static As Integer min
    Dim As Integer num=size
    Dim As Integer max=num+min,ctr
    Redim Preserve arr(0 To max)
    For n As Integer = min To max
        ctr+=1
        pi = Rnd
        i = 0
        Do:i+=1:Loop While pi > p(i)
        newx = a(i)*x+b(i)*y+e(i)
        newy = c(i)*x+d(i)*y+f(i)
        x = newx
        y = newy
        Var r=map(1,num,ctr,0,col)
        arr(n)=Type<pt>(x*_Width+Xpos,y*_Height+Ypos,Rgb(r,(255-r)*.8,0))
    Next n
    If flag=0 Then min=max Else min=0
End Sub

'create 30 ferns of varying colour
Redim As pt array(0)
Dim As Integer a,col
For n As Integer=1 To 30
    Do
        a=intrange(-50,50)
    Loop Until Abs(a)>20
    Var b=IntRange(10,30)
    Var c=IntRange(-5,5)
    col=IntRange(0,255)
    Circle plant(n),(150,400),2*Abs(a),Rgb(180,180,0),,,.2,f
    'create two fronds per plant
    frond(160,400,a+c,-b,array(),0,30000,col)
    col=col/2
    frond(160,400+c,-a,-b+c,array(),1,30000,col)
    For n2 As Integer=Lbound(array) To Ubound(array):Pset plant(n),(array(n2).x,array(n2).y),array(n2).col:Next n2
    Next n
    
    
    Draw String(350,350), "Ferns to images done"
    
    Type SPRITE
        As Double     px
        As Double     py              ' position of sprite in world coordinates
        As Double     pz
        As Any Ptr    img             ' image used by sprite
    End Type
    
    Function RotateSprite(c As sprite,p As sprite,angle As sprite,scale As sprite=Type<sprite>(1,1,1)) As sprite
        Dim As Single sx=Sin(angle.px),sy=Sin(angle.py),sz=Sin(angle.pz)
        Dim As Single cx=Cos(angle.px),cy=Cos(angle.py),cz=Cos(angle.pz)
        Dim As Single dx=p.px-c.px,dy=p.py-c.py,dz=p.pz-c.pz
        Return Type<sprite>((scale.px)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.px,_
        (scale.py)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.py,_
        (scale.pz)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.pz,p.img)
    End Function  
    
    Function perspective(p As sprite,eyepoint As sprite) As sprite'UNUSED
        Dim As Single   w=1+(p.pz/eyepoint.pz)
        Return Type<sprite>((p.px-eyepoint.px)/w+eyepoint.px,(p.py-eyepoint.py)/w+eyepoint.py,(p.pz-eyepoint.pz)/w+eyepoint.pz,p.img)
    End Function
    
    Const sprNUM = 400
    
    Redim Shared As SPRITE sprites(0)  
    
    '-----  initialize sprite -----------------
    For i As Integer   = 0 To sprNUM-1
        Redim Preserve sprites(i)
        sprites(i).px  = 10*Int(Rnd(1)*400)  'scatter trees
        'sprites(i).py  = i+250' (Leave this for the moment)
        sprites(i).pz  = Int(Rnd(1)*4000)-Int(Rnd(1)*4000)
        Var z=IntRange(1,30)'pick up one of thirty plant types.
        sprites(i).img = plant(z)
    Next i
    '------------------------------------------
    
    Draw String(350,400), "Sptites made"
    
    Sub sortTrees(sprites() As sprite)
        Dim As Integer swapFlag
        Do
            swapFlag = 0
            For i As Integer = 0 To Ubound(sprites)-1
                If sprites(i).pz < sprites(i+1).pz Then
                    Swap sprites(i),sprites(i+1)
                    swapFlag = 1  'flag a swap took place
                End If
            Next i
        Loop Until swapFlag = 0
    End Sub
    
    
    sortTrees(sprites())
    'now resize the sprite images downwards by .pz component
    For n As Integer=Lbound(sprites) To Ubound(sprites)
        sprites(n).py=n/9+150'now give the y values so trees sit on the yellow bit
        Var sz=map(-4000,4000,sprites(n).pz,1,.3)
        're size each image by .pz value, the .py has already been graded downwards
        sprites(n).img=resize(sprites(n).img,sz)
    Next n
    Draw String(350,450), "Sptites resized"
    Sleep 500
    Sub setup(w() As Wrm)
        For z As Integer=1 To Ubound(W,1)
            Do
                W(z,0).x=Intrange(50,800-50):W(z,0).y=Intrange(200,600-90)
            Loop Until w(z,0).x<>0 And w(z,0).y<>0
            Do
                W(z,0).dx=Rnd*3:W(z,0).dy=Rnd*1
            Loop Until Type<wrm>(W(z,0).dx,W(z,0).dy).length>1
            
            w(z,0).kx=1:w(z,0).ky=1
            Dim As Wrm p=Type<Wrm>(Intrange(50,800-50),Intrange(50,600-50))
            Var p2=160*((p-W(z,0)).unit)
            p2=W(z,0)+p2
            Dim As Single j
            For z3 As Single=1 To Ubound(w,2)
                j+=1/(Ubound(w,2))
                Var I=lineto(W(z,0),p2,j)
                w(z,z3)=Type<Wrm>(I.x,I.y)
            Next z3
        Next z
    End Sub
    
    Redim As Point p1(1 To 30),p2(1 To 30),p3(1 To 30)
    Redim As Point c1(0)                       'interpolating points
    'set initial values
    SetLayerRange(p1(),20)
    SetLayerRange(p2(),15)
    SetLayerRange(p3(),10)
    Randomize 1
    Dim As sprite pivot=Type<sprite>(xres/2,yres/2,8000)'rotate about this point in 3D space
    Dim As Single angle=-.15,stepper
    Dim As Integer fps
    Dim As wrm W(1 To 2,20)
    setup(W())
    Dim As Long k=2
    Do
        stepper=map(-.15,.75,angle,.00025,.0001)'angle incrementer
        angle+=stepper
        If angle>.75 Then angle=-.15 'repeat all over again
        Var xpos=map(-.15,.75,angle,20,780) 'progress bar
        Screenlock()
        Cls
        
        Line (0,0)-(800,255),Rgb(100,100,255),bf   
        
        AdvanceLayer(p1(),-.15*k)
        GetCatmull(p1(),c1(),100)
        drawarraypoints(c1(),Rgb(200,0,200),150)
        
        AdvanceLayer(p2(),-.25*k)
        GetCatmull(p2(),c1(),80)
        drawarraypoints(c1(),Rgb(137,73,9),200)
        
        AdvanceLayer(p3(),-.3*k)
        GetCatmull(p3(),c1(),80)
        drawarraypoints(c1(),Rgb(40,100,0),230)
        
        Line (0,256)-(800,600),Rgb(200,200,0),bf 
        
        'progress bar
        Line(20,40)-(780,50),Rgb(200,0,0),b
        Line(20,41)-(xpos,49),Rgb(0,0,100),bf
        
        For n As Integer=Lbound(sprites) To Ubound(sprites)
            Var tmp=rotatesprite(pivot,sprites(n),Type<sprite>(0,angle,0),Type<sprite>(1,1,1))
            If tmp.px>-400 Andalso tmp.px<800 Then
                If tmp.pz>-2000 Then
                    Put(tmp.px,tmp.py),sprites(n).img,trans
                End If
            End If
        Next n
        
        Draw String(10,10),"FPS = " & fps
        Worms(W())'between images
        
        For n As Integer=Lbound(sprites)To Ubound(sprites)
            Var tmp=rotatesprite(pivot,sprites(n),Type<sprite>(0,angle,0),Type<sprite>(1,1,1))
            If tmp.px>-400 Andalso tmp.px<800 Then
                If tmp.pz<=-2000 Then
                    Put(tmp.px,tmp.py),sprites(n).img,trans''draw the images.
                End If
            End If
        Next n
        Screenunlock()
        Sleep regulate(60,fps)
        
    Loop Until Multikey(&H01)
    Sleep
    'clean up
    For n As Integer=Lbound(sprites) To Ubound(sprites)
        If sprites(n).img Then Imagedestroy sprites(n).img
    Next n
    For n As Integer=1 To Ubound(plant)
        Imagedestroy plant(n)
    Next n  
    
  
Statistically I got no comments, must be significant one way or another.
angros47
Posts: 2323
Joined: Jun 21, 2005 19:04

Re: Can FB simple animations be run on a website?

Post by angros47 »

This is the code to save a video from FreeBasic:

https://freebasic.net/forum/viewtopic.p ... 46#p236246
TimG
Posts: 5
Joined: Jul 22, 2019 17:13

Re: Can FB simple animations be run on a website?

Post by TimG »

Thanks for the replies folks. I got a little preoccupied with another project and didn't get back to this forum until today. I had hoped to make my programs interactive with users entering their own parameter values and then seeing simulated distributions and statistical results, but I might still just make them available in zipped form from the web site. Sorry to bomb the list list with an off topic post.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Can FB simple animations be run on a website?

Post by MrSwiss »

TimG wrote: I got a little preoccupied with another project and didn't get back to this forum until today.
Let me guess ... that project was titled: "vacations/holidays". ;-D
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Can FB simple animations be run on a website?

Post by TJF »

Hi TimG!

There's a simple and save way to run FB excutables on a webside, if the executable is compiled against GTK: just run that application under the braodway backend. Then you can connect any html5 browser to one of the broadway ports and use the browser window as a virtual screen/keyboard for your application running on your server.

Regards
TimG
Posts: 5
Joined: Jul 22, 2019 17:13

Re: Can FB simple animations be run on a website?

Post by TimG »

TJF wrote:There's a simple and save way to run FB excutables on a webside, if the executable is compiled against GTK: just run that application under the braodway backend. Then you can connect any html5 browser to one of the broadway ports and use the browser window as a virtual screen/keyboard for your application running on your server.
Okay, but I'm going to have to spend a little time unpacking that! Thanks for the advice TJF.
And to MrSwiss, we took a vacation in March. My current preoccupations are: woodworking, gardening, photography, sports car mechanics, and whatever else I feel like doing. ;-) Retirement is good.

Thanks,
TimG
Post Reply