'Code supplement for Lens Flare tutorial
'for QB express
'Relsoft 2004
'Http://Rel.Betterwebber.com
'
'Special thanks to:
'Plasma357 for SetVideoSeg
'Pete for QBexpress

DECLARE SUB normalizevec (v AS ANY)
DECLARE SUB SetVideoSeg (Segment%)
DEFINT A-Z

'$DYNAMIC

TYPE vector2d               '2d vector used to get flare positions
    x   AS SINGLE           'x component
    y   AS SINGLE
    mag AS SINGLE           'length
END TYPE

CONST PI = 3.141593         'pie
CONST xcenter = 160         'center of screen
CONST ycenter = 100


'Setvideoseg stuff
REDIM vpage(32009) AS INTEGER        'Clear offscreen buffer
vpage(6) = 2560                      'Width 320*8
vpage(7) = 200                       'Height

DIM SHARED Layer
Layer = VARSEG(vpage(0)) + 1         'Buffer Seg(Ask Plasma)


DIM vec AS vector2d                 'dimension both the light
DIM light AS vector2d               'and direction vector


CLS
SCREEN 13                           '320*200*256


SetVideoSeg Layer                   'Set Draw to Buffer
cx = xcenter                        'center of screen
cy = ycenter

DO

frame& = (frame& + 1) AND &H7FFFFFFF
'move the flare vector using trig functions
'and timer as parameter

T! = TIMER
light.x = INT(COS(T! * .4) + SIN(T!) * 100)
light.y = INT(SIN(T! + .2) * SIN(T! * .5) * 64)

'change the length for cooler effect
leng = INT(SIN(T! + .2) * SIN(T! * .5) * 256)


'center our light vector
light.x = light.x + cx
light.y = light.y + cy


'derive flare vector from center and light
vec.x = cx - light.x
vec.y = cy - light.y

'normalize it
normalizevec vec



'get positions of flares relative to center

l1! = leng
l2! = leng / 1.5
l3! = leng / 2


l4! = -leng / 8
l5! = -leng / 2
l6! = -leng


SetVideoSeg Layer                   'Set Draw to Buffer
LINE (0, 0)-(319, 199), 0, BF       'clear screen


    nx! = vec.x * l1! + cx
    ny! = vec.y * l1! + cy
    PSET (nx!, ny!), 15


    'ditto but single flare
    nx! = vec.x * l2! + cx
    ny! = vec.y * l2! + cy
    PSET (nx!, ny!), 15

    'ditto
    nx! = vec.x * l3! + cx
    ny! = vec.y * l3! + cy
    PSET (nx!, ny!), 15

    'ditto
    nx! = vec.x * l4! + cx
    ny! = vec.y * l4! + cy
    PSET (nx!, ny!), 15

    'ditto
    nx! = vec.x * l5! + cx
    ny! = vec.y * l5! + cy
    PSET (nx!, ny!), 15

    'ditto
    nx! = vec.x * l6! + cx
    ny! = vec.y * l6! + cy
    PSET (nx!, ny!), 15
SetVideoSeg &HA000          'set draw to VGA
WAIT &H3DA, 8               'wait retrace
PUT (0, 0), vpage(6), PSET  'blit to screen

LOOP UNTIL INKEY$ <> ""

END

REM $STATIC
SUB normalizevec (v AS vector2d)
'normalizes v to give it a length of 1

    dx! = v.x
    dy! = v.y
    dist! = SQR(dx! * dx! + dy! * dy!)
    IF dist! < .00001 THEN EXIT SUB  'just a precaution for too small
                                     'values
    v.x = dx! / dist!
    v.y = dy! / dist!
    v.mag = dist!

END SUB

SUB SetVideoSeg (Segment) STATIC

  '===============================================================
  ' SetVideoSeg by Plasma
  '---------------------------------------------------------------
  ' Changes QB's active video segment for SCREEN 13
  '---------------------------------------------------------------
  ' * Works for all graphics functions (does not work with PRINT)
  ' * Compatible with:      QBasic 1.x
  '                     QuickBasic 4.x (IDE & compiled)
  '                         QB PDS 7.1 (IDE & compiled)
  '                          VBDOS 1.0 (IDE & compiled)
  '===============================================================


  DEF SEG

  ' If SetVideoSeg was previously called, we can just
  ' set the new segment and bail.

  IF VideoSegOff <> 0 THEN
    POKE VideoSegOff, Segment AND &HFF
    POKE VideoSegOff + 1, (Segment AND &HFF00&) \ &H100
    EXIT SUB
  END IF


  ' Otherwise we have to search for b$AddrC, which holds the
  ' graphics offset (b$OffC) and segment (b$SegC). Since b$AddrC
  ' is in the default segment, we can find it by setting it to a
  ' certain value, and then searching for that value.

  SCREEN 13             ' Set b$SegC to A000 (00A0 in memory)
  PSET (160, 100), 0    ' Set b$OffC to 7DA0 (not needed in the IDE)

  ' Search for b$AddrC, which is in the default segment and
  ' should have a value of A0 7D 00 A0.
  FOR i = 0 TO &H7FFC
    IF PEEK(i) = &HA0 AND PEEK(i + 1) = &H7D THEN
    IF PEEK(i + 2) = &H0 AND PEEK(i + 3) = &HA0 THEN
      ' Found it, so set b$SegC to the specified segment and exit
      VideoSegOff = i + 2
      POKE VideoSegOff, Segment AND &HFF
      POKE VideoSegOff + 1, (Segment AND &HFF00&) \ &H100
      EXIT SUB
    END IF
    END IF
  NEXT

  SCREEN 0
  WIDTH 80, 25
  PRINT "SetVideoSeg Error: Cannot find video segment offset."
  PRINT "Check to make sure you are using a compatible version of QB."
  END

END SUB