! ==============================================================================
! MineCells  ver1.2
!
! （十進BASIC ソース）：　全文コピーして実行してください。
!
! ※ マインスイーパの変形版です。
! 　　地雷をすべて残し、他のセルをすべて開くのが目的です。
! 　　Plainモード以外では、地雷を踏むと、周囲のセルが爆発します。
! 　　さらにそこに地雷があれば誘爆します。
! 　　フルテキストモード（★ を有効にする）でも遊んでみてください。
!
! 
!   十進BASIC は、以下のURIより入手してください。
!   http://hp.vector.co.jp/authors/VA008683/
!  
! （註）操作は、マウスのクリックです。
!
!                                                       2014.07.02
!                                                       2014.07.06 updated
!                                                       S. Nakajima
! ==============================================================================

RANDOMIZE
SET ECHO "off"
SET COLOR MODE "NATIVE"

! maximum values of these parameters.
LET SizeZ = 4
LET SizeX = 20
LET SizeY = 20

OPTION BASE 0
DIM MapMine(SizeZ+1, SizeX+1, SizeY+1)
DIM MapNum (SizeZ+1, SizeX+1, SizeY+1)
DIM MapOpn (SizeZ+1, SizeX+1, SizeY+1)
DIM MapDiff(SizeZ+1, SizeX+1, SizeY+1)
DIM FloorMineNum(SizeZ+1)


DO

   LET Mode1$ = "Graphics and Mouse"
   ! LET Mode1$ = "Text and Keyboard Input"  ! ★ This mode needs no graphicks window
    
   INPUT PROMPT "Select (0: Plain, 1: Small, 2: Middle, 3: Large）": Inkey
   Let Mode2$ = "Deton"
   Select case Inkey
   CASE 0
      CALL Plain
      LET Mode2$ = "Simple"
   Case 2
      CALL Middle
   Case 3
      CALL Large
   Case else
      CALL Small
   End Select
   IF Inkey = 0 THEN
      LET FrasePositionX = SizeX/2
   ELSE
      LET FrasePositionX = SizeX+1.5
   END IF
    
   CALL InitilalizeValues
   CALL PutMinesToCells
   CALL MakeMapNum
    
   IF Mode1$ = "Text and Keyboard Input" THEN
   !  CALL ShowMap1
   !  CALL ShowMap2
      CALL ShowMap3
   ELSE
      CALL DrawCells
   END IF
    
   DO
      CALL ClickCell
      IF MapOpn(cz,cx,cy) <= 0 THEN
         CALL DelFlagMark
         IF MouseButton$ = "left" THEN
            LET MapOpn(cz,cx,cy) = 1
            IF MapNum (cz,cx,cy) = 99 THEN
               LET MapOpn(cz,cx,cy) = 2
               LET ResidualMineNum = ResidualMineNum-1
               IF Mode1$ = "Text and Keyboard Input" THEN
                  PRINT "You made the Mine detonate"
               END IF
               IF Mode2$ = "Simple" THEN 
                  LET GameOverFlg = 1
               ELSE
                  CALL Detonation
               END IF
            END IF
            IF MapNum (cz,cx,cy) = 0 THEN
               CALL Zero
            END IF
            IF Mode1$ = "Text and Keyboard Input" THEN
               CALL ShowMap3 
            ELSE     
               CALL DrawMap
            END IF 
         ELSE                     ! MouseButton$ = "right"
            LET MapOpn(cz,cx,cy) = MapOpn(cz,cx,cy) -1 
            IF MapOpn(cz,cx,cy) = -4 THEN LET MapOpn(cz,cx,cy) = 0
            CALL AddFlag
         END IF
      ELSE
         IF Mode1$ = "Text and Keyboard Input" THEN
            PRINT cz;cx;cy; " is already opened" 
         END IF
      END IF
       
      CALL CountResidualCells
      IF FlagNum = 0 THEN
         LET ResidualMineMinusFlag$ = ""
      ELSE
         LET ResidualMineMinusFlag$ = " (" & STR$(ResidualMineNum - FlagNum) & ")"
      END IF
      IF Mode1$ = "Text and Keyboard Input" THEN
         PRINT "Number of Closed Cells   :"; ResidualCellNum ; "/"; SizeX*SizeY*SizeZ
         PRINT "Number of Residual Mines :"; ResidualMineNum ; ResidualMineMinusFlag$
         PRINT "----------------------------"
      ELSE
         SET TEXT COLOR ColorIndex(1,1,1)
         PLOT TEXT ,AT FrasePositionX, SizeY+1.5: frase1$
         LET frase1$ ="Residual Mines : "& STR$(ResidualMineNum) & ResidualMineMinusFlag$
         SET TEXT COLOR ColorIndex(1,0.5,1)
         PLOT TEXT ,AT FrasePositionX, SizeY+1.5: frase1$
      END IF    
       
      IF ResidualMineNum = 0 THEN
         LET GameOverFlg = 1
      ELSE
         IF ResidualMineNum >= ResidualCellNum THEN
            LET GameOverFlg = 2
         END IF
      END IF 
       
      IF GameOverFlg <> 0 THEN EXIT DO 
   LOOP
    
    
   IF GameOverFlg =1 THEN LET frase2$= "GameOver"
   IF GameOverFlg =2 THEN LET frase2$="You Saved "&STR$(ResidualMineNum)&" Mines."
   IF Mode1$ = "Text and Keyboard Input" THEN
      PRINT frase2$
      IF ResidualMineNum = MineNum THEN
         PRINT "You Made All Free Cells Open without Explosion."
      END IF
   ELSE
      CALL DrawResidualMines
      SET TEXT COLOR ColorIndex(1,1,1)
      PLOT TEXT ,AT FrasePositionX, SizeY+1.5: frase1$
      SET TEXT COLOR ColorIndex(1,0,0)
      PLOT TEXT ,AT FrasePositionX, SizeY+1.5: frase2$
      IF ResidualMineNum = MineNum THEN
         WAIT delay 2
         SET TEXT COLOR ColorIndex(1,1,1)
         PLOT TEXT ,AT FrasePositionX, SizeY+1.5: frase2$
         SET TEXT COLOR ColorIndex(1,0,0)
         PLOT TEXT ,AT FrasePositionX, SizeY+1.5: "You Made All Free Cells Open without Explosion."
      END IF
   END IF
    
   Input prompt "Retry (Y/N) ?": retry$
LOOP while Retry$ = "Y" OR Retry$ = "y"


! ============================================
! initial parameters

SUB Small
   Let SizeZ = 4
   LET SizeX = 5
   LET SizeY = 5
   LET MineNum = 10
END SUB

SUB MIDDLE
   Let SizeZ = 4
   LET SizeX = 10
   LET SizeY = 10
   LET MineNum = 40
END SUB

SUB Large
   Let SizeZ = 4
   LET SizeX = 20
   LET SizeY = 20
   LET MineNum = 160
END SUB

SUB Plain
   Let SizeZ = 1
   LET SizeX = 20
   LET SizeY = 20
   LET MineNum = 40
END SUB


SUB InitilalizeValues
   LET ResidualMineNum = MineNum
   LET ResidualCellNum = SizeZ * SizeX * SizeY 
   LET GameOverFlg = 0
   LET FlagNum = 0
   FOR Z = 0 TO SizeZ+1
      LET FloorMineNum(Z) = 0
      FOR Y = 0 TO SizeY+1
         FOR X = 0 TO SizeX+1
            LET MapMine(Z, X, Y) = 0
            LET MapNum (Z, X, Y) = 0
            LET MapOpn (Z, X, Y) = 0
            LET MapDiff(Z, X, Y) = 0
         NEXT X
      NEXT Y
   NEXT Z
END SUB

! ============================================
! to prepare game data

SUB PutMinesToCells
   LET Count = 0
   DO
      LET k = INT(RND * SizeZ * SizeX * SizeY )
      LET z = 1 + INT(k/SizeX/SizeY)
      LET y = 1 + INT((k-(z-1)*(SizeX*SizeY))/SizeX)
      LET x = 1 + k - (z-1)*(SizeX*SizeY) - (y-1)*(SizeX)
      IF MapMine(Z, X, Y)=0 THEN
         LET MapMine(Z, X, Y) = 1
         LET Count = Count +1
      END IF
   LOOP UNTIL Count >= MineNum
END SUB

SUB MakeMapNum
   FOR mz = 1 TO SizeZ
      for my = 1 to SizeY
         for mx = 1 to SizeX
            IF  MapMine(mZ,mX,mY) = 1 THEN
               LET MapNum(mZ,mX,mY) = 99
               LET FloorMineNum(mZ) = FloorMineNum(mZ) + 1
            ELSE
               LET Count = 0
               FOR iz = mz-1 TO mz+1
                  FOR iy = my-1 TO my+1
                     FOR ix = mx-1 TO mx+1
                        LET Count = Count + MapMine(iZ,iX,iY)
                     NEXT ix
                  NEXT iy
               NEXT iz
               LET MapNum(mZ,mX,mY) = Count
            END IF
         next mx
      NEXT my
   NEXT mz
END SUB


! ============================================
! show text-base maps (as a results of PRINT commands).

SUB ShowMap1
! This map shows the position of mines.
   for sz = 1 to SizeZ
      PRINT sz;"F"; 
      PRINT " ("& STR$(FloorMineNum(sz)) &")"
      FOR sy = SizeY TO 1 STEP -1
         for sx = 1 to SizeX
            IF MapMine(sZ, sX, sY) = 0 THEN
               PRINT "[ ]";
            ELSE
            ! print using " ##" : MapMine(sZ, sX, sY);
               PRINT " ★";
            END IF
         next sx
         print
      NEXT sy
      print 
      print
   NEXT sz
END SUB

SUB ShowMap2
! This map shows the number of mines in the surrounding cells.
! When the cell has a mine, the number of the cell be 99.
   FOR sZ = 1 TO SizeZ
      PRINT sZ;" F"
      FOR sY = SizeY TO 1 STEP -1
         FOR sX = 1 TO SizeX
            IF MapNum(sZ, sX, sY) = 0 THEN
               PRINT "   ";
            ELSE
               PRINT USING " ##" : MapNum(sZ, sX, sY);
            END IF
         NEXT sx
         print
      NEXT sy
      print 
      print
   NEXT sz
END SUB

SUB ShowMap3
! This map is the results when the player clicks any cells.
   for sz = 1 to SizeZ
      PRINT sz;" F"
      FOR sy = SizeY TO 1 STEP -1
         for sx = 1 to SizeX
            IF MapOpn(sZ, sX, sY) = 0 THEN
               PRINT "[ ]";
            ELSE
               IF MapOpn(sZ, sX, sY) < 0 THEN
                  PRINT "[F]";
               END IF
               IF MapOpn(sZ, sX, sY) = 1 THEN
                  IF MapNum(sZ, sX, sY) = 0 THEN
                     PRINT "   ";
                  ELSE
                     PRINT USING " ##" : MapNum(sZ, sX, sY);
                  END IF
               END IF
               IF MapOpn(sZ, sX, sY) = 2 THEN
                  IF MapNum(sZ, sX, sY) = 99 THEN
                     PRINT " ★";
                  ELSE
                     PRINT USING " ##" : MapNum(sZ, sX, sY);
                     ! PRINT " ※";
                  END IF
               END IF
            END IF
         NEXT sx
         IF MOD(sy,5)=0 THEN
            PRINT " y=";sy
         ELSE 
            print
         END IF
      NEXT sy
      PRINT " x=";
      FOR sx = 2 TO SizeX
         IF MOD(sx,5)=0 THEN
            PRINT USING "###" :sx;
         ELSE 
            PRINT "   ";
         END IF
      NEXT sx 
      print 
      print
   NEXT sz
END SUB


! ============================================
! show maps on graphicks window

SUB DrawCells
   CLEAR
   SET WINDOW 0,SizeX*2+3,0,SizeY*2+3
   IF  Mode2$ = "Simple" THEN
      SET WINDOW 0,SizeX+2,SizeY+1,SizeY*2+3
   END IF
   DRAW grid
   SET LINE width 2
   LET SS = 0
   DO
      SET LINE COLOR ColorIndex((0+1.5*ss/MIN(SizeX,SizeY))^.5,(0+1.5*ss/MIN(SizeX,SizeY))^.6,1)
      FOR A = 0 TO 1
         FOR B = 0 TO 1
            LET Xshift = A * (SizeX+1) + 1
            LET Yshift = B * (SizeY+1) + 1
            PLOT LINES : 0+SS+Xshift,0+SS+Yshift; 
            PLOT LINES : SizeX-SS+Xshift,0+SS+Yshift; 
            PLOT LINES : SizeX-SS+Xshift,SizeY-SS+Yshift; 
            PLOT LINES : 0+SS+Xshift,SizeY-SS+Yshift; 
            PLOT LINES : 0+SS+Xshift,0+SS+Yshift 
         NEXT B
      NEXT A
      LET SS = SS + 3
   LOOP WHILE Mode2$ <> "Simple" AND SizeX - 2*SS > 1 AND SizeY - 2*SS > 1
   SET TEXT HEIGHT 0.8
   SET TEXT JUSTIFY "center", "half"
   IF  Mode2$ <> "Simple" THEN
      SET TEXT COLOR ColorIndex(0.1,0.5,0.5)
      PLOT TEXT ,AT 2.5,       SizeY*2+2.5 :"1 F ("& STR$(FloorMineNum(1)) &")"
      PLOT TEXT ,AT SizeX+3.5, SizeY*2+2.5 :"2 F ("& STR$(FloorMineNum(2)) &")"
      PLOT TEXT ,AT 2.5,       0.5         :"3 F ("& STR$(FloorMineNum(3)) &")"
      PLOT TEXT ,AT SizeX+3.5, 0.5         :"4 F ("& STR$(FloorMineNum(4)) &")"
   END IF
   SET TEXT COLOR ColorIndex(1,0.5,1)
   LET frase1$ = "Save "&STR$(ResidualMineNum)&" Mines."
   PLOT TEXT ,AT FrasePositionX, SizeY+1.5: frase1$
END SUB

SUB DrawMap
   FOR qZ = 1 TO SizeZ
      FOR qY = 1 TO SizeY
         FOR qX = 1 TO SizeX
            LET A = MOD(qZ+1,2)
            LET B = 1-INT((qZ-1)/2) 
            LET Xshift = A * (SizeX+1) + qX + 0.5
            LET Yshift = B * (SizeY+1) + qY + 0.5
            IF MapOpn(qZ, qX, qY) = 1 AND MapDiff(qZ, qX, qY) = 0 THEN
               IF MapNum(qZ, qX, qY) = 0 THEN
                  SET TEXT COLOR ColorIndex(0.8,0.8,0.8)
                  PLOT TEXT ,AT Xshift,Yshift:  "□"                     
               ELSE
                  LET CI = MIN(MapNum(qZ, qX, qY)-1, 8)/8
                  SET TEXT COLOR ColorIndex(0.5+CI/2, 0.5-CI/2, 1-CI)
                  PLOT TEXT ,AT Xshift,Yshift:  STR$(MapNum(qZ, qX, qY))  
               END IF
               LET MapDiff(qZ, qX, qY) = 1
            END IF
            IF MapOpn(qZ, qX, qY) = 2 AND MapDiff(qZ, qX, qY) <> 2 THEN
               SET TEXT COLOR ColorIndex(0.6,0.4,0.4)
               IF MapNum(qZ, qX, qY) = 99 THEN
                  PLOT TEXT ,AT Xshift,Yshift:  "★" 
               ELSE
                  PLOT TEXT ,AT Xshift,Yshift:  STR$(MapNum(qZ, qX, qY))
                  ! PLOT TEXT ,AT Xshift,Yshift:  "※"   
               END IF
               LET MapDiff(qZ, qX, qY) = 2
            END IF
         NEXT qx
      NEXT qy
   NEXT qz
END SUB

SUB AddFlag
! Variables, cX, cY, cZ, should be able to be scooped.
   LET A = MOD(cZ+1,2)
   LET B = 1-INT((cZ-1)/2) 
   LET Xshift = A * (SizeX+1) + cX + 0.5
   LET Yshift = B * (SizeY+1) + cY + 0.5
    
   IF MapOpn(cZ, cX, cY) = -1 THEN  
      SET TEXT COLOR ColorIndex(0.3,0.5,0)
      PLOT TEXT ,AT Xshift,Yshift:  "○" 
      LET FlagNum = FlagNum + 1
   END IF
   IF MapOpn(cZ, cX, cY) = -2 THEN  
      SET TEXT COLOR ColorIndex(1,1,1)
      PLOT TEXT ,AT Xshift,Yshift:  "○" 
      SET TEXT COLOR ColorIndex(0.4,0.6,0.1)
      PLOT TEXT ,AT Xshift,Yshift:  "△" 
   END IF
   IF MapOpn(cZ, cX, cY) = -3 THEN  
      SET TEXT COLOR ColorIndex(1,1,1)
      PLOT TEXT ,AT Xshift,Yshift:  "△" 
      SET TEXT COLOR ColorIndex(0.5,0.7,0.2)
      PLOT TEXT ,AT Xshift,Yshift:  "▽" 
   END IF
   IF MapOpn(cZ, cX, cY) = 0  THEN  
      SET TEXT COLOR ColorIndex(1,1,1)
      PLOT TEXT ,AT Xshift,Yshift:  "▽" 
      LET FlagNum = FlagNum - 1
   END IF
END SUB

SUB DelFlagMark
! Variables, cX, cY, cZ, should be able to be scooped.
   LET A = MOD(cZ+1,2)
   LET B = 1-INT((cZ-1)/2) 
   LET Xshift = A * (SizeX+1) + cX + 0.5
   LET Yshift = B * (SizeY+1) + cY + 0.5
   SET TEXT COLOR ColorIndex(1,1,1)
   PLOT TEXT ,AT Xshift,Yshift:  "○" 
   PLOT TEXT ,AT Xshift,Yshift:  "△" 
   PLOT TEXT ,AT Xshift,Yshift:  "▽" 
END SUB

SUB DrawResidualMines
   FOR rZ = 1 TO SizeZ
      FOR rY = 1 TO SizeY
         FOR rX = 1 TO SizeX
            LET A = MOD(rZ+1,2)
            LET B = 1-INT((rZ-1)/2) 
            LET Xshift = A * (SizeX+1) + rX + 0.5
            LET Yshift = B * (SizeY+1) + rY + 0.5
            IF MapOpn(rZ, rX, rY) <= 0 AND MapDiff(rZ, rX, rY) = 0 AND MapNum(rZ, rX, rY) = 99 THEN
               SET TEXT COLOR ColorIndex(1,0,0)
               PLOT TEXT ,AT Xshift,Yshift:  "◎" 
               LET MapDiff(rZ, rX, rY) = 3
            END IF
         NEXT rX
      NEXT rY
   NEXT rZ
END SUB

! ============================================
! Routines according to player's action

SUB ClickCell
   IF Mode1$ = "Text and Keyboard Input" THEN
      DO
         INPUT PROMPT "F(1-"&STR$(sizeZ)&"), x(1-"&STR$(sizeX)&"), y(1-"&STR$(sizeY)&")" :cz, cx, cy
      LOOP WHILE cz<1 OR cy<1 OR cx<1 OR cz>sizeZ OR cy>sizeY OR cx>sizeX
      Let MouseButton$ = "left"
   ELSE
      DO
         DO
            MOUSE POLL MouseX, MouseY, MouseLeft, MouseRight
         LOOP while MouseLeft = 0 AND MouseRight = 0
         IF MouseRight = 1 THEN Let MouseButton$ = "right"
         IF MouseLeft = 1  THEN Let MouseButton$ = "left"
         DO
            MOUSE POLL MouseX, MouseY, MouseLeft, MouseRight
         LOOP until MouseLeft = 0 AND MouseRight = 0
         LET cz = 1
         IF MouseX > SizeX+1.5 THEN
            LET cx = INT(MouseX)-SizeX-1
            LET cz = cz+1
         ELSE
            LET cx = INT(MouseX)
         END IF
         IF MouseY < SizeY+1.5 THEN
            LET cy = INT(MouseY)
            LET cz = cz+2
         ELSE
            LET cy = INT(MouseY)-SizeY-1
         END IF
      LOOP UNTIL 1 <= cx AND cx <= SizeX AND 1<= cy AND cy <= SizeY     
   END IF
END SUB

SUB Zero
! When the cell-number is zero, make open surrounding cells.
   DO
      LET Flg = 0
      FOR zZ = 1 TO SizeZ
         FOR zY = 1 TO SizeY
            FOR zX = 1 TO SizeX
               IF MapNum (zZ, zX, zY) = 0 AND MapOpn(zZ, zX, zY) = 1 THEN
                  FOR aZ = zZ-1 TO zZ+1
                     FOR aY = zY-1 TO zY+1
                        FOR aX = zX-1 TO zX+1
                           IF  MapOpn(aZ, aX, aY) = 0  THEN
                              LET MapOpn(aZ, aX, aY) = 1
                              LET Flg = 1
                           END IF
                        NEXT aX
                     NEXT aY
                  NEXT aZ
               END IF
            NEXT zX
         NEXT zY
      NEXT zZ
   LOOP UNTIL Flg = 0
END SUB

SUB Detonation
! When the cell has a mine, make get explosion surrounding cells.
   DO
      LET Flg = 0
      FOR dZ = 1 TO SizeZ
         FOR dY = 1 TO SizeY
            FOR dX = 1 TO SizeX
               IF MapNum (dZ, dX, dY) = 99 AND MapOpn(dZ, dX, dY) = 2 THEN
                  FOR aZ = dZ-1 TO dZ+1
                     FOR aY = dY-1 TO dY+1
                        FOR aX = dX-1 TO dX+1
                           IF  MapOpn(aZ, aX, aY) <> 2  THEN
                              LET MapOpn(aZ, aX, aY) = 2
                              LET Flg = 1
                              IF MapNum (aZ, aX, aY) = 99 THEN
                                 LET ResidualMineNum = ResidualMineNum - 1
                              END IF
                           END IF
                        NEXT aX
                     NEXT aY
                  NEXT aZ
               END IF
            NEXT dX
         NEXT dY
      NEXT dZ
   LOOP UNTIL Flg = 0
END SUB

SUB CountResidualCells
   LET Count = 0
   LET Count2 = 0
   FOR jz = 1 TO SizeZ
      FOR jy = 1 TO SizeY
         FOR jx = 1 TO SizeX
            IF MapOpn(jZ, jX, jY) = 0 THEN
               LET Count = Count + 1
            END IF
            IF MapOpn(jZ, jX, jY) < 0 THEN
               LET Count  = Count  + 1
               LET Count2 = Count2 + 1
            END IF
         NEXT jx
      NEXT jy
   NEXT jz
   LET ResidualCellNum = Count
   LET FlagNum         = Count2
END SUB


! 変更履歴
! ４階モードのとき、大きい枠に対して補助線を追加
! 地雷マークを●から★に変更。フラグで付けた○と区別のため。
! 誘爆したときの色を変更。
! 難易度調整のため、各フロアごとの地雷数を表示するようにした。
END