神経衰弱ゲーム

 投稿者：しばっち  投稿日：2020年10月18日(日)09時40分6秒
  これは1人用(1人プレイ)の神経衰弱です。脳トレに利用できます。(笑)

52枚のカードを同時に表示させるためグラフィック画面が1300*600と大きくなっています。
解像度がこれより低いモニタでは使いづらいかもしれません。


カードを選び左クリックするとカードをめくります。
2枚めくり数字が同じならそのままで、違うなら元に戻ります。
全部めくるとゲームクリアになります。
右クリックするとヒントとしてカードを表示します(2秒間 3回まで)
(サンプル画像 1段目)


1人用なので3分間で何枚取れるか等でも楽しめるかもしれません。
また、多人数でもプレイできるように等改造するのもいいかもしれません。
整然と並べているのでバラバラに配置するようにしてもいいかもしれません。


ちなみにスペースキー、リターンキーで実行終了(ギブアップ)します。(イラッときたら押下しましょう!)
または十進BASICアイコンの「中断」をクリックして「中止」を選ぶと終了できます。(笑)


なお、このプログラムの実行には画像サンプルにあるようなカード画像(74*110)が別途必要です。(サンプル画像 2段目)
下記からダウンロードしてください。(data.zip 4.86MB)


https://23.gigafile.nu/1217-c1787339e69ef44cb3f89a20ddef71091

ダウンロードパスワード：設定していません
ダウンロード期限：2020年12月17日(木)


画像は画像検索で適当に見つけてダウンロードしたのでもうURLは分かりません。
画像ファイルがない場合は適当に検索して入手したものを利用してください。
カードの画像サイズは 74*110 ですが、プログラムを修正するなり画像を拡大縮小すれば実行可能だと思います。

ビジュアル(見た目)にこだわらないならこの下にある画像データ生成プログラムで生成できます。
(サンプル画像 3段目)

また、トランプのイラストフォントというのもあるようです。(PLOT TEXT文に置き換えるか(改造するか)、画像データ(74*110)を作成してください)
https://www.dafont.com/playing-cards.font


RANDOMIZE
OPTION ANGLE DEGREES
LET WIDTH=74 !'カードサイズ設定
LET HEIGHT=110
DIM S(52,0 TO WIDTH-1,0 TO HEIGHT-1),M(0 TO WIDTH-1,0 TO HEIGHT-1),OMOTE(0 TO WIDTH-1,0 TO HEIGHT-1)
DIM XS(52),YS(52),P(52)
LET PATH$=".\data\" !'カード画像があるパス
SET DRAW MODE HIDDEN
FOR J=1 TO 4
   READ TYPE$
   DATA "heart","diamond","club","spade"
   FOR I=1 TO 13
      CALL PICTURELOAD(PATH$&TYPE$&STR$(I)&".png",XSIZE,YSIZE) !カード画像がない場合別途入手するか、画像生成プログラムで作成してください。
      MAT M=ZER
      ASK PIXEL ARRAY (0,0) M
      LET K=K+1
      FOR Y=0 TO YSIZE-1
         FOR X=0 TO XSIZE-1
            LET S(K,X,Y)=M(X,Y)
         NEXT X
      NEXT Y
   NEXT I
NEXT J
CALL PICTURELOAD(PATH$&"omote.png",XSIZE,YSIZE)
ASK PIXEL ARRAY (0,0) OMOTE
! CALL PICTURELOAD(PATH$&"congratulations.png",XSIZE1,YSIZE1)
! DIM IMAGE(XSIZE1-1,YSIZE1-1),IMAGE_MASK(XSIZE1-1,YSIZE1-1)
! ASK PIXEL ARRAY (0,0) IMAGE
! CALL PICTURELOAD(PATH$&"congratulations_mask.png",XSIZE1,YSIZE1)
! ASK PIXEL ARRAY (0,0) IMAGE_MASK
! CALL PICTURELOAD(PATH$&"game over.png",XSIZE2,YSIZE2)
! DIM IMAGE2(XSIZE2-1,YSIZE2-1),IMAGE2_MASK(XSIZE2-1,YSIZE2-1)
! ASK PIXEL ARRAY (0,0) IMAGE2
! CALL PICTURELOAD(PATH$&"game over_mask.png",XSIZE2,YSIZE2)
! ASK PIXEL ARRAY (0,0) IMAGE2_MASK
CALL GINIT(1300,600) !'グラフィックウィンドゥサイズ
SET DRAW MODE EXPLICIT
LET I=0
FOR Y=0 TO 400 STEP 120 !'カードを並べる
   FOR X=0 TO 1200 STEP 100
      LET I=I+1
      LET XS(I)=X+10
      LET YS(I)=Y+20
      DRAW DISP(WIDTH,HEIGHT,OMOTE) WITH SHIFT(XS(I),YS(I))
      LET P(I)=I
   NEXT X
NEXT Y
FOR I=1 TO 52 !'カードシャッフル
   SWAP P(I),P(INT(RND*52+1))
NEXT I
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT BACKGROUND "OPAQUE"
SET TEXT HEIGHT 40
LET TI=INT(TIME) !'タイマーセット
LET PP=52 !'カード残数
LET HINT=3 !'ヒント回数
DO
   IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN !'ギブアップ
      FOR I=1 TO 52
         LET K=P(I)
         IF K>=0 THEN
            FOR Y=0 TO HEIGHT-1
               FOR X=0 TO WIDTH-1
                  LET M(X,Y)=S(K,X,Y)
               NEXT X
            NEXT Y
            DRAW DISP(WIDTH,HEIGHT,M) WITH SHIFT(XS(I),YS(I))
         END IF
      NEXT I
      !! DRAW DISP2(XSIZE2,YSIZE2,IMAGE2,IMAGE2_MASK) WITH SHIFT(180,220)
      SET TEXT HEIGHT 150
      SET TEXT BACKGROUND "TRANSPARENT"
      LET THETA=120
      FOR I=0 TO 25
         SET TEXT COLOR COLORINDEX(I/25,0,1-I/25)
         PLOT TEXT ,AT 180+I*COS(THETA),220-I*SIN(THETA):"Game Over !! "
      NEXT I
      PLAYSOUND PATH$&"game over.wav" ! ファイルがない場合は注釈か削除してください
      STOP
   END IF
   LET T=INT(TIME)-TI
   IF T<0 THEN LET T=T+86400
   SET TEXT COLOR COLORINDEX(0,0,0)
   PLOT TEXT ,AT 1050,520:USING$("%%",MOD(INT(T/3600),24))&":"&USING$("%%",MOD(INT(T/60),60))&":"&USING$("%%",MOD(T,60))
   PLOT TEXT ,AT 10,520:"残 "&USING$("%%",PP)&"枚"
   PLOT TEXT ,AT 220,520:"ヒント "&STR$(HINT)&"回"
   PLOT TEXT ,AT 750,520:"手数 "&STR$(COUNT)&"回"
   MOUSE POLL X,Y,LEFT,RIGHT
   FOR II=1 TO 52
      IF P(II)>=0 THEN
         IF XS(II)<=X AND XS(II)+WIDTH-1>=X AND YS(II)<=Y AND YS(II)+HEIGHT-1>=Y THEN
            CALL BOX(XS(II),YS(II),XS(II)+WIDTH-1,YS(II)+HEIGHT-1,255,0,0)
         ELSE
            CALL BOX(XS(II),YS(II),XS(II)+WIDTH-1,YS(II)+HEIGHT-1,255,255,255)
         END IF
      END IF
   NEXT  II
   IF RIGHT<>0 AND HINT>0 THEN !'右クリックでヒント
      FOR I=1 TO 52
         IF XS(I)<=X AND XS(I)+WIDTH-1>=X AND YS(I)<=Y AND YS(I)+HEIGHT-1>=Y THEN EXIT FOR
      NEXT I
      IF I<=52 THEN
         LET K=P(I)
         IF K>=0 THEN
            FOR Y=0 TO HEIGHT-1
               FOR X=0 TO WIDTH-1
                  LET M(X,Y)=S(K,X,Y)
               NEXT X
            NEXT Y
            DRAW DISP(WIDTH,HEIGHT,M) WITH SHIFT(XS(I),YS(I))
            WAIT DELAY 2   !'2秒間表示したら裏返す
            DRAW DISP(WIDTH,HEIGHT,OMOTE) WITH SHIFT(XS(I),YS(I))
            LET HINT=HINT-1
         END IF
      END IF
   END IF
   IF LEFT<>0 THEN !'左クリック
      FOR I=1 TO 52
         IF XS(I)<=X AND XS(I)+WIDTH-1>=X AND YS(I)<=Y AND YS(I)+HEIGHT-1>=Y THEN EXIT FOR
      NEXT I
      IF I<=52 THEN
         IF F=0 THEN
            LET J=I
            PLAYSOUND PATH$&"turn1.wav" ! ファイルがない場合は注釈か削除してください
         END IF
         LET K=P(I)
         IF K>=0 THEN
            FOR Y=0 TO HEIGHT-1
               FOR X=0 TO WIDTH-1
                  LET M(X,Y)=S(K,X,Y)
               NEXT X
            NEXT Y
            DRAW DISP(WIDTH,HEIGHT,M) WITH SHIFT(XS(I),YS(I))
            IF F=1 THEN
               LET COUNT=COUNT+1 !'カードめくった回数
               IF MOD(P(I),13)=MOD(P(J),13) THEN !'当たりなら
                  PLAYSOUND PATH$&"当たり1.wav" ! ファイルがない場合は注釈か削除してください
                  LET PP=PP-2 !'カード残数
                  LET P(I)=-1
                  LET P(J)=-1
                  IF PP=0 THEN !'残数 0ならクリア
                  !! DRAW DISP2(XSIZE1,YSIZE1,IMAGE,IMAGE_MASK) WITH SHIFT(100,200)
                     SET TEXT BACKGROUND "TRANSPARENT"
                     SET TEXT HEIGHT 100
                     LET THETA=150
                     FOR I=0 TO 25
                        SET TEXT COLOR COLORINDEX(I/25,0,0)
                        PLOT TEXT ,AT 100+I*COS(THETA),240-I*SIN(THETA):"Congratulations !!"
                     NEXT I
                     PLAYSOUND PATH$&"fanfare1.wav" ! ファイルがない場合は注釈か削除してください
                     STOP
                  END IF
               ELSE !'外れならカードを戻す
                  PLAYSOUND PATH$&"外れ1.wav" ! ファイルがない場合はWAIT DELAY 1にしてください
                  DRAW DISP(WIDTH,HEIGHT,OMOTE) WITH SHIFT(XS(I),YS(I))
                  DRAW DISP(WIDTH,HEIGHT,OMOTE) WITH SHIFT(XS(J),YS(J))
               END IF
               !               IF COUNT>0 AND MOD(COUNT,15)=0  THEN !'強制シャッフル。これ以下の注釈を外すと15回カードをめくる毎にカードがシャッフルされます
               !                  SET TEXT COLOR COLORINDEX(1,0,0)
               !                  PLOT TEXT ,AT 500,520:"シャッフルします    "
               !                  FOR I=1 TO 52
               !                     LET L=INT(RND*52+1)
               !                     IF P(I)<>-1 AND P(L)<>-1 THEN SWAP P(I),P(L)
               !                  NEXT I
               !                  WAIT DELAY 1
               !                  PLOT TEXT ,AT 500,520:"　　　　　　　　"
               !               END IF
            END IF
         END IF
         LET F=1-F !' クリック1回目ならF=0 クリック2回目ならF=1
         WAIT DELAY .5
      END IF
   END IF
LOOP
END

EXTERNAL  PICTURE DISP(XSIZE,YSIZE,M(,))
MAT PLOT CELLS,IN 0,0;XSIZE-1,YSIZE-1:M
END PICTURE

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB BOX(XS,YS,XE,YE,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT LINES:XS,YS;XE,YS
PLOT LINES:XE,YS;XE,YE
PLOT LINES:XE,YE;XS,YE
PLOT LINES:XS,YE;XS,YS
END SUB

EXTERNAL  PICTURE DISP2(XX,YY,C(,),M(,))
SET DRAW MODE MASK
MAT PLOT CELLS,IN 0,0;XX-1,YY-1:M
SET DRAW MODE MERGE
MAT PLOT CELLS,IN 0,0;XX-1,YY-1:C
END PICTURE
------------------------------------------------------------------------------------------------------
下記は画像データ生成プログラムです。環境依存文字(unicode)を使用しています。
これはハート、ダイア、スペード、クラブといったマークでこのプログラムはWindows用です。
Mac、Linux環境では適宜修正してください。(ORD関数、CHR$関数で確認してください)
サンプル画像 3段目にあるマークです。

また実行の際にはLazarus版十進BASICが必要です。(シフトJISにはない文字を使用するためです)
BASICAcc,ParactBASICでも実行できるはずです。

神経衰弱にマークは必要ないのでマークの頭文字でいいなら
Lazarus版を使う必要はありません。


LET XSIZE=74 !'カードサイズ設定
LET YSIZE=110
DIM R$(13),RR$(13),T(4),TT$(4)
MAT READ R$,RR$,T,TT$
DATA A,2,3,4,5,6,7,8,9,10,J,Q,K
DATA 1,2,3,4,5,6,7,8,9,10,11,12,13
DATA 9829,9830,9824,9827 !'環境依存文字(unicode)ハート、ダイア、スペード、クラブ
!!DATA 104,100,115,99 !'頭文字 h,d,s,c
DATA heart,diamond,spade,club
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET TEXT JUSTIFY "CENTER","TOP"
SET TEXT BACKGROUND "OPAQUE"
SET TEXT HEIGHT 40
FOR J=1 TO 4
   FOR I=1 TO 13
      CLEAR
      IF J<=2 THEN SET TEXT COLOR 4 ELSE SET TEXT COLOR 1
      PLOT TEXT ,AT XSIZE/2,0:CHR$(T(J))
      SET TEXT COLOR 1
      PLOT TEXT ,AT XSIZE/2,YSIZE/2:R$(I)
      GSAVE TT$(J)&RR$(I)&".png"
   NEXT I
NEXT J
CLEAR
LET C1=0
LET C2=2
LET DOT=8
SET POINT STYLE 1
FOR Y=0 TO YSIZE-1
   FOR X=0 TO XSIZE-1 !'市松模様
      IF MOD(X,2*DOT)<DOT THEN LET C=C1 ELSE LET C=C2
      IF MOD(Y,2*DOT)<DOT THEN LET C=(C1+C2)-C
      SET POINT COLOR C
      PLOT POINTS:X,Y
   NEXT X
NEXT Y
GSAVE "omote.png"
CLEAR
SET TEXT HEIGHT 18
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT COLOR 1
LET K$="Joker"
FOR I=1 TO LEN(K$)
   PLOT TEXT ,AT (I-1)*XSIZE/LEN(K$)+5,(I-1)*YSIZE/LEN(K$):K$(I:I)
NEXT I
GSAVE "joker1.png" !'ジョーカーは使用していません。
END
 

戻る