'===========================================================================
' Subject: EXPLODE GRAPHICS                  Date: 03-04-97 (19:28)       
' Author:  Nick Kochakian                    Code: QB, QBasic, PDS        
' Origin:  NickK@worldnet.att.net          Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB expgfx (x1%, y1%, x2%, y2%, x%, y%)
'Explode Graphics
'
'
'3/2/97 - 3/4/97
'1997 By: - Nick Kochakian -
'
'
'This program gets each pixel in the box you define and explodes the graphic,
'or whatever.
'
'This program has only messed up a couple times. If any one knows why some
'times the dots just freeze on the screen please tell me why.
'
'Hint: Don't explode too much stuff at one time... It'll be too slow as you'll
'see if you run the program... But I've added a new feature that will speed
'up the explosion. Before, after a pixel left the screen it kept going. So
'I made it so after a pixel leaves the screen it stops and the program ignores
'it until you stop it, which makes the whole thing go ALOT faster! :)
'
'You can contact me at: nickK@worldnet.att.net

DEFINT A-Z   'Uncomment this for slower computers

RANDOMIZE TIMER

SCREEN 13

x1 = 5
y1 = 1
x = x1
y = y1
x2 = 160
y2 = 30

'LINE (x1, y1)-(x2, y2), 15, B  '<---| Uncomment these two to put a box around
'END                            '<---| your desired graphics area. Then
                                      'Re-comment them.
cntrline = 0

DO
fakex = INT(RND * x1) + 1
fakey = INT(RND * y1) + 1
fakex2 = INT(RND * x2) + 1
fakey2 = INT(RND * y2) + 1
fakec = INT(RND * 255) + 1
LINE (fakex, fakey)-(fakex2, fakey2), fakec
cntrline = cntrline + 1
LOOP UNTIL cntrline = 1

fakec = 20
msgcntr = 1

msg$ = "Explode!"
LOCATE 2, 2

DO
COLOR fakec
PRINT MID$(msg$, msgcntr, 1);
fakec = fakec + 1
msgcntr = msgcntr + 1
LOOP UNTIL fakec = 27

SLEEP 2

CALL expgfx(x1, y1, x2, y2, x, y)

SUB expgfx (x1, y1, x2, y2, x, y)
pixels = 10000
px = pixels
py = pixels
pd = pixels
oldcol = pixels
newcol = pixels
pcol = pixels
pgon = pixels

DIM x(px)
DIM y(py)
DIM d(pd)
DIM oldc(oldcol)
DIM newc(newcol)
DIM c(pcol)
DIM pg(pgon)

px = 1
py = 1
pd = 1
oldcol = 1
newcol = 1
pcol = 1
pgon = 1

pixcnt = 0

cntr = 1

DO
'PSET (x, y), 15
'FOR i = 1 TO 999
'NEXT i
x = x + 1
IF x > x2 THEN x = x1: y = y + 1
IF y > y2 THEN cntr = 2

IF POINT(x, y) > 0 THEN
col = 0
col = POINT(x, y)
c(pcol) = col
pixcnt = pixcnt + 1

x(px) = x
y(py) = y

dirs = INT(RND * 8) + 1
d(pd) = dirs

oldc(oldcol) = 0
newc(newcol) = 0

px = px + 1
py = py + 1
pd = pd + 1
oldcol = oldcol + 1
newcol = newcol + 1
pcol = pcol + 1
END IF

LOOP UNTIL cntr = 2

px = px + 1
py = py + 1

x(px) = -1
y(py) = -1

px = 1
py = 1
pd = 1
oldcol = 1
newcol = 1
pcol = 1

cntr = 1

DO
ooncit:
IF pg(pgon) = 1 THEN
px = px + 1
py = py + 1
pd = pd + 1
'oldcol = oldcol + 1
'newcol = newcol + 1
pcol = pcol + 1

pgon = pgon + 1
END IF
IF pg(pgon) = 1 THEN GOTO ooncit:

PSET (x(px), y(py)), 0
IF d(pd) = 1 AND pg(pgon) = 0 THEN x(px) = x(px) + 1
IF d(pd) = 2 AND pg(pgon) = 0 THEN y(py) = y(py) + 1
IF d(pd) = 3 AND pg(pgon) = 0 THEN x(px) = x(px) + 1: y(py) = y(py) + 1
IF d(pd) = 4 AND pg(pgon) = 0 THEN x(px) = x(px) - 1: y(py) = y(py) + 1
IF d(pd) = 5 AND pg(pgon) = 0 THEN x(px) = x(px) + 1: y(py) = y(py) - 1
IF d(pd) = 6 AND pg(pgon) = 0 THEN x(px) = x(px) - 1: y(py) = y(py) - 1
IF d(pd) = 7 AND pg(pgon) = 0 THEN x(px) = x(px) - 1
IF d(pd) = 8 AND pg(pgon) = 0 THEN y(py) = y(py) - 1
PSET (x(px), y(py)), c(pcol)

IF x(px) > 320 THEN pg(pgon) = 1
IF x(px) < 0 THEN pg(pgon) = 1
IF y(py) > 200 THEN pg(pgon) = 1
IF y(py) < 0 THEN pg(pgon) = 1

pgbak = pgon
pgon = 1
pgcnt = 0
FOR i = 1 TO pixcnt
IF pg(pgon) = 1 THEN pgcnt = pgcnt + 1
pgon = pgon + 1
NEXT i
IF pgcnt = pixcnt THEN cntr = 2
pgon = pgbak

'FOR i = 1 TO 0
'NEXT i
px = px + 1
py = py + 1
pd = pd + 1
'oldcol = oldcol + 1
'newcol = newcol + 1
pcol = pcol + 1

pgon = pgon + 1

IF x(px) = -1 AND y(py) = -1 THEN
px = 1
py = 1
pd = 1
oldcol = 1
newcol = 1
pcol = 1
pgon = 1
END IF

LOOP UNTIL cntr = 2 OR INKEY$ <> ""

END SUB