Foro -Documentación -Código fuente -Contacto -Empleo

Buscar

Traducir

Amazon

Solitario PDF Imprimir E-mail
Usar puntuación: / 0
MaloBueno 
Código fuente - Juegos
Escrito por Administrator   
Domingo, 12 de Octubre de 2008 07:40
PROGRAM ZSOL 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.  
Comentarios
Buscar
¡Sólo los usuarios registrados pueden escribir comentarios!

3.26 Copyright (C) 2008 Compojoom.com / Copyright (C) 2007 Alain Georgette / Copyright (C) 2006 Frantisek Hliva. All rights reserved."

 
home search