'" dreierneu
'" Demo schnelles Flächenfüllen
'" P. Kittel, CBM Ffm, 4.4.87, 18.6.88

CLEAR,4000
CLEAR,7500

sc&=PEEKL(WINDOW(7) + 46) '" Screen-Struktur
Hoehe=PEEKW(sc&+14):PRINT '" Screen-Höhe
IF Hoehe=256 THEN
  ym=250:y1=140:y0=58:ye=119:zl=29:PRINT "PAL-Schirm"
          ELSE
  ym=200:y1=105:y0=45:ye= 93:zl=23:PRINT "NTSC-Schirm"
  END IF

PRINT
PRINT "Der Farbzyklus ist hier durch fz=0 (bzw. a$=";CHR$(34);"o";CHR$(34);")"
PRINT "lahmgelegt, er ist nur bei Compilation"
PRINT "sinnvoll, weil er sehr zeitaufwendig ist."
a$="o"
'" PRINT "Mit(m) oder ohne(o) Farbzyklus ? ";
'" a$="":WHILE a$<>"m" AND a$<>"o":a$=INKEY$:WEND
'" PRINT a$:PRINT 
fz=a$="m"

SCREEN 1,570,ym,4,2
WINDOW 2," Demo schnelles Füllen von Dreiecksflächen, Ende mit q ",(0,0)-(500,ym-15),0,1
x1=250
x2=290:y2=y1
z1=0  :z2=0
co=2

nn=15
DIM pr(nn),pg(nn),pb(nn),pra(nn+1),pga(nn+1),pba(nn+1)
FOR i=2 TO nn:PALETTE i,0,0,0:NEXT
fr=0:fg=0:fb=0:pf=0:ff=4000:fs=0:c7=7/15:c6=15*16:c2=15*256
cc=0:cf=1:co2=0
PALETTE 0,.5,.5,.5
COLOR 1
LOCATE 1,2:PRINT "Schnelle";:   LOCATE 1   ,50:PRINT "Flächenfüllen";
LOCATE 2,2:PRINT "Grafik"  ;:   LOCATE 2   ,52:PRINT "mit Blitter";
                                LOCATE zl-1,58:PRINT "Bitte";
                                LOCATE zl  ,51:PRINT "vergleichen!";
IF fz THEN
  LOCATE zl/2-1,25:PRINT "Bitte etwas Geduld...";
  END IF
COLOR 2
LOCATE zl-1,2:PRINT "4096";
LOCATE zl  ,2:PRINT "Farbtöne";

'" Die Art der Farbweiterschaltung wird
'" durch die Variablen fs und ff in
'" späteren Zeilen bestimmt.
'" Hier ist viel Raum für eigene
'" Experimente.

WHILE INKEY$<>"q" ' Endlosschleife bis q-Taste

  x3=x2 :y3=y2
  z1=z1+.01         :IF z1>6.28 THEN z1=0
  z2=z2+.03*SIN(z1) :IF z2>6.28 THEN z2=0
  z3=z3+z1*SIN(z2)/4:IF z3>6.28 THEN z3=0

  x2=INT(120*(1+SIN(z2))*COS(z3)+x1)
  y2=INT( y0*(1+SIN(z2))*SIN(z3)+ye)
  AREA (x1,y1):AREA (x2,y2):AREA (x3,y3)

  IF fz=0 THEN
    pra(co)=pr(co):pga(co)=pg(co):pba(co)=pb(co)
    PALETTE co,pr(co),pg(co),pb(co)
    END IF

  '" Farbweiterschaltung
  co=co+1:IF co>nn THEN
    co=2
    co2=co2+1
    IF co2>1 OR fz=0 THEN
      co2=0
      fs=fs+.1:IF fs>7 THEN fs=fs-7
      ff=ff+273.16*(1+COS(fs)*1.02):IF ff>4095 THEN ff=ff-4095
      fi=INT(ff)
      ar=fr:ag=fg:ab=fb
      fr=(fi AND 15)/15
      fg=(fi AND 15*16 )/c6
      fb=(fi AND 15*256)/c2  
      pr(15)=fr:pg(15)=fg:pb(15)=fb ' neue Farbe
      cc=cc+1:IF cc>20 THEN cc=0:cf=-cf
      IF cf*(fr+ar)>cf THEN
        fr2=2-fr:m=(fr2-ar)/14:a=ar-m
        FOR i=2 TO 14:pr(i)=a+i*m:IF pr(i)>1 THEN pr(i)=2-pr(i)
          NEXT
              ELSE
        fr2=-fr:m=(fr2-ar)/14:a=ar-m
        FOR i=2 TO 14:pr(i)=a+i*m:IF pr(i)<0 THEN pr(i)=-pr(i)
          NEXT
        END IF
      IF cf*(fg+ag)>cf THEN
        fg2=2-fg:m=(fg2-ag)/14:a=ag-m
        FOR i=2 TO 14:pg(i)=a+i*m:IF pg(i)>1 THEN pg(i)=2-pg(i)
          NEXT
              ELSE
        fg2=-fg:m=(fg2-ag)/14:a=ag-m
        FOR i=2 TO 14:pg(i)=a+i*m:IF pg(i)<0 THEN pg(i)=-pg(i)
          NEXT
        END IF
      IF cf*(fb+ab)>cf THEN
        fb2=2-fb:m=(fb2-ab)/14:a=ab-m
        FOR i=2 TO 14:pb(i)=a+i*m:IF pb(i)>1 THEN pb(i)=2-pb(i)
          NEXT
              ELSE
        fb2=-fb:m=(fb2-ab)/14:a=ab-m
        FOR i=2 TO 14:pb(i)=a+i*m:IF pb(i)<0 THEN pb(i)=-pb(i)
          NEXT
        END IF
      END IF
    END IF

  IF fz THEN
    '" Palette zyklisch umbelegen  
     FOR i=nn+1 TO 3 STEP -1
       pra(i)=pra(i-1): pga(i)=pga(i-1): pba(i)=pba(i-1)
       NEXT
     pra(2)=pra(nn+1): pga(2)=pga(nn+1): pba(2)=pba(nn+1)
     cd=2*co-2: IF cd>nn THEN cd=cd-nn+1
     pra(cd)=pr(co):   pga(cd)=pg(co):   pba(cd)=pb(co)
     FOR i=2 TO nn:PALETTE i,pra(i),pga(i),pba(i):NEXT
     END IF

  COLOR co
  AREAFILL
  WEND

'" Am Schluß sauber aufräumen
WINDOW CLOSE 2
SCREEN CLOSE 1
END