home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / scope.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-15  |  5.5 KB  |  201 lines
  1. 10 ' N O T E       N O T E       N O T E       N O T E
  2. 20 '
  3. 30 ' See important comments at the end of this program.
  4. 40 '
  5. 50 KEY OFF
  6. 60 DIM SCRN%(8,4)
  7. 70 SCREEN 0,0
  8. 80 LOCATE 1,1,0
  9. 90 GOSUB 1080      'INITIALIZE ARRAY
  10. 100 GOSUB 760      'PRINT MENU ON SCREEN
  11. 110 GOSUB 1390     'GO ASK USER WHAT HE WANTS TO DO
  12. 120 GOSUB 1790     'GO SEE WHAT HE SAID TO DO
  13. 130 GOSUB 1580     'SWITCH TO COLOR DISPLAY
  14. 140 GOSUB 670
  15. 150 IF SCRN%(7,2)>1 THEN SCREEN 1,1 ELSE SCREEN 1,0
  16. 160 IF SCRN%(5,2)>1 THEN COLOR 0,CINT(RND) ELSE COLOR CINT(RND * 15),CINT(RND)
  17. 170 CLS
  18. 180 '
  19. 190 '
  20. 200 X1=(RND * 50)+1
  21. 210 X2=(RND * 50)+1
  22. 220 Y1=RND * X1
  23. 230 Y2=RND * X2
  24. 240 GOTO 360
  25. 250 '
  26. 260 IF INT(RND * 11) = 5 THEN GOSUB 670
  27. 270 CC$=INKEY$
  28. 280 IF LEN(CC$)=0 THEN 310
  29. 290 IF CC$=CHR$(27) THEN GOSUB 1680: GOTO 100
  30. 300 IF CC$=" " THEN 160
  31. 310 IF INT(RND * 250) = 125 THEN 160
  32. 320 X1=(X1+XX) MOD 110
  33. 330 Y1=(Y1+YX) MOD 110
  34. 340 X2=(X2+XY) MOD 110
  35. 350 Y2=(Y2+YY) MOD 110
  36. 360 Y1=-Y1
  37. 370 Y2=-Y2
  38. 380 GOSUB 510
  39. 390 X1=-X1
  40. 400 X2=-X2
  41. 410 GOSUB 510
  42. 420 Y1=-Y1
  43. 430 Y2=-Y2
  44. 440 GOSUB 510
  45. 450 X1=-X1
  46. 460 X2=-X2
  47. 470 GOSUB 510
  48. 480 GOTO 260
  49. 490 '
  50. 500 '
  51. 510 ON I% GOTO 520,560,590,630
  52. 520 LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO
  53. 530 LINE((Y1+100)*35/24,X1+100)-((Y2+100)*35/24,X2+100),CO
  54. 540 RETURN
  55. 550 '
  56. 560 LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO,B
  57. 570 RETURN
  58. 580 '
  59. 590 LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO
  60. 600 LINE((Y1+100)*35/24,X1+100)-((Y2+100)*35/24,X2+100),CO,B
  61. 610 RETURN
  62. 620 '
  63. 630 CIRCLE (X1+150,Y1+100),ABS(X2),CO
  64. 640 RETURN
  65. 650 '
  66. 660 '
  67. 670 XX=(RND * 11)-5
  68. 680 XY=(RND * 11)-5
  69. 690 YX=(RND * 11)-5
  70. 700 YY=(RND * 11)-5
  71. 710 CO=CINT(RND *3)
  72. 720 RANDOMIZE(VAL(RIGHT$(TIME$,2)))
  73. 730 RETURN
  74. 740 '
  75. 750 '
  76. 760 VL$=CHR$(179)
  77. 770 HL$=CHR$(196)
  78. 780 UR$=CHR$(191)
  79. 790 LR$=CHR$(217)
  80. 800 UL$=CHR$(218)
  81. 810 LL$=CHR$(192)
  82. 820 CLS
  83. 830 LOCATE ,,0
  84. 840 PRINT TAB(15) "KALEIDOSCOPE"
  85. 850 LOCATE 4
  86. 860 PRINT "Foreground" TAB(15) UL$ "Lines" TAB(35) UR$
  87. 870 PRINT TAB(15) VL$ "Boxes" TAB(35) VL$
  88. 880 PRINT TAB(15) VL$ "Lines and Boxes" TAB(35) VL$
  89. 890 PRINT TAB(15) LL$ "Circles" TAB(35) LR$
  90. 900 LOCATE 10
  91. 910 PRINT "Background" TAB(15) UL$ "Random Color" TAB(32) UR$
  92. 920 PRINT TAB(15) LL$ "Black" TAB(32) LR$
  93. 930 LOCATE 14
  94. 940 PRINT "Mode" TAB(15) UL$ "Color" TAB(33) UR$
  95. 950 PRINT TAB(15) LL$ "Black & White" TAB(33) LR$
  96. 960 LOCATE 18
  97. 970 PRINT "Select one from each group"
  98. 980 PRINT "Move cursor with RETURN key"
  99. 990 PRINT "Press SPACE to execute KALEIDOSCOPE"
  100. 1000 PRINT "Press ESC to EXIT"
  101. 1010 LOCATE 24,1
  102. 1020 PRINT "While running, SPACE bar will restart";
  103. 1030 LOCATE 25,1
  104. 1040 PRINT "ESC will return to this menu";
  105. 1050 RETURN
  106. 1060 ' 
  107. 1070 '
  108. 1080 FOR I%=0 TO 3
  109. 1090 FOR J%=0 TO 7
  110. 1100 READ SCRN%(J%,I%)
  111. 1110 NEXT J%,I%
  112. 1120 RETURN
  113. 1130 '
  114. 1140 '
  115. 1150 FOR I%=0 TO 7
  116. 1160 LOCATE SCRN%(I%,0),SCRN%(I%,1)
  117. 1170 IF SCRN%(I%,2)=0 THEN PRINT " "
  118. 1180 IF SCRN%(I%,2)=1 THEN COLOR 0,7: PRINT " ": COLOR 7,0
  119. 1190 IF SCRN%(I%,2)=2 THEN COLOR 0,7: PRINT "X": COLOR 7,0
  120. 1200 IF SCRN%(I%,2)=3 THEN PRINT "X"
  121. 1210 NEXT I%
  122. 1220 RETURN
  123. 1230 '
  124. 1240 '
  125. 1250 IF SCRN%(CURS%,2)=1 THEN SCRN%(CURS%,2)=0 ELSE SCRN%(CURS%,2)=3
  126. 1260 CURS%=CURS%+1
  127. 1270 IF CURS%=8 THEN CURS%=0
  128. 1280 IF SCRN%(CURS%,2)=0 THEN SCRN%(CURS%,2)=1 ELSE SCRN%(CURS%,2)=2
  129. 1290 RETURN
  130. 1300 '
  131. 1310 '
  132. 1320 FOR I%=0 TO 7
  133. 1330 IF SCRN%(I%,3)=SCRN%(CURS%,3) THEN SCRN%(I%,2)=0
  134. 1340 NEXT I%
  135. 1350 SCRN%(CURS%,2)=2
  136. 1360 RETURN
  137. 1370 '
  138. 1380 '
  139. 1390 GOSUB 1150
  140. 1400 CC$=""
  141. 1410 WHILE LEN(CC$)<>1
  142. 1420 CC$=INKEY$
  143. 1430 WEND
  144. 1440 IF CC$=CHR$(13) THEN GOSUB 1250: GOSUB 1150
  145. 1450 IF (CC$="x") OR (CC$="X") THEN GOSUB 1320: GOSUB 1150
  146. 1460 'IF NO MONOCHROME DISPLAY, activate 1471 & comment 1470            *****
  147. 1470 'IF CC$=CHR$(27) THEN GOSUB 1680: KEY ON: LOCATE ,,1,12,13: CLS: END
  148. 1471 IF CC$=CHR$(27) THEN GOSUB 1680: LOCATE ,,1,7: CLS: RUN"BASMENU
  149. 1480 IF CC$=" " THEN RETURN
  150. 1490 GOTO 1390
  151. 1500 '
  152. 1510 '
  153. 1520 DATA 4,5,6,7,10,11,14,15
  154. 1530 DATA 22,22,32,24,29,22,22,30
  155. 1540 DATA 2,0,0,0,3,0,3,0
  156. 1550 DATA 1,1,1,1,2,2,3,3
  157. 1560 '
  158. 1570 '
  159. 1580  RETURN  'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAY
  160. 1590 DEF SEG=&H41
  161. 1600 POKE 0,(PEEK(0) AND &HCF) OR &H20
  162. 1610 DEF SEG
  163. 1620 SCREEN 0
  164. 1630 WIDTH 40
  165. 1640 SCREEN 1,0
  166. 1650 RETURN
  167. 1660 '
  168. 1670 '
  169. 1680  SCREEN 0,0  'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAT
  170. 1690  RETURN 'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAY
  171. 1700 DEF SEG=&H41
  172. 1710 POKE 0,(PEEK(0) OR &H30)
  173. 1720 DEF SEG
  174. 1730 SCREEN 0
  175. 1740 WIDTH 80
  176. 1750 LOCATE 1,1,0
  177. 1760 RETURN
  178. 1770 '
  179. 1780 '
  180. 1790 IF SCRN%(0,2)>1 THEN I%=1
  181. 1800 IF SCRN%(1,2)>1 THEN I%=2
  182. 1810 IF SCRN%(2,2)>1 THEN I%=3
  183. 1820 IF SCRN%(3,2)>1 THEN I%=4
  184. 1830 RETURN
  185. 1840 '         N O T E        N O T E
  186. 1850 'Activate/deactivate statements commented above depending on whether
  187. 1860 'or not you have a monochrome display. The statement numbers are
  188. 1870 'listed below in an ON statement incase someone renumbers this thing.
  189. 1880 ON I% GOTO 1460,1580,1680,1690
  190. 1890 '
  191. 1900 'If from time to time it appears that the program is not working, it may b
  192. 1910 'that it is painting with the same color as the background.
  193. 1920 '
  194. 1930 'Feel free to copy this program and pass it on to a friend, lover, etc.,
  195. 1940 'but lets see how many hands this program passes through. Before you
  196. 1950 'copy it, please add your name to the bottom of the list below.
  197. 1960 'This program written for the IBM PC by
  198. 1970 ' Bill Decker  4 Sherwood Dr. Endicott, N. Y. 13760
  199. 1980 ' Barry Shiffrin 2309 Acorn Dr. Vestal, NY  13850
  200. 1990 ' Bob Vollmer for STL PC-Club library 8-543-4866
  201.