'FreeBasic Miner 1.0 - 2011
'--------------------------------------------------
'
'
'--------------------------------------------------

'--------------------------------------------------
'A FAZER:
'
'Criar mais minas
'


'--------------------------------------------------
#Include Once "fbgfx.bi"
#Include Once "file.bi"
#Include Once "windows.bi"
#Include Once "win\mmsystem.bi"
#If __FB_LANG__ = "fb"
	Using FB 
#EndIf



'--------------------------------------------------
#Define RGBA_A(c) (CUInt(c) Shr 24)
#Define RGBA_R(c) (CUInt(c) Shr 16 And 255)
#Define RGBA_G(c) (CUInt(c) Shr 8 And 255)
#Define RGBA_B(c) (CUInt(c) And 255)
#Define Magenta &HFFFF00FF
#Define LargArqFonte	838
#Define MaxUndo 49

Const C255 = Chr (255)

Enum	'opções do menu
	Jogar
	IrPara
	VerTop
	Sobre
	Volume
	EscIdioma
	Custom
	Editar
	Sair
End Enum

Enum	'status do programa
	NoMenu
	Configs
	Jogando
	ModoDemo
	Testando
	Pausado
	GameOver
	ModoMapa
	Instruc
	VenceuMina
	VenceuJogo
	Top10
	SelIdioma
	Editor
End Enum

Enum	'Posição do mouse no editor
	EdForaTela
	EdTela
	EdInicio
	EdEsquerda
	EdDireita
	EdFim
	EdBarra
	EdItem
	EdNovo
	EdAbre
	EdMove
	EdSalva
	EdVisao
	EdMudaGrid
	EdApaga
	EdTesta
	EdUndo
	EdRedo
	EdEXIT
End Enum

Enum	'Status do editor
	Editando
	Selecionando
	RespNovo
	RespAbrindo
	EdMovendo
	RespSalvar
	Apagando0
	Apagando1
	RespTesta
	RespExit
End Enum
	


'Tipos
'--------------------------------------------------

'Som
Type TSons
	COn1			As DWord
	COn2			As DWord
	COff			As DWord
	Tempo			As UByte
End Type

'Jogo
Type TJogo
	Status       	As Integer 	'Status do programa
	Status0       	As Integer 	'Status no início do ciclo, para comparar abaixo
	StatusAnt		As Integer	'Idem acima
	EdStatus		As Integer	'Status do editor de minas
	UltExplosao  	As Integer	'Ponto para incluir nova explosão
	Passos       	As Integer	'Número de ciclos para concluir um movimento
	TamanhoPasso 	As Integer	'Espaço percorrido em cada passo
	Ciclo        	As Integer	'Ciclo atual (0 a passos-1)
	DelayMSec	  	As Integer	'Milisegundos por quardo
	UltTimer     	As Long		'Marcador de tempo para ajustar FPS
	Encerra      	As Integer	'Sai do jogo (0=não)
	SeqCiclo     	As Integer	'Sequencia de ciclos (0-999)
	Player       	As Integer	'0=Jogador 1;   1=Jogador 2
	TelaInstr    	As Integer	'Número da tela de instruções
	NumMinas     	As Integer	'Número de minas disponíveis
	NumVidas     	As Integer	'Número de vidas ao iniciar partida
	Volume   		As UByte	'Volume dos efeitos sonoros
	MaxAlcancada	As UInteger	'Número mais alto de mina alcançado até o momento
End Type

'Boneco
Type TBoneco
	Mina           	As Integer  'Número da mina (caverna)
	Vidas          	As Integer  'Número de vidas
	Pontos         	As Long     'Pontuação atual
	Morreu         	As Integer  '0=vivo 1~=passos
	UltDir         	As Integer  'Ao parar, para onde fica de frente
	DirAtual       	As Integer  'Para onde está indo (0=parado 1=direita 2=esquerda 3=subindo 4=descendo 5=caindo)
	Empurrando     	As Integer  'Se está empurrando objetos
	Passo          	As Integer  'Passo do movimento (0=parado; 1 a jogo.passos)
	Img            	As Integer  'Número da imagem
	ImgX           	As Integer  'X da posição absoluta na tela
	ImgY           	As Integer  'Y da posição absoluta na tela 
	X              	As Integer  'Posição X (quadro)
	Y              	As Integer  'Posição Y (quadro)
	Oxigenio       	As Integer  'Oxigenio atual (diminui se estiver na água)
	NoOxigenio     	As Integer  '0=Não 1=Usando garrafa de oxigênio
	ItSuporte      	As Integer  'Quantos suportes possui
	ItOxigenio     	As Integer  'Quantas garrafas de oxigênio possui
	ItPicareta     	As Integer  'Quantas picaretas possui
	ItFuradeira    	As Integer  'Quantas furadeiras possui
	ItBombinha     	As Integer  'Quantas bombas pequenas possui
	ItBombona      	As Integer  'Quantas bombas grandes possui
	NaPicareta     	As Integer  'Se está usando a picareta (0=não 1~=passo)
	NaFuradeira    	As Integer  'Se está usando a furadeira (id. acima)
	DirFuradeira   	As Integer  'Para que lado está furando (1=direita 2=esquerda)
	VirouFuradeira 	As Integer  '0=Não virou, ainda pode virar; 1=já virou, não pode mais
	Tempo          	As Long     'Marca o tempo (em segundos)
	Nome           	As String   'Nome do jogador
End Type

'Mina
Type TMina
	Numero 			As Integer
	Tipo				As UByte	'0=Normal  1=Personalizada
	Larg 				As UByte    'Largura (Tela=25)
	ALT        		As UByte    'Altura (Tela=17)
	Tesouros   		As Integer  'Quantidade de tesouros a recolher para completar a mina
	X          		As Integer  'Posição X inicial do boneco
	Y          		As Integer  'Posição Y inicial do boneco
	Noturno    		As UByte    'Se a mina é noturna ou não
	Tempo      		As UInteger	'Tempo para concluir a mina
	Alterada 		As Integer	'Se foi feita alteraçao depois de ler ou de gravar pela ultima vez
End Type

'Explosões
Type TExplosao
	X     		As Integer   'X do quadro da explosão
	Y     		As Integer   'Y do quadro da explosão
	Tipo  		As Integer   '0=não está em uso; 1=pequena (3 quadros); 2=grande (9 quadros)
	Tempo 		As Integer   '0=não está em uso; 1~=passos
End Type

'Editor
Type EdTipo
	Tp 			As Integer  '0=fundo 1=obj 2=frente
	Cod 		As Integer 	'Código do fundo, objeto ou frente
End Type


'Comportamentos dos diferentes objetos (12 diferentes)
Type TComportamento
	Vazio    	As Byte		'0=não vazio; 1=vazio (vão livre para andar e empurrar)
	Sobe     	As Byte		'0=não sobe; 1=sobe
	Apoia    	As Byte		'0=não apóia; 1=apoia
	Anda     	As Byte		'0=Não anda; 1=Anda e some ou pega; 2=Anda e permanece
	Mata     	As Byte		'0=não mata; 1=mata
	PEmpurra 	As Integer	'0=empurra inúmeros; 1=empurra 2; 2=empurra 1; 3=não empurra
	Cai      	As Byte		'0=não cai; 1=cai
	Destroi  	As Byte		'0=não destrói 1=só com explosão 2=explosão, furadeira ou picareta
	Som      	As Byte		'0=Vazio 1=Terra 2=Tijolo/Escada/Pedra 3=Diamante/Carrinho/Item 4=Caixa/Feno (5=boneco)
End Type

'Objetos (81 diferentes)
Type TiposObj
	Tipo As Integer    'Índice do tipo de comportamento
	Img  As Integer    'Número da imagem
	Item As Integer    'Numero do item
End Type

'Mensagens na tela
Type TMsgPT
	Ciclo  As Integer '0=Acabou
	Pontos As Integer
	X	As Integer
	Y	As Integer
End Type

'Tiles
Type TObj
	Tp         As UByte    'Indicador do tipo de objeto
	Caindo     As Byte     '0=não; 1=sim
	AntCaindo  As Byte     'Se já estava caindo anteriormente
	Empurrando As Byte     '0=não; 1=direita; 2=esquerda
	Passo      As Integer  'Número do passo no movimento
End Type

'Top Score
Type Recorde
	Nome   As String    'Nome
	Pontos As UInteger	'Pontuação
End Type


'Sub's
'--------------------------------------------------
Declare Sub EscreveNumero (ByVal Numero As Long, Comprimento As Integer, X1 As Integer, Y1 As Integer, PReenche As Integer)
Declare Sub Escreve (ByVal Texto As String, x1 As Integer, y1 As Integer, Bold As Integer = 0, BoldV As Integer = 0)
Declare Sub EscreveCentro (ByVal Texto As String, x1 As Integer, Bold As Integer = 0, BoldV As Integer = 0)
Declare Sub EscrevePT (Pontos As  Integer, X As Integer, Y As Integer, CJCarac As Integer)
Declare Function LargTexto (ByVal Texto As String, Bold As Integer = 0) As Integer
Declare Sub IniciaJogo
Declare Sub IniciaVida
Declare Sub LeMinaIn (NMina As Integer, SoQuant As Integer = 0)
Declare Sub LeMinaOUT (NMina As Integer, Editando As Integer = 0)
Declare Sub LeMinaDet (Editando As Integer = 0)
Declare Sub LeMinasPers
Declare Sub Desenha
Declare Sub Joga
Declare Sub PegaObj (POX As Integer, POY As Integer)
Declare Function EmpurraObj (ByVal POX As Integer, ByVal POY As Integer, ByVal MDir As Integer, ByVal Peso As Integer, ByVal Quant As Integer) As Integer 
Declare Sub Explode (ByVal EXX As Integer, ByVal EXY As Integer, ByVal XTam As Integer)
Declare Sub LimpaMina
Declare Function VerificaRecorde As Integer
Declare Sub LeTopDez
Declare Sub TrocaTelas
Declare Sub MontaTopDez
Declare Sub LimpaTopDez
Declare Sub Mensagem (QCor As Integer, Tipo As Integer, T1 As String, T2 As String, T3 As String, OX As Integer = 400, OY As Integer= 300, Opcao As Integer = 0)
Declare Sub DesBox (H As Integer, V As Integer, QCor As Integer, OX As Integer = 400, OY As Integer = 300)
Declare Sub PutLogo (LX As Integer, LY As Integer)
Declare Sub SorteiaNotaGameOver
Declare Sub SorteiaNotaVenceu
Declare Sub MarcaPt (Pontos As Integer, X As Integer, Y As Integer)
Declare Function CTRX As Integer
Declare Function CTRY As Integer
Declare Function ProximaTeclaDemo () As String
Declare Sub LoadBar (perc As Integer)
Declare Sub RegravaConfig
Declare Function LeTXT (Idioma As String) As Integer
Declare Sub LeTXTBase
Declare Sub ProcIdiomas ()
Declare Sub DesFundo
Declare Sub VeSeGanhaVida (Acrescimo As Integer)
Declare Sub CalculaBonusTempo
Declare Sub LeMouse
Declare Sub MudaStatus (NovoStatus As Integer)
Declare Sub DesligaSons
Declare Sub LimpaTeclado (IncLMTec As Integer = 0)

'Editor:
Declare Sub Edita
Declare Sub EscreveNumeroPeq (ByVal Numero As Integer, X1 As Integer, Y1 As Integer)
Declare Sub SalvaMina (ParaTestar As Integer = 0)
Declare Sub Dlinha (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, QualCor As Integer)
Declare Sub CopiaMMinEd
Declare Sub CopiaMEdMin
Declare Sub EncerraTeste
Declare Sub DesenhaItem (ITX As Integer, ITY As Integer, ITN As Integer)
Declare Function MaiorColuna As Integer
Declare Function MaiorLinha As Integer
Declare Function ContaTesouros As Integer
Declare Function PosMouseEd () As Integer
Declare Sub FazRedo
Declare Sub FazUndo
Declare Sub LimpaMinaEditor
Declare Function PergFecha () As Integer
Declare Sub SwapEDXY
Declare Sub GravaUndo
Declare Function PerguntaSeEncerraTeste() as Integer


'Variáveis compartilhadas
'--------------------------------------------------

'Armazenamento das Imagens
Dim Shared Carregou As Integer
Dim Shared As Any Ptr Grafx, GrafX2, BMP (281)

'Mensagens de pontos na tela
Dim Shared As TMsgPT MSG (20)

'Recordes
Dim Shared TopPt (10) As Recorde
Dim Shared As Integer ConfirmDel

'Sons
Dim Shared hMidiOut As HMIDIOUT
Dim Shared As TSons Som (1 To 6, 1 To 4), SomEx (1 To 7)
Dim Shared As UByte Toca (1 To 6, 1 To 4), QtdNotasVenceu
Dim Shared As DWord UltNotaGameOver, resposta
Dim Shared As Double TimerNotaVenceu

'Menu
Dim Shared As Integer OpMenu, XM, YM, Mina1, Mina2, PosTop10, Opcao1

'Genéricas
Dim Shared As Integer Iniciado, MapX, MapY, ProxMsg, LenMSG, EncerraEditor
Dim Shared As String Tecla, UltTecla
Dim Shared As UInteger CorRGB, CorRGB2

'Fonte
Dim Shared As String Lt, XTemp
Dim Shared as Integer PosLetra (100, 1)

'Screen
Dim Shared ScrAtiva As Integer

'Idiomas
Dim Shared As String Idioma (15), IAtual
Dim Shared As Integer IQuant, NAtual

'Timer
Dim Shared As UInteger ATimer, NTimer
Dim Shared NumFPS(5) As Integer
Dim Shared NomFPS(5) As String
Dim Shared As Double TIMESTART

'Jogo
Dim Shared Jogo As TJogo
Dim Shared Boneco As TBoneco
Dim Shared As TMina Mina
Dim Shared PontoTesouro (7 To 22) As Integer
Dim Shared As Integer TmpSleep, PtBonus, Quadros, ultQuadros
Dim Shared As Double Timer1, Timer2

'Explosões
Dim Shared Explosao (10) As TExplosao

'Comportamentos de objetos
Dim Shared Comport (13) As TComportamento

'Tipos de objetos
Dim Shared TpObjeto (84) As TiposObj

'Tiles: fundo - layer 0 (0 = água)
Dim Shared As UByte Fundo (-1 To 100, -1 To 60)

'Tiles: objetos - layer 1
Dim Shared As TObj Objeto (-1 To 100, -1 To 60)

'Tiles: frente - layer 2
Dim Shared As UByte Frente (-1 To 100, -1 To 60)

'Imagens do boneco
Dim Shared Parado (5) As Integer
Dim Shared Movendo (7,3) As Integer
Dim Shared Usando (2,1) As Integer

'Tela inicial
Dim Shared As Integer CRed, CGreen, CBlue, VRed, VGreen, VBlue, CRed2, CGreen2, CBlue2

'Modo Demonstração
Dim Shared As String TeclasDemo
Dim Shared As Integer PositDemo, DemoW1, DemoW2, DemoCiclo, MensDemo, TempMens
Dim Shared As Double TTDemo1, TTDemo2

'Minas personalizadas
Dim Shared As Integer MinaPers (999), SelPers (999), QuantPers, PersTemp

'Textos (todos)
Dim Shared As String TXT (159) 

'Mouse:
Dim Shared As Integer MouseX, MouseY, MouseB, MouseXAnt, MouseYAnt, MouseBAnt, MouseDisparou, MouseLiberou, MouseSimNao, MouseMoveu, MouseSobre, MouseW, MouseWAnt, MouseWDir

'Editor:
Dim Shared As TMina MinaEd
Dim Shared As String LMTec, UMTec

Dim Shared As Integer EdX1, EdX2, EdY1, EdY2, EdMOn, EdShow, PrimeiroItem, ItemSel
Dim Shared As Integer EDXX1, EDXX2, EDYY1, EDYY2, EdGrid, PosMouse

'Undo:
Dim Shared As Integer MatrizAtual, MatrizRedoLimite, MatrizUndoLimite, EdMovendoUndo, BonecoX (MaxUndo), BonecoY (MaxUndo)
Dim Shared As UByte UndoFundo (MaxUndo, -1 To 100, -1 To 60), UndoFrente (MaxUndo, -1 To 100, -1 To 60), UndoObjeto (MaxUndo, -1 To 100, -1 To 60)


'--------------------------------------------------

'Fonte
Lt = "ABCDEFGHIJKLMNOPQRSTUVWXYZÇÁÉÍÓÚÂÊÔÃÕÀabcdefghijklmnopqrstuvwxyzçáéíóúâêôãõà.,:?!0123456789-+'/()=_>|"
'*FT* Lt = " 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZÇÁÉÍÓÚÂÊÔÃÕÀabcdefghijklmnopqrstuvwxyzçáéíóúâêôãõà-_=+(*)&%$#@!?,.<>;:|"

'Vairáveis locais
Dim as integer F, G, H, I

'Inicializa a tela
WindowTitle "FreeBasic Miner"
Screen 19, 32, 2  '800x600, Cores de 32 bits, 2 páginas
CRed = 0
Randomize
VRed = Int(Rnd*2)
VGreen = Int(Rnd*2)
VBlue = Int(Rnd*2)
DesFundo
CRed = 0
	
Draw String (25,500), "Carregando FreeBasic Miner..."
Line (20,520) - (779,554), RGB(200,200,200), bf
Line (21,519) - (778,555), RGB(200,200,200), b
Line (23,523) - (776,551), RGB(16,16,48),bf

LoadBar 5
LeTXT ("Portugues")
IAtual = "Portugues"
Idioma (0)= "Portugues"
Idioma (0)= "Portugues"

Sleep 2, 1

'Definição das imagens do boneco
'--------------------------------------------------

'Parado (depende do último movimento)
Parado (0) = 116
Parado (1) = 119
Parado (2) = 122
Parado (3) = 117
Parado (4) = 117
Parado (5) = 116

'Andando p/ direita
Movendo (0, 0) = 119
Movendo (0, 1) = 118
Movendo (0, 2) = 120
Movendo (0, 3) = 118

'Andando p/ esquerda
Movendo (1, 0) = 122
Movendo (1, 1) = 121
Movendo (1, 2) = 123
Movendo (1, 3) = 121

'Subindo
Movendo (2, 0) = 124
Movendo (2, 1) = 117
Movendo (2, 2) = 125
Movendo (2, 3) = 117

'Descendo
Movendo (3, 0) = 124
Movendo (3, 1) = 117
Movendo (3, 2) = 125
Movendo (3, 3) = 117

'Caindo
Movendo (4, 0) = 126
Movendo (4, 1) = 126
Movendo (4, 2) = 126
Movendo (4, 3) = 126

'Empurrando p/ direita
Movendo (5, 0) = 128
Movendo (5, 1) = 127
Movendo (5, 2) = 129
Movendo (5, 3) = 127

'Empurrando para esquerda
Movendo (6, 0) = 131
Movendo (6, 1) = 130
Movendo (6, 2) = 132
Movendo (6, 3) = 130

'Morrendo
Movendo (7, 0) = 116
Movendo (7, 1) = 119
Movendo (7, 2) = 117
Movendo (7, 3) = 122

'Usando a picareta
Usando (0, 0) = 133
Usando (0, 1) = 134

'Usando a furadeira p/ direita
Usando (1, 0) = 135
Usando (1, 1) = 136

'Usando a furadeira p/ esquerda
Usando (2, 0) = 137
Usando (2, 1) = 138

LoadBar 10
Sleep 2, 1

'Definição dos comportamentos
'--------------------------------------------------

'Vazio (inclui água)
With Comport (0) 
	.Vazio = 1
	.Sobe = 0
	.Apoia = 0
	.Anda = 2
	.Mata = 0
	.PEmpurra = 3	'Não pode ser empurrado
	.Cai = 0
	.Destroi = 0
	.Som = 1
End With

'Terra (pode ser eliminada)
With Comport (1) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 1
	.Mata = 0
	.PEmpurra = 3
	.Cai = 0
	.Destroi = 1
	.Som = 1
End With

'Parede destrutível
With Comport (2) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 0
	.Mata = 0
	.PEmpurra = 3
	.Cai = 0
	.Destroi = 2
	.Som = 1
End With  

'Parede indestrutível
With Comport (3) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 0
	.Mata = 0
	.PEmpurra = 3
	.Cai = 0
	.Destroi = 0
	.Som = 2
End With

'Escada
With Comport (4) 
	.Vazio = 0
	.Sobe = 1
	.Apoia = 1
	.Anda = 2
	.Mata = 0
	.PEmpurra = 3
	.Cai = 0
	.Destroi = 1
	.Som = 1
End With   

'Diamante
With Comport (5) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 1
	.Mata = 0
	.PEmpurra = 3
	.Cai = 1
	.Destroi = 1
	.Som = 2
End With     

'Pedra
With Comport (6) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 0
	.Mata = 0
	.PEmpurra = 3
	.Cai = 1
	.Destroi = 2
	.Som = 2
End With     

'Carrinho
With Comport (7) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 0
	.Mata = 0
	.PEmpurra = 0
	.Cai = 1
	.Destroi = 1
	.Som = 3
End With 

'Caixa
With Comport (8) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 0
	.Mata = 0
	.PEmpurra = 2
	.Cai = 1
	.Destroi = 2
	.Som = 4
End With  

'Feno
With Comport (9) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 0
	.Mata = 0
	.PEmpurra = 1
	.Cai = 1
	.Destroi = 2
	.Som = 1
End With    

'Item
With Comport (10) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 1
	.Mata = 0
	.PEmpurra = 3
	.Cai = 1
	.Destroi = 1
	.Som = 3
End With  

'Bomba acionada
With Comport (11) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 2
	.Mata = 0
	.PEmpurra = 3
	.Cai = 1
	.Destroi = 0
	.Som = 3
End With   

'Suporte em uso
With Comport (12) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 2
	.Mata = 0
	.PEmpurra = 3
	.Cai = 1
	.Destroi = 1
	.Som = 2
End With    

'Espetos
With Comport (13) 
	.Vazio = 0
	.Sobe = 0
	.Apoia = 1
	.Anda = 2
	.Mata = 1
	.PEmpurra = 3
	.Cai = 0
	.Destroi = 1
	.Som = 2
End With      

LoadBar 15
Sleep 2, 1


'Definição dos tipos de objetos:
'--------------------------------------------------

'Vazio (0):
With TpObjeto (0)
	.Tipo = 0
	.Img  = 0
	.Item = 0
End With

'Terras (1-14):
For f = 0 To 13
	With TpObjeto (f + 1)
		.Tipo = 1
		.Img  = f + 36
		.Item = 0
	End With
Next

'Paredes destrutíveis (15-25):
For f = 0 To 10
	With TpObjeto (f + 15)
		.Tipo = 2
		.Img  = f + 50
		.Item = 0
	End With
Next

'Paredes indestrutíveis (26-37):
For f = 0 To 11
	With TpObjeto (f + 26)
		.Tipo = 3
		.Img  = f + 61
		.Item = 0
	End With
Next

'Escadas (38-39):
For f = 0 To 1
	With TpObjeto (f + 38)
		.Tipo = 4
		.Img  = f + 73
		.Item = 0
	End With
Next

'Diamantes (40-55):
For f = 0 To 15
	With TpObjeto (f + 40)
		.Tipo = 5
		.Img  = f + 75
		.Item = f + 7
	End With
Next

'Pedras (56-63):
For f = 0 To 7
	With TpObjeto (f + 56)
		.Tipo = 6
		.Img  = f + 91
		.Item = 0
	End With
Next

'Carrinhos (64-66):
For f = 0 To 2
	With TpObjeto (f + 64)
		.Tipo = 7
		.Img  = f + 99
		.Item = 0
	End With
Next

'Caixas (67-68):
For f = 0 To 1
	With TpObjeto (f + 67)
		.Tipo = 8
		.Img  = f + 102
		.Item = 0
	End With
Next

'Feno (69-70):
For f = 0 To 1
	With TpObjeto (f + 69)
		.Tipo = 9
		.Img  = f + 104
		.Item = 0
	End With
Next

'Itens para pegar (71-76):
For f = 0 To 5
	With TpObjeto (f + 71)
		.Tipo = 10
		.Img  = f + 106
		.Item = f + 1
    End With
Next

'Bombas em Uso (77-78: Pequena; 79-80: Grande):
For f = 0 To 3
	With TpObjeto (f + 77)
		.Tipo = 11
		.Img  = f + 112
		.Item = 0
	End With
Next

'Suporte em Uso (81):
With TpObjeto (81)
	.Tipo = 12
	.Img  = 236
	.Item = 0
End With

'Espetos (82-84)
For f = 0 To 2
	With TpObjeto(f + 82)
		.tipo = 13
		.img  = 233 + f
		.item = 0
	End With
Next

LoadBar 20
Sleep 2, 1

'Pontos por tesouro
PontoTesouro (7)  = 1
PontoTesouro (8)  = 2
PontoTesouro (9)  = 3
PontoTesouro (10) = 4
PontoTesouro (11) = 5
PontoTesouro (12) = 6
PontoTesouro (13) = 7
PontoTesouro (14) = 8
PontoTesouro (15) = 9
PontoTesouro (16) = 10
PontoTesouro (17) = 12
PontoTesouro (18) = 15
PontoTesouro (19) = 17
PontoTesouro (20) = 20
PontoTesouro (21) = 25
PontoTesouro (22) = 30

'Inicializa MIDI
If midiOutOpen( @hMidiOut, MIDI_MAPPER, 0, 0, CALLBACK_NULL) Then
	Cls
	Draw String (10, 20), TXT (1)
	Draw String (10, 50), TXT (50)
	LimpaTeclado
	If hMidiOut <> 0 Then midiOutClose hMidiOut
	End
End If

LoadBar 25
Sleep 2, 1
'Prepara imagens
Grafx = ImageCreate (800, 440, 0, 32)
Sleep 10, 1
BMP (275) = ImageCreate (448, 444, RGBA (0, 0, 0, 255), 32)
For f = 0 To 79
	Circle BMP (275), (222, 222), 144 - f, RGBA (0, 0, 0, 255 - f * 3.17), , , , f
Next
Circle BMP (275), (222, 222), 64, RGBA (0, 0, 0, 0), , , , f
Carregou = BLoad ("Res\Sprites.bmp", Grafx)
LoadBar 27

'Posições das figuras no arquivo de imagem
'0-184 = fundos, frentes, objetos, bonecos...
For f = 0 To 184
	BMP (f) = ImageCreate (32, 32, 0, 32)
	Put BMP (f), (0,0), GrafX, ((f Mod 25) * 32, Int (f/25) * 32) - Step (31, 31), PSet
Next

LoadBar 30

'185-196 = Explosoes
For f = 0 To 11
	BMP (185 + f) = ImageCreate (32, 32, 0, 32)

	'transparência gradativa
	For G = 0 To 31
		For H = 0 To 31
			CorRGB = Point (320 + F * 32 + G, 224 + H, GrafX)
			If CorRGB = Magenta Then
				PSet BMP(185 + F), (G, H), RGBA (255, 0, 255, 0)
			Else
				PSet BMP(185 + F), (G, H), RGBA (rgba_R(CorRGB), rgba_G(CorRGB), rgba_B(CorRGB), 255 - f * 21)
			End If
		Next
	Next
Next

LoadBar 33

'197 - 208 = Algarismos (fundo opaco)
For f = 0 To 11
	BMP (197 + f) = ImageCreate (10, 15, 0, 32)
	Put BMP (197 + f), (0,0), GrafX, (f * 10 + 672, 256) - Step (9, 14), PSet
Next

LoadBar 35

'209 = Medidor do oxigênio
BMP (209) = ImageCreate (100, 16, 0, 32)
Put BMP (209), (0,0), GrafX, (672, 272) - (771, 287), PSet

'210 = Barra de informações - (210)
BMP (210) = ImageCreate (800, 56, 0, 32)
Put BMP (210), (0,0), GrafX, (0, 352) - (799, 407), PSet

'211 = Logo do Jogo (211)
BMP (211) = ImageCreate (220, 96, 0, 32)
Put BMP (211), (0,0), GrafX, (0, 256) - (219, 351), PSet

'212 = Game over (212)
BMP (212) = ImageCreate (128, 64, 0, 32)
Put BMP (212), (0,0), GrafX, (672, 288) - (799, 351), PSet

'213 - 237 = Agua (213 a 237); espetos (233-235); suporte em uso (236); fundo para água (237)
For f = 0 To 24
	BMP (213 + f) = ImageCreate (32, 32, 0, 32)
	Put BMP (213 + f), (0,0), GrafX, (F * 32, 408) - Step (31, 31), PSet
Next

'238 = Setinhas: vermelha, laranja, amarela, verde e azul
BMP (238) = ImageCreate (58, 15, 0, 32)			
Put BMP (238), (0, 0), Grafx, (7, 385) - (64, 399), PSet

LoadBar 40

'239 - 246 = Números (esmaecendo)
For F = 0 To 7
	BMP (239 + f) = ImageCreate (90, 15, 0, 32)			
	For H = 0 To 89
		For I = 0 To 14
			CorRGB = (Point (288 + H, 320 + I, GrafX) And 255) * (1 - F * .1)
			PSet BMP (239 + f), (H, I), RGBA (255, 255, 0, CorRGB)
		Next
	Next
Next

LoadBar 45

'247 = Fonte (LETRAS)

Grafx2 = ImageCreate(LargArqFonte, 23, 0, 32)
BMP (247)= ImageCreate(LargArqFonte, 22, 0, 32)
Carregou = BLoad ("Res\Fonte.bmp", Grafx2)

h=0
PosLetra (0,0) = 0
For g = 0 To LargArqFonte - 1
	For f = 0 To 21
		CorRGB = Point (g, f, grafx2) And 255
		PSet BMP (247), (g, f), RGBA (255, 255, 255, CorRGB)
	Next           
	If (point(g, 22, Grafx2) and 1) = 0 then
		PosLetra (h, 1)= G
		h += 1
		If g < LargArqFonte - 1 Then PosLetra (h, 0) = g + 1
	end if
Next

LoadBar 50

'248 - 251 = Quadros para mensagem
For h = 0 To 3
	BMP (248 + h) = ImageCreate (64, 64, 0, 32)
	For F = 0 To 63
		For G = 0 To 63
			CorRGB = Point (288 + h * 64 + F, 256 + G, GrafX)
			If CorRGB = Magenta Then
				PSet BMP (248 + h), (F, G), RGBA (255, 0, 255, 0)
			Else
				PSet BMP (248 + h), (F, G), RGBA (rgba_R(CorRGB), rgba_G(CorRGB), rgba_B(CorRGB), 192)
			End If
		Next
	Next
Next

LoadBar 55

'252 = FreeBasic's HORSE
BMP (252) = ImageCreate (59, 47, 0, 32)
Put BMP(252), (0, 0), grafx, (225,256) - (283,302), PSet

'Objetos de frente
For H = 25 To 36
	For G = 0 To 31
		For F = 0 To 31
			CorRGB = Point (F, G, BMP (H))
			If CorRGB = Magenta Then
				PSet BMP (H), (F, G), RGBA (255, 0, 255, 0)
			Else
				If H < 32 Then
					PSet BMP (H), (F, G), RGBA (rgba_R(CorRGB), rgba_G(CorRGB), rgba_B(CorRGB), 191)
				Else
					PSet BMP (H), (F, G), RGBA (rgba_R(CorRGB), rgba_G(CorRGB), rgba_B(CorRGB), 127)
				End If
			End If
		Next
	Next
Next

LoadBar 60

For h = 0 To 5
	BMP (253 + h) = ImageCreate (42, 48, 0, 32)
	Put BMP(253 + H), (0, 0), GrafX, (544 + (h Mod 3) * 42, 256 + (Int (h/3) * 48)) - Step (41, 47), PSet
Next

For F= 259 To 273
	BMP (F) = ImageCreate (32, 32, 0, 32)
Next

LoadBar 65

For f = 0 To 4
	Put BMP (264 + F), (0, 0), GrafX, (378 + F * 32, 320) - Step (31, 31), PSet
	For g = 0 To 31
		Put BMP (269 + f), (g, 0), GrafX, (409 + F * 32 - G, 320) - Step (0, 31), PSet
		For h = 0 To 31
			PSet BMP (259 + F), (31 - H, G), Point (378 + F * 32 + G, 320 + H, GrafX)
		Next
	Next
Next

LoadBar 70

'Números pequenos para o editor
BMP (274) = ImageCreate (60, 8, 0, 32)
Put BMP (274), (0, 0), GrafX, (288, 335) - (347, 342), PSet

ImageDestroy GrafX

LoadBar 75

'Imagens do Menu
BMP (276) = ImageCreate (630, 128, 0, 32)
GrafX = ImageCreate (723, 128, 0, 32)
Carregou = BLoad ("Res\Menu.bmp", GrafX)
Put BMP (276), (0,0), GrafX, (0, 0) - (629, 127), PSet
BMP (277) = ImageCreate (96, 96, 0, 32)

'Imagens do menu do editor
BMP (278) = ImageCreate (73, 19, RGBA(255, 0, 255, 0), 32)
For f = 0 To 3
	Line bmp (278), (3 - f, f) - (69 +  f, 18 - f), RGBA (0, 0, 0, 255), b
Next

LoadBar 80

Line bmp (278), (4, 4) - (68, 14), RGBA (0, 0, 0, 64), Bf
BMP (279) = ImageCreate (611, 21, RGBA (255, 0, 255, 0), 32)
Line bmp (279), (0,0) - (22, 20), RGB (128, 128, 128), b
Line bmp (279), (23,0) - (45, 20), RGB (128, 128, 128), b
Line bmp (279), (46,0) - (564, 20), RGB (128, 128, 128), b
Line bmp (279), (565,0) - (587, 20), RGB (128, 128, 128), b
Line bmp (279), (588,0) - (610, 20), RGB (128, 128, 128), b
Put bmp (279), (3, 2), GrafX, (688, 66) - (703, 82), PSet
Put bmp (279), (30, 2), GrafX, (695, 66) - (703, 82), PSet
Put bmp (279), (572, 2), GrafX, (677, 66) - (685, 82), PSet
Put bmp (279), (592, 2), GrafX, (677, 66) - (692, 82), PSet
Line bmp (279), (48, 4) - (562, 17), RGBA (255, 255, 255, 255), B
Line bmp (279), (48, 4) - (561, 16), RGBA (128, 128, 128, 255), B
Line bmp (279), (49, 5) - (52, 16), RGBA (255, 255, 0, 255), BF
Line bmp (279), (53, 5) - (152, 16), RGBA (80, 160, 160, 255), BF
Line bmp (279), (153, 5) - (208, 16), RGBA (185, 106, 106, 255), BF
Line bmp (279), (209, 5) - (561, 16), RGBA (100, 180, 100, 255), BF

LoadBar 85

BMP (280) = ImageCreate (187, 56, RGBA (255, 0, 255, 0), 32)
For F = 0 To 1
	For g = 0 To 1
		Line bmp (280), (g * 27, F * 28) - Step (26, 27), RGBA (96, 96, 96, 255), B
		Put bmp (280), (2 + g * 27, 3 + F * 28), GrafX, (631 + G * 23, f * 23)- Step (22, 22), PSet
	Next
	For g = 0 To 2
		Line bmp (280), (106 + g * 27, F * 28) - Step (26, 27), RGBA (96, 96, 96, 255), B
		Put bmp (280), (108 + g * 27, 3 + F * 28), GrafX, (631 + F * 23, 46 + G * 23)- Step (22, 22), PSet
	Next
Next
Line bmp (280), (54, 0) - Step (51, 55), RGBA (0, 0, 0, 255), B
Line bmp (280), (55, 0) - Step (49, 55), RGBA (128, 128, 128, 255), B
'Line bmp (280), (56, 1) - step (47, 53), rgba (160, 160, 160, 255), BF
Put bmp (280), (57, 3), Grafx, (677, 0) - (722, 49), PSet
BMP (281) = ImageCreate (46, 16, RGBA (192, 192, 192, 255), 32)
Put bmp (281), (0, 0), grafX, (677, 50) - (722, 65), PSet

ImageDestroy GrafX
LoadBar 90

'Hilight do menu
Sleep 10, 1
For F=0 To 15
	Circle BMP (277), (f + 15, f + 15), 15, RGBA(64, 255, 64, f * 16), , , , f
	Circle BMP (277), (f + 15, 80 - f), 15, RGBA(64, 255, 64, f * 16), , , , f
	Circle BMP (277), (80 - f, f + 15), 15, RGBA(64, 255, 64, f * 16), , , , f
	Circle BMP (277), (80 - f, 80 - f), 15, RGBA(64, 255, 64, f * 16), , , , f
	Line BMP (277), (16 + f, f) - (79 - f, 95 - f), RGBA(64, 255, 64, f * 16), bf
	Line BMP (277), (f , 16 + f) - (95 - f, 79 - f), RGBA(64, 255, 64, f * 16), bf
Next

LoadBar 95

'Sons: feno caindo:
Som (1, 1).COn1 = &H76c0 : Som (1, 1).COn2 = &H6f3490: Som (1, 1).COff = &H6f3480	'Ok Sobre terra, feno, tijolo ou escada
Som (1, 2).COn1 = &H76c0 : Som (1, 2).COn2 = &H6f2d90: Som (1, 2).COff = &H6f2d80	'Ok Sobre parede indestr., pedra, tesouro, suporte, espeto
Som (1, 3).COn1 = &H76c0 : Som (1, 3).COn2 = &H6f3b90: Som (1, 3).COff = &H6f3b80	'Ok Sobre carro, item, bomba
Som (1, 4).COn1 = &H75c0 : Som (1, 4).COn2 = &H6f3f90: Som (1, 4).COff = &H6f3f80	'Ok Sobre caixa	

'Sons: pedra, tesouro ou suporte caindo:
Som (2, 1).COn1 = &H7fc1 : Som (2, 1).COn2 = &H774391: Som (2, 1).COff = &H774381	'Ok Sobre terra, feno, tijolo ou escada	
Som (2, 2).COn1 = &H7fc1 : Som (2, 2).COn2 = &H774491: Som (2, 2).COff = &H774481	'Ok Sobre parede indestr., pedra, tesouro, suporte, espeto
Som (2, 3).COn1 = &H7fc1 : Som (2, 3).COn2 = &H774591: Som (2, 3).COff = &H774581	'Ok Sobre carro, item, bomba
Som (2, 4).COn1 = &H7fc1 : Som (2, 4).COn2 = &H774691: Som (2, 4).COff = &H774681	'Ok Sobre caixa

'Sons: carro, item ou bomba caindo:
Som (3, 1).COn1 = &H2fc2 : Som (3, 1).COn2 = &H7f4c92: Som (3, 1).COff = &H7f4c82	'Ok Sobre terra, feno, tijolo ou escada
Som (3, 1).COn1 = &H2fc2 : Som (3, 2).COn2 = &H7f4892: Som (3, 2).COff = &H7f4882	'Ok Sobre parede indestr., pedra, tesouro, suporte, espeto
Som (3, 1).COn1 = &H2fc2 : Som (3, 3).COn2 = &H7f4392: Som (3, 3).COff = &H7f4382	'Ok Sobre carro, item, bomba	
Som (3, 1).COn1 = &H2fc2 : Som (3, 4).COn2 = &H7f3c92: Som (3, 4).COff = &H7f3c82	'Ok Sobre caixa	

'Sons: caixa caindo:
Som (4, 1).COn1 = &H73c3 : Som (4, 1).COn2 = &H7f3c93: Som (4, 1).COff = &H7f3c83	'Ok Sobre terra, feno, tijolo ou escada	
Som (4, 2).COn1 = &H73c3 : Som (4, 2).COn2 = &H7f4393: Som (4, 2).COff = &H7f4383	'Ok Sobre parede indestr., pedra, tesouro, suporte, espet
Som (4, 3).COn1 = &H73c3 : Som (4, 3).COn2 = &H7f4093: Som (4, 3).COff = &H7f4083	'Ok Sobre carro, item, bomba
Som (4, 4).COn1 = &H73c3 : Som (4, 4).COn2 = &H7f3893: Som (4, 4).COff = &H7f3883	'Ok Sobre caixa		

'Sons: furadeira
Som (5, 1).COn1 = &H7cc4 : Som (5, 1).COn2 = &H7f5994: Som (5, 1).COff = &H7f5984	'Ok Furando feno ou tijolo	
Som (5, 2).COn1 = &H7cc4 : Som (5, 2).COn2 = &H7f5a94: Som (5, 2).COff = &H7f5a84	'Ok Furando pedra ou tesouro
Som (5, 3).COn1 = &H7cc4 : Som (5, 3).COn2 = &H7f5b94: Som (5, 3).COff = &H7f5b84	'Ok Furando carro ou item
Som (5, 4).COn1 = &H7cc4 : Som (5, 4).COn2 = &H7f5c94: Som (5, 4).COff = &H7f5c84	'Ok Furando caixa

'Sons: picareta5
Som (6, 1).COn1 = &H7fc5 : Som (6, 1).COn2 = &H7f5795: Som (6, 1).COff = &H7f5785	'Furando feno ou tijolo
Som (6, 2).COn1 = &H7fc5 : Som (6, 2).COn2 = &H7f5695: Som (6, 2).COff = &H7f5685	'Furando pedra ou tesouro
Som (6, 3).COn1 = &H7fc5 : Som (6, 3).COn2 = &H7f5595: Som (6, 3).COff = &H7f5585	'Furando carro ou item
Som (6, 4).COn1 = &H7fc5 : Som (6, 4).COn2 = &H7f5495: Som (6, 4).COff = &H7f5485	'Furando caixa

'Sons: Explosões
SomEx (1).COn1 = &H7fc6 : SomEx (1).COn2 = &H7f3296: SomEx (1).COff = &H7f3286	'Ok Explosao bomba pequena
SomEx (2).COn1 = &H7fc6 : SomEx (2).COn2 = &H7f2f96: SomEx (2).COff = &H7f2f86	'Ok Explosao bomba grande
SomEx (3).COn1 = &H7fc6 : SomEx (3).COn2 = &H7f2396: SomEx (3).COff = &H7f2386	'Ok Explosao boneco
SomEx (4).COn1 = &H72c6 : SomEx (4).COn2 = &H6f4096: SomEx (4).COff = &H6f4086	'Ok pega item
SomEx (5).COn1 = &H72c6 : SomEx (5).COn2 = &H5f4896: SomEx (5).COff = &H5f4886	'Ok Pega tesouro
SomEx (6).COn1 = &H15c6 : SomEx (6).COn2 = &H6f2996: SomEx (6).COff = &H6f2986	'Ok Dame
SomEx (7).COn1 = &H7ec6 : SomEx (7).COn2 = &H6f4196: SomEx (7).COff = &H6f4186	'Ok Empurrando

'---------------------------------------------------
LeMinaIn 0, 1

LoadBar 100
Sleep 2, 1

Jogo.NumVidas = 2
If FileExists("Config.min") Then
	Open "Config.min" For Binary As #1
	Get #1, , Jogo.Volume
	Get #1, , Jogo.MaxAlcancada
	Close #1
Else
	Jogo.Volume   = 64
	Jogo.MaxAlcancada = 1
End If
If Jogo.MaxAlcancada < 1 Then Jogo.MaxAlcancada = 1
If Jogo.Volume < 0 Or jogo.Volume > 127 Then Jogo. Volume = 64

midiOutSetVolume(0, (jogo.volume Shl 9) Or (jogo.volume Shl 1))

'FPS / velocidade
Jogo.Passos = 8
Jogo.DelayMSec = 33
Jogo.TamanhoPasso = 4   'pixels

'Le recordes
LeTopDez
ConfirmDel = 0

'Inicia parâmetros
IniciaJogo
IniciaVida
LimpaMina
MudaStatus NoMenu
TmpSleep = 25
Sleep 20, 1
Quadros = 0
UltQuadros = 0
Timer1 = Timer

Cls

ScreenSet 0, 1
ScrAtiva=0

'-----------------------------------------
'Chama o ciclo Principal
'-----------------------------------------

Joga

'-----------------------------------------
'Encerra o Programa
'-----------------------------------------

'Libera canais de som e memória alocada para imagens
If hMidiOut <> 0 Then midiOutClose hMidiOut
For f= 0 To 277
	ImageDestroy BMP (f)
Next


End		

'*****************************************
'*****************************************
'*****************************************
'Procedimentos e Funções
'*****************************************
'*****************************************
'*****************************************


'-------------------------------------------------------------------------------------------

'Desenha o fundo de listras coloridas dos menus, pausa, etc.

Sub DesFundo
Dim F as integer
	cRed = (Cred + 2) Mod 256
	For F = 0 To 119
		CRed2 = (cred + f) Mod 256
		If CRed2 > 127 Then CRed2 = 255 - cred2
		Line (0, f * 5) - (799, f * 5 + 9), RGB(cred2 * VRed, cred2 * VGreen, Cred2 * VBlue), bf
	Next
End Sub

'-------------------------------------------------------------------------------------------

'Desenha a barra indicando a carga do programa

Sub LoadBar (perc As Integer)
	Line (25,525) - (25 + perc * 7.51,549), RGB(127,127,255),bf
	Sleep 2, 1
End Sub


'-------------------------------------------------------------------------------------------

'Desenha a tela

Sub Desenha

	'Declaração de variáveis locais
	Dim As Integer XR, YR, X1, Y1, X1R, Y1R, BonecoR, Agua0, DF1, DF2, DG1, DG2, FigPt, F, G, H, I
	Dim As Integer TRX, TRY, TRXa, TRYa, Explodindo
	
	'Verifica se há explosão, para tremer a imagem
	For f=0 To 10
		If explosao(f).tipo > 0 And explosao(f).tempo < 10 Then explodindo = 1
	Next
	
	'Calcula que parte da tela deve ser mostrada
	If (Jogo.Status = ModoMapa) Or (jogo.status = Top10) Or (Jogo.Status = Editor) Then
		TRX  = MapX
		TRY  = MapY
		TRXa = 0
		TRYa = 0
		
	Else 
		With Boneco
			'Calcula o X inicial da tela
			If Mina.Larg < 25 Or .X < 12 Then
				TRX  = 0
				TRXa = 0
			ElseIf .X > Mina.Larg - 12 Then
				TRX  = Mina.LArg - 24
				TRXa = 0
			ElseIf .DirAtual = 1 Then
				TRX  = .X - 12
				TRXa = -.Passo * Jogo.TamanhoPasso
			ElseIf .DirAtual = 2 Then
				TRX  = .X - 13
				TRXa = (.Passo - Jogo.Passos) * Jogo.TamanhoPasso
			Else	
				TRX  = .x - 12
				TRXa = 0
			End If
			
			If .X = 12 And .DirAtual = 2 Then
				TRX  = 0
				TRXa = 0
			End If  
			
			If .x = Mina.Larg - 12 And .DirAtual = 1 Then TRXa = 0
			
			'Calcula o Y inicial da tela
			If Mina.ALT < 17 Or .Y < 8 Then
				TRY  = 0
				TRYa = 0
			ElseIf .Y > Mina.ALT - 8 Then
				TRY  = Mina.ALT - 16
				TRYa = 0
			ElseIf .DirAtual > 3 Then
				TRY  = .Y - 8
				TRYa = -.Passo * Jogo.TamanhoPasso
			ElseIf .DirAtual = 3 Then
				TRY  = .Y - 9
				TRYa = (.Passo - Jogo.Passos) * Jogo.TamanhoPasso
			Else	
				TRY  = .Y - 8
				TRYa = 0
			End If
			
			If .Y = 8 And .DirAtual = 3 Then
				TRY  = 0
				TRYa = 0
			End If  
			
			If .Y = Mina.ALT - 8 And .DirAtual > 3 Then TRYa = 0
			
		End With                                           
	End If

	If (mina.noturno = 0) Or (Jogo.Status = Editor) Then
		df1 = 0
		df2 = 25
		dg1 = 0
		dg2 = 17
	Else
		'Limpa tela (desnecessário se não for no modo noturno, pois toda a tela é redesenhada)
		Cls
		df1 = boneco.x - trx - 5
		df2 = boneco.x - trx + 5
		dg1 = boneco.y - try - 5
		dg2 = boneco.y - try + 5
		If df1 < 0  Then df1 = 0
		If df2 > 25 Then df2 = 25
		If dg1 < 0  Then dg1 = 0
		If dg2 > 17 Then dg2 = 17
	End If

	'Grupo de imagens do boneco
	If Boneco.NoOxigenio = 0 Then
		BonecoR = Jogo.Player * 46
	Else                    
		BonecoR = 23
	End If

	If Explodindo > 0 Then
		TRXA = trxa + Rnd * 11 - 5
		trya = TRYA + Rnd * 11 - 5
	ElseIf jogo.status = VenceuJogo Then
		TRXA = trxa + Rnd * 3 - 1
		trya = TRYA + Rnd * 3 - 1
	End If

	'Inicia o desenho
	'----------------

	'Desenha imagens do fundo (layer 0, pset) 
	For f = df1 To df2
		For g = dg1 To dg2
			If fundo (TRX + f, TRY + g) > 0 Then
				Put (TRXa + f * 32, TRYa + g * 32), BMP (fundo (TRX + f, TRY + g)),PSet
			Else
				Put (TRXa + F * 32, TRYa + g * 32), BMP (237), PSet
			End If
		Next
	Next
	
	'Desenha os Objetos sobre o fundo (layer 1, trans)
	If (Jogo.Status <> Editor) Or (EdShow =1 Or EdShow = 2) Then
		For f = df1 To df2
			For g = dg1 To dg2
				XR = 0
				YR = 0
				'Calcula posição de objeto caindo 
				If objeto (TRX + f,TRY + g).caindo = 1 Then 
					YR = Objeto(TRX + f,TRY + g).Passo * Jogo. TamanhoPasso
				Else
					'Calcula posição de objeto empurrado
					Select Case objeto (TRX + f,TRY + g).Empurrando
					Case 1
						XR = Objeto (TRX + f,TRY + g).Passo * Jogo. TamanhoPasso
					Case 2
						XR = -Objeto (TRX + f,TRY + g).Passo * Jogo. TamanhoPasso
					End Select
				End If
				'Desenha o objeto na sua posição
				Put (TRXa + f * 32 + XR, TRYa + g * 32 + YR), BMP (TpObjeto (Objeto (TRX + F,TRY + G).tp).Img), Trans
			Next
		Next
	End If
	
	'Desenha o boneco (layer 1, trans)
	If Jogo.Status <> VenceuJogo And Jogo.Status <> Top10 And JOGO.STATUS <> GameOver And BONECO.MORREU = 0 Then
		
		'Calcula Posição
		With Boneco
			
			'Escolhe imagem
			'Picareta
			If jogo.Status = Editor Then
				.Img = Parado (0)
				.ImgX = .x * 32
				.ImgY = .y * 32
			Else
				If .NaPicareta > 0 Then
					.Img = Usando(0, .NaPicareta Mod 2) + BonecoR 
					Put (TRXa + .ImgX - (TRX * 32), TRYa + .ImgY - (TRY * 32)+ 32), BMP (259 + Int((.NaPicareta / Jogo.Passos) * 2.35)), Trans
					
				'Furadeira
				ElseIf .NaFuradeira>0 Then
					.img = Usando (.DirFuradeira, .NaFuradeira Mod 2) + BonecoR
					If .DirFuradeira = 1 Then
						Put (TRXa + .ImgX - (TRX * 32) + 32, TRYa + .ImgY - (TRY * 32)), BMP (264 + Int((.NaFuradeira / Jogo.Passos) * 2.35)), Trans
					Else
						Put (TRXa + .ImgX - (TRX * 32) - 32, TRYa + .ImgY - (TRY * 32)), BMP (269 + Int((.NaFuradeira / Jogo.Passos) * 2.35)), Trans
					End If
					
				'Parado
				ElseIf .DirAtual = 0 Then
					.img = Parado (.UltDir) + BonecoR 
					
				'Movendo-se
				Else
					.img = Movendo (.diratual + (.empurrando * 5) - 1, .passo Mod 4) + BonecoR 
				End If
				
				'Ajusta posição conforme movimento
				Select Case .DirAtual
				Case 1 'Direita
					.ImgX = .x * 32 + (.Passo * Jogo.TamanhoPasso)
				Case 2 'Esquerda
					.ImgX = .x * 32 - (.Passo * Jogo.TamanhoPasso)
				Case 3 'Subindo
					.imgY = .y * 32 - (.Passo * Jogo.TamanhoPasso)
				Case 4, 5 'Descendo / Caindo
					.imgY = .y * 32 + (.Passo * Jogo.TamanhoPasso)
				Case Else
					.ImgX = .x * 32
					.ImgY = .y * 32
				End Select
			End If
			
			'Desenha
			Put (TRXa + .ImgX - (TRX * 32), TRYa + .ImgY - (TRY * 32)), BMP (.Img), Trans
		End With	
	End If

	'Desenha objetos da frente (layer 3, trans)
	If (jogo.status <> Top10) And (Jogo.Status <> Editor Or EdShow >=2) Then
		For f = df1 To df2
			For g = dg1 To dg2
				If frente (TRX + f,TRY + g) > 0 Then
					Put (TRXa + f * 32, TRYa + g * 32), BMP (frente (TRX + f, TRY + g) + 24), Alpha
				End If
			Next
		Next
	End If

	'Desenha água (layer 4, Alpha 95)
	Agua0 = (Jogo.seqciclo * 13) Mod 20
	For f = df1 To df2
		For g = dg1 To dg2
			'Desenha, se o fundo for água (0)
			If fundo (TRX + f, TRY + g) = 0 Then
				Put (TRXa + f * 32, TRYa + g * 32), BMP (213 + (Agua0 + F + g * 6) Mod 20), Alpha, 95
			End If
		Next
	Next

	'Desenha Lanterna (layer 5, Alpha variável)
	If Jogo.Status <> Editor Then
		If mina.noturno = 1 Then
			Put (TRXa + boneco.ImgX - (TRX * 32) - 208, TRYa + boneco.ImgY - (TRY * 32) - 208), BMP (275), (0, 0) - (443, 443), Alpha
		End If
		
		'Desenha explosões (layer 6, trans)
		For f = 0 To 10
			With Explosao(f)
				
				If .tipo > 0 Then
					For G = (.Tipo = 2) To - (.Tipo = 2)
						For H = -1 To 1
							Put(TRXa + (.x - TRX + H) * 32, TRYa + (.y - TRY + G) * 32), BMP (185 + Int(.tempo / 3)), Alpha
						Next
					Next
				Else
					.Tempo = 0
				End If
				
				'Incrementa contador
				.tempo += 1
				If .tempo >= 35 Then
					.tempo = 0
					.tipo  = 0
				EndIf
			End With
		Next
		
		'Mensagens de pontos na tela
		For I = 0 To 9
			With Msg (I)
				If .Ciclo > 0 Then
					EscrevePT (.Pontos, TRXa + (.X -TRX) * 32 + 16, TRYa + (.Y - TRY) * 32 - 12 + Int(.Ciclo/4), Int((127 - .Ciclo) / 16))
					.Ciclo -= 1
				End If
			End With
		Next
	Else
		Select Case edgrid
		Case 6, 7
			For f=0 To 23
				Line(f*32+32,0)-(f*32+32,543),RGB(255,0,255)
			Next
			For f=0 To 15
				Line(0,f*32+32)-(799,f*32+32),RGB(255,0,255)
			Next
		Case 2, 3
			For f=0 To 23
				Line(f*32+32,0)-(f*32+32,543),RGB(255,255,255)
			Next
			For f=0 To 15
				Line(0,f*32+32)-(799,f*32+32),RGB(255,255,255)
			Next
		Case 0, 1
			For f=0 To 23
				Line(f*32+32,0)-(f*32+32,543),RGB(31,31,31)
			Next
			For f=0 To 15
				Line(0,f*32+32)-(799,f*32+32),RGB(31,31,31)
			Next
		End Select
		

		If edgrid Mod 2 = 0 Then
			For f=0 To 24
				EscreveNumeroPeq (MapX + f, 11+f*32,0)
			Next
			For f=0 To 16
				EscreveNumeroPeq (Mapy + f, 0, 11+f*32)
			Next
		End If
		
	End If
	
	If Jogo.Status <> Editor Then
		'Desenha a barra inferior
		Put (0, 544), BMP (210), PSet
		
		With Boneco
			
			'Pontuação
			EscreveNumero .Pontos, 6, 7, 577, 0
			
			'Núm. mina
			'If Jogo.Status <> ModoDemo Then
				EscreveNumero .Mina, 3, 96, 577, 0
			'end if
			
			'Oxigenio
			Put( 151, 576), BMP (209), (0, 0) - Step (.Oxigenio, 15), PSet
			
			'Qtde Itens Garrafa de Oxigenio
			EscreveNumero .ItOxigenio, 1, 296, 575, 0
			
			'Qtde Itens Suporte Pedra
			EscreveNumero .ItSuporte, 1, 347, 575, 0
			
			'Qtde Itens Picareta
			EscreveNumero .ItPicareta, 1, 393, 575, 0
			
			'Qtde Itens Furadeira
			EscreveNumero .ItFuradeira, 1, 445, 575, 0
			
			'Qtde Itens Bombinha
			EscreveNumero .ItBombinha, 1, 489, 575, 0
			
			'Qtde Itens Bombona
			EscreveNumero .ItBombona, 1, 532, 575, 0
					
			'Quantidade de pedras a recolher
			EscreveNumero Mina.Tesouros, 2, 550, 575, 0         
			
			'Vidas
			EscreveNumero .Vidas, 2, 582, 576, 0
			
		End With
		
		'Tempo Maximo
		If Mina.Tempo > 0 Then
			EscreveNumero Int(mina.Tempo/60), 2, 655,556, 1
			EscreveNumero Mina.Tempo Mod 60, 2, 683,556, 1
			If mina.tempo - boneco.tempo >= 20 Or Jogo.Status <> Jogando Then
				Put (642, 578), BMP(238), (48, 0) - Step (9, 14), Trans
			Else
				If (jogo.seqciclo Mod 2 = 1) Or (jogo.status = VenceuJogo) Then Put (642, 578), BMP (238), (Int ((mina.tempo - boneco.tempo) / 5) * 12, 0) - Step (9, 14), Trans
			End If
		End If
		If jogo.seqciclo Mod 2 = 1 And boneco.morreu = 0 And iniciado > 0 And jogo.status <> VenceuJogo Then
			Line (679, 582) - (680, 590), Point (679, 581), bf
		End If
		EscreveNumero Int(Boneco.Tempo / 60), 2, 655, 578, 1
		EscreveNumero Boneco.Tempo Mod 60, 2, 683, 578, 1
		
		If Jogo.Status = ModoDemo Then
			DemoCiclo = DemoCiclo + 1
			Select Case MensDemo
			Case 1
				EscreveCentro TXT(11), 430, 1, 0
				EscreveCentro TXT(12), 460, 1, 0
			Case 2
				EscreveCentro TXT(13), 445, 1, 0
			Case 3
				EscreveCentro TXT(14), 430, 1, 0
				EscreveCentro TXT(15), 460, 1, 0
			Case 4
				EscreveCentro TXT(16), 430, 1, 0
				EscreveCentro TXT(17), 460, 1, 0
			Case 5
				EscreveCentro TXT(18), 445, 1, 0
			Case 6
				EscreveCentro TXT(19), 430, 1, 0
				EscreveCentro TXT(20), 460, 1, 0
			Case 7
				EscreveCentro TXT(21), 430, 1, 0
				EscreveCentro TXT(22), 460, 1, 0
			Case 8
				EscreveCentro TXT(23), 445, 1, 0
			Case 9
				EscreveCentro TXT(24), 445, 1, 0
			Case 10
				EscreveCentro TXT(25), 430, 1, 0
				EscreveCentro TXT(26), 460, 1, 0
			Case 11
				EscreveCentro TXT(27), 430, 1, 0
				EscreveCentro TXT(28), 460, 1, 0
			Case 12
				EscreveCentro TXT(29), 430, 1, 0
				EscreveCentro TXT(30), 460, 1, 0
			Case 13
				EscreveCentro TXT(31), 430, 1, 0
				EscreveCentro TXT(32), 460, 1, 0
			Case 14
				EscreveCentro TXT(33), 430, 1, 0
				EscreveCentro TXT(34), 460, 1, 0
			Case 15
				EscreveCentro TXT(35), 430, 1, 0
				EscreveCentro TXT(36), 460, 1, 0
			Case 16
				EscreveCentro TXT(37), 430, 1, 0
				EscreveCentro TXT(38), 460, 1, 0
			Case 17
				EscreveCentro TXT(39), 430, 1, 0
				EscreveCentro TXT(40), 460, 1, 0
			Case 18
				EscreveCentro TXT(41), 445, 1, 0
			Case 19
				EscreveCentro TXT(42), 430, 1, 0
				EscreveCentro TXT(43), 460, 1, 0
			Case 20
				EscreveCentro TXT(44), 430, 1, 0
				EscreveCentro TXT(45), 460, 1, 0
			Case 21
				EscreveCentro TXT(46), 430, 1, 0
				EscreveCentro TXT(47), 460, 1, 0
			Case 22
				EscreveCentro TXT(48), 430, 1, 0
				EscreveCentro TXT(49), 460, 1, 0
				For F = 0 To 4
					Line (480 + f, 480)-(533 + f, 533), &HFFA000
					Line (515, 529 + f)-(533, 529 + f), &HFFA000
					Line (533 + f, 515)-(533 + f, 533), &HFFA000
				Next
			End Select
		End If
	Else
	
		Line (0, 543) - (799, 543), &H000000
		
		Select Case Jogo.EdStatus
		Case Editando
			Line (1, 545) - (609, 563), &HA0A0A0, BF
			Line (0, 565) - (610, 599), &H000000, BF
			Line (611, 544) - (611, 599), &H606060
			Line (612, 544) - (612, 599), &H000000
			Line (614, 545) - (798, 598), &HA0A0A0, BF
			Line (667 , 544) - (667 , 599), &H000000
			Line (718 , 544) - (718 , 599), &H000000
			
			Select Case PosMouse
			Case EdForaTela
				'Nada a fazer
			Case EdTela
				Dlinha EDX1 * 32 - 3, EDY1 * 32 - 3, EDX1 * 32 + 34, EDY1 * 32 + 34, 0
			Case EdInicio
				Line (1, 545) - (21, 563), &HFFFFFF, BF
			Case EdEsquerda
				Line (24, 545) - (44, 563), &HFFFFFF, BF
			Case EdDireita
				Line (565, 545) - (585, 563), &HFFFFFF, BF
			Case EdFim
				Line (588, 545) - (608, 563), &HFFFFFF, BF
			Case EdBarra
				Line (47, 545) - (563, 563), &HFFFFFF, BF
			Case EdItem
				Line (Int (MouseX / 34) * 34 - 1, 565) - Step (35, 34), &HFFFFFF, BF
			Case EdNovo
				Line (614, 545) - (638, 570), &HFFFFFF, BF
			Case EdAbre
				Line (641, 545) - (665, 570), &HFFFFFF, BF
			Case EdMove
				Line (614, 573) - (638, 598), &HFFFFFF, BF
			Case EdSalva
				Line (641, 573) - (665, 598), &HFFFFFF, BF
			Case EdVisao
				Line (669, 545) - (716, 598), &HFFFFFF, BF
			Case EdMudaGrid
				Line (720, 545) - (744, 570), &HFFFFFF, BF
			Case EdApaga
				Line (747, 545) - (771, 570), &HFFFFFF, BF
			Case EdTesta
				Line (774, 545) - (798, 570), &HFFFFFF, BF
			Case EdUndo
				Line (720, 573) - (744, 598), &HFFFFFF, BF
			Case EdRedo
				Line (747, 573) - (771, 598), &HFFFFFF, BF
			Case EdEXIT
				Line (774, 573) - (798, 598), &HFFFFFF, BF
			End Select
			
			'se mouse estiver sobre qualquer área, fazer um hilight em amarelo ou verde
			Put (0, 544), bmp (279), Trans
			'calcula posiçao da barra e mostra:
			Put (46 + Primeiroitem * 4.48, 545), BMP (278), Alpha
			Put (613, 544), BMP(280), Trans
			
			If ItemSel >= PrimeiroItem And ItemSel <= PrimeiroItem + 17 Then
				Line (Int (ItemSel - PrimeiroItem) * 34 - 1, 565) - Step (35, 34), &H40ff40, BF
			End If
			
			For f = 0 To 17
				DesenhaItem f * 34 + 1, 568, PrimeiroItem + F
			Next
						
			If EdShow = 0 Or Edshow = 1 Then Put (670, 547), Bmp (281), Trans
			If EdShow = 0 Or Edshow = 3 Then Put (670, 564), Bmp (281), Trans
			
		Case Selecionando
			DesBox 24, 1, 4, 400, 572
			EscreveCentro TXT(109), 562
			Dlinha EDXX1 * 32 - 3, EDYY1 * 32 - 3, EDXX2 * 32 + 34, EDYY2 * 32 + 34, 1
		Case EdMovendo
			DesBox 24, 1, 4, 400, 572
			EscreveCentro TXT(110), 562
		Case Apagando0, Apagando1
			DesBox 24, 1, 4, 400, 572
			EscreveCentro TXT(111), 562
			If Jogo.EdStatus = Apagando0 Then
				Dlinha EDX1 * 32 - 3, EDY1 * 32 - 3, EDX1 * 32 + 34, EDY1 * 32 + 34, 3
			Else
				Dlinha EDXX1 * 32 - 3, EDYY1 * 32 - 3, EDXX2 * 32 + 34, EDYY2 * 32 + 34, 2
			End If
		End Select
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Escreve a pontuação ganha na tela

Sub EscrevePT (Pontos As  Integer, X As Integer, Y As Integer, CJCarac As Integer)
	Dim As String StrNum, NumTxt
	Dim As Integer X1, NumVal, F
	
	'Passa o número para texto
	StrNum= Str(Pontos)
	X1 = X - (Len (StrNum) * 6)
	For f = 1 To Len (StrNum)
		NumTxt = Mid$(StrNum, f, 1)
		NumVal = Val (NumTxt)
		Put (x1 + f * 12 - 12, Y), BMP (239 + CJCarac), (NumVal * 9, 0) - Step (8,14), Alpha
	Next
End Sub

'-------------------------------------------------------------------------------------------

'Escreve um número (caracteres especiais)

Sub EscreveNumero (ByVal Numero As Long, Comprimento As  Integer, X1 As Integer, Y1 As Integer, Preenche As Integer)
	Dim As String StrNum, NumTxt 
	Dim As Integer NumVal, F
	
	If Preenche=0 Then 
		StrNum= Right(Space (Comprimento) & Str(Numero), Comprimento)
	Else
		StrNum= Right("0000000000" & Str(Numero), Comprimento)
	End If
	If Len (StrNum) < Len (Str(Numero)) Then StrNum = String (Comprimento, "+")

	For f= 1 To Comprimento
		NumTxt= Mid$(StrNum,f,1)
		If NumTxt =" " Then
			NumVal=0
		ElseIf NumTxt ="+" Then
			NumVal=11
		Else
			NumVal=Val(NumTxt)+1
		End If
		Put (x1+f*12-12, Y1), BMP (197 + NumVal), PSet
	Next
End Sub

'----------------------------------------------------------------------

'Escreve textos

Sub Escreve (ByVal Texto As String, x1 As Integer, y1 As Integer, Bold As Integer = 0, BoldV As Integer = 0)
	Dim As Integer LF, PosL, LG, LV
	For LF = 1 To Len(Texto)
		PosL = InStr(Lt, Mid$(Texto, LF, 1)) - 1
		If PosL = -1 Then
			X1 += 8
		Else
			For LV = 0 To BoldV
				For LG = 0 To Bold
					Put(X1 + LG, Y1 + LV), BMP (247), (PosLetra (PosL, 0), 0) - (PosLetra (PosL, 1), 21), Alpha
				Next
			Next
			x1 += PosLetra (PosL, 1) - PosLetra (PosL, 0) + Bold + 2
		End If
	Next
End Sub

'----------------------------------------------------------------------

'Escreve textos centralizados

Sub EscreveCentro (ByVal Texto As String, Y1 As Integer, Bold As Integer = 0, BoldV As Integer = 0)
	Escreve Texto, 399-LargTexto(Texto, Bold)/2, Y1, Bold, BoldV
End Sub

'----------------------------------------------------------------------

'Calcula a largura que um texto ocupa em pixels

Function LargTexto (ByVal Texto As String, Bold As Integer = 0) As Integer
	Dim As Integer LF, PosL, LArg
	For LF = 1 To Len (Texto)
		PosL = InStr(Lt,Mid$(Texto,LF,1)) - 1
		If PosL = -1 Then
			Larg += 8
		Else
			Larg += PosLetra (PosL, 1) - PosLetra (PosL, 0) + Bold + 2
		End If
	Next
	Larg = Larg - Bold - 1
	Return Larg
End Function

'-------------------------------------------------------------------------------------------

'Inicializa dados para nova partida

Sub IniciaJogo
	Randomize
	'Inicializa as variáveis principais
	With Jogo
		.UltExplosao=0
		.Encerra=0
		.player=Int(Rnd * 2)
		.Ciclo=0
	.SeqCiclo=0
	End With

	With Boneco
		.Mina=1
		.Vidas=Jogo.NumVidas
		.Pontos=0
	End With
End Sub

'----------------------------------------------------------------------

'Inicia dados da vida (zera status do boneco)

Sub IniciaVida
	Dim F as integer
	With Boneco
		.Morreu=0
		.Empurrando =0
		.Passo =0
		.Img =116
		.ImgX =0
		.ImgY =0
		.UltDir = 0
		.DirAtual = 0
		.Oxigenio =10
		.NoOxigenio=0
		.ItOxigenio =0
		.ItSuporte =0
		.ItPicareta = 0
		.ItFuradeira = 0
		.ItBombinha = 0
		.ItBombona = 0
		.NaPicareta = 0
		.NaFuradeira = 0
		.DirFuradeira = 0
		.VirouFuradeira =0
		.Tempo=0
	End With

	Iniciado=0
	TIMESTART = Timer + 5
	Jogo.UltExplosao=0
	For f = 0 To 10
		Explosao (f).Tipo=0
		Explosao (f).Tempo=0
	Next
End Sub

'----------------------------------------------------------------------

'Le arquivo e monta uma mina

Sub LeMinaOUT (NMina As Integer, Editando As Integer = 0)
	Dim As String Linha, NArq
	Randomize
	
	LimpaMina

	'zera contador de tesouros para iniciar a contagem
	Mina.Tesouros = 0

	'Abre arquivo
	If NMina = -1 Then
		NArq = "Minas\TESTE.MAP"
	Else
		LimpaMinaEditor
		NArq = "Minas\M" + Right("000" & Str(NMina), 3) + ".MAP"
	End If

	'Verifica se o arquivo existe
	If FileExists (Narq) Then
		If NMina > -1 Then Mina.numero = NMina
		Open Narq For Binary As #1
		Get #1, , Mina.LArg
		Get #1, , Mina.Alt
		Get #1, , Mina.Noturno
		Get #1, , Mina.Tempo
		
		LeMinaDet Editando
		Close #1

	Else  'Arquivo não existe
		Mensagem 4, 8, TXT(0), TXT(50),""
		If Tecla <>"" And Tecla <> UltTecla Then
			MudaStatus NoMenu
		End If
		MudaStatus NoMenu
		IniciaJogo
		IniciaVida
		LimpaMina
		LimpaMinaEditor
	End If	
	
End Sub

'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------

'Sub Principal

Sub Joga
	Dim As Integer Emp1, Emp2, Emp3, SeqDemo, F, G, H, I

	ATimer = Int(Timer * 1000)
	If VRed+VGreen+VBlue=0 Then VBlue=1
	TeclasDemo=	"R01M01R15M22R23M02R24M03L23M04L16M05L12M06L08M07L05M08L04M09D04L00R01W20L00M10R24D06M11L22IC L20ICLL18ICLL16M12IV R18W50L14IV R16W50L12ICLL10" & _
				"IV R12W50L08ICLL06IV R08W50L04ICLL02IV R04W50L01M13L00IX M14D08R04M15IB L02W50R06IB L04W50R08IB L06W50R10IB L08W50R12IB L10W50R14IB L12W50R16IB L14W50" & _
				"R17M16R20IZ R21M17R22M18IB L19W20L01M19D10L00M20R24U09M21###"
	Tecla = ""

	
	'-------------
	'#############
	'-------------
	
	'CICLO DO JOGO
	
	'-------------
	'#############
	'-------------

	While Jogo.Encerra = 0

		Jogo.Status0 = Jogo.Status
		
		'Silencia canais que terminaram de reproduzir sons
		For f = 1 To 6
			For g = 1 To 4
				If Som (f, g). Tempo > 0 Then
					Som (f, g). Tempo -=1
					If Som (f, g). Tempo = 0 Then midiOutShortMsg (hMidiOut, Som(f,g).COff)
				End If
			Next
			If SomEx (f).Tempo > 0 Then
				SomEx (f).Tempo -= 1
				If SomEx (f).Tempo = 0 Then midiOutShortMsg (hMidiOut, SomEx(f).COff)
			End If
		Next				
				
		If Inkey = Chr(255) + "k" Then
			Jogo.Encerra = 1
			GoTo TerminaCiclo
		End If
		
		'Não há som a reproduzir
		For f=1 To 6
			For g= 1 To 4
				Toca(f,g)=0
			Next
		Next
		
		'Incrementa Contador de ciclos
		With Jogo
			.Ciclo = (.Ciclo+1) Mod .passos
			If.Ciclo=0 Then
				.SeqCiclo= (.SeqCiclo + 1) Mod 1500
				If .seqciclo Mod 10 = 0 Then WindowTitle "FreeBasic Miner"
			End If
		End With
		
		'Lê o teclado
		UltTecla= Tecla
		Tecla=""
		'Controles
		For F = 0 To 127
			If MultiKey (f) Then Tecla = "?"
		Next
		If MultiKey(FB.SC_ENTER) Then Tecla ="["
		If MultiKey(FB.SC_ESCAPE) Then Tecla ="ESC"
		If MultiKey(FB.SC_SPACE) Then Tecla = "]"
		If MultiKey(FB.SC_DELETE) Then Tecla = "<"
		If MultiKey(FB.SC_P) Then Tecla ="P"
		If MultiKey(FB.SC_A) Then Tecla = "A"
		If MultiKey(FB.SC_B) Then Tecla = "B"
		If MultiKey(FB.SC_C) Then Tecla = "C"
		If MultiKey(FB.SC_M) Then Tecla = "M"
		If MultiKey(FB.SC_Q) Then Tecla = "Q"
		If MultiKey(FB.SC_V) Then Tecla = "V"
		If MultiKey(FB.SC_X) Then Tecla = "X"
		If MultiKey(FB.SC_Z) Then Tecla = "Z"
		If MultiKey(SC_TAB) Then Tecla = "TAB"
		If MultiKey(SC_PAGEUP) Then Tecla = "@"
		If MultiKey(SC_PAGEDOWN) Then Tecla = "#"
		'Movimento
		If MultiKey(FB.SC_DOWN) Then Tecla ="D"
		If MultiKey(FB.SC_LEFT) Then Tecla ="L"
		If MultiKey(FB.SC_RIGHT) Then Tecla ="R"
		If MultiKey(FB.SC_UP) Then Tecla ="U"

		LeMouse
		
		Select Case Jogo.Status
		'-------------------------------------------------------------------------------------------
		
		Case NoMenu 'MENU --> mostra as opções até uma ser escolhida
		
			'Fundo e LOGO
			DesFundo			
			PutLogo 290, 40
			
			'Opções
			MouseSobre = -1
			For F = 0 To 8
				If (MouseY > 300) And (MouseY < 363) And (MouseX > 48 + F * 80) And (MouseX < 111 + F * 80) Then
					MouseSobre = F
					If (MouseMoveu = 1) And (OpMenu <> F) Then
						midiOutShortMsg (hMidiOut, &H7f4080 + (OpMenu * 256))
						OpMenu = F
						midiOutShortMsg (hMidiOut, &H76c0)
						midiOutShortMsg (hMidiOut, &H7f4090 + (OpMenu * 256))
					End If
				End If
				If OpMenu = F Then
					Put (32 + f * 80, 284), BMP (277), (0,0)-(95,95), Alpha
					Put (48 + F * 80, 300), BMP (276), (f*64,64)-Step(63,63), Trans
				Else
					Put (48 + F * 80, 300), BMP (276), (f*64,0)-Step(63,63), Trans
				End If
			Next
			EscreveCentro TXT (OpMenu + 2), 380, 1, 1
			
			If (Tecla <> "") Or (MouseMoveu = 1) Then TTDemo1 = Timer

			If MouseSobre > -1 And MouseDisparou = 1 Then OpMenu = MouseSobre : Tecla = "["

			If UltTecla <> Tecla Then
				
				If Tecla = "D" Or tecla = "R" Then
					midiOutShortMsg (hMidiOut, &H7f4080 + (OpMenu * 256))
					OpMenu = (Opmenu + 1) Mod (Sair + 1)
					midiOutShortMsg (hMidiOut, &H76c0)
					midiOutShortMsg (hMidiOut, &H7f4090 + (OpMenu * 256))
				ElseIf Tecla = "U" Or Tecla = "L" Then
					midiOutShortMsg (hMidiOut, &H7f4080 + (OpMenu * 256))
					OpMenu = (OpMenu + Sair) Mod (Sair + 1)
					midiOutShortMsg (hMidiOut, &H76c0)
					midiOutShortMsg (hMidiOut, &H7f4090 + (OpMenu * 256))
				ElseIf Tecla = "ESC" Then
					Jogo.encerra=1
				ElseIf Tecla = "[" Or tecla = "]" Then
					Select Case OpMenu	'Jogar, IrPara, VerTop, Sobre, Volume, EscIdioma, Custom, Editar, Sair
					Case Jogar
						Opcao1 = 0
						MudaStatus Jogando
						IniciaJogo
						IniciaVida
						Mina.Tipo = 0
						LeMinaIn 1
						Iniciado=0
						TIMESTART = Timer + 5
					Case IrPara, Volume
						Opcao1 = 0
						MudaStatus Configs
					Case VerTop
						MudaStatus Top10
						PosTop10 = 0
					Case Sobre
						MudaStatus Instruc
					Case EscIdioma
						Jogo.Status = SelIdioma
						ProcIdiomas
					Case Custom
						Opcao1 = 0
						Boneco.Mina = 0
						Cls
						TrocaTelas
						Cls
						Mensagem 7, 8, TXT(92), TXT(93), " "
						LeMinasPers
						TrocaTelas
						Cls
						MudaStatus Configs
					Case Editar
						Opcao1 = 0
						Boneco.Mina = 0
						Cls
						TrocaTelas
						Cls
						Mensagem 7, 8, TXT(92), TXT(93), " "
						LeMinasPers
						TrocaTelas
						Cls
						MudaStatus Configs
					Case Sair
						Jogo.encerra = 1
					End Select
				End If
			End If
			
			If Timer > TTDemo1 + 8 Then
				MudaStatus ModoDemo
				Mina.Tipo = 0
				IniciaJogo
				IniciaVida
				LeMinaIn 0
				Iniciado=0
				MensDemo = 0
				TempMens = 0
				Tecla = ""
				PositDemo = 0
				DemoW1 = 0
				DemoW2 = 0
				DemoCiclo = 0
			End If
		
		'-------------------------------------------------------------------------------------------
		
		Case SelIdioma	'troca o idioma do programa
			DesFundo
			PutLogo 290, 40

			If IQuant = 0 Then
				Mensagem 5, 8, "Só há o idioma português instalado.", "", ""
				If Tecla <> "" And ulttecla <> Tecla Then
					MudaStatus NoMenu
				End If
			Else
				DesBox 10, IQuant + 3, 0, 400, 370
				EscreveCentro TXT(7), 374 - (IQuant + 3) * 16, 1, 1
				MouseSobre = -1
				For f = 0 To IQuant
					If (MouseX > 252) And (MouseX < 547) And (Abs (MouseY - (444 - (IQuant + 3) * 16 + f * 32)) < 16) Then
						MouseSobre = F
						If MouseMoveu = 1 Then NAtual = F
					End If
					EscreveCentro Idioma (f), 434 - (IQuant + 3) * 16 + F * 32, 1, 0
				Next
				Line (250, 426 - (IQuant + 3) * 16 + NAtual * 32) - Step (300, 35), RGB (0, 127, 255), b
				Line (251, 427 - (IQuant + 3) * 16 + NAtual * 32) - Step (298, 33), RGB (0, 127, 255), b

				If MouseSobre > -1 And MouseDisparou = 1 Then NAtual = MouseSobre : Tecla = "["

				If UltTecla <> Tecla Then
					If (Tecla = "U" Or Tecla ="L") And NAtual > 0 Then NAtual -= 1
					If (Tecla = "D" Or Tecla ="R") And NAtual < IQuant Then NAtual += 1
					If Tecla = "[" Or Tecla = "]" Then
						IAtual = Idioma (NAtual)
						LeTXT (IAtual)
						MudaStatus NoMenu
					End If
					If Tecla = "ESC" Then MudaStatus NoMenu
				End If
			End If			
			
		'-------------------------------------------------------------------------------------------
		
		Case Configs 'trata algumas opções do menu
			
			'Desenha fundo e LOGO
			DesFundo
			PutLogo 290, 40
				
			Select Case OpMenu
			Case IrPara 'Ir para Mina...
				If Boneco.Mina < 1 Or Boneco.Mina > Jogo.NumMinas Then Boneco.Mina = 1
				EscreveCentro TXT(51), 140, 1, 0
				EscreveCentro TXT(52), 575, 1, 0
				
				Mina1 = Int((boneco.mina - 1) / 100) * 100 + 1
				If Mina1 > Jogo.NumMinas - 100 Then
					Mina2 = Jogo.NumMinas - Mina1 + 1
				Else
					Mina2 = 100
				End If

				MouseSobre = -1

				For F = 0 To Mina2 - 1
					XM = (F Mod 10) * 65 + 80
					YM = Int (F / 10) * 40 + (370 - Int((Mina2 + 9)/10) * 20)
					If Mina1 + F > Jogo.MaxAlcancada Then
						Put (XM, YM + 2), BMP (276), (576, 33) - (630, 65), Trans
					Else
						Put (XM, YM + 2), BMP (276), (576, 0) - (630, 32), Trans
					End If
					If (MouseX > XM) And (MOuseX < XM + 54) And (MouseY > YM + 2) And (MouseY < YM + 35) Then
						MouseSobre = Mina1 + F
					End If
					If Mina1 + F > Jogo.MaxAlcancada Then
						Put (XM, YM + 6), BMP (276), (576, 103) - (630, 127), Trans
					ElseIf Mina1 + F < 10 Then
						Escreve Str(Mina1 + F), XM + 23, YM + 8, 1, 0
					ElseIf Mina1 + F < 100 Then
						Escreve Str(Mina1 + F), XM + 17, YM + 8, 1, 0
					Else
						Escreve Str(Mina1 + F), XM + 11, YM + 8, 1, 0
					End If
					
				Next

				If (MouseMoveu = 1) And (MouseSobre > -1) Then Boneco.Mina = MouseSobre
				If MouseSobre > -1 And MouseDisparou = 1 Then Boneco.Mina = MouseSobre : Tecla = "["
				XM = ((Boneco.Mina - Mina1) Mod 10) * 65 + 80
				YM = Int ((Boneco.Mina - Mina1) / 10) * 40 + (370 - Int((Mina2+9)/10) * 20)
				Put (XM, YM), BMP (276), (576, 66)-(630, 102), Trans
				
				If MouseWDir = -1 Then Tecla = "#"
				If MouseWDir = 1 Then Tecla = "@"
				
				If Tecla <>"" And Tecla <> UltTecla Then
					Select Case Tecla
					Case "D"
						If Boneco.Mina <= Jogo.NumMinas - 10 Then Boneco.Mina += 10 
					Case "L"
						If Boneco.Mina > 1 Then Boneco.Mina -= 1
					Case "U"
						If Boneco.Mina > 10 Then Boneco.Mina -= 10
					Case "R"
						If Boneco.Mina < Jogo.NumMinas Then Boneco.Mina += 1
					Case "@"
						If Boneco.Mina > 100 Then Boneco.Mina -= 100 Else Boneco. Mina = 1
					Case "#"
						If Boneco.Mina < Jogo.NumMinas - 100 Then Boneco.Mina += 100 Else Boneco.Mina = Jogo.NumMinas
					Case "ESC"
						MudaStatus NoMenu
					Case "[", "]"
						If Boneco.Mina <= Jogo.MaxAlcancada Then
							XM = Boneco.Mina
							IniciaJogo
							IniciaVida
							Boneco.Mina = XM
							Mina.Tipo = 0
							LeMinaIn XM
							Iniciado = 0
							TIMESTART = Timer + 5
							MudaStatus Jogando
						End If
					End Select
				End If
					
			Case Volume 'Ajuste do Volume
				
				Put (364,250), BMP (276), (256,0)-Step(63,63), Trans
				MouseSobre = -1
				If (MouseY > 330) And (MouseY < 400) And (MouseX > 270) And (MouseX < 530) Then
					MouseSobre = (MouseX - 275) / 2
					If MouseSobre <0 Then MouseSobre = 0
					If MouseSobre > 127 Then MouseSobre = 127
				End If
				
				If MouseDisparou = 1 Then
					If MouseSobre > -1 Then
						Jogo.volume = mousesobre
					Else
						Tecla = "["
					EndIf
				EndIf
				
				'Barras
				If MouseSobre = - 1 Then
					CorRGB = &H60ff00
					CorRGB2 = &H205000
				Else
					CorRGB = &H60ff90
					CorRGB2 = &H205030
					Line (270, 405) - (530, 325), &H909090, b
					Line (269, 406) - (531, 324), &H909090, b
				End If
				For F = 0 To 15
					If Jogo.Volume >= F * 8 Then
						Line (275 + f * 16, 400) - Step(10, -10 - f * 4), CorRGB, BF
					Else
						Line (275 + f * 16, 400) - Step(10, -10 - f * 4), CorRGB2, BF
					End If
				Next
				If jogo.volume = 0  Then Line (275,400) - Step(10, -10 ), RGBA(180,0,0,0), BF
				If jogo.volume = 127  Then Line (515,400) - Step(10, -70 ), RGBA(200,200,0,0), BF
				EscreveCentro TXT(53), 440, 1, 0
				EscreveCentro TXT(54), 500, 1, 0
				
				If tecla = "D" Or Tecla = "L" Then
					If Jogo.Volume > 0 Then Jogo.volume -= 1
				ElseIf tecla = "U" Or tecla = "R" Then
					If jogo.volume < 127 Then Jogo.volume += 1
				ElseIf (tecla = "[" Or tecla = "]" Or Tecla = "ESC") And UltTecla <> tecla Then
					RegravaConfig
					MudaStatus NoMenu
				ElseIf MouseWDir = -1 Then
					If Jogo.Volume > 8 Then
						Jogo.Volume -= 8
					Else
						Jogo.Volume = 0
					End If
				ElseIf MouseWDir = 1 Then
					Jogo.Volume += 8
					If Jogo.Volume > 127 Then Jogo.Volume = 127
				End If
				midiOutSetVolume(0, (jogo.volume Shl 9) Or (jogo.volume Shl 1))
			
			Case Custom, Editar
				MouseSobre = -1
				If (QuantPers = 0) Then
					If OpMenu = Editar Then
						LimpaMina
						LimpaMinaEditor
						MudaStatus Editor
						Jogo.EdStatus = Editando
					Else
						Mensagem 7, 8, TXT(55), TXT(56),""
						If (Tecla <>"" And Tecla <> UltTecla) Or (MouseDisparou = 1) Then
							MudaStatus NoMenu
						End If
					End If
				Else
					If Boneco.Mina < 0 Or Boneco.Mina > QuantPers -1 Then Boneco.Mina = 0
					EscreveCentro TXT(51), 140, 1, 0
					If OpMenu = Editar Then 
						EscreveCentro TXT(97), 575, 1, 0
					Else
						EscreveCentro TXT(52), 575, 1, 0
					End If
					
					Mina1 = Int((boneco.mina) / 100) * 100
					If Mina1 > QuantPers - 100 Then
						Mina2 = QuantPers - Mina1
					Else
						Mina2 = 100
					End If
				
					For F = 0 To Mina2 - 1
						XM = (F Mod 10) * 65 + 80
						YM = Int (F / 10) * 40 + (370 - Int((Mina2 + 9)/10) * 20)
						Put (XM, YM+2), BMP (276), (576, 0)-(630, 32), Trans
						If (MouseX > XM) And (MOuseX < XM + 54) And (MouseY > YM + 2) And (MouseY < YM + 35) Then
							MouseSobre = Mina1 + F
						End If

						PersTemp = MinaPers (Mina1 + F)
						If PersTemp < 10 Then
							Escreve Str(PersTemp), XM + 23, YM + 8, 1, 0
						ElseIf PersTemp < 100 Then
							Escreve Str(PersTemp), XM + 17, YM + 8, 1, 0
						Else
							Escreve Str(PersTemp), XM + 11, YM + 8, 1, 0
						End If
					Next
					If (MouseMoveu = 1) And (MouseSobre > -1) Then Boneco.Mina = MouseSobre
					If MouseSobre > -1 And MouseDisparou = 1 Then Boneco.Mina = MouseSobre : Tecla = "["

					XM = ((Boneco.Mina - Mina1) Mod 10) * 65 + 80
					YM = Int ((Boneco.Mina - Mina1) / 10) * 40 + (370 - Int((Mina2 + 9)/10) * 20)
					Put (XM, YM), BMP (276), (576,66)-(630, 102), Trans
					If MouseWDir = -1 Then Tecla = "#"
					If MouseWDir = 1 Then Tecla = "@"
					
					If Tecla <>"" And Tecla <> UltTecla Then
						Select Case Tecla
						Case "D"
							Boneco.Mina += 10 
							If Boneco.Mina >= QuantPers Then Boneco.Mina -= 10
						Case "L"
							Boneco.Mina -= 1
							If Boneco.Mina < 0 Then Boneco.Mina = 0
						Case "U"
							Boneco.Mina -= 10
							If Boneco.Mina < 0 Then Boneco.Mina += 10
						Case "R"
							Boneco.Mina += 1
							If Boneco.Mina >= QuantPers Then Boneco.Mina = QuantPers - 1
						Case "@"
							Boneco.Mina -= 100
							If Boneco.Mina < 0 Then Boneco.Mina = 0
						Case "#"
							Boneco.Mina += 100
							If Boneco.Mina >= QuantPers Then Boneco.Mina = QuantPers - 1
						Case "TAB"
							If OpMenu = Editar Then
								LimpaMina
								LimpaMinaEditor
								MudaStatus Editor
							End If
						Case "ESC"
							Boneco.Mina = 1
							MudaStatus NoMenu
						Case "[", "]"
							XM = MinaPers(Boneco.Mina)
							IniciaJogo
							IniciaVida
							Boneco.Mina = XM
							Mina.Tipo = 1
							Iniciado = 0
							TIMESTART = Timer + 5
							If OpMenu = Editar Then
								LeMinaOUT XM, 1
								MudaStatus Editor
								While MouseB = 1 And MouseX <> -1
									Sleep 1, 1
									LeMouse
								Wend
							Else
								LeMinaOUT XM, 0
								MudaStatus Jogando
							End If
						End Select
					End If
				End If
			End Select
		'-------------------------------------------------------------------------------------------
			
		Case Jogando, ModoDemo, Testando 'JOGANDO; MODO DEMONSTRAÇÃO; TESTANDO MINA EM EDIÇÃO
			
			If Jogo.Status = ModoDemo Then
				'No modo demo, qualquer tecla faz voltar pro menu
				For F= 1 To 127
					If (MultiKey(f)) Then MudaStatus NoMenu
				Next
				
				'Busca comandos ou direções para modo demo
				If Boneco.NaFuradeira = 0 And Boneco.NaPicareta = 0 Then
					Tecla = ProximaTeclaDemo ()
					If Tecla = "ESC" Then
						MudaStatus NoMenu
					End If
				End If
			End If
			
			'Verifica se acabou o tempo
			If (jogo.SeqCiclo Mod 8 = 0) And (jogo.Ciclo = 0) And (iniciado > 0) And (boneco.morreu = 0) Then
				boneco.Tempo += 1
				If (boneco.tempo >= mina.tempo) And (mina.tempo > 0) And (Jogo.Status = Jogando) Then
					boneco.morreu = 1
				End If
			End If
			
			'Verifica Comandos: PAUSAR, MAPA, QUIT e ESC
			If boneco.morreu = 0 And iniciado = 1 And (Jogo.Status = Jogando Or Jogo.Status = Testando) And UltTecla <> Tecla Then
				Select Case Tecla
				Case "M"	'Mapa
					With boneco
						If (mina.Larg > 24 Or mina.Alt > 16) Then
							'Calcula o X inicial da tela
							If Mina.Larg <25 Or .X<=12 Then
								MapX=0
							ElseIf .X>= Mina.Larg-12 Then
								MapX=Mina.LArg-24
							Else
								MapX=.X-12
							End If
							
							'Calcula o Y inicial da tela
							If Mina.Alt <17 Or .Y<=8 Then
								MapY=0
							ElseIf .Y> Mina.Alt-8 Then
								MapY=Mina.Alt-16
							Else	
								MapY=.Y-8
							End If
							MudaStatus ModoMapa
						Else
							'Som DAME
							midiOutShortMsg (hMidiOut, SomEx(6).COn1)
							midiOutShortMsg (hMidiOut, SomEx(6).COn2)
							SomEx(6). Tempo = 4
						End If
					End With
					
				Case "P"	'Pausa
					MudaStatus Pausado
					
				Case "ESC" 	'ESC
					If Jogo.Status = Testando Then
						LMTEC=""
						LimpaTeclado
						opcao1 = 0
						DesligaSons
						While lmtec <> " " And LMTec <> Chr(13) And lmtec <> Chr(27)
							Cls
							Mensagem 4, 5, TXT (95), "", "", 400, 300, Opcao1
							LMTec=Inkey
							LeMouse
							If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
							If (MouseDisparou = 1) And (MouseSimNao > 0) Then LMTec = " "
							If (LmTec = c255 + "H") Or (LmTec = c255+ "K") Or (LmTec = c255+ "M") Or (LmTec = c255+ "P") Then Opcao1 = 1 - Opcao1
							TrocaTelas
						Wend
						Cls
						If (LmTec <> Chr(27)) And (Opcao1 = 0) Then EncerraTeste
						LimpaTeclado 1
						
					Else
						boneco.Morreu = 1
					End If
					
				Case "Q"	'Quit
					
					LMTEC=""
					LimpaTeclado
					opcao1 = 0
					While lmtec <> " " And LMTec <> Chr(13) And lmtec <> Chr(27)
						Cls
						Mensagem 4, 5, TXT(57), "", "", 400, 300, Opcao1
						LMTec=Inkey
						LeMouse
						If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
						If (MouseDisparou = 1) And (MouseSimNao > 0) Then LMTec = " "
						If (LmTec = c255+ "H") Or (LmTec = c255+ "K") Or (LmTec = c255+ "M") Or (LmTec = c255+ "P") Then Opcao1 = 1 - Opcao1
						TrocaTelas
						jogo.seqciclo=(jogo.seqciclo+1) Mod 360
					Wend
					Cls
					If LMTec <> Chr(27) And Opcao1 = 0 Then
						jogo.encerra = 1
					End If
					
					LimpaTeclado 1
						
				End Select
			End If
			
			If (Jogo.Status0 = Jogo.Status) And (Jogo.Encerra <> 1) Then
				'Conclui movimentação de objetos empurrados
				If Boneco.Empurrando = 1 Then
					If Boneco.DirAtual = 1 Then
						Emp1 = Mina.Larg
						Emp2 = 0
						Emp3 = -1
					Else
						Emp1 = 0
						Emp2 = Mina.Larg
						Emp3 = 1
					End If
					For F = Emp1 To Emp2 Step Emp3
						With Objeto (F, boneco.Y)
							If .Empurrando > 0 And .Passo >= Jogo.Passos -1 Then
								Objeto(F + 3 - .Empurrando * 2, boneco.y).Tp = .Tp
								Objeto(F + 3 - .Empurrando * 2, boneco.y).Passo = 0
								Objeto(F + 3 - .Empurrando * 2, boneco.y).Empurrando = 0
								Objeto(F + 3 - .Empurrando * 2, boneco.y).Caindo = 0
								Objeto(F + 3 - .Empurrando * 2, boneco.y).AntCaindo = 0
								.Passo = 0
								.Empurrando = 0
								.Caindo = 0
								.AntCaindo=0
								.Tp = 0
							End If
						End With
					Next
				Else
					midiOutShortMsg (hMidiOut, SomEx(7).COff)
				End If
				
				'Verifica e conclui movimentação e outros comportamentos do boneco
				With Boneco
					'Se concluiu movimento nesta passagem, zera movimento
					If .DirAtual > 0 And .Passo = Jogo.Passos Then
						'Pega ultimo movimento que estava fazendo
						.UltDir= .DirAtual
						'Reposiciona boneco, conforme movimento concluido
						Select Case .DirAtual
						'Direita
						Case 1
							.x += 1
						'Esquerda
						Case 2
							.x -= 1
						'Subindo
						Case 3
							.y -= 1
						'Caindo / Descendo
						Case 4,5
							.y += 1
						End Select
						
						'Não está mais andando, nem empurrando
						.DirAtual = 0
						.Empurrando = 0
						.Passo = 0
					End If
					
					If Iniciado = 0 Then
						If ((Tecla <> "") And (Tecla <> UltTecla)) Or ((Timer >= TIMESTART) And (Jogo.Status <> Testando)) Then
							Iniciado = 1
						End If
						
					ElseIf .Morreu = 1 Then
						Explode (.x, .y, 2)
						.Morreu = 2
						If Jogo.Status = ModoDemo Then
							.Morreu = 0
							MudaStatus NoMenu
						End If
						
					ElseIf .Morreu > 1 Then
						.Morreu = (.Morreu + 1) Mod 100
						If .Morreu < 2 Then .Morreu = 2
						
						'Verifica se terminou movimento
						If Tecla <> "" And Tecla <> UltTecla Then
							'Zera contadores de ciclos
							Jogo.Ciclo = 0
							Jogo.SeqCiclo = 0
							
							'Se for teste, apenas reinicia
							If Jogo.Status = Testando Then
								LeMinaOUT -1, 0
								Iniciado = 0
								IniciaVida
								
							'Verifica Game Over
							ElseIf Boneco.Vidas < 1 Then
								MudaStatus GameOver
								
							'Atualiza número de vidas e reinicia mina e boneco
							Else
								'Tira uma vida
								Boneco.Vidas -= 1
								If Mina.Tipo = 0 Then
									LeMinaIn Boneco.Mina
								Else
									LeMinaOUT Boneco.Mina, 0
								End If
								
								Iniciado = 0
								IniciaVida
							End If
						End If
						
					'Se não pressionou ESC nem estava morto, verifica se está parado em posição de cair
							'(1-parado; 2-não está na escada; 3-não está sobre objeto que o apoie, ou o objeto de baixo está caindo, ou o objeto de baixo mata)
							
					ElseIf Iniciado = 1 And .DirAtual = 0 And .y < Mina.Alt And comport(TpObjeto(objeto(.x, .y).tp).tipo).sobe = 0 And _
								(comport (TpObjeto (objeto (.x, .y + 1).tp).tipo).apoia = 0 Or Objeto(.x, .y + 1).caindo = 1 Or comport(tpobjeto(Objeto(.x, .y + 1).tp).tipo).mata = 1) Then
						
						'Informa queda, eliminando outros movimentos ou ações (ficam perdidas)
						.DirAtual		= 5
						.UltDir			= 5
						.NaFuradeira	= 0
						.NaPicareta		= 0
						.Passo			= 1
						If comport(tpobjeto(Objeto(.x, .y + 1).tp).tipo).mata = 1 Then .morreu = 1
						
					'Se não está morto, nem pediu pra morrer, nem vai cair, verifica se está usando a picareta
					ElseIf .NaPicareta > 0 Then
						If .NaPicareta Mod 3 =1 Then
							midiOutShortMsg (hMidiOut, Som(6, 1).COn1)
							midiOutShortMsg (hMidiOut, Som(6, 1).COn2)
							Som (6,1).Tempo = 1
						End If
	
						.NaPicareta += 1
						If .Napicareta >= Jogo.Passos * 2 Then
							.NaPicareta = 0
							Objeto(.x, .y + 1).tp = 0
						End If
						
					'Se não morreu nem pediu, não vai cair nem está usando a picareta, verifica se está usando a furadeira
					ElseIf .NaFuradeira > 0 Then
						.NaFuradeira += 1
						If (.DirFuradeira = 1 And Objeto (.x + 1, .y).caindo = 1)  Or (.DirFuradeira = 2 And Objeto (.x - 1, .y).caindo = 1) Then
							.Nafuradeira = 0
						End If
						If .NaFuradeira >= Jogo.Passos * 2 Then
							If .dirfuradeira=1 Then
								Objeto (.x + 1, .y).tp = 0
							Else
								Objeto (.x - 1, .y).tp = 0
							End If
							.NaFuradeira = 0
							.VirouFuradeira = 0
						ElseIf .VirouFuradeira = 0 And .Nafuradeira <= Jogo.Passos Then
							If .DirFuradeira = 1 And Tecla = "L" And comport(TpObjeto(Objeto(.x - 1, .y).tp).tipo).destroi = 2 And Objeto(.x - 1, .y).caindo = 0 Then
								.VirouFuradeira = 1
								.DirFuradeira = 2
							ElseIf .dirfuradeira = 2 And tecla = "R" And comport(TpObjeto(Objeto(.x + 1, .y).tp).tipo).destroi = 2 And Objeto(.x + 1, .y).caindo = 0 Then
								.viroufuradeira = 1
								.dirfuradeira = 1
							End If
						End If
					'Se não está morto, não pediu, não vai cair, não está usando a picareta nem a furadeira, verifica se está no meio de um movimento e dá sequencia ao mesmo
					ElseIf Iniciado = 1 And .DirAtual > 0 Then
						.Passo += 1
						
					ElseIf Iniciado = 1 Then
					
						'Se não morreu nem pediu, não vai cair nem está usando nada, nem está no meio de nenhum movimento, verifica se foi solicitado novo movimento, e se ele é possível
						Select Case Tecla
						
						'==========================
						'Tecla para cima
						Case "U"
							'Se não está no topo e está em uma escada
							.UltDir = 3
							If .y > 0 And Comport(TpObjeto(Objeto(.x, .y).tp).tipo).sobe = 1 Then
								If comport(TpObjeto(Objeto(.x, .y - 1).tp).tipo).mata = 1 Then
									.morreu = 1
								Else
									'Se o objeto de cima está livre
									If Comport(TpObjeto(Objeto(.x, .y - 1).tp).tipo).anda > 0 Then
										'Atualiza direção e inicia movimento
										.DirAtual	= 3
										.Passo		= 1
										
										'Pega e limpa objeto do destino, se for o caso
										PegaObj .x, .y - 1
										'Atenção: se 2 posições acima for pedra, vai cair na cabeça!
									End If
								End If
							End If
							
						'==========================
						'Tecla para baixo
						Case "D"
							'Se não está no fundo
							.UltDir = 5
							If .y < Mina.Alt Then
							    If comport(TpObjeto(Objeto(.x, .y + 1).tp).tipo).mata = 1 Then
									.morreu = 1
								Else
									
									'Se o objeto de baixo for uma escada, então desce
									If Comport(TpObjeto(Objeto(.x,.y + 1).tp).tipo).sobe = 1 Then
										'Atualiza direção e inicia movimento
										.DirAtual	= 4
										.UltDir		= 4
										.Passo		= 1
										
									'Se abaixo não for escada, verifica se permite andar
									ElseIf comport(TpObjeto(Objeto(.x, .y + 1).tp).tipo).anda > 0 Then
										'Atualiza direção e inicia movimento (queda)
										.DirAtual	= 5
										.UltDir		= 5
										.Passo		= 1
										'Pega e limpa objeto do destino, conforme o caso
										PegaObj .x, .y + 1
									End If
								End If
							End If
							
						'==========================
						'Tecla para esquerda
						Case "L" 
							.UltDir = 2
							.DirFuradeira = 2
							'Se não está no extremo esquerdo
							If .X > 0 Then
								'Verifica se foi na direção de objeto que mata
								If comport(TpObjeto(Objeto(.x - 1, .y).tp).tipo).mata = 1 Then
									.morreu = 1
								Else
									'Se o objeto da esquerda permite andar e objeto da esquerda acima não está caindo 
									If comport(TpObjeto(Objeto(.x - 1, .y).tp).tipo).anda > 0 And Objeto (.x - 1, .y - 1).caindo = 0 Then
										'Atualiza direção e inicia movimento (queda)
										.DirAtual	= 2
										.Passo		= 1
										'Pega e limpa objeto do destino, conforme o caso
										PegaObj .x - 1, .y
										
									'Se objeto da esquerda não permite andar, testa se tem condições de ser empurrado 
									ElseIf EmpurraObj (.x - 1, .y, 2, 0, 1) < 3 Then
										.Empurrando	= 1
										.DirAtual	= 2
										.Passo		= 1
										midiOutShortMsg (hMidiOut, SomEx(7).COn1)
										midiOutShortMsg (hMidiOut, SomEx(7).COn2)
									End If
								End If
							End If
						
						'==========================
						'Tecla para Direita
						Case "R"
							.UltDir = 1
							.DirFuradeira = 1
							'Se não está no extremo direito
							If .x < Mina.Larg Then
								If comport(TpObjeto(Objeto(.x + 1, .y).tp).tipo).mata = 1 Then
									.morreu = 1
								Else
									'Se o objeto da direita permite andar e objeto da direita acima não está caindo 
									If comport(TpObjeto(Objeto(.x + 1, .y).tp).tipo).anda > 0 And Objeto (.x + 1, .y - 1).caindo = 0 Then
										.DirAtual	= 1
										.Passo		= 1
										'Pega e limpa objeto do destino, conforme o caso
										PegaObj .x + 1, .y
									'Se objeto da direita não permite andar, testa se tem condições de ser empurrado 
									ElseIf EmpurraObj (.x + 1, .y, 1, 0, 1) < 3 Then
										.Empurrando	= 1
										.DirAtual	= 1
										.UltDir		= 1
										.Passo		= 1
										midiOutShortMsg (hMidiOut, SomEx(7).COn1)
										midiOutShortMsg (hMidiOut, SomEx(7).COn2)
									End If
								End If
							End If
							
						'==========================
						'Usar Suporte
						Case "Z"
						If UltTecla <> "Z" Then
							If Comport(TpObjeto(Objeto(.x, .y).tp).tipo).apoia = 0 And .ItSuporte > 0 Then
								Objeto(.x, .y).tp = 81
								.ItSuporte -= 1
							Else
								midiOutShortMsg (hMidiOut, SomEx(6).COn1)
								midiOutShortMsg (hMidiOut, SomEx(6).COn2)
								SomEx (6).Tempo = 10
							End If
						End If
						
						'==========================
						'Usar Picareta
						Case "X"
							If UltTecla <> "X" Then
								If Comport(TpObjeto(Objeto(.x, .y + 1).tp).Tipo).Destroi = 2 And .ItPicareta > 0 Then
									.ItPicareta -= 1
									.NaPicareta  = 1
								Else
									midiOutShortMsg (hMidiOut, SomEx(6).COn1)
									midiOutShortMsg (hMidiOut, SomEx(6).COn2)
									SomEx (6).Tempo = 10
								End If
							End If
							
						'==========================
						'Usar Furadeira
						Case "C" 
							If UltTecla <> "C" Then
								If .ItFuradeira > 0 And ((Comport(TpObjeto(Objeto(.x - 1, .y).tp).Tipo).Destroi = 2 And Objeto(.x - 1, .y).caindo=0) Or (Comport(TpObjeto(Objeto(.x + 1, .y).tp).Tipo).Destroi = 2) And Objeto(.x + 1, .y).caindo = 0) Then
									If .DirFuradeira = 1 And Comport(TpObjeto(Objeto(.x + 1, .y).tp).Tipo).Destroi = 2 And Objeto(.x + 1, .y).caindo = 0 Then
										.DirFuradeira	 = 1
										.ItFuradeira 	-= 1
										.NaFuradeira 	 = 1
										.VirouFuradeira	 = 0
										midiOutShortMsg (hMidiOut, Som(5, comport(tpobjeto(objeto(.x + 1, .y).tp).tipo).som).COn1)
										midiOutShortMsg (hMidiOut, Som(5, comport(tpobjeto(objeto(.x + 1, .y).tp).tipo).som).COn2)
										Som(5, comport(tpobjeto(objeto(.x + 1, .y).tp).tipo).som).Tempo = 16
									ElseIf Comport(TpObjeto(Objeto(.x - 1, .y).tp).Tipo).Destroi = 2 And Objeto(.x - 1,.y).caindo = 0 Then
										.DirFuradeira	 = 2
										.ItFuradeira 	-= 1
										.NaFuradeira 	 = 1
										.VirouFuradeira	 = 0
										midiOutShortMsg (hMidiOut, Som(5, comport(tpobjeto(objeto(.x - 1, .y).tp).tipo).som).COn1)
										midiOutShortMsg (hMidiOut, Som(5, comport(tpobjeto(objeto(.x - 1, .y).tp).tipo).som).COn2)
										Som(5, comport(tpobjeto(objeto(.x - 1, .y).tp).tipo).som).Tempo = 16
									End If
								Else
									midiOutShortMsg (hMidiOut, SomEx(6).COn1)
									midiOutShortMsg (hMidiOut, SomEx(6).COn2)
									SomEx (6).Tempo = 10
								End If
							End If
							
						'==========================
						'Aciona bomba pequena
						Case "V"
							If UltTecla <> "V" Then
								If .Itbombinha > 0 And Comport(TpObjeto(Objeto(.x, .y).tp).Tipo).vazio = 1 Then
									.ItBombinha 			-= 1
									objeto(.x, .y).Tp		 = 77
									objeto(.x, .y).Passo	 = 1
								Else
									midiOutShortMsg (hMidiOut, SomEx(6).COn1)
									midiOutShortMsg (hMidiOut, SomEx(6).COn2)
									SomEx (6).Tempo = 10
								End If
							End If
							
						'==========================
						'Aciona bomba grande
						Case "B"
							If UltTecla <> "B" Then
								If .Itbombona > 0 And Comport(TpObjeto(Objeto(.x, .y).tp).Tipo).vazio = 1 Then
									.ItBombona 			-= 1
									objeto(.x,.y).Tp	 = 79
									objeto(.x,.y).Passo	 = 1
								Else
									midiOutShortMsg (hMidiOut, SomEx(6).COn1)
									midiOutShortMsg (hMidiOut, SomEx(6).COn2)
									SomEx (6).Tempo = 10
								End If
							End If
							
						'==========================	
						'****DESATIVAR:::
						'Pula a mina
						Case "TAB"
							If ulttecla <> "TAB" And Jogo.Status = Jogando Then 
								Jogo.SeqCiclo = 0
								MudaStatus VenceuMina
								CalculaBonusTempo
							End If
							
						End Select
					End If
					
					'Atualizar oxigenio - Se estiver vivo e no momento de atualizar (jogo.Ciclo=0)
					If Iniciado = 1 And Jogo.Ciclo = 0 And .morreu = 0 Then
						If (Fundo(.X, .Y) = 0 And (.DirAtual <> 3 Or Fundo(.X, .Y - 1) = 0 Or .Passo < Jogo.Passos / 2)) Or (fundo(.x, .y + 1)=0 And .DirAtual > 3 And .Passo >= Jogo.Passos / 2) Then
							If .Oxigenio > 10 Then .NoOxigenio = 1
							.Oxigenio -= 1
							If .Oxigenio < 0 Then
								If .ItOxigenio > 0 Then
									.ItOxigenio	-= 1
									.Oxigenio	 = 99
									.NoOxigenio	 = 1
								Else
									.Oxigenio	= 0
									.Morreu		= 1
								End If
							End If
						Else
							.NoOxigenio = 0
							If .Oxigenio < 10 Then .Oxigenio += 1
						End If
					End If
				End With 'Boneco
				
				'Verifica Movimentação dos Objetos
				'---------------------------------
				If Iniciado = 1 Then
					With Boneco
						'Se estiver indo para a direita, faz a leitura ao contrário
						If .diratual = 1 Or (.DirAtual = 0 And .UltDir = 1) Then
							Emp1 = Mina.Larg
							Emp2 = 0
							Emp3 = -1
						Else
							Emp1 = 0
							Emp2 = Mina.Larg
							Emp3 = 1
						End If
					End With
					
					'Roda todos os objetos verificando-os   (1 a 1)
					For F = Emp1 To Emp2 Step Emp3
						For G = Mina.Alt To 0 Step -1
						 	With Objeto(F, G)
								'Verifica se há movimento
								If .Passo > 0 Or .empurrando > 0 Then
									'Dá sequencia
									.Passo += 1
									If .tp >= 77 And .Tp <= 80 Then
										.Tp = 77 + 2 * Int((.tp - 77) / 2) + (.passo Mod 2)
										If .Passo >= Jogo.Passos * 6 Then
											Explode (f, g, Int((.tp - 77) / 2) )
										End If
									End If
									
									'Verifica se é queda e se com esse passo atingiu o boneco, que estava subindo
									If .Caindo = 1 And Boneco.X = F And Boneco.Y = G + 2 And Boneco.DirAtual = 3 And (Boneco.Passo + .Passo >= Jogo.Passos) Then
										If Boneco.Morreu = 0 Then
											Boneco.Morreu = 1
											.Passo -= 1
										End If
									End If
									
									'Verifica se concluiu movimento (exceto bombas)
									If .Passo = Jogo.Passos And (.tp < 77 Or .tp > 80)Then
										'conclui queda
										If .Caindo = 1 Then
											Objeto(F, G + 1).AntCaindo	= 1 'informa que ciclo terminou, mas era queda
											Objeto(F, G + 1).Tp 		= .Tp
											Objeto(F, G + 1).Passo 		= 0
											Objeto(F, G + 1).Empurrando	= 0
											Objeto(F, G + 1).Caindo		= 0
											.AntCaindo	= 0
											.Passo		= 0
											.Empurrando	= 0
											.Caindo		= 0
											.Tp			= 0
											
											'Verifica se a queda do objeto terminou, ou seja, chocou-se sobre outro objeto
											If objeto(f, g + 2).caindo = 0 And comport(tpobjeto(objeto(f, g + 2).tp).tipo).vazio = 0 Then
												Toca(comport(tpobjeto(objeto(f, g + 1).tp).tipo).som, comport(tpobjeto(objeto(f, g + 2).tp).tipo).som) = 1
											End If
										End If
									End If
									
									
								'Trata queda de objetos:
									
								'Verifica se o objeto já estava caindo 
								ElseIf .AntCaindo = 1 Then
									
									'Verifica se para de cair (cai sobre apoio)
									If Comport(TpObjeto(Objeto(f, g + 1).Tp).Tipo).Apoia = 1 Then
										.AntCaindo = 0
										
									'Verifica se cai sobre o boneco
									ElseIf Boneco.Morreu = 0 And (Boneco.Y = G + 1 And ((Boneco.X = F And Boneco.DirAtual < 4 And (Boneco.DirAtual = 0 Or Boneco.Passo < Int((Jogo.Passos - 1) * .8))) Or _
									(Boneco.X = F - 1 And Boneco.DirAtual = 1) Or (Boneco.X = F + 1 And Boneco.DirAtual = 2))) Then
										Boneco.Morreu = 1
										
									Else	'Se não cai sobre apoio nem sobre o boneco, continua caindo
										.Caindo	= 1
										.Passo	= 1
									End If
									
								'Se não estava caindo, verifica se começa a cair (se não está apoiado por objeto ou pelo boneco)
								ElseIf Comport(TpObjeto(.tp).Tipo).Cai = 1 And G < Mina.Alt And Comport(TpObjeto(Objeto(F, G + 1).tp).Tipo).Apoia = 0 And _
								Objeto (F - 1,G + 1).Empurrando <> 1 And Objeto (F + 1, G + 1).Empurrando <> 2 Then
									If boneco.morreu = 0 And (Boneco.Y = g + 1 And (Boneco.X = F Or (Boneco.X = F - 1 And Boneco.DirAtual = 1) Or _
									(Boneco.X = F + 1 And Boneco.DirAtual = 2))) Then
										.AntCaindo = 0
										
									Else	'Não cai
										.Caindo	= 1
										.Passo	= 1
									End If
								End If
							End With
						Next
					Next
				End If 
				
				If Iniciado = 0 And mina.tesouros > 0 Then
					Desenha
					If Jogo.Status = Testando Then
						Mensagem 1, 2, TXT(60), TXT(96), ""
					Else
						Mensagem 1, 2, TXT(60), TXT (61) & " . . . " & Str(Int (TIMESTART - Timer + 1)), ""
					End If
					For F = 0 To 9
						Msg(f).Ciclo = 0
					Next
				Else
					For f = 1 To 6 'Rotina para gerar o som
						For g = 1 To 4
							If toca(f, g) = 1 Then
								midiOutShortMsg(hMidiOut, Som (f, g).COn1)
								midiOutShortMsg(hMidiOut, Som (f, g).COn2)
								Som (f, g).Tempo = 8
							End If
						Next
					Next
					
					Desenha
				End If
			Else
				DesligaSons
			End If
		'-------------------------------------------------------------------------------------------
		
		Case Pausado 'PAUSA NO JOGO
		
			'desenha fundo e LOGO
			DesFundo
			Mensagem 7, 2, TXT(62), TXT(63), ""
			If tecla <> "" And tecla <> ultTecla Then
				Jogo.status = Jogo.StatusAnt
			End If
			
		'-------------------------------------------------------------------------------------------
		
		Case GameOver 'GAME OVER
		
			Desenha
			SorteiaNotaGameOver
			If XM < 30 Then
				Put ( 240 + XM * 3, XM * 8.5), BMP (212), (0, 0) - (112, 28), Trans
				Put ( 452 - xm * 3, 580- xm * 8.5), BMP (212), (18, 33) - (127, 63), Trans
				XM += 1
			ElseIf XM < 60 Then
				Put (334 + Rnd * (60 - XM), 268+Rnd * (60 - XM)), BMP (212), Trans
				XM += 1
			ElseIf XM < 2000 Then
				Put (334 + Rnd * (260-XM)/75, 268 + Rnd * (260-XM)/75), BMP (212), Trans
				XM += 1
			Else
				midiOutShortMsg (hMidiOut, &H6f0087 Or UltNotaGameOver)
				Tecla = "A"
			End If
			If tecla <> "" And tecla <> ultTecla Then
				midiOutShortMsg (hMidiOut, &H6f0087 Or UltNotaGameOver)
				PosTop10 = VerificaRecorde ()
				If PosTop10 > 0 Then
					MudaStatus Top10
				Else
					MudaStatus NoMenu
				End If
				IniciaJogo
				IniciaVida
				TTDemo1 = Timer
				VRed=Int(Rnd*2)
				VGreen=Int(Rnd*2)
				VBlue=Int(Rnd*2)
				If VRed+VGreen+VBlue=0 Then VBlue=1
			End If
			
		'-------------------------------------------------------------------------------------------
		
		Case ModoMapa 'Modo de MAPA
		
			Select Case Tecla	
			Case "U"
				MapY -= 1
				If MapY < 0 Then MapY = 0
			Case "D"
				MapY += 1
				If MapY > Mina.Alt - 16 Then MapY -= 1
			Case "R"
				Mapx += 1
				If MapX > Mina.Larg - 24 Then MapX -= 1
			Case "L"
				MapX -= 1
				If MapX < 0 Then MapX = 0
			Case "" 
				'Não faz nada
			Case Else
				If UltTecla <> Tecla Then Jogo.Status = Jogo.StatusAnt
			End Select
			
			'Verifica se acabou o tempo
			If (jogo.SeqCiclo Mod 5=0) And (jogo.Ciclo=0) And (iniciado > 0) And (boneco.morreu = 0) Then
				boneco.Tempo += 1
				If (boneco.tempo>=mina.tempo) And (mina.tempo>0) Then
					boneco.morreu = 1
					Jogo.status = Jogo.StatusAnt
				End If
			End If
			
			Desenha
			Line(2,551)-(545,596),Point(2,551),b
			Line(3,552)-(544,595), Point(3,552),b
			Line(4,553)-(543,594), Point(4,553),b
			Line (5,554)-(542,593),Point(5,554),bf
			Line(2,597)-(545,597),Point(2,597)
			Line(110,554)-(110,593),Point(2,551)
			Escreve TXT(64), 10, 560, 0, 0
			Escreve TXT(65), 127, 552, 0, 0
			Escreve TXT(66), 115, 572, 0, 0
			If Int (Timer * 10) Mod 5 <=2 Then
				Mensagem 2, 0, TXT(64), "", "", 750 - LargTexto (txt(64), 1)/2, 500
			End If
			
		'-------------------------------------------------------------------------------------------
		
		Case Instruc 'FreeBasic Miner?
		
			DesFundo
			Line (0, 565) - (799, 599), RGB(48 * VRed, 48 * VGreen, 48 * VBlue), BF
			
			If (ulttecla <> tecla And Tecla <>"") Or (MouseDisparou = 1) Then
				MudaStatus NoMenu
				Jogo.Ciclo=0
				Jogo.SeqCiclo=0
			End If
			
			PutLogo 290, 40
			EscreveCentro TXT(67), 570, 1, 1
			EscreveCentro TXT(68), 150
			EscreveCentro TXT(69), 180
			EscreveCentro TXT(70), 210
			EscreveCentro TXT(71), 240
			EscreveCentro TXT(72), 270
			EscreveCentro TXT(73), 305
			EscreveCentro TXT(74), 340,1
			Put (370,430), BMP(252), Trans
			EscreveCentro TXT(75), 480, 1, 1
			
		'-------------------------------------------------------------------------------------------
		
		Case VenceuMina 'CONCLUIU A MINA	
		
			Desenha
			If Jogo.StatusAnt = Testando Then
				F = PerguntaSeEncerraTeste
			Else
				If mina.Tipo = 0 Then
					If Boneco.Mina < Jogo.NumMinas Then
						Mensagem 2, 6, TXT(76), TXT(77) & ": " & Str(PtBonus), ""
					Else
						Mensagem 2, 6, TXT(76), TXT(77) & ": " & Str(PtBonus), TXT(94) & ": " & Str(boneco.Vidas) & " x 1000 = " & Str(boneco.vidas * 1000)
					End If
				Else
					Mensagem 2, 6, TXT(78), TXT(77) & ": " & Str(PtBonus), TXT(79) & Str(Boneco.Pontos + PtBonus)
				End If
				If tecla <> "" And tecla <> ultTecla Then
					If mina.Tipo = 0 Then
						If Boneco.Mina = Jogo.NumMinas Then
							MudaStatus VenceuJogo
							QtdNotasVenceu = 0
							UltNotaGameOver = 0
							Jogo.SeqCiclo =- 1
						Else
							Boneco.Mina +=1
							If Boneco.Mina > Jogo.MaxAlcancada Then
								Jogo.MaxAlcancada  = Boneco.Mina
								RegravaConfig
							End If
							IniciaVida
							MudaStatus Jogando
							LeMinaIn Boneco.Mina
							Iniciado=0	
							TIMESTART = Timer + 5
						End If
						Boneco.Pontos += PtBonus
						If Boneco.Mina = Jogo.NumMinas Then Boneco.Pontos += Boneco.Vidas * 1000
					Else
						MudaStatus NoMenu
					End If				
				End If
			End If
		'-------------------------------------------------------------------------------------------
		
		Case VenceuJogo 'VENCEU O JOGO
		
			For f=0 To 19
				g=Int(Rnd*100)
				h=Int(Rnd*60)
				Frente (g,h)=0
				Fundo (g,h)=1
				objeto (g,h).tp = 40 + Int(Rnd*16)
			Next
			
			SorteiaNotaVenceu
			
			Desenha
			jogo.Ciclo=jogo.passos-1
			Mensagem 0, 12, TXT(80), TXT(81), ""
			If tecla <> "" And tecla <> ultTecla Then
				midiOutShortMsg (hMidiOut, &H6f0080 Or UltNotaGameOver)
				midiOutShortMsg (hMidiOut, &H5f0080 Or (UltNotaGameOver + 513))
				PosTop10 = VerificaRecorde()
				If PosTop10 > 0 Then
					MudaStatus Top10
				Else
					MudaStatus NoMenu
				End If
				IniciaJogo
				IniciaVida
				LimpaMina
				TTDemo1 = Timer
				VRed=Int(Rnd*2)
				VGreen=Int(Rnd*2)
				VBlue=Int(Rnd*2)
				If VRed+VGreen+VBlue=0 Then VBlue=1
				Jogo.SeqCiclo=0
			End If
			
		'-------------------------------------------------------------------------------------------
		
		Case Top10 'TOP 10
		
			DesFundo
						
			DesBox 14, 11, 3, 400, 310
						
			'Logo
			PutLogo 290, 40
			
			'Opções:
			EscreveCentro "Top 10", 140, 2, 1
		
			For f = -1 To 9
				Line(197, 200 + f * 30) - Step (394, 0), RGB (128, 128, 128)
			Next
			
			If PosTop10 > 0 Then
				Line(187, 175 + (PosTop10 - 1) * 30) - Step (413, 31), RGB (80 + 80 * VRed, 80 + 80 * VGreen, 80 + 80 * VBlue), bf
				Line(190, 178 + (PosTop10 - 1) * 30) - Step (407, 25), RGB (48 + 48 * VRed, 48 + 48 * VGreen, 48 + 48 * VBlue), bf
			End If
			
			For f=0 To 9
				g = len (Toppt(f).nome)
				While LargTexto (left(Toppt(f).nome, g), 1) > 399 - ((largTexto ("0",1)+2) * (1+len (str(Toppt(f).Pontos))))
					g -= 1
				Wend
				Escreve Left(toppt(f).nome, g), 198, 180 + f * 30, 1, 0
				Escreve Str(toppt (f).pontos), 602 - ((largTexto ("0",1) +2)* ( 1 + len (str(Toppt(f).Pontos)))), 180 + f * 30, 1, 0
			Next
			
			If ConfirmDel = 0 Then
				EscreveCentro TXT(82), 520, 1, 0
			ElseIf ConfirmDel = 1 Then
				Mensagem 1, 5, TXT(83), TXT(84), "", , , Opcao1
			ElseIf ConfirmDel = 2 Then
				Mensagem 0, 5, TXT(90), TXT(91), "", , , Opcao1
			End If
			
			If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1

			If (Tecla <> UltTecla And Tecla <> "") Or (MouseDisparou = 1) Then
				If ConfirmDel = 0 Then
					If Tecla = "<" Then
						ConfirmDel = 1
						Opcao1 = 1
					Else
						PosTop10 = 0
						MudaStatus NoMenu
					End If
				Else
					If Tecla = "ESC" Then
						ConfirmDel = 0
					ElseIf (Tecla = "U") Or (Tecla = "D") Or (Tecla = "R") Or (Tecla = "L") Then
						Opcao1 = 1 - Opcao1
					ElseIf (Tecla ="[") Or (Tecla = "]") Or (MouseDisparou = 1) Then
						Select Case ConfirmDel
						Case 1
							If Opcao1 = 0 Then
								LimpaTopDez
								PosTop10 = 0
							End If
							ConfirmDel = 2
							Opcao1 = 1

						Case 2
							If Opcao1 = 0 Then
								Jogo.MaxAlcancada = 1
								RegravaConfig
								ConfirmDel = 0
							Else 
								ConfirmDel = 0
							End If
						End Select
					End If
				End If
			End If
			
		'-------------------------------------------------------------------------------------------
		
		Case Editor
			
			Edita
			If Jogo.Status = Editor Then Desenha
			
		'-------------------------------------------------------------------------------------------
			
		End Select
		
		'Calcula e mostra FPS
		Quadros += 1
		Timer2 = Timer
		'Escreve Right ("0000" + str(UltQuadros), 4) , 0, 0, 1, 1
		If Int(Timer2) <> Int (Timer1) Then
			Timer1 = Timer2
			UltQuadros = Quadros
			Quadros = 0
		End If
		
		'FLIP + temporizador
		TrocaTelas

TerminaCiclo:
	Wend
	
End Sub

'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------

'Boneco recolhe pedras ou outros objetos

Sub PegaObj (POX As Integer, POY As Integer)
	With boneco
		Select Case TpObjeto (Objeto(POX,POY).TP).Item
		Case 1
			.ItOxigenio+=1
			midiOutShortMsg (hMidiOut, SomEx(4).COn1)
			midiOutShortMsg (hMidiOut, SomEx(4).COn2)
			SomEx (4).Tempo = 10
		Case 2
			.ItSuporte+=1
			midiOutShortMsg (hMidiOut, SomEx(4).COn1)
			midiOutShortMsg (hMidiOut, SomEx(4).COn2)
			SomEx (4).Tempo = 10
		Case 3
			.ItPicareta+=1
			midiOutShortMsg (hMidiOut, SomEx(4).COn1)
			midiOutShortMsg (hMidiOut, SomEx(4).COn2)
			SomEx (4).Tempo = 10
		Case 4
			.ItFuradeira+=1
			midiOutShortMsg (hMidiOut, SomEx(4).COn1)
			midiOutShortMsg (hMidiOut, SomEx(4).COn2)
			SomEx (4).Tempo = 10
		Case 5
			.ItBombinha+=1
			midiOutShortMsg (hMidiOut, SomEx(4).COn1)
			midiOutShortMsg (hMidiOut, SomEx(4).COn2)
			SomEx (4).Tempo = 10
		Case 6
			.ItBombona+=1
			midiOutShortMsg (hMidiOut, SomEx(4).COn1)
			midiOutShortMsg (hMidiOut, SomEx(4).COn2)
			SomEx (4).Tempo = 10
		'Recolhe tesouros:
		Case 7 To 22
			midiOutShortMsg (hMidiOut, SomEx(5).COn1)
			midiOutShortMsg (hMidiOut, SomEx(5).COn2)
			SomEx (5).Tempo = 10
			VeSeGanhaVida PontoTesouro(TpObjeto (Objeto(POX, POY).TP).Item)
			MarcaPt (PontoTesouro(TpObjeto (Objeto(POX, POY).TP).Item), POX, POY)
			.Pontos += PontoTesouro(TpObjeto (Objeto(POX, POY).TP).Item)
			Mina.Tesouros -= 1
			If Mina.Tesouros = 0 Then
				Jogo.SeqCiclo = 0
				
				If jogo.status = Jogando Or Jogo.Status = Testando Then 'Termina a fase
					Jogo.StatusAnt = Jogo.Status
					MudaStatus VenceuMina
					CalculaBonusTempo
					
				Else 'Termina a demonstração
					MudaStatus NoMenu
					VRed = Int(Rnd*2)
					VGreen = Int(Rnd*2)
					VBlue = Int(Rnd*2)
					If VRed + VGreen + VBlue = 0 Then VBlue = 1
				End If
				
			End If
		End Select

	End With

	'Limpa o objeto
	If Objeto(POX, POY).Tp <77 Or Objeto(POX, POY).Tp > 80 Then
		If Comport(TpObjeto(Objeto(POX, POY).Tp).Tipo).Anda=1then
			Objeto(POX,POY).Tp=0
		End If
		Objeto(POX,POY).Caindo=0
		Objeto(POX,POY).AntCaindo=0
		Objeto(POX,POY).Empurrando=0
		Objeto(POX,POY).Passo=0
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Verifica possibilidade e inicia o empurrar de objetos

Function EmpurraObj (ByVal POX As Integer, ByVal POY As Integer, ByVal MDir As Integer, ByVal Peso As Integer, ByVal Quant As Integer) As Integer
	Dim As Integer Resultado, XR, PesoTemp
	Resultado= Comport(TpObjeto(objeto(POX, POY).Tp).Tipo).PEmpurra
	XR= 3 - (MDir * 2)
		
	'Antes, verifica se o objeto não está caindo nem vai começar a cair agora
	If (Comport(TpObjeto(Objeto(POX, POY).tp).Tipo).Cai =1 And POY < Mina.Alt And Comport(TpObjeto(Objeto(POX, POY+1).tp).Tipo).Apoia=0) Or Objeto (POX, POY).Caindo=1 Then
		Resultado=5
	Else	
		
		'Só faz verificação se ainda não tiver chegado ao canto da mina
		If POX >0 And POX < Mina.Larg Then
			If Resultado + Peso > 2 Then
				Resultado = 3
				
			ElseIf Resultado = 2 Then
				If Quant=1 And Comport(TpObjeto(objeto(POX + XR, POY).Tp).Tipo).Vazio=1 And Objeto(POX + XR, POY - 1).caindo=0 Then
					Resultado = 2
				Else
					Resultado = 3
				End If
				
			ElseIf Resultado =1 Then
				If Quant=1 Then
					If Comport(TpObjeto(objeto(POX + XR, POY).Tp).Tipo).Vazio=1 And Objeto(POX + XR, POY - 1).caindo=0 Then
						Resultado=1
					Else
						PesoTemp = EmpurraObj (POX + XR, POY, MDir, 1, 2)
						If PesoTemp <= 1 Then
							Resultado = PesoTemp + 1
						Else
							Resultado = 3
						End If
					End If
				
				ElseIf quant = 2 And peso < 2 Then
					If Comport(TpObjeto(objeto(POX + XR, POY).Tp).Tipo).Vazio=1 And Objeto(POX + XR, POY - 1).caindo=0 Then
						Resultado = 1
					Else
						Resultado = 3
					End If
				Else
					Resultado = 3
				End If
				
			ElseIf Resultado =0 Then
				If Peso > 0 And Quant >2 Then
					Resultado = 3
				Else
					If Comport(TpObjeto(objeto(POX + XR, POY).Tp).Tipo).Vazio=1 And Objeto(POX + XR, POY - 1).caindo=0 Then
						Resultado = Peso
					Else
						PesoTemp = EmpurraObj (POX + XR, POY, MDir, Peso, Quant + 1)
						If PesoTemp <= 1 Then
							Resultado = Peso
						Else
							Resultado=3
						End If
					End If
				End If
			End If
		Else
			Resultado = 3
		End If
	End If

	If Resultado < 3 Then
		Objeto(POX,POY).Empurrando = MDir
		Objeto(POX,POY).Passo = 0
	End If

	Return Resultado
End Function

'-------------------------------------------------------------------------------------------

'Inicia uma explosao (bomba ou morte do boneco)

Sub Explode (ByVal EXX As Integer, ByVal EXY As Integer, ByVal XTam As Integer)
	Dim As Integer LF, LG, NTam
	NTam=XTam
	midiOutShortMsg (hMidiOut, SomEx(XTam+1).COn1)
	midiOutShortMsg (hMidiOut, SomEx(XTam+1).COn2)
	SomEx (XTam+1).Tempo = 16

	If XTam=2 Then XTam=1
	Objeto (EXX, EXY).tp = 0
	For LF = -1 To 1
		For lg = -XTam To XTam
			With Objeto(EXX+LF,EXY+LG)
				If .Tp >=77 And .Tp<=80 Then
					Explode (EXX+LF, EXY+LG, Int((.tp-77)/2))
				ElseIf Comport(TpObjeto(.Tp).Tipo).Destroi>0 Then
					.Tp=0
				End If
			End With
		Next
	Next

	With Boneco
		If .morreu=0 And .x >= EXX-2 And .X <=EXX+2 Then 
			If (.X =EXX-2 And .DirAtual=1 And .Passo>=jogo.Passos * .4) Or (.X=EXX-1 And (.dirAtual<>2 Or .Passo<=Jogo.Passos * .6)) Or .x=EXX Or (.x=EXX+1 And (.diratual<>1 Or .Passo<=Jogo.Passos * .6)) Or (.X =EXX+2 And .DirAtual=2 And .Passo>=jogo.Passos * .4) Then
				If XTam=0 Then
					If (.Y =EXY-1 And .DirAtual>3 And .Passo>=jogo.Passos * .4) Or (.Y=EXY And (.dirAtual<3 Or .Passo<=Jogo.Passos * .6)) Or (.Y =EXY+1 And .DirAtual=3 And .Passo>=jogo.Passos *.3) Then .Morreu=1
				Else
					If (.Y =EXY-2 And .DirAtual>3 And .Passo>=jogo.Passos * .4) Or (.Y=EXY-1 And (.dirAtual<>3 Or .Passo<=Jogo.Passos * .6)) Or .Y=EXY Or (.Y=EXY+1 And (.diratual<4 Or .Passo<=Jogo.Passos * .6)) Or (.Y =EXY+2 And .DirAtual=3 And .Passo>=jogo.Passos * .4) Then .Morreu=1
				End If
			End If
		End If
	End With

	Jogo.UltExplosao = (Jogo.UltExplosao + 1) Mod 11
	With Explosao(Jogo.UltExplosao)
		.X=EXX
		.Y=EXY
		.Tipo=XTam+1
		.Tempo=1
	End With

End Sub


'-------------------------------------------------------------------------------------------

'Esvazia o conteúdo da matriz da mina

Sub LimpaMina
	Dim as integer F, G
	For f = -1 To 100
		For g = -1 To 60
			Frente (f, g) = 0
			Fundo (f, g) = 1
			Objeto (f, g).tp = 0
			Objeto (f, g).Caindo = 0
			Objeto (f, g).AntCaindo = 0
			Objeto (f, g).Empurrando = 0
			Objeto (f, g).Passo = 0
		Next
	Next
	Mina.Larg = 99
	Mina.Alt = 59
	Mina.X = 0
	Mina.Y = 0
	Boneco.X = 0
	Boneco.Y = 0
	MAPX = 0
	MAPY = 0
End Sub

'-------------------------------------------------------------------------------------------

'Reinicia tabela de recordes

Sub LimpaTopDez
	Dim as integer F
	Kill "Top10.min"
	MontaTopDez
	Open "Top10.min" For Output As #1
	For f=0 To 9
		Print #1, toppt(f).nome; ", " ; Str(toppt(f).pontos)
	Next
	Close #1
End Sub

'-------------------------------------------------------------------------------------------

'Verifica se está entre os TOP 10, solicita nome e inclui na tabela

Function VerificaRecorde As Integer
	Dim as integer F
	Dim Posit As Integer
	Dim TecX As String
	Posit = 10
	For F = 9 To 0 Step -1
		If Boneco.pontos > TopPt(f).Pontos Then Posit = F
	Next
	If Posit < 10 Then
		For f = 9 To Posit Step -1
			TopPt(f+1).Pontos = TopPt(f).Pontos
			TopPt(F+1).Nome = TopPt(f).Nome
		Next
		TopPt(Posit).Pontos = Boneco.Pontos
		LimpaTeclado
		TecX=""
		
		While TecX <> Chr(13)
			TecX=Inkey
			If Len(TecX)>0 Then
				If InStr(" " + Lt, TecX)>0 And Len (Boneco.nome) < 20 And TecX <> "," Then Boneco.Nome += TecX
				If tecx=Chr(8) Or tecx=Chr(255)+Chr(83) And Len(boneco.nome)>0 Then boneco.nome=Left(boneco.nome, Len(boneco.nome)-1)
			End If
			DesFundo
			Mensagem 4, 10, TXT(85), TXT(86), "", , 220
			If boneco.nome="" Then
				Mensagem 2, 10, " ", Chr (32 + 63 * ((Timer * 2) Mod 2)), " ",, 360
			Else
				Mensagem 2, 10, " ", boneco.nome & Chr (32 + 63 * ((Timer * 2) Mod 2)), " ",, 360
			End If
			TrocaTelas
		Wend
		Cls
		UltTecla = "["
		Tecla = "["
		If boneco.nome="" Then boneco.nome="?"
		TopPt(Posit).Nome=boneco.nome
		
		LimpaTeclado
		
		Kill "Top10.min"
		Open "Top10.min" For Output As #1
		For f=0 To 9
			Print #1, toppt(f).nome; ", " ; Str(toppt(f).pontos)
		Next
		Close #1
	End If

	If Posit < 10 Then Return (Posit + 1) Else Return 0
	
End Function

'-------------------------------------------------------------------------------------------

'Le a tabela dos TOP 10

Sub LeTopDez
	Dim as integer F
	'Lê Top10. Se não houver, reinicia recordes
	If FileExists("Top10.min") Then
		Open "Top10.min" For Input As #1
		For f=0 To 9
			Input #1, TopPt(f).nome, TopPt(f).pontos
		Next
		Close #1
	Else
		MontaTopDez
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Reinicia tabela de TOP 10

Sub MontaTopDez
	TopPt(0).nome = "Top1" : TopPt(0).pontos = 15000
	TopPt(1).nome = "Top2" : TopPt(1).pontos = 12500
	TopPt(2).nome = "Top3" : TopPt(2).pontos = 10000
	TopPt(3).nome = "Top4" : TopPt(3).pontos =  9000
	TopPt(4).nome = "Top5" : TopPt(4).pontos =  8000
	TopPt(5).nome = "Top6" : TopPt(5).pontos =  7000
	TopPt(6).nome = "Top7" : TopPt(6).pontos =  5000
	TopPt(7).nome = "Top8" : TopPt(7).pontos =  4000
	TopPt(8).nome = "Top9" : TopPt(8).pontos =  3000
	TopPt(9).nome = "Top10" : TopPt(9).pontos = 2000
End Sub


'-------------------------------------------------------------------------------------------

'Faz a troca de screens e ajusta o FPS

Sub TrocaTelas
	Dim As Integer tempo, Falta

	ScreenSet 1 - ScrAtiva,  ScrAtiva
	ScrAtiva = 1 - ScrAtiva
	
	'Ajuste FPS
	ATimer = NTimer
	NTimer = Int(Timer * 1000)
	Falta = 1
	Tempo = NTimer - ATimer
	Falta = Jogo.DelayMSec - Tempo 
	If Falta < 1 Then Falta = 1
	If MultiKey(SC_LSHIFT) Or MultiKey(SC_RSHIFT) Then
		Sleep 1, 1
	Else
		Sleep Falta, 1
	End If
 End Sub

'-------------------------------------------------------------------------------------------

'Manda desenhar o quadro e escreve as mensagens

Sub Mensagem (QCor As Integer, Tipo As Integer, T1 As String, T2 As String, T3 As String, OX As Integer = 400, OY As Integer= 300, Opcao As Integer = 0)

'Tipos:
'0-Sem ícone + pressiona qq tecla
'1-Sem ícone + Sim / Não
'2-Exclamação + Pressiome qq tecla
'3-Exclamação + Sim / Não
'4-Interrogação + pressiona qq tecla
'5-Interrogação + Sim / Não
'6-Ok + pressiona qq tecla
'7-Ok + Sim / Não
'8-Dame + pressiona qq tecla
'9-Dame + Sim / Não
'10-Medalha + pressiona qq tecla
'12-ByNIZ + pressiona qq tecla

	Dim As Integer Larg, Alt, V, F
	Dim As String Tex (2)
	
	If T2 = "" Then
		Alt = 1
	ElseIf T3 = "" Then
		Alt = 2
	Else
		Alt = 3
	End If
	V = Alt
	
	Tex(0) = T1
	Tex(1) = T2
	Tex(2) = T3
	
	Larg = 10
	For F = 0 To 2
		If LargTexto (Tex (f), - (f = 0)) > Larg Then Larg = LargTexto (Tex (f), - (f = 0))
	Next
	
	Larg = Int (Larg / 32) + 1
	If Tipo > 1 Then Larg += 2
	If (Tipo Mod 2 = 1) And (Larg < 7) Then Larg = 7
	If Tipo Mod 2 = 1 Then Alt += 2
	If Tipo > 1 And Alt < 2 Then Alt = 2

	DesBox Larg, Alt, QCor, OX, OY
	For F = 0 To V - 1
		Escreve Tex(F), OX - 24 * (Tipo > 1) - LargTexto(Tex(F), - (f = 0)) /2  , OY - Alt * 16 + F * 32 + 4, - (f = 0), 0
	Next
	If Tipo > 1 Then Put (OX - Larg * 16, OY - Alt * 16), BMP (252 + Int(Tipo / 2)),Trans

	MouseSimNao = 0

	If Tipo Mod 2 = 1 Then
		Put (OX - 66 + Opcao * 76, Oy + Alt * 16 - 38), BMP (276), (576, 0) - (630, 32), Trans
		Put (OX + 10 - 76 * Opcao, Oy + Alt * 16 - 38), BMP (276), (576, 33) - (630, 65), Trans
		Escreve TXT(58), OX - 38 - LargTexto (TXT (58), 0)/2, Oy + Alt * 16 - 32, 0, 0
		Escreve TXT(59), OX + 38 - LargTexto (TXT (59), 0)/2, Oy + Alt * 16 - 32, 0, 0
		Put (OX - 66 + Opcao * 76, Oy + Alt * 16 - 40), BMP (276), (576, 66) - (630, 102), Trans
		If (MouseY > OY + Alt * 16 - 39) And (MouseY < Oy + Alt * 16 - 4) Then
			If MouseX > OX - 67 And MouseX < OX - 9 Then MouseSimNao = 1
			If MouseX > OX + 9 And MouseX < OX + 67 Then MouseSimNao = 2
		End If
	End If

End Sub

'-------------------------------------------------------------------------------------------

'Desenha o quadro (para mensagens)

Sub DesBox (H As Integer, V As Integer, QCor As Integer, OX As Integer = 400, OY As Integer = 300)
	Dim as integer F, G
	If QCor < 4 Then
		Put (OX - 16 - H * 16, OY - 16 - V * 16), BMP (248 + QCor), (0, 0) - Step (15, 15), Alpha
		Put (OX - 16 - H * 16, OY + V * 16), BMP (248 + QCor), (0, 48) - Step (15, 15), Alpha
		Put (OX + H * 16, OY - 16 - V * 16), BMP (248 + QCor), (48, 0) - Step (15, 15), Alpha
		Put (OX + H * 16, OY + V * 16), BMP (248 + QCor), (48, 48) - Step (15, 15), Alpha
		For F = 0 To H - 1
			Put (OX - H * 16 + F * 32, OY - 16 - V * 16), BMP (248 + QCor), (16, 0) - Step (31, 15), Alpha
			Put (OX - H * 16 + F * 32, OY + V * 16), BMP (248 + QCor), (16, 48) - Step (31, 15), Alpha
			For G = 0  To V - 1
				Put (OX - H * 16 + F * 32, OY - V * 16 + G * 32), BMP (248 + QCor), (16, 16) - Step (31, 31), Alpha
			Next
		Next
		For G = 0  To V - 1
			Put (OX - 16- H * 16, OY - V * 16 + G * 32), BMP (248 + QCor), (0, 16) - Step (15, 31), Alpha
			Put (OX + H * 16, OY - V * 16 + G * 32), BMP (248 + QCor), (48, 16) - Step (15, 31), Alpha
		Next
	Else
		QCor -= 4
		Put (OX - 16 - H * 16, OY - 16 - V * 16), BMP (248 + QCor), (0, 0) - Step (15, 15), Trans
		Put (OX - 16 - H * 16, OY + V * 16), BMP (248 + QCor), (0, 48) - Step (15, 15), Trans
		Put (OX + H * 16, OY - 16 - V * 16), BMP (248 + QCor), (48, 0) - Step (15, 15), Trans
		Put (OX + H * 16, OY + V * 16), BMP (248 + QCor), (48, 48) - Step (15, 15), Trans
		For F = 0 To H - 1
			Put (OX - H * 16 + F * 32, OY - 16 - V * 16), BMP (248 + QCor), (16, 0) - Step (31, 15), Trans
			Put (OX - H * 16 + F * 32, OY + V * 16), BMP (248 + QCor), (16, 48) - Step (31, 15), Trans
			For G = 0  To V - 1
				Put (OX - H * 16 + F * 32, OY - V * 16 + G * 32), BMP (248 + QCor), (16, 16) - Step (31, 31), Trans
			Next
		Next
		For G = 0  To V - 1
			Put (OX - 16- H * 16, OY - V * 16 + G * 32), BMP (248 + QCor), (0, 16) - Step (15, 31), Trans
			Put (OX + H * 16, OY - V * 16 + G * 32), BMP (248 + QCor), (48, 16) - Step (15, 31), Trans
		Next
	End If
End Sub
 
'-------------------------------------------------------------------------------------------

'Desenha o LOGO do game

Sub PutLogo (LX As Integer, LY As Integer)
	Put (LX, LY), BMP (211), Trans
End Sub

'-------------------------------------------------------------------------------------------

Function CTRX As Integer
	With Boneco
		If .X < 12 Then
			Return .X * 32 + 16
		ElseIf .X > Mina.Larg - 12 Then
			Return 784 - (Mina.LArg - .X) * 32
		Else	
			Return 399
		End If
	End With
End Function

'-------------------------------------------------------------------------------------------

Function CTRY As Integer
	With Boneco
		If .Y < 8 Then
			Return .Y * 32 + 16
		ElseIf .Y > Mina.Alt - 8 Then
			Return 500 - (Mina.Alt - .Y) * 32
		Else	
			Return 240
		End If
	End With
End Function

'-------------------------------------------------------------------------------------------

Sub MarcaPt (Pontos As Integer, X As Integer, Y As Integer)
	With  MSG (ProxMsg)
		.Ciclo = 63
		.Pontos = Pontos
		.X = X
		.Y = Y
	End With
	ProxMsg = (ProxMsg + 1) Mod 10
End Sub

'-------------------------------------------------------------------------------------------

'Simula pressionamento de teclas no modo demo

Function ProximaTeclaDemo As String
	Dim TecTemp As String
	Dim As Integer ValTemp, BX, BY

	BX = Boneco.X
	BY = Boneco.Y
	If Boneco.Passo = Jogo.Passos Then
		Select Case boneco.DirAtual
		Case 1
			bx = bx + 1
		Case 2
			bx = bx - 1
		Case 3 
			by = by - 1
		Case 4, 5
			by = by + 1
		End Select
	End If
	If TempMens > 0 Then
		TempMens = TempMens-1
		If TempMens > 0 Then
			Return " " 
			GoTo SaiDaqui
		End If
	End If
	MensDemo = 0

Proximo:
	If PositDemo > Len (TeclasDemo)/3 Then
		PositDemo = 0
		Return "ESC"
	Else
		TecTemp = Mid(teclasdemo, positdemo * 3 + 1, 1)
		Select Case TecTemp
		
		Case "M"
			MensDemo = Val(Mid(teclasdemo, positdemo * 3 + 2, 2))
			TempMens = 250
			PositDemo = PositDemo + 1
			Return " "
			
		Case "#"
			Return "ESC"
			PositDemo = 0
			
		Case "W"
			ValTemp=Val(Mid(teclasdemo, positdemo * 3 + 2, 2))
			If DemoW1 = 0 Then
				DemoW1 = ValTemp
				DemoW2 = 0
			Else
				DemoW2 = DemoW2 + 1
				If DemoW2 >= DemoW1 Then
					DemoW1 = 0
					DemoW2 = 0
					PositDemo = PositDemo + 1
					GoTo Proximo
				End If
			End If
			Return ""
			
		Case "I"
			TecTemp = Mid(teclasdemo, positdemo * 3 + 2, 1)
			If TecTemp="D" Then TecTemp="V"
			If TecTemp="C" Then
				If Mid(teclasdemo, positdemo * 3 + 3, 1) = "R" Then
					Boneco.DirFuradeira = 1
				ElseIf Mid(teclasdemo, positdemo * 3 + 3, 1) = "L" Then
					Boneco.DirFuradeira = 2
				End If
			End If
			PositDemo = PositDemo + 1
			Return TecTemp
			
		Case "R"
			ValTemp=Val(Mid(teclasdemo, positdemo * 3 + 2, 2))
			If bX < ValTemp Then
				Return TecTemp
			Else
				PositDemo = PositDemo + 1
				GoTo Proximo
			End If
			
		Case "L"
			ValTemp=Val(Mid(teclasdemo, positdemo * 3 + 2, 2))
			If bX > ValTemp Then
				Return TecTemp
			Else
				PositDemo = PositDemo + 1
				GoTo Proximo
			End If
			
		Case "U", "D"
			ValTemp=Val(Mid(teclasdemo, positdemo * 3 + 2, 2))
			If bY <> ValTemp Then
				Return TecTemp
			Else
				PositDemo = PositDemo + 1
				GoTo Proximo
			End If
		End Select
	End If

SaiDaqui:

End Function

'-------------------------------------------------------------------------------------------

'Le mina do arquivo (padrão)

Sub LeMinaIn (NMina As Integer, SoQuant As Integer = 0)
	Dim As LongInt FilePos, FileTam
	Dim As UShort MinaTemp, TotMinas
	Dim As UByte Temporary1
	Randomize

	LimpaMina

	'zera contador de tesouros para iniciar a contagem
	Mina.Tesouros = 0

	'Abre arquivo
	
	'Verifica se o arquivo existe
	If FileExists ("Minas.Bin") Then
		Open "Minas.Bin" For Binary As #1
		FileTam = Lof (1)
		If FileTam > 20 Then
			Get #1, , TotMinas
			Jogo.NumMinas = TotMinas
			
			FilePos = 3
			
			If SoQuant = 0 Then
				
				Get #1, , MinaTemp
				Get #1, , Mina.LArg
				Get #1, , Mina.Alt
				Get #1, , Mina.Noturno
				Get #1, , Mina.Tempo
				
				While MinaTemp < NMina
					FilePos = FilePos + ((Mina.Alt * Mina.Larg) * 3) + 9
					Get #1, FilePos, MinaTemp
					Get #1, , Mina.LArg
					Get #1, , Mina.Alt
					Get #1, , Mina.Noturno
					Get #1, , Mina.Tempo
				Wend
				
				LeMinaDet 0
							
			End If
		Else
			MessageBox NULL,TXT(87), TXT(0), MB_ICONERROR
			MudaStatus NoMenu
		End If
		
		Close #1
		
	Else  'Arquivo não existe
		MessageBox NULL, TXT(88), TXT(0), MB_ICONERROR
		MudaStatus NoMenu
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Le o desenho da mina (tiles)

Sub LeMinaDet (Editando As Integer = 0)
	Dim As Integer MXR, MYR, F, G
	MXR=0
	MYR=0

	If Editando = 0 Then
		If Mina.Larg < 24 Then MXR = Int (25 - Mina.Larg) / 2
		If Mina.alt < 16 Then MYR = Int(17 - Mina.Alt) / 2
		For f = -1 To mina.larg
			For g = -1 To mina.alt
				objeto(mxr + f, myr + g).tp = 31
			Next
		Next
	End If
	
	Mina.Larg -= 1
	Mina.Alt -= 1
	
	'Lê cada linha
	For g = 0 To Mina.Alt
		'Le linha
		For f = 0 To Mina.Larg
			Get #1, , Fundo (MXR + f, MYR + g)
			Get #1, , Frente (MXR + f, MYR + g)
			Get #1, , Objeto (MXR + f, MYR + g).tp
			'Posição inicial do boneco
			If objeto (MXR + f, MYR + g).tp = 85 Then
				Mina.X = MXR + F
				Mina.Y = MYR + G
				Boneco.X = Mina.X
				Boneco.Y = Mina.Y
				Objeto(MXR + f, MYR + g).tp = 0
			ElseIf tpobjeto(Objeto (MXR+f,MYR+g).Tp).Tipo=5 Then
				Mina.Tesouros +=1
			End If
		Next
	Next
	Sleep 1, 1
	Mina.Larg += MXR
	Mina.Alt += MYR
	Jogo.UltExplosao = 0
	Jogo.Ciclo=0
	Iniciado=0
End Sub

'-------------------------------------------------------------------------------------------

'Faz levantamento e contagem das minas personalizadas

Sub LeMinasPers
	Dim As String Narq
	Dim As Integer Ordem, F
	ScreenSet ScrAtiva,  ScrAtiva
	Ordem = 0
	
	Line (298, 320) - (502, 344), &HFFFFFF, b
	
	For F = 0 To 999
		line (300 + f/5, 322) - step (0, 20), &H7080F0
		NArq = "Minas\M" + Right("000" & Str(f), 3) + ".MAP"
		If FileExists (Narq) Then
			MinaPers (Ordem) = F
			Ordem +=1
		End If
	Next
	If Ordem < 999 Then
		For F = Ordem To 999
			MinaPers (f) = 0
		Next
	End If
	Boneco.Mina = MinaPers (0)
	QuantPers = Ordem
End Sub

'-------------------------------------------------------------------------------------------

'Gera um som aleatório (Game Over)

Sub SorteiaNotaGameOver
	Dim Nota As Integer
	
	Randomize
	
	If Jogo.Status <> GameOver Or (Rnd * 500) < 10 Then
		Nota = (Int(Rnd * 32) + 64) Shl 8
		midiOutShortMsg (hMidiOut, &H65c7)
		midiOutShortMsg (hMidiOut, &H600087 Or UltNotaGameOver)
		midiOutShortMsg (hMidiOut, &H600097 Or Nota)
		UltNotaGameOver = Nota
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Gera um som aleatório (Vencendo o jogo)

Sub SorteiaNotaVenceu
	Dim Nota As Integer
	
	Randomize
	
	If (QtdNotasVenceu = 0) Or (QtdNotasVenceu < 6 And Timer - TimerNotaVenceu >= .11) Then
		QtdNotasVenceu += 1
		If QtdNotasVenceu = 1 Then
			Nota = (Int(Rnd * 32) + 36) Shl 8
		Else
			Nota = (Int(Rnd * 6) + (UltNotaGameOver Shr 8) - 1) Shl 8
			If Nota = ultNotaGameOver Then Nota -= 512
		End If
		midiOutShortMsg (hMidiOut, &H76c0)  '26, 29, 2d, 6b
		midiOutShortMsg (hMidiOut, &H6bc1)  '26, 29, 2d, 6b
		midiOutShortMsg (hMidiOut, &H5f0080 Or (UltNotaGameOver + 513))
		midiOutShortMsg (hMidiOut, &H6f0080 Or UltNotaGameOver)
		midiOutShortMsg (hMidiOut, &H600090 Or (Nota + 513))	
		midiOutShortMsg (hMidiOut, &H6f0090 Or Nota)	
		UltNotaGameOver = Nota
		TimerNotaVenceu = Timer 
	ElseIf Timer - TimerNotaVenceu >= .6 Then
		QtdNotasVenceu = 0
	End If
End Sub


'-------------------------------------------------------------------------------------------

'Regrava configurações: Volume e maior mina alcançada

Sub RegravaConfig
	Kill "Config.min"
	Open "Config.min" For Binary As #1
	Put #1, , jogo.volume
	Put #1, , Jogo.MaxAlcancada
	Close #1
End Sub

'-------------------------------------------------------------------------------------------

'Le textos do programa, no idioma selecionado

Function LeTXT (Idioma As String) As Integer
	Dim as integer F

	If Idioma = "Portugues" Then
		LeTXTBase
	Else
		If FileExists ("lang\" + idioma + ".Lng") Then
			Open "lang\" + idioma + ".LNG" For Input As #1
			F = 0
			While Not Eof (1)
				Input #1, TXT(F)
				F += 1
			Wend
			Close #1
			Return 0
			
		Else
			Return 1
		End If
	End If
End Function

'-------------------------------------------------------------------------------------------

'Define os textos, em português

Sub ProcIdiomas ()
	Dim As String Arquivo
	Dim as integer F
	
	'Conta e carrega matriz com idiomas disponíveis
	IQuant = 0
	Arquivo = Dir ("Lang\*.Lng")
	While Len(Arquivo) > 0 And IQuant < 9
		IQuant += 1
		Idioma (IQuant) = Left(Arquivo, Len(Arquivo) - 4)
		Arquivo = Dir ()
	Wend
	
	'Localiza idioma atual na matriz
	NAtual = 0
	For f = 0 To IQuant
		If Idioma (F) = IAtual Then	NAtual = F
	Next
	
End Sub

'-------------------------------------------------------------------------------------------

'Verifica se é pra ganhar vida

Sub VeSeGanhaVida (Acrescimo As Integer)
	If Int(boneco.pontos / 1000) < Int ((boneco.Pontos + Acrescimo) / 1000) Then
		Boneco.vidas += 1
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Calcula o bonus de acordo com o tempo para concluir a mina

Sub CalculaBonusTempo
	If Mina.Tempo = 0 Then
		PtBonus = (300 - Boneco.Tempo)
		If PtBonus > 100 Then PtBonus = 100
	Else
		PtBonus = (Mina.Tempo - Boneco.Tempo)
		If PtBonus > 100 Then PtBonus = 100
	End If
	VeSeGanhaVida PtBonus
End Sub

'-------------------------------------------------------------------------------------------

'Define os textos, em português

Sub LeTXTBase
	TXT(00) = "Erro"
	TXT(01) = "Dispositivo MIDI não pode ser iniciado."
	TXT(02) = "Iniciar"
	TXT(03) = "Selecionar fase"
	TXT(04) = "Recordes"
	TXT(05) = "FreeBasic Miner ?"
	TXT(06) = "Volume"
	TXT(07) = "Selecionar Idioma (Language)"
	TXT(08) = "Fases personalizadas"
	TXT(09) = "Criar e editar minas"
	TXT(10) = "Sair"
	TXT(11) = "O objetivo do jogo é coletar todas as pedras preciosas existentes em cada mina."
	TXT(12) = "Você é capaz? Se ficar preso ou desistir, pressione ESC para suicidar e recomeçar"
	TXT(13) = "Quando não houver nada sob seus pés, você cairá. Vejamos..."
	TXT(14) = "Agora vamos passar por baixo de um objeto. Enquanto estamos embaixo, os objetos"
	TXT(15) = "permanecem suspensos, e caem depois que saimos."
	TXT(16) = "Ao lado, temos carrinhos, que podem ser empurrados, independente da quantidade."
	TXT(17) = "Eles também cairão quando não houver nada abaixo."
	TXT(18) = "Agora vamos empurrar palha. É possível empurrar até dois blocos simultaneamente."
	TXT(19) = "Se houver palha e um carrinho lado a lado, também podemos empurrar o par,"
	TXT(20) = "mas não é possível empurrar mais do que 2 desses objetos."
	TXT(21) = "Ao lado, vamos empurrar uma caixa de madeira. Ela é mais pesada,"
	TXT(22) = "por só é possível empurrar uma de cada vez."
	TXT(23) = "Ao lado há duas caixas, e por isso não conseguiremos empurrar."
	TXT(24) = "Agora vamos andar pela terra, escavando-a."
	TXT(25) = "Existem solos de cores e texturas diferentes, mas todos se comportam da mesma"
	TXT(26) = "maneira: simplesmente são eliminados quando passamos por eles."
	TXT(27) = "Ao lado, vamos pegar uma furadeira, e em seguida vamos, usá-la, pressionado C."
	TXT(28) = "Veja ao lado os tipos de paredes que podem ser destruídas."
	TXT(29) = "Agora acabamos de pegar uma pequena bomba. Vamos acioná-la pressionando D"
	TXT(30) = "e sair do local antes que ela exploda!!!"
	TXT(31) = "Como você viu, também dá pra destruir as rochas. Em seguida, vamos"
	TXT(32) = "pegar e utilizar uma picareta, pressionando B."
	TXT(33) = "Perfuramos o chão, destruindo-o, e por isso acabamos descendo."
	TXT(34) = "Vamos pegar bombas maiores e mais poderosas, que acionaremos pressionando E."
	TXT(35) = "Veja que as rochas serão destruídas, mas o piso ficará intacto, pois foi feito de"
	TXT(36) = "materiais indestrutíveis. Ao acionar bombas, não se esqueça de se afastar!"
	TXT(37) = "Agora vamos pegar um suporte. Ele serve para que os objetos acima não caiam."
	TXT(38) = "Vamos acioná-lo pressionando A abaixo da rocha à direita."
	TXT(39) = "Viu? A rocha não caiu! Agora vamos tentar experimentar explodir uma"
	TXT(40) = "estrutura de aço..."
	TXT(41) = "Vamos perder tempo, pois isso não será destruído... Vamos procurar uma saída."
	TXT(42) = "Abaixo há uma garrafa de oxigênio. Com ela, será possível passar mais tempo na água."
	TXT(43) = "Sem essas garrafas, é possível passar um período bem curto na água."
	TXT(44) = "Vamos correr, antes que o oxigênio se esgote! Vamos achar uma escada para"
	TXT(45) = "sairmos da água!"
	TXT(46) = "É isso!  E recolhendo todas as pedras, você passa de fase."
	TXT(47) = "Você pode tentar coisas como sair debaixo de uma pedra e voltar rapidamente..."
	TXT(48) = "Veja aqui a indicação de quantas pedras ainda restam a recolher. Nos quadros"
	TXT(49) = "ao lado também aparecerão outros itens que forem recolhidos."
	TXT(50) = "Falha na leitura do arquivo da mina."
	TXT(51) = "Use as setas para mover. Ao selecionar, pressione ENTER ou ESPAÇO."
	TXT(52) = "Pressione ESC para sair. Use (Page UP) e (Page Down) para avançar."
	TXT(53) = "Pressione ESPAÇO ou ENTER ao terminar."
	TXT(54) = "Obs.: afeta o volume do sintetizador de SW do Windows."
	TXT(55) = "Não há nenhuma mina personalizada salva."
	TXT(56) = "Pressione alguma tecla para retornar ao menu."
	TXT(57) = "Deseja mesmo encerrar?"
	TXT(58) = "Sim"
	TXT(59) = "Não"
	TXT(60) = "Prepare-se para iniciar"
	TXT(61) = "> Seja rápido!"
	TXT(62) = "PAUSA"
	TXT(63) = "Pressione qualquer tecla"
	TXT(64) = "Este é o esclusivo Modo Mapa!/_=+(-)"
	TXT(65) = "Use: Setas para movimentar - ESC ou M para sair"
	TXT(66) = "Atenção! O tempo continua contando no modo mapa"
	TXT(67) = "Aguarde alguns segundos na tela do menu para ver uma demonstração"
	TXT(68) = "A ideia do jogo é simples: recolher todas as pedras preciosas que existem em cada uma das"
	TXT(69) = "minas. O desafio está em ser capaz de chegar até elas. Escave a terra, empurre objetos,"
	TXT(70) = "destrua paredes, recolha e utilize as ferramentas e bombas, e tome cuidado com certos"
	TXT(71) = "objetos, e também evite afogar-se ou ficar preso em um lugar de onde não consiga sair."
	TXT(72) = "Se ficar preso, ou quando quiser, pressione ESC para morrer e tentar de novo."
	TXT(73) = "Se preferir, pressionando SHIFT o jogo fica acelerado."
	TXT(74) = "Dica: Quanto mais rápido recolher tudo, mais pontos irá ganhar!"
	TXT(75) = "Agradecimento Especial (Special Thanks to): The FreeBASIC development team"
	TXT(76) = "Passou!!! Parabéns!!!"
	TXT(77) = "Pontos pelo tempo"
	TXT(78) = "Bom trabalho nessa mina personalizada"
	TXT(79) = "Pontos totais: "
	TXT(80) = "VENCEU"
	TXT(81) = "Parabéns! Você concluiu o jogo!"
	TXT(82) = "Pressione DELETE para apagar os recordes"
	TXT(83) = "Tem certeza de que deseja apagar os recordes,"
	TXT(84) = "eliminando seus registros de pontuação?"
	TXT(85) = "Parabéns!! Você entrou para a lista de recordistas!"
	TXT(86) = "Digite seu nome e pressione ENTER"
	TXT(87) = "Arquivo MINAS.BIN está corrompido ou foi alterado."
	TXT(88) = "Arquivo MINAS.BIN não foi encontrado"
	TXT(89) = "Para alternar entre janela e tela cheia: ALT + ENTER"
	TXT(90) = "Quer apagar o registro de minas alcançadas?"
	TXT(91) = "(Só poderá iniciar o jogo na primeira mina)"
	TXT(92) = "Procurando minas personalizadas."
	TXT(93) = "Aguarde um instante . . ."
	TXT(94) = "Bonus extra pelas vidas"
	TXT(95) = "Encerrar o teste e retornar para o editor?"
	TXT(96) = "Para encerrar o teste, pressione ESC."
	TXT(97) = "Pressione TAB para iniciar uma mina em branco, e ESC para sair."
	TXT(98) = "A mina sofreu alterações e não foi salva."
	TXT(99) = "Fechar a mina e iniciar uma nova (em branco)?"
	TXT(100)= "Não é permitido uma mina sem pedras preciosas."
	TXT(101)= "Digite o número para gravar a mina (0 a 999). Tecle ESC para desistir"
	TXT(102)= "Obs.: Se houver arquivo com nome igual, será substituído."
	TXT(103)= "A mina deve ser solucionada no claro?"
	TXT(104)= "(Escolha SIM para claro e NÃO para escuro)"
	TXT(105)= "Fechar o editor?"
	TXT(106)= "Digite o tempo para completar a mina (em segundos aprox.)."
	TXT(107)= "Obs.: Digite 0 se o tempo for livre."
	TXT(108)= "Testar a mina?"
	TXT(109)= "Delimite a área a editar. Pressione ESC para desistir."
	TXT(110)= "Setas de direção: mover  - ESPAÇO, ENTER ou ESC: terminar"
	TXT(111)= "Delimite a área a apagar. Pressione ESC para desistir."
	TXT(112)= "A mina foi salva com sucesso."
	TXT(113)= "Fechar a mina para abrir outra?"
	TXT(114)= ""
	TXT(115)= ""
	TXT(116)= ""
	TXT(117)= ""
	TXT(118)= ""
	TXT(119)= ""
	TXT(120)= ""
	TXT(121)= ""
	TXT(122)= ""
	TXT(123)= ""
	TXT(124)= ""
	TXT(125)= ""
	TXT(126)= ""
	TXT(127)= ""
	TXT(128)= ""
	TXT(129)= ""
	TXT(130)= ""
	TXT(131)= ""
	TXT(132)= ""
	TXT(133)= ""
	TXT(134)= ""
	TXT(135)= ""
	TXT(136)= ""
	TXT(137)= ""
	TXT(138)= ""
	TXT(139)= ""
	TXT(140)= ""
	TXT(141)= ""
	TXT(142)= ""
	TXT(143)= ""
	TXT(144)= ""
	TXT(145)= ""
	TXT(146)= ""
	TXT(147)= ""
	TXT(148)= ""
	TXT(149)= ""
	TXT(150)= ""
End Sub

'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------

'ROTINAS REFERENTES AO EDITOR DE MINAS

'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------



'-------------------------------------------------------------------------------------------

'Escreve um número pequeno e de 2 algarismos como cabeçalho de linha e coluna

Sub EscreveNumeroPeq (ByVal Numero As Integer, X1 As Integer, Y1 As Integer)

	Put (x1, Y1), BMP (274), (Int(Numero/10) * 6, 0) - Step(5, 7), Trans
	Put (x1 + 6, Y1), BMP (274), ((Numero Mod 10) * 6, 0)- Step(5, 7), Trans

End Sub

'-------------------------------------------------------------------------------------------

'Desenha um quadro

Sub Dlinha (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, QualCor As Integer)
	Select Case QualCor
	Case 0
		CorRGB = &H00FF00
	Case 1
		CorRGB = &HFFFF00
	Case 2
		CorRGB = &HFF4040
	Case 3
		CorRGB = &H9F0000
	End Select
	Line (x1, y1) - (x2, y1 + 2), CorRGB, BF
	Line (x1, y1) - (x1 + 2, y2), CorRGB, BF
	Line (x1, y2 - 2) - (x2, y2), CorRGB, BF
	Line (x2 - 2, y1) - (x2, y2), CorRGB, BF
End Sub

'-------------------------------------------------------------------------------------------

'Conta as pedras existentes na mina

Function ContaTesouros As Integer
	Dim as integer F, G
	Dim Contagem As Integer
	Contagem = 0
	For f=0 To 99
		For g =0 To 59
			If (objeto(f, g).TP >= 40) And (objeto(f, g).TP <= 55) Then Contagem += 1
		Next
	Next
	Return Contagem
End Function

'-------------------------------------------------------------------------------------------

'Acha a coluna do objeto mais abaixo

Function MaiorLinha As Integer
	Dim As integer LMax, f, g
	LMax = 1
	
	For F = 0 To 99
		For G = 0 To 59
			If objeto(f,g).TP > 0 Or fundo (f, g) <> 1 Or frente (f,g )>0 Then
				If G > LMaX Then LMaX = G
			End If
		Next
	Next
	Return LMax
End Function

'-------------------------------------------------------------------------------------------

'Acha a coluna do objeto mais à direita

Function MaiorColuna As Integer
	Dim as integer LMax, f, g
	LMax = 1
	
	For F = 0 To 99
		For G = 0 To 59
			If objeto(f,g).TP > 0 Or fundo (f, g) <> 1 Or frente (f,g )>0 Then
				If F > LMaX Then LMaX = F
			End If
		Next
	Next
	Return LMax
End Function

'-------------------------------------------------------------------------------------------

'Salva a mina em arquivo


Sub SalvaMina (ParaTestar As Integer = 0)
	Dim As String Linha, NArq, LMNum, LmTec
	Dim As Integer nmina, MaiorX, MaiorY, ValTemp, f, g

	'zera contador de tesouros para verificar se tem
	Mina.Tesouros = ContaTesouros ()
	
	Cls
	TrocaTelas

	If Mina.tesouros = 0 Then
		LimpaTeclado 
		Cls
		Mensagem 5, 8, TXT (100), "", ""
		TrocaTelas
		Cls
		While inkey <> ""
			sleep 1, 1
		Wend
		While Inkey = ""
			Sleep 1, 1
		Wend
		LimpaTeclado
	Else
		If ParaTestar = 0 Then
			
			LMNum= Str(Mina.numero)
			LimpaTeclado
			LMTec = ""
			
			While LMTec<>Chr(27) And LMTec<>Chr(13)
				Cls
				Mensagem 5, 4, TXT(101), TXT(102), LMNum & Chr (32 + 63 * ((Timer * 2) Mod 2))
				
				If LMTec >= "0" And LMTec <= "9" And Len (LMNum) < 3 Then
					If LMNum = "0" Then LMNum = "0"
					LMNum += LMTec
				ElseIf LMTec = Chr(8) Or lmtec = c255 + Chr(83) Then
					lMNum = Left (LMNum, Len (LMNum) - 1)
				End If		
				TrocaTelas	
				LMTec=Inkey 
					
			Wend
			Cls
			TrocaTelas
			
			NArq = "Minas\M" + Right("000" & Str(LMNum),3) + ".MAP"
			Mina.numero= Val(LMNum)
		Else
			NArq = "Minas\TESTE.MAP"
		End If
		
		Cls
		
		If ParaTestar <> 0 Or LMTec = Chr (13) Then
		
			If ParaTestar = 0 Then
				LMTec=""
				While Inkey<>""
					Sleep 10, 1
				Wend
				Opcao1 = Mina.Noturno
				While LMTec <> " " And LMTec <> Chr(27) And LMTec <> Chr(13)
					Cls
					Mensagem 5, 5, TXT(103), TXT(104), "", , , Opcao1
					LMTec=Inkey
					LeMouse
					If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
					If (MouseDisparou = 1) And (MouseSimNao > 0) Then LMTec = " "
					If (LmTec = c255+ "H") Or (LmTec = c255+ "K") Or (LmTec = c255+ "M") Or (LmTec = c255+ "P") Then Opcao1 = 1 - Opcao1
					TrocaTelas
				Wend
				Cls
			End If
			
			If ParaTestar <> 0 Or LMTec <> Chr(27) Then
				If ParaTestar = 0 Then
					Mina.Noturno = Opcao1

					LMNum=Str(Mina.Tempo)
				
					While Inkey <> ""
						Sleep 10
					Wend
					LMTec = ""
					While LMTec <> Chr(27) And LMTec <> Chr(13)
						Cls
						Mensagem 5, 4, TXT(106), TXT(107), LMNum & Chr (32 + 63 * ((Timer * 2) Mod 2))
						If (LMTec >= "0") And (LMTec <= "9") And (Len (LMNum) < 5) Then
							If LMNum = "0" Then LMNum = ""
							LMNum += LMTec
						ElseIf LMTec = Chr(8) Or lmtec = c255 + Chr(83) Then
							lMNum = Left(LMNum, Len (LMNum) - 1)
						End If
						LMTec = Inkey
						TrocaTelas
					Wend
					Cls
				End If
				
				If ParaTestar <> 0 Or lmtec = Chr(13) Then
					If ParaTestar = 0 Then
						Mina.Tempo=Val(LMNum)
						Mina.alterada = 0
						EdShow = 2
					End If
					
					'Inicia gravação da mina:
					
					Mina.Larg = MaiorColuna () + 1
					Mina.Alt = MaiorLinha () + 1
					
					'Salva dimensões, se é noturno/diurno e o tempo (0=livre)
					Kill Narq
					Open NArq For Binary As #1
					Put #1,, Mina.Larg
					Put #1,, Mina.Alt
					Put #1,, Mina.Noturno
					Put #1,, Mina.Tempo
				 
					'Escreve cada linha
					For g=0 To Mina.Alt-1
						
						For f= 0 To Mina.Larg-1
							Put #1,,fundo(f,g)
							Put #1,,frente(f,g)
							If boneco.x=f And boneco.y=g Then
								objeto(f,g).TP =85
								Put #1,,objeto(f,g).TP
								objeto(f,g).TP = 0
							Else
								Put #1,, objeto(f,g).TP
							End If
						Next
					Next
					Close #1
										
					Cls
					TrocaTelas
					Cls
					If ParaTestar = 0 Then
						Mensagem 6, 6, TXT(112), "", ""
						TrocaTelas
						While Inkey <> ""
							Sleep 1, 1
						Wend
						While Inkey = ""
							Sleep 1, 1
						Wend
						Cls
					End If
					LimpaTeclado
				Else
					UltTecla = "ESC"
				End If
			Else
				UltTecla = "ESC"
			End If
		Else
			UltTecla = "ESC"
		End If
	End If 

	LimpaTeclado
	
End Sub

'-------------------------------------------------------------------------------------------

'Rotina principal do EDITOR - pode ser mudada para um item dentro de "Joga"

Sub Edita

	Dim as integer F, G
	PosMouse = PosMouseEd ()

	Select Case Jogo.EdStatus
	Case Editando
		EdX1 = Int (MouseX / 32)
		EdY1 = Int (MouseY / 32)
		Select Case Tecla
		Case "ESC"
			If Tecla <> UltTecla Then Jogo.EdStatus = RespExit
		Case "U"
			MapY -= 1
			If MapY < 0 Then MapY = 0
		Case "D"
			MapY += 1
			If MapY > 43 Then MapY = 43
		Case "R"
			Mapx += 1
			If MapX > 75 Then MapX = 75
		Case "L"
			MapX-=1
			If MapX < 0 Then MapX = 0
		End Select
		
		If (MouseDisparou = 1) Or ((MouseB > 0) And ((PosMouse = EdBarra) Or (PosMouse = EdEsquerda) Or (PosMouse = EdDireita))) Then
			Select Case PosMouse
			Case EdForaTela
				'Nada a fazer
			Case EdTela
				EdX2 = EDX1
				EdY2 = EDY1
				EdXX1 = EDX1
				EdXX2 = EDX2
				EdYY1 = EDY1
				EdYY2 = EDY2
				If ItemSel = 0 Then
					If (boneco.x <> Mapx + edx1) Or (boneco.y <> Mapy + edy1) Then
						GravaUndo
						boneco.x = Mapx + edx1
						boneco.y = Mapy + edy1
						Mina.Alterada = 1
					End If
				Else
					Jogo.EdStatus = Selecionando
				End If
			Case EdInicio
				PrimeiroItem = 0
			Case EdEsquerda
				PrimeiroItem -= 1
				If PrimeiroItem < 0 Then PrimeiroItem = 0
			Case EdDireita
				PrimeiroItem += 1
				If PrimeiroItem > 100 Then PrimeiroItem = 100
			Case EdFim
				PrimeiroItem = 100
			Case EdBarra
				PrimeiroItem = Int ((MouseX - 80) / 4.48)
				If PrimeiroItem < 0 Then PrimeiroItem = 0
				If PrimeiroItem > 100 Then PrimeiroItem = 100
			Case EdItem
				ItemSel = PrimeiroItem + Int (MouseX / 34)
			Case EdNovo
				Jogo.EdStatus = RespNovo
			Case EdAbre
				Jogo.EdStatus = RespAbrindo
			Case EdMove
				Jogo.EdStatus = EdMovendo
				EdMovendoUndo = 0
			Case EdSalva
				Jogo.EdStatus = RespSalvar
				UMTec = Str(Mina.Numero)
			Case EdVisao
				EdShow = (Edshow + 1) Mod 4
			Case EdMudaGrid
				EdGrid = (EdGrid + 1) Mod 8
			Case EdApaga
				EdXX1 = -1
				EdXX2 = -1
				EdYY1 = -1
				EdYY2 = -1
				EdX1 = -1
				EdY1 = -1
				Jogo.EdStatus = Apagando0
			Case EdTesta
				Jogo.EdStatus = RespTesta
			Case EdUndo
				FazUndo
			Case EdRedo
				FazRedo
			Case EdEXIT
				Jogo.EdStatus = RespExit
			End Select
		End If
		
	Case Selecionando
		If PosMouse = EdTela Then
			EdX2 = Int (MouseX / 32)
			EdY2 = Int (MouseY / 32)
			SwapEDXY
			If (Tecla = "ESC") And (Ulttecla <> Tecla) Then
				Jogo.EdStatus = Editando
			Else
				If MouseLiberou = 1 Then
					
					Jogo.EdStatus = Editando
					GravaUndo
					Mina.alterada = 1
					For F = EDXX1 To EDXX2
						For G = EDYY1 To EDYY2
							Select Case ItemSel
							Case 1 To 25
								Fundo (MAPX + F, MAPY + G) = ItemSel - 1
							Case 26 To 37
								Frente (MAPX + F, MAPY + G) = ItemSel - 26
							Case 38 To 114
								Objeto (MAPX + F, MAPY + G).TP = ItemSel - 38
							Case Else
								Objeto (MAPX + F, MAPY + G).TP = ItemSel - 33
							End Select
						Next
					Next
				
				End If
			End If
		End If
		
	Case RespNovo
		If PergFecha () = 1 Then
			GravaUndo
			For f = -1 To 100
				For g = -1 To 60
					objeto (f, g).TP = 0
					fundo  (f, g) = 1
					frente (f, g) = 0
				Next
			Next
			boneco.x = 0
			boneco.y = 0
		End If
		Jogo.EdStatus = Editando		
		
	Case RespAbrindo
		If PergFecha () = 1 Then
			Opcao1 = 0
			Boneco.Mina = 0
			Cls
			TrocaTelas
			Cls
			Mensagem 7, 8, TXT(92), TXT(93), " "
			LeMinasPers
			TrocaTelas
			Cls
			MudaStatus Configs
		Else
			Jogo.EdStatus = Editando
		End If
		
	Case EdMovendo
		If ulttecla <> tecla Then
			Select Case Tecla
			Case "U"
				If EdMovendoUndo = 0 Then GravaUndo : EdMovendoUndo = 1
				Mina.alterada = 1
				For f = 0 To 99
					For g = 0 To 59
						objeto (f, g) = objeto (f, g + 1)
						fundo  (f, g) = fundo  (f, g + 1)
						frente (f, g) = frente (f, g + 1)
					Next
				Next
				If boneco.y > 0 Then boneco.y -= 1
				Objeto (boneco.x, boneco.y).tp = 0
			Case "D"
				If EdMovendoUndo = 0 Then GravaUndo : EdMovendoUndo = 1
				Mina.alterada = 1
				For f = 0 To 99
					For g = 59 To 0 Step -1
						objeto (f, g) = objeto (f, g - 1)
						fundo  (f, g) = fundo  (f, g - 1)
						frente (f, g) = frente (f, g - 1)
					Next
				Next
				If boneco.y < 59 Then boneco.y += 1
				Objeto (boneco.x, boneco.y).tp = 0
			Case "R"
				If EdMovendoUndo = 0 Then GravaUndo : EdMovendoUndo = 1
				Mina.alterada = 1
				For f = 99 To 0 Step -1
					For g = 0 To 59
						objeto(f, g) = objeto (f - 1, g)
						fundo(f, g)  = fundo  (f - 1, g)
						frente(f, g) = frente (f - 1, g)
					Next
				Next
				If boneco.x < 99 Then boneco.x += 1
				Objeto (boneco.x, boneco.y).tp = 0
			Case "L"
				If EdMovendoUndo = 0 Then GravaUndo : EdMovendoUndo = 1
				Mina.alterada = 1
				For f = 0 To 99
					For g = 0 To 59
						objeto (f, g) = objeto (f + 1, g)
						fundo  (f, g) = fundo  (f + 1, g)
						frente (f, g) = frente (f + 1, g)
					Next
				Next
				If boneco.x > 0 Then boneco.x -= 1
				Objeto (boneco.x, boneco.y).tp = 0
			Case "[", "]", "ESC"
				Jogo.EdStatus = Editando
				EdMovendoUndo = 0
			End Select
		End If
		
	Case RespSalvar
		SalvaMina
		Jogo.EdStatus = Editando
		
	Case Apagando0
		If PosMouse = EdTela Then
			EdX1 = Int (MouseX / 32)
			EdY1 = Int (MouseY / 32)
		End If
		If Tecla = "ESC" And UltTecla <> Tecla Then
			Jogo.EdStatus = Editando
		End If
		If MouseDisparou = 1 Then
			If PosMouse = EdTela Then
				EdMon = 1
				EdX2 = EDX1
				EdY2 = EDY1
				EdXX1 = EDX1
				EdXX2 = EDX2
				EdYY1 = EDY1
				EdYY2 = EDY2
				Jogo.EdStatus = apagando1
			End If
		End If
		
	Case Apagando1
		If PosMouse = EdTela Then
			EdX2 = Int (MouseX / 32)
			EdY2 = Int (MouseY / 32)
			SwapEDXY
			If (Tecla = "ESC") And (Ulttecla <> Tecla) Then
				Jogo.EdStatus = Editando
			Else
				If MouseLiberou = 1 Then
					Jogo.EdStatus = Editando
					GravaUndo
					Mina.alterada = 1
					For F = EDXX1 To EDXX2
						For G = EDYY1 To EDYY2
							Fundo (MAPX + F, MAPY + G) = 1
							Frente (MAPX + F, MAPY + G) = 0
							Objeto (MAPX + F, MAPY + G).TP = 0
						Next
					Next
				End If
			End If
		End If
		
	Case RespTesta
		Opcao1 = 0
		LMTec = ""
		If ContaTesouros () = 0 Then
			Cls
			TrocaTelas
			Cls
			Mensagem 5, 8, TXT(100), "", ""
			Jogo.EdStatus = Editando
			TrocaTelas
			Cls
			While Inkey = ""
				Sleep 1, 1
			Wend
			LimpaTeclado
		Else
			While lmtec <> " " And LMTec <> Chr(13) And lmtec <> Chr(27)
				Cls
				Mensagem 4, 5, TXT (108), "", "", 400, 300, Opcao1
				LMTec=Inkey
				LeMouse
				If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
				If (MouseDisparou = 1) And (MouseSimNao > 0) Then LMTec = " "
				If (LmTec = c255+ "H") Or (LmTec = c255+ "K") Or (LmTec = c255+ "M") Or (LmTec = c255+ "P") Then Opcao1 = 1 - Opcao1
				TrocaTelas
				jogo.seqciclo=(jogo.seqciclo+1) Mod 360
			Wend
			Cls
			If Opcao1 = 1 Or LMTec = Chr(27) Then
				Jogo.EdStatus = Editando
			Else
				SalvaMina -1
				LeMinaOUT -1, 0
				IniciaVida
				MudaStatus Testando
			End If
			
			LimpaTeclado 1
			
		End If
		
	Case RespExit
		Opcao1 = 1
		LMTec = ""
		While lmtec <> " " And LMTec <> Chr(13) And lmtec <> Chr(27)
			Cls
			If Mina.Alterada = 1 Then
				Mensagem 4, 5, TXT (98), TXT (105), "", 400, 300, Opcao1
			Else
				Mensagem 4, 5, TXT (105), "", "", 400, 300, Opcao1
			End If
			LMTec=Inkey
			LeMouse
			If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
			If (MouseDisparou = 1) And (MouseSimNao > 0) Then LMTec = " "
			If (LmTec = c255+ "H") Or (LmTec = c255+ "K") Or (LmTec = c255+ "M") Or (LmTec = c255+ "P") Then Opcao1 = 1 - Opcao1
			TrocaTelas
			jogo.seqciclo=(jogo.seqciclo+1) Mod 360
		Wend
		Cls
		If Opcao1 = 1 Or LMTec = Chr(27) Then
			Jogo.EdStatus = Editando
		Else
			MudaStatus NoMenu
		End If
		
		LimpaTeclado 1
		
	End Select 
	
	Objeto (Boneco.x, boneco.y).Tp = 0
		
End Sub

'-------------------------------------------------------------------------------------------

Sub EncerraTeste
	LeMinaOUT -1, 1
	MudaStatus Editor
	Kill "Minas\TESTE.MAP"
End Sub

'-------------------------------------------------------------------------------------------

'Desenha um item na tela do editor, conforme seu tipo

Sub DesenhaItem (ITX As Integer, ITY As Integer, ITN As Integer)
	If ITN = 0 Then	'Boneco (ITN = 0)
		Put (ITX, ITY), BMP (116), Trans
	ElseIf ITN = 1 Then	'Fundo 0 = água (ITN = 1)
		Put (ITX, ITY), BMP (213), PSet
	ElseIf ITN = 2 Then 'Fundo 1 = vazio
		Line (ITX, ITY) - Step (31, 31), &HFFFFFF, B
		Escreve "Fu", ITX + 7, ITY - 1
		Escreve "vz", ITX + 7, ITY + 13
		Line (ITX, ITY + 31) - Step (31, -31), &HFFFFFF
	ElseIf ITN  < 26 Then	'Fundos 1 a 24 (ITN = 2 a 25)
		Put (ITX, ITY), BMP (ITN - 1), PSet
	ElseIf ITN = 26 Then	'Frente 0 = vazio
		Line (ITX, ITY) - Step (31, 31), &HFFFFFF, B
		Escreve "Fr", ITX + 7, ITY - 1
		Escreve "vz", ITX + 7, ITY + 13
		Line (ITX, ITY + 31) - Step (31, -31), &HFFFFFF
	ElseIf ITN < 38 Then	'Frentes 0 a 10
		Put (ITX, ITY), BMP (ITN - 2), Trans
	ElseIf ITN = 38 Then	'Objeto 0 = vazio
		Line (ITX, ITY) - Step (31, 31), &HFFFFFF, B
		Escreve "Obj", ITX + 3, ITY - 1
		Escreve "vz", ITX + 7, ITY + 13
		Line (ITX, ITY + 31) - Step (31, - 31), &HFFFFFF
	ElseIf ITN < 115 Then
		Put (ITX, ITY), BMP (TpObjeto(ITN - 38).img), Trans
	ElseIf ITN < 123 Then
		Put (ITX, ITY), BMP (TpObjeto(ITN - 33).img), Trans
	Else 
		Escreve "?", ITX + 10, ITY + 7
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Encontra a posição do mouse (sobre qual comando ele está)

Function PosMouseEd () As Integer
	Dim Resposta As Integer
	If MouseY >= 544 Then
		If MouseX < 611 Then
			If MouseY > 564 Then
				Resposta = EdItem
			Else
				If MouseX < 23 Then
					Resposta = EdInicio
				ElseIf MouseX < 46 Then
					Resposta = EdEsquerda
				ElseIf MouseX < 565 Then
					Resposta = EdBarra
				ElseIf MouseX < 588 Then
					Resposta = EdDireita
				Else
					Resposta = EdFim
				End If
			End If
		ElseIf MouseX > 612 Then
			If MouseX < 640 Then
				If MouseY < 572 Then
					Resposta = EdNovo
				Else
					Resposta = EdMove
				End If
			ElseIf MouseX < 667 Then
				If MouseY < 572 Then
					Resposta = EdAbre
				Else
					Resposta = EdSalva
				End If
			ElseIf MouseX < 719 Then
				Resposta = EdVisao
			ElseIf MouseX < 746 Then
				If MouseY < 572 Then
					Resposta = EdMudaGrid
				Else
					Resposta = EdUndo
				End If
			ElseIf MouseX < 773 Then
				If MouseY < 572 Then
					Resposta = EdApaga
				Else
					Resposta = EdRedo
				End If
			Else
				If MouseY < 572 Then
					Resposta = EdTesta
				Else
					Resposta = EdExit
				End If
			End If
		End If
	ElseIf MouseY > 0 And MouseX >0 And MouseX <= 799 Then
		Resposta = EdTela
	Else
		Resposta = EdForaTela
	End If
	Return Resposta
End Function

'-------------------------------------------------------------------------------------------

'Limpa dados da mina usados pelo editor (nº, tempo, etc)

Sub LimpaMinaEditor
	Dim as integer F, G, H
	For H = 0 To MaxUndo
		For f = -1 To 100
			For g = -1 To 60
				UndoFrente (h, f, g) = 0
				UndoFundo  (h, f, g) = 1
				UndoObjeto (h, f, g) = 0
			Next
		Next
		BonecoX (h) = 0
		BonecoY (h) = 0
	Next

	Mina.alterada = 0
	LMTec = ""
	UMTec = ""
	PrimeiroItem = 0
	ItemSel = 0
	EdShow = 2
	EdGrid = 0
	MatrizAtual = 0
	MatrizRedoLimite = 0
	MatrizUndoLimite = 0
	EdMovendoUndo = 0
	Mina.Tempo = 0
	Mina.Numero = 0
	Mina.Noturno = 0
End Sub

'-------------------------------------------------------------------------------------------

'Pergunta se pode fechar mina não salva

Function PergFecha () As Integer
	Dim OpTXT As Integer
	If Jogo.EdStatus = RespNovo Then
		OpTXT = 99
	ElseIf Jogo.EdStatus = RespAbrindo Then
		OpTXT = 113
	End If
	Opcao1 = 1
	LMTec = ""
	While lmtec <> " " And LMTec <> Chr(13) And lmtec <> Chr(27)
		Cls
		If Mina.Alterada = 1 Then
			Mensagem 4, 5, TXT (98), TXT (OpTXT), "", 400, 300, Opcao1
		Else
			Mensagem 4, 5, TXT (OpTXT), "", "", 400, 300, Opcao1
		End If
		LMTec=Inkey
		LeMouse
		If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
		If (MouseDisparou = 1) And (MouseSimNao > 0) Then LMTec = " "
		If (LmTec = c255+ "H") Or (LmTec = c255+ "K") Or (LmTec = c255+ "M") Or (LmTec = c255+ "P") Then Opcao1 = 1 - Opcao1
		TrocaTelas
		jogo.seqciclo=(jogo.seqciclo+1) Mod 360
	Wend
	Cls
	LimpaTeclado 1
		
	If Opcao1 = 1 Or LMTec = Chr(27) Then
		Return 0
	Else
		Return 1
	End If
		
End Function

'-------------------------------------------------------------------------------------------

'Coloca coordenadas em ordem crescente

Sub SwapEDXY
	If EDX2 > EDX1 Then
		EDXX1 = EDX1
		EDXX2 = EDX2
	Else
		EDXX1 = EDX2
		EDXX2 = EDX1
	End If
	If EDY2 > EDY1 Then
		EDYY1 = EDY1
		EDYY2 = EDY2
	Else
		EDYY1 = EDY2
		EDYY2 = EDY1
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Grava situação para possível futuro UNDO

Sub GravaUndo
	Dim as integer F, G
	
	For f = -1 To 100
		For g = -1 To 60
			UndoFrente (MatrizAtual, f, g) = Frente (f, g)
			UndoFundo  (MatrizAtual, f, g) = Fundo  (f, g)
			UndoObjeto (MatrizAtual, f, g) = Objeto (F, g).tp			
		Next
	Next
	
	BonecoX (MatrizAtual) = Boneco.X
	BonecoY (MatrizAtual) = Boneco.Y
	
	If MatrizAtual = MaxUndo Then
		MatrizAtual = 0
	Else
		MatrizAtual += 1
	End If
	MatrizRedoLimite = MatrizAtual
	
	If MatrizAtual = MatrizUndoLimite Then
		If MatrizUndoLimite = MaxUndo then
			MatrizUndoLimite = 0
		Else
			MatrizUndoLimite += 1
		End If
	End If

End Sub


'-------------------------------------------------------------------------------------------

'Faz um undo no editor

Sub FazUndo
	Dim as integer F, G
	If MatrizAtual = MatrizRedoLimite Then
		For f = -1 To 100
			For g = -1 To 60
				UndoFrente (MatrizAtual, f, g) = Frente (f, g)
				UndoFundo  (MatrizAtual, f, g) = Fundo  (f, g)
				UndoObjeto (MatrizAtual, f, g) = Objeto (F, g).tp			
			Next
		Next
		BonecoX (MatrizAtual) = Boneco.X
		BonecoY (MatrizAtual) = Boneco.Y
	End If

	If MatrizAtual <> MatrizUndoLimite Then
		If MatrizAtual = 0 then
			MatrizAtual = MaxUndo
		Else
			MatrizAtual -= 1
		End If
		For f = -1 To 100
			For g = -1 To 60
				Frente (f, g)    = UndoFrente (MatrizAtual, f, g)
				Fundo  (f, g)    = UndoFundo  (MatrizAtual, f, g)
				Objeto (F, g).tp = UndoObjeto (MatrizAtual, f, g)
			Next
		Next
		Boneco.X = BonecoX (MatrizAtual)
		Boneco.Y = BonecoY (MatrizAtual)
	End If
End Sub

'-------------------------------------------------------------------------------------------

'Faz um redo no editor

Sub FazRedo
	Dim as integer F, G
	If MatrizAtual <> MatrizRedoLimite Then
		If MatrizAtual = MaxUndo then
			MatrizAtual = 0
		Else
			MatrizAtual += 1
		End If
		For f = -1 To 100
			For g = -1 To 60
				Frente (f, g)    = UndoFrente (MatrizAtual, f, g)
				Fundo  (f, g)    = UndoFundo  (MatrizAtual, f, g)
				Objeto (F, g).tp = UndoObjeto (MatrizAtual, f, g)
			Next
		Next
		Boneco.X = BonecoX (MatrizAtual)
		Boneco.Y = BonecoY (MatrizAtual)
	End If
End Sub

'-------------------------------------------------------------------------------------------

Sub LimpaTeclado (IncLMTec As Integer = 0)
	Dim as integer EsperaMais, f
	
	If IncLMTec <> 0 Then
		If LMTec = " " Then
			UltTecla = "]"
			Tecla = "]"
		ElseIf LMTec = Chr(13) Then
			UltTecla = "["
			Tecla = "["
		ElseIf LMTec = Chr(27) Then
			UltTecla = "ESC"
			Tecla = "ESC"
		End If
	End If
	
	EsperaMais = 1 
	While EsperaMais = 1 
		EsperaMais = 0
		For F = 0 To 127
			If MultiKey (f) Then EsperaMais = 1
		Next
		Sleep 1, 1
	Wend
	
	While Inkey <> ""
		Sleep 1, 1
	Wend
End Sub

'-------------------------------------------------------------------------------------------

'Faz a leitura do mouse

Sub LeMouse
	MouseXAnt = MouseX
	MouseYAnt = MouseY
	MouseBAnt = MouseB
	'MouseW, MouseWAnt, MouseWDir
	MouseWAnt = MouseW
	GetMouse (MouseX, MouseY, MouseW, MouseB)	
	MouseB = MouseB And 1
	If MouseB = 1 And MouseBAnt = 0 Then MouseDisparou = 1 Else MouseDisparou = 0
	If MouseB = 0 And MouseBAnt = 1 Then MouseLiberou = 1 Else MouseLiberou = 0
	If (MouseXAnt <> MouseX) Or (MouseYAnt <> MouseY) Then MouseMoveu = 1 Else MouseMoveu = 0
	MouseWDir = Sgn (MouseW - MouseWAnt)
End Sub

'-------------------------------------------------------------------------------------------

'Faz a mudança de um status para outro, arranjando os parametros necessários

Sub MudaStatus (NovoStatus As Integer)
	Jogo.StatusAnt = Jogo.Status
	Select Case NovoStatus
	Case NoMenu
		LimpaTeclado
		TTDemo1 = Timer
	Case GameOver
		SorteiaNotaGameOver
		XM =0
	Case Instruc
		Jogo.TelaInstr = 0
	Case Top10
		LeTopDez
	Case Editor
		Jogo.EdStatus = Editando
		EdShow = 2
		EdMOn=0
		EdGrid=0
	Case Configs
		'
	Case Jogando
		'
	Case ModoDemo
		'
	Case Testando
		'
	Case Pausado
		'
	Case ModoMapa
		'
	Case VenceuMina
		Opcao1 = 0
	Case VenceuJogo
		'
	Case SelIdioma
		'
	End Select
	Jogo.Status = NovoStatus
End Sub

'-------------------------------------------------------------------------------------------

'Desativa os sons ligados

Sub DesligaSons
	Dim as integer F, G
	For f = 1 To 6
		For g = 1 To 4
			midiOutShortMsg(hMidiOut, Som (f, g).COff)
		Next
	Next
	For f = 1 To 7
		midiOutShortMsg(hMidiOut, SomEx (f).COff)
	Next
End Sub

'-------------------------------------------------------------------------------------------

'Pede confirmação se é pra encerrar o teste da mina sendo editada

Function PerguntaSeEncerraTeste() as Integer
	Mensagem 0, 5, TXT (95), "", "", 400, 300, Opcao1
	If (Tecla <> UltTecla) And (Tecla = "R" or Tecla = "U" Or Tecla = "D" Or Tecla = "L") Then
		Opcao1 = 1 - Opcao1
	End If
	If ((MouseMoveu = 1) Or (MouseDisparou = 1)) And (MouseSimNao > 0) Then Opcao1 = MouseSimNao - 1
	If (Opcao1 = 1 and ((MouseDisparou = 1) or ((Tecla <> UltTecla) And (Tecla = "[" Or Tecla = "]")))) Or (Tecla = "ESC" and UltTecla <> Tecla) then
		MudaStatus Testando
		LeMinaOUT -1, 0
		Iniciado = 0
		IniciaVida	
		Return 1
	Elseif Opcao1 = 0 Then
		If (MouseDisparou = 1) or ((Tecla <> UltTecla) and (Tecla = "[" or Tecla = "]")) Then
			EncerraTeste
			Return 2
		End If
	Else
		Return 0
	End If
End Function
