'$DYNAMIC
'$INCLUDE: 'useless.bi'
DEFINT A-Z
DECLARE SUB OutPortW (dir AS INTEGER, a AS INTEGER)
DECLARE SUB LoadCharInMap (filename AS STRING, map AS INTEGER)
DECLARE SUB VESAtextMode (whichMode AS INTEGER)

REM $STATIC
SUB LoadCharInMap (filename AS STRING, map AS INTEGER)
'This function is used internally
DIM nbyte AS STRING * 1, aBase AS INTEGER, fh AS INTEGER
DIM index AS INTEGER, scanline AS INTEGER
aBase = &H4000 * map
DEF SEG = &HA000
fh = FREEFILE
OPEN filename FOR BINARY AS #fh
FOR index = 0 TO 255
  FOR scanline = 0 TO 15
    GET #fh, , nbyte
    POKE aBase + scanline, ASC(nbyte)
  NEXT scanline
  aBase = aBase + 32
NEXT index
CLOSE fh
DEF SEG
END SUB

SUB OutPortW (dir AS INTEGER, a AS INTEGER)
'This function is used internally
OUT dir, a AND 255
OUT dir + 1, a / 256
END SUB

SUB USbumpUpPal
'Bump up the palette entries 16 notches for dislpaying BMPs with palettes
IF LEFT$(USdetectVideoHardware$, 1) <> "V" THEN EXIT SUB
FOR a = 0 TO 15
  PALETTE a, a + 16
NEXT a
END SUB

FUNCTION UScheckAnsi
'Checks to see if the ANSI driver is loaded
DIM regs AS RegTypeX
regs.ax = &H1A00
CALL interruptx(&H2F, regs, regs)
UScheckAnsi = 0
result$ = HEX$(regs.ax)
IF RIGHT$(result$, 2) = "FF" THEN
  UScheckAnsi = 1
ELSE
  UScheckAnsi = 0
END IF
END FUNCTION

SUB USdelay (thetime AS SINGLE)
'Machine-independant delay routine
t! = TIMER
DO
  a! = TIMER
  IF a! > t! + thetime THEN EXIT DO
LOOP
END SUB

FUNCTION USdetectVideoHardware$
'Detects video hardware
DIM regs AS RegTypeX
regs.ax = &H1A00
CALL interruptx(&H10, regs, regs)
SELECT CASE (regs.bx AND 255)
  CASE 0: USdetectVideoHardware$ = "NA"
  CASE 1: USdetectVideoHardware$ = "MM"
  CASE 2: USdetectVideoHardware$ = "CC"
  CASE 3: USdetectVideoHardware$ = "RS"
  CASE 4: USdetectVideoHardware$ = "EC"
  CASE 5: USdetectVideoHardware$ = "EM"
  CASE 6: USdetectVideoHardware$ = "PC"
  CASE 7: USdetectVideoHardware$ = "VM"
  CASE 8: USdetectVideoHardware$ = "VC"
  CASE 9: USdetectVideoHardware$ = "RS"
  CASE 10: USdetectVideoHardware$ = "AD"
  CASE 11: USdetectVideoHardware$ = "AM"
  CASE 12: USdetectVideoHardware$ = "AC"
  CASE ELSE: USdetectVideoHardware$ = "UK"
END SELECT
END FUNCTION

FUNCTION USgetElement& (x AS INTEGER, y AS INTEGER, sourceSegment AS INTEGER, sourceOffset AS INTEGER)
'Gets a character element
DIM theX AS INTEGER, theY AS INTEGER, theZ AS INTEGER, Colour AS LONG, element AS LONG
IF x > USinternalScreenX OR x < 1 THEN EXIT FUNCTION
IF y > USinternalScreenY OR y < 1 THEN EXIT FUNCTION
theY = (y - 1) * USinternalLineOffset
theX = (x - 1) * 2
theZ = theY + theX
DEF SEG = sourceSegment
IF sourceSegment = SCREENSEG THEN
  element = PEEK(theZ + sourceOffset)
  Colour = PEEK(theZ + 1 + sourceOffset)
ELSE
  element = PEEK(theZ + sourceOffset + 1)
  Colour = PEEK(theZ + sourceOffset + 2)
END IF
USgetElement = element + (Colour * 256&)
END FUNCTION

SUB USloadFont (filename AS STRING)
'Loads a custom font into video memory
DIM font(2047) AS INTEGER
DIM regs AS RegTypeX
DIM fh AS INTEGER, a AS INTEGER
fh = FREEFILE
OPEN filename FOR BINARY AS #fh
  FOR a = 0 TO 2047
    GET #fh, , font(a)
  NEXT a
CLOSE fh
regs.ax = &H1100
regs.bx = 4096
regs.cx = 255
regs.dx = 0
regs.es = VARSEG(font(0))
regs.bp = VARPTR(font(0))
CALL interruptx(&H10, regs, regs)
END SUB

SUB USpcopy (sourceSegment AS INTEGER, sourceOffset AS INTEGER, destSegment AS INTEGER, destOffset AS INTEGER)
'Copies one buffer to another
DIM copyBytes AS INTEGER
copyBytes = (USinternalScreenX * USinternalScreenY) * 2
CopyMem destSegment, destOffset, sourceSegment, sourceOffset, copyBytes
END SUB

SUB USplaceElement (x AS INTEGER, y AS INTEGER, element AS INTEGER, Colour AS INTEGER, destSegment AS INTEGER, destOffset AS INTEGER)
'Places a character element
DIM theX AS LONG, theY AS LONG, theZ AS LONG
IF x > USinternalScreenX OR x < 1 THEN EXIT SUB
IF y > USinternalScreenY OR y < 1 THEN EXIT SUB
IF Colour > 255 OR Colour < 0 THEN EXIT SUB
IF element > 255 OR element < 1 THEN EXIT SUB
theY = (y - 1) * USinternalLineOffset
theX = (x - 1) * 2
theZ = theY + theX
DEF SEG = destSegment
IF destSegment = SCREENSEG THEN
  POKE (theZ + destOffset), element
  POKE (theZ + 1 + destOffset), Colour
ELSE
  POKE (theZ + destOffset + 1), element
  POKE (theZ + destOffset + 2), Colour
END IF
END SUB

SUB USset512charMode (fontfile1 AS STRING, fontfile2 AS STRING)
'Sets the elusive 512 character mode
DIM regs AS RegType, OutPortWs AS RegType
OutPortW &H3C4, &H100
OutPortW &H3C4, &H402
OutPortW &H3C4, &H704
OutPortW &H3C4, &H300
OutPortW &H3CE, &H204
OutPortW &H3CE, &H5
OutPortW &H3CE, &H6
LoadCharInMap fontfile1, 0
LoadCharInMap fontfile2, 1
Map0 = Map0 AND 255
Map1 = Map1 AND 255
regs.ax = &H1103
b = (Map0 AND 3) + (Map0 AND 4) * 4
c = (Map1 AND 3) * 4 + (Map1 AND 4) * 8
regs.bx = b + c
CALL INTERRUPT(&H10, regs, OutPortWs)
OutPortW &H3C4, &H100
OutPortW &H3C4, &H302
OutPortW &H3C4, &H304
OutPortW &H3C4, &H300
OutPortW &H3CE, &H4
OutPortW &H3CE, &H1005
OutPortW &H3CE, &HE06
END SUB

SUB USset640x400
i% = INP(&H3CC) AND (NOT (4 OR 8))
OUT &H3C2, i%
OUT &H3C4, 0
OUT &H3C5, 0
OUT &H3C4, 0
OUT &H3C5, 3
OUT &H3C4, 1
OUT &H3C5, INP(&H3C5) OR 1
OUT &H3C4, 0
OUT &H3C5, 0
OUT &H3C4, 0
OUT &H3C5, 3
END SUB

SUB USsetMode (Mode AS INTEGER)
'Sets the screen mode
SELECT CASE Mode
  CASE 0: USinternalScreenX = 80: USinternalScreenY = 25: WIDTH 80, 25
  CASE 1: USinternalScreenX = 40: USinternalScreenY = 25: WIDTH 40, 25
  CASE 2: USinternalScreenX = 80: USinternalScreenY = 30: WIDTH 80, 30
  CASE 3: USinternalScreenX = 40: USinternalScreenY = 30: WIDTH 40, 30
  CASE 4: USinternalScreenX = 80: USinternalScreenY = 43: WIDTH 80, 43
  CASE 5: USinternalScreenX = 40: USinternalScreenY = 43: WIDTH 40, 43
  CASE 6: USinternalScreenX = 80: USinternalScreenY = 50: WIDTH 80, 50
  CASE 7: USinternalScreenX = 40: USinternalScreenY = 50: WIDTH 40, 50
  CASE 8: USinternalScreenX = 80: USinternalScreenY = 60: WIDTH 80, 60
  CASE 9: USinternalScreenX = 40: USinternalScreenY = 60: WIDTH 40, 60
  CASE 10: VESAtextMode &H109: USinternalScreenX = 132: USinternalScreenY = 25
  CASE 11: VESAtextMode &H10A: USinternalScreenX = 132: USinternalScreenY = 43
  CASE 12: VESAtextMode &H10B: USinternalScreenX = 132: USinternalScreenY = 50
  CASE 13: VESAtextMode &H10C: USinternalScreenX = 132: USinternalScreenY = 60
  CASE 14: VESAtextMode &H108: USinternalScreenX = 80: USinternalScreenY = 60
  CASE ELSE: EXIT SUB
END SELECT
USinternalLineOffset = USinternalScreenX * 2
END SUB

SUB USsetPal (Colour AS INTEGER, red AS INTEGER, green AS INTEGER, blue AS INTEGER)
'Sets a palette element
OUT &H3C8, Colour
OUT &H3C9, red
OUT &H3C9, green
OUT &H3C9, blue
END SUB

FUNCTION USversion$ (checktype%)
'Dumb useless function
SELECT CASE checktype
CASE 1: USversion$ = "0.21"
CASE 2: USversion$ = "August 3rd, 2004"
CASE 3: USversion$ = "Necros Ihsan Nodtveidt"
CASE ELSE: USversion$ = "Useless Sock"
END SELECT
END FUNCTION

SUB USwriteText (text AS STRING, x AS INTEGER, y AS INTEGER, Colour AS INTEGER, destSegment AS INTEGER, destOffset AS INTEGER)
'Writes text using the special colour rules
FOR a = 1 TO LEN(text)
  USplaceElement (a - 1 + x), y, ASC(MID$(text, a, 1)), Colour, destSegment, destOffset
NEXT a
END SUB

SUB VESAtextMode (whichMode AS INTEGER)
'Used internally by the library
DIM regs AS RegTypeX
regs.ax = &H4F02
regs.bx = whichMode
CALL interruptx(&H10, regs, regs)
IF regs.ax = &H4F01 THEN ERROR 5
END SUB

