home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 9 / 009.d81 / spritecat (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  5KB  |  188 lines
  1. 100 rem spritecat
  2. 110 rem andy gamble  sept 1984
  3. 130 cu$="[157][157][157][157][157][157][157][157][157][157][157][157][157]"
  4. 140 bl$="                                        "
  5. 150 cl$="[204]  [205]  [216]  [217]  [206]  [196]  [211]  [195]  [209]  [197]  [208]  [200]elp   "
  6. 160 me$="lmxyndscqhep":mm$="bc01mr":poke53272,23
  7. 170 dimsd(63):vc=53248:col=1:bc=0:m0=2:m1=5
  8. 180 fori=1to63:poke703+i,0:next
  9. 190 pokevc+32,9:pokevc+33,bc:printchr$(129)
  10. 200 poke2040,11:pokevc+39,col:pokevc+21,1:pokevc,70:pokevc+1,140
  11. 210 printchr$(147)cl$:gosub390
  12. 220 rem *** main program ***
  13. 230 gosub1900
  14. 240 fori=1tolen(me$):ifx$=mid$(me$,i,1)then270
  15. 250 ifx$=chr$(asc(mid$(me$,i,1))+128)then270
  16. 260 next:goto230
  17. 270 onigosub300,480,760,790,820,1070,1210,1340,1370,1390,1540,1790
  18. 280 goto230
  19. 290 rem *** load sprite ***
  20. 300 print"[147]"bl$"[198]ile name";
  21. 310 inputfl$
  22. 315 iffl$=""thenprint""bl$:gosub390:return
  23. 320 fori=len(fl$)to1step-1:ifmid$(fl$,i,1)=" "thenfl$=left$(fl$,i-1):next
  24. 330 open15,8,15:open1,8,4,fl$+",s,4"
  25. 340 input#15,a$,b$,c$,d$:ifval(a$)=0then380
  26. 350 print""bl$""b$": ";:gosub1920
  27. 360 gosub1900
  28. 370 goto390
  29. 380 fori=1to63:input#1,sd(i):poke703+i,sd(i):next
  30. 390 pokevc+21,1:print""tab(23)"[196]ata"
  31. 400 fori=1to63step3
  32. 410 printtab(20);
  33. 420 forj=0to1
  34. 430 printsd(i+j)",";:next
  35. 440 printsd(i+2)
  36. 450 next
  37. 460 print""cl$:close15:close1:return
  38. 470 rem *** multi-color ***
  39. 480 print"[147]"bl$"[205]ulticolor:[194]   [195]   0   1   [205]   [210]"
  40. 490 print""tab(15)"[194] = [194]ackground color"
  41. 500 print""tab(15)"[195] = [211]prite color"
  42. 510 print""tab(15)"0 = [205]ulitcolor #0"
  43. 520 print""tab(15)"1 = [205]ulitcolor #1"
  44. 530 print""tab(15)"[205] = [205]ulticolor on/off"
  45. 540 print""tab(15)"[210] = [210]eturn to main menu"
  46. 550 gosub1900
  47. 560 fori=1tolen(mm$)
  48. 570 ifx$=mid$(mm$,i,1)then600
  49. 580 ifx$=chr$(asc(mid$(mm$,i,1))+128)then600
  50. 590 next:goto550
  51. 600 onigosub640,1340,670,700,730
  52. 610 ifi=6thenprint"[147]"bl$:gosub390:return
  53. 620 goto550
  54. 630 rem ** background color **
  55. 640 bc=bc+1:ifbc=16thenbc=0
  56. 650 pokevc+33,bc:return
  57. 660 rem ** multicolor #0 **
  58. 670 m0=m0+1:ifm0=16thenm0=0
  59. 680 pokevc+37,m0:return
  60. 690 rem ** multicolor #1 **
  61. 700 m1=m1+1:ifm1=16thenm1=0
  62. 710 pokevc+38,m1:return
  63. 720 rem ** multicolor on/off **
  64. 730 ifpeek(vc+28)=0thenpokevc+28,1:return
  65. 740 pokevc+28,0:return
  66. 750 rem ** x-expand **
  67. 760 ifpeek(vc+29)=0thenpokevc+29,1:return
  68. 770 pokevc+29,0:return
  69. 780 rem ** y-expand **
  70. 790 ifpeek(vc+23)=0thenpokevc+23,1:return
  71. 800 pokevc+23,0:return
  72. 810 rem ** enter data **
  73. 820 print""bl$"[197]nter digits only, ending with return"
  74. 830 print"";
  75. 840 fori=1to21:printtab(20)"                ":next
  76. 850 print""tab(23)"[196]ata":printtab(21);
  77. 860 fori=1to63step3
  78. 870 forj=0to2
  79. 880 sd$=""
  80. 890 print"[164][157]";
  81. 900 gosub1900:ls=len(sd$)
  82. 910 ifx$="*"thenprintleft$(cu$,ls)mid$(bl$,2,ls+1)left$(cu$,ls+1);:goto880
  83. 920 ifls=3thengoto950
  84. 930 ifx$>="0"andx$<="9"thensd$=sd$+x$:printx$; 
  85. 940 ifx$=chr$(13)andls=0thenprint"0";
  86. 950 ifx$=chr$(13)goto970
  87. 960 goto890
  88. 970 sd=val(sd$):ifsd<=255then1000
  89. 980 ls=len(sd$):printleft$(cu$,ls)mid$(bl$,2,ls+1)left$(cu$,ls+1);
  90. 990 goto880
  91. 1000 ifj<2thenprint" , ";:goto1020
  92. 1010 print" ";
  93. 1020 sd(i+j)=sd:poke703+i+j,sd
  94. 1030 nextj:print:printtab(21); 
  95. 1040 nexti
  96. 1050 print"[147]"cl$:gosub390:return
  97. 1060 rem ** diskif **
  98. 1070 print"[147]"bl$:printtab(5);:pokevc+21,0
  99. 1080 open1,8,0,"$0"
  100. 1090 get#1,a$,a$
  101. 1100 get#1,a$,a$ 
  102. 1110 ifa$=""then1170
  103. 1120 get#1,a$,b$
  104. 1130 printasc(a$+chr$(0))+asc(b$+chr$(0))*256;
  105. 1140 get#1,a$
  106. 1150 ifa$=""thenprint:printtab(5);:goto1100
  107. 1160 printa$;:goto1140
  108. 1170 close1:print""bl$"";:gosub1920
  109. 1180 gosub1900
  110. 1190 print"[147]"cl$:pokevc+21,1:gosub390:return 
  111. 1200 rem ** save sprite **
  112. 1210 print""bl$"[198]ile name";
  113. 1220 inputfl$
  114. 1230 fori=len(fl$)to1step-1:ifmid$(fl$,i,1)=" "thenfl$=left$(fl$,i-1):next
  115. 1240 open15,8,15:open1,8,4,fl$+",s,w"
  116. 1250 input#15,a$,b$,c$,d$:ifval(a$)=0then1290
  117. 1260 print""bl$""b$": ";:gosub1920
  118. 1270 gosub1900
  119. 1280 goto1320
  120. 1290 fori=1to63
  121. 1300 print#1,sd(i)
  122. 1310 next
  123. 1320 print""cl$:close15:close1::return
  124. 1330 rem ** color **
  125. 1340 col=col+1:ifcol=16thencol=0
  126. 1350 pokevc+39,col:return
  127. 1360 rem ** quit **
  128. 1370 print"[147]";:pokevc+21,0:poke53272,21:goto63000
  129. 1380 rem ** help **
  130. 1390 print"[147]"bl$"[200]elp: ";:gosub1920:pokevc+21,0
  131. 1400 print"[204][146] = [204]oad sprite from disk"
  132. 1410 print"[205][146] = [205]ulti-color mode"
  133. 1420 print"[216][146] = [197]xpand in x-direction"
  134. 1430 print"[217][146] = [197]xpand in y-direction"
  135. 1440 print"[206][146] = [197]nter new sprite data"
  136. 1450 print"[196][146] = [196]isk menu"
  137. 1460 print"[211][146] = [211]ave sprite to disk"
  138. 1470 print"[195][146] = [195]hange sprite color"
  139. 1480 print"[197][146] = [197]dit sprite data"
  140. 1490 print"[208][146] = [208]rint sprite"
  141. 1500 print"[209][146] = [209]uit program"
  142. 1510 gosub1900
  143. 1520 print"[147]"cl$:pokevc+21,1:gosub390:return
  144. 1530 rem ** edit **
  145. 1540 print""bl$" space to continue, return to select"
  146. 1550 print""tab(20);
  147. 1560 fori=1to63step3
  148. 1570 forj=0to2
  149. 1580 print""sd(i+j)left$(cu$,len(str$(sd(i+j)))+1);
  150. 1590 gosub1900:ifx$=" "thenprint"[146]"sd(i+j)"";:goto1750
  151. 1600 ifx$<>chr$(13)then1590
  152. 1610 print""bl$"[197]nter new data: ";
  153. 1620 sd$=""
  154. 1630 print"[164][157]";
  155. 1640 gosub1900:ls=len(sd$)
  156. 1650 ifx$="*"thenprintleft$(cu$,ls)mid$(bl$,2,ls+1)left$(cu$,ls+1);
  157. 1655 ifx$="*"goto1620
  158. 1660 ifls=3thengoto1680
  159. 1670 ifx$>="0"andx$<="9"thensd$=sd$+x$:printx$;
  160. 1680 ifx$=chr$(13)andls=0thenprint"0":goto1710
  161. 1690 ifx$=chr$(13)then1710
  162. 1700 goto1630
  163. 1710 sd=val(sd$)
  164. 1720 ifsd>255thenprint"[157][157][157][157]     [157][157][157][157]";:goto1620
  165. 1730 sd(i+j)=sd:poke703+i+j,sd
  166. 1740 print"[147]"cl$:gosub390:return
  167. 1750 nextj:print:printtab(20);
  168. 1760 nexti
  169. 1770 print""cl$:return
  170. 1780 rem ** print **
  171. 1790 print""bl$"[208]rinting...":open4,4
  172. 1800 print#4,fl$:print#4
  173. 1810 fori=1to61step3
  174. 1820 forj=0to2:bi=128:bi$="":sd=sd(i+j)
  175. 1830 ifsd<bithenbi$=bi$+" ":bi=bi/2:goto1850
  176. 1840 bi$=bi$+"[209]":sd=sd-bi:bi=bi/2
  177. 1850 ifbi>=1then1830
  178. 1860 print#4,bi$;:next:print#4,sd(i)sd(i+1)sd(i+2)
  179. 1870 next
  180. 1880 close4:print""cl$:return
  181. 1890 rem ** get s/r **
  182. 1900 getx$:ifx$=""then1900
  183. 1910 return
  184. 1920 print"[208]ress space to continue":return
  185. 63000 print"[147]load"chr$(34)"c.payload"chr$(34)",8":print"run"
  186. 63001 poke832,0
  187. 63002 poke631,13:poke632,13:poke198,2:end
  188.