| 10 |
AUTOGOTO 70 |
| 70 |
"A" GOSUB 7490 :CHAIN "X:ADBCHN.PRG",70 |
| 170 |
RESTORE 190 :GOTO 7290 |
| 190 |
DATA 1,"SUCHE",2,"Nachname",210,"Vorname",220,"Geburtstag",360 |
| 210 |
PRINT "Nachname:":L=0:GOTO 230 |
| 220 |
PRINT "Vorname:":L=1 |
| 230 |
M$(0)="A":INPUT M$(0) |
| 240 |
IF LEN M$(0)<3 LET M$(0)=M$(0)+"aa" |
| 250 |
GOSUB 6490 :IF F5 GOTO 230 |
| 260 |
POKE 12348,16:CLEAR A:B=G |
| 270 |
P=S(0,L):IF M$(0)<D$(P,L) LET R=0:RETURN |
| 280 |
R=INT ((A+B)/2) |
| 290 |
P=S(R,L) |
| 300 |
IF D$(P,L)=M$(0) GOTO 340 |
| 310 |
IF B-A=1 LET R=R+1:P=S(R,L):RETURN |
| 320 |
IF D$(P,L)<M$(0) LET A=R:GOTO 280 |
| 330 |
B=R:GOTO 280 |
| 340 |
IF R IF D$(S(R-1,L),L)=M$(0) LET R=R-1:P=S(R,L):GOTO 340 |
| 350 |
RETURN |
| 360 |
PRINT "Geburtstag:":INPUT M$(0) |
| 370 |
L=2:CLEAR A:B=G:IF M$(0)=""CLEAR U,V:GOTO 400 |
| 380 |
U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=1900:GOSUB 490 |
| 390 |
IF F5 GOSUB 6510 :GOTO 360 |
| 400 |
W=U+V*31 |
| 410 |
P=S(0,2):IF W<VAL LEFT$ (D$(P,5),2)+31*VAL MID$ (D$(P,5),4,2) LET R=0:RETURN |
| 420 |
R=INT ((A+B)/2):P=S(R,2):H=VAL LEFT$ (D$(P,5),2)+31*VAL MID$ (D$(P,5),4,2) |
| 430 |
IF H=W GOTO 470 |
| 440 |
IF B-A=1 LET R=R+1:P=S(R,L):RETURN |
| 450 |
IF H<W LET A=R:GOTO 420 |
| 460 |
B=R:GOTO 420 |
| 470 |
IF R LET H=S(R-1,2):IF VAL LEFT$ (D$(H,5),2)+31*VAL MID$ (D$(H,5),4,2)=W LET P=H:R=R-1:GOTO 470 |
| 480 |
RETURN |
| 490 |
CLEAR F5:IF U<1 OR U>31 OR V<1 OR V>12 OR W<1890 OR W>1999LET F5=1:GOTO 520 |
| 500 |
IF (V=4 OR V=6 OR V=9 OR V=11) AND U>30 LET F5=1:GOTO 520 |
| 510 |
IF V=2 AND U>29 LET F5=1 |
| 520 |
RETURN |
| 530 |
RESTORE 550 :GOTO 7290 |
| 550 |
DATA 1,LEFT$ (D$(P,1)+" "+D$(P,0),24),2,"o.k.",610 |
| 560 |
DATA "weiter",570,"zurueck",590 |
| 570 |
R=R+1:IF R>G BEEP 1,255,100:R=G |
| 580 |
P=S(R,L):GOTO 530 |
| 590 |
R=R-1:IF -R CLEAR R:BEEP 1,255,100 |
| 600 |
P=S(R,L):GOTO 530 |
| 610 |
RETURN |
| 1200 |
GRAPH :CROTATE 1:GLCURSOR (480,0):SORGN :CLEAR GX,GY,G1,G2,G3,Z,G4 |
| 1210 |
RESTORE 1230 :GOTO 7290 |
| 1230 |
DATA 1,"GRAFIK",8,"Zeile",1290,"Druck",1440,"Farbe",1260,"Typ" |
| 1240 |
DATA 1370,"Unter.",1810,"Zeigen",1270,"Suchen",1740,"RAHMEN",1750,"MENU |
| 1250 |
DATA 1660 |
| 1260 |
GOSUB 1680 :GOTO 1210 |
| 1270 |
GLCURSOR (-GY,-Z-100):GOSUB 6300 :GLCURSOR (-GY,-GX) |
| 1280 |
GOTO 1210 |
| 1290 |
GX=0:RESTORE 1310 :GOTO 7290 |
| 1310 |
DATA 1,"ZEILE",8,"2.4mm",1340,"4.8mm",1340,"7.2mm",1340 |
| 1320 |
DATA " 9.6mm",1340,"12.0mm",1340,"14.4mm",1340,"16.8mm",1340,"19.2mm" |
| 1330 |
DATA 1340,"GRAFIK",1210 |
| 1340 |
CSIZE K+1:GY=GY+12*K+20 |
| 1350 |
GLCURSOR (-GY,0):G2=K+1 |
| 1360 |
GOTO 1210 |
| 1370 |
RESTORE 1390 :GOTO 7290 |
| 1390 |
DATA 1,"SCHRIFT",2,"normal",1410,"g e s p e r r t",1420,"sscchhaatteenn |
| 1400 |
DATA 1430 |
| 1410 |
G1=0:GOTO 1210 |
| 1420 |
G1=1:GOTO 1210 |
| 1430 |
G1=2:GOTO 1210 |
| 1440 |
IF GY=0 BEEP 1,255,100:GOTO 1290 |
| 1450 |
RESTORE 1470 :GOTO 7290 |
| 1470 |
DATA 0,7,"Name",1490,"Vorname",1490,"Strasse",1490,"Ort",1490,"Telefon |
| 1480 |
DATA 1490,"Geb.dat.",1490,"Bemerkung",1490,"<Text>",1500 |
| 1490 |
T$(0)=D$(P,K)+" ":GOTO 1510 |
| 1500 |
GOSUB 6420 |
| 1510 |
A=GX,B=GY+2*G2 |
| 1520 |
FOR I=1 TO LEN T$(0) |
| 1530 |
IF G3 COLOR RND 7-1,7 |
| 1540 |
LPRINT "P"+MID$ (T$(0),I,1) |
| 1550 |
IF G3 COLOR RND 7-1,7 |
| 1560 |
IF G1=2 GLCURSOR (-GY+G2,-GX-G2):LPRINT "P"+MID$ (T$(0),I,1) |
| 1570 |
GX=GX+G2*6:IF G1=1 LET GX=GX+G2*6 |
| 1580 |
GLCURSOR (-GY,-GX) |
| 1590 |
NEXT I |
| 1600 |
IF GX>Z LET Z=GX |
| 1610 |
IF G3 COLOR RND 7-1,7 |
| 1620 |
ON G4+1 GOTO 1640 ,1630 ,1630 ,1650 |
| 1630 |
LLINE (-B,-GX)-(-B,-A),NOT (G4-1)+2 |
| 1640 |
GLCURSOR (-GY,-GX):GOTO 1210 |
| 1650 |
LLINE (-B,-GX)-(-B,-A),0:LLINE (-B-5,-A)-(-B-5,-GX):GLCURSOR (-GY,-GX):GOTO 1210 |
| 1660 |
GLCURSOR (-480,-Z-100):LPRINT CHR$ 27+"@" |
| 1670 |
GOTO 70 |
| 1680 |
RESTORE 1700 :GOTO 7290 |
| 1700 |
DATA 0,7,"Schwarz",1720,"Violett",1720,"Rot",1720,"Rosa",1720,"Gruen" |
| 1710 |
DATA 1720,"Blau",1720,"Gelb",1720,"bunt/ohne",1730 |
| 1720 |
G3=0:COLOR K,7:RETURN |
| 1730 |
G3=1:RETURN |
| 1740 |
GOSUB 170 :GOSUB 530 :GOTO 1210 |
| 1750 |
GOSUB 1680 :LLINE (-GY-20,-Z)-(0,18),0,K,B:POKE &FB20,0 |
| 1760 |
RESTORE 1780 :GOTO 7290 |
| 1780 |
DATA 1,"Hintergrund ausfuellen ?",1,"nein",1660,"ja",1790 |
| 1790 |
GOSUB 1680 |
| 1800 |
PAINT 9:GOTO 1660 |
| 1810 |
RESTORE 1830 :GOTO 7290 |
| 1830 |
DATA 1,"UNTERSTREICHEN",3,"nein",1850,"punktiert",1850,"einfach",1850 |
| 1840 |
DATA "doppelt",1850 |
| 1850 |
G4=K:GOTO 1210 |
| 6300 |
WAIT :CURSOR 17,3:PRINT CHR$ 91;"ENTER";CHR$ 93:WAIT 0:BEEP 1,1,25:CLS :RETURN |
| 6420 |
PRINT "Text eingeben:":PRINT CHR$ 91;"ENTER";CHR$ 93;" = "; |
| 6430 |
IF LEN T$(0)>14 PRINT LEFT$ (T$(0),10);" ...":GOTO 6460 |
| 6440 |
IF ASC T$(0)<33 PRINT "<SPC>":GOTO 6460 |
| 6450 |
PRINT T$(0) |
| 6460 |
INPUT T$(0) |
| 6470 |
POKE 12348,16:CLS |
| 6480 |
RETURN |
| 6490 |
CLEAR F5:H=ASC LEFT$ (M$(0),1):IF H<65 OR H>90 AND H<>32 AND H<>0 LET F5=1 |
| 6500 |
H=ASC MID$ (M$(0),2,1):IF H<97 OR H>122 AND H<>46 AND H<>32 AND H<>0 LET F5=1 |
| 6510 |
CLS :IF F5 BEEP 1,255,200:RESTORE 6550 :GOTO 7290 |
| 6520 |
POKE 12348,16 |
| 6530 |
RETURN |
| 7290 |
CLS :WAIT 0:READ F0:IF F0 READ M$(0):PRINT M$(0) |
| 7300 |
X=0:Y=F0:READ N:Q=INT (N/(4-F0)):S=16-4*Q |
| 7310 |
FOR I=0 TO N:J=INT (I/(4-F0)):CURSOR J*S,I-(4-F0)*J+F0:READ M$(0),Z(I) |
| 7320 |
PRINT " ";LEFT$ (M$(0),S+6-8*SGN Q):NEXT I |
| 7330 |
K=Y-F0+(4-F0)*X:IF K>N LET X=Q:Y=F0+N-(4-F0)*X:K=N |
| 7340 |
CURSOR X*S,Y:PRINT "->" |
| 7350 |
T=ASC INKEY$ :IF T=0 GOTO 7350 |
| 7360 |
BEEP 1,1,25 |
| 7370 |
IF T=5 CURSOR X*S,Y:PRINT " ":Y=Y+1:IF Y>3 LET Y=F0:X=X+1:IF X>Q CLEAR X |
| 7380 |
IF T=4 CURSOR X*S,Y:PRINT " ":Y=Y-1:IF Y<F0 LET Y=3:X=X-1:IF -X CLEAR X |
| 7390 |
IF T=14 CURSOR X*S,Y:PRINT " ":X=X+1:IF X>Q CLEAR X |
| 7400 |
IF T=15 CURSOR X*S,Y:PRINT " ":X=X-1:IF X<0 LET X=Q |
| 7410 |
IF T=13 CLS :CLEAR X,Y:GOTO Z(K) |
| 7420 |
GOTO 7330 |
| 7490 |
RESTORE 7500 :GOTO 7290 |
| 7500 |
DATA 1,"Externer Programmteil !",1,"CE-140F o.k.",7510,"Abbruch",7520 |
| 7510 |
RETURN |
| 7520 |
CLS :END |