home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disc 41 / Commodore_Disc_41_19xx_-_de.d64 / telefonkosten (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-01-01  |  6.7 KB  |  215 lines
  1. 10 rem telefonkosten ==========c64
  2. 20 rem (p) commodore-welt-team
  3. 30 rem ===========================
  4. 40 rem (c) by schmid-fabian   v3.5
  5. 50 rem        heidelberg
  6. 60 rem
  7. 70 rem (v) a.m.               v2.0
  8. 80 rem
  9. 90 rem ===========================
  10. 91 at=49152:wo=49172:gosub92:goto100
  11. 92 if peek(49154)=174thenreturn
  12. 93 sys57812"sysmc",8,0:poke780,0
  13. 94 poke781,254:poke782,191
  14. 95 sys65493:return
  15. 100 gosub1460:rem anleitung
  16. 110 gosub410:rem daten
  17. 120 printsc$:sysat,8,6:printfe$;:printsl$"[212]elefonkosten"
  18. 130 printc4$"[206]ummer suchen"b5$"(1)"
  19. 140 printc4$"[206]ummer eingeben"b3$"(2)"
  20. 150 printc4$"[206]ummer aendern"b4$"(3)"
  21. 160 printc4$"[205]onatsabrechnung"b2$"(4)"
  22. 170 printc4$"[208]rogramm beenden"b2$"(5)"
  23. 180 gosub1643:on val(a$) goto 200,340,360,1220,190:goto120
  24. 190 printsc$:end
  25. 200 gosub900:ifi=nnthenprint"[206]icht vorhanden":gosub1641:goto120
  26. 210 ifasc(right$(te$(i),2))=47then z$=right$(te$(i),1):goto230
  27. 220 input "[218]one (n123)";z$
  28. 230 syswo,z$,zo$,ww:tr=ta(ww):iftr=0then220
  29. 240 printc2$cl$:sysat,0,6:print"[194]itte [212]aste druecken"b4$c4$:print:gosub1641:t0=ti
  30. 250 printhe$"[213]hrzeit: "rv$left$(ti$,2)":"mid$(ti$,3,2)":"right$(ti$,2)ro$;
  31. 260 syswo,z$,zo$,ww:tr=ta(ww+b%):if(ti$<"080000")or(ti$>"180000")thenb%=4
  32. 270 se=(ti-t0)/60:e%=se/tr+1
  33. 280 mi%=se/60:
  34. 281 printright$("   "+str$(mi%),3)".";
  35. 282 mm=int(se-mi%*60):mm$=str$(mm)
  36. 283 printright$("00"+right$(mm$,len(mm$)-1),2);
  37. 284 print" min "
  38. 290 print"[197]inheiten",e%:print"[212]arif",tr;c1$b2$"s/[197]inheit"
  39. 300 print"[203]osten"b3$,e%*dm" [196][205] "
  40. 310 getq$:ifq$=""then250""
  41. 320 sysat,0,6:print"[199]ebuehren abspeichern ? (j)":gosub1641:ifq$="j"thengosub1000
  42. 330 goto120
  43. 340 gosub730:printcl$"[206]ummern abspeichern ?":gosub1641:ifq$="j"thengosub830
  44. 350 goto120
  45. 360 gosub900:gosub740:printcl$"[206]ummern abspeichern ?":gosub1641:ifq$="j"thengosub830
  46. 370 goto120
  47. 380 rem --------------------------
  48. 390 rem  daten
  49. 400 rem --------------------------
  50. 410 sl$=chr$(014):c4$=chr$(017)
  51. 420 he$=chr$(019):fl$=chr$(130)
  52. 430 c2$=chr$(145):cl$=chr$(147)
  53. 440 c1$=chr$(157):cr$=chr$(013)
  54. 450 rv$=chr$(018):ro$=chr$(146)
  55. 460 b$=" ":b2$=b$+b$:b3$=b2$+b$
  56. 470 b4$=b3$+b$:b5$=b4$+b$
  57. 480 b$=b5$+b5$:cc$="[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"
  58. 490 nn=100:dim i,na$(nn),ad$(nn),te$(nn),dt%(500),eh%(500),nm$(500)
  59. 500 sc$=chr$(19)+chr$(19)+chr$(147):printsc$:sysat,8,6:printfe$;
  60. 510 pr$=ti$:print"[213]hrzeit ";:gosub1410:inputq$:iflen(q$)<>6then510
  61. 511 ti$=q$
  62. 520 input"[196]atum ([212]ag,[205]onat)";dt,mn
  63. 530 if dt>31 or mn>12 then 520
  64. 540 pr$="j":print"normaler [215]erktag";:gosub1410:inputq$:ifq$="j"thenb%=0:goto550
  65. 541 b%=4
  66. 550 open8,8,8,"nummern,s,r":i=1
  67. 560 input#8,tn$:if st>0 then 580
  68. 570 input#8,na$(i),ad$(i),te$(i):ifst=0theni=i+1:goto570
  69. 580 close8:printds$:fort=1to200:next
  70. 590 rem --------------------------
  71. 600 rem  daten
  72. 610 rem --------------------------
  73. 620 zo$="n123":rem bereichs-kennung
  74. 630 rem normal:billigtarif
  75. 640 ta(1)=480 :ta(5)=720:rem nahbereich
  76. 650 ta(2)=45  :ta(6)=67.5:rem zone 1
  77. 660 ta(3)=20  :ta(7)=38.571:rem zone 2
  78. 670 ta(4)=12  :ta(8)=38.571:rem zone 3
  79. 680 dm=0.23   :rem gebuehren/einheit
  80. 690 return
  81. 700 rem --------------------------
  82. 710 rem  nummern eingeben
  83. 720 rem --------------------------
  84. 730 i=0
  85. 731 i=i+1:ifna$(i)<>""then731
  86. 740 printhe$he$cl$c4$c4$c4$fe$i:ifi=nnthen120
  87. 750 pr$=na$(i):print"[206]ame";:gosub1410:inputna$(i)
  88. 760 pr$=ad$(i):print"[193]dresse";:gosub1410:inputad$(i)
  89. 770 pr$=te$(i):print"[212]elefon/[212]arif";:gosub1410:inputte$(i)
  90. 780 print"weiter ?":gosub1641:ifq$="j" theni=i+1:goto740
  91. 790 return
  92. 800 rem --------------------------
  93. 810 rem  nummern abspeichern
  94. 820 rem --------------------------
  95. 830 open8,8,15,"s:nummern.bak":close8
  96. 831 open8,8,15,"r:nummern.bak=nummern":close8
  97. 840 e=0
  98. 841 e=e+1:ifna$(e)<>""then841
  99. 850 open8,8,8,"nummern,s,w":print#8,"t"
  100. 860 fori=1toe-1:print#8,na$(i)cr$ad$(i)cr$te$(i):next:close8:goto120
  101. 870 rem --------------------------
  102. 880 rem  name suchen und anzeigen
  103. 890 rem --------------------------
  104. 900 printc4$c4$:input"[206]ame";ns$:i=0:ifns$="*"then ns$=" "
  105. 910 ifns$<>"@"then920
  106. 911 i=0:input"name,nummer";na$(0),te$(0):printsc$:sysat,5,5:printfe$;:return
  107. 920 mm$=left$(ns$,1):ll=len(ns$)
  108. 921 i=i+1:ww$=na$(i):ifna$(i)=""theni=nn:return
  109. 922 syswo,ns$,ww$,ww:ifww=0andi<>nnthen921
  110. 923 ifmid$(na$(i),ww,ll)=ns$then929
  111. 924 ww$=left$(ww$,ww-1)
  112. 927 ifww<>1then922
  113. 928 goto921
  114. 929 if i=nn then return
  115. 930 printchr$(147);:sysat,5,5:printfe$;:print"i="i
  116. 931 printc4$na$(i):printad$(i):printc4$te$(i)c4$
  117. 940 print"[207][203]?":gosub1641:ifq$="n"then920
  118. 941 return
  119. 950 rem --------------------------
  120. 960 rem  gebuehren abspeichern
  121. 970 rem --------------------------
  122. 980 printchr$(147);:input"[196]atum ([212]ag,[205]onat)";dt,mn
  123. 990 if dt>31 or mn>12 then 980
  124. 1000 restore:forq=1tomn:read mn$:next:printcl$"[196]atum:"dtc1$"."mn$
  125. 1010 printcl$na$(i):print"[196]atum :"dt"."mn$:print"[197]inheiten"e%:print"[207][203] ?"
  126. 1020 gosub1641:ifq$<>"j"then980
  127. 1030 data jan,feb,mar,apr,mai,jun,jul,aug,sep,okt,nov,dez
  128. 1040 k=0:p$="tel."+mn$:open8,8,8,p$+",s,r":close8
  129. 1050 ifds>0thenprint"[198]loppyfehler":printds$:gosub1641:goto1040
  130. 1060 open8,8,8,p$+",s,r":k=1:es=0
  131. 1070 input#8,a$:printhe$he$cl$:if st>0 thenk=0:goto1100
  132. 1080 input#8,nm$(k),dt%(k),eh%(k)
  133. 1090 es=es+eh%(k):ifst=0thenk=k+1:goto 1080
  134. 1100 close8:printds$:fort=1to200:next:rem if er>0 thenprinthe$he$err$(er):stop
  135. 1110 print"[197]intraege im [205]onat "+mn$+":"k+1
  136. 1120 es=es+e%:print"[197]inheiten gesamt"b3$es"="es*dm"[196][205]"
  137. 1130 rem   open1,8,15,"s:"+p$:close1
  138. 1140 open1,8,15,"s:"+p$+".bak":print#1,"r:"+p$+".bak"+"="+p$:close1
  139. 1150 open8,8,8,p$+",s,w":print#8,mn$
  140. 1160 if k>0 then forq=1tok:print#8,nm$(q):print#8,dt%(q):print#8,eh%(q):nextq
  141. 1170 print#8,na$(i):print#8,dt:print#8,e%
  142. 1180 close8:return
  143. 1190 rem -------------------------
  144. 1200 rem  zwischenbilanz
  145. 1210 rem -------------------------
  146. 1220 print:input "[205]onat (jan-dez)";mn$
  147. 1230 p$="tel."+mn$:open8,8,8,p$+",s,r":close8
  148. 1231 open15,8,15:input#15,ds:close15
  149. 1240 ifds>0thenprint"[198]loppyfehler":printds$:gosub1641:goto1220
  150. 1250 pr$="j":print"[196]ruckerausgabe";:gosub1410:inputq$:dr%=0:if q$="j" then dr%=1
  151. 1260 open8,8,8,p$+",s,r":k=1:es=0
  152. 1270 input#8,a$:printhe$he$cl$:ifdr%thenopen4,4,7
  153. 1280 input#8,nm$(k),dt%(k),eh%(k):sd=st
  154. 1290 printk;left$(nm$(k),16),dt%(k);eh%(k)
  155. 1291 ifdr%then1300
  156. 1292 a$="":geta$:ifa$=""then1300
  157. 1293 gosub1643
  158. 1300 if dr% then print#4,k;left$(nm$(k)+bl$+bl$,20),left$(str$(dt%(k))+b5$,5),eh%(k)
  159. 1310 es=es+eh%(k):k=k+1:ifsd=0then1280
  160. 1320 close8
  161. 1330 print:print"[197]intraege im [205]onat "+mn$+":"k-1
  162. 1340 if dr% then print#4:print#4,"[197]intraege im [205]onat "+mn$+":"k-1
  163. 1350 print"[197]inheiten gesamt"b3$es"="es*dm"[196][205]"
  164. 1360 if dr% then print#4,"[197]inheiten gesamt"b3$es"="es*dm"[196][205]":close4
  165. 1370 gosub1643:goto120
  166. 1380 rem -------------------------
  167. 1390 rem  input vorgabe
  168. 1400 rem -------------------------
  169. 1410 print"  "pr$left$(cc$,len(pr$)+2);:return
  170. 1420 print(NULL)(er),ds$:stop:(NULL)next
  171. 1430 rem -------------------------
  172. 1440 rem  anleitung
  173. 1450 rem -------------------------
  174. 1460 printchr$(147);:printchr$(14)"[193]nleitung? (j)":gosub1641:ifq$<>"j"thenreturn
  175. 1470 print:print"[205]it diesem [208]rogramm kann man":print
  176. 1480 print"a) seine [212]elefonnummern speichern
  177. 1490 [153]b3$"incl. (NULL)amen und atndressen
  178. 1500 print"b) die [206]ummer, die zum eingegebenen
  179. 1510 [153]b3$"(NULL)amen gehoert, suchen (* fuer alle)
  180. 1520 printb3$"([212]aste wenn [214]erbindung hergestellt)
  181. 1530 [153]"c) vals wird angezeigt:
  182. 1540 printb3$"[213]hrzeit, [197]inheiten, [203]osten
  183. 1550 [153]"d) (NULL)ame, str$atum und valinheiten werden
  184. 1560 printb3$"abgespeichert und koennen am [197]nde
  185. 1570 [153]b3$"des (NULL)onats mit (NULL)(NULL)(NULL)atn(NULL)(NULL)atnpeek(NULL)vallenleft$(NULL)(NULL)(NULL)chr$"
  186. 1580 [153]b3$"fuer das ascinanzamt
  187. 1590 printb3$"(oder innerfamiliaer)
  188. 1600 [153]b3$"abgerechnet werden.
  189. 1610 print:print:print"[196]as [208]rogramm ist [205]enuegesteuert. [197]s muss";
  190. 1620 print"immer mit 'j' oder 'n' geantwortet
  191. 1630 [153]"werden.
  192. 1640 gosub1641:return
  193. 1641 getq$:ifq$=""then1641
  194. 1642 return
  195. 1643 geta$:ifa$=""then1643
  196. 1644 return
  197. 1650 rem -------------------------
  198. 1660 rem  liste der unterprogramme
  199. 1670 rem -------------------------
  200. 1680 goto120:rem menue
  201. 1690 goto490:rem daten einlesen
  202. 1700 goto730:rem nummern eingeben
  203. 1710 goto830:rem nummern abspeichern
  204. 1720 goto900:rem name suchen und anzeigen
  205. 1730 goto980:rem gebuehren abspeichern
  206. 1740 goto1410:rem input vorgabe
  207. 1750 rem =========================
  208. 1760 rem 12277 bytes memory
  209. 1770 rem 06281 bytes program
  210. 1780 rem 00294 bytes variables
  211. 1790 rem 04520 bytes arrays
  212. 1800 rem 00460 bytes strings
  213. 1810 rem 00722 bytes free (0)
  214. 1820 rem =========================
  215.