home *** CD-ROM | disk | FTP | other *** search
/ Commodore 64 Scene Diskmags Assortment / Public_3_1991_Stony_Soft_de_Side_B.d64 / p.dateiprogramm (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  10KB  |  252 lines
  1. 1 rem datei - programm
  2. 2 rem basic-software
  3. 3 rem **************
  4. 4 rem public domain software 1985
  5. 10 poke788,52:poke53265,11:poke53280,0:poke53281,0:printchr$(8)chr$(14)
  6. 11 data 169,6,141,32,208,32,244,207,169,0,141,32,208,32,244,207,238,255
  7. 12 data207,208,235,96,162,4,160,153,136,208,253,202,208,248,96
  8. 13 fori=53214to53246:readx:pokei,x:next
  9. 14 data32,250,174,32,158,173,32,143,173,165,100,133,247,165,101,133
  10. 15 data248,32,253,174,32,158,173,32,143,173,160,0,177,247,133,249
  11. 16 data177,100,145,247,165,249,145,100,200,192,3,208,239,32,247,174,96
  12. 17 fori=53100to53148:readx:pokei,x:next
  13. 18 data32,253,174,32,235,183,224,40,176,19,165,20,201,25,176,13,134,211,133
  14. 19 data214,32,16,229,32,253,174,76,160,170,76,72,178,32
  15. 20 fori=53150to53182:readx:pokei,x:next:goto100
  16. 33 pokef,l:sysc,7,3,z;z$:pokef,d:return
  17. 44 pokef,l:sysc,7,33,v;z$:pokef,d:return
  18. 100 c=53150:x=1:y=1:f=646:d=8:l=14:r=53214:b=53265:a%=1:v%=1:p%=1:f%=1:s%=1
  19. 110 g=1:a=1:e=1:z$="[157]  ":k$="                      "
  20. 120 h$="...........":fori=0to6:f$(i)=h$:next
  21. 130 g$="[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174][221]                      [221]"
  22. 140 i$="[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]":g$=g$+i$
  23. 150 n$="[145][145]                          "
  24. 160 i$="                        ":n$=n$+i$
  25. 170 i$="[221][145][157][176][192][192][192][192][192][192][192][192][192][192][192][192][174][157][221][157][157][157][157][157][157][157][157][157][157][157][157][157][157][173][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  26. 180 gl$=" [145][157]              [157] [157][157][157][157][157][157][157][157][157][157][157][157][157][157]              "
  27. 190 printfre(o):dimp$(410,6):gosub200:pokeb,27:sysr:goto570
  28. 200 pokef,d:print"[166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]";
  29. 210 print"[166]                                      [166]";
  30. 220 print"[166]         [196]atei    -    [208]rogramm       [166]";
  31. 230 print"[166]                                      [166]";
  32. 240 print"[166]           ";:pokef,l:print"                ";:pokef,d
  33. 250 print"           [166]";
  34. 260 print"[166][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][166]";
  35. 270 print"[166]        [166]                    [166]        [166]";
  36. 280 print"[166]        [166] [208]rogrammfunktionen [166]        [166]";
  37. 290 print"[166]        [166][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][166]        [166]";
  38. 300 print"[166]                                      [166]";
  39. 310 print"[166]        ";:pokef,l:print"-1-";:pokef,d
  40. 320 print"  [196]aten  '[204][207][193][196]'en          [166]";
  41. 330 print"[166]        ";:pokef,l:print"-2-";:pokef,d
  42. 340 print"  [196]aten  '[211][193][214][197]'n           [166]";
  43. 350 print"[166]        ";:pokef,l:print"-3-";:pokef,d
  44. 360 print"  [196]aten  eingeben          [166]";
  45. 370 print"[166]        ";:pokef,l:print"-4-";:pokef,d
  46. 380 print"  [196]aten  definieren        [166]";
  47. 390 print"[166]        ";:pokef,l:print"-5-";:pokef,d
  48. 400 print"  [196]aten  aendern           [166]";
  49. 410 print"[166]        ";:pokef,l:print"-6-";:pokef,d
  50. 420 print"  [196]aten  drucken           [166]";
  51. 430 print"[166]        ";:pokef,l:print"-7-";:pokef,d
  52. 440 print"  [196]aten  suchen            [166]";
  53. 450 print"[166]        ";:pokef,l:print"-8-";:pokef,d
  54. 460 print"  [198]arben aendern           [166]";
  55. 470 print"[166]        ";:pokef,l:print"-9-";:pokef,d
  56. 480 print"  [198]reier [211]peicher          [166]";
  57. 490 print"[166]        ";:pokef,l:print"-^-";:pokef,d
  58. 500 print"  [208]rogramm beenden         [166]";
  59. 510 print"[166]                                      [166]";
  60. 520 print"[166]                                      [166]";
  61. 530 print"[166]              [193]uswahl !               [166]";
  62. 540 print"[166]              [163][163][163][163][163][163][163][163][163]               [166]";
  63. 550 print"[166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]";
  64. 560 poke2023,102:poke56295,d:return
  65. 570 gosub200:pokeb,27:poke198,0
  66. 580 pokef,l:sysc,22,25,"[191][146]";
  67. 590 fori=1to120:next:print"[157][191]":fori=1to120:next:gete$:ife$=""then580
  68. 600 ife$="^"thensysc,22,25,e$:pokef,d:goto2390
  69. 610 e=val(e$):ife>0 and e<10thensysc,22,25,e$;:poke646,d:goto650
  70. 620 l$="<<<  [197]ingabe nur 1-9 und '^' moeglich ! <<< "
  71. 630 gosub1220:ife$=""then630
  72. 640 goto570
  73. 650 onegoto770,880,960,1170,1290,1750,1840,2010,2190
  74. 660 ifz>0thenreturn:l$="<<< * [203]eine [196]aten im [211]peicher * <<< "
  75. 670 gosub1220:ife$=""then670
  76. 680 goto570
  77. 690 poke768,185:open15,8,15,"i":poke768,139
  78. 700 ifst<>-128thengosub840:return
  79. 710 pokef,l:sysc,23,1,"[196][197][214][201][195][197][160][206][207][212][160][208][210][197][211][197][206][212][160][197][210][210][207][210] ":pokef,d
  80. 720 poke198,0:wait198,1:goto830
  81. 730 open4,4:poke768,185:print#4:close4:
  82. 740 poke768,139:ifst<>-128thenreturn
  83. 750 goto710
  84. 760 rem daten laden
  85. 770 l$="<<<  [196]atendiskette  einlegen ! ***  [212]aste  druecken !   <<< "
  86. 780 gosub1220:ife$=""then780
  87. 790 gosub690:pokef,l:sysc,7,10,"[196]aten werden geladen";:pokef,d
  88. 800 open8,8,8,"0:datei,s,r":gosub840
  89. 810 fori=0to6:input#8,f$(i):next:gosub840:input#8,z:gosub840:gosub33
  90. 820 forv=1toz:gosub44:fori=0to6:input#8,p$(v,i):nexti,v:gosub840
  91. 830 close4:close8:close10:close15:sysr:poke53280,h:pokeb,11:goto570
  92. 840 input#15,a,b$,g,e
  93. 850 pokef,l:sysc,23,1,a;b$;g;e:pokef,d:ifa=0thenreturn
  94. 860 poke198,0:wait198,1:goto830
  95. 870 rem *****  daten saven
  96. 880 l$=" ***  [196]atendiskette  einlegen ! ***  [212]aste  druecken !  <<< "
  97. 890 l1$="<<<  [193]chtung vorhandenes [196]atenfile wird ueberschrieben !":l$=l1$+l$
  98. 900 gosub660:gosub1220:ife$=""then900
  99. 910 gosub690:pokef,l:sysc,7,10,"  [196]aten  speichern  ";:pokef,d
  100. 920 open8,8,8,"@0:datei,s,w":gosub840
  101. 930 fori=0to6:print#8,f$(i):next:gosub840:print#8,z:gosub840:gosub33
  102. 940 forv=1toz:gosub44:fori=0to6:print#8,p$(v,i):nexti,v:gosub840:goto830
  103. 950 rem daten eingeben
  104. 960 pokeb,11:sysc,7,10,"  [196]aten   eingeben  ":gosub1130
  105. 970 z=z+1:gosub33:ifz=410then570
  106. 980 x=8:y=2:fori=0to6:x=x+2:sysc,x,y,f$(i):next:pokeb,27:x=9:y=14:g=21
  107. 990 fori=0to6:sysc,x,y,g$:x=x+1:y=y+1:gosub1060:ifa$=""thena$=chr$(160)
  108. 1000 sys53100(p$(z,i),a$):a$="":x=x+1:y=y-1:sysc,x,y,n$:next:gosub1130
  109. 1010 sysc,14,3,"[215]eitere [197]ingaben   ";:pokef,l:print"> [210]eturn <":pokef,d
  110. 1020 sysc,17,3,"[218]um [205]enue          ";:pokef,l:print"> [211]pace <":pokef,d
  111. 1030 gete$:ife$=""then1030
  112. 1040 ifasc(e$)=13then960
  113. 1050 pokeb,11:goto570
  114. 1060 pokef,l:sysc,x,y,a$" [146]":gete$:ife$=""then1060
  115. 1070 ifasc(e$)=20thena$="":sysc,x,y,left$(k$,g+1):goto1060
  116. 1080 ifasc(e$)=13thenpokef,d:sysc,x,y,a$" ":return
  117. 1090 iflen(a$)=gthen1060
  118. 1100 ifasc(e$)>127andasc(e$)<160then1060
  119. 1110 ifasc(e$)<32 or asc(e$)=44 or asc(e$)=58 or asc(e$)=34then1060
  120. 1120 a$=a$+e$:goto1060
  121. 1130 x=8:y=1
  122. 1140 x=x+1:sysc,x,y,"                                      ":ifx<23then1140
  123. 1150 return
  124. 1160 rem daten definieren
  125. 1170 pokeb,11:gosub1130:sysc,7,10," [196]aten   definieren ":x=10:y=4:pokeb,27:g=11
  126. 1180 fori=0to6:sysc,x,y,"[198]eld [206]r."i;i$:y=16:gosub1060:f$(i)=a$:a$=""
  127. 1190 f$(i)=f$(i)+left$(h$,11-len(f$(i))):sysc,x,y,f$(i)" "
  128. 1200 y=15:sysc,x,y,gl$:x=x+2:y=4:next:pokeb,11:goto570
  129. 1210 rem laufschrift
  130. 1220 sysc,7,10,"                    ":x=7:y=29:s=0:pokef,l:fora=1tolen(l$)
  131. 1230 fori=1to130:next:goto1260
  132. 1240 y=y-1:s=s+1:sysc,x,y,mid$(l$,a,s):ifs=18theny=y+1:s=s-1:next:return
  133. 1250 goto1230
  134. 1260 gete$:ife$<>""thenpokef,d:return
  135. 1270 goto1240
  136. 1280 rem daten aendern
  137. 1290 v=1:gosub660
  138. 1300 pokeb,11:sysc,7,10,"   [196]aten  aendern   ":gosub1130
  139. 1310 x=10:y=2
  140. 1320 pokef,l:sysc,x,y,"[198]1";:pokef,d:print" vor ";:pokef,l:print"[198]3";:pokef,d
  141. 1330 print" rueck ";:pokef,l:print"[198]5";:pokef,d:print" aendern";
  142. 1340 pokef,l:print"  [198]7";:pokef,d:print" [205]enue":x=11
  143. 1350 pokef,l:sysc,x,y,"[198]2";:pokef,d:print" 10  ";:pokef,l:print"[198]4";:pokef,d
  144. 1360 print"  10  ";:pokef,l:print" [198]6";:pokef,d:print" loeschen ";
  145. 1370 pokef,l:print"[198]8";:pokef,d:print" sort.":gosub33:x=14:y=1
  146. 1380 fori=0to6:sysc,x,y,i;f$(i):x=x+1:next:pokeb,27
  147. 1390 x=14:y=16:ifv>zthenv=z
  148. 1400 ifv<1thenv=1
  149. 1410 pokef,l:fori=0to6:sysc,x,y,k$:sysc,x,y,p$(v,i):x=x+1:next:gosub44
  150. 1420 gete$:ife$=""then 1420
  151. 1430 ifasc(e$)=133thenv=v+1:goto1390
  152. 1440 ifasc(e$)=137thenv=v+10:goto1390
  153. 1450 ifasc(e$)=134thenv=v-1:goto1390
  154. 1460 ifasc(e$)=138thenv=v-10:goto1390
  155. 1470 ifasc(e$)=135then1520
  156. 1480 ifasc(e$)=139then1580
  157. 1490 ifasc(e$)=136thenpokeb,11:goto570
  158. 1500 ifasc(e$)=140then1630
  159. 1510 goto1420
  160. 1520 sysc,22,2,"[215]elche [198]eldnummer (0-6) aendern ?":gete$:ife$=""then1520
  161. 1530 ifasc(e$)>47 and asc(e$)<55then1550
  162. 1540 goto1520
  163. 1550 i=val(e$):sysc,22,2,"[206]euer [201]nhalt ";:print"[145]"g$
  164. 1560 x=22:y=16:g=21:gosub1060:ifa$=""thena$=chr$(160)
  165. 1570 p$(v,i)=a$:a$="":pokeb,11:goto1300
  166. 1580 l$="<<<  [211]oll dieser [196]atensatz geloescht werden (j/n) ?  <<< ":gosub660
  167. 1590 gosub1220:ife$=""then1590
  168. 1600 ife$<>"j"then1300
  169. 1610 pokef,l:sysc,7,10,"  [196]aten   loeschen  ":pokef,d:
  170. 1620 fora=vtoz:fori=0to6:sys53100(p$(a,i),p$(a+1,i)):nexti,a:z=z-1:goto1300
  171. 1630 ifz<2then1420
  172. 1640 sys c,22,2,"[215]elches [198]eld ( 0-6 ) sortieren ?":gete$:ife$=""then1640
  173. 1650 ifasc(e$)<48 or asc(e$)>54then1640
  174. 1660 sysc,22,2,"[211]ortierroutine laeuft !       ":pokef,l:i=val(e$)
  175. 1670 fore=z-1to1step-1:sysc,22,26,e;z$
  176. 1680 forw=1toe:sysc,22,31,w;z$
  177. 1690 ifp$(w,i)<=p$(w+1,i)then1730
  178. 1700 fora=0to6:sys53100(e$(a),p$(w,a)):next
  179. 1710 fora=0to6:sys53100(p$(w,a),p$(w+1,a)):next
  180. 1720 fora=0to6:sys53100(p$(w+1,a),e$(a)):next
  181. 1730 nextw,e:pokef,d:goto1290
  182. 1740 rem daten drucken
  183. 1750 gosub660:pokeb,11
  184. 1760 sysc,7,10,"   [196]aten  drucken   ":gosub1130:pokeb,27:gosub33
  185. 1770 x=15:y=9:sysc,x,y,"[196]atum ":g=10:y=16:gosub1060
  186. 1780 sysc,15,9,"  [196]rucker bereit ???    ":poke198,0:wait198,1:gosub730:open4,4,7
  187. 1790 print#4,tab(19)chr$(14)chr$(14)"[196]aten - [193]rchiv"chr$(13)chr$(13)chr$(13)
  188. 1800 print#4,tab(5)"[204]iste vom  "a$chr$(13)chr$(13):a$=""
  189. 1810 forv=1toz:fori=0to6:print#4,tab(5)f$(i);tab(3)p$(v,i)
  190. 1820 next:print#4:next:open10,4,10:print#10:goto830
  191. 1830 rem daten suchen
  192. 1840 gosub660:pokeb,11:gosub1130:sysc,7,10,"    [211]uchbegriffe    "
  193. 1850 x=8:y=2:fori=0to6:x=x+2:sysc,x,y,f$(i):s$(i)="":next:x=9:y=14:pokeb,27:g=21
  194. 1860 fori=0to6:sysc,x,y,g$:x=x+1:y=y+1:gosub1060:s$(i)=a$:a$=""
  195. 1870 x=x+1:y=y-1:sysc,x,y,n$:next
  196. 1880 pokeb,11:sysc,7,10,"  [196]aten  ausgeben  ":gosub1130
  197. 1890 x=13:y=2:fori=0to6:sysc,x,y,f$(i):x=x+1:next:pokeb,27:gosub33
  198. 1900 sysc,10,9,"[196]atei wird durchsucht!":a=0
  199. 1910 forv=1toz:gosub44:fori=0to6:ifs$(i)=""thena=a+1:goto1930
  200. 1920 ifleft$(p$(v,i),len(s$(i)))=s$(i)thena=a+1
  201. 1930 next:ifa=7then1970
  202. 1940 a=0:next:sysc,10,9,k$"  ":l$="<<< * [196]ateiende * <<< "
  203. 1950 gosub1220:ife$=""then1950
  204. 1960 pokeb,11:goto570
  205. 1970 sysc,10,9,k$"  ":x=13:y=14:pokef,l:fori=0to6:sysc,x,y,k$:sysc,x,y,p$(v,i)
  206. 1980 x=x+1:next:wait198,1:poke198,0:pokef,d
  207. 1990 sysc,10,9,"[196]atei wird durchsucht !":goto1940
  208. 2000 rem farben aendern
  209. 2010 pokeb,11:gosub1130:pokef,l:sysc,7,10,"   [198]arbe  aendern   ":x=11:y=10
  210. 2020 sysc,x,y,"[198]1";:pokef,d:print"  [200]intergrundfarbe"
  211. 2030 x=14:pokef,l:sysc,x,y,"[198]3";:pokef,d:print"  [211]chriftfarbe  1"
  212. 2040 x=17:pokef,l:sysc,x,y,"[198]5";:pokef,d:print"  [211]chriftfarbe  2"
  213. 2050 x=20:pokef,l:sysc,x,y,"[198]7";:pokef,d:print"  [218]um  [205]enue":pokeb,27
  214. 2060 gete$:ife$=""then2060
  215. 2070 ifasc(e$)=133thenh=h+1:goto 2120
  216. 2080 ifasc(e$)=134thenl=l+1:goto 2140
  217. 2090 ifasc(e$)=135thend=d+1:goto 2160
  218. 2100 ifasc(e$)=136thenpokeb,11:goto570
  219. 2110 goto2060
  220. 2120 ifh=16thenh=0
  221. 2130 poke53280,h:poke53281,h:goto2060
  222. 2140 ifl=16thenl=0
  223. 2150 pokeb,11:gosub200:goto2010
  224. 2160 ifd=16thend=0
  225. 2170 goto2150
  226. 2180 rem freier speicher
  227. 2190 pokeb,11:sysc,7,10,"  [198]reier  [211]peicher  ":gosub1130:gosub33
  228. 2200 x=9:y=8:gosub2280:sysc,16,6,"[211]peicherplatz aufraeumen (j/n)":pokeb,27
  229. 2210 gete$:ife$="n"thenpokeb,11:goto570
  230. 2220 ife$<>"j"then2210
  231. 2230 sysc,19,12,"[194]itte  [215]arten !!!"
  232. 2240 sysc,21,8,"[199]arbage [195]ollection laeuft":poke646,l
  233. 2250 sysc,16,19,(int(fre(o)/49));:pokef,d:print"[157] [196]atensaetze  "
  234. 2260 sysc,16,5,"[208]latz fuer ca. ":sysr:poke53280,h:x=17:y=6:gosub2280
  235. 2270 poke198,0:wait198,1:pokeb,11:goto570
  236. 2280 a=peek(43)+256*peek(44):e=peek(45)+256*peek(46):p%=e-a
  237. 2290 a=peek(47)+256*peek(48):v%=a-e
  238. 2300 e=peek(49)+256*peek(50):a%=e-a
  239. 2310 a=peek(51)+256*peek(52):f%=a-e
  240. 2320 e=peek(55)+256*peek(56):s%=e-a
  241. 2330 x=x+1:sysc,x,8," [208]rogramm  =";:pokef,l:printp%;z$:pokef,d:sysc,x,27,"[194]ytes"
  242. 2340 x=x+1:sysc,x,8," [193]rrays    =";:pokef,l:printa%;z$:pokef,d:sysc,x,27,"[194]ytes"
  243. 2350 x=x+1:sysc,x,8," [214]ariablen =";:pokef,l:printv%;z$:pokef,d:sysc,x,27,"[194]ytes"
  244. 2360 x=x+1:sysc,x,8," [211]trings   =";:pokef,l:prints%;z$:pokef,d:sysc,x,27,"[194]ytes "
  245. 2370 x=x+1:sysc,x,8," [198]rei      =";:pokef,l:printf%:pokef,d:sysc,x,27,"[194]ytes":return
  246. 2380 rem programm ende
  247. 2390 l$="<<<  [193]chtung [195]omputer fuehrt ein [210]eset aus !  *** "
  248. 2400 l1$=" [211]ind alle [196]aten gespeichert (j/n) ?   <<< ":l$=l$+l1$
  249. 2410 sysr:poke53280,h:gosub1220:ife$=""then2410
  250. 2420 ife$<>"j"then570
  251. 2430 sys64738
  252.