Display a Window Bitmap on a 3D plane:
Must be pure FreeBASIC(No OpenGL, assembly, etc. allowed)
Must support 3D rotation and zoom.
Must compile and run under DOS.
Can not be restricted to any one graphics mode.
Coding Challenge
-
fatman2021
- Posts: 215
- Joined: Dec 14, 2013 0:43
Re: Coding Challenge
Is there a prize to win?
-
grindstone
- Posts: 862
- Joined: May 05, 2015 5:35
- Location: Germany
Re: Coding Challenge
Aren't we all in here only just for fun?Is there a prize to win?
Re: Coding Challenge
fatman2021 wrote:Must compile and run under DOS.
Well, I'd say: DOS isn't any fun (I'm not interested, in catering for dinosaur OS's)!grindstone wrote:Aren't we all in here only just for fun?
Re: Coding Challenge
Something similar to that? http://www.freebasic.net/forum/viewtopic.php?t=15963
Re: Coding Challenge
Maybe something like:
If the bitmap (top line) is not found, not to worry, you get some numbers.
Code: Select all
dim as string bmpfile="bird.bmp"
#include "file.bi"
'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,begin As Long,Finish As Ulong)
Dim As Long i=begin,j=finish
Dim As datatype x =array(((I+J)\2))
While I <= J
While array(I)dot b1 X dot:I+=1:Wend
While array(J)dot b2 X dot:J-=1:Wend
If I<=J Then Swap array(I),array(J): I+=1:J-=1
Wend
If J > begin Then fname(array(),begin,J)
If I < Finish Then fname(array(),I,Finish)
End Sub
#endmacro
'<><><><><><><><><><><><><><><><><><><><><><>
screen 20,32
dim shared as integer bts
screeninfo ,,bts
dim as any ptr i=imagecreate(200,200,rgb(0,200,0))
sub GetSize(bmp As String,byref dx as long,byref dy as long,byref b as ushort=0) 'get bitmap width/height/ colour resolution
' print bmp
Open bmp For Binary access read As #1
Get #1, 19, dX
Get #1, 23, dY
get #1, 29, b
Close #1
End sub
function mapS(a as single,b as single,x as single,c as single,d as single) as single
return ((d)-(c))*((x)-(a))/((b)-(a))+(c)
end function
function resize(picture As String,_x As Integer,_y As Integer) as any ptr
dim as long dimensionx,dimensiony
Getsize(picture,dimensionx,dimensiony)
Dim Scale_x As Double=_x/dimensionx
Dim Scale_y As Double=_y/dimensiony
var dx=_x/dimensionx,dy=_y/dimensiony
dim as any ptr im=Imagecreate(dimensionx,dimensiony)
dim as any ptr tim=Imagecreate(_x,_y)
Bload picture,im
Dim As Ulong col
For y As Integer=0 To (dimensiony-1)
For x As Integer=0 To (dimensionx-1)
Dim As Integer xx=mapS(0,dimensionx,x,0,_x)
Dim As Integer yy=mapS(0,dimensiony,y,0,_y)
Line tim,(xx-dx,yy-dy)-(xx+dx,yy+dy),point(x,y,im),bf
Next x
Next y
return tim
End function
Type Point 'VECTOR POINT
As double x,y,z
As Ulong col
as byte flag
End Type:SetQsort(point,QsortZ,down,.z) 'set up the quicksort
type sincos 'FLOATS for angles
as single sx,sy,sz
as single cx,cy,cz
declare static function construct(as single,as single,as single) as sincos
end type
#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro
function sincos.construct(x as single,y as single,z as single) as sincos
return type <sincos>(sin(x),sin(y),sin(z), _
cos(x),cos(y),cos(z))
end function
Function RotatePoint(c As Point,p As Point,a as sincos,scale As sincos=Type<sincos>(1,1,1)) As Point
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<Point>((scale.sx)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
(scale.sy)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
(scale.sz)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col,p.flag)
End Function
Function perspective(p As Point,eyepoint As Point) As Point
Dim As Single w=1+(p.z/eyepoint.z)
Return Type<Point>((p.x-eyepoint.x)/w+eyepoint.x,(p.y-eyepoint.y)/w+eyepoint.y,(p.z-eyepoint.z)/w+eyepoint.z,p.col,p.flag)
End Function
function contrast(c as ulong) as ulong 'make one random colour over another different
dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
do
r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120
return rgb(r2,g2,b2)
end function
Sub _line(x1 As long,y1 As long,x2 As long,y2 As long,l As long,col As Ulong,byref xp as long=0,byref yp as long=0)
Dim As long diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
if ln=0 then ln=1e-6
Dim As Single nx=diffx/ln,ny=diffy/ln
xp=x1+l*nx:yp=y1+l*ny
Line(x1,y1)-(xp,yp),col
End Sub
sub mouse(mx as long,my as long,sz as long)
dim as long xp,yp
_line(mx,my,mx+sz,my+.8*sz,sz,rgb(50,50,50),xp,yp)
_line(xp,yp,mx+sz/2,yp+.03*sz,.4*sz,rgb(50,50,50),xp,yp)
var tx=xp,ty=yp
_line(mx,my,mx,my+1.2*sz,sz,rgb(50,50,50),xp,yp)
_line(xp,yp,mx+sz/2,yp-sz/2,.4*sz,rgb(50,50,50),xp,yp)
_line(xp,yp,mx+sz/2,yp+sz/2,sz,rgb(50,50,50),xp,yp)
_line(xp,yp,xp+sz/2,yp-.4*sz,.2*sz,rgb(50,50,50),xp,yp)
_line(xp,yp,tx,ty,.95*sz,rgb(50,50,50),xp,yp)
paint(mx+.1*sz,my+.2*sz),rgb(200,200,200),rgb(50,50,50)
end sub
function shade(c as ulong,n as single) as ulong
if bts<16 then return c
if n>1 or n<0 then exit function
return rgba(Cptr(Ubyte Ptr,@c)[2]*n,Cptr(Ubyte Ptr,@c)[1]*n,Cptr(Ubyte Ptr,@c)[0]*n,Cptr(Ubyte Ptr,@c)[3])
end function
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
#macro anotherplate()
a2=sincos.construct(-pi/2,0,0)
ub=ubound(a)
for n as long=lbound(a) to ubound(a)/2
var tmp=rotatepoint(type<point>(cx,cy),a(n),a2)
redim preserve a(ub+n)
a(ub+n)=tmp
next n
#endmacro
'============================ set up the plates =======================
dim as long Pflag
'dim as string bmpfile="bob.bmp"
start:
randomize 3
#define IR IntRange(0,3)
if fileexists (bmpfile) then
i=resize(bmpfile,200,200)
else
print bmpfile; " not found, loading some numbers instead"
for x as long=0 to 200 step 20
for y as long=0 to 200 step 20
dim as ulong col=rgb(rnd*255,rnd*255,rnd*255)
line i,(x,y)-(x+20,y+20),col,bf
draw string i,(x+8,y+4),chr(IntRange(48,57)),contrast(col)
next:next
end if
'capture the image in an array
redim as point a()
dim as long ctr,cx,cy
for x as long=0 to 199
for y as long=0 to 199
ctr+=1
redim preserve a(1 to ctr)
a(ctr)=type(x,y,0,point(x,y,i),IR)
cx+=x:cy+=y
next
next
cx=cx/ctr:cy=cy/ctr'centre of plate
'Rotate the plate 90 degrees on y axis and add to the first plate
ctr=0
var ub=ubound(a)+1
dim as single pi=4*atn(1)
var a2=sincos.construct(0,-pi/2,0)
for n as long=lbound(a) to ubound(a)
var tmp=rotatepoint(type<point>(cx,cy),a(n),a2)
redim preserve a(ub+n)
a(ub+n)=tmp
next n
a2=sincos.construct(0,0,0)
'
dim as single sz=1.5
for n as long=lbound(a) to ubound(a)
a(n)=rotatepoint(Type<Point>(cx,cy,0),a(n),a2,type<sincos>(sz,sz,sz))
a(n).x+=400:a(n).y+=300
next n
cx+=400:cy+=300
'==================================
'=============================================================================
if Pflag then : anotherplate() :end if ''if your cpu is fast
redim as point rot(lbound(a) to ubound(a))
dim as single cm,cs
dim as long fps,finish
dim as string k
'sz=1
dim as sincos Mag
dim as single anglex,angley,anglez,minz,maxz,eye=800
dim as integer mx,my,mb,flag,kp=1
Do
maxz=1e-10
minz=1e10
Mag=type<sincos>(sz,sz,sz)'the scaler
getmouse mx,my,,mb
anglex-=.025:if anglex>2*pi then anglex=0
angley-=.015:if angley>2*pi then anglez=0
anglez-=.012:if anglez>2*pi then anglex=0
k=inkey
if k=chr(27) and finish=0 then finish=1
if finish then
Pflag=0
sz=2
cm+=150
for n as long=lbound(a) to ubound(a)
a(n).z+=IntRange(140,160)
select case as const a(n).flag
case 0:a(n).x+=IntRange(5,15)\4
case 1:a(n).y+=IntRange(5,15)\4
case 2:a(n).x-=IntRange(5,15)\4
case 3:a(n).y-=IntRange(5,15)\4
end select
next n
end if
var SC=sincos.construct(anglex,angley,anglez)
eye=100+700*sz
For n As long=Lbound(a) To Ubound(a)
rot(n) =rotatepoint(Type<Point>(cx,cy,cm),a(n),SC,mag)
rot(n) =perspective(rot(n),Type<Point>(cx,cy,eye))
if maxz<rot(n).z then maxz=rot(n).z
if minz>rot(n).z then minz=rot(n).z
Next n
Qsortz(rot(),Lbound(rot),Ubound(rot))
Screenlock
Cls
For n As long=Lbound(a) To Ubound(a)
dim as single rad=map(maxz,minz,rot(n).z,1,2.75)
dim as single s=map(maxz,minz,rot(n).z,.1,1) '
if finish=0 then
circle(rot(n).x,rot(n).y),rad*sz,shade(rot(n).col,s),,,,f
else
pset(rot(n).x,rot(n).y),(rot(n).col)
end if
Next n
Draw String(10,10), "Number of points " & Ubound(a),Rgb(200,0,0)
Draw String(10,50), "Framerate " & fps
draw string(10,300),"bigger"
mouse(60,310,25)
draw string(10,400),"smaller"
mouse(68,410,25)
if pflag=0 and finish=0 then
draw string(5,490),"One more plate,(only for fast machine)"
mouse(68,510,25)
if incircle(60,510,50,mx,my) and flag=0 and mb=1 and finish=0 then
flag=1:Pflag=1:kp=1
screenunlock
exit do
'anotherplate()
end if
end if
if pflag=1 and finish=0 then
draw string(5,490),"Two plates only"
mouse(68,510,25)
if incircle(60,510,50,mx,my) and flag=0 and mb=1 and finish=0 then
flag=1:Pflag=1:kp=0
screenunlock
exit do
'anotherplate() gone
end if
end if
Screenunlock
if incircle(60,310,50,mx,my) and flag=0 and mb=1 and finish=0 then flag=1:sz*=1.1 '.01
if incircle(60,410,50,mx,my) and flag=0 and mb=1 and finish=0 then flag=1:sz*=.9
sleep regulate(20,fps),1
flag=mb
Loop Until cm>10000
if pflag then pflag*=kp: goto start
cls
draw string(400,300), "DONE"
sleep
screen 0
imagedestroy i
-
fatman2021
- Posts: 215
- Joined: Dec 14, 2013 0:43
Re: Coding Challenge
Good Work..dodicat wrote:Maybe something like:If the bitmap (top line) is not found, not to worry, you get some numbers.Code: Select all
dim as string bmpfile="bird.bmp" #include "file.bi" '<><><><><><><><><><><> Quick SORT <><><><><><><><><><> #define up <,> #define down >,< #macro SetQsort(datatype,fname,b1,b2,dot) Sub fname(array() As datatype,begin As Long,Finish As Ulong) Dim As Long i=begin,j=finish Dim As datatype x =array(((I+J)\2)) While I <= J While array(I)dot b1 X dot:I+=1:Wend While array(J)dot b2 X dot:J-=1:Wend If I<=J Then Swap array(I),array(J): I+=1:J-=1 Wend If J > begin Then fname(array(),begin,J) If I < Finish Then fname(array(),I,Finish) End Sub #endmacro '<><><><><><><><><><><><><><><><><><><><><><> screen 20,32 dim shared as integer bts screeninfo ,,bts dim as any ptr i=imagecreate(200,200,rgb(0,200,0)) sub GetSize(bmp As String,byref dx as long,byref dy as long,byref b as ushort=0) 'get bitmap width/height/ colour resolution ' print bmp Open bmp For Binary access read As #1 Get #1, 19, dX Get #1, 23, dY get #1, 29, b Close #1 End sub function mapS(a as single,b as single,x as single,c as single,d as single) as single return ((d)-(c))*((x)-(a))/((b)-(a))+(c) end function function resize(picture As String,_x As Integer,_y As Integer) as any ptr dim as long dimensionx,dimensiony Getsize(picture,dimensionx,dimensiony) Dim Scale_x As Double=_x/dimensionx Dim Scale_y As Double=_y/dimensiony var dx=_x/dimensionx,dy=_y/dimensiony dim as any ptr im=Imagecreate(dimensionx,dimensiony) dim as any ptr tim=Imagecreate(_x,_y) Bload picture,im Dim As Ulong col For y As Integer=0 To (dimensiony-1) For x As Integer=0 To (dimensionx-1) Dim As Integer xx=mapS(0,dimensionx,x,0,_x) Dim As Integer yy=mapS(0,dimensiony,y,0,_y) Line tim,(xx-dx,yy-dy)-(xx+dx,yy+dy),point(x,y,im),bf Next x Next y return tim End function Type Point 'VECTOR POINT As double x,y,z As Ulong col as byte flag End Type:SetQsort(point,QsortZ,down,.z) 'set up the quicksort type sincos 'FLOATS for angles as single sx,sy,sz as single cx,cy,cz declare static function construct(as single,as single,as single) as sincos end type #define Intrange(f,l) int(Rnd*((l+1)-(f))+(f)) #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c) #macro incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius #endmacro function sincos.construct(x as single,y as single,z as single) as sincos return type <sincos>(sin(x),sin(y),sin(z), _ cos(x),cos(y),cos(z)) end function Function RotatePoint(c As Point,p As Point,a as sincos,scale As sincos=Type<sincos>(1,1,1)) As Point Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z Return Type<Point>((scale.sx)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_ (scale.sy)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_ (scale.sz)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col,p.flag) End Function Function perspective(p As Point,eyepoint As Point) As Point Dim As Single w=1+(p.z/eyepoint.z) Return Type<Point>((p.x-eyepoint.x)/w+eyepoint.x,(p.y-eyepoint.y)/w+eyepoint.y,(p.z-eyepoint.z)/w+eyepoint.z,p.col,p.flag) End Function function contrast(c as ulong) as ulong 'make one random colour over another different dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2 do r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255) loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120 return rgb(r2,g2,b2) end function Sub _line(x1 As long,y1 As long,x2 As long,y2 As long,l As long,col As Ulong,byref xp as long=0,byref yp as long=0) Dim As long diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy) if ln=0 then ln=1e-6 Dim As Single nx=diffx/ln,ny=diffy/ln xp=x1+l*nx:yp=y1+l*ny Line(x1,y1)-(xp,yp),col End Sub sub mouse(mx as long,my as long,sz as long) dim as long xp,yp _line(mx,my,mx+sz,my+.8*sz,sz,rgb(50,50,50),xp,yp) _line(xp,yp,mx+sz/2,yp+.03*sz,.4*sz,rgb(50,50,50),xp,yp) var tx=xp,ty=yp _line(mx,my,mx,my+1.2*sz,sz,rgb(50,50,50),xp,yp) _line(xp,yp,mx+sz/2,yp-sz/2,.4*sz,rgb(50,50,50),xp,yp) _line(xp,yp,mx+sz/2,yp+sz/2,sz,rgb(50,50,50),xp,yp) _line(xp,yp,xp+sz/2,yp-.4*sz,.2*sz,rgb(50,50,50),xp,yp) _line(xp,yp,tx,ty,.95*sz,rgb(50,50,50),xp,yp) paint(mx+.1*sz,my+.2*sz),rgb(200,200,200),rgb(50,50,50) end sub function shade(c as ulong,n as single) as ulong if bts<16 then return c if n>1 or n<0 then exit function return rgba(Cptr(Ubyte Ptr,@c)[2]*n,Cptr(Ubyte Ptr,@c)[1]*n,Cptr(Ubyte Ptr,@c)[0]*n,Cptr(Ubyte Ptr,@c)[3]) end function 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 #macro anotherplate() a2=sincos.construct(-pi/2,0,0) ub=ubound(a) for n as long=lbound(a) to ubound(a)/2 var tmp=rotatepoint(type<point>(cx,cy),a(n),a2) redim preserve a(ub+n) a(ub+n)=tmp next n #endmacro '============================ set up the plates ======================= dim as long Pflag 'dim as string bmpfile="bob.bmp" start: randomize 3 #define IR IntRange(0,3) if fileexists (bmpfile) then i=resize(bmpfile,200,200) else print bmpfile; " not found, loading some numbers instead" for x as long=0 to 200 step 20 for y as long=0 to 200 step 20 dim as ulong col=rgb(rnd*255,rnd*255,rnd*255) line i,(x,y)-(x+20,y+20),col,bf draw string i,(x+8,y+4),chr(IntRange(48,57)),contrast(col) next:next end if 'capture the image in an array redim as point a() dim as long ctr,cx,cy for x as long=0 to 199 for y as long=0 to 199 ctr+=1 redim preserve a(1 to ctr) a(ctr)=type(x,y,0,point(x,y,i),IR) cx+=x:cy+=y next next cx=cx/ctr:cy=cy/ctr'centre of plate 'Rotate the plate 90 degrees on y axis and add to the first plate ctr=0 var ub=ubound(a)+1 dim as single pi=4*atn(1) var a2=sincos.construct(0,-pi/2,0) for n as long=lbound(a) to ubound(a) var tmp=rotatepoint(type<point>(cx,cy),a(n),a2) redim preserve a(ub+n) a(ub+n)=tmp next n a2=sincos.construct(0,0,0) ' dim as single sz=1.5 for n as long=lbound(a) to ubound(a) a(n)=rotatepoint(Type<Point>(cx,cy,0),a(n),a2,type<sincos>(sz,sz,sz)) a(n).x+=400:a(n).y+=300 next n cx+=400:cy+=300 '================================== '============================================================================= if Pflag then : anotherplate() :end if ''if your cpu is fast redim as point rot(lbound(a) to ubound(a)) dim as single cm,cs dim as long fps,finish dim as string k 'sz=1 dim as sincos Mag dim as single anglex,angley,anglez,minz,maxz,eye=800 dim as integer mx,my,mb,flag,kp=1 Do maxz=1e-10 minz=1e10 Mag=type<sincos>(sz,sz,sz)'the scaler getmouse mx,my,,mb anglex-=.025:if anglex>2*pi then anglex=0 angley-=.015:if angley>2*pi then anglez=0 anglez-=.012:if anglez>2*pi then anglex=0 k=inkey if k=chr(27) and finish=0 then finish=1 if finish then Pflag=0 sz=2 cm+=150 for n as long=lbound(a) to ubound(a) a(n).z+=IntRange(140,160) select case as const a(n).flag case 0:a(n).x+=IntRange(5,15)\4 case 1:a(n).y+=IntRange(5,15)\4 case 2:a(n).x-=IntRange(5,15)\4 case 3:a(n).y-=IntRange(5,15)\4 end select next n end if var SC=sincos.construct(anglex,angley,anglez) eye=100+700*sz For n As long=Lbound(a) To Ubound(a) rot(n) =rotatepoint(Type<Point>(cx,cy,cm),a(n),SC,mag) rot(n) =perspective(rot(n),Type<Point>(cx,cy,eye)) if maxz<rot(n).z then maxz=rot(n).z if minz>rot(n).z then minz=rot(n).z Next n Qsortz(rot(),Lbound(rot),Ubound(rot)) Screenlock Cls For n As long=Lbound(a) To Ubound(a) dim as single rad=map(maxz,minz,rot(n).z,1,2.75) dim as single s=map(maxz,minz,rot(n).z,.1,1) ' if finish=0 then circle(rot(n).x,rot(n).y),rad*sz,shade(rot(n).col,s),,,,f else pset(rot(n).x,rot(n).y),(rot(n).col) end if Next n Draw String(10,10), "Number of points " & Ubound(a),Rgb(200,0,0) Draw String(10,50), "Framerate " & fps draw string(10,300),"bigger" mouse(60,310,25) draw string(10,400),"smaller" mouse(68,410,25) if pflag=0 and finish=0 then draw string(5,490),"One more plate,(only for fast machine)" mouse(68,510,25) if incircle(60,510,50,mx,my) and flag=0 and mb=1 and finish=0 then flag=1:Pflag=1:kp=1 screenunlock exit do 'anotherplate() end if end if if pflag=1 and finish=0 then draw string(5,490),"Two plates only" mouse(68,510,25) if incircle(60,510,50,mx,my) and flag=0 and mb=1 and finish=0 then flag=1:Pflag=1:kp=0 screenunlock exit do 'anotherplate() gone end if end if Screenunlock if incircle(60,310,50,mx,my) and flag=0 and mb=1 and finish=0 then flag=1:sz*=1.1 '.01 if incircle(60,410,50,mx,my) and flag=0 and mb=1 and finish=0 then flag=1:sz*=.9 sleep regulate(20,fps),1 flag=mb Loop Until cm>10000 if pflag then pflag*=kp: goto start cls draw string(400,300), "DONE" sleep screen 0 imagedestroy i