' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... es.geocities.com/jm00092 ' '______________________________________________________________________ ' JUEGA AUTOM TICAMENTE AL PARC¡S ' ' ' ' PARA SALIR PULSAR VARIAS VECES DURANTE TIRADAS DE DADOS ' ' DECLARE SUB TEXTO (LV!, LH!, TEXT$, C!, CF!) DECLARE SUB btx (V!, H!, sol!, sombra!, CARA!, BORDE!, letra!, TEXT$, AMPL!) DECLARE SUB pieza (C!, n!) DECLARE SUB borra (n!) DECLARE FUNCTION dado! (C!) DECLARE FUNCTION lisl$ (n!) DECLARE SUB digital (H!, V!, n$, C1!, C2!, B!, b1!, b2!) DECLARE SUB boton (H!, V!, L!, A!, sol!, sombra!, CARA!, BORDE!) DECLARE SUB tablero () RANDOMIZE TIMER SCREEN 12 PALETTE 12, 63 PALETTE 3, 28 PAINT (1, 1), 7 tablero digital 500, 20, "PARCHIS", 12, 3, 1, 8, 7 digital 203, 230, "0", 10, 3, 1, 2, 10 digital 265, 230, "0", 9, 3, 1, 1, 9 digital 234, 201, "0", 12, 3, 1, 4, 12 digital 234, 257, "0", 14, 3, 1, 6, 14 digital 113, 322, "4", 10, 3, 1, 2, 10 digital 355, 136, "4", 9, 3, 1, 1, 9 digital 145, 108, "4", 12, 3, 1, 4, 12 digital 323, 350, "4", 14, 3, 1, 6, 14 FOR n = 1 TO 68 pieza 12, n NEXT FOR n = 1 TO 68 borra n NEXT pieza 14, 5 pieza 9, 22 pieza 12, 39 pieza 10, 56 DO btx 22, 63, 15, 8, 7, 0, 5, " QUIEN SALE ", 4 DO: LOOP WHILE INKEY$ = "" btx 22, 63, 8, 15, 7, 0, 5, " QUIEN SALE ", 4 BEEP QUIEN = dado(13) - 1 LOOP UNTIL QUIEN < 5 lamarillo = 5 lazul = 22 lrojo = 39 lverde = 56 DO QUIEN = QUIEN + 1 IF QUIEN > 4 THEN QUIEN = 1 SELECT CASE QUIEN CASE 1: btx 22, 63, 15, 8, 7, 0, 14, " AMARILLO ", 4 CASE 2: btx 22, 63, 15, 8, 7, 0, 9, " AZUL ", 4 CASE 3: btx 22, 63, 15, 8, 7, 0, 12, " ROJO ", 4 CASE 4: btx 22, 63, 15, 8, 7, 0, 10, " VERDE ", 4 END SELECT DO: LOOP WHILE INKEY$ = "" alamarillo = lamarillo alazul = lazul alrojo = lrojo alverde = lverde SELECT CASE QUIEN CASE 1: btx 22, 63, 8, 15, 7, 0, 14, " AMARILLO ", 4: lamarillo = lamarillo + dado(14) CASE 2: btx 22, 63, 8, 15, 7, 0, 9, " AZUL ", 4: lazul = lazul + dado(9) CASE 3: btx 22, 63, 8, 15, 7, 0, 12, " ROJO ", 4: lrojo = lrojo + dado(12) CASE 4: btx 22, 63, 8, 15, 7, 0, 10, " VERDE ", 4: lverde = lverde + dado(10) END SELECT borra alamarillo borra alazul borra alrojo borra alverde pieza 14, lamarillo pieza 9, lazul pieza 12, lrojo pieza 10, lverde LOOP UNTIL INKEY$ = CHR$(27) ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB borra (n) cad$ = lisl$(n) LH = VAL(MID$(cad$, 1, 3)) LV = VAL(MID$(cad$, 4, 3)) C = POINT(LH - 1, LV + 5) LINE (LH, LV)-STEP(18, 18), C, BF END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB boton (H, V, L, A, sol, sombra, CARA, BORDE) CF = POINT(H, V) PSET (H, V), CF IF A <> 32 THEN LINE STEP(L, A)-STEP(-L, -A), BORDE, B LINE STEP(1, 1)-STEP(0, A - 2), sol LINE STEP(0, 0)-STEP(L - 2, 0), sombra LINE STEP(0, 0)-STEP(0, -A + 2), sombra LINE STEP(-1, 0)-STEP(-L + 3, 0), sol LINE STEP(1, 1)-STEP(0, A - 4), sol LINE STEP(0, 0)-STEP(L - 4, 0), sombra LINE STEP(0, 0)-STEP(0, -A + 4), sombra LINE STEP(-1, 0)-STEP(-L + 5, 0), sol LINE STEP(1, 1)-STEP(L - 6, A - 6), CARA, BF END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB btx (V, H, sol, sombra, CARA, BORDE, letra, TEXT$, AMPL) IF AMPL < 2 THEN : AMPL = 2 PSET (((H - 1) * 8) - AMPL - 3, ((V - 1) * 16) - AMPL - 3) L = (LEN(TEXT$) * 8) + (2 * AMPL) + 4 A = 16 + (2 * AMPL) + 3 LINE STEP(L, A)-STEP(-L, -A), BORDE, B LINE STEP(1, 1)-STEP(0, A - 2), sol LINE STEP(0, 0)-STEP(L - 2, 0), sombra LINE STEP(0, 0)-STEP(0, -A + 2), sombra LINE STEP(-1, 0)-STEP(-L + 3, 0), sol LINE STEP(1, 1)-STEP(0, A - 4), sol LINE STEP(0, 0)-STEP(L - 4, 0), sombra LINE STEP(0, 0)-STEP(0, -A + 4), sombra LINE STEP(-1, 0)-STEP(-L + 5, 0), sol LINE STEP(1, 1)-STEP(L - 6, A - 6), CARA, BF TEXTO V, H, TEXT$, letra, CARA END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' FUNCTION dado (C) LINE (484, 384)-(628, 468), 8, BF LINE (480, 380)-(624, 464), C, BF LINE (480, 380)-(624, 464), 0, B digital 603, 389, "E", C, 3, 1, C - 8, C NVE = 0 DO NVE = NVE + 1 H = INT(RND * 69) + 485 V = INT(RND * 39) + 385 n = INT(RND * 6) + 1 HASTA = INT(RND * 40) + 20 IF n = 7 THEN n = 6 SELECT CASE n CASE 1: cod$ = "000010000" CASE 2: IF RND < .5 THEN cod$ = "001000100" ELSE cod$ = "100000001" CASE 3: IF RND < .5 THEN cod$ = "001010100" ELSE cod$ = "100010001" CASE 4: cod$ = "101000101" CASE 5: cod$ = "101010101" CASE 6: IF RND < .5 THEN cod$ = "111000111" ELSE cod$ = "101101101" END SELECT LINE (481, 381)-(597, 463), C, BF LINE (H + 3, V + 2)-STEP(37, 37), C - 8, BF LINE (H + 1, V + 1)-STEP(35, 35), 15, BF LINE (H, V)-STEP(37, 37), 0, B nc = 0 FOR hh = H + 8 TO H + 28 STEP 10 FOR vv = V + 8 TO V + 28 STEP 10 nc = nc + 1 IF MID$(cod$, nc, 1) = "1" THEN CIRCLE (hh, vv), 4, 0 PAINT (hh, vv), 0, 0 END IF NEXT NEXT LOCATE 10, 75: PRINT FRE(-2) SOUND (n * 800), .5 SOUND (n * 300), 1 digital 603, 389, MID$(STR$(n), 2, 1), C, 3, 1, C - 8, C LOOP WHILE NVE < HASTA dado = n END FUNCTION ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' TIPOGRAFIA DE MARCADORES DIGITALES HECHO EN RONDA ' ' ' SUB digital (H, V, n$, C1, C2, B, b1, b2) IF B THEN boton H - 5, V - 5, ((15 * LEN(n$) + 7)), 32, b1, 15, 0, b2 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 "A": cadena$ = "1111110" CASE "B": cadena$ = "0101111" CASE "C": cadena$ = "1100101" CASE "Z": cadena$ = "0001101" CASE "D": cadena$ = "0011111" CASE "E": cadena$ = "1101101" CASE "F": cadena$ = "1101100" CASE "G": cadena$ = "1100111" CASE "H": cadena$ = "0111110" CASE "I": cadena$ = "0010010" CASE "J": cadena$ = "0010011" CASE "L": cadena$ = "0100101" CASE "M": cadena$ = "1110110" CASE "N": cadena$ = "0001110" CASE "¤": cadena$ = "1001110" CASE "¥": cadena$ = "1001110" CASE "W": cadena$ = "0001111" CASE "O": cadena$ = "1110111" CASE "P": cadena$ = "1111100" CASE "R": cadena$ = "0001100" CASE "S": cadena$ = "1101011" CASE "T": cadena$ = "0101101" CASE "U": cadena$ = "0110111" CASE "V": cadena$ = "0000111" CASE "Y": cadena$ = "0111100" CASE "=": cadena$ = "0001001" CASE ":": cadena$ = "0001000" CASE "-": cadena$ = "0001000" CASE " ": cadena$ = "0000000" CASE ELSE: SOUND 1000, 1: cadena$ = "0000000" END SELECT IF MID$(cadena$, 1, 1) = "1" THEN : PSET (H, V), C1: DRAW "brr10gl8fr6": ELSE : PSET (H, V), C2: DRAW "brr10gl8fr6" IF MID$(cadena$, 2, 1) = "1" THEN : PSET (H, V), C1: : DRAW "bdd9eu7fd5": ELSE : PSET (H, V), C2: : DRAW "bdd9eu7fd5" IF MID$(cadena$, 3, 1) = "1" THEN : PSET (H, V), C1: : DRAW "bdbr12d9hu7gd5": ELSE : PSET (H, V), C2: : DRAW "bdbr12d9hu7gd5" IF MID$(cadena$, 4, 1) = "1" THEN : PSET (H, V), C1: : DRAW "br2bd10r8fl10fr8": ELSE : PSET (H, V), C2: : DRAW "br2bd10r8fl10fr8" IF MID$(cadena$, 5, 1) = "1" THEN : PSET (H, V), C1: : DRAW "bd12d9eu7fd5": ELSE : PSET (H, V), C2: : DRAW "bd12d9eu7fd5" IF MID$(cadena$, 6, 1) = "1" THEN : PSET (H, V), C1: : DRAW "bd12br12d9hu7gd5": ELSE : PSET (H, V), C2: : DRAW "bd12br12d9hu7gd5" IF MID$(cadena$, 7, 1) = "1" THEN : PSET (H, V), C1: : DRAW "brbd22r10hl8er6": ELSE : PSET (H, V), C2: : DRAW "brbd22r10hl8er6" PSET (H, V), 0 H = H + 15 NEXT H = ah END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' POSICIONES DE LAS CASILLAS DEL PARCHIS FUNCTION lisl$ (n) SELECT CASE n CASE 1: lisl$ = "282440" CASE 2: lisl$ = "282418" CASE 3: lisl$ = "282396" CASE 4: lisl$ = "282374" CASE 5: lisl$ = "282352" CASE 6: lisl$ = "282330" CASE 7: lisl$ = "282308" CASE 8: lisl$ = "267286" CASE 9: lisl$ = "286267" CASE 10: lisl$ = "308282" CASE 11: lisl$ = "330282" CASE 12: lisl$ = "352282" CASE 13: lisl$ = "374282" CASE 14: lisl$ = "396282" CASE 15: lisl$ = "418282" CASE 16: lisl$ = "440282" CASE 17: lisl$ = "440232" CASE 18: lisl$ = "440182" CASE 19: lisl$ = "418182" CASE 20: lisl$ = "396182" CASE 21: lisl$ = "374182" CASE 22: lisl$ = "352182" CASE 23: lisl$ = "330182" CASE 24: lisl$ = "308182" CASE 25: lisl$ = "286195" CASE 26: lisl$ = "267176" CASE 27: lisl$ = "282154" CASE 28: lisl$ = "282132" CASE 29: lisl$ = "282110" CASE 30: lisl$ = "282088" CASE 31: lisl$ = "282066" CASE 32: lisl$ = "282044" CASE 33: lisl$ = "282022" CASE 34: lisl$ = "232022" CASE 35: lisl$ = "182022" CASE 36: lisl$ = "182044" CASE 37: lisl$ = "182066" CASE 38: lisl$ = "182088" CASE 39: lisl$ = "182110" CASE 40: lisl$ = "182132" CASE 41: lisl$ = "182154" CASE 42: lisl$ = "195176" CASE 43: lisl$ = "176195" CASE 44: lisl$ = "154182" CASE 45: lisl$ = "132182" CASE 46: lisl$ = "110182" CASE 47: lisl$ = "088182" CASE 48: lisl$ = "066182" CASE 49: lisl$ = "044182" CASE 50: lisl$ = "022182" CASE 51: lisl$ = "022232" CASE 52: lisl$ = "022282" CASE 53: lisl$ = "044282" CASE 54: lisl$ = "066282" CASE 55: lisl$ = "088282" CASE 56: lisl$ = "110282" CASE 57: lisl$ = "132282" CASE 58: lisl$ = "154282" CASE 59: lisl$ = "176267" CASE 60: lisl$ = "195286" CASE 61: lisl$ = "182308" CASE 62: lisl$ = "182330" CASE 63: lisl$ = "182352" CASE 64: lisl$ = "182374" CASE 65: lisl$ = "182396" CASE 66: lisl$ = "182418" CASE 67: lisl$ = "182440" CASE 68: lisl$ = "232440" END SELECT END FUNCTION ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB mover (C, d, H) de = d - 1 DO de = de + 1 LOOP UNTIL de = H END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB pieza (C, n) cad$ = lisl$(n) LH = VAL(MID$(cad$, 1, 3)) LV = VAL(MID$(cad$, 4, 3)) boton LH, LV, 18, 18, 15, C - 8, C, 0 END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB tablero LINE (20, 20)-(468, 468), 8, BF LINE (16, 16)-(464, 464), 15, BF LINE (16, 16)-(464, 464), 0, B LINE (18, 18)-(462, 462), 0, B LINE (215, 42)-(265, 196), 12, BF LINE (215, 284)-(265, 438), 14, BF LINE (284, 215)-(438, 265), 9, BF LINE (42, 215)-(196, 265), 10, BF LINE (215, 20)-(265, 196), 0, B LINE (215, 284)-(265, 460), 0, B LINE (284, 215)-(460, 265), 0, B LINE (20, 215)-(196, 265), 0, B FOR n = 44 TO 220 STEP 22 LINE (240 - n, 240 - n)-(240 + n, 240 + n), 0, B NEXT LINE (20, 20)-STEP(145, 145), 12, BF LINE (20, 20)-STEP(145, 145), 0, B LINE (165, 20)-STEP(-145, 145), 0 LINE (315, 20)-STEP(145, 145), 9, BF LINE (315, 20)-STEP(145, 145), 0, B LINE (315, 20)-STEP(145, 145), 0 LINE (20, 315)-STEP(145, 145), 10, BF LINE (20, 315)-STEP(145, 145), 0, B LINE (20, 315)-STEP(145, 145), 0 LINE (315, 315)-STEP(145, 145), 14, BF LINE (315, 315)-STEP(145, 145), 0, B LINE (315, 460)-STEP(145, -145), 0 LINE (20, 20)-(460, 460), 0 LINE (460, 20)-(20, 460), 0 PAINT (230, 240), 10, 0 PAINT (240, 230), 12, 0 PAINT (250, 240), 9, 0 PAINT (240, 250), 14, 0 PAINT (50, 40), 4, 0 PAINT (50, 140), 4, 0 PAINT (320, 70), 1, 0 PAINT (430, 70), 1, 0 PAINT (30, 340), 2, 0 PAINT (150, 340), 2, 0 PAINT (350, 340), 6, 0 PAINT (350, 430), 6, 0 PAINT (280, 370), 14, 0 PAINT (360, 190), 9, 0 PAINT (180, 120), 12, 0 PAINT (120, 270), 10, 0 END SUB ' ' © JM. :: Hecho en Ronda ' ' ' Procedente de... www.jm-web.tk :: es.geocities.com/jm00092 ' '______________________________________________________________________ ' SUB TEXTO (LV, LH, TEXT$, C, CF) LOCATE LV, LH: COLOR C: PRINT TEXT$ IF CF = 0 THEN : PLAY "a": EXIT SUB LINE (((LH - 1) * 8) - 1, (LV - 1) * 16)-STEP(7 + (8 * (LEN(TEXT$) - 1)) + 1, 15), C, B PAINT (((LH - 1) * 8) + 1, ((LV - 1) * 16) + 1), CF, C LINE (((LH - 1) * 8) - 1, (LV - 1) * 16)-STEP(7 + (8 * (LEN(TEXT$) - 1)) + 1, 15), CF, B LH = LH - 1 FOR LETRAS = 1 TO LEN(TEXT$) LH = LH + 1 FOR H = ((LH - 1) * 8) TO ((LH - 1) * 8) + 7 FOR V = ((LV - 1) * 16) + 3 TO ((LV - 1) * 16) + 10 IF POINT(H, V) = 0 THEN : PSET (H, V), CF NEXT NEXT NEXT END SUB