'                              ÛCOLOTRIS.BASÛ
'                              ÛCOLOTÛÛS.BASÛ
'                              ÛCOLOÛÛÛÛ.BASÛ
'                              ÛCOLÛÛÛÛÛÛBASÛ
'                              ÛCOÛÛÛÛÛÛÛÛASÛ
'                              ÛCÛÛÛÛÛÛÛÛÛÛSÛ
'          ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÛÛÛÛÛÛÛÛÛÛÛÛÛÛÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'
'          Reglas del juego:
'           Colocar filas horizontales de 6 cajas del mismo color
'
'           F5 = Empezar
'
'                                                  Hecho en Ronda
'
'          ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'                         es.geocities.com/jm00092
'
'
'
'
'
'
'
'
DECLARE SUB entrada ()
DECLARE SUB salida ()
DECLARE SUB letras (h1!, V!, n$, c!, ch!, cv!, dh!, dv!, gh!, gv!)
DECLARE SUB letra (ph!, pv!, l$, c!)
DECLARE SUB puntos ()
DECLARE SUB BORRA (h!, V!)
DECLARE SUB cubo (h!, V!, c!)
DECLARE SUB baja (lh!, lv!)
DECLARE SUB buscalineas ()
DIM SHARED hay(1 TO 9)
DIM SHARED punt(1 TO 5)
RANDOMIZE TIMER
SCREEN 13


entrada

a = 1
1 :
IF a = 0 THEN SCREEN 13


FOR h = 0 TO 300 STEP 15
FOR V = 5 TO 195 STEP 15
cubo h, V, 42
NEXT
NEXT
FOR h = 45 TO 180 STEP 15
FOR V = 20 TO 170 STEP 15
BORRA h, V
NEXT
NEXT

FOR h = 210 TO 280 STEP 15
FOR V = 50 TO 170 STEP 15
BORRA h, V
NEXT
NEXT

letra 1, 1, "C", 31
letra 2, 1, "O", 32
letra 3, 1, "L", 33
letra 4, 1, "O", 34
letra 5, 1, "T", 35
letra 6, 1, "R", 36
letra 7, 1, "I", 37
letra 8, 1, "S", 38
                           
letra 10, 1, "H", 16
letra 11, 1, "E", 17
letra 12, 1, "C", 18
letra 13, 1, "H", 19
letra 14, 1, "O", 20
letra 15, 1, "E", 56
letra 16, 1, "N", 57
letra 17, 1, "R", 16
letra 18, 1, "O", 17
letra 19, 1, "N", 18
letra 20, 1, "D", 19
letra 21, 1, "A", 20
                           
FOR V = 12 TO 4 STEP -1
letra 20, V, RIGHT$(STR$(13 - V), 1), 95 - V
NEXT


WHILE INKEY$ <> "": WEND
DO
hh = 105
vv = 20
IF POINT(hh + 10, vv) <> 0 THEN BEEP: salida
c = (INT(RND * 5) * 4) + 32
cubo hh, vv, c
                                        
DO
DO
kbd$ = ""
kbd$ = UCASE$(INKEY$)
ccc = ccc + 1
IF ccc > 4000 THEN
ccc = 0
caida = 1
EXIT DO
END IF
LOOP WHILE kbd$ = ""

BORRA hh, vv



ah = hh
av = vv
IF caida THEN
vv = vv + 15
caida = 0
IF snd = 1 THEN SOUND 800, 1: snd = 0 ELSE snd = 1: SOUND 600, 1

IF POINT(hh + 10, vv) <> 0 THEN
cubo hh, vv - 15, c
FOR n = 1500 TO 2500 STEP 500
SOUND n, 1.5
NEXT
EXIT DO
END IF
END IF


SELECT CASE kbd$

'ARRIBA
CASE CHR$(0) + "H": SOUND 1000, 1
'ABAJO
CASE CHR$(0) + "P": vv = vv + 15
'IZQUIERDA
CASE CHR$(0) + "K": hh = hh - 15
'DERECHA
CASE CHR$(0) + "M": hh = hh + 15

CASE CHR$(27): salida

END SELECT



IF POINT(hh + 10, vv) <> 0 THEN hh = ah: vv = av

IF hh < 45 THEN : hh = 45: SOUND 100, 2
IF hh > 180 THEN : hh = 180: SOUND 200, 2
IF vv > 185 THEN : vv = 185: SOUND 400, 2


'IF POINT(hh, v) = 0 THEN
cubo hh, vv, c

LOOP UNTIL kbd$ = CHR$(27)
buscalineas
LOOP UNTIL kbd$ = CHR$(27)


salida

SUB baja (lh, lv)

FOR llh = lh TO lh + 75 STEP 15
LINE (llh + 2, lv + 2)-STEP(9, 9), 0, B
LINE (llh + 5, lv + 5)-STEP(3, 3), 0, BF
NEXT



ccc = POINT(lh, lv)
punt(((ccc - 32) / 4) + 1) = punt(((ccc - 32) / 4) + 1) + 1

FOR llh = lh TO lh + 75 STEP 15
SOUND 1000, 1.5
BORRA llh, lv
FOR delay = 1 TO 4000: NEXT
NEXT


FOR llh = lh TO lh + 75 STEP 15
FOR llv = lv TO 30 STEP -15
SELECT CASE POINT(llh + 10, llv - 15)
CASE IS <> 0: cubo llh, llv, POINT(llh + 10, llv - 15)
CASE 0: BORRA llh, llv
END SELECT
NEXT
NEXT


puntos
END SUB

SUB BORRA (h, V)
FOR n = 1 TO 8
hay(n) = 0
NEXT
IF POINT(h - 5, V - 10) > 0 THEN hay(1) = 1
IF POINT(h + 10, V - 10) > 0 THEN hay(2) = 1
IF POINT(h + 28, V - 10) > 0 THEN hay(3) = 1
IF POINT(h + 25, V) > 0 THEN hay(4) = 1
IF POINT(h + 25, V + 20) > 0 THEN hay(5) = 1
IF POINT(h + 10, V + 20) > 0 THEN hay(6) = 1
IF POINT(h - 5, V + 20) > 0 THEN hay(7) = 1
IF POINT(h - 5, V) > 0 THEN hay(8) = 1
LINE (h, V - 1)-STEP(14, 14), c, BF
IF hay(3) = 0 THEN LINE (h + 14, V)-STEP(5, -5), 0
IF hay(2) = 0 AND hay(3) = 0 THEN PSET (h + 1, V - 1), 0: DRAW "r13url13rur13url13rur13url13"
IF hay(2) = 0 AND hay(3) = 1 THEN PSET (h + 1, V - 1), 0: DRAW "r13ul12rur11ul10rur9ul8"
IF hay(4) = 0 AND hay(3) = 0 THEN PSET (h + 14, V + 13), 0: DRAW "u13rud13uru13rud13uru13rud13"
IF hay(4) = 0 AND hay(3) = 1 THEN PSET (h + 14, V + 13), 0: DRAW "u13rud13uru12rd11uru10rd9"
IF hay(6) = 1 AND hay(4) = 0 THEN PSET (h + 1, V + 14), POINT(h, V + 15) + 48: DRAW "r13url13rur13url13rur13url13"
IF hay(6) = 1 AND hay(4) = 1 THEN PSET (h + 1, V + 14), POINT(h, V + 15) + 48: DRAW "r13ul12rur11ul10rur9ul8"
IF hay(7) = 1 AND hay(8) = 0 THEN PSET (h - 1, V + 14), POINT(h - 2, V + 15) + 48: DRAW "ururlur2url3ur4"
IF hay(7) = 1 AND hay(6) = 0 THEN PSET (h + 1, V + 13), POINT(h - 2, V + 15) + 96: DRAW "r3ul2ruru"
IF hay(8) = 1 AND hay(2) = 0 THEN PSET (h - 1, V + 13), POINT(h - 3, V) + 96: DRAW "u13rud13uru13rud13uru13rud13"
IF hay(8) = 1 AND hay(2) = 1 THEN PSET (h - 1, V + 13), POINT(h - 3, V) + 96: DRAW "u13rud13uru12rd11uru10rd9"
IF hay(7) = 1 THEN LINE (h - 1, V + 14)-STEP(5, -5), POINT(h - 3, V + 18) + 48
END SUB

SUB buscalineas
FOR V = 170 TO 20 STEP -15
FOR hh = 0 TO 60 STEP 15
cpf = POINT(hh + 45, V)
cp = 0
FOR h = 45 + hh TO 120 + hh STEP 15
IF POINT(h, V) = cpf THEN cp = cp + 1
NEXT
IF cp = 6 AND cpf <> 0 THEN baja 45 + hh, V
NEXT
NEXT
END SUB

SUB cubo (h, V, c)
FOR n = 1 TO 8
hay(n) = 0
NEXT
IF POINT(h + 10, V - 10) > 0 THEN hay(2) = 1
IF POINT(h + 25, V - 10) > 0 THEN hay(3) = 1
IF POINT(h + 25, V) > 0 THEN hay(4) = 1
LINE (h, V)-STEP(13, 13), c, BF
LINE (h + 1, V - 1)-STEP(12, 0), c + 48
LINE (h + 14, V)-STEP(0, 13), c + 96
IF hay(3) = 0 THEN LINE (h + 14, V - 1)-STEP(5, -5), c + 48
IF hay(2) = 0 AND hay(3) = 0 THEN PSET (h + 1, V - 1), c + 48: DRAW "r13url13rur13url13rur13url13"
IF hay(2) = 0 AND hay(3) = 1 THEN PSET (h + 1, V - 1), c + 48: DRAW "r13ul12rur11ul10rur9ul8"
IF hay(4) = 0 AND hay(3) = 0 THEN PSET (h + 14, V + 13), c + 96: DRAW "u13rud13uru13rud13uru13rud13"
IF hay(4) = 0 AND hay(3) = 1 THEN PSET (h + 14, V + 13), c + 96: DRAW "u13rud13uru12rd11uru10rd9"
END SUB

SUB entrada
FOR h = 30 TO 275 STEP 15
cubo h, 20, (INT(RND * 5) * 4) + 32
cubo h, 170, (INT(RND * 5) * 4) + 32
NEXT
FOR V = 20 TO 180 STEP 15
cubo 15, V, (INT(RND * 5) * 4) + 32
cubo 285, V, (INT(RND * 5) * 4) + 32
NEXT

letras 58, 50, "juego de qbasic       colotris.bas", 36, 1, 1, 1, 2, 0, 1

letras 52, 75, "COLOR-TETRIS", 20, 1, 1, 3, 4, 2, 3
letras 78, 130, ".jm.", 82, 1, 1, 2, 1, 1, 0
letras 84, 143, "hecho en ronda", 90, 1, 1, 2, 1, 1, 0

WHILE INKEY$ <> "": WEND
SLEEP

END SUB

SUB letra (ph, pv, l$, c)
letras (((ph - 1) * 15)), (((pv - 1) * 15) + 7), l$, 128, 1, 1, 2, 1, 2, 1
letras (((ph - 1) * 15) - 1), (((pv - 1) * 15) + 6), l$, c, 1, 1, 2, 1, 2, 1
END SUB

SUB letras (h1, V, n$, c, ch, cv, dh, dv, gh, gv)
h = h1
n$ = UCASE$(n$)
FOR n = 1 TO LEN(n$)
SELECT CASE MID$(n$, n, 1)
CASE "A": cad$ = "0111010001100011000110001111111000110001"
CASE "B": cad$ = "111101000110001100011111010001100011111"
CASE "C": cad$ = "011101000110000100001000010000100010111"
CASE "D": cad$ = "11100100101000110001100011000110010111"
CASE "E": cad$ = "1111110000100001000011110100001000011111"
CASE "F": cad$ = "111111000010000100001111010000100001"
CASE "G": cad$ = "011101000110000100001000010011100010111"
CASE "H": cad$ = "1000110001100011000111111100011000110001"
CASE "I": cad$ = "1111100100001000010000100001000010011111"
CASE "J": cad$ = "000110000100001000010000100001100010111"
CASE "K": cad$ = "1000010001100101010011000101001001010001"
CASE "L": cad$ = "1000010000100001000010000100001000011111"
CASE "M": cad$ = "1000111011111111010110001100011000110001"
CASE "N": cad$ = "1000110001100011100110101100111000110001"
CASE "¥": cad$ = "1111100000100011000111001101011001110001"
CASE "O": cad$ = "011101000110001100011000110001100010111"
CASE "P": cad$ = "011101000110001100011111010000100001"
CASE "Q": cad$ = "0111010001100011000110001100011001001101"
CASE "R": cad$ = "0111010001100011000111110101001001010001"
CASE "S": cad$ = "011101000110000100000111000001100010111"
CASE "T": cad$ = "11111001000010000100001000010000100001"
CASE "U": cad$ = "100011000110001100011000110001100010111"
CASE "V": cad$ = "10001100011000110001100011101101010001"
CASE "W": cad$ = "100011000110001100011010110101101010111"
CASE "X": cad$ = "1000101010010100010000100010100101010001"
CASE "Y": cad$ = "10001100011000110001011100010000100001"
CASE "Z": cad$ = "1111100001000010001011111010001100011111"
CASE "1": cad$ = "001000110011100001000010000100001000111"
CASE "2": cad$ = "0111010001000010001000100010001000011111"
CASE "3": cad$ = "011101000100001000010011000001100010111"
CASE "4": cad$ = "1000010000100011000111111000010000100001"
CASE "5": cad$ = "111111000010000100001111000001100010111"
CASE "6": cad$ = "001100100010000100001111010001100010111"
CASE "7": cad$ = "11111100010000100010000100010000100001"
CASE "8": cad$ = "011101000110001100010111010001100010111"
CASE "9": cad$ = "0111010001100011000101111000010000100001"
CASE "0": cad$ = "011101000110001100011000110001100010111"
CASE ".": cad$ = "0000000000000000000000000000000000001"
CASE ",": cad$ = "00000000000000000000000000000000000010001"
CASE "-": cad$ = "0000000000000000000011111"
CASE "+": cad$ = "000000000000100001001111100100001"
CASE "=": cad$ = "00000000000000000000111110000011111"
CASE " ": cad$ = ""
CASE "Û": cad$ = STRING$(40, "1")
CASE ELSE: cad$ = "0000000000000000000000000000000000011111"
END SELECT
nnn = 0
FOR vv = 1 TO 10
FOR hh = 1 TO 5
nnn = nnn + 1
IF MID$(cad$, nnn, 1) = "1" THEN LINE (h + (hh * dh), V + (vv * dv))-STEP(gh, gv), c + ((vv - 1) * cv) + ((hh - 1) * ch), BF
NEXT
NEXT
h = h + (dh * 6)
NEXT
END SUB

SUB puntos
n = 0
FOR h = 210 TO 280 STEP 15
n = n + 1
FOR V = 170 TO 185 - (punt(n) * 15) STEP -15
cubo h, V, ((n - 1) * 4) + 32
NEXT
NEXT
END SUB

SUB salida

FOR h = 0 TO 300 STEP 15
FOR V = 5 TO 195 STEP 15
BORRA h, V
NEXT
NEXT

FOR h = 30 TO 275 STEP 15
cubo h, 20, (INT(RND * 5) * 4) + 32
cubo h, 170, (INT(RND * 5) * 4) + 32
NEXT
FOR V = 20 TO 180 STEP 15
cubo 15, V, (INT(RND * 5) * 4) + 32
cubo 285, V, (INT(RND * 5) * 4) + 32
NEXT

letras 58, 50, "SALIDA", 32, 1, 1, 1, 2, 0, 1

letras 52, 75, " JUEGO TERMINADO", 20, 1, 1, 2, 4, 1, 3
letras 50, 130, "PARA SALIR PULSAR S", 82, 1, 1, 1, 1, 0, 0
letras 50, 143, "PARA VOLVER A JUGAR PULSAR V", 90, 1, 1, 1, 1, 0, 0

WHILE INKEY$ <> "": WEND
DO
kbd$ = UCASE$(INKEY$)
LOOP UNTIL kbd$ = "V" XOR kbd$ = "S"
IF kbd$ = "V" THEN RUN 1
CLS
letras 95, 95, "J.M.G.B.   RONDA   1997", 20, 1, 1, 1, 1, 0, 0
COLOR 0
END

SLEEP


END SUB