home *** CD-ROM | disk | FTP | other *** search
/ Softdisk G-S 131 / SGDS 131.2mg / SDGS.131 / SDC131 / C / GRABBER (.txt) < prev    next >
Encoding:
Applesoft BASIC Source Code  |  1992-08-25  |  7.7 KB  |  239 lines  |  [FC] Applesoft BASIC Program (0x6001)
  1. 1  RESTORE : REM LEAVE THIS HERE IF YOU USE DATA
  2. 2  REM TO QUIT:POKE104,8:GOTO150
  3. 3  REM bload images @ $E00, boxrtn @ $D00, font @ $A00
  4. 4 D$ =  CHR$(4):IC = 1
  5. 6  DIM UN$(15),PN$(15),SB$(255),FI$(15),PC(14,7),PC$(14),TC(7)
  6. 7  VTAB 5: HTAB 12: PRINT "PRINT SHOP GRABBER": VTAB 24: HTAB 16: PRINT "Press a key"
  7. 8 WA = 50: GET A$: CALL 2260: POKE 230,64: POKE  -16299,0
  8. 9  PRINT  CHR$(4)"PREFIX": INPUT OP$
  9. 10 BOX = 3328:GIMME = 3331: INVERSE 
  10. 11 SHAD = 0:BUTN = 1:DIAL = 2:INPT = 3
  11. 13  PRINT  CHR$(12);
  12. 15  CALL GIMME,BUTN
  13. 20  CALL BOX,1,2,40,22
  14. 33  CALL GIMME,INPT: CALL BOX,6,4,30,17: HOME : PRINT "v1.0": REM v1.0b3
  15. 34  HTAB 6: PRINT "PRINT SHOP GRABBER": HTAB 14: PRINT "by": HTAB 8: PRINT "Peter Rokitski"
  16. 36  PRINT : PRINT "Copyright 1992 Softdisk, Inc     All rights reserved."
  17. 38  PRINT " Published on Softdisk #131": PRINT "Subscriptions:1-800-831-2694"
  18. 40  PRINT "   Changing this notice is": HTAB 11: PRINT "illegal."
  19. 44  PRINT : HTAB 9: PRINT "Press a key": GET A$
  20. 190  POKE 0,PS: CALL 3849
  21. 200  POKE 216,0:MN$ = "PS Grabber":UN$(1) = "Load Pic":UN$(2) = "Grab":UN$(3) = "Save PS Image":UN$(4) = "Save New PS Image":UN$(5) = "Quit":NF = 5
  22. 260 HH = 20 -( LEN(MN$)/2):W =  LEN(MN$) +2: CALL GIMME,DIAL: CALL BOX,HH,1,W,3: HOME : PRINT MN$;
  23. 300  CALL GIMME,DIAL: CALL BOX,6,21,30,4: PRINT "Arrows move, RETURN selects.": PRINT "         ESC exits.";
  24. 400  CALL GIMME,INPT: CALL BOX,6,4,30,17:MV = 4:CS = 1: GOSUB 8000
  25. 420  IF CS = 0  OR CS = 5  THEN 50000
  26. 460 FP = 0: ON CS GOTO 1000,3000,1250,1280
  27. 999  REM Choose Printer
  28. 1000 :
  29. 1005 :
  30. 1010 FP = 1:PS = 2: GOTO 2000
  31. 1020 :
  32. 1250  CALL BOX,17,6,19,4: VTAB 7: PRINT "PS name:":V = 8:H = 1:IN = 0:IW = 15:IN$ = "PS.": GOSUB 20000: IF IN$ < >""  THEN PR$ = IN$
  33. 1251 FP = 2: POKE 0,0:PS = 0: CALL 3846: CALL 3849:PS$ = ",TBIN": GOTO 2000
  34. 1280  CALL BOX,17,7,19,4: VTAB 8: PRINT "New PS name:":V = 9:H = 1:IN = 0:IW = 15:IN$ = "NPS.": GOSUB 20000: IF IN$ < >""  THEN PR$ = IN$
  35. 1281 FP = 2: POKE 0,1:PS = 1: CALL 3846: CALL 3849:PS$ = ",T$F5": GOTO 2000
  36. 1300 F$ = CP$ +PR$: ONERR  GOTO 1320
  37. 1310  PRINT D$"create"F$PS$: GOTO 1350
  38. 1320  IF  PEEK(222) < >19  THEN P = 144:D = 30: GOSUB 30000: CALL BOX,14,9,15,4: PRINT "Disk Error!": PRINT " Press a key": GET A$: GOTO 2060
  39. 1325 P = 144:D = 30: GOSUB 30000: CALL BOX,14,9,15,4: PRINT "File exists. Replace it?"
  40. 1326  GET A$: IF A$ = "n"  OR A$ = "N"  THEN  GOTO 190
  41. 1327  IF A$ < >"y"  AND A$ < >"Y"  THEN 1326
  42. 1330  ONERR  GOTO 1335
  43. 1331  PRINT D$"verify"F$
  44. 1332  PRINT D$"unlock"F$: PRINT D$"delete"F$: GOTO 1310
  45. 1335  IF  PEEK(222) = 5  THEN 1332
  46. 1336  IF  PEEK(222) < >13  THEN 1320
  47. 1340 P = 144:D = 30: GOSUB 30000: CALL BOX,14,9,15,4: PRINT "Wrong type.  Replace it?"
  48. 1341  GET A$: IF A$ = "n"  OR A$ = "N"  THEN 190
  49. 1342  IF A$ < >"y"  AND A$ < >"Y"  THEN 1341
  50. 1343  GOTO 1332
  51. 1350  IF PS = 0  THEN  PRINT D$"bsave"F$",a$2000,l576": GOTO 190
  52. 1355  PRINT D$"bsave"F$",a$3007,l609,t$F5": POKE 512, LEN(F$): FOR I = 1 TO  LEN(F$): POKE 512 +I, ASC( MID$ (F$,I,1)): NEXT 
  53. 1356  PRINT F$
  54. 1360  CALL 3852: GOTO 190
  55. 1999  REM <CTRL-0x0a>Add to menu
  56. 2000 :
  57. 2010  CALL GIMME,INPT: CALL BOX,6,4,30,17
  58. 2012  PRINT  CHR$(4)"PREFIX": INPUT PF$:DL = 0: FOR I = 1 TO  LEN(PF$): IF  MID$ (PF$,I,1) = "/"  THEN DL = DL +1
  59. 2013  NEXT :DL = DL -1
  60. 2015  GOTO 10000
  61. 2020  REM <CTRL-0x0a>Returns to next line
  62. 2030  IF FP  THEN PR$ = K$: GOTO 2100
  63. 2040 FI$ = K$:FP$ = CP$
  64. 2050 TX = 0: IF  MID$ (SB$(CS +TP),2,1) = "A"  THEN TX = 1
  65. 2060  ON PS +1 GOTO 190,190,200
  66. 2100  IF CP$ = ""  THEN 2060
  67. 2109  ONERR  GOTO 2200
  68. 2110  PRINT D$"BLOAD"CP$PR$",a$2000"
  69. 2120  PRINT  CHR$(20): HOME : VTAB 23: NORMAL : HTAB 15: PRINT "PRESS A KEY";: POKE  -16300,0: POKE  -16301,0: GET A$: POKE  -16302,0: POKE  -16299,0: INVERSE : GOTO 2060
  70. 2200  POKE 216,0: CALL BOX,14,9,15,4:P = 144:D = 30: GOSUB 30000: PRINT " Disk Error!": PRINT " Press a key": GET A$:PR$ = "": GOTO 2060
  71. 3000  POKE 230,32: POKE  -16300,0: POKE 232,15: POKE 233,15: ROT= 0: SCALE= 1
  72. 3010  POKE  -16301,0: NORMAL : PRINT  CHR$(20): PRINT D$"PR#0":FL = 0
  73. 3020  PRINT  CHR$(20): HOME : VTAB 21: PRINT "     ARROWS, A,Z OR I,J,K,M MOVE BOX"
  74. 3030  PRINT " 1-9 SETS MOVE INCREMENT, RETURN GRABS"
  75. 3040  PRINT "   SPACE BAR TOGGLES FULL SCREEN VIEW"
  76. 3045  PRINT "   ESC EXITS";:PG = 0
  77. 3049  VTAB 24: HTAB 18: PRINT "CURRENT INCREMENT: "IC;
  78. 3050 K =  PEEK(49152): IF K <127  THEN  XDRAW 1 AT XC,YC:FL = 1 -FL: GOTO 3050
  79. 3051  POKE 49168,0
  80. 3052  IF K = 160  THEN PG = 1 -PG: POKE 49235 -PG,0: GOTO 3050
  81. 3053  IF K >176  AND K <186  THEN IC = K -176: VTAB 24: HTAB 37: PRINT IC;: GOTO 3050
  82. 3055  IF FL  THEN  XDRAW 1 AT XC,YC:FL = 0
  83. 3056  IF K = 155  THEN 4100
  84. 3057  IF K = 141  THEN 4000
  85. 3060  IF K = 136  OR K = 202  OR K = 234  THEN XC = XC -IC: IF XC >190  THEN XC = 190
  86. 3070  IF K = 149  OR K = 203  OR K = 235  THEN XC = XC +IC: IF XC >190  AND XC <279  THEN XC = 279
  87. 3080  IF K = 139  OR K = 201  OR K = 233  OR K = 193  OR K = 225  THEN YC = YC -IC: IF YC >138  THEN YC = 138
  88. 3090  IF K = 138  OR K = 205  OR K = 237  OR K = 218  OR K = 250  THEN YC = YC +IC: IF YC >138  AND YC <191  THEN YC = 191
  89. 3091  IF XC <0  THEN XC = 279
  90. 3092  IF YC <0  THEN YC = 191
  91. 3093  IF XC >279  THEN XC = XC -280
  92. 3094  IF YC >191  THEN YC = YC -192
  93. 3100  GOTO 3050
  94. 4000  POKE 0,YC +1: POKE 1,(XC +1)/7: POKE 2,XC +1 -7 * PEEK(1)
  95. 4001  IF YC = 191  THEN  POKE 0,0
  96. 4002  IF XC = 279  THEN  POKE 1,0: POKE 2,0
  97. 4003  CALL 3840
  98. 4010  POKE 49234,0: POKE 230,64: CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1): POKE 49237,0: INVERSE 
  99. 4020  GOTO 200
  100. 4100  POKE 49234,0: POKE 230,64: CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1): POKE 49237,0: INVERSE : GOTO 200
  101. 7999  REM Menu
  102. 8000 :
  103. 8005  FOR I = 1 TO NF: PRINT " "UN$(I): NEXT 
  104. 8020  VTAB CS +MV: HTAB 1: NORMAL : PRINT " "UN$(CS)" ";: IF BP  THEN CS = 1:BP = 0: INVERSE : RETURN 
  105. 8030  POKE  -16368,0: GET K$: POKE  -16368,0
  106. 8040  VTAB CS +MV: HTAB 1: INVERSE : PRINT " "UN$(CS)" ";
  107. 8050  IF K$ =  CHR$(27)  THEN CS = 0: GOTO 8990
  108. 8060  IF (K$ =  CHR$(8)  OR K$ =  CHR$(11))  AND CS >1  THEN CS = CS -1: GOTO 8020
  109. 8070  IF (K$ =  CHR$(8)  OR K$ =  CHR$(11))  AND CS = 1  THEN CS = NF: GOTO 8020
  110. 8080  IF (K$ =  CHR$(10)  OR K$ =  CHR$(21))  AND CS <NF  THEN CS = CS +1: GOTO 8020
  111. 8090  IF (K$ =  CHR$(10)  OR K$ =  CHR$(21))  AND CS = NF  THEN CS = 1: GOTO 8020
  112. 8100  IF K$ =  CHR$(13)  THEN 8990
  113. 8120 P = 96:D = 20: GOSUB 30010: GOTO 8020
  114. 8990  IF CS >0  THEN  FOR I = 1 TO 1: VTAB CS +MV: HTAB 1: POKE 50,255 -192 *( PEEK(50) = 255): PRINT " "UN$(CS)" ";: FOR J = 1 TO WA: NEXT J: NEXT I: INVERSE 
  115. 8991  RETURN 
  116. 9990  REM <CTRL-0x0a>SET PREFIX BY PATH
  117. 9999  REM <CTRL-0x0a>ADD, DELETE, EDIT, MENU TITLE
  118. 10000 :
  119. 10010 K$ = ""
  120. 10020  CALL GIMME,DIAL: CALL BOX,6,21,30,4
  121. 10030  POKE  -16368,0
  122. 10040  CALL GIMME,INPT: CALL BOX,6,4,30,17
  123. 10050  PRINT "One moment..."
  124. 10060  ONERR  GOTO 60000
  125. 10070  PRINT  CHR$(4)"PREFIX": INPUT PF$
  126. 10080  IF DL  THEN CP$ = PF$: GOTO 10330
  127. 10090  CALL 3843:DC = 0: FOR I = 0 TO 15:L =  PEEK(512 +16 *I):SB$(DC +1) = "{} /": IF L  THEN DC = DC +1: FOR J = 1 TO L:SB$(DC) = SB$(DC) + CHR$( PEEK(512 +16 *I +J)): NEXT 
  128. 10100  NEXT :CP$ = "": GOTO 10520
  129. 10330  ONERR  GOTO 10980
  130. 10340  PRINT  CHR$(4)"PREFIX"CP$
  131. 10350 DC = 0
  132. 10360  PRINT  CHR$(12);: PRINT "Reading": PRINT CP$"..."
  133. 10370  PRINT  CHR$(4)"OPEN "CP$",TDIR"
  134. 10380  PRINT  CHR$(4)"READ "CP$
  135. 10390  INPUT K$: INPUT K$: INPUT K$
  136. 10400  INPUT K$: IF   NOT  LEN(K$)  OR DC = 128  THEN 10470
  137. 10410 TYP$ =  MID$ (K$,18,3):LN =  VAL( MID$ (K$,64,8)): IF   NOT FP  THEN 10415
  138. 10411  IF TYP$ < >"BIN"  AND TYP$ < >"DIR"  THEN 10400
  139. 10412 A$ = "~B ": IF TYP$ = "BIN"  AND  MID$ (K$,22,7) < >"     17"  THEN 10400
  140. 10413  IF TYP$ = "BIN"  AND FP = 2  THEN 10400
  141. 10414  GOTO 10420
  142. 10415  IF TYP$ < >"DIR"  AND TYP$ < >"BIN"  AND TYP$ < >"$F5"  THEN 10400
  143. 10419 A$ = "~" + LEFT$(TYP$,1) +" "
  144. 10420  IF TYP$ = "DIR"  THEN A$ = "{} "
  145. 10440 K$ = A$ + MID$ (K$,2,15)
  146. 10450  IF  RIGHT$(K$,1) = " "  THEN K$ =  LEFT$(K$, LEN(K$) -1): GOTO 10450
  147. 10451  IF   NOT FP  OR TYP$ = "DIR"  THEN 10460
  148. 10452  IF  LEN(K$) <5  THEN 10400
  149. 10453  IF  RIGHT$(K$,4) < >".PRT"  THEN 10460
  150. 10460 DC = DC +1:SB$(DC) = K$: GOTO 10400
  151. 10470  PRINT  CHR$(4)"CLOSE"
  152. 10480  IF   NOT DC  AND FP < >2  THEN 10950
  153. 10520  CALL GIMME,DIAL: CALL BOX,6,21,30,4
  154. 10530 :
  155. 10540  HOME : PRINT "RTN:Open   MOVE:[ ]   D:Disk": PRINT "ESC:Close             M:Menu";
  156. 10545  IF FP = 2  THEN  HTAB 13: PRINT "S:Save";
  157. 10550  CALL GIMME,INPT: CALL BOX,6,4,30,17: POKE  -16368,0
  158. 10560  VTAB 17: HTAB 1: PRINT "Prefix:"CP$;
  159. 10570 TP = 0:BT = 7
  160. 10580 CS = 1
  161. 10590  IF BT >DC -1  THEN BT = DC -1
  162. 10600  POKE 35, PEEK(35) -3: PRINT  CHR$(12);: POKE 35, PEEK(35) +3
  163. 10605  VTAB 5: PRINT "Choose a ";:K$ = "file": IF FP  THEN K$ = "picture": IF FP = 2  THEN K$ = "save destination  for " +PR$
  164. 10606  PRINT K$"..."
  165. 10607  IF   NOT DC  THEN 10640
  166. 10610  FOR I = 1 TO BT -TP +1: VTAB I +7: HTAB 3
  167. 10620  PRINT " "SB$(I +TP)" "
  168. 10630  NEXT I
  169. 10640  VTAB 7: HTAB 3: PRINT "-------------------": VTAB 16: HTAB 3: PRINT "-------------------"
  170. 10650  IF TP >0  THEN  VTAB 7: HTAB 3: PRINT "^-------MORE------^"
  171. 10660  IF BT <DC -1  THEN  VTAB 16: HTAB 3: PRINT "`-------MORE------`"
  172. 10670  REM  Missing line
  173. 10675  IF   NOT DC  THEN 10690
  174. 10680  VTAB CS +7: HTAB 3: NORMAL : PRINT " "SB$(CS +TP)" "
  175. 10690  GOSUB 40010: IF   NOT DC  THEN 10700
  176. 10695  INVERSE : VTAB CS +7: HTAB 3: PRINT " "SB$(CS +TP)" "
  177. 10700  IF (K$ =  CHR$(11)  OR K$ =  CHR$(8))  AND CS = 1  AND TP >0  THEN TP = TP -8:BT = TP +7:CS = 8: GOTO 10600
  178. 10710  IF (K$ =  CHR$(11)  OR K$ =  CHR$(8))  THEN  IF CS >1  THEN CS = CS -1: GOTO 10670
  179. 10720  IF (K$ =  CHR$(10)  OR K$ =  CHR$(21))  AND CS = BT -TP +1  AND BT <DC -1  THEN TP = TP +8:BT = BT +8: GOTO 10580
  180. 10730  IF (K$ =  CHR$(10)  OR K$ =  CHR$(21))  THEN  IF CS <BT -TP +1  THEN CS = CS +1: GOTO 10670
  181. 10740  IF K$ =  CHR$(27)  AND DL = 0  THEN CP$ = "": GOTO 2030
  182. 10750  IF K$ =  CHR$(27)  THEN  GOSUB 10900: ON DL >0 GOTO 10330: GOTO 10000
  183. 10760  IF K$ =  CHR$(13)  THEN 10830
  184. 10765  IF K$ = "M"  OR K$ = "m"  THEN 2060
  185. 10766  IF K$ = "d"  OR K$ = "D"  THEN DL = 0: GOTO 10060
  186. 10767  IF (K$ = "s"  OR K$ = "S")  AND FP = 2  AND DL  THEN 1300
  187. 10770 P = 144:D = 20: GOSUB 30000: GOTO 10670
  188. 10820  REM <CTRL-0x01>add dir to path
  189. 10830  IF DC = 0  AND FP = 2  THEN 10770
  190. 10835  IF  LEFT$(SB$(CS +TP),1) = "~"  THEN K$ =  MID$ (SB$(CS +TP),4): GOTO 2030
  191. 10840  IF   NOT  LEN(CP$)  THEN 10860
  192. 10850  IF  RIGHT$(CP$,1) < >"/"  THEN CP$ = CP$ +"/"
  193. 10860 CP$ = CP$ + MID$ (SB$(CS +TP),4): IF  RIGHT$(CP$,1) < >"/"  THEN CP$ = CP$ +"/"
  194. 10870 DL = DL +1
  195. 10880  GOTO 10330
  196. 10890  REM  Remove dir from path
  197. 10900  IF DL = 0  THEN  RETURN 
  198. 10910 CP$ =  LEFT$(CP$, LEN(CP$) -1)
  199. 10920  IF  RIGHT$(CP$,1) < >"/"  AND  LEN(CP$) >2  THEN CP$ =  LEFT$(CP$, LEN(CP$) -1): GOTO 10920
  200. 10930 DL = DL -1: RETURN 
  201. 10940  REM  Back out
  202. 10950 :
  203. 10955  CALL BOX,7,6,28,13: PRINT "No picture files": PRINT "in "CP$".": PRINT "Backing out one level.": PRINT : PRINT "Press a key.": GOSUB 40010
  204. 10960  IF DL = 1  THEN  GOSUB 10900: GOTO 10000
  205. 10970  GOSUB 10900: CALL BOX,6,4,30,17: GOTO 10330
  206. 10980  IF  PEEK(222) = 6  THEN  POKE 216,0:DL = 0: GOTO 10000
  207. 10981  IF  PEEK(222) = 5  THEN  PRINT D$"close": GOTO 10950
  208. 10990  GOTO 60000
  209. 20000 :
  210. 20010  VTAB V: HTAB H
  211. 20020  PRINT IN$;
  212. 20030  PRINT " " CHR$(8);
  213. 20040  IF  PEEK(49152) <128  THEN  PRINT "_" CHR$(8);: GOTO 20030
  214. 20050  GET T$
  215. 20060  IF T$ =  CHR$(24)  THEN  IF  LEN(IN$)  THEN  HTAB H: PRINT  SPC(  LEN(IN$) +1):IN$ = "": GOTO 20010
  216. 20070  IF T$ =  CHR$(127)  THEN T$ =  CHR$(8)
  217. 20080  IF T$ =  CHR$(27)  THEN  HTAB H: PRINT  SPC(  LEN(IN$) +1): HTAB H: PRINT :IN$ = "": GOTO 20150
  218. 20090  IF T$ =  CHR$(8)  THEN  IF  LEN(IN$) = 1  THEN IN$ = "": PRINT " " CHR$(8) CHR$(8);: GOTO 20030
  219. 20100  IF T$ =  CHR$(8)  THEN  IF  LEN(IN$)  THEN IN$ =  LEFT$(IN$, LEN(IN$) -1): PRINT " " CHR$(8) CHR$(8);: GOTO 20030
  220. 20110  IF T$ =  CHR$(13)  THEN  PRINT : GOTO 20150
  221. 20115  IF (T$ <"0"  OR T$ >"9")  AND IN >0  THEN 20130
  222. 20120  IF T$ > = " "  THEN  IF  LEN(IN$) <IW  THEN IN$ = IN$ +T$: PRINT T$;: GOTO 20140
  223. 20130 P = 96:D = 20: GOSUB 30000
  224. 20140  GOTO 20030
  225. 20150 CS = 1 -(IN$ = ""): RETURN 
  226. 30000 :
  227. 30010  CALL  PEEK(121) + PEEK(122) *256 +32,P,D: REM   GET  COS g EXP R CHR$ ONERR P PLOT  TAN GET   GET  COS g EXP R CHR$ ONERR P PLOT  ATN GET  PLOT 0 TAB(  GR  MID$  MID$  = <CTRL-0x05>  OR  ATN GET <UNKNOWN TOKEN><CTRL-0x13> * = <CTRL-0x05> RESTORE  TAN GET  = <UNKNOWN TOKEN> RIGHT$<CTRL-0x01> =  MID$  IF  TAN GET  =  PEEK````
  228. 30020  RETURN 
  229. 40000  CALL GIMME,DIAL: CALL BOX,6,21,30,4: PRINT "Please press a key."
  230. 40010  POKE  -16368,0: GET K$: POKE  -16368,0: RETURN 
  231. 50000 P = 144:D = 30: GOSUB 30000: CALL BOX,10,7,22,5: PRINT : PRINT "Do you want to quit?"
  232. 50010  GET A$: IF A$ = "n"  OR A$ = "N"  THEN 200
  233. 50015  IF A$ < >"Y"  AND A$ < >"y"  THEN 50010
  234. 50020  PRINT  CHR$(20);: NORMAL : HOME : POKE 104,8: PRINT  CHR$(4)"PR#0": TEXT : HOME : GOTO 150
  235. 60000 E =  PEEK(222): POKE 216,0: CALL GIMME,SHAD: CALL BOX,1,1,40,24: PRINT "Error:"E: PRINT "Line Number:" PEEK(218) + PEEK(219) *256
  236. 60010  PRINT : IF E = 255  THEN  PRINT "Someone pressed Control-C!"
  237. 60020  PRINT : PRINT "Press a key to restart."
  238. 60030  GOSUB 40000
  239. 60040  PRINT D$"prefix"OP$: GOTO 10