10 REM  *******************************
20 REM  **                           **
30 REM  **   FRUCHTWEINBEREITUNG     **
40 REM  **         VON               **
50 REM  **   SIEGFRIED DAHLMANN      **
60 REM  **     SCHLOSS STR.9         **
70 REM  **     4044 KAARST 2         **
80 REM  **                           **
90 REM  *******************************
100 PRINTCHR$(147)CHR$(14)CHR$(8)
110 C=828:V=53248
120 REM
130 REM *** DATEN EINLESEN ***
140 REM
150 POKEV+32,10:POKEV+33,13
160 FORI=0TO62:READQ:POKE896+I,Q:NEXTI
170 FORI=0TO62:READQ:POKE704+I,Q:NEXTI
180 FORI=1TO6:READB$(I),H$(I):NEXTI
190 FORI=828TO850
200 READQ:POKEI,Q:NEXTI
210 OPEN15,8,15,"IO"
220 SYSC,0,0
230 FORI=1TO8:PRINTCHR$(17)CHR$(151)"[198]RUCHT",
240 FORJ=1TO50:NEXTJ,I
250 FORI=1TO8:PRINTCHR$(17)CHR$(30)"W E I N",
260 FORJ=1TO50:NEXTJ,I
270 FORJ=1TO200:NEXTJ
280 SYSC,20,0:PRINTCHR$(5)"[211]IEGFRIED [196]AHLMANN"
290 PRINT"[211]CHLOSS STR.9"
300 PRINT"4044 [203][193][193][210][211][212][160]2"
310 SYSC,0,0:FORJ=1TO500:NEXTJ
320 FORI=1TO8:PRINTCHR$(17)"         ",
330 FORJ=1TO50:NEXTJ,I
340 FORI=1TO8:PRINTCHR$(17)"         ",
350 FORJ=1TO50:NEXTJ,I
360 POKEV+32,5:POKEV+33,2
370 SYSC,7,15:PRINTCHR$(153)"[198][160]R U C H T W E I N"
380 SYSC,10,19:PRINT"BEREITUNG"
390 POKE2041,14:POKE2042,11:POKEV+40,10:POKEV+41,13
400 POKEV+21,6:POKEV+23,6:POKEV+29,6
410 POKEV+2,75:POKEV+4,75:POKEV+3,100:POKEV+5,100
420 SYSC,24,11:PRINT"[194]ITTE [212]ASTE DRUECKEN!"CHR$(146);:FORI=1TO50:NEXTI
430 POKE198,0:WAIT198,1
440 FORI=75TO190:POKEV+2,I:POKEV+4,I:NEXTI
450 PRINTCHR$(147):POKEV+32,6:POKEV+33,6
460 FORI=39TO0STEP-1
470 POKE1024+I,127:POKE55296+I,5
480 POKE1784+I,127:POKE56056+I,5
490 POKE1984+I,127:POKE56256+I,5
500 NEXTI
510 FORI= 0 TO 880 STEP 40
520 POKE1064+I,127:POKE55336+I,5
530 POKE1103+I,127:POKE55375+I,5
540 NEXTI
550 SYSC,12,11:PRINTCHR$(154)"[218]UERST F1 WAEHLEN,"
560 PRINT:PRINTTAB(7)" DANN <[160][210][197][212][213][210][206][160]> DRUECKEN ";
570 GOTO890
580 REM
590 REM *** WEINSORTENWAHL ***
600 REM
610 POKEV+32,9:POKEV+33,9:O=0
620 SYSC,1,15:PRINTCHR$(158)"[215]EINSORTEN":PRINT
630 FORI=1TO3:PRINT:PRINTTAB(2)B$(I)TAB(12)"......................";I:NEXTI
640 FORI=4TO6:PRINT:PRINTTAB(2)B$(I)TAB(16)"..................";I:NEXTI
650 SYSC,17,18:PRINTCHR$(18)CHR$(153)"[218]AHL EINGEBEN"CHR$(146):FORI=1TO50:NEXTI
660 SYSC,17,18:PRINT"[218]AHL EINGEBEN":FORI=1TO50:NEXTI
670 GETA$:IFA$=""THEN650
680 IFASC(A$)<49ORASC(A$)>54THEN670
690 POKEV+21,0:POKEV+32,2:POKEV+33,2:Y=VAL(A$)
700 PRINTCHR$(147)
710 SYSC,0,1:PRINTB$(Y):RETURN
720 REM
730 REM *** BEFEHLSAUSFUEHRUNG ***
740 REM
750 IFY=2ORY=3THENO=125
760 IFO=0THENSYSC,1,0:PRINT"[215]AEHLE [212]ISCH- ODER [196]ESSERTWEIN":ME=1:RETURN
770 IFO=85THENSYSC,0,18:PRINT"[212]ISCHWEIN   "
780 IFO=125THENSYSC,0,18:PRINT"[196]ESSERTWEIN"
790 ON Y GOSUB1280,1520,1590,1280,1280,1280
800 RETURN
810 IFX=8THENPOKEV+21,0:PRINTCHR$(147)CHR$(9):CLOSE15:END
820 IFY=0ANDX<>1THENSYSC,4,7:PRINTCHR$(150)"[197]RST [215]EINSORTE <F1> WAEHLEN!":GOTO890
830 IFX=2 OR X=9 OR ME=1THEN850
840 IFY<>0THENPRINTCHR$(147):IFX<>1THENSYSC,0,0:PRINTB$(Y)
850 ON X GOSUB 610,1750,750,1750,1170,1750,1200,810,2670
860 REM
870 REM *** MENUE ***
880 REM
890 X=0:A$="":IFXX=0THEN920
900 IFXX=1THENA$=AA$:GOTO920
910 POKE198,0:WAIT198,1:GETA$:XX=1
920 SYSC,20,2:IFA$=CHR$(133)THENPRINTCHR$(18)"F1=[215]EINSORTE"CHR$(146):X=1:GOTO940
930 PRINTCHR$(158)"F1=[215]EINSORTE"
940 SYSC,21,2:IFA$=CHR$(134)THENPRINTCHR$(18)"F3=[194]ERECHNUNG"CHR$(146):X=3:GOTO960
950 PRINT"F3=[194]ERECHNUNG"
960 SYSC,22,2:IFA$=CHR$(135)THENPRINTCHR$(18)"F5=[212]ISCHWEIN"CHR$(146):X=5:GOTO980
970 PRINT"F5=[212]ISCHWEIN"
980 SYSC,23,2:IFA$=CHR$(136)THENPRINTCHR$(18)"F7=[196]ESSERTWEIN"CHR$(146):X=7:GOTO1000
990 PRINT"F7=[196]ESSERTWEIN"
1000 SYSC,20,20:IFA$=CHR$(137)THENPRINTCHR$(18)"F2=[211]PEICHERN"CHR$(146):X=2:GOTO1020
1010 PRINT"F2=[211]PEICHERN"
1020 SYSC,21,20:IFA$=CHR$(138)THENPRINTCHR$(18)"F4=[197]INLESEN"CHR$(146):X=4:GOTO1040
1030 PRINT"F4=[197]INLESEN"
1040 SYSC,22,20:IFA$=CHR$(139)THENPRINTCHR$(18)"F6=[204]OESCHEN"CHR$(146):X=6:GOTO1060
1050 PRINT"F6=[204]OESCHEN"
1060 SYSC,23,20:IFA$=CHR$(140)THENPRINTCHR$(18)"F8=[208]ROGRAMMENDE"CHR$(146):X=8:GOTO1080
1070 PRINT"F8=[208]ROGRAMMENDE"
1080 SYSC,24,12:IFA$="P"THENPRINTCHR$(18)CHR$(29)"[208]=[193]USDRUCK"CHR$(146);:X=9:GOTO1100
1090 PRINT" [208]=[193]USDRUCK ";
1100 IFX<1ORX>9THEN910
1110 POKE198,0:WAIT198,1:GETAA$
1120 IFAA$<>CHR$(13)THEN890
1130 GOTO810
1140 REM
1150 REM *** BESTIMMUNG DER SUESSE ***
1160 REM
1170 O=85:IFME=1THENME=0:GOTO770
1180 SYSC,0,18:PRINT"[212]ISCHWEIN  "
1190 RETURN
1200 O=125:IFME=1THENME=0:GOTO780
1210 SYSC,0,18:PRINT"[196]ESSERTWEIN"
1220 RETURN
1230 REM
1240 REM *** RECHENPROGRAMME FUER ***
1250 REM *** BROMBEERE,JOHANNISBEERE ***
1260 REM *** SAUERKIRSCH,STACHELBEERE **
1270 REM
1280 GOSUB2000
1290 SYSC,1,0:PRINTCHR$(144):INPUT"[211]AFT (L):";SL
1300 INPUT"[211]AEURE  :";SG
1310 INPUT"[207]ECHSLE :";OE
1320 IFOE=0ORSL=0ORSG=0THENRETURN
1330 ZW=(SL*SG)/8-SL:W=INT(ZW*10+.5)/10
1340 IFW<.1THENPRINTCHR$(5)"[213]NGUELTIGE [197]INGABEN":RETURN
1350 OG=(SL*OE)/(ZW+SL)
1360 BO=O-OG
1370 A=BO*(ZW+SL):ZZ=INT(A*2.5)/1000
1380 NS=INT(SL*10.7)/10
1390 PRINTCHR$(17)CHR$(5)"[215]ASSER      :";W;"L"
1400 PRINT"[218]UCKER      :";ZZ;"KG"
1410 PRINT"[199]ESAMTLITER :";W+SL;"L"
1420 PRINT"[206]AEHRSALZ   :";NS;"G"
1430 PRINT"[200]EFEN       : ";H$(Y)
1440 IFX=4 THEN GOSUB 2000:RETURN
1450 PRINTCHR$(155)CHR$(18)"[218]UCKER UND [215]ASSER DUERFEN ZUSAMMEN"
1460 PRINTCHR$(18)"NICHT MEHR ALS";W;CHR$(157)" L BETRAGEN !!! "CHR$(146)
1470 RETURN
1480 REM
1490 REM *** RECHENPROGRAMM FUER ***
1500 REM *** ERDBEERE, HAGEBUTTE ***
1510 REM
1520 GOSUB2000
1530 SYSC,1,0:PRINTCHR$(144):INPUT"[198]RUCHTBREI  (L) :";F
1540 W=INT(F*.5*10+.5)/10
1550 ZZ=INT(F*.5*1000+.5)/1000
1560 MS=W*10
1570 NS=INT(F*.53*10+.5)/10
1580 GOTO1650
1590 GOSUB2000
1600 SYSC,1,0:PRINTCHR$(144):INPUT"[198]RUCHT (KG) :";F
1610 W=INT(F*3.2*10+.5)/10
1620 ZZ=INT(F*1.2*1000+.5)/1000
1630 MS=INT(F*16+.5)
1640 NS=INT(MS+.5)/10
1650 PRINTCHR$(17)CHR$(5)"[215]ASSER     :";W;"L"
1660 PRINT"[218]UCKER     :";ZZ;"KG ZUM [215]ASSER DAZU!!"
1670 PRINT"[205]ILCHSAEURE:";MS;"G"
1680 PRINT"[206]AEHRSALZ  :";NS;"G"
1690 PRINT"[200]EFEN      : ";H$(Y)
1700 IFX=4THENGOSUB2000
1710 RETURN
1720 REM
1730 REM *** DISK ***
1740 REM
1750 SYSC,1,0:PRINTCHR$(144)
1760 IFX=2THENSYSC,13,0:IFF=0ANDSL=0THENPRINT"[215]ELCHE [196]ATEN DENN?":RETURN
1770 Z$="":J$=""
1780 INPUT"[202]AHRGANG";J$
1790 INPUT"[218]USATZ  ";Z$
1800 JJ$=LEFT$(B$(Y),7)+RIGHT$(J$,2)+RIGHT$(Z$,2)
1810 ONX/2GOSUB1930,2120,2250
1820 IFX<>4THENRETURN
1830 SYSC,3,0:PRINTCHR$(144)
1840 IFFE=1THENFE=0:RETURN
1850 IFY=2THENPRINT"[198]RUCHTBREI  (L) :";F:GOTO1540
1860 IFY=3THENPRINT"[198]RUCHT (KG) :";F:GOTO1610
1870 PRINT"[211]AFT (L):";SL
1880 PRINT"[211]AEURE  :";SG
1890 PRINT"[207]ECHSLE :";OE:GOTO1320
1900 REM
1910 REM *** FILES SCHREIBEN ***
1920 REM
1930 OPEN2,8,2,JJ$+",S,W":GOSUB2330
1940 IFEN=63 THENPRINT"[198]ILENAME BESTEHT SCHON":GOTO2020
1950 IFEN>63THENRETURN
1960 IFEN=0THENPRINT"OKAY"
1970 IFY=2ORY=3THENPRINT#2,F:GOTO1990
1980 PRINT#2,SL:PRINT#2,SG:PRINT#2,OE:PRINT#2,O
1990 CLOSE2
2000 OE=0:SL=0:SG=0:F=0
2010 RETURN
2020 PRINTTAB(15)CHR$(150)"[202]A   -->    @ "
2030 PRINT"[213]EBERSCHREIBEN?                DRUECKEN"
2040 PRINTTAB(15)"[206]EIN --> [210][197][212][213][210][206]"
2050 POKE198,0:WAIT198,1:GETA$:IFA$=CHR$(13)THEN CLOSE 2:RETURN
2060 IFA$<>CHR$(64)THEN2050
2070 CLOSE2
2080 OPEN2,8,2,"@:"+JJ$+",S,W":GOTO1970
2090 REM
2100 REM *** FILES LESEN ***
2110 REM
2120 GOSUB2000
2130 OPEN2,8,2,JJ$+",S,R":GOSUB2330
2140 IFEN=62 THENPRINT"[198]ILE GIBT ES NICHT":CLOSE2:FE=1:RETURN
2150 IFEN>63THENRETURN
2160 IFY=2ORY=3THENINPUT#2,F:O=125:GOTO2190
2170 INPUT#2,SL,SG,OE,O
2180 IFO=85THENGOSUB1180
2190 IFO=125THENGOSUB1210
2200 CLOSE 2
2210 RETURN
2220 REM
2230 REM *** FILES LOESCHEN ***
2240 REM
2250 OPEN 2,8,2,JJ$+",S,R":GOSUB2330
2260 IFEN<>0THENPRINT"[198]ILE GIBT ES NICHT":CLOSE2:RETURN
2270 CLOSE2
2280 PRINT#15,"S:"+JJ$:GOSUB2330:IFEN=1THENPRINT"[198]ILE GELOESCHT"
2290 RETURN
2300 REM
2310 REM *** FEHLERKANAL LESEN ***
2320 REM
2330 INPUT#15,EN,EM$
2340 IFEN=21OREN>64THENSYSC,17,0
2350 IFEN=21THENPRINTEM$;"[196]ISK NICHT FORMATIERT? [193]NDERE EINLEGEN"
2360 IFEN=72THENPRINT"[196]ISK IST VOLL! [194]ITTE NEUE EINLEGEN"
2370 IFEN=74THENPRINT"[203]EINE [196]ISK IN DER [198]LOPPY! [196]ISK EINLEGEN"
2380 IFEN=21OREN>71THENPRINT"UND LETZTEN [208]ROGRAMMPUNKT WIEDERHOLEN!":CLOSE 2
2390 RETURN
2400 REM
2410 REM *** SPRITE ***
2420 REM
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
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
2450 DATA0,0,0
2460 REM
2470 REM *** SPRITE ***
2480 REM
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
2500 DATA1,255,0,3,255,128,3,255,128,7,255,192,7,255,192,7,255,192,7,255,192
2510 DATA3,255,128,3,255,128,1,255,0,0,254,0
2520 REM
2530 REM *** WEIN- UND HEFESORTEN ***
2540 REM
2550 DATA"[194]ROMBEERE","[194]URGUNDER/[194]ORDEAUX","[197]RDBEERE","[212]OKAIER/[211]UEDWEIN"
2560 DATA"[200]AGEBUTTE","[208]ORTWEIN/[205]ALAGA/[212]OKAIER","[202]OHANNISBEERE","[211]TEINBERG,[208]ORTWEIN"
2570 DATA"[211]AUERKIRSCH   ","[194]URGUND,[208]ORTWEIN","[211]TACHELBEERE  "
2580 DATA"[211]TEINBERG,[211]HERRY/[208]ORTWEIN"
2590 REM
2600 REM *** CURSORPOSITIONIERUNG ***
2610 REM
2620 DATA32,253,174,32,158,183,138,72,32,253,174,32
2630 DATA158,183,138,168,104,170,24,32,240,255,96
2640 REM
2650 REM *** HARDCOPYROUTINE ***
2660 REM
2670 SYSC,24,1:PRINT"[196]RUCKER FERTIGMACHEN, DANN ---> [210][197][212][213][210][206]";
2680 POKE198,0:WAIT198,1:GETA$:IFA$<>CHR$(13)THENGOSUB2700:RETURN
2690 PRINTCHR$(19);:OPEN1,4,7:OPEN2,3:GOSUB2710:CLOSE2:CLOSE1
2700 SYSC,24,1:PRINT"                                      ";:RETURN
2710 FORI=1TO20:FORJ=1TO20:GET#2,C1$:PRINTCHR$(20);:GET#2,C2$
2720 PRINTCHR$(157)CHR$(148)C1$C2$;
2730 PRINT#1,C1$C2$;:NEXT:PRINT#1:NEXT:PRINTCHR$(19);:RETURN