Code archives/Graphics/Game of Brutal Koloboks

This code has been declared by its author to be Public Domain code.

Download source code

Game of Brutal Koloboks by Matt Merkulov2007
From article: Making 2D engine (rus)
Image used:
'Game of Brutal Koloboks by Matt Merkulov

'Controls:
'WASD - move protagonist
'Mouse - move target
'Left mouse button - fire
'Right mouse button - Force
'Mouse wheel - zoom
'Space - teleport

Framework brl.glmax2d ' Base module - an engine based on OpenGL
Import brl.random ' Generator of random numbers
Import BRL.Basic ' From this module command Incbin is used
Import BRL.PNGLoader ' Loading of PNG images

Incbin "new_images.png" ' It is for keeping image in an exe

Const sxsize = 800, sysize = 600, color_depth = 32 ' Resolution of the screen and depth of color

Const tilesize = 64 ' the size of the tile / sprite

' Auxiliary constants
Const tilesize2 = tilesize / 2, tilesize4 = tilesize / 4, tilesize8 = tilesize / 8
Const tilesize16 = tilesize / 16, tilesize32 = tilesize / 32

Const sxsize2 = sxsize / 2, sysize2 = sysize / 2
Const sxsize4 = sxsize / 4, sxsize34 = sxsize * 3 / 4
Const sysize34 = sysize * 3 / 4, sxsize24 = sxsize / 2 -4

Const fxsize = 160, fysize = 120 ' Size of a field in tiles
Const fblurq = 5 ' Blur passes quantity for temporarily generated auxiliary heightmap of a field
Const sand_threshold# = 0.4, grass_threshold# = 0.5 ' Thresholds of height for sand and grass
Global fdx#, fdy# ' Shift of a displayed part of a field

Const kolobokq = 500 ' Wild koloboks
Global speedpersec# = 1.0 ' Modifier of speed (tiles / se?)
Global angpersec# = 90.0 ' Modifier of angular speed (degrees / se?)

Global sc# = 1.0, tilesc# ' Magnification in pixels and tiles
Global dtim# ' Time of processing of the previous cycle
Global timspeed# ' Modifier for moving depending on dtim#
Global timang# ' the Modifier for turn depending on dtim#
Const minms = 100 ' Maximum seconds for cycle
Const cam_speed# = 2.0 ' Relative speed of reaction of the camera on mouse movements
Const magn_speed# = 2.0 ' Relative speed of reaction of scale on mouse wheel rotation 
Global camx#, camy# ' Current coordinates of the camera

Global layer_order:TList = CreateList()' List of displayed layers in order of appearance
Global actingobj:TList = CreateList()' List for active objects

Const showcollisions = False ' Display of collisions(now switched off)
Global ccnt, objcnt, chcnt ' Counters of collisions, objects, checks of collisions per second

Const force_reload_time = 7000, force_power# = 3.0 ' Time of Force "reloading", its power
Global force_time = 1000, force_radius# = 5.0 ' Time of action of Force, radius of action
Global force_reload, force_effect ' Time of "reload"'s end and effect of Force

Const fireable_percent = 25 ' Percent of fireable ground koloboks
Const min_fire_distance# = 7.0 ' Minimal distance of firing
Const min_enemy_distance = 20 ' Minimal distance up to the enemy in the beginning of game

Const constant_bonustypeq = 7, temporary_bonustypeq = 5 ' Quantity of constant and temporary bonuses
Const constant_bonus_crateq = 10 ' Quantity of crates with constant bonuses (for every)
Const temporary_bonus_crateq = 100 ' Quantity of crates with temporary bonuses
Const empty_crates_percent = 30 ' Percent of empty crates
Const crate_bits_packq = 4 ' Quantity of variants of pieces of a box
Const bonustypeq = constant_bonustypeq + temporary_bonustypeq

' Constant bonuses
Const BONUS_BULLET_DAMAGE = 0 ' Increase damage of bullets
Const BONUS_BULLET_SPEED = 1 ' Increase the speed of bullets
Const BONUS_BULLET_LIFETIME = 2 ' Increase in time of a life of a bullet
Const BONUS_RELOAD_TIME = 3 ' Reduction of intervals between shots
Const BONUS_MAX_HEALTH = 4 ' Increase maximal quantity of health
Const BONUS_SPEED = 5 ' Increase player's speed
Const BONUS_ESOURCE = 6 ' Energy sources (it is necessary to collect all for finishing of game)
Global esource_collected, light

' Time(Temporary)bonuses
Const bonus_threshold = constant_bonustypeq
Const BONUS_HEALTH = bonus_threshold + 0 ' Health
Const BONUS_TEMPORARY_FIREPOWER = bonus_threshold + 1 ' Temporary increase fire power
Const BONUS_BOMB = bonus_threshold + 2 ' Bomb!
Const BONUS_TEMPORARY_SPEED = bonus_threshold + 3 ' Temporary acceleration
Const BONUS_TEMPORARY_INVULNERABILITY = bonus_threshold + 4 ' Temporary invulnerability

Global temporary_firepower, temporary_speed, temporary_invulnerability ' Time of the termination(ending)of action of bonuses

Const fading_time = 1000, damage_time = 400 ' Time of "fading out", "reddening" from damages
Const NOT_YET = 1000000000, INDESTRUCTIBLE = 1000000000 ' Constants "has not died yet", "indestructible"

Const TM_IDLE = 0 ' Playng as usually
Const TM_READY = 1 ' Preparing for teleportation (waiting)
Const TM_DECREASING = 2 ' Decreasing
Const TM_ENLARGING = 3 ' Growing on a new place
Global teleport = NOT_YET, teleport_mode = TM_IDLE ' Time of the ending of a cycle of teleportation mode
Const teleport_ready_time = 5000 ' Time of preparation for teleportation
Const max_teleport_radius = 50 ' Maximal distance in tiles for teleportation

Type layer_obj Abstract
	Field collision_with:TList = CreateList()' List of layers, with which this layer collides

	Method collides_with(layer:layer_obj)
		If tile_layer_obj(layer) Then RuntimeError "Tile layers cannot collide - use tile collision layer"
		collision_with.addlast layer
	End Method

	Method draw()
	End Method
End Type

Const TILE_DONT_DRAW = -1
Type tile_layer_obj Extends layer_obj
	Field image:TImage ' Images for tiles
	Field frame[fxsize, fysize]' Number of tile for each cell

	Method collides_with(layer:layer_obj)
		RuntimeError "Tile layers cannot collide -use tile collision layer"
	End Method

	Function add:tile_layer_obj(tile_image:TImage, clearing = True) ' Adding tile layer
		l:tile_layer_obj = New tile_layer_obj
		l.image = tile_image
		If clearing Then
			For y = 0 Until fysize ' Installation "do not draw tile" for all cells
				For x = 0 Until fxsize
					l.frame[x, y] = TILE_DONT_DRAW
				Next
			Next
		End If
		layer_order.addlast l ' Adding layer in the list of displayed ones
		Return l
	End Function

	Method draw()' Drawing layer
		SetScale tilesc#, tilesc# 
		scr2field 0, 0, x1#, y1# 
		scr2field sxsize - 1, sysize - 1, x2#, y2# 

		xx1 = Max(0, Floor(x1#)) ' Determining what part of field is currently visible on screen
		xx2 = Min(Ceil(x2#), fxsize - 1)
		yy1 = Max(0, Floor(y1#))
		yy2 = Min(Ceil(y2#), fysize - 1)

		For y = yy1 To yy2
			For x = xx1 To xx2
				If frame[x, y] >= TILE_DRAW Then ' Check, whether it is necessary to draw tile
					field2scr x, y, sx#, sy# 
					DrawImage image, sx#, sy#, frame[x, y]
				End If
			Next
		Next
	End Method
End Type

Type tile_collision_layer_obj Extends layer_obj
	Field collision[fxsize, fysize] ' Collision with tile ("solid" / "hologram")

	Function add:tile_collision_layer_obj()
		Return New tile_collision_layer_obj
	End Function
End Type

Type object_layer_obj Extends layer_obj
	Field objects:TList[fxsize, fysize]' the List of objects for each cell, being on it

	Function add:object_layer_obj()
		l:object_layer_obj = New object_layer_obj
		For y = 0 Until fysize ' Initialization of lists
			For x = 0 Until fxsize
				l.objects[x, y] = CreateList()
			Next
		Next
		layer_order.addlast l
		Return l
	End Function

	Method draw()
		scr2field 0, 0, x1#, y1# 
		scr2field sxsize - 1, sysize - 1, x2#, y2# 

		xx1 = Max(0, Floor(x1# -0.5))
		xx2 = Min(Floor(x2# + 0.5), fxsize - 1)
		yy1 = Max(0, Floor(y1# -0.5))
		yy2 = Min(Floor(y2# + 0.5), fysize - 1)

		For y = yy1 To yy2
			For x = xx1 To xx2
				For o:base_obj = EachIn objects[x, y]
					o.draw
				Next
			Next
		Next
		reset_transformations
	End Method
End Type

Const CT_IMMATERIAL = 0 ' Type of collision model - non - material
Const CT_CIRCULAR = 1 ' Type of collision model - a circle
Const CT_SQUARE = 2 ' Type of collision model - a square
' Base type for objects
Type base_obj
	Field x#, y#, size# = 1, angle# ' Coordinates, size(in tiles), an angle of object sprite's turn
	Field speed# ' Speed of object (tiles / sec)
	Field moving_angle# ' Current angle of movement
	Field r = 255, g = 255, b = 255 ' Color of object (by default white)
	Field image:TImage, frame ' Image for object
	Field tilex, tiley ' Coordinates of tile on which this object being on 
	Field act_link:TLink, tile_link:TLink ' References to this object from lists of active objects and objects of a tile
	Field layer:object_layer_obj ' Layer of object
	Field coll_type = CT_CIRCULAR, radius# = 0.5 ' Type of collision model and its radius
	Field health# ' Health of object
	Field death = NOT_YET, damage_end ' Time of death (it is not defined yet), time of the ending of "reddening"

	Const ONLY_ON_GROUND = True ' Constant for accommodation of object only on a land
	Method place_find(onlyonground = False)' Search of a place for accommodation of object
		Repeat
			x = Rnd(1.0, fxsize - 1.01)
			y = Rnd(1.0, fysize - 1.01)
			tilex = Floor(x)
			tiley = Floor(y)
			' Definition of kolobok's groundness / waterness
			If layer_sand.collision(tilex, tiley) Then layer = layer_ground_koloboks Else layer = layer_water_koloboks
			' Check of a finding on a land (for accommodation only on a land) and on absence of collisions
			If layer = layer_ground_koloboks Or onlyonground = False Then If Not collision(x#, y#) Then Exit
		Forever
	End Method

	Method random_color()' Definnig random (but not so dark) color for object
		Repeat
			r = Rand(0, 255)
			g = Rand(0, 255)
			b = Rand(0, 255)
		Until r + g + b >= 255
	End Method

	Const ACTIVE = True, INACTIVE = False
	Method register(acting = ACTIVE)' Registration of object in lists
		tilex = Floor(x#)
		tiley = Floor(y#)
		tile_link = layer.objects(tilex, tiley).addlast(Self)' Registration in the list of objects of a cell (tile)
		If acting Then act_link = actingobj.addlast(Self)' Registration in the list of active objects
		objcnt:+1
	End Method

	Method draw()' Drawing of object
		field2scr x#, y#, sx#, sy# 
		SetScale size# * tilesc#, size# * tilesc# 
		SetRotation angle# 

		dmg = damage_end - MilliSecs() ' "Reddening" from damages
		If dmg > 0 Then
			k1# = 1.0 * dmg / damage_time; k2# = 1.0 - k1# 
			SetColor k1# * 255 + k2# * r, k2# * g, k2# * b
		Else
			SetColor r, g, b ' Setting natural color
		End If

		If death = NOT_YET Then
			SetAlpha 1 ' If yet has not started to disappear, opaque
		Else
			SetAlpha limit(.001* (death - MilliSecs()), 0, 1)' Else disappear...
			If death < MilliSecs() Then destroy ' And in the end it is destroyed absolutely
		End If

		If Self = player Then
			If temporary_firepower > MilliSecs() Then
				col = 191 + 64 * Sin(MilliSecs()) ' Flickering yellow color of the player with fire power
				SetColor col, col, 0
			End If
			If temporary_invulnerability > MilliSecs() Then SetAlpha 0.5 ' half-transparency of invulnerable
			Select teleport_mode
				Case TM_READY; SetAlpha 0.75 + 0.25 * Sin(MilliSecs())' Cyclic change of a transparency during preparation for teleportation
				Case TM_DECREASING; s# = sc# * size# / tilesize * Max(0.0, 1.0* (teleport - MilliSecs()) / fading_time); SetScale s#, s# ' Reduction
				Case TM_ENLARGING; s# = sc# * size# / tilesize * Min(1.0, 1.0 - 1.0* (teleport - MilliSecs()) / fading_time); SetScale s#, s# ' Occurrence in a new place
			End Select
		End If

		DrawImage image, sx#, sy#, frame
	End Method

	Method move(newx#, newy#)' Correct moving
		newtilex = Floor(newx#)
		newtiley = Floor(newy#)
		If tilex <> newtilex Or tiley <> newtiley Then ' If the object has moved to other cell, 
			RemoveLink tile_link ' Remove it from the list of an old cell
			tilex = newtilex
			tiley = newtiley
			tile_link = layer.objects[tilex, tiley].addlast(Self) ' Register in the list of new cell
		End If
		x# = newx#
		y# = newy#
	End Method

	Method try_move(newx#, newy#)
		If Not collision(newx#, newy#) Then move newx#, newy#; Return True
	End Method

	Method try_move_ang(ang#, spd#, ma_change = False)
		If try_move(x# + timspeed# * Cos(ang#) * spd#, y# + timspeed# * Sin(ang#) * spd#) Then
			If ma_change Then moving_angle# = ang# 
			Return True
		End If
	End Method

	Method collision2(o:base_obj, newx#, newy#)' Check of object on collision with another
		Select True
			Case coll_type = CT_CIRCULAR ' If model of the given object - a circle
				Select True
					Case o.coll_type = CT_CIRCULAR ' And model of the second object - a circle too (a circle with circle)
						dx# = newx# -o.x# 
						dy# = newy# -o.y# 
						' Checking, whether distance between objects, than the sum of their radiuses there is less
						If Sqr(dx# * dx# + dy# * dy#) < o.radius# + radius# Then ccnt:+1; Return True
					Case o.coll_type = CT_SQUARE ' And if model of the second object - a square (a circle with a square)
						If(o.x# - o.radius# <= newx# And newx# <= o.x# + o.radius#) Or (o.y# - o.radius# <= newy# And newy# <= o.y# + o.radius#) Then
							dx# = Abs(newx# -o.x#)
							dy# = Abs(newy# -o.y#)
							sumr# = o.radius# + radius# 
							If dx# < sumr# And dy# < sumr# Then ccnt:+1; Return True
						Else
							dx# = Min(Abs(newx# -o.x# -o.radius#), Abs(newx# -o.x# + o.radius#))
							dy# = Min(Abs(newy# -o.y# -o.radius#), Abs(newy# -o.y# + o.radius#))
							If Sqr(dx# * dx# + dy# * dy#) < radius# Then ccnt:+1; Return True
						End If
					Default ' But here if the second object is non - material - collision is not present
						Return False
				End Select
			Case coll_type = CT_SQUARE ' If model of the given object - a square
				If o.coll_type = CT_SQUARE Then ' And model of the second object - a square too
					dx# = Abs(newx# -o.x#)
					dy# = Abs(newy# -o.y#)
					sumr# = o.radius# + radius# 
					' Checking, whether according coordinate difference is less than the sum of radiuses
					If dx# < sumr# And dy# < sumr# Then ccnt:+1; Return True
				Else ' Else we check collision of the second object with given (interchange the position)
					Return o.collision2(Self, newx#, newy#)
				End If
			Default ' Non - material object do not collide
				Return False
		End Select
	End Method

	Method collision(newx#, newy#) ' Check of the given object on collision with something
		' Collision with borders of a field (it will complicate other checks, therefore we leave)
		If newx# < 1.0 Or newy# < 1.0 Or newx# >= fxsize - 1.0 Or newy# >= fysize - 1.0 Then
			boundaries_collision_act
			Return True
		End If
		For l:layer_obj = EachIn layer.collision_with ' Cycle on all layers of a collision
			tl:tile_collision_layer_obj = tile_collision_layer_obj(l)
			If tl Then ' If it's a tile collison layer, 
				For yy = Floor(newy# -radius#)To Floor(newy# + radius#)
					For xx = Floor(newx# -radius#)To Floor(newx# + radius#)
						If tl.collision(xx, yy) Then
							tile_object.x# = xx + 0.5
							tile_object.y# = yy + 0.5
							If collision2(tile_object, newx#, newy#) Then collided = True; tile_collision_act xx, yy
						End If
					Next
				Next
			Else ' Else it's object layer
				ol:object_layer_obj = object_layer_obj(l)
				x2 = Floor(newx#)
				y2 = Floor(newy#)
				For yy = y2 - 1 To y2 + 1
					For xx = x2 - 1 To x2 + 1
						For o:base_obj = EachIn ol.objects[xx, yy]
							If Self <> o Then
								chcnt:+1
								If showcollisions Then ' Displaying checks of collisions by lines
									field2scr o.x#, o.y#, sx1#, sy1# 
									field2scr newx#, newy#, sx2#, sy2# 
									DrawLine sx1#, sy1#, sx2#, sy2# 
								End If
								If collision2(o, newx#, newy#) Then collided = True; object_collision_act o
							End If
						Next
					Next
				Next
			End If
		Next
		Return collided
	End Method

	Method act()' Actions of objects
	End Method

	Method object_collision_act(o:base_obj)' Actions at collision with objects
	End Method

	Method tile_collision_act(xx, yy)' Actions at collision with "solid" tiles
	End Method

	Method boundaries_collision_act()' Actions at collision with borders of a map
	End Method

	Method damage(amount#)' Taking damage
		If death < NOT_YET Then Return ' If it's already disappearing then leaving
		If health# = INDESTRUCTIBLE Then Return ' If basically it is indestructive, then leaving too
		If Self = player And temporary_invulnerability > MilliSecs() Then Return ' If it is temporarily indestructive - leaving
		health# = health# -amount# ' we Reducing health
		damage_end = damage_time + MilliSecs()' Settng "reddening"
		If health <= 0 Then ' If health on zero, 
			death = fading_time + MilliSecs()' Object starts to disappear
			' the Crate disappears at once, the others become non - material
			If crate_obj(Self) = Null Then coll_type = CT_IMMATERIAL Else death = 0
		End If
	End Method

	Method destroy()' Correct destruction of object
		If act_link <> Null Then RemoveLink act_link ' Removing object from the list of active ones
		RemoveLink tile_link ' Removing object from the list of cell's objects
		objcnt:-1
	End Method
End Type

Global tile_object:base_obj = New base_obj
tile_object.radius# = 0.5
tile_object.coll_type = CT_SQUARE

' Base type for koloboks
Type kolobok_obj Extends base_obj
	Field bullet_reload, bullet_reload_time ' Time of the reload's ending , reload time
	Field bullet_speed#, bullet_lifetime = 2000 ' Speed and time of a life of a bullet of this kolobok
	Field bullet_damage# ' Damage of a bullet
	Field max_health# = 1 ' Maximal health
	Field bite_damage#, bite_reload ' Damage from a bite and time of an opportunity of a following bite
	Field bite_reload_time, bite ' Interval between bites, an auxiliary flag

	Function create:kolobok_obj()' Creation of wild kolobok
		o:kolobok_obj = New kolobok_obj
		o.random_color
		o.image = kolobok
		o.moving_angle# = Rnd(0, 360)
		If Rand(1, 100) > fireable_percent And o.frame = 1 Then ' Parameters for not able to shoot
			o.bullet_reload = 1000000000
			o.bullet_reload_time = 1000
			o.bullet_lifetime = 0
			o.bullet_damage# = 0
			o.bullet_speed# = 0
		Else ' Parameters for able to shoot
			o.bullet_reload_time = Rand(300, 1000)
			o.bullet_lifetime = Rand(1000, 4000)
			o.bullet_damage# = Rnd(1, 5)
			o.bullet_speed# = Rnd(0.5, 1.5)
		End If
		o.max_health = Rand(50, 200)
		o.health = o.max_health
		o.bite_damage# = Rnd(4, 12)
		o.bite_reload_time = Rand(200, 500)
		' Calculation of the size and speed on set of parameters
		o.size# = (o.max_health - 50) / 150.0 + o_bullet_speed# / 1.5 + o.bullet_lifetime / 4000.0
		o.size# :+o.bullet_damage# / 5.0 + (o.bite_damage# -4.0) / 8.0 + (500 - o.bite_reload_time) / 300.0
		o.size# :+(1000.0 - o.bullet_reload_time) / 1000.0
		o.size# = limit(o.size / 7.0 * 1.0 + 0.25, 0, 1.0)
		o.speed# = (1.25 - o.size#) * 2
		o.radius# = 0.4 * o.size# 
		o.place_find
		o.frame = (o.layer = layer_ground_koloboks)' For water koloboks - 0, for ground - 1
		o.register
		Return o
	End Function

	Method draw()' Drawing kolobok
		super.draw
		bar_draw
	End Method

	Method bar_draw()' Drawing of a strip of health
		field2scr x#, y#, sx#, sy# 
		barsize = 1.0 * size# * sc# ' Setting length (depending on the kolobok's size in pixels)
		If barsize > 4 And max_health <> health Then
			barsize2 = barsize / 2
			barheight = limit(Floor(max_health / 50) + 1, 1, 6)' Setting height depending on a maximum of health
			SetRotation 0
			SetScale 1, 1
			SetGrayColor 255
			k# = 1.0 * health / max_health
			DrawEmptyRect sx# -barsize2, sy# -barsize2 - 6, barsize - 1, barheight + 2
			SetColor 255* (1.0 - k#), 255 * k#, 0 ' Setting color: closer to a maximum - green, closer to 0 - red
			DrawRect sx# -barsize2 + 1, sy# -barsize2 - 5, k# * (barsize - 2), barheight
		End If
	End Method

	Method act()' Kolobok's actions
	If death < NOT_YET Then Return ' If kolobok disappearing, he will be idle

	angle# = ATan2(player.y - y#, player.x - x#)' the angle of "prompting" on the player

	If force_effect > MilliSecs() Then ' Calculating distance up to the player if Force works
		rad# = Sqr((player.x# -x#) * (player.x# -x#) + (player.y# -y#) * (player.y# -y#))
	Else
		rad# = 10000
	End If
	If rad# <= force_radius# Then ' If the distance up to the player is less than radius of action of Force, 
		' Trying to move away from the player
		try_move_ang angle# + 180.0, force_power# * Sin(90.0* (force_radius# -rad#) / force_radius#)
	Else
		' Else calculating, in what side to rotate
		dang# = calc_dangle(moving_angle#, angle# + 180* (temporary_firepower > MilliSecs()))
		' Also trying to move after turning
		If Not try_move_ang(moving_angle# + timang# * (1 - 2 * (dang# < 0)), speed#, True) Then
			' If move was not possible, 
			If bite Then ' If it is possible to bite, we'll stand and bite...
				moving_angle# = angle# 
				bite = False
			Else ' If it is impossible, we'll try make a sidestep
				If Not try_move_ang(moving_angle# + 90.0* (1 - 2 * Rand(0, 1)), speed#, True) Then
					' If it is impossible, we'll try to step in another side
					If Not try_move_ang(moving_angle# + 180.0, speed#, True) Then moving_angle# = Rnd(0.0, 360.0)
						' If we have absolutely clamped, next time we shall try a random angle
					End If
				End If
			End If
		End If

		If bullet_reload < MilliSecs() Then ' If time has come to shoot
			' And distance up to the player is less than maximal
			If Sqr((player.x# -x#) * (player.x# -x#) + (player.y# -y#) * (player.y# -y#)) <= min_fire_distance# Then
				' Creating the list and insert there all of nearby water koloboks
				near:TList = nearly_objects(CreateList(), tilex, tiley, 2, layer_water_koloboks)
				' And also ground ones
				near = nearly_objects(near, tilex, tiley, 2, layer_ground_koloboks)
				' But delete current kolobok and the player
				near.remove player
				near.remove Self
				' Because we shall check, whether there is another kolobok on a way of the bullet which have been released in the player
				For o:base_obj = EachIn near
					If kolobok_obj(o) Then
						' Calculating angle between a vector of a shot and a vector from center of shooting to center of checked kolobok
						dang# = Abs(calc_dangle(ATan2(y# -o.y#, x# -o.x#), ATan2(y# -player.y#, x# -player.x#)))
						' Checking is radius of kolobok is not less than length of an arch
						If Pi * Sqr((x# -o.x#) * (x# -o.x#) + (y# -o.y#) * (y# -o.y#)) * dang# / 180.0 < o.radius Then Return
					End If
				Next
				' If there are no koloboks on a way of a shot - firing safely 
				fire
			End If
		End If
	End Method

	Method object_collision_act(o:base_obj)
		If o = player Then ' Checking, if current kolobok have collided with the player
			If bite_reload < MilliSecs() Then ' If we are ready to bite
				player.damage(bite_damage)' Then bite
				bite_reload = MilliSecs() + bite_reload_time
			End If
			bite = True ' This flag shows, that we have seized the player and then we can stand at current place
		End If
	End Method

	Method fire()
		' The amendment for the speed at temporary acceleration
		If Self = player And temporary_speed > MilliSecs() Then spd# = 6.0 Else spd# = speed# 
		If Self = player And temporary_firepower > MilliSecs() Then ' Shooting with firepower
			bullet_obj.create x#, y#, 0.75, angle#, 4.0 + spd#, 2000, 25, Self, 0.5 * 0.3, r, g, b
			bullet_reload = MilliSecs() + 40
		Else ' Shooting in usual mode
			bullet_obj.create x#, y#, 0.5 * size#, angle#, bullet_speed# + spd#, bullet_lifetime, bullet_damage, Self, size# * 0.3, r, g, b
			bullet_reload = MilliSecs() + bullet_reload_time
		End If
	End Method

End Type

' the Player
Type player_obj Extends kolobok_obj
	Function create:player_obj()
		o:player_obj = New player_obj
		o.x# = 0.5 * fxsize ' Placing the player in the center of the field
		o.y# = 0.5 * fysize
		o.size# = 0.75
		o.radius# = 0.4 * o.size
		o.image = kolobok
		o.frame = 2
		o.speed# = 2.0
		o.bullet_reload_time = 450
		o.bullet_speed# = 1.0
		o.bullet_damage# = 2.5
		o.max_health# = 300
		o.health# = o.max_health# 
		o.layer = layer_ground_koloboks
		Repeat ' Moving the player to the right until he will not stand completely on a land and uncollided
			o.x:+0.5
		Until Not o.collision(o.x#, o.y#)
		o.register
		Return o
	End Function

	Method act()' Actions of the player
		If death < NOT_YET Then Return ' If we have already defeated, we're idle
		If teleport_mode = TM_IDLE Then ' If currently we're not teleportating 
			If KeyHit(KEY_SPACE) Then ' If the space key is pressed
				If Sqr(targetx# * targetx# + targety# * targety#) <= max_teleport_radius Then ' And the distance is not more than maximum
					If Not collision(player.x# + targetx#, player.y# + targety#) Then ' And also in a place of occurrence there are no collisions
						teleport_mode = TM_READY ' That we prepare for teleportation
						teleport = MilliSecs() + teleport_ready_time ' Setting time of next stage
					End If
				End If
			End If
		Else
			If teleport <= MilliSecs() Then ' If the cycle has come to the end, 
			teleport_mode = teleport_mode + 1 ' Passing to the following
			teleport = MilliSecs() + fading_time ' Setting time of a next cycle
			If teleport_mode = TM_ENLARGING And Not collision(player.x# + targetx#, player.y# + targety#) Then
				move player.x# + targetx#, player.y# + targety# ' It is moved to a point of teleportation after reduction
				fdx2# = fdx2# -targetx# 
				fdy2# = fdy2# -targety# 
				targetx# = 0
				targety# = 0
			ElseIf teleport_mode > TM_ENLARGING Then ' If the cycle of increasing is completed
				teleport_mode = TM_IDLE ' that we reset teleportation mode
			End If
		End If
		Return ' At teleportation it is necessary to stand quietly, therefore we leave a method
	End If

	If bullet_reload < MilliSecs()And MouseDown(1) Then fire ' If time to shoot have approached and fire key is pressed then fire
	
	If MouseDown(2)And force_reload <= MilliSecs() Then ' Using Force if the button is pressed and kolobok is ready
		force_reload = force_reload_time + MilliSecs()
		force_effect = force_time + MilliSecs()
	End If
	If force_effect > MilliSecs() Then size# = 0.75 + 0.5* (force_effect - MilliSecs()) / force_time Else size# = 0.75 ' "Swelling" from Force

	mov = False ' Calculating angle of a vector of movement, based on the pressed keys
	If KeyDown(KEY_S) Then ang2# = 90.0; mov = True
	If KeyDown(KEY_W) Then ang2# = -90.0; mov = True
	' If one of the previous keys is pressed - we'll modify an angle depending on previous value
	If KeyDown(KEY_A) Then ang2# = 180.0 - 0.5 * ang2#; mov = True
	If KeyDown(KEY_D) Then ang2# = 0.5 * ang2#; mov = True
	
	If Not mov Then Return ' If we are standing, there is nothing more to do
	
	' Modifier of speed for temporary acceleration
	If temporary_speed > MilliSecs() Then spd# = 6.0 Else spd# = speed# 
		' If there are no collisions, move
		try_move_ang ang2#, spd# 
	End Method

	Method destroy()
		' They kicked us well, so we shout
		Notify"AAAAAAAAAAAAAA!!! Whyyyyy???!!!"
		End
	End Method

	Method object_collision_act(o:base_obj)
		' If we have collided with a bonus and it is not taken yet - we'll take it
		bo:bonus_obj = bonus_obj(o)
		If bo Then If bo.death = NOT_YET Then bo.get
	End Method
End Type

' the Bullet
Type bullet_obj Extends base_obj
	Field parent:base_obj, damage# ' the Index on shooting and factor of damage

	' Creating a bullet
	Function create:bullet_obj(bx#, by#, bsize#, bangle#, bspeed#, blifetime, bdamage#, bparent:base_obj = Null, d# = 0, br = 255, bg = 255, bb = 255)
		bul:bullet_obj = New bullet_obj
		bul.layer = layer_bullets
		bul.x# = bx# + Cos(bangle#) * d# ' Displacement otn.The given coordinates
		bul.y# = by# + Sin(bangle#) * d# 
		bul.r = br
		bul.g = bg
		bul.b = bb
		bul.image = bullet
		bul.parent = bparent
		bul.angle# = bangle# 
		bul.size# = bsize# 
		bul.speed# = bspeed# 
		bul.radius = bsize# * 0.25
		bul.death = MilliSecs() + blifetime
		bul.damage# = bdamage# 
		bul.register
	End Function

	Method act()' Works simply - bullet flies forward before collision
		move x# + timspeed# * Cos(angle#) * speed#, y# + timspeed# * Sin(angle#) * speed# 
		collision x#, y# 
		If MilliSecs() > death Then destroy ' Time of a life is limited from occurrence
	End Method

	Method object_collision_act(o:base_obj)' Damage of the met object (except shooter)
		If o <> parent Then
			ccnt:+1
			o.damage(damage)
			destroy
		End If
	End Method
	
	Method boundaries_collision_act()' It is destroyed at collision with borders
		destroy
	End Method
End Type

Type crate_obj Extends base_obj
	Field bonus_type ' Type of a bonus inside

	Function create:crate_obj(b_type)
		o:crate_obj = New crate_obj
		o.image = crate
		o.place_find ONLY_ON_GROUND
		o.bonus_type = b_type
		o.coll_type = CT_SQUARE
		o.health = 10
		If o.speed >= bonustypeq Then o.speed = -1
		o.register INACTIVE
	End Function

	Method destroy()' Explosion of a crate
		If bonus_type >= 0 Then bonus_obj.create x#, y#, bonus_type ' Creation of a bonus on its place

		offset = Rand(0, crate_bits_packq - 1) * 16 ' the random choice of a package of slices
		For yy = 0 To 3 ' Creation of 16 scattering slices
			For xx = 0 To 3
				o:crate_bits_obj = New crate_bits_obj
				o.dx# = Rnd(-1.0, 1.0) + xx - 1.5
				o.dy# = Rnd(-1.0, 1.0) + yy - 1.5
				o.x# = x# + 0.125* (xx * 2 - 3)
				o.y# = y# + 0.125* (yy * 2 - 3)
				o.image = crate_bits
				o.frame = xx + yy * 4 + offset
				o.layer = layer_top_scenery
				o.death = 2000 + MilliSecs()
				o.register
			Next
		Next
	
		super.destroy ' Destruction of crate object - calling procedure from base_obj
	End Method

End Type

Type crate_bits_obj Extends base_obj
	Field dx#, dy# ' Increments for movement

	Method act()' Bits simply flying for 2 seconds
		x# = x# + dx# * timspeed# 
		y# = y# + dy# * timspeed# 
	End Method
End Type

Type bonus_obj Extends base_obj
	Field dangle#, rotation_period!, pulsing_period! ' Variables for pulsing / tilting

	Function create:bonus_obj(x#, y#, b_type)
		o:bonus_obj = New bonus_obj
		o.x = x# 
		o.y = y# 
		o.image = bonus
		o.frame = b_type
		o.health = INDESTRUCTIBLE ' Bonus can not be destroyed
		o.dangle# = Rnd(5, 30)
		o.rotation_period! = Rnd(0.5, 0.1)
		o.pulsing_period! = Rnd(0.5, 0.1)
		o.layer = layer_ground_koloboks
		o.register
	End Function

	Method draw()
		angle# = dangle# * Sin(rotation_period! * MilliSecs())' Angle variations
		size# = 0.8 + 0.2 * Sin(pulsing_period! * MilliSecs())' Size variations
		super.draw
	End Method

	Method get()' We taking bonus
		' Constant bonuses change characteristics to the value depending
		' on quantity of such bonuses on a map (if to collect all bonuses characteristics will change
		' from initial up to the fixed value, they are specified in comments)
		Select frame
			Case BONUS_BULLET_DAMAGE; player.bullet_damage:+10.0 / constant_bonus_crateq ' 2.5 - 12.5
			Case BONUS_BULLET_SPEED; player.bullet_speed:+3.0 / constant_bonus_crateq ' 1.0 - 4.0 tiles / se?
			Case BONUS_BULLET_LIFETIME; player.bullet_lifetime:+3000 / constant_bonus_crateq ' 2 - 5 se?
			Case BONUS_RELOAD_TIME; player.bullet_reload_time:-400 / constant_bonus_crateq ' 0.5 - 0.1 se?
			Case BONUS_MAX_HEALTH; player.max_health:+500.0 / constant_bonus_crateq; player.health = player.max_health ' 300 - 800
			Case BONUS_SPEED; player.speed:+2.0 / constant_bonus_crateq ' 2.0 - 4.0 tiles / se?
			Case BONUS_HEALTH
				If player.health = player.max_health Then Return ' If we have full health - we do not take a bonus
				player.health = limit(player.health + 0.15 * player.max_health, 0, player.max_health) ' + 15% from a maximum
			Case BONUS_TEMPORARY_FIREPOWER; temporary_firepower = MilliSecs() + 10000 ' 10 seconds of firepower
			Case BONUS_TEMPORARY_SPEED; temporary_speed = MilliSecs() + 15000 ' 15 seconds of acceleration
			Case BONUS_TEMPORARY_INVULNERABILITY; temporary_invulnerability = MilliSecs() + 20000 ' 20 seconds of invulnerability
			Case BONUS_BOMB
				For n1 = 2 To 4 ' Generation of splinters of a bomb
					n2 = 0
					While n2 < 360
						bullet_obj.create x#, y#, 1, n2, n1, (5 - n1) * 800, 35, player, player.size# * 0.4
						n2 = n2 + 10* (n1 - 1)
					Wend
				Next
			Case BONUS_ESOURCE
				esource_collected = esource_collected + 1
				If esource_collected = constant_bonus_crateq Then light = MilliSecs() + fading_time ' Yes there will be light if all mana will be collected
		End Select
		death = fading_time + MilliSecs()' Disappearance of a bonus
		coll_type = CT_IMMATERIAL ' The bonus becomes non - material
	End Method
End Type

SeedRnd MilliSecs()' That is for receive new sequence of random numbers each new program launch

SetGraphicsDriver GLMax2DDriver()' Setting the OpenGL graphics driver 
Graphics sxsize, sysize ', color_depth
AutoImageFlags FILTEREDIMAGE | MIPMAPPEDIMAGE | DYNAMICIMAGE
SetBlend ALPHABLEND
reset_transformations

' Loading images with an alpha-channel from an exe-file
Global images:TPixmap = LoadPixmapPNG("incbin::new_images.png")

' Creating images for tiles
tex_water:TImage = tiles_grab(0, 1, False)
tex_sand:TImage = tiles_grab(1, 1, False)
tex_grass:TImage = tiles_grab(2, 1, False)

' Cutting out images
Global kolobok:TImage = tiles_grab(3, 3)
Global bullet:TImage = tiles_grab(6)
Global bonus:TImage = tiles_grab(7, 12)
Global crate:TImage = tiles_grab(19)
Global crate_bits:TImage = CreateImage(tilesize4, tilesize4, crate_bits_packq * 16)
For n = 0 To 3
	For yy = 0 To 3
		For xx = 0 To 3
			new_grab crate_bits, n * tilesize + xx * tilesize4, yy * tilesize4 + tilesize * 5, n * 16 + yy * 4 + xx
		Next
	Next
Next
Global target:TImage = tiles_grab(24), targetx#, targety# 

' Creating water texture in a package of tiles
tile_tex:TImage = CreateImage(tilesize, tilesize, 513)
pixmap:TPixmap = LockImage(tile_tex, 0)
pixmap.paste(LockImage(tex_water)), 0, 0
UnlockImage tile_tex, 0
UnlockImage tex_water
' Adding two libraries - transition from water to sand and from sand to a grass
tile_lib_create tex_water, tex_sand, 4.0 / tilesize, 360.0, tile_tex, 1
tile_lib_create tex_sand, tex_grass, 4.0 / tilesize, 720.0, tile_tex, 257

' Making "slice pie" of layers
Global layer_tiles:tile_layer_obj = tile_layer_obj.add(tile_tex)' all over again - tiley
Global layer_bullets:object_layer_obj = object_layer_obj.add()' Then bullets and splinters of bombs
Global layer_water_koloboks:object_layer_obj = object_layer_obj.add()' After - water koloboks
Global layer_ground_koloboks:object_layer_obj = object_layer_obj.add()' Then - ground koloboks, crates and bonuses
Global layer_top_scenery:object_layer_obj = object_layer_obj.add()' From above - splinters of crates

' Creating layers of tile collisions
Global layer_water:tile_collision_layer_obj = tile_collision_layer_obj.add()' the Layer of"firm"water
Global layer_sand:tile_collision_layer_obj = tile_collision_layer_obj.add()' the Layer of"firm"sand

' Defining what collides with what
layer_water_koloboks.collides_with layer_water_koloboks ' Water koloboks - among themselves
layer_water_koloboks.collides_with layer_sand ' Water koloboks - with a tile collision layer of sand
layer_ground_koloboks.collides_with layer_ground_koloboks ' Ground koloboks - among themselves
layer_ground_koloboks.collides_with layer_water ' Ground koloboks - with a tile collision layer of water
layer_bullets.collides_with layer_water_koloboks ' Bullets - with ground koloboks
layer_bullets.collides_with layer_ground_koloboks ' Bullets - with water koloboks

field_generate ' Generating a field
Global player:player_obj = player_obj.create()' Creating the player
objects_generate ' Creating koloboks and crates

HideMouse

sc# = 64.0
fdx# = player.x + sxsize2 / sc# 
fdy# = player.y + sysize2 / sc# 
Repeat

	tim = MilliSecs()' Storing current moment of time
	
	MoveMouse sxsize2, sysize2 ' Setting the cursor of the mouse in the center of the screen

	' Smooth change of coordinates of the camera (while teleportation the camera is fixed on the player, differently - on an average point between the player and a target)
	camera_change 0.5 * targetx# * (teleport_mode = TM_IDLE), 0.5 * targety# * (teleport_mode = TM_IDLE), 1.1 ^ MouseZ() * 64.0
	
	player.angle = ATan2(targety#, targetx#)' Targetting player's sprite on a target

	timspeed# = speedpersec# * dtim# ' Definition of multiplier for the speed based of last cycle time
	timang# = angpersec# * dtim# ' Same for angular speed

	' Displaying layers
	For l:layer_obj = EachIn layer_order
		l.draw
	Next

	' Actions of active objects
	For o:base_obj = EachIn actingobj
		o.act
	Next

	' Displaying counters
	DrawText"Frames / sec:" + fps + ", objects:" + objcnt + ", collision checks / frame:" + chcnt + ", collisions / frame:" + ccnt, 0, 0
	ccnt = 0
	chcnt = 0

	' Displaying target
	field2scr targetx# + player.x, targety# + player.y, sx#, sy# 
	DrawImage target, sx#, sy# 

	' Clarification of the screen after gathering all energy sources
	If light > MilliSecs() Then
		' Setting transparency
		SetAlpha 1.0 - 1.0 * (light - MilliSecs()) / fading_time
		' Drawing also the white rectangular all-screen-wide
		DrawRect 0, 0, sxsize, sysize
		reset_transformations
	ElseIf light <> 0 Then
		' Congratulating player with a victory
		Notify"Congratulations!!!"
		End
	End If

	Flip False

	' Updating counters of the frames per second
	If fpstim <= MilliSecs() Then
		fpstim = MilliSecs() + 1000
		fps = cnt
		cnt = 0
	Else
		cnt:+1
	End If

	If teleport_mode = TM_IDLE Then
		targetx# :+(MouseX() -sxsize2) / sc# ' Changing coordinates of a target
		targety# :+(MouseY() -sysize2) / sc# 
		' Restrictions on moving target far from player 
		targetx# = limit(targetx#, Max(-sxsize / sc# * 0.75, -player.x), Min(sxsize / sc# * 0.75, fxsize - player.x))
		targety# = limit(targety#, Max(-sysize / sc# * 0.75, -player.y), Min(sysize / sc# * 0.75, fysize - player.y))
	End If

	' Calculation of time spent for a coil of a cycle(in seconds) for calculation of multipliers of speeds
	dtim# = 0.001* (Min(MilliSecs() -tim, minms))
	' Time is limited for unallowing too big multipliers, negatively
	' affecting collisions

Until KeyHit(KEY_ESCAPE)

' Generation of a field
Function field_generate()
	Const tile_water = 0
	Const tile_sand = 256
	Const tile_grass = 512
	Local ff#[fxsize, fysize, 2]' Auxiliary buffer - heightmaps for tiles
	Local pos2bit[] = [0, 6, 1, 4, 5, 2, 7, 3]
	fmin# = 1.0; fmax# = 0 ' Variables of a minimum and a maximum of values of heights
	For n = 0 To fblurq + 3
		loadingbar"Generating field...", n, fblurq + 4 ' the Indicator of completeness of process
		maxd# = 0
		For y = 0 Until fysize ' the Cycle on all tiles
			For x = 0 Until fxsize
				Select n
					Case 0 ' firstly we'll fill heighmap with random values
						ff#[x, y, 1] = Rnd(0, 1)
					Case fblurq + 1 ' After stages of smoothing - tile layers formation stage
						d# = (ff#[x, y, k] -fmin#) / (fmax# -fmin#)' Correcting value of height that the minimum corresponded to value 0.0, and maximum to 1.0
						If d# < sand_threshold# Then ' Up to a threshold of sand
							layer_tiles.frame[x, y] = tile_water ' Displaying clean tile waters
							layer_water.collision[x, y] = True ' Setting a collision with this tile in a water layer
						ElseIf d# < grass_threshold# Then ' From a threshold of sand up to a threshold of a grass
							layer_tiles.frame[x, y] = tile_sand ' Displaying clean sand tile
							layer_sand.collision[x, y] = True ' Setting a collision with this tile in a layer of sand
						Else ' After a threshold of a grass
							layer_tiles.frame[x, y] = tile_grass ' Displaying clean grass tile
							layer_sand.collision[x, y] = True
						End If
					Case fblurq + 2 ' Stage of elimination of the grass adjoining water
						If layer_tiles.frame[x, y] = tile_grass Then ' If tile is a grass, 
							For yy = -1 To 1 ' the Cycle on all next tilem
								For xx = -1 To 1
									x2 = (x + xx + fxsize)Mod fxsize ' Calculation of coordinates of next tile
									y2 = (y + yy + fysize)Mod fysize '(a field zatsikleno)
									If layer_tiles.frame[x2, y2] = tile_water Then ' If one of tiles is water
										layer_tiles.frame[x, y] = tile_sand ' That changes grass tile on sand tile
									End If
								Next
							Next
						End If
					Case fblurq + 3 ' Stage of smoothing tiles (a choice of the frame from library)
						If layer_tiles.frame[x, y] > tile_water Then ' If pure(clean)water this is passed(missed)tile
							bitpos = 0; mask = 0
							For yy = -1 To 1 ' the Cycle on all next tilem
								For xx = -1 To 1
									If xx <> 0 Or yy <> 0 Then
										x2 = (x + xx + fxsize) Mod fxsize
										y2 = (y + yy + fysize) Mod fysize
										If layer_tiles.frame[x, y] > tile_sand Then ' If ?urrent tile - a grass, 
											' If neighbour tile - a grass too then certain bit (of this neighbour) will be on in the current tile frame number
											If layer_tiles.frame[x2, y2] > tile_sand Then setbit mask, pos2bit[bitpos]
										Else ' Else it's sand tile
											' If neighbour tile too then certain bit (of this neighbour) will be on in the current tile frame number
											If layer_tiles.frame[x2, y2] > tile_water Then setbit mask, pos2bit[bitpos]
										End If
										bitpos:+1 ' Increasing bit counter
									End If
								Next
							Next
							layer_tiles.frame[x, y] = 1 + 256* (layer_tiles.frame[x, y] = tile_grass) + mask
						End If
					Default ' Stages of smoothing of a heightmap
						sum# = 0
						For yy = -1 To 1 ' Summarizing values of heights of next tiles and height of current tile * 8
							For xx = -1 To 1
								sum# = sum# + ff#[(x + xx + fxsize) Mod fxsize, (y + yy + fysize) Mod fysize, k] * (1.0 + 7.0* (xx = 0 And yy = 0))
							Next
						Next
						sum# = sum# / 16.0 ' Calculating average value (central tile has the same weight, as all 8 next in the sum)
						If n = fblurq Then setminmax sum#, fmin#, fmax# ' Correcting values of a maximum and a minimum of height
						ff#[x, y, 1 - k] = sum# ' Setting value of height in the buffer
				End Select
			Next
		Next
		k = 1 - k ' Swapping the buffer and a current map
		If n = fblurq + 1 Then ' Fringing tilemap with water after a stage of formation of layers
			For x = 0 Until fxsize
				waterize x, 0
				waterize x, fysize - 1
			Next
			For y = 0 Until fysize
				waterize 0, y
				waterize fxsize - 1, y
			Next
		End If
	Next
End Function

' Fill tile with water
Function waterize(x, y)
	layer_tiles.frame[x, y] = 0 ' Displaying clean water tile
	layer_water.collision[x, y] = True ' Collision for water tile collision layer
	layer_sand.collision[x, y] = False ' No collision for sand tile collision layer
End Function

' Creation of library tiles transition between structures
Function tile_lib_create(bottom_tile:TImage, top_tile:TImage, rowd#, period#, tile_lib:TImage, offset = 0)
	Local dt#[tilesize2] ' Filling array of fluctuations of border
	For dn = 0 Until tilesize2
		dt#[dn] = (Sin(90 + dn * period# / tilesize2) - 1) * tilesize32
	Next

	bottom_pixmap:TPixmap = LockImage(bottom_tile)
	top_pixmap:TPixmap = LockImage(top_tile)

	For n = 0 To 255 ' Eight cells around tile can be same or different (2 variants), 
		' therefore all - 2 ^ 8 = 256 variants
		loadingbar "Generating transition tiles...", n, 256
		lib_pixmap:TPixmap = LockImage(tile_lib, n + offset)
		For n1 = 0 To 1
			For n2 = 0 To 1
				v = biton(n, n1 + n2 * 2)
				vx = biton(n, n1 + 4)
				vy = biton(n, n2 + 6)
				For yy = 0 Until tilesize2
					For xx = 0 Until tilesize2
						If vx Then
							If vy Then
								If v Then
									k1# = 1
								Else
									k1# = rowd# * (Sqr(xx * xx + yy * yy))
								End If
							Else
								k1# = (yy + dt#[xx]) * rowd# 
							End If
						Else
							If vy Then
								k1# = (xx + dt#[yy]) * rowd# 
							Else
								k1# = 2.0 - rowd# * (Sqr((tilesize2 - xx) * (tilesize2 - xx) + (tilesize2 - yy) * (tilesize2 - yy)) + Rand(-1, 1))
							End If
						End If
						If k1# > 1 Then k1# = 1 ' we Limit factor within the limits of an interval[0, 1]
						If k1# < 0 Then k1# = 0
						k2# = 1.0 - k1# ' Coefficient of transparency for pixels of another tile
						If n1 Then x = tilesize - 1 - xx Else x = xx ' Mirroring (if it is necessary)
						If n2 Then y = tilesize - 1 - yy Else y = yy
						fromrgba ReadPixel(top_pixmap, x, y), r1, g1, b1, dummy ' Receiving color components of tiles' pixels 
						fromrgba ReadPixel(bottom_pixmap, x, y), r2, g2, b2, dummy
						' Mixing colors with the set factors, then write pixel with resulting components
						WritePixel lib_pixmap, x, y, torgba(k1# * r1 + k2# * r2, k1# * g1 + k2# * g2, k1# * b1 + k2# * b2, 255)
					Next
				Next	
			Next
		Next
	Next

	UnlockImage bottom_tile
	UnlockImage top_tile
End Function

' Generation of crates and koloboks
Function objects_generate()
	' Koloboks
	For n = 1 To kolobokq
		If(n Mod 100) = 0 Then loadingbar"Generating objects...", n, kolobokq * 3
		Repeat
			o:kolobok_obj = kolobok_obj.create()
			' Distance up to the player should be not less than minimum
			If Sqr((o.x - player.x) * (o.x - player.x) + (o.y - player.y) * (o.y - player.y)) >= min_enemy_distance Then Exit
			o.destroy
		Forever
	Next
	
	' crates with constant bonuses
	For n1 = 1 To constant_bonustypeq ' Cycle on all types of bonuses
		If(n Mod 100) = 0 Then loadingbar"Generating objects...", n1 + constant_bonustypeq, constant_bonustypeq * 3
		For n2 = 1 To constant_bonus_crateq ' Creating certain quantity of crates of each type
			crate_obj.create(n1 - 1)
		Next
	Next

	' crates with temporary bonuses
	For n = 1 To temporary_bonus_crateq
		loadingbar"Generating objects...", n + temporary_bonus_crateq * 2, temporary_bonus_crateq * 3
		If Rand(1, 100) > empty_crates_percent Then
			crate_obj.create Rand(0, temporary_bonustypeq - 1) + bonus_threshold
		Else
			crate_obj.create - 1 ' the Part of crates are empty
		End If
	Next
End Function

' Adding nearly objects to the list
Function nearly_objects:TList(lst:TList, x, y, radius, layer:object_layer_obj)
	For yy = Max(y - radius, 0)To Min(y + radius, fysize - 1)
		For xx = Max(x - radius, 0)To Min(x + radius, fxsize - 1)
			For o:base_obj = EachIn(layer.objects[xx, yy])
				lst.addlast o
			Next
		Next
	Next
	Return lst
End Function

' Function of a grabbing of the image from other image
Function new_grab:TImage(image:TImage, x, y, frame)
	pixmap:TPixmap = LockImage(image, frame)
	w:TPixmap = images.window(x, y, ImageWidth(image), ImageHeight(image))
	pixmap.paste w, 0, 0
	UnlockImage image
	Return image
End Function

' Function of a grabbing tile or series of tiles from the image
Function tiles_grab:TImage(num, frameq = 1, midhn = True)
	image:TImage = CreateImage(tilesize, tilesize, frameq)
	If midhn Then MidHandleImage image ' the flag midhn means, that the image is necessary ottsentrovat
	For n = 0 To frameq - 1
		pos = num + n
		new_grab image, (pos Mod 4) * tilesize, Floor(pos / 4) * tilesize, n ' By default tiley settle down on the image in 4 columns
	Next
	Return image
End Function

Function reset_transformations()
	SetGrayColor 255
	SetRotation 0
	SetAlpha 1
	SetScale 1.0, 1.0
End Function

Function camera_change(x#, y#, scale#)
	' Changing camera scaling and position 
	sc# = sc# + magn_speed# * (scale# -sc#) * dtim# 
	camx# = camx# + cam_speed# * (x# -camx#) * dtim# 
	camy# = camy# + cam_speed# * (y# -camy#) * dtim# 

	sc# = limit(sc#, Max(1.0 * sxsize / fxsize, 1.0 * sysize / fysize), 256.0)' Restriction of increasing scaling
	tilesc# = sc# / tilesize ' Calculation of factor of scaling for tiles
	
	xsize# = sxsize / sc# ' Sizes of a displayed rectangular piece of a field
	ysize# = sysize / sc# 
	
	fdx# = limit(player.x + camx# -xsize# * 0.5, 0, fxsize - xsize#)' Restrictions of displacement of a screen field (within borders)
	fdy# = limit(player.y + camy# -ysize# * 0.5, 0, fysize - ysize#)
End Function

' Setting color - a shade of grey
Function SetGrayColor(col)
	SetColor col, col, col
End Function

' Strip displaying completeness of process
Function loadingbar(txt$, pos, maximum)
	Cls
	SetColor 128, 128, 255
	DrawText txt$, (sxsize - TextWidth(txt$)) / 2, sysize34
	col = 255 * pos / maximum
	SetGrayColor 255
	DrawEmptyRect sxsize4, sysize34 + 20, sxsize2, 30
	SetColor 255 - col, col, 0
	DrawRect sxsize4 + 2, sysize34 + 22, sxsize24 * pos / maximum, 26
	Flip False
	SetGrayColor 255
End Function

' Function for drawing an empty rectangle
Function DrawEmptyRect(x#, y#, xsize#, ysize#)
	xsize# = xsize# -1
	ysize# = ysize# -1
	DrawLine x#, y#, x# + xsize#, y# 
	DrawLine x# + xsize#, y#, x# + xsize#, y# + ysize# 
	DrawLine x# + xsize#, y# + ysize#, x#, y# + ysize# 
	DrawLine x#, y# + ysize#, x#, y# 
End Function

' Function for translation Write / ReadPixel - value to color components' values and an alpha of the channel
Function fromRGBa(from, r Var, g Var, b Var, a Var)
	b = from & $FF
	g = (from Shr 8) & $FF
	r = (from Shr 16) & $FF
	a = (from Shr 24) & $FF
	Return
End Function

' Function for translation values of color components and an alpha - channel to Write / ReadPixel - value
Function toRGBa(r, g, b, a = 255)
	Return b | (g Shl 8) | (r Shl 16) | (a Shl 24)
End Function

' Swapping values of two variables
Function swap(v1 Var, v2 Var)
	z = v2
	v2 = v1
	v1 = z
End Function

' Change of a minimum and a maximum on the basis of a variable
Function setminmax(v#, vmin# Var, vmax# Var)
	If v# < vmin# Then vmin# = v# 
	If v# > vmax# Then vmax# = v# 
End Function

' Translation from screen coordinates to field coordinates in tiles 
Function scr2field(sx#, sy#, tx# Var, ty# Var)
	tx# = sx# / sc# + fdx# 
	ty# = sy# / sc# + fdy# 
End Function

' Translation from field coordinates to screen
Function field2scr(tx#, ty#, sx# Var, sy# Var)
	sx# = (tx# - fdx#) * sc#
	sy# = (ty# - fdy#) * sc#
End Function

' Making variable stay in limits of minumum and maximum values
Function limit# (v#, vmin#, vmax#)
	If v# < vmin# Then v = vmin# ElseIf v# > vmax# Then v# = vmax# 
	Return v#
End Function

' Function returns state of a bit in value at number bitnum
Function biton(v, bitnum)
	If v & (1 Shl bitnum) Then Return True Else Return False
End Function

' Setting on a bit at number bitnum in value of a variable
Function setbit(v Var, bitnum)
	v = v | (1 Shl bitnum)
End Function

' Calculation of the minimal difference of angles
Function calc_dangle# (ang1#, ang2#)
	dang# = ang2# - ang1# 
	Return dang# - Floor(dang# / 360 + 0.5) * 360
End Function

Comments

Jesse2007
Wow. This stuff is great. I love the zooming. Thanks for shareing. I will definitely find this stuff usefull.


Matt Merkulov2007
Thanks!
I really appreciate your comments.
There's a powerful similar 2D-engine coming (soon, I hope)!

And I forgot to add some screenies from this game. Here they are:





Code Archives Forum