'===========================================================================
' Subject: VGA CHRISTMAS DEMO                Date: 05-26-96 (10:02)       
' Author:  David A. Wicker                   Code: QB, QBasic, PDS        
' Origin:  david@fastlane.net              Packet: GRAPHICS.ABC
'===========================================================================
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³                 * SCENARIO BBS VGA CHRISTMAS DEMO *                ³
' ³                                                                    ³
' ³      Written by David A. Wicker ÄÄ (C) 1996+ Scenario, Inc.        ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
DECLARE SUB PPSET (H, V, C)
DECLARE SUB SweetLine (X1, Y1, X2, Y2)
DECLARE SUB GPR (H, V, T$)
DECLARE SUB PRGB (C, R, G, B)
DECLARE SUB RGB (P, R, G, B)
DECLARE SUB CRGB (N, R, G, B)
DECLARE SUB DEC (N)
DECLARE SUB INC (N)

RANDOMIZE TIMER

'ON ERROR GOTO ErrFound
SCREEN 13
DEF SEG = &HA000
RANDOMIZE TIMER

DEF FNR (A) = INT(RND * A)
DEF FNN$ (A) = MID$(STR$(A), 2)
DEF FNO$ (A$) = LEFT$(A$, 1)
DEF FNC$ (A$, A) = MID$(A$, A, 1)
DEF FNVAL (A$, A) = VAL(FNC$(A$, A))

  DIM FontIMG$(96)
  FOR I = 1 TO 96
    READ FontIMG$(I)
  NEXT

FOR I = 0 TO 254
  PALETTE I, 0
NEXT
PALETTE 255, 47 + 65536 * 63
 
LINE (0, 162)-(319, 162), 255
LINE (0, 189)-(319, 189), 255

TextSize = 1
TextColor = 255
OffSetY = 1
GPR 19, 13, "Just a moment..."

DIM I.ScrTxt(3841)

X! = 0
LY! = 0
FOR Y = 0 TO 130
  C = FNR(12)
  FOR I = 160 - X! TO 160 + X!
    PPSET I, Y + 10, C + 32
    C = C + FNR(4)
    IF C > 11 THEN C = C - 12
  NEXT
  X! = X! - 2 + SIN(((Y + 10) MOD 20) / 40) * 11.5
NEXT

FOR Y = 141 TO 160
  C = FNR(12)
  FOR X = 160 - 20 TO 160 + 20
    PPSET X, Y, C + 66
    C = C + FNR(4)
    IF C > 11 THEN C = C - 12
  NEXT
NEXT

READ A$
  FOR I = 1 TO LEN(A$) STEP 4
    X1 = FNVAL(A$, I)
    Y1 = FNVAL(A$, I + 1)
    X2 = FNVAL(A$, I + 2)
    Y2 = FNVAL(A$, I + 3)
    SweetLine 160 - 12 + X1 * 3, Y1 * 3, 160 - 12 + X2 * 3, Y2 * 3
  NEXT

C = 0
FOR V = 20 TO 161 STEP 3
  FOR H = 0 TO 319 STEP 6
    LV = V
MoreLites:
    IF POINT(H + 3, V + 3) > 0 AND POINT(H + 3, V + 3) < 62 THEN
      CIRCLE (H + 2, V + 2), 1, 48 + C * 2
      PPSET H + 2, V + 2, 49 + C * 2
      INC C
      IF C = 7 THEN C = 0
      H = H + 6 + FNR(3)
      V = V + FNR(3) + 1
      INC LV
    GOTO MoreLites
    ELSE
      V = LV
      C = FNR(7)
    END IF
  NEXT
NEXT

FOR H = 0 TO 319 STEP 4
  I! = RND * 2 + 1
  C = FNR(31) + 1
  X! = H
  YY = FNR(162)
  FOR Y! = 0 TO 161 STEP I!
    IF POINT(X!, Y!) = 0 THEN PPSET INT(X!), INT(Y!), C
    X! = X! + SIN((Y! + YY) / 10) * 3
    INC C
    IF C = 32 THEN C = 1
  NEXT
NEXT

T$ = "Seasons Greetings From *Lost *Scenario!    "
T$ = T$ + "SysOp: *Topaz  Co-SysOp: *Primrose    "
T$ = T$ + "Here's wishing you the very best for the holidays and a "
T$ = T$ + "very Happy New Year!  "
T$ = T$ + "    Scenario used to be a BBS local to Fort Worth, but has now "
T$ = T$ + "moved to the internet!    "
T$ = T$ + "*Scenario BBS specialized in file transfers "
T$ = T$ + "including crunched GIFs and JPGs, unique and original games and "
T$ = T$ + "tool files.  For Message Bases it had: Time Wind's Tavern, "
T$ = T$ + "Primrose Erotica, Philosophy Base, Swap/Trade/Sell, and The "
T$ = T$ + "Warboard.    "
T$ = T$ + "From all of me to all of you, *Merry *Christmas!!"
T$ = T$ + STRING$(50, " ")

FOR I = 1 TO LEN(T$)
  A& = A& + ASC(FNC$(T$, I))
NEXT

'Bad: IF A& <> 87735 THEN GOTO Bad

FOR I = 0 TO 15
  PALETTE 32 + I, 256 * I * 4
  PALETTE 62 + I, I * 3
NEXT

FOR I = 0 TO 7
  PRGB 78 + I, I, 0, 7
  PRGB 78 + 8 + I, 7, 0, 7 - I
  PRGB 78 + 16 + I, 7, I, 0
  PRGB 78 + 24 + I, 7 - I, 7, 0
  PRGB 78 + 32 + I, 0, 7 - I, I
NEXT

FOR I = 0 TO 319
  PPSET I, 162, 78 + I \ 8
  PPSET I, 189, 78 + I \ 8
NEXT

PALETTE 254, 63 + 63 * 256 + 63 * 65536
FOR V = 0 TO 5
  FOR H = 0 TO 319
    IF V = 0 OR (POINT(H, 161 - V) = 254 AND FNR(7 - V) > 0) THEN PPSET H, 160 - V, 254
  NEXT
NEXT

TextSize = 4
TextColor = 78
GPR 9, 0, CHR$(128)

TP = 1
TextSize = 2
OffSetY = 8
OffSetX = 10
DO
  FOR I = 1 TO 31
    PALETTE I, 63 + 63 * 256 + 63 * 65536
    IF NT = 0 THEN
      NT = 4
      IF FNC$(T$, TP) = "*" OR (Flicker = 1 AND FNC$(T$, TP) <> " ") THEN
        TextColor = 254
        Flicker = 1
        IF FNC$(T$, TP) = "*" THEN TP = TP + 1
      ELSE
        Flicker = 0
        TextColor = 78 + ((TP - 1) MOD 40)
      END IF
      GPR 25, 6, FNC$(T$, TP)
      INC TP
      IF TP = LEN(T$) THEN TP = 1
    END IF
    DEC NT
    GET (3, 164)-(319, 187), I.ScrTxt
    PUT (0, 164), I.ScrTxt, PSET
    LINE (317, 164)-(319, 187), 0, BF
    R = FNR(14)
    IF R = 0 THEN
      CRGB 48, 3, 0, 3
      CRGB 49, 4, 0, 4
    ELSEIF R = 1 THEN
      CRGB 48, 1, 0, 1
      CRGB 49, 2, 0, 2
    ELSEIF R = 2 THEN
      CRGB 50, 3, 0, 0
      CRGB 51, 4, 0, 0
    ELSEIF R = 3 THEN
      CRGB 50, 1, 0, 0
      CRGB 51, 2, 0, 0
    ELSEIF R = 4 THEN
      CRGB 52, 3, 1, 0
      CRGB 53, 4, 2, 0
    ELSEIF R = 5 THEN
      CRGB 52, 1, 0, 0
      CRGB 53, 2, 1, 0
    ELSEIF R = 6 THEN
      CRGB 54, 3, 3, 0
      CRGB 55, 4, 4, 0
    ELSEIF R = 7 THEN
      CRGB 54, 1, 1, 0
      CRGB 55, 2, 2, 0
    ELSEIF R = 8 THEN
      CRGB 56, 0, 3, 0
      CRGB 57, 0, 4, 0
    ELSEIF R = 9 THEN
      CRGB 56, 0, 1, 0
      CRGB 57, 0, 2, 0
    ELSEIF R = 10 THEN
      CRGB 58, 0, 0, 3
      CRGB 59, 0, 0, 4
    ELSEIF R = 11 THEN
      CRGB 58, 0, 0, 1
      CRGB 59, 0, 0, 2
    ELSEIF R = 12 THEN
      CRGB 60, 3, 3, 3
      CRGB 61, 4, 4, 4
    ELSEIF R = 13 THEN
      CRGB 60, 1, 1, 1
      CRGB 61, 2, 2, 2
    END IF
    PALETTE I, 0
  NEXT
LOOP UNTIL INKEY$ > ""

Around:

SCREEN 0: WIDTH 80: CLS : COLOR 7, 0
C(0) = 0
C(1) = 1
C(2) = 9
C(3) = 11
C(4) = 15
C(5) = 15
FOR I = 1 TO 79
  COLOR C(FNR(2) + I \ 20)
  LOCATE 9, I
  PRINT "Ä";
  LOCATE 13, I
  PRINT "Ä";
NEXT
LOCATE 10, 1
COLOR 15
PRINT "Home Page Address: ";
COLOR 13:
PRINT "http://www.fastlane.net/homepages/david/david.html"
LOCATE 12, 1
COLOR 15
PRINT "Mailing Address  : ";
COLOR 14
PRINT "david@fastlane.net"
COLOR 7
LOCATE 23
END

ErrFound:
  WIDTH 80
  SCREEN 0, 0
  SCREEN 0, 1
  CLS
  LOCATE 12, 22
  COLOR 12
  PRINT "OOPS!  You don't support VGA Graphix!"
  COLOR 7
END

FontData:
DATA BR2D5BD2D,BRD2BR2U2,BRD8BR2U8BFBDL4BD4R4,BFBR3L3GDFR2FDGL3BFBRU8
DATA BDRDLUBFBR3G4BR3RDLU,BF3BRHL2GDFR2L2GDFR2EGBGU8,BR2D2,BR3G2D4F2,BRF2D4G2
DATA BF2D4BEH2BGR4BHG2,BF2D4BE2L4,BF2BD5DG,BD4R4,BF2BD5D,BF2BR2G4
DATA BRR2FD6GL2HU6EBFBD2D2,BFED8RL2,BDER2FD2G4DR4,R4D2G2RFD2GL2H
DATA BR4LG3D2R4U2D5,BR4L4D3R3FD3GL2H,BR3LG2D5FR2EU2HL,R4D3G2D3
DATA BRR2FD2GL2HU2EBD4GD2FR2EU2H,BF2BD3LHU3ER2FD5G2L,BF2DBD2D,BFBRDBD2D3G
DATA BFBR2G3F3,BD2R4BD4L4,BFF3G3,R3FD2GLDBD2D,BF2G2F2E2H2D4HU2EFD2
DATA BD8U7ER2FD7BU3L2,BD8U8R3FD2GLRFD2GL,BFBR3HL2GD6FR2E,BD8U8R3FD6GL
DATA BR4L3GD6FR3BH3BUR,BR4L3GD7BEBU3R,BR3L2GD6FR3U4L,D8BEBU3R3U4D8,BRR2LD8LR2
DATA BR3RD7GL2H,D8BR4UH3E3U,D8R4,BD8U8F2DUE2D8,BD8U8R3FD7,BRR2FD6GL2HU6E
DATA BD8U8R3FD3GL,BRR2FD5G2LHU6EBDBFBD4F2,BD8U8R3FD2G2F2D
DATA BFBR3HL2GD2FR2FD2GL2H,R4L2D8,D7FR2EU7,D6F2E2U6,D7FEU2D2FEU7
DATA D2F4D2BL4U2E4U2,D3F2E2U3BG2BD3D3,R4D2G4D2R4,BR4L3D8R3L2U8,BD2F4
DATA R3D8L3R2U8,BD4E2F2,BD8R4,BR2DF,BFBD2R2FD4L3HUER,D8R3EU3HL,BF4HL2GD3FR2E
DATA BR4D8L3HU3ER,BF2BD3R2UHL2GD3FR2E,BR4LGD9GLBE2BU6LR3,BF2BD6LHU3ER3D7GL2H
DATA D8BEBU4R2FD4,BR2DBGBDRD5,BR4DBGBDRD7GL2H,D8BR4H2UE2,BRRD8RL2
DATA BD8U5R2D2U2RFD4,BD8U5R3FD4,BFBD2R2FD3GL2HU3E,BD11U8R3FD3GL
DATA BF4BD7U8L3GD3FR,BD8U5R3F,BFBRBF2L3GFR2FDGL3,BRD7FRBU5L2,BD3D4FR2EU4
DATA BD3D3F2E2U3,BD3D4FEUDFEU4,BD3F2DG2BR4H2UE2,BD3D4FRBE2BU3D7GL2H
DATA BD3R4G4DR4,BFBR3LGDGFDFR,BR2D3BD2D3,BDRFDFGDGL,BDEFEDGHGU
DATA F4G4U8FD6EU4FD2
TopazData:
DATA BRR3BLG2LE2BR3G2RE2LBRR2G2L2BR2BE2BRR3GLBUG2LE2BR4G2RE2LBRR2G2BELBEBR2RG2RE2LBGBDR

StarData:
DATA 4053538383656578784646181825250303333340

SUB CRGB (N, R, G, B)
  RR = R * 16 - 1
  GG = G * 16 - 1
  BB = B * 16 - 1
  IF RR < 0 THEN RR = 0
  IF GG < 0 THEN GG = 0
  IF BB < 0 THEN BB = 0
  RGB N, RR, GG, BB
END SUB

SUB DEC (N)
  N = N - 1
END SUB

SUB GPR (H, V, T$) : SHARED FontIMG$(), TextColor, TextSize, OffSetY, OffSetX
  TS = TextSize
  AX = TS - 1
  AY = TS - 1
  IF FNO$(T$) > CHR$(127) THEN
    AX = 1
    AY = 0
  END IF
  FOR I = 1 TO LEN(T$)
    FOR X = 0 TO AX
      FOR Y = 0 TO AY
        DRAW "BM" + FNN$((I + H - 1) * 6 * TS + X + OffSetX) + "," + FNN$(V * 13 * TS + Y + OffSetY) + "C" + FNN$(TextColor) + "S" + FNN$(TS * 4) + FontIMG$(ASC(MID$(T$, I, 1)) - 32)
      NEXT
    NEXT
  NEXT
END SUB

SUB INC (N)
  N = N + 1
END SUB

SUB PPSET (H, V, C)
  POKE V * 320& + H, C
END SUB

SUB PRGB (C, R, G, B)
  RGB C, R * 8, G * 8, B * 8
END SUB

SUB RGB (N, R, G, B)
  OUT &H3C8, N
  OUT &H3C9, R
  OUT &H3C9, G
  OUT &H3C9, B
END SUB

SUB SweetLine (X1, Y1, X2, Y2) : SHARED LastSweetColor
  H1! = X1
  V1! = Y1
  H2! = X2
  V2! = Y2
  C = LastSweetColor
  A! = -1
  B! = -1
  IF V1! <> V2! THEN A! = ABS(H1! - H2!) / ABS(V1! - V2!)
  IF H1! <> H2! THEN B! = ABS(V1! - V2!) / ABS(H1! - H2!)
  IF A! < 0 OR A! > 1 THEN A! = 1
  IF B! < 0 OR B! > 1 THEN B! = 1
  DO
    LINE (160, 12)-(H1!, V1!), C + 78
    INC C
    IF C = 40 THEN C = 0
    IF INT(H1!) < INT(H2!) THEN H1! = H1! + A!
    IF INT(H1!) > INT(H2!) THEN H1! = H1! - A!
    IF INT(V1!) < INT(V2!) THEN V1! = V1! + B!
    IF INT(V1!) > INT(V2!) THEN V1! = V1! - B!
  LOOP UNTIL INT(H1!) = INT(H2!) AND INT(V1!) = INT(V2!)
  LastSweetColor = C
END SUB