home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.whtech.com
/
ftp.whtech.com.tar
/
ftp.whtech.com
/
club100
/
gam
/
puzzle.ba
< prev
next >
Wrap
Text File
|
2006-10-19
|
2KB
|
24 lines
0 'PUZZLE.BA: A BASIC 15 SQUARES PUZZLE
1 'CLUB 100 LIBRARY - 415/939-1246 BBS, 937-5039 NEWSLETTER, 932-8856 VOICE NUMBER PUZZLE BY SAM LOYD IN 1870
2 'M100 PROGRAM BY RON BALONIS IN 1986
3 CLEAR 200:R=4:C=4:X=4:Y=4:KB$=CHR$(30)+CHR$(31)+CHR$(29)+CHR$(28):KY$=CHR$(155)+CHR$(154)+CHR$(152)+CHR$(153):TLE$="+++FIFTEEN SQUARES PUZZLE+++":'
4 SEQ$="ABCDEFGHIJKLMNO_":PUZZLE$=SEQ$:CLS:PRINT @6,TLE$:'---MAKE THE PUZZLE
5 FOR I=1 TO R: FOR J=1 TO C: GOSUB 22: NEXT J: NEXT I:I=X:J=Y:'
6 FOR L=0 TO VAL(RIGHT$(TIME$,2)): K=RND(1):'---USE TIME TO RANDOMIZE
7 NEXT L:'
8 '-----MACHINE'S TURN TO MIX THEM UP
9 FOR L=1 TO 100:K=INT(RND(1)*4)+1:GOSUB 18:NEXT L:BEEP:BEEP:'
10 '--------YOUR TURN TO SORT THEM OUT
11 PRINT@100,"++USE CURSOR KEYS++";:PRINT@140,"TO SOLVE THE PUZZLE";:PRINT@188,KY$;:PRINT @220," PRESS <Q> TO QUIT";:'
12 PRINT @45+X*40+2*Y," ";:A$=INPUT$(1): K=INSTR(KB$+"Qq",A$): IF K=0 THEN 12
13 IF K=5 OR K=6 THEN MENU ELSE GOSUB 18
14 '
15 '------TEST TO SEE IF PUZZLE'S DONE
16 IF PUZZLE$<>SEQ$ THEN 12
17 PRINT @48,"+++++PUZZLE SOLVED!+++++";:BEEP:BEEP:FOR I=1 TO 1500:NEXT I:RUN 0:'
18 '---EXCHANGE SQUARES
19 X=X+(K=1)-(K=2):Y=Y+(K=3)-(K=4):IF X<1 THEN BEEP:X=1 ELSE IF X>R THEN BEEP:X=R
20 IF Y<1 THEN BEEP:Y=1 ELSE IF Y>C THEN BEEP:Y=C
21 A$=MID$(PUZZLE$,Y+C*(X-1),1):MID$(PUZZLE$,Y+C*(X-1),1)=MID$(PUZZLE$,J+C*(I-1),1):MID$(PUZZLE$,J+C*(I-1),1)=A$:GOSUB 22:I=X:J=Y
22 PRINT@45+I*40+2*J,MID$(PUZZLE$,J+C*(I-1),1);:RETURN:'---The End Of The Program