home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
FGFADE11.ZIP
/
FADE.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-02-13
|
8KB
|
216 lines
'*****************************************************************************
' *
' FADE.BAS *
' *
' This program demonstrates how to perform a smooth palette fade with *
' Fastgraph. This example assumes a 256-color video mode with 6-bit DAC *
' values (i.e., between 0 and 63). These values are defined at the top of *
' this file, so you can change them easily. *
' *
' The fadein() and fadeout() routines in this program were originally *
' written by John Wagner, author of the IMPROCES image processing program. *
' *
' To compile this program and link it with Fastgraph version 4.0: *
' *
' BC /O FADE; (QuickBASIC 4.5) *
' LINK FADE,,NUL,FGQB; *
' *
' BC /Fs /O FADE; (BASIC PDS 7.x) *
' LINK FADE,,NUL,FGQBX; *
' *
' BC /O FADE; (Visual Basic for DOS) *
' LINK FADE,,NUL,FGVBDOS; *
' *
' This program also can be linked with Fastgraph/Light version 4.0 if you *
' replace the FGxxx library references with FGLxxx. *
' *
' Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published *
' by Ted Gruber Software. For more info, please call, write, or FAX. *
' *
' Ted Gruber Software orders/info (702) 735-1980 *
' PO Box 13408 FAX (702) 735-4603 *
' Las Vegas, NV 89112 BBS (702) 796-7134 *
' *
'*****************************************************************************
REM $INCLUDE: 'fastgraf.bi'
DEFINT A-Z
REM function declarations
DECLARE SUB FadeIn (PCXfile$, Delay)
DECLARE SUB FadeOut (Delay)
DECLARE SUB Pack (DacString$, Dacs())
DECLARE SUB Unpack (DacString$, Dacs())
REM these values can be changed for different video modes
CONST NDACS = 256
CONST NCOLORS = 64
CONST VideoMode = 19
CONST ArraySize = NDACS * 3
REM these global arrays hold two complete sets of DAC values
DIM SHARED Dacs1(ArraySize) AS INTEGER
DIM SHARED Dacs2(ArraySize) AS INTEGER
DIM SHARED DacString AS STRING*ArraySize
REM start of main program
REM make sure the requested graphics mode is available
IF (FGtestmode(VideoMode,1) = 0) THEN
PRINT "This program requires a "; NDACS; "-color graphics mode."
STOP
END IF
REM calculate the base delay between DAC updates
Delay = FGmeasure / 128
REM initialize Fastgraph for the requested video mode
OldMode = FGgetmode
FGsetmode VideoMode
REM for each PCX file, fade it in and then back out
FadeIn "TOMMY.PCX"+CHR$(0), Delay
FGwaitfor 36
FadeOut Delay
FGwaitfor 18
FadeIn "BALLOONS.PCX"+CHR$(0), Delay
FGwaitfor 36
FadeOut Delay*2
FGwaitfor 18
FadeIn "MOUSE.PCX"+CHR$(0), Delay
FGwaitfor 36
FadeOut Delay*4
REM restore the original video mode and screen attributes
FGsetmode OldMode
FGreset
END
'*****************************************************************************
' *
' FadeIn *
' *
' Display an image by gradually increasing each DAC's RGB components to *
' their original values. *
' *
'*****************************************************************************
SUB FadeIn (PCXfile$, Delay)
REM get the target DAC values from the PCX file
Status = FGpcxpal(PCXfile$,DacString)
Unpack DacString, Dacs1()
REM zero all of the DACs
DacString = STRING$(ArraySize,0)
FGsetdacs 0, NDACS, DacString
Unpack DacString, Dacs2()
REM display the blacked-out PCX image
Status = FGshowpcx(PCXfile$,1)
REM cycle through the DACs, gradually increasing them to their old values
FOR J = 0 TO NCOLORS-1
REM increment each RGB component if it is below its old value
Target = NCOLORS - J
FOR I = 0 TO ArraySize-1
IF (Dacs1(I) > Target) AND (Dacs2(I) < Dacs1(I)) THEN Dacs2(I) = Dacs2(I) + 1
NEXT
REM update the DACs each time through the loop
FGstall Delay
Pack DacString, Dacs2()
FGsetdacs 0, NDACS, DacString
NEXT
END SUB
'*****************************************************************************
' *
' FadeOut *
' *
' Erase an image by gradually fading each DAC's RGB components to black. *
' *
'*****************************************************************************
SUB FadeOut (Delay)
REM load the dacs1 and dacs2 arrays with the current DAC values
FGgetdacs 0, NDACS, DacString
Unpack DacString, Dacs1()
Unpack DacString, Dacs2()
REM cycle through the DACs, gradually reducing them to 0 (black)
FOR J = 0 TO NCOLORS-1
REM decrement each RGB component if it is above 0
FOR I = 0 TO ArraySize-1
IF (Dacs2(I) > 0) THEN Dacs2(I) = Dacs2(I) - 1
NEXT
REM update the DACs each time through the loop
FGstall Delay
Pack DacString, Dacs2()
FGsetdacs 0, NDACS, DacString
NEXT
END SUB
'*****************************************************************************
' *
' Pack *
' *
' Pack the values from an integer array into a string variable. *
' *
'*****************************************************************************
SUB Pack (DacString$, Dacs())
FOR I = 0 TO ArraySize-1
MID$(DacString$,I+1,1) = CHR$(Dacs(I))
NEXT
END SUB
'*****************************************************************************
' *
' Unpack *
' *
' Unpack the values from a string variable into an integer array. *
' *
'*****************************************************************************
SUB Unpack (DacString$, Dacs())
FOR I = 0 TO ArraySize-1
Dacs(I) = ASC(MID$(DacString$,I+1,1))
NEXT
END SUB