'===========================================================================
' Subject: CROSS-FADING DEMONSTRATION        Date: 08-22-97 (17:10)       
' Author:  Petter Holmberg                   Code: QB, QBasic, PDS        
' Origin:  petter.holmberg@usa.net         Packet: GRAPHICS.ABC
'===========================================================================
' A crossfading demonstration by Petter Holmberg, -97:

TYPE PalType
  red AS INTEGER
  green AS INTEGER
  blue AS INTEGER
END TYPE

DECLARE SUB BuildPic1 ()
DECLARE SUB BuildPic2 ()
DECLARE SUB BuildEffect ()
DECLARE SUB PalMorph ()
DECLARE SUB Crossfade ()

DIM SHARED picmem%(32001)
DIM SHARED palmem(0 TO 255) AS PalType

DIM SHARED colormem%(255, 1)
DIM SHARED morphpic%(32001)
DIM SHARED morphfrompal(0 TO 255) AS PalType
DIM SHARED morphtopal(0 TO 255) AS PalType

FOR memfill% = 0 TO 255
   FOR fillarray% = 0 TO 1
      colormem%(memfill%, fillarray%) = 256
   NEXT fillarray%
NEXT memfill%

' --- Print start text:

CLS
SCREEN 0
WIDTH 80, 25

PRINT "A crossfading demonstration by Petter Holmberg, -97:"
PRINT
PRINT "Crossfading, or palette morphing, is a cool graphical effect mostly used in"
PRINT "television as a method to switch between two pictures. On the screen you can"
PRINT "watch how the present picture slowly fades away, while at the same time a new"
PRINT "picture emerges and become more and more prominent. Finally, the first picture"
PRINT "has completely disappeared and been replaced by the new picture."
PRINT
PRINT "This effect can also be used in computer programs, and it's a really cool way"
PRINT "to switch between pictures. The good thing with crossfading is that it only"
PRINT "requires a gradient change between two palettes. No pixels need to be read or"
PRINT "written during the effect. However, a picture containing information about both"
PRINT "the pictures in the crossfade and two palettes, one making this picture look"
PRINT "like the first picture in the crossfade, and the other one making it look like"
PRINT "the second one must be calculated."
PRINT "This program shows two pictures, builds the crossfading picture and palettes"
PRINT "and then cycles between them until a key is pressed."
PRINT
PRINT "If you want to, you may replace the simple pictures used in this demo with some"
PRINT "other pictures and save the crossfading picture and palettes for use in your own"
PRINT "programs, as long as you credit me in your code. Also note that I don't take any"
PRINT "responsibility for any kind of damage due to the use of this program."
PRINT "Petter Holmberg, -97"

DO: LOOP WHILE INKEY$ = ""

SCREEN 13

' --- Display and save the first picture:

BuildPic1

LOCATE 1, 1
PRINT "   Press any key to show picture 2...   ";
DO: LOOP WHILE INKEY$ = ""
CLS

' --- Display the second picture:

BuildPic2

LOCATE 1, 1
PRINT "  Press any key to build the effect...  ";
LOCATE 25, 1
PRINT "     (This will take a few seconds)     ";
DO: LOOP WHILE INKEY$ = ""
LOCATE 1, 1
PRINT "                                        ";
LOCATE 25, 1
PRINT "                                        ";

' --- Create the crossfading effect:

BuildEffect

CLS
LOCATE 1, 1
PRINT "  Completed. Now press any key to look  ";
PRINT "      at the crossfading effect...      ";
DO: LOOP WHILE INKEY$ = ""
CLS

' --- Do the crossfading:

DO
   Crossfade
   FOR swappalettes% = 0 TO 255
      SWAP morphfrompal(swappalettes%), morphtopal(swappalettes%)
   NEXT swappalettes%
LOOP WHILE INKEY$ = ""

' --- End the program:

SCREEN 0
WIDTH 80, 25

PRINT "That's all for now..."
PRINT "Petter Holmberg, -97"

SUB BuildEffect

' This SUB builds the crossfade picture and palettes.

' --- Memory locations for the three pictures:

pic1seg& = VARSEG(picmem%(2))
pic1ofs& = 4
pic2seg& = &HA000
pic2ofs& = 0
destseg& = VARSEG(morphpic%(2))
destofs& = 4

' --- Set value for first color index to be used in the crossfading picture:

destcolor% = 1

' --- Create the picture and palettes:

FOR buildpic& = 0 TO 64000

   DEF SEG = pic1seg&
   pic1pixel% = PEEK(pic1ofs&)
   DEF SEG = pic2seg&
   pic2pixel% = PEEK(pic2ofs&)

   oldpixel% = 0

   FOR scanpixels% = 0 TO destcolor%
      IF colormem%(scanpixels%, 0) = pic1pixel% AND colormem%(scanpixels%, 1) = pic2pixel% THEN
       oldpixel% = 1
       DEF SEG = destseg&
       POKE destofs&, scanpixels%
       EXIT FOR
      END IF
   NEXT scanpixels%

   IF oldpixel% = 0 THEN
    IF destcolor% = 255 THEN
     BEEP
     SCREEN 0
     WIDTH 80, 25
     PRINT "Sorry, the pictures are too complex for the crossfading effect. Reduce the color"
     PRINT "depth or picture detail and try again."
     END
    END IF
    colormem%(destcolor%, 0) = pic1pixel%
    colormem%(destcolor%, 1) = pic2pixel%
    DEF SEG = destseg&
    POKE destofs&, destcolor%
    morphfrompal(destcolor%).red = palmem(pic1pixel%).red
    morphfrompal(destcolor%).green = palmem(pic1pixel%).green
    morphfrompal(destcolor%).blue = palmem(pic1pixel%).blue
    OUT &H3C7, pic2pixel%
    morphtopal(destcolor%).red = INP(&H3C9)
    morphtopal(destcolor%).green = INP(&H3C9)
    morphtopal(destcolor%).blue = INP(&H3C9)
    destcolor% = destcolor% + 1
   END IF

   pic1ofs& = pic1ofs& + 1
   pic2ofs& = pic2ofs& + 1
   destofs& = destofs& + 1

NEXT buildpic&

DEF SEG

morphpic%(0) = 2560
morphpic%(1) = 200

END SUB

SUB BuildPic1

' This SUB initializes and saves the first picture and its palette.

' --- Draw sample picture:

CIRCLE (159, 99), 100, 15
PAINT (159, 99), 32, 15

LOCATE 13, 15
PRINT "Crossfading!"

' --- Save the first picture and its palette:

GET (0, 0)-(319, 199), picmem%

FOR readpal% = 0 TO 255
   OUT &H3C7, readpal%
   palmem(readpal%).red = INP(&H3C9)
   palmem(readpal%).green = INP(&H3C9)
   palmem(readpal%).blue = INP(&H3C9)
NEXT readpal%

END SUB

SUB BuildPic2

' This SUB initializes the second picture and its palette.

' --- Draw sample picture:

LINE (55, 13)-(263, 185), , B
PAINT (159, 99), 40, 15

LOCATE 12, 10
PRINT "A cool effect coded by"
LOCATE 13, 11
PRINT "Petter Holmberg, -97"
LOCATE 14, 10
PRINT "petter.holmberg@usa.net"

END SUB

SUB Crossfade

' This SUB crossfades between the two sample pictures.

' --- Set the first palette and display the crossfading picture:

OUT &H3C8, 0
FOR setpal% = 0 TO 255
   OUT &H3C9, morphfrompal(setpal%).red
   OUT &H3C9, morphfrompal(setpal%).green
   OUT &H3C9, morphfrompal(setpal%).blue
NEXT setpal%

PUT (0, 0), morphpic%, PSET

' --- Save the palette for use in the crossfading code:

OUT &H3C7, 0
FOR getpal% = 0 TO 255
   palmem(getpal%).red = INP(&H3C9)
   palmem(getpal%).green = INP(&H3C9)
   palmem(getpal%).blue = INP(&H3C9)
NEXT getpal%

' --- Crossfading code:

FOR morphpal% = 0 TO 63
   FOR morphscan% = 0 TO 255
      IF palmem(morphscan%).red < morphtopal(morphscan%).red THEN
       IF 63 - morphtopal(morphscan%).red < morphpal% AND palmem(morphscan%).red < morphtopal(morphscan%).red THEN palmem(morphscan%).red = palmem(morphscan%).red + 1
      ELSE
       IF 63 - morphtopal(morphscan%).red > morphpal% AND palmem(morphscan%).red > morphtopal(morphscan%).red THEN palmem(morphscan%).red = palmem(morphscan%).red - 1
      END IF
      IF palmem(morphscan%).green < morphtopal(morphscan%).green THEN
       IF 63 - morphtopal(morphscan%).green < morphpal% AND palmem(morphscan%).green < morphtopal(morphscan%).green THEN palmem(morphscan%).green = palmem(morphscan%).green + 1
      ELSE
       IF 63 - morphtopal(morphscan%).green > morphpal% AND palmem(morphscan%).green > morphtopal(morphscan%).green THEN palmem(morphscan%).green = palmem(morphscan%).green - 1
      END IF
      IF palmem(morphscan%).blue < morphtopal(morphscan%).blue THEN
       IF 63 - morphtopal(morphscan%).blue < morphpal% AND palmem(morphscan%).blue < morphtopal(morphscan%).blue THEN palmem(morphscan%).blue = palmem(morphscan%).blue + 1
      ELSE
       IF 63 - morphtopal(morphscan%).blue > morphpal% AND palmem(morphscan%).blue > morphtopal(morphscan%).blue THEN palmem(morphscan%).blue = palmem(morphscan%).blue - 1
      END IF
   NEXT morphscan%

   WAIT (&H3DA), 8    ' Wait for a screen update.
   WAIT (&H3DA), 8, 8 ' Wait for the vertical retrace.

   OUT &H3C8, 0
   FOR setpal% = 0 TO 255
      OUT &H3C9, palmem(setpal%).red
      OUT &H3C9, palmem(setpal%).green
      OUT &H3C9, palmem(setpal%).blue
   NEXT setpal%
NEXT morphpal%

END SUB