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

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