Ooops
March 01, 2021, 10:42:37 PM

Author Topic: [bmx] Game of Brutal Koloboks by Matt Merkulov [ 1+ years ago ]  (Read 475 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
Title : Game of Brutal Koloboks
Author : Matt Merkulov
Posted : 1+ years ago

Description : From article: <a href="http://blitzetcetera.org/index.php/Создание_двумерного_движка_на_примере_игры_%22Зверские_колобки%22" target="_blank"> Making 2D engine[/url] (rus)
Image used:


Code :
Code: BlitzMax
  1. 'Game of Brutal Koloboks by Matt Merkulov
  2.  
  3. 'Controls:
  4. 'WASD - move protagonist
  5. 'Mouse - move target
  6. 'Left mouse button - fire
  7. 'Right mouse button - Force
  8. 'Mouse wheel - zoom
  9. 'Space - teleport
  10.  
  11. Framework brl.glmax2d ' Base module - an engine based on OpenGL
  12. Import brl.random ' Generator of random numbers
  13. Import BRL.Basic ' From this module command Incbin is used
  14. Import BRL.PNGLoader ' Loading of PNG images
  15.  
  16. Incbin "new_images.png" ' It is for keeping image in an exe
  17.  
  18. Const sxsize = 800, sysize = 600, color_depth = 32 ' Resolution of the screen and depth of color
  19.  
  20. Const tilesize = 64 ' the size of the tile / sprite
  21.  
  22. ' Auxiliary constants
  23. Const tilesize2 = tilesize / 2, tilesize4 = tilesize / 4, tilesize8 = tilesize / 8
  24. Const tilesize16 = tilesize / 16, tilesize32 = tilesize / 32
  25.  
  26. Const sxsize2 = sxsize / 2, sysize2 = sysize / 2
  27. Const sxsize4 = sxsize / 4, sxsize34 = sxsize * 3 / 4
  28. Const sysize34 = sysize * 3 / 4, sxsize24 = sxsize / 2 -4
  29.  
  30. Const fxsize = 160, fysize = 120 ' Size of a field in tiles
  31. Const fblurq = 5 ' Blur passes quantity for temporarily generated auxiliary heightmap of a field
  32. Const sand_threshold# = 0.4, grass_threshold# = 0.5 ' Thresholds of height for sand and grass
  33. Global fdx#, fdy# ' Shift of a displayed part of a field
  34.  
  35. Const kolobokq = 500 ' Wild koloboks
  36. Global speedpersec# = 1.0 ' Modifier of speed (tiles / se?)
  37. Global angpersec# = 90.0 ' Modifier of angular speed (degrees / se?)
  38.  
  39. Global sc# = 1.0, tilesc# ' Magnification in pixels and tiles
  40. Global dtim# ' Time of processing of the previous cycle
  41. Global timspeed# ' Modifier for moving depending on dtim#
  42. Global timang# ' the Modifier for turn depending on dtim#
  43. Const minms = 100 ' Maximum seconds for cycle
  44. Const cam_speed# = 2.0 ' Relative speed of reaction of the camera on mouse movements
  45. Const magn_speed# = 2.0 ' Relative speed of reaction of scale on mouse wheel rotation
  46. Global camx#, camy# ' Current coordinates of the camera
  47.  
  48. Global layer_order:TList = CreateList()' List of displayed layers in order of appearance
  49. Global actingobj:TList = CreateList()' List for active objects
  50.  
  51. Const showcollisions = False ' Display of collisions(now switched off)
  52. Global ccnt, objcnt, chcnt ' Counters of collisions, objects, checks of collisions per second
  53.  
  54. Const force_reload_time = 7000, force_power# = 3.0 ' Time of Force "reloading", its power
  55. Global force_time = 1000, force_radius# = 5.0 ' Time of action of Force, radius of action
  56. Global force_reload, force_effect ' Time of "reload"'s end and effect of Force
  57.  
  58. Const fireable_percent = 25 ' Percent of fireable ground koloboks
  59. Const min_fire_distance# = 7.0 ' Minimal distance of firing
  60. Const min_enemy_distance = 20 ' Minimal distance up to the enemy in the beginning of game
  61.  
  62. Const constant_bonustypeq = 7, temporary_bonustypeq = 5 ' Quantity of constant and temporary bonuses
  63. Const constant_bonus_crateq = 10 ' Quantity of crates with constant bonuses (for every)
  64. Const temporary_bonus_crateq = 100 ' Quantity of crates with temporary bonuses
  65. Const empty_crates_percent = 30 ' Percent of empty crates
  66. Const crate_bits_packq = 4 ' Quantity of variants of pieces of a box
  67. Const bonustypeq = constant_bonustypeq + temporary_bonustypeq
  68.  
  69. ' Constant bonuses
  70. Const BONUS_BULLET_DAMAGE = 0 ' Increase damage of bullets
  71. Const BONUS_BULLET_SPEED = 1 ' Increase the speed of bullets
  72. Const BONUS_BULLET_LIFETIME = 2 ' Increase in time of a life of a bullet
  73. Const BONUS_RELOAD_TIME = 3 ' Reduction of intervals between shots
  74. Const BONUS_MAX_HEALTH = 4 ' Increase maximal quantity of health
  75. Const BONUS_SPEED = 5 ' Increase player's speed
  76. Const BONUS_ESOURCE = 6 ' Energy sources (it is necessary to collect all for finishing of game)
  77. Global esource_collected, light
  78.  
  79. ' Time(Temporary)bonuses
  80. Const bonus_threshold = constant_bonustypeq
  81. Const BONUS_HEALTH = bonus_threshold + 0 ' Health
  82. Const BONUS_TEMPORARY_FIREPOWER = bonus_threshold + 1 ' Temporary increase fire power
  83. Const BONUS_BOMB = bonus_threshold + 2 ' Bomb!
  84. Const BONUS_TEMPORARY_SPEED = bonus_threshold + 3 ' Temporary acceleration
  85. Const BONUS_TEMPORARY_INVULNERABILITY = bonus_threshold + 4 ' Temporary invulnerability
  86.  
  87. Global temporary_firepower, temporary_speed, temporary_invulnerability ' Time of the termination(ending)of action of bonuses
  88.  
  89. Const fading_time = 1000, damage_time = 400 ' Time of "fading out", "reddening" from damages
  90. Const NOT_YET = 1000000000, INDESTRUCTIBLE = 1000000000 ' Constants "has not died yet", "indestructible"
  91.  
  92. Const TM_IDLE = 0 ' Playng as usually
  93. Const TM_READY = 1 ' Preparing for teleportation (waiting)
  94. Const TM_DECREASING = 2 ' Decreasing
  95. Const TM_ENLARGING = 3 ' Growing on a new place
  96. Global teleport = NOT_YET, teleport_mode = TM_IDLE ' Time of the ending of a cycle of teleportation mode
  97. Const teleport_ready_time = 5000 ' Time of preparation for teleportation
  98. Const max_teleport_radius = 50 ' Maximal distance in tiles for teleportation
  99.  
  100. Type layer_obj Abstract
  101.         Field collision_with:TList = CreateList()' List of layers, with which this layer collides
  102.  
  103.         Method collides_with(layer:layer_obj)
  104.                 If tile_layer_obj(layer) Then RuntimeError "Tile layers cannot collide - use tile collision layer"
  105.                 collision_with.addlast layer
  106.         End Method
  107.  
  108.         Method draw()
  109.         End Method
  110. End Type
  111.  
  112. Const TILE_DONT_DRAW = -1
  113. Type tile_layer_obj Extends layer_obj
  114.         Field image:TImage ' Images for tiles
  115.         Field frame[fxsize, fysize]' Number of tile for each cell
  116.  
  117.         Method collides_with(layer:layer_obj)
  118.                 RuntimeError "Tile layers cannot collide -use tile collision layer"
  119.         End Method
  120.  
  121.         Function add:tile_layer_obj(tile_image:TImage, clearing = True) ' Adding tile layer
  122.                 l:tile_layer_obj = New tile_layer_obj
  123.                 l.image = tile_image
  124.                 If clearing Then
  125.                         For y = 0 Until fysize ' Installation "do not draw tile" for all cells
  126.                                 For x = 0 Until fxsize
  127.                                         l.frame[x, y] = TILE_DONT_DRAW
  128.                                 Next
  129.                         Next
  130.                 End If
  131.                 layer_order.addlast l ' Adding layer in the list of displayed ones
  132.                 Return l
  133.         End Function
  134.  
  135.         Method draw()' Drawing layer
  136.                 SetScale tilesc#, tilesc#
  137.                 scr2field 0, 0, x1#, y1#
  138.                 scr2field sxsize - 1, sysize - 1, x2#, y2#
  139.  
  140.                 xx1 = Max(0, Floor(x1#)) ' Determining what part of field is currently visible on screen
  141.                 xx2 = Min(Ceil(x2#), fxsize - 1)
  142.                 yy1 = Max(0, Floor(y1#))
  143.                 yy2 = Min(Ceil(y2#), fysize - 1)
  144.  
  145.                 For y = yy1 To yy2
  146.                         For x = xx1 To xx2
  147.                                 If frame[x, y] >= TILE_DRAW Then ' Check, whether it is necessary to draw tile
  148.                                         field2scr x, y, sx#, sy#
  149.                                         DrawImage image, sx#, sy#, frame[x, y]
  150.                                 End If
  151.                         Next
  152.                 Next
  153.         End Method
  154. End Type
  155.  
  156. Type tile_collision_layer_obj Extends layer_obj
  157.         Field collision[fxsize, fysize] ' Collision with tile ("solid" / "hologram")
  158.  
  159.         Function add:tile_collision_layer_obj()
  160.                 Return New tile_collision_layer_obj
  161.         End Function
  162. End Type
  163.  
  164. Type object_layer_obj Extends layer_obj
  165.         Field objects:TList[fxsize, fysize]' the List of objects for each cell, being on it
  166.  
  167.         Function add:object_layer_obj()
  168.                 l:object_layer_obj = New object_layer_obj
  169.                 For y = 0 Until fysize ' Initialization of lists
  170.                         For x = 0 Until fxsize
  171.                                 l.objects[x, y] = CreateList()
  172.                         Next
  173.                 Next
  174.                 layer_order.addlast l
  175.                 Return l
  176.         End Function
  177.  
  178.         Method draw()
  179.                 scr2field 0, 0, x1#, y1#
  180.                 scr2field sxsize - 1, sysize - 1, x2#, y2#
  181.  
  182.                 xx1 = Max(0, Floor(x1# -0.5))
  183.                 xx2 = Min(Floor(x2# + 0.5), fxsize - 1)
  184.                 yy1 = Max(0, Floor(y1# -0.5))
  185.                 yy2 = Min(Floor(y2# + 0.5), fysize - 1)
  186.  
  187.                 For y = yy1 To yy2
  188.                         For x = xx1 To xx2
  189.                                 For o:base_obj = EachIn objects[x, y]
  190.                                         o.draw
  191.                                 Next
  192.                         Next
  193.                 Next
  194.                 reset_transformations
  195.         End Method
  196. End Type
  197.  
  198. Const CT_IMMATERIAL = 0 ' Type of collision model - non - material
  199. Const CT_CIRCULAR = 1 ' Type of collision model - a circle
  200. Const CT_SQUARE = 2 ' Type of collision model - a square
  201. ' Base type for objects
  202. Type base_obj
  203.         Field x#, y#, size# = 1, angle# ' Coordinates, size(in tiles), an angle of object sprite's turn
  204.         Field speed# ' Speed of object (tiles / sec)
  205.         Field moving_angle# ' Current angle of movement
  206.         Field r = 255, g = 255, b = 255 ' Color of object (by default white)
  207.         Field image:TImage, frame ' Image for object
  208.         Field tilex, tiley ' Coordinates of tile on which this object being on
  209.         Field act_link:TLink, tile_link:TLink ' References to this object from lists of active objects and objects of a tile
  210.         Field layer:object_layer_obj ' Layer of object
  211.         Field coll_type = CT_CIRCULAR, radius# = 0.5 ' Type of collision model and its radius
  212.         Field health# ' Health of object
  213.         Field death = NOT_YET, damage_end ' Time of death (it is not defined yet), time of the ending of "reddening"
  214.  
  215.         Const ONLY_ON_GROUND = True ' Constant for accommodation of object only on a land
  216.         Method place_find(onlyonground = False)' Search of a place for accommodation of object
  217.                 Repeat
  218.                         x = Rnd(1.0, fxsize - 1.01)
  219.                         y = Rnd(1.0, fysize - 1.01)
  220.                         tilex = Floor(x)
  221.                         tiley = Floor(y)
  222.                         ' Definition of kolobok's groundness / waterness
  223.                         If layer_sand.collision(tilex, tiley) Then layer = layer_ground_koloboks Else layer = layer_water_koloboks
  224.                         ' Check of a finding on a land (for accommodation only on a land) and on absence of collisions
  225.                         If layer = layer_ground_koloboks Or onlyonground = False Then If Not collision(x#, y#) Then Exit
  226.                 Forever
  227.         End Method
  228.  
  229.         Method random_color()' Definnig random (but not so dark) color for object
  230.                 Repeat
  231.                         r = Rand(0, 255)
  232.                         g = Rand(0, 255)
  233.                         b = Rand(0, 255)
  234.                 Until r + g + b >= 255
  235.         End Method
  236.  
  237.         Const ACTIVE = True, INACTIVE = False
  238.         Method register(acting = ACTIVE)' Registration of object in lists
  239.                 tilex = Floor(x#)
  240.                 tiley = Floor(y#)
  241.                 tile_link = layer.objects(tilex, tiley).addlast(Self)' Registration in the list of objects of a cell (tile)
  242.                 If acting Then act_link = actingobj.addlast(Self)' Registration in the list of active objects
  243.                 objcnt:+1
  244.         End Method
  245.  
  246.         Method draw()' Drawing of object
  247.                 field2scr x#, y#, sx#, sy#
  248.                 SetScale size# * tilesc#, size# * tilesc#
  249.                 SetRotation angle#
  250.  
  251.                 dmg = damage_end - MilliSecs() ' "Reddening" from damages
  252.                 If dmg > 0 Then
  253.                         k1# = 1.0 * dmg / damage_time; k2# = 1.0 - k1#
  254.                         SetColor k1# * 255 + k2# * r, k2# * g, k2# * b
  255.                 Else
  256.                         SetColor r, g, b ' Setting natural color
  257.                 End If
  258.  
  259.                 If death = NOT_YET Then
  260.                         SetAlpha 1 ' If yet has not started to disappear, opaque
  261.                 Else
  262.                         SetAlpha limit(.001* (death - MilliSecs()), 0, 1)' Else disappear...
  263.                         If death < MilliSecs() Then destroy ' And in the end it is destroyed absolutely
  264.                 End If
  265.  
  266.                 If Self = player Then
  267.                         If temporary_firepower > MilliSecs() Then
  268.                                 col = 191 + 64 * Sin(MilliSecs()) ' Flickering yellow color of the player with fire power
  269.                                 SetColor col, col, 0
  270.                         End If
  271.                         If temporary_invulnerability > MilliSecs() Then SetAlpha 0.5 ' half-transparency of invulnerable
  272.                         Select teleport_mode
  273.                                 Case TM_READY; SetAlpha 0.75 + 0.25 * Sin(MilliSecs())' Cyclic change of a transparency during preparation for teleportation
  274.                                 Case TM_DECREASING; s# = sc# * size# / tilesize * Max(0.0, 1.0* (teleport - MilliSecs()) / fading_time); SetScale s#, s# ' Reduction
  275.                                 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
  276.                         End Select
  277.                 End If
  278.  
  279.                 DrawImage image, sx#, sy#, frame
  280.         End Method
  281.  
  282.         Method move(newx#, newy#)' Correct moving
  283.                 newtilex = Floor(newx#)
  284.                 newtiley = Floor(newy#)
  285.                 If tilex <> newtilex Or tiley <> newtiley Then ' If the object has moved to other cell,
  286.                         RemoveLink tile_link ' Remove it from the list of an old cell
  287.                         tilex = newtilex
  288.                         tiley = newtiley
  289.                         tile_link = layer.objects[tilex, tiley].addlast(Self) ' Register in the list of new cell
  290.                 End If
  291.                 x# = newx#
  292.                 y# = newy#
  293.         End Method
  294.  
  295.         Method try_move(newx#, newy#)
  296.                 If Not collision(newx#, newy#) Then move newx#, newy#; Return True
  297.         End Method
  298.  
  299.         Method try_move_ang(ang#, spd#, ma_change = False)
  300.                 If try_move(x# + timspeed# * Cos(ang#) * spd#, y# + timspeed# * Sin(ang#) * spd#) Then
  301.                         If ma_change Then moving_angle# = ang#
  302.                         Return True
  303.                 End If
  304.         End Method
  305.  
  306.         Method collision2(o:base_obj, newx#, newy#)' Check of object on collision with another
  307.                 Select True
  308.                         Case coll_type = CT_CIRCULAR ' If model of the given object - a circle
  309.                                 Select True
  310.                                         Case o.coll_type = CT_CIRCULAR ' And model of the second object - a circle too (a circle with circle)
  311.                                                 dx# = newx# -o.x#
  312.                                                 dy# = newy# -o.y#
  313.                                                 ' Checking, whether distance between objects, than the sum of their radiuses there is less
  314.                                                 If Sqr(dx# * dx# + dy# * dy#) < o.radius# + radius# Then ccnt:+1; Return True
  315.                                         Case o.coll_type = CT_SQUARE ' And if model of the second object - a square (a circle with a square)
  316.                                                 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
  317.                                                         dx# = Abs(newx# -o.x#)
  318.                                                         dy# = Abs(newy# -o.y#)
  319.                                                         sumr# = o.radius# + radius#
  320.                                                         If dx# < sumr# And dy# < sumr# Then ccnt:+1; Return True
  321.                                                 Else
  322.                                                         dx# = Min(Abs(newx# -o.x# -o.radius#), Abs(newx# -o.x# + o.radius#))
  323.                                                         dy# = Min(Abs(newy# -o.y# -o.radius#), Abs(newy# -o.y# + o.radius#))
  324.                                                         If Sqr(dx# * dx# + dy# * dy#) < radius# Then ccnt:+1; Return True
  325.                                                 End If
  326.                                         Default ' But here if the second object is non - material - collision is not present
  327.                                                 Return False
  328.                                 End Select
  329.                         Case coll_type = CT_SQUARE ' If model of the given object - a square
  330.                                 If o.coll_type = CT_SQUARE Then ' And model of the second object - a square too
  331.                                         dx# = Abs(newx# -o.x#)
  332.                                         dy# = Abs(newy# -o.y#)
  333.                                         sumr# = o.radius# + radius#
  334.                                         ' Checking, whether according coordinate difference is less than the sum of radiuses
  335.                                         If dx# < sumr# And dy# < sumr# Then ccnt:+1; Return True
  336.                                 Else ' Else we check collision of the second object with given (interchange the position)
  337.                                         Return o.collision2(Self, newx#, newy#)
  338.                                 End If
  339.                         Default ' Non - material object do not collide
  340.                                 Return False
  341.                 End Select
  342.         End Method
  343.  
  344.         Method collision(newx#, newy#) ' Check of the given object on collision with something
  345.                 ' Collision with borders of a field (it will complicate other checks, therefore we leave)
  346.                 If newx# < 1.0 Or newy# < 1.0 Or newx# >= fxsize - 1.0 Or newy# >= fysize - 1.0 Then
  347.                         boundaries_collision_act
  348.                         Return True
  349.                 End If
  350.                 For l:layer_obj = EachIn layer.collision_with ' Cycle on all layers of a collision
  351.                         tl:tile_collision_layer_obj = tile_collision_layer_obj(l)
  352.                         If tl Then ' If it's a tile collison layer,
  353.                                 For yy = Floor(newy# -radius#)To Floor(newy# + radius#)
  354.                                         For xx = Floor(newx# -radius#)To Floor(newx# + radius#)
  355.                                                 If tl.collision(xx, yy) Then
  356.                                                         tile_object.x# = xx + 0.5
  357.                                                         tile_object.y# = yy + 0.5
  358.                                                         If collision2(tile_object, newx#, newy#) Then collided = True; tile_collision_act xx, yy
  359.                                                 End If
  360.                                         Next
  361.                                 Next
  362.                         Else ' Else it's object layer
  363.                                 ol:object_layer_obj = object_layer_obj(l)
  364.                                 x2 = Floor(newx#)
  365.                                 y2 = Floor(newy#)
  366.                                 For yy = y2 - 1 To y2 + 1
  367.                                         For xx = x2 - 1 To x2 + 1
  368.                                                 For o:base_obj = EachIn ol.objects[xx, yy]
  369.                                                         If Self <> o Then
  370.                                                                 chcnt:+1
  371.                                                                 If showcollisions Then ' Displaying checks of collisions by lines
  372.                                                                         field2scr o.x#, o.y#, sx1#, sy1#
  373.                                                                         field2scr newx#, newy#, sx2#, sy2#
  374.                                                                         DrawLine sx1#, sy1#, sx2#, sy2#
  375.                                                                 End If
  376.                                                                 If collision2(o, newx#, newy#) Then collided = True; object_collision_act o
  377.                                                         End If
  378.                                                 Next
  379.                                         Next
  380.                                 Next
  381.                         End If
  382.                 Next
  383.                 Return collided
  384.         End Method
  385.  
  386.         Method act()' Actions of objects
  387.         End Method
  388.  
  389.         Method object_collision_act(o:base_obj)' Actions at collision with objects
  390.         End Method
  391.  
  392.         Method tile_collision_act(xx, yy)' Actions at collision with "solid" tiles
  393.         End Method
  394.  
  395.         Method boundaries_collision_act()' Actions at collision with borders of a map
  396.         End Method
  397.  
  398.         Method damage(amount#)' Taking damage
  399.                 If death < NOT_YET Then Return ' If it's already disappearing then leaving
  400.                 If health# = INDESTRUCTIBLE Then Return ' If basically it is indestructive, then leaving too
  401.                 If Self = player And temporary_invulnerability > MilliSecs() Then Return ' If it is temporarily indestructive - leaving
  402.                 health# = health# -amount# ' we Reducing health
  403.                 damage_end = damage_time + MilliSecs()' Settng "reddening"
  404.                 If health <= 0 Then ' If health on zero,
  405.                         death = fading_time + MilliSecs()' Object starts to disappear
  406.                         ' the Crate disappears at once, the others become non - material
  407.                         If crate_obj(Self) = Null Then coll_type = CT_IMMATERIAL Else death = 0
  408.                 End If
  409.         End Method
  410.  
  411.         Method destroy()' Correct destruction of object
  412.                 If act_link <> Null Then RemoveLink act_link ' Removing object from the list of active ones
  413.                 RemoveLink tile_link ' Removing object from the list of cell's objects
  414.                 objcnt:-1
  415.         End Method
  416. End Type
  417.  
  418. Global tile_object:base_obj = New base_obj
  419. tile_object.radius# = 0.5
  420. tile_object.coll_type = CT_SQUARE
  421.  
  422. ' Base type for koloboks
  423. Type kolobok_obj Extends base_obj
  424.         Field bullet_reload, bullet_reload_time ' Time of the reload's ending , reload time
  425.         Field bullet_speed#, bullet_lifetime = 2000 ' Speed and time of a life of a bullet of this kolobok
  426.         Field bullet_damage# ' Damage of a bullet
  427.         Field max_health# = 1 ' Maximal health
  428.         Field bite_damage#, bite_reload ' Damage from a bite and time of an opportunity of a following bite
  429.         Field bite_reload_time, bite ' Interval between bites, an auxiliary flag
  430.  
  431.         Function create:kolobok_obj()' Creation of wild kolobok
  432.                 o:kolobok_obj = New kolobok_obj
  433.                 o.random_color
  434.                 o.image = kolobok
  435.                 o.moving_angle# = Rnd(0, 360)
  436.                 If Rand(1, 100) > fireable_percent And o.frame = 1 Then ' Parameters for not able to shoot
  437.                         o.bullet_reload = 1000000000
  438.                         o.bullet_reload_time = 1000
  439.                         o.bullet_lifetime = 0
  440.                         o.bullet_damage# = 0
  441.                         o.bullet_speed# = 0
  442.                 Else ' Parameters for able to shoot
  443.                         o.bullet_reload_time = Rand(300, 1000)
  444.                         o.bullet_lifetime = Rand(1000, 4000)
  445.                         o.bullet_damage# = Rnd(1, 5)
  446.                         o.bullet_speed# = Rnd(0.5, 1.5)
  447.                 End If
  448.                 o.max_health = Rand(50, 200)
  449.                 o.health = o.max_health
  450.                 o.bite_damage# = Rnd(4, 12)
  451.                 o.bite_reload_time = Rand(200, 500)
  452.                 ' Calculation of the size and speed on set of parameters
  453.                 o.size# = (o.max_health - 50) / 150.0 + o_bullet_speed# / 1.5 + o.bullet_lifetime / 4000.0
  454.                 o.size# :+o.bullet_damage# / 5.0 + (o.bite_damage# -4.0) / 8.0 + (500 - o.bite_reload_time) / 300.0
  455.                 o.size# :+(1000.0 - o.bullet_reload_time) / 1000.0
  456.                 o.size# = limit(o.size / 7.0 * 1.0 + 0.25, 0, 1.0)
  457.                 o.speed# = (1.25 - o.size#) * 2
  458.                 o.radius# = 0.4 * o.size#
  459.                 o.place_find
  460.                 o.frame = (o.layer = layer_ground_koloboks)' For water koloboks - 0, for ground - 1
  461.                 o.register
  462.                 Return o
  463.         End Function
  464.  
  465.         Method draw()' Drawing kolobok
  466.                 super.draw
  467.                 bar_draw
  468.         End Method
  469.  
  470.         Method bar_draw()' Drawing of a strip of health
  471.                 field2scr x#, y#, sx#, sy#
  472.                 barsize = 1.0 * size# * sc# ' Setting length (depending on the kolobok's size in pixels)
  473.                 If barsize > 4 And max_health <> health Then
  474.                         barsize2 = barsize / 2
  475.                         barheight = limit(Floor(max_health / 50) + 1, 1, 6)' Setting height depending on a maximum of health
  476.                         SetRotation 0
  477.                         SetScale 1, 1
  478.                         SetGrayColor 255
  479.                         k# = 1.0 * health / max_health
  480.                         DrawEmptyRect sx# -barsize2, sy# -barsize2 - 6, barsize - 1, barheight + 2
  481.                         SetColor 255* (1.0 - k#), 255 * k#, 0 ' Setting color: closer to a maximum - green, closer to 0 - red
  482.                         DrawRect sx# -barsize2 + 1, sy# -barsize2 - 5, k# * (barsize - 2), barheight
  483.                 End If
  484.         End Method
  485.  
  486.         Method act()' Kolobok's actions
  487.         If death < NOT_YET Then Return ' If kolobok disappearing, he will be idle
  488.  
  489.         angle# = ATan2(player.y - y#, player.x - x#)' the angle of "prompting" on the player
  490.  
  491.         If force_effect > MilliSecs() Then ' Calculating distance up to the player if Force works
  492.                 rad# = Sqr((player.x# -x#) * (player.x# -x#) + (player.y# -y#) * (player.y# -y#))
  493.         Else
  494.                 rad# = 10000
  495.         End If
  496.         If rad# <= force_radius# Then ' If the distance up to the player is less than radius of action of Force,
  497.                 ' Trying to move away from the player
  498.                 try_move_ang angle# + 180.0, force_power# * Sin(90.0* (force_radius# -rad#) / force_radius#)
  499.         Else
  500.                 ' Else calculating, in what side to rotate
  501.                 dang# = calc_dangle(moving_angle#, angle# + 180* (temporary_firepower > MilliSecs()))
  502.                 ' Also trying to move after turning
  503.                 If Not try_move_ang(moving_angle# + timang# * (1 - 2 * (dang# < 0)), speed#, True) Then
  504.                         ' If move was not possible,
  505.                         If bite Then ' If it is possible to bite, we'll stand and bite...
  506.                                 moving_angle# = angle#
  507.                                 bite = False
  508.                         Else ' If it is impossible, we'll try make a sidestep
  509.                                 If Not try_move_ang(moving_angle# + 90.0* (1 - 2 * Rand(0, 1)), speed#, True) Then
  510.                                         ' If it is impossible, we'll try to step in another side
  511.                                         If Not try_move_ang(moving_angle# + 180.0, speed#, True) Then moving_angle# = Rnd(0.0, 360.0)
  512.                                                 ' If we have absolutely clamped, next time we shall try a random angle
  513.                                         End If
  514.                                 End If
  515.                         End If
  516.                 End If
  517.  
  518.                 If bullet_reload < MilliSecs() Then ' If time has come to shoot
  519.                         ' And distance up to the player is less than maximal
  520.                         If Sqr((player.x# -x#) * (player.x# -x#) + (player.y# -y#) * (player.y# -y#)) <= min_fire_distance# Then
  521.                                 ' Creating the list and insert there all of nearby water koloboks
  522.                                 near:TList = nearly_objects(CreateList(), tilex, tiley, 2, layer_water_koloboks)
  523.                                 ' And also ground ones
  524.                                 near = nearly_objects(near, tilex, tiley, 2, layer_ground_koloboks)
  525.                                 ' But delete current kolobok and the player
  526.                                 near.remove player
  527.                                 near.remove Self
  528.                                 ' Because we shall check, whether there is another kolobok on a way of the bullet which have been released in the player
  529.                                 For o:base_obj = EachIn near
  530.                                         If kolobok_obj(o) Then
  531.                                                 ' Calculating angle between a vector of a shot and a vector from center of shooting to center of checked kolobok
  532.                                                 dang# = Abs(calc_dangle(ATan2(y# -o.y#, x# -o.x#), ATan2(y# -player.y#, x# -player.x#)))
  533.                                                 ' Checking is radius of kolobok is not less than length of an arch
  534.                                                 If Pi * Sqr((x# -o.x#) * (x# -o.x#) + (y# -o.y#) * (y# -o.y#)) * dang# / 180.0 < o.radius Then Return
  535.                                         End If
  536.                                 Next
  537.                                 ' If there are no koloboks on a way of a shot - firing safely
  538.                                 fire
  539.                         End If
  540.                 End If
  541.         End Method
  542.  
  543.         Method object_collision_act(o:base_obj)
  544.                 If o = player Then ' Checking, if current kolobok have collided with the player
  545.                         If bite_reload < MilliSecs() Then ' If we are ready to bite
  546.                                 player.damage(bite_damage)' Then bite
  547.                                 bite_reload = MilliSecs() + bite_reload_time
  548.                         End If
  549.                         bite = True ' This flag shows, that we have seized the player and then we can stand at current place
  550.                 End If
  551.         End Method
  552.  
  553.         Method fire()
  554.                 ' The amendment for the speed at temporary acceleration
  555.                 If Self = player And temporary_speed > MilliSecs() Then spd# = 6.0 Else spd# = speed#
  556.                 If Self = player And temporary_firepower > MilliSecs() Then ' Shooting with firepower
  557.                         bullet_obj.create x#, y#, 0.75, angle#, 4.0 + spd#, 2000, 25, Self, 0.5 * 0.3, r, g, b
  558.                         bullet_reload = MilliSecs() + 40
  559.                 Else ' Shooting in usual mode
  560.                         bullet_obj.create x#, y#, 0.5 * size#, angle#, bullet_speed# + spd#, bullet_lifetime, bullet_damage, Self, size# * 0.3, r, g, b
  561.                         bullet_reload = MilliSecs() + bullet_reload_time
  562.                 End If
  563.         End Method
  564.  
  565. End Type
  566.  
  567. ' the Player
  568. Type player_obj Extends kolobok_obj
  569.         Function create:player_obj()
  570.                 o:player_obj = New player_obj
  571.                 o.x# = 0.5 * fxsize ' Placing the player in the center of the field
  572.                 o.y# = 0.5 * fysize
  573.                 o.size# = 0.75
  574.                 o.radius# = 0.4 * o.size
  575.                 o.image = kolobok
  576.                 o.frame = 2
  577.                 o.speed# = 2.0
  578.                 o.bullet_reload_time = 450
  579.                 o.bullet_speed# = 1.0
  580.                 o.bullet_damage# = 2.5
  581.                 o.max_health# = 300
  582.                 o.health# = o.max_health#
  583.                 o.layer = layer_ground_koloboks
  584.                 Repeat ' Moving the player to the right until he will not stand completely on a land and uncollided
  585.                         o.x:+0.5
  586.                 Until Not o.collision(o.x#, o.y#)
  587.                 o.register
  588.                 Return o
  589.         End Function
  590.  
  591.         Method act()' Actions of the player
  592.                 If death < NOT_YET Then Return ' If we have already defeated, we're idle
  593.                 If teleport_mode = TM_IDLE Then ' If currently we're not teleportating
  594.                         If KeyHit(KEY_SPACE) Then ' If the space key is pressed
  595.                                 If Sqr(targetx# * targetx# + targety# * targety#) <= max_teleport_radius Then ' And the distance is not more than maximum
  596.                                         If Not collision(player.x# + targetx#, player.y# + targety#) Then ' And also in a place of occurrence there are no collisions
  597.                                                 teleport_mode = TM_READY ' That we prepare for teleportation
  598.                                                 teleport = MilliSecs() + teleport_ready_time ' Setting time of next stage
  599.                                         End If
  600.                                 End If
  601.                         End If
  602.                 Else
  603.                         If teleport <= MilliSecs() Then ' If the cycle has come to the end,
  604.                         teleport_mode = teleport_mode + 1 ' Passing to the following
  605.                         teleport = MilliSecs() + fading_time ' Setting time of a next cycle
  606.                         If teleport_mode = TM_ENLARGING And Not collision(player.x# + targetx#, player.y# + targety#) Then
  607.                                 move player.x# + targetx#, player.y# + targety# ' It is moved to a point of teleportation after reduction
  608.                                 fdx2# = fdx2# -targetx#
  609.                                 fdy2# = fdy2# -targety#
  610.                                 targetx# = 0
  611.                                 targety# = 0
  612.                         ElseIf teleport_mode > TM_ENLARGING Then ' If the cycle of increasing is completed
  613.                                 teleport_mode = TM_IDLE ' that we reset teleportation mode
  614.                         End If
  615.                 End If
  616.                 Return ' At teleportation it is necessary to stand quietly, therefore we leave a method
  617.         End If
  618.  
  619.         If bullet_reload < MilliSecs()And MouseDown(1) Then fire ' If time to shoot have approached and fire key is pressed then fire
  620.        
  621.         If MouseDown(2)And force_reload <= MilliSecs() Then ' Using Force if the button is pressed and kolobok is ready
  622.                 force_reload = force_reload_time + MilliSecs()
  623.                 force_effect = force_time + MilliSecs()
  624.         End If
  625.         If force_effect > MilliSecs() Then size# = 0.75 + 0.5* (force_effect - MilliSecs()) / force_time Else size# = 0.75 ' "Swelling" from Force
  626.  
  627.         mov = False ' Calculating angle of a vector of movement, based on the pressed keys
  628.         If KeyDown(KEY_S) Then ang2# = 90.0; mov = True
  629.         If KeyDown(KEY_W) Then ang2# = -90.0; mov = True
  630.         ' If one of the previous keys is pressed - we'll modify an angle depending on previous value
  631.         If KeyDown(KEY_A) Then ang2# = 180.0 - 0.5 * ang2#; mov = True
  632.         If KeyDown(KEY_D) Then ang2# = 0.5 * ang2#; mov = True
  633.        
  634.         If Not mov Then Return ' If we are standing, there is nothing more to do
  635.        
  636.         ' Modifier of speed for temporary acceleration
  637.         If temporary_speed > MilliSecs() Then spd# = 6.0 Else spd# = speed#
  638.                 ' If there are no collisions, move
  639.                 try_move_ang ang2#, spd#
  640.         End Method
  641.  
  642.         Method destroy()
  643.                 ' They kicked us well, so we shout
  644.                 Notify"AAAAAAAAAAAAAA!!! Whyyyyy???!!!"
  645.                 End
  646.         End Method
  647.  
  648.         Method object_collision_act(o:base_obj)
  649.                 ' If we have collided with a bonus and it is not taken yet - we'll take it
  650.                 bo:bonus_obj = bonus_obj(o)
  651.                 If bo Then If bo.death = NOT_YET Then bo.get
  652.         End Method
  653. End Type
  654.  
  655. ' the Bullet
  656. Type bullet_obj Extends base_obj
  657.         Field parent:base_obj, damage# ' the Index on shooting and factor of damage
  658.  
  659.         ' Creating a bullet
  660.         Function create:bullet_obj(bx#, by#, bsize#, bangle#, bspeed#, blifetime, bdamage#, bparent:base_obj = Null, d# = 0, br = 255, bg = 255, bb = 255)
  661.                 bul:bullet_obj = New bullet_obj
  662.                 bul.layer = layer_bullets
  663.                 bul.x# = bx# + Cos(bangle#) * d# ' Displacement otn.The given coordinates
  664.                 bul.y# = by# + Sin(bangle#) * d#
  665.                 bul.r = br
  666.                 bul.g = bg
  667.                 bul.b = bb
  668.                 bul.image = bullet
  669.                 bul.parent = bparent
  670.                 bul.angle# = bangle#
  671.                 bul.size# = bsize#
  672.                 bul.speed# = bspeed#
  673.                 bul.radius = bsize# * 0.25
  674.                 bul.death = MilliSecs() + blifetime
  675.                 bul.damage# = bdamage#
  676.                 bul.register
  677.         End Function
  678.  
  679.         Method act()' Works simply - bullet flies forward before collision
  680.                 move x# + timspeed# * Cos(angle#) * speed#, y# + timspeed# * Sin(angle#) * speed#
  681.                 collision x#, y#
  682.                 If MilliSecs() > death Then destroy ' Time of a life is limited from occurrence
  683.         End Method
  684.  
  685.         Method object_collision_act(o:base_obj)' Damage of the met object (except shooter)
  686.                 If o <> parent Then
  687.                         ccnt:+1
  688.                         o.damage(damage)
  689.                         destroy
  690.                 End If
  691.         End Method
  692.        
  693.         Method boundaries_collision_act()' It is destroyed at collision with borders
  694.                 destroy
  695.         End Method
  696. End Type
  697.  
  698. Type crate_obj Extends base_obj
  699.         Field bonus_type ' Type of a bonus inside
  700.  
  701.         Function create:crate_obj(b_type)
  702.                 o:crate_obj = New crate_obj
  703.                 o.image = crate
  704.                 o.place_find ONLY_ON_GROUND
  705.                 o.bonus_type = b_type
  706.                 o.coll_type = CT_SQUARE
  707.                 o.health = 10
  708.                 If o.speed >= bonustypeq Then o.speed = -1
  709.                 o.register INACTIVE
  710.         End Function
  711.  
  712.         Method destroy()' Explosion of a crate
  713.                 If bonus_type >= 0 Then bonus_obj.create x#, y#, bonus_type ' Creation of a bonus on its place
  714.  
  715.                 offset = Rand(0, crate_bits_packq - 1) * 16 ' the random choice of a package of slices
  716.                 For yy = 0 To 3 ' Creation of 16 scattering slices
  717.                         For xx = 0 To 3
  718.                                 o:crate_bits_obj = New crate_bits_obj
  719.                                 o.dx# = Rnd(-1.0, 1.0) + xx - 1.5
  720.                                 o.dy# = Rnd(-1.0, 1.0) + yy - 1.5
  721.                                 o.x# = x# + 0.125* (xx * 2 - 3)
  722.                                 o.y# = y# + 0.125* (yy * 2 - 3)
  723.                                 o.image = crate_bits
  724.                                 o.frame = xx + yy * 4 + offset
  725.                                 o.layer = layer_top_scenery
  726.                                 o.death = 2000 + MilliSecs()
  727.                                 o.register
  728.                         Next
  729.                 Next
  730.        
  731.                 super.destroy ' Destruction of crate object - calling procedure from base_obj
  732.         End Method
  733.  
  734. End Type
  735.  
  736. Type crate_bits_obj Extends base_obj
  737.         Field dx#, dy# ' Increments for movement
  738.  
  739.         Method act()' Bits simply flying for 2 seconds
  740.                 x# = x# + dx# * timspeed#
  741.                 y# = y# + dy# * timspeed#
  742.         End Method
  743. End Type
  744.  
  745. Type bonus_obj Extends base_obj
  746.         Field dangle#, rotation_period!, pulsing_period! ' Variables for pulsing / tilting
  747.  
  748.         Function create:bonus_obj(x#, y#, b_type)
  749.                 o:bonus_obj = New bonus_obj
  750.                 o.x = x#
  751.                 o.y = y#
  752.                 o.image = bonus
  753.                 o.frame = b_type
  754.                 o.health = INDESTRUCTIBLE ' Bonus can not be destroyed
  755.                 o.dangle# = Rnd(5, 30)
  756.                 o.rotation_period! = Rnd(0.5, 0.1)
  757.                 o.pulsing_period! = Rnd(0.5, 0.1)
  758.                 o.layer = layer_ground_koloboks
  759.                 o.register
  760.         End Function
  761.  
  762.         Method draw()
  763.                 angle# = dangle# * Sin(rotation_period! * MilliSecs())' Angle variations
  764.                 size# = 0.8 + 0.2 * Sin(pulsing_period! * MilliSecs())' Size variations
  765.                 super.draw
  766.         End Method
  767.  
  768.         Method get()' We taking bonus
  769.                 ' Constant bonuses change characteristics to the value depending
  770.                 ' on quantity of such bonuses on a map (if to collect all bonuses characteristics will change
  771.                 ' from initial up to the fixed value, they are specified in comments)
  772.                 Select frame
  773.                         Case BONUS_BULLET_DAMAGE; player.bullet_damage:+10.0 / constant_bonus_crateq ' 2.5 - 12.5
  774.                         Case BONUS_BULLET_SPEED; player.bullet_speed:+3.0 / constant_bonus_crateq ' 1.0 - 4.0 tiles / se?
  775.                         Case BONUS_BULLET_LIFETIME; player.bullet_lifetime:+3000 / constant_bonus_crateq ' 2 - 5 se?
  776.                         Case BONUS_RELOAD_TIME; player.bullet_reload_time:-400 / constant_bonus_crateq ' 0.5 - 0.1 se?
  777.                         Case BONUS_MAX_HEALTH; player.max_health:+500.0 / constant_bonus_crateq; player.health = player.max_health ' 300 - 800
  778.                         Case BONUS_SPEED; player.speed:+2.0 / constant_bonus_crateq ' 2.0 - 4.0 tiles / se?
  779.                         Case BONUS_HEALTH
  780.                                 If player.health = player.max_health Then Return ' If we have full health - we do not take a bonus
  781.                                 player.health = limit(player.health + 0.15 * player.max_health, 0, player.max_health) ' + 15% from a maximum
  782.                         Case BONUS_TEMPORARY_FIREPOWER; temporary_firepower = MilliSecs() + 10000 ' 10 seconds of firepower
  783.                         Case BONUS_TEMPORARY_SPEED; temporary_speed = MilliSecs() + 15000 ' 15 seconds of acceleration
  784.                         Case BONUS_TEMPORARY_INVULNERABILITY; temporary_invulnerability = MilliSecs() + 20000 ' 20 seconds of invulnerability
  785.                         Case BONUS_BOMB
  786.                                 For n1 = 2 To 4 ' Generation of splinters of a bomb
  787.                                         n2 = 0
  788.                                         While n2 < 360
  789.                                                 bullet_obj.create x#, y#, 1, n2, n1, (5 - n1) * 800, 35, player, player.size# * 0.4
  790.                                                 n2 = n2 + 10* (n1 - 1)
  791.                                         Wend
  792.                                 Next
  793.                         Case BONUS_ESOURCE
  794.                                 esource_collected = esource_collected + 1
  795.                                 If esource_collected = constant_bonus_crateq Then light = MilliSecs() + fading_time ' Yes there will be light if all mana will be collected
  796.                 End Select
  797.                 death = fading_time + MilliSecs()' Disappearance of a bonus
  798.                 coll_type = CT_IMMATERIAL ' The bonus becomes non - material
  799.         End Method
  800. End Type
  801.  
  802. SeedRnd MilliSecs()' That is for receive new sequence of random numbers each new program launch
  803.  
  804. SetGraphicsDriver GLMax2DDriver()' Setting the OpenGL graphics driver
  805. Graphics sxsize, sysize ', color_depth
  806. AutoImageFlags FILTEREDIMAGE | MIPMAPPEDIMAGE | DYNAMICIMAGE
  807. SetBlend ALPHABLEND
  808. reset_transformations
  809.  
  810. ' Loading images with an alpha-channel from an exe-file
  811. Global images:TPixmap = LoadPixmapPNG("incbin::new_images.png")
  812.  
  813. ' Creating images for tiles
  814. tex_water:TImage = tiles_grab(0, 1, False)
  815. tex_sand:TImage = tiles_grab(1, 1, False)
  816. tex_grass:TImage = tiles_grab(2, 1, False)
  817.  
  818. ' Cutting out images
  819. Global kolobok:TImage = tiles_grab(3, 3)
  820. Global bullet:TImage = tiles_grab(6)
  821. Global bonus:TImage = tiles_grab(7, 12)
  822. Global crate:TImage = tiles_grab(19)
  823. Global crate_bits:TImage = CreateImage(tilesize4, tilesize4, crate_bits_packq * 16)
  824. For n = 0 To 3
  825.         For yy = 0 To 3
  826.                 For xx = 0 To 3
  827.                         new_grab crate_bits, n * tilesize + xx * tilesize4, yy * tilesize4 + tilesize * 5, n * 16 + yy * 4 + xx
  828.                 Next
  829.         Next
  830. Next
  831. Global target:TImage = tiles_grab(24), targetx#, targety#
  832.  
  833. ' Creating water texture in a package of tiles
  834. tile_tex:TImage = CreateImage(tilesize, tilesize, 513)
  835. pixmap:TPixmap = LockImage(tile_tex, 0)
  836. pixmap.paste(LockImage(tex_water)), 0, 0
  837. UnlockImage tile_tex, 0
  838. UnlockImage tex_water
  839. ' Adding two libraries - transition from water to sand and from sand to a grass
  840. tile_lib_create tex_water, tex_sand, 4.0 / tilesize, 360.0, tile_tex, 1
  841. tile_lib_create tex_sand, tex_grass, 4.0 / tilesize, 720.0, tile_tex, 257
  842.  
  843. ' Making "slice pie" of layers
  844. Global layer_tiles:tile_layer_obj = tile_layer_obj.add(tile_tex)' all over again - tiley
  845. Global layer_bullets:object_layer_obj = object_layer_obj.add()' Then bullets and splinters of bombs
  846. Global layer_water_koloboks:object_layer_obj = object_layer_obj.add()' After - water koloboks
  847. Global layer_ground_koloboks:object_layer_obj = object_layer_obj.add()' Then - ground koloboks, crates and bonuses
  848. Global layer_top_scenery:object_layer_obj = object_layer_obj.add()' From above - splinters of crates
  849.  
  850. ' Creating layers of tile collisions
  851. Global layer_water:tile_collision_layer_obj = tile_collision_layer_obj.add()' the Layer of"firm"water
  852. Global layer_sand:tile_collision_layer_obj = tile_collision_layer_obj.add()' the Layer of"firm"sand
  853.  
  854. ' Defining what collides with what
  855. layer_water_koloboks.collides_with layer_water_koloboks ' Water koloboks - among themselves
  856. layer_water_koloboks.collides_with layer_sand ' Water koloboks - with a tile collision layer of sand
  857. layer_ground_koloboks.collides_with layer_ground_koloboks ' Ground koloboks - among themselves
  858. layer_ground_koloboks.collides_with layer_water ' Ground koloboks - with a tile collision layer of water
  859. layer_bullets.collides_with layer_water_koloboks ' Bullets - with ground koloboks
  860. layer_bullets.collides_with layer_ground_koloboks ' Bullets - with water koloboks
  861.  
  862. field_generate ' Generating a field
  863. Global player:player_obj = player_obj.create()' Creating the player
  864. objects_generate ' Creating koloboks and crates
  865.  
  866. HideMouse
  867.  
  868. sc# = 64.0
  869. fdx# = player.x + sxsize2 / sc#
  870. fdy# = player.y + sysize2 / sc#
  871. Repeat
  872.  
  873.         tim = MilliSecs()' Storing current moment of time
  874.        
  875.         MoveMouse sxsize2, sysize2 ' Setting the cursor of the mouse in the center of the screen
  876.  
  877.         ' 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)
  878.         camera_change 0.5 * targetx# * (teleport_mode = TM_IDLE), 0.5 * targety# * (teleport_mode = TM_IDLE), 1.1 ^ MouseZ() * 64.0
  879.        
  880.         player.angle = ATan2(targety#, targetx#)' Targetting player's sprite on a target
  881.  
  882.         timspeed# = speedpersec# * dtim# ' Definition of multiplier for the speed based of last cycle time
  883.         timang# = angpersec# * dtim# ' Same for angular speed
  884.  
  885.         ' Displaying layers
  886.         For l:layer_obj = EachIn layer_order
  887.                 l.draw
  888.         Next
  889.  
  890.         ' Actions of active objects
  891.         For o:base_obj = EachIn actingobj
  892.                 o.act
  893.         Next
  894.  
  895.         ' Displaying counters
  896.         DrawText"Frames / sec:" + fps + ", objects:" + objcnt + ", collision checks / frame:" + chcnt + ", collisions / frame:" + ccnt, 0, 0
  897.         ccnt = 0
  898.         chcnt = 0
  899.  
  900.         ' Displaying target
  901.         field2scr targetx# + player.x, targety# + player.y, sx#, sy#
  902.         DrawImage target, sx#, sy#
  903.  
  904.         ' Clarification of the screen after gathering all energy sources
  905.         If light > MilliSecs() Then
  906.                 ' Setting transparency
  907.                 SetAlpha 1.0 - 1.0 * (light - MilliSecs()) / fading_time
  908.                 ' Drawing also the white rectangular all-screen-wide
  909.                 DrawRect 0, 0, sxsize, sysize
  910.                 reset_transformations
  911.         ElseIf light <> 0 Then
  912.                 ' Congratulating player with a victory
  913.                 Notify"Congratulations!!!"
  914.                 End
  915.         End If
  916.  
  917.         Flip False
  918.  
  919.         ' Updating counters of the frames per second
  920.         If fpstim <= MilliSecs() Then
  921.                 fpstim = MilliSecs() + 1000
  922.                 fps = cnt
  923.                 cnt = 0
  924.         Else
  925.                 cnt:+1
  926.         End If
  927.  
  928.         If teleport_mode = TM_IDLE Then
  929.                 targetx# :+(MouseX() -sxsize2) / sc# ' Changing coordinates of a target
  930.                 targety# :+(MouseY() -sysize2) / sc#
  931.                 ' Restrictions on moving target far from player
  932.                 targetx# = limit(targetx#, Max(-sxsize / sc# * 0.75, -player.x), Min(sxsize / sc# * 0.75, fxsize - player.x))
  933.                 targety# = limit(targety#, Max(-sysize / sc# * 0.75, -player.y), Min(sysize / sc# * 0.75, fysize - player.y))
  934.         End If
  935.  
  936.         ' Calculation of time spent for a coil of a cycle(in seconds) for calculation of multipliers of speeds
  937.         dtim# = 0.001* (Min(MilliSecs() -tim, minms))
  938.         ' Time is limited for unallowing too big multipliers, negatively
  939.         ' affecting collisions
  940.  
  941. Until KeyHit(KEY_ESCAPE)
  942.  
  943. ' Generation of a field
  944. Function field_generate()
  945.         Const tile_water = 0
  946.         Const tile_sand = 256
  947.         Const tile_grass = 512
  948.         Local ff#[fxsize, fysize, 2]' Auxiliary buffer - heightmaps for tiles
  949.         Local pos2bit[] = [0, 6, 1, 4, 5, 2, 7, 3]
  950.         fmin# = 1.0; fmax# = 0 ' Variables of a minimum and a maximum of values of heights
  951.         For n = 0 To fblurq + 3
  952.                 loadingbar"Generating field...", n, fblurq + 4 ' the Indicator of completeness of process
  953.                 maxd# = 0
  954.                 For y = 0 Until fysize ' the Cycle on all tiles
  955.                         For x = 0 Until fxsize
  956.                                 Select n
  957.                                         Case 0 ' firstly we'll fill heighmap with random values
  958.                                                 ff#[x, y, 1] = Rnd(0, 1)
  959.                                         Case fblurq + 1 ' After stages of smoothing - tile layers formation stage
  960.                                                 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
  961.                                                 If d# < sand_threshold# Then ' Up to a threshold of sand
  962.                                                         layer_tiles.frame[x, y] = tile_water ' Displaying clean tile waters
  963.                                                         layer_water.collision[x, y] = True ' Setting a collision with this tile in a water layer
  964.                                                 ElseIf d# < grass_threshold# Then ' From a threshold of sand up to a threshold of a grass
  965.                                                         layer_tiles.frame[x, y] = tile_sand ' Displaying clean sand tile
  966.                                                         layer_sand.collision[x, y] = True ' Setting a collision with this tile in a layer of sand
  967.                                                 Else ' After a threshold of a grass
  968.                                                         layer_tiles.frame[x, y] = tile_grass ' Displaying clean grass tile
  969.                                                         layer_sand.collision[x, y] = True
  970.                                                 End If
  971.                                         Case fblurq + 2 ' Stage of elimination of the grass adjoining water
  972.                                                 If layer_tiles.frame[x, y] = tile_grass Then ' If tile is a grass,
  973.                                                         For yy = -1 To 1 ' the Cycle on all next tilem
  974.                                                                 For xx = -1 To 1
  975.                                                                         x2 = (x + xx + fxsize)Mod fxsize ' Calculation of coordinates of next tile
  976.                                                                         y2 = (y + yy + fysize)Mod fysize '(a field zatsikleno)
  977.                                                                         If layer_tiles.frame[x2, y2] = tile_water Then ' If one of tiles is water
  978.                                                                                 layer_tiles.frame[x, y] = tile_sand ' That changes grass tile on sand tile
  979.                                                                         End If
  980.                                                                 Next
  981.                                                         Next
  982.                                                 End If
  983.                                         Case fblurq + 3 ' Stage of smoothing tiles (a choice of the frame from library)
  984.                                                 If layer_tiles.frame[x, y] > tile_water Then ' If pure(clean)water this is passed(missed)tile
  985.                                                         bitpos = 0; mask = 0
  986.                                                         For yy = -1 To 1 ' the Cycle on all next tilem
  987.                                                                 For xx = -1 To 1
  988.                                                                         If xx <> 0 Or yy <> 0 Then
  989.                                                                                 x2 = (x + xx + fxsize) Mod fxsize
  990.                                                                                 y2 = (y + yy + fysize) Mod fysize
  991.                                                                                 If layer_tiles.frame[x, y] > tile_sand Then ' If ?urrent tile - a grass,
  992.                                                                                         ' If neighbour tile - a grass too then certain bit (of this neighbour) will be on in the current tile frame number
  993.                                                                                         If layer_tiles.frame[x2, y2] > tile_sand Then setbit mask, pos2bit[bitpos]
  994.                                                                                 Else ' Else it's sand tile
  995.                                                                                         ' If neighbour tile too then certain bit (of this neighbour) will be on in the current tile frame number
  996.                                                                                         If layer_tiles.frame[x2, y2] > tile_water Then setbit mask, pos2bit[bitpos]
  997.                                                                                 End If
  998.                                                                                 bitpos:+1 ' Increasing bit counter
  999.                                                                         End If
  1000.                                                                 Next
  1001.                                                         Next
  1002.                                                         layer_tiles.frame[x, y] = 1 + 256* (layer_tiles.frame[x, y] = tile_grass) + mask
  1003.                                                 End If
  1004.                                         Default ' Stages of smoothing of a heightmap
  1005.                                                 sum# = 0
  1006.                                                 For yy = -1 To 1 ' Summarizing values of heights of next tiles and height of current tile * 8
  1007.                                                         For xx = -1 To 1
  1008.                                                                 sum# = sum# + ff#[(x + xx + fxsize) Mod fxsize, (y + yy + fysize) Mod fysize, k] * (1.0 + 7.0* (xx = 0 And yy = 0))
  1009.                                                         Next
  1010.                                                 Next
  1011.                                                 sum# = sum# / 16.0 ' Calculating average value (central tile has the same weight, as all 8 next in the sum)
  1012.                                                 If n = fblurq Then setminmax sum#, fmin#, fmax# ' Correcting values of a maximum and a minimum of height
  1013.                                                 ff#[x, y, 1 - k] = sum# ' Setting value of height in the buffer
  1014.                                 End Select
  1015.                         Next
  1016.                 Next
  1017.                 k = 1 - k ' Swapping the buffer and a current map
  1018.                 If n = fblurq + 1 Then ' Fringing tilemap with water after a stage of formation of layers
  1019.                         For x = 0 Until fxsize
  1020.                                 waterize x, 0
  1021.                                 waterize x, fysize - 1
  1022.                         Next
  1023.                         For y = 0 Until fysize
  1024.                                 waterize 0, y
  1025.                                 waterize fxsize - 1, y
  1026.                         Next
  1027.                 End If
  1028.         Next
  1029. End Function
  1030.  
  1031. ' Fill tile with water
  1032. Function waterize(x, y)
  1033.         layer_tiles.frame[x, y] = 0 ' Displaying clean water tile
  1034.         layer_water.collision[x, y] = True ' Collision for water tile collision layer
  1035.         layer_sand.collision[x, y] = False ' No collision for sand tile collision layer
  1036. End Function
  1037.  
  1038. ' Creation of library tiles transition between structures
  1039. Function tile_lib_create(bottom_tile:TImage, top_tile:TImage, rowd#, period#, tile_lib:TImage, offset = 0)
  1040.         Local dt#[tilesize2] ' Filling array of fluctuations of border
  1041.         For dn = 0 Until tilesize2
  1042.                 dt#[dn] = (Sin(90 + dn * period# / tilesize2) - 1) * tilesize32
  1043.         Next
  1044.  
  1045.         bottom_pixmap:TPixmap = LockImage(bottom_tile)
  1046.         top_pixmap:TPixmap = LockImage(top_tile)
  1047.  
  1048.         For n = 0 To 255 ' Eight cells around tile can be same or different (2 variants),
  1049.                 ' therefore all - 2 ^ 8 = 256 variants
  1050.                 loadingbar "Generating transition tiles...", n, 256
  1051.                 lib_pixmap:TPixmap = LockImage(tile_lib, n + offset)
  1052.                 For n1 = 0 To 1
  1053.                         For n2 = 0 To 1
  1054.                                 v = biton(n, n1 + n2 * 2)
  1055.                                 vx = biton(n, n1 + 4)
  1056.                                 vy = biton(n, n2 + 6)
  1057.                                 For yy = 0 Until tilesize2
  1058.                                         For xx = 0 Until tilesize2
  1059.                                                 If vx Then
  1060.                                                         If vy Then
  1061.                                                                 If v Then
  1062.                                                                         k1# = 1
  1063.                                                                 Else
  1064.                                                                         k1# = rowd# * (Sqr(xx * xx + yy * yy))
  1065.                                                                 End If
  1066.                                                         Else
  1067.                                                                 k1# = (yy + dt#[xx]) * rowd#
  1068.                                                         End If
  1069.                                                 Else
  1070.                                                         If vy Then
  1071.                                                                 k1# = (xx + dt#[yy]) * rowd#
  1072.                                                         Else
  1073.                                                                 k1# = 2.0 - rowd# * (Sqr((tilesize2 - xx) * (tilesize2 - xx) + (tilesize2 - yy) * (tilesize2 - yy)) + Rand(-1, 1))
  1074.                                                         End If
  1075.                                                 End If
  1076.                                                 If k1# > 1 Then k1# = 1 ' we Limit factor within the limits of an interval[0, 1]
  1077.                                                 If k1# < 0 Then k1# = 0
  1078.                                                 k2# = 1.0 - k1# ' Coefficient of transparency for pixels of another tile
  1079.                                                 If n1 Then x = tilesize - 1 - xx Else x = xx ' Mirroring (if it is necessary)
  1080.                                                 If n2 Then y = tilesize - 1 - yy Else y = yy
  1081.                                                 fromrgba ReadPixel(top_pixmap, x, y), r1, g1, b1, dummy ' Receiving color components of tiles' pixels
  1082.                                                 fromrgba ReadPixel(bottom_pixmap, x, y), r2, g2, b2, dummy
  1083.                                                 ' Mixing colors with the set factors, then write pixel with resulting components
  1084.                                                 WritePixel lib_pixmap, x, y, torgba(k1# * r1 + k2# * r2, k1# * g1 + k2# * g2, k1# * b1 + k2# * b2, 255)
  1085.                                         Next
  1086.                                 Next   
  1087.                         Next
  1088.                 Next
  1089.         Next
  1090.  
  1091.         UnlockImage bottom_tile
  1092.         UnlockImage top_tile
  1093. End Function
  1094.  
  1095. ' Generation of crates and koloboks
  1096. Function objects_generate()
  1097.         ' Koloboks
  1098.         For n = 1 To kolobokq
  1099.                 If(n Mod 100) = 0 Then loadingbar"Generating objects...", n, kolobokq * 3
  1100.                 Repeat
  1101.                         o:kolobok_obj = kolobok_obj.create()
  1102.                         ' Distance up to the player should be not less than minimum
  1103.                         If Sqr((o.x - player.x) * (o.x - player.x) + (o.y - player.y) * (o.y - player.y)) >= min_enemy_distance Then Exit
  1104.                         o.destroy
  1105.                 Forever
  1106.         Next
  1107.        
  1108.         ' crates with constant bonuses
  1109.         For n1 = 1 To constant_bonustypeq ' Cycle on all types of bonuses
  1110.                 If(n Mod 100) = 0 Then loadingbar"Generating objects...", n1 + constant_bonustypeq, constant_bonustypeq * 3
  1111.                 For n2 = 1 To constant_bonus_crateq ' Creating certain quantity of crates of each type
  1112.                         crate_obj.create(n1 - 1)
  1113.                 Next
  1114.         Next
  1115.  
  1116.         ' crates with temporary bonuses
  1117.         For n = 1 To temporary_bonus_crateq
  1118.                 loadingbar"Generating objects...", n + temporary_bonus_crateq * 2, temporary_bonus_crateq * 3
  1119.                 If Rand(1, 100) > empty_crates_percent Then
  1120.                         crate_obj.create Rand(0, temporary_bonustypeq - 1) + bonus_threshold
  1121.                 Else
  1122.                         crate_obj.create - 1 ' the Part of crates are empty
  1123.                 End If
  1124.         Next
  1125. End Function
  1126.  
  1127. ' Adding nearly objects to the list
  1128. Function nearly_objects:TList(lst:TList, x, y, radius, layer:object_layer_obj)
  1129.         For yy = Max(y - radius, 0)To Min(y + radius, fysize - 1)
  1130.                 For xx = Max(x - radius, 0)To Min(x + radius, fxsize - 1)
  1131.                         For o:base_obj = EachIn(layer.objects[xx, yy])
  1132.                                 lst.addlast o
  1133.                         Next
  1134.                 Next
  1135.         Next
  1136.         Return lst
  1137. End Function
  1138.  
  1139. ' Function of a grabbing of the image from other image
  1140. Function new_grab:TImage(image:TImage, x, y, frame)
  1141.         pixmap:TPixmap = LockImage(image, frame)
  1142.         w:TPixmap = images.window(x, y, ImageWidth(image), ImageHeight(image))
  1143.         pixmap.paste w, 0, 0
  1144.         UnlockImage image
  1145.         Return image
  1146. End Function
  1147.  
  1148. ' Function of a grabbing tile or series of tiles from the image
  1149. Function tiles_grab:TImage(num, frameq = 1, midhn = True)
  1150.         image:TImage = CreateImage(tilesize, tilesize, frameq)
  1151.         If midhn Then MidHandleImage image ' the flag midhn means, that the image is necessary ottsentrovat
  1152.         For n = 0 To frameq - 1
  1153.                 pos = num + n
  1154.                 new_grab image, (pos Mod 4) * tilesize, Floor(pos / 4) * tilesize, n ' By default tiley settle down on the image in 4 columns
  1155.         Next
  1156.         Return image
  1157. End Function
  1158.  
  1159. Function reset_transformations()
  1160.         SetGrayColor 255
  1161.         SetRotation 0
  1162.         SetAlpha 1
  1163.         SetScale 1.0, 1.0
  1164. End Function
  1165.  
  1166. Function camera_change(x#, y#, scale#)
  1167.         ' Changing camera scaling and position
  1168.         sc# = sc# + magn_speed# * (scale# -sc#) * dtim#
  1169.         camx# = camx# + cam_speed# * (x# -camx#) * dtim#
  1170.         camy# = camy# + cam_speed# * (y# -camy#) * dtim#
  1171.  
  1172.         sc# = limit(sc#, Max(1.0 * sxsize / fxsize, 1.0 * sysize / fysize), 256.0)' Restriction of increasing scaling
  1173.         tilesc# = sc# / tilesize ' Calculation of factor of scaling for tiles
  1174.        
  1175.         xsize# = sxsize / sc# ' Sizes of a displayed rectangular piece of a field
  1176.         ysize# = sysize / sc#
  1177.        
  1178.         fdx# = limit(player.x + camx# -xsize# * 0.5, 0, fxsize - xsize#)' Restrictions of displacement of a screen field (within borders)
  1179.         fdy# = limit(player.y + camy# -ysize# * 0.5, 0, fysize - ysize#)
  1180. End Function
  1181.  
  1182. ' Setting color - a shade of grey
  1183. Function SetGrayColor(col)
  1184.         SetColor col, col, col
  1185. End Function
  1186.  
  1187. ' Strip displaying completeness of process
  1188. Function loadingbar(txt$, pos, maximum)
  1189.         Cls
  1190.         SetColor 128, 128, 255
  1191.         DrawText txt$, (sxsize - TextWidth(txt$)) / 2, sysize34
  1192.         col = 255 * pos / maximum
  1193.         SetGrayColor 255
  1194.         DrawEmptyRect sxsize4, sysize34 + 20, sxsize2, 30
  1195.         SetColor 255 - col, col, 0
  1196.         DrawRect sxsize4 + 2, sysize34 + 22, sxsize24 * pos / maximum, 26
  1197.         Flip False
  1198.         SetGrayColor 255
  1199. End Function
  1200.  
  1201. ' Function for drawing an empty rectangle
  1202. Function DrawEmptyRect(x#, y#, xsize#, ysize#)
  1203.         xsize# = xsize# -1
  1204.         ysize# = ysize# -1
  1205.         DrawLine x#, y#, x# + xsize#, y#
  1206.         DrawLine x# + xsize#, y#, x# + xsize#, y# + ysize#
  1207.         DrawLine x# + xsize#, y# + ysize#, x#, y# + ysize#
  1208.         DrawLine x#, y# + ysize#, x#, y#
  1209. End Function
  1210.  
  1211. ' Function for translation Write / ReadPixel - value to color components' values and an alpha of the channel
  1212. Function fromRGBa(from, r Var, g Var, b Var, a Var)
  1213.         b = from & $FF
  1214.         g = (from Shr 8) & $FF
  1215.         r = (from Shr 16) & $FF
  1216.         a = (from Shr 24) & $FF
  1217.         Return
  1218. End Function
  1219.  
  1220. ' Function for translation values of color components and an alpha - channel to Write / ReadPixel - value
  1221. Function toRGBa(r, g, b, a = 255)
  1222.         Return b | (g Shl 8) | (r Shl 16) | (a Shl 24)
  1223. End Function
  1224.  
  1225. ' Swapping values of two variables
  1226. Function swap(v1 Var, v2 Var)
  1227.         z = v2
  1228.         v2 = v1
  1229.         v1 = z
  1230. End Function
  1231.  
  1232. ' Change of a minimum and a maximum on the basis of a variable
  1233. Function setminmax(v#, vmin# Var, vmax# Var)
  1234.         If v# < vmin# Then vmin# = v#
  1235.         If v# > vmax# Then vmax# = v#
  1236. End Function
  1237.  
  1238. ' Translation from screen coordinates to field coordinates in tiles
  1239. Function scr2field(sx#, sy#, tx# Var, ty# Var)
  1240.         tx# = sx# / sc# + fdx#
  1241.         ty# = sy# / sc# + fdy#
  1242. End Function
  1243.  
  1244. ' Translation from field coordinates to screen
  1245. Function field2scr(tx#, ty#, sx# Var, sy# Var)
  1246.         sx# = (tx# - fdx#) * sc#
  1247.         sy# = (ty# - fdy#) * sc#
  1248. End Function
  1249.  
  1250. ' Making variable stay in limits of minumum and maximum values
  1251. Function limit# (v#, vmin#, vmax#)
  1252.         If v# < vmin# Then v = vmin# ElseIf v# > vmax# Then v# = vmax#
  1253.         Return v#
  1254. End Function
  1255.  
  1256. ' Function returns state of a bit in value at number bitnum
  1257. Function biton(v, bitnum)
  1258.         If v & (1 Shl bitnum) Then Return True Else Return False
  1259. End Function
  1260.  
  1261. ' Setting on a bit at number bitnum in value of a variable
  1262. Function setbit(v Var, bitnum)
  1263.         v = v | (1 Shl bitnum)
  1264. End Function
  1265.  
  1266. ' Calculation of the minimal difference of angles
  1267. Function calc_dangle# (ang1#, ang2#)
  1268.         dang# = ang2# - ang1#
  1269.         Return dang# - Floor(dang# / 360 + 0.5) * 360
  1270. End Function


Comments :


Jesse(Posted 1+ years ago)

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


Matt Merkulov(Posted 1+ years ago)

 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:[img]forum.boolean.name/images/koloboks1.html">[img]forum.boolean.name/images/koloboks2.html">[img]forum.boolean.name/images/koloboks3.html">


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal