netica
Простая и в тоже время занимательная игра. Принцип состоит в том, чтобы объединять равные цифры в одну, набирая при этом очки. Есть три режима игры:
- Шаг за шагом - все цифры передвигаются в заданном направлении на один шаг, одинаковые объединяются
- До стены - все цифры передвигаются в заданном направлении пока не упрутся в стену или в соседнюю цифру, одинаковые объединяются
- 123,6 - режим такой же как Шаг за шагом, но надо сначала объединить цифры в тройки и дальше тройки уже могут объединяться. На мой взягляд этот режим самый сложный.
Автор: ThePuppetMaster
Платформы:
Windows , Linux
'########################################################################################################################################## Dim Shared G_Version As String: G_Version = "1.02.0" '########################################################################################################################################## Open Cons For Output As #1 '########################################################################################################################################## '#Define USE_MOCE #IF DEFINED(USE_MOCE) #INCLUDE Once "../../../bi/moce/moce.bi" #ENDIF '########################################################################################################################################## Dim Shared G_GridSize As Integer = 4 Dim Shared G_ScreenW As Integer = 440 Dim Shared G_ScreenH As Integer = 440 Dim Shared G_FieldOverlay As Any Ptr '########################################################################################################################################## Dim Shared G_NetD(1 To 5, 1 To 5) As Integer Dim Shared G_NetN(1 To 5, 1 To 5) As Integer Dim Shared G_NetM(1 To 5, 1 To 5) As Integer Dim Shared G_AnimZ As Integer Dim Shared G_AnimS As Integer Dim Shared G_Score As Integer Dim Shared G_GameMode As Integer = 1 Dim Shared G_GameEnd As Integer = 1 Dim Shared G_12RatioC As Integer Dim Shared G_12RatioL As Integer '########################################################################################################################################## Function Net_RndAdd(V_SetMy As Integer) As Integer Dim C As Integer For Y As Integer = 1 To G_GridSize For X As Integer = 1 To G_GridSize If G_NetD(Y, X) = 0 Then C += 1 Next Next Dim Z As Integer = Int((Rnd * C) + 1) C = 0 Dim TV As Integer For Y As Integer = 1 To G_GridSize For X As Integer = 1 To G_GridSize If G_NetD(Y, X) = 0 Then C += 1 If C = Z Then Do TV = (2 ^ Int(Rnd * 2)) If G_12RatioL <> TV Then Exit Do G_12RatioC += 1 If G_12RatioC < 3 Then Exit Do Loop G_12RatioL = TV G_12RatioC = 0 G_NetD(Y, X) = TV Return 1 End If Next Next Return 0 End Function '########################################################################################################################################## Sub DrawNums(V_PosX As Integer, V_PosY As Integer, V_Size As Integer, V_Color As Uinteger, V_Num As Integer) Dim V As Integer Dim S As String = Str(V_Num) Dim TX As Integer Dim TFW As Integer = V_Size / 2 For Z As Integer = 0 To Len(S) - 1 If (Len(S) Mod 2) = 0 Then TX = V_PosX + TFW - ((Fix(Len(S) / 2) - Z) * V_Size) Else: TX = V_PosX - ((Fix(Len(S) / 2) - Z) * V_Size) End If V = S[Z] - 48 Select Case V Case 0, 4, 5, 6, 8, 9 : Line (TX - TFW + 4, V_PosY - TFW - 1)-(TX - TFW + 3, V_PosY), V_Color, BF End Select Select Case V Case 0, 2, 6, 8 : Line (TX - TFW + 4, V_PosY + TFW + 1)-(TX - TFW + 3, V_PosY), V_Color, BF End Select Select Case V Case 0, 1, 2, 3, 4, 7, 8, 9 : Line (TX + TFW - 4, V_PosY - TFW - 1)-(TX + TFW - 3, V_PosY), V_Color, BF End Select Select Case V Case 0, 1, 3, 4, 5, 6, 7, 8, 9 : Line (TX + TFW - 4, V_PosY + TFW + 1)-(TX + TFW - 3, V_PosY), V_Color, BF End Select Select Case V Case 0, 2, 3, 5, 6, 7, 8, 9 : Line (TX - TFW + 4, V_PosY - TFW - 1)-(TX + TFW - 3, V_PosY - TFW), V_Color, BF End Select Select Case V Case 2, 3, 4, 5, 6, 8, 9 : Line (TX - TFW + 4, V_PosY - 1)-(TX + TFW - 3, V_PosY), V_Color, BF End Select Select Case V Case 0, 2, 3, 5, 6, 8, 9 : Line (TX - TFW + 4, V_PosY + TFW + 1)-(TX + TFW - 3, V_PosY + TFW), V_Color, BF End Select Next End Sub '########################################################################################################################################## Function GetCol(V_Value As Integer) As Uinteger Select Case V_Value Case 1 : Return &HFF00EADA Case 2 : Return &HFF00EA94 Case 4, 3 : Return &HFF00EA3B Case 8, 6 : Return &HFF27EA00 Case 16, 12 : Return &HFF72EA08 Case 32, 24 : Return &HFFAEEA09 Case 64, 48 : Return &HFFD2E100 Case 128, 96 : Return &HFFFFCC00 Case 256, 192 : Return &HFFFFA200 Case 512, 384 : Return &HFFFF6A00 Case 1024, 768 : Return &HFFFF2B00 Case 2048, 1536 : Return &HFFE00000 Case 4096, 3072 : Return &HFFE0234F Case 8192, 6144 : Return &HFFE02692 Case 16384, 12288 : Return &HFFD12BBE Case 32768, 24376 : Return &HFFD72DEA Case 65536 : Return &HFFBC27CD Case 131072 : Return &HFF742FB4 Case 262144 : Return &HFF4F38B4 Case 524288 : Return &HFF3B39B4 Case 1048576 : Return &HFF4447AD Case 2097152 : Return &HFF5365AD Case 4194304 : Return &HFF6A51AD Case 8388608 : Return &HFF7550AD Case 16777216 : Return &HFFA450AD End Select End Function '########################################################################################################################################## Sub Redraw() Dim X As Integer Dim Y As Integer Dim Z As Integer Dim V As Integer Dim C As Integer Dim S As String Dim TW As Integer = G_ScreenW / G_GridSize Dim TH As Integer = G_ScreenH / G_GridSize Dim TB As Integer = 3 Dim TCol As Uinteger Dim TAX As Integer Dim TAY As Integer Dim TFS As Integer = Iif(G_GridSize = 5, 12, 20) Screenlock() Line (0, 0)-(G_ScreenW, G_ScreenH), &HFF999999, BF For Y = 1 To G_GridSize For X = 1 To G_GridSize Line((X - 1) * TW + TB, (Y - 1) * TH + TB)-(X * TW - TB, Y * TH - TB), &HFFFFFFFF, BF If G_NetD(X, Y) <> 0 Then If G_NetM(X, Y) = 0 Then TCol = GetCol(G_NetD(X, Y)) Line(TAX + (X - 1) * TW + TB, TAY + (Y - 1) * TH + TB)-(TAX + X * TW - TB, TAY + Y * TH - TB), TCol, BF Put (TB + (X - 1) * TW + TB, TB + (Y - 1) * TH + TB), G_FieldOverlay, (0, 0)-(TW - TB * 3 - 1, TH - TB * 3 - 1), Alpha DrawNums(TAX + X * TW - TW / 2, TAY + Y * TW - TH / 2, TFS, &HFF000000, G_NetD(X, Y)) End If End If Line((X - 1) * TW + TB, (Y - 1) * TH + TB)-(X * TW - TB, Y * TH - TB), &HFF666666, B Next Next For Y = 1 To G_GridSize For X = 1 To G_GridSize If G_NetM(X, Y) <> 0 Then TCol = GetCol(G_NetD(X, Y)) TAX = 0 TAY = 0 If G_NetM(X, Y) <> 0 Then Select Case G_NetM(X, Y) Case 1: TAY = -G_AnimZ Case 2: TAY = G_AnimZ Case 3: TAX = -G_AnimZ Case 4: TAX = G_AnimZ End Select End If Line(TAX + (X - 1) * TW + TB, TAY + (Y - 1) * TH + TB)-(TAX + X * TW - TB, TAY + Y * TH - TB), TCol, BF Put (TAX + TB + (X - 1) * TW + TB, TAY + TB + (Y - 1) * TH + TB), G_FieldOverlay, (0, 0)-(TW - TB * 3 - 1, TH - TB * 3 - 1), Alpha DrawNums(TAX + X * TW - TW / 2, TAY + Y * TW - TH / 2, TFS, &HFF000000, G_NetD(X, Y)) Line(TAX + (X - 1) * TW + TB, TAY + (Y - 1) * TH + TB)-(TAX + X * TW - TB, TAY + Y * TH - TB), &HFF666666, B End If Next Next If G_GameEnd <> 0 Then Line (50, G_ScreenH / 2 - 60)-(G_ScreenW - 50, G_ScreenH / 2 + 80), &HFFB9BFFF, BF Select Case G_GameEnd Case 1 X = 1: S = "n e t i c a" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 3: S = "V:" & G_Version Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 4: S = "freebasic@deltalabs.de" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 6: S = " ESC = Exit" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 7: S = " ARROW-Keys = Move the stones" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 8: S = " ENTER = Start new game" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 9: S = " m = Change PlayMode" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 10: S = " g = Gridsize" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 11 S = "PlayMode: " Select Case G_GameMode Case 0: S += "Step-By-Step" Case 1: S += "ToWall" Case 2: S += "123,6" End Select Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 50 + (X * 10)), S, &HFF000000 X = 12 S = "Grid: " & Str(G_GridSize) Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 50 + (X * 10)), S, &HFF000000 Case 2 X = 1: S = "n e t i c a" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 4: S = "YEAH!!!" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 6: S = "this is your score:" Draw String (G_ScreenW / 2 - (Len(S) * 4), G_ScreenH / 2 - 60 + (X * 10)), S, &HFF000000 X = 9 DrawNums(G_ScreenW / 2, G_ScreenH / 2 - 60 + (X * 10), 20, &HFF000000, G_Score) End Select Line (50, G_ScreenH / 2 - 60)-(G_ScreenW - 50, G_ScreenH / 2 + 80), &HFF000000, B Line (50 - 1, G_ScreenH / 2 - 60 - 1)-(G_ScreenW - 50 + 1, G_ScreenH / 2 + 80 + 1), &HFFFFFFFF, B Line (50 - 2, G_ScreenH / 2 - 60 - 2)-(G_ScreenW - 50 + 2, G_ScreenH / 2 + 80 + 2), &HFFFFFFFF, B End If Screenunlock() #IF DEFINED(USE_MOCE) MOCE_Shot(0, 1) #ENDIF End Sub '########################################################################################################################################## Sub CheckClear() Dim X As Integer Dim Y As Integer For Y = 1 To G_GridSize For X = 1 To G_GridSize G_NetM(X, Y) = 0 G_NetN(X, Y) = 0 Next Next End Sub '########################################################################################################################################## Function CheckDo1(V_Direction As Integer, V_GameMode As Integer) As Integer Dim TRV As Integer Dim X As Integer Dim Y As Integer Select Case V_Direction Case 1 'U For Y = 1 To G_GridSize For X = 1 To G_GridSize If Y = 1 Then G_NetN(X, Y) = G_NetD(X, Y): Continue For If G_NetD(X, Y) = 0 Then Continue For If G_NetN(X, Y - 1) = 0 Then G_NetN(X, Y - 1) = G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = 1 Continue For Elseif (V_GameMode = 2) And ((G_NetN(X, Y - 1) + G_NetD(X, Y)) <= 4) Then If ((G_NetN(X, Y - 1) + G_NetD(X, Y)) <> 3) Then G_NetN(X, Y) = G_NetD(X, Y): Continue For G_NetN(X, Y - 1) = 3 G_NetM(X, Y) = V_Direction TRV = G_NetN(X, Y - 1) Continue For Elseif G_NetN(X, Y - 1) = G_NetD(X, Y) Then G_NetN(X, Y - 1) += G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = G_NetN(X, Y - 1) Continue For Else: G_NetN(X, Y) = G_NetD(X, Y): Continue For End If Next Next Case 2 'D For Y = G_GridSize To 1 Step -1 For X = 1 To G_GridSize If Y = G_GridSize Then G_NetN(X, Y) = G_NetD(X, Y): Continue For If G_NetD(X, Y) = 0 Then Continue For If G_NetN(X, Y + 1) = 0 Then G_NetN(X, Y + 1) = G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = 1 Continue For Elseif (V_GameMode = 2) And ((G_NetN(X, Y + 1) + G_NetD(X, Y)) <= 4) Then If ((G_NetN(X, Y + 1) + G_NetD(X, Y)) <> 3) Then G_NetN(X, Y) = G_NetD(X, Y): Continue For G_NetN(X, Y + 1) = 3 G_NetM(X, Y) = V_Direction TRV = G_NetN(X, Y - 1) Continue For Elseif G_NetN(X, Y + 1) = G_NetD(X, Y) Then G_NetN(X, Y + 1) += G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = G_NetN(X, Y + 1) Continue For Else: G_NetN(X, Y) = G_NetD(X, Y): Continue For End If Next Next Case 3 'L For X = 1 To G_GridSize For Y = 1 To G_GridSize If X = 1 Then G_NetN(X, Y) = G_NetD(X, Y): Continue For If G_NetD(X, Y) = 0 Then Continue For If G_NetN(X - 1, Y) = 0 Then G_NetN(X - 1, Y) = G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = 1 Continue For Elseif (V_GameMode = 2) And ((G_NetN(X - 1, Y) + G_NetD(X, Y)) <= 4) Then If ((G_NetN(X - 1, Y) + G_NetD(X, Y)) <> 3) Then G_NetN(X, Y) = G_NetD(X, Y): Continue For G_NetN(X - 1, Y) = 3 G_NetM(X, Y) = V_Direction TRV = G_NetN(X, Y - 1) Continue For Elseif G_NetN(X - 1, Y) = G_NetD(X, Y) Then G_NetN(X - 1, Y) += G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = G_NetN(X - 1, Y) Continue For Else: G_NetN(X, Y) = G_NetD(X, Y): Continue For End If Next Next Case 4 'R For X = G_GridSize To 1 Step -1 For Y = 1 To G_GridSize If X = G_GridSize Then G_NetN(X, Y) = G_NetD(X, Y): Continue For If G_NetD(X, Y) = 0 Then Continue For If G_NetN(X + 1, Y) = 0 Then G_NetN(X + 1, Y) = G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = 1 Continue For Elseif (V_GameMode = 2) And ((G_NetN(X + 1, Y) + G_NetD(X, Y)) <= 4) Then If ((G_NetN(X + 1, Y) + G_NetD(X, Y)) <> 3) Then G_NetN(X, Y) = G_NetD(X, Y): Continue For G_NetN(X + 1, Y) = 3 G_NetM(X, Y) = V_Direction TRV = G_NetN(X, Y - 1) Continue For Elseif G_NetN(X + 1, Y) = G_NetD(X, Y) Then G_NetN(X + 1, Y) += G_NetD(X, Y) G_NetM(X, Y) = V_Direction TRV = G_NetN(X + 1, Y) Continue For Else: G_NetN(X, Y) = G_NetD(X, Y): Continue For End If Next Next End Select Return TRV End Function '########################################################################################################################################## Sub DoAnimation() Dim TW As Integer = G_ScreenW / G_GridSize Dim TH As Integer = G_ScreenH / G_GridSize If TH > TW Then TW = TH Do If G_AnimS < 30 Then G_AnimS += 2 G_AnimZ += G_AnimS If G_AnimZ > TW Then G_AnimZ = TW Redraw() Sleep 15, 1 If G_AnimZ >= TW Then Exit Do Loop End Sub '########################################################################################################################################## Sub DoActions() For Y As Integer = 1 To G_GridSize For X As Integer = 1 To G_GridSize G_NetD(X, Y) = G_NetN(X, Y) G_NetM(X, Y) = 0 Next Next End Sub '########################################################################################################################################## Sub DoMove(V_Direction As Integer) Dim TRV As Integer Select Case G_GameMode Case 0 CheckClear() G_Score += CheckDo1(V_Direction, G_GameMode) DoAnimation() DoActions() G_AnimZ = 0 G_AnimS = 0 Case 1 Do G_AnimZ = 0 CheckClear() TRV = CheckDo1(V_Direction, G_GameMode) DoAnimation() DoActions() Redraw() If TRV = 0 Then Exit Do G_Score += TRV Loop G_AnimZ = 0 G_AnimS = 0 Case 2 CheckClear() G_Score += CheckDo1(V_Direction, G_GameMode) DoAnimation() DoActions() G_AnimZ = 0 G_AnimS = 0 End Select TRV = Net_RndAdd(1) If TRV = 0 Then G_GameEnd = 2 G_Score += (TRV * 10) End Sub '########################################################################################################################################## Sub GameStart() G_Score = 0 CheckClear() For Y As Integer = 1 To G_GridSize For X As Integer = 1 To G_GridSize G_NetD(X, Y) = 0 Next Next For X As Integer = 1 To G_GridSize - 1 Net_RndAdd(1) Next Windowtitle "TPM's netica V" & G_Version & " [score: nonix]" G_GameEnd = 0 End Sub '########################################################################################################################################## Sub Main() Randomize Timer() Screenres(G_ScreenW, G_ScreenH, 32) G_FieldOverlay = Imagecreate(G_ScreenW / 4, G_ScreenH / 4, &H00000000, 32) For X As Integer = 0 To 255 Line G_FieldOverlay, (X, 0)-(0, X), Rgba(255, 255, 255, X) Next Windowtitle "TPM's netica V" & G_Version & " [score: nonix]" #IF DEFINED(USE_MOCE) Mkdir "/home/tpm/temp/moce/" MOCE_Init("/home/tpm/temp/moce/", G_ScreenW, G_ScreenH) #ENDIF Dim TKey As String Dim TKey0 As Ubyte Dim TKey1 As Ubyte G_NetD(1, 1) = 8 Do TKey0 = 0 TKey1 = 0 TKey = Inkey() If Len(TKey) > 0 Then TKey0 = TKey[0] If Len(TKey) > 1 Then TKey1 = TKey[1] Select Case TKey0 Case 0 Case 13: If G_GameEnd <> 0 Then GameStart() Case 27: Exit Do Case 103 If G_GridSize = 4 Then G_GridSize = 5 Else G_GridSize = 4 G_GameEnd = 1 Case 109 G_GameMode += 1 If G_GameMode > 2 Then G_GameMode = 0 G_GameEnd = 1 Case 255 If G_GameEnd <> 0 Then Exit Select Select Case TKey1 Case 72: DoMove(1) Case 80: DoMove(2) Case 75: DoMove(3) Case 77: DoMove(4) End Select Windowtitle "TPM's netica V" & G_Version & " [score: " & Str(G_Score) & "]" End Select Do Until Inkey() = "" Loop Redraw() Sleep 40, 1 Loop #IF DEFINED(USE_MOCE) MOCE_Render("/home/tpm/temp/moce.avi") #ENDIF End Sub '########################################################################################################################################## Main() End 0
