10 REM      * * * DADOS * * * 20 REM      * por J.Riveros * 30 REM 40 50 GOSUB 1750 60 GOSUB 150:GOSUB 260 70 GOSUB 430:GOSUB 570:GOSUB 750 80 WHILE fin 90 FOR turno=1 TO nj 100 GOSUB 790 110 NEXT turno 120 WEND 130 GOSUB 1480 140 REM *** ESTABLECE MODO, TINTA, ETC *** 150 MODE 1:RANDOMIZE TIME:DEFINT a-z 160 BORDER 12:INK 0,12:INK 1,0:INK 2,26:INK 3,6 170 FOR x=1 TO 6 180 d$(x)=MID$("NRJQKA",x,1) 190 NEXT x 200 REM *** VENTANAS *** 210 WINDOW #1,11,14,8,10:WINDOW #2,15,18,8,10:WINDOW #3,19,22,8,10 220 WINDOW #4,23,26,8,10:WINDOW #5,27,30,8,10 230 WINDOW #6,2,39,14,22:WINDOW #7,2,39,24,24 240 RETURN 250 REM *** CREA CARACTERES DE DADOS *** 260 SYMBOL 240,0,0,0,15,31,31,31,31:SYMBOL 241,0,0,0,255,255,255,255,255 270 SYMBOL 242,0,0,0,240,248,248,248,248:SYMBOL 243,31,31,31,31,31,31,31,31 280 SYMBOL 244,248,248,248,248,248,248,248,248:SYMBOL 245,31,31,31,31,15,0,0,0 290 SYMBOL 246,255,255,255,255,255,0,0,0:SYMBOL 247,248,248,248,248,240,0,0,0 300 SYMBOL 248,0,60,126,126,126,126,60,0:SYMBOL 249,219,219,0,24,24,0,219,219 310 SYMBOL 250,219,219,0,102,102,0,219,219 320 REM *** DADO SIN SIMBOLO *** 330 dado$="":FOR x=1 TO 19:READ caracter 340 dado$=dado$+CHR$(caracter):NEXT x 350 REM *** DADO CON SIMBOLO *** 360 FOR x=1  TO 6 370 simbolo$(x)="":FOR y=1 TO 8:READ caracter 380 simbolo$(x)=simbolo$(x)+CHR$(caracter):NEXT y 390 dado$(x)=dado$+simbolo$(x) 400 NEXT x 410 RETURN 420 REM *** DADOS DE LOS JUGADORES *** 430 PAPER 0:PEN 1 440 CLS:LOCATE 2,12 450 INPUT "Numero de jugadores (max. 4)";nj 460 IF nj<1 OR nj>4 THEN CLS:LOCATE 10,12:PRINT"ENTRADA INCORRECTA":FOR x=1 TO 3000:NEXT x:GOTO 440 470 PRINT CHR$(7); 480 FOR x=1 TO nj 490 CLS:LOCATE 2,12 500 PRINT"Nombre del jugador n.";x;"(Max. 8 letras)" 510 LOCATE 12,14:INPUT nombre$(x) 520 IF LEN(nombre$(x))>8 OR nombre$(x)="" THEN 490 530 nombre$(x)=UPPER$(nombre$(x)):SOUND 1,200*x,10,7 540 NEXT x 550 RETURN 560 REM *** PANTALLA *** 570 CLS:PEN 2:LOCATE 3,1 580 PRINT"JUGADORES" SPC(6) "A" SPC(2) "K" SPC(2) "Q" SPC(2) "J" SPC(2) "R" SPC(2) "N TOTAL" 590 LOCATE 2,2 600 PRINT CHR$(150);STRING$(37,CHR$(154));CHR$(156) 610 FOR x=1 TO nj 620 LOCATE 2,2+x:PEN 2:PRINT CHR$(149) SPC (37) CHR$(149) 630 LOCATE 3,2+x:PEN 1:PRINT x;CHR$(8)+"-";nombre$(x) 640 NEXT x 650 LOCATE 2,3+nj:PEN 2:PRINT CHR$(147);STRING$(37,CHR$(154));CHR$(153) 660 ORIGIN 4,40:DRAWR 630,0,1:DRAWR 0,170:DRAWR -630,0:DRAWR 0,-170 670 PAPER #6,0:CLS #6:PEN #6,1 680 LOCATE #6,2,1:PRINT #6,"Turno para";STRING$(15,".") 690 LOCATE #6,2,3:PRINT #6,"Te faltan";STRING$(16,".") 700 LOCATE #6,2,5:PRINT #6,"Tirada";STRING$(19,".") 710 LOCATE #6,2,7:PRINT #6,"Eleccion";STRING$(17,".") 720 LOCATE #6,2,9:PRINT #6,"Acumulas";STRING$(17,".") 730 RETURN 740 REM *** INICIA VARIABLES *** 750 FOR x=1 TO nj:total(x)=0:tienes$(x)="":el(x)=0:faltan$(x)="":NEXT x:fin=1:finj=0 760 FOR x=1 TO 6:FOR y=1 TO nj:t$(y,x)=d$(x):NEXT y:NEXT x 770 RETURN 780 REM *** RUTINA PRINCIPAL *** 790 nd=5:tirada=0:acuerdo=0:acum=0:dobla=0 800 LOCATE #6,29,1:PRINT #6,SPACE$(8):LOCATE #6,29,1:PRINT #6,nombre$(turno) 810 tienes$(turno)=tienes$(turno)+d$(el(turno)) 820 t$(turno,el(turno))="-" 830 faltan$(turno)=t$(turno,6)+t$(turno,5)+t$(turno,4)+t$(turno,3)+t$(turno,2)+t$(turno,1) 840 LOCATE #6,29,3:PRINT #6,SPACE$(3):LOCATE #6,29,3:PRINT #6,faltan$(turno) 850 LOCATE #6,28,7:PRINT #6,SPACE$(3) 860 LOCATE #6,28,9:PRINT #6,SPACE$(3) 870 REM *** TIRADAS *** 880 WHILE tirada<3 890 tirada=tirada+1 900 PEN 1 910 LOCATE #6,28,5:PRINT #6,tirada 920 FOR x=1 TO 5 930 PAPER #x,0:CLS #x 940 NEXT x 950 PAPER #7,0:CLS #7:PEN #7,3 960 PRINT #7,"Pulsa <ESPACIO> para tirar los dados" 970 WHILE INKEY(47)<>0:WEND 980 CLS #7 990 REM *** TIRA DADOS *** 1000 FOR t=1 TO nd 1010 valor(t)=RND*5+1 1020 PRINT #t,dado$(valor(t)):SOUND 1,100*t,2,7 1030 NEXT t 1040 IF tirada<>1 AND elec<>0 THEN 1160 1050 REM *** ELEGIR *** 1060 FOR x=1 TO 2000:NEXT x 1070 CLS #7:PEN #7,1 1080 CALL &BB03:INPUT #7,"Elige (A,K,Q,J,R,N,0)";el$:IF el$="" OR LEN(el$)>1 THEN 1080 1090 CLS #7 1100 el$=UPPER$(el$) 1110 elec=INSTR("0NRJQKA",el$) 1120 IF elec=0 THEN CLS #7:PRINT #7,"ELECCION INCORRECTA":GOTO 1060 1130 elec=elec-1 1140 IF tirada=3 AND elec=0 THEN CLS #7:PRINT #7,"TIENES QUE ELEGIR ALGO":GOTO 1060 1150 IF INSTR(tienes$(turno),el$)<>0 AND el$<>"" THEN CLS #7:PRINT #7,"YA LO TIENES":GOTO 1060 1160 el(turno)=elec:SOUND 1,300,15,5 1170 LOCATE #6,29,7:PRINT #6,SPACE$(3):LOCATE #6,29,7:PRINT #6,el$ 1180 FOR x=1 TO nd 1190 IF elec=valor(x) OR 6=valor(x) THEN 1200 ELSE 1210 1200 acuerdo=acuerdo+1 1210 NEXT x 1220 nd=nd-acuerdo:acum=acum+acuerdo:acuerdo=0 1230 LOCATE #6,28,9:PRINT #6,SPACE$(3):LOCATE #6,28,9:PRINT #6,acum 1240 IF nd=0 THEN nd=5 1250 REM *** MARCADOR *** 1260 puntos(elec)=acum*elec 1270 loc=6-elec 1280 IF tirada=3 THEN PEN 1 ELSE PEN 2 1290 IF elec<>0 THEN LOCATE (3*loc)+17,2+turno:PRINT #0,USING"##";puntos(elec) 1300 IF tirada=3 THEN total(turno)=total(turno)+puntos(el(turno)):LOCATE 35,2+turno:PEN 3:PRINT #0,USING"##";total(turno):SOUND 1,300,10,5 1310 REM *** MENSAJES *** 1320 PEN #7,2 1330 IF tirada<>3 AND acum=10 THEN CLS #7:PRINT #7:"ENHORABUENA, TE DOBLAS DE NUEVO" 1340 IF tirada<>3 AND acum=5 AND dobla=0 THEN CLS #7:PRINT #7,"ENHORABUENA, TE DOBLAS":dobla=1 1350 IF tirada=3 AND acum=0 THEN CLS #7:PRINT #7,"QUE HORROR !!!" 1360 IF tirada=3 AND (el$<>"A" AND (acum=1 OR acum=2) OR (el$="A" AND acum=1)) THEN CLS #7:PRINT #7,"PINCHASTE, ";nombre$(turno) 1370 IF tirada=3 AND ((el$<>"A" AND acum=3) OR (el$="A" AND acum=2)) THEN CLS #7:PRINT #7,"REGULAR..." 1380 IF (tirada=3 AND el$="A" AND acum=3) OR (tirada=3 AND el$<>"A" AND acum=4) THEN CLS #7:PRINT #7,"BIEN !" 1390 IF tirada=3 AND ((el$<>"A" AND acum=5) OR (el$="A" AND acum=4)) THEN  CLS #7:PRINT #7,"MUY BIEN, ";nombre$(turno) 1400 IF tirada=3 AND ((el$<>"A" AND acum>5) OR (el$="A" AND acum=4)) THEN CLS #7:PRINT #7,"EXCELENTE TIRADA" 1410 FOR x=1 TO 3000:NEXT x 1420 WEND 1430 REM *** DETECTA FIN PARTIDA *** 1440 finj=finj+1 1450 IF finj=6*nj AND tirada=3 THEN fin=0 1460 RETURN 1470 REM *** FIN *** 1480 PAPER #7,2:CLS #7:PEN #7,1 1490 PRINT #7,TAB(10)"FIN DE LA PARTIDA" 1500 FOR x=1 TO 5:CLS #x:NEXT x 1510 REM *** CLASIFICACION *** 1520 CLS #6:PRINT #6,TAB(13)"CLASIFICACION" 1530 PRINT #6:PRINT #6:PRINT #6 1540 invert=0 1550 FOR x=1 TO nj-1 1560 IF total(x)<total(x+1) THEN GOSUB 1690 1570 NEXT x 1580 IF invert=1 THEN 1540 1590 FOR x=1 TO nj 1600 pun(x)=15-LEN(nombre$(x)) 1610 PRINT #6,TAB(5);"-";nombre$(x);STRING$(pun(x),".");total(x);"Puntos" 1620 NEXT x 1630 FOR x=1 TO 3000:NEXT x 1640 CLS #7 1650 PRINT #7,TAB(10)"NUEVA PARTIDA (S/N)?" 1660 sn$=UPPER$(INKEY$):IF sn$<>"S" AND sn$<>"N" THEN 1660 1670 IF sn$="S" THEN 70 1680 CLS:PEN 1:CALL &BBFF:END 1690 g=total(x):n$=nombre$(x) 1700 total(x)=total(x+1):nombre$(x)=nombre$(x+1) 1710 total(x+1)=g:nombre$(x+1)=n$ 1720 invert=1 1730 RETURN 1740 REM *** PRESENTACION *** 1750 MODE 1:INK 0,0:INK 1,0:INK 2,26:INK 3,2:BORDER 0 1760 y=18 1770 LOCATE 1,25:PEN 1:PRINT"DA-2" 1780 WHILE y 1790 y=y-2 1800 FOR x=0 TO 60 STEP 2 1810 IF TEST (x,y) THEN PEN INT(RND*2)+2:LOCATE x/2+4,(-y+17)/2:PRINT CHR$(233):SOUND 1,1000,2,7,0,0,1:FOR retardo=1 TO 10:NEXT 1820 NEXT 1830 WEND 1840 LOCATE 14,13:PEN 3:PRINT STRING$(13,"*") 1850 LOCATE 14,15:PEN 2:PRINT "Por J.Laborda" 1860 LOCATE 14,17:PEN 3:PRINT STRING$(13,"*") 1870 LOCATE 12,22:PEN 2:PRINT "(Pulsa una tecla)" 1880 WHILE INKEY$="":WEND 1890 MODE 0 1900 LOCATE 3,12:PEN 3 1910 PRINT"Buena suerte !" 1920 SOUND 1,300,10,7:SOUND 1,0,2,7:SOUND 1,800,10,7:SOUND 1,0,2,7:SOUND 1,200,10,7 1930 FOR x=1 TO 2000:NEXT 1940 RETURN 1950 REM *** DATA DE LOS DADOS *** 1960 DATA 15,2,240,241,242,8,8,8,10,243,143,244,8,8,8,10,245,246,247 1970 DATA 15,1,22,1,11,8,8,249 1980 DATA 15,3,22,1,11,8,8,250 1990 DATA 15,1,22,1,11,8,8,74 2000 DATA 15,1,22,1,11,8,8,81 2010 DATA 15,3,22,1,11,8,8,75 2020 DATA 15,3,22,1,11,8,8,248