'' ----------------------------------------------------------------------------
'' Game: ANUS
'' From Tiranas
'' ----------------------------------------------------------------------------

Randomize Timer

#include "./WorldSim3D.bi"
#include "./SampleFunctions.bi"

#define CAMERA_SPEED 1.8f

Dim Shared As int32 bunit1 = 0
Dim as Int32 prevFPS 		= 0
dim Shared As wColor4s  sceneColor = (255,99,99,99)
dim Shared As wVector2i fromPos	= (120,80)
dim Shared As wVector2i toPos		= (250,96)
Dim as wEngineCreationParameters startParams
dim as String wndCaption 	= "Game: ANUS  FPS: "
Dim as String metrics
Dim Shared As wVector3f vec1, vec2, pos1, tag1
Dim Shared As wVector3f pos_m
Dim Shared As Byte pos_o
Dim Shared As int32 ch_err1
Dim Shared As int32 itmp = 0
Dim Shared As int32 uMax = 3    ' Кол-во врагов уровня
Dim Shared As int32 units = 0   ' Кол-во текущих врагов
Dim Shared As int32 cMax  = 12  ' Кол-во кристаллов
Dim Shared As int32 hHits = 3   ' Кол-во жизней
Dim Shared As int32 hCrys = 0   ' Кол-во собранных кристалов
Dim Shared As int32 hLevel = 0  ' Номер уровня
Dim Shared As Single eeShag = 8  ' Шаг для героя в пикселях
Dim Shared As Single euShag = 1  ' Шаг юнита в пикселях
Dim Shared As Single eeGrav = 3  ' гравитация героя в пикселях
Dim Shared As Single euGrav = 2  ' гравитация юнита в пикселях
'Dim Shared As wSelector CombinedCollision = 0
'Dim Shared As wAnimator ColAnimatDwarf    	    = 0

'-----------------------------------------------------------------------------
' Старт движка
'-----------------------------------------------------------------------------
Dim as Boolean init=wEngineStartWithGui("Game: ANUS",_
										"./data/fonts/MSSanSerif10.xml",_
										"./data/fonts/logo_490_x_190.png",_
										wL_EN,_
										@startParams,_
										@"outConfig.xml")

if Not init then
	PrintWithColor("wEngineStart() failed!"): End
endif
'///Show engine logo
wEngineShowLogo(FALSE)

  ' Размер рабочего окна 
	Dim Shared As wVector2u rWinSize
	wWindowGetSize(@rWinSize)


Dim as String  fontPath = "./data/fonts/Cyr.xml"
CheckFilePath(fontPath)
Dim Shared As wFont  BitFont  = 0
BitFont = wFontLoad(fontPath)

fontPath = "./data/fonts/myfont1.xml"
CheckFilePath(fontPath)
Dim Shared As wFont  font01 = 0
font01 = wFontLoad(fontPath)

Dim as String  cube_texture01_path = "./data/tex/Brick.jpg"
CheckFilePath(cube_texture01_path)
Dim Shared As wTexture  cube_texture01
cube_texture01 = wTextureLoad(cube_texture01_path)

Dim Shared As String  portal_tex01_path
portal_tex01_path = "./data/tex/PortClose.png"
CheckFilePath(portal_tex01_path)

  Dim Shared As String dwarf2_path
  dwarf2_path = "./data/model/dwarf2.b3d"
  CheckFilePath(dwarf2_path)

  Dim As String war1_pic_path = "./data/tex/img_unit_01.png"
  CheckFilePath(war1_pic_path)
  Dim Shared As wTexture war1_pic_tex
  war1_pic_tex = wTextureLoad(war1_pic_path)

  Dim As String her1_pic_path = "./data/tex/img_hero_01.png"
  CheckFilePath(her1_pic_path)
  Dim Shared As wTexture her1_pic_tex
  her1_pic_tex = wTextureLoad(her1_pic_path)

  Dim As String crs1_pic_path = "./data/tex/img_crys_01.png"
  CheckFilePath(crs1_pic_path)
  Dim Shared As wTexture crs1_pic_tex
  crs1_pic_tex = wTextureLoad(crs1_pic_path)

  Dim As String glow_path = "./data/tex/glow.jpg"
  CheckFilePath(glow_path)
  Dim Shared As wTexture glow_tex
  glow_tex = wTextureLoad(glow_path)

  ' Sky
  '------------------------------------------------------------------------------------
  Dim as String skyTexPath(5)
  skyTexPath(0)= "./data/tex/sky4/desert_up.jpg"
	skyTexPath(1)= "./data/tex/sky4/desert_dn.jpg"
	skyTexPath(5)= "./data/tex/sky4/desert_ft.jpg"
	skyTexPath(4)= "./data/tex/sky4/desert_rt.jpg"
	skyTexPath(3)= "./data/tex/sky4/desert_lf.jpg"
	skyTexPath(2)= "./data/tex/sky4/desert_bk.jpg"
  For i As Int32 = 0 To 5
    CheckFilePath(skyTexPath(i))
  Next i
  Dim as wTexture SkyTexture(5)
  For i As Int32 = 0 To 5
    SkyTexture(i)=wTextureLoad(skyTexPath(i))
  Next i
  Dim as wNode SkyBox = 0
  SkyBox = wSkyBoxCreate(SkyTexture(0), SkyTexture(1), SkyTexture(2), SkyTexture(3), SkyTexture(4), SkyTexture(5))
  '------------------------------------------------------------------------------------

  Dim As String ant01_path
  ant01_path = "./data/model/ant01.b3d"
  CheckFilePath(ant01_path)
  Dim As wMesh mDunit
	mDunit = wMeshLoad (ant01_path, FALSE)
	Dim Shared As wNode dunit 
  dunit = wNodeCreateFromMesh (mDunit)
  pos1.x = 3.5f: pos1.y = 3.5f: pos1.z = 3.5f
  wNodeSetScale (dunit, pos1)
  wNodeSetVisibility (dunit, FALSE)
  
  'Dim As String unit1_path = "./data/model/ant1.jpg"
  'CheckFilePath(unit1_path)
  'Dim Shared As wTexture unit1_tex
  'unit1_tex = wTextureLoad(unit1_path)
  '
  '  Dim as wMaterial material
  '  For j As int32 = 0 to wNodeGetMaterialsCount(dunit) - 1
  '     material = wNodeGetMaterial(dunit, j)
  '     wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
  '     wMaterialSetTexture(material, j, unit1_tex)
  '  Next j


  Dim As wNode Light1
  pos1.x = 1500.0f: pos1.y = 1500.0f: pos1.z = 0.0f
  Dim As wColor4f col1 = (0.0f, 0.0f, 0.3, 1.0f)
  Light1 = wLightCreate (pos1, col1, 2000.0f)
  
  Dim As String crys01_path
  crys01_path = "./data/model/Crystal_02.obj"
  CheckFilePath (crys01_path)
  Dim As wMesh mCrys
	mCrys = wMeshLoad (crys01_path, FALSE)
	'wMeshFlipSurface (mCrys)
	Dim Shared As wNode dcrys
  dcrys = wNodeCreateFromMesh (mCrys)
  pos1.x = 0.2f: pos1.y = 0.2f: pos1.z = 0.2f
  wNodeSetScale (dcrys, pos1)
    Dim As String crys01_tex_path = "./data/model/Crystal_02.png"
    CheckFilePath (crys01_tex_path)
    Dim Shared As wTexture crys01_tex
    crys01_tex = wTextureLoad (crys01_tex_path)
    Dim as wMaterial material
    For j As int32 = 0 to wNodeGetMaterialsCount(dcrys) - 1
      material = wNodeGetMaterial (dcrys, j)
      wMaterialSetFlag (material, wMF_LIGHTING, TRUE)
        wMaterialSetType(material, wMT_TRANSPARENT_ALPHA_CHANNEL) 
  	    'wMaterialSetType(material, wMT_TRANSPARENT_ALPHA_CHANNEL_REF)
		    wMaterialSetTexture (material, j, crys01_tex)
		    'wMaterialSetType(material, wMT_TRANSPARENT_ADD_COLOR)
    Next j
    pos1.x = 0.0f: pos1.y = 0.5f: pos1.z = 0.0f
    Dim As wAnimator an_crys = wAnimatorRotationCreate (dcrys, pos1)
  wNodeSetVisibility (dcrys, FALSE)
  
  '---------------------------------------------------------------------
  ' Создание камеры
  '---------------------------------------------------------------------
  'Camera=wFpsCameraCreate(100.f,CAMERA_SPEED)
  Public Const zPosCam As Long = -600 ' Стандартное расстояние камеры от игрового поля
  Public Const As int32 time_restore_box = 4000 ' время Восстановления куба 
  Dim Shared As Long z_cam = -600
  Dim Shared As wNode Camera = 0
  'Camera=wFpsCameraCreate(100, CAMERA_SPEED, @wKeyMapDefault(1), 8, FALSE, 0)
  pos1.x = 1000: pos1.y = 600: pos1.z = -1000
  tag1.x = 1000: tag1.y = 600: tag1.z = 510
  Camera = wCameraCreate(pos1, tag1)

  wCameraSetClipDistance(Camera, 70000, 1)
  'vec1.x = 1000: vec1.y = 600: vec1.z = -1000
  'wNodeSetPosition (Camera, vec1)
  'vec1.x = 1000: vec1.y = 600: vec1.z = 510
  'wCameraSetTarget (camera, vec1)


Public Const xMax As Long = 30
Public Const yMax As Long = 20


Type tMap1
	Obj As Byte
	nObj As int32
	node As wNode
	'body As physics_obj
	not_vis As Byte
	time1 As UInt32
	lean(0 To 4) As wNode
End Type
Dim Shared Map1(-2 To xMax + 2, -2 To yMax + 10) As tMap1
Dim Shared Map2(-2 To xMax + 2, -2 To yMax + 10) As tMap1

Type tNotVisBox
  x As int32
  y As int32
  n As Byte
End Type
Dim Shared box_not_vis() As tNotVisBox

Type tPortal
	spr As wNode
	lig As wNode
	txt As wTexture
	As Long x, y, z
	As Byte iOpen
End Type
Dim Shared port1 As tPortal

Type tUnit
	Obj As Byte
	node As wNode
	hits As int32
	As int32 x, x1, x3, pos_dw_x
	As int32 y, y1, y3, pos_dw_y
	vec As Byte
End Type
Dim Shared unit(0 To 12) As tUnit
Dim Shared crys() As tUnit

Type tPE1
	As wNode p1, p2
	As wEmitter e1, e2
	As wAnimator anim(0 To 1)
End Type
Dim Shared ParEmi1(1 To 5) As tPE1

Dim Shared mDwarf As wMesh
Dim Shared dwarf as wNode
Dim Shared dwarf_px as wNode
Dim Shared dwarf_pl as wNode
Dim Shared As float32 bdworf_ani = 0
Dim Shared pv() As wNode

'------------------------------------------------------------------------------
#include "./Sound.bas"
#Include "./FindPath_Volna.bi"
#Include "./Logo.bas"
'------------------------------------------------------------------------------


Declare Function rndi(first As long, last As long) As Long
Declare Sub SetMaterial1(material as wMaterial)
Declare Sub CreateCube64_12(x As Long, y As Long, z As Long = 0, r As Long = 255, g As Long = 255, b As Long = 255) ' Create standart cube 64
Declare Sub CreateLadder1(x As long, y As long, z As Long)
Declare Sub CreatePortalClose1(x As long, y As long, z As Long) ' Создание закрытого портала
Declare Sub OpenPortale(x As int32, y As int32, z As int32 = 0) ' Открытие портала
Declare Sub CreateMap1()          ' Создать карту
Declare Function ControlEndAttac1(EndFrame As Float32) As boolean
Declare Sub dworf_ani(i As int32, speed As Float32)  ' Анимация гнома
Declare Sub DelObjMap1(x As int32, y As int32)       ' Удалить объект с карты
Declare Sub DestroyCube1()        ' Разрушить куб 1
Declare Sub SetRndPosPla1()       ' Поместить хероя в произвольную, свободную позицию
Declare Sub CreatePla1()          ' Создать хероя
Declare Sub SetCamera1()          ' Установить камеру
Declare Function GaviPosDraw(node As wNode, eGrav As Single) As boolean ' Гравитация
'Declare Function ControlCollisia(node_a As wNode, LeftRightUpDown As int32) As boolean ' Контроль пересечения с объектами
Declare Function ControlColB(node_a As wNode, LeftRightUpDown As int32, shag As Single) As boolean
Declare Sub ControlPosDwarf(node As wNode, LeftRightUpDown As int32, eShag As Single, NoSound As int32) ' Перемещение героя
Declare Sub Interface1()          ' Информационная панель
Declare Sub CreateUnits()         ' Создать врагов
Declare Sub dunit_ani(i As int32, inode As int32, speed As Float32 = 15) ' Анимация врагов
Declare Sub DelUnit(i As int32)   ' Удаление врага
Declare Sub DelAllUnits()         ' Удаление всех врагов
Declare Sub SetRndPosUnit(unit As tUnit) ' Поместить врага в произвольную, свободную позицию
Declare Sub TransPosWar1()          ' Контроль позиции врагов
Declare Sub GameEnd1()              ' Херой погиб
Declare Sub RestoreBox1()           ' Восстановление кубов по времени
Declare Sub Add_box_not_vis(x As int32, y As int32) ' Добавить идентификатор разрушенного куба
Declare Sub CreateCrystals()        ' Создать кристаллы
Declare Sub GetPathUnit(i As int32, NewPos As int32 = 0, NotPath As int32 = 1, RndPos As int32 = 0) ' Просчитать путь для юнита
Declare sub Get3DTextPosition(ByVal font As wFont, ByVal text As Const WString ptr, ByVal target As wNode, ByVal p1 As wVector2i ptr, ByVal p2 As wVector2i Ptr)
Declare sub OpenPortale1() ' Открытие портала
Declare Sub ClsPortal()    ' Удалить портал
Declare Sub ClearLevel()   ' Очистка
Declare sub NewGame()      ' Новый уровень
Declare Sub TransUnit1(i As int32 = 1)
  
Dim KeyEvent as wKeyEvent Ptr
Dim Shared As int32 nBegToButton1, nBegToButton2, vb_x = 0, vb_y = 0
Dim Shared As int32 Pla1_Vector
Dim Shared As boolean SetAttac1 = FALSE


'CombinedCollision = wCollisionGroupCreate()

'------------------------------------
SetLogo1() ' Пказать Лого
'------------------------------------

NewGame()  ' Новый уровень

while(wEngineRunning())
	
	wSceneBegin(sceneColor)
	
		
  wNodeAnimateJoints (dwarf)
  For i As int32 = 1 To uMax
    wNodeAnimateJoints (unit(i).node)
  Next i
  
	wSceneDrawAll()


		Do While wInputIsKeyEventAvailable
      KeyEvent = wInputReadKeyEvent
      Select case as const KeyEvent->key
        Case wKC_KEY_1
          'if KeyEvent->direction = wKD_UP Then
          '  TransUnit1()
            'GetPathUnit(1, 1, 0) ' Просчитать путь для юнита
          'EndIf
        Case wKC_KEY_2
          'if KeyEvent->direction = wKD_UP Then GetPathUnit(2, 1, 0) ' Просчитать путь для юнита
        Case wKC_KEY_3
          'if KeyEvent->direction = wKD_UP Then GetPathUnit(3, 1, 0) ' Просчитать путь для юнита
        Case wKC_KEY_C ' Контроль звуков          
          'crash_hero()
        Case wKC_KEY_X
          if KeyEvent->direction = wKD_UP Then
            'pos_m = wNodeGetAbsoluteRotation (unit(1).node)
            'pos_m.x = pos_m.x + 90
            'If pos_m.x > 360 Then pos_m.x = 0 
            'wNodeSetAbsoluteRotation (unit(1).node, pos_m)
            'pos_m = wNodeGetAbsoluteRotation (unit(1).node)
          EndIf
        Case wKC_KEY_Y
          if KeyEvent->direction = wKD_UP Then
            'pos_m = wNodeGetAbsoluteRotation (unit(1).node)
            'pos_m.y = pos_m.y + 90
            'If pos_m.y > 360 Then pos_m.y = 0 
            'wNodeSetAbsoluteRotation (unit(1).node, pos_m)
            'pos_m = wNodeGetAbsoluteRotation (unit(1).node)
          EndIf
        Case wKC_KEY_Z
          if KeyEvent->direction = wKD_UP Then
            'pos_m = wNodeGetAbsoluteRotation (unit(1).node)
            'pos_m.z = pos_m.z + 90
            'If pos_m.z > 360 Then pos_m.z = 0 
            'wNodeSetAbsoluteRotation (unit(1).node, pos_m)
            'pos_m = wNodeGetAbsoluteRotation (unit(1).node)
          EndIf
        Case wKC_KEY_T
      		if KeyEvent->direction = wKD_DOWN Then
      			'OpenPortale1() ' Открытие портала
      			Exit Do
      		EndIf
        Case wKC_PLUS, wKC_ADD       ' Для камеры (приблизить)
      		z_cam += 20: If z_cam > -100 Then z_cam = -100
      		SetCamera1()
        Case wKC_MINUS, wKC_SUBTRACT ' Для камеры (отдалить)
      	  z_cam -= 20: If z_cam < -2000 Then z_cam = -2000
      	  SetCamera1()
        Case wKC_RETURN              ' Для камеры (восстановить расстояние)
      		z_cam = zPosCam
      		SetCamera1()
        Case wKC_KEY_I               ' Снимок экрана
      		wSystemSaveScreenShot(@"./_Screen001.jpg")
        Case wKC_KEY_A, wKC_LEFT, wKC_NUMPAD4   ' Анимация гнома Left
          nBegToButton1 = 0: vb_x = 0: vb_y = 0
          vb_x = -300: nBegToButton1 += 1: nBegToButton2 = 0: Pla1_Vector = 1: SetAttac1 = FALSE
          dworf_ani(1, 15)
          'bdworf_ani = 1
          ControlPosDwarf(dwarf, 1, eeShag, 0)
          pos1.x = 0: pos1.y = -90: pos1.z = 0
	        wNodeSetAbsoluteRotation (dwarf, pos1)
          if KeyEvent->direction = wKD_UP Then
            dworf_ani(0, 15)
          EndIf
        Case wKC_KEY_D, wKC_RIGHT, wKC_NUMPAD6  ' Анимация гнома Right
      		nBegToButton1 = 0: vb_x = 0: vb_y = 0
					vb_x = 300: nBegToButton1 += 1: nBegToButton2 = 0: Pla1_Vector = 2: SetAttac1 = FALSE
					dworf_ani(1, 15)
					'bdworf_ani = 2
					ControlPosDwarf(dwarf, 2, eeShag, 0)
          pos1.x = 0: pos1.y = 90: pos1.z = 0	
	        wNodeSetAbsoluteRotation (dwarf, pos1)
					if KeyEvent->direction = wKD_UP Then
					  dworf_ani(0, 15)
					EndIf
        Case wKC_KEY_W, wKC_UP, wKC_NUMPAD8     ' Анимация гнома Up
      		nBegToButton1 = 0: vb_x = 0: vb_y = 0
					vb_x = 300: nBegToButton1 += 1: nBegToButton2 = 0: Pla1_Vector = 3: SetAttac1 = FALSE
					dworf_ani(1, 15)
					'bdworf_ani = 3
					ControlPosDwarf(dwarf, 3, eeShag, 0)
          pos1.x = 0: pos1.y = 0: pos1.z = 0	
	        wNodeSetAbsoluteRotation (dwarf, pos1)
					if KeyEvent->direction = wKD_UP Then
					  dworf_ani(0, 15)
					EndIf
        Case wKC_KEY_S, wKC_DOWN, wKC_NUMPAD2   ' Анимация гнома Down
      		nBegToButton1 = 0: vb_x = 0: vb_y = 0
					vb_x = 300: nBegToButton1 += 1: nBegToButton2 = 0: Pla1_Vector = 4: SetAttac1 = FALSE
					dworf_ani(1, 15)
					'bdworf_ani = 4
					ControlPosDwarf(dwarf, 4, eeShag, 0)
          pos1.x = 0: pos1.y = 180: pos1.z = 0	
	        wNodeSetAbsoluteRotation (dwarf, pos1)
					if KeyEvent->direction = wKD_UP Then
					  dworf_ani(0, 15)
					EndIf
        Case wKC_LCONTROL, wKC_RCONTROL, wKC_SPACE ' Анимация удара сверху
          If Not SetAttac1 Then
            SetAttac1 = TRUE: dworf_ani(2, 20)
          End If
        Case Else
          'Pla1_Vector = 0
          'dworf_ani(0)
      End Select
		Loop
		
		If SetAttac1 Then
		  If ControlEndAttac1(140) Then ' Конец анимаации удара сверху
	      SetAttac1 = FALSE: DestroyCube1() ' Разрушить куб 1
		  EndIf
		EndIf
		
      GaviPosDraw(dwarf, eeGrav) ' Гравитация героя
	  
	    TransPosWar1() ' Контроль позиции врагов
	    
	    RestoreBox1()  ' Восстановление кубов по времени
	    
	'------------------------------------------------------
	Interface1() ' Информационная панель
  '------------------------------------------------------

      'metrics ="tmp: " + Str(Int(itmp))      
      'fromPos.x = 20: fromPos.y = 70: toPos.x = 600: toPos.y = 100
      'wFontDraw(BitFont, metrics, fromPos, toPos)
  
      'vec1 = wNodeGetPosition(Camera)
      'metrics ="Camera Position: x: " + Str(Int(vec1.x)) + " y: " + Str(Int(vec1.y)) + " z: " + Str(Int(vec1.z)) 
      'fromPos.y+=30: toPos.y+=30
      'wFontDraw(BitFont, metrics, fromPos, toPos)
	    
      'vec1 = wCameraGetTarget(Camera)
      'metrics ="Camera Target: x: " + Str(Int(vec1.x)) + " y: " + Str(Int(vec1.y)) + " z: " + Str(Int(vec1.z))      
      'fromPos.y+=30: toPos.y+=30
      'wFontDraw(BitFont, metrics, fromPos, toPos)

      'metrics ="pos_m.x: " + Str(Int(pos_m.x)) + " y: " + Str(Int(pos_m.y)) + " z: " + Str(Int(pos_m.z)) + " Obj: " + Str(Int(pos_o))      
      'fromPos.y+=30: toPos.y+=30
      'wFontDraw(BitFont, metrics, fromPos, toPos)

      'metrics ="tmp: " + Str(Int(itmp))      
      'fromPos.y+=30: toPos.y+=30
      'wFontDraw(BitFont, metrics, fromPos, toPos)

      ' Названия над юнитами
      For i As int32 = 1 To UBound(unit)
        If unit(i).node <> 0 And unit(i).hits > 0 Then
          Dim as const zstring ptr nodeName = wNodeGetName(unit(i).node)
          Dim As string modelCaption = *nodeName
          Get3DTextPosition(BitFont, modelCaption, unit(i).node, @fromPos, @toPos)
          wFontDraw(BitFont, modelCaption, fromPos, toPos, wCOLOR4s_WHITE)
        End If
      Next i

      '  metrics ="dworf_ani: " & Str(bdworf_ani)      
      '  fromPos.y+=30: toPos.y+=30
      '  wFontDraw(BitFont, metrics, fromPos, toPos)

       
  SetCamera1() ' Установка камеры
  
    
	wSceneEnd()
	
	'///Close by ESC
	wEngineCloseByEsc()
	
	'///Update fps
	if prevFPS <> wEngineGetFPS() then
		prevFPS = wEngineGetFPS()
		wWindowSetCaption(wndCaption + Str(prevFPS))
	EndIf
	
Wend

'///Stop engine
wEngineStop()

end




Sub NewGame()       ' Новый уровень
  hLevel += 1
  ClearLevel()      ' Очистка
  '------------------------------------
  CreateMap1()      ' Создать карту
  CreatePla1()      ' Создать героя
  CreateCrystals()  ' Создать кристаллы
  CreateUnits()     ' Создать врагов
End Sub



Sub ClsPortal()     ' Удалить портал
  For i As int32 = 1 To 5
  	If ParEmi1(i).p1 <> 0 Then wNodeDestroy(ParEmi1(i).p1)
  	If ParEmi1(i).p2 <> 0 Then wNodeDestroy(ParEmi1(i).p2)
  	ParEmi1(i).e1 = 0: ParEmi1(i).p1 = 0: ParEmi1(i).e2 = 0: ParEmi1(i).p2 = 0
  	'If ParEmi1(i).anim(0) <> 0 Then
  	'  wNodeDestroy(ParEmi1(i).anim(0))
  	'EndIf
  	'If ParEmi1(i).anim(1) <> 0 Then
  	'  wNodeDestroy(ParEmi1(i).anim(1))
  	'EndIf
  Next
  'wNodeDestroy(pivot_portal1)
  'pivot_portal1 = 0
End Sub


Sub ClearLevel() ' Очистка

  ClsPortal()     ' Удалить портал
  If port1.spr <> 0 Then
    wNodeDestroy(port1.spr)
    port1.spr = 0
  EndIf
  If port1.lig <> 0 Then
    wNodeDestroy(port1.lig)
    port1.lig = 0
  EndIf

  For i As int32 = 1 To UBound(unit)
    If unit(i).node <> 0 Then 
      wNodeDestroy(unit(i).node)
      unit(i).node = 0
    EndIf
  Next
  For i As int32 = 1 To UBound(crys)
    If crys(i).node <> 0 Then
      wNodeDestroy(crys(i).node)
      crys(i).node = 0
    EndIf
  Next
  hCrys = 0
  
  For y As int32 = 0 To yMax
    For x As int32 = 0 To xMax
      If Map1(x, y).node <> 0 Then
        wNodeDestroy(Map1(x, y).node)
        Map1(x, y).node = 0
      EndIf
      If Map2(x, y).node <> 0 Then
        wNodeDestroy(Map2(x, y).node)
        Map2(x, y).node = 0
      EndIf
      For j As int32 = 0 To 4
        If Map1(x, y).lean(j) <> 0 Then
          wNodeDestroy(Map1(x, y).lean(j))
          Map1(x, y).lean(j) = 0
        EndIf
      Next
    Next
  Next
  Erase Map1
  Erase Map2
  
  
  
  
End Sub








Sub SetCamera1() ' Установить камеру в позицию
  Dim as wVector3f p, t
  
  p = wNodeGetPosition(dwarf)  
  t.x = p.x: t.y = p.y + 50: t.z = 0
  wCameraSetTarget(Camera, t)
  'wSetNodeRotation(camera, 0, 180, 0)
  p.y = p.y + 40: p.z = z_cam
  wNodeSetPosition(Camera, p)
End Sub

Function rndi(first As long, last As long) As Long
  Return Int(Rnd * (last - first + 1)) + first
End Function

Sub CreateMap1() ' Создать карту
  Dim As Long i, xBeg, yBeg, lBeg, x, x2, y, y2, n, k
  Dim As Byte p1
  
  For i = 1 To 15
  	n = 0
  	Do
  		xBeg = rndi(2, xMax-2): yBeg = rndi(2, yMax-2)
  		If Map1(xBeg, yBeg).Obj = 0 Then Exit Do
  		n += 1: If n > 200 Then Exit Do
  	Loop
  	If n > 200 Then Exit For
  	
  	lBeg = rndi(1, xMax Shr 1)
  	If (xBeg + lBeg) >= (xMax-4) Then lBeg = xMax - xBeg - 3
  	n = 0 
  	For k = xBeg + 1 To xBeg + lBeg
  		If Map1(k, yBeg).Obj = 0 Then
  			n += 1
  		Else
  			Exit For
  		EndIf
  	Next
  	lBeg = n
  	
  	For x = xBeg To xBeg + lBeg
  		Map1(x, yBeg).Obj = 1  ' Куб-платформа
  		Map2(x, yBeg).Obj = 1
  		If x = xBeg Then
  			'CreateCube64_12(x, yBeg, 0, 255, 0, 0)
  			CreateCube64_12(x, yBeg, 0, 150, 150, 150)
  		ElseIf x = xBeg + lBeg Then
  			'CreateCube64_12(x, yBeg, 0, 0, 0, 255)
  			CreateCube64_12(x, yBeg, 0, 150, 150, 150)
  		Else
  			CreateCube64_12(x, yBeg, 0, 150, 150, 150)
  		EndIf
  	Next
  Next

  ' самый нижний ряд (ограничитель)
  y = 0
  For x = 0 To xMax
		CreateCube64_12(x,y,0, 99,99,99)		
		Map1(x, y).Obj = 99  ' Куб-платформа
		Map2(x, y).Obj = 99  ' Куб-платформа
  Next
  ' самый Верхний ряд (ограничитель)
  y = yMax
  For x = 0 To xMax
		CreateCube64_12(x,y,0, 99,99,99)
		Map1(x, y).Obj = 98  ' Куб-платформа
		Map2(x, y).Obj = 98  ' Куб-платформа
  Next
  ' левый ряд (ограничитель)
  x = 0
  For y = 1 To yMax - 1
		CreateCube64_12(x,y,0, 99,99,99)
		Map1(x, y).Obj = 98  ' Куб-платформа
		Map2(x, y).Obj = 98  ' Куб-платформа
  Next
  ' Правый ряд (ограничитель)
  x = xMax
  For y = 1 To yMax - 1
		CreateCube64_12(x,y,0, 99,99,99)
		Map1(x, y).Obj = 98  ' Куб-платформа
		Map2(x, y).Obj = 98  ' Куб-платформа
  Next
  
  ' Создание лестниц  
  For y = 1 To yMax-1
  	For x = 1 To xMax-1		
	  	If Map1(x, y).Obj = 1 Then
	  		x2 = x - 1
	  		If x2 > 0 Then
  				If Map1(x2, y).Obj = 0 Or Map1(x2, y).Obj = 2 Then
	  				For y2 = y + 1 To 1 Step -1
  						If Map1(x2, y2).Obj = 0 Then
  							CreateLadder1(x2, y2, 30)
  							Map1(x2, y2).Obj = 2 ' Лестница
  							Map2(x2, y2).Obj = 2 ' Лестница
  						Else
  							Exit For
  						End If
	  				Next
  				End If
	  		End If
  			x2 = x + 1
  			If x2 < xMax Then
  				If Map1(x2, y).Obj = 0 Or Map1(x2, y).Obj = 2 Then
  					For y2 = y + 1 To 1 Step -1
  						If Map1(x2, y2).Obj = 0 Then
  							CreateLadder1(x2, y2, 30)
  							Map1(x2, y2).Obj = 2 ' Лестница
  							Map2(x2, y2).Obj = 2 ' Лестница
  						Else
  							Exit For
  						End If
  					Next
  				End If
  			End If
  		End If
  	Next
  Next
  
  ' Создание закрытого портала
  Do
  	x = rndi(2, xMax-2): y = rndi(2, yMax-2)
  	p1 = Map1(x, y).Obj
  	If p1 <> 2 And p1 <> 1 And p1 <> 99 Then
  		p1 = Map1(x, y - 1).Obj
  		If p1 = 1 Or p1 = 99 Then
  			CreatePortalClose1(x, y, 0)
  			Map2(x, y).Obj = 100 ' Закрытый портал
  		  Exit Do
  		EndIf
  	EndIf
  Loop
End Sub


Sub CreateCube64_12(x As Long, y As Long, z As Long = 0, r As Long = 255, g As Long = 255, b As Long = 255)
  ' Create standart cube 64
  Dim As wNode node
  Dim as wMaterial material
  Dim as wVector3f pos1
  'Dim as wSelector sel1
  'Dim As physics_obj PhysTest
  'Dim As wColor4s col1 = (r, g, b, 0)
  Dim As wColor4s col1 = (0, r, g, b)
  node = wNodeCreateCube(64, FALSE, col1)
  'node = wNodeCreateCube(64, TRUE, col1) 
    material = wNodeGetMaterial(node, 0)
    SetMaterial1(material)
    wMaterialSetTexture(material, 0, cube_texture01)
    pos1.x = x*64: pos1.y = y*64: pos1.z = z
    wNodeSetPosition (node, pos1)     
  	Map1(x, y).node = node
		'PhysicsCreateBox(Map1(x, y).mesh, PhysTest, 0)
		'Map1(x, y).body = PhysTest
		'sel1 = wCollisionCreateFromBox(node) ' Коллизии к кубу
		'wCollisionGroupAddCollision(CombinedCollision, sel1)
End Sub

Sub CreateLadder1(x As long, y As long, z As long) ' Создать Лестницу
  Dim As wNode node
  DIM as wVector3f scale, pos1
  Dim as wMaterial material
  Dim As wColor4s col1 = (0, &H80, &H40, &H40)
  Dim As Long x1, y1
  x1 = x * 64: y1 = y * 64
  
  node = wNodeCreateCube(1, FALSE, col1)
    material = wNodeGetMaterial(node, 0)
    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
    scale.x = 4: scale.y = 64: scale.z = 4
    wNodeSetScale(node, scale)
    pos1.x = x1 - 24: pos1.y = y1: pos1.z = z
    wNodeSetPosition (node, pos1)
    Map1(x, y).lean(0) = node

  node = wNodeCreateCube(1, FALSE, col1)
    material = wNodeGetMaterial(node, 0)
    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
    scale.x = 4: scale.y = 64: scale.z = 4
    wNodeSetScale(node, scale)
    pos1.x = x1 + 24: pos1.y = y1: pos1.z = z
    wNodeSetPosition (node, pos1)
    Map1(x, y).lean(1) = node

    col1.alpha = 0: col1.red = &HC0: col1.green = &H40: col1.blue = &H0
  node = wNodeCreateCube(1, FALSE, col1)
    material = wNodeGetMaterial(node, 0)
    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
    scale.x = 64: scale.y = 4: scale.z = 4
    wNodeSetScale(node, scale)
    pos1.x = x1: pos1.y = y1 + 22: pos1.z = z - 2
    wNodeSetPosition (node, pos1)
    scale.x = 0: scale.y = 0: scale.z = rndi(-7, 7)
    wNodeSetRotation(node, scale)
    Map1(x, y).lean(2) = node
         
  node = wNodeCreateCube(1, FALSE, col1)
    material = wNodeGetMaterial(node, 0)
    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
    scale.x = 64: scale.y = 4: scale.z = 4
    wNodeSetScale(node, scale)
    pos1.x = x1: pos1.y = y1: pos1.z = z - 2
    wNodeSetPosition (node, pos1)
    scale.x = 0: scale.y = 0: scale.z = rndi(-7, 7)
    wNodeSetRotation(node, scale)
    Map1(x, y).lean(3) = node
    
  node = wNodeCreateCube(1, FALSE, col1)
    material = wNodeGetMaterial(node, 0)
    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
    scale.x = 64: scale.y = 4: scale.z = 4
    wNodeSetScale(node, scale)
    pos1.x = x1: pos1.y = y1 - 22: pos1.z = z - 2
    wNodeSetPosition (node, pos1)
    scale.x = 0: scale.y = 0: scale.z = rndi(-7, 7)
    wNodeSetRotation(node, scale)
    Map1(x, y).lean(4) = node
End Sub

Sub CreatePortalClose1(x As long, y As long, z As Long) ' Создание закрытого портала
  Dim As wMaterial material
  DIM as wVector3f pos1
  Dim as wVector2f size
  Dim As wColor4s topCol, botCol
  With port1
  	pos1.x = x * 64: pos1.y = y * 64: pos1.z = z
  	size.x = 64.0: size.y = 64.0
  	.spr = wBillBoardCreate (pos1, size)
    material = wNodeGetMaterial(.spr, 0)
    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
    wMaterialSetType(material, wMT_TRANSPARENT_ALPHA_CHANNEL) 
  	'wMaterialSetType(material, wMT_TRANSPARENT_ALPHA_CHANNEL_REF)
		If .txt = 0 Then .txt = wTextureLoad(portal_tex01_path)
		wMaterialSetTexture(material, 0, .txt)
		wMaterialSetType(material, wMT_TRANSPARENT_ADD_COLOR)
    '----------------------------------------------------------
    .x = x: .y = y: .z = z
    topCol.alpha = 0: topCol.red = &Hff: topCol.green = &Hff: topCol.blue = &H0
    botCol.alpha = 0: botCol.red = &Hff: botCol.green = &Hff: botCol.blue = &H0
    wBillBoardSetColor (.spr, topCol, botCol) 
    'Map1(x, y).Obj = 100 ' Закрытый портал
    .iOpen = 0
  End With
  'mesh = CreateMeshSphere(16)
  '  ScaleMesh(mesh,3,3,3)
  '  PositionEntity(mesh, x * 64, y * 64, z)
  '  EntityColor mesh, 255, 40, 40
End Sub

Sub OpenPortale1() ' Открытие портала 1
  Dim As wVector3f pos1
  Dim As wColor4f col1 = (1.0f, 1.0f, 1.0f, 0.0f)
  Dim as Float32 rad1 = 70
  'If Map1(port1.x, port1.y).Obj = 100 Then ' Закрыто
  	' DeleteEntity(port1.spr): port1.spr = 0
  	'Map1(port1.x, port1.y).Obj = 101 ' Портал 1 (Открыто)
  	OpenPortale(port1.x * 64, port1.y * 64)
    With port1
    	pos1.x = .x * 64: pos1.y = .y * 64: pos1.z = 0
    	.lig = wLightCreate (pos1, col1, rad1)
    	wLightSetCastShadows (.lig, true)
    	.iOpen = 1 ' Портал открыт 
    End With
  'End If
End Sub

Sub OpenPortale(x As int32, y As int32, z As int32 = 0) ' Открытие портала
	Dim As wNode fairy01, fairy02, fairy03
	dim as wParticleEmitter param1
	Dim As wEmitter emitter01, emitter02, emitter03
	Dim As wAffector af01, af02
	Dim As wColor4s col1 = wCOLOR4s_BLACK
	Dim As int32 i, r, g, b, h, ki
  Dim As wVector3f pos1, rot1 = wVECTOR3f_ZERO, scale = wVECTOR3f_ONE
  Dim As wVector3f grav = (0, -0.06f, 0)
  Dim as wMaterial material
  Dim as wVector3f direct = (0, 1.0f, 0)
  'Dim As wAnimator Ani1
  Dim as wVector3f bMin = (4, 4, 4)
  Dim as wVector3f bMax = (4, 4, 4)  
  'pivot_portal1 = CreateMeshNull()
  
  'PositionEntity(pivot_portal1,x,y,z)
  ' glow_tex
  ki = 4
  
	For i = 1 To ki
		r = 0: g = 0: b = 0 ' r = rndi(0,255): g = rndi(0,255): b = rndi(0,255)
		h = rndi(1, 900)
		If h <= 300 Then 
			r = 255
		ElseIf h <= 600 Then
			g = 255
		ElseIf h <= 900 Then
			b = 255
		EndIf
		
  	pos1.x = x: pos1.y = y: pos1.z = z
  	fairy01 = wParticleSystemCreate (false, pos1, rot1, scale)
    af01 = wParticleFadeOutAffectorCreate (fairy01) ' Затухание частиц
    wParticleFadeOutAffectorSetTime (af01, 600)     ' Время затухания частицы
    col1.alpha = 0: col1.red = 16: col1.green = 8: col1.blue = 0
    wParticleFadeOutAffectorSetColor (af01, col1)   ' Цвет затухания частицы
    af02 = wParticleGravityAffectorCreate (fairy01) ' Гравитация частиц
    wParticleGravityAffectorSetGravity (af02, grav) ' Устснавливает вектор гравитации частицам.
    wParticleGravityAffectorSetTimeLost (af02, 2000)' Время гравитации в миллисекундах
    For j As int32 = 0 to wNodeGetMaterialsCount(fairy01) - 1
      material = wNodeGetMaterial(fairy01, j)               ' материал нода
      wMaterialSetFlag(material, wMF_LIGHTING, FALSE)       ' не реагировать на свет
      wMaterialSetType(material, wMT_TRANSPARENT_ADD_COLOR) ' прозрачность фона текстуры
      wMaterialSetTexture(material, j, glow_tex)            ' установка текстуры
    Next j
    ' Аниматор вращение вокруг своей оси
  	'wAnimator = wAnimatorRotationCreate (byval node as wNode, byval pos as wVector3f)
    ' Аниматор вращения вокруг точки	
  	pos1.x = x: pos1.y = y+20-15*(i-1): pos1.z = z
    ParEmi1(i).anim(0) = wAnimatorFlyingCircleCreate (fairy01, pos1, 30, 0.002f, direct, 0.0f, 0.0f)
    emitter01 = wParticleBoxEmitterCreate (fairy01)   ' создать эмиттер
    wParticleBoxEmitterSetBox (emitter01, bMin, bMax) ' размеры куба эмиттера 
  
    param1.direction.x = 0: param1.direction.y = -0.06f: param1.direction.z = 0
  	param1.minParticlesPerSecond = 10 ' частицы в секунду
  	param1.maxParticlesPerSecond = 14
  	param1.minStartColor.alpha = 255: param1.minStartColor.red = r: param1.minStartColor.green = g: param1.minStartColor.blue = b
  	param1.maxStartColor = wCOLOR4s_WHITE ' (255, 255, 255, 255)
  	param1.lifeTimeMin = 600
  	param1.lifeTimeMax = 1200
  	param1.maxAnglesDegrees = 15
  	param1.minStartSize.x = 5: param1.minStartSize.y = 5
  	param1.maxStartSize.x = 20: param1.maxStartSize.y = 20
     
  	wParticleEmitterSetParameters (emitter01, param1)
  	wParticleSystemSetEmitter (fairy01, emitter01) 
  
  		ParEmi1(i).p1 = fairy01
  		ParEmi1(i).e1 = emitter01 
    '---------------------------------------------------------------------------
    pos1.x = x: pos1.y = y: pos1.z = z
    fairy02 = wParticleSystemCreate (false, pos1, rot1, scale)
    af01 = wParticleFadeOutAffectorCreate (fairy02) ' Затухание частиц
    wParticleFadeOutAffectorSetTime (af01, 600)     ' Время затухания частицы
    col1.alpha = 0: col1.red = 16: col1.green = 8: col1.blue = 0
    wParticleFadeOutAffectorSetColor (af01, col1)   ' Цвет затухания частицы
    af02 = wParticleGravityAffectorCreate (fairy02) ' Гравитация частиц
    wParticleGravityAffectorSetGravity (af02, grav) ' Устснавливает вектор гравитации частицам.
    wParticleGravityAffectorSetTimeLost (af02, 2000)' Время гравитации в миллисекундах
    For j As int32 = 0 to wNodeGetMaterialsCount(fairy02) - 1
      material = wNodeGetMaterial(fairy02, j)               ' материал нода
      wMaterialSetFlag(material, wMF_LIGHTING, FALSE)       ' не реагировать на свет
      wMaterialSetType(material, wMT_TRANSPARENT_ADD_COLOR) ' прозрачность фона текстуры
      wMaterialSetTexture(material, j, glow_tex)            ' установка текстуры
    Next j
    ' Аниматор вращение вокруг своей оси
  	'wAnimator = wAnimatorRotationCreate (byval node as wNode, byval pos as wVector3f)
    ' Аниматор вращения вокруг точки	
  	pos1.x = x: pos1.y = y+20-15*(i-1): pos1.z = z
    ParEmi1(i).anim(1) = wAnimatorFlyingCircleCreate (fairy02, pos1, 30, -0.002f, direct, 300.14f, 0.0f)
  
    emitter02 = wParticleBoxEmitterCreate (fairy02)   ' создать эмиттер
    wParticleBoxEmitterSetBox (emitter02, bMin, bMax) ' размеры куба эмиттера 
  
    param1.direction.x = 0: param1.direction.y = -0.06f: param1.direction.z = 0
  	param1.minParticlesPerSecond = 10 ' частицы в секунду
  	param1.maxParticlesPerSecond = 14
  	param1.minStartColor.alpha = 255: param1.minStartColor.red = r: param1.minStartColor.green = g: param1.minStartColor.blue = b
  	param1.maxStartColor = wCOLOR4s_WHITE ' (255, 255, 255, 255)
  	param1.lifeTimeMin = 600
  	param1.lifeTimeMax = 1200
  	param1.maxAnglesDegrees = 15
  	param1.minStartSize.x = 5: param1.minStartSize.y = 5
  	param1.maxStartSize.x = 20: param1.maxStartSize.y = 20
     
  	wParticleEmitterSetParameters (emitter02, param1)
  	wParticleSystemSetEmitter (fairy02, emitter02)

		  ParEmi1(i).p2 = fairy02
		  ParEmi1(i).e2 = emitter02
	Next
  '---------------------------------------------------------------------------
    pos1.x = x - 5: pos1.y = y - 32: pos1.z = z
    fairy03 = wParticleSystemCreate (false, pos1, rot1, scale)
    af01 = wParticleFadeOutAffectorCreate (fairy03) ' Затухание частиц
    wParticleFadeOutAffectorSetTime (af01, 500)     ' Время затухания частицы
    col1.alpha = 0: col1.red = 16: col1.green = 8: col1.blue = 0
    wParticleFadeOutAffectorSetColor (af01, col1)   ' Цвет затухания частицы
    af02 = wParticleGravityAffectorCreate (fairy03) ' Гравитация частиц
    grav.x = 0: grav.y = 0.26: grav.z = 0
    wParticleGravityAffectorSetGravity (af02, grav) ' Устснавливает вектор гравитации частицам.
    wParticleGravityAffectorSetTimeLost (af02, 2000)' Время гравитации в миллисекундах
    For j As int32 = 0 to wNodeGetMaterialsCount(fairy03) - 1
      material = wNodeGetMaterial(fairy03, j)               ' материал нода
      wMaterialSetFlag(material, wMF_LIGHTING, FALSE)       ' не реагировать на свет
      wMaterialSetType(material, wMT_TRANSPARENT_ADD_COLOR) ' прозрачность фона текстуры
      wMaterialSetTexture(material, j, glow_tex)            ' установка текстуры
    Next j
    ' Аниматор вращение вокруг своей оси
  	'wAnimator = wAnimatorRotationCreate (byval node as wNode, byval pos as wVector3f)
    ' Аниматор вращения вокруг точки	
  	'pos1.x = x: pos1.y = y+20-15*(i-1): pos1.z = z
    'Ani1 = wAnimatorFlyingCircleCreate (fairy03, pos1, 30, -0.002f, direct, 300.14f, 0.0f)
  
    emitter03 = wParticleBoxEmitterCreate (fairy03)   ' создать эмиттер
    wParticleBoxEmitterSetBox (emitter03, bMin, bMax) ' размеры куба эмиттера 
  
    param1.direction.x = 0: param1.direction.y = 0.02f: param1.direction.z = 0
  	param1.minParticlesPerSecond = 120 ' частицы в секунду
  	param1.maxParticlesPerSecond = 160
  	param1.minStartColor.alpha = 255: param1.minStartColor.red = 0: param1.minStartColor.green = 0: param1.minStartColor.blue = 128
  	param1.maxStartColor.alpha = 255: param1.maxStartColor.red = 128: param1.maxStartColor.green = 128: param1.maxStartColor.blue = 128 
  	param1.lifeTimeMin = 500
  	param1.lifeTimeMax = 1000
  	param1.maxAnglesDegrees = 15
  	param1.minStartSize.x = 30: param1.minStartSize.y = 30
  	param1.maxStartSize.x = 80: param1.maxStartSize.y = 80
     
  	wParticleEmitterSetParameters (emitter03, param1)
  	wParticleSystemSetEmitter (fairy03, emitter03)

		  ParEmi1(ki + 1).p1 = fairy03
		  ParEmi1(ki + 1).e2 = emitter03
  
End Sub

















Function GaviPosDraw(node As wNode, eGrav As Single) As boolean ' Гравитация
  Dim As wVector3f pos1, pos_d, pos_k
  Dim As int32 pos_y
  Dim As Byte pos_b, not_v 
  pos_d = wNodeGetAbsolutePosition(node)
  pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 64) \ 64: pos_k.z = 0
  pos_b = Map1(pos_k.x, pos_k.y).Obj     ' Позиция
  not_v = Map1(pos_k.x, pos_k.y).not_vis
  
  If pos_b = 0 Or not_v = 1 Then
    If Not ControlColB(node, 4, eGrav) Then
      pos1.x = pos_d.x: pos1.y = pos_d.y - eGrav: pos1.z = 0
      wNodeSetPosition (node, pos1)
      Return TRUE
    EndIf
  EndIf
  Return FALSE
End Function

Function ControlColB(node_a As wNode, LeftRightUpDown As int32, shag As Single) As boolean
  Dim As wVector3f pos_d, pos_k
  Dim As Byte pos_obj, not_v
  pos_d = wNodeGetAbsolutePosition(node_a)
  
  'tr1.x = pos_d.x: tr1.y = pos_d.y: tr1.z = 0
  'tr2.x = pos_d.x - 32: tr2.y = pos_d.y: tr2.z = 0      ' левая нижняя 
  'w3dDrawLine(tr1, tr2, wCOLOR4s_RED)
  'tr1.x = pos_d.x - 32: tr1.y = pos_d.y: tr1.z = 0
  'tr2.x = pos_d.x - 32: tr2.y = pos_d.y + 32: tr2.z = 0 ' левая  
  'w3dDrawLine(tr1, tr2, wCOLOR4s_GREEN)
  'tr1.x = pos_d.x - 32: tr1.y = pos_d.y + 32: tr1.z = 0
  'tr2.x = pos_d.x - 32: tr2.y = pos_d.y + 64: tr2.z = 0 ' левая верхняя  
  'w3dDrawLine(tr1, tr2, wCOLOR4s_BLUE)
  'tr1.x = pos_d.x - 32: tr1.y = pos_d.y + 64: tr1.z = 0
  'tr2.x = pos_d.x: tr2.y = pos_d.y + 64: tr2.z = 0      ' верхняя  
  'w3dDrawLine(tr1, tr2, wCOLOR4s_GREY)
  'tr1.x = pos_d.x: tr1.y = pos_d.y + 64: tr1.z = 0
  'tr2.x = pos_d.x + 32: tr2.y = pos_d.y + 64: tr2.z = 0 ' правая верхняя   
  'w3dDrawLine(tr1, tr2, wCOLOR4s_MAGENTA)
  'tr1.x = pos_d.x + 32: tr1.y = pos_d.y + 64: tr1.z = 0
  'tr2.x = pos_d.x + 32: tr2.y = pos_d.y + 32: tr2.z = 0 ' правая   
  'w3dDrawLine(tr1, tr2, wCOLOR4s_YELLOW)
  'tr1.x = pos_d.x + 32: tr1.y = pos_d.y + 32: tr1.z = 0
  'tr2.x = pos_d.x + 32: tr2.y = pos_d.y: tr2.z = 0      ' правая нижняя
  'w3dDrawLine(tr1, tr2, wCOLOR4s_ORANGE)
  'tr1.x = pos_d.x + 32: tr1.y = pos_d.y: tr1.z = 0
  'tr2.x = pos_d.x: tr2.y = pos_d.y: tr2.z = 0           ' нижняя 
  'w3dDrawLine(tr1, tr2, wCOLOR4s_WHITE)

  pos_k.z = 0
  Select Case LeftRightUpDown
    Case 1
      ' левая верхняя
      pos_k.x = (pos_d.x + 8 - shag) \ 64: pos_k.y = (pos_d.y + 92) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis 
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' левая
      pos_k.x = (pos_d.x + 8 - shag) \ 64: pos_k.y = (pos_d.y + 64) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' левая нижняя
      pos_k.x = (pos_d.x + 8 - shag) \ 64: pos_k.y = (pos_d.y + 32) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
    Case 2
      ' правая верхняя
      pos_k.x = (pos_d.x + 56 + shag) \ 64: pos_k.y = (pos_d.y + 92) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' правая
      pos_k.x = (pos_d.x + 56 + shag) \ 64: pos_k.y = (pos_d.y + 64) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' правая нижняя
      pos_k.x = (pos_d.x + 56 + shag) \ 64: pos_k.y = (pos_d.y + 32) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
    Case 3
      ' левая верхняя
      pos_k.x = (pos_d.x + 8) \ 64: pos_k.y = (pos_d.y + 96 + shag) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' правая верхняя
      pos_k.x = (pos_d.x + 56) \ 64: pos_k.y = (pos_d.y + 96 + shag) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' верхняя
      pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 96 + shag) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
    Case 4
      ' левая нижняя
      pos_k.x = (pos_d.x + 8) \ 64: pos_k.y = (pos_d.y + 32 - shag) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' правая нижняя
      pos_k.x = (pos_d.x + 56) \ 64: pos_k.y = (pos_d.y + 32 - shag) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
      ' нижняя
      pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 32 - shag) \ 64
      pos_obj = Map1(pos_k.x, pos_k.y).Obj: not_v = Map1(pos_k.x, pos_k.y).not_vis
      If (pos_obj = 98 Or pos_obj = 99 Or pos_obj = 1) and (not_v = 0) Then Return TRUE
  End Select
  Return FALSE  
End Function

Sub ControlPosDwarf(node As wNode, LeftRightUpDown As int32, eShag As Single, NoSound As int32) ' Перемещение героя
  'Dim As int32 pr, u, gr = 20
  Dim As Byte b
  Dim As wVector3f pos1, pos_d, pos_k

  pos_d = wNodeGetAbsolutePosition(node)
  pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 64) \ 64
  
  Select Case LeftRightUpDown
      '---------------------------------------------
    Case 1 ' Left
      If Not ControlColB(node, LeftRightUpDown, eShag) Then
      'pr = (pos_d.y - 32): u = (pr \ 64) * 64
      'If pr < (u + gr) And pr > (u - gr) Then
        pos_d.x -= eShag: wNodeSetPosition(node, pos_d)
      'EndIf
      Else
        ch_err1 +=1
        If ch_err1 >= 2 Then
          ch_err1 = 0
          pos_d.x = ((pos_d.x + 32) \ 64) * 64
          pos_d.y = ((pos_d.y) \ 64) * 64 + 32
          pos_d.z = 0
          wNodeSetPosition(node, pos_d)
        EndIf
      EndIf
      If NoSound = 0 Then
        b = Map1(pos_k.x, pos_k.y - 1).Obj
        If b = 1 Or b = 99 Then step_stone_2()
      End If
      '---------------------------------------------
    Case 2 ' Right
      If Not ControlColB(node, LeftRightUpDown, eShag) Then
      'pr = (pos_d.y - 32): u = (pr \ 64) * 64
      'If pr < (u + gr) And pr > (u - gr) Then
        pos_d.x += eShag: wNodeSetPosition(node, pos_d)
      'EndIf
      Else
        ch_err1 +=1
        If ch_err1 >= 2 Then
          ch_err1 = 0
          pos_d.x = ((pos_d.x + 32) \ 64) * 64
          pos_d.y = ((pos_d.y) \ 64) * 64 + 32
          pos_d.z = 0
          wNodeSetPosition(node, pos_d)
        EndIf
      EndIf
      If NoSound = 0 Then
        b = Map1(pos_k.x, pos_k.y - 1).Obj
        If b = 1 Or b = 99 Then step_stone_2()
      EndIf
      '---------------------------------------------
    Case 3 ' Up
      If Not ControlColB(node, LeftRightUpDown, eShag) Then
      'pr = (pos_d.x + 8): u = (pr \ 64) * 64
      'If pr < (u + gr) And pr > (u - gr) Then
        pos_d.y += eShag: wNodeSetPosition(node, pos_d)
      'EndIf
      Else
        ch_err1 +=1
        If ch_err1 >= 2 Then
          ch_err1 = 0
          pos_d.x = ((pos_d.x + 32) \ 64) * 64
          pos_d.y = ((pos_d.y) \ 64) * 64 + 32
          pos_d.z = 0
          wNodeSetPosition(node, pos_d)
        EndIf
      EndIf
      '---------------------------------------------
    Case 4 ' Down
      If Not ControlColB(node, LeftRightUpDown, eShag) Then
      'pr = (pos_d.x + 8): u = (pr \ 64) * 64
      'If pr < (u + gr) And pr > (u - gr) Then
        pos_d.y -= eShag: wNodeSetPosition(node, pos_d)
      'EndIf
      Else
        ch_err1 +=1
        If ch_err1 >= 2 Then
          ch_err1 = 0
          pos_d.x = ((pos_d.x + 32) \ 64) * 64
          pos_d.y = ((pos_d.y) \ 64) * 64 + 32
          pos_d.z = 0
          wNodeSetPosition(node, pos_d)
        EndIf
      EndIf
	    '---------------------------------------------
  End Select
End Sub

Function ControlEndAttac1(EndFrame As Float32) As boolean
  Dim As Float32 f
  ' Получает номер кадра, которй в настоящее время проиграется нодом.
  f = wNodeGetAnimationFrame(dwarf)
  If f = EndFrame Then Return TRUE
End Function

Sub dworf_ani(i As int32, speed As Float32 = 15) ' Анимация гнома
  'AnimateMesh( mesh, loop, speed, start, end, tran )
	'AnimateMesh(dwarf,1,15,1,300,1)'Animate the mesh
	Dim As Int32 k
	Dim As Float32 f
	Dim as wVector2i range
	
	wNodeSetAnimationLoopMode (dwarf, FALSE)
  wNodeSetTransitionTime (dwarf, 0.5f) 

	Select Case i
	  Case 0: k = 0 ' Остановить
	    wNodeSetAnimationSpeed (dwarf, speed)
		  range.x = 0: range.y = 0
		  wNodeSetAnimationRange (dwarf, range)
	  Case 1: k = 1 ' Ходьба
	    wNodeSetAnimationSpeed (dwarf, speed)
			f = wNodeGetAnimationFrame (dwarf)
			If f < 1 or f >= 13 Then
			  range.x = 1: range.y = 13
			  wNodeSetAnimationRange (dwarf, range)
			EndIf
	  Case 2: k = 2 ' Удар сверху вниз
	    wNodeSetAnimationSpeed (dwarf, speed)
		  range.x = 130: range.y = 140
		  wNodeSetAnimationRange (dwarf, range)
		Case 3: k = 3 ' Прыжок в бок
		  wNodeSetAnimationSpeed (dwarf, speed)
		  range.x = 15: range.y = 15
		  wNodeSetAnimationRange (dwarf, range)
	End Select 
End Sub


Sub SetRndPosPla1() ' Поместить хероя в произвольную, свободную позицию
	Dim As Long x, y, z
	DIM as wVector3f pos1
	Do
		x = rndi(1, xMax - 1): y = rndi(1, yMax - 1)
		If map1(x, y).obj = 0 And (map1(x, y - 1).obj = 1 Or map1(x, y - 1).obj = 99) Then Exit Do
	Loop
	pos1.x = x * 64: pos1.y = y * 64 - 32: pos1.z = z
	'wNodeSetPosition (dwarf_px, pos1)
	wNodeSetPosition (dwarf, pos1)

  pos1.x = 0: pos1.y = 180: pos1.z = 0	
	wNodeSetAbsoluteRotation (dwarf, pos1)
	
	Pla1_Vector = 4: SetAttac1 = FALSE
End Sub

Sub CreatePla1() ' Создать хероя
  'Dim As physics_obj physSphere
  Dim As wMaterial  material
  DIM as wVector3f pos1
  If dwarf <> 0 Then
    SetRndPosPla1()
    Exit Sub
  EndIf
  mDwarf = wMeshLoad (dwarf2_path, FALSE)
  dwarf = wNodeCreateFromMesh (mDwarf)
  pos1.x = 1.1f: pos1.y = 1.1f: pos1.z = 1.1f
  wNodeSetScale (dwarf, pos1)
  
  dworf_ani(0, 15) ' Animate the mesh
  
  for i as Int32 = 0 to wNodeGetMaterialsCount(dwarf) - 1
     material = wNodeGetMaterial(dwarf, i)
     wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
  Next i

  
  
  'ColAnimatDwarf = wAnimatorCollisionResponseCreate (CombinedCollision, dwarf, 0.0005f)
  'If (ColAnimatDwarf) Then  
  '  Dim As wAnimatorCollisionResponse p
  '  wAnimatorCollisionResponseGetParameters(ColAnimatDwarf, @p)
  '  p.ellipsoidRadius.x=30.f: p.ellipsoidRadius.y=15.f: p.ellipsoidRadius.z=30.f
  '  p.ellipsoidTranslation.x=0.f: p.ellipsoidTranslation.y=50.f: p.ellipsoidTranslation.z=0.f
  '  p.gravity.x=0.f: p.gravity.y=-30.f: p.gravity.z=0.f
  '  wAnimatorCollisionResponseSetParameters(ColAnimatDwarf, p)
  'EndIf
    
  'Dim As String dwarf_tex_path = "./data/model/dwarf2.jpg"
  'Dim As wTexture dwarf_tex = wTextureLoad(dwarf_tex_path)
	'wMaterialSetTexture(material, 0, dwarf_tex)


  'wSetNodeScale(dwarf, 0.1, 0.1, 0.1)
  'wSetNodePosition(dwarf, 0.0, -0.2, 0.0)
	'dwarf_pl = wAddSphereSceneNode(26, 12)
	'dwarf_pl = wNodeCreateSphere(26, 16, FALSE, wCOLOR4s_WHITE)
 
	'wSetNodeParent(dwarf, dwarf_pl)
	'wSetNodePosition(dwarf, 0, -26, 0)
	
	'wSetNodeMaterialFlag(dwarf_pl, wMF_LIGHTING, FALSE)
  'wSetNodeMaterialType(dwarf_pl, wMT_TRANSPARENT_ALPHA_CHANNEL)
  '============================================================
  'Dim mater As wMaterial
  'mater = wGetMaterial(dwarf_pl, 0)
  'wSetMaterialType(mater, wMT_TRANSPARENT_ADD_COLOR)
  '============================================================
  'wMaterialSetDiffuseColor(mater, 0,0,0,0)
  
	'EntityColor Pla1, &H40, &HFF, &H40
	'MaterialAlpha(Pla1, 0, 0.0)	
	'EntityAlpha(Pla1, 0.0)
	'EntityParent dwarf, Pla1
	
	'dwarf_px = wPhysCreateBodySphere(26, 26, 26, 120.0)
	'PhysicsCreateSphere(dwarf_pl, physSphere, 120.0)
	'dwarf_px = physSphere.body
	'wSetNodeParent(dwarf_px, dwarf_pl)
	
	SetRndPosPla1()
	'BodyMaterial(dwarf_px, material2)
End Sub


Sub SetMaterial1(material as wMaterial)
  wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
  'wMaterialSetFlag(material, wMF_ZWRITE_ENABLE, TRUE)
  wMaterialSetFlag(material, wMF_ANISOTROPIC_FILTER, TRUE)
  'wMaterialSetFlag(material, wMF_BILINEAR_FILTER, FALSE)
  wMaterialSetFlag(material, wMF_TRILINEAR_FILTER, TRUE)
  wMaterialSetFlag(material, wMF_ANTI_ALIASING, TRUE)
End Sub






















Sub Add_box_not_vis(x As int32, y As int32) ' Добавить идентификатор разрушенного куба
  Dim As int32 k = -1
  For i As int32 = 0 To UBound(box_not_vis)
    If box_not_vis(i).n = 1 Then
      k = i
    EndIf
  Next
  If k >= 0 Then
    box_not_vis(k).x = x: box_not_vis(k).y = y: box_not_vis(k).n = 0 
  Else
    k = UBound(box_not_vis) + 1: ReDim Preserve box_not_vis(k)
    box_not_vis(k).x = x: box_not_vis(k).y = y: box_not_vis(k).n = 0
  EndIf
End Sub


Sub RestoreBox1() ' Восстановление кубов по времени
  Dim As int32 x, y
  For i As int32 = 0 To UBound(box_not_vis)
    If box_not_vis(i).n = 0 Then
      x = box_not_vis(i).x: y = box_not_vis(i).y
      If Map1(x, y).not_vis > 0 Then
        If (Map1(x, y).time1 + time_restore_box) < wTimerGetRealTime() Then
          Map1(x, y).not_vis = 0
          box_not_vis(i).n = 1 ' Отработан
          wNodeSetVisibility (Map1(x, y).node, TRUE)
            ' Юнит в кубе
            For j As int32 = 0 To uMax
              If unit(j).hits > 0 Then
                Dim As wVector3f pos_d, pos_k
                pos_d = wNodeGetAbsolutePosition(unit(j).node)
                pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 32) \ 64
                If pos_k.x = x And pos_k.y = y Then
                  DelUnit(j) ' Удаление потраченной жизни врага
                EndIf
              EndIf
            Next
            ' Герой в кубе
            Dim As wVector3f pos_d, pos_k
            pos_d = wNodeGetAbsolutePosition(dwarf)
            pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 32) \ 64
            If pos_k.x = x And pos_k.y = y Then
              GameEnd1() ' Херой погиб
              Exit For
            EndIf
        End If
      EndIf
    EndIf
  Next
End Sub

Sub DelObjMap1(x As int32, y As int32) ' Удалить объект с карты
  Dim i As int32
	If Map1(x, y).Obj = 2 Then ' Лестница
	  For i = 0 To 4
	  	If Map1(x, y).lean(i) <> 0 Then
	  		wNodeDestroy Map1(x, y).lean(i)
	  		Map1(x, y).lean(i) = 0
	  	EndIf
	  Next
	  Map1(x, y).node = 0
	  Map1(x, y).Obj = 0
	EndIf
	
	If Map1(x, y).Obj = 1 Or Map1(x, y).Obj = 99 Then
    If Map1(x, y).node <> 0 Then 
      'wNodeDestroy(Map1(x, y).node)
      Map1(x, y).not_vis = 1
      Map1(x, y).time1 = wTimerGetRealTime()
      Add_box_not_vis(x, y)
      wNodeSetVisibility (Map1(x, y).node, FALSE)
      CrashBox()
      'Map1(x, y).node = 0
      'Map1(x, y).Obj = 0
    EndIf
  EndIf
End Sub


Sub DestroyCube1() ' Разрушить куб 1
  Dim As Byte p, nv, b = 0
  Dim As wVector3f pos_d, pos_k
  
  pos_d = wNodeGetAbsolutePosition(dwarf)
  pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 32) \ 64: pos_k.z = 0
  
	' x O 1
	' 1 1 1
	If pos_k.y >= 0 And pos_k.x > 0 And Pla1_Vector = 1 Then
		p = Map1(pos_k.x - 1, pos_k.y).Obj: nv = Map1(pos_k.x - 1, pos_k.y).not_vis
		If (p = 1 Or p = 99) And nv = 0 Then
				b = 1: DelObjMap1(pos_k.x - 1, pos_k.y)
		EndIf
	EndIf
	'   O 1
	' x 1 1
	If b = 0 Then
		If pos_k.y > 0 And pos_k.x > 0 And Pla1_Vector = 1 Then
			p = Map1(pos_k.x - 1, pos_k.y - 1).Obj: nv = Map1(pos_k.x - 1, pos_k.y - 1).not_vis
			If (p = 1 Or p = 99) And nv = 0 Then
					b = 1: DelObjMap1(pos_k.x - 1, pos_k.y - 1)
			EndIf
		EndIf
	EndIf
	' 1 O x
	' 1 1 1
	If b = 0 Then
		If pos_k.y >= 0 And pos_k.x < xMax And Pla1_Vector = 2 Then
			p = Map1(pos_k.x + 1, pos_k.y).Obj: nv = Map1(pos_k.x + 1, pos_k.y).not_vis
			If (p = 1 Or p = 99) And nv = 0 Then
					b = 1: DelObjMap1(pos_k.x + 1, pos_k.y)
				EndIf
		EndIf
	EndIf
	' 1 O
	' 1 1 x
	If b = 0 Then
		If pos_k.y > 0 And pos_k.x < xMax And Pla1_Vector = 2 Then
			p = Map1(pos_k.x + 1, pos_k.y - 1).Obj: nv = Map1(pos_k.x + 1, pos_k.y - 1).not_vis
			If (p = 1 Or p = 99) And nv = 0 Then
				b = 1: DelObjMap1(pos_k.x + 1, pos_k.y - 1)
			EndIf
		EndIf
	EndIf
	' 1 O 1
	' 1 x 1
	If b = 0 Then
		If pos_k.y > 0 And pos_k.x >= 0 And (Pla1_Vector = 3 Or Pla1_Vector = 4) Then
			p = Map1(pos_k.x, pos_k.y - 1).Obj: nv = Map1(pos_k.x, pos_k.y - 1).not_vis
			If (p = 1 Or p = 99) And nv = 0 Then
				b = 1: DelObjMap1(pos_k.x, pos_k.y - 1)
			EndIf
		EndIf
	EndIf
End Sub
























Sub Interface1() ' Информационная панель
	Dim As wVector2i p1, p2
	Dim As wColor4s c1
	
	' Затенение информационной плосы
	p1.x = 0: p1.y = 0: p2.x = rWinSize.x : p2.y = 64
	c1.alpha = 128: c1.red  = 30: c1.green = 30: c1.blue = 30
  w2dDrawRect (p1, p2, c1)
  
  ' Эмблема врагов
  fromPos.x = 0: fromPos.y = 0: toPos.x = 63: toPos.y = 63
  'wTextureDraw(war1_pic_tex, fromPos, TRUE, c1)
  c1.alpha = 255: c1.red  = 255: c1.green = 255: c1.blue = 255
  wTextureDrawAdvanced(war1_pic_tex, fromPos, toPos, 0, wVECTOR2f_ONE, TRUE, c1)

  ' Количество врагов
  fromPos.x = 70: fromPos.y = 0: toPos.x = 200: toPos.y = 63
  wFontDraw(font01, Str(units), fromPos, toPos, wCOLOR4s_RED)

  ' Эмблема героя
  fromPos.x = 130: fromPos.y = 0: toPos.x = 193: toPos.y = 63
  c1.alpha = 255: c1.red  = 255: c1.green = 255: c1.blue = 255
  wTextureDrawAdvanced(her1_pic_tex, fromPos, toPos, 0, wVECTOR2f_ONE, TRUE, c1)
  
  ' Количество жизней
  fromPos.x = 200: fromPos.y = 0: toPos.x = 330: toPos.y = 63
  wFontDraw(font01, Str(hHits), fromPos, toPos, wCOLOR4s_GREEN)
  
  ' Эмблема кристалов
  fromPos.x = 260: fromPos.y = 0: toPos.x = 323: toPos.y = 63
  c1.alpha = 255: c1.red  = 255: c1.green = 255: c1.blue = 255
  wTextureDrawAdvanced(crs1_pic_tex, fromPos, toPos, 0, wVECTOR2f_ONE, TRUE, c1)

  ' Количество кристалов
  fromPos.x = 330: fromPos.y = 0: toPos.x = 460: toPos.y = 63
  wFontDraw(font01, Str(hCrys), fromPos, toPos, wCOLOR4s_BLUE)

  ' Номер уровня
  fromPos.x = rWinSize.x - 100: fromPos.y = 0: toPos.x = fromPos.x + 100: toPos.y = 63
  wFontDraw(font01, Str(hLevel), fromPos, toPos, wCOLOR4s_WHITE)
      
End Sub
























Sub CreateUnits() ' Создать врагов
  Dim As int32 i

	'uMax += 1
	'If uMax > UBound(unit) Then uMax = UBound(unit)
	units = uMax
	For i = 1 To uMax
		unit(i).Obj = 51
		unit(i).node = wNodeDuplicate (dunit) ' Дублировать нод
		wNodeSetName (unit(i).node, Str(i))   ' Имя нода

    pos1.x = 3.5f: pos1.y = 3.5f: pos1.z = 3.5f
    wNodeSetScale (unit(i).node, pos1)
		SetRndPosUnit(unit(i))
    unit(i).hits = 3
    unit(i).x3 = -1: unit(i).y3 = -1
    Dim as wMaterial material
    For j As int32 = 0 to wNodeGetMaterialsCount(unit(i).node) - 1
       material = wNodeGetMaterial(unit(i).node, j)
       wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
       'wMaterialSetTexture(material, j, unit1_tex)
    Next j
    		
		dunit_ani(1, i, 15)
		wNodeSetVisibility (unit(i).node, TRUE)
	Next
End Sub

Sub SetRndPosUnit(un As tUnit) ' Поместить врага в произвольную, свободную позицию
	Dim As int32 b, x, y, z = 0
	
	Do
		x = rndi(1, xMax - 1): y = rndi(1, yMax - 1)
		If Map1(x, y).obj = 0 Then
		  If Map1(x, y - 1).obj = 1 Or Map1(x, y - 1).obj = 99 Then
		    b = 0
		    For i As int32 = 0 To uMax
		      If x = unit(i).x And y = unit(i).y Then
		        b = 1: Exit For
		      EndIf
		    Next
		    If b = 0 Then
		      un.x = x: un.y = y
		      Exit Do
		    End If
		  EndIf
		EndIf
	Loop
	
	pos1.x = x * 64: pos1.y = y * 64 - 32: pos1.z = z
	wNodeSetPosition (un.node, pos1)
	'Map1(x, y).Obj = 51 ' Враг
End Sub

Sub dunit_ani(i As int32, inode As int32, speed As Float32 = 15) ' Анимация врагов
	Dim As Float32 f
	Dim as wVector2i range
	
	wNodeSetAnimationLoopMode (unit(inode).node, TRUE)
  wNodeSetTransitionTime (unit(inode).node, 1.5f)

	Select Case i
	  Case 0 ' Остановить
	    wNodeSetAnimationSpeed (unit(inode).node, speed)
		  range.x = 0: range.y = 0
		  wNodeSetAnimationRange (unit(inode).node, range)
	  Case 1 ' Ходьба
	    wNodeSetAnimationSpeed (unit(inode).node, speed)
			f = wNodeGetAnimationFrame (unit(inode).node)
			If f < 1 or f > 9 Then
			  range.x = 1: range.y = 9
			  wNodeSetAnimationRange (unit(inode).node, range)
			EndIf
	End Select 
End Sub









Sub CreateCrystals() ' Создать кристаллы
  Dim As int32 x, y, n, z = 0
  For i As int32 = 1 To cMax
    n = 0
    Do
  		x = rndi(1, xMax - 1): y = rndi(1, yMax - 1)
		  If Map2(x, y - 1).obj = 1 Or Map2(x, y - 1).obj = 99 Then  		   
		    If Map2(x, y).Obj = 0 Then
		      ReDim Preserve crys(i)
      		crys(i).Obj = 31
      		Map2(x, y).Obj = 31
      		Map2(x, y).nObj = i
	        crys(i).node = wNodeDuplicate (dcrys)
	        crys(i).hits = 1
		      crys(i).x = x: crys(i).y = y
        	pos1.x = x * 64: pos1.y = y * 64: pos1.z = z
          wNodeSetPosition (crys(i).node, pos1)
          wNodeSetVisibility (crys(i).node, TRUE)
		      Exit Do
		    End If
		    n += 1
		    If n >= 100 Then Exit Do
		  EndIf
    Loop
		If n >= 100 Then Exit For
  Next
End Sub










Sub DelUnit(i As int32) ' Удаление потраченной жизни врага
	If unit(i).node = 0 Then Exit Sub ' DeleteEntity .body
	unit(i).hits -= 1
	If unit(i).hits > 0 Then 
    SetRndPosUnit(unit(i)) ' Поместить врага в произвольную, свободную позицию
	Else
	  ' uMax
	  units = units - 1 ' Текущее кол-во врагов
	  wNodeSetVisibility (unit(i).node, FALSE)
	EndIf
End Sub


Sub GameEnd1() ' Херой погиб
  hHits -= 1
  If hHits < 1 Then   
    wEngineStop()
  	End
  Else
    SetRndPosPla1() ' Поместить героя в произвольную позицию
  EndIf
End Sub











sub Get3DTextPosition(ByVal font As wFont, ByVal text As Const WString ptr, ByVal target As wNode, ByVal p1 As wVector2i ptr, ByVal p2 As wVector2i Ptr)
  Dim As wVector3f minSize, maxSize, position
  Dim As wVector2u textSize
  Dim As wVector2i textPosition
  Dim As Float32 targetHeight

  position=wNodeGetAbsolutePosition(target)
  wNodeGetTransformedBoundingBox(target,@minSize,@maxSize)
  targetHeight=(maxSize.y-minSize.y)
  position.y+=targetHeight
  textPosition=wCollisionGetScreenCoordFrom3dPosition(position)
  textSize=wFontGetTextSize(font,text)

  p1->x=textPosition.x-textSize.x/2
  p2->x=textPosition.x+textSize.x/2

  p1->y=textPosition.y-textSize.y
  p2->y=textPosition.y
End Sub












Sub GetPathUnit(i As int32, NewPos As int32 = 0, NotPath As int32 = 1, RndPos As int32 = 0) ' Просчитать путь для юнита
  ' Произвольная конечная позиция
  
  If unit(i).node = 0 Or unit(i).hits <= 0 Then Return
  
  Dim As wMaterial material
  Dim As wVector3f pos_d, pos1
  Dim As Long x, y, x1, y1, x2, y2, x3, y3, n1, k
  Dim As Byte v(), p1, p2
  
  pos_d = wNodeGetAbsolutePosition(unit(i).node)
  x1 = (pos_d.x + 32) \ 64: y1 = (pos_d.y + 64) \ 64

     
  If (x1 = unit(i).x3 And y1 = unit(i).y3) Or unit(i).y3 = -1 Or NewPos = 1 Then
    If RndPos = 1 Then
  		n1 = 0
  		Do
  		  ' x[1, 29] y[1,19]
  			x3 = rndi(1, xMax - 1): y3 = rndi(1, yMax - 1)
  			If x1 <> x3 Or y1 <> y3 Then
  				p1 = Map1(x3, y3).Obj: p2 = Map1(x3, y3 - 1).Obj
  				If p1 = 0 Then
  					If p2 = 1 Or p2 = 99 Then
  						Exit Do
  					EndIf
  				EndIf
  			EndIf
  			n1 += 1: If n1 >= 59 Then Exit Do
  		Loop
  		If n1 >= 59 Then Return
    Else
      pos_d = wNodeGetAbsolutePosition(dwarf)
      x3 = (pos_d.x + 32) \ 64: y3 = (pos_d.y + 64) \ 64
    EndIf
  Else
  	x3 = unit(i).x3: y3 = unit(i).y3
  End If
    
  n1 = FPVErr2(v(),x1,y1,x3,y3)
  If n1 Then
  	unit(i).x = x1: unit(i).y = y1   ' Текущая позиция 
  	unit(i).x3 = x3: unit(i).y3 = y3 ' Конечная позиция движения
  	x2 = x1: y2 = y1: k = 1

    If NotPath = 0 Then
  	  For k = 0 To UBound(pv)
  	  	If pv(k) <> 0 Then
  	  	  wNodeDestroy (pv(k)) ' Удалить нод
  	  	EndIf
  	  Next
  	  ReDim pv(0 To 1 + UBound(v) + 1)
    EndIf
	  '-------------------------------------------------------
	  If NotPath = 0 Then
  	  pv(0) = wNodeCreateSphere (20, 16, FALSE, wCOLOR4s_RED)
        material = wNodeGetMaterial(pv(0), 0)
        wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
  	    pos1.x = x3 * 64: pos1.y = y3 * 64: pos1.z = 0
        wNodeSetPosition (pv(0), pos1)
        '-------------------------------------------------------
      pv(1) = wNodeCreateSphere (20, 16, FALSE, wCOLOR4s_WHITE)
        material = wNodeGetMaterial(pv(1), 0)
        wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
  	    pos1.x = x1 * 64: pos1.y = y1 * 64: pos1.z = 0
        wNodeSetPosition (pv(1), pos1)
	  EndIf
	  
	  	For k = 1 To UBound(v) - 1	  	    
    		Select Case v(k)
    			Case 1: y2 += 1 ' vbKeyDown
    			Case 2: x2 -= 1 ' vbKeyLeft
    			Case 3: x2 += 1 ' vbKeyRight
    			Case 4: y2 -= 1 ' vbKeyUp
    		End Select
    		If k = 1 Then
    			unit(i).x1 = x2: unit(i).y1 = y2 ' Следующая позиция перемещения +1
    			unit(i).vec = v(k)               ' Вектор перемещения к следующей позиции
    			'unit(i).x1 = x1 - 1: unit(i).y1 = y1
    			'unit(i).vec = 2
    		EndIf
        If NotPath = 0 Then
  	  	  pv(1 + k) = wNodeCreateSphere (20, 16, FALSE, wCOLOR4s_BLUE)
  	  	    material = wNodeGetMaterial(pv(1 + k), 0)
  	  	    wMaterialSetFlag(material, wMF_LIGHTING, FALSE)
      	    pos1.x = x2 * 64: pos1.y = y2 * 64: pos1.z = 0
            wNodeSetPosition (pv(1 + k), pos1)
        EndIf
	  	Next
  EndIf
End Sub

Sub TransPosWar1() ' Контроль позиции врагов
  Dim As wVector3f pos1, pos_d, pos_k, pos_u 
  Dim As Byte pos_b, not_v
  pos_d = wNodeGetAbsolutePosition(dwarf) ' Позиция героя в пикселях
  pos_k.x = (pos_d.x + 32) \ 64: pos_k.y = (pos_d.y + 64) \ 64 ' Позиция героя по Map1
  If pos_d.y < -512 Then
    GameEnd1()   ' Херой погиб
  Else
    If pos_k.y = 0 Then
      crash_hero() ' Звук падения героя
    EndIf
    If port1.iOpen = 1 Then
      If port1.x = pos_k.x And port1.y = pos_k.y Then
        'Dim as wAnimator fadeAnimator = wAnimatorFadingCreate(dwarf, 3000, -0.25f)
        portal_1() ' Звук прохода через портал
        NewGame()  ' Новый уровень
      EndIf
    EndIf
    If Map2(pos_k.x, pos_k.y).Obj = 31 Then ' Кристалл
      hCrys += 1
      If hCrys < cMax Then
        gathering() ' Звук сбора кристаллов
      Else
        Colocal_2()    ' Звук оканчания сбора
        OpenPortale1() ' Открытие портала
      EndIf

      Dim As int32 i = Map2(pos_k.x, pos_k.y).nObj
      crys(i).hits = 0
      'wNodeDestroy(crys(i).node) ' Удалить нод
      Map2(pos_k.x, pos_k.y).Obj = 0
      wNodeSetVisibility (crys(i).node, FALSE)
    EndIf
  EndIf
  '--------------------------------------------------------------
	'Dim As Long i, x, y, x1, y1, x2, y2, x3, y3, n1
	'Dim As Byte v(), p1, p2
	'Dim As int32 vu_x, vu_y, xb, yb
	''--------------------------------------------------------------
	'Exit Sub
	For i As int32 = 1 To uMax
		If unit(i).node <> 0 And unit(i).hits > 0 Then
        pos_d = wNodeGetAbsolutePosition(unit(i).node) ' Позиция юнита в пикселях
        pos_u.x = (pos_d.x + 32) \ 64: pos_u.y = (pos_d.y + 64) \ 64 ' Позиция юнита по Map1
        pos_b = Map1(pos_u.x, pos_u.y).Obj      ' Позиция
      If unit(i).node <> 0 And unit(i).hits > 0 Then
        If Not GaviPosDraw(unit(i).node, euGrav) Then ' Гравитация юнита
          'not_v = Map1(pos_u.x, pos_u.y).not_vis  ' Видимость куба
          If pos_u.y > 0 Then ' юнит не упал ниже игрового поля
            'itmp += 1
            GetPathUnit(i) ' Просчитать путь для юнита
            If unit(i).vec <= 0 Then
              'GetPathUnit(i) ' Просчитать путь для юнита
              ' Сохранить позицию героя по Map1
              unit(i).pos_dw_x = pos_k.x: unit(i).pos_dw_y = pos_k.y
              'itmp += 1
            Else
              If unit(i).pos_dw_x <> pos_k.x Or unit(i).pos_dw_y <> pos_k.y Then
                'unit(i).vec = 0
                ' Позиция героя изменилась - пересчитываем путь до героя
                'GetPathUnit(i) ' Просчитать путь для юнита
                'unit(i).pos_dw_x = pos_k.x: unit(i).pos_dw_y = pos_k.y
                'itmp +=1
              Else
                If unit(i).x1 = pos_u.x And unit(i).y1 = pos_u.y Then
                'If pos_d.x > (pos_u.x * 64 - 4) And pos_d.x < (pos_u.x * 64 + 4) Then
                '  If pos_d.y > (pos_u.y * 64 - 4) And pos_d.y < (pos_u.y * 64 + 4) Then
                  'GetPathUnit(i) ' Просчитать путь для юнита
                  'itmp +=1
                '  EndIf
                'EndIf
                EndIf
              EndIf
            End If
    				Select Case unit(i).vec
    				  Case 1 ' 1 - vbKeyDown
    					  ControlPosDwarf(unit(i).node, 3, euShag, 1)
                pos1.x = 270: pos1.y = 0: pos1.z = 0	
                wNodeSetAbsoluteRotation (unit(i).node, pos1)
    				  Case 2 ' 2 - vbKeyLeft
    					  ControlPosDwarf(unit(i).node, 1, euShag, 1)
                pos1.x = 0: pos1.y = -90: pos1.z = 0	
                wNodeSetAbsoluteRotation (unit(i).node, pos1)
    				  Case 3 ' 3 - vbKeyRight
    					  ControlPosDwarf(unit(i).node, 2, euShag, 1)
                pos1.x = 0: pos1.y = 90: pos1.z = 0
                wNodeSetAbsoluteRotation (unit(i).node, pos1)
    				  Case 4 ' 4 - vbKeyUp
    					  ControlPosDwarf(unit(i).node, 4, euShag, 1)
                pos1.x = 270: pos1.y = 0: pos1.z = 180	
                wNodeSetAbsoluteRotation (unit(i).node, pos1)
    				End Select
          EndIf
        EndIf
      If pos_u.y < -6 Then DelUnit(i) ' Удалить юнит
        ' проверка на контакт с героем
        If pos_u.y > 0 Then ' юнит не упал ниже игрового поля
          If pos_u.x = pos_k.x And pos_u.y = pos_k.y Then
            ' Проверяет, пересекаются ли ограничивающие прямоугольники двух нодов.
            If wNodesAreIntersecting (unit(i).node, dwarf) Then
              For j As int32  = 1 To uMax
                If unit(j).node <> 0 And unit(j).hits > 0 Then
                  unit(j).vec = 0
                  unit(j).pos_dw_x = -1: unit(j).pos_dw_y = -1
                EndIf
              Next
              GameEnd1()   ' Херой погиб
            End If
            EndIf
          EndIf
      EndIf
		End If
	Next
End Sub


Sub TransUnit1(i As int32 = 1)
  ' Перемещение unit(1).node
  Dim As wVector3f pos1, pos_d, pos_k, pos_u
  'If bunit1 = 0 Then
  '  bunit1 = 1
    GetPathUnit(i, 1, 0) ' Просчитать путь для юнита
  'End If
  pos_d = wNodeGetAbsolutePosition(unit(i).node)
  pos_u.x = (pos_d.x + 32) \ 64: pos_u.y = (pos_d.y + 64) \ 64
  'If pos_u.x = unit(i).x3 And pos_u.y = unit(i).y3 Then
    'itmp += 1
    If wNodesAreIntersecting (unit(i).node, dwarf) Then
      itmp += 1
    EndIf
  'EndIf
    euShag = 8
				Select Case unit(i).vec
				  Case 1 ' 1 - vbKeyDown
					  ControlPosDwarf(unit(i).node, 3, euShag, 1)
            pos1.x = 270: pos1.y = 0: pos1.z = 0	
            wNodeSetAbsoluteRotation (unit(i).node, pos1)
				  Case 2 ' 2 - vbKeyLeft
					  ControlPosDwarf(unit(i).node, 1, euShag, 1)
            pos1.x = 0: pos1.y = -90: pos1.z = 0	
            wNodeSetAbsoluteRotation (unit(i).node, pos1)
				  Case 3 ' 3 - vbKeyRight
					  ControlPosDwarf(unit(i).node, 2, euShag, 1)
            pos1.x = 0: pos1.y = 90: pos1.z = 0
            wNodeSetAbsoluteRotation (unit(i).node, pos1)
				  Case 4 ' 4 - vbKeyUp
					  ControlPosDwarf(unit(i).node, 4, euShag, 1)
            pos1.x = 270: pos1.y = 0: pos1.z = 180	
            wNodeSetAbsoluteRotation (unit(i).node, pos1)
				End Select

  
End Sub






