10 REM (c) 19870625 J.de B.P.
   20 MODE135:PROCcur(0)
   30 PROCinit:E%=0
   40 ON ERROR PROCerror:E%=17:GOTO40
   50 REPEAT
   60 IFE%<>17 PROCdeal:M%=0:sdir%=1
   70 REPEAT
   80 PROCdisp
   90 PROCcommand
  100 UNTILE%:UNTILE%<>1
  110 PROCdisp:PROCwin(2):CLS
  120 IFE%=2 PRINT'on$"Game solved in ";M%;" moves"off$''on$"Very well done."off$'
  130 IFE%=3 PRINT'on$"Game"CHR$136"not"CHR$137"solved."off$'
  140 IFFNosb(12,2,0)
  150 PROCcur(7)
  160 END
  170 :
  180 DEFPROCinit
  190 on$=CHR$132+CHR$157+CHR$135:off$="  "+CHR$156
  200 DIM T%(8,10,3),W%(3,1),A%(3)
  210 IFFNosb(12,2,0)ORFNosb(4,0,0)
  220 M%=0:L%=0:E%=0:S%=0:Q%=0:W%=0
  230 sdir%=1:ow%=0:cl%=30:file%=0
  240 B$=STRING$(cl%," "):F$=B$:A$=B$
  250 ENDPROC
  260 :
  270 DEFPROCdeal
  280 PROCwin(0):CLS
  290 RAND%=RND(-TIME)
  300 FORR%=0TO7:FORC%=0TO9:FORD%=0TO3:T%(R%,C%,D%)=0:NEXT:NEXT:NEXT
  310 FORS%=0TO3:A%(S%)=0:NEXT
  320 FORL%=1TO&D:FORS%=0TO3
  330 REPEAT:R%=RND(8)-1:C%=RND(10-R%)-1:UNTILT%(R%,C%,0)=0
  340 PRINTTAB(C%*4,R%+3);:PROCnumcard(L%,S%,0)
  350 T%(R%,C%,0)=S%*&10+L%
  360 NEXT:NEXT
  370 ENDPROC
  380 :
  390 DEFPROCdisp
  400 PROCwin(0)
  410 FORR%=0TO3:PRINTTAB(R%*4,0);
  420 IFA%(R%)>0 PROCnumcard(A%(R%),R%,A%(R%)-1) ELSE PRINT"    "
  430 NEXT
  440 FORR%=0TO7:FORC%=0TO9
  450 PRINTTAB(C%*4,R%+3);
  460 L%=T%(R%,C%,0):S%=L%DIV&10:L%=L%AND&F
  470 PROCnumcard(L%,S%,T%(R%,C%,1))
  480 NEXT:NEXT
  490 PROCwin(1)
  500 PRINTon$"Moves so far :";M%;off$;CHR$13;
  510 ENDPROC
  520 :
  530 DEFPROCcommand
  540 PROCwin(2):PRINT:REPEAT
  550 A$=FNin(0,11,cl%,221,on$+"=>"+off$,A$,"")
  560 IFE%=6 A$=B$
  570 IFE%=&B0 A$="SWING "
  580 IFE%=&B1 A$="MOVE "
  590 IFE%=&B2 A$="OUT "
  600 IFE%=&B3 A$="SHOW "
  610 IFE%=&B4 A$="FIND "
  620 IFE%=&B5 A$="LOAD "
  630 IFE%=&B6 A$="SAVE "
  640 IFE%=&B7 A$="HELP "
  650 IFE%=&B8 A$="REDEAL "
  660 IFE%=&B9 A$="EXIT "
  670 UNTILE%=0 ANDA$<>"":B$=A$
  680 PRINT:REPEAT:F%=1
  690 F$=FNword:IFF$="" UNTILTRUE:ENDPROC
  700 IFF$="*" PROCoscli(A$):F%=0:A$=""
  710 IFF$="SWING"ORF$="WIBBLE"ORF$="WOBBLE" PROCswing
  720 IFF$="MOVE" PROCmove
  730 IFF$="OUT" PROCout
  740 IFF$="SHOW" PROCshow
  750 IFF$="FIND" PROCfind
  760 IFF$="LOAD" PROCload
  770 IFF$="SAVE" PROCsave
  780 IFF$="REDEAL" F%=-1:E%=1
  790 IFF$="HELP" F%=10
  800 IFF$="EXIT" F%=-1:E%=3
  810 IFF% PROCmess:A$=""
  820 RAND%=RND(-TIME):TIME=ABSRND
  830 UNTILFALSE
  840 :
  850 DEFPROCmess
  860 IFF%=-1 ENDPROC
  870 PRINTon$;
  880 IFF%=1 PRINT"Command not known";
  890 IFF%=2 PRINT"No card of that name";
  900 IFF%=3 PRINT"Card inaccessible";
  910 IFF%=4 PRINT"Not legal to take that out";
  920 IFF%=5 PRINT"Not a legal move";
  930 IFF%=6 PRINT"No space for King";
  940 IFF%=7 PRINT"Bad filename";
  950 IFF%=8 PRINT"File not found";
  960 IFF%=9 PRINT"MOVE king to <num>";
  970 IFF%=10 PRINT"Commands available :-"+off$''"SWING, MOVE, OUT, SHOW, FIND, LOAD,     SAVE, HELP, REDEAL, EXIT";
  980 PRINToff$
  990 ENDPROC
 1000 :
 1010 DEFPROCswing
 1020 L%=-1
 1030 FORC%=5*(sdir%+1) TO 5*(1-sdir%) STEP -sdir%
 1040 IFT%(0,C%,0)<>0ANDL%=-1 L%=C%
 1050 NEXT
 1060 IFL%=-1:L%=5*(sdir%+1)
 1070 FORR%=0TO7
 1080 S%=L%:Q%=0
 1090 FORC%=L%TO(-4.5*(sdir%-1))STEP-sdir%
 1100 IFT%(R%,C%,0)<>0 FORD%=0TO3:T%(R%,S%,D%)=T%(R%,C%,D%):NEXT:S%=S%-sdir% ELSEQ%=Q%+1
 1110 NEXT
 1120 IFQ% FORC%=(-4.5*(sdir%-1))TO((Q%-10)*(sdir%=-1)-(Q%-1)*(sdir%=1))STEPsdir%:FORD%=0TO3:T%(R%,C%,D%)=0:NEXT:NEXT
 1130 NEXT
 1140 M%=M%+1:sdir%=-sdir%:F%=0
 1150 ENDPROC
 1160 :
 1170 DEFPROCmove
 1180 F$=FNword:IFF$="" F%=2:ENDPROC
 1190 L%=FNcard(F$):IFL%=0 F%=2:ENDPROC
 1200 D%=FNsee(L%):IFD%=-1 F%=3:ENDPROC
 1210 S%=L%DIV&10:L%=L%AND&F
 1220 F$=FNword:IFF$="UP" PROCmoveup(D%AND&F,D%DIV&10):ENDPROC ELSEA$=F$+" "+A$:F$=CHR$255
 1230 IFL%=&D PROCking:ENDPROC
 1240 R%=D%AND&F:C%=D%DIV&10
 1250 LOCALQ%,P%,A%:Q%=-1:P%=-1
 1260 FORA%=0TO10
 1270 IFT%(0,A%,0)<>0ANDQ%=-1 Q%=A%
 1280 NEXT
 1290 FORA%=10TO0STEP-1
 1300 IFT%(0,A%,0)<>0ANDP%=-1 P%=A%
 1310 NEXT
 1320 LOCAL A%
 1330 PROCtrymove(P%):IFF%<>0 PROCtrymove(Q%)
 1340 ENDPROC
 1350 :
 1360 DEFPROCtrymove(P%)
 1370 LOCALQ%,N%,U%
 1380 Q%=T%(0,P%,0):N%=T%(R%,C%,1):U%=T%(R%,C%,2):IF(S%<>(Q%DIV&10))OR(L%<>(Q%AND&F)-1+N%) F%=5:ENDPROC
 1390 T%(0,P%,0)=Q%-1+N%:T%(0,P%,1)=T%(0,P%,1)-1+N%
 1400 FORN%=0TO3:T%(R%,C%,N%)=0:NEXT
 1410 F%=0:M%=M%+1:ENDPROC
 1420 :
 1430 DEFPROCmoveup(R%,C%)
 1440 IFR%=0 F%=5:ENDPROC
 1450 Q%=T%(R%-1,C%,0):IF(Q%AND&F)<>(L%+1+T%(R%,C%,1)) F%=5:ENDPROC
 1460 IFT%(R%-1,C%,1)<0 F%=5:ENDPROC
 1470 IF(S%MOD2)=((Q%DIV&10+T%(R%,C%,1))AND1) F%=5:ENDPROC
 1480 T%(R%-1,C%,1)=T%(R%-1,C%,1)+1+T%(R%,C%,1)
 1490 T%(R%-1,C%,2)=(T%(R%-1,C%,2)*2+((Q%DIV&20)AND1))*2^T%(R%,C%,1)+T%(R%,C%,2)
 1500 T%(R%-1,C%,0)=S%*&10+L%
 1510 FORA%=0TO3:T%(R%,C%,A%)=0:NEXT
 1520 F%=0:M%=M%+1:ENDPROC
 1530 :
 1540 DEFPROCking
 1550 F$=FNword:IFF$="" F%=9:ENDPROC
 1560 P%=VALF$:IFP%<0ORP%>9 F%=6:ENDPROC
 1570 IFT%(0,P%,0)<>0 F%=6:ENDPROC
 1580 IFT%(1,P%,0)<>0 F%=5:ENDPROC
 1590 T%(0,P%,0)=S%*&10+L%
 1600 PROCremove(D%AND&F,D%DIV&10)
 1610 F%=0:M%=M%+1:ENDPROC
 1620 :
 1630 DEFPROCout
 1640 F$=FNword:IFF$="" F%=2:ENDPROC
 1650 L%=FNcard(F$):IFL%=0 F%=2:ENDPROC
 1660 D%=FNsee(L%):IFD%=-1 F%=3:ENDPROC
 1670 S%=L%DIV&10:L%=L%AND&F
 1680 IFA%(S%)<>L%-1 F%=4:ENDPROC
 1690 A%(S%)=A%(S%)+1:IFA%(S%)=13 E%=-1:FORS%=0TO3:E%=E%AND(A%(S%)=13):NEXT:E%=E%*-2
 1700 PROCremove(D%AND&F,D%DIV&10)
 1710 F%=0:M%=M%+1:ENDPROC
 1720 :
 1730 DEFPROCshow
 1740 F$=FNword:IFF$="" F%=2:ENDPROC
 1750 L%=FNcard(F$):IFL%=0 F%=2:ENDPROC
 1760 D%=FNfind(L%):IFD%=-1 F%=3:ENDPROC
 1770 S%=L%DIV&10:L%=L%AND&F
 1780 PRINTon$"Under ";:PROCnumcard(L%,S%,0):PRINTCHR$135"there are :"off$'
 1790 P%=T%(D%AND&F,D%DIV&10,1):Q%=SGNP%:P%=ABSP%:R%=T%(D%AND&F,D%DIV&10,2)
 1800 IFP%=0 PRINTon$"No cards"off$:F%=0:ENDPROC
 1810 FORC%=0TOP%-1
 1820 L%=L%+1:IFQ%=1 S%=((S%EOR1)AND1)OR2*(R%MOD2):R%=R%DIV2
 1830 PROCnumcard(L%,S%,0):NEXT
 1840 PRINT:F%=0:ENDPROC
 1850 :
 1860 DEFPROCfind
 1870 F$=FNword:IFF$="" F%=2:ENDPROC
 1880 L%=FNcard(F$):IFL%=0 F%=2:ENDPROC
 1890 D%=FNfind(L%):IFD%=-1 F%=3:ENDPROC
 1900 PROCwin(0):PRINTTAB((D%DIV&10)*4+1,3+D%AND&F)CHR$136STRING$(3,CHR$9)CHR$137;
 1910 IFINKEY(200)
 1920 F%=0:ENDPROC
 1930 :
 1940 DEFPROCload
 1950 F$=FNword:IFF$="" F%=7:ENDPROC
 1960 IFLEFT$(F$,1)="""" F$=EVALF$
 1970 file%=OPENINF$:IFfile%=0 F%=8:ENDPROC
 1980 INPUT#file%,M%,sdir%
 1990 FORS%=0TO3:INPUT#file%,A%(S%):NEXT
 2000 FORR%=0TO7:FORC%=0TO9
 2010 INPUT#file%,Q%:T%(R%,C%,0)=Q%
 2020 IFQ%<>0 INPUT#file%,Q%:T%(R%,C%,1)=Q%
 2030 IFQ%<>0 INPUT#file%,Q%:T%(R%,C%,2)=Q%
 2040 NEXT:NEXT
 2050 CLOSE#file%:file%=0
 2060 F%=0:ENDPROC
 2070 :
 2080 DEFPROCsave
 2090 F$=FNword:IFF$="" F%=7:ENDPROC
 2100 IFLEFT$(F$,1)="""" F$=EVALF$
 2110 file%=OPENUPF$:IFfile%=0 file%=OPENOUTF$
 2120 IFfile%=0 F%=8:ENDPROC
 2130 PRINT#file%,M%,sdir%
 2140 FORS%=0TO3:PRINT#file%,A%(S%):NEXT
 2150 FORR%=0TO7:FORC%=0TO9
 2160 Q%=T%(R%,C%,0):PRINT#file%,Q%
 2170 IFQ%<>0 Q%=T%(R%,C%,1):PRINT#file%,Q%
 2180 IFQ%<>0 Q%=T%(R%,C%,2):PRINT#file%,Q%
 2190 NEXT:NEXT
 2200 CLOSE#file%:file%=0:F%=0:ENDPROC
 2210 :
 2220 DEFFNcard(F$)
 2230 LOCALL%,S%:S%=INSTR("HCDS",RIGHT$(F$,1))-1:IFS%=-1:=0
 2240 F$=LEFT$(F$,LEN(F$)-1):IFF$="":=0
 2250 L%=INSTR("A23456789TJQK",LEFT$(F$,1))
 2260 IFL%=0:=0
 2270 =S%*&10+L%
 2280 :
 2290 DEFFNsee(L%)
 2300 D%=FNfind(L%):IF(D%AND&F)<7 IFT%((D%AND&F)+1,D%DIV&10,0)<>0 D%=-1
 2310 =D%
 2320 :
 2330 DEFFNfind(L%)
 2340 LOCALR%,C%,D%:D%=-1
 2350 FORR%=0TO7:FORC%=0TO9
 2360 IFT%(R%,C%,0)=L% D%=C%*&10+R%:R%=9:C%=9
 2370 NEXT:NEXT
 2380 =D%
 2390 :
 2400 DEFPROCremove(R%,C%)
 2410 IFT%(R%,C%,1)=0 T%(R%,C%,0)=0:T%(R%,C%,2)=0:T%(R%,C%,3)=0:ENDPROC
 2420 T%(R%,C%,0)=T%(R%,C%,0)+1
 2430 IFT%(R%,C%,1)<0 T%(R%,C%,1)=T%(R%,C%,1)+1:ENDPROC
 2440 S%=T%(R%,C%,2)MOD2:T%(R%,C%,0)=((T%(R%,C%,0)EOR&10)AND&FFFFFFDF)OR(S%*&20)
 2450 T%(R%,C%,2)=T%(R%,C%,2)DIV2
 2460 T%(R%,C%,1)=T%(R%,C%,1)-1
 2470 ENDPROC
 2480 :
 2490 DEFPROCwin(W%)
 2500 W%(ow%,0)=POS:W%(ow%,1)=VPOS
 2510 VDU28
 2520 IFW%=0 VDU0,12,39,0
 2530 IFW%=1 VDU17,0,39,0
 2540 IFW%=2 VDU0,24,39,13
 2550 PRINTTAB(W%(W%,0),W%(W%,1));
 2560 ow%=W%:ENDPROC
 2570 :
 2580 DEFPROCnumcard(L%,S%,T%)
 2590 IFL%<>0 PRINTCHR$(129+(S%AND1)*4); ELSEPRINTCHR$135;
 2600 IFL%=0 PRINTSTRING$(3,CHR$(32+33*(R%=0)));
 2610 IFL%=0 ELSEIFT%<>0 PRINT"["; ELSEPRINT" ";
 2620 IFL%>0 PRINTMID$("A23456789TJQK",L%,1);
 2630 IFL%>0 PRINTMID$("HCDS",S%+1,1);
 2640 ENDPROC
 2650 :
 2660 DEFFNword
 2670 LOCALL%,F$:L%=INSTR(A$," ")
 2680 IFLEFT$(A$,1)="*" ="*"
 2690 IFL%=0 F$=A$:A$="" ELSEF$=FNs_s(LEFT$(A$,L%-1)):A$=FNs_s(MID$(A$,L%))
 2700 =F$
 2710 :
 2720 DEFPROCoscli(A$)
 2730 OSCLIA$
 2740 IFLEFT$(A$,3)="*TV"VDU22,7
 2750 ENDPROC
 2760 :
 2770 DEFFNgetmulti:=GET$
 2780 DEFPROCerror
 2790 IFFNosb(4,0,0)ORFNosb(225,1,0)ORFNosb(12,2,0)
 2800 IFfile% CLOSE#file%:file%=0
 2810 PROCcur(5):ONERROROFF
 2820 A$="":B$="REDEAL"
 2830 IF(ERR=17)ANDNOTINKEY(-2)THENPRINT'on$"Escape"off$;:ENDPROC
 2840 REPORT:PRINT" at line ";ERL:END
 2850 DEFFNin(P%,V%,L%,F%,prp$,li$,key$)
 2860 LOCALin$,ins,curs,cnv,prp,b1%,b2%,shf
 2870 b1%=((FNosb(225,&B0,0)AND&FF00)DIV&100)+(FNosb(226,&80,0)AND&FF00)+((FNosb(227,&90,0)AND&FF00)*&100)+(FNosb(228,1,0)AND&FF00)*&10000
 2880 b2%=(FNosb(4,2,0)AND&FF00)DIV&100
 2890 cnv=F%MOD10:prp=(F%DIV100)MOD10:in$=STRING$(L%," "):IFLEN(li$)>L%li$=LEFT$(li$,L%):VDU7
 2900 PRINTTAB(P%,V%)prp$" ";:P%=POS:V%=VPOS
 2910 REPEATE%=0:in$=li$:curs=1
 2920 REPEATPROCcur(0):PRINTTAB(P%,V%);
 2930 IF(prp AND1)=0PRINTin$;ELSEPRINTSTRING$(LENin$,CHR$255);
 2940 IF(prp AND2)=0PRINTSTRING$(L%-LENin$,"_");ELSEPRINTSTRING$(L%-LENin$," ");
 2950 PRINTSTRING$(L%-curs+1,CHR$8);:IFins PROCcur(2-(curs>L%))ELSEPROCcur(1)
 2960 `%=ASCFNgetmulti:shf=INKEY(-2)*-2-INKEY(-1)
 2970 IF`%=&7F PROCdel
 2980 IF`%<27ANDshf AND2 `%=`%+96
 2990 IF(`%>31)AND(`%<127)PROCchar
 3000 IF(`%AND&8F>&8A)PROCarrow
 3010 UNTIL(`%=9)OR(`%=13)OR(`%>&AF AND`%<&BB)
 3020 IF`%=9 E%=6ELSEIF`%<>13 E%=`%
 3030 IF`%=13OR`%=9 `%=0
 3040 UNTILFNcompress OR`%
 3050 PROCcur(0):PRINTTAB(P%,V%);
 3060 IF(prp AND1)=0PRINTin$;ELSEPRINTSTRING$(LENin$,CHR$255);
 3070 IF(prp AND2)=0PRINTSTRING$(L%-LENin$,"_");ELSEPRINTSTRING$(L%-LENin$," ");
 3080 IFFNosb(4,b2%AND&FF,0)
 3090 IFFNosb(225,b1%AND&FF,0)ORFNosb(226,(b1%DIV&100)AND&FF,0)ORFNosb(227,(b1%DIV&10000)AND&FF,0)ORFNosb(228,(b1%DIV&1000000)AND&FF,0)
 3100 =in$
 3110 DEFPROCcur(C%):LOCAL flag
 3120 IFC%>3THENflag=18:C%=C%AND3
 3130 flag=flag-32*(C%=0)-96*(C%=2)-64*(C%=3):VDU23 0 10 flag,0;0;0;:ENDPROC
 3140 DEFFNosb(A%,X%,Y%):=USR&FFF4
 3150 DEFPROCchar:IFFNosb(12,25,0)
 3160 IFcurs>L%VDU7:ENDPROC
 3170 IFcnv=0ORNOTFNalpha(CHR$`%) PROCaddchar:ENDPROC
 3180 IFcnv=1 THEN`%=`%AND&5F
 3190 IFcnv=2 THEN`%=`%OR &20
 3200 IFshf AND2 PROCaddchar:ENDPROC
 3210 IF(cnv>2AND(shf AND1))OR(cnv>3ANDcurs=1) THEN`%=`%AND&5F
 3220 IFcurs<2 PROCaddchar:ENDPROC
 3230 IF(cnv>4ANDMID$(in$,curs-1,1)=" ")OR(cnv>5ANDFNalpha(MID$(in$,curs-1,1))=0) `%=`%AND&5F
 3240 PROCaddchar:ENDPROC
 3250 DEFFNalpha(alph$):=(alph$>"@"ANDalph$<"[")OR(alph$>"`"ANDalph$<"{")
 3260 DEFPROCaddchar
 3270 IF(curs>L%)OR((`%=255)ORkey$=""ORINSTR(key$,CHR$`%))=0 VDU7:ENDPROC
 3280 IFins SOUND3,-5,200,1:IFLEN(in$)=L%VDU7:ENDPROC
 3290 LOCALi$:i$=LEFT$(in$,curs-1)+CHR$`%:in$=i$+MID$(in$,curs+ins+1,255-LENi$):curs=curs+1:ENDPROC
 3300 DEFPROCdel:IFFNosb(12,10,0)
 3310 IF(shf=0)AND(curs<2)OR(shf=1)AND(curs>LENin$) ENDPROC
 3320 curs=curs+(shf=0):in$=LEFT$(in$,curs-1)+MID$(in$,curs+1,LENin$-curs):ENDPROC
 3330 DEFPROCarrow:IFFNosb(12,5,0)
 3340 IF(`%=&BB)in$=li$:curs=1
 3350 IF(`%=&8B)
 3360 IF(`%=&9B)in$="":curs=1
 3370 IF(`%=&BC)curs=curs+(curs>1)
 3380 IF(`%=&8C)curs=1
 3390 IF(`%=&9C)
 3400 IF(`%=&BD)curs=curs-(curs<=LENin$)
 3410 IF(`%=&8D)curs=LENin$+1
 3420 IF(`%=&9D)in$=LEFT$(in$,curs-1)
 3430 IF(`%=&BE)
 3440 IF(`%=&8E)ins=FALSE
 3450 IF(`%=&9E)
 3460 IF(`%=&BF):LOCAL_%:_%=`%:`%=255:PROCaddchar:`%=_%
 3470 IF(`%=&8F)ins=TRUE
 3480 IF(`%=&9F)
 3490 ENDPROC
 3500 DEFFNcompress:LOCALsear,st:st=(F%DIV10)MOD10
 3510 REPEATsear=-INSTR(in$,CHR$255)*(in$<>""):IFsear in$=LEFT$(in$,sear-1)+MID$(in$,sear+1,LENin$-sear)
 3520 UNTILsear=0
 3530 IFRIGHT$(in$,1)=" "REPEATin$=LEFT$(in$,LENin$-1):UNTILRIGHT$(in$,1)<>" "
 3540 IF(st AND1)=0THENin$=FNs_s(in$)
 3550 st=st DIV2
 3560 IFst=0THEN=in$<>""
 3570 IFst=2THEN=LENin$=L%
 3580 =TRUE
 3590 DEFFNs_s(st$):LOCALL%:REPEATL%=L%+1:UNTILMID$(st$,L%,1)<>" "ORL%>LEN(st$):=MID$(st$,L%)