Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. '########################################################################################################################
    
  2. ' JewelX - n Jewels Clone
    
  3. '########################################################################################################################
    
  4. 'Idee: 2012.08.20 - 12:20:36
    
  5. 'Autor: Martin Wiemann - Admin@mln.ath.cx
    
  6. 'Lizenz: Tu was du nicht lassen kannst, solange du hiermit nicht mehr geld verdienst, als ich!
    
  7. '########################################################################################################################
    
  8. 'NOTE: ""XTGUI mechanism copyright by Martin Wiemann
    
  9. 'NOTE: patent pending for ""XTGUI mechanism!
    
  10. 'NOTE: (contact us for comercial usage licence! Info@deltalabs.de)
    
  11. '########################################################################################################################
    
  12. 
    
  13. 
    
  14. 
    
  15. '########################################################################################################################
    
  16. #INCLUDE Once "vbcompat.bi"
    
  17. 
    
  18. 
    
  19. 
    
  20. '########################################################################################################################
    
  21. Dim Shared G_FieldW             As Uinteger = 12
    
  22. Dim Shared G_FieldH             As Uinteger = 12
    
  23. Dim Shared G_ImgWH              As Uinteger = 25
    
  24. Dim Shared G_StatOffset         As Uinteger = 50
    
  25. Dim Shared G_Field()            As Integer
    
  26. Dim Shared G_FieldNoShow()      As Integer
    
  27. Dim Shared G_FieldBG()          As Integer
    
  28. Dim Shared G_FieldOffsetX()     As Integer
    
  29. Dim Shared G_FieldOffsetY()     As Integer
    
  30. Dim Shared G_IMGJewelD(5)       As Any Ptr
    
  31. Dim Shared G_IMGPuzzleD(10)     As Any Ptr
    
  32. Dim Shared G_IMGRock            As Any Ptr
    
  33. Dim Shared G_IMGEarth           As Any Ptr
    
  34. Dim Shared G_IMGBackground      As Any Ptr
    
  35. Dim Shared G_IMGBackgroundOK    As Any Ptr
    
  36. Dim Shared G_CurX               As Ubyte
    
  37. Dim Shared G_CurY               As Ubyte
    
  38. Dim Shared G_CurHide            As Ubyte
    
  39. Dim Shared G_SelX               As Ubyte
    
  40. Dim Shared G_SelY               As Ubyte
    
  41. Dim Shared G_GameMode           As Ubyte
    
  42. Dim Shared G_GameLevel          As Ubyte
    
  43. Dim Shared G_GameStartTime      As Double
    
  44. Dim Shared G_GamePoints         As Uinteger
    
  45. Dim Shared G_GameStones         As Uinteger
    
  46. 
    
  47. 
    
  48. 
    
  49. '########################################################################################################################
    
  50. ' \/ see notes! \/
    
  51. '########################################################################################################################
    
  52. Dim Shared XTGUI_IMGBG As Any Ptr
    
  53. Dim Shared XTGUI_IMGBU As Any Ptr
    
  54. Dim Shared XTGUI_W As Uinteger
    
  55. Dim Shared XTGUI_H As Uinteger
    
  56. 
    
  57. '------------------------------------------------------------------------------------------------------------------------
    
  58. Sub XTGUI_Init(V_Width As Uinteger, V_Height As Uinteger)
    
  59. If XTGUI_IMGBG <> 0 Then Exit Sub
    
  60. XTGUI_W = V_Width
    
  61. XTGUI_H = V_Height
    
  62. XTGUI_IMGBG = Imagecreate(XTGUI_W, XTGUI_H, 32)
    
  63. XTGUI_IMGBU = Imagecreate(XTGUI_W, XTGUI_H, 32)
    
  64. Line XTGUI_IMGBG, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
    
  65. Line XTGUI_IMGBU, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
    
  66. End Sub
    
  67. 
    
  68. '------------------------------------------------------------------------------------------------------------------------
    
  69. Sub XTGUI_Term()
    
  70. If XTGUI_IMGBG <> 0 Then Imagedestroy(XTGUI_IMGBG): XTGUI_IMGBG = 0
    
  71. If XTGUI_IMGBU <> 0 Then Imagedestroy(XTGUI_IMGBU): XTGUI_IMGBU = 0
    
  72. End Sub
    
  73. 
    
  74. '------------------------------------------------------------------------------------------------------------------------
    
  75. Sub XTGUI_Cls()
    
  76. Line XTGUI_IMGBG, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
    
  77. Line XTGUI_IMGBU, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
    
  78. End Sub
    
  79. 
    
  80. '------------------------------------------------------------------------------------------------------------------------
    
  81. Function XTGUI_GetDrawBuffer() As Any Ptr
    
  82. Return XTGUI_IMGBG
    
  83. End Function
    
  84. 
    
  85. '------------------------------------------------------------------------------------------------------------------------
    
  86. Sub XTGUI_AddText(V_Left As Integer, V_Top As Integer, V_Text As String, V_TextColor As Uinteger = &H00FFFFFF)
    
  87. Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), V_Text, V_TextColor
    
  88. End Sub
    
  89. 
    
  90. '------------------------------------------------------------------------------------------------------------------------
    
  91. Sub XTGUI_AddButton(V_Left As Integer, V_Top As Integer, V_Width As Uinteger, V_Height As Uinteger, V_Text As String, V_Callback As Any Ptr, V_BackColor As Uinteger = &H007070CC, V_TextColor As Uinteger = &H00FFFFFF, V_BorderColor As Uinteger = &H000000FF)
    
  92. Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
    
  93. Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
    
  94. Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), V_Text, V_TextColor
    
  95. Line XTGUI_IMGBU, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), Cast(Uinteger, V_Callback), BF
    
  96. End Sub
    
  97. 
    
  98. '------------------------------------------------------------------------------------------------------------------------
    
  99. Sub XTGUI_Draw(V_OffsetX As Integer, V_OffsetY As Integer)
    
  100. Put (V_OffsetX, V_OffsetY), XTGUI_IMGBG, Pset
    
  101. End Sub
    
  102. 
    
  103. '------------------------------------------------------------------------------------------------------------------------
    
  104. Function XTGUI_CheckIO(V_OffsetX As Integer, V_OffsetY As Integer) As Integer
    
  105. Static XTGUI_TX As Integer
    
  106. Static XTGUI_TY As Integer
    
  107. Static XTGUI_TZ As Integer
    
  108. Static XTGUI_TB As Integer
    
  109. Dim TR As Integer
    
  110. Dim TX As Integer
    
  111. Dim TY As Integer
    
  112. Dim TZ As Integer
    
  113. Dim TB As Integer
    
  114. Dim RV As Integer = 0
    
  115. TR = Getmouse(TX, TY, TZ, TB)
    
  116. If TR = 0 Then
    
  117.     If XTGUI_TB <> TB Then
    
  118.         If TB = 1 Then
    
  119.             If ((TX - V_OffsetX) >= 0) And ((TX - V_OffsetX) < XTGUI_W) Then
    
  120.                 If ((TY - V_OffsetY) >= 0) And ((TY - V_OffsetY) < XTGUI_H) Then
    
  121.                     Dim TSub As Sub (Byref R_Return As Integer = 0)
    
  122.                     TSub = Cast(Any Ptr, Cast(Uinteger Ptr, XTGUI_IMGBU + 32)[(TY - V_OffsetY) * XTGUI_W + (TX - V_OffsetX)])
    
  123.                     If TSub <> 0 Then TSub(RV)
    
  124.                 End If
    
  125.             End If
    
  126.         End If
    
  127.     End If
    
  128.     XTGUI_TX = TX
    
  129.     XTGUI_TY = TY
    
  130.     XTGUI_TZ = TZ
    
  131.     XTGUI_TB = TB
    
  132. End If
    
  133. Return RV
    
  134. End Function
    
  135. '########################################################################################################################
    
  136. ' /\ see notes! /\
    
  137. '########################################################################################################################
    
  138. 
    
  139. 
    
  140. 
    
  141. '########################################################################################################################
    
  142. Sub Jewels_Exit(Byref R_Return As Integer = 0)
    
  143. R_Return = 1
    
  144. End Sub
    
  145. 
    
  146. '------------------------------------------------------------------------------------------------------------------------
    
  147. Sub Jewels_New(Byref R_Return As Integer = 0)
    
  148. R_Return = 2
    
  149. End Sub
    
  150. 
    
  151. '------------------------------------------------------------------------------------------------------------------------
    
  152. Sub Jewels_NewFill(Byref R_Return As Integer = 0)
    
  153. R_Return = 3
    
  154. End Sub
    
  155. 
    
  156. '------------------------------------------------------------------------------------------------------------------------
    
  157. Sub Jewels_NewRock(Byref R_Return As Integer = 0)
    
  158. R_Return = 4
    
  159. End Sub
    
  160. 
    
  161. '------------------------------------------------------------------------------------------------------------------------
    
  162. Sub Jewels_NewPuzzle(Byref R_Return As Integer = 0)
    
  163. R_Return = 5
    
  164. End Sub
    
  165. 
    
  166. '------------------------------------------------------------------------------------------------------------------------
    
  167. Sub Jewels_NewPuzzleRock(Byref R_Return As Integer = 0)
    
  168. R_Return = 6
    
  169. End Sub
    
  170. 
    
  171. '------------------------------------------------------------------------------------------------------------------------
    
  172. Sub Jewels_Abort(Byref R_Return As Integer = 0)
    
  173. R_Return = 10
    
  174. End Sub
    
  175. 
    
  176. '------------------------------------------------------------------------------------------------------------------------
    
  177. Sub Jewels_Resume(Byref R_Return As Integer = 0)
    
  178. R_Return = 11
    
  179. End Sub
    
  180. 
    
  181. 
    
  182. 
    
  183. '#####################################################################################################################
    
  184. Function TimeFormat(V_Value As Uinteger) As String
    
  185. Dim XR As Uinteger = V_Value
    
  186. Dim XH As Uinteger = XR \ 3600:     XR = XR Mod 3600
    
  187. Dim XM As Uinteger = XR \ 60:       XR = XR Mod 60
    
  188. Return Format(XH, "00") & ":" & Format(XM, "00") & ":" & Format(XR, "00")
    
  189. End Function
    
  190. 
    
  191. 
    
  192. 
    
  193. '########################################################################################################################
    
  194. Sub DoDraw()
    
  195. Dim TImg As Any Ptr
    
  196. Screenlock()
    
  197. Cls()
    
  198. Dim X As Integer
    
  199. For Y As Integer = 0 To G_FieldH - 1
    
  200.     For X = 0 To G_FieldW - 1
    
  201.         Select Case G_FieldBG(Y + 1, X + 1)
    
  202.             Case 0: Put (X * G_ImgWH, Y * G_ImgWH), G_IMGBackground, Pset
    
  203.             Case 1: Put (X * G_ImgWH, Y * G_ImgWH), G_IMGBackgroundOK, Pset
    
  204.         End Select
    
  205.     Next
    
  206. Next
    
  207. For Y As Integer = 0 To G_FieldH - 1
    
  208.     For X = 0 To G_FieldW - 1
    
  209.         Select Case G_Field(Y + 1, X + 1)
    
  210.             Case 0
    
  211.             Case 1 To 5 'steine
    
  212.                 If G_FieldNoShow(Y + 1, X + 1) = 0 Then
    
  213.                     Put (X * G_ImgWH + G_FieldOffsetX(Y + 1, X + 1), Y * G_ImgWH + G_FieldOffsetY(Y + 1, X + 1)), G_IMGJewelD(G_Field(Y + 1, X + 1)), Alpha
    
  214.                 End If
    
  215.                 
    
  216.             Case 6 To 10 'rock-steine
    
  217.                 If G_FieldNoShow(Y + 1, X + 1) = 0 Then
    
  218.                     Put (X * G_ImgWH, Y * G_ImgWH), G_IMGJewelD(G_Field(Y + 1, X + 1) - 5), Alpha
    
  219.                 End If
    
  220.                 Put (X * G_ImgWH, Y * G_ImgWH), G_IMGRock, Alpha
    
  221.                 
    
  222.             Case 11 To 20 'puzzel
    
  223.                 Put (X * G_ImgWH + G_FieldOffsetX(Y + 1, X + 1), Y * G_ImgWH + G_FieldOffsetY(Y + 1, X + 1)), G_IMGPuzzleD(G_Field(Y + 1, X + 1) - 10), Alpha
    
  224.                 
    
  225.             Case 21 'unnutzbar
    
  226.                 Put (X * G_ImgWH, Y * G_ImgWH), G_IMGEarth, Pset
    
  227.                 
    
  228.         End Select
    
  229.     Next
    
  230. Next
    
  231. Dim TCol As Uinteger = &H006666FF
    
  232. If G_SelX <> 0 Then TCol = &H00FFFF00
    
  233. If G_CurHide = 0 Then
    
  234.     Line ((G_CurX - 1) * G_ImgWH, (G_CurY - 1) * G_ImgWH)-(G_CurX * G_ImgWH, G_CurY * G_ImgWH), TCol, B
    
  235.     Line ((G_CurX - 1) * G_ImgWH - 1, (G_CurY - 1) * G_ImgWH - 1)-(G_CurX * G_ImgWH + 1, G_CurY * G_ImgWH + 1), TCol, B
    
  236. End If
    
  237. 
    
  238. X = G_FieldH * G_ImgWH
    
  239. Line (0, X)-(G_FieldW * G_ImgWH - 1, X + G_StatOffset - 1), &H00444444, BF
    
  240. Line (0, X)-(G_FieldW * G_ImgWH - 1, X + G_StatOffset - 1), &H00888888, B
    
  241. Draw String (3, X + 3), "Points:  " & Space(8 - Iif(Len(Str(G_GamePoints)) > 8, 8, Len(Str(G_GamePoints)))) & Str(G_GamePoints)
    
  242. Draw String (3, X + 15), "Runtime: " & TimeFormat(Fix(Timer() - G_GameStartTime))
    
  243. Draw String (3, X + 27), "Stones:  " & Space(8 - Iif(Len(Str(G_GameStones)) > 8, 8, Len(Str(G_GameStones)))) & Str(G_GameStones)
    
  244. Select Case G_GameMode
    
  245.     Case 2 To 5: Draw String (3, X + 39), "Level:   " & Space(8 - Iif(Len(Str(G_GameLevel)) > 8, 8, Len(Str(G_GameLevel)))) & Str(G_GameLevel)
    
  246. End Select
    
  247. Screenunlock()
    
  248. End Sub
    
  249. 
    
  250. 
    
  251. 
    
  252. '########################################################################################################################
    
  253. Function CheckGoal() As Integer
    
  254. Dim X As Integer
    
  255. Dim Y As Integer
    
  256. Select Case G_GameMode
    
  257.     Case 1: Return -1
    
  258.     Case 2, 3
    
  259.         For Y = 1 To G_FieldH
    
  260.             For X = 1 To G_FieldW
    
  261.                 If G_Field(Y, X) <> 21 Then If G_FieldBG(Y, X) = 0 Then Return -1
    
  262.             Next
    
  263.         Next
    
  264.         
    
  265.     Case 4, 5
    
  266.         Dim Z As Integer
    
  267.         Dim X1 As Integer
    
  268.         Dim Y1 As Integer
    
  269.         For Y = 1 To G_FieldH
    
  270.             For X = 1 To G_FieldW
    
  271.                 Select Case G_Field(Y, X)
    
  272.                     Case 11, 14, 17
    
  273.                         X1 = X
    
  274.                         Y1 = Y
    
  275.                         Z = G_Field(Y, X)
    
  276.                         Do
    
  277.                             Select Case Z
    
  278.                                 Case 11 To 13
    
  279.                                     X1 += 1
    
  280.                                     If X1 > G_FieldW Then Return -1
    
  281.                                     Select Case G_Field(Y, X1)
    
  282.                                         Case 12
    
  283.                                         Case 13: Exit Do
    
  284.                                         Case Else: Return -1
    
  285.                                     End Select
    
  286.                                     
    
  287.                                 Case 14 To 16
    
  288.                                     Y1 += 1
    
  289.                                     If Y1 > G_FieldH Then Return -1
    
  290.                                     Select Case G_Field(Y1, X)
    
  291.                                         Case 15
    
  292.                                         Case 16: Exit Do
    
  293.                                         Case Else: Return -1
    
  294.                                     End Select
    
  295.                                     
    
  296.                                 Case Else: Exit Do
    
  297.                             End Select
    
  298.                             If (X1 = X) And (Y1 = Y) Then Exit Do
    
  299.                         Loop
    
  300.                 End Select
    
  301.             Next
    
  302.         Next
    
  303.         
    
  304. End Select
    
  305. Return 1
    
  306. End Function
    
  307. 
    
  308. 
    
  309. '########################################################################################################################
    
  310. Function CheckField() As Integer
    
  311. Dim X As Integer
    
  312. Dim Y As Integer
    
  313. Dim Z As Integer
    
  314. Dim TID As Integer
    
  315. Dim C As Integer = 1
    
  316. Dim SZ As Integer = 1
    
  317. Dim TField(0 To G_FieldH, 0 To G_FieldW) As Integer
    
  318. Dim RV As Integer = 0
    
  319. Dim DRV As Integer
    
  320. Dim SZX As Integer
    
  321. Dim BC As Uinteger
    
  322. Do
    
  323.     BC = 0
    
  324.     DRV = 0
    
  325.     For Y = 1 To G_FieldH
    
  326.         For X = 1 To G_FieldW
    
  327.             TField(Y, X) = 0
    
  328.         Next
    
  329.     Next
    
  330.     For Y = 1 To G_FieldH
    
  331.         TID = Iif(G_Field(Y, 1) <= 5, G_Field(Y, 1), Iif(G_Field(Y, 1) <= 10, G_Field(Y, 1) - 5, G_Field(Y, 1)))
    
  332.         SZ = 1
    
  333.         C = 1
    
  334.         For X = 2 To G_FieldW
    
  335.             If (Iif(G_Field(Y, X) <= 5, G_Field(Y, X), Iif(G_Field(Y, X) <= 10, G_Field(Y, X) - 5, G_Field(Y, X))) <> TID) Or (X = G_FieldW) Then
    
  336.                 If X = G_FieldW Then If Iif(G_Field(Y, X) <= 5, G_Field(Y, X), Iif(G_Field(Y, X) <= 10, G_Field(Y, X) - 5, G_Field(Y, X))) = TID Then C += 1
    
  337.                 If C >= 3 Then
    
  338.                     Select Case TID
    
  339.                         Case 1 To 5, 6 To 10
    
  340.                             SZX = SZ + C - 1
    
  341.                             If SZX > G_FieldW Then SZX = G_FieldW
    
  342.                             For Z = SZ To SZX
    
  343.                                 TField(Y, Z) = 1
    
  344.                             Next
    
  345.                             G_GamePoints += C
    
  346.                             If C = 4 Then G_GamePoints += 1
    
  347.                             If C = 5 Then G_GamePoints += 1
    
  348.                             If C = 6 Then G_GamePoints += 2
    
  349.                             If C = 7 Then G_GamePoints += 3
    
  350.                             If C > 7 Then G_GamePoints += C
    
  351.                             BC += C
    
  352.                     End Select
    
  353.                 End If
    
  354.                 TID = Iif(G_Field(Y, X) <= 5, G_Field(Y, X), Iif(G_Field(Y, X) <= 10, G_Field(Y, X) - 5, G_Field(Y, X)))
    
  355.                 SZ = X
    
  356.                 C = 1
    
  357.             Else: C += 1
    
  358.             End If
    
  359.         Next
    
  360.     Next
    
  361.     For X = 1 To G_FieldW
    
  362.         TID = Iif(G_Field(1, X) <= 5, G_Field(1, X), Iif(G_Field(1, X) <= 10, G_Field(1, X) - 5, G_Field(1, X)))
    
  363.         SZ = 1
    
  364.         C = 1
    
  365.         For Y = 2 To G_FieldH
    
  366.             If (Iif(G_Field(Y, X) <= 5, G_Field(Y, X), Iif(G_Field(Y, X) <= 10, G_Field(Y, X) - 5, G_Field(Y, X))) <> TID) Or (Y = G_FieldH) Then
    
  367.                 If Y = G_FieldH Then If Iif(G_Field(Y, X) <= 5, G_Field(Y, X), Iif(G_Field(Y, X) <= 10, G_Field(Y, X) - 5, G_Field(Y, X))) = TID Then C += 1
    
  368.                 If C >= 3 Then
    
  369.                     Select Case TID
    
  370.                         Case 1 To 5, 6 To 10
    
  371.                             SZX = SZ + C - 1
    
  372.                             If SZX > G_FieldH Then SZX = G_FieldH
    
  373.                             For Z = SZ To SZX
    
  374.                                 TField(Z, X) = 1
    
  375.                             Next
    
  376.                             G_GamePoints += C
    
  377.                             If C = 4 Then G_GamePoints += 1
    
  378.                             If C = 5 Then G_GamePoints += 2
    
  379.                             If C = 6 Then G_GamePoints += 3
    
  380.                             If C = 7 Then G_GamePoints += 4
    
  381.                             If C > 7 Then G_GamePoints += C
    
  382.                             BC += C
    
  383.                     End Select
    
  384.                 End If
    
  385.                 TID = Iif(G_Field(Y, X) <= 5, G_Field(Y, X), Iif(G_Field(Y, X) <= 10, G_Field(Y, X) - 5, G_Field(Y, X)))
    
  386.                 SZ = Y
    
  387.                 C = 1
    
  388.             Else: C += 1
    
  389.             End If
    
  390.         Next
    
  391.     Next
    
  392.     If BC = 6 Then G_GamePoints += 1
    
  393.     If BC = 7 Then G_GamePoints += 2
    
  394.     If BC = 8 Then G_GamePoints += 3
    
  395.     If BC = 9 Then G_GamePoints += 4
    
  396.     If BC = 10 Then G_GamePoints += 5
    
  397.     C = 0
    
  398.     For Z = 1 To 4
    
  399.         For Y = 1 To G_FieldH
    
  400.             For X = 1 To G_FieldW
    
  401.                 If TField(Y, X) = 1 Then
    
  402.                     If G_FieldNoShow(Y, X) = 0 Then
    
  403.                         G_FieldNoShow(Y, X) = 1
    
  404.                     Else: G_FieldNoShow(Y, X) = 0
    
  405.                     End If
    
  406.                     C = 1
    
  407.                 End If
    
  408.             Next
    
  409.         Next
    
  410.         If C = 1 Then
    
  411.             DoDraw()
    
  412.             Sleep 150, 1
    
  413.             C = 0
    
  414.         End If
    
  415.     Next
    
  416.     
    
  417.     For Y = 1 To G_FieldH
    
  418.         For X = 1 To G_FieldW
    
  419.             If TField(Y, X) = 1 Then
    
  420.                 Select Case G_Field(Y, X)
    
  421.                     Case 1 To 5
    
  422.                         G_Field(Y, X) = 0
    
  423.                         Select Case G_GameMode
    
  424.                             Case 2, 3
    
  425.                                 G_FieldBG(Y, X) = 1
    
  426.                                 G_GamePoints += 10
    
  427.                                 
    
  428.                         End Select
    
  429.                         RV = 1
    
  430.                         DRV = 1
    
  431.                         
    
  432.                     Case 6 To 10
    
  433.                         G_GamePoints += 10
    
  434.                         G_Field(Y, X) -= 5
    
  435.                         RV = 1
    
  436.                         DRV = 1
    
  437.                         
    
  438.                 End Select
    
  439.             End If
    
  440.         Next
    
  441.     Next
    
  442.     
    
  443.     Do
    
  444.         C = 0
    
  445.         For X = 1 To G_FieldW
    
  446.             For Y = G_FieldH To 1 Step -1
    
  447.                 If G_Field(Y, X) = 0 Then
    
  448.                     If Y = 1 Then
    
  449.                         G_Field(0, X) = Int((Rnd * 5) + 1)
    
  450.                         G_GamePoints += 1
    
  451.                         G_FieldOffsetY(0, X) = -G_ImgWH
    
  452.                         G_GameStones += 1
    
  453.                     End If
    
  454.                     Select Case G_Field(Y - 1, X)
    
  455.                         Case 1 To 5, 11 To 20
    
  456.                             G_Field(Y, X) = G_Field(Y - 1, X)
    
  457.                             G_Field(Y - 1, X) = 0
    
  458.                             G_FieldOffsetY(Y, X) = -G_ImgWH
    
  459.                             C = 1
    
  460.                     End Select
    
  461.                 End If
    
  462.             Next
    
  463.         Next
    
  464.         If C = 0 Then Exit Do
    
  465.         For Z = 1 To G_ImgWH
    
  466.             For X = 1 To G_FieldW
    
  467.                 For Y = G_FieldH To 0 Step -1
    
  468.                     If G_FieldOffsetY(Y, X) < 0 Then G_FieldOffsetY(Y, X) += 1
    
  469.                 Next
    
  470.             Next
    
  471.             DoDraw()
    
  472.             Sleep 10, 1
    
  473.         Next
    
  474.     Loop
    
  475.     
    
  476.     For X = 1 To G_FieldW
    
  477.         If G_Field(1, X) = 0 Then G_Field(1, X) = Int((Rnd * 5) + 1)
    
  478.     Next
    
  479.     If DRV = 0 Then Exit Do
    
  480. Loop
    
  481. Return RV
    
  482. End Function
    
  483. 
    
  484. 
    
  485. 
    
  486. '########################################################################################################################
    
  487. Function DoMove(V_Direction As Ubyte) As Integer
    
  488. If G_SelX <> 0 Then
    
  489.     Dim TID1 As Integer = G_Field(G_CurY, G_CurX)
    
  490.     G_SelX = G_CurX
    
  491.     G_SelY = G_CurY
    
  492.     Select Case V_Direction
    
  493.         Case 1
    
  494.             If G_CurX <= 1 Then Return 0
    
  495.             G_SelX = G_CurX - 1
    
  496.             
    
  497.         Case 2
    
  498.             If G_CurX >= G_FieldW Then Return 0
    
  499.             G_SelX = G_CurX + 1
    
  500.             
    
  501.         Case 3
    
  502.             If G_CurY <= 1 Then Return 0
    
  503.             G_SelY = G_CurY - 1
    
  504.             
    
  505.         Case 4
    
  506.             If G_CurY >= G_FieldH Then Return 0
    
  507.             G_SelY = G_CurY + 1
    
  508.             
    
  509.     End Select
    
  510.     Select Case G_Field(G_SelY, G_SelX)
    
  511.         Case 0, 1 To 5, 11 To 20
    
  512.         Case Else: Return 0
    
  513.     End Select
    
  514.     Dim TID2 As Integer = G_Field(G_SelY, G_SelX)
    
  515.     G_Field(G_CurY, G_CurX) = TID2
    
  516.     G_Field(G_SelY, G_SelX) = TID1
    
  517.     If (CheckField() <> 1) And (TID2 <> 0) Then
    
  518.         G_Field(G_CurY, G_CurX) = TID1
    
  519.         G_Field(G_SelY, G_SelX) = TID2
    
  520.         G_SelX = 0
    
  521.         G_SelY = 0
    
  522.     Else
    
  523.         G_SelX = 0
    
  524.         G_SelY = 0
    
  525.     End If
    
  526.     CheckField()
    
  527. Else
    
  528.     Dim C As Uinteger
    
  529.     Do
    
  530.         C += 1
    
  531.         Select Case V_Direction
    
  532.             Case 1: If G_CurX = 1 Then G_CurX = G_FieldW Else G_CurX -= 1
    
  533.             Case 2: If G_CurX = G_FieldW Then G_CurX = 1 Else G_CurX += 1
    
  534.             Case 3: If G_CurY = 1 Then G_CurY = G_FieldH Else G_CurY -= 1
    
  535.             Case 4: If G_CurY = G_FieldH Then G_CurY = 1 Else G_CurY += 1
    
  536.         End Select
    
  537.         Select Case V_Direction
    
  538.             Case 1, 2: If C = G_FieldW Then Exit Do
    
  539.             Case 3, 4: If C = G_FieldH Then Exit Do
    
  540.         End Select
    
  541.         If G_Field(G_CurY, G_CurX) <> 21 Then Exit Do
    
  542.     Loop
    
  543. End If
    
  544. Return CheckGoal()
    
  545. End Function
    
  546. 
    
  547. 
    
  548. 
    
  549. '########################################################################################################################
    
  550. Sub Main()
    
  551. Randomize(Timer())
    
  552. Screenres G_FieldW * G_ImgWH, G_FieldH * G_ImgWH + G_StatOffset, 32
    
  553. Windowtitle "JewelX"
    
  554. 
    
  555. Dim X As Uinteger
    
  556. For X = 1 To 5
    
  557.     G_IMGJewelD(X) = Imagecreate(G_ImgWH, G_ImgWH, 32)
    
  558.     Bload "j" & Str(X) & ".bmp", G_IMGJewelD(X)
    
  559. Next
    
  560. For X = 1 To 10
    
  561.     G_IMGPuzzleD(X) = Imagecreate(G_ImgWH, G_ImgWH, 32)
    
  562.     Bload "p" & Str(X) & ".bmp", G_IMGPuzzleD(X)
    
  563. Next
    
  564. G_IMGRock = Imagecreate(G_ImgWH, G_ImgWH, 32)
    
  565. Bload "rock.bmp", G_IMGRock
    
  566. G_IMGEarth = Imagecreate(G_ImgWH, G_ImgWH, 32)
    
  567. Bload "earth.bmp", G_IMGEarth
    
  568. G_IMGBackground = Imagecreate(G_ImgWH, G_ImgWH, 32)
    
  569. Bload "background.bmp", G_IMGBackground
    
  570. G_IMGBackgroundOK = Imagecreate(G_ImgWH, G_ImgWH, 32)
    
  571. Bload "backgroundok.bmp", G_IMGBackgroundOK
    
  572. 
    
  573. Redim Preserve G_Field(0 To G_FieldH, 0 To G_FieldW) As Integer
    
  574. Redim Preserve G_FieldBG(0 To G_FieldH, 0 To G_FieldW) As Integer
    
  575. Redim Preserve G_FieldNoShow(0 To G_FieldH, 0 To G_FieldW) As Integer
    
  576. Redim Preserve G_FieldOffsetX(0 To G_FieldH, 0 To G_FieldW) As Integer
    
  577. Redim Preserve G_FieldOffsetY(0 To G_FieldH, 0 To G_FieldW) As Integer
    
  578. 
    
  579. Dim TKey As String
    
  580. Dim TKey1 As Ubyte
    
  581. Dim TKey2 As Ubyte
    
  582. Dim Y As Integer
    
  583. Dim TGUIW As Integer = G_FieldW * G_ImgWH - 60
    
  584. Dim RV As Integer
    
  585. Dim TNoReset As Ubyte
    
  586. XTGUI_Init(G_FieldW * G_ImgWH, G_FieldH * G_ImgWH + G_StatOffset)
    
  587. G_GameLevel = 0
    
  588. G_CurX = 1
    
  589. G_CurY = 1
    
  590. Do
    
  591.     XTGUI_Cls()
    
  592.     Line XTGUI_GetDrawBuffer(), (1, 1)-(G_FieldW * G_ImgWH - 2, G_FieldH * G_ImgWH + G_StatOffset - 2), &H0000FF00, B
    
  593.     XTGUI_AddText(20, 10, "JewelsX - Version: keine Ahnung")
    
  594.     XTGUI_AddButton(30, 50, TGUIW, 25, "START Regular", @Jewels_New)
    
  595.     XTGUI_AddButton(30, 80, TGUIW, 25, "START Fill", @Jewels_NewFill)
    
  596.     XTGUI_AddButton(30, 110, TGUIW, 25, "START Fill & Rocks", @Jewels_NewRock)
    
  597.     XTGUI_AddButton(30, 140, TGUIW, 25, "START Puzzle", @Jewels_NewPuzzle)
    
  598.     XTGUI_AddButton(30, 170, TGUIW, 25, "START Puzzle & Rocks", @Jewels_NewPuzzleRock)
    
  599.     XTGUI_AddButton(30, 250, TGUIW, 25, "EXIT", @Jewels_Exit)
    
  600.     XTGUI_AddText(50, G_FieldH * G_ImgWH + G_StatOffset - 30, "Coder: ThePuppetMaster")
    
  601.     XTGUI_Draw(0, 0)
    
  602.     Do
    
  603.         Select Case G_GameMode
    
  604.             Case 2
    
  605.                 If G_GameLevel < 7 Then
    
  606.                     RV = G_GameMode + 1
    
  607.                     TNoReset = 1
    
  608.                     G_GamePoints += (G_GameLevel * 100) * G_GameMode
    
  609.                 End If
    
  610.                 
    
  611.             Case 4, 5
    
  612.                 If G_GameLevel < 7 Then
    
  613.                     RV = G_GameMode + 1
    
  614.                     TNoReset = 1
    
  615.                     G_GamePoints += (G_GameLevel * 100) * G_GameMode
    
  616.                 End If
    
  617.                 
    
  618.             Case Else: RV = XTGUI_CheckIO(0, 0): G_GameLevel = 0
    
  619.         End Select
    
  620.         Select Case RV
    
  621.             Case 0
    
  622.             Case 1: Exit Sub
    
  623.             Case 2 To 6
    
  624.                 G_GameMode = RV - 1
    
  625.                 For Y = 1 To G_FieldH
    
  626.                     For X = 1 To G_FieldW
    
  627.                         G_FieldBG(Y, X) = 0
    
  628.                         G_FieldNoShow(Y, X) = 0
    
  629.                         G_FieldOffsetX(Y, X) = 0
    
  630.                         G_FieldOffsetY(Y, X) = 0
    
  631.                         Select Case G_GameMode
    
  632.                             Case 1, 2, 4: G_Field(Y, X) = Int((Rnd * 5) + 1)
    
  633.                             Case 3, 5: G_Field(Y, X) = Iif(Int(Rnd * 2) = 0, Int(Rnd * 10), Int(Rnd * 4))
    
  634.                         End Select
    
  635.                     Next
    
  636.                 Next
    
  637.                 G_SelX = 0
    
  638.                 G_SelY = 0
    
  639.                 G_CurHide = 1
    
  640.                 If TNoReset = 0 Then
    
  641.                     TNoReset = 0
    
  642.                     G_CurX = 1
    
  643.                     G_CurY = 1
    
  644.                     G_GameStartTime = Timer()
    
  645.                     G_GamePoints = 0
    
  646.                     G_GameStones = 0
    
  647.                     G_GameLevel = 0
    
  648.                 End If
    
  649.                 Select Case G_GameMode
    
  650.                     Case 1 To 3: G_GameLevel += 1
    
  651.                     Case 4, 5: If G_GameLevel < 10 Then G_GameLevel += 1
    
  652.                 End Select
    
  653.                 CheckField()
    
  654.                 Select Case G_GameMode
    
  655.                     Case 2
    
  656.                         Select Case G_GameLevel
    
  657.                             Case 2
    
  658.                                 G_Field(5, 1) = 21
    
  659.                                 G_Field(6, 1) = 21
    
  660.                                 G_Field(5, G_FieldW) = 21
    
  661.                                 G_Field(6, G_FieldW) = 21
    
  662.                                 
    
  663.                         End Select
    
  664.                     Case 4, 5
    
  665.                         Select Case G_GameLevel
    
  666.                             Case 1
    
  667.                                 G_Field(4, 6) = 14
    
  668.                                 G_Field(6, 6) = 16
    
  669.                                 
    
  670.                             Case 2
    
  671.                                 G_Field(3, 6) = 14
    
  672.                                 G_Field(5, 6) = 15
    
  673.                                 G_Field(7, 6) = 16
    
  674.                                 
    
  675.                             Case 3
    
  676.                                 G_Field(4, 6) = 11
    
  677.                                 G_Field(5, 7) = 13
    
  678.                                 
    
  679.                             Case 4
    
  680.                                 G_Field(4, 6) = 11
    
  681.                                 G_Field(5, 7) = 12
    
  682.                                 G_Field(6, 8) = 13
    
  683.                                 
    
  684.                             Case 5
    
  685.                                 G_Field(2, 6) = 11
    
  686.                                 G_Field(4, 8) = 12
    
  687.                                 G_Field(5, 9) = 13
    
  688.                                 
    
  689.                             Case 6
    
  690.                                 G_Field(2, 6) = 14
    
  691.                                 G_Field(4, 8) = 15
    
  692.                                 G_Field(6, 10) = 16
    
  693.                                 
    
  694.                             Case 7
    
  695.                                 G_Field(2, 6) = 14
    
  696.                                 G_Field(4, 8) = 15
    
  697.                                 G_Field(6, 10) = 16
    
  698.                                 G_Field(3, 2) = 11
    
  699.                                 G_Field(5, 3) = 12
    
  700.                                 G_Field(4, 4) = 12
    
  701.                                 G_Field(7, 8) = 13
    
  702.                                 
    
  703.                             Case 8
    
  704.                                 G_Field(2, 6) = 14
    
  705.                                 G_Field(4, 8) = 15
    
  706.                                 G_Field(2, 12) = 15
    
  707.                                 G_Field(6, 10) = 16
    
  708.                                 G_Field(3, 2) = 11
    
  709.                                 G_Field(5, 3) = 12
    
  710.                                 G_Field(4, 4) = 12
    
  711.                                 G_Field(7, 8) = 13
    
  712.                                 
    
  713.                             Case 9
    
  714.                                 G_Field(8, 10) = 14
    
  715.                                 G_Field(2, 6) = 14
    
  716.                                 G_Field(4, 8) = 15
    
  717.                                 G_Field(2, 12) = 15
    
  718.                                 G_Field(6, 10) = 16
    
  719.                                 G_Field(1, 1) = 16
    
  720.                                 G_Field(3, 2) = 11
    
  721.                                 G_Field(5, 3) = 12
    
  722.                                 G_Field(4, 4) = 12
    
  723.                                 G_Field(7, 8) = 13
    
  724.                                 
    
  725.                             Case 10
    
  726.                                 G_Field(8, 10) = 14
    
  727.                                 G_Field(2, 6) = 15
    
  728.                                 G_Field(4, 8) = 15
    
  729.                                 G_Field(2, 12) = 15
    
  730.                                 G_Field(6, 10) = 15
    
  731.                                 G_Field(1, 1) = 15
    
  732.                                 G_Field(3, 2) = 15
    
  733.                                 G_Field(5, 3) = 15
    
  734.                                 G_Field(4, 4) = 15
    
  735.                                 G_Field(7, 8) = 16
    
  736.                                 
    
  737.                         End Select
    
  738.                 End Select
    
  739.                 CheckField()
    
  740.                 If CheckGoal() <> 1 Then
    
  741.                     CheckField()
    
  742.                     G_CurHide = 0
    
  743.                     Do Until Inkey() = ""
    
  744.                     Loop
    
  745.                     Do
    
  746.                         TKey1 = 0
    
  747.                         TKey2 = 0
    
  748.                         TKey = Inkey()
    
  749.                         If Len(TKey) > 0 Then TKey1 = TKey[0]
    
  750.                         If Len(TKey) > 1 Then TKey2 = TKey[1]
    
  751.                         Select Case TKey1
    
  752.                             Case 0
    
  753.                             Case 13
    
  754.                                 If G_SelX = 0 Then
    
  755.                                     Select Case G_Field(G_CurY, G_CurX)
    
  756.                                         Case 1 To 5, 11 To 20
    
  757.                                             G_SelX = G_CurX
    
  758.                                             G_SelY = G_CurY
    
  759.                                     End Select
    
  760.                                 Else
    
  761.                                     G_SelX = 0
    
  762.                                     G_SelY = 0
    
  763.                                 End If
    
  764.                                 
    
  765.                             Case 27
    
  766.                                 XTGUI_Cls()
    
  767.                                 Line XTGUI_GetDrawBuffer(), (1, 1)-(G_FieldW * G_ImgWH - 2, G_FieldH * G_ImgWH + G_StatOffset - 2), &H00FF0000, B
    
  768.                                 XTGUI_AddText(20, 10, "Abort game?")
    
  769.                                 XTGUI_AddButton(30, 50, TGUIW, 25, "RESUME", @Jewels_Resume)
    
  770.                                 XTGUI_AddButton(30, 250, TGUIW, 25, "ABORT", @Jewels_Abort)
    
  771.                                 XTGUI_AddText(50, G_FieldH * G_ImgWH + G_StatOffset - 30, "Coder: ThePuppetMaster")
    
  772.                                 XTGUI_Draw(0, 0)
    
  773.                                 Do
    
  774.                                     RV = XTGUI_CheckIO(0, 0)
    
  775.                                     If RV <> 0 Then Exit Do
    
  776.                                     Sleep 1, 1
    
  777.                                 Loop
    
  778.                                 If RV = 10 Then G_GameMode = 0: Exit Do
    
  779.                                 
    
  780.                             Case Else
    
  781.                                 G_CurHide = 1
    
  782.                                 Select Case TKey2
    
  783.                                     Case 75: If DoMove(1) = 1 Then Exit Do 'left
    
  784.                                     Case 77: If DoMove(2) = 1 Then Exit Do 'right
    
  785.                                     Case 72: If DoMove(3) = 1 Then Exit Do 'top
    
  786.                                     Case 80: If DoMove(4) = 1 Then Exit Do 'bot
    
  787.                                     Case 107: Exit Do
    
  788.                                     'Case Else: Print Str(TKey1) & " " & Str(TKey2): Sleep 1000, 1
    
  789.                                 End Select
    
  790.                                 G_CurHide = 0
    
  791.                         End Select
    
  792.                         DoDraw()
    
  793.                         Sleep 1, 1
    
  794.                     Loop
    
  795.                 End If
    
  796.                 Exit Do
    
  797.         End Select
    
  798.         Sleep 1, 1
    
  799.     Loop
    
  800.     For Y = 1 To G_FieldH
    
  801.         For X = 1 To G_FieldW
    
  802.             G_FieldNoShow(Y, X) = 1
    
  803.         Next
    
  804.     Next
    
  805.     DoDraw()
    
  806. Loop
    
  807. End Sub
    
  808. 
    
  809. 
    
  810. 
    
  811. '#################################################################################################################################################################
    
  812. Main()
    
  813. Screen 0
    
  814. End 0
    
  815. 
    
  816.