Apple-1-Mini/code/programs/BASIC/WORDSEARCH.TXT

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