### Author Topic: BASIC Solitaire  (Read 4170 times)

0 Members and 1 Guest are viewing this topic.

#### mr.freeze ##### Re: BASIC Solitaire
« Reply #25 on: 17:25, 21 June 20 »
I don't understand. I prefer to withdraw.

#### mr.freeze ##### Re: BASIC Solitaire
« Reply #26 on: 17:36, 21 June 20 »
If @AMSDOS type-in the program I offer to proof-read it.

#### AMSDOS ##### Re: BASIC Solitaire
« Reply #27 on: 11:30, 22 June 20 »
If @AMSDOS type-in the program I offer to proof-read it.

Okay! Code: [Select]
`10 REM ---------------------------------20 REM             SOLITAIRE30 REM ---------------------------------40 MODE 1:BORDER 16:INK 0,16:INK 1,26:INK 2,0:INK 3,650 GOSUB 92060 REM ---------- PRINT BOARD ----------70 WINDOW 1,23,1,2380 PAPER 0:CLS:PAPER 2:PEN 190 FOR i=1 TO 23 STEP 22:FOR j=1 TO 23100 LOCATE j,i:IF (j+3)/3=(j+3)\3 THEN PRINT CHR\$(96+j\3) ELSE PRINT" ";110 LOCATE i,j:IF (j+3)/3=(j+3)\3 THEN PRINT USING "#";8-j\3; ELSE PRINT" ";120 NEXT:NEXT130 FOR i=2 TO 20 STEP 3:FOR j=2 TO 20 STEP 3140 WINDOW j,j+2,i,i+2150 IF (i<8 OR i>14) AND (j<8 OR j>14) THEN PAPER 2:CLS ELSE PAPER 1:PEN 2:PRINT CHR\$(&87)CHR\$(&83)CHR\$(&8B)CHR\$(&85)CHR\$(&CA)CHR\$(&8A)CHR\$(&8D)CHR\$(&8C)CHR\$(&8E);160 NEXT:NEXT170 WINDOW p,p,q,q:PAPER 3:PRINT" "180 EVERY 20 GOSUB 870190 WINDOW 26,40,1,23:PAPER 2:CLS:PEN 1:PRINT r\$"   SOLITAIRE",R\$:WINDOW 26,40,5,23:LOCATE 1,18200 g=g+1210 REM --------- PLAYER OPTION --------220 PRINT "DO YOU WANT THE COMPUTER TO   MAKE THE MOVES?","KEY [Y] OR [N]"CHR\$(7);230 I\$=INKEY\$:I\$=UPPER\$(I\$):IF I\$<>"N" AND I\$<>"Y" THEN 230240 CLS:PRINT"   M O V E S":LOCATE 1,14:PRINT R\$"  GAME"SPC(5)CHR\$(&18);:PRINT USING "##";g;:PRINT CHR\$(&18)R\$"  PEGS","  REMOVED  "CHR\$(&18);:PRINT USING "##";t;:PRINT CHR\$(&18)R\$CHR\$(&18);250 c=1-(I\$="N"):ON c GOSUB 360,480260 REM270 REM ----- END OF GAME SEQUENCE -----280 v=1:WINDOW 1,40,25,25:PAPER 0:EI:IF e THEN 310290 IF I\$="N" THEN PEN 3:IF t<31 THEN PRINT CHR\$(&EE);" NO LEGAL MOVES LEFT ";CHR\$(&EE) ELSE PRINT CHR\$(&EE);" W E L L   D O N E ! ";CHR\$(&EE)300 FOR i=1 TO 6:FOR j=1 TO 6:SOUND 1,s(j),7,5:NEXT:NEXT310 CLS:PEN 2:PRINT"WOULD YOU LIKE ANOTHER GAME? [Y] OR [N]"CHR\$(7);320 I\$=INKEY\$:I\$=UPPER\$(I\$):IF I\$<>"Y" AND I\$<>"N" THEN 320330 IF I\$="N" THEN MODE 2:INK 0,0:INK 1,25:BORDER 0:PAPER 0:PEN 1:END340 MODE 1:INK 3,6:GOSUB 950350 GOTO 60360 REM ------- COMPUTER'S MOVES -------370 RANDOMIZE TIME:d=INT(RND*4)380 FOR t=0 TO 30390 WINDOW p,p,q,q:PAPER 1:PEN 2:PRINT P\$;:v=0400 n1=n:p1=p:q1=q410 p=(ASC(MID\$(d\$(d),t*4+1,1)))-66:q=(ASC(MID\$(d\$(d),t*4+2,1)))-66420 p2=(ASC(MID\$(d\$(d),t*4+3,1)))-66:q2=(ASC(MID\$(d\$(d),t*4+4,1)))-66430 n=a(q/3,p/3):P1\$=CHR\$(128-74*(n1=1)-15*(n1=0)):P\$=CHR\$(128-74*(n=1)-15*(n=0))440 WINDOW p1,p1,q1,q1:PAPER 1:PEN 2:PRINT p1\$;:WINDOW p,p,q,q:PRINT CHR\$(&18)P\$CHR\$(&18);450 FOR i=0 TO 500:NEXT460 GOSUB 620470 NEXT:RETURN480 REM -------- PLAYER'S MOVES --------490 WHILE INKEY(63)=-1 AND e500 DI:WINDOW p,p,q,q:PAPER 1:PEN 2:PRINT P\$;:EI510 n1=n:p1=p:q1=q:v=0520 IF INKEY\$="" THEN 520530 p=p-3*(INKEY(1)=0)+3*(INKEY(8)=0):q=q-3*(INKEY(2)=0)+3*(INKEY(0)=0)540 p2=(INKEY(8)=32)-(INKEY(1)=32):q2=(INKEY(0)=32)-(INKEY(2)=32)550 IF p<3 OR p<9 AND (q<9 OR q>15) OR p>15 AND (q<0 OR q>15) OR p>21 OR q<3 OR q<9 AND (p<9 OR p>15) OR q>15 AND (p<9 OR p>15) OR q>21 THEN p=p1:q=q1:GOTO 520560 IF p=3 AND p2=-1 OR p=21 AND p2=1 OR q=3 AND q2=-1 OR q=21 AND q2=1 THEN 520570 n=a(q/3,p/3):P1\$=CHR\$(128-74*(n1=1)-15)*(n1=0)):P\$=CHR\$(128-74*(n=1)-15*(n=0))580 DI:WINDOW p1,p1,q1,q1:PAPER 1:PEN 2:PRINT P1\$;:WINDOW p,p,q,q:PRINT P\$;:EI590 IF ABS(p2)=1 XOR ABS(q2)=1 THEN GOSUB 620600 WEND610 RETURN620 REM ---- CHECK VALIDITY OF MOVE ----630 n2=a((q/3+2*q2),(p/3+2*p2)):n3=a((q/3+q2),(p/3+p2))640 IF n=1 AND n2=-1 AND n3=1 THEN 680650 v=1:WINDOW 26,40,25,25:PAPER 0:PEN 3:PRINT"!NOT PERMITTED!";660 FOR i=0 TO 4:SOUND 1,s(i),7,5:NEXT:FOR i=0 TO 500:NEXT:DI:CLS670 RETURN680 REM --------- EXECUTE MOVE ---------690 a(q/3,p/3)=-1:a((q/3+q2),(p/3+p2))=-1:a((q/3+2*q2),(p/3+2*p2))=1700 p3=p+3*p2:q3=q+3*q2:px=p2:qx=q2:IF I\$="N" THEN t=t+1710 p2=p+6*p2:q2=q+6*q2720 DI:WINDOW p,p,q,q:PAPER 1:PEN 2:PRINT" ";:WINDOW p3,p3,q3,q3:PRINT" ";:WINDOW p2,p2,q2,q2:PRINT CHR\$(&CA);730 REM740 REM ---------- PRINT MOVE ----------750 WINDOW x,x+2,y,y:PAPER 2:PEN 1:PRINT CHR\$(96+p/3);:PRINT USING "#";8-q/3;:PRINT CHR\$(240-(qx<>-1)-(ABS(px)=1)-(px=1));:WINDOW 37,38,22,22:PRINT CHR\$(&18);:PRINT USING "##";t-(I\$="Y");760 s(t)=INT(125000/(440*(2^(oct+(10-nt)/12)))+0.5):SOUND 1,s(t),7,5770 nt=nt-1:IF nt=0 THEN oct=oct+1:nt=12780 p=p2:q=q2:y=y+1:IF y=17-(x=36) THEN x=x+4:y=7790 REM800 REM -- DO MORE LEGAL MOVES EXIST? --810 e=0820 FOR i=1 TO 7:FOR j=1 TO 7830 IF a(i,j)<>1 OR e=1 THEN 850840 IF a(i-1,j)+a(i+1,j)=1 OR a(i,j-1)+a(i,j)+a(i,j+1)=1 THEN e=1850 NEXT:NEXT860 RETURN870 REM ---- FLASHING CURSOR & TEXT ----880 IF I\$="Y" THEN RETURN890 n=a(q/3,p/3):P\$=CHR\$(128-74*(n=1)-15*(n=0))900 IF v THEN z=NOT z:INK 3,6-20*(NOT z) ELSE PRINT CHR\$(&18)P\$;910 RETURN920 REM ---------- INITIALISE ----------930 DIM a(8,8),s(31),D\$(3):s(0)=237940 FOR i=0 TO 3:READ D\$(i):NEXT950 e=1:n=-1:nt=6:oct=0:p=12:q=12:t=0:v=1:x=28:y=7:z=0960 P\$=" ":R\$=STRING\$(&F,CHR\$(&9A))970 FOR i=1 TO 7:FOR j=3 TO 5:a(i,j)=1:NEXT:NEXT980 FOR i=3 TO 5:FOR j=1 TO 7:a(i,j)=1:NEXT:NEXT:a(4,4)=-1990 RETURN1000 DATA NHBCTKABQEBCQNBAKECBQEBCQTBAWQABNQCBWKBCWQABHQCBKWBAKNBCQWABKWBAKHBCEKCBNKABEQBAEKCBNQBANKABHKBCHQCBNQCBTNABKNCBQKBCTQABNTBA1010 DATA NTBAHQCBKWBAKNBCQWABKHBCEKCBNKABEQBAEKCBTKABQEBCQNBAKECBQEBCQTBAWQABNQCBWKBCWQABNKBCNQCBTQBATKABNKABHNCBQNABKWBAKQBAWKCBNHBC1020 DATA TNABQTBAWQABNQCBWKBCHQCBKWBAKNBCQEABKWBAKHBCEKCBNKABEQBAEKCBTKABQEBCQNBAKECBQEBCKNCBQNBAQHABKHBCKNBCNTBANKBCWQABQQABKTBAHNCB1030 DATA HNCBKHBCEKCBNKABEQBATKABQEBCQNBAKECBQEBCQTBAWQABNQCBWKBCWQABHQCBKWBAKNBCQEABKWBAQNABKNBCKTCBQTBAQNBANHBCNQBAEKCBKKCBQHBCTNAB1040 ' (C) 1984 Philip Jimenez`
* Using the old Amstrad Languages * with the Firmware * I also like to problem solve code in BASIC * And type-in Type-Ins! Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

#### mr.freeze ##### Re: BASIC Solitaire
« Reply #28 on: 19:11, 02 July 20 »
Okay! Great! I'll work on that this weekend.

#### mr.freeze ##### Re: BASIC Solitaire
« Reply #29 on: 20:00, 05 July 20 »
This is my errata:

Code: [Select]
`220 PRINT "DO YOU WANT THE COMPUTER TO  MAKE THE MOVES?","KEY  [Y] OR [N]"CHR\$(7);310 CLS:PEN 2:PRINT"WOULD YOU LIKE ANOTHER GAME?  [Y] OR [N]"CHR\$(7);550 IF p<3 OR p<9 AND (q<9 OR q>15) OR p>15 AND (q<9 OR q>15) OR p>21 OR q<3 OR q<9 AND (p<9 OR p>15) OR q>15 AND (p<9 OR p>15) OR q>21 THEN p=p1:q=q1:GOTO 520570 n=a(q/3,p/3):P1\$=CHR\$(128-74*(n1=1)-15*(n1=0))\$=CHR\$(128-74*(n=1)-15*(n=0))840 IF a(i-1,j)+a(i,j)+a(i+1,j)=1 OR a(i,j-1)+a(i,j)+a(i,j+1)=1 THEN e=11010 DATA NTBAHQCBKWBAKNBCQWABKHBCEKCBNKABEQBAEKCBTKABQEBCQNBAKECBQEBCQTBAWQABNQCBWKBCWQABNKBCNQCBTQBATKABNKABHNCBQNABKWBAKQBAHKCBNHBC1020 DATA TNABQTBAWQABNQCBWKBCHQCBKWBAKNBCQWABKWBAKHBCEKCBNKABEQBAEKCBTKABQEBCQNBAKECBQEBCKNCBQNBAQHABKHBCKNBCNTBANKBCWQABQQABKTBAHNCB1030 DATA HNCBKHBCEKCBNKABEQBATKABQEBCQNBAKECBQEBCQTBAWQABNQCBWKBCWQABHQCBKWBAKNBCQWABKWBAQNABKNBCKTCBQTBAQNBANHBCNQBAEKCBKKCBQHBCTNAB`
220 and 310: string format
550: 0 instead of 9
570: ) too many
840 a subexpression missing
1010: 8th character from the right W -> H
1020: 34th character from the left E -> W
1030: 51th charater from the right E -> W

Edit: Make the line 310 appears on its own line and fix the error on line 1010 mentioned in the next post. I first thought it was my beer but I think that this Website doesn't manage well Unix line endings.
« Last Edit: 19:04, 08 July 20 by mr.freeze »

#### mr.freeze ##### Re: BASIC Solitaire
« Reply #30 on: 20:53, 05 July 20 »
I knew I shouldn't have accepted this third Chimay bleue. Line 1010 reads like this :1010 DATA NTBAHQCBKWBAKNBCQWABKHBCEKCBNKABEQBAEKCBTKABQEBCQNBAKECBQEBCQTBAWQABNQCBWKBCWQABNKBCNQCBTQBATKABNKABHNCBQNABKWBAKQBAHKCBNHBC

#### Johnny Olsen ##### Re: BASIC Solitaire
« Reply #31 on: 16:47, 20 August 20 »
@mr.freeze you have fixed an error in line 570 but have made another.

570 n=a(q/3,p/3):P1\$=CHR\$(128-74*(n1=1)-15)*(n1=0)): P\$=CHR\$(128-74*(n=1)-15*(n=0))
570 n=a(q/3,p/3):P1\$=CHR\$(128-74*(n1=1)-15*(n1=0))\$=CHR\$(128-74*(n=1)-15*(n=0))

I have corrected the error and made a dsk file.

When I uploaded this I discovered that ": P" gives a smiley so it's not your fault.

#### Johnny Olsen ##### Re: BASIC Solitaire
« Reply #32 on: 12:39, 09 March 21 »
I just found out that solitaire comes from the book "Mindbending Games For The Amstrad CPC 464 - Philip Laird" scanned by ACME.

You can find it here.

https://acpc.me/?language=eng#ACME/LIVRES/[ENG]ENGLISH