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