home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1988 January / 64er_Magazin_88-01_1988_Markt__Technik_de_Side_A.d64 / maske (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  9KB  |  289 lines
  1. 10 rem  *******************************
  2. 15 rem  *  bildschirmmaskengenerator  *
  3. 20 rem  *      mit intelligenten      *
  4. 25 rem  *  optimierungseigenschaften  *
  5. 30 rem  *    und groesstmoeglicher    *
  6. 35 rem  *   speicherplatz-ersparnis   *
  7. 40 rem  *         version 2.0         *
  8. 45 rem  * written 3/86 by roman bartke*
  9. 50 rem  *     max-von-laue-str.29     *
  10. 55 rem  *      5630 remscheid 11      *
  11. 60 rem  *      tel. 02191/63753       *
  12. 65 rem  *                             *
  13. 70 rem  *z.150 einz. v.k.smoczyk 12/85*
  14. 75 rem  *******************************
  15. 80 :
  16. 85 :
  17. 90 poke55,255:poke56,127:clr:rem basicram-ende nach 32768
  18. 95 goto755
  19. 100 rem pass 1
  20. 105 poke837,peek(53272):poke53281,g:poke53280,bo
  21. 110 clr:fori=704to704+63:readq:next
  22. 115 dimc$(15):fori=0to15:readc$:c$(i)=c$:next
  23. 120 za=24:sa=39:r=0:f=16:s=0:m=49155
  24. 125 ifpeek(2023)=32or(peek(2023)=96andpeek(2)=1)thenpoke834,0:goto135
  25. 130 poke832,peek(2023):poke833,peek(56295)and15:poke834,1
  26. 135 forz=0toza:b=0:fors=0tosa
  27. 140 x=peek(40*z+s+1024):c=peek(40*z+s+55296)and15
  28. 145 poke55296+40*z+s,1:poke1024+40*z+s,asc("*")
  29. 150 xx=x+(x>127)*128:w=xx-(xx>-1andxx<32orxx>95)*64-(xx>63andxx<96)*32
  30. 155 ifpeek(2)=1andw=160thenw=32
  31. 160 ifr=0andx>127thenr=1:m=m+1:pokem,asc(""):b=1:goto170
  32. 165 ifr=1andx<127thenr=0:m=m+1:pokem,asc("[146]")
  33. 170 ifc=fthen190
  34. 175 if(w=32orw=160)andr=0then190
  35. 180 ifef=0thenpoke838,asc(c$(c)):ef=1:f=c:goto190:rem erste farbe
  36. 185 f=c:m=m+1:pokem,asc(c$(c))
  37. 190 m=m+1:pokem,w
  38. 195 ifw<>32orr=1thenb=1:rem falls leerzeile,dann flag fuer crsr-down
  39. 200 next
  40. 205 ifb=1then215
  41. 210 m=m-39:pokem,asc(""):goto230
  42. 215 m=m+1
  43. 220 if(w=32or(w=96andpeek(2)=1))andr=0thenpokem,13:goto230
  44. 225 pokem,141
  45. 230 ifz=24andb=1thenpoke839,1
  46. 235 next
  47. 240 poke49152,int(m/256):poke49153,m-peek(49152)*256
  48. 245 rem pass 2
  49. 250 clr
  50. 255 dimz$(51)
  51. 260 m=peek(49152)*256+peek(49153)
  52. 265 fori=49156tom
  53. 270 ifchr$(peek(i))=""thenr=1
  54. 275 ifchr$(peek(i))="[146]"thenr=0
  55. 280 ifpeek(i)=141then295
  56. 285 ifpeek(i)=13thengosub375:goto295
  57. 290 z$=z$+chr$(peek(i)):goto365
  58. 295 rem spc(x) einbauen (wenn mehr als 7 spaces)
  59. 300 l=0:s=0
  60. 305 l=l+1:ifmid$(z$,l,1)=chr$(32)andr=0thens=s+1:goto305
  61. 310 ifs<8then320
  62. 315 z$=chr$(153)+chr$(166)+right$(str$(s),len(str$(s))-1)+")"+chr$(34)+right$(z$,len(z$)-s)
  63. 320 iflen(z$)<=65then345
  64. 325 j=j+1:z$(j)=left$(z$,65)+chr$(34)+";"
  65. 330 j=j+1:z$(j)=right$(z$,len(z$)-65)
  66. 335 ifpeek(i)=141thenz$(j)=z$(j)+chr$(34)+";"
  67. 340 goto360
  68. 345 j=j+1
  69. 350 ifh=1thenh=0:z$(j)=z$:goto360
  70. 355 ifh=0thenz$(j)=z$+chr$(34)+";"
  71. 360 z$="":z=0
  72. 365 next:goto410
  73. 370 rem hintere spaces beseitigen
  74. 375 ifr=1orright$(z$,1)<>" "thenreturn
  75. 380 d=len(z$)
  76. 385 d=d-1
  77. 390 ifmid$(z$,d,1)=chr$(32)then385
  78. 395 z$=left$(z$,d)
  79. 400 h=1:return
  80. 405 :
  81. 410 rem for-next einbauen (ab 3 gleichen zeilen)
  82. 415 dimzz$(55):e=1:z=1:rem 55=j+4 maximale zeilenanzahl
  83. 420 a=e:e=a+1:ife>j+1then510
  84. 425 ifz$(a)=z$(e)thene=e+1:goto425
  85. 430 rem a,e-a,z$(a) stehen hier bereit
  86. 435 ifleft$(z$(a),2)=chr$(153)+chr$(166)thensp=1:goto445
  87. 440 sp=0
  88. 445 if(e-a)<>1then460
  89. 450 z=z+1:ifsp=0thenzz$(z)=chr$(153)+chr$(34)
  90. 455 zz$(z)=zz$(z)+z$(a):goto420
  91. 460 if(e-a)<>2then485
  92. 465 z=z+2:ifsp=0thenzz$(z-1)=chr$(153)+chr$(34)
  93. 470 zz$(z-1)=zz$(z-1)+z$(a)
  94. 475 ifsp=0thenzz$(z)=chr$(153)+chr$(34)
  95. 480 zz$(z)=zz$(z)+z$(a+1):goto420
  96. 485 z=z+3:zz$(z-2)=chr$(129)+"i"+chr$(178)+"1"+chr$(164)
  97. 490 zz$(z-2)=zz$(z-2)+right$(str$(e-a),len(str$(e-a))-1)
  98. 495 ifsp=0thenzz$(z-1)=chr$(153)+chr$(34)
  99. 500 zz$(z-1)=zz$(z-1)+z$(a):zz$(z)=chr$(130)
  100. 505 goto420
  101. 510 rem erste zeile generieren
  102. 515 ez$=chr$(151)+"53281,"+right$(str$(peek(49154)),len(str$(peek(49154)))-1)
  103. 520 ez$=ez$+":"+chr$(151)+"53280,"
  104. 525 ez$=ez$+right$(str$(peek(49155)),len(str$(peek(49155)))-1)
  105. 530 ez$=ez$+":"+chr$(151)+"53272,"+right$(str$(peek(837)),len(str$(peek(837)))-1)
  106. 535 ez$=ez$+":"+chr$(153)+chr$(34)+"[147]"+chr$(peek(838))+chr$(34)+";"
  107. 540 zz$(1)=ez$:ez$=""
  108. 545 rem generierung der letzten zeile
  109. 550 ifpeek(839)=1andpeek(834)=0andzz$(z)<>chr$(130)thenzz$(z)=zz$(z)+"":goto650
  110. 555 rem schleife geht nicht bis zur letzten zeile
  111. 560 ifzz$(z)=chr$(130)andpeek(834)=0thengosub590:zz$(z)=zz$(z)+"":goto650
  112. 565 rem letztes zeichen poken, falls das zeichen nicht space ist
  113. 570 ifpeek(834)=0then650
  114. 575 ifzz$(z)<>chr$(130)then625
  115. 580 gosub590:goto625
  116. 585 rem for-next schleife um 1 erniedrigen
  117. 590 z$=zz$(z-2):ifval(right$(z$,2))=0thenan=1:goto600
  118. 595 an=2
  119. 600 z1$=left$(z$,len(z$)-an)
  120. 605 z$=str$(val(right$(z$,an))-1):za$=right$(z$,len(z$)-1):zz$(z-2)=z1$+za$
  121. 610 ifan=1andza$="2"thenzz$(z-2)=zz$(z-1):zz$(z)=zz$(z-1):goto620
  122. 615 z=z+1:zz$(z)=zz$(z-2)
  123. 620 return
  124. 625 zz$(z)=left$(zz$(z),len(zz$(z))-3)+""+right$(zz$(z),2)
  125. 630 z=z+1:zz$(z)=chr$(151)+"2023,"+right$(str$(peek(832)),len(str$(peek(832)))-1)
  126. 635 zz$(z)=zz$(z)+":"+chr$(151)+"56295,"
  127. 640 zz$(z)=zz$(z)+right$(str$(peek(833)),len(str$(peek(833)))-1)
  128. 645 rem maske als programm
  129. 650 print"[147][155]";:poke53281,11:poke53280,11:poke53272,21
  130. 655 print"startzeile   ?"
  131. 660 print"schrittweite ?[157][145][145]";:inputsz$:print""spc(16);:inputsw$
  132. 665 sz=val(sz$):sw=val(sw$)
  133. 670 if(sz+z>63999)or(z*sw+sz-1>63999)orsw<1then655
  134. 675 ez=sz+z*sw-1:v=0:ka=32768
  135. 680 forzn=sztoezstepsw:v=v+1
  136. 685 k=ka+len(zz$(v))+6
  137. 690 ka=ka+1:pokeka,k-int(k/256)*256:ka=ka+1:pokeka,int(k/256)
  138. 695 ka=ka+1:pokeka,zn-int(zn/256)*256:ka=ka+1:pokeka,int(zn/256)
  139. 700 fori=1tolen(zz$(v)):ka=ka+1:pokeka,asc(mid$(zz$(v),i,1)):next
  140. 705 ka=ka+1:pokeka,0:next
  141. 710 ka=ka+2:pokeka-1,0:pokeka,0
  142. 715 rem von 2049 auf 32769 umschalten
  143. 720 ka=ka+1:poke835,ka-int(ka/256)*256:poke836,int(ka/256)
  144. 725 print"[147]p[207]32768,0:p[207]43,1:p[207]44,128:p[207]45,p[197](835):poke46,p[197](836):p[207]55,0:p[207]56,160
  145. 730 [153]"clr
  146. 735 print"list"
  147. 740 poke631,19:poke632,13:poke633,13:poke634,13:poke198,4:end
  148. 745 :
  149. 750 :
  150. 755 rem *** bmg/editor ***
  151. 760 gosub1300
  152. 765 xd=16:yd=44:x1=0:y1=0
  153. 770 x=xd:y=yd:k=0:pokev+1,y:z=(x>255):pokev,x+(z*256):poke53264,z*(-1)
  154. 775 pokev+2,0:pokev+3,0:pokev+21,3
  155. 780 geta$:ifa$=""then780
  156. 785 a=1*(a$="")+2*(a$="[145]")+3*(a$="")+4*(a$="[157]")+5*(a$="")+6*(a$="[147]"):a=a*-1
  157. 790 ifa=1theny=y+8:ify>236theny=236:goto880
  158. 795 ifa=2theny=y-8:ify<44theny=44:goto880
  159. 800 ifa=3andx=328andy=236then880
  160. 805 ifa=3thenx=x+8:ifx>328thenx=16:a=1:goto790
  161. 810 ifa=4andx=16andy=44then880
  162. 815 ifa=4thenx=x-8:ifx<16thenx=328:a=2:goto795
  163. 820 ifa=5andk=0thenprint"";:goto765
  164. 825 ifa=6andk=0thenprint"[147]";:goto765
  165. 830 ifa=0andk=0then930
  166. 835 goto880
  167. 840 rem zeichen schreiben
  168. 845 ifa$=chr$(13)then880
  169. 850 ifa$=chr$(34)then780
  170. 855 a=asc(a$):b=a-161-33*(a<255)-64*(a<192)-32*(a<160)+32*(a<96)-64*(a<64)
  171. 860 ifrv=1thenb=b+128
  172. 865 poke1024+y1*40+x1,b
  173. 870 poke55296+y1*40+x1,peek(v+39):a=3:goto800
  174. 875 rem sprites koordinieren
  175. 880 ifk=1then905
  176. 885 z=(x>255):pokev,x+(z*256):poke53264,z*(-1):pokev+1,y
  177. 890 x1=(x-16)/8:y1=(y-44)/8
  178. 895 ifln=1thenk=1
  179. 900 goto780
  180. 905 z=(x>255):pokev+2,x+(z*256):poke53264,peek(53264)and1or(z*(-2)):pokev+3,y
  181. 910 ifa$=chr$(13)thenx2=(x-16)/8:y2=(y-44)/8:ifx1<>x2andy1<>y2then780
  182. 915 ifa$=chr$(13)andln=1then1155
  183. 920 goto780
  184. 925 rem zusatzfunktionen
  185. 930 a=1*(a$="")+2*(a$="[146]")+3*(a$="")+4*(a$="")+5*(a$="")
  186. 935 a=a+6*(a$="[133]")+7*(a$="[134]")+8*(a$="[135]")+9*(a$="[136]")+10*(a$=chr$(148))
  187. 940 a=a+11*(a$=chr$(20))+12*(a$="")+13*(a$=""):a=a*-1:ifa=0then990
  188. 945 rem gong
  189. 950 poke54296,15:poke54277,0:poke54278,247:poke54276,17:poke54273,20
  190. 955 poke54272,0:fori=1to100:next:poke54276,16
  191. 960 ifa=11thengosub1260:a=4:goto810
  192. 965 ifa=12then1150
  193. 970 ifa=13then1285
  194. 975 onagosub1015,1020,1110,1125,1030,1195,1210,1220,1225,1235
  195. 980 goto780
  196. 985 rem cursorfarben
  197. 990 a=1*(a$="[144]")+2*(a$="")+3*(a$="")+4*(a$="[159]")+5*(a$="[156]")+6*(a$="")
  198. 995 a=a+7*(a$="")+8*(a$="[158]")+9*(a$="[129]")+10*(a$="[149]")+11*(a$="[150]")+12*(a$="[151]")
  199. 1000 a=a+13*(a$="[152]")+14*(a$="[153]")+15*(a$="[154]")+16*(a$="[155]"):a=a*-1
  200. 1005 ifa=0then845
  201. 1010 printco$(a);:pokev+39,a-1:pokev+40,a-1:goto780
  202. 1015 rv=1:return:rem rvs/on
  203. 1020 rv=0:return:rem rvs/off
  204. 1025 rem zeile zentrieren
  205. 1030 ze$="":z=y1:i=0:c1=0:c2=0:zz=0
  206. 1035 ifi<40thench=peek(1024+z*40+i):ifch=32orch=96thenc1=c1+1:i=i+1:goto1035
  207. 1040 i=39
  208. 1045 ifi>-1thench=peek(1024+z*40+i):ifch=32orch=96thenc2=c2+1:i=i-1:goto1045
  209. 1050 ifc1=c2then780
  210. 1055 fori=c1to40-c2:ze$=ze$+chr$(peek(1024+z*40+i))+chr$(peek(55296+z*40+i)):next
  211. 1060 ifc1>c2then1085
  212. 1065 c=(c2-c1)/2
  213. 1070 gosub1110
  214. 1075 fori=c1+cto40-c2+c:zz=zz+2:poke1024+z*40+i,asc(mid$(ze$,zz-1,1))
  215. 1080 poke55296+z*40+i,asc(mid$(ze$,zz,1)):next:goto1105
  216. 1085 c=(c1-c2)/2
  217. 1090 gosub1110
  218. 1095 zz=0:fori=c1-cto40-c2-c:zz=zz+2:poke1024+z*40+i,asc(mid$(ze$,zz-1,1))
  219. 1100 poke55296+z*40+i,asc(mid$(ze$,zz,1)):next
  220. 1105 return
  221. 1110 rem zeile loeschen
  222. 1115 print"";left$(d$,y1);s$;"":poke1024+y1*40+39,32
  223. 1120 return
  224. 1125 rem spalte loeschen
  225. 1130 ifx1=39thenfori=0to24:poke1024+i*40+39,32:next:goto1140
  226. 1135 print"";spc(x1);:fori=1to24:print" [157]";:next:print"";:poke1024+24*40+x1,32
  227. 1140 return
  228. 1145 rem linie zeichnen
  229. 1150 ln=1:goto885
  230. 1155 xd=x2*8+16:yd=y2*8+44:xn=x2:yn=y2
  231. 1160 z=peek(1024+x1+40*y1):c=peek(55296+x1+40*y1)
  232. 1165 ifx1>x2thenx=x1:x1=x2:x2=x:goto1175
  233. 1170 ify2>y1theny=y1:y1=y2:y2=y
  234. 1175 ify1=y2thenfori=x1tox2:poke1024+40*y1+i,z:poke55296+40*y1+i,c:next:goto1185
  235. 1180 fori=y2toy1:poke55296+40*i+x1,c:poke1024+40*i+x1,z:next
  236. 1185 x1=xn:y1=yn:ln=0:k=0:goto770
  237. 1190 rem ground+1
  238. 1195 g=peek(53281)and15:ifg<15theng=g+1:poke53281,g:return
  239. 1200 ifg=15theng=0:poke53281,g:return
  240. 1205 rem border+1
  241. 1210 bo=peek(53280)and15:ifbo<15thenbo=bo+1:poke53280,bo:return
  242. 1215 ifbo=15thenbo=0:poke53280,bo:return
  243. 1220 poke650,255:return:rem repeat/on
  244. 1225 poke650,0:return:rem repeat/off
  245. 1230 rem insert
  246. 1235 fori=39tox1step-1:poke55296+y1*40+i,peek(55296+y1*40+i-1)
  247. 1240 poke1024+y1*40+i,peek(1024+y1*40+i-1):next
  248. 1245 poke1024+y1*40+x1,32
  249. 1250 return
  250. 1255 rem delete
  251. 1260 fori=x1to39:poke55296+y1*40+i,peek(55296+y1*40+i+1)
  252. 1265 poke1024+y1*40+i,peek(1024+y1*40+i+1):next
  253. 1270 poke1024+y1*40+39,32
  254. 1275 return
  255. 1280 rem editor-ende
  256. 1285 fori=15to0step-1:poke53281,i:poke53280,i:next:poke49154,g:poke49155,bo
  257. 1290 poke53281,g:poke53280,bo
  258. 1295 pokev+21,0:goto105
  259. 1300 rem init/sprite-init
  260. 1305 gosub1365
  261. 1310 d$=""
  262. 1315 s$="                                       "
  263. 1320 fori=832to839:pokei,0:next
  264. 1325 dimco$(16):co$="[144][159][156][158][129][149][150][151][152][153][154][155]":fori=1tolen(co$):co$(i)=mid$(co$,i,1):next
  265. 1330 fori=704to704+63:readq:pokei,q:next:poke2040,11:poke2041,11
  266. 1335 v=53248:pokev+39,15:pokev+40,15
  267. 1340 return
  268. 1345 data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,255,128,1,0,128,1,0,128,1,0,128
  269. 1350 data 1,0,128,1,0,128,1,0,128,1,0,128,1,0,128,1,255,128,0,0,0,0,0,0,0
  270. 1355 data 0,0,0,0,0,0,0,0,0,0,0,0
  271. 1360 data"[144]","","","[159]","[156]","","","[158]","[129]","[149]","[150]","[151]","[152]","[153]","[154]","[155]"
  272. 1365 g=11:bo=g:poke53281,g:poke53280,bo
  273. 1370 print"[147]      [155]      [146]      [146]      [146]         [146]"
  274. 1375 print"       [144] [155] [144]   [155] [146]   [144]  [155] [146]  [144]  [155] [144] [146] [155] [144] [155] [144]   [155] [144] [146]"
  275. 1380 print"      [155] [144] [155] [144] [146]  [155] [144] [146] [155] [144] [146]  [155] [144]  [146] [155] [144] [146] [155] [144] [155] [144] [146]    [146]"
  276. 1385 print"      [155]      [144]  [146] [155] [144] [155] [146] [144]  [155] [146]  [144] [146] [155] [144] [155] [144] [155]   [146]"
  277. 1390 print"       [144] [155] [144]   [155] [146]   [144] [155]  [146]   [144] [155] [144] [146] [155] [144] [155]   [144] [155] [144] [146]"
  278. 1395 print"      [155] [144] [155] [144] [146]  [155] [144] [146] [155] [144] [155] [144] [155] [144] [155] [144] [155] [144] [146] [155] [144]     [155] [144] [146]"
  279. 1400 print"      [155]      [144]  [146] [155]   [144] [146]  [155]   [144] [146] [155]       [144] [146]"
  280. 1405 print"             [146]      [146]      [146]         [146]"
  281. 1410 print"      b[155]ildschirm[158]-[144]m[155]asken[158]-[144]g[155]enerator
  282. 1415 n$[178][199](82)[170][199](79)[170][199](77)[170][199](65)[170][199](78)[170][199](32)[170][199](66)[170][199](65)
  283. 1420 n$[178]n$[170][199](82)[170][199](84)[170][199](75)[170][199](69)
  284. 1425 [153]"    syswritten 3/1986  by ";n$
  285. 1430 [151]2,0:[153]""[166]8)"listsollen 'shift/space' den"
  286. 1435 [153]"    'space'-zeichen gleich sein ? jcmdcmdcmd";:[133]a$
  287. 1440 [139]a$[179][177]"n"[167][151]2,1
  288. 1445 [142]
  289.