1. &---------------------------------------------------------------------*
  2. *& Report ZNBCSH_TETRIS *
  3. *&---------------------------------------------------------------------*
  4. *& (c) Sergey Shumakov, 2004 , [email protected] *
  5. *& Comment: I lost interest, when encounter limit one fps *
  6. *&---------------------------------------------------------------------*
  7. * To install TETRIS:
  8. * 1) Create program and place ALL this text in it.
  9. * 2) Create standart SCREEN 100 and insert this part
  10. *------------------------------------------------------------*
  11. * PROCESS BEFORE OUTPUT.
  12. * MODULE STATUS_0100.
  13. *
  14. * PROCESS AFTER INPUT.
  15. * MODULE EXX AT EXIT-COMMAND.
  16. * MODULE USER_COMMAND_0100.
  17. *------------------------------------------------------------*
  18. * 3) Create GUI-status STATUS_0 and insert
  19. * 3.1) Free functional keys
  20. *------------------------------------------------------------*
  21. * F5 PF21 Drop (F5)
  22. * F6 PF22 Left (F6)
  23. * F7 PF23 Rotate(F7)
  24. * F8 PF24 Right (F8)
  25. * Shift-F1 PF25 Return
  26. * Shift-F6 PF26 Down
  27. *------------------------------------------------------------*
  28. * 3.2) Buttons
  29. *------------------------------------------------------------*
  30. * PF21 PF22 PF23 PF24
  31. * Drop (F5) Left (F6) Rotate(F7) Right (F8)
  32. *------------------------------------------------------------*
  33. * 3.3) And as usual standart functions ;-)
  34. * BACK UP EXIT
  35. *------------------------------------------------------------*
  36. * 4) Activate it and enjoy! ;-)
  37. * 5) If you want to try delays less then one second,
  38. * create functional module like this, and comment/uncomment
  39. * CALLs and RECIEVEs in the forms 'f_call_rfc_wait' and 'f_task_end'.
  40. *------------------------------------------------------------*
  41. * FUNCTION Z_NBCSH_DELAY .
  42. * *"------------------------------------------------------------
  43. * *" IMPORTING
  44. * *" VALUE(DELAY) TYPE F DEFAULT 1
  45. * *"------------------------------------------------------------
  46. * wait up to delay seconds.
  47. * ENDFUNCTION.
  48. *------------------------------------------------------------*
  49. REPORT znbcsh_tetris .
  50. DATA count TYPE i.
  51. DATA scores TYPE i.
  52. TYPES: BEGIN OF outtype ,
  53. line TYPE char20,
  54. END OF outtype.
  55. DATA outtab TYPE outtype OCCURS 1 WITH HEADER LINE.
  56. *---------------------------------------------------------------------*
  57. DATA: stakan TYPE c OCCURS 0,
  58. stakan_fig LIKE stakan,
  59. stakan_fig_old LIKE stakan,
  60. stakan_zad LIKE stakan.
  61. DATA: sz, st, sf,
  62. data0,
  63. data1,
  64. data2,
  65. data3,
  66. data4,
  67. data5,
  68. data6,
  69. data7,
  70. data8,
  71. data9.
  72. DATA: err, fl_new.
  73. DATA: row TYPE i, col TYPE i.
  74. DATA: st_width TYPE i VALUE 12, st_height TYPE i VALUE 20.
  75. TYPES: BEGIN OF figure,
  76. * cur_pos TYPE i,
  77. * start_pos type I,
  78. name(10),
  79. width TYPE i,
  80. height TYPE i,
  81. * nextfig type figure,
  82. body1 TYPE i,
  83. body2 TYPE i,
  84. body3 TYPE i,
  85. body4 TYPE i,
  86. old_body1 TYPE i,
  87. old_body2 TYPE i,
  88. old_body3 TYPE i,
  89. old_body4 TYPE i,
  90. END OF figure.
  91. DATA: square TYPE figure,
  92. line1 TYPE figure,
  93. line2 TYPE figure,
  94. lzz1 TYPE figure,
  95. lzz2 TYPE figure,
  96. rzz1 TYPE figure,
  97. rzz2 TYPE figure,
  98. tri1 TYPE figure,
  99. tri2 TYPE figure,
  100. tri3 TYPE figure,
  101. tri4 TYPE figure,
  102. lgg1 TYPE figure,
  103. lgg2 TYPE figure,
  104. lgg3 TYPE figure,
  105. lgg4 TYPE figure,
  106. rgg1 TYPE figure,
  107. rgg2 TYPE figure,
  108. rgg3 TYPE figure,
  109. rgg4 TYPE figure
  110. .
  111. DATA cur_fig TYPE figure.
  112. START-OF-SELECTION.
  113. PERFORM init_figures.
  114. PERFORM init_stakan.
  115. PERFORM put_next_fig.
  116. SET PF-STATUS 'STATUS_0'.
  117. CALL SCREEN 100.
  118. AT USER-COMMAND.
  119. CASE sy-ucomm.
  120. WHEN 'BACK' OR 'UP' OR 'EXIT'.
  121. LEAVE PROGRAM.
  122. * PERFORM f_read_data.
  123. * is_selfield-refresh = 'X'.
  124. * SET USER-COMMAND '&OPT'. " Optimize columns width
  125. ENDCASE.
  126. *Drop
  127. AT PF21.
  128. CLEAR: err, count.
  129. DO.
  130. PERFORM fig_move USING 'DOWN' CHANGING err.
  131. IF err EQ 'X'.
  132. EXIT.
  133. ENDIF.
  134. ADD 1 TO count.
  135. ENDDO.
  136. ADD count TO scores.
  137. PERFORM out.
  138. PERFORM f_call_rfc_wait.
  139. AT PF22.
  140. PERFORM fig_move USING 'LEFT' CHANGING err.
  141. PERFORM out.
  142. PERFORM f_call_rfc_wait.
  143. AT PF23.
  144. PERFORM fig_rotate.
  145. PERFORM out.
  146. PERFORM f_call_rfc_wait.
  147. AT PF24.
  148. PERFORM fig_move USING 'RIGHT' CHANGING err.
  149. PERFORM out.
  150. PERFORM f_call_rfc_wait.
  151. AT PF25.
  152. * set user-command 'PF21'.
  153. CALL METHOD cl_gui_cfw=>set_new_ok_code
  154. EXPORTING new_code = 'PF21'.
  155. LEAVE LIST-PROCESSING.
  156. AT PF26.
  157. PERFORM fig_move USING 'DOWN' CHANGING err.
  158. PERFORM out.
  159. IF err = 'X'.
  160. PERFORM fig_append.
  161. PERFORM check_full_line.
  162. PERFORM put_next_fig.
  163. ENDIF.
  164. PERFORM f_call_rfc_wait.
  165. *---------------------------------------------------------------------*
  166. * FORM out *
  167. *---------------------------------------------------------------------*
  168. * ........ *
  169. *---------------------------------------------------------------------*
  170. FORM out.
  171. DATA outstring(100).
  172. DATA: lc TYPE i, otstup TYPE i.
  173. DATA stakan_out LIKE stakan.
  174. DATA so(2).
  175. otstup = st_width * 4.
  176. stakan_out[] = stakan[].
  177. MODIFY stakan_out FROM 'X' INDEX cur_fig-body1.
  178. MODIFY stakan_out FROM 'X' INDEX cur_fig-body2.
  179. MODIFY stakan_out FROM 'X' INDEX cur_fig-body3.
  180. MODIFY stakan_out FROM 'X' INDEX cur_fig-body4.
  181. CLEAR outstring.
  182. WRITE AT 30 'Score: '.
  183. WRITE scores .
  184. LOOP AT stakan_out INTO st.
  185. IF sy-tabix LE otstup. CONTINUE. ENDIF.
  186. lc = sy-tabix MOD st_width .
  187. CASE st.
  188. WHEN ','. so = '::'.
  189. WHEN 'O'. so = 'OO'.
  190. WHEN 'X'. so = '[]'.
  191. ENDCASE.
  192. CONCATENATE outstring so INTO outstring.
  193. IF lc = 0.
  194. NEW-LINE.
  195. TRANSLATE outstring USING ': '.
  196. *WRITE outstring INTENSIFIED ON .
  197. *WRITE outstring COLOR COL_negative." INVERSE ON .
  198. WRITE (24) outstring .
  199. * WRITE outstring+1(st_width) INVERSE ON .
  200. * write: outstring(1).
  201. * WRITE: outstring .
  202. CLEAR outstring.
  203. ENDIF.
  204. ENDLOOP.
  205. ENDFORM.
  206. *---------------------------------------------------------------------*
  207. * Form F_CALL_RFC_WAIT
  208. *---------------------------------------------------------------------*
  209. FORM f_call_rfc_wait.
  210. DATA lv_mssg(80). "#EC NEEDED
  211. * Wait in a task
  212. * You need to create functional module 'Z_NBCSH_DELAY'
  213. * to try delay less then 1 second
  214. * DATA seconds TYPE f.
  215. * seconds = '0.5'.
  216. * CALL FUNCTION 'Z_NBCSH_DELAY' STARTING NEW TASK '001'
  217. * PERFORMING f_task_end ON END OF TASK
  218. * EXPORTING
  219. * delay = seconds
  220. * EXCEPTIONS
  221. * RESOURCE_FAILURE = 1
  222. * communication_failure = 2 MESSAGE lv_mssg
  223. * system_failure = 3 MESSAGE lv_mssg
  224. * OTHERS = 4.
  225. CALL FUNCTION 'RFC_PING_AND_WAIT' STARTING NEW TASK '001'
  226. PERFORMING f_task_end ON END OF TASK
  227. EXPORTING
  228. seconds = 1 " Refresh time
  229. busy_waiting = space
  230. EXCEPTIONS
  231. RESOURCE_FAILURE = 1
  232. communication_failure = 2 MESSAGE lv_mssg
  233. system_failure = 3 MESSAGE lv_mssg
  234. OTHERS = 4.
  235. SET USER-COMMAND 'PF25'.
  236. ENDFORM. " F_CALL_RFC_WAIT
  237. *---------------------------------------------------------------------*
  238. * Form F_TASK_END
  239. *---------------------------------------------------------------------*
  240. FORM f_task_end USING u_taskname.
  241. DATA lv_mssg(80). "#EC NEEDED
  242. * Receiving task results
  243. * You need to create functional module 'Z_NBCSH_DELAY'
  244. * to try delay less then 1 second
  245. RECEIVE RESULTS FROM FUNCTION 'RFC_PING_AND_WAIT'
  246. * RECEIVE RESULTS FROM FUNCTION 'Z_NBCSH_DELAY'
  247. EXCEPTIONS
  248. RESOURCE_FAILURE = 1
  249. communication_failure = 2 MESSAGE lv_mssg
  250. system_failure = 3 MESSAGE lv_mssg
  251. OTHERS = 4.
  252. CHECK sy-subrc EQ 0.
  253. SET USER-COMMAND 'PF26'. " down
  254. ENDFORM. " F_TASK_END
  255. *************** END OF PROGRAM ZNBCSH_TETRIS *********************
  256. *&---------------------------------------------------------------------*
  257. *& Module STATUS_0100 OUTPUT
  258. *&---------------------------------------------------------------------*
  259. * text
  260. *----------------------------------------------------------------------*
  261. MODULE status_0100 OUTPUT.
  262. * SET PF-STATUS 'STATUS_0'.
  263. *CALL METHOD cl_gui_cfw=>set_new_ok_code
  264. * EXPORTING new_code = 'PF21'.
  265. * WRITE 'Press to begin'.
  266. PERFORM out.
  267. LEAVE TO LIST-PROCESSING AND RETURN TO SCREEN 100.
  268. LEAVE SCREEN.
  269. * leave screen.
  270. * SET TITLEBAR 'xxx'.
  271. * DATA lv_mssg(80). "#EC NEEDED
  272. ENDMODULE. " STATUS_0100 OUTPUT
  273. *&---------------------------------------------------------------------*
  274. *& Module USER_COMMAND_0100 INPUT
  275. *&---------------------------------------------------------------------*
  276. * text
  277. *----------------------------------------------------------------------*
  278. MODULE user_command_0100 INPUT.
  279. CASE sy-ucomm.
  280. WHEN 'BACK' OR 'UP' OR 'EXIT'.
  281. LEAVE PROGRAM.
  282. ENDCASE.
  283. ENDMODULE. " USER_COMMAND_0100 INPUT
  284. *---------------------------------------------------------------------*
  285. * MODULE exx INPUT *
  286. *---------------------------------------------------------------------*
  287. * ........ *
  288. *---------------------------------------------------------------------*
  289. MODULE exx INPUT.
  290. LEAVE PROGRAM.
  291. ENDMODULE. " EXX INPUT
  292. *---------------------------------------------------------------------*
  293. * FORM init_figures *
  294. *---------------------------------------------------------------------*
  295. * ........ *
  296. *---------------------------------------------------------------------*
  297. FORM init_figures.
  298. DATA s TYPE i.
  299. DATA w TYPE i.
  300. w = st_width. "
  301. s = w DIV 2. "
  302. square-name = 'SQUARE'.
  303. square-body1 = s.
  304. square-body2 = s + 1.
  305. square-body3 = s + w.
  306. square-body4 = s + w + 1.
  307. square-width = 2.
  308. square-height = 2.
  309. line1-name = 'LINE1'.
  310. line1-body1 = s - 2.
  311. line1-body2 = s - 1.
  312. line1-body3 = s .
  313. line1-body4 = s + 1.
  314. line1-width = 4.
  315. line1-height = 1.
  316. line2-name = 'LINE2'.
  317. line2-body1 = s .
  318. line2-body2 = s + w.
  319. line2-body3 = s + w + w.
  320. line2-body4 = s + w + w + w.
  321. line2-width = 1.
  322. line2-height = 4.
  323. lzz1-name = 'LZZ1'.
  324. lzz1-body1 = s .
  325. lzz1-body2 = s + w.
  326. lzz1-body3 = s + 1 + w.
  327. lzz1-body4 = s + 1 + w + w.
  328. lzz1-width = 2.
  329. lzz1-height = 3.
  330. lzz2-name = 'LZZ2'.
  331. lzz2-body1 = s .
  332. lzz2-body2 = s + 1.
  333. lzz2-body3 = s + w - 1.
  334. lzz2-body4 = s + w.
  335. lzz2-width = 3.
  336. lzz2-height = 2.
  337. rzz1-name = 'RZZ1'.
  338. rzz1-body1 = s + 1.
  339. rzz1-body2 = s + w .
  340. rzz1-body3 = s + w + 1.
  341. rzz1-body4 = s + w + w.
  342. rzz1-width = 2.
  343. rzz1-height = 3.
  344. rzz2-name = 'RZZ2'.
  345. rzz2-body1 = s - 1.
  346. rzz2-body2 = s .
  347. rzz2-body3 = s + w.
  348. rzz2-body4 = s + 1 + w.
  349. rzz2-width = 3.
  350. rzz2-height = 2.
  351. tri1-name = 'TRI1'.
  352. tri1-body1 = s .
  353. tri1-body2 = s + w - 1.
  354. tri1-body3 = s + w.
  355. tri1-body4 = s + 1 + w.
  356. tri1-width = 3.
  357. tri1-height = 2.
  358. tri2-name = 'TRI2'.
  359. tri2-body1 = s - 1.
  360. tri2-body2 = s + w - 1.
  361. tri2-body3 = s + w.
  362. tri2-body4 = s - 1 + w + w.
  363. tri2-width = 2.
  364. tri2-height = 3.
  365. tri3-name = 'TRI3'.
  366. tri3-body1 = s - 1.
  367. tri3-body2 = s .
  368. tri3-body3 = s + 1.
  369. tri3-body4 = s + w.
  370. tri3-width = 3.
  371. tri3-height = 2.
  372. tri4-name = 'TRI4'.
  373. tri4-body1 = s .
  374. tri4-body2 = s - 1 + w.
  375. tri4-body3 = s + w.
  376. tri4-body4 = s + w + w.
  377. tri4-width = 2.
  378. tri4-height = 3.
  379. lgg1-name = 'LGG1'.
  380. lgg1-body1 = s .
  381. lgg1-body2 = s + w.
  382. lgg1-body3 = s + w + w.
  383. lgg1-body4 = s + w + w + 1.
  384. lgg1-width = 2.
  385. lgg1-height = 3.
  386. lgg2-name = 'LGG2'.
  387. lgg2-body1 = s - 1.
  388. lgg2-body2 = s .
  389. lgg2-body3 = s + 1.
  390. lgg2-body4 = s + w - 1.
  391. lgg2-width = 2.
  392. lgg2-height = 3.
  393. lgg3-name = 'LGG3'.
  394. lgg3-body1 = s .
  395. lgg3-body2 = s + 1.
  396. lgg3-body3 = s + w + 1.
  397. lgg3-body4 = s + w + w + 1.
  398. lgg3-width = 2.
  399. lgg3-height = 3.
  400. lgg4-name = 'LGG4'.
  401. lgg4-body1 = s + 1.
  402. lgg4-body2 = s - 1 + w.
  403. lgg4-body3 = s + w.
  404. lgg4-body4 = s + w + 1.
  405. lgg4-width = 2.
  406. lgg4-height = 3.
  407. rgg1-name = 'RGG1'.
  408. rgg1-body1 = s + 1.
  409. rgg1-body2 = s + w + 1.
  410. rgg1-body3 = s + w + w .
  411. rgg1-body4 = s + w + w + 1.
  412. rgg1-width = 2.
  413. rgg1-height = 3.
  414. rgg2-name = 'RGG2'.
  415. rgg2-body1 = s - 1.
  416. rgg2-body2 = s + w - 1.
  417. rgg2-body3 = s + w.
  418. rgg2-body4 = s + w + 1.
  419. rgg2-width = 2.
  420. rgg2-height = 3.
  421. rgg3-name = 'RGG3'.
  422. rgg3-body1 = s .
  423. rgg3-body2 = s + 1.
  424. rgg3-body3 = s + w .
  425. rgg3-body4 = s + w + w.
  426. rgg3-width = 2.
  427. rgg3-height = 3.
  428. rgg4-name = 'RGG4'.
  429. rgg4-body1 = s - 1.
  430. rgg4-body2 = s .
  431. rgg4-body3 = s + 1.
  432. rgg4-body4 = s + w + 1.
  433. rgg4-width = 2.
  434. rgg4-height = 3.
  435. ENDFORM.
  436. *---------------------------------------------------------------------*
  437. * FORM init_stakan_zad *
  438. *---------------------------------------------------------------------*
  439. * ........ *
  440. *---------------------------------------------------------------------*
  441. FORM init_stakan.
  442. DATA size_v TYPE i.
  443. DATA size_h TYPE i.
  444. size_v = st_height + 4 .
  445. size_h = st_width - 2.
  446. CLEAR stakan.
  447. DO size_v TIMES.
  448. APPEND 'O' TO stakan.
  449. DO size_h TIMES.
  450. APPEND ',' TO stakan.
  451. ENDDO.
  452. APPEND 'O' TO stakan.
  453. ENDDO.
  454. APPEND ',' TO stakan.
  455. DO size_h TIMES.
  456. APPEND 'O' TO stakan.
  457. ENDDO.
  458. APPEND ',' TO stakan.
  459. ENDFORM.
  460. *---------------------------------------------------------------------*
  461. * FORM put_next_fig *
  462. *---------------------------------------------------------------------*
  463. * ........ *
  464. *---------------------------------------------------------------------*
  465. * --> FIG *
  466. *---------------------------------------------------------------------*
  467. FORM put_next_fig.
  468. * DATA rnd LIKE bbseg-wrbtr.
  469. *
  470. * CALL FUNCTION 'RANDOM_AMOUNT'
  471. * EXPORTING
  472. * rnd_min = '1'
  473. * rnd_max = '7'
  474. ** VALCURR = 'DEM'
  475. * IMPORTING
  476. * rnd_amount = rnd
  477. * .
  478. DATA rnd TYPE i.
  479. CALL FUNCTION 'QF05_RANDOM_INTEGER'
  480. EXPORTING
  481. ran_int_max = 7
  482. ran_int_min = 1
  483. IMPORTING
  484. ran_int = rnd
  485. * EXCEPTIONS
  486. * INVALID_INPUT = 1
  487. * OTHERS = 2
  488. .
  489. IF sy-subrc <> 0.
  490. * MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
  491. * WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
  492. ENDIF.
  493. * CONDENSE rnd.
  494. CASE rnd.
  495. WHEN '1'.
  496. cur_fig = square.
  497. WHEN '2'.
  498. cur_fig = line1.
  499. WHEN '3'.
  500. cur_fig = rzz1.
  501. WHEN '4'.
  502. cur_fig = lzz1.
  503. WHEN '5'.
  504. cur_fig = tri1.
  505. WHEN '6'.
  506. cur_fig = lgg1.
  507. WHEN '7'.
  508. cur_fig = rgg1.
  509. ENDCASE.
  510. PERFORM fig_move USING 'INIT' CHANGING err.
  511. IF NOT err IS INITIAL.
  512. DATA result(20).
  513. WRITE scores TO result.
  514. CONDENSE result.
  515. CONCATENATE 'You score:' result INTO result SEPARATED BY space.
  516. DATA answer.
  517. CALL FUNCTION 'POPUP_TO_CONFIRM_WITH_MESSAGE'
  518. EXPORTING
  519. defaultoption = 'Y'
  520. diagnosetext1 = result
  521. diagnosetext2 = 'you_max_result'
  522. diagnosetext3 = 'max_result'
  523. textline1 = 'Play again?'
  524. * TEXTLINE2 = ' '
  525. titel = 'GAME OVER'
  526. * START_COLUMN = 25
  527. * START_ROW = 6
  528. cancel_display = ''
  529. IMPORTING
  530. answer = answer
  531. .
  532. IF answer EQ 'N'.
  533. LEAVE PROGRAM.
  534. ELSE.
  535. PERFORM init_stakan.
  536. PERFORM put_next_fig.
  537. ENDIF.
  538. ENDIF.
  539. ENDFORM.
  540. *---------------------------------------------------------------------*
  541. * FORM fig_move *
  542. *---------------------------------------------------------------------*
  543. * ........ *
  544. *---------------------------------------------------------------------*
  545. * --> DIR *
  546. *---------------------------------------------------------------------*
  547. FORM fig_move USING dir TYPE char5 CHANGING error.
  548. DATA: shft TYPE i.
  549. error = ''.
  550. DATA temp_fig LIKE cur_fig.
  551. temp_fig = cur_fig.
  552. * PERFORM SAVE_POS.
  553. CASE dir.
  554. WHEN 'DOWN'.
  555. shft = st_width.
  556. WHEN 'LEFT'.
  557. shft = -1.
  558. WHEN 'RIGHT'.
  559. shft = 1.
  560. WHEN 'INIT'.
  561. shft = st_width * 4.
  562. ENDCASE.
  563. ADD shft TO cur_fig-body1.
  564. ADD shft TO cur_fig-body2.
  565. ADD shft TO cur_fig-body3.
  566. ADD shft TO cur_fig-body4.
  567. PERFORM check_pos CHANGING error.
  568. IF NOT error IS INITIAL.
  569. cur_fig = temp_fig.
  570. * PERFORM RESTORE_POS.
  571. ENDIF.
  572. ENDFORM.
  573. *---------------------------------------------------------------------*
  574. * FORM check_pos *
  575. *---------------------------------------------------------------------*
  576. * ........ *
  577. *---------------------------------------------------------------------*
  578. * --> ERROR *
  579. *---------------------------------------------------------------------*
  580. FORM check_pos CHANGING error TYPE char1.
  581. DATA: v_pos TYPE i, h_pos TYPE i.
  582. DO 1 TIMES.
  583. READ TABLE stakan INTO st INDEX cur_fig-body1.
  584. IF st NE ','.
  585. error = 'X'. EXIT.
  586. ENDIF.
  587. READ TABLE stakan INTO st INDEX cur_fig-body2.
  588. IF st NE ','.
  589. error = 'X'. EXIT.
  590. ENDIF.
  591. READ TABLE stakan INTO st INDEX cur_fig-body3.
  592. IF st NE ','.
  593. error = 'X'. EXIT.
  594. ENDIF.
  595. READ TABLE stakan INTO st INDEX cur_fig-body4.
  596. IF st NE ','.
  597. error = 'X'. EXIT.
  598. ENDIF.
  599. ENDDO.
  600. ENDFORM.
  601. *&---------------------------------------------------------------------*
  602. *& Form fig_rotate
  603. *&---------------------------------------------------------------------*
  604. * text
  605. *----------------------------------------------------------------------*
  606. * --> p1 text
  607. * <-- p2 text
  608. *----------------------------------------------------------------------*
  609. FORM fig_rotate.
  610. DATA error.
  611. DATA: start TYPE i, shft TYPE i.
  612. DATA temp_fig LIKE cur_fig.
  613. DATA: w TYPE i, w2 TYPE i.
  614. w = st_width.
  615. w2 = st_width DIV 2.
  616. temp_fig = cur_fig.
  617. start = cur_fig-body1.
  618. CASE temp_fig-name.
  619. WHEN 'LINE1'.
  620. cur_fig = line2.
  621. shft = - ( w * 2 + w2 - 2 ) .
  622. WHEN 'LINE2'.
  623. cur_fig = line1.
  624. shft = w * 2 - w2 .
  625. WHEN 'LZZ1'.
  626. cur_fig = lzz2.
  627. shft = w - w2 .
  628. WHEN 'LZZ2'.
  629. cur_fig = lzz1.
  630. shft = w2 - w - w .
  631. WHEN 'RZZ1'.
  632. cur_fig = rzz2.
  633. shft = w - w2 - 1 .
  634. WHEN 'RZZ2'.
  635. cur_fig = rzz1.
  636. shft = w2 - w - w + 1.
  637. WHEN 'TRI1'.
  638. cur_fig = tri2.
  639. shft = - w2 + 1 .
  640. WHEN 'TRI2'.
  641. cur_fig = tri3.
  642. shft = w - w2 .
  643. WHEN 'TRI3'.
  644. cur_fig = tri4.
  645. shft = - w - w2 + 1 .
  646. WHEN 'TRI4'.
  647. cur_fig = tri1.
  648. shft = - w2 .
  649. WHEN 'LGG1'.
  650. cur_fig = lgg2.
  651. shft = - w2 + 1 .
  652. WHEN 'LGG2'.
  653. cur_fig = lgg3.
  654. shft = - w2 .
  655. WHEN 'LGG3'.
  656. cur_fig = lgg4.
  657. shft = - w2 .
  658. WHEN 'LGG4'.
  659. cur_fig = lgg1.
  660. shft = - w2 - 1 .
  661. WHEN 'RGG1'.
  662. cur_fig = rgg2.
  663. shft = - w2 .
  664. WHEN 'RGG2'.
  665. cur_fig = rgg3.
  666. shft = - w2 .
  667. WHEN 'RGG3'.
  668. cur_fig = rgg4.
  669. shft = - w2 + 1 .
  670. WHEN 'RGG4'.
  671. cur_fig = rgg1.
  672. shft = - w2 .
  673. WHEN 'SQUARE'.
  674. cur_fig = square.
  675. shft = - st_width DIV 2 .
  676. ENDCASE.
  677. cur_fig-body1 = start + cur_fig-body1 + shft. "- temp_fig-body1.
  678. cur_fig-body2 = start + cur_fig-body2 + shft. "- temp_fig-body2.
  679. cur_fig-body3 = start + cur_fig-body3 + shft. "- temp_fig-body3.
  680. cur_fig-body4 = start + cur_fig-body4 + shft. "- temp_fig-body4.
  681. PERFORM check_pos CHANGING error.
  682. IF error = 'X'.
  683. cur_fig = temp_fig.
  684. ENDIF.
  685. ENDFORM. " fig_rotate
  686. *&---------------------------------------------------------------------*
  687. *& Form fig_append
  688. *&---------------------------------------------------------------------*
  689. * text
  690. *----------------------------------------------------------------------*
  691. * --> p1 text
  692. * <-- p2 text
  693. *----------------------------------------------------------------------*
  694. FORM fig_append.
  695. MODIFY stakan FROM 'X' INDEX cur_fig-body1.
  696. MODIFY stakan FROM 'X' INDEX cur_fig-body2.
  697. MODIFY stakan FROM 'X' INDEX cur_fig-body3.
  698. MODIFY stakan FROM 'X' INDEX cur_fig-body4.
  699. ENDFORM. " fig_append
  700. *&---------------------------------------------------------------------*
  701. *& Form check_full_line
  702. *&---------------------------------------------------------------------*
  703. * text
  704. *----------------------------------------------------------------------*
  705. * --> p1 text
  706. * <-- p2 text
  707. *----------------------------------------------------------------------*
  708. FORM check_full_line.
  709. DATA count_line TYPE i.
  710. DATA: n1 TYPE i, n2 TYPE i.
  711. DATA outstring(20).
  712. DATA: s TYPE i, s10 TYPE i, sw TYPE i.
  713. DATA lc TYPE i.
  714. sw = st_width - 2.
  715. CLEAR outstring.
  716. LOOP AT stakan INTO st.
  717. lc = sy-tabix MOD st_width .
  718. IF lc = 1.
  719. s = sy-tabix.
  720. s10 = s + st_width - 1.
  721. ENDIF.
  722. CONCATENATE outstring st INTO outstring.
  723. IF lc = 0.
  724. SEARCH outstring FOR ','.
  725. IF sy-subrc NE 0.
  726. DELETE stakan FROM s TO s10.
  727. ADD 1 TO count_line.
  728. ENDIF.
  729. CLEAR outstring.
  730. ENDIF.
  731. ENDLOOP.
  732. CLEAR: n1, n2.
  733. DO count_line TIMES.
  734. ADD 10 TO n1.
  735. ADD n1 TO n2.
  736. * 10 for one line, 10+20 for two, 10+20+30 for three...
  737. INSERT 'O' INTO stakan INDEX 1.
  738. DO sw TIMES.
  739. INSERT ',' INTO stakan INDEX 1.
  740. ENDDO.
  741. INSERT 'O' INTO stakan INDEX 1.
  742. ENDDO.
  743. ADD n2 TO scores.
  744. ENDFORM. " check_full_line