The Random Program: Fading Routines

[Mitthrawnuruodo]

Hey everybody!
Well for some reason I needed a break, and started programming randomly and this is what I came up with in 20 min.:

Code:

DECLARE SUB getpic (fadetitle() AS ANY, title$)
DECLARE SUB fadein (fadetitle() AS ANY, X%, Y%, seconds%)
DECLARE SUB fadeout (fadetitle() AS ANY, X%, Y%, seconds%)

CLEAR
CLS

TYPE fadetitletype
  X AS INTEGER
  Y AS INTEGER
  index AS INTEGER
  col AS INTEGER
END TYPE
REDIM fadetitle(0) AS fadetitletype

SCREEN 13
RANDOMIZE TIMER

title$ = "This is the Title, Must be 1 line long"
getpic fadetitle(), title$

'----TEST OUTPUT----|
CLS
'(x, y) of title (They are centered below)
X% = 159 - (fadetitle(0).X + fadetitle(UBOUND(fadetitle)).X / 2)
Y% = 99 - (7 / 2)

LOCATE 1, 1: PRINT "Fading in: "
fadein fadetitle(), X%, Y%, 3
LOCATE 2, 1: PRINT "Press any key"

DO: LOOP WHILE INKEY$ = ""
LINE (0, 0)-(319, 16), 0, BF    'CLS for top output

LOCATE 1, 1: PRINT "Fading out: "
fadeout fadetitle(), X%, Y%, 3
LOCATE 2, 1: PRINT "Press any key to exit"

COLOR 0
END

SUB fadein (fadetitle() AS fadetitletype, X%, Y%, seconds%)

FOR i% = 0 TO UBOUND(fadetitle)
    fadetitle(i%).index = INT(RND * (10 * seconds% - 0 + 1) + 0)
NEXT i%

FOR k% = 0 TO 10 * seconds%
  FOR i% = 0 TO UBOUND(fadetitle)
   IF fadetitle(i%).index = k% THEN
      PSET (fadetitle(i%).X + X%, fadetitle(i%).Y + Y%), fadetitle(i%).col
   END IF
  NEXT i%
  timeri! = TIMER
  DO: LOOP UNTIL TIMER - timeri! > .01
NEXT k%
END SUB

SUB fadeout (fadetitle() AS fadetitletype, X%, Y%, seconds%)

FOR i% = 0 TO UBOUND(fadetitle)
    fadetitle(i%).index = INT(RND * (10 * seconds% - 0 + 1) + 0)
NEXT i%

FOR k% = 0 TO 10 * seconds%
  FOR i% = 0 TO UBOUND(fadetitle)
   IF fadetitle(i%).index = k% THEN
      PSET (fadetitle(i%).X + X%, fadetitle(i%).Y + Y%), 0
   END IF
  NEXT i%
  timeri! = TIMER
  DO: LOOP UNTIL TIMER - timeri! > .01
NEXT k%

END SUB

SUB getpic (fadetitle() AS fadetitletype, title$)

LOCATE 1, 1: PRINT title$

'|----GET SIZE----|
size% = -1
FOR i% = 0 TO 319
FOR j% = 0 TO 7
    col% = POINT(i%, j%)
    IF col% <> 0 THEN
       size% = size% + 1
    END IF
NEXT j%
NEXT i%

'|---GET ARRAY-----|
REDIM fadetitle(size%) AS fadetitletype

fadetitlei% = -1
FOR i% = 0 TO 319
  FOR j% = 0 TO 7
     col% = POINT(i%, j%)
     IF col% <> 0 THEN
       fadetitlei% = fadetitlei% + 1
       fadetitle(fadetitlei%).X = i%
       fadetitle(fadetitlei%).Y = j%
       fadetitle(fadetitlei%).col = col%
     END IF
  NEXT j%
NEXT i%

END SUB

It's a demo on some fading routines. Enjoy this random code!

[Neo]

NeoLib v1.6 has very many fading routines

BlueKeyboard once called me the palette expert... although I think that's a little too much honour for me... I'm just trying to find out how to do simulataneous palette transition.

[barok]

one time i made a few palette routines... can be found on qbnz, though i would recommend neolib more.

[Mitthrawnuruodo]

Well, I don't care it was made before, only that I felt like making it....

Plus its not very complex, so people can learn from it.

Plus its cool

[barok]

We're not trying to compete with you... We (well, I... I don't know about Plasma. ) thought you might be interested in those programs, since you seem to be into the palette commands now.

[Mitthrawnuruodo]

Palette commands?

I hope your talking about stuff like PALETTE 1, 2.
Not stuff like OUT &H3GA.

Well if your talking about the former then I know it already. If the latter then I'm scared to learn it.

And Plasma can be as better as me all he wants. I don't care because I'm never going to be as good as him.

BTW I like people who compete. I philosopis a lot and I think its healthy for a society to compete to better themselves, something about the more you are challenged, the more you want to beat, the more better you become, the more you put up a challenge, the better your opponent becomes....etc. :wink:

[barok]

yes, i'm talking about out. Trust me, it's much easier than it seems. Plus it's faster.