'===========================================================================
' Subject: BIG TEXT BANNER SCROLL             Date: 06-27-99 (15:00)       
'  Author: Viktor Rootselainen                Code: QB, QBasic, PDS        
'  Origin: viktor.rootselainen@pp.inet.fi   Packet: TEXT.ABC
'===========================================================================
'Big text & scroll on text mode
'for QB, QBX, VBDOS and QBasic
'by Viktor Rootselainen   (c) CrashSoft  1999
'http://personal.inet.fi/koti/v.r/qb/
DEFINT A-Z
DECLARE FUNCTION PeekWord% (Segment%, Offset%)
DECLARE SUB GetFont ()
DECLARE SUB PrintBig (text$, xpos%, ypos%, col%, flags%)
DECLARE SUB ScrollBig (text$, colr%, x1%, y1%, x2%, CharPos%, gpos%)
DECLARE FUNCTION BitGetR% (byte%, bit%)
DECLARE SUB ScrollTekst (text$, x%, y%, Position%, textwidth)
DECLARE SUB delay (time%)

DIM SHARED tPos(3), BitMask(7), Font AS STRING * 4096

txt$ = "This is normal scroll...     :)"
txt2$ = "BIG text scrolling by VR   1999"
txt3$ = "Press any key to exit..."
tPos(2) = -3: tPos(1) = -2

GetFont
CLS

DEF SEG = &HB800: char = 176
FOR i = 1 TO 480 STEP 2
    char = char + 1: IF char > 178 THEN char = 176
    POKE i + 1759, char
NEXT
DEF SEG

PrintBig "CrashSoft", 5, 3, 8, 2


DO
  PCOPY 0, 2: SCREEN , , 2, 1
  ScrollBig txt2$, 10, 1, 9, 11, tmp, tmp2

  COLOR 9: ScrollTekst txt3$, 20, 35, tPos(1), 20
  COLOR 15: ScrollTekst txt$, 25, 1, tPos(2), 80
  COLOR 14: ScrollTekst "Time is now " + TIME$, 2, 35, tPos(3), 15
  PCOPY 2, 1: SCREEN , , 1
  delay 90
LOOP WHILE INKEY$ = ""


SCREEN , , 0, 0
COLOR 7, 0: END

FUNCTION BitGetR (byte, bit)
'stupid sub

temp = BitMask(7 - bit)
IF (byte AND temp) THEN BitGetR = 1 ELSE BitGetR = 0

END FUNCTION

' Millisecond delay routine
' The time variable can be any integer value
' 1 = one millisecond, 1000 = one second 32767 = 32 seconds.
SUB delay (time)

OUT &H61, INP(&H61) AND &HFC
OUT &H43, &HB4
OUT &H42, 166
OUT &H42, 4
OUT &H61, INP(&H61) OR 1

FOR n = 1 TO time STEP 1
    DO
        OUT &H43, &H80
        t = INP(&H42)
    LOOP WHILE INP(&H42) > 2
    DO
        OUT &H43, &H80
        t = INP(&H42)
    LOOP WHILE INP(&H42) <= 2
NEXT n


END SUB

SUB GetFont

FOR a = 0 TO 7: BitMask(a) = 2 ^ a: NEXT a         'make 0-7 bit table

Segment = VARSEG(Font)
Offset = VARPTR(Font)
FontOffs = PeekWord(0, &H7C) - 1024                'bios font addr.
FontSeg = PeekWord(0, &H7E)

FOR i = 1 TO 4096
    DEF SEG = FontSeg: a = PEEK(FontOffs)
    DEF SEG = Segment: POKE Offset, a
    Offset = Offset + 1: FontOffs = FontOffs + 1
NEXT
DEF SEG


END SUB

FUNCTION PeekWord (Segment, Offset)
'this sucks!
            
DEF SEG = Segment
    low = PEEK(Offset)
    high = PEEK(Offset + 1)

    word& = (word& AND 255) OR ((high AND 255) * 256&)
    word& = (word& AND &HFF00) OR (low AND 255)
    PeekWord = VAL("&H" + HEX$(word&))
DEF SEG

END FUNCTION

SUB PrintBig (text$, xpos, ypos, col, flags)

  xx = xpos
  FOR chr = 1 TO LEN(text$)
   i = 8 * ASC(MID$(text$, chr, 1))
   FOR y = 1 TO 8: byte = ASC(MID$(Font$, i + y, 1)): yy = ypos + y
     FOR x = 0 TO 7: xpos = xx + x

     IF BitGetR(byte, x) AND xpos > 0 AND xpos <= 80 AND yy > 0 AND yy <= 25 THEN
        IF flags AND 2 THEN colr = col + y ELSE IF flags AND 1 THEN colr = col + 7 - x ELSE colr = col
        LOCATE yy, xpos: COLOR colr: PRINT "Û";
     END IF

  NEXT: NEXT: xx = xx + 8: NEXT

END SUB

SUB ScrollBig (text$, colr, x1, y1, x2, CharPos, gpos)

txt$ = SPACE$(x2 - 1) + text$ + " "

IF CharPos > 0 THEN
   print$ = MID$(txt$, CharPos, x2)
   PrintBig print$, x1 - gpos, y1, colr, 0
END IF

gpos = gpos + 1: IF gpos > 7 THEN gpos = 0: CharPos = CharPos + 1
IF CharPos > LEN(txt$) THEN CharPos = 0

END SUB

SUB ScrollTekst (text$, x, y, Position, textwidth)

Position = Position + 1
IF x <= 0 OR x > 25 OR y <= 0 OR y > 80 OR Position <= 0 THEN EXIT SUB

txt$ = SPACE$(textwidth - 1) + text$ + " "
LOCATE x, y: print$ = MID$(txt$, Position, textwidth)
PRINT print$;

IF Position > LEN(txt$) THEN Position = 0

END SUB