'===========================================================================
' Subject: GRAPHICS MELT #1, #2              Date: 03-02-97 (06:56)       
' Author:  Nick Kochakian                    Code: QB, QBasic, PDS        
' Origin:  NickK@worldnet.att.net          Packet: GRAPHICS.ABC
'===========================================================================
'Graphics melt #1 and #2
'
'3/2/97
'1997 By: - Nick Kochakian -
'
'This melts any graphic you put a "box" around.
'
'If you have any comments or questions e-mail me at: nickK@worldnet.att.net
'
'Have fun! :)

DEFINT A-Z

RANDOMIZE TIMER
SCREEN 13

x1 = 5
y1 = 7
x = x1
y = y1
x2 = 305
y2 = 15

'delay = 9999

way = 1 'The way to melt the graphic / text on the screen
'way = 1 -> melt
'way = 2 -> boil / blend

LOCATE 2, 2: PRINT "Graphics Melt 1997 By: Nick Kochakian"

'LINE (x1, y1)-(x2, y2), 15, B  'Uncomment these two to put a box around the
'END                            'graphics you want melted. Then recomment.

pixels = 10000
px = pixels
py = pixels
pc = pixels
onc = pixels

DIM x(px)
DIM y(py)
DIM c(pc)
DIM o(onc)

px = 1
py = 1
pc = 1
onc = 1

pixcnt = 0

DO
IF POINT(x, y) > 0 THEN
col = POINT(x, y)
x(px) = x
y(py) = y
c(pc) = col
px = px + 1
py = py + 1
pc = pc + 1
pixcnt = pixcnt + 1
END IF

x = x + 1
IF x > x2 THEN x = x1: y = y + 1
LOOP UNTIL y > y2

px = px + 1
py = py + 1

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

px = 1
py = 1
pc = 1

DO
redoit:
numend = INT(RND * pixcnt) + 1
FOR i = 1 TO numend
px = px + 1
py = py + 1
pc = pc + 1
onc = onc + 1
NEXT i

oncbak = onc
onc = 1
onccntr = 0
FOR i = 1 TO pixcnt
onc = onc + 1
onccntr = onccntr + 1
NEXT i

IF onccntr = pixcnt THEN onc = oncbak: GOSUB oncreset:

IF o(onc) = 1 THEN GOTO redoit:

IF way = 2 THEN PSET (x(px), y(py)), 0

y(py) = y(py) + 1
PSET (x(px), y(py)), c(pc)
o(onc) = 1

px = 1
py = 1
pc = 1
onc = 1
FOR i = 1 TO delay
NEXT i
LOOP UNTIL INKEY$ <> ""
END

oncreset:
onc = 1
FOR i = 1 TO pixcnt
o(onc) = 0
onc = onc + 1
NEXT i
onc = 1
RETURN