'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...        es.geocities.com/jm00092
'
'______________________________________________________________________
'                                       JUEGA AUTOM TICAMENTE AL PARC¡S
'
'
'
' <!> PARA SALIR PULSAR <ESCAPE> 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