home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib38a.dsk / APRIL.1990 / COLORSCOUT.DEMO.bas < prev    next >
BASIC Source File  |  2023-02-26  |  8KB  |  142 lines
  1. 10  REM  ********************************
  2. 20  REM  * COLORSCOUT.DEMO              *
  3. 30  REM  * BY SCOTT ALFTER              *
  4. 40  REM  * COPYRIGHT (C) 1990           *
  5. 50  REM  * MINDCRAFT PUBL. CORP.        *
  6. 60  REM  * CONCORD, MA 01742            *
  7. 70  REM  ********************************
  8. 80  ONERR  GOTO 630
  9. 90  PRINT  CHR$(4)"BRUN COLORSCOUT.BIN"
  10. 100  REM  MAKE TITLE SCREEN
  11. 110  PRINT  CHR$(21): PRINT  CHR$(4)"PR#0": HOME 
  12. 120  VTAB 10:S$ = "COLORSCOUT FUNCTION DEMO": GOSUB 490
  13. 130  VTAB 12:S$ = "BY SCOTT ALFTER": GOSUB 490
  14. 140  VTAB 15:S$ = "COPYRIGHT (C) 1990": GOSUB 490
  15. 150  PRINT :S$ = "MINDCRAFT PUBL. CORP.": GOSUB 490
  16. 160  PRINT :S$ = "CONCORD, MA 01742": GOSUB 490
  17. 170  VTAB 24:S$ = "PRESS RETURN TO BEGIN.  ": GOSUB 490: PRINT  CHR$(8);
  18. 180  GOSUB 440
  19. 190  DIM C$(4,7):C$(1,0) = "BLACK":C$(1,1) = "WHITE": FOR I = 0 TO 7: READ C$(4,I): NEXT : DATA  BLACK 1,GREEN,PURPLE,WHITE 1,BLACK 2,ORANGE,BLUE,WHITE 2: REM  COLOR CONVERSION ARRAY
  20. 200  FOR I = 768 TO I +6: READ J: POKE I,J: NEXT : POKE 232,0: POKE 233,3: SCALE= 1: ROT= 0: DATA 1,0,4,0,7,1,0: REM  SET UP ZOT
  21. 210 D3 =  PEEK(48896) < >76: REM  0 FOR PRODOS, 1 FOR DOS 3.3
  22. 220  REM 
  23. 230  REM  RUN THE MENU
  24. 240  REM 
  25. 250  HOME : IF   NOT MI  THEN MI = 1: REM  FIRST TIME, DEFAULT OPTION IS LOAD PICTURE
  26. 260  VTAB 1:S$ = "MAIN MENU": GOSUB 490
  27. 270  IF MI = 1  THEN  INVERSE : REM  SELECTED OPTION IN INVERSE
  28. 280  VTAB 5:S$ = "LOAD PICTURE": GOSUB 490: NORMAL 
  29. 290  IF MI = 2  THEN  INVERSE 
  30. 300  VTAB 7:S$ = "CATALOG DISK": GOSUB 490: NORMAL 
  31. 310  IF MI = 3  THEN  INVERSE 
  32. 320  VTAB 9:S$ = "GET COLORS FROM SCREEN (COLOR)": GOSUB 490: NORMAL 
  33. 330  IF MI = 4  THEN  INVERSE 
  34. 340  VTAB 11:S$ = "GET PIXELS FROM SCREEN (MONOCHROME)": GOSUB 490: NORMAL 
  35. 350  IF MI = 5  THEN  INVERSE 
  36. 360  VTAB 13:S$ = "QUIT PROGRAM": GOSUB 490: NORMAL 
  37. 370  VTAB 17:S$ = "SELECT AN OPTION WITH THE ARROWS, THEN": GOSUB 490: PRINT :S$ = "PRESS RETURN.  ": GOSUB 490: PRINT  CHR$(8);
  38. 380  GET A$: IF A$ =  CHR$(13)  THEN  ON MI GOSUB 730,900,1070,1070,1370: GOTO 250
  39. 390  IF A$ =  CHR$(27)  THEN MI = 5: GOTO 260: REM  ESCAPE SELECTS QUIT, BUT DOESN'T GO TO IT
  40. 400 MI = MI +(A$ =  CHR$(21)) +(A$ =  CHR$(10)) -(A$ =  CHR$(8)) -(A$ =  CHR$(11)):MI = (MI = 6) +MI *(MI >0  AND MI <6) +5 *  NOT MI: GOTO 270
  41. 410  REM 
  42. 420  REM  GET A RETURN
  43. 430  REM 
  44. 440  GET A$: IF A$ < > CHR$(13)  THEN  PRINT  CHR$(7);: GOTO 440
  45. 450  RETURN 
  46. 460  REM 
  47. 470  REM  CENTER A STRING ON THE SCREEN
  48. 480  REM 
  49. 490  HTAB ((40 - LEN(S$))/2) +1: PRINT S$;: RETURN 
  50. 500  REM 
  51. 510  REM  CONVERT A$ FROM LOWERCASE TO UPPERCASE
  52. 520 A$ =  CHR$( ASC(A$) -32 *( ASC(A$) >95)): RETURN 
  53. 530  REM 
  54. 540  REM  TURN ON ERROR TRAPPING
  55. 550  REM 
  56. 560  ONERR  GOTO 650
  57. 570  RETURN 
  58. 580  REM 
  59. 590  REM  TURN OFF ERROR TRAPPING
  60. 600  REM 
  61. 610  POKE 216,0: RETURN 
  62. 620  REM 
  63. 630  IF  PEEK(222) = 6  THEN  HOME : PRINT "COLORSCOUT COULDN'T BE FOUND": END 
  64. 640  HOME : PRINT "ERROR #" PEEK(222)"IN LINE " PEEK(218) +256 * PEEK(219): END 
  65. 650  CALL  -3288: TEXT 
  66. 660  IF  PEEK(222) = 6  THEN  VTAB 20:S$ = "THAT FILE DOESN'T EXIST.": GOSUB 490: PRINT :S$ = "PRESS RETURN AND TRY AGAIN.  ": GOSUB 490: PRINT  CHR$(8) CHR$(7);: GOSUB 440: VTAB 15: HTAB 1: PRINT  SPC( 40): VTAB 20: PRINT  SPC( 80): GOSUB 610: GOTO 780
  67. 670  VTAB 20:S$ = "CHECK THE DISK DRIVE.": GOSUB 490: PRINT :S$ = "PRESS RETURN AND TRY AGAIN.  ": GOSUB 490: PRINT  CHR$(8) CHR$(7);: GOSUB 440: VTAB 15: HTAB 1: PRINT  SPC( 40): VTAB 20: PRINT  SPC( 80): GOSUB 610
  68. 680  IF R = 1  THEN 780: REM  ERROR IN LOADING FILE
  69. 690  IF R = 2  THEN 900: REM  ERROR IN GETTING CATALOG
  70. 700  REM 
  71. 710  REM  LOAD A PICTURE INTO PAGE 1
  72. 720  REM 
  73. 730  HOME :R = 1
  74. 740  VTAB 1:S$ = "LOAD PICTURE": GOSUB 490
  75. 750  VTAB 6:S$ = "ENTER A FILENAME AND PRESS RETURN.": GOSUB 490: PRINT 
  76. 760 S$ = "(YOU MAY ALSO PRESS ESCAPE AND SELECT": GOSUB 490: PRINT 
  77. 770 S$ = "THE CATALOG DISK OPTION.)": GOSUB 490
  78. 780  VTAB 12:S$ = "FILENAME? ": FOR I = 1 TO 15 +15 *D3:S$ = S$ + CHR$(95): NEXT : GOSUB 490: FOR I = 1 TO 15 +15 *D3: PRINT  CHR$(8);: NEXT :P = 1:N$ = "": REM  ALLOW 15 CHARACTERS FOR PRODOS, 30 FOR DOS 3.3
  79. 790  GET A$: GOSUB 520: IF A$ =  CHR$(27)  THEN MI = 2: RETURN : REM  ESCAPE MAKES CATALOG DISK THE DEFAULT OPTION
  80. 800  IF A$ >"@"  AND A$ < CHR$(91)  AND P <16 +15 *D3  THEN  PRINT A$;:N$ = N$ +A$:P = P +1: GOTO 790: REM  ONLY LETTERS CAN BE THE FIRST CHARACTER
  81. 810  IF ((((A$ >"/"  AND A$ <":")  OR A$ = ".")  AND P >1  AND P <16)  AND   NOT D3)  OR (A$ > CHR$(31)  AND P >1  AND P <31  AND D3)  THEN  PRINT A$;:N$ = N$ +A$:P = P +1: GOTO 790: REM  OTHER CHARS MAY BE LETTERS, #S, PERIODS (PRODOS) OR ANY PRINTABLE CHAR (DOS 3.3)
  82. 820  IF A$ =  CHR$(8)  AND P >1  THEN  PRINT  CHR$(8) CHR$(95) CHR$(8);:N$ =  MID$ (N$,1, LEN(N$) -1):P = P -1: GOTO 790
  83. 830  IF A$ < > CHR$(13)  OR P = 1  THEN  PRINT  CHR$(7);: GOTO 790
  84. 840  HTAB 1: PRINT  SPC( 40): VTAB 12:S$ = "FILENAME: " +N$: GOSUB 490: REM  CLEAN UP DISPLAY
  85. 850  VTAB 15:S$ = "LOADING THE PICTURE...PLEASE WAIT": GOSUB 490: GOSUB 560: REM  ERROR TRAPPING IS TURNED ON AROUND DISK OPERATIONS
  86. 860  PRINT : PRINT  CHR$(4)"BLOAD"N$",A$2000": GOSUB 610:MI = 3: RETURN : REM  DEFAULT OPTION IS COLOR GET
  87. 870  REM 
  88. 880  REM  CATALOG A DISK
  89. 890  REM 
  90. 900 S = S *  NOT   NOT S +6 *  NOT S:D = D *  NOT   NOT D +  NOT D: GOSUB 490: PRINT :R = 2: REM  FIRST TIME OPTION IS UDES, DEFAULTS OF SLOT 6, DRIVE 1 ARE SET
  91. 910  TEXT : HOME :S$ = "CATALOG DISK": GOSUB 490
  92. 920  VTAB 11:S$ = "SLOT? " + STR$(S): GOSUB 490: PRINT  CHR$(8);
  93. 930  GET A$: IF A$ =  CHR$(27)  THEN MI = 1: RETURN : REM  ESCAPE SETS LOAD PICTURE AS DEFAULT
  94. 940  IF A$ >"/"  AND A$ <"8"  THEN S =  VAL(A$): GOTO 920: REM  ONLY SLOTS 0-7
  95. 950  IF A$ < > CHR$(13)  THEN  PRINT  CHR$(7);: GOTO 930
  96. 960  VTAB 13:S$ = "DRIVE? " + STR$(D): GOSUB 490: PRINT  CHR$(8);
  97. 970  GET A$: IF A$ =  CHR$(27)  THEN MI = 1: RETURN 
  98. 980  IF A$ = "1"  OR A$ = "2"  THEN D =  VAL(A$): GOTO 960: REM  ONLY DRIVES 1-2
  99. 990  IF A$ < > CHR$(13)  THEN  PRINT  CHR$(7);: GOTO 970
  100. 1000  VTAB 11: HTAB 1: PRINT  SPC( 120): REM  ERASE INPUT
  101. 1010  POKE 34,2: HOME : VTAB 3:S$ = "SLOT " + STR$(S) +", DRIVE " + STR$(D): GOSUB 490: POKE 34,4: HOME : REM  SLOT, DRIVE GO INTO TEMPORARY HEADER AT TOP OF SCREEN
  102. 1020  PRINT : GOSUB 560: PRINT  CHR$(4)"CAT" MID$ ("ALOG",1,4 *D3)",S"S",D"D: GOSUB 610: REM  "CAT" FOR PRODOS, "CATALOG" FOR DOS 3.3
  103. 1030  PRINT :S$ = "PRESS RETURN TO CONTINUE.  ": GOSUB 490: PRINT  CHR$(8);: GOSUB 440: TEXT :MI = 1: RETURN 
  104. 1040  REM 
  105. 1050  REM  ENTER FOR THE TWO GETTING ROUTINES
  106. 1060  REM 
  107. 1070  HOME 
  108. 1080  VTAB 1
  109. 1090  IF MI = 3  THEN S$ = "GET COLORS FROM SCREEN (COLOR)":F = 4: REM  USR(4) FOR COLOR
  110. 1100  IF MI = 4  THEN S$ = "GET PIXELS FROM SCREEN (MONOCHROME)":F = 1: REM  USR(1) FOR MONOCHROME
  111. 1110  GOSUB 490
  112. 1120  VTAB 9:S$ = "USE THE ARROWS OR IJKM TO MOVE THE": GOSUB 490: PRINT 
  113. 1130 S$ = "CURSOR.  THE COLOR WILL APPEAR ON THE": GOSUB 490: PRINT 
  114. 1140 S$ = "BOTTOM OF THE SCREEN.  PRESS ESCAPE": GOSUB 490: PRINT 
  115. 1150 S$ = "WHEN FINISHED.  PRESS RETURN TO BEGIN.  ": GOSUB 490: PRINT  CHR$(8);
  116. 1160  GET A$: IF A$ =  CHR$(27)  THEN MI = 3 +(MI = 3): RETURN 
  117. 1170  IF A$ < > CHR$(13)  THEN  PRINT  CHR$(7);: GOTO 1160
  118. 1180  REM 
  119. 1190  REM  TURN ON HI-RES PAGE 1
  120. 1200  REM 
  121. 1210  POKE 49239,0: POKE 49235,0: POKE 49232,0: POKE 230,32: HOME :X = 140:Y = 96
  122. 1220  REM 
  123. 1230  REM  GET COLORS/PIXELS
  124. 1240  REM 
  125. 1250  VTAB 22: HTAB 1: PRINT  SPC( 40): VTAB 22:S$ = C$(F, USR(F),X,Y): GOSUB 490: REM  MODE (1 OR 4) AND COLOR RETURNED SELECT A COLOR NAME FROM THE ARRAY
  126. 1260  XDRAW 1 AT X,Y: REM  USE THE ZOT AS A CURSOR
  127. 1270 K =  PEEK( -16368):K = K -32 *(K >223): REM  THIS WAY, YOU DON'T HAVE TO WAIT FOR THE KEY TO REPEAT
  128. 1280 X = X +(K = 149  OR K = 203) -(K = 136  OR K = 202): REM  UPDATE X
  129. 1290 Y = Y +(K = 138  OR K = 205) -(K = 139  OR K = 201): REM  UPDATE Y
  130. 1300 X = 279 *(X =  -1) +X *(X > -1  AND X <280):Y = 159 *(Y =  -1) +Y *(Y > -1  AND Y <160): REM  X IS LIMITED TO 0-279 AND Y IS LIMITED TO 0-159.  SCREEN WRAPAROUND IS USED.
  131. 1310  XDRAW 1: REM  ERASE ZOT
  132. 1320  IF K = 155  THEN MI = 3 +(MI = 3): TEXT : RETURN : REM  ON ESCAPE, THE DEFAULT ITEM BECOMES THE OTHER GETTING OPTION (COLOR IF MONOCHROME, AND VICE VERSA)
  133. 1330  GOTO 1250
  134. 1340  REM 
  135. 1350  REM  QUIT PROGRAM
  136. 1360  REM 
  137. 1370  HOME 
  138. 1380  VTAB 1:S$ = "QUIT PROGRAM": GOSUB 490
  139. 1390  VTAB 12:S$ = "ARE YOU SURE?  ": GOSUB 490: PRINT  CHR$(8);
  140. 1400  GET A$: GOSUB 520: IF A$ =  CHR$(27)  OR A$ = "N"  THEN MI = 1: RETURN : REM  ON ESCAPE, DEFAULT IS LOAD PICTURE
  141. 1410  IF A$ < >"Y"  THEN  PRINT  CHR$(7);: GOTO 1400
  142. 1420  TEXT : HOME : END