'===========================================================================
' Subject: SHINE FX TEXT                     Date: 03-04-97 (18:20)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  Convert from Pascal code        Packet: TEXT.ABC
'===========================================================================
'/--------------------------------------------------------------\
'| SHINE FX TEXT  Converted from Pascal code by William Yu       |
'|                Released to the Public Domain (03-01-97)       |
'|                                                               |
'| Cheap plugs: Do you remember TheDraw's (v4.6+) shiny intro?   |
'|              How about TouchStone(tm) Pictures shiny ending?  |
'\--------------------------------------------------------------/

DECLARE SUB Init.XTable ()
DECLARE SUB Shine (sx%, sy%, ex%, ey%, C%)
DECLARE SUB ShowImage ()
DEFINT A-Z

' Shine FX (Pascal version) - by Christopher J. C.
' inspired by lotsa product out there that use this kind of FX

' This code is public domain.  Do whatever you want with it.

' A credit line for me would be nice  ;^p

CONST MaxRow = 25
CONST MaxColumn = 80

DIM SHARED XTable(1 TO MaxRow) AS INTEGER

DEF SEG = &HB800

 Init.XTable
 ShowImage
 DO
   Shine 1, 1, 31, 12, 15
 LOOP UNTIL INKEY$ <> ""

END

SUB Init.XTable
  FOR cnt = 0 TO MaxRow - 1
    XTable(cnt + 1) = -cnt
  NEXT cnt
END SUB

SUB Shine (sx, sy, ex, ey, C)

DIM Buffer(1 TO MaxRow) AS INTEGER     ' Add or remove the number
DIM Buffer2(1 TO MaxRow) AS INTEGER    ' of light sequences as desired, and
DIM Buffer3(1 TO MaxRow) AS INTEGER    ' delete necessary code from below

 cnt = 0
 FOR x = sx TO ex + ey - sy
   FOR y = sy TO ey
     IF (XTable(y - sy + 1) + x > sx - 1) AND (XTable(y - sy + 1) + x < ex + 1) THEN
       num = (y - 1) * 160 + (XTable(y - sy + 1) + (x - 1)) * 2 + 1
       Buffer(y) = PEEK(num)                    'save background attr.
       Buffer2(y) = PEEK(num + 2)               '2nd save
       Buffer3(y) = PEEK(num + 4)               '3rd save
       POKE num, C + (Buffer(y) AND 240)        'highlight the spot
                                                'Just change the attribute
       POKE num + 2, C + (Buffer2(y) AND 240)   '2nd highlight
       POKE num + 4, C + (Buffer3(y) AND 240)   '3rd highlight
     END IF
   NEXT y

   WAIT &H3DA, 8     ' Wait for retrace, else chaos erupts!
  
   FOR y = sy TO ey
     IF (XTable(y - sy + 1) + x > sx - 1) AND (XTable(y - sy + 1) + x < ex + 1) THEN
       'restore background attr.
       ' 1st, 2nd, then 3rd
       POKE ((y - 1) * 160 + (XTable(y - sy + 1) + (x - 1)) * 2 + 1), Buffer(y)
       POKE ((y - 1) * 160 + (XTable(y - sy + 1) + (x - 1)) * 2 + 1) + 2, Buffer2(y)
       POKE ((y - 1) * 160 + (XTable(y - sy + 1) + (x - 1)) * 2 + 1) + 4, Buffer3(y)
     END IF
   NEXT y
 NEXT x
END SUB

SUB ShowImage

 FOR cnt = 1 TO 7
   LOCATE cnt + 1, 1: COLOR 11: PRINT "Û"
   LOCATE cnt + 4, 31: COLOR 9: PRINT "Û"
 NEXT cnt
 COLOR , 3
 FOR cnt = 2 TO 11
   LOCATE cnt, 2: PRINT SPACE$(29)
 NEXT cnt
 
 COLOR 11, 0
LOCATE 1, 1: PRINT "ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ";
COLOR 3: PRINT "Ü"
LOCATE 12, 1: PRINT "ß";
COLOR 9: PRINT "ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß"
COLOR , 3: LOCATE 9, 1: COLOR 11: PRINT "²"
LOCATE 10, 1: PRINT "±": LOCATE 11, 1: PRINT "°"
LOCATE 4, 31: COLOR 9: PRINT "²"
LOCATE 3, 31: PRINT "±": LOCATE 2, 31: PRINT "°"
COLOR 11: LOCATE 3, 10: PRINT "Shine FX Text"
COLOR 8: LOCATE 4, 7: PRINT "ÄÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÄ"
COLOR 12: LOCATE 5, 9: PRINT "Pascal Code by"
COLOR 1: LOCATE 6, 8: PRINT "Christopher J. C."
COLOR 12: LOCATE 7, 9: PRINT "BASIC Code by"
COLOR 1: LOCATE 8, 11: PRINT "William Yu"
COLOR 8: LOCATE 9, 7: PRINT "ÄÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÄ"
COLOR 11: LOCATE 10, 4: PRINT "Add a little shine to the"
LOCATE 11, 5: PRINT "usually boring screen"

END SUB