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