10 REM Programm "Stereo" (c) Fritz J”rn, Juli 1994 20 REM Mit wiederholenden Streifen. (c) Fritz J”rn, Juli 1994 30 REM A und B sind jeweils repetierende Zeilenteile. Um 40 horizontale 40 REM Punkte zusammenzubekommen, gibt's A und B. B folgt direkt auf A. 50 REM Fr 200 Zeilen gibt's A(200) und B(200) zum Merken der Struktur. 60 REM Das Programm máte noch optimiert werden: Ganzzahlarithmetik! 70 REM Man k”nnte die A- und B-Felder nur einmal errechnen und 80 REM in einer Datei speichern. 90 DIM A(200), B(200), BA(32), BB(32) 100 REM Es ging nicht mit allen 32 Bits, deshalb statt 1-32 nur 12-32... 110 KEY OFF 'schaltet die Funktionszeile unten aus 120 SCREEN 2 'schaltet auf feinen Grafikmodus (0-199 von oben nach unten 130 CLS 'und 0-639 von links nach rechts) 140 PRINT 150 PRINT 160 PRINT 170 PRINT 180 PRINT 190 PRINT 200 PRINT 210 PRINT " Stereo-Programm von Fritz J”rn" 220 PRINT "Schwarzweiáausgabe (c) Fritz J”rn Juli 1994, Tel.u.Fax +49-69-733362" 230 PRINT 240 PRINT "Das Programm zeichnet erst eine Zufallsfl„che mit Streifen," 250 PRINT "piept dann einmal, und macht anschlieáend die ¯L”cher®." 260 PRINT " Zwei T”nchen und das Bild ist fertig. " 270 PRINT 280 PRINT "Sollen die L”cher normal sichtbar sein, S drcken," 290 PRINT" sonst irgendeine Taste zum Starten."; 300 A$=INKEY$ 310 SI=0 ' L”cher sollen nicht sichtbar sein, wenn si=0 320 IF A$="s" OR A$="S" THEN SI=1 330 IF A$="" THEN GOTO 300 'weiter auf Eingabe warten 340 CLS 350 FOR J=1 TO 200 'alle Zeilen von oben bis unten 360 A(J)=0 370 B(J)=0 380 REM A(J) und B(J) mit zuf„lligen Bits auffllen 390 FOR I=13 TO 32 'alle Bits von A und B 400 IF RND < .5 THEN P=0 ELSE P=1 'zuf„llig 0 oder 1 erzeugen 410 A(J)=A(J)+P*2^I 420 IF RND < .5 THEN P=0 ELSE P=1 'zuf„llig 0 oder 1 erzeugen 430 B(J)=B(J)+P*2^I 440 NEXT I 450 REM 32 Bits aus A(J) und B(J) extrahieren und in BA und BB schreiben 460 FOR I=13 TO 32 470 T=INT(A(J)/2^I) 480 IF 2*INT(T/2)=T THEN BA(I)=1 ELSE BA(I)=0 490 T=INT(B(J)/2^I) 500 IF 2*INT(T/2)=T THEN BB(I)=1 ELSE BB(I)=0 510 REM Gleich alle nebeneinander zeigen 520 FOR R= 1 TO 16 530 IF BA(I) = 1 THEN PSET (R*40+I-53,J-1) 'Punkte 0...19 weil I von 13...32 540 IF BB(I) = 1 THEN PSET (R*40+I-33,J-1) 'Punkte 20...39 550 NEXT R 560 NEXT I 570 NEXT J 580 BEEP ' ************ Ende der fl„chigen Vorrunde *********** 590 REM Nach dem Zeichnen der zweidimensionalen Fl„che jetzt die 600 REM šberlagerung. (K”nnte man auch gleich machen...) 610 REM n„chste 31 Runden, jeweils daneben 620 FOR J=1 TO 200 'auch zeilenm„áig J=20-39, 60-79 etc. berspr. 630 IF 2*INT(INT(J/20)/2)=INT(J/20) THEN GOTO 840 'J=20-39, 60-79 etc. 640 REM 32 Bits aus A(J) und B(J) extrahieren und in BA und BB schreiben 650 FOR I=13 TO 32 660 IF SI=0 GOTO 700 'Sollen L”cher zu sehen sein? Wenn ja, si=1 670 BA(I)=1 680 BB(I)=1 690 GOTO 740 700 T=INT(A(J)/2^I) 710 IF 2*INT(T/2)=T THEN BA(I)=1 ELSE BA(I)=0 720 T=INT(B(J)/2^I) 730 IF 2*INT(T/2)=T THEN BB(I)=1 ELSE BB(I)=0 740 REM Jede Runde S Punkte nach rechts schieben 750 S=2 760 FOR R=1 TO 14 STEP 2 'STEP 2 um jede 2. Spalte zu berspringen 770 REM Sollen die L”cher ¯leicht® sichtbar bleiben, die Presets weglassen. 780 IF BA(I)= 1 THEN PSET (S+S*R+R*40+I-13,J-1) 790 IF BA(I)= 0 THEN PRESET (S+S*R+R*40+I-13,J-1) 800 IF BB(I)= 1 THEN PSET (S+S*R+R*40+I+ 7,J-1) 810 IF BB(I)= 0 THEN PRESET (S+S*R+R*40+I+ 7,J-1) 820 NEXT R 830 NEXT I 840 NEXT J 850 BEEP 860 BEEP 870 IF INKEY$="" GOTO 870 'Warten, bis eine Taste gedrckt wird. 880 CLS 890 END