반응형
테트리스 혼자 놀기 버전이다.
조작 방법은 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>반응형
댓글