home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / s85xx / s8507a.d64 / fruchtwein (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  7KB  |  274 lines
  1. 10 REM  *******************************
  2. 20 REM  **                           **
  3. 30 REM  **   FRUCHTWEINBEREITUNG     **
  4. 40 REM  **         VON               **
  5. 50 REM  **   SIEGFRIED DAHLMANN      **
  6. 60 REM  **     SCHLOSS STR.9         **
  7. 70 REM  **     4044 KAARST 2         **
  8. 80 REM  **                           **
  9. 90 REM  *******************************
  10. 100 PRINTCHR$(147)CHR$(14)CHR$(8)
  11. 110 C=828:V=53248
  12. 120 REM
  13. 130 REM *** DATEN EINLESEN ***
  14. 140 REM
  15. 150 POKEV+32,10:POKEV+33,13
  16. 160 FORI=0TO62:READQ:POKE896+I,Q:NEXTI
  17. 170 FORI=0TO62:READQ:POKE704+I,Q:NEXTI
  18. 180 FORI=1TO6:READB$(I),H$(I):NEXTI
  19. 190 FORI=828TO850
  20. 200 READQ:POKEI,Q:NEXTI
  21. 210 OPEN15,8,15,"IO"
  22. 220 SYSC,0,0
  23. 230 FORI=1TO8:PRINTCHR$(17)CHR$(151)"[198]RUCHT",
  24. 240 FORJ=1TO50:NEXTJ,I
  25. 250 FORI=1TO8:PRINTCHR$(17)CHR$(30)"W E I N",
  26. 260 FORJ=1TO50:NEXTJ,I
  27. 270 FORJ=1TO200:NEXTJ
  28. 280 SYSC,20,0:PRINTCHR$(5)"[211]IEGFRIED [196]AHLMANN"
  29. 290 PRINT"[211]CHLOSS STR.9"
  30. 300 PRINT"4044 [203][193][193][210][211][212][160]2"
  31. 310 SYSC,0,0:FORJ=1TO500:NEXTJ
  32. 320 FORI=1TO8:PRINTCHR$(17)"         ",
  33. 330 FORJ=1TO50:NEXTJ,I
  34. 340 FORI=1TO8:PRINTCHR$(17)"         ",
  35. 350 FORJ=1TO50:NEXTJ,I
  36. 360 POKEV+32,5:POKEV+33,2
  37. 370 SYSC,7,15:PRINTCHR$(153)"[198][160]R U C H T W E I N"
  38. 380 SYSC,10,19:PRINT"BEREITUNG"
  39. 390 POKE2041,14:POKE2042,11:POKEV+40,10:POKEV+41,13
  40. 400 POKEV+21,6:POKEV+23,6:POKEV+29,6
  41. 410 POKEV+2,75:POKEV+4,75:POKEV+3,100:POKEV+5,100
  42. 420 SYSC,24,11:PRINT"[194]ITTE [212]ASTE DRUECKEN!"CHR$(146);:FORI=1TO50:NEXTI
  43. 430 POKE198,0:WAIT198,1
  44. 440 FORI=75TO190:POKEV+2,I:POKEV+4,I:NEXTI
  45. 450 PRINTCHR$(147):POKEV+32,6:POKEV+33,6
  46. 460 FORI=39TO0STEP-1
  47. 470 POKE1024+I,127:POKE55296+I,5
  48. 480 POKE1784+I,127:POKE56056+I,5
  49. 490 POKE1984+I,127:POKE56256+I,5
  50. 500 NEXTI
  51. 510 FORI= 0 TO 880 STEP 40
  52. 520 POKE1064+I,127:POKE55336+I,5
  53. 530 POKE1103+I,127:POKE55375+I,5
  54. 540 NEXTI
  55. 550 SYSC,12,11:PRINTCHR$(154)"[218]UERST F1 WAEHLEN,"
  56. 560 PRINT:PRINTTAB(7)" DANN <[160][210][197][212][213][210][206][160]> DRUECKEN ";
  57. 570 GOTO890
  58. 580 REM
  59. 590 REM *** WEINSORTENWAHL ***
  60. 600 REM
  61. 610 POKEV+32,9:POKEV+33,9:O=0
  62. 620 SYSC,1,15:PRINTCHR$(158)"[215]EINSORTEN":PRINT
  63. 630 FORI=1TO3:PRINT:PRINTTAB(2)B$(I)TAB(12)"......................";I:NEXTI
  64. 640 FORI=4TO6:PRINT:PRINTTAB(2)B$(I)TAB(16)"..................";I:NEXTI
  65. 650 SYSC,17,18:PRINTCHR$(18)CHR$(153)"[218]AHL EINGEBEN"CHR$(146):FORI=1TO50:NEXTI
  66. 660 SYSC,17,18:PRINT"[218]AHL EINGEBEN":FORI=1TO50:NEXTI
  67. 670 GETA$:IFA$=""THEN650
  68. 680 IFASC(A$)<49ORASC(A$)>54THEN670
  69. 690 POKEV+21,0:POKEV+32,2:POKEV+33,2:Y=VAL(A$)
  70. 700 PRINTCHR$(147)
  71. 710 SYSC,0,1:PRINTB$(Y):RETURN
  72. 720 REM
  73. 730 REM *** BEFEHLSAUSFUEHRUNG ***
  74. 740 REM
  75. 750 IFY=2ORY=3THENO=125
  76. 760 IFO=0THENSYSC,1,0:PRINT"[215]AEHLE [212]ISCH- ODER [196]ESSERTWEIN":ME=1:RETURN
  77. 770 IFO=85THENSYSC,0,18:PRINT"[212]ISCHWEIN   "
  78. 780 IFO=125THENSYSC,0,18:PRINT"[196]ESSERTWEIN"
  79. 790 ON Y GOSUB1280,1520,1590,1280,1280,1280
  80. 800 RETURN
  81. 810 IFX=8THENPOKEV+21,0:PRINTCHR$(147)CHR$(9):CLOSE15:END
  82. 820 IFY=0ANDX<>1THENSYSC,4,7:PRINTCHR$(150)"[197]RST [215]EINSORTE <F1> WAEHLEN!":GOTO890
  83. 830 IFX=2 OR X=9 OR ME=1THEN850
  84. 840 IFY<>0THENPRINTCHR$(147):IFX<>1THENSYSC,0,0:PRINTB$(Y)
  85. 850 ON X GOSUB 610,1750,750,1750,1170,1750,1200,810,2670
  86. 860 REM
  87. 870 REM *** MENUE ***
  88. 880 REM
  89. 890 X=0:A$="":IFXX=0THEN920
  90. 900 IFXX=1THENA$=AA$:GOTO920
  91. 910 POKE198,0:WAIT198,1:GETA$:XX=1
  92. 920 SYSC,20,2:IFA$=CHR$(133)THENPRINTCHR$(18)"F1=[215]EINSORTE"CHR$(146):X=1:GOTO940
  93. 930 PRINTCHR$(158)"F1=[215]EINSORTE"
  94. 940 SYSC,21,2:IFA$=CHR$(134)THENPRINTCHR$(18)"F3=[194]ERECHNUNG"CHR$(146):X=3:GOTO960
  95. 950 PRINT"F3=[194]ERECHNUNG"
  96. 960 SYSC,22,2:IFA$=CHR$(135)THENPRINTCHR$(18)"F5=[212]ISCHWEIN"CHR$(146):X=5:GOTO980
  97. 970 PRINT"F5=[212]ISCHWEIN"
  98. 980 SYSC,23,2:IFA$=CHR$(136)THENPRINTCHR$(18)"F7=[196]ESSERTWEIN"CHR$(146):X=7:GOTO1000
  99. 990 PRINT"F7=[196]ESSERTWEIN"
  100. 1000 SYSC,20,20:IFA$=CHR$(137)THENPRINTCHR$(18)"F2=[211]PEICHERN"CHR$(146):X=2:GOTO1020
  101. 1010 PRINT"F2=[211]PEICHERN"
  102. 1020 SYSC,21,20:IFA$=CHR$(138)THENPRINTCHR$(18)"F4=[197]INLESEN"CHR$(146):X=4:GOTO1040
  103. 1030 PRINT"F4=[197]INLESEN"
  104. 1040 SYSC,22,20:IFA$=CHR$(139)THENPRINTCHR$(18)"F6=[204]OESCHEN"CHR$(146):X=6:GOTO1060
  105. 1050 PRINT"F6=[204]OESCHEN"
  106. 1060 SYSC,23,20:IFA$=CHR$(140)THENPRINTCHR$(18)"F8=[208]ROGRAMMENDE"CHR$(146):X=8:GOTO1080
  107. 1070 PRINT"F8=[208]ROGRAMMENDE"
  108. 1080 SYSC,24,12:IFA$="P"THENPRINTCHR$(18)CHR$(29)"[208]=[193]USDRUCK"CHR$(146);:X=9:GOTO1100
  109. 1090 PRINT" [208]=[193]USDRUCK ";
  110. 1100 IFX<1ORX>9THEN910
  111. 1110 POKE198,0:WAIT198,1:GETAA$
  112. 1120 IFAA$<>CHR$(13)THEN890
  113. 1130 GOTO810
  114. 1140 REM
  115. 1150 REM *** BESTIMMUNG DER SUESSE ***
  116. 1160 REM
  117. 1170 O=85:IFME=1THENME=0:GOTO770
  118. 1180 SYSC,0,18:PRINT"[212]ISCHWEIN  "
  119. 1190 RETURN
  120. 1200 O=125:IFME=1THENME=0:GOTO780
  121. 1210 SYSC,0,18:PRINT"[196]ESSERTWEIN"
  122. 1220 RETURN
  123. 1230 REM
  124. 1240 REM *** RECHENPROGRAMME FUER ***
  125. 1250 REM *** BROMBEERE,JOHANNISBEERE ***
  126. 1260 REM *** SAUERKIRSCH,STACHELBEERE **
  127. 1270 REM
  128. 1280 GOSUB2000
  129. 1290 SYSC,1,0:PRINTCHR$(144):INPUT"[211]AFT (L):";SL
  130. 1300 INPUT"[211]AEURE  :";SG
  131. 1310 INPUT"[207]ECHSLE :";OE
  132. 1320 IFOE=0ORSL=0ORSG=0THENRETURN
  133. 1330 ZW=(SL*SG)/8-SL:W=INT(ZW*10+.5)/10
  134. 1340 IFW<.1THENPRINTCHR$(5)"[213]NGUELTIGE [197]INGABEN":RETURN
  135. 1350 OG=(SL*OE)/(ZW+SL)
  136. 1360 BO=O-OG
  137. 1370 A=BO*(ZW+SL):ZZ=INT(A*2.5)/1000
  138. 1380 NS=INT(SL*10.7)/10
  139. 1390 PRINTCHR$(17)CHR$(5)"[215]ASSER      :";W;"L"
  140. 1400 PRINT"[218]UCKER      :";ZZ;"KG"
  141. 1410 PRINT"[199]ESAMTLITER :";W+SL;"L"
  142. 1420 PRINT"[206]AEHRSALZ   :";NS;"G"
  143. 1430 PRINT"[200]EFEN       : ";H$(Y)
  144. 1440 IFX=4 THEN GOSUB 2000:RETURN
  145. 1450 PRINTCHR$(155)CHR$(18)"[218]UCKER UND [215]ASSER DUERFEN ZUSAMMEN"
  146. 1460 PRINTCHR$(18)"NICHT MEHR ALS";W;CHR$(157)" L BETRAGEN !!! "CHR$(146)
  147. 1470 RETURN
  148. 1480 REM
  149. 1490 REM *** RECHENPROGRAMM FUER ***
  150. 1500 REM *** ERDBEERE, HAGEBUTTE ***
  151. 1510 REM
  152. 1520 GOSUB2000
  153. 1530 SYSC,1,0:PRINTCHR$(144):INPUT"[198]RUCHTBREI  (L) :";F
  154. 1540 W=INT(F*.5*10+.5)/10
  155. 1550 ZZ=INT(F*.5*1000+.5)/1000
  156. 1560 MS=W*10
  157. 1570 NS=INT(F*.53*10+.5)/10
  158. 1580 GOTO1650
  159. 1590 GOSUB2000
  160. 1600 SYSC,1,0:PRINTCHR$(144):INPUT"[198]RUCHT (KG) :";F
  161. 1610 W=INT(F*3.2*10+.5)/10
  162. 1620 ZZ=INT(F*1.2*1000+.5)/1000
  163. 1630 MS=INT(F*16+.5)
  164. 1640 NS=INT(MS+.5)/10
  165. 1650 PRINTCHR$(17)CHR$(5)"[215]ASSER     :";W;"L"
  166. 1660 PRINT"[218]UCKER     :";ZZ;"KG ZUM [215]ASSER DAZU!!"
  167. 1670 PRINT"[205]ILCHSAEURE:";MS;"G"
  168. 1680 PRINT"[206]AEHRSALZ  :";NS;"G"
  169. 1690 PRINT"[200]EFEN      : ";H$(Y)
  170. 1700 IFX=4THENGOSUB2000
  171. 1710 RETURN
  172. 1720 REM
  173. 1730 REM *** DISK ***
  174. 1740 REM
  175. 1750 SYSC,1,0:PRINTCHR$(144)
  176. 1760 IFX=2THENSYSC,13,0:IFF=0ANDSL=0THENPRINT"[215]ELCHE [196]ATEN DENN?":RETURN
  177. 1770 Z$="":J$=""
  178. 1780 INPUT"[202]AHRGANG";J$
  179. 1790 INPUT"[218]USATZ  ";Z$
  180. 1800 JJ$=LEFT$(B$(Y),7)+RIGHT$(J$,2)+RIGHT$(Z$,2)
  181. 1810 ONX/2GOSUB1930,2120,2250
  182. 1820 IFX<>4THENRETURN
  183. 1830 SYSC,3,0:PRINTCHR$(144)
  184. 1840 IFFE=1THENFE=0:RETURN
  185. 1850 IFY=2THENPRINT"[198]RUCHTBREI  (L) :";F:GOTO1540
  186. 1860 IFY=3THENPRINT"[198]RUCHT (KG) :";F:GOTO1610
  187. 1870 PRINT"[211]AFT (L):";SL
  188. 1880 PRINT"[211]AEURE  :";SG
  189. 1890 PRINT"[207]ECHSLE :";OE:GOTO1320
  190. 1900 REM
  191. 1910 REM *** FILES SCHREIBEN ***
  192. 1920 REM
  193. 1930 OPEN2,8,2,JJ$+",S,W":GOSUB2330
  194. 1940 IFEN=63 THENPRINT"[198]ILENAME BESTEHT SCHON":GOTO2020
  195. 1950 IFEN>63THENRETURN
  196. 1960 IFEN=0THENPRINT"OKAY"
  197. 1970 IFY=2ORY=3THENPRINT#2,F:GOTO1990
  198. 1980 PRINT#2,SL:PRINT#2,SG:PRINT#2,OE:PRINT#2,O
  199. 1990 CLOSE2
  200. 2000 OE=0:SL=0:SG=0:F=0
  201. 2010 RETURN
  202. 2020 PRINTTAB(15)CHR$(150)"[202]A   -->    @ "
  203. 2030 PRINT"[213]EBERSCHREIBEN?                DRUECKEN"
  204. 2040 PRINTTAB(15)"[206]EIN --> [210][197][212][213][210][206]"
  205. 2050 POKE198,0:WAIT198,1:GETA$:IFA$=CHR$(13)THEN CLOSE 2:RETURN
  206. 2060 IFA$<>CHR$(64)THEN2050
  207. 2070 CLOSE2
  208. 2080 OPEN2,8,2,"@:"+JJ$+",S,W":GOTO1970
  209. 2090 REM
  210. 2100 REM *** FILES LESEN ***
  211. 2110 REM
  212. 2120 GOSUB2000
  213. 2130 OPEN2,8,2,JJ$+",S,R":GOSUB2330
  214. 2140 IFEN=62 THENPRINT"[198]ILE GIBT ES NICHT":CLOSE2:FE=1:RETURN
  215. 2150 IFEN>63THENRETURN
  216. 2160 IFY=2ORY=3THENINPUT#2,F:O=125:GOTO2190
  217. 2170 INPUT#2,SL,SG,OE,O
  218. 2180 IFO=85THENGOSUB1180
  219. 2190 IFO=125THENGOSUB1210
  220. 2200 CLOSE 2
  221. 2210 RETURN
  222. 2220 REM
  223. 2230 REM *** FILES LOESCHEN ***
  224. 2240 REM
  225. 2250 OPEN 2,8,2,JJ$+",S,R":GOSUB2330
  226. 2260 IFEN<>0THENPRINT"[198]ILE GIBT ES NICHT":CLOSE2:RETURN
  227. 2270 CLOSE2
  228. 2280 PRINT#15,"S:"+JJ$:GOSUB2330:IFEN=1THENPRINT"[198]ILE GELOESCHT"
  229. 2290 RETURN
  230. 2300 REM
  231. 2310 REM *** FEHLERKANAL LESEN ***
  232. 2320 REM
  233. 2330 INPUT#15,EN,EM$
  234. 2340 IFEN=21OREN>64THENSYSC,17,0
  235. 2350 IFEN=21THENPRINTEM$;"[196]ISK NICHT FORMATIERT? [193]NDERE EINLEGEN"
  236. 2360 IFEN=72THENPRINT"[196]ISK IST VOLL! [194]ITTE NEUE EINLEGEN"
  237. 2370 IFEN=74THENPRINT"[203]EINE [196]ISK IN DER [198]LOPPY! [196]ISK EINLEGEN"
  238. 2380 IFEN=21OREN>71THENPRINT"UND LETZTEN [208]ROGRAMMPUNKT WIEDERHOLEN!":CLOSE 2
  239. 2390 RETURN
  240. 2400 REM
  241. 2410 REM *** SPRITE ***
  242. 2420 REM
  243. 2430 DATA0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  244. 2440 DATA0,170,0,1,255,0,3,255,128,3,255,128,1,255,0,1,255,0,0,254,0,0,124,0
  245. 2450 DATA0,0,0
  246. 2460 REM
  247. 2470 REM *** SPRITE ***
  248. 2480 REM
  249. 2490 DATA0,0,0,0,56,0,0,56,0,0,56,0,0,16,0,0,124,0,0,56,0,0,56,0,0,56,0,0,124,0
  250. 2500 DATA1,255,0,3,255,128,3,255,128,7,255,192,7,255,192,7,255,192,7,255,192
  251. 2510 DATA3,255,128,3,255,128,1,255,0,0,254,0
  252. 2520 REM
  253. 2530 REM *** WEIN- UND HEFESORTEN ***
  254. 2540 REM
  255. 2550 DATA"[194]ROMBEERE","[194]URGUNDER/[194]ORDEAUX","[197]RDBEERE","[212]OKAIER/[211]UEDWEIN"
  256. 2560 DATA"[200]AGEBUTTE","[208]ORTWEIN/[205]ALAGA/[212]OKAIER","[202]OHANNISBEERE","[211]TEINBERG,[208]ORTWEIN"
  257. 2570 DATA"[211]AUERKIRSCH   ","[194]URGUND,[208]ORTWEIN","[211]TACHELBEERE  "
  258. 2580 DATA"[211]TEINBERG,[211]HERRY/[208]ORTWEIN"
  259. 2590 REM
  260. 2600 REM *** CURSORPOSITIONIERUNG ***
  261. 2610 REM
  262. 2620 DATA32,253,174,32,158,183,138,72,32,253,174,32
  263. 2630 DATA158,183,138,168,104,170,24,32,240,255,96
  264. 2640 REM
  265. 2650 REM *** HARDCOPYROUTINE ***
  266. 2660 REM
  267. 2670 SYSC,24,1:PRINT"[196]RUCKER FERTIGMACHEN, DANN ---> [210][197][212][213][210][206]";
  268. 2680 POKE198,0:WAIT198,1:GETA$:IFA$<>CHR$(13)THENGOSUB2700:RETURN
  269. 2690 PRINTCHR$(19);:OPEN1,4,7:OPEN2,3:GOSUB2710:CLOSE2:CLOSE1
  270. 2700 SYSC,24,1:PRINT"                                      ";:RETURN
  271. 2710 FORI=1TO20:FORJ=1TO20:GET#2,C1$:PRINTCHR$(20);:GET#2,C2$
  272. 2720 PRINTCHR$(157)CHR$(148)C1$C2$;
  273. 2730 PRINT#1,C1$C2$;:NEXT:PRINT#1:NEXT:PRINTCHR$(19);:RETURN
  274.