본문 바로가기
TechNical/WMI

[HTA] 테트리스 혼자놀기 버전

by 강멍멍이 2020. 2. 23.
반응형

테트리스 혼자 놀기 버전이다.

조작 방법은 ASDW , Space

숫자패드가 있으면 숫자패드를 눌러도 된다.

원래는 엑셀로 만들었는데, 엑셀은 타이머가 최소 1초 단위라서 레벨이라는 개념이 안 들어가 지더라.

그러다가 HTA로 구현하게 되었는데 이건 1초 이하로 속도 조절을 할 수가 있다.

그런데 문제는 방향키가 안 먹어서 영문이나 숫자 패드를 눌러야 한다.

 

초기에는 모든 블럭 모양을 정해 놓고 하드코딩으로 회전시켰는데,

블럭을 랜덤으로 만들다 보니까 배열에 담아서 돌리는 알고리즘을 생각하는데 골이 좀 아팠다.

뭔가 좀 더 깔끔한 방법이 있을 것 같은데 뭘 해야 할지 모르겠다. ㅋ

가로 세로 크기를 맘대로 변경 할 수도 있는데, 기본으로 정해 놓은 사이즈가 딱 알맞는 것 같다.

[Tetris.hta]

<html>
    <meta charset="euc-kr">
    <head>
        <title>테트리스</title>
        <HTA:APPLICATION 
         ID="강멍멍이"
         APPLICATIONNAME="이판사판 테트리스"
         SCROLL="no"
         SINGLEINSTANCE="yes"
         WINDOWSTATE="normal"
        />
        
        <style>
            BODY {
                font-size:9pt;
                font-family:돋움체;
            }
            
            TABLE, TR, TD {
                font-size:1pt;
                text-indent:-10000px;
                border:1px solid black;
                border-collapse:collapse;
            }            
            
            .hide {
                opacity : 0;
                transition: opacity 1s linear;
                -webkit-transition: opacity 1s linear;
            }
        </style>
     
        <script language="VBScript">
            Dim interval, levelCnt, levelCntMax , intervalMinus, viewLevel
            
            Dim intX, intY
            Dim xBound, yBound
            Dim aniXDir, aniYDir

            
            Dim isButtom
            Dim blockColor
            Dim boxDir
            Dim chkStack
            Dim chkLineFill
            Dim ableYn
            Dim endGame
            Dim scoreCnt
            
            Dim timerID
            Dim animateTimerID
            
            Dim colorArr
                        
            Dim blockType
            Dim nextBlockType
            Dim blockArr(4, 4)
            Dim nextBlockArr(4, 4)
            Dim fireBlockYn
            Dim firePosition
            Dim nextFireBlockYn
            Dim nextFirePosition
            Dim fireBullet            
            
            Sub Window_OnLoad
                window.resizeTo 220, 500
                'window.moveTo 750, 250
                window.moveTo 1200, 350
                
                colorArr = Array("e2edff", "teal", "aqua", "salmon", "darkkhaki", "darkred", "plum", "lime", "black", "gray")

                xBound = CInt(inpColCnt.value)
                yBound = CInt(inpRowCnt.value)            
                
                For nRow = 1 To yBound
                    Set tblRow = mainTbl.insertRow()

                    For nCell = 1 To xBound
                        Set tblCell = tblRow.insertCell()
                        tblCell.style.width = 10
                        tblCell.style.height = 10
                        tblCell.style.backgroundcolor = "#ffffff"
                        tblCell.innerHtml= "0"
                    Next
                Next

                For nRow = 1 To 4
                    Set tblRow = tblNextBlock.insertRow()

                    For nCell = 1 To 4
                        Set tblCell = tblRow.insertCell()
                        tblCell.style.width = 10
                        tblCell.style.height = 10
                        tblCell.style.backgroundcolor = "#ffffff"
                        tblCell.innerHtml= "0"
                    Next
                Next                
                
                intX = CInt(yBound / 2)
                intY = CInt(xBound / 2)
                
                aniXDir = 0
                aniYDir = 0
                animateTimerID = window.setTimeOut("animate", 500)
                                
            End Sub
            
            Sub animate
                'mainTbl.Rows(intX).Cells(intY).style.backgroundcolor = "white"
                Randomize                
                aniDir = Int(2 * Rnd)
                
                If aniDir = 0 Then
                    If aniXDir = 0 Then
                        intX = intX + 1
                    Else
                        intX = intX - 1
                    End If                
            
                    If intX = yBound -1 Then
                        aniXDir = 1
                    End If
    
                    If intX = 0 Then
                        aniXDir = 0
                    End If
                End If

                Randomize                
                aniDir = Int(2 * Rnd)

                If aniDir = 0 Then
                    If aniYDir = 0 Then
                        intY = intY + 1
                    Else
                        intY = intY - 1
                    End If
                
                    If intY = xBound - 1 Then
                        aniYDir = 1
                    End If
    
                    If intY = 0 Then
                        aniYDir = 0
                    End If
                End If
                
                On Error Resume Next
                Randomize                
                aniColor = Int(10 * Rnd)                
                'mainTbl.Rows(intX).Cells(intY).style.backgroundcolor = "white"
                mainTbl.Rows(intX).Cells(intY).style.backgroundcolor = colorArr(aniColor)
                window.clearTimeOut(animateTimerID)
                animateTimerID = window.setTimeOut("animate", 100)
            End Sub
            
            Sub startGame
                document.body.focus()   '시작버튼에 있는 포커스 제거
                window.clearTimeOut(animateTimerID)
                
                xBound = CInt(inpColCnt.value)
                yBound = CInt(inpRowCnt.value)
                
                levelCntMax = 80
                intervalMinus = 20
                                
                interval = 700
                levelCnt = 1
                viewLevel = 1
                scoreCnt = 0                
                
                labLevelCnt.innerHTML = viewLevel

                rowCnt = 0      
                tblRowCnt = mainTbl.rows.length
                Do While rowCnt < tblRowCnt
                    mainTbl.deleteRow(0)
                    rowCnt = rowCnt + 1
                Loop                                
                                
                For nRow = 1 To yBound
                    Set tblRow = mainTbl.insertRow()

                    For nCell = 1 To xBound
                        Set tblCell = tblRow.insertCell()
                        tblCell.style.width = 10
                        tblCell.style.height = 10
                        tblCell.style.backgroundcolor = "#ffffff"
                        tblCell.innerHtml= "0"
                    Next
                Next

                endGame = "N"

                chkStack = "N"
                chkLineFill = "N"
                
                Call blockShape
                    
                Call newBlock            
            End Sub
            
            Sub newBlock
                intX = CInt(xBound / 2) - 2
                intY = -1
                boxDir = 1
                isButtom = "N"
                ableYn = "Y"
                'fireBlockYn = "N"
                'fireBullet = 0
                
                Call blockShape
                
                Call setPosition(intY, intX, "D")                
                
                timerID = window.setTimeOut("moveDown", interval)
            End Sub

            Sub moveDown
                levelCnt = levelCnt + 1
                
                If levelCnt > levelCntMax Then
                    interval = interval - intervalMinus
                    levelCnt = 1
                    
                    viewLevel = viewLevel + 1
                    labLevelCnt.innerHTML = viewLevel
                End If                
                
                If chkStack = "N" And chkLineFill = "N" And intY <= yBound + 1 Then
                
                    Call checkStack(1)
                    
                    If isButtom = "Y" And intY < 1 Then
                        If endGame <> "Y" Then
                            MsgBox "End!"
                            intX = CInt(yBound / 2)
                            intY = CInt(xBound / 2)
                            animateTimerID = window.setTimeOut("animate", 500)
                        End If
                        
                        endGame = "Y"
                        
                    ElseIf isButtom = "Y" Then
                        '바닥까지 내려 오거나 쌓이면 새 블럭 생성
                        Call checkLineFill
                        Call newBlock
                    Else
                        Call setPosition(intY, intX, "R")
                        intY = intY + 1
                        Call setPosition(intY, intX, "D")
                       
                        window.clearTimeOut(timerID)
                        timerID = window.setTimeOut("moveDown", interval)
                    End If
                        
                End If
                    
            End Sub                        
                
            Sub moveDownByKey
               
                If chkStack = "N" And chkLineFill = "N" And intY <= yBound + 1 Then
                    Call checkStack(1)
                    
                    If isButtom = "Y" And intY < 1 Then
                        If endGame <> "Y" Then
                            MsgBox "End!"
                            intX = CInt(yBound / 2)
                            intY = CInt(xBound / 2)                            
                            animateTimerID = window.setTimeOut("animate", 500)
                        End If
                                                
                        endGame = "Y"

                    ElseIf isButtom = "Y" Then
                        Call checkLineFill
                        Call newBlock
                    Else
                        Call setPosition(intY, intX, "R")
                        intY = intY + 1
                        Call setPosition(intY, intX, "D")
                    End If                    
                End If
                                
            End Sub
            
            Sub moveLeft                
                Call setPosition(intY, intX, "R")
                Call setPosition(intY, intX - 1, "C")
                
                If ableYn = "Y" Then
                    Call setPosition(intY, intX, "R")
                    intX = intX - 1                    
                End If
                
                Call setPosition(intY, intX, "D")                            

            End Sub            

            Sub moveRight
                Call setPosition(intY, intX, "R")
                Call setPosition(intY, intX + 1, "C")
                
                If ableYn = "Y" Then
                    Call setPosition(intY, intX, "R")
                    intX = intX + 1
                End If
                
                Call setPosition(intY, intX, "D")
            End Sub            
            
            
            Sub rotateBox
                If fireBlockYn = "Y" Then
                    Exit Sub
                End If
                
                '블럭별로 주변에 부딪혀도 회전 가능한지 체크해야 함
                '회전
                prevVal = 0
                arrSize = 3                
                'blockArrCopy = blockArr
                Dim blockArrCopy(4, 4)
                Dim rotateArr(4, 4)
                
                Call setPosition(intY, intX, "R")
                
                '원본 어레이 복사
                For nRow = 0 To arrSize
                    For nCol = 0 To arrSize 
                        blockArrCopy(nRow, nCol) = blockArr(nRow, nCol)
                    Next
                Next 
                               
                For nRow = 0 To arrSize
                    For nPos = 0 To (arrSize / 2)
                        For nCol = 0 To arrSize - nPos
                        
                            '시계방향
                            blockArr(nCol + nPos, nPos) = blockArrCopy(arrSize - nPos, nCol + nPos)
                            blockArr(arrSize - nPos, nCol + nPos) = blockArrCopy(arrSize - nCol - nPos, arrSize - nPos)
                            blockArr(nCol + nPos, arrSize - nPos) = blockArrCopy(nPos, nCol + nPos)
                            blockArr(nPos, nCol + nPos) = blockArrCopy(arrSize - nCol - nPos, nPos)

                            '반시계 방향
                            'blockArr(nCol + nPos, nPos) = blockArrCopy(nPos, arrSize - nPos - nCol)
                            'blockArr(arrSize - nPos, nCol + nPos) = blockArrCopy(nCol + nPos, nPos)
                            'blockArr(nCol + nPos, arrSize - nPos) = blockArrCopy(arrSize - nPos, arrSize - nCol - nPos)
                            'blockArr(nPos, nCol + nPos) = blockArrCopy(nCol + nPos, arrSize - nPos)                            
                                                        
                        Next
                    Next
                Next

                '회전한 어레이 보관
                For nRow = 0 To arrSize
                    For nCol = 0 To arrSize 
                        rotateArr(nRow, nCol) = blockArr(nRow, nCol)
                    Next
                Next
                    
                '회전 가능여부 확인                    
                Call setPosition(intY, intX, "C")
                
                '원본 어레이 복구
                For nRow = 0 To arrSize
                    For nCol = 0 To arrSize 
                        blockArr(nRow, nCol) = blockArrCopy(nRow, nCol)
                    Next
                Next                
                
                If ableYn = "Y" Then
                    Call setPosition(intY, intX, "R")           
                    '회전한 어레이 적용
                    For nRow = 0 To arrSize
                        For nCol = 0 To arrSize 
                            blockArr(nRow, nCol) = rotateArr(nRow, nCol)
                        Next
                    Next
                End If
                
                Call setPosition(intY, intX, "D")

            End Sub

            Sub checkStack(yPos)                
                '체크하는 찰나의 순간에 아래로 내려가는 이벤트가 일어 날 수 있어서 걸어 줬다
                chkStack = "Y"
                
                '자기꺼는 제외하고 다른 블럭이랑 겹치는지 비교한다.
                Call setPosition(intY, intX, "R")
                Call setPosition(intY + yPos, intX, "C")
                
                If ableYn = "N" Then
                    isButtom = "Y"
                Else
                    isButtom = "N"
                End If
                
                chkStack = "N"
                
                Call setPosition(intY, intX, "D")
            End Sub            

            Sub checkLineFill
                chkLineFill = "Y"
                '밑에서 부터 올라가면서 체크한다
                For intRow = yBound - 1 To 0 Step -1
                    For intCol = 0 To xBound - 1
                        On Error Resume Next
                        If mainTbl.Rows(intRow).Cells(intCol).innerHtml = "0" Then
                            Exit For
                        End If
                        
                        If intCol = xBound - 1 Then
                            mainTbl.deleteRow(intRow)

                            Set tblRow = mainTbl.insertRow(0)
                            For nCell = 1 To xBound
                                Set tblCell = tblRow.insertCell()
                                tblCell.style.width = 10
                                tblCell.style.height = 10
                                tblCell.innerHtml= "0"
                            Next
                                                        
                            intRow = yBound
                            intCol = 1
                            scoreCnt = scoreCnt + 1
                            
                            labScore.innerHTML = scoreCnt
                                            
                        End If
                    Next
                Next
                chkLineFill = "N"
            End Sub
            
            Sub fireBlock
                If fireBlockYn = "Y" And fireBullet > 0 Then
                    rowCnt = yBound - 1                    
                    Do While rowCnt > 1
                        If mainTbl.Rows(rowCnt).Cells(intX + firePosition).innerHtml = 0 Then                            
                            mainTbl.Rows(rowCnt).Cells(intX + firePosition).innerHtml = 1
                            mainTbl.Rows(rowCnt).Cells(intX + firePosition).style.backgroundcolor = "red"
                            fireBullet = fireBullet - 1
                            labBullet.innerHTML = fireBullet
                            
                            If fireBullet = 0 Then
                                blockType = 9   '총알 다 쓰면 회색
                            End If
                            Exit Do
                        End If
                        rowCnt = rowCnt - 1
                    Loop
                End If
            End Sub
            
            Sub holdGame
                MsgBox "일시중지!!"
            End Sub
            
            Sub blockShape
            
                '이전에 만들어 놓은 블럭을 넣고 다음 블럭을 생성한다.
                fireBlockYn = nextFireBlockYn
                firePosition = nextFirePosition
                
                If nextFireBlockYn = "Y" Then
                    fireBullet = 5
                Else
                    fireBullet = 0
                End If
                
                labBullet.innerHTML = fireBullet
                                
                blockType = nextBlockType 
                For nRow = 0 To 3
                    For nCol = 0 To 3 
                        blockArr(nRow, nCol) = nextBlockArr(nRow, nCol)
                    Next
                Next
                
                '블럭 영역 초기화
                For nRow = 0 To 3
                    For nCol = 0 To 3
                        nextBlockArr(nRow, nCol) = 0
                    Next
                Next
                
                nextFireBlockYn = "N"
                
                Randomize                
                blockRndYn = Int(2 * Rnd)
                
                Randomize                
                nextBlockType = Int(7 * Rnd) + 1    '블럭 색상 & 모양(랜덤 아닌 경우)                
                
                If chkBlockRandom.checked = "True" And blockRndYn = 0 Then
                    okCnt = Int(5 * Rnd) + 1
                    
                    If okCnt = 1 Then
                        nextFireBlockYn = "Y"
                        nextBlockType = 8   '총알 발사하는 블럭은 깜장색                   
                    End If 
                                        
                    Do Until okCnt = 0
                        rndX = Int(3 * Rnd)
                        rndY = Int(3 * Rnd)
                        nextFirePosition = rndY
                        IF nextBlockArr(rndX, rndY) <> 1 Then
                            okCnt = okCnt - 1
                            nextBlockArr(rndX, rndY) = 1
                        End If
                    Loop
                Else
                    If nextBlockType  = 1 Then
                        nextBlockArr(1, 0) = 1
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(1, 2) = 1
                        nextBlockArr(2, 2) = 1
                    ElseIf nextBlockType = 2 Then
                        nextBlockArr(1, 0) = 1
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(1, 2) = 1
                        nextBlockArr(2, 0) = 1
                    ElseIf nextBlockType = 3 Then
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(1, 2) = 1
                        nextBlockArr(2, 1) = 1
                        nextBlockArr(2, 2) = 1
                    ElseIf nextBlockType = 4 Then
                        nextBlockArr(1, 0) = 1
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(1, 2) = 1
                        nextBlockArr(1, 3) = 1
                    ElseIf nextBlockType = 5 Then
                        nextBlockArr(1, 0) = 1
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(2, 1) = 1
                        nextBlockArr(2, 2) = 1
                    ElseIf nextBlockType = 6 Then
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(1, 2) = 1
                        nextBlockArr(2, 0) = 1
                        nextBlockArr(2, 1) = 1
                    ElseIf nextBlockType = 7 Then
                        nextBlockArr(1, 1) = 1
                        nextBlockArr(2, 0) = 1
                        nextBlockArr(2, 1) = 1
                        nextBlockArr(2, 2) = 1
                    End If
                End If
                
                '다음 블럭 미리보기
                For nRow = 0 To 3
                    For nCol = 0 To 3
                        If nextBlockArr(nRow, nCol) = 1 Then 
                            tblNextBlock.Rows(nRow).Cells(nCol).style.backgroundcolor = colorArr(nextBlockType)                        
                        Else
                            tblNextBlock.Rows(nRow).Cells(nCol).style.backgroundcolor = "ffffff"
                        End If
                    Next
                Next          
                                    
            End Sub
        
            Sub setPosition(getY, getX, drType)
            
                On Error Resume Next                
                
                'C로 들어 오면 원본을 먼저 삭제한 상태이다.
                '이동 할 포지션에 값을 +1 해서 기존재 여부를 확인 한다.
                If drType = "C" Then
                    For nRow = 0 To 3
                        For nCol = 0 To 3
                            If blockArr(nRow, nCol) = 1 Then 
                                mainTbl.Rows(getY + nRow).Cells(getX + nCol).innerHtml = mainTbl.Rows(getY + nRow).Cells(getX + nCol).innerHtml + 1
                            End If
                        Next
                    Next
                End If                  

                '여기서 밑에 불럭이 있는지 잡는거 같은데..
                '해당 지점에 이미 존재하는 블럭이 있다면 2가 될 것이다. 존재하면 이동불가
                ableYn = "Y"
                
                For nRow = 0 To 3
                    If ableYn = "N" Then
                        Exit For
                    End If
                    
                    For nCol = 0 To 3
                        Err.Clear   '루프를 돌 때마다 에러코드를 클리어 해 줘야 정상동작 한다.
                    
                        If mainTbl.Rows(getY + nRow).Cells(getX + nCol).innerHtml > 1 Then                            

                            '바운더리를 넘어갈 경우 IF문 안으로 들어오기 때문에, 정상인 경우에만 체크를 한다.                                                            
                            If Err.Number = 0 Then
                                ableYn = "N"
                                Exit For
                            End If
                            
                        End If
                    Next
                Next
                
                '체크용도로 숫자 올린거 다시 내린다.
                If drType = "C" Then
                    For nRow = 0 To 3
                        For nCol = 0 To 3
                            If blockArr(nRow, nCol) >= 1 Then 
                                mainTbl.Rows(getY + nRow).Cells(getX + nCol).innerHtml = mainTbl.Rows(getY + nRow).Cells(getX + nCol).innerHtml - 1
                            End If
                        Next
                    Next
                End If

                '바운더리 이동 가능여부 확인
                For nRow = 0 To 3
                    For nCol = 0 To 3
                        If blockArr(nRow, nCol) >= 1 Then
                            If (getX + nCol) < 0 OR (getX + nCol) >= xBound Then
                                'msgbox nRow & " " & nCol & " " & getX & " " &  getX + nCol
                                ableYn = "N"
                            End If

                            If (getY + nRow) < 0 OR (getY + nRow) >= yBound Then
                                ableYn = "N"
                            End If
                        End If
                    Next
                Next
               
                setNum = "0"
                setColor = "#ffffff"
                
                If ableYn = "Y" And drType = "D" Then                    
                    setNum = "1"
                    setColor = colorArr(blockType)
                End If
                
                If drType = "R" Or drType = "D" Then
                    For nRow = 0 To 3
                        For nCol = 0 To 3
                            If blockArr(nRow, nCol) = 1 Then 
                                mainTbl.Rows(getY + nRow).Cells(getX + nCol).innerHtml = setNum
                                mainTbl.Rows(getY + nRow).Cells(getX + nCol).style.backgroundcolor = setColor
                            End If
                        Next
                    Next
                End If
                
                'msgbox "4"
                                    
            End Sub
            
            Sub chekKeyPress
                
                'msgbox window.event.Keycode    '키 값을 알고 싶다면?
                
                If endGame <> "Y" Then
                    IF (window.event.Keycode = 119 Or window.event.Keycode = 56) THEN    'w키, 상
                        Call rotateBox
                    END IF
    
                    IF (window.event.Keycode = 115 Or window.event.Keycode = 53) THEN    's키, 하
                        Call moveDownByKey
                    END IF
                                    
                    IF (window.event.Keycode = 97 Or window.event.Keycode = 52) THEN    'a키, 좌
                        Call moveLeft
                    END IF
    
                    IF (window.event.Keycode = 100 Or window.event.Keycode = 54) THEN    'd키, 우
                        Call moveRight
                    END IF

                    IF (window.event.Keycode = 32) THEN    '스페이스키, 파이어!
                        Call fireBlock
                    END IF

                    IF (window.event.Keycode = 27) THEN    'ESC 중지/시작
                        Call holdGame
                    END IF                    
                End If
            End Sub            
        </script>
    </head>        
    
    <body onKeyPress="chekKeyPress">
        Row:<input id="inpRowCnt" type="input" value="20" style="width:20px;height:20px"/>
        Col:<input id="inpColCnt" type="input" value="10" style="width:20px;height:20px"/>
        이판사판:<input id="chkBlockRandom" type="checkbox" style="width:20px" title="블럭 모양 무작위" checked/>        
        <br>        
        <div style="float:left;width:75%;height:10%;margin:3px;">
            <button onClick="startGame" style="width:35px;height:20px">Start</button>
            lv:<label id="labLevelCnt"></label>/Sc:<label id="labScore"></label><br>
            발사:<label id="labBullet"></label>
        </div>
        <table id="tblNextBlock" style="float:left;width:40px;height:40px"></table>
        <table id="mainTbl" style="width:100%;height:85%"></table>
    </body>
</html>
반응형

댓글