I follow the rules approximately, with only one killer box (red).
No globals, but cheated by using two byref functions to simulate two globals.
Use the mouse rather than the keyboard, start off with the eater box in the bottom right.
The mouse can be a bit severe, could easily code for the arrows, which would make it a more gentle affair.
Code: Select all
#define difficulty .85 '(1 easy, 0 difficult)
#define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
Static As Double timervalue,_lastsleeptime,t3,frames
frames+=1
If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
If sleeptime<1 Then sleeptime=1
_lastsleeptime=sleeptime
timervalue=Timer
Return sleeptime
End Function
Type box
As Long x,y
As Long free
Declare Static Sub checkfree(() As box)
Declare Static Function checkclear( As box) As Long
End Type
Sub box.checkfree(b() As box)
For n As Long=Lbound(b) To Ubound(b)
If Point(b(n).x+30,b(n).y+30)=Rgb(0,0,0) Then b(n).free=1 Else b(n).free=0
Next n
End Sub
Function box.checkclear(b As box) As Long
If Point(b.x,b.y)=Rgb(0,0,0) And Point(b.x+60,b.y)=Rgb(0,0,0) And _
Point(b.x+60,b.y+60)=Rgb(0,0,0) And Point(b.x,b.y+60)=Rgb(0,0,0)_
Then
Return 1
Else
Return 0
End If
End Function
Type frame
As Long x,y
As Long w,h
As zstring * 50 caption
As Any Ptr i
As Long active
Declare Sub show()
Declare Function map(a As Single,b As Single,x As Single,c As Single,d As Single) As Single
Declare Function overlapped(() As frame,As Long=0) As Long
Declare Constructor
Declare Constructor(W As Long,h As Long,col As Ulong,px As Long,py As Long,As String,As boolean)
Declare Sub update()
Declare Sub MoveByMouse(As Long, As Long, As Long,x() As frame,() As box)
Declare Static Sub showscreen(() As Frame)
Declare Function InImage(As Long,As Long) As Long
Declare Static Sub destroy(() As frame)
Declare Sub Write(As Long,As Long,As String)
Declare Sub blow(sz As Single,As String="")
End Type
Function killer() Byref As frame
Static As frame k
Return k
End Function
Function kl() Byref As Long
Static As Long k
Return k
End Function
Constructor frame
If Screenptr=0 Then Print "No graphics screen!":Sleep:End
End Constructor
Constructor frame(Wd As Long,hi As Long,col As Ulong,px As Long,py As Long,cap As String,a As boolean)
If Screenptr=0 Then this.constructor
If i Then Imagedestroy i
i=Imagecreate(wd,hi,col)
x=px:y=py
w=Wd:h=Hi
Var b=(h+w)/4
For k As Single=1 To b\10
Var z=map(1,b/10,k,1,.1)
Var r=Cptr(Ubyte Ptr,@col)[2]
Var g=Cptr(Ubyte Ptr,@col)[1]
Var b=Cptr(Ubyte Ptr,@col)[0]
Line i,(k,k)-(w-k,h-k),Rgb(r*z,g*z,b*z),b
Next k
Line i,(b\10,b\10)-(wd-b\10,25),Rgb(0,100,255),bf
Draw String i,(b\10,b\10),cap
If cap="EATER" Then
Circle i,(wd\2-.2*wd\2,hi/1.75),.02*wd,0,,,,f
Circle i,(wd\2+.2*wd\2,hi/1.75),.02*wd,0,,,,f
Circle i,(wd\2,hi/1.6),.25*wd,0
Circle i,(wd\2,hi/1.6),.15*wd,0,4.5,5.9
End If
caption=cap
active=a
End Constructor
Sub frame.blow(sz As Single,c As String="")
If c="" Then
this.constructor(w+sz,h+sz,Rgb(255,255,255),x,y,"EATER",true)
Else
this.constructor(w+sz,h+sz,Rgb(255,255,255),x,y,c,true)
End If
End Sub
Sub frame.show()
Put(x,y),i,Pset
End Sub
Function frame.Overlapped(f() As Frame,flag As Long=0) As Long
Dim As box p2(1 To 4)
If flag=0 Then
For n As Long=Lbound(f) To Ubound(f)-1
p2(1).x=f(n).x:p2(1).y=f(n).y
p2(2).x=f(n).x+f(n).w:p2(2).y=f(n).y
p2(3).x=f(n).x+f(n).w:p2(3).y=f(n).y+f(n).h
p2(4).x=f(n).x:p2(4).y=f(n).y+f(n).h
For n2 As Long=1 To 4
If n<>35 And f(n).active Then
If p2(n2).x<x+w And p2(n2).x>x And p2(n2).y<y+h And p2(n2).y>y Then Return n
End If
Next n2
Next n
Else
p2(1).x=killer.x:p2(1).y=killer.y
p2(2).x=killer.x+killer.w:p2(2).y=killer.y
p2(3).x=killer.x+killer.w:p2(3).y=killer.y+killer.h
p2(4).x=killer.x:p2(4).y=killer.y+killer.h
For n2 As Long=1 To 4
If f(Ubound(f)).InImage(p2(n2).x,p2(n2).y) Then
f(Ubound(f)).active=false
End If
Next n2
End If
Return 0
End Function
Function frame.map(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
Sub frame.showscreen(n() As frame)
Static As Long fps
Screenlock
Cls
Draw String(10,750),"FPS = "&fps
killer.show
For m As Long=1 To Ubound(n)
If n(m).active Then n(m).show
Next m
Screenunlock
Sleep regulate(60,fps)
End Sub
Sub movekiller
Static As Single dx,dy,start
If start=0 Then
dx=(Rnd-Rnd)*10
dy=(Rnd-Rnd)*10
start=1
End If
killer.x+=dx*kl
killer.y+=dy*kl
If killer.x<0 Or killer.x>1024-60 Then dx=-dx
If killer.y<0 Or killer.y>768-60 Then dy=-dy
End Sub
Function checkdone(f() As frame) As Long
For n As Long=Lbound(f) To Ubound(f)-1
If f(n).active Then Return 0
Next n
Return 1
End Function
Sub Frame.MoveByMouse(mx As Long,my As Long,button As Long,n() As frame,bx() As box)
Dim As Long x1=mx,y1=my,dx,dy,b
Dim As Long idx=x-mx,idy=y-my
Dim As Long ov
While button = 1
frame.showscreen(n())
box.checkfree(bx())
If checkdone(n()) Then this.blow(0,"WINNER"):kl()=0
Var m=irange(Lbound(bx),(Ubound(bx)-1))
If m>0 Andalso bx(m).free And Rnd >difficulty Then
Dim As box ctrf=Type(n(Ubound(n)).x+n(Ubound(n)).w/2,n(Ubound(n)).y+n(Ubound(n)).h/2)
Dim As box ctrc=Type(bx(m).x+30,bx(m).y+30)
Var ic= incircle(ctrf.x,ctrf.y,2*n(Ubound(n)).w,ctrc.x,ctrc.y)
If ic=0 Then
n(m).active=true
End If
End If
movekiller
Type<frame>.overlapped(n(),1)
box.checkfree(bx())
Getmouse mx,my,,button
If mx>0 And my>0 Then
If mx<>x1 Or my<>y1 Then
dx = mx-x1
dy = my-y1
x1 = mx
y1 = my
x=x1+dx+idx
y=y1+dy+idy
ov=this.Overlapped(n())
If ov <>0 Andalso n(ov).active Then
n(ov).active=0
this.blow(2)
Exit Sub
End If
End If
End If
Wend
End Sub
Function Frame.InImage(mx As Long,my As Long) As Long
Return mx<x+w And mx>x And my<y+h And my>y
End Function
Sub frame.destroy(f() As frame)
Erase f
Windowtitle "THE END"
End Sub
Sub frame.write(xp As Long=0,yp As Long=0,s As String)
Draw String i,(xp,yp),s
End Sub
'+++++++++++ START +++++++++++++
Const sz=60
Screen 20,32
Redim As frame f()
Redim As box bx()
Dim As Long c
For x As Long=10 To 1024-80 Step 150
For y As Long=10 To 768-80 Step 150
c+=1
Redim Preserve bx(1 To c)
Redim Preserve f(1 To c)
bx(c).x=x:bx(c).y=y:bx(c).free=0
Var colour=Rgb(Rnd*150,Rnd*150,Rnd*150)
f(c)=frame(sz,sz,colour,x,y,"box "+Str(c),true)
Next
Next
f(Ubound(f)).blow(10)
killer()=frame(sz,sz,Rgb(255,0,0),100,100,"KILLER",false)
Dim As Long mx,my,mb
kl()=1
dim as string key
Do
Getmouse mx,my,,mb
If f(Ubound(f)).InImage(mx,my) Then f(Ubound(f)).MoveByMouse(mx,my,mb,f(),bx())
movekiller
Type<frame>.overlapped(f(),1)
frame.showscreen(f())
If checkdone(f()) Then f(Ubound(f)).blow(0,"WINNER"):kl()=0
key=inkey
Loop Until key=chr(27) or key=chr(255)+"k" 'close button
frame.destroy(f())