259 lines
7.9 KiB
Plaintext
259 lines
7.9 KiB
Plaintext
SCR
|
|
LOMEM=768
|
|
HIMEM=16384
|
|
10 PRINT " WORD SEARCH PUZZLE"
|
|
20 PRINT " CREATIVE COMPUTING"
|
|
30 PRINT " MORRISTOWN, NEW JERSEY"
|
|
35 REM PORTED TO REPLICA/1 BY CARL CLAUNCH
|
|
40 PRINT:PRINT:PRINT
|
|
50 PRINT " THIS PROGRAM IS A WORD SEARCH PUZZLE GENERATOR!!"
|
|
60 PRINT "THE PROGRAM TAKES A SET OF INPUT STRINGS, PURGES ALL"
|
|
70 PRINT "NON-ALPHABETIC CHARACTERS OUT OF THEM, AND INCORPORATES"
|
|
80 PRINT "THEM INTO A WORD SEARCH PUZZLE."
|
|
90 PRINT
|
|
100 PRINT "IN THE COURSE OF MAKING THE PUZZLE, THE MACHINE MAY"
|
|
110 PRINT "FIND THAT IT CAN'T PUT A PARTICULAR WORD ANYWHERE, AND"
|
|
120 PRINT "SO IT WILL ASK YOU IF IT SHOULD START THE WHOLE PUZZLE"
|
|
130 PRINT "OVER. IF YOU DON'T WANT IT TO START OVER, TYPING 'NO'"
|
|
140 PRINT "WILL THROW AWAY THAT PARTICULAR WORD. IF THIS PERSISTS,"
|
|
150 PRINT "TRY EITHER GIVING LESS WORDS OR BIGGER PUZZLE DIMENSIONS!"
|
|
160 PRINT:PRINT
|
|
300 REM MAJOR ALTERATION TO SUIT LIMITED STRING HANDLING IN WOZ BASIC
|
|
310 INPUT "HOW MANY COLUMNS DOES YOUR PRINTER HAVE",T2
|
|
315 DIM X$(5)
|
|
320 INPUT "DO YOU WANT A SOLUTION PRINTOUT?",X$:X$(LEN(X$)+1)=" "
|
|
330 INPUT "WHAT IS TO BE THE WIDTH OF THE PUZZLE",W:M2=W
|
|
340 IF W*2<=T2 THEN 345
|
|
343 PRINT "THAT WILL NOT FIT IN ",T2," COLUMNS.":GOTO 330
|
|
345 IF W<1 THEN 330
|
|
350 INPUT "THE LENGTH ",L:IF L>W THEN M2=L
|
|
355 IF L<1 THEN 350
|
|
360 INPUT "WHAT IS THE MAXIMUM NUMBER OF WORDS IN THE PUZZLE?",M
|
|
370 IF M>=2 THEN 380
|
|
375 PRINT "SORRY, THERE MUST BE AT LEAST TWO WORDS.":GOTO 360
|
|
380 PRINT
|
|
390 DIM A$(L*W),W$(255),Q$(25),T$(30),U$(30),Z$(255)
|
|
400 DIM W9(M*3),D1(16),D2(28),R(20),S(20),Y$(255)
|
|
410 PRINT "NOW ENTER A HEADING THAT WILL BE PRINTED OVER THE PUZZLE:"
|
|
420 PRINT "(",W," CHARACTERS MAXIMUM! )"
|
|
430 INPUT Q$
|
|
435 GOSUB 4700 : REM FILL IN A$ WITH BLANKS
|
|
440 PRINT "OK . . . ENTER A WORD AT EACH QUESTION MARK."
|
|
450 PRINT "TO REDO THE PREVIOUS WORD, TYPE A HYPHEN (-)."
|
|
460 PRINT "WHEN YOU RUN OUT OF WORDS, TYPE A PERIOD (.)."
|
|
465 U=0 :REM COUNT OF WORDS
|
|
470 FOR I=1 TO M
|
|
480 INPUT T$:IF T$#"-" THEN 490
|
|
485 I=I-1:IF I#0 THEN 489
|
|
486 PRINT "CAN'T REDO IF YOU HAVEN'T ENTERED ANY WORDS YET"
|
|
487 I=I+1:GOTO 480
|
|
489 PRINT "REDO ",W$(R(I),S(I))," . . .":GOTO 480
|
|
490 IF T$#"." THEN 500
|
|
495 M=I-1:GOTO 660
|
|
500 IF LEN(T$)#0 THEN 510
|
|
505 PRINT "INPUT ERROR; REDO:":GOTO 480
|
|
510 J=1:T$(LEN(T$)+1)=" "
|
|
520 Z=0:Z$=T$(J,J):GOSUB 2000:IF Z=1 THEN 570
|
|
530 U$=T$(J):T$(J)=U$(2)
|
|
570 J=J+1:IF J<LEN(T$) THEN 520
|
|
575 U$=T$:T$=U$(1,LEN(U$)-1)
|
|
580 PRINT "-";T$;"-"
|
|
600 IF LEN(T$)<=M2 THEN 610
|
|
605 PRINT "THAT'S TOO LONG, I'M AFRAID.";
|
|
607 PRINT " TRY ANOTHER ONE.":GOTO 480
|
|
610 IF U=0 THEN 630
|
|
612 FOR I8=1 TO I-1:IF W$(R(I8),S(I8))=T$ THEN 620
|
|
615 NEXT I8: GOTO 630
|
|
620 PRINT "YOU ENTERED THAT ONE ALREADY. ENTER ANOTHER.":GOTO 480
|
|
630 W$(LEN(W$)+1)=T$
|
|
632 U=U+1
|
|
634 R(U)=1:S(U)=LEN(T$)
|
|
636 IF U=1 THEN 640
|
|
638 R(U)=S(U-1)+1:S(U)=R(U)+LEN(T$)-1
|
|
640 NEXT I
|
|
650 PRINT "THAT'S IT...";M;" WORDS."
|
|
660 PRINT "NOW LET ME PONDER THIS......"
|
|
680 FOR I=1 TO M-1
|
|
685 FOR J=I TO M
|
|
690 IF (S(I)-R(I)+1)>=(S(J)-R(J)+1) THEN 700
|
|
695 GOSUB 4500 : REM RESORT THIS INTO SEQUENCE BY SIZE
|
|
700 NEXT J:NEXT I
|
|
710 GOSUB 3000
|
|
750 FOR I=1 TO M
|
|
760 L2=S(I)-R(I)+1
|
|
770 N2=0
|
|
790 S3=D2(RND(28)+1)
|
|
800 S1=RND(W)+1:X1=S1+(L2-1)*D1(S3*2-1):IF X1 < 1 OR X1 > W THEN 790
|
|
810 S2=RND(L)+1:X1=S2+(L2-1)*D1(S3*2):IF X1 < 1 OR X1 > L THEN 790
|
|
820 N2=N2+1:IF N2#W*L*2 THEN 850
|
|
830 PRINT "COULDN'T FIT '";W$(R(I),S(I));"' IN PUZZLE."
|
|
832 INPUT "DO YOU WANT ME TO START OVER?",Z$:Z$(LEN(Z$)+1)=" "
|
|
834 IF Z$(1,1)#"Y" THEN 836
|
|
835 GOSUB 4700: GOTO 750
|
|
836 GOSUB 4600:GOTO 950 : REM SHUFFLE DOWN WORDS OVER I, LOWER M BY 1
|
|
850 J=S2:K=S1
|
|
860 FOR P=1 TO L2
|
|
865 S4=(J-1)*W+K
|
|
870 IF A$(S4,S4)#" " AND A$(S4,S4)#W$(R(I)+P-1,R(I)+P-1) THEN 790
|
|
880 J=J+D1(S3*2):K=K+D1(S3*2-1):NEXT P
|
|
900 J=S2:K=S1
|
|
910 FOR P=1 TO L2
|
|
915 Z=(J-1)*W+K : Z$=W$(R(I)+P-1,R(I)+P-1):GOSUB 5000:REM PUT Z$ IN POS Z
|
|
920 J=J+D1(S3*2):K=K+D1(S3*2-1):NEXT P: REM SHIFT TO NEXT
|
|
940 W9(I*3-2)=S1:W9(I*3-1)=S2:W9(I*3)=S3 : REM SAVE POSITION OF EACH WORD/LETTER
|
|
950 NEXT I : REM END OF FITTING
|
|
970 FOR I=1 TO L
|
|
975 FOR J=1 TO W
|
|
978 Z=(I-1)*W+J
|
|
980 IF A$(Z,Z)#" " THEN 990
|
|
982 GOSUB 6000+RND(26) : REM GO GET A RANDOM LETTER
|
|
985 GOSUB 5000:REM STICK IT IN ARRAY
|
|
990 NEXT J:NEXT I
|
|
1010 FOR I=1 TO M-1:FOR J=I+1 TO M
|
|
1020 IF (S(I)-R(I))<=(S(J)-R(J)) THEN 1030
|
|
1021 GOSUB 4500: REM SWAP INDICES TO SORT
|
|
1025 FOR K=1 TO 3:H2=W9((I-1)*3+K):W9((I-1)*3+K)=W9((J-1)*3+K):W9((J-1)*3+K)=H2:NEXT K
|
|
1030 NEXT J:NEXT I
|
|
1040 INPUT "HOW MANY COPIES OF THIS PUZZLE DO YOU WANT",N
|
|
1050 PRINT "FOR EACH COPY, HIT RETURN TO BEGIN PRINTING..."
|
|
1060 FOR C=1 TO N:GOSUB 1070:NEXT C:GOTO 1230
|
|
1070 INPUT Z$:PRINT
|
|
1080 T=(T2-2*W)/2:PRINT
|
|
1090 PRINT : REM PRINTING HEADING FIRST
|
|
1100 TAB (T2-LEN(Q$))/2: PRINT Q$
|
|
1110 PRINT:PRINT
|
|
1120 FOR J=1 TO L:TAB(T)
|
|
1130 FOR K=1 TO W
|
|
1132 IF A$((J-1)*W+K)#"." THEN 1135
|
|
1134 PRINT ". ":GOTO 1140
|
|
1135 Z=(J-1)*W+K: PRINT A$(Z,Z);" ";
|
|
1140 NEXT K:PRINT:NEXT J
|
|
1150 PRINT:PRINT
|
|
1160 PRINT "FIND THESE HIDDEN WORDS IN THE ABOVE PUZZLE:"
|
|
1170 PRINT
|
|
1180 FOR J=1 TO M:IF S(J)-R(J)+1=0 THEN 1210
|
|
1190 PRINT W$(R(J),S(J));:TAB(4):PRINT" ";
|
|
1210 NEXT J:PRINT:PRINT:PRINT:PRINT
|
|
1220 RETURN
|
|
1230 IF X$(1,1) = "Y" THEN 1250
|
|
1240 END
|
|
1250 REM WANT SOLUTION PRINTOUT
|
|
1255 Z$=".":PRINT "PREPARING SOLUTION PRINTOUT"
|
|
1260 FOR I=1 TO L:FOR J=1 TO W:Z=(I-1)*W+J:GOSUB 5000:NEXT J:NEXT I
|
|
1270 FOR I=1 TO M
|
|
1280 L2=S(I)-R(I)+1:J=W9(I*3-1):K=W9(I*3-2)
|
|
1290 FOR P=1 TO L2
|
|
1300 Z=(J-1)*W+K
|
|
1305 Z$=W$(R(I)+P-1,R(I)+P-1) : GOSUB 5000
|
|
1310 J=J+D1(W9(I*3)*2):K=K+D1(W9(I*3)*2-1):NEXT P
|
|
1320 NEXT I
|
|
1330 Q$="HERE IS THE ANSWER KEY:"
|
|
1335 PRINT "HIT ENTER TO PRINT SOLUTION KEY"
|
|
1340 GOSUB 1070
|
|
1350 PRINT:PRINT
|
|
1360 END
|
|
2000 IF Z$="A" THEN Z=1 : REM VERIFIES CHARACTER IS ALPHABETIC
|
|
2005 IF Z$="B" THEN Z=1
|
|
2010 IF Z$="C" THEN Z=1
|
|
2015 IF Z$="D" THEN Z=1
|
|
2020 IF Z$="E" THEN Z=1
|
|
2025 IF Z$="F" THEN Z=1
|
|
2030 IF Z$="G" THEN Z=1
|
|
2035 IF Z$="H" THEN Z=1
|
|
2040 IF Z$="I" THEN Z=1
|
|
2045 IF Z$="J" THEN Z=1
|
|
2050 IF Z$="K" THEN Z=1
|
|
2055 IF Z$="L" THEN Z=1
|
|
2060 IF Z$="M" THEN Z=1
|
|
2065 IF Z$="N" THEN Z=1
|
|
2070 IF Z$="O" THEN Z=1
|
|
2075 IF Z$="P" THEN Z=1
|
|
2080 IF Z$="Q" THEN Z=1
|
|
2085 IF Z$="R" THEN Z=1
|
|
2090 IF Z$="S" THEN Z=1
|
|
2095 IF Z$="T" THEN Z=1
|
|
2100 IF Z$="U" THEN Z=1
|
|
2105 IF Z$="V" THEN Z=1
|
|
2110 IF Z$="W" THEN Z=1
|
|
2115 IF Z$="X" THEN Z=1
|
|
2120 IF Z$="Y" THEN Z=1
|
|
2125 IF Z$="Z" THEN Z=1
|
|
2130 RETURN
|
|
3000 D1(1)=0 : REM INITIALIZE VALUES, REPLACES
|
|
3001 D1(2)=1 : REM DATA AND READ STATEMENTS
|
|
3002 D1(3)=1
|
|
3003 D1(4)=1
|
|
3004 D1(5)=1
|
|
3005 D1(6)=0
|
|
3006 D1(7)=1
|
|
3007 D1(8)=-1
|
|
3008 D1(9)=0
|
|
3009 D1(10)=-1
|
|
3010 D1(11)=-1
|
|
3011 D1(12)=-1
|
|
3012 D1(13)=-1
|
|
3013 D1(14)=0
|
|
3014 D1(15)=-1
|
|
3016 D1(16)=1
|
|
3020 D2(1)=2
|
|
3021 D2(2)=4
|
|
3023 D2(3)=6
|
|
3024 D2(4)=8
|
|
3025 FOR Z=5 TO 24:D2(Z)=D2(Z-4):NEXT Z
|
|
3026 D2(25)=1
|
|
3027 D2(26)=3
|
|
3028 D2(27)=5
|
|
3029 D2(28)=7
|
|
3030 RETURN
|
|
4000 Z$=W$(R(Z),S(Z)):REM RETURNS WORD Z INTO STRING Z$
|
|
4010 RETURN
|
|
4500 REM ONLY NEED TO SWAP INDICES
|
|
4510 S6=S(I)
|
|
4520 S(I)=S(J)
|
|
4530 S(J)=S6
|
|
4540 S6=R(I)
|
|
4550 R(I)=R(J)
|
|
4560 R(J)=S6
|
|
4570 RETURN
|
|
4600 FOR I5=I TO M-1 : REM DROP R(I),S(I) FROM LIST
|
|
4610 R(I5)=R(I5+1)
|
|
4620 S(I5)=S(I5+1)
|
|
4630 NEXT I5
|
|
4640 M=M-1
|
|
4650 RETURN
|
|
4700 FOR I5=1 TO W:Z$(I5)=" ":NEXT I5
|
|
4710 FOR I5=1 TO L:A$((I5-1)*W+1)=Z$:NEXT I5
|
|
4720 RETURN
|
|
5000 REM ENTERS CHARACTER Z$ INTO POSITION Z OF A$
|
|
5010 IF Z<L*W THEN Y$=A$(Z+1)
|
|
5020 A$(Z)=Z$
|
|
5030 IF Z<L*W THEN A$(Z+1)=Y$
|
|
5040 RETURN
|
|
6000 Z$="A":RETURN :REM COMPUTED GOTO FROM RND FUNCTION
|
|
6001 Z$="B":RETURN
|
|
6002 Z$="C":RETURN
|
|
6003 Z$="D":RETURN
|
|
6004 Z$="E":RETURN
|
|
6005 Z$="F":RETURN
|
|
6006 Z$="G":RETURN
|
|
6007 Z$="H":RETURN
|
|
6008 Z$="I":RETURN
|
|
6009 Z$="J":RETURN
|
|
6010 Z$="K":RETURN
|
|
6011 Z$="L":RETURN
|
|
6012 Z$="M":RETURN
|
|
6013 Z$="N":RETURN
|
|
6014 Z$="O":RETURN
|
|
6015 Z$="P":RETURN
|
|
6016 Z$="Q":RETURN
|
|
6017 Z$="R":RETURN
|
|
6018 Z$="S":RETURN
|
|
6019 Z$="T":RETURN
|
|
6020 Z$="U":RETURN
|
|
6021 Z$="V":RETURN
|
|
6022 Z$="W":RETURN
|
|
6023 Z$="X":RETURN
|
|
6024 Z$="Y":RETURN
|
|
6025 Z$="Z":RETURN
|
|
RUN
|