'===========================================================================
' Subject: Alternat Fade Algorithm            Date: 06-13-03 (  :  )       
'  Author: Richard Kelly                      Code: Qbasic, QB, PDS        
'  Origin: arborpa@yahoo.com                Packet: DEMOS.ABC
'===========================================================================
'Name of program: Graphics Demo & Alternative Algorithm
'Author: Richard Kelly
'E-Mail address: arborpa@yahoo.com </ym/Compose?To=arborpa@yahoo.com&YY=15762&order=down&sort=date&pos=0>
'Category: Graphics/Demos/Algorithms - Your choice
'Originally released on: 06/14/2003
'Language: QB/QuickBASIC/PDS
'Version: 1.00

'Please note that my E-Mail address has changed to the one above.  
Those who
'have E-Mailed at either of the NEWSON addresses and have not received 
a
'reply, please try again at the YAHOO.COM address.

'For documentation, select "DOCs" from the [F2] menu.

DECLARE SUB Animate ()
DECLARE SUB Coordinates ()
DECLARE SUB Darkness ()
DECLARE SUB DOCs ()
DECLARE SUB DrawBoxes ()
DECLARE SUB FadeIn ()
DECLARE SUB FadeOut ()
DECLARE SUB LoadPal ()
DECLARE SUB Main ()
DECLARE SUB Pal ()
DECLARE SUB PauseIt ()
DECLARE SUB PressKey ()
DECLARE SUB Road ()
DECLARE SUB Stars ()
DIM SHARED ResX, ResY, VX, VY

ResolutionX = 640
ResolutionY = 350

VX = ResolutionX / 10
VY = ResolutionY / 10

DIM SHARED Box%(VX, VY, 1), Remaining%(VX + 1, VY, 1), P%(14, 2)
DIM SHARED PN%(14), DP%(15, 2), Stuff%(999)

Main

END

'Palette colors (1-15) - Red, Green, Blue (Valid values are 0-63)
DATA 21,42,0
DATA 63,63,63
DATA 0,42,21
DATA 32,32,32
DATA 63,0,0
DATA 0,63,0
DATA 42,42,42
DATA 21,21,21
DATA 0,0,63
DATA 63,0,63
DATA 21,21,21
DATA 21,21,21
DATA 63,63,0
DATA 63,63,0
DATA 63,63,63

'Data for OUT values called within the PN% array
DATA 0, 1, 2, 3, 4, 19, 6, 55, 56, 57, 58, 59, 60, 61, 62

SUB Animate

H = P%(14, 0): I = P%(14, 1): J = P%(14, 2)
FOR T = 13 TO 10 STEP -1: FOR P1 = 0 TO 2: P%(T + 1, P1) = P%(T, P1)
NEXT P1, T: FOR P1 = 0 TO 2: P%(10, P1) = P%(14, P1): NEXT
P%(14, 0) = H: P%(14, 1) = I: P%(14, 2) = J
FOR T = 0 TO 3: FOR P1 = 0 TO 2: A = P%(T, P1) + 3: A = A MOD 64
P%(T, P1) = A: NEXT P1, T

END SUB

SUB Coordinates

'Store the coordinates in the Remaining% array.  (?, ?, 0) is the X
'coordinate, and (?, ?, 1) is the Y coordinate.
FOR R1 = 0 TO VX - 1: Remaining%(R1, 0, 0) = VY: FOR R2 = 0 TO VY - 1
Remaining%(R1, R2 + 1, 0) = R1 * 10: Remaining%(R1, R2 + 1, 1) = R2 * 
10
NEXT R2, R1

VZ = VX: A = -1: B = 0

StartBox:
'Set the place in the array for the coordinates of the next box.
A = A + 1: IF A >= VX - 1 THEN A = 0: B = B + 1
'The End?
IF VZ < 0 THEN GOTO Alter
'Select a box coordinate at random.  Note that "Remaining%(X, 0, 0)" 
tells how
'many unselected coordinates are left in the chosen portion of the 
array.
X = INT(RND * VZ): VW = Remaining%(VZ, 0, 0): Y = INT(RND * VW) + 1
'Put the chosen coordinates into the Box% array.
Box%(A, B, 0) = Remaining%(X, Y, 0): Box%(A, B, 1) = Remaining%(X, Y, 
1)
'Find the position of the final coordinate in the entire array.
VU = Remaining%(VZ, 0, 0)
'Remaining%(X, Y, ?) is now stored in Box%, so replace Remaining% with 
the
'very last (unstored by Box%) coordinate in the array.  This is the 
fastest
'and simplest way to organize it.
Remaining%(X, Y, 0) = Remaining%(VZ, VU, 0)
Remaining%(X, Y, 1) = Remaining%(VZ, VU, 1)
'The next command line has been REMarked out to increase the speed of 
the
'program's performance.  If you use this array more than once in your 
own
'code, you should remove the REM word, as it will easily allow the 
program to
'leave the Remaining% array "clear" when all Box% coordinates have been
'selected.  Of course, you could *also* use the array again if you set 
all the
'(?, 0, 0) numbers to the variable "VY" ...
REM Remaining%(VZ, VU, 0) = 0: Remaining%(VZ, VU, 1) = 0
'Decrease the "base" number in the last portion of the Remaining% 
array, so
'the coordinates placed in Box% won't be selected again.
Remaining%(VZ, 0, 0) = VU - 1
'Are all coordinates in this portion of the array selected?
IF VU > 1 THEN GOTO NextBox
'Yes?  Then mark out that array portion!
VZ = VZ - 1
NextBox:
'Next box, please.
GOTO StartBox
'Finis!
Alter:

END SUB

SUB Darkness

FOR P0 = 0 TO 14: OUT &H3C7, PN%(P0): FOR P1 = 0 TO 2: OUT &H3C9, 0: 
NEXT: NEXT

END SUB

SUB DOCs

'I have created and released this graphics demo to teach the programmer 
two
'things:

'1.  The fastest and simplest way to set the palettes in 640x350 
16-color EGA.
'2.  To randomly select every area of the screen and store it in an 
array,
'    there's a way to do it that takes the same amount of CPU cycles to
'    complete ... no matter how many times you re-execute it.

'The EGA palette cannot be set through the OUT command using values 
0-14.
'The correct values are stored in the PN% array.  The Red/Green/Blue 
settings
'are in the array P%(?,0-2).  For fading in and out, the "dummy" 
palette DP%
'is used.

'The palette is set using the SUB "Pal", and the palette is completely 
black
'when the SUB "Darkness" is called.  The palette is also black after 
the SUB
'"FadeOut" has executed.

'All animation is palette cycling, and the colors changed are 1-4 (the
'"stars") and 11-14 (the stripes in the road).  The values of these 
colors are
'changed in the SUB "Animate".

'All valid coordinates for the screen are placed in the Remaining% 
array.
'Each coordinate will be selected at random, then placed for use in the 
Box%
'array.

'The most commonly used way (at least to me) that a programmer would 
randomly
'select every area of the screen and store it in an array (In this 
case, Box%)
'would be something like the following:

FOR B0 = 0 TO 63
FOR B1 = 0 TO 34
Try:
X = INT(RND * 64)
Y = INT(RND * 34)
'Remaining%(X, Y, 0) will equal "-1" when the coordinate has already 
been
'picked before.
IF Remaining%(X, Y, 0) = -1 THEN GOTO Try
'The coordinate was *not* already used, so store it in the array.
Box%(B0, B1, 0) = Remaining%(X, Y, 0): Box%(B0, B1, 1) = Remaining%(X, 
Y, 1)
'Mark the new coordinate as "used".
Remaining%(X, Y, 0) = -1
NEXT B1, B0

'Although this technique works, the routine will keep picking countless
'numbers of "used" coordinates at random, and the more coordinates that 
are
'stored in the array, the longer the program has to keep generating 
random
'numbers before it finds an "unused" area.  Add to that the fact that 
the
'routine takes a different amount of time to finish filling the Box% 
array
'every time it's run, and you see how impractical this method is.

'With modesty, I feel my method is faster and more practical to use, 
and I
'want the whole world to know how it works.  So here it is, documented 
and
'everything!

END SUB

SUB DrawBoxes

FOR X = 0 TO VX - 1: FOR Y = 0 TO VY
B0 = Box%(X, Y, 0): B1 = Box%(X, Y, 1): SCREEN 9, 0, 1, 0
GET (B0, B1)-(B0 + 9, B1 + 9), Stuff%: SCREEN 9, 0, 0, 0
PUT (B0, B1), Stuff%, PSET: NEXT
CALL Animate
CALL Pal
CALL PauseIt
NEXT

END SUB

SUB FadeIn

FOR F = 62 TO 0 STEP -1
CALL Animate
FOR P0 = 0 TO 14: FOR P1 = 0 TO 2
DP = P%(P0, P1) - F: IF DP < 0 THEN DP = 0
DP%(P0, P1) = DP: NEXT P1, P0
CALL PauseIt
FOR P0 = 0 TO 14: OUT &H3C7, PN%(P0)
FOR P1 = 0 TO 2: OUT &H3C9, DP%(P0, P1): NEXT P1, P0, F

END SUB

SUB FadeOut

FOR F = 1 TO 63 STEP 2
CALL Animate
FOR P0 = 0 TO 14: FOR P1 = 0 TO 2
DP = P%(P0, P1) - F: IF DP < 0 THEN DP = 0
DP%(P0, P1) = DP: NEXT P1, P0
CALL PauseIt
FOR P0 = 0 TO 14: OUT &H3C7, PN%(P0)
FOR P1 = 0 TO 2: OUT &H3C9, DP%(P0, P1): NEXT P1, P0, F

END SUB

SUB LoadPal

SCREEN 9, 0, 1, 1: COLOR 7, 0: SCREEN 9, 0, 0, 0: COLOR 7, 0

OUT &H3C7, 14: FOR Y = 0 TO 2: OUT &H3C9, 32: NEXT
FOR P0 = 0 TO 14: FOR P1 = 0 TO 2: READ P%(P0, P1): NEXT: NEXT
FOR P2 = 0 TO 14: READ PN%(P2): NEXT

END SUB

SUB Main

RANDOMIZE TIMER

LoadPal
Pal

Coordinates

Road
Stars

FadeIn

PressKey

DrawBoxes

PressKey

FadeOut

'If you re-program the code beyond the SUB "FadeOut", make sure you 
remove the
'REM statements from the following two lines, or you won't see anything 
on the
'screen.
REM CLS
REM Pal

END SUB

SUB Pal

FOR P0 = 0 TO 14: OUT &H3C7, PN%(P0): FOR P1 = 0 TO 2: OUT &H3C9, 
P%(P0, P1)
NEXT: NEXT

END SUB

SUB PauseIt

FOR TR = 1 TO 3: WAIT &H3DA, 8: WAIT &H3DA, 8, 8: NEXT

END SUB

SUB PressKey

Waiting:
CALL Animate
CALL PauseIt
CALL Pal
IF INKEY$ = "" THEN GOTO Waiting

END SUB

SUB Road

SCREEN 9, 0, 1, 0

CALL Darkness

C = 0

FOR T = 0 TO 340 STEP 10: U = T + 9
LINE (0, T)-(299, U), 5, BF: LINE (300, T)-(317, U), 8, BF
LINE (318, T)-(321, U), C + 11, BF: LINE (322, T)-(339, U), 8, BF
LINE (340, T)-(639, U), 5, BF: C = (C + 1) MOD 4: NEXT

END SUB

SUB Stars

SCREEN 9, 0, 0, 0

CALL Darkness

FOR T = 0 TO 99: PSET (INT(RND * 640), INT(RND * 350)), 15: NEXT
FOR C = 1 TO 4: FOR T = 0 TO 99: PSET (INT(RND * 640), INT(RND * 350)), 
C
NEXT T, C

END SUB