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 |