Solitario en modo texto escrito en ABAP
PROGRAM ZMN00003 NO STANDARD PAGE HEADING.
DATA: NUMBER LIKE DATATYPE-INTEGER2.
DATA: DUMMY LIKE DATATYPE-INTEGER2.
DATA: BEGIN OF CARDS OCCURS 52 ,
ENTRY TYPE I,
ROW TYPE I,
COL TYPE I,
VIS(1),
END OF CARDS.
DATA: CARD_NUM TYPE I, SUIT_NUM TYPE I, SUIT(1), CARD(2), ROWS TYPE I.
DATA: BLANK(3) VALUE '***'.
DATA: NEXT-CARD(4) VALUE 'Next'.
DATA: RESTART(8) VALUE 'New game'.
DATA: REVEAL(6) VALUE 'Reveal'.
DATA: TEST_NUM TYPE I, TO_NUM TYPE I, MOVING_NUM TYPE I,
PILE_NUM TYPE I.
DATA: CURR_C TYPE I, CURR_H TYPE I, CURR_S TYPE I, CURR_D TYPE I.
DATA: MOVING_SUIT(1), TO_SUIT(1), MOVING_CARD(2), TO_CARD(2),
PILE_SUIT(1), PILE_CARD(2),MOVING_TYPE(1) .
DATA: MOVING_ROW TYPE I, MOVING_COL TYPE I,
TO_ROW TYPE I, TO_COL TYPE I, TEST_ROW TYPE I.
DATA: CURRENT_CARD TYPE I,
MIN_CARD TYPE I , MAX_CARD TYPE I.
DATA: CURRENTFIELD(50).
DATA: DISC_C(3),DISC_H(3),DISC_S(3),DISC_D(3).
DATA: ROWS_OUT TYPE I, COLS_OUT TYPE I.
PERFORM SHUFFLE.
PERFORM SHOW_SCREEN.
AT LINE-SELECTION.
GET CURSOR FIELD CURRENTFIELD.
PERFORM PROCESS-INPUT.
*---------------------------------------------------------------------*
* FORM SHUFFLE *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM SHUFFLE.
MIN_CARD = 3.MAX_CARD = 24.
CURR_C = -1.CURR_D = -1.CURR_H = -1.CURR_S = -1.
DISC_C = 'CCC'.DISC_H = 'HHH'.DISC_S = 'SSS'.DISC_D = 'DDD'.
NUMBER = SY-UZEIT MOD 1000.
DO NUMBER TIMES.
CALL FUNCTION 'RANDOM_I2'
IMPORTING
RND_VALUE = DUMMY.
ENDDO.
REFRESH CARDS. CLEAR CARDS. SY-TABIX = 0.
WHILE SY-TABIX < 52.
*do 40 times.
CALL FUNCTION 'RANDOM_I2'
EXPORTING
RND_MIN = 0
RND_MAX = 51
IMPORTING
RND_VALUE = NUMBER.
READ TABLE CARDS WITH KEY NUMBER TRANSPORTING NO FIELDS.
IF SY-SUBRC <> 0.
CARDS-VIS = 'n'.
DESCRIBE TABLE CARDS LINES ROWS.
CASE ROWS.
WHEN 0.CARDS-VIS = 'y'.CARDS-ROW = 0.CARDS-COL = 0.
WHEN 7.CARDS-VIS = 'y'.CARDS-ROW = 1.CARDS-COL = 1.
WHEN 13.CARDS-VIS = 'y'.CARDS-ROW = 2.CARDS-COL = 2.
WHEN 18.CARDS-VIS = 'y'.CARDS-ROW = 3.CARDS-COL = 3.
WHEN 22.CARDS-VIS = 'y'.CARDS-ROW = 4.CARDS-COL = 4.
WHEN 25.CARDS-VIS = 'y'.CARDS-ROW = 5.CARDS-COL = 5.
WHEN 27.CARDS-VIS = 'y'.CARDS-ROW = 6.CARDS-COL = 6.
WHEN 28.CARDS-ROW = 20.CARDS-COL = 0.
ENDCASE.
CARDS-COL = CARDS-COL + 1.
CARDS-ENTRY = NUMBER.
APPEND CARDS.
ENDIF.
*enddo.
ENDWHILE.
CURRENT_CARD = MIN_CARD.
ENDFORM.
*---------------------------------------------------------------------*
* FORM SHOW_SCREEN *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM SHOW_SCREEN.
ROWS_OUT = 1.
COLS_OUT = 4.
DO 7 TIMES.
SKIP TO LINE ROWS_OUT.
POSITION COLS_OUT.
WRITE BLANK HOTSPOT.
COLS_OUT = COLS_OUT + 4.
ENDDO.
LOOP AT CARDS.
PERFORM MAKE_CARD.
IF CARDS-ROW < 20.
ROWS_OUT = CARDS-ROW + 1.
SKIP TO LINE ROWS_OUT.
COLS_OUT = CARDS-COL * 4.
POSITION COLS_OUT.
IF CARDS-VIS = 'n'.
WRITE 'XXX' COLOR OFF INTENSIFIED OFF INVERSE OFF.
ELSE.
IF SUIT = 'D' OR SUIT = 'H'.
WRITE: SUIT NO-GAP COLOR 6 INTENSIFIED INVERSE HOTSPOT,
CARD COLOR 6 INTENSIFIED INVERSE HOTSPOT.
ELSE.
WRITE: SUIT NO-GAP COLOR OFF INTENSIFIED OFF INVERSE OFF HOTSPOT,
CARD COLOR OFF INTENSIFIED OFF INVERSE OFF HOTSPOT.
ENDIF.
ENDIF.
ELSE.
SKIP TO LINE 20. COLS_OUT = CARDS-COL * 4.
IF COLS_OUT > 48.
SKIP TO LINE 21.
COLS_OUT = COLS_OUT - 48.
ENDIF.
POSITION COLS_OUT.
IF CARDS-COL = CURRENT_CARD.
PILE_SUIT = SUIT.
PILE_CARD = CARD.
PILE_NUM = CARD_NUM.
IF SUIT = 'D' OR SUIT = 'H'.
WRITE: PILE_SUIT NO-GAP COLOR 6 INTENSIFIED INVERSE HOTSPOT,
PILE_CARD COLOR 6 INTENSIFIED INVERSE HOTSPOT.
ELSE.
WRITE: PILE_SUIT NO-GAP COLOR OFF INTENSIFIED OFF HOTSPOT,
PILE_CARD COLOR OFF INTENSIFIED OFF HOTSPOT.
ENDIF.
ELSE.
IF CARDS-COL < CURRENT_CARD.
WRITE 'XXX' COLOR OFF INTENSIFIED OFF INVERSE OFF.
ENDIF.
ENDIF.
ENDIF.
ENDLOOP.
SKIP TO LINE 4. POSITION 40.WRITE: DISC_C
COLOR OFF INTENSIFIED OFF INVERSE OFF HOTSPOT.
SKIP TO LINE 4. POSITION 44. WRITE: DISC_D
COLOR 6 INTENSIFIED INVERSE HOTSPOT.
SKIP TO LINE 4. POSITION 48. WRITE: DISC_S
COLOR OFF INTENSIFIED OFF INVERSE OFF HOTSPOT.
SKIP TO LINE 4. POSITION 52. WRITE: DISC_H
COLOR 6 INTENSIFIED INVERSE HOTSPOT.
IF MIN_CARD > 0.
SKIP TO LINE 23. POSITION 1. WRITE NEXT-CARD HOTSPOT.
ENDIF.
SKIP TO LINE 23. POSITION 20. WRITE RESTART HOTSPOT.
* skip to line 23. position 40. write reveal hotspot.
SKIP TO LINE 25. POSITION 1. WRITE CURRENTFIELD.
SY-LSIND = 0.
ENDFORM.
*---------------------------------------------------------------------*
* FORM PROCESS-INPUT *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM PROCESS-INPUT.
IF CURRENTFIELD = 'NEXT-CARD'.
IF CURRENT_CARD = MAX_CARD.
CURRENT_CARD = MIN_CARD.
ELSE.
CURRENT_CARD = CURRENT_CARD + 3.
IF CURRENT_CARD > MAX_CARD.
CURRENT_CARD = MAX_CARD.
ENDIF.
ENDIF.
MOVING_CARD = SPACE.
CURRENTFIELD = SPACE.
PERFORM SHOW_SCREEN.
EXIT.
ENDIF.
IF CURRENTFIELD = 'REVEAL'.
LOOP AT CARDS.
CARDS-VIS = 'y'.
MODIFY CARDS.
ENDLOOP.
PERFORM SHOW_SCREEN.
EXIT.
ENDIF.
IF CURRENTFIELD = 'RESTART'.
PERFORM SHUFFLE.
CURRENTFIELD = 'Restarting'.
PERFORM SHOW_SCREEN.
EXIT.
ENDIF.
IF MOVING_CARD = SPACE.
IF CURRENTFIELD = 'CARD' OR CURRENTFIELD = 'SUIT'.
CURRENTFIELD = SPACE.
ROWS_OUT = SY-CUROW - 1.
COLS_OUT = SY-CUCOL DIV 4.
LOOP AT CARDS.
IF CARDS-ROW = ROWS_OUT AND CARDS-COL = COLS_OUT.
CURRENTFIELD = 'Moving '.
PERFORM MAKE_CARD.
MOVING_ROW = CARDS-ROW.
MOVING_COL = CARDS-COL.
MOVING_CARD = CARD.
MOVING_SUIT = SUIT.
MOVING_TYPE = 'm'.
MOVING_NUM = CARD_NUM.
CURRENTFIELD+8(1) = SUIT.
CURRENTFIELD+9(2) = CARD.
ENDIF.
ENDLOOP.
ELSE.
IF CURRENTFIELD = 'PILE_CARD' OR CURRENTFIELD = 'PILE_SUIT'.
MOVING_CARD = PILE_CARD.
MOVING_SUIT = PILE_SUIT.
MOVING_TYPE = 'p'.
MOVING_NUM = PILE_NUM.
CURRENTFIELD = 'Moving pile card'.
CURRENTFIELD+17(1) = PILE_SUIT.
CURRENTFIELD+18(2) = PILE_CARD.
ELSE.
CURRENTFIELD = SPACE.
ENDIF.
ENDIF.
ELSE.
IF CURRENTFIELD = 'CARD' OR CURRENTFIELD = 'SUIT' OR
CURRENTFIELD = 'BLANK'.
ROWS_OUT = SY-CUROW - 1.
COLS_OUT = SY-CUCOL DIV 4.
TEST_ROW = -1.
IF CURRENTFIELD = 'BLANK'.
TO_COL = COLS_OUT.
TO_ROW = ROWS_OUT - 1.
IF MOVING_CARD = 'K'.
PERFORM MOVE_CARD.
ELSE.
CURRENTFIELD = 'Can only move K to blank'.
MOVING_CARD = SPACE.
ENDIF.
ELSE.
LOOP AT CARDS.
IF ( CARDS-ROW >= TEST_ROW AND CARDS-ROW < 20 )
AND CARDS-COL = COLS_OUT.
TEST_ROW = CARDS-ROW.
PERFORM MAKE_CARD.
TO_COL = CARDS-COL.
TO_ROW = CARDS-ROW.
TO_CARD = CARD.
TO_SUIT = SUIT.
TO_NUM = CARD_NUM.
ENDIF.
ENDLOOP.
IF TO_COL <> MOVING_COL OR MOVING_TYPE = 'p'.
IF
( ( MOVING_SUIT = 'D' OR MOVING_SUIT = 'H' ) AND
( TO_SUIT = 'D' OR TO_SUIT = 'H' ) )
OR
( ( MOVING_SUIT = 'C' OR MOVING_SUIT = 'S' ) AND
( TO_SUIT = 'S' OR TO_SUIT = 'S' ) ).
CURRENTFIELD = 'Can only put black on red or red on black'.
MOVING_CARD = SPACE.
ELSE.
TEST_NUM = TO_NUM - 1.
IF TEST_NUM = MOVING_NUM.
PERFORM MOVE_CARD.
ELSE.
CURRENTFIELD = 'Can only put on next higher card'.
MOVING_CARD = SPACE.
ENDIF.
ENDIF.
ELSE.
CURRENTFIELD = 'Can only move to another column'.
MOVING_CARD = SPACE.
ENDIF.
ENDIF.
ELSE.
IF CURRENTFIELD(4) = 'DISC'.
TO_SUIT = CURRENTFIELD+5(1).
IF MOVING_TYPE = 'p'.
ELSE.
TEST_ROW = -1.
LOOP AT CARDS.
IF CARDS-COL = MOVING_COL AND
CARDS-ROW > TEST_ROW AND CARDS-ROW < 20.
TEST_ROW = CARDS-ROW.
PERFORM MAKE_CARD.
MOVING_SUIT = SUIT.
MOVING_CARD = CARD.
MOVING_ROW = CARDS-ROW.
MOVING_COL = CARDS-COL.
MOVING_NUM = CARD_NUM.
ENDIF.
ENDLOOP.
ENDIF.
IF MOVING_SUIT = TO_SUIT.
CASE MOVING_SUIT.
WHEN 'C'. TEST_NUM = CURR_C + 1.
WHEN 'H'. TEST_NUM = CURR_H + 1.
WHEN 'D'. TEST_NUM = CURR_D + 1.
WHEN 'S'. TEST_NUM = CURR_S + 1.
ENDCASE.
IF TEST_NUM = MOVING_NUM.
PERFORM DISCARD_CARD.
CASE MOVING_SUIT.
WHEN 'C'. CURR_C = CURR_C + 1.
WHEN 'D'. CURR_D = CURR_D + 1.
WHEN 'S'. CURR_S = CURR_S + 1.
WHEN 'H'. CURR_H = CURR_H + 1.
ENDCASE.
ELSE.
CURRENTFIELD = 'Can only discard on next lower card'.
MOVING_CARD = SPACE.
ENDIF.
ELSE.
MOVING_CARD = SPACE.
CURRENTFIELD = 'Can only discard on same suit'.
ENDIF.
ELSE.
MOVING_CARD = SPACE.
CURRENTFIELD = SPACE.
ENDIF.
ENDIF.
ENDIF.
PERFORM SHOW_SCREEN.
ENDFORM.
*---------------------------------------------------------------------*
* FORM MAKE_CARD *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM MAKE_CARD.
SUIT_NUM = CARDS-ENTRY DIV 13 .
CASE SUIT_NUM.
WHEN 0.SUIT = 'D'.
WHEN 1.SUIT = 'H'.
WHEN 2.SUIT = 'C'.
WHEN 3.SUIT = 'S'.
ENDCASE.
CARD_NUM = CARDS-ENTRY MOD 13.
CASE CARD_NUM.
WHEN 0.CARD = 'A'.
WHEN 1.CARD = '2'.
WHEN 2.CARD = '3'.
WHEN 3.CARD = '4'.
WHEN 4.CARD = '5'.
WHEN 5.CARD = '6'.
WHEN 6.CARD = '7'.
WHEN 7.CARD = '8'.
WHEN 8.CARD = '9'.
WHEN 9.CARD = '10'.
WHEN 10.CARD = 'J'.
WHEN 11.CARD = 'Q'.
WHEN 12.CARD = 'K'.
ENDCASE.
ENDFORM.
*---------------------------------------------------------------------*
* FORM MOVE_CARD *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM MOVE_CARD.
IF CURRENTFIELD <> 'BLANK'.
CURRENTFIELD = 'Moving xxx to'.
MOVE MOVING_SUIT TO CURRENTFIELD+7(1).
MOVE MOVING_CARD TO CURRENTFIELD+8(2).
MOVE TO_SUIT TO CURRENTFIELD+14(1).
MOVE TO_CARD TO CURRENTFIELD+15(2).
ELSE.
CURRENTFIELD = 'Starting emtpy column'.
ENDIF.
IF MOVING_TYPE = 'p'.
MOVE 'from pile' TO CURRENTFIELD+18.
LOOP AT CARDS.
IF CARDS-ROW = 20 AND CARDS-COL = CURRENT_CARD.
CARDS-COL = TO_COL.
CARDS-ROW = TO_ROW + 1.
CARDS-VIS = 'y'.
ENDIF.
IF CARDS-ROW = 20 AND CARDS-COL > CURRENT_CARD.
CARDS-COL = CARDS-COL - 1.
ENDIF.
MODIFY CARDS.
ENDLOOP.
CURRENT_CARD = CURRENT_CARD - 1.
MAX_CARD = MAX_CARD - 1.
IF MAX_CARD < MIN_CARD.
MIN_CARD = MIN_CARD - 1.
MAX_CARD = MIN_CARD.
ENDIF.
IF CURRENT_CARD < 1.
CURRENT_CARD = MIN_CARD.
ENDIF.
ELSE.
LOOP AT CARDS.
IF CARDS-COL = MOVING_COL AND
( CARDS-ROW >= MOVING_ROW AND CARDS-ROW < 20 ).
CARDS-COL = TO_COL.
CARDS-ROW = TO_ROW + 1 + CARDS-ROW - MOVING_ROW.
MODIFY CARDS.
ENDIF.
ENDLOOP.
TEST_ROW = MOVING_ROW - 1.
LOOP AT CARDS.
IF CARDS-COL = MOVING_COL AND CARDS-ROW = TEST_ROW.
CARDS-VIS = 'y'.
MODIFY CARDS.
ENDIF.
ENDLOOP.
ENDIF.
MOVING_CARD = SPACE.
ENDFORM.
*---------------------------------------------------------------------*
* FORM DISCARD_CARD *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM DISCARD_CARD.
MOVE 'Discarding' TO CURRENTFIELD.
MOVE MOVING_SUIT TO CURRENTFIELD+13(1).
MOVE MOVING_CARD TO CURRENTFIELD+14(2).
CASE TO_SUIT.
WHEN 'C'.
DISC_C+1(2) = MOVING_CARD.
WHEN 'D'.
DISC_D+1(2) = MOVING_CARD.
WHEN 'H'.
DISC_H+1(2) = MOVING_CARD.
WHEN 'S'.
DISC_S+1(2) = MOVING_CARD.
ENDCASE.
IF MOVING_TYPE = 'p'.
MOVE 'from pile' TO CURRENTFIELD+18.
LOOP AT CARDS.
IF CARDS-ROW = 20 AND CARDS-COL = CURRENT_CARD.
CARDS-COL = 0.
ENDIF.
IF CARDS-ROW = 20 AND CARDS-COL > CURRENT_CARD.
CARDS-COL = CARDS-COL - 1.
ENDIF.
MODIFY CARDS.
ENDLOOP.
CURRENT_CARD = CURRENT_CARD - 1.
MAX_CARD = MAX_CARD - 1.
IF MAX_CARD < MIN_CARD.
MIN_CARD = MIN_CARD - 1.
MAX_CARD = MIN_CARD.
ENDIF.
IF CURRENT_CARD < 1.
CURRENT_CARD = MIN_CARD.
ENDIF.
ELSE.
LOOP AT CARDS.
IF CARDS-ROW = MOVING_ROW AND CARDS-COL = MOVING_COL.
CARDS-COL = 0.
MODIFY CARDS.
ENDIF.
ENDLOOP.
TEST_ROW = MOVING_ROW - 1.
LOOP AT CARDS.
IF CARDS-COL = MOVING_COL AND CARDS-ROW = TEST_ROW.
CARDS-VIS = 'y'.
MODIFY CARDS.
ENDIF.
ENDLOOP.
ENDIF.
MOVING_CARD = SPACE.
ENDFORM.
|
