home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / square.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-15  |  17.1 KB  |  453 lines
  1. 1 '                        T h e   S q u a r e  (tm)
  2. 2 '                        -------------------
  3. 3 '
  4. 4 '    Copyright (c) 1983 by:   David N. Smith,
  5. 5 '                             44 Ole Musket Lane,
  6. 6 '                             Danbury, Ct. 06810
  7. 7 '                             CompuServe: 73145,153
  8. 8 '
  9. 9 '    The Square is distributed following the "freeware" concept:
  10. 10 '
  11. 11 '   1) you may copy it freely for personal use but not for profit, nor as
  12. 12 '      a part of a package which is sold.  Give it away and encourage
  13. 13 '      others to do so also.
  14. 14 '
  15. 15 '   2) contributions of $20 can be made if you find the program
  16. 16 '      entertaining.
  17. 17 '
  18. 18 '   If you send a postage paid, self addressed, diskette mailer to the
  19. 19 '   address above, the author will send a diskette with the program and
  20. 20 '   documentation.
  21. 21 '
  22. 22 '   If you send a postage paid, self addressed, diskette mailer with your
  23. 23 '   contribution of $20, the author will send a COMPILED version of The
  24. 24 '   Square.  The compiled version is significantly faster.
  25. 25 '
  26. 26 '   See accompanying file SQUARE.SUM for more information.
  27. 27 '
  28. 30 CLEAR ,,2048
  29. 31 DEFINT A-Z
  30. 32 '
  31. 33 ' constants
  32. 34 SCORE=0   '  moves since scrambled
  33. 35 LEVEL=0   ' level of difficulty (0,1)
  34. 36 BLOBS$=CHR$(219)+CHR$(219)+CHR$(219)
  35. 37 CUROFF=0: CURON=1
  36. 39 SCRAMBLED=0 ' was sqaure scrambled by program?
  37. 40 RUNNING=0   ' have initialized
  38. 41 DIR=1       ' direction of move (+1 or -1)
  39. 43 REDISPLAY=1' redisplay sqaure? (1=yes, 0=no)
  40. 44 '
  41. 45 X$=TIME$+"":  X=VAL(MID$(X$,7,2)): X=X*100+VAL(MID$(X$,4,2))
  42. 48 RANDOMIZE X
  43. 49 '
  44. 50 DARROW$=CHR$(25)
  45. 51 DARROW2$=DARROW$+DARROW$
  46. 52 DARROW3$=DARROW2$+DARROW$
  47. 53 RARROW$=CHR$(26): RARROW3$=RARROW$+RARROW$+RARROW$
  48. 54 '
  49. 56 KEY OFF: CLS
  50. 59 DEF SEG=0
  51. 60 IF (PEEK(&H410) AND &H30) <> &H30 THEN MONO=0 ELSE MONO=1
  52. 62 IF MONO=0 THEN SCREEN 0,1,0,0: COLOR  7,0,0: WIDTH 40: CLS
  53. 65 IF MONO=1 THEN COLOR  7,0
  54. 100 '
  55. 101 ' *******************
  56. 102 '
  57. 108 DIM SQ(36) ' sq(6,6)
  58. 120 DIM CH$(4)
  59. 122 CH$(1)=CHR$(176): CH$(2)=CHR$(206): CH$(3)=CHR$(221): CH$(4)=CHR$(219)
  60. 130 MAXNMOVES=100:  NMOVES=0:  DIM MOVES(100)
  61. 136 DIM ICOLOR(4): ICOLOR(1)=1: ICOLOR(2)=2: ICOLOR(3)=4: ICOLOR(4)=15
  62. 138 '
  63. 139 'saved status
  64. 140 DIM SAVESQ(36), STATUS(10)
  65. 142 STATUSSAVED=0
  66. 197 '
  67. 290 ' **********************************
  68. 295 '                 initialization
  69. 300 RUNNING=0
  70. 305 GOSUB 6000   ' initialize the square
  71. 310 GOSUB 5000   ' display logo
  72. 320 GOSUB 6500   ' ask level of difficulty
  73. 325 REDISPLAY=1
  74. 330 GOSUB 1000   ' display square
  75. 360 GOSUB 4100   ' scramble the square
  76. 370 RUNNING=1
  77. 380 REDISPLAY=0
  78. 490 '
  79. 495 ' **********************************
  80. 499 '                   main loop
  81. 500 WHILE  1=1
  82. 510    GOSUB 1000  ' display square
  83. 520    GOSUB 8000  ' see if it's in solution
  84. 530    GOSUB 3000  ' read a command
  85. 540    GOSUB 2000  ' perform operation
  86. 590 WEND           ' loop
  87. 660 STOP
  88. 990 ' **********************************
  89. 998 '
  90. 999 ' display square
  91. 1000 IF REDISPLAY=0 THEN RETURN
  92. 1005 IF MONO=0 THEN GOTO 1500
  93. 1010 REDISPLAY=0
  94. 1015 CLS
  95. 1017 LOCATE 1,70: IF LEVEL=0 THEN PRINT"Hard" ELSE PRINT "Harder"
  96. 1018 COLOR 7:  S$=SPACE$(36)
  97. 1050 FOR J=1 TO 6
  98. 1065    IF LEVEL=1 THEN LOCATE J*3-2,15: PRINT STR$(J)+" "+RARROW$
  99. 1070    FOR I=1 TO 6
  100. 1080       X$=CH$(SQ(J+I*6-6)): MARK=MARK+1
  101. 1100       MID$(S$, (I*6)-5,6)=X$+X$+X$+X$+X$+" "
  102. 1120    NEXT I
  103. 1135    LOCATE J*3-1, 21: IF LEVEL=0 THEN PRINT S$+STR$(J)+RARROW$ ELSE PRINT S$
  104. 1145    LOCATE J*3-0, 21: PRINT S$
  105. 1180 NEXT J
  106. 1190 IF LEVEL=1 THEN LOCATE 19,16: PRINT "1 "+RARROW$
  107. 1200 LOCATE 20, 18
  108. 1210 IF LEVEL=0  THEN PRINT DARROW3$ +"  A     B     C     D     E     F "+DARROW3$
  109. 1215 IF LEVEL<>0 THEN PRINT DARROW2$+"A     B     C     D     E     F     A "+DARROW2$
  110. 1220 RETURN
  111. 1499 ' COLOR DISPLAY    ----------------------
  112. 1500 CLS
  113. 1502 LOCATE 1,32: IF LEVEL=0 THEN PRINT"Hard" ELSE PRINT "Harder"
  114. 1505 COLOR 15,0: REDISPLAY=0
  115. 1550 FOR Y=1 TO 6
  116. 1570    FOR X=1 TO 6
  117. 1575       IC=SQ(Y+X*6-6): COLOR ICOLOR(IC),0,0
  118. 1590       LOCATE Y*3-1,10+X*4-4: PRINT BLOBS$
  119. 1610       LOCATE Y*3,  10+X*4-4: PRINT BLOBS$
  120. 1630    NEXT X
  121. 1640    COLOR  7,0,0
  122. 1650    IF LEVEL=0 THEN LOCATE Y*3,  5: PRINT STR$(Y) +" "+ RARROW$    ELSE LOCATE Y*3-2,4: PRINT STR$(Y) +" "+ RARROW$
  123. 1680 NEXT Y
  124. 1690 IF LEVEL=1 THEN LOCATE 19,5 : PRINT "1 "+RARROW$
  125. 1700 LOCATE 20, 18
  126. 1710 IF LEVEL=0  THEN PRINT "     "+DARROW3$ +"  A   B   C   D   E   F  "+DARROW3$
  127. 1720 IF LEVEL<>0 THEN PRINT"    "+ DARROW3$+" A   B   C   D   E   F   A "+DARROW3$
  128. 1730 RETURN
  129. 1990 ' ****************************
  130. 1996 ' perform operation: +A, -3, -c, d, 6, ...
  131. 1997 ' inputs: OP$
  132. 1998 '
  133. 2000 IF OP$>="A" AND OP$<="Z" THEN OP$=CHR$( ASC(OP$)+ASC("a")-ASC("A") )
  134. 2005 IF OP$="l" OR OP$="q" OR OP$="r" OR OP$="s" THEN GOSUB 2850 ' doit or not?
  135. 2010 IF OP$="" THEN RETURN
  136. 2015 IF OP$="l" THEN GOTO 320
  137. 2018 IF OP$="m" THEN GOSUB 10000: RETURN
  138. 2020 IF OP$="q" THEN GOTO 2900
  139. 2025 IF OP$="r" THEN REDISPLAY=1: GOSUB 6000: GOTO 2600
  140. 2030 IF OP$="s" THEN REDISPLAY=1: GOSUB 1000: GOSUB 4100: GOTO 2600
  141. 2040 IF OP$="u" THEN GOTO 2700
  142. 2100 IF OP$="?" THEN  GOSUB 5500: REDISPLAY=1: RETURN
  143. 2110 IF OP$="/" THEN  GOSUB 5500: REDISPLAY=1: RETURN
  144. 2120 IF OP$="+" THEN DIR=+1: GOTO 2600
  145. 2130 IF OP$="!" THEN REDISPLAY=1: IF LEVEL=1 THEN LEVEL=0: RETURN ELSE LEVEL=1: RETURN
  146. 2140 IF OP$="-" THEN DIR=-1: GOTO 2600
  147. 2150 IF OP$=" " THEN REDISPLAY=1: RETURN
  148. 2220 ' must be a row or column slide
  149. 2240 IF (OP$<"1" OR OP$>"6") AND (OP$<"a" OR  OP$>"f") THEN BEEP: GOTO 2600
  150. 2260 IF NMOVES=MAXNMOVES THEN FOR I=1 TO MAXNMOVES/2: MOVES(I)=MOVES(I+MAXNMOVES/2): NEXT I: NMOVES=MAXNMOVES/2
  151. 2270 NMOVES=NMOVES+1
  152. 2280 MOVES(NMOVES)=ASC(OP$)*DIR
  153. 2300 SCORE=SCORE+1
  154. 2310 REDISPLAY=1
  155. 2320 GOSUB 7000
  156. 2330 DIR=1
  157. 2599 ' see if another character has been typed
  158. 2600 FOR I=1 TO 10
  159. 2610    OP$=INKEY$: IF OP$ <> ""  GOTO 2000
  160. 2620 NEXT I
  161. 2630 RETURN
  162. 2699 '   undo a move (and unscore it too)
  163. 2700 IF NMOVES=0 THEN BEEP: GOTO 2600
  164. 2710 IF NMOVES > MAXNMOVES THEN BEEP: GOTO 2600
  165. 2720 I=MOVES(NMOVES): IF I<0 THEN DIR=1: I=-I ELSE DIR=-1
  166. 2740 OP$=CHR$(I): REDISPLAY=1: GOSUB 7000: NMOVES=NMOVES-1: SCORE=SCORE-1: DIR=1
  167. 2800 GOTO 2600
  168. 2849 ' ask before doing something drastic
  169. 2850 IF SCRAMBLED=0 THEN RETURN
  170. 2855 IF MONO=1 THEN LOCATE 22,1 ELSE LOCATE 23,1
  171. 2860 PRINT " "+OP$+" resets the game; type `y' or 'n'   "
  172. 2870 X$=INKEY$: IF X$="" THEN GOTO 2870
  173. 2880 IF X$<>"y" AND X$<>"Y" AND X$<>"n" AND X$<>"N" THEN GOTO 2850
  174. 2885 IF X$="n" OR X$="N" THEN OP$=""
  175. 2890 RETURN
  176. 2898 '
  177. 2899 ' stopping
  178. 2900 CLS: LOCATE 12,15: IF MONO=0 THEN COLOR  12+16  ELSE COLOR 15+16
  179. 2920 PRINT "G O O D B Y E"
  180. 2925 IF MONO=0 THEN COLOR  12     ELSE COLOR 15
  181. 2930 LOCATE 15,10: PRINT "Thank you for playing"
  182. 2945 IF MONO=0 THEN COLOR  15     ELSE COLOR 7
  183. 2950 LOCATE 22,1: KEY ON
  184. 2960 STOP
  185. 2990 ' *********************************
  186. 2997 '
  187. 2998 '  enter a command
  188. 2999 '
  189. 3000 IF MONO=1 THEN LOCATE 22,1: X$=SPACE$(20)   ELSE LOCATE 23,1: X$="  "
  190. 3010 PRINT "  Enter command (or ?)"+X$+"  ("+MID$(STR$(SCORE),2)+" moves)    "
  191. 3020 I=1: OP$=""
  192. 3030 WHILE OP$=""
  193. 3035    OP$=INKEY$: I=I+1: IF I>(300-NMOVES) THEN GOTO 3052
  194. 3050 WEND
  195. 3052 IF LEN(OP$)>=2 THEN STOP
  196. 3055 IF OP$<>"" THEN RETURN
  197. 3060 IF RANDOMLY=0 OR SCRAMBLED=0 THEN GOTO 3020
  198. 3065 I=INT(12*RND)+1: IF I<=6 THEN GOSUB 7800 ELSE J=I-6: GOSUB 7600
  199. 3070 FOR II=1 TO 2: PLAY "ml t255 l64 n10n12n10n12n10n12n10n12n10n12n10": NEXT
  200. 3075 GOTO 3020
  201. 3990 ' *********************************
  202. 3996 '
  203. 3998 '       scramble
  204. 3999 '
  205. 4000 LOCATE 22,1: PRINT "scramble the square now? ('y' or 'n')"
  206. 4020 X$=INKEY$: IF X$="" THEN GOTO 4020
  207. 4025 IF X$="?" THEN GOSUB 5500: CLS: GOTO 4000
  208. 4030 LOCATE 22,1: PRINT "                                     "
  209. 4050 IF X$<>"y" AND X$<>"n" AND X$<>"Y" AND X$<>"n" THEN GOTO 4000
  210. 4060 IF X$="n" OR X$<>"N" THEN RETURN
  211. 4099 ' entry point here (scramble without prompting)
  212. 4100 IF MONO=1 THEN LOCATE 22,1 ELSE LOCATE 23,1
  213. 4105 PRINT " Square being scrambled ...          "
  214. 4107 K=30
  215. 4110 FOR K=1 TO K
  216. 4120    I=INT(12*RND)+1: SOUND 100,.2: DIR=-1
  217. 4125    IF I<=6 THEN GOSUB 7800: IF LEVEL=1 THEN I=I+1: IF I>6 THEN I=1: GOSUB 7800 ELSE GOSUB 7800
  218. 4130    IF I>6  THEN J=I-6: GOSUB 7600: IF LEVEL=1 THEN J=J+1: IF J>6 THEN J=1: GOSUB 7600 ELSE GOSUB 7600
  219. 4150 NEXT K
  220. 4160 'REDISPLAY=1
  221. 4170 SCORE=0: SCRAMBLED=1: NMOVES=0: DIR=1
  222. 4195 PLAY "ml t255 l64 ccddeeffggaabb"
  223. 4200 RETURN
  224. 4992 ' *********************************
  225. 4993 ' *********************************
  226. 4996 '    logo
  227. 5000 IF MONO=0 THEN 5200
  228. 5002 CLS
  229. 5005 LOCATE 3,1
  230. 5016 PRINT " *****  *   *  *****"
  231. 5018 PRINT "   *    *   *  *              IBM Personal Computer"
  232. 5020 PRINT "   *    *****  ***                Recreational"
  233. 5022 PRINT "   *    *   *  *                    Program"
  234. 5024 PRINT "   *    *   *  *****              Version 1.0c"
  235. 5028 LOCATE 10,1
  236. 5030 PRINT "    *****    *****    *     *     ***    ******    ******* (tm)"
  237. 5031 PRINT "   *     *  *     *   *     *    *   *   *     *   *"
  238. 5032 PRINT "   *        *     *   *     *    *   *   *     *   *"
  239. 5033 PRINT "    *****   *     *   *     *   *     *  ******    ****"
  240. 5034 PRINT "         *  *     *   *     *   *******  *   *     *"
  241. 5035 PRINT "   *     *  *     *   *     *  *       * *    *    *"
  242. 5036 PRINT "    *****    ********  *****   *       * *     *   *******"
  243. 5038 LOCATE 18,1
  244. 5040 PRINT "            Copyright (c) 1983 by David N. Smith"
  245. 5050 LOCATE 21,1
  246. 5055 PRINT "  HIT SPACE BAR TO CONTINUE"
  247. 5057 PRINT "  (Press M to change display type)"
  248. 5060 PRINT "  Hit ? for instructions at ANY time."
  249. 5065 X$=INKEY$ :  IF X$="" THEN GOTO 5065
  250. 5068 IF X$="?" THEN GOSUB 5500
  251. 5070 IF X$="m" OR X$="M" THEN GOSUB 10000: GOTO 5000
  252. 5075 IF X$="r" OR X$="R" THEN RANDOMLY=1: GOTO 5065
  253. 5090 RETURN
  254. 5199 'color display (40 column)
  255. 5200 CLS: LOCATE 5,5: PRINT "T H E"
  256. 5225 LOCATE 9,5: PRINT "S Q U A R E  (tm)"
  257. 5238 LOCATE 14,5: PRINT "Copyright (c) 1983 by David N. Smith
  258. 5240 LOCATE 15,5: PRINT "Version 1.0c"
  259. 5250 LOCATE 18,1: PRINT "  HIT SPACE BAR TO CONTINUE"
  260. 5260 PRINT "  (Press M to change display device)
  261. 5262 PRINT "  Hit ? for instructions at ANY time."
  262. 5265 X$=INKEY$ :  IF X$="" THEN GOTO 5265
  263. 5267 COLOR  7,0,0
  264. 5268 IF X$="?" THEN GOSUB 5500
  265. 5270 IF X$="m" OR X$="M" THEN GOSUB 10000: GOTO 5200
  266. 5290 RETURN
  267. 5492 ' *********************************
  268. 5495 '
  269. 5496 '    help
  270. 5500 CLS:  OP$="": REDISPLAY=1
  271. 5510 IF MONO=0 THEN INDENT$=" " ELSE INDENT$=SPACE$(20)
  272. 5902 PRINT INDENT$+"     C O M M A N D   S U M M A R Y"
  273. 5903 PRINT " "
  274. 5904 PRINT INDENT$+"a to f  Slide corresponding column(s)"
  275. 5906 PRINT INDENT$+"1 to 6  Slide corresponding row(s)"
  276. 5907 PRINT " "
  277. 5908 PRINT INDENT$+"-       Reverse direction of next
  278. 5909 PRINT INDENT$+"         row or column slide command."
  279. 5910 PRINT INDENT$+"        Examples:  -b  -6  -f  -1"
  280. 5911 PRINT " "
  281. 5912 PRINT INDENT$+"l       Reset level of difficulty."
  282. 5913 PRINT INDENT$+"m       To/From Monochrome Display
  283. 5914 PRINT INDENT$+"q       Quit; Don't play any longer."
  284. 5915 PRINT INDENT$+"r       Reset; put into solution."
  285. 5916 PRINT INDENT$+"s       Scramble again (differently)"
  286. 5917 PRINT INDENT$+"u       Undo the last move."
  287. 5919 PRINT INDENT$+"/ or ?  Display command summary"
  288. 5920 PRINT " "
  289. 5924 PRINT INDENT$+"Any other key causes a beep and is"
  290. 5926 PRINT INDENT$+"otherwise ignored."
  291. 5928 PRINT INDENT$
  292. 5929 IF MONO=0 THEN COLOR 12 ELSE COLOR 15
  293. 5932 PRINT " Hit any key to continue."
  294. 5933 COLOR 7
  295. 5934 OP$=INKEY$: IF OP$="" THEN GOTO 5934
  296. 5940 CLS
  297. 5980 RETURN
  298. 5990 ' ********************
  299. 5995 '
  300. 5997 ' initialize the square
  301. 5998 '
  302. 6000 FOR I=1 TO 3: FOR J=1 TO 3: SQ(I+J*6-6)=1: NEXT J: NEXT I
  303. 6050 FOR I=4 TO 6: FOR J=1 TO 3: SQ(I+J*6-6)=2: NEXT J: NEXT I
  304. 6060 FOR I=1 TO 3: FOR J=4 TO 6: SQ(I+J*6-6)=3: NEXT J: NEXT I
  305. 6070 FOR I=4 TO 6: FOR J=4 TO 6: SQ(I+J*6-6)=4: NEXT J: NEXT I
  306. 6075 SCORE=0: SCRAMBLED=0: NMOVES=0
  307. 6100 RETURN
  308. 6490 ' ******************************
  309. 6495 ' ask level of difficulty
  310. 6500 CLS
  311. 6505 LOCATE  8,10: PRINT "  Type a space for a Hard puzzle"
  312. 6515 LOCATE 12,10: PRINT "  Type an 'r' for a race against time"
  313. 6518 LOCATE 16,10: PRINT "  Hit any other key for a Harder puzzle"
  314. 6523 LOCATE 20,10: PRINT "  Hit ? for instructions at ANY time."
  315. 6530 X$=INKEY$: IF X$="" THEN GOTO 6530
  316. 6535 GOSUB 6000
  317. 6540 CLS: LEVEL=1
  318. 6555 IF X$="m" OR X$="M" THEN GOSUB 10000: GOTO 6500
  319. 6557 IF X$="r" OR X$="R" THEN RANDOMLY=1: LEVEL=0: RETURN
  320. 6560 IF X$=" " THEN LEVEL=0
  321. 6565 IF X$="?" THEN GOSUB 5500: GOTO 6500
  322. 6570 RETURN
  323. 6990 '*****************************
  324. 6995 '
  325. 6996 ' process command to rotate a column or row
  326. 6997 '
  327. 7000 IF OP$ >= "1" AND OP$ <= "6"  THEN GOTO 7100  ' row move
  328. 7010 IF OP$ <  "a" OR  OP$ >  "f"  THEN RETURN     ' error
  329. 7050 ' rotate a row
  330. 7060 J=ASC(OP$)-ASC("a")+1: GOSUB 7600  ' rotate row 'j'
  331. 7075 J=J-1: IF J=0 THEN J=6
  332. 7080 IF LEVEL=1 THEN GOSUB 7600 ' rotate row 'j'
  333. 7090 RETURN
  334. 7100 ' rotate a column
  335. 7110 I=ASC(OP$)-ASC("1")+1: GOSUB 7800  ' rotate row 'j'
  336. 7130 I=I-1: IF I=0 THEN I=6
  337. 7140 IF LEVEL=1 THEN GOSUB 7800 ' rotate column j
  338. 7150 RETURN
  339. 7590 ' ******************************
  340. 7595 ' rotate a row (7600)    or column (7800)
  341. 7600 IF DIR=-1 THEN X=SQ(1+J*6-6): FOR I=2 TO 6: SQ(I-1+J*6-6)=SQ(I+J*6-6): NEXT I: SQ(6+J*6-6)=X
  342. 7610 IF DIR=1  THEN X=SQ(6+J*6-6): FOR I=1 TO 5: SQ(7-I+J*6-6)=SQ(6-I+J*6-6): NEXT I: SQ(1+J*6-6)=X
  343. 7620 ICOL=0: JROW=J: GOSUB 9000 ' redisplay it
  344. 7650 RETURN
  345. 7799 ' rotate a column
  346. 7800 IF DIR=-1 THEN X=SQ(I+1*6-6): FOR J=2 TO 6: SQ(I+(J-1)*6-6)=SQ(I+J*6-6): NEXT J: SQ(I+6*6-6)=X
  347. 7810 IF DIR=1  THEN X=SQ(I+6*6-6): FOR J=1 TO 5: SQ(I+(7-J)*6-6)=SQ(I+(6-J)*6-6): NEXT J: SQ(I+1*6-6)=X
  348. 7820 JROW=0: ICOL=I: GOSUB 9000 ' redisplay it
  349. 7890 RETURN
  350. 7997 '****
  351. 7999 ' see if square has been solved and make noise if so.
  352. 8000 IF SCRAMBLED=0 THEN RETURN
  353. 8010 II=SQ(1+1*6-6)
  354. 8020 FOR I=1 TO 3: FOR J=1 TO 3: IF II<>SQ(I+J*6-6) THEN RETURN: ELSE: NEXT J: NEXT I
  355. 8030 II=SQ(4+1*6-6)
  356. 8040 FOR I=4 TO 6: FOR J=1 TO 3: IF II<>SQ(I+J*6-6) THEN RETURN: ELSE: NEXT J: NEXT I
  357. 8050 II=SQ(1+4*6-6)
  358. 8060 FOR I=1 TO 3: FOR J=4 TO 6: IF II<>SQ(I+J*6-6) THEN RETURN: ELSE: NEXT J: NEXT I
  359. 8070 II=SQ(4+4*6-6)
  360. 8080 FOR I=4 TO 6: FOR J=4 TO 6: IF II<>SQ(I+J*6-6) THEN RETURN: ELSE: NEXT J: NEXT I
  361. 8088 IF MONO=0 THEN COLOR 4
  362. 8090 PRINT "            Y O U   W I N ! ! !      "
  363. 8100 FOR J=1 TO 10
  364. 8105    FOR I=600 TO 1100 STEP 100:  SOUND I,.15: SOUND I-150,.15: NEXT I
  365. 8125    FOR I=1200 TO 600 STEP -200: SOUND I,.15: SOUND I-150,.15: NEXT I
  366. 8145 NEXT J
  367. 8150 SOUND 50,0: CLS
  368. 8235 IF MONO=1 THEN COLOR 15+16  ELSE COLOR  3+16        ' blinking display
  369. 8238 IF MONO=0 THEN INDENT$="        " ELSE INDENT$=SPACE$(27)
  370. 8240 PRINT INDENT$+"Y   Y    OO    U  U"
  371. 8241 PRINT INDENT$+" Y Y    O  O   U  U"
  372. 8242 PRINT INDENT$+"  Y     O  O   U  U"
  373. 8243 PRINT INDENT$+"  Y     O  O   U  U"
  374. 8244 PRINT INDENT$+"  Y      OO     UU"
  375. 8245 PRINT ""
  376. 8246 PRINT ""
  377. 8247 PRINT INDENT$+"W   W  III  N   N   !!!"
  378. 8248 PRINT INDENT$+"W   W   I   NN  N   !!!"
  379. 8249 PRINT INDENT$+"W   W   I   N N N   !!!"
  380. 8250 PRINT INDENT$+"W W W   I   N  NN"
  381. 8251 PRINT INDENT$+" W W   III  N   N    !"
  382. 8252 PRINT ""
  383. 8253 PRINT ""
  384. 8255 COLOR 7
  385. 8260 LOCATE 16,1
  386. 8265 PRINT "Hit space bar to see square"
  387. 8270 PRINT "Hit:   ? for help"
  388. 8275 PRINT "       s to scramble square again"
  389. 8280 PRINT "       q to quit"
  390. 8290 SCRAMBLED=0
  391. 8300 RETURN
  392. 8995 '****************************
  393. 8997 ' update one column or rwo
  394. 9000 'IF RUNNING=0  THEN RETURN
  395. 9040 REDISPLAY=0: IF MONO=0 THEN GOTO 9200
  396. 9100 COLOR  7,0:  IF ICOL>0 THEN GOTO 9150
  397. 9103 ' update mono column
  398. 9105 FOR I=1 TO 6
  399. 9110    X$=CH$(SQ(I+JROW*6-6)): X$=X$+X$+X$+X$+X$
  400. 9120    LOCATE I*3-1, 21+JROW*6-6: PRINT X$
  401. 9130    LOCATE I*3-0, 21+JROW*6-6: PRINT X$
  402. 9140 NEXT I
  403. 9145 RETURN
  404. 9150 ' update mono row
  405. 9155 FOR J=1 TO 6
  406. 9160    X$=CH$(SQ(ICOL+J*6-6)): X$=X$+X$+X$+X$+X$
  407. 9170    LOCATE ICOL*3-1, 21+J*6-6: PRINT X$
  408. 9180    LOCATE ICOL*3-0, 21+J*6-6: PRINT X$
  409. 9190 NEXT J
  410. 9195 RETURN
  411. 9197 ' ----- mono display -----
  412. 9200 ' update color column
  413. 9202 IF ICOL>0 THEN GOTO 9255
  414. 9205 FOR I=1 TO 6
  415. 9210    IC=SQ(I+JROW*6-6): COLOR ICOLOR(IC),0,0
  416. 9220    LOCATE I*3-1, 10+JROW*4-4: PRINT BLOBS$
  417. 9230    LOCATE I*3-0, 10+JROW*4-4: PRINT BLOBS$
  418. 9240 NEXT I
  419. 9242 COLOR 15,0
  420. 9245 RETURN
  421. 9250 ' update color row
  422. 9255 FOR J=1 TO 6
  423. 9257    IC=SQ(ICOL+J*6-6): COLOR ICOLOR(IC),0,0
  424. 9270    LOCATE ICOL*3-1, 10+J*4-4: PRINT BLOBS$
  425. 9280    LOCATE ICOL*3-0, 10+J*4-4: PRINT BLOBS$
  426. 9290 NEXT J
  427. 9292 COLOR 15,0
  428. 9295 RETURN
  429. 9980 '******************************
  430. 9990 ' COLOR MONITOR-MONOCHROME MONITOR SWITCH    EMD 11-81
  431. 10000 CLS
  432. 10010 PRINT
  433. 10020 PRINT"   For Color display press-C"
  434. 10030 PRINT"   For Monochrome press   -M"
  435. 10040 PRINT"   For no change press any other key."
  436. 10050 K$=INKEY$:IF K$="" GOTO 10050
  437. 10060 IF K$="C" OR K$="c" THEN GOSUB 10190
  438. 10070 IF K$="M" OR K$="m" THEN GOSUB 10110
  439. 10080 CLS
  440. 10090 REDISPLAY=1
  441. 10100 RETURN
  442. 10110 '************** switch to monochrome ************
  443. 10120 DEF SEG=0: POKE &H410,(PEEK(&H410) OR &H30)
  444. 10140 DEF SEG:  LOCATE ,,1,12,13
  445. 10155 SCREEN 0: WIDTH 80: COLOR  7,0: MONO=1
  446. 10170 RETURN
  447. 10180 '**************************
  448. 10190 REM switch to color/graphics adapter
  449. 10200 DEF SEG=0: POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
  450. 10220 DEF SEG: LOCATE ,,1,6,7
  451. 10240 SCREEN 0: WIDTH 40: MONO=0
  452. 10260 RETURN
  453.