home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib30b.dsk / WINDOWORKS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  190 lines
  1. 1  REM   **********************
  2. 2  REM   *     WINDOWORKS     *
  3. 3  REM   *  By  Bob Thrasher  *
  4. 4  REM   * Copyright (C) 1987 *
  5. 5  REM   * BY MicroSPARC, Inc *
  6. 6  REM   * Concord, MA  01742 *
  7. 7  REM   **********************
  8. 10  TEXT : PRINT  CHR$(12) CHR$(21): HOME : HIMEM: 15360: REM ** HIMEM=$3C00
  9. 20  GOTO 1160
  10. 30  REM ** DOS or ProDOS?
  11. 40 PD = ( PEEK(48896) = 76):Z = 1 -PD: IF PD = 0  THEN  VTAB 24: HTAB 1: PRINT "SLOT "DS", DRIVE "DD;: RETURN 
  12. 50  IF DP$ = ""  THEN  PRINT D$"PREFIX": INPUT DP$
  13. 60  VTAB 24: HTAB 1: PRINT "PREFIX: "DP$;: RETURN 
  14. 70  REM ** Add Prefix/Suffix to H$
  15. 80  IF PD = 0  THEN H$ = H$ +",S" + STR$(DS) +",D" + STR$(DD): RETURN 
  16. 90 H$ = DP$ +H$: RETURN 
  17. 100  REM ** Various Subroutines
  18. 110  VTAB A: HTAB B: PRINT "Press any Arrow";: VTAB A +1: HTAB B: PRINT "or A & Z to";: VTAB A +2: HTAB B: PRINT "move then press";: VTAB A +3: HTAB B: PRINT "Return if OK";: RETURN 
  19. 120  POKE 34,15: HOME : TEXT : RETURN 
  20. 130  CALL A(5): POKE D +2,0: POKE D +7,0: POKE D +5,0: POKE D,0: RETURN 
  21. 140  POKE 49168,0: VTAB 1
  22. 150  IF  PEEK(49152) <128  THEN 180
  23. 160  GET G$: VTAB 1: HTAB 1: PRINT : GOSUB 290: RETURN 
  24. 170  POKE 49168,0: VTAB 1
  25. 180  IF  PEEK(49152) <128  THEN 180
  26. 190  GET G$: PRINT : RETURN 
  27. 200  GOSUB 320: VTAB A +2: HTAB 13: PRINT F$;: GOSUB 140: RETURN 
  28. 210 A = 16:B = 21:CM = 2: GOSUB 330: RETURN 
  29. 220 A$ = "Load a Hi-Res picture first":A = 16: GOSUB 300: GOSUB 200: GOTO 1280
  30. 230 A$ = "No windows in memory":A = 16: GOSUB 300: GOSUB 200: GOTO 1280
  31. 240  VTAB 1: HTAB 1: PRINT : PRINT D$H$: RETURN 
  32. 250  ONERR  GOTO 270
  33. 260  VTAB 1: HTAB 1: PRINT : PRINT D$"BLOADWINDOWORKS.ML": RETURN 
  34. 270  PRINT "FATAL ERROR -": PRINT : PRINT : PRINT "THIS PROGRAM REQUIRES THE BINARY FILE": PRINT : INVERSE : PRINT "WINDOWORKS.ML";: NORMAL 
  35. 280  PRINT " TO BE ON THE SAME DISK": PRINT "AND IT IS MISSING.": PRINT : PRINT "PROGRAM STOPPED.": END 
  36. 290  POKE A(1),10: POKE A(3),2: CALL A(7): RETURN 
  37. 300  FOR E = 1 TO 10: POKE A(3),2: POKE A(1),20: CALL A(7): POKE A(3),2: POKE A(1),50: CALL A(7): NEXT : RETURN 
  38. 310  FOR E = 100 TO 10  STEP  -10: POKE A(3),3: POKE A(1),E: CALL A(7): NEXT : RETURN 
  39. 320  VTAB A: HTAB 21 - LEN(A$)/2: PRINT A$;: RETURN 
  40. 330  GOSUB 110: IF CM = 1  THEN 380
  41. 340  IF CM = 2  THEN 400
  42. 350  VTAB 1: HTAB 3: POKE 32,2: PRINT "View Hi-Res Screen": PRINT "View Animation": PRINT "Add Window": PRINT "Delete Window": PRINT "Edit Window"
  43. 360  PRINT "Delete All Windows": PRINT "Load Picture": PRINT "Load Window File": PRINT "Save Window File": PRINT "Create Final Module"
  44. 370  PRINT "Modify Data Drive": PRINT "Catalog Data Drive": PRINT "Toggle Overlay": PRINT "Exit Program":V1 = 1:V2 = 14:H1 = 1:H2 = 23: GOTO 410
  45. 380  VTAB 1: HTAB 27: POKE 32,26: PRINT "Scroll Up": PRINT "Scroll Down": PRINT "Scroll Left": PRINT "Scroll Right": PRINT "Inverse": PRINT "Color Change": PRINT "Frame":V1 = 1:V2 = 7:H1 = 25:H2 = 40
  46. 390  GOTO 410
  47. 400  VTAB 12: HTAB 27: POKE 32,26: PRINT "No": PRINT "Yes":V1 = 12:V2 = 13:H1 = 25:H2 = 31
  48. 410  TEXT :C = 0: IF CM = 0  THEN C = CC
  49. 420  VTAB V1 +C: HTAB H1: INVERSE : PRINT " ";: NORMAL : PRINT ">";: HTAB H2 -1: PRINT "<";: INVERSE : PRINT " ";: NORMAL :C1 = C
  50. 430  GOSUB 170: IF G$ = "A"  OR G$ = AL$  OR G$ = AU$  THEN C1 = C -1
  51. 440  IF G$ = "Z"  OR G$ = AR$  OR G$ = AD$  THEN C1 = C +1
  52. 450  IF C1 <0  THEN C1 = V2 -V1
  53. 460  IF C1 >V2 -V1  THEN C1 = 0
  54. 470  IF G$ = CR$  THEN 500
  55. 480  VTAB V1 +C: HTAB H1: PRINT "  ";: HTAB H2 -1: PRINT "  ";
  56. 490 C = C1: GOTO 420
  57. 500  GOSUB 120: GOSUB 290: IF CM = 0  THEN CC = C
  58. 510  RETURN 
  59. 520  REM ** Global Error Handler
  60. 530  TEXT : HOME :I =  PEEK(222):A$ = "": IF I = 4  THEN A$ = "Disk is Write Protected"
  61. 540  IF I = 8  THEN A$ = "I/O ERROR on this disk"
  62. 550  IF I = 9  THEN A$ = "Sorry, disk is full.  Use another."
  63. 560  IF I = 13  THEN A$ = "Must be a binary file"
  64. 570  IF I = 6  THEN A$ = "File not on this disk"
  65. 580  IF I = 10  THEN A$ = "File exists and is locked"
  66. 590  IF I = 16  AND PD = 0 GOTO 640: IF I = 16  AND PD  THEN A$ = "Bad pathname"
  67. 600  IF I = 17  THEN A$ = "ProDOS directory full"
  68. 610  IF I = 255  THEN A$ = "Please do not press Control-C"
  69. 620  IF A$ = ""  THEN A$ = "Error Encountered...Please retry"
  70. 630 A = 5: GOSUB 200: GOTO 1280
  71. 640  VTAB 5: PRINT "An error is present in": PRINT : HTAB 10: PRINT "LINE #" PEEK(218) +256 * PEEK(219): PRINT : PRINT "Please correct, save the new version.": PRINT : PRINT "and rerun WINDOWORKS": END 
  72. 650  REM ** Speed Setting Routine
  73. 660  VTAB 18: HTAB 3: PRINT "Slow --:--:--:--:--:--:--:--:-- Fast";: FOR E = 1 TO 8: VTAB 19: HTAB 7 +E *3: PRINT E;: NEXT :C = B(5) *(M < >K)
  74. 670 A = 23:A$ = "Use Arrows, A & Z, or (1-8) to select": GOSUB 320:A = 24:A$ = "Press Return when satisfied": GOSUB 320
  75. 680  INVERSE : VTAB 18: HTAB 31 -(C *3): PRINT "-:-";: NORMAL : GOSUB 140:P = 0: IF G$ = "A"  OR G$ = AL$  OR G$ = AU$  THEN P = 1
  76. 690  IF G$ = ES$  THEN C = 255: RETURN 
  77. 700  IF G$ = "Z"  OR G$ = AR$  OR G$ = AD$  THEN P =  -1
  78. 710  IF G$ = CR$  THEN  RETURN 
  79. 720  IF G$ > = "1"  AND G$ < = "8"  THEN P(8 - VAL(G$)) -C
  80. 730  VTAB 18: HTAB 30 -(C *3): PRINT "-:-";:C = C +P: IF C >7  OR C <0  THEN C = C -P
  81. 740  GOTO 680
  82. 750  REM ** Create A Window
  83. 760  GOSUB 130: IF L = 1  THEN  CALL A(6)
  84. 770  IF M = K  THEN  POKE A(12),65: POKE A(13),130: POKE A(14),13: POKE A(15),27: GOTO 790
  85. 780  FOR E = 0 TO 3: POKE A(E +12), PEEK(A(17) +M *7 +E): NEXT : FOR E = 0 TO 5:B(E) =  PEEK(A(17) +M *7 +E): NEXT 
  86. 790  CALL A(0): TEXT : IF  PEEK(A(12)) = 255  THEN WF = 255: RETURN 
  87. 800 A = 11:B = 25:CM = 1:G = B(4) *(M < >K): GOSUB 330: IF C = 255  THEN WF = C
  88. 810 F = A(17) +M *7: FOR E = 0 TO 3: POKE F +E, PEEK(A(12 +E)): NEXT : POKE F +4,C: GOSUB 660: POKE F +5,C: IF C = 255  THEN WF = C
  89. 820  RETURN 
  90. 830  FOR E = 0 TO 5: POKE F +E,B(E): NEXT : GOTO 1280
  91. 840  GOSUB 130:M = 0
  92. 850  FOR E = 0 TO 3: POKE A(E +12), PEEK(A(17) +M *7 +E): NEXT 
  93. 860  CALL A(9): FOR E = 1 TO 20: NEXT : CALL A(9): IF  PEEK(49152) <128  THEN 860
  94. 870  GET G$: GOSUB 290: IF (G$ = AL$  OR G$ = "A"  OR G$ = AU$)  AND M < >0  THEN M = M -1
  95. 880  IF (G$ = "Z"  OR G$ = AR$  OR G$ = AD$)  AND (M +1) < >K  THEN M = M +1
  96. 890  IF G$ = ES$  THEN M = 255: RETURN 
  97. 900  IF G$ < >CR$  THEN 850
  98. 910  RETURN 
  99. 920  REM ** Input a String Routine
  100. 930 A = 17:A$ = "Use <- for erase, Control-X to clear": GOSUB 320
  101. 940 A = 19:A$ = "Press Return when finished": GOSUB 320: VTAB 22: HTAB 6: FOR E = 1 TO 15 +Z *15: PRINT "-";: NEXT : GOSUB 310
  102. 950  VTAB 21: HTAB 6: PRINT C$;: FOR E =  LEN(C$) TO 15 +Z *15: PRINT " ";: NEXT : HTAB 6 + LEN(C$): INVERSE : PRINT " ";: NORMAL 
  103. 960  GOSUB 170: ON G$ <" "  OR G$ =  CHR$(127) GOTO 980: IF PD = 1  THEN  ON G$ <"."  OR G$ >"Z"  OR (G$ >"9"  AND G$ <"A")  OR  LEN(C$) >E -1 GOTO 960
  104. 970 C$ = C$ +G$: VTAB 21: HTAB 5 + LEN(C$): PRINT G$;: INVERSE : PRINT " ";: NORMAL : GOTO 960
  105. 980  IF (G$ = AL$  OR G$ =  CHR$(127))  AND ( LEN(C$) >1)  THEN C$ =  LEFT$(C$, LEN(C$) -1): GOTO 950
  106. 990  IF G$ = ES$  THEN C$ = "": RETURN 
  107. 1000  IF G$ = AL$  OR G$ =  CHR$(127)  OR G$ =  CHR$(24)  THEN C$ = "": GOTO 950
  108. 1010  IF G$ < >CR$  THEN 960
  109. 1020  POKE A(17) -1,K: VTAB 21: HTAB 6: PRINT C$" ";: RETURN 
  110. 1030  REM ** Modify Data Disk Loc.
  111. 1040  GOSUB 40: IF PD  THEN 1090
  112. 1050  VTAB 24: HTAB 6: GET C$: ON C$ = CR$ GOTO 1070:C =  VAL(C$): IF C <1  OR C >7  THEN 1050
  113. 1060  PRINT C$;:DS = C
  114. 1070  HTAB 15: GET C$: ON C$ = CR$ GOTO 1280:C =  VAL(C$): IF C <1  OR C >4  THEN 1070
  115. 1080  PRINT C$;:DD = C: GOTO 1280
  116. 1090  VTAB 23: HTAB 1: PRINT "Enter new ProDOS prefix (max. 30 chars.)";:C$ = "/":Z = 1: GOSUB 930:Z = 0: IF  LEN(C$) <2  THEN 1280
  117. 1100  IF  LEFT$(C$,1) < >"/"  THEN C$ = "/" +C$
  118. 1110  IF  RIGHT$(C$,1) < >"/"  THEN C$ = C$ +"/"
  119. 1120  PRINT D$"PREFIX"C$:DP$ = C$: GOTO 1280
  120. 1130  REM ** Catalog Data Drive
  121. 1140  HOME :H$ = "CAT": IF PD = 0  THEN H$ = H$ +"ALOG,S" + STR$(DS) +",D" + STR$(DD)
  122. 1150  GOSUB 240: FOR C = 1 TO 38: PRINT "-";: NEXT : GOSUB 140: PRINT : GOTO 1280
  123. 1160 DS = 6:DD = 1:D$ =  CHR$(4):D = 49232: DIM A(18):B$(0) = "OFF":B$(1) = "ON":E$(0) = "NO":E$(1) = "YES":F$ = "-PRESS RETURN-"
  124. 1170 AL$ =  CHR$(8):AR$ =  CHR$(21):AU$ =  CHR$(11):AD$ =  CHR$(10):CR$ =  CHR$(13):ES$ =  CHR$(27)
  125. 1180  GOSUB 250: HOME : ONERR  GOTO 530
  126. 1190  FOR E = 0 TO 18:A(E) = ( PEEK(24576 +E *2) +256 * PEEK(24577 +E *2)): NEXT : CALL A(8): CALL A(18)
  127. 1200  REM ** Title Page
  128. 1210 A = 3:A$ = "WINDOWORKS": GOSUB 320:A = 5:A$ = "BY BOB THRASHER": GOSUB 320:A = 9:A$ = "COPYRIGHT (C) 1987": GOSUB 320:A = 11:A$ = "BY MICROSPARC, INC.": GOSUB 320
  129. 1220  IF  PEEK( -1101) = 6  THEN A = 18:A$ = " ": GOSUB 200: GOTO 1260
  130. 1230 A = 20:A$ = "PLEASE TYPE ONLY IN UPPER-CASE": GOSUB 320: PRINT : PRINT : PRINT "  CAN YOU DISPLAY LOWER-CASE (Y/N)?";: FLASH : PRINT " ";: NORMAL : GOSUB 310
  131. 1240  GOSUB 140: IF G$ = "N"  THEN  CALL A(4): GOTO 1260
  132. 1250  IF G$ < >"Y"  THEN 1240
  133. 1260 G = 0:J = 0:K = 0:L = 0: POKE A(17),255
  134. 1270  REM ** Main Menu
  135. 1280  ONERR  GOTO 530
  136. 1290  TEXT : HOME :A = 16:B = 5:CM = 0: VTAB 16: HTAB 25: PRINT "WINDOWS:";K: HTAB 25: PRINT "OVERLAY:";B$(L): HTAB 25: PRINT "PICTURE:";E$(J): GOSUB 40
  137. 1300  GOSUB 330: ON C +1 GOTO 1330,1370,1400,1450,1490,1540,1580,1640,1710,1750,1040,1140,1800,1820
  138. 1310  GOTO 1300
  139. 1320  REM ** View Hi-Res Screen
  140. 1330  IF J = 0  THEN 220
  141. 1340  GOSUB 130: IF L = 1  THEN  CALL A(6)
  142. 1350  GOSUB 140: GOTO 1280
  143. 1360  REM ** View Animation
  144. 1370  IF K = 0  THEN 230
  145. 1380  FOR E = 0 TO 49: POKE A(17) +E *7 +6,0: NEXT : GOSUB 130: CALL A(10): GOTO 1280
  146. 1390  REM ** Add Window
  147. 1400  IF J = 0  THEN 220
  148. 1410  IF K = 50  THEN A$ = "Limit of 50 windows":A = 16: GOSUB 300: GOSUB 200: GOTO 1280
  149. 1420 M = K:WF = 0: GOSUB 760: IF WF = 255  THEN 830
  150. 1430 K = K +1: POKE F +7,255: GOTO 1280
  151. 1440  REM ** Delete Window
  152. 1450  IF K = 0  THEN 230
  153. 1460  GOSUB 840: IF M = 255  THEN 1280
  154. 1470  FOR E = A(17) +M *7 TO A(17) +(49 *7): POKE E, PEEK(E +7): NEXT :K = K -1: GOTO 1280
  155. 1480  REM ** Edit Window
  156. 1490  IF K = 0  THEN 230
  157. 1500  GOSUB 840: IF M = 255  THEN 1280
  158. 1510 WF = 0: GOSUB 760: IF WF = 255  THEN 830
  159. 1520  GOTO 1280
  160. 1530  REM ** Delete All Windows
  161. 1540  IF K = 0  THEN 230
  162. 1550  GOSUB 210: IF C = 1  THEN K = 0: POKE A(17),255
  163. 1560  GOTO 1280
  164. 1570  REM ** Load Picture
  165. 1580 A = 16:A$ = "Enter filename of picture to load:": GOSUB 320:C$ = "": GOSUB 930: IF C$ = ""  THEN 1280
  166. 1590 H$ = C$: GOSUB 80:H$ = "VERIFY" +H$: GOSUB 240:FS =  PEEK(38941) + PEEK(38942) *256:FT =  PEEK(38949): IF (FT < >4  AND FT < >132) *Z  THEN 1620
  167. 1600  IF (FS <33  OR FS >34) *Z  THEN 1620
  168. 1610  HGR2 :H$ = "BLOAD" + RIGHT$(H$, LEN(H$) -6) +",A$4000": GOSUB 240: GOSUB 290: CALL A(2): GOSUB 290:H = ( PEEK(A(16)) + PEEK(A(16) +1) *256) -3: POKE H,76: POKE H +1,96: POKE H +2,143: GOSUB 140:J = 1: GOTO 1280
  169. 1620  POKE 32,24: POKE 33,15: HOME : TEXT : VTAB 10: HTAB 25: PRINT "Please select a";: VTAB 11: HTAB 25: PRINT "33 or 34 sector";: VTAB 12: HTAB 25: PRINT "binary file.";: VTAB 14: HTAB 25: PRINT F$;: GOSUB 300: GOSUB 140: GOTO 1280
  170. 1630  REM ** Load Window File
  171. 1640  IF J = 0  THEN 220
  172. 1650 A = 16:A$ = "Enter filename of window data to load:": GOSUB 320:C$ = "W.": GOSUB 930: IF  LEN(C$) <3  THEN 1280
  173. 1660 H$ = C$: GOSUB 80:H$ = "VERIFY" +H$: GOSUB 240:FS =  PEEK(38941) + PEEK(38942) *256:FT =  PEEK(38949): IF (FT < >4  AND FT < >132) *Z  THEN 1620
  174. 1670  IF (FS < >3) *Z  THEN 1620
  175. 1680 H$ = "BLOAD" + RIGHT$(H$, LEN(H$) -6) +",A" + STR$(A(17) -1): GOSUB 240:K =  PEEK(A(17) -1): GOTO 1280
  176. 1690  POKE 32,24: POKE 33,15: HOME : TEXT : VTAB 10: HTAB 25: PRINT "Please select a";: VTAB 11: HTAB 25: PRINT "3 sector binary";: VTAB 12: HTAB 25: PRINT "window file.";: VTAB 14: HTAB 25: PRINT F$;: GOSUB 300: GOSUB 140: GOTO 1280
  177. 1700  REM ** Save Window File
  178. 1710  IF K = 0  THEN 230
  179. 1720 C$ = "W.":A = 16:A$ = "Enter filename for window data:": GOSUB 320: GOSUB 930: IF  LEN(C$) <3  THEN 1280
  180. 1730 H$ = C$: GOSUB 80:H$ = "BSAVE" +H$ +",A" + STR$(A(17) -1) +",L351": GOSUB 240: GOTO 1280
  181. 1740  REM *** Create Final Module
  182. 1750  IF J = 0  THEN 220
  183. 1760  IF K = 0  THEN 230
  184. 1770 C$ = "":A = 16:A$ = "Enter filename for final module:": GOSUB 320: GOSUB 930: IF  LEN(C$) <1  THEN 1280
  185. 1780 H$ = C$: GOSUB 80:H$ = "BSAVE" +H$ +",A" + STR$(H) +",L" + STR$(38400 -H): GOSUB 240: GOTO 1280
  186. 1790  REM ** Toggle Overlay
  187. 1800 L = 1 -L:A = 16:A$ = "The Window Overlay Option is now " +B$(L): GOSUB 200: GOTO 1280
  188. 1810  REM ** Exit Program
  189. 1820  GOSUB 210: IF C < >1  THEN 1280
  190. 1830  HOME : END