Code archives/Graphics/Game of Brutal Koloboks
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
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
| ||
Wow. This stuff is great. I love the zooming. Thanks for shareing. I will definitely find this stuff usefull. |
| ||
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