home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1985 December / 64er_Magazin_85-12_1985_Markt__Technik_de.d64 / eprom-automat (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  6KB  |  245 lines
  1. 1 rem (c) 1985 by dirk gazic
  2. 2 rem             amsterdamer str. 41
  3. 3 rem             5000 koeln 90
  4. 4 rem             tel.:02203/32921
  5. 5 :
  6. 6 :
  7. 7 :
  8. 8 :
  9. 9 :
  10. 1000 rem initializierung ---------------
  11. 1010 :
  12. 1020 poke55,0:poke56,128:clr:dimze%(4),te$(4)
  13. 1030 hf=0:vf=0:sf=5:rem farbvorgabe
  14. 1040 printchr$(14)chr$(8)chr$(147)
  15. 1050 re$(0)="[146]":re$(1)=""
  16. 1060 fori=1to4:readze%(i):readte$(i):next
  17. 1070 ei$="[201]hre [197]ingabe [194]itte >>>":rem haeufigste statuszeile
  18. 1080 data 8,"[208]rogramm bearbeiten"
  19. 1090 data10,"[211]peicherinhalt sichern"
  20. 1100 data 12,"[196]irectory zeigen"
  21. 1110 data 14,"[208]rogramm beenden"
  22. 1120 goto2560:rem hauptprogramm
  23. 1130 :
  24. 1140 :
  25. 1150 :
  26. 1160 rem input-routine -----------------
  27. 1170 :
  28. 1180 poke204,0:poke205,2:wait207,1,1:poke204,1
  29. 1190 l=len(ww$):printww$;" [157]";:ifl>0thenforzz=1tol:print"[157]";:next:l=0
  30. 1200 poke204,0
  31. 1210 poke198,0:wait198,1:getw$
  32. 1220 poke205,2:wait207,1,1:poke204,1
  33. 1230 ifw$=chr$(29)andl<mxthen1300
  34. 1240 ifw$=chr$(157)andl>0thenl=l-1:printw$;:goto1200
  35. 1250 ifw$=chr$(13)then1320
  36. 1260 ifw$=chr$(20)andl>0then1350
  37. 1270 ifasc(w$)<32orasc(w$)=34then1200
  38. 1280 ifw$="*"orw$=";"orw$=","then1200
  39. 1290 ifasc(w$)>127andasc(w$)<160then1200
  40. 1300 l=l+1:printw$;:ifl<mxthen1200
  41. 1310 l=mx-1:print"[157]";:goto1200
  42. 1320 ifl>0thenforzz=1tol:print"[157]";:next
  43. 1330 ww$="":open3,3:forzz=1tomx:get#3,w$:ww$=ww$+w$:next:close3
  44. 1340 return
  45. 1350 ifl=0then1200
  46. 1360 gosub1320
  47. 1370 forzz=1tomx:print"[157]";:next
  48. 1380 ifl=1thenww$=mid$(ww$,2):goto1190
  49. 1390 ww$=left$(ww$,l-1)+mid$(ww$,l+1):printww$;" ";
  50. 1400 forzz=1tomx-l+1:print"[157]";:next
  51. 1410 l=l-1:goto1200
  52. 1420 :
  53. 1430 :
  54. 1440 :
  55. 1450 rem leerstellen entfernen ---------
  56. 1460 :
  57. 1470 l1=len(ww$):ifl1=0thenreturn
  58. 1480 l2=asc(right$(ww$,1)):ifl2<>32andl2<>160thenreturn
  59. 1490 ww$=left$(ww$,l1-1):goto1470
  60. 1500 :
  61. 1510 :
  62. 1520 :
  63. 1530 rem untere statuszeile ------------
  64. 1540 :
  65. 1550 i=int((39-len(an$))/2)
  66. 1560 an$=left$("                                    ",i)+an$
  67. 1570 poke214,23:sys58640:print:print"                                       [146]";
  68. 1580 poke214,23:sys58640:print:print"";an$"[146]";
  69. 1590 poke2023,160:poke56295,peek(646)
  70. 1600 return
  71. 1610 :
  72. 1620 :
  73. 1630 :
  74. 1640 rem obere statuszeile -------------
  75. 1650 :
  76. 1660 print"                                        [146]"
  77. 1670 i=int((39-len(an$))/2)
  78. 1680 an$=left$("                                    ",i)+an$
  79. 1690 print"";an$;"[146]"
  80. 1700 return
  81. 1710 :
  82. 1720 :
  83. 1730 :
  84. 1740 rem fehlerton ---------------------
  85. 1750 :
  86. 1760 si=54272
  87. 1770 for i=0 to 23:poke i+si,0:next
  88. 1780 pokesi+1,7:pokesi+5,60:pokesi+24,15:pokesi+2,50:pokesi+3,15:pokesi+4,65
  89. 1790 return
  90. 1800 :
  91. 1810 :
  92. 1820 :
  93. 1830 rem disk-fehler -------------------
  94. 1840 :
  95. 1850 input#1,ff$,fe$,tt$,ss$
  96. 1860 iffe$="ok"thenreturn
  97. 1870 an$=ff$+","+fe$+","+tt$+","+ss$
  98. 1880 gosub1530
  99. 1890 ifff$="74"thenprint#1,"uj":fori=1to3000:next
  100. 1900 gosub1740:poke198,0:wait198,1
  101. 1910 return
  102. 1920 :
  103. 1930 :
  104. 1940 :
  105. 1950 rem directory ---------------------
  106. 1960 :
  107. 1970 open1,8,15,"i":gosub1830:close1:iffe$<>"ok"thenreturn
  108. 1980 print"[147]";:re=0
  109. 1990 open1,8,0,"$0"
  110. 2000 get#1,a$,b$
  111. 2010 get#1,a$,b$
  112. 2020 get#1,a$,b$
  113. 2030 getq$:ifq$="[133]"thenclose1:return
  114. 2040 ifq$="[134]"thenwait198,1:poke198,0
  115. 2050 print"[146]";
  116. 2060 c=0
  117. 2070 if a$<>"" then c=asc(a$)
  118. 2080 if b$<>"" then c=c+asc(b$)*256
  119. 2090 printmid$(str$(c),2);:poke211,4
  120. 2100 ifre=0thenprint"";
  121. 2110 get#1,b$:if st<>0 then 2220
  122. 2120 if b$<>chr$(34) then 2110
  123. 2130 printchr$(34);
  124. 2140 get#1,b$:printb$;:ifb$<>chr$(34)then2140
  125. 2150 print"  ";
  126. 2160 get#1,b$:if b$=chr$(32) then 2160
  127. 2170 poke211,24:c$=""
  128. 2180 c$=c$+b$:get#1,b$:ifb$<>""then 2180
  129. 2190 ifleft$(c$,1)="*"thenpoke211,23
  130. 2200 printc$
  131. 2210 if st=0 then re=1:goto 2010
  132. 2220 print"blocks free"
  133. 2230 close1
  134. 2240 an$="'[212][193][211][212][197]' fuer [210]ueckkehr ins [205]enue":gosub1530
  135. 2250 poke198,0:wait198,1
  136. 2260 return
  137. 2270 :
  138. 2280 :
  139. 2290 :
  140. 2300 rem menuesteuerung ----------------
  141. 2310 :
  142. 2320 print"[147]":poke646,sf
  143. 2330 an$=nm$:gosub1640
  144. 2340 an$="[215]aehlen mit [195][213][210][211][207][210] und [210][197][212][213][210][206]":gosub1530
  145. 2350 gosub2510:re=1:gosub2500
  146. 2360 poke53280,hf:poke53281,vf
  147. 2370 poke198,0:wait198,1:getq$
  148. 2380 ifq$=chr$(13)thenreturn
  149. 2390 ifq$="[145]"andze>1thenre=0:gosub2500:ze=ze-1:re=1:gosub2500:goto2360
  150. 2400 ifq$="[145]"thenre=0:gosub2500:ze=4:re=1:gosub2500:goto2360
  151. 2410 ifq$=""andze<4thenre=0:gosub2500:ze=ze+1:re=1:gosub2500:goto2360
  152. 2420 ifq$=""thenre=0:gosub2500:ze=1:re=1:gosub2500:goto2360
  153. 2430 ifq$="[133]"andhf<255thenhf=hf+1:goto2360
  154. 2440 ifq$="[133]"thenhf=0
  155. 2450 ifq$="[134]"andvf<255thenvf=vf+1:goto2360
  156. 2460 ifq$="[134]"thenvf=0
  157. 2470 ifq$="[135]"andsf<15thensf=sf+1:goto2300
  158. 2480 ifq$="[135]"thensf=0:goto2300
  159. 2490 goto2360
  160. 2500 poke211,8:poke214,ze%(ze):sys58640:printre$(re)te$(ze):return
  161. 2510 fori=1to4:poke211,8:poke214,ze%(i):sys58640:printte$(i):next
  162. 2520 return
  163. 2530 :
  164. 2540 :
  165. 2550 :
  166. 2560 rem hauptprogramm -----------------
  167. 2570 :
  168. 2580 nm$=" [193]uto.[197]prom [214]1.2      (c) by [196]irk [199]azic"
  169. 2590 ze=1:gosub2300
  170. 2600 onzegosub2650,3050,1950,3270
  171. 2610 goto2560
  172. 2620 :
  173. 2630 :
  174. 2640 :
  175. 2650 rem programm bearbeiten -----------
  176. 2660 :
  177. 2670 an$="[205]odus: [208]rogramm bearbeiten":gosub1640
  178. 2680 an$=ei$:gosub1530:ww$=""
  179. 2690 print"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  180. 2700 print"[221][198]ilename:                 [221]"
  181. 2710 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  182. 2720 print"[145][145]";:mx=16:gosub1160:gosub1450:na$=ww$
  183. 2730 open1,8,15:open2,8,0,na$
  184. 2740 gosub1830:iffe$<>"ok"thenclose1:close2:return
  185. 2750 get#2,lb$:get#2,hb$
  186. 2760 ifasc(lb$+chr$(0))=1andasc(hb$+chr$(0))=8then2790
  187. 2770 an$="[208]rogrammstart ist nicht $0801":close1:close2:gosub1740:gosub1530
  188. 2780 poke198,0:wait198,1:return
  189. 2790 restore
  190. 2800 an$="[194]itte warten":gosub1530
  191. 2810 fori=1to4:reada:reada$:next
  192. 2820 fori=32768to32859:reada:pokei,a:next
  193. 2830 get#2,a$:a$=a$+chr$(0)
  194. 2840 pokei,asc(a$)
  195. 2850 i=i+1:ifi<40960orst=64then2880
  196. 2860 an$="[208]rogramm ist zu lang":close1:close2:gosub1740:gosub1530
  197. 2870 poke198,0:wait198,1:return
  198. 2880 ifst<>64then2830
  199. 2890 close1:close2
  200. 2900 hb=int(i/256):lb=i-hb*256
  201. 2910 poke32838,lb:poke32842,hb
  202. 2920 i1=i-30811:i2=i
  203. 2930 hb=int(i1/256):lb=i1-hb*256
  204. 2940 poke32846,lb:poke32852,hb
  205. 2950 return
  206. 2960 :
  207. 2970 data9,128,9,128,195,194,205,56,48,120,142,22,208,32,163,253,32,80,253,32
  208. 2980 data21,253,32,91,255,88,32,83,228,32,191,227,32,61,128,162,251,154,169
  209. 2990 data82,141,119,2,169,213,141,120,2,169,13,141,121,2,169,3,141,198,0,76
  210. 3000 data134,227,169,92,133,95,169,128,133,96,169,110,133,90,169,128,133,91
  211. 3010 data169,20,133,88,133,45,169,8,133,89,133,46,76,191,163
  212. 3020 :
  213. 3030 :
  214. 3040 :
  215. 3050 rem speicherinhalt sichern --------
  216. 3060 :
  217. 3070 ifi2=0thengosub1740:return
  218. 3080 an$="[205]odus: [211]peicherinhalt sichern":gosub1640
  219. 3090 an$=ei$:gosub1530
  220. 3100 print"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  221. 3110 print"[221][198]ilename:                 [221]"
  222. 3120 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]":ww$="modul."+na$
  223. 3130 ww$=left$(ww$,16):print"[145][145]";:mx=16:gosub1160:gosub1450
  224. 3140 open1,8,15:open2,8,1,ww$
  225. 3150 gosub1830:iffe$<>"ok"thenclose1:close2:return
  226. 3160 print"[221][211]tartadresse:   * 4096    "
  227. 3170 ww$=mid$(str$(8),2):print"[145]";:mx=1:gosub1160
  228. 3180 ad=val(ww$):ifad<1orad>8thengosub1740:goto3160
  229. 3190 ad=ad*4096:hb=int(ad/256):lb=ad-hb*256
  230. 3200 print#2,chr$(lb)chr$(hb);
  231. 3210 an$="[194]itte warten":gosub1530
  232. 3220 fori=32768toi2:print#2,chr$(peek(i));:next
  233. 3230 gosub1830:close1:close2:i2=0:return
  234. 3240 :
  235. 3250 :
  236. 3260 :
  237. 3270 rem programm beenden --------------
  238. 3280 an$="[205]odus: [208]rogramm beenden":gosub1640
  239. 3290 an$="[215]ollen [211]ie wirklich beenden [j/n]":gosub1530:poke198,0:wait198,1:getq$
  240. 3300 ifq$="n"thenreturn
  241. 3310 ifq$<>"j"then3290
  242. 3320 print"[147]":ifi1=0then3340
  243. 3330 print"[194]earbeitetes [208]rogramm steht ab $8000    [197]promfertig im [211]peicher"
  244. 3340 new
  245.