home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1989 September / 64er_Magazin_89-09_1989_Markt__Technik_de_Side_A.d64 / rel-demo (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1989-01-01  |  5.4 KB  |  182 lines
  1. 10 rem ------------------------------
  2. 20 rem --                          --
  3. 30 rem --  demonstrationsprogramm  --
  4. 40 rem --  fuer  relative dateien  --
  5. 50 rem --                          --
  6. 60 rem --   (w) 1989 joerg nebel   --
  7. 70 rem --   und matthias ullmann   --
  8. 80 rem --                          --
  9. 90 rem ------------------------------
  10. 100 :
  11. 110 rem *** initialisieren ***
  12. 120 :
  13. 130 poke 53280,6:poke 53281,6:poke 646,7:print chr$(147)chr$(142)chr$(8)
  14. 140 sys 57812 "rel-tool",8,1:poke 780,0:sys 62629 : sys 49155
  15. 150 dm=100 : dim i$(dm) : nu$=chr$(0):cr$=chr$(13):pi$=chr$(255)
  16. 160 sys 49152,1,3,"demoprogramm fuer relative dateien"
  17. 170 sys 49152,2,2,"------------------------------------"
  18. 180 sys 49152,21,1," f1 [146] dateien zeigen  f3 [146] datei anlegen"
  19. 190 sys 49152,22,1," f5 [146] datei loeschen  f7 [146] programmstart"
  20. 200 gosub 7400:if ta=8 then 8000
  21. 210 if ta<1 or ta>4 then 200
  22. 220 sys 49155,5,20:if ta>1 then gosub 500
  23. 230 on ta goto 300,800,250,700
  24. 240 :
  25. 250 sys 49152,7,3,"sind sie sicher ? (j/n)"
  26. 260 gosub 7400:if ta$<>"j" and ta$<>"n" then 260
  27. 270 sys 49155,5,7:if ta$="n" then 200
  28. 280 open 1,8,15,"s0:"+dn$:print#1,"s0:"+in$:gosub 7050:close 1:sys 49155,5
  29. 290 :
  30. 300 gosub 400:open 1,8,15,"m-e"+chr$(34)+chr$(235):close 1:goto 200
  31. 310 :
  32. 380 rem *** dateien zeigen ***
  33. 390 :
  34. 400 open 1,8,0,"$:*=r":poke 781,1:sys 65478
  35. 410 get a$,a$,a$,a$:sys 49152,5,7,"0 ";
  36. 420 for i=1 to 28:get a$:print a$;:next:print cr$spc(6);
  37. 430 get a$,a$,a$,b$:if st then sys 65484:close 1:return
  38. 440 print asc(a$+nu$)+256*asc(b$+nu$);:goto 420
  39. 450 :
  40. 480 rem *** dateiangaben holen ***
  41. 490 :
  42. 500 na$="":sys 49152,5,3,"dateiname   ";:input na$:if len(na$)>14 then 500
  43. 510 if na$="" then ta=1:sys 49155,5:return
  44. 520 for i=1 to len(na$):a$=mid$(na$,i,1)
  45. 530 if a$="*" or a$="?" or a$="." then  500
  46. 540 next i:dn$=na$+".d":in$=na$+".i":if ta>2 then return
  47. 550 open 1,8,15:open 2,8,2,dn$:gosub 7050:close 2:close 1:if en=0 then 500
  48. 560 sys 49152,7,3:input"satzlaenge  ";sl
  49. 570 if sl<2 or sl>254 then 560
  50. 580 sys 49152,9,3:input"satzanzahl  ";sm
  51. 590 af=1:si=1:open 1,8,15:open 2,8,2,dn$+",l,"+chr$(sl):gosub 7050
  52. 600 gosub 6510:close 2:close 1:sys 49155,5,9:return
  53. 610 :
  54. 680 rem *** hauptprogramm ***
  55. 690 :
  56. 700 open 1,8,15:open 2,8,2,dn$:gosub 7050:close 2:close 1
  57. 710 if en=62 then sys 49152,7,3,"datei nicht vorhanden !";:goto 200
  58. 720 :
  59. 800 print chr$(147)chr$(14)chr$(8):sys 49152,1,12,"[196]atei bearbeiten"
  60. 810 sys 49152,2,11,"------------------"
  61. 820 gosub 6000:gosub 5000
  62. 830 sys 49152,19,1," [198]1 [146] [194]laettern (+)   [198]2 [146] [194]laettern (-)"
  63. 840 sys 49152,20,1," [198]3 [146] [211]atz eingeben   [198]4 [146] [211]atz loeschen"
  64. 850 sys 49152,21,1," [198]5 [146] [206]ame suchen     [198]6 [146] [211]atz aendern"
  65. 860 sys 49152,22,1," [198]7 [146] [215]eiter suchen   [198]8 [146] [208]rogrammende"
  66. 870 gosub 7400:if ta<1 or ta>8 then 870
  67. 880 bf=0:if (ta=6 or ta=7) and (sn=0 or i$(sn)=pi$) then 870
  68. 890 on ta gosub 1000,2000,4000,4500,1000,3000,2010,8000:goto 870
  69. 900 rem tasten: <f1>,<f3>,<f5>,<f7>,<f2>,<f4>,<f6>,<f8>
  70. 910 :
  71. 980 rem *** blaettern ***
  72. 990 :
  73. 1000 if ta=1 then sn=sn+1:if sn>sm then sn=1:bf=bf+1
  74. 1010 if ta=5 then sn=sn-1:if sn<1 then sn=sm:bf=bf+1
  75. 1020 if bf=2 then sys 49152,5,1,"[206]och kein [196]atensatz vorhanden !";:return
  76. 1030 if i$(sn)=pi$ then 1000
  77. 1040 goto 5010
  78. 1050 :
  79. 1980 rem *** satz eingeben/aendern ***
  80. 1990 :
  81. 2000 su$=pi$:as=1:gosub 7500:if sn=0 then gosub 6500
  82. 2010 d0$=d1$:gosub 7300:if ta=2 then gosub 5040
  83. 2020 sys 49152,8,10:input d1$:if d1$="" then 2020
  84. 2030 sys 49152,10,10:input d2$
  85. 2040 sys 49152,12,10:input d3$
  86. 2050 sys 49152,14,10:input d4$
  87. 2060 sys 49152,16,10:input d5$
  88. 2070 da$=d1$+cr$+d2$+cr$+d3$+cr$+d4$+cr$+d5$:dl=len(da$)+1
  89. 2080 gosub 7000:print#2,da$:gosub 7050
  90. 2090 if en=51 then sys 49152,5,1,"[196]atensatz um";dl-sl;"[157] [218]eichen zu lang !";
  91. 2100 if en=51 then gosub 5050:gosub 7300:goto 2020
  92. 2110 i$(sn)=d1$:if d0$<>d1$ then df=1
  93. 2120 if i$(sn)=pi$ then d1$="[198]reier [196]atensatz"
  94. 2130 goto 5000
  95. 2140 :
  96. 2980 rem *** satz loeschen ***
  97. 2990 :
  98. 3000 sys 49152,5,1,"[211]ind [211]ie sicher ? ([202]/[206])";
  99. 3010 gosub 7400:if ta$="n" then 5040
  100. 3020 if ta$<>"j" then 3010
  101. 3030 gosub 7300:df=1:d1$=pi$
  102. 3040 sys 49155,5:goto 2070
  103. 3050 :
  104. 3980 rem *** suchen ***
  105. 3990 :
  106. 4000 su$="":sys 49155,5:input" [211]uchkriterium ";su$:if su$="" then 4000
  107. 4010 as=1:gosub 7500
  108. 4020 if sn=0 then sys 49152,5,1,"[196]atensatz nicht vorhanden !";:return
  109. 4030 goto 5010
  110. 4040 :
  111. 4480 rem *** weiter suchen ***
  112. 4490 :
  113. 4500 if sn=0 or su$="" or su$=pi$ then return
  114. 4510 as=sn+1:if as>sm then sn=0:sys 49152,5,1,"[196]ateiende erreicht !";:return
  115. 4520 gosub 7500:if sn>0 then 5010
  116. 4530 sys 49152,5,1,"[203]ein weiterer [211]atz vorhanden !";:return
  117. 4540 :
  118. 4980 rem *** satz anzeigen ***
  119. 4990 :
  120. 5000 sys 49152,5,1,"[211]tatus     ";en$;:goto 5050
  121. 5010 sys 49155,6,18:gosub 7000
  122. 5020 input#2,d1$,d2$,d3$,d4$,d5$
  123. 5030 if d1$=pi$ then d1$="[198]reier [196]atensatz"
  124. 5040 sys 49152,5,1,"[196]atensatz [206]ummer ";sn;"[157] [146]";
  125. 5050 sys 49152,8,1,"[206]ame       ";d1$;
  126. 5060 sys 49152,10,1,"[214]orname    ";d2$;
  127. 5070 sys 49152,12,1,"[211]trasse    ";d3$;
  128. 5080 sys 49152,14,1,"[208][204][218]/[207]rt    ";d4$;
  129. 5090 sys 49152,16,1,"[212]elefon    ";d5$;
  130. 5100 return
  131. 5110 :
  132. 5980 rem *** dateien oeffnen ***
  133. 5990 :
  134. 6000 open 1,8,15:open 2,8,2,dn$:gosub 7050
  135. 6010 if af=1 then af=0:return
  136. 6020 sys 49155,5:open 3,8,3,in$+",s,r"
  137. 6030 input#3,sm$,sl$:sm=val(sm$):sl=val(sl$):if sm>dm then 6530
  138. 6040 for i=1 to sm:input#3,i$(i):next
  139. 6050 close 3:return
  140. 6060 :
  141. 6480 rem *** datei anlegen/erweitern ***
  142. 6490 :
  143. 6500 sm=sm+1:si=sm
  144. 6510 sm=int(254*int((sm*sl+253)/254)/sl)
  145. 6520 if sm<=dm then 6560
  146. 6530 lf=1:sys 49155,5,18:sys 49152,5,3,"[196]imensionierung auf";sm;"anpassen !";
  147. 6540 gosub 7400:if af=1 then close 2:print#1,"s0:"+dn$:goto 8060
  148. 6550 sm=si-1:goto 8000
  149. 6560 sn=sm:gosub 7000:print#2,pi$
  150. 6570 for i=si to sm:i$(i)=pi$:next
  151. 6580 sn=si:df=1:return
  152. 6590 :
  153. 6980 rem *** positionieren ***
  154. 6990 :
  155. 7000 hb=int(sn/256):lb=sn-hb*256
  156. 7010 print#1,"p"+chr$(2)+chr$(lb)+chr$(hb)+chr$(1)
  157. 7020 :
  158. 7030 rem *** fehlerkanal ***
  159. 7040 :
  160. 7050 input#1,en,en$,et,es
  161. 7060 if en=0 or en=50 or en=51 or en=62 then return
  162. 7070 sys 49155,5:sys 49152,5,1," status [146]  ";en;en$;et;es;:if en<20 then 7400
  163. 7080 close 3:close 2:close 1:end
  164. 7090 :
  165. 7100 rem *** einzeiler ***
  166. 7200 :
  167. 7300 d1$="":d2$="":d3$="":d4$="":d5$="":da$="":return
  168. 7400 poke 198,0:wait 198,1:get ta$:ta=asc(ta$)-132:return
  169. 7500 p%=0:sys 49158,su$,i$(as),i$(sm),p%:sn=p%:return
  170. 7600 :
  171. 7980 rem *** programmende ***
  172. 7990 :
  173. 8000 if df=0 then 8060
  174. 8010 sys 49155,5,18:sys 49152,5,7,"[196]ateien werden gesichert !"
  175. 8020 print#1,"s0:"+in$
  176. 8030 open 3,8,3,in$+",s,w"
  177. 8040 print#3,str$(sm)+cr$+str$(sl)
  178. 8050 for i=1 to sm:print#3,i$(i):next
  179. 8060 close 3:close 2:close 1:sys 49155
  180. 8070 print chr$(142)chr$(9)
  181. 8080 if lf=1 then list 150
  182.