'
' DEMO.BAS - demonstrates use of BIN files from
'            Brent's QBASIC toolbox
'
' (C)1991 Brent Ashley
'
DEFINT A-Z
DECLARE SUB BiosPrint (Row%, Col%, Attr%, OutStr$)
DECLARE SUB BlockCopy (FromSeg%, FromOfs%, ToSeg%, ToOfs%, Count%)
DECLARE SUB Explode (Top%, Lft%, Bot%, Rgt%, Attr%, Shad%, Delay)
DECLARE SUB ScrnSave (SaveRestore%)
DECLARE SUB ScrollArea (Top%, Lft%, Bot%, Rgt%, Attr%, Lines%)
DECLARE SUB SLBox (Top%, Lft%, Bot%, Rgt%, Attr%, Shad%)
DECLARE SUB TickPause (Ticks%)
DECLARE FUNCTION ColorAttr% (Fore%, Back%)
DECLARE FUNCTION CurDir$ (DriveNum%)
DECLARE FUNCTION CurDrive% ()
DECLARE FUNCTION DayOfWeek% ()
DECLARE FUNCTION DosVer$ ()
DECLARE FUNCTION FileExist% (Filespec$)
DECLARE FUNCTION LoadBin$ (BinFileName$)
DECLARE FUNCTION WeekDay$ ()
TYPE RegTypeX
  AX    AS INTEGER
  BX    AS INTEGER
  CX    AS INTEGER
  DX    AS INTEGER
  BP    AS INTEGER
  SI    AS INTEGER
  DI    AS INTEGER
  Flags AS INTEGER
  DS    AS INTEGER
  ES    AS INTEGER
END TYPE
DIM SHARED Regs AS RegTypeX
DECLARE SUB Interrupt (IntNum%, Regs AS RegTypeX)
CLS
' fill screen with letters
FOR i = 1 TO 24
  PRINT STRING$(80, 64 + i);
NEXT
TickPause 9

' fancy scrolling
FOR i = 6 TO 15
  ScrollArea 6, 25, 15, 55, ColorAttr(7, i), 1
  TickPause 2
NEXT
TickPause 8
FOR i = 2 TO 23
  ScrollArea 2, 2, 23, 79, ColorAttr(7, i), -1
  TickPause 1
NEXT
TickPause 8

' panel and box
ScrollArea 5, 10, 21, 70, ColorAttr(0, 3), 0
SLBox 8, 30, 18, 47, ColorAttr(3, 0), 1

' quick color printing via BIOS
FOR i = 9 TO 17
  BiosPrint i, 31, ColorAttr(23 - i, i), " Interrupt Demo "
NEXT
COLOR 31, 1: LOCATE 23, 32: PRINT " Press a key... ";
' save screen
ScrnSave 1
DO: LOOP UNTIL LEN(INKEY$)
CLS

' random boxes!
RANDOMIZE TIMER
FOR i = 1 TO 50
  Top = 1 + RND(1) * 20
  Lft = 1 + RND(1) * 70
  Bot = Top + (23 - Top) * RND(1) + 1
  Rgt = Lft + (77 - Lft) * RND(1) + 1
  Fore = RND(1) * 15
  Back = RND(1) * 8
  SLBox Top, Lft, Bot, Rgt, ColorAttr(Fore, Back), 1
NEXT
COLOR 3, 0
SLBox 8, 25, 16, 55, ColorAttr(3, 0), 1
BiosPrint 10, 32, ColorAttr(19, 0), "50 Speedy Boxes!"
LOCATE 12, 32: PRINT " Press a key to"
LOCATE 13, 32: PRINT "see first screen"
LOCATE 14, 32: PRINT "    again..."
DO: LOOP UNTIL LEN(INKEY$)
' restore screen
ScrnSave 0
DO: LOOP UNTIL LEN(INKEY$)

' show some system info
COLOR 14, 1
Attr = ColorAttr(14, 1)
Explode 5, 15, 17, 65, Attr, 0, 0
LOCATE 8, 23: PRINT "     Today is: "; WeekDay$
LOCATE 9, 23: PRINT "Current Drive: "; CHR$(CurDrive + 64)
LOCATE 10, 23: PRINT "    Directory: "; CurDir$(0)
LOCATE 11, 23: PRINT "  Dos Version:"; DosVer$
IF FileExist("C:\CONFIG.SYS") THEN Sys$ = "Exists" ELSE Sys$ = "Not there"
LOCATE 12, 23: PRINT "C:\CONFIG.SYS: "; Sys$
IF FileExist("C:\QWERTY.UIO") THEN Sys$ = "Exists" ELSE Sys$ = "Not there"
LOCATE 13, 23: PRINT "C:\QWERTY.UIO: "; Sys$
ScrnSave 1
Explode 19, 20, 23, 60, Attr, 1, 3
LOCATE 21, 26: PRINT "Wow! - Pretty neat, Huh?!?"
TickPause 30
ScrnSave 0
DO: LOOP WHILE LEN(INKEY$) ' clear keyboard buffer
DO: LOOP UNTIL LEN(INKEY$)
COLOR 7, 0: CLS
PRINT "...end of demo."

SUB BiosPrint (Row, Col, Attr, OutStr$)
  ' print string using BIOS - only available on AT and later
  Regs.AX = &H1301
  Regs.BX = Attr
  Regs.CX = LEN(OutStr$)
  Regs.DX = (Row - 1) * 256 + (Col - 1)
  Regs.ES = VARSEG(OutStr$)
  Regs.BP = SADD(OutStr$)
  Interrupt &H10, Regs
END SUB

SUB BlockCopy (FromSeg, FromOfs, ToSeg, ToOfs, Count)
  STATIC MemCopy$
  IF NOT LEN(MemCopy$) THEN MemCopy$ = LoadBin("MemCopy.BIN")
  DEF SEG = VARSEG(MemCopy$)
  CALL Absolute(FromSeg, FromOfs, ToSeg, ToOfs, Count, SADD(MemCopy$))
END SUB

FUNCTION ColorAttr (Fore, Back)
  ColorAttr = (Fore AND 16) * 8 + (Back AND 7) * 16 + (Fore AND 15)
END FUNCTION

FUNCTION CurDir$ (DriveNum)
  ' returns current dir without leading \ or drive
  ' drive number is 0 for default, 1 for a, etc
  STATIC Temp$
  Temp$ = SPACE$(64)
  Regs.AX = &H4700
  Regs.DX = DriveNum
  Regs.DS = VARSEG(Temp$)
  Regs.SI = SADD(Temp$)    ' use SADD for dynamic strings!
  Interrupt &H21, Regs
  CurDir$ = LEFT$(Temp$, INSTR(Temp$, CHR$(0)) - 1)
END FUNCTION

FUNCTION CurDrive
  ' returns logged drive (a=1, b=2, etc)
  Regs.AX = &H1900
  Interrupt &H21, Regs
  CurDrive = Regs.AX MOD 256 + 1
END FUNCTION

FUNCTION DosVer$
  ' returns DOS version in string format
  Regs.AX = &H3000
  Interrupt &H21, Regs
  DosVer$ = RTRIM$(STR$(Regs.AX MOD 256)) + "." + LTRIM$(STR$(Regs.AX \ 256))
END FUNCTION

SUB Explode (Top, Lft, Bot, Rgt, Attr, Shad, Delay)
  Wide = Rgt - Lft
  High = Bot - Top
  HMid = (Rgt + Lft) \ 2
  VMid = (Top + Bot) \ 2
  FOR i = 1 TO High \ 2
    HOfs = i * (Wide / High)
    IF HOfs >= 1 THEN
      SLBox VMid - i, HMid - HOfs, VMid + i, HMid + HOfs, Attr, 0
    END IF
    TickPause Delay
  NEXT
  SLBox Top, Lft, Bot, Rgt, Attr, Shad
END SUB

FUNCTION FileExist (Filespec$) STATIC
  ' set new DOS DTA
  DIM DTA AS STRING * 43
  DTA = SPACE$(43)
  Regs.AX = &H1A00
  Regs.DS = VARSEG(DTA)
  Regs.DX = VARPTR(DTA)
  Interrupt &H21, Regs
  ' insulate Filespec from change
  Spec$ = Filespec$ + CHR$(0)
  Regs.AX = &H4E00
  Regs.CX = 39
  Regs.DS = VARSEG(Spec$)
  Regs.DX = SADD(Spec$)
  Interrupt &H21, Regs
  IF Regs.Flags AND 1 THEN FileExist = 0 ELSE FileExist = -1
END FUNCTION

SUB Interrupt (IntNum, Regs AS RegTypeX) STATIC
  STATIC FileNum, IntOffset, Loaded
  ' use fixed-length string to fix its position in memory
  ' and so we don't mess up string pool before routine
  ' gets its pointers from caller
  DIM IntCode AS STRING * 200
  IF NOT Loaded THEN                        ' loaded will be 0 first time
    IntCode = LoadBin("IntCode.BIN")   ' load routine and determine
    IntOffset = INSTR(IntCode$, CHR$(&HCD) + CHR$(&H21)) + 1 ' int # offset
    Loaded = -1
  END IF
  SELECT CASE IntNum
    CASE &H25, &H26, IS > 255               ' ignore these interrupts
    CASE ELSE
      DEF SEG = VARSEG(IntCode)             ' poke interrupt number into
      POKE VARPTR(IntCode) * 1& + IntOffset - 1, IntNum' code block
      CALL Absolute(Regs, VARPTR(IntCode$)) ' call routine
  END SELECT
END SUB

FUNCTION LoadBin$ (BinFileName$)
  ' Loads a binary file as a string
  STATIC FileNum, Buf$
  FileNum = FREEFILE
  OPEN BinFileName$ FOR BINARY AS FileNum
  IF LOF(FileNum) = 0 THEN
    CLOSE FileNum
    KILL BinFileName$
    CLS : PRINT "Can't find "; BinFileName$; " - aborting."
    END
  END IF
  Buf$ = SPACE$(LOF(FileNum)) ' size buffer
  GET FileNum, , Buf$
  CLOSE #FileNum
  LoadBin$ = Buf$
END FUNCTION

SUB ScrnSave (SaveRestore) STATIC
  STATIC InitDone
  IF NOT InitDone THEN
    REDIM ScrnBuf(1 TO 2000) ' 4000 bytes
    DEF SEG = 0
    IF PEEK(&H463) = &HB4 THEN
      VidSeg = &HB000 ' mono
    ELSE
      VidSeg = &HB800 ' color
    END IF
    InitDone = -1
  END IF
  IF SaveRestore THEN ' save
    BlockCopy VidSeg, 0, VARSEG(ScrnBuf(1)), VARPTR(ScrnBuf(1)), 4000
  ELSE
    BlockCopy VARSEG(ScrnBuf(1)), VARPTR(ScrnBuf(1)), VidSeg, 0, 4000
  END IF
END SUB

SUB ScrollArea (Top, Lft, Bot, Rgt, Attr, Lines)
  ' scrolls area up (or down if lines negative)
  ' scrolled away area filled with Attr
  ' use lines = 0 to clear entire area to Attr
  IF Lines > 0 THEN
    Regs.AX = &H600 + Lines
  ELSE
    Regs.AX = &H700 - Lines
  END IF
  Regs.BX = Attr * 256
  Regs.CX = (Top - 1) * 256 + Lft - 1
  Regs.DX = (Bot - 1) * 256 + Rgt - 1
  Interrupt &H10, Regs
END SUB

SUB SLBox (Top, Lft, Bot, Rgt, Attr, Shad)
  STATIC SLB$, BinLoaded
  IF NOT BinLoaded THEN
    SLB$ = LoadBin("SLBox.BIN")
    BinLoaded = -1
  END IF
  DEF SEG = VARSEG(SLB$)
  CALL Absolute(Top, Lft, Bot, Rgt, Attr, Shad, SADD(SLB$))
END SUB

SUB TickPause (Ticks)
  DEF SEG = 0
  FOR i = 1 TO Ticks
    Now = PEEK(&H46C)
    DO: LOOP WHILE PEEK(&H46C) = Now
  NEXT
END SUB

FUNCTION WeekDay$
  Regs.AX = &H2A00
  Interrupt &H21, Regs
  SELECT CASE Regs.AX MOD 256 + 1
    CASE 1: WeekDay$ = "Sunday"
    CASE 2: WeekDay$ = "Monday"
    CASE 3: WeekDay$ = "Tuesday"
    CASE 4: WeekDay$ = "Wednesday"
    CASE 5: WeekDay$ = "Thursday"
    CASE 6: WeekDay$ = "Friday"
    CASE 7: WeekDay$ = "Saturday"
  END SELECT
END FUNCTION