'                                �����������
'                                �����������
'
'   ____  ____  ____  ____  ____  ____  ____  ____  ____  ____  ____  ____
'   ����  ����  ����  ����  ����  ����  ����  ����  ����  ����  ����  ����
'
'                              J  U  E  G  O
'
'                        C  I  B  E  R  N  �  T  I  C  O
'
'             D  E     C  O  N  S  T  R  U  C  C  I  O  N  E  S
'
'   ____  ____  ____  ____  ____  ____  ____  ____  ____  ____  ____  ____
'   ����  ����  ����  ����  ����  ����  ����  ����  ����  ����  ����  ����
'                  H  E  C  H  O     E  N     R  O  N  D  A
'
'                          es.geocities.com/jm00092
'
'
'
'
'
DECLARE SUB borra (h!, v!)
DECLARE SUB salida ()
DECLARE SUB ayuda ()
DECLARE SUB entrada ()
DECLARE SUB caida (h!, n!, l!, a!, C!)
DECLARE SUB actual (pie!, lar!, alt!, col!)
DECLARE FUNCTION menuh! (h!, v!, l!, a!, d!, n!, C!, cf!)
DECLARE FUNCTION menuv! (h!, v!, l!, a!, d!, n!, C!, cf!)
DECLARE SUB pantalla ()
DECLARE SUB PIEZAS (h!, v!, n!, l!, a!, C!)
DECLARE SUB pieza (h!, v!, l!, a!, C!)
RANDOMIZE TIMER
SCREEN 12
DIM SHARED cl(1 TO 7)
DIM SHARED guia(1 TO 410)
DIM SHARED sal(1 TO 2000)
DIM SHARED cursor(1 TO 40)
FOR n = 1 TO 7
READ cl(n)
NEXT

PALETTE 12, 63
PALETTE 3, 40

entrada
'gosub limpiamemoria
CLEAR
FOR n = 1 TO 7
READ cl(n)
NEXT

ayuda
'gosub limpiamemoria
CLEAR
FOR n = 1 TO 7
READ cl(n)
NEXT

pantalla

alt = 3
col = 15
lar = 4
pie = 0
DO
DO
kbd$ = UCASE$(INKEY$)
LOOP WHILE kbd$ = ""

IF alt > 3 THEN
IF kbd$ = "C" XOR kbd$ = "L" THEN alt = 3
END IF

SELECT CASE kbd$
CASE "A"
SELECT CASE menuv(1, 53, 46, 19, 19, 2, 10, 0)
CASE 1: alt = 3
CASE 2: alt = 1
END SELECT
pie = 0
CASE "C"
col = cl(menuv(1, 96, 46, 20, 20, 7, 10, 0))
pie = 0
CASE "E"
pie = (menuv(1, 240, 46, 48, 48, 4, 10, 0))
SELECT CASE pie
CASE 1 TO 2: lar = 2: alt = 9
CASE 3: lar = 2: alt = 6
CASE 4: lar = 4: alt = 6
END SELECT
CASE "L"
resp = (menuh(88, 19, 82, 29, 82, 6, 10, 0))
SELECT CASE resp
CASE 1 TO 4: lar = resp
CASE 5: lar = 6
CASE 6: lar = 8
END SELECT
pie = 0
CASE CHR$(27): salida
CASE " ": GOSUB colocar
CASE "Q": GOSUB mover
CASE ELSE: BEEP
END SELECT
actual pie, lar, alt, col
LOCATE 29, 2: COLOR 13: PRINT "DIS ";
IF FRE(-2) < 500 THEN : 'gosub limpiamemoria
LOCATE 3, 75: PRINT MID$(TIME$, 1, 5)
LOOP

colocar:
LOCATE 29, 2: COLOR 13: PRINT "COL ";
alh = 53
lh = 53
PIEZAS lh, 70, pie, lar, alt, col
DO
DO
kbd$ = INKEY$
LOOP WHILE kbd$ = ""
alh = lh
SELECT CASE kbd$
CASE CHR$(0) + "K": lh = lh - 10
CASE CHR$(0) + "M": lh = lh + 10
CASE CHR$(27): SOUND 300, 5: PIEZAS lh, 70, 0, lar, alt, 0: PUT (lh - 3, 110), guia, XOR: EXIT DO
     CASE CHR$(13): caida lh, pie, lar, alt, col: EXIT DO
          CASE " ": caida lh, pie, lar, alt, col: EXIT DO
CASE CHR$(0) + "P": caida lh, pie, lar, alt, col: EXIT DO
CASE ELSE: lh = lh + 10
END SELECT
IF lh < 53 THEN lh = alh
IF lh > 633 - (lar * 10) THEN lh = alh
PUT (lh - 3, 110), guia, XOR
PUT (alh - 3, 110), guia, XOR
IF lh < 70 THEN LINE (50, 65)-(50, 479), 13, B
IF lh <> alh THEN
PIEZAS alh, 70, 0, lar, alt, 0
PIEZAS lh, 70, pie, lar, alt, col
END IF
LOOP
IF lh < 70 THEN LINE (50, 65)-(50, 479), 13, B
IF FRE(-2) < 500 THEN : 'gosub limpiamemoria

RETURN


mover:
LOCATE 29, 2: COLOR 13: PRINT "QUIT";
alh = 53
lh = 53
alv = 72
lv = 72
PUT (lh, lv), cursor, XOR
DO
DO
kbd$ = INKEY$
LOOP WHILE kbd$ = ""
alh = lh
alv = lv
PUT (alh, alv), cursor, XOR
SELECT CASE kbd$
CASE CHR$(0) + "H": lv = lv - 4
CASE CHR$(0) + "P": lv = lv + 4
CASE CHR$(0) + "K": lh = lh - 10
CASE CHR$(0) + "M": lh = lh + 10
CASE CHR$(0) + "I": lv = lv - 20
CASE CHR$(0) + "Q": lv = lv + 20
CASE CHR$(27):  EXIT DO
CASE CHR$(13):  borra lh, lv
CASE " ": borra lh, lv
CASE ELSE
END SELECT
IF lh < 53 THEN : lh = 53
IF lv < 72 THEN : lv = 72
IF lh > 623 THEN : lh = 623
IF lv > 472 THEN : lv = 472

PUT (lh, lv), cursor, XOR
IF FRE(-2) < 500 THEN : 'gosub limpiamemoria

LOOP
RETURN



DATA 8,7,1,2,12,14,15

SUB actual (pie, lar, alt, col)
LINE (1, 1)-(84, 49), 0, BF
SELECT CASE pie
CASE 0: mh = 43 - ((lar * 10) / 2): mv = 22
CASE 1 TO 2: mh = 30: mv = 8
CASE 3: mh = 30: mv = 14
CASE 4: mh = 20: mv = 14
END SELECT
PIEZAS mh, mv, pie, lar, alt, col
END SUB

SUB ayuda
FOR n = 0 TO 638 STEP 2
LINE (n, 65)-(n + 1, 479), 0, B, &H5555
NEXT

LOCATE 4, 1: COLOR 8: PRINT "       PANTALLA DE INSTRUCCIONES      Pulsa cualquier tecla para empezar       "
LINE (28, 77)-(602, 176), 0, BF
LINE (0, 189)-(275, 415), 0, BF
LINE (0, 419)-(275, 478), 0, BF
LINE (290, 189)-(627, 311), 0, BF
LINE (290, 317)-(627, 390), 0, BF
LINE (290, 396)-(627, 478), 0, BF
LINE (28, 77)-(602, 176), 13, B
LINE (0, 189)-(275, 415), 13, B
LINE (0, 419)-(275, 478), 13, B
LINE (290, 189)-(627, 311), 13, B
LINE (290, 317)-(627, 390), 13, B
LINE (290, 396)-(627, 478), 13, B


COLOR 13
 LOCATE 6, 5: PRINT "Programa para construir objetos en dos dimensiones con piezas parecidas"
 LOCATE 7, 5: PRINT "a las de TENTE. Primero hay que 'dise�ar' una pieza eligiendo su color,"
 LOCATE 8, 5: PRINT "altura y longitud. Despu�s hay que ponerla encima del lugar donde se va"
 LOCATE 9, 5: PRINT "colocar y dejarla caer. Para quitar piezas pulsar la tecla Q, situar el"
LOCATE 10, 5: PRINT "cursor en la esquina superior izquierda de la pieza y pulsar ��. No se"
LOCATE 11, 5: PRINT "pueden archivar las construcciones en los discos al salir del programa."

LOCATE 13, 10: PRINT "BLOQUES DISPONIBLES"
LOCATE 28, 3: PRINT "PIEZAS"
LOCATE 29, 3: PRINT "ESPECIALES";
LOCATE 13, 40: PRINT "TECLAS PARA DISE�O DE PIEZAS"
LOCATE 21, 40: PRINT "TECLAS PARA COLOCACI�N DE PIEZAS"
LOCATE 26, 40: PRINT "TECLAS PARA QUITAR PIEZAS"

COLOR 15
LOCATE 14, 40: PRINT "A........Definir altura"
LOCATE 15, 40: PRINT "C........Definir color"
LOCATE 16, 40: PRINT "L........Definir longitud"
LOCATE 17, 40: PRINT "E........Seleccionar pieza especial"
LOCATE 18, 40: PRINT "��......Colocar la pieza dise�ada"
LOCATE 19, 40: PRINT "Q........Quitar piezas ya colocadas"

LOCATE 22, 40: PRINT ",......Mover pieza por la regla"
LOCATE 23, 40: PRINT "��,....Dejar caer la pieza"
LOCATE 24, 40: PRINT "Esc......Cancelar colocaci�n"

LOCATE 27, 40: PRINT ", AvP�g, ReP�g......Mover cursor";
LOCATE 28, 40: PRINT "��......Quitar si no hay m�s encima";
LOCATE 29, 40: PRINT "Esc......Volver al sistema de dise�o";

FOR v = 1 TO 7
hh = 0
FOR h = 1 TO 8
IF h = 5 THEN h = 6: hh = hh - 10
IF h = 7 THEN h = 8: hh = hh - 10
hh = hh + (h * 10) - 5
pieza hh, ((v * 30) + 180), h, 3, cl(v)
pieza hh, ((v * 30) + 198), h, 1, cl(v)
NEXT
NEXT
PIEZAS 110, 430, 1, 0, 0, 0
PIEZAS 145, 430, 2, 0, 0, 0
PIEZAS 180, 430, 3, 0, 0, 0
PIEZAS 215, 430, 4, 0, 0, 0


WHILE INKEY$ <> "": WEND
DO: LOOP WHILE INKEY$ = ""
CLS
END SUB

SUB borra (h, v)
WHILE INKEY$ <> "": WEND
IF POINT(h + 1, v) <> 0 AND POINT(h + 2, v - 1) = 0 AND POINT(h, v + 1) = 0 THEN  ELSE SOUND 200, 3: EXIT SUB
a = 0
l = 0
vv = v
hh = h
DO
vv = vv + 4
a = a + 1
IF a > 9 THEN a = 1: EXIT DO
LOOP WHILE POINT(h + 1, vv + 3) <> 0
a = a + 1
IF a = 2 THEN a = 1
IF a = 7 THEN a = 1
IF a > 9 THEN a = 1
DO
hh = hh + 10
l = l + 1
LOOP WHILE POINT(hh, v + 1) <> 0
l = l - 1

ccc = 0
FOR hh = h TO h + (l * 10) STEP 10
ccc = POINT(hh + 4, v - 4) + ccc
NEXT
IF ccc > 0 THEN : SOUND 3000, 1: EXIT SUB
FOR n = 3100 TO 2400 STEP -40
SOUND n, .3
NEXT

FOR hh = h TO h + (l * 10) STEP 10
LINE (hh + 2, v - 1)-STEP(6, -1), 0, BF
NEXT


FOR hh = h TO h + l * 10 STEP 10
FOR vv = v TO v + a * 4 STEP 4
LINE (hh, vv - 4)-STEP(9, 3), 0, BF
NEXT
NEXT

FOR hh = h TO h + (l * 10) STEP 10
ccc = POINT(hh + 2, v + (a * 4))
LINE (hh + 2, v + (a * 4) - 2)-STEP(6, -1), ccc, BF
NEXT
WHILE INKEY$ <> "": WEND
END SUB

SUB caida (h, n, l, a, C)
IF POINT(0, 0) = 13 THEN LOCATE 29, 2: COLOR 13: PRINT "CAI ";
pieza h, 70, l, a, 0
v = 72
DO
pieza h, v, l, a, 0
v = v + 4
PIEZAS h, v, n, l, a, C

fin = 0
FOR nn = 0 TO l - 1
fin = fin + POINT(h + (nn * 10) + 5, v + (a * 4) + 2)
NEXT
LOOP WHILE fin = 0 AND v < 472 - (a * 4)
pieza h, v, l, a, 0
IF v > 108 THEN PIEZAS h, v + 3, n, l, a, C
IF POINT(0, 0) = 13 THEN PUT (h - 3, 110), guia, XOR


END SUB

SUB entrada
LOCATE 1, 5: PRINT "J U E G O   C I B E R N � T I C O   D E   C O N S T R U C C I O N E S"
LOCATE 2, 19: COLOR 12: PRINT "H  E  C  H  O      E  N      R  O  N  D  A"
LOCATE 4, 1: COLOR 8: PRINT "Pulsa cualquier tecla para empezar o espera un poco."
LOCATE 4, 61: COLOR 3: PRINT "Piezas caidas: 0"

DO
a = RND: IF a < .3 THEN a = 1 ELSE a = 3
C = cl(INT(RND * 7) + 1)': IF co = 8 THEN : co = 7: c = cl(co)
l = INT(RND * 6) + 1
SELECT CASE l
CASE 1 TO 4: l = l
CASE 5: l = 6
CASE IS > 5: l = 8
END SELECT
h = INT(RND * (64 - l)) * 10
p = INT(RND * 50)
SELECT CASE p
CASE 1 TO 2: l = 2: a = 9
CASE 3 TO 4: l = 2: a = 6: p = 3
CASE 5 TO 7: l = 4: a = 6: p = 4
CASE ELSE: p = 0
END SELECT
caida h, p, l, a, C
num = num + 1
LOCATE 4, 75: PRINT num
LOOP WHILE INKEY$ = "" AND num < 300
END SUB

FUNCTION menuh (h, v, l, a, d, n, C, cf)
psi = h
LINE (psi, v)-(psi + l, v + a), C, B
DO
DO
kbd$ = INKEY$
LOOP WHILE kbd$ = ""
LINE (psi, v)-(psi + l, v + a), cf, B
SELECT CASE kbd$
CASE CHR$(0) + "K": psi = psi - d
CASE CHR$(0) + "M": psi = psi + d
CASE CHR$(13): SOUND 950, 4
CASE ELSE: psi = psi + d
END SELECT
IF psi > h + (d * (n - 1)) THEN : psi = h
IF psi < h THEN : psi = h + (d * (n - 1))
LINE (psi, v)-(psi + l, v + a), C, B
LOOP UNTIL kbd$ = CHR$(13)
LINE (psi, v)-(psi + l, v + a), cf, B

menuh = ((psi - h) / d) + 1
END FUNCTION

FUNCTION menuv (h, v, l, a, d, n, C, cf)
psi = v
LINE (h, psi)-(h + l, psi + a), C, B
DO
DO
kbd$ = INKEY$
LOOP WHILE kbd$ = ""
LINE (h, psi)-(h + l, psi + a), cf, B
SELECT CASE kbd$
CASE CHR$(0) + "H": psi = psi - d
CASE CHR$(0) + "P": psi = psi + d
CASE CHR$(13): SOUND 950, 4
CASE ELSE: psi = psi + d
END SELECT
IF psi > v + (d * (n - 1)) THEN : psi = v
IF psi < v THEN : psi = v + (d * (n - 1))
LINE (h, psi)-(h + l, psi + a), C, B
LOOP UNTIL kbd$ = CHR$(13)
LINE (h, psi)-(h + l, psi + a), cf, B
menuv = ((psi - v) / d) + 1
END FUNCTION

SUB pantalla
LOCATE 1, 18: COLOR 15: PRINT "JUEGO CIBERN�TICO DE CONSTRUCCI�NES"
LOCATE 1, 60: COLOR 12: PRINT "HECHO EN RONDA"
COLOR 13
LOCATE 29, 2: PRINT "DIS ";
LOCATE 3, 75: PRINT MID$(TIME$, 1, 5);
pieza 4, 59, 4, 3, 15
pieza 4, 81, 4, 1, 15
FOR n = 1 TO 7
pieza 4, (n * 20) + 82, 4, 3, cl(n)
NEXT
hh = 19
FOR n = 1 TO 8
IF n = 5 THEN n = 6
IF n = 7 THEN n = 8
hh = hh + 80
pieza hh, 29, n, 3, 15
NEXT
 PIEZAS 14, 248, 1, 0, 0, 0
PIEZAS 14, 295, 2, 0, 0, 0
PIEZAS 14, 350, 3, 0, 0, 0
PIEZAS 4, 396, 4, 0, 0, 0
LINE (0, 0)-(85, 50), 13, B
LINE (0, 52)-(48, 93), 13, B
LINE (0, 95)-(48, 237), 13, B
LINE (0, 239)-(48, 433), 13, B
LINE (87, 18)-(581, 50), 13, B
LINE (583, 18)-(636, 50), 13, B
LINE (0, 435)-(48, 479), 13, B
LINE (50, 52)-(636, 63), 13, B
LINE (50, 65)-(636, 479), 13, B
LINE (87, 0)-(636, 16), 13, B
FOR hh = 53 TO 625 STEP 10
PSET (hh + 5, 59), 15
DRAW "s4url2ulr4"
NEXT
FOR hh = 53 TO 625 STEP 40
PSET (hh + 5, 59), 12
DRAW "s4url2ulr4"
NEXT
GET (636, 110)-(636, 470), guia
LINE (3, 2)-STEP(9, 4), 13, B
GET (2, 2)-STEP(9, 3), cursor
LINE (3, 2)-STEP(9, 4), 0, B
END SUB

SUB pieza (h, v, l, a, C)

LINE (h, v)-STEP(l * 10, a * 4), C, BF
LINE (h, v)-STEP(l * 10, a * 4), 0, B

FOR n = h + 5 TO h + (l * 10) - 5 STEP 10
LINE (n - 4, v)-STEP(8, -3), C, BF
LINE (n - 4, v)-STEP(8, -3), 0, B

NEXT

END SUB

SUB PIEZAS (h, v, n, l, a, C)
SELECT CASE n
CASE 0
pieza h, v, l, a, C
CASE 1
pieza h, v, 2, 1, 12
LINE (h, v)-STEP(20, 36), 12, BF
LINE (h, v)-STEP(20, 36), 0, B
LINE (h + 3, v + 3)-STEP(14, 17), 11, BF
LINE (h + 3, v + 23)-STEP(11, 0), 11, BF
LINE (h + 3, v + 26)-STEP(14, 6), 11, BF
CASE 2
pieza h, v, 2, 1, 12
LINE (h, v)-STEP(20, 36), 12, BF
LINE (h, v)-STEP(20, 36), 0, B
LINE (h + 3, v + 3)-STEP(14, 17), 11, BF
LINE (h + 6, v + 23)-STEP(11, 0), 11, BF
LINE (h + 3, v + 26)-STEP(14, 6), 11, BF
CASE 3
pieza h, v, 2, 1, 12
LINE (h, v)-STEP(20, 24), 12, BF
LINE (h, v)-STEP(20, 24), 0, B
LINE (h + 3, v + 3)-STEP(14, 7), 11, BF
LINE (h + 3, v + 13)-STEP(14, 7), 11, BF
PSET (h + 8, v + 21), 12: DRAW "s4r4lul2"
CASE 4
pieza h, v, 4, 1, 12
LINE (h, v)-STEP(40, 24), 12, BF
LINE (h, v)-STEP(40, 24), 0, B
LINE (h + 3, v + 3)-STEP(34, 16), 11, BF

END SELECT

END SUB

SUB salida
LOCATE 29, 2: COLOR 13: PRINT "SAL ";

GET (270, 250)-(400, 320), sal
LINE (270, 250)-(400, 320), 0, BF
LINE (270, 250)-(400, 320), 13, B
COLOR 13: LOCATE 17, 40: PRINT "SALIDA"
COLOR 15: LOCATE 18, 38: PRINT "S...Salir"
LOCATE 19, 38: PRINT "V...Volver"
LOCATE 20, 38: PRINT "N...Nuevo"

DO
DO
kbd$ = UCASE$(INKEY$)
LOOP WHILE kbd$ = ""
SELECT CASE kbd$
CASE "S": CLS : LOCATE 16, 31: COLOR 13: PRINT "J.M.G.B.  Ronda 1997": COLOR 0: SYSTEM: END
CASE "V": EXIT DO
CASE CHR$(27): EXIT DO
CASE "N": CLS : pantalla: EXIT SUB
END SELECT
LOOP

PUT (270, 250), sal, PSET
EXIT SUB
END SUB