FreeBASIC 1.09.0 Release

General discussion for topics related to the FreeBASIC project or its community.
Post Reply
srvaldez
Posts: 3606
Joined: Sep 25, 2005 21:54

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by srvaldez »

srvaldez wrote:like SARG I don't know about AXL, BXL, CXL, DXL the only thing thar occurs to me is that it could possibly refer to AX-low and so on
I believe that that this confirms it

Code: Select all

dim as long n, l
asm
	mov ax, 32123
	mov byte ptr[l], axl
end asm
? l
sleep
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by jj2007 »

This should throw an error. There is no axl or axh in x86 Assembly.

eax 32 bit
ax 16 bit low word of eax
al 8 bit low byte of ax
ah 8 bit high byte of ax
srvaldez
Posts: 3606
Joined: Sep 25, 2005 21:54

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by srvaldez »

I know jj, but apparently the gnu assembler interprets axl the same as al
coderJeff
Site Admin
Posts: 4383
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by coderJeff »

#cmdline "args..." directive added to specify fbc command line options in user source.

github: Add '#cmdline "args..."' directive #341

documentation discussion: #cmdline "args..." directive
VANYA
Posts: 1862
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by VANYA »

coderJeff wrote:#cmdline "args..." directive added to specify fbc command line options in user source.

github: Add '#cmdline "args..."' directive #341

documentation discussion: #cmdline "args..." directive
A very good innovation! You're a big lad!
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by counting_pine »

coderJeff wrote:#cmdline "args..." directive added to specify fbc command line options in user source.

github: Add '#cmdline "args..."' directive #341

documentation discussion: #cmdline "args..." directive
Epic!
Nice work Jeff.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by MrSwiss »

coderJeff wrote:#cmdline "args..." directive added to specify fbc command line options in user source.
@coderJeff, great job.

I've had to test it straight away (with StW's latest 'nightly build') however, it doesn't seem to work 'as intended':

Code: Select all

' _test.bas -- (c) 2021-09-07, MrSwiss

#If __FB_VERSION__ >= "1.09.0"          ' already resolved
#If __FB_BUILD_DATE_ISO___ >= "2021-09-05"  ' NOT resolved yet (latest nightly StW build)
'#If __FB_BUILD_DATE___ >= "09-05-2021"

#cmdline "-gen gcc -O 2"                ' NOT resolved yet
#Print __FB_VERSION__                   ' works OK
#Print __FB_BUILD_DATE_ISO___           ' NOT resolved yet
'#Print __FB_BUILD_DATE___

#EndIf  ' __FB_BUILD_DATE_ISO___
#EndIf  ' __FB_VERSION__


' ===== TEST =====
#cmdline "-gen gcc -O 2"                ' not working 'as intended'
' below: __FB_BUILD_DATE_ISO__ resolved now (too late IMO)
Print "This program compiled with a compiler built on this date: " + __FB_BUILD_DATE_ISO__

Print :Print
Print "... done ... ";
Sleep
' ===== end-TEST =====
' ----- EOF -----
There seem to be some timing issues for some 'intrinsic defines' too (resolution seems too late).
Namely: __FB_BUILD_DATE__ and, __FB_BUILD_DATE_ISO__

Can this be prehaps be influenced by the 'used' version of GCC ? (for building FBC itself)
dodicat
Posts: 8239
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by dodicat »

Mr Swiss
I haven't got the latest build, but
-gen gcc -O 2
looks strange.
try maybe
-gen gcc -Wc -O2
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by MrSwiss »

dodicat,
dodicat wrote:-gen gcc -O 2 looks strange.
It nevertheless works in both: FBEdit aswell as command line.
In FBEdit -O2 never worked propperly (w/o a space inbetween) ...
dodicat
Posts: 8239
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by dodicat »

Just got the build.
this works

Code: Select all

#cmdline "-gen gcc -Wc -O2"

 Function isprime(n As ulongint) As integer
    If (n=2) Or (n=3) Then Return -1
    If n Mod 2 = 0 Then return 0
    If n Mod 3 = 0 Then return 0
    Dim As ulongint limit=Sqr(N)+1
    For I As ulongint = 6 To limit Step 6
        If N Mod (i-1) = 0 Then return 0
        If N Mod (i+1) = 0 Then return 0
    Next I
    Return -1
End Function


print "Please wait . . ."
dim as double t=timer
print isprime(18446744073709551557)

print "done  ",timer -t;" seconds"
sleep
 

Code: Select all

Please wait . . .
-1
done           10.45152950001648 seconds
  
With no options I get >14 seconds.
coderJeff
Site Admin
Posts: 4383
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by coderJeff »

MrSwiss wrote:There seem to be some timing issues for some 'intrinsic defines' too (resolution seems too late).
Namely: __FB_BUILD_DATE__ and, __FB_BUILD_DATE_ISO__
Thank you for testing. Above __FB_BUILD_DATE__ and __FB_BUILD_DATE_ISO__ is correct.
Below is not correct:

Code: Select all

#Print __FB_BUILD_DATE_ISO___           ' NOT resolved yet
'#Print __FB_BUILD_DATE___
I don't want to give away the surprise ... look closely. :P
coderJeff
Site Admin
Posts: 4383
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by coderJeff »

dodicat wrote: -gen gcc -O 2
This is correct for fbc's command line. fbc converts it to '-O2' when invoking gcc.
-gen gcc -Wc -O2
This is correct to pass '-O2' to gcc directly.

fbc doesn't do anything with '-O 2' -- it is only passed along to gcc. All of fbc's optimizations (constant folding, dead private sub removal, etc) are turned on by default all the time. Maybe in a past life fbc made decisions based on '-O arg'
coderJeff
Site Admin
Posts: 4383
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by coderJeff »

dodicat wrote:Just got the build.
this works
...
Thank-you for testing. :)
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by MrSwiss »

coderJeff wrote:Above __FB_BUILD_DATE__ and __FB_BUILD_DATE_ISO__ is correct.
Below is not correct:

Code: Select all
#Print __FB_BUILD_DATE_ISO___ ' NOT resolved yet
'#Print __FB_BUILD_DATE___

I don't want to give away the surprise ... look closely. :P
Yea, you're correct. As always, the details (one underline too much). :D
dodicat
Posts: 8239
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC 1.08.1 and 1.09.0 Development

Post by dodicat »

I use a more complex code (+ graphics) to test the #cmdline
This time if I use use -gen gcc, I get a pile of errors.
32 bit seems to be the same either optimised or not (32 fps)
64 bit looks OK (20 fps and 32 fps)
Note that optimising with the official 32 bit compiler gives
(32 fps and 38 fps)

Code: Select all

#cmdline " -Wc -O2"
Type Point
    As Single x,y,z
    As Ulong col
End Type

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) 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

Sub drawpolygon(p() As Point, col As Ulong,im As Any Ptr=0) 
    Dim k As Long=Ubound(p)+1
    Dim As Long index,nextindex
    Dim As Single cx,cy,counter
    For n As Long=1 To Ubound(p)
        counter+=1
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        cx+=p(index).x:cy+=p(index).y
        Line im,(p(index).x,p(index).y)-(p(nextindex).x,p(nextindex).y),col
    Next
    cx=cx/counter:cy=cy/counter
    p(0)=Type<Point>(cx,cy)
    Line im,(p(4).x,p(4).y)-(p(36).x,p(36).y),col
    Paint im,((p(1).x+p(4).x)\2,p(1).y),Rgb(0,0,0),col'prop
    Paint im,(cx,cy),col,col
    For n As Long=8 To 10
        Line im,(p(n).x,p(n).y)-(p(n+1).x,p(n+1).y),Rgb(200,0,0)
    Next n
    Line im,(p(11).x,p(11).y)-(p(8).x,p(8).y),Rgb(200,0,0)
    Paint im,((p(8).x+p(10).x)/2,(p(8).y+p(10).y)/2),Rgb(100,100,255),Rgb(200,0,0)
    for n as long=-1 to 1
    line(p(16).x,p(16).y+n)-(p(21).x,p(21).y+n),rgb(0,0,0)
    next
End Sub

Function RotatePoint(c As Point,p As Point,angle As Point,scale As Point=Type<Point>(1,1,1)) As Point
    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<Point>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z,p.col)
End Function

Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
    Static As Integer pitch,pitchs,xres,yres,runflag
    Static As Any Ptr row,rows
    Static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
    If dest=0 Then
    Screeninfo xres,yres,,,pitchS
    rowS=Screenptr
    Else
    If sc<>1 Then 
        Dim As Integer x,y
        Imageinfo dest,x,y
    Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
    End If
    Imageinfo dest, xres,yres,,pitchS,rows
    End If
    Dim As Long centreX=ddx\2,centreY=ddy\2
    Dim As Single sx=Sin(angle)
    Dim As Single cx=Cos(angle)
    Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
    Var fx=sc*.7071067811865476,sc2=1/sc
    If fixedpivot=false Then
     shiftx+=centreX*sc-centrex
     shiftY+=centrey*sc-centrey
     End If
    For y As Long=centrey-fx*mx+1 To centrey+ fx*mx 
        Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
        shfty=y+shifty
        For x As Long=centrex-mx*fx To centrex+mx*fx 
                 If x+shiftx >=0 Then 'on the screen
                    If x+shiftx <xres Then
                        If shfty >=0 Then
                            If shfty<yres Then
            resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
                If resultx >=0 Then 'on the image
                    If resultx<ddx Then
                        If resulty>=0 Then
                            If resulty<ddy Then
    Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
   If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
                End If:End If:End If:End If
                End If:End If:End If:End If
        Next x
    Next y
End Sub

Sub cloud(x As Long, y As Long,length As Long=100,Alpha As Long=105, Zoom As Single = 0,im As Any Ptr=0)
    Static As Long r=255,b=255,g=255
    Dim As Double pi=3.14159
    Static As Long cl,p
    cl=cl+1
    If cl Mod 100000=0 Then
        p=p+1
        Draw String(x/50+8*p,400),"_____",Rgb(255,255,255)
    End If
    If Length<=1 Or Alpha<=1 Then Exit Sub
    Dim As Single rnded  = -pi+rnd*1*pi*3
    Dim As Single rnded2 = -pi+rnd*-3*pi*3
    If Alpha<15 Then
        For i As long = 0 To 255-Alpha Step 100
            Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgba(R,G,B,Alpha)
            Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgba(R,G,B,Alpha)
        Next
    End If
    cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom,im)
    cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom,im)
    cloud(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom,im)
End Sub

Sub Tree(i As Any Ptr=0,x1 As Single,y1 As Single,size As Single,angle As Single,depth As Single,colb As Ulong=0,colL As Ulong=0)
    Dim  As Single spread,scale,x2,y2
    spread=25
    scale=.76
    #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    x2=x1-.25*size*Cos(angle*.01745329)
    y2=y1-.25*size*Sin(angle*.01745329)
    Static As long count,fx,fy,sz,z
    If count=0 Then  fx=x1:fy=y1:sz=size:z=2^(depth+1)-1
    Line i,(x1,y1)-(x2,y2),colb
    If count=0 Then  fx=x2:fy=y2:sz=size
    count=count+1
    If count>z Then count=0
    If incircle(fx,fy,(.45*sz),x2,y2)=0 Then Circle i,(x2,y2),.01*sz,colL 
    If depth>0 Then
        Tree(i,x2, y2, size * Scale, angle - Spread, depth - 1,colB,colL)
        Tree(i,x2, y2, size * Scale, angle + Spread, depth - 1,colB,colL)
    End If
End Sub

Function Filter(Byref tim As Ulong Pointer,_
    Byval rad As Single,_
    Byval destroy As long=1,_
    Byval fade As long=0) As Ulong Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Long x,y
        As Ulong col
    End Type
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As long=-ymin To ymax
        For x1 As long=-xmin To xmax
            inc=inc+1 
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Ulong Pointer im=Imagecreate(_x,_y)
    Dim As Ulong col
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As long=0 To (_y)-1
        For x As long=0 To (_x)-1
            col=Point(x,y,tim)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Ulong averagecolour
    Dim As long ar,ag,ab
    Dim As long xmin,xmax,ymin,ymax,inc
    For y As long=0 To _y-1
        For x As long=0 To _x-1  
            average()
            Pset im,((NewPoints(x,y).x),(NewPoints(x,y).y)),averagecolour
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function


Function range(f As Long,l As Long) As Long
    Return  Int(Rnd*((l+1)-(f)))+f
    End Function

Function go As Long
    #macro backdrop()
    Scope
        #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
        Dim As Single minx,maxx,miny,maxy,lasty,grad
        Dim As Long ctr
        #macro paintsketch(_function,r,g,b,im,sz,set)
        Randomize 1
        ctr=0
        For x As Double=minx To maxx Step (maxx-minx)/5000
            ctr+=1
            If ctr=4500 Then  Randomize 1
            Dim As Double x1=(xres)*(x-minx)/(maxx-minx)
            Dim As Double y1=(yres)*(_function-maxy)/(miny-maxy)
            If ctr Mod set=0 Then
                Var xx=x1+rnd*5-rnd*5,yy=y1+rnd*set/4
                tree(im,xx,yy,sz,90+(rnd*10-rnd*10),12,Rgb(100,10+rnd*50,0),Rgb(rnd*50,100+rnd*100,0))
            End If
            grad=y1-lasty
            lasty=y1
            grad=grad*250
            Line im,(x1,yres)-(x1,y1),Rgb(r+grad,g+grad,b)
        Next x
        #endmacro
        #macro _window(topleftX,topleftY,bottomrightX,bottomrightY)
        minx=topleftX
        maxx=bottomrightX
        miny=bottomrightY
        maxy=topleftY
        #endmacro
        #macro sea
        For z As Long=0 To .7*yres
            Var r=map(0,(.7*yres),z,0,250)
            Var g=map(0,(.7*yres),z,0,250)
            Var b=map(0,(.7*yres),z,200,250)
            Line im2,(0,z)-(xres,z),Rgb(r,g,b)
        Next z
        #endmacro
        sea
        Dim As Single pi=4*Atn(1)
        _window(-4*pi,3,4*pi,-1.2)
        paintsketch(.05*Sin(x)+.05*Sin(2*x),50,100,50,imgs(1),15,100)
        
        _window(-3*pi,2,3*pi,-.8) 
        paintsketch(.1*Sin(x),50,120,0,imgs(2),25,100)
        
        _window(-2*pi,2,2*pi,-.6) 
        paintsketch(.1*Sin(x),50,150,0,imgs(3),30,150)
        
        _window(-pi,2,pi,-.5)
        paintsketch(.2*Sin(x),50,170,0,imgs(4),55,150)
        Var x=xres,y=yres
        Randomize 2
        For a As Long = 1 To 7
            If a<=5 Then
                cloud(x*1.5/a, y*1/a, Range(60,80)/2, Range(40,60),5,im2)
                cloud(x*1.4/a, y*2/a, range(60,80)/2, range(40,60),2,im2)
            End If
            If a=6 Then  cloud(x/2,y/4,150,250,1,im2)
            If a=7 Then  cloud(.8*x,.1*y,100,80,5,im2)
            
        Next
        im2=filter(im2,2)
        Line im2,(0,.7*yres)-(xres,.9*yres),Rgb(0,50,200),bf
    End Scope
    #endmacro
    
    #macro Sweep(p,_step,sz)
    For z As Long=0 To (sz)\4 -_step
        Swap p[z],p[z+_step]
    Next z
    #endmacro
    
    Dim As Integer xres,yres
    Screenres 1024,768,32,,64
    Screeninfo xres,yres
    Width xres\8,yres\16
    Dim As Any Ptr sim=Imagecreate(150,25)
    Draw String sim,(5,10),"D-CAT",Rgb(0,0,0)
    Draw String sim,(129,10),"|||",Rgb(0,0,0)
    Circle sim,(90,15),35,Rgb(0,10,0),,,.1,f
    Dim As Any Ptr im2=Imagecreate(xres,yres)
    Dim As Any Ptr imgs(1 To 4)={Imagecreate(xres,yres),Imagecreate(xres,yres),Imagecreate(xres,yres),Imagecreate(xres,yres)}
      Draw String(20,406),"[",Rgb(255,255,255)
      Draw String(690,406),"]",Rgb(255,255,255)
    backdrop()
    Dim As Ulong Ptr p(1 To 4),p2
    Dim As long size,size2
    
    For n As Long=1 To 4
        Imageinfo imgs(n),,,,,p(n),size
    Next n
    Imageinfo im2,,,,,p2,size2
    
    Dim As Point pt(0 To 38),rot(0 To 38)
    For n As Long=1 To 38: Read pt(n).x:pt(n).x+=410: Next
    For n As Long=1 To 38: Read pt(n).y:pt(n).y+=350: Next 
    drawpolygon(pt(),Rgb(0,0,0))
    Dim As Point ctr=pt(0)
    Dim As Single pi=4*Atn(1)
    Dim As Single a
    Dim As Long k2=1.5
    Dim As String i
    Dim As String s="Going on holiday"
    Dim As Any Ptr im(1 To Len(s))
    
    Dim As Long sz=10,fps
    For n As Long=1 To Len(s)
        im(n)=Imagecreate(sz*3,sz*3)
        Draw String im(n),(10,5),Chr(s[n-1]),Rgb(255,rnd*255,rnd*255)
        Put(n*sz,400),im(n),trans
    Next
    
    Dim As Single angl,d=50
    Dim As Single x1,y1,x2,y2
    Dim As Single x3,y3,x4,y4,yy=100
    Do
        i=Inkey
        For n As Long=1 To 4
            sweep(p(n),k2*n,size) 'hills
        Next n
        sweep(p2,1,size2) 'sky
        angl+=.1 
        a=.1*Sin(angl)
        Screenlock
        Cls
        Put(0,0),im2,Pset
        For n As Long=1 To 3
            Put(0,0),imgs(n),trans
        Next n
        For n As Long=1 To 38
            pt(n).y+=a*5
            rot(n)= rotatepoint(ctr,pt(n),Type<Point>(0,0,a),Type<Point>(.8,.8,.8))
        Next n
        drawpolygon(rot(),Rgb(88,73,00))
        Circle(rot(22).x,rot(22).y),3,0,,,,f
         rotateimage(,sim,-a,rot(0).x-75,rot(0).y-12.5,1,,true) 
       
        For n As Long=1 To Ubound(im)
            Var k=n+2,k1=k+1
            If n=1 Then  
                x1=k*3*sz-d:y1=400+30*Sin(angl+n/2)-20
                x2=k*3*sz-d:y2=400+30*Sin(angl+n/2)+40
            End If
            If n=Ubound(im) Then  
                x3=k1*3*sz-d:y3=400+30*Sin(angl+(n+1)/2)-20
                x4=k1*3*sz-d:y4=400+30*Sin(angl+(n+1)/2)+40
            End If
            Pset(k*3*sz-d,400+30*Sin(angl+n/2)-20+yy),Rgb(200,0,1)
            Line -((k+1)*3*sz-d,400+30*Sin(angl+(n+1)/2)-20+yy),Rgb(200,0,1)
            
            Pset(k*3*sz-d,400+30*Sin(angl+n/2)+40+yy),Rgb(0,0,1)
            Line -((k+1)*3*sz-d,400+30*Sin(angl+(n+1)/2)+40+yy),Rgb(200,0,1)
        Next
        Line(x1,y1+yy)-(x2,y2+yy),Rgb(200,0,1)
        Line(x3,y3+yy)-(x4,y4+yy),Rgb(200,0,1)
        Paint(100,400+30*Sin(angl+(1)/2)+10+yy),Rgb(0,100,200),Rgb(200,0,1)
        For n As Long=1 To Ubound(im)
            Var k=n+2
            rotateimage(,im(n),(Sin((angl+n/2)))/4-0,k*3*sz-d-15,400+30*Sin(angl+n/2)+yy-20,2)
        Next n
      
        Line(x3,y3+yy)-(rot(22).x,rot(22).y),Rgb(0,0,0)
        Line(x4,y4+yy)-(rot(22).x,rot(22).y),Rgb(0,0,0)
        Put(0,0),imgs(4),trans
        Line(0,750)-(xres,768),Rgb(200,200,200),bf
        Draw String(400,755),"Framerate = "&fps,Rgb(200,0,0)
        Screenunlock
        Sleep regulate(40,fps),1
    Loop Until i=Chr(27)
    For n As Long=Lbound(im) To Ubound(im)
        Imagedestroy im(n)
    Next
    Imagedestroy im2
    Imagedestroy sim
    For n As Long=1 To 4
        Imagedestroy(imgs(n))
    Next n
    Sleep
    Return 0
End Function

Data _
498, 489, 487, 481, 454, 420, 399, 390, 381, 369, 359, 331, 297, 272, 255, 247, 237, 228, 217, 205, 202, 205, 219, 228, 251, 288, 319, 347, 359, 401, 418, 440, 440, 457, 471, 480, 486, 488 

Data _
165, 158, 116, 157, 153, 152, 151, 151, 144, 143, 146, 145, 148, 151, 151, 149, 134, 124, 120, 133, 152, 167, 174, 174, 178, 184, 189, 191, 193, 196, 195, 200, 193, 190, 182, 174, 218, 177 


End go 
Post Reply