Code: Select all
'PrimeZero's bitrunner v.50:UNLEAK-TESTED
Const palegreen = rgb(150,250,150)
Const green =rgb(50,150,50)
Const whitegrey = rgb(150,150,150)
const yellow = rgb(250,250,0)
Const cream = rgb(225,225,150)
const gold = rgb(182,144,128)
Const black = rgb(0,0,0)
Const lightblue = rgb(160,190,250)
Const blue =rgb(100,100,240)
Const lightpink = rgb(200,150,150)
Const bitcol = rgb(205,155,205)
Const bitcolnew = rgb(255,155,205)
const bitcoloth=rgb(205,155,255)
Const red = rgb(250,50,50)
const orange=rgb(180,130,130)
const white=rgb(255,255,255)
Const pi=3.1415926535
dim as integer scrx,scry
screeninfo scrx,scry
Randomize Timer
'screenres scrx,scry,,,1
Screen 18,32,,1
Type bitstype
As Single vigour , speed , cycle , guard
As Byte sign, anticipation
As Single x , y _
, oldx , oldy ,xx , yy
End Type
Type playertype
As Single x , y _
, oldx , oldy
As Integer score , tscore , pscore , ascore , rings
End Type
Type mousetype
As Integer x , y , b
End Type
Type appletype
As Integer x , y
End Type
Const maxbits = 1000
Dim Shared As playertype player
Dim Shared As mousetype mouse
Dim Shared As Integer playfieldsize
Dim Shared As Integer totbits , games
Dim Shared As Byte restart , appleexist
Dim Shared As Single modlen , modspd
Dim Shared As Single maxvig
Dim Shared As Single xaccum , yaccum , y , x
Dim Shared As appletype apple
Dim Shared As Single surtime,start
Dim Shared As Byte quit
Dim shared As Double angle, mag,speed,distance
Dim shared As Single anglex , angley
Dim shared As Integer avgx , avgy
Dim shared As Integer f
Dim Shared scoretable(2) As Any Ptr
For i As Integer = 0 To 2
scoretable(i) = ImageCreate(224,128,black )
Next
Dim Shared As Integer highscore(2)
f=Freefile
Open "high.dat" For Random As #f
For i As Integer = 0 To 2
Get #f, i*4 , highscore(i)
Next
Close
For i As Integer = 0 To 2
Bload "high"&i &".bmp", scoretable(i)
Next
Declare Sub alllogic
Declare Sub moveyourself
Declare Sub endsub
Declare Sub movebits
Declare Sub plotbits
Declare Sub plotplayer
Declare Sub setupbits
Declare Sub reinit
Declare Sub options
Declare Sub avgbittcoords( avgx As Integer , avgy As Integer )
Declare Sub apples
Declare Sub bsavehigh(i As Integer)
Declare Function checkcollision() As Byte
Declare Function checkescape As Byte
Dim Shared As String * 32 gamemode
dim Shared As bitstype bitt(maxbits)
Dim shared As Integer i,scorebox
Dim shared As Single treasure ,total
do
player.pscore=0:player.tscore=0:games=0
cls
setmouse 400,300,1
Locate 1,30
Color lightblue
? "bitrunner"
Locate 2,14
Color palegreen
? "collect and escape with as many rings as possible"
Sleep 500,1
gamemode="FREEPLAY" : totbits=19
Line (1,30)-(639,50),red,b
Locate 3,28
Color cream
? "GAME MODE:"; gamemode
Color whitegrey
Locate 5,14
? "use the mouse buttons inside the box to change game mode"
Locate 20,14
Color lightpink
? "left mouse button to continue, right to go through options"
For i As Integer = 0 To 2
Put (i*210, 344), scoretable(i)
Next
Do
getmouse mouse.x , mouse.y , , mouse.b
If mouse.y < 50 And mouse.b <> 0 Then
Select Case mouse.b
Case 1
gamemode="FREEPLAY"
Case 2
gamemode="MAXRUN"
Case 4
gamemode="SURVIVAL"
End Select
Locate 3,38
Color cream
? gamemode;" "
End If
Sleep 20
Loop Until mouse.b <> 0 And mouse.y > 50 Or multikey(1)
If mouse.b = 2 Then options
If playfieldsize < 1 Then playfieldsize = 230
If modspd < .1 Or modspd > 1 Then modspd = .1
If modlen < .1 Or modlen > 1 Then modlen = 4
If maxvig < .1 Or maxvig > 1 Then maxvig = .67
Do
setmouse 320,240,0
If gamemode="MAXRUN" Then
totbits=0
Elseif gamemode="SURVIVAL" Then
totbits=4
surtime=Timer
Else
totbits-=1
End If
alllogic
Loop Until restart=0 Or multikey(1) Or quit=-1 or restart=-2
Loop Until restart=0 Or multikey(1) Or quit=-1
For i As Integer = 0 To 2
ImageDestroy( scoretable(i) )
Next
Sub alllogic
restart = 0
appleexist=0
reinit
start = timer
Do
movebits
moveyourself
If checkcollision Then endsub
If checkescape = -1 Then endsub
plotbits
plotplayer
apples
If gamemode="SURVIVAL" Then
If timer-surtime>3 Then
totbits+=1
surtime=Timer
End If
End If
Sleep 10
Loop Until multikey(1) Or restart
End Sub
Sub moveyourself
player.oldx = player.x
player.oldy = player.y
getmouse mouse.x , mouse.y ,, mouse.b
angle = atan2( ( 240 - mouse.y ) , ( 320 - mouse.x ) )
mag = ((240-mouse.y)^2+(320-mouse.x)^2)
y = Sin(angle) * mag
x = Cos(angle) * mag
player.x-=x*.0004
player.y-=y*.0004
' angley=240-player.y 'black hole
' anglex=320-player.x
' angle = atan2( angley , anglex )
' player.y += Sin(angle)*(mag/3*.0004)
' player.x += Cos(angle)*(mag/3*.0004)
'
End Sub
Function checkescape As Byte
Return (Sqr( (player.x - 320)^2 + (player.y - 240)^2 ) > playfieldsize)
End Function
Sub endsub
scorebox=0
Sleep 200 , 1
games+=1
Locate 9,36
If checkcollision Then
Color bitcol
? "CAPTURED"
player.tscore=0
player.score=0
totbits-=1
else
Color palegreen
? "ESCAPE!"
end if
if not checkcollision then
treasure=player.rings^2+player.score*(player.score+1)*.5
Select Case gamemode
Case "FREEPLAY"
total=((totbits+treasure)*maxvig)
Case "SURVIVAL"
total=((totbits+treasure+(timer-start))*maxvig)
Case "MAXRUN"
total=totbits*maxvig
End Select
' total+=player.tscore*((player.score+1)*.03)
player.tscore+= total
player.ascore=player.tscore
If total > player.pscore Then
player.pscore = total
end if
x=0:y=0
for i = 1 to player.score
y+=20
x=20*int(y/600)
color gold
if i >player.score-player.rings then color cream
circle (x+10,(y mod 600)+10),5
next
Select Case gamemode
Case "FREEPLAY"
i = 0
totbits-=1
Case "SURVIVAL"
i = 1
Case "MAXRUN"
i = 2
End Select
Line scoretable(i) , (0,0)-(224,128),black,bf
Color whitegrey
Draw String scoretable(i), (0,scorebox), "GAME MODE: "&gamemode &"("&games &")":scorebox+=16
Color bitcol
Draw String scoretable(i), (0,scorebox), "BITS: "&totbits:scorebox+=16
if gamemode="SURVIVAL" then
Color blue
Draw String scoretable(i), (0,scorebox), "TIMER: "&int(timer-start):scorebox+=16
end if
if not gamemode="MAXRUN" then
Color cream
Draw String scoretable(i), (0,scorebox), "TREASURE: "&int(treasure):scorebox+=16
end if
Color orange
Draw String scoretable(i), (0,scorebox), "MODIFIER "&maxvig:scorebox+=16
Color palegreen
Draw String scoretable(i), (0,scorebox), "TOTAL SCORE: "&int(total):scorebox+=16
Color lightblue
Draw String scoretable(i), (0,scorebox), "PEAK SCORE: "&int(player.pscore*100)*.01:scorebox+=16
Color red
Draw String scoretable(i), (0,scorebox), "AVG SCORE: "&int(player.ascore/games):scorebox+=16
Put( 260, 170 ), scoretable(i), pset
If total > highscore(i) Then
bsavehigh(i)
? "saving.."
sleep 800
? "press button to continue"
end if
END IF
Do
getmouse mouse.x , mouse.y ,, mouse.b
If multikey(1) Then quit=-1
Sleep 1
Loop Until mouse.b=1 Or quit=-1 or mouse.b=2
restart =-1
if mouse.b=2 then restart=-2
End Sub
Function checkcollision() As Byte
For checkcol As Integer = 1 To totbits-1
With bitt(checkcol)
If Sqr((player.y - .y)^2 + (player.x - .x)^2 ) < 1 Then Return -1
End With
Next
Return 0
End Function
Sub avgbittcoords( avgx As Integer , avgy As Integer )
avgx = 0
avgy = 0
For i As Integer = 1 To totbits
avgx += bitt(i).x
avgy += bitt(i).y
Next
avgx /= totbits
avgy /= totbits
End Sub
Sub movebits
avgbittcoords(avgx , avgy)
For i = 1 To totbits
With bitt(i)
.oldx = .x
.oldy = .y
.cycle+= modspd * .sign
If Abs(.cycle) > modlen Then .sign *=-1
angley = player.y+(player.y-player.oldy)*.anticipation -.y
anglex = player.x+(player.x-player.oldx)*.anticipation -.x
angle = atan2( angley , anglex )
speed = .vigour + (.cycle * .vigour)
speed *= ( ( playfieldsize*2 - Sqr((player.x-.x)^2+(player.y-.y)^2 )) / (playfieldsize*2) )
.y += Sin(angle) * speed* .guard
.x += Cos(angle) * speed* .guard
angley = 240-( .y - avgy ) 'spread out
anglex = 320-( .x - avgx )
angle = atan2( angley , anglex )
.y -= Sin(angle) * speed* (1-.guard)
.x -= Cos(angle) * speed* (1-.guard)
for ii as integer = 1 to totbits
if ii<>i then
angley=bitt(ii).y -(.y+(.y-.oldy)) 'kinetic
anglex=bitt(ii).x -(.x+(.x-.oldx))
angle = atan2( angley , anglex )
bitt(ii).yy += Sin(angle)/(totbits^1.5)
bitt(ii).xx += Cos(angle)/(totbits^1.5)
end if
next
angley=.oldy-.y 'kinetic
anglex=.oldx-.x
angle = atan2( angley , anglex )
.y -= Sin(angle)
.x -= Cos(angle)
End With
Next
for i = 1 to totbits
bitt(i).x-=bitt(i).xx
bitt(i).y-=bitt(i).yy
bitt(i).xx=0
bitt(i).yy=0
next
End Sub
Sub plotbits
'cls
For i = 1 To totbits+1
Pset ( bitt(i).oldx , bitt(i).oldy ) , black
Next
For i = 1 To totbits
select case bitt(i).anticipation
case -1
Pset ( bitt(i).x , bitt(i).y ) , bitcoloth
case 0
Pset ( bitt(i).x , bitt(i).y ) , bitcolnew
case 1
Pset ( bitt(i).x , bitt(i).y ) , bitcol
End select
Next
End Sub
Sub plotplayer
Line (player.oldx + 1 , player.oldy + 1 ) - (player.oldx - 1 , player.oldy - 1 ) , black ,bf
Circle(player.x , player.y) , 1 , lightblue,,,,f
End Sub
Sub setupbits
For i = 1 To maxbits
With bitt(i)
angle = (Rnd*6.282)
distance = Int(Rnd * (playfieldsize*.50)) + .49 * playfieldsize
.x = 320 - (Sin(angle) * distance)
.y = 240 - (Cos(angle) * distance)
.vigour = (Rnd * maxvig) + maxvig/2
.cycle = (Rnd * (modlen*2)) - modlen
.sign = 1
.guard = Rnd*.5+.5
.anticipation=int(rnd*3)-1
End With
Next
End Sub
Sub reinit
player.rings=0
player.x = 320 : player.y = 240
Cls
Circle (320,240), playfieldsize, green
setupbits
End Sub
Sub options
Do
Sleep 1
Loop Until Inkey = ""
Input "playfield size, default 200";playfieldsize
Input "bitt variance speed, 1 (slow) to 10 (erratic), default is 5";modspd
modspd *=.01
Input "bitt variance length, 1 (consistent) to 10 (predictable), default is 5"; modlen
modlen *=.1
Input "bitt overall speed, 1 (slow) to 10 (fast), default is 3";maxvig
maxvig *=.1
End Sub
Sub apples
If appleexist = 0 Then
do
angle = Rnd * pi*2
mag = (Rnd*playfieldsize)-playfieldsize*.1
apple.x = 320-Sin(angle)*mag
apple.y = 240-Cos(angle)*mag
loop until sqr((apple.x-player.x)^2+(apple.y-player.y)^2) > sqr((player.y-player.oldy)^2+(player.x-player.oldx)^2) or multikey(1)
appleexist = -1
Circle (apple.x,apple.y),5,cream
If gamemode<>"SURVIVAL" Then totbits+=1
End If
If Sqr((player.x-apple.x)^2+(player.y-apple.y)^2) < 6 Then
appleexist = 0
Circle (apple.x,apple.y),5,black
player.score+=1
player.rings+=1
End If
End Sub
Sub bsavehigh(i As Integer)
Bsave "high"&i &".bmp", scoretable(i)
highscore(i)=player.pscore
f = Freefile
Open "high.dat" For Random As #f
Put #f, i*4 , highscore(i)
Close
End Sub