2048

**Toast_r** · 29. September 2020

Angeregt duch den Thread Selbstgeschriebene Spiele für die Commodore PET/CBM-Reihe möchte ich hier mal meine unfertige 2048-Anpassung für den MFA mit MBASIC unter CP/M mit der MFA-Video-Serial Karte vorstellen.

Grundlage ist diese Applesoft-Variante des Spiels, das ich einfach 1:1 ins MBASIC kopiert und dann angepasst habe.

Diese Version enthielt keine Prüfung, ob ein Zug zulässig ist, es wurden also auch unzulässige Züge durchgeführt.

Die Prüfung habe ich naträglich eingefügt.

Ich habe noch keine erwähnenswerten Optimierungen durchgeführt, was man dem Programm auch anmerkt: Es ist ~~ziemlich~~ verdammt langsam.

Auf der Z180 CPU mit 16 MHz ist die Geschwindigkeit so gerade erträglich. Bei 33 MHz ist es angenehm spielbar.

Auf der 8085 CPU habe ich es noch nicht ausprobiert. Da dürfte es absolut unerträglich sein.

Momentan fehlt mir die Lust und die Zeit, das zu optimieren. Und auf der 33 MHz Z180 CPU läuft es ja mit angenehmer Geschwindigkeit.

Die Bidschirmausgabe nutzt die VT-100 Terminalcodes incl. doppelt hoher Schrift für die Zahlen im Spielfeld auf der MFA Video-Serial Karte.

ThoralfAsmussen · 30. September 2020

Und wo ist nun das Programm selbst ?

**Toast_r** · 30. September 2020

Natürlich sollte das dabei sein.

Reiche ich nach, sobald ich wieder am Rechner bin.

**Toast_r** · 30. September 2020

So, hier nun das Programm.

Code

10 REM  ************
20 REM  *   2048   *
30 REM  ************
40 PRINT CHR$(27)"[2J";
100 W=2: REM    **** W=0 FOR LOOSE W=1 FOR WIN W=2 FOR PLAYING ****
110 DIM MA(4,4)
120 FC=16:REM FREECELLS
130 SC=0:MT=2:AM=1:REM SC=SCORE MT=MAXTILE AM=ALLOWED MOVE
140 GOSUB 1000:REM DRAW SCREEN
150 GOSUB 1500:REM PRINT SCORE AND MAXTILE
160 AM=1:GOSUB 1700:REM PUT FIRST "2"
170 GOSUB 2000:REM PRINT SCORES
200 REM  ******************
210 REM  MAIN PROGRAM
220 REM  ******************
230 REM PRINT CHR$(27)"[22;38H";
235 IF W<2 THEN GOTO 950:REM  ******* END GAME ********
240 A$=INKEY$:IF A$="E" OR A$="e" THEN GOTO 999
280 REM  ************************
285 REM  FOLLOWING LINES HANDLE UP, LEFT, RIGHT, DOWN
290 REM  ************************
300 IF A$="8" THEN GOSUB 2500:GOSUB 3500:GOSUB 2500:GOSUB 1700:GOSUB 2000:GOSUB 1500
350 IF A$="4" THEN GOSUB 2600:GOSUB 3600:GOSUB 2600:GOSUB 1700:GOSUB 2000:GOSUB 1500
400 IF A$="6" THEN GOSUB 2700:GOSUB 3700:GOSUB 2700:GOSUB 1700:GOSUB 2000:GOSUB 1500
450 IF A$="2" THEN GOSUB 2800:GOSUB 3800:GOSUB 2800:GOSUB 1700:GOSUB 2000:GOSUB 1500
460 GOTO 200
950 PRINT CHR$(27);"[10;0H";
960 PRINT "          ********************"
970 IF W=1 THEN PRINT "          *    YOU   WIN     *"
980 IF W=0 THEN PRINT "          *    YOU   LOOSE   *"
990 PRINT "          ********************"
995 PRINT "               SCORE  =";SC
996 PRINT "               MAXTILE=";MT
999 END
1000 REM  DRAW FRAME + SCORE
1010 FOR I=1 TO 5
1020 VT=1+(I-1)*4:PRINT CHR$(27)"[";VT;";0H";
1025 PRINT "-------------------------------------------------"
1030 NEXT
1040 FOR I=1 TO 4
1050 FOR J=1 TO 3
1060 VT=1+(I-1)*4+J:PRINT CHR$(27)"["VT";0H";
1065 PRINT "|           |           |           |           |"
1070 NEXT : NEXT
1090 PRINT CHR$(27);"[3;65H8"CHR$(27);"[9;65H2"CHR$(27);"[6;60H4"CHR$(27);"[6;70H6"
1130 PRINT CHR$(27);"[12;60HE = END"CHR$(27);"[14;60HSCORE:"CHR$(27);"[16;60HMAX TILE:"
1200 RETURN
1500 REM  ***************
1501 REM  PRINT SCORE + MAXTILE
1502 REM  ***************
1510 PRINT CHR$(27);"[14;67H";
1520 SC$=STR$(SC):LS=LEN(SC$)
1530 FOR I=1 TO 7-LS: PRINT " ";: NEXT
1540 PRINT SC$CHR$(27);"[16;69H";
1560 MT$=STR$(MT):LS=LEN(MT$)
1570 FOR I=1 TO 5-LS:PRINT " ";: NEXT
1580 PRINT MT$
1590 IF MT=2048 THEN W=1: REM *** YOU WIN ***
1595 AM=0
1690 RETURN
1700 REM  ****************
1701 REM  PUT A "2" IN A RANDOM EMPTY CELL
1702 REM  ****************
1705 IF AM=0 THEN PRINT CHR$(7):RETURN
1708 IF FC=0 THEN W=0:GOTO 1800:REM *** YOU LOOSE ***
1710 K=INT(RND(1)*FC+1)
1720 N=0
1730 FOR I=1 TO 4
1740 FOR J=1 TO 4
1750 IF MA(I,J)=0 THEN N=N+1
1760 IF N=K THEN MA(I,J)=2:FC=FC-1:I=4:J=4
1780 NEXT:NEXT
1800 AM=0:RETURN
2000 REM  *************
2001 REM  WRITE THE CELL CONTENT AND CALC. FREECELLS AND MAXTILE
2002 REM  *************
2005 FC=0:MT=0:REM INITIALIZE FREECELLS AND MAXTILES
2010 FOR I=1 TO 4
2020 FOR J=1 TO 4
2030 PRINT CHR$(27);"["3+(I-1)*4";"2+(J-1)*12"H";CHR$(27)"[3m    "CHR$(27)"[m";:
2040 PRINT CHR$(13);CHR$(27);"["2+(J-1)*12"C";
2050 IF MA(I,J)=0 THEN FC=FC+1: GOTO 2060
2055 M$=STR$(MA(I,J)):PRINT CHR$(27)"[3m"RIGHT$(M$,LEN(M$)-1)CHR$(27)"[m"
2060 IF MA(I,J)>MT THEN MT=MA(I,J)
2090 NEXT:NEXT
2190 RETURN
2500 REM  *****************
2510 REM   COMPACT UP - KIND OF BUBBLE SORT
2520 REM  *****************
2530 FOR J=1 TO 4
2540 FOR K=3 TO 1 STEP -1
2550 FOR I=1 TO K
2560 IF MA(I,J)=0 THEN MA(I,J)=MA(I+1,J):MA(I+1,J)=0:IF MA(I,J)<>0 THEN AM=1
2570 NEXT:NEXT:NEXT
2590 RETURN
2600 REM  ************
2610 REM  COMPACT LEFT
2620 REM  ************
2630 FOR I=1 TO 4
2640 FOR K=3 TO 1 STEP -1
2650 FOR J=1 TO K
2660 IF MA(I,J)=0 THEN MA(I,J)=MA(I,J+1):MA(I,J+1)=0:IF MA(I,J)<>0 THEN AM=1
2670 NEXT:NEXT:NEXT
2690 RETURN
2700 REM   ************
2710 REM   COMPACT RIGHT
2720 REM   ************
2730 FOR I=1 TO 4
2740 FOR K=2 TO 4
2750 FOR J=4 TO K STEP -1
2760 IF MA(I,J)=0 THEN MA(I,J)=MA(I,J-1):MA(I,J-1)=0:IF MA(I,J)<>0 THEN AM=1
2770 NEXT:NEXT:NEXT
2790 RETURN
2800 REM   *****************
2810 REM    COMPACT DOWN
2820 REM   *****************
2830 FOR J=1 TO 4
2840 FOR K=2 TO 4
2850 FOR I=4 TO K STEP -1
2860 IF MA(I,J)=0 THEN MA(I,J)=MA(I-1,J):MA(I-1,J)=0:IF MA(I,J)<>0 THEN AM=1
2870 NEXT:NEXT:NEXT
2890 RETURN
3500 REM  ***************
3510 REM  ADD UP
3520 REM  ***************
3530 FOR J=1 TO 4
3540 FOR I=1 TO 3
3550 IF MA(I,J) THEN IF MA(I,J)=MA(I+1,J) THEN MA(I,J)=MA(I,J)*2:MA(I+1,J)=0:SC=SC+MA(I,J):AM=1
3560 NEXT:NEXT
3590 RETURN
3600 REM  **************
3610 REM  SUM LEFT
3620 REM  **************
3630 FOR I= 1 TO 4
3640 FOR J= 1 TO 3
3650 IF MA(I,J) THEN IF MA(I,J)=MA(I,J+1) THEN MA(I,J)=MA(I,J)*2:MA(I,J+1)=0:SC=SC+MA(I,J):AM=1
3660 NEXT:NEXT
3690 RETURN
3700 REM  **************
3710 REM  SUM RIGHT
3720 REM  **************
3730 FOR I= 1 TO 4
3740 FOR J= 4 TO 2 STEP  - 1
3750 IF MA(I,J) THEN IF MA(I,J)=MA(I,J-1) THEN MA(I,J)=MA(I,J)*2:MA(I,J-1)=0:SC=SC+MA(I,J):AM=1
3760 NEXT:NEXT
3790 RETURN
3800 REM   ***************
3810 REM   ADD DOWN
3820 REM   ***************
3830 FOR J= 1 TO 4
3840 FOR I= 4 TO 2 STEP  - 1
3850 IF MA(I,J) THEN IF MA(I,J)=MA(I-1,J) THEN MA(I,J)=MA(I,J)*2:MA(I-1,J)=0:SC=SC+MA(I,J):AM=1
3860 NEXT:NEXT
3890 RETURN

Alles anzeigen

Schroeder · 30. September 2020

Leicht angepasst für VMS BASIC

Ich werde noch einige unwichtige Zeilennummern entfernen. Die sind noch als Referenz für Compiler ERROR geblieben.

Eine Sache ist beim PRINT unter VMS BASIC anders. Eine Zahl hat immer ein führendes Leerzeichen. Daher die Formatierung über STR$(). Ansonsten funktioniert die ESC Sequenz ESC[x;yH nicht.

Code

1 PROGRAM PRG2048
10 !  ************
20 !  *   2048   *
30 !  ************
40 PRINT CHR$(27);"[2J";
100 ! W=0 FOR LOOSE W=1 FOR WIN W=2 FOR PLAYING ****
101 W=2
110 DIM MA(4,4)
120 ! FREECELLS
121 FC=16
130 ! SC=SCORE MT=MAXTILE AM=ALLOWED MOVE
131 SC=0
132 MT=2
133 AM=1
140 GOSUB DRAW_SCREEN
150 GOSUB PRINT_SCORE
160 AM=1
165 GOSUB PUT_FIRST_2
170 GOSUB WRITE_CELL
200 MAIN_LOOP:
201   !  ******************
210   !  MAIN GAME LOOP
220   !  ******************
230   ! PRINT CHR$(27);"[22;38H";
235   IF W<2
        THEN
        GOTO END_GAME
      END IF
240   A$=INKEY$(0%,WAIT)
245   IF A$="E" OR A$="e"
        THEN
        GOTO EXIT_GAME
      END IF
280   !  ************************
285   !  FOLLOWING LINES HANDLE UP, LEFT, RIGHT, DOWN
290   !  ************************
295   VALID_KEY=0
300   IF A$="8"
        THEN
        VALID_KEY=1
        GOSUB COMPACT_UP
        GOSUB SUM_UP
        GOSUB COMPACT_UP
      END IF
350   IF A$="4"
        THEN
        VALID_KEY=1
        GOSUB COMPACT_LEFT
        GOSUB SUM_LEFT
        GOSUB COMPACT_LEFT
      END IF
400   IF A$="6"
        THEN
        VALID_KEY=1
        GOSUB COMPACT_RIGHT
        GOSUB SUM_RIGHT
        GOSUB COMPACT_RIGHT
      END IF
450   IF A$="2"
        THEN
        VALID_KEY=1
        GOSUB COMPACT_DOWN
        GOSUB SUM_DOWN
        GOSUB COMPACT_DOWN
      END IF
455   IF VALID_KEY
        THEN
        GOSUB PUT_FIRST_2
        GOSUB WRITE_CELL
        GOSUB PRINT_SCORE
      END IF
460 GOTO MAIN_LOOP

1000 DRAW_SCREEN:
1001 ! DRAW FRAME + SCORE
1010   FOR I=1 TO 5
1020     ROW$=STR$(1+(I-1)*4)
1022     PRINT CHR$(27);"[";ROW$;";0H";
1025     PRINT "-------------------------------------------------"
1030   NEXT I
1040   FOR I=1 TO 4
1050     FOR J=1 TO 3
1060       ROW$=STR$(1+(I-1)*4+J)
1062       PRINT CHR$(27);"[";ROW$;";0H";
1065       PRINT "|           |           |           |           |"
1070     NEXT J
1075   NEXT I
1090   PRINT CHR$(27);"[3;65H8";CHR$(27);"[9;65H2";CHR$(27);"[6;60H4";CHR$(27);"
[6;70H6"
1130   PRINT CHR$(27);"[12;60HE = END";CHR$(27);"[14;60HSCORE:";CHR$(27);"[16;60
HMAX TILE:";":"
1150 RETURN

1500 PRINT_SCORE:
1501   !  ***************
1502   !  PRINT SCORE + MAXTILE
1503   !  ***************
1510   PRINT CHR$(27);"[14;67H";
1520   SC$=STR$(SC)
1525   LS=LEN(SC$)
1530   FOR I=1 TO 7-LS
         PRINT " ";
       NEXT I
1540   PRINT SC$;CHR$(27);"[16;69H";
1560   MT$=STR$(MT)
1565   LS=LEN(MT$)
1570   FOR I=1 TO 5-LS
         PRINT " ";
       NEXT I
1580   PRINT MT$
1590   IF MT=2048
          THEN
          W=1
          ! *** YOU WIN ***
       END IF
1595   AM=0
1596 RETURN

1700 PUT_FIRST_2:
1701   !  ****************
1702   !  PUT A "2" IN A RANDOM EMPTY CELL
1703   !  ****************
1705   IF AM=0
         THEN
         PRINT CHR$(7)
         RETURN
       END IF
1708   IF FC=0
         THEN
         W=0
         GOTO 1800
         REM *** YOU LOOSE ***
       END IF
1710   K=INT(RND*FC+1)
1720   N=0
1730   FOR I=1 TO 4
1740     FOR J=1 TO 4
1750       IF MA(I,J)=0
             THEN
             N=N+1
           END IF
1760       IF N=K
             THEN
             MA(I,J)=2
             FC=FC-1
             I=4
             J=4
           END IF
1780     NEXT J
1785   NEXT I
1800   AM=0
1900 RETURN

2000 WRITE_CELL:
2001   !  *************
2002   !  WRITE THE CELL CONTENT AND CALC. FREECELLS AND MAXTILE
2003   !  *************
2005   FC=0
2006   MT=0
2007   ! INITIALIZE FREECELLS AND MAXTILES
2010   FOR I=1 TO 4
2020     FOR J=1 TO 4
2021       ROW$=STR$(3+(I-1)*4)
2022       COL$=STR$(2+(J-1)*12)
2030       PRINT CHR$(27);"[";ROW$;";";COL$;"H";CHR$(27);"[3m    ";CHR$(27);"[m"
;
2040       PRINT CHR$(13);CHR$(27);"[";COL$;"C";
2050       IF MA(I,J)=0
            THEN
            FC=FC+1
            GOTO 2060
           END IF
2055       M$=STR$(MA(I,J))
2056       PRINT CHR$(27);"[3m";RIGHT$(M$,LEN(M$)-1);CHR$(27);"[m"
2060       IF MA(I,J)>MT
             THEN
             MT=MA(I,J)
           END IF
2090     NEXT J
2091   NEXT I
2095 RETURN
2500 COMPACT_UP:
2501   !  *****************
2510   !   COMPACT UP - KIND OF BUBBLE SORT
2520   !  *****************
2530   FOR J=1 TO 4
2540     FOR K=3 TO 1 STEP -1
2550       FOR I=1 TO K
2560         IF MA(I,J)=0
               THEN
               MA(I,J)=MA(I+1,J)
               MA(I+1,J)=0
               IF MA(I,J)<>0
                 THEN
                 AM=1
               END IF
             END IF
2570       NEXT I
2580     NEXT K
2585   NEXT J
2590 RETURN
2600 COMPACT_LEFT:
2601   !  ************
2610   !  COMPACT LEFT
2620   !  ************
2630   FOR I=1 TO 4
2640     FOR K=3 TO 1 STEP -1
2650       FOR J=1 TO K
2660         IF MA(I,J)=0
               THEN
               MA(I,J)=MA(I,J+1)
               MA(I,J+1)=0
               IF MA(I,J)<>0
                 THEN
                 AM=1
               END IF
             END IF
2670       NEXT J
2680     NEXT K
2685   NEXT I
2690 RETURN

2700 COMPACT_RIGHT:
2701   !   ************
2710   !   COMPACT RIGHT
2720   !   ************
2730   FOR I=1 TO 4
2740     FOR K=2 TO 4
2750       FOR J=4 TO K STEP -1
2760         IF MA(I,J)=0
               THEN
               MA(I,J)=MA(I,J-1)
               MA(I,J-1)=0
               IF MA(I,J)<>0
                 THEN
                 AM=1
               END IF
             END IF
2770       NEXT J
2780     NEXT K
2785   NEXT I
2790 RETURN

2800 COMPACT_DOWN:
2801   !   *****************
2810   !    COMPACT DOWN
2820   !   *****************
2830   FOR J=1 TO 4
2840     FOR K=2 TO 4
2850       FOR I=4 TO K STEP -1
2860         IF MA(I,J)=0
               THEN
               MA(I,J)=MA(I-1,J)
               MA(I-1,J)=0
               IF MA(I,J)<>0
                 THEN
                 AM=1
               END IF
             END IF
2870       NEXT I
2880     NEXT K
2885   NEXT J
2890 RETURN

3500 SUM_UP:
3501   !  ***************
3510   !  ADD UP
3520   !  ***************
3530   FOR J=1 TO 4
3540     FOR I=1 TO 3
3550       IF MA(I,J)
             THEN
             IF MA(I,J)=MA(I+1,J)
               THEN
               MA(I,J)=MA(I,J)*2
               MA(I+1,J)=0
               SC=SC+MA(I,J)
               AM=1
             END IF
           END IF
3560     NEXT I
3565   NEXT J
3590 RETURN

3600 SUM_LEFT:
3605   !  **************
3610   !  SUM LEFT
3620   !  **************
3630   FOR I= 1 TO 4
3640     FOR J= 1 TO 3
3650       IF MA(I,J)
             THEN
             IF MA(I,J)=MA(I,J+1)
               THEN
               MA(I,J)=MA(I,J)*2
               MA(I,J+1)=0
               SC=SC+MA(I,J)
               AM=1
             END IF
           END IF
3660     NEXT J
3665   NEXT I
3690 RETURN

3700 SUM_RIGHT:
3705   !  **************
3710   !  SUM RIGHT
3720   !  **************
3730   FOR I= 1 TO 4
3740     FOR J= 4 TO 2 STEP  - 1
3750       IF MA(I,J)
             THEN
             IF MA(I,J)=MA(I,J-1)
               THEN
               MA(I,J)=MA(I,J)*2
               MA(I,J-1)=0
               SC=SC+MA(I,J)
               AM=1
             END IF
           END IF
3760     NEXT J
3765   NEXT I
3790 RETURN

3800 SUM_DOWN:
3805   !   ***************
3810   !   ADD DOWN
3820   !   ***************
3830     FOR J= 1 TO 4
3840     FOR I= 4 TO 2 STEP  - 1
3850       IF MA(I,J)
             THEN
             IF MA(I,J)=MA(I-1,J)
               THEN
               MA(I,J)=MA(I,J)*2
               MA(I-1,J)=0
               SC=SC+MA(I,J)
               AM=1
             END IF
           END IF
3860     NEXT I
3865   NEXT J
3890 RETURN

! END GAME
4000 END_GAME:
4010 PRINT CHR$(27);"[10;0H";
4020 PRINT "          ********************"
4030 IF W=1 THEN PRINT "          *    YOU   WIN     *"
4040 IF W=0 THEN PRINT "          *    YOU   LOOSE   *"
4050 PRINT "          ********************"
4060 PRINT "               SCORE  =";SC
4070 PRINT "               MAXTILE=";MT
4100 EXIT_GAME:
4200 END PROGRAM

Alles anzeigen

2048

Ähnliche Themen

Diskinhalte archivieren und anschauen Vaxstation

Sharp X68000 Compact

Atari Syquest Medien gebraucht gekauft

Atari 260ST Erstkontakt - Hilfe gesucht!