10REM"„'SOLITAIRE'  …(ver.2)
   20REM"ƒ (part 2)
   30REM"�by E.J.Allen (C) 1986
   40:
   50ONERRORGOTO1910
   60*FX229,1
   70VDU28,0,31,39,0
   80PRINTTAB(0,23)SPC(200);SPC(117)
   90PROC_INITI
  100REPEAT
  110PROC_NAME
  120PROC_BOARD
  130PROC_MOVE
  140PROC_FINISH
  150UNTIL A$="N"ORB$="N"
  160*FX229,0
  170*FX4,0
  180VDU23,0,10,96,0;0;0;
  190END
  200:
  210DEFPROC_INITI
  220VDU19,0,4;0;0;0;:VDU19,3,2;0;0;0;
  230ENVELOPE 1,1,0,0,0,0,0,0,126,-1,0,-1,50,75
  240*FX4,1
  250GCOL0,2
  260BS=32:BS$="........"
  270VDU23,0,10,20,0;0;0;
  280DIM P(81),D$(1),C$(1)
  290D$(0)=CHR$240+CHR$241+CHR$10+CHR$8+CHR$8+CHR$242+CHR$243
  300D$(1)=CHR$244+CHR$245+CHR$10+CHR$8+CHR$8+CHR$246+CHR$247
  310C$(0)=CHR$32+CHR$32+CHR$10+CHR$8+CHR$8+CHR$32+CHR$32
  320C$(1)=CHR$230+CHR$230+CHR$10+CHR$8+CHR$8+CHR$230+CHR$230
  330ENDPROC
  340:
  350DEFPROC_BOARD
  360CLS:RESTORE1680
  370FORZ%=1TO81:READA%:P(Z%)=A%:NEXT
  380MOVE495,980
  390FORZ%=1TO12:READA%,B%
  400DRAWA%,B%:NEXT
  410COLOUR1
  420FORY%=2TO4STEP2
  430FORX%=16TO20STEP2:PRINTTAB(X%,Y%)D$(1):NEXTX%,Y%
  440FORY%=6TO10STEP2
  450FORX%=12TO24STEP2:PRINTTAB(X%,Y%)D$(1):NEXTX%,Y%
  460FORY%=12TO14STEP2
  470FORX%=16TO20STEP2:PRINTTAB(X%,Y%)D$(1):NEXTX%,Y%
  480COLOUR3:PRINTTAB(18,8)D$(0)
  490S%=41:X%=18:Y%=8:N%=32:ENDPROC
  500:
  510DEFPROC_MOVE
  520COLOUR1:PRINTTAB(29,1)"SOLITAIRE";TAB(33,3)"by";TAB(29,5)"E.J.Allen"
  530COLOUR2:PRINTTAB(1,15)"Counters";TAB(1,16);"Left=";TAB(27,15)"Best Score=";:COLOUR1:PRINT;BS;:COLOUR2:PRINTTAB(27,16)"by ";:COLOUR1:PRINTBS$
  540COLOUR2
  550PRINTTAB(0,21)"  'E'    = End game.";TAB(0,23)"'CURSOR' = Move cursor/counter.";TAB(0,25)"'RETURN' = Select counter."
  560COLOUR2:C%=0:F$=C$(1):PRINTTAB(6,16);N%;" ":IFN%<BS BS=N%:BS$=B$:COLOUR1:PRINTTAB(38,15);BS;" ";TAB(30,16);BS$;SPC(8-LEN(BS$)):COLOUR2
  570IFN%=1ANDP(41)=1 BS$=B$:COLOUR1:PRINTTAB(30,16);BS$;SPC(8-LEN(BS$))
  580IFN%=1 ENDPROC
  590REPEAT:PROC_COL
  600COLOUR2:PRINTTAB(X%,Y%)F$
  610W%=INKEY(20):IFW%>0 PROC_COL:PRINTTAB(X%,Y%);D$(P(S%)):GOTO640
  620PROC_COL:PRINTTAB(X%,Y%)D$(P(S%))
  630W%=INKEY(20)
  640UNTILW%>0
  650IFW%=69 OR W%=101 THENENDPROC
  660IFW%=13ANDP(S%)=1 C%=1:F$=C$(0):GOTO590
  670W%=W%-135:IFW%<1ORW%>4THEN590
  680IFC%=1THEN750
  690ONW%GOTO700,710,720,730
  700IFP(S%-1)<2 X%=X%-2:S%=S%-1:PROC_S1:GOTO560 ELSEPROC_S2:GOTO590
  710IFP(S%+1)<2 X%=X%+2:S%=S%+1:PROC_S1:GOTO560 ELSEPROC_S2:GOTO590
  720IFP(S%+9)<2 Y%=Y%+2:S%=S%+9:PROC_S1:GOTO560 ELSEPROC_S2:GOTO590
  730IFP(S%-9)<2 Y%=Y%-2:S%=S%-9:PROC_S1:GOTO560 ELSEPROC_S2:GOTO590
  740:
  750ONW%GOTO760,770,780,790
  760PROC_LEFT:GOTO560
  770PROC_RIGHT:GOTO560
  780PROC_DOWN:GOTO560
  790PROC_UP:GOTO560
  800:
  810DEFPROC_LEFT
  820IFP(S%)=1ANDP(S%-1)=1ANDP(S%-2)=0 GOTO830 ELSEPROC_S2:ENDPROC
  830PROC_S3:FORZ%=1TO2
  840P(S%)=0:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):X%=X%-2:S%=S%-1:NEXT
  850P(S%)=1:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):N%=N%-1:ENDPROC
  860:
  870DEFPROC_RIGHT
  880IFP(S%)=1ANDP(S%+1)=1ANDP(S%+2)=0 GOTO890 ELSEPROC_S2:ENDPROC
  890PROC_S3:FORZ%=1TO2
  900P(S%)=0:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):X%=X%+2:S%=S%+1:NEXT
  910P(S%)=1:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):N%=N%-1:ENDPROC
  920:
  930DEFPROC_DOWN
  940IFP(S%)=1ANDP(S%+9)=1ANDP(S%+18)=0 GOTO950 ELSEPROC_S2:ENDPROC
  950PROC_S3:FORZ%=1TO2
  960P(S%)=0:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):Y%=Y%+2:S%=S%+9:NEXT
  970P(S%)=1:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):N%=N%-1:ENDPROC
  980:
  990DEFPROC_UP
 1000IFP(S%)=1ANDP(S%-9)=1ANDP(S%-18)=0 GOTO1010 ELSEPROC_S2:ENDPROC
 1010PROC_S3:FORZ%=1TO2
 1020P(S%)=0:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):Y%=Y%-2:S%=S%-9:NEXT
 1030P(S%)=1:PROC_COL:PRINTTAB(X%,Y%)D$(P(S%)):N%=N%-1:ENDPROC
 1040:
 1050DEFPROC_S1:SOUND1,-8,150,2:ENDPROC
 1060:
 1070DEFPROC_S2:SOUND1,-10,10,4:ENDPROC
 1080:
 1090DEFPROC_S3
 1100FORZ%=1TO3:SOUND1,-15,10*Z%,1:NEXT
 1110SOUND1,-12,50,1:ENDPROC
 1120:
 1130DEFPROC_TUNE
 1140X%=1:RESTORE1830
 1150REPEAT:READ T%:PROC_CENTRE
 1160IFT%=255THEN1180
 1170SOUND1,1,T%,4:SOUND2,1,T%,4:SOUND3,1,T%,4
 1180UNTILT%=255
 1190ENDPROC
 1200:
 1210DEFPROC_CENTRE
 1220X%=X%+1:IFX% MOD2 COLOUR3:PRINTTAB(18,8);D$(0) ELSE COLOUR1:PRINTTAB(18,8);D$(1)
 1230ENDPROC
 1240:
 1250DEFPROC_COL
 1260IFP(S%)=1 THENCOLOUR1 ELSECOLOUR3
 1270ENDPROC
 1280:
 1290DEFPROC_NAME
 1300VDU23,0,10,96,0;0;0;
 1310PROC_S1:*FX21,0
 1320COLOUR1:PRINTTAB(0,28)"What is your name? ........";TAB(19,28);:PROC_input(8)
 1330IFB$=""THEN1320
 1340N$=LEFT$(B$,1)
 1350FORZ%=2TO LEN(B$)
 1360L%=ASC(MID$(B$,Z%,1))
 1370IFL%>96ANDL%<123THEN1400
 1380L%=L%+32
 1390IFL%<97ORL%>122THEN1410
 1400N$=N$+CHR$(L%)
 1410NEXTZ%
 1420B$=N$:VDU23,0,10,20,0;0;0;
 1430ENDPROC
 1440:
 1450DEFPROC_input(Z%)
 1460B$="":FORA%=1TOZ%+1
 1470K%=GET
 1480IFK%=127ANDA%>1 A%=A%-1:VDU127:VDU46:VDU8:B$=LEFT$(B$,A%-1):GOTO1470
 1490IFK%=13 A%=Z%+1:GOTO1540
 1500IFK%<>13ANDA%=Z%+1THEN1470
 1510IFK%<32ORK%>126THEN1470
 1520B$=B$+CHR$(K%)
 1530VDU K%
 1540NEXTA%:ENDPROC
 1550:
 1560DEFPROC_FINISH
 1570IFN%=1ANDP(41)=1 COLOUR1:PRINTTAB(0,19)"CONGRATULATIONS!! You've done it!"
 1580COLOUR2:PRINTTAB(0,21)B$;", You have ";N%;" counters left.":IFN%<BS BS=N%:BS$=B$
 1590PRINT'"The best score is ";BS;" by ";BS$;".       ";TAB(0,25);SPC(39)
 1600IFN%=1ANDP(41)=1 PROC_TUNE:FORZ%=1TO2000:NEXT
 1610COLOUR2:PRINTTAB(0,28)"Another Game? (Y/N)"
 1620PROC_S1
 1630REPEAT:COLOUR1:PRINTTAB(15,28)"Y";TAB(17,28)" ":A$=INKEY$(15)
 1640PRINTTAB(15,28)" ";TAB(17,28)"N":B$=INKEY$(15)
 1650UNTIL A$="N"ORB$="N"ORA$="Y"ORB$="Y"
 1660ENDPROC
 1670:
 1680DATA 2,2,2,2,2,2,2,2,2
 1690DATA 2,2,2,1,1,1,2,2,2
 1700DATA 2,2,2,1,1,1,2,2,2
 1710DATA 2,1,1,1,1,1,1,1,2
 1720DATA 2,1,1,1,0,1,1,1,2
 1730DATA 2,1,1,1,1,1,1,1,2
 1740DATA 2,2,2,1,1,1,2,2,2
 1750DATA 2,2,2,1,1,1,2,2,2
 1760DATA 2,2,2,2,2,2,2,2,2
 1770:
 1780DATA 720,980,720,850,855,850
 1790DATA 855,620,720,620,720,490
 1800DATA 495,490,495,620,360,620
 1810DATA 360,850,495,850,495,980
 1820:
 1830DATA 100,100,112,116,128,128,136,128,100,148,140,136,128,120,116,108
 1840DATA 100,100,112,116,128,128,136,128,100,148,140,136,128,120,116,108
 1850DATA 120,120,132,136,148,138,156,148,120,148,140,136,128,120,116,108
 1860DATA 100,100,112,116,128,128,136,138,100,148,140,136,128,120,128,128
 1870DATA 144,148,156,156,148,144,120,120,132,136,148,148,132,136,100,100
 1880DATA 112,116,128,128,136,128,100,148,140,136,128,120,116,108,255
 1890:
 1900REM ERROR ROUTINE
 1910*FX229,0
 1920*FX4,0
 1930VDU23,0,10,96,0;0;0;
 1940MODE7:REPORT:PRINT" at line ";ERL
 1950END