|
★ СПО Звезда ★
|
|
|
Кот_Матроскин
|
#76 | Вторник, 13.03.2018, 08:28
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
pop eax
pop ebx
pop ecx
add esp, 0x8
push ecx
push ebx
push eax
start: mov ebx, DWORD PTR [esp+0x4]
mov ebp, DWORD PTR [esp+0x8]
mov eax, ebx
cmp eax, ebp
jae short x1
mov edx, ebp
sub edx, eax
shr edx, 0x3
mov edi, DWORD PTR [eax+edx*4]
cmp eax, ebp
ja short b0
b1: mov eax, ebx
cmp DWORD PTR [eax], edi
jge short b3
add ebx, 0x4
jmp short b1
b4: sub ebp, 0x4
b3: mov eax, ebp
cmp DWORD PTR [eax], edi
jg short b4
mov ecx, ebx
cmp ecx, eax
ja short b5
sub ebp, 0x4
add ebx, 0x4
mov edx, DWORD PTR [eax]
xchg DWORD PTR [ecx], edx
mov DWORD PTR [eax], edx
b5: mov eax, ebx
cmp eax, ebp
jbe short b1
b0: mov edi, eax
sub eax, 0x4
push eax
push DWORD PTR [esp+0x8]
call start
push DWORD PTR [esp+0x8]
push edi
call start
x1: ret 0x8
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#77 | Вторник, 13.03.2018, 08:28
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
Private Type worm ' Structure of snake, just x and y with may be color
X() As Integer
Y() As Integer
cl As Integer
End Type
Const DefaultPlayerLenght As Integer = 3 ' Initial lnt of played worm
Const DefaultWormsQty As Integer = 5 ' all worms qty in game
Const DefaultCarrotsQty As Integer = 40 ' carrots buffer lnt
Const DefaultStonesQty As Integer = 10 ' stones buffer lnt
Dim Unit(DefaultWormsQty) As worm ' base variable to store worms coords and colors
Dim Carrotrs As worm ' carrots buffer to check collisions and generate them
Dim DirectionByte As Integer ' 0-up 1-down 2-left 3-right
' System to generate moving, using 4 values for direction, 2 bits
Dim RuntimeBit As Boolean ' for program stop
Dim StopBit As Boolean ' for worm stop at border, boolean values
Dim cnt As Integer ' global counter, that pass not to do every time inits
Dim BCnt As Byte ' same as cnt but byted
Dim tmpX As Integer 'global increment coords, that way we do not pass it every time to procs
Dim tmpY As Integer
Private Sub main()
Initialize ' initing vars and field area
Do
For cnt = 0 To 1500 ' slow motion loop, default are some fast
DoEvents
Next
DoEvents ' specially it unfreeze excel and make it procs, if no this operand, it freezes when code run, modality
If RuntimeBit = False Then Exit Sub ' exit condition
' ActiveCell.Value = DirectionByte ' debug thing
' ActiveCell.Offset(1, 0).Value = tmpX
'ActiveCell.Offset(2, 0).Value = tmpY
MoveTick ' incrementor \ decrementor of coords
Render ' draw anything on the area of game
Loop
End Sub
Private Sub CheckCollideCarrot() ' if you eat carrot it have same coords
Dim a As Integer ' may be temp, may be global, i make local focus here
Dim b As Integer
For a = 0 To UBound(Carrotrs.X)
With Carrotrs
If tmpX = .X(a) And tmpY = .Y(a) Then GrowPlayer ' Reinint of player matrix
End With
Next
End Sub
Private Sub GrowPlayer()
Dim avg As Integer
avg = UBound(Unit(1).X)
ReDim Preserve Unit(1).X(avg + 1) ' Preserver just method, it may possible to use just simple copy to tmp_buffer
ReDim Preserve Unit(1).Y(avg + 1)
End Sub
Private Sub Initialize()
DirectionByte = 0 ' default up
ClearAREA ' clear field for game
InitPlayer ' playable snake character prepare
InitEnemy ' bots prepare
InitCarrots
InitStones ' generate stones and carrots buffers with fill it by randoms
End Sub
Private Sub ClearAREA()
'Dim a As Integer
'Dim b As Integer
' For a = 1 To 30
' For b = 1 To 60
' Cells(a, b).Value = ""
' DoEvents
' ActiveWindow.Caption = "clearing..."
' Next
' Next
' ActiveWindow.Caption = "Running..."
Range("a1:bh40").Select ' it fastly over 100000 times
Selection.CLear
Cells(30, 30).Select
End Sub
Private Sub InitPlayer()
ReDim Unit(1).X(DefaultPlayerLenght) 'making matrix of same size
ReDim Unit(1).Y(DefaultPlayerLenght)
Dim a As Integer
For a = 0 To DefaultPlayerLenght 'initial fill with middle of game area
Unit(1).X(a) = 30
Unit(1).Y(a) = a + 20
Next
End Sub
Private Sub InitEnemy()
End Sub
Private Sub InitCarrots()
With Carrotrs
ReDim .X(DefaultCarrotsQty) ' prepare buffer
ReDim .Y(DefaultCarrotsQty)
End With
Dim xx As Integer
Dim yy As Integer
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
For cnt = 0 To UBound(Carrotrs.X)
xx = Int((60 - 1 + 1) * Rnd + 1) ' filler of buffer
yy = Int((30 - 1 + 1) * Rnd + 1)
With Carrotrs
.X(cnt) = xx ' filling buffer with coords
.Y(cnt) = yy
Cells(yy, xx).Value = "V" ' also directly draw on screen
End With
Next
End Sub
Private Sub InitStones() ' to do here
End Sub
Private Sub MoveTick()
StopBit = False ' warning - reset every tick to sync globally
tmpX = Unit(1).X(0) ' copy to buffer "head" of snake, it next coord in use
tmpY = Unit(1).Y(0)
If DirectionByte = 3 Then
tmpX = tmpX + 1
End If
If DirectionByte = 2 Then
tmpX = tmpX - 1 ' incrementor \ dec conditions
End If
If DirectionByte = 0 Then
tmpY = tmpY - 1
End If
If DirectionByte = 1 Then
tmpY = tmpY + 1
End If
If tmpX = 0 Then
tmpX = 1
StopBit = True
End If
If tmpX = 61 Then
tmpX = 60
StopBit = True
End If
If tmpY = 0 Then
tmpY = 1 ' bound area checker and stopper
StopBit = True
End If
If tmpY = 41 Then
tmpY = 40
StopBit = True
End If
CheckSelfBite ' collision checkers in another focus, possible to write here directly, but
' it badly reading property
CheckCollideCarrot
Dim Cntr As Integer ' local counter
Dim avg As Integer ' just stupid temp value of bound
avg = UBound(Unit(1).X) ' gives matrix size (upper)
DoEvents
If StopBit = False Then ' if border - do nothing
For Cntr = avg - 1 To 0 Step -1
Unit(1).X(Cntr + 1) = Unit(1).X(Cntr) ' simple copier a+1 to a
Unit(1).Y(Cntr + 1) = Unit(1).Y(Cntr)
DoEvents
Next
Unit(1).X(0) = tmpX ' regenerate fresh head coords write here as last op
Unit(1).Y(0) = tmpY
Else
DoEvents ' for unfreeze excel interface in long loop
End If
End Sub
Private Sub Render()
For cnt = 0 To UBound(Unit(1).X) ' all coords of player matrix
DoEvents
Cells(Unit(1).Y(cnt), Unit(1).X(cnt)).Value = cnt ' write to cell, also can change it color
Next
cnt = UBound(Unit(1).X)
Cells(Unit(1).Y(cnt), Unit(1).X(cnt)).Value = "" ' remove tail especially without buffer glue
End Sub
Private Sub CheckSelfBite()
For cnt = 1 To UBound(Unit(1).X)
With Unit(1)
If tmpX = .X(cnt) And tmpY = .Y(cnt) Then ' if head==body you dead
WormDead
End If
End With
Next
End Sub
Private Sub WormDead()
RuntimeBit = False
StopBit = True
Cells(tmpY, tmpX).Select ' SFX and message of game over here
Selection.Value = "X"
End Sub
'-------------------------------- EVENTS ROUTINES --------------------------------
Private Sub B_5_Click()
End Sub
Private Sub B_DOWN_Click()
If DirectionByte = 0 Then Exit Sub
DirectionByte = 1
End Sub
Private Sub B_left_Click()
If DirectionByte = 3 Then Exit Sub ' if you move left you can not move right, you eat yourself, so do nothing on this event
DirectionByte = 2
End Sub
Private Sub B_right_Click()
If DirectionByte = 2 Then Exit Sub
DirectionByte = 3
End Sub
Private Sub B_UP_Click()
If DirectionByte = 1 Then Exit Sub
DirectionByte = 0
End Sub
Private Sub B_START_Click()
RuntimeBit = True
StopBit = False ' starting params for triggers
main
End Sub
Private Sub B_STOP_Click()
RuntimeBit = False ' exit condition bit in main loop
End Sub
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#78 | Четверг, 15.03.2018, 00:46
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#79 | Воскресенье, 18.03.2018, 22:16
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#80 | Суббота, 31.03.2018, 23:51
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
almanack
|
#81 | Воскресенье, 01.04.2018, 02:06
|
Повелитель стихий
Постоянные пациенты
Юзер-бар +
ШТАМП, лисичка просто прелесть 
Я всегда хотел быть котиком. И сейчас это мне удалось.
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#82 | Среда, 04.04.2018, 00:09
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#83 | Суббота, 07.04.2018, 03:02
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#84 | Пятница, 18.05.2018, 20:52
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
Вторая работа под сомнением пока нет медстсетры либо еще кого, основная стала уже проще да и заказы не идут волной.
|
Статус: нет меня
|
|
|
|
Wizard
|
#85 | Пятница, 25.05.2018, 15:06
|
Матафон
На вязках
Юзер-бар +
Цитата ШТАМП (  ) основная стала уже проще да и заказы не идут волной.
отлично
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#86 | Воскресенье, 03.06.2018, 11:18
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
Wizard
|
#87 | Воскресенье, 03.06.2018, 12:44
|
Матафон
На вязках
Юзер-бар +
а эт от чего клава? Спутниковый тюнер?
|
Сообщение отредактировал(а) Wizard - Воскресенье, 03.06.2018, 12:45
|
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#88 | Воскресенье, 03.06.2018, 12:58
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
Это модуль управления охранно-пожарной сигнализации
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#89 | Воскресенье, 03.06.2018, 13:04
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
|
Кот_Матроскин
|
#90 | Понедельник, 11.06.2018, 05:55
|
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Диагноз: melancholical disorder
|
Статус: нет меня
|
|
|
