API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 27th, 2017
45
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 11.11 KB | None | 0 0
raw download clone embed print report
  1. Global Score,FallTime=400, FallTimeStandard = 400,lastfall,movetime=50, lastmove, GameMode =1, NextShape, CurrentShape
  2. Global Level = 1, NextScore = 100
  3. Global Korobeiniki,Background, Screen
  4. Const GSW = 11, GSH = 20
  5.  
  6. Dim Blocks( GSW - 1 ,GSH - 1 )
  7.  
  8. Dim Shape(4,2) ; 4 кирпича, 2 координаты: 1 = x, 2 = y
  9.  
  10. Function CreateShape(fig, x=GSW/2-2,y=0)
  11. Select fig
  12. Case 1
  13. ; []
  14. ; []
  15. ; []
  16. ; []
  17. Shape(1,1) = 0+x
  18. Shape(1,2) = 0+y
  19.  
  20. Shape(2,1) = 1+x
  21. Shape(2,2) = 0+y
  22.  
  23. Shape(3,1) = 2+x
  24. Shape(3,2) = 0+y
  25.  
  26. Shape(4,1) = 3+x
  27. Shape(4,2) = 0+y
  28. Case 2
  29. ; [][][][]
  30. Shape(1,1) = 0+x
  31. Shape(1,2) = 0+y
  32.  
  33. Shape(2,1) = 0+x
  34. Shape(2,2) = 1+y
  35.  
  36. Shape(3,1) = 0+x
  37. Shape(3,2) = 2+y
  38.  
  39. Shape(4,1) = 0+x
  40. Shape(4,2) = 3+y
  41. Case 3
  42. ; []
  43. ; []
  44. ; [][]
  45. Shape(1,1) = 1+x
  46. Shape(1,2) = 0+y
  47.  
  48. Shape(2,1) = 1+x
  49. Shape(2,2) = 1+y
  50.  
  51. Shape(3,1) = 1+x
  52. Shape(3,2) = 2+y
  53.  
  54. Shape(4,1) = 0+x
  55. Shape(4,2) = 2+y
  56. Case 4
  57. ; []
  58. ; [][][]
  59. Shape(1,1) = 0+x
  60. Shape(1,2) = 0+y
  61.  
  62. Shape(2,1) = 0+x
  63. Shape(2,2) = 1+y
  64.  
  65. Shape(3,1) = 1+x
  66. Shape(3,2) = 1+y
  67.  
  68. Shape(4,1) = 2+x
  69. Shape(4,2) = 1+y
  70. Case 5
  71. ; [][]
  72. ; []
  73. ; []
  74. Shape(1,1) = 0+x
  75. Shape(1,2) = 0+y
  76.  
  77. Shape(2,1) = 0+x
  78. Shape(2,2) = 1+y
  79.  
  80. Shape(3,1) = 0+x
  81. Shape(3,2) = 2+y
  82.  
  83. Shape(4,1) = 1+x
  84. Shape(4,2) = 0+y
  85. Case 6
  86. ; [][][]
  87. ; []
  88. Shape(1,1) = 0+x
  89. Shape(1,2) = 0+y
  90.  
  91. Shape(2,1) = 1+x
  92. Shape(2,2) = 0+y
  93.  
  94. Shape(3,1) = 2+x
  95. Shape(3,2) = 0+y
  96.  
  97. Shape(4,1) = 2+x
  98. Shape(4,2) = 1+y
  99. Case 7
  100. ; []
  101. ; []
  102. ; [][]
  103. Shape(1,1) = 0+x
  104. Shape(1,2) = 0+y
  105.  
  106. Shape(2,1) = 0+x
  107. Shape(2,2) = 1+y
  108.  
  109. Shape(3,1) = 0+x
  110. Shape(3,2) = 2+y
  111.  
  112. Shape(4,1) = 1+x
  113. Shape(4,2) = 2+y
  114. Case 8
  115. ; [][][]
  116. ; []
  117. Shape(1,1) = 0+x
  118. Shape(1,2) = 0+y
  119.  
  120. Shape(2,1) = 0+x
  121. Shape(2,2) = 1+y
  122.  
  123. Shape(3,1) = 1+x
  124. Shape(3,2) = 0+y
  125.  
  126. Shape(4,1) = 2+x
  127. Shape(4,2) = 0+y
  128. Case 9
  129. ; [][]
  130. ; []
  131. ; []
  132. Shape(1,1) = 0+x
  133. Shape(1,2) = 0+y
  134.  
  135. Shape(2,1) = 1+x
  136. Shape(2,2) = 0+y
  137.  
  138. Shape(3,1) = 1+x
  139. Shape(3,2) = 1+y
  140.  
  141. Shape(4,1) = 1+x
  142. Shape(4,2) = 2+y
  143. Case 10
  144. ; []
  145. ; [][][]
  146. Shape(1,1) = 0+x
  147. Shape(1,2) = 1+y
  148.  
  149. Shape(2,1) = 1+x
  150. Shape(2,2) = 1+y
  151.  
  152. Shape(3,1) = 2+x
  153. Shape(3,2) = 1+y
  154.  
  155. Shape(4,1) = 2+x
  156. Shape(4,2) = 0+y
  157. Case 11
  158. ; [][]
  159. ; [][]
  160. Shape(1,1) = 0+x
  161. Shape(1,2) = 0+y
  162.  
  163. Shape(2,1) = 1+x
  164. Shape(2,2) = 0+y
  165.  
  166. Shape(3,1) = 0+x
  167. Shape(3,2) = 1+y
  168.  
  169. Shape(4,1) = 1+x
  170. Shape(4,2) = 1+y
  171. Case 12
  172. ; [][]
  173. ; [][]
  174. Shape(1,1) = 0+x
  175. Shape(1,2) = 1+y
  176.  
  177. Shape(2,1) = 1+x
  178. Shape(2,2) = 0+y
  179.  
  180. Shape(3,1) = 1+x
  181. Shape(3,2) = 1+y
  182.  
  183. Shape(4,1) = 2+x
  184. Shape(4,2) = 0+y
  185. Case 13
  186. ; []
  187. ; [][]
  188. ; []
  189. Shape(1,1) = 0+x
  190. Shape(1,2) = 0+y
  191.  
  192. Shape(2,1) = 0+x
  193. Shape(2,2) = 1+y
  194.  
  195. Shape(3,1) = 1+x
  196. Shape(3,2) = 1+y
  197.  
  198. Shape(4,1) = 1+x
  199. Shape(4,2) = 2+y
  200. Case 14
  201. ; []
  202. ; [][]
  203. ; []
  204. Shape(1,1) = 1+x
  205. Shape(1,2) = 0+y
  206.  
  207. Shape(2,1) = 0+x
  208. Shape(2,2) = 1+y
  209.  
  210. Shape(3,1) = 1+x
  211. Shape(3,2) = 1+y
  212.  
  213. Shape(4,1) = 0+x
  214. Shape(4,2) = 2+y
  215. Case 15
  216. ; [][]
  217. ; [][]
  218. Shape(1,1) = 0+x
  219. Shape(1,2) = 0+y
  220.  
  221. Shape(2,1) = 1+x
  222. Shape(2,2) = 0+y
  223.  
  224. Shape(3,1) = 1+x
  225. Shape(3,2) = 1+y
  226.  
  227. Shape(4,1) = 2+x
  228. Shape(4,2) = 1+y
  229. Case 16
  230. ; []
  231. ; [][][]
  232. Shape(1,1) = 0+x
  233. Shape(1,2) = 1+y
  234.  
  235. Shape(2,1) = 1+x
  236. Shape(2,2) = 1+y
  237.  
  238. Shape(3,1) = 2+x
  239. Shape(3,2) = 1+y
  240.  
  241. Shape(4,1) = 1+x
  242. Shape(4,2) = 0+y
  243. Case 17
  244. ; []
  245. ; [][]
  246. ; []
  247. Shape(1,1) = 0+x
  248. Shape(1,2) = 0+y
  249.  
  250. Shape(2,1) = 0+x
  251. Shape(2,2) = 1+y
  252.  
  253. Shape(3,1) = 0+x
  254. Shape(3,2) = 2+y
  255.  
  256. Shape(4,1) = 1+x
  257. Shape(4,2) = 1+y
  258. Case 18
  259. ; [][][]
  260. ; []
  261. Shape(1,1) = 0+x
  262. Shape(1,2) = 0+y
  263.  
  264. Shape(2,1) = 1+x
  265. Shape(2,2) = 0+y
  266.  
  267. Shape(3,1) = 2+x
  268. Shape(3,2) = 0+y
  269.  
  270. Shape(4,1) = 1+x
  271. Shape(4,2) = 1+y
  272. Case 19
  273. ; []
  274. ; [][]
  275. ; []
  276. Shape(1,1) = 1+x
  277. Shape(1,2) = 0+y
  278.  
  279. Shape(2,1) = 1+x
  280. Shape(2,2) = 1+y
  281.  
  282. Shape(3,1) = 1+x
  283. Shape(3,2) = 2+y
  284.  
  285. Shape(4,1) = 0+x
  286. Shape(4,2) = 1+y
  287. End Select
  288. ;lastFall = MilliSecs()
  289. CurrentShape = fig
  290.  
  291. End Function
  292.  
  293. Function CheckShape()
  294. For i = 1 To 4
  295. x = Shape(i,1)
  296. y = Shape(i,2)
  297. If Shape(i,1) >= 0 And Shape(i,1) =< (GSW - 1) And Shape(i,2) >= 0 And Shape(i,2) =< (GSH - 1) Then
  298. If Blocks (Shape(i,1),Shape(i,2)) = 1 Then achtung = 1
  299. Else
  300. achtung = 1
  301. End If
  302. Next
  303. If Achtung Then Return 0 Else Return 1
  304. End Function
  305.  
  306. Function GameOver()
  307. CopyRect 0,0,GraphicsWidth(), GraphicsHeight(), 0,0,FrontBuffer(),ImageBuffer(Screen)
  308. GameMode = 0
  309. End Function
  310.  
  311. Function MoveShape(x)
  312. ; проверка
  313. For i = 1 To 4
  314. If Shape(i,1)+x > GSW - 1 Or Shape(i,1)+x < 0
  315. Achtung = 1
  316. Else
  317. If Blocks(Shape(i,1)+x,shape(i,2)) = 1
  318. Achtung = 1
  319. End If
  320. End If
  321. Next
  322. If Achtung = 0
  323. ; сдвиг в сторону
  324. For i = 1 To 4
  325. Shape(i,1) = Shape(i,1) +x
  326. Next
  327. End If
  328. End Function
  329.  
  330. Function RotateShape()
  331. Select CurrentShape
  332. ; палка
  333. Case 1
  334. CreateShape(2,Shape(1,1),Shape(1,2))
  335. If Not CheckShape() Then
  336. CreateShape(1,Shape(1,1),Shape(1,2))
  337. End If
  338. Case 2
  339. CreateShape(1,Shape(1,1),Shape(1,2))
  340. If Not CheckShape() Then
  341. CreateShape(2,Shape(1,1),Shape(1,2))
  342. End If
  343. ; Г
  344. Case 3
  345. CreateShape(4,Shape(1,1)-1,Shape(1,2))
  346. If Not CheckShape() Then
  347. CreateShape(3,Shape(1,1),Shape(1,2))
  348. End If
  349.  
  350. Case 4
  351. CreateShape(5,Shape(1,1),Shape(1,2))
  352. If Not CheckShape() Then
  353. CreateShape(4,Shape(1,1),Shape(1,2))
  354. End If
  355. Case 5
  356. CreateShape(6,Shape(1,1),Shape(1,2))
  357. If Not CheckShape() Then
  358. CreateShape(5,Shape(1,1),Shape(1,2))
  359. End If
  360. Case 6
  361. CreateShape(3,Shape(1,1),Shape(1,2))
  362. If Not CheckShape() Then
  363. CreateShape(6,Shape(1,1)-1,Shape(1,2))
  364. End If
  365. ; L
  366.  
  367. Case 7
  368. CreateShape(8,Shape(1,1),Shape(1,2))
  369. If Not CheckShape() Then
  370. CreateShape(7,Shape(1,1),Shape(1,2))
  371. End If
  372.  
  373. Case 8
  374. CreateShape(9,Shape(1,1),Shape(1,2))
  375. If Not CheckShape() Then
  376. CreateShape(8,Shape(1,1),Shape(1,2))
  377. End If
  378. Case 9
  379. CreateShape(10,Shape(1,1),Shape(1,2))
  380. If Not CheckShape() Then
  381. CreateShape(9,Shape(1,1),Shape(1,2)-1)
  382. End If
  383. Case 10
  384. CreateShape(7,Shape(1,1),Shape(1,2)-1)
  385. If Not CheckShape() Then
  386. CreateShape(10,Shape(1,1)-1,Shape(1,2))
  387. End If
  388. ; S
  389.  
  390. Case 12
  391. CreateShape(13,Shape(1,1),Shape(1,2)-1)
  392. If Not CheckShape() Then
  393. CreateShape(12,Shape(1,1),Shape(1,2))
  394. End If
  395.  
  396. Case 13
  397. CreateShape(12,Shape(1,1),Shape(1,2))
  398. If Not CheckShape() Then
  399. CreateShape(13,Shape(1,1),Shape(1,2)-1)
  400. End If
  401.  
  402. ; Z
  403.  
  404. Case 14
  405. CreateShape(15,Shape(1,1)-1,Shape(1,2))
  406. If Not CheckShape() Then
  407. CreateShape(14,Shape(1,1),Shape(1,2))
  408. End If
  409.  
  410. Case 15
  411. CreateShape(14,Shape(1,1),Shape(1,2))
  412. If Not CheckShape() Then
  413. CreateShape(15,Shape(1,1)-1,Shape(1,2))
  414. End If
  415.  
  416. ; фигурка с пиписькой :)
  417.  
  418. Case 16
  419. CreateShape(17,Shape(1,1),Shape(1,2)-1)
  420. If Not CheckShape() Then
  421. CreateShape(16,Shape(1,1),Shape(1,2))
  422. End If
  423.  
  424. Case 17
  425. CreateShape(18,Shape(1,1),Shape(1,2))
  426. If Not CheckShape() Then
  427. CreateShape(17,Shape(1,1),Shape(1,2))
  428. End If
  429. Case 18
  430. CreateShape(19,Shape(1,1),Shape(1,2))
  431. If Not CheckShape() Then
  432. CreateShape(18,Shape(1,1)-1,Shape(1,2))
  433. End If
  434. Case 19
  435. CreateShape(16,Shape(1,1)-1,Shape(1,2))
  436. If Not CheckShape() Then
  437. CreateShape(19,Shape(1,1),Shape(1,2)-1)
  438. End If
  439. End Select
  440. End Function
  441.  
  442. Function UpdateBlocks()
  443. For y = 0 To GSH - 1
  444. Achtung = 0
  445. For x = 0 To GSW - 1
  446. If Blocks(x,y) <> 1 Then Achtung = 1
  447. Next
  448. If Achtung = 0
  449. For i = 0 To GSW - 1
  450. For j = y-1 To 0 Step -1
  451. Blocks(i,j+1)=Blocks(i,j)
  452. Next
  453. Next
  454. CountLines = CountLines + 1
  455. End If
  456. Next
  457. If Countlines <> 0 Then Score = Score + 30*CountLines*level + (2*level)^CountLines
  458. If Score >= NextScore Then
  459. level = level +1
  460. NextScore = (level^2)*200
  461. FallTimeStandard = 800/Sqr(level)
  462. End If
  463. End Function
  464.  
  465. Function UpdateShape()
  466. If MilliSecs() - LastFall > FallTime Then
  467. LastFall = MilliSecs()
  468. ; проверка
  469. For i = 1 To 4
  470. If Shape(i,2)+1 > GSH - 1
  471. Achtung = 1
  472. Else
  473. If Blocks(Shape(i,1),Shape(i,2)+1) = 1
  474. Achtung = 1
  475. End If
  476. End If
  477. Next
  478. If Achtung = 0
  479. ; сдвиг вниз + отрисовка
  480. For i = 1 To 4
  481. Shape(i,2) = Shape(i,2) +1
  482. Text Shape(i,1)*20+20,Shape(i,2)*20+20, "[]"
  483. Next
  484.  
  485. Else
  486. ; удаление фигуры в игровое поле
  487. For i = 1 To 4
  488. Blocks(Shape(i,1),Shape(i,2)) = 1
  489. Next
  490. CreateShape(NextShape)
  491. If Not CheckShape() Then GameOver()
  492. CurrentShape = NextShape
  493.  
  494. NextShape = Rnd(1,19)
  495.  
  496. End If
  497. Else
  498. For i = 1 To 4
  499. Text Shape(i,1)*20+20,Shape(i,2)*20+20, "[]"
  500. Next
  501. End If
  502.  
  503. End Function
  504.  
  505. Function DrawGameScreen()
  506. DrawImage Background, 0,0
  507. Rect 20,20,220,400,0
  508. Text 20,430,"Уровень "+Level;+" Следующий уровень: "+NextScore+" очков"
  509. Text 20,450,"Набрано очков: "+Score
  510. For i = 0 To GSW - 1
  511. For j = 0 To GSH -1
  512. If Blocks(i , j) = 1
  513. Text i*20+20,j*20+20,"[]"
  514. End If
  515. Next
  516. Next
  517. Text 450,430,"Программист: Дмитрий Маслов aka ABTOMAT",1
  518. Text 450,450,"РСФСР, Ленинград 2008",1
  519. End Function
  520.  
  521. Function DrawGameOverScreen()
  522. DrawImage (Screen,0,0)
  523. Color 255,255,255
  524. Rect 10,200,240,80,0
  525. Color 0,0,0
  526. Rect 11,201,238,78
  527. Color 255,255,255
  528. Text 125,215,"Вы проиграли!",1
  529. Text 125,235,"Вы набрали "+score+" очков",1
  530. Text 125,255,"Escape - выход из программы",1
  531. End Function
  532.  
  533. Function LoadImages()
  534. Background = LoadImage ("Background.bmp")
  535. End Function
  536.  
  537. Function LoadFonts()
  538. FixedFont = LoadFont("FixedSys",10)
  539. SetFont FixedFont
  540. End Function
  541.  
  542. Function LoadSounds()
  543. PlayMusic("Music1.mid");("01 - Du hast (Single Ver).mp3")
  544. End Function
  545.  
  546. Graphics3D 640,480,32,1
  547. SetBuffer BackBuffer()
  548.  
  549. SeedRnd(MilliSecs())
  550.  
  551. Screen = CreateImage (GraphicsWidth(), GraphicsHeight())
  552. nextshape = Rnd(1,2)
  553. CurrentShape = Rnd(1,2)
  554. CreateShape(CurrentShape)
  555. LoadFonts()
  556. LoadImages()
  557. LoadSounds()
  558. GameMode = 1
  559.  
  560. Repeat
  561. Cls()
  562. Select GameMode
  563. Case 1
  564. If KeyHit(32) Or KeyDown(32) Or KeyHit(205) Or KeyDown(205)Then
  565. If MilliSecs() - Lastmove > Movetime
  566. MoveShape(1)
  567. LastMove = MilliSecs()
  568. End If
  569. End If
  570. If KeyHit(30) Or KeyDown(30) Or KeyHit(203) Or KeyDown(203) Then
  571. If MilliSecs() - Lastmove > Movetime
  572. MoveShape(-1)
  573. LastMove = MilliSecs()
  574. End If
  575. End If
  576. If KeyDown(31) Or KeyHit (31) Or KeyHit(208) Or KeyDown(208) Then
  577. If FallTimeStandard > 50 Then Falltime = 50 Else Falltime = FallTimeStandard/2
  578. Else
  579. FallTime = FallTimeStandard
  580. End If
  581. If KeyHit(57) Or KeyHit(82) Then RotateShape()
  582. UpdateBlocks()
  583. UpdateShape()
  584. DrawGameScreen()
  585. Flip
  586. Case 0
  587. DrawGameOverScreen()
  588. Flip
  589. End Select
  590.  
  591. Until KeyHit(1)
  592.  
  593. End
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!