'===========================================================================
' Subject: STAR SCROLL                       Date: 04-07-97 (17:31)       
' Author:  Angelo Ken Pesce                  Code: QB, QBasic, PDS        
' Origin:  us0082@uniserv.uniplan.it       Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB SETPAL ()
DECLARE SUB mov (xs%, ys%, xe%, ye%, xm%, ym%)
DECLARE SUB scrd ()
DECLARE SUB rndp ()
' ------------------------------------------ Init
'$DYNAMIC
DEFINT A-Z
SCREEN 13: CALL SETPAL
DIM SHARED scr(319, 100) AS INTEGER
CONST vgaseg = &HA000
CLS
' -----------------------------------------------

' ------------------------------------------ Main
DEF SEG = vgaseg
DO
CALL rndp

' FIRST LINE
CALL mov(1, 1, 106, 33, -1, -1)
CALL mov(106, 1, 212, 33, 0, -1)
CALL mov(212, 1, 318, 33, 1, -1)

' CENTRAL LEFT AND RIGHT
CALL mov(1, 33, 106, 65, -1, 0)
CALL mov(212, 33, 318, 65, 1, 0)

' LAST LINE
CALL mov(1, 64, 106, 101, -1, 1)
CALL mov(106, 65, 212, 100, 0, 1)
CALL mov(212, 65, 318, 99, 1, 1)

' CENTRAL CENTRAL UP
CALL mov(107, 35, 160, 50, -1, -1)
CALL mov(159, 35, 211, 50, 1, -1)
' CENTRAL CENTRAL DOWN
CALL mov(107, 49, 160, 66, -1, 1)
CALL mov(159, 50, 211, 65, 1, 1)

CALL scrd
LOOP UNTIL INKEY$ <> ""
DEF SEG
END
' -----------------------------------------------

REM $STATIC
SUB mov (xs, ys, xe, ye, xm, ym)

' xs,ys = start position (x,y) (max 319,100)
' xe,ye = end position (x,y) (max 319,100)
' xm,ym = shift value (x,y)

ynd = 320 - (xe - xs + 1): ind = ys * 320 + xs
xs = xs + xm: xe = xe + xm
ys = ys + ym: ye = ye + xm
FOR y = ys TO ye
FOR x = xs TO xe
col = (PEEK(ind) + PEEK(ind + 1) + PEEK(ind - 1) + PEEK(ind + 320) + PEEK(ind - 320)) / 5
IF col < 0 THEN col = 0
ind = ind + 1
scr(x, y) = col
NEXT
ind = ind + ynd
NEXT
END SUB

SUB rndp
FOR i = 0 TO 200
x = RND * 319
y = RND * 100
POKE (y * 320 + x), 127
NEXT
END SUB

SUB scrd
FOR y = 0 TO 100
FOR x = 0 TO 319
POKE (ind), scr(x, y)
ind = ind + 1
NEXT
NEXT
END SUB

SUB SETPAL
FOR i = 0 TO 126
PALETTE i, ((63 - ABS(63 - i)) * 256 + (INT(i / 2) * 65536))
FOR ii = 0 TO 5
PSET (i, ii), i
NEXT
NEXT
PALETTE 127, 0
END SUB