'===========================================================================
' Subject: SMOOTH FADER                      Date: 08-09-98 (03:32)       
' Author:  Daniel Davies                     Code: QB, QBasic, PDS        
' Origin:  ia53@rapid.co.uk                Packet: GRAPHICS.ABC
'===========================================================================
'Smooth Fader
'Daniel Davies
'E-Mail :- ia53@rapid.co.uk
'web :- www.users.rapid.net.uk/ia53/

'better than any other faders I've come across in QB
'makes it so that all colours hit black at the same time,
'the sample image isn't really a good example,
'but on more complex images the effect is very noticable
'if you use any of this in your programs please give me credit

DECLARE SUB fade ()
SCREEN 13

DIM SHARED r(255) AS INTEGER, g(255) AS INTEGER, b(255) AS INTEGER
DIM SHARED r2(255) AS SINGLE, g2(255) AS SINGLE, b2(255) AS SINGLE
DIM SHARED rinc(255) AS SINGLE, ginc(255) AS SINGLE, binc(255) AS SINGLE

FOR x% = 0 TO 319: LINE (x%, 0)-(x%, 199), x%: NEXT x%
LOCATE 1, 1: PRINT "normal fade"
FOR tmp% = 0 TO 63: FOR tmp1% = 0 TO 255
OUT &H3C7, tmp1%: r% = INP(&H3C9): g% = INP(&H3C9): b% = INP(&H3C9)
IF r% > 0 THEN r% = r% - 1
IF g% > 0 THEN g% = g% - 1
IF b% > 0 THEN b% = b% - 1
OUT 968, tmp1%: OUT 969, r%: OUT 969, g%: OUT 969, b%
NEXT tmp1%: WAIT &H3DA, 8: NEXT tmp%
BEEP

FOR x% = 0 TO 319: LINE (x%, 0)-(x%, 199), x%: NEXT x%
LOCATE 1, 1: PRINT "Smooth fade"

PALETTE

fade
BEEP
SLEEP
PALETTE

'Smooth Fader
'Daniel Davies
'E-Mail :- ia53@rapid.co.uk
'web :- www.users.rapid.net.uk/ia53/
'if you use any of this in your programs please give me credit
SUB fade

stages% = 48  'this is how many stages the fade goes through
              

OUT 968, 0
FOR count% = 0 TO 255
        'read in palette values
r% = INP(969): g% = INP(969): b% = INP(969)
r(count%) = r%: g(count%) = g%: b(count%) = b%
r2(count%) = r%: g2(count%) = g%: b2(count%) = b%
rinc(count%) = r% / stages%
ginc(count%) = g% / stages%
binc(count%) = b% / stages%
NEXT count%

FOR count% = 0 TO stages% - 1
FOR tmp% = 0 TO 255
r2(tmp%) = r2(tmp%) - rinc(tmp%)
g2(tmp%) = g2(tmp%) - ginc(tmp%)
b2(tmp%) = b2(tmp%) - binc(tmp%)
r(tmp%) = r2(tmp%)
g(tmp%) = g2(tmp%)
b(tmp%) = b2(tmp%)
NEXT tmp%

OUT 968, 0: FOR setpal% = 0 TO 255
OUT 969, r(setpal%): OUT 969, g(setpal%): OUT 969, b(setpal%)
NEXT setpal%: WAIT &H3DA, 8
NEXT count%
END SUB