Compucolor.org – Virtual Media

Listing of file='CROSSW.BAS;01' on disk='vmedia/bounce_ball-sector.ccvf'

0 GOTO 65000
1 CLEAR 4000:X= 0:Y= 22:H= 9:W= 40:C= 1:GOSUB 64000
2 H= 21:GOTO 100
3 GOSUB 5:PRINT
5 H= H+ 1:IF H< 31THEN PLOT 3,0,H:RETURN
6 Z= CALL (0):PLOT 3,0,30:PRINT SPC( 40)""
7 PLOT 3,0,30:RETURN
98 REM 
99 REM
100 PLOT 27,24,14,6,37,12,3,22,3:PRINT "C R O S S W O R D S"
110 PLOT 15,6,35,3,15,29
111 REM 
112 REM
113 PRINT "COPYRIGHT 1979  BY DAVID B. SUITS"
114 REM
115 REM                       GENERAL STUDIES
116 REM                       ROCHESTER INSTITUTE OF TECHNOLOGY
117 REM                       ROCHESTER, NY  14623
118 REM 
119 REM
120 PLOT 14,6,100,3,17,15
121 REM 
122 REM
123 PRINT "THIS PROGRAM NOT TO BE COPIED"
124 REM 
150 PLOT 6,38,3,64,0:FOR J= 1TO 1000:NEXT
159 REM   GIVE MENU OF PUZZLES
160 GOSUB 5000
190 DIM WA$(NW),WD$(NW),CA$(NW),CD$(NW)
192 DIM WA(NW,2),WD(NW,2),FL(NW,2)
199 REM   PRINT COMMAND TABLE
200 GOSUB 8500
204 REM  GIVE INSTRUCTIONS
205 GOSUB 4000:PLOT 6,3:GOSUB 3:PRINT "     ***  PLEASE STAND BY ***"
206 H= H- 2:PLOT 3,64,0
209 REM   GET WORDS AND CLUES
210 GOSUB 9000:GOSUB 9500
214 REM   SET UP FLAGS
215 FOR J= 1TO NW:FL(J,1)= 0:IF LEN (WA$(J))< 2THEN FL(J,1)= - 2
220 FL(J,2)= 0:IF LEN (WD$(J))< 2THEN FL(J,2)= - 2
225 NEXT
239 REM   SET UP DISPLAY
240 GOSUB 8000:PLOT 6,3,3,0,29:PRINT SPC( 40)""
497 REM 
498 REM
499 REM  CHECK FOR WIN
500 PLOT 3,64,0:N= 0:FOR J= 1TO NW:IF FL(J,1)= - 2THEN N= N+ 1
510 IF FL(J,2)= - 2THEN N= N+ 1
520 NEXT :IF N< 2* NWTHEN 600
530 GOSUB 3:PRINT :GOSUB 3:PRINT "THAT'S IT!"
535 GOSUB 5:PRINT "YOU HAVE EVERYTHING CORRECT!"
540 GOSUB 3:PRINT "     CONGRATULATIONS"
545 GOSUB 3:GOSUB 5
550 FOR K= 1TO 4000:NEXT
555 LOAD "MENU":RUN
598 REM 
599 REM  GET COMMANDS
600 PLOT 6,3:GOSUB 3:INPUT "COMMAND: ";C$
605 GOSUB 800
620 C1$= LEFT$ (C$,1)
625 IF C1$= "C"THEN GOSUB 1000:GOTO 600
630 IF C1$= "W"THEN GOSUB 2000:GOTO 500
635 IF C1$= "E"THEN GOSUB 3000:GOTO 600
640 IF C1$= "G"THEN 700
645 GOSUB 3:PRINT "I'M SORRY.  I DON'T UNDERSTAND."
650 GOSUB 5:PRINT "PLEASE TRY AGAIN."
655 FOR J= 1TO 500:NEXT :GOSUB 4000:GOTO 600
698 REM 
699 REM  PLAYER GIVES UP
700 FOR J= 1TO NW
702 GOSUB 5:PRINT
705 IF LEN (WA$(J))< 2THEN 740
710 GOSUB 5:PRINT "CLUE FOR"J" ACROSS WAS:"
715 GOSUB 5:PRINT CA$(J):GOSUB 5
720 IF FL(J,1)= - 2THEN PRINT "YOU GOT THAT ONE":GOTO 740
722 IF FL(J,1)= - 1THEN PRINT "YOU MISSED THAT. ";
725 PRINT "THE ANSWER IS:":GOSUB 5:PRINT WA$(J)
730 A$= WA$(J):X= WA(J,1)+ 1:Y= WA(J,2)+ 1:GOSUB 2500
740 IF LEN (WD$(J))< 2THEN 775
745 GOSUB 5:PRINT "CLUE FOR"J" DOWN WAS:"
750 GOSUB 5:PRINT CD$(J):GOSUB 5
755 IF FL(J,2)= - 2THEN PRINT "YOU GOT THAT ONE":GOTO 775
757 IF FL(J,2)= - 1THEN PRINT "YOU MISSED THAT. ";
760 PRINT "THE ANSWER IS:":GOSUB 5:PRINT WD$(J)
765 A$= WD$(J):X= WD(J,1)+ 1:Y= WD(J,2)+ 1:PLOT 27,10:GOSUB 2540
775 IF J< NWTHEN PLOT 19:GOSUB 5:INPUT "PRESS RETURN TO CONTINUE ";R$
780 NEXT J
785 GOTO 545
799 REM 

DELETE SPACES

800 IF RIGHT$ (C$,1)= " "THEN C$= LEFT$ (C$,LEN (C$)- 1):GOTO 800
825 FOR J= 1TO LEN (C$)
830 IF MID$ (C$,J,1)= " "THEN C$= LEFT$ (C$,J- 1)+ RIGHT$ (C$,LEN (C$)- J)
835 NEXT :RETURN
898 REM
899 REM  ILLEGAL COMMAND NOTICE
900 GOSUB 3:PRINT "ILLEGAL COMMAND!":F= - 1:RETURN
999 REM 

GIVE CLUE

1000 F$= "C":GOSUB 2600:IF FTHEN RETURN
1050 IF B$= "D"THEN 1100
1069 REM  ACROSS
1070 IF LEN (WA$(A))> 1THEN 1085
1075 GOSUB 3:PRINT "SORRY.  THERE IS NO"A" ACROSS.":RETURN
1085 GOSUB 3:PRINT "CLUE FOR"A" ACROSS:"
1090 GOSUB 5:PRINT CA$(A):RETURN
1099 REM  DOWN
1100 IF LEN (WD$(A))> 1THEN 1115
1105 GOSUB 3:PRINT "SORRY.  THERE IS NO"A" DOWN.":RETURN
1115 GOSUB 3:PRINT "CLUE FOR"A" DOWN:"
1120 GOSUB 5:PRINT CD$(A):RETURN
1999 REM 

WRITE

2000 F$= "W":GOSUB 2600:IF FTHEN RETURN
2050 IF B$= "D"THEN 2200
2069 REM   ACROSS
2070 IF LEN (WA$(A))> 1THEN 2085
2075 GOSUB 3:PRINT "SORRY.  THERE IS NO"A" ACROSS.":RETURN
2085 PLOT 22:GOSUB 3:PRINT A" ACROSS:"
2090 GOSUB 5:INPUT "ENTER YOUR WORD: ";A$
2095 IF LEN (A$)= LEN (WA$(A))THEN 2120
2097 IF LEN (A$)= 1THEN RETURN
2100 GOSUB 3:PRINT "SAY, THAT'S"LEN (A$)" LETTERS."
2105 GOSUB 5:PRINT "FOR"A" ACROSS YOU NEED"LEN (WA$(A))" LETTERS.":RETURN
2120 X= WA(A,1)+ 1:Y= WA(A,2)+ 1:GOSUB 2500
2125 FL(A,1)= - 1:IF A$= WA$(A)THEN FL(A,1)= - 2
2130 RETURN
2199 REM   DOWN
2200 IF LEN (WD$(A))> 1THEN 2215
2205 GOSUB 3:PRINT "SORRY.  THERE IS NO"A" DOWN.":RETURN
2215 PLOT 22:GOSUB 3:PRINT A" DOWN:"
2220 GOSUB 5:INPUT "ENTER YOUR WORD: ";A$
2225 IF LEN (A$)= LEN (WD$(A))THEN 2245
2227 IF LEN (A$)= 1THEN RETURN
2230 GOSUB 3:PRINT "SAY, THAT'S"LEN (A$)" LETTERS."
2235 GOSUB 5:PRINT "FOR"A" DOWN YOU NEED"LEN (WD$(A))" LETTERS":RETURN
2245 X= WD(A,1)+ 1:Y= WD(A,2)+ 1:PLOT 27,10:GOSUB 2540
2250 PLOT 27,24
2255 FL(A,2)= - 1:IF A$= WD$(A)THEN FL(A,2)= - 2
2260 RETURN
2499 REM 

WRITE PLAYER'S WORD

2500 REM  ACROSS
2520 PLOT 6,39,3,X,Y:FOR W= 1TO LEN (A$)
2525 PRINT MID$ (A$,W,1);:PLOT 25
2530 NEXT :PLOT 6,3:RETURN
2539 REM   DOWN
2540 PLOT 6,39,3,X,Y:FOR W= 1TO LEN (A$)
2545 PRINT MID$ (A$,W,1);:PLOT 10
2550 NEXT :PLOT 27,24,6,3:RETURN
2599 REM 

PARSE USER INPUT

2600 F= 0:IF LEN (C$)> 1THEN 2620
2605 GOSUB 5:PRINT "PLEASE SPECIFY THE NUMBER"
2610 GOSUB 5:INPUT "AND EITHER A OR D:";C$
2615 GOSUB 800
2620 IF LEN (C$)< 2THEN F= - 1:RETURN
2625 IF LEFT$ (C$,1)= F$THEN C$= RIGHT$ (C$,LEN (C$)- 1)
2630 B$= RIGHT$ (C$,1):IF B$< > "A"AND B$< > "D"THEN F= - 1:GOTO 4000
2635 A= VAL (LEFT$ (C$,LEN (C$)- 1)):IF A< 1OR A< > INT (A)OR A> NWTHEN 900
2640 RETURN
2999 REM 

ERASE

3000 F$= "E":GOSUB 2600:IF FTHEN RETURN
3020 F$= "E":GOSUB 2600:IF FTHEN RETURN
3050 IF B$= "D"THEN 3200
3069 REM   ACROSS
3070 IF LEN (WA$(A))> 1THEN 3085
3075 GOSUB 3:PRINT "SORRY.  THERE IS NO"A" ACROSS":RETURN
3085 IF FL(A,1)THEN 3088
3086 GOSUB 3:PRINT "YOU CAN'T ERASE WHAT ISN'T THERE":RETURN
3088 X= WA(A,1):Y= WA(A,2)+ 1
3090 PLOT 6,32,30,3,X,Y
3095 FOR J= 0TO LEN (WA$(A))- 1
3100 PLOT 25:F= 0
3105 FOR K= 1TO NW
3107 IF LEN (WD$(K))< 2THEN 3130
3110 IF WD(K,1)< > X+ 2* JTHEN 3130
3115 IF WD(K,2)> YTHEN 3130
3120 IF Y> WD(K,2)+ 2* LEN (WD$(K))THEN 3130
3125 IF FL(K,2)THEN F= - 1
3130 NEXT :IF FTHEN PLOT 25:GOTO 3140
3135 PLOT 109
3140 NEXT J:FL(A,1)= 0
3145 PLOT 29,6,3:RETURN
3199 REM   DOWN
3200 IF LEN (WD$(A))> 1THEN 3210
3205 GOSUB 3:PRINT "SORRY.  THERE IS NO"A" DOWN.":RETURN
3210 IF FL(A,2)THEN 3214
3212 GOSUB 3:PRINT "YOU CAN'T ERASE WHAT ISN'T THERE.":RETURN
3214 X= WD(A,1)+ 1:Y= WD(A,2)
3215 PLOT 6,32,30,27,10,3,X,Y
3220 FOR J= 0TO LEN (WD$(A))- 1
3225 PLOT 10:F= 0
3230 FOR K= 1TO NW
3232 IF LEN (WA$(K))< 2THEN 3255
3235 IF WA(K,2)< > Y+ 2* JTHEN 3255
3240 IF WA(K,1)> XTHEN 3255
3245 IF X> WA(K,1)+ 2* LEN (WA$(K))THEN 3255
3250 IF FL(K,1)THEN F= - 1
3255 NEXT :IF FTHEN PLOT 10:GOTO 3265
3260 PLOT 109
3265 NEXT :FL(A,2)= 0
3270 PLOT 27,24,29,6,3:RETURN
3999 REM 

INSTRUCTIONS

4000 PLOT 6,6
4025 GOSUB 5:PRINT "ENTER COMMANDS WITH A LETTER FOLLOWED"
4030 GOSUB 5:PRINT "BY THE APPROPRIATE NUMBER AND EITHER"
4035 GOSUB 5:PRINT "A FOR ACROSS OR D FOR DOWN."
4040 GOSUB 3:PRINT "FOR EXAMPLE, TO GET THE CLUE FOR"
4045 GOSUB 5:PRINT "23 ACROSS, ENTER: C23A"
4050 RETURN
4999 REM 

GIVE MENU OF PUZZLES

5000 PLOT 3,17,15,11,3,19,7:PRINT ">>>   PUZZLE TOPICS   <<<"
5004 REM  ENTER PUZZLE NAMES AND NUMBERS HERE
5005 PLOT 15:PRINT
5010 PLOT 19:PRINT TAB( 20)"COMPUTERS AND"
5015 PRINT TAB( 20)"THE COMPUCOLOR II . . 1"
5020 PRINT
5025 PLOT 19:PRINT TAB( 20)"GENERAL . . . . . . . 2"
5100 PRINT :PRINT
5110 PRINT TAB( 29);:INPUT "YOUR CHOICE? ";C$
5114 REM  ENTER VALUE FOR NW (NUMBER OF WORDS) FOR EACH PUZZLE
5115 IF VAL (C$)= 1THEN NW= 46:RETURN
5120 IF VAL (C$)= 2THEN NW= 55:RETURN
5200 PLOT 28,11:GOTO 5110
7999 REM 

SET UP DISPLAY

8000 PLOT 6,32,30
8030 FOR J= 1TO NW
8032 X1= 0:Y1= 0
8034 IF LEN (WA$(J))< 2THEN 8042
8038 X= WA(J,1):Y= WA(J,2):T$= WA$(J)
8040 PLOT 3,X,Y:GOSUB 8320:PLOT 3,X,Y+ 1:GOSUB 8325
8042 NEXT :PLOT 27,10
8050 FOR J= 1TO NW
8052 X1= 0:Y1= 0
8054 IF LEN (WD$(J))< 2THEN 8060
8057 X= WD(J,1):Y= WD(J,2):T$= WD$(J)
8058 PLOT 3,X,Y:GOSUB 8340:PLOT 3,X+ 1,Y:GOSUB 8350
8060 NEXT :PLOT 27,24,6,37
8070 FOR J= 1TO NW:X1= 0
8071 IF LEN (WA$(J))< 2THEN 8076
8072 IF J< 10THEN X1= 1
8074 PLOT 3,WA(J,1)+ X1,WA(J,2):PRINT RIGHT$ (STR$ (J),LEN (STR$ (J))- 1)
8076 IF LEN (WD$(J))< 2THEN 8084
8078 IF (WA(J- 1,1)= WD(J,1)- 2)AND (WA(J- 1,2)= WD(J,2))THEN X1= 1
8080 IF (WD(J- 1,1)= WD(J,1)- 2)AND (WD(J- 1,2)= WD(J,2))THEN X1= 1
8082 PLOT 3,WD(J,1)+ X1,WD(J,2):PRINT RIGHT$ (STR$ (J),LEN (STR$ (J))- 1)
8084 NEXT :PLOT 29:RETURN
8298 REM
8299 REM
8320 FOR K= 1TO LEN (T$):PLOT 32,98:NEXT :RETURN
8325 FOR K= 1TO LEN (T$):PLOT 127,109:NEXT :RETURN
8340 FOR K= 1TO LEN (T$):PLOT 32,127:NEXT :RETURN
8350 FOR K= 1TO LEN (T$):PLOT 98,109:NEXT :RETURN
8499 REM 

PRINT COMMANDS TABLE

8500 PLOT 15,6,4,12,27,24,30,3,0,21
8525 FOR J= 0TO 63:PLOT 101:NEXT
8530 PLOT 3,40,21,110,3,63,21,111,3,40,31,108,3,63,31,109
8532 PLOT 3,41,31:FOR J= 1TO 22:PLOT 127:NEXT
8535 PLOT 27,10,3,40,22:FOR J= 1TO 9:PLOT 97:NEXT
8540 PLOT 3,63,22:FOR J= 1TO 9:PLOT 98:NEXT :PLOT 29
8545 PLOT 27,24,3,47,22:PRINT "COMMANDS"
8550 PLOT 3,41,24,19:PRINT "C  .  .  . CLUE"
8555 PLOT 3,41,25,19:PRINT "<NUMBER> . LINE NUMBER"
8560 PLOT 3,41,26,19:PRINT "A  .  .  . ACROSS"
8565 PLOT 3,41,27,19:PRINT "D  .  .  . DOWN"
8570 PLOT 3,41,28,19:PRINT "W  .  .  . WRITE"
8575 PLOT 3,41,29,19:PRINT "E  .  .  . ERASE"
8580 PLOT 3,41,30,19:PRINT "G  .  .  . GIVE UP"
8590 RETURN
8999 REM 

THE WORDS

9000 FILE "R",1,"WORDS"+ C$,16
9024 REM  WORDS ACROSS
9025 FOR J= 1TO NW
9030 GET 1;W$[16]:GOSUB 9300
9040 WA(J,1)= X:WA(J,2)= Y:WA$(J)= W$
9050 NEXT
9199 REM WORDS DOWN
9200 FOR J= 1TO NW
9210 GET 1;W$[16]:GOSUB 9300
9220 WD(J,1)= X:WD(J,2)= Y:WD$(J)= W$
9230 NEXT
9235 FILE "C",1
9298 REM

9299 REM
9300 X= VAL (LEFT$ (W$,2)):Y= VAL (MID$ (W$,3,2)):W$= RIGHT$ (W$,12)
9310 N= 0:W1$= ""
9320 N= N+ 1:IF N= 17THEN 9350
9325 IF MID$ (W$,N,1)= " "THEN 9350
9330 W1$= W1$+ MID$ (W$,N,1):GOTO 9320
9350 W$= W1$:RETURN
9500 REM 

THE CLUES

9520 FILE "R",2,"CLUES"+ C$,8
9525 FOR J= 1TO NW
9530 GET 2;CA$(J)[32]
9535 NEXT
9540 FOR J= 1TO NW
9545 GET 2;CD$(J)[32]
9550 NEXT
9560 FILE "C",2
9565 RETURN
63999 REM 

SCROLLING PATCH
64000 GOSUB 65410
64010 Z= 28672+ 128* Y+ X+ X:AD= TM+ 2:GOSUB 65400
64015 Z= 128- W- W:AD= TM+ 25:GOSUB 65400
64020 POKE TM+ 5,H- 1:POKE TM+ 7,W* (C+ 1):POKE TM+ 19,35* (1- C)
64030 RETURN
65000 GOSUB 65410:RESTORE 65030
65030 DATA 33,-1,-1,6,-1,14,-1,17,128,0,25,126
65040 DATA 17,128,255,25,119,35,-1,13,194,-1,-1
65050 DATA 17,-1,-1,25,5,194,-1,-1,201
65055 IF TM> 65503THEN TM= TM- 32:GOTO 65080
65060 FOR I= 1TO 32:READ A
65065 IF A= > 0AND A< > PEEK (TM+ 1)THEN I= 32:TM= TM- 32
65070 NEXT
65080 RESTORE 65030
65090 FOR I= 1TO 32:READ A:POKE TM+ I,A- (A< 0):NEXT
65100 Z= TM+ 1:AD= 33283:GOSUB 65400
65110 Z= TM:AD= ER:GOSUB 65400
65120 Z= TM+ 6:AD= TM+ 30:GOSUB 65400
65130 Z= TM+ 8:AD= TM+ 22:GOSUB 65400
65190 CLEAR 50:GOTO 1
65400 ZZ= INT (Z/ 256):POKE AD,Z- 256* ZZ:POKE AD+ 1,ZZ:RETURN
65410 ER= 32940:TM= 256* PEEK (ER+ 1)+ PEEK (ER):RETURN