'************************************************************
'*                                                          *
'*                  AMOS Super Impose                       *
'*     Laget av Torsten Erik Gabrielsen for Amiga Forum     *
'*                                                          *
'*       Viser en Super Impose wipe mellom to bilder        *
'*                                                          *
'************************************************************

' Les inn bilde 0  
FILE$=Fsel$("","","Velg det første bildet i wipen") : Rem La bruker velge fil' 
Load Iff FILE$,0 : Rem Hent valgt IFF-bilde 

' Sjekk bilde data 
ANTALLFARGER1=Screen Colour
BREDDE=Screen Width
HOEYDE=Screen Height

' Sett av plass til fargetabell bilde 0
Dim R1(ANTALLFARGER1),G1(ANTALLFARGER1),B1(ANTALLFARGER1)

' Les fargetabell
For I=0 To ANTALLFARGER1-1
   R1(I)=(Colour(I) and $F00)/$100 : Rem Rødt 
   G1(I)=(Colour(I) and $F0)/$10 : Rem Grønt
   B1(I)=(Colour(I) and $F) : Rem blått
Next I

' Les inn bilde 1  
FILE$=Fsel$("","","Velg det andre bildet i wipen") : Rem La bruker velge fil' 
Load Iff FILE$,1
ANTALLFARGER2=Screen Colour

If Screen Height<>HOEYDE or Screen Width<>BREDDE
   Print "Bildene må være av samme størrelse!"
   End 
End If 

ANTALLFARGERTOTALT=ANTALLFARGER1*ANTALLFARGER2

'Hvis lowres så kan vi ha 32 farger; hires kan bare ha 16  
ANTALLFARGERMAKS=32
If(Screen Mode and Hires)=Hires Then ANTALLFARGERMAKS=16
If ANTALLFARGERTOTALT>ANTALLFARGERMAKS
   Print "For mange farger tilsammen!"
   End 
End If 

'Sett av plass til fargetabell bilde 1 
Dim R2(ANTALLFARGER2),G2(ANTALLFARGER2),B2(ANTALLFARGER2)
' Les fargetabell bilde 1
For I=0 To ANTALLFARGER2-1
   R2(I)=(Colour(I) and $F00)/$100 : Rem Rødt 
   G2(I)=(Colour(I) and $F0)/$10 : Rem grønt
   B2(I)=(Colour(I) and $F) : Rem blått
Next I

'Åpne vår fantastiske super impose skjerm! 
Screen Open 2,BREDDE,HOEYDE,ANTALLFARGERTOTALT,Screen Mode
Flash Off : Screen Hide 2

Screen 0 : Rem Finn addressene til bitplanene til bilde 0 
DEPTH1=Ln(ANTALLFARGER1)/Ln(2) : Rem formel for å finne antall
DEPTH2=Ln(ANTALLFARGER2)/Ln(2) : Rem bitplan til bildet.  
Dim FRABITPLAN(DEPTH1+DEPTH2)
For I=0 To DEPTH1-1
   FRABITPLAN(I)=Logbase(I) : Rem finn addressen til bitplanet 
Next I

Screen 1 : Rem Finn addressene til bitplanene til bilde 1 
For I=0 To DEPTH2-1
   FRABITPLAN(I+DEPTH1)=Logbase(I) : Rem finn addr. til bitplanet 
Next I

'Beregn bytestørrelse for hvert bitplan
BITPLANESIZE=Int((BREDDE+7)/8)*HOEYDE

Screen 2 : Rem Svitsj til den nye super impose skjermen 
For I=0 To DEPTH1+DEPTH2-1
   Rem kopier inn bitplanene fra de to bildeskjermene 
   Copy FRABITPLAN(I),FRABITPLAN(I)+BITPLANESIZE-1 To Logbase(I)
Next I

J=0 : Rem Sett fargene slik at bare bilde 0 vises
For I=0 To ANTALLFARGERTOTALT-1
   Colour I,R1(J)*$100+G1(J)*$10+B1(J)
   J=J+1
   If J=ANTALLFARGER1 Then J=0
Next I

Screen Show 2
Rem Trinn= Antall frames Super Impose'en skal skje på:   
TRINN=32 : Rem prøv å endre denne.
Repeat 
   'Endre fargene gradvis fra bilde 0 til bilde 1 
   For I=0 To TRINN
      For J=0 To ANTALLFARGER1-1
         For K=0 To ANTALLFARGER2-1
            Rem Farge J fra bilde 0 og farge K 
            Rem fra bilde 1 overlapper hverandre 
            Rem som farge J+K*ANTALLFARGER1
            Rem (ANTALLFARGER1= antall farger i bilde 0) 
            FARGENUM=J+K*ANTALLFARGER1

            Rem Øk hver fargekomponent gradvis fra 
            Rem bilde 0's til bilde 1's
            R=R1(J)+(I*(R2(K)-R1(J)))/TRINN
            G=G1(J)+(I*(G2(K)-G1(J)))/TRINN
            B=B1(J)+(I*(B2(K)-B1(J)))/TRINN
            Colour FARGENUM,R*$100+G*$10+B
         Next K
      Next J
   Next I

   For I=1 To 1 : Rem vent litt
      Wait Vbl 
   Next I

   'Endre fargene gradvis fra bilde 1 til bilde 0 
   For I=0 To TRINN
      For J=0 To ANTALLFARGER1-1
         For K=0 To ANTALLFARGER2-1
            FARGENUM=J+K*ANTALLFARGER1
            R=R2(K)+(I*(R1(J)-R2(K)))/TRINN
            G=G2(K)+(I*(G1(J)-G2(K)))/TRINN
            B=B2(K)+(I*(B1(J)-B2(K)))/TRINN
            Colour FARGENUM,R*$100+G*$10+B
         Next K
      Next J
   Next I

   For I=1 To 1 : Rem vent litt
      Wait Vbl 
   Next I
   'Til bruker trykker på en musknapp 
Until Mouse Key<>0