'===========================================================================
' Subject: CREATES A WAVEY EFFECT ON IMAGE   Date: 11-15-97 (00:24)       
' Author:  Xtance Coders Alliance            Code: QB, QBasic, PDS        
' Origin:  harryst@castel.nl               Packet: GRAPHICS.ABC
'===========================================================================
'         .$$$$$$$$.  .$$$$$$$$.     .$$$$$$$$.    .$$$$$$$$$.   $. .$
'         $$$$$ $$$$ss$$$$ $$$$$    s$$$$ $$$$$    $$$$$ $$$$$   $s s$
'         $$$$$ $$$$$$$$$$ $$$$$    $$$$$ $$$$$    $$$$$ $$$$$   $$.$$
'          $$$$ $$$$$$$$$$ $$$$     $$$$$ $$$$     $$$$$ $$$$$   $$s$$
'           s$$ $$$$$$$$$$ $$s      $$$$$ $$s      $$$$$ $$$$$   $$$$$
'             s $$$$$$$$$$ s        $$$$$ s        $$$$$ $$$$$   $$$$$
'               $$$$$$$$$$          $$$$$          $$$$$$$$$$$   $$$$$
'               $$$$$$$$$$          $$$$$          $$$$$ $$$$$   $$$$$
'               $$$$$$$$$$          $$$$$          $$$$$ $$$$$   $$$$$
'               $$$$$$$$$$          $$$$$          $$$$$ $$$$$   $$$$$
'            s  $$$$$$$$$$  s       $$$$$  s       $$$$$ $$$$$   $$$$$
'          s$$  $$$$$$$$$$  $$s     $$$$$  $$s     $$$$$ $$$$$   $$$$$
'         $$$$  $$$$$$$$$$  $$$$    $$$$$  $$$$    $$$$$ $$$$$    S$S
'        $$$$$  $$$$$$$$$$  $$$$$   $$$$$  $$$$$   $$$$$ $$$$$     .
'        $$$$$$$$$$$$$$$$$$$$$$$$   $$$$$$$$$$$$   $$$$$ $$$$$    s$s
'        .$$$$$$$$$$$$$$$$$$$$$$.   .$$$$$$$$$$.   .$$$. .$$$.   $$$$$
'
'                Xtance               Coders         Alliance
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'	This program is made by Mr. Snow from Xtance Coders Alliance and
'					      DeeJee'z Team 1997
'
'		for All Basic Programmers in the Big Fat World
'   
'  E-Mail to harryst@castel.nl
'  or     to mrsnow@freemail.nl
'
'
' Credit me please.. if you use any routines from my source

DECLARE SUB Center (Text$)
DECLARE SUB Wave ()
DECLARE SUB DeInit ()
DECLARE SUB Init ()
DECLARE SUB txtpalget (col%, r%, g%, B%)
DECLARE SUB txtpalset (col%, r%, g%, B%)
DECLARE SUB SinusWave ()
DECLARE SUB PcxLoad ()
DEFINT A-Z
'$DYNAMIC
RANDOMIZE -TIMER
DIM SHARED B1%(2890), B2%(2890)   'punch pictures
DIM SHARED COSINUS(160) AS INTEGER
DIM SHARED RAND(255) AS INTEGER
DIM SHARED oldpal(16, 3)
DIM SHARED WaveSide1, WaveSide2, WaveSide3
DIM SHARED Wave1, Wave2, Wave3
CONST PI = 3.14159265358#


PcxLoad
SinusWave


CALL Init
Center ("Hello,  I'm Mr. Snow and has programmed all this stuph... okay i ripped some")
Center ("        routines, pictures and music files.. but that s all..")
Center ("")
Center ("        Please enjoy you looking at the sources.. this are the sources from")
Center ("        1996 and 1997 (not all are sources..) the moast are things that i")
Center ("        like the moast..")
Center ("")
Center ("        B.T.W There is also another pack of me... but you can only get it")
Center ("        for F 5.- or $5 that's not much but atleast a bit for my study")
Center ("")
Center ("        My e-mail is: harryst@castel.nl or (This is the best...)")
Center ("                      mrsnow@freemail.nl")
Center ("                      xca@freemail.nl")
Center ("                      djt@freemail.nl")
Center ("                      hstok@freemail.nl")
Center ("")
Center ("        my page is for now http://www.page4life.nl/mrsnow/")
Center ("        but it could change to http://www.page4life.nl/xtance")
Center ("        or to http://www.page4life.nl/xtance1 (or xtance2)")
Center ("")
Center ("        Thanx.. Please send this allover the world")
Center ("")
Center ("MAIL ME ALOTTTTTTTTT")
Center ("")
Center ("[Any key to return to your normal dos prompt or windows prompt/system...]")

DO
	CALL Wave
LOOP UNTIL INKEY$ <> ""


CALL DeInit

PRINT "                    ----> Xtance Records   <----"
PRINT
PRINT "                        Rensumaheerd 102"
PRINT "                        9736 AD Groningen"
PRINT "                        The Netherlands"
PRINT "                        +31(0)50-5417749"
PRINT "                Ask for Eric (Only English or Dutch)"
PRINT
PRINT "enjoy.... "

REM $STATIC
SUB Center (Text$)
i = CSRLIN + 1
LOCATE i, 40 - (LEN(Text$) / 2): PRINT Text$
END SUB

REM $DYNAMIC
SUB DeInit STATIC
DEF SEG
CLS

FOR i = 1 TO 15
 txtpalset i, oldpal(i, 1), oldpal(i, 2), oldpal(i, 3)
NEXT i

WIDTH 80, 25

END SUB

SUB Init STATIC
DEF SEG = &HB800
r = 3                   '-\
g = 5                   '  |- For the RGB Colors (3,5,5)=Gray
B = 5                   '-/

WaveSide1 = 1           '-\
WaveSide2 = 3           '  |- Think it's for the speed
WaveSide3 = 1           '-/

R1 = 1                  '-\
R2 = 10                 '  |- Think it's the start position
R3 = 20                 '-/

WIDTH 80, 50            ' Set the screen mode to 80 x 50
LOCATE , , 0            ' Set the cursor off

'--------- Counting / calculate part ------
FOR i = 1 TO 15
 txtpalget i, oldpal(i, 1), oldpal(i, 2), oldpal(i, 3)
NEXT i

FOR c = 0 TO 160
    COSINUS(c) = COS(c * 2 * PI / 80) * 16 + 16
NEXT

FOR c = 0 TO 255
    RAND(c) = INT(RND * 4) + 1
NEXT

FOR i = 0 TO 6
 txtpalset i, i * r, i * g, i * B
NEXT i

FOR i = 7 TO 15
 txtpalset i, (15 - i) * r, (15 - i) * g, (15 - i) * B
NEXT i

END SUB

SUB PcxLoad STATIC
DIM Buf(32002) AS INTEGER: Buf(0) = 2560: Buf(1) = 200
DIM i AS LONG

BSEG& = VARSEG(Buf(2)): BOFS& = VARPTR(Buf(2))


'       Change Back.pcx with one of your pcx files..
OPEN "BACK.PCX" FOR BINARY AS #1

	Fin& = LOF(1) - 767
	SEEK #1, Fin&
	pal$ = INPUT$(768, 1)
      
	p% = 1
	Fin& = Fin& - 1


	SCREEN 13

	FOR T& = 0 TO 255
		OUT &H3C8, T&
	      
		FOR hue% = 1 TO 3
			OUT &H3C9, ASC(MID$(pal$, p%)) \ 4: p% = p% + 1
		NEXT
	NEXT

	SEEK #1, 129
	T& = BOFS&

	DEF SEG = BSEG&

	CLS
      
	DO
		p$ = INPUT$(256, 1): FPos& = SEEK(1): l% = LEN(p$)
	      
		IF FPos& > Fin& THEN
			l% = l% - (FPos& - Fin&): p$ = LEFT$(p$, l%): view$ = "done"
		END IF
      
		FOR p% = 1 TO l%
			dat% = ASC(MID$(p$, p%))
		      
			IF rle% = 0 THEN
				IF (dat% AND 192) = 192 THEN
					rle% = dat% AND 63
				ELSE
					POKE T&, dat%: T& = T& + 1
				END IF
			ELSE
			FOR rle% = rle% TO 1 STEP -1
				POKE T&, dat%: T& = T& + 1
			NEXT
			END IF
		NEXT

LOOP UNTIL view$ = "done"
CLOSE 1
PUT (0, 0), Buf, PSET



END SUB

SUB SinusWave
DIM lines%(1 TO 144, 1 TO 200)                     'allocate memory
rmovement% = 20                                    'the movement amount
rspeed% = 25                                       'the movement speed

FOR n% = 1 TO 200
 GET (19, n% - 1)-(299, n% - 1), lines%(1, n%)     'get the 200 lines
NEXT n%
'CLS

DO
 s! = s! + rspeed% / 100                           'increase start value
 FOR n% = 1 TO 200
  c! = s! + n% / rmovement%                        'calculate position
  p% = (19 + SIN(c!) * 19)                         'for this line

  LINE (0, n% - 1)-(p% - 1, n% - 1), 0             'clear the left and
  LINE (p% + 279, n% - 1)-(319, n% - 1), 0         'right side

  PUT (p%, n% - 1), lines%(1, n%), PSET            'draw the line
 NEXT n%

LOOP WHILE INKEY$ = ""


END SUB

SUB txtpalget (col, r, g, B) STATIC
c = col

SELECT CASE c
CASE 6
 c = 20
CASE 8 TO 15
 c = c + 48
END SELECT

 OUT &H3C7, c

 r = INP(&H3C9)
 g = INP(&H3C9)
 B = INP(&H3C9)

END SUB

SUB txtpalset (col, r, g, B) STATIC

c = col

SELECT CASE c
CASE 6
 c = 20
CASE 8 TO 15
 c = c + 48
END SELECT

 OUT &H3C8, c
 OUT &H3C9, r
 OUT &H3C9, g
 OUT &H3C9, B

END SUB

REM $STATIC
SUB Wave
    Wave1 = Wave1 + WaveSide1
    IF Wave1 >= 80 THEN
	Wave1 = 0
	R1 = (R1 + 1) AND 255
	WaveSide1 = RAND(R1)
    END IF
  
    Wave2 = Wave2 + WaveSide2
    IF Wave2 >= 80 THEN
	Wave2 = 0
	R2 = (R2 + 2) AND 255
	WaveSide2 = RAND(R2)
    END IF
  
    Wave3 = Wave3 + WaveSide3
    IF Wave3 >= 80 THEN
	Wave3 = 0
	R3 = (R3 + 2) AND 255
	WaveSide3 = RAND(R3)
    END IF
  
    FOR i = 1 TO 2
	WAIT &H3DA, 8, 8
	WAIT &H3DA, 8, 0
    NEXT i
  
    position = 1
    FOR y = 0 TO 49
	e = COSINUS(y + Wave1)
	FOR x = 0 TO 79
	    col = COSINUS(x + Wave2) + e + COSINUS(x + Wave3) + COSINUS(x + y)
	    IF col > 127 THEN col = 127
	    POKE position, col
	    position = position + 2
	NEXT
    NEXT

END SUB