'
' JUEGO DE COLUMNAS
'
'  Teclas: Izquierda/derecha.. Mover
'          Arriba............. Rotar colores
'          Escape............. Salir
'
'   -------------------------------------------------
'                            es.geocities.com/jm00092
'  
'
DECLARE SUB borrarybajar ()
DECLARE FUNCTION buscar! ()
DECLARE SUB pieza (h!, v!, c1!, c2!, c3!)
DECLARE FUNCTION cabe! (h!, v!)
DECLARE SUB digital (h!, v!, num!, l!, c1!, c2!, b!)
DECLARE SUB boton (h!, v!, l!, a!, sol!, sombra!, cara!, bord!)
RANDOMIZE TIMER
SCREEN 12
PALETTE 12, 63
PALETTE 4, 30
boton 0, 0, 640, 480, 15, 8, 7, 0
digital 400, 400, 0, 4, 12, 4, 1
boton 98, 13, 214, 454, 8, 15, 0, 7
tiempo = 4000
fin = 0
pc1 = INT(RND * 5) + 10
pc2 = INT(RND * 5) + 10
pc3 = INT(RND * 5) + 10
DO
   h = 190
   v = 15
   IF cabe(h, v) = 0 THEN fin = 1
   c1 = pc1
   c2 = pc2
   c3 = pc3
   pc1 = INT(RND * 5) + 10
   pc2 = INT(RND * 5) + 10
   pc3 = INT(RND * 5) + 10
   pieza 400, 300, pc1, pc2, pc3
   pieza h, v, c1, c2, c3
   t = 0
   llegado = 0
   DO
      DO
         tecla$ = INKEY$
         t = t + 1
      LOOP WHILE tecla$ = "" AND t < tiempo
      ah = h
      av = v
      LINE (ah, av)-STEP(29, 89), 0, BF
      IF t = tiempo THEN
         v = v + 30
         t = 0
      END IF
      IF cabe(h, v) = 0 THEN llegado = 1
      SELECT CASE tecla$
      CASE CHR$(0) + "H"
         aux = c1
         c1 = c2
         c2 = c3
         c3 = aux
      CASE CHR$(0) + "P": v = v + 30
      CASE CHR$(0) + "K": h = h - 30
      CASE CHR$(0) + "M": h = h + 30
      END SELECT
      IF cabe(h, v) = 0 THEN
         h = ah
         v = av
      END IF
      pieza h, v, c1, c2, c3
   LOOP WHILE tecla$ <> CHR$(27) AND llegado = 0
   b = buscar
   WHILE b > 0
      borrarybajar
      puntos = puntos + b
      digital 400, 400, puntos, 4, 12, 4, 0
      b = buscar
   WEND
LOOP WHILE tecla$ <> CHR$(27) AND fin = 0

SUB borrarybajar
   DIM bajar(1 TO 2000)
   FOR h = 100 TO 280 STEP 30
      FOR v = 15 TO 435 STEP 30
         IF POINT(h + 24, v + 15) = 15 THEN
            LINE (h, v)-STEP(29, 29), 0, BF
            FOR vv = 1 TO 30
              GET (h + 1, 15)-(h + 29, v + 28), bajar
              PUT (h + 1, 16), bajar, PSET
            NEXT
         END IF
      NEXT
   NEXT
END SUB

SUB boton (h, v, l, a, sol, sombra, cara, bord)
LINE (h, v)-STEP(l, a), bord, B
LINE (h + 1, v + 1)-STEP(l - 2, a - 2), sol, B
LINE (h + 2, v + 2)-STEP(l - 3, a - 3), sombra, B
LINE (h + 2, v + 2)-STEP(l - 4, a - 4), cara, BF
END SUB

FUNCTION buscar
   b = 0
   FOR h = 100 TO 280 STEP 30
      FOR v = 15 TO 435 STEP 30
         c = POINT(h + 15, v + 15)
         IF c <> 0 THEN
            IF POINT(h + 45, v + 15) = c AND POINT(h + 75, v + 15) = c THEN
               boton h + 5, v + 5, 20, 20, c - 8, 15, c, c
               boton h + 35, v + 5, 20, 20, c - 8, 15, c, c
               boton h + 65, v + 5, 20, 20, c - 8, 15, c, c
               b = b + 3
            END IF
            IF POINT(h + 15, v + 45) = c AND POINT(h + 15, v + 75) = c THEN
               boton h + 5, v + 5, 20, 20, c - 8, 15, c, c
               boton h + 5, v + 35, 20, 20, c - 8, 15, c, c
               boton h + 5, v + 65, 20, 20, c - 8, 15, c, c
               b = b + 3
            END IF
            IF POINT(h + 45, v + 45) = c AND POINT(h + 75, v + 75) = c THEN
               boton h + 5, v + 5, 20, 20, c - 8, 15, c, c
               boton h + 35, v + 35, 20, 20, c - 8, 15, c, c
               boton h + 65, v + 65, 20, 20, c - 8, 15, c, c
               b = b + 3
            END IF
            IF POINT(h + 45, v - 15) = c AND POINT(h + 75, v - 45) = c THEN
               boton h + 5, v + 5, 20, 20, c - 8, 15, c, c
               boton h + 35, v - 25, 20, 20, c - 8, 15, c, c
               boton h + 65, v - 55, 20, 20, c - 8, 15, c, c
               b = b + 3
            END IF
         END IF
      NEXT
   NEXT
   buscar = b
END FUNCTION

FUNCTION cabe (h, v)
   IF POINT(h + 15, v + 15) = 0 AND POINT(h + 15, v + 45) = 0 AND POINT(h + 15, v + 75) = 0 THEN
      cabe = 1
   ELSE
      cabe = 0
   END IF
END FUNCTION

SUB digital (h, v, num, l, c1, c2, b)
IF b THEN boton h - 5, v - 5, ((15 * l + 7)), 32, 8, 15, 0, 7

IF (l - LEN(STR$(num))) > -1 THEN
n$ = SPACE$(l - LEN(STR$(num))) + STR$(num)
ELSE
n$ = RIGHT$(STR$(num), LEN(STR$(num)) - 1)
END IF


ah = h
FOR X = 1 TO LEN(n$)
SELECT CASE UCASE$(MID$(n$, X, 1))
CASE "1": cadena$ = "0010010"
CASE "2": cadena$ = "1011101"
CASE "3": cadena$ = "1011011"
CASE "4": cadena$ = "0111010"
CASE "5": cadena$ = "1101011"
CASE "6": cadena$ = "1101111"
CASE "7": cadena$ = "1010010"
CASE "8": cadena$ = "1111111"
CASE "9": cadena$ = "1111011"
CASE "0": cadena$ = "1110111"
CASE "-": cadena$ = "0001000"
CASE " ": cadena$ = "0000000"
CASE ELSE: cadena$ = "0000000"
END SELECT

IF MID$(cadena$, 1, 1) = "1" THEN : PSET (h, v), c1: DRAW "s4brr10gl8fr6":         ELSE : PSET (h, v), c2: DRAW "s4brr10gl8fr6"
IF MID$(cadena$, 2, 1) = "1" THEN : PSET (h, v), c1: : DRAW "s4bdd9eu7fd5":        ELSE : PSET (h, v), c2: : DRAW "s4bdd9eu7fd5"
IF MID$(cadena$, 3, 1) = "1" THEN : PSET (h, v), c1: : DRAW "s4bdbr12d9hu7gd5":    ELSE : PSET (h, v), c2: : DRAW "s4bdbr12d9hu7gd5"
IF MID$(cadena$, 4, 1) = "1" THEN : PSET (h, v), c1: : DRAW "s4br2bd10r8fl10fr8":  ELSE : PSET (h, v), c2: : DRAW "s4br2bd10r8fl10fr8"
IF MID$(cadena$, 5, 1) = "1" THEN : PSET (h, v), c1: : DRAW "s4bd12d9eu7fd5":      ELSE : PSET (h, v), c2: : DRAW "s4bd12d9eu7fd5"
IF MID$(cadena$, 6, 1) = "1" THEN : PSET (h, v), c1: : DRAW "s4bd12br12d9hu7gd5":  ELSE : PSET (h, v), c2: : DRAW "s4bd12br12d9hu7gd5"
IF MID$(cadena$, 7, 1) = "1" THEN : PSET (h, v), c1: : DRAW "s4brbd22r10hl8er6":   ELSE : PSET (h, v), c2: : DRAW "s4brbd22r10hl8er6"
PSET (h, v), 0
h = h + 15
NEXT
h = ah
END SUB

SUB pieza (h, v, c1, c2, c3)
boton h, v, 30, 30, 15, c1 - 8, c1, 0
boton h, v + 30, 30, 30, 15, c2 - 8, c2, 0
boton h, v + 60, 30, 30, 15, c3 - 8, c3, 0
'boton h + 3, v + 3, 24, 24, 15, c1 - 8, c1, c1
'boton h + 3, v + 33, 24, 24, 15, c2 - 8, c2, c2
'boton h + 3, v + 63, 24, 24, 15, c3 - 8, c3, c3
END SUB