DEFINT A-Z
'$INCLUDE: 'qb.bi'
DIM SHARED InRegs AS RegType, OutRegs AS RegType
DECLARE SUB tset (X, Y, t)  ' Place a character anywhere on the screen
DECLARE SUB cset (X, Y, b, f) ' Place a color block anywhere on the screen
DECLARE SUB cline (X, Y, x2, y2, b, f, o AS STRING) ' Color block line
DECLARE SUB zerosave (filename AS STRING) ' Save the screen
DECLARE SUB zeroload (filename AS STRING) ' Load it again
DECLARE FUNCTION cpoint (X, Y) ' Get the color of a specified location
DECLARE SUB ccircle (X, Y, radius, b, f) ' draw a circle
DECLARE SUB blink (onoff AS STRING) ' Toggle blinking on or off
DECLARE SUB xSET (X, Y, b, f) ' XOR place a color block
DECLARE SUB xline (x1, y1, x2, y2, b, f, o AS STRING) ' Place an XOR line
DECLARE FUNCTION tpoint (X, Y)
DECLARE SUB fcircle (X, Y, radius, b, f)

SUB blink (onoff AS STRING)
IF onoff = "ON" THEN InRegs.BX = 1
IF onoff = "OFF" THEN InRegs.BX = 0
    InRegs.AX = &H1003
    Interrupt &H10, InRegs, OutRegs
END SUB

SUB ccircle (X, Y, radius, b, f)
DEF SEG = &HB800
c = (b * 16) + f
D = 3 - (2 * radius)
xc = 0
yc = radius

DO
 cset X + xc, Y + yc, b, f
 cset X + xc, Y - yc, b, f
 cset X - xc, Y + yc, b, f
 cset X - xc, Y - yc, b, f
 cset X + yc, Y + xc, b, f
 cset X + yc, Y - xc, b, f
 cset X - yc, Y + xc, b, f
 cset X - yc, Y - xc, b, f
 IF D < 0 THEN
  D = D + (4 * xc) + 6
 ELSE
  D = D + 4 * (xc - yc) + 10
  yc = yc - 1
 END IF
 xc = xc + 1
LOOP UNTIL xc > yc
DEF SEG
END SUB

SUB cline (x1, y1, x2, y2, bg, fg, o AS STRING)
'-----------------------------------------------------------------------------
c = (bg * 16) + fg
'-----------------------------------------------------------------------------
DEF SEG = &HB800
'-----------------------------------------------------------------------------
IF UCASE$(o) = "B" THEN GOSUB jtbox
IF UCASE$(o) = "BF" THEN GOSUB jtfbx
IF UCASE$(o) = "L" THEN GOSUB line1:
'-----------------------------------------------------------------------------
jtbox:
FOR trange = x1 TO x2
POKE (((y1 - 1) * 160) + ((trange) * 2)) + 1, c
POKE (((y2 - 1) * 160) + ((trange) * 2)) + 1, c
NEXT trange
FOR trange = y1 TO y2
POKE (((trange - 1) * 160) + ((x1) * 2)) + 1, c
POKE (((trange - 1) * 160) + ((x2) * 2)) + 1, c
NEXT trange
DEF SEG
EXIT SUB
'-----------------------------------------------------------------------------
jtfbx:
FOR trangey = y1 TO y2
	FOR trangex = x1 TO x2
		POKE (((trangey - 1) * 160) + ((trangex) * 2)) + 1, c
	NEXT trangex
NEXT trangey
DEF SEG
EXIT SUB
'-----------------------------------------------------------------------------
line1:
 a = x2 - x1
 b = y2 - y1
 DX2 = 1: DY2 = 1
 IF a < 0 THEN a = -a: DX2 = -1
 IF b < 0 THEN b = -b: DY2 = -1
 DX1 = DX2: DY1 = 0
 IF a < b THEN SWAP a, b: DX1 = 0: DY1 = DY2
 I1 = b% * 2
 D = I1 - a
 I2 = D - a
 X = x1: Y = y1
 FOR i = 0 TO a
  cset Y, X, bg, fg
  IF D < 0 THEN
    X = X + DX1
    Y = Y + DY1
    D = D + I1
  ELSE
    X = X + DX2
    Y = Y + DY2
    D = D + I2
  END IF
 NEXT
DEF SEG
END SUB

FUNCTION cpoint (X, Y)
DEF SEG = &HB800
cpoint = PEEK((X - 1) * 160 + (Y - 1) * 2 + 1)
'ForeGround = Attr MOD 16
'BackGround = (Attr - ForeGround) MOD 15
DEF SEG
END FUNCTION

SUB cset (X, Y, b, f)
c = (b * 16) + f
DEF SEG = &HB800
POKE (((Y - 1) * 160) + ((X - 1) * 2)) + 1, c
DEF SEG
END SUB

SUB fcircle (X, Y, radius, b, f)
DEF SEG = &HB800
radius = radius + 1
DO
radius = radius - 1
D = 3 - (2 * radius)
xc = 0
yc = radius
DO
 cset X + xc, Y + yc, b, f
 cset X + 1 + xc, Y - 1 + yc, b, f
 cset X + 1 + xc, Y - 2 + yc, b, f
 cset X + xc, Y - yc, b, f
 cset X + 1 + xc, Y + 1 - yc, b, f
 cset X + 1 + xc, Y + 2 - yc, b, f
 cset X - xc, Y + yc, b, f
 cset X - xc, Y - 1 + yc, b, f'
 cset X + 1 + xc, Y - 1 + yc, b, f
 cset X + 1 + xc, Y - 2 + yc, b, f
 cset X - xc, Y - yc, b, f
 cset X - xc, Y + 1 - yc, b, f'
 cset X + 1 + xc, Y - yc, b, f
 cset X + yc, Y + xc, b, f
 cset X - 1 + yc, Y + xc, b, f
 cset X - 2 + yc, Y + xc, b, f
 cset X + yc, Y - xc, b, f
 cset X - 1 + yc, Y - xc, b, f
 cset X - 2 + yc, Y - xc, b, f
 cset X - yc, Y + xc, b, f
 cset X + 1 - yc, Y + xc, b, f
 cset X + 2 - yc, Y + xc, b, f
 cset X - yc, Y - xc, b, f
 cset X + 1 - yc, Y - xc, b, f
 cset X + 2 - yc, Y - xc, b, f
 IF D < 0 THEN
  D = D + (4 * xc) + 6
 ELSE
  D = D + 4 * (xc - yc) + 10
  yc = yc - 1
 END IF
 xc = xc + 1
LOOP UNTIL xc > yc
LOOP UNTIL radius = 1
DEF SEG
END SUB

FUNCTION tpoint (X, Y)
DEF SEG = &HB800
tpoint = PEEK((X - 1) * 160 + (Y - 1) * 2)
DEF SEG
END FUNCTION

SUB tset (X, Y, t)
DEF SEG = &HB800
POKE ((Y - 1) * 160) + ((X - 1) * 2), t
DEF SEG
END SUB

SUB xline (x1, y1, x2, y2, bg, fg, o AS STRING)
'-----------------------------------------------------------------------------
c = (bg * 16) + fg
'-----------------------------------------------------------------------------
DEF SEG = &HB800
'-----------------------------------------------------------------------------
IF UCASE$(o) = "B" THEN GOSUB xbox
IF UCASE$(o) = "BF" THEN GOSUB xfbx
IF UCASE$(o) = "L" THEN GOSUB xline:
'-----------------------------------------------------------------------------
xbox:
POKE (((y1 - 1) * 160) + ((x1) * 2)) + 1, c XOR PEEK((((y1 - 1) * 160) + ((x1) * 2)) + 1)
POKE (((y2 - 1) * 160) + ((x2) * 2)) + 1, c XOR PEEK((((y2 - 1) * 160) + ((x2) * 2)) + 1)
POKE (((y1 - 1) * 160) + ((x2) * 2)) + 1, c XOR PEEK((((y1 - 1) * 160) + ((x2) * 2)) + 1)
POKE (((y2 - 1) * 160) + ((x1) * 2)) + 1, c XOR PEEK((((y2 - 1) * 160) + ((x1) * 2)) + 1)
FOR trange = x1 TO x2
POKE (((y1 - 1) * 160) + ((trange) * 2)) + 1, c XOR PEEK((((y1 - 1) * 160) + ((trange) * 2)) + 1)
POKE (((y2 - 1) * 160) + ((trange) * 2)) + 1, c XOR PEEK((((y2 - 1) * 160) + ((trange) * 2)) + 1)
NEXT trange
FOR trange = y1 TO y2
POKE (((trange - 1) * 160) + ((x1) * 2)) + 1, c XOR PEEK((((trange - 1) * 160) + ((x1) * 2)) + 1)
POKE (((trange - 1) * 160) + ((x2) * 2)) + 1, c XOR PEEK((((trange - 1) * 160) + ((x2) * 2)) + 1)
NEXT trange
DEF SEG
EXIT SUB
'-----------------------------------------------------------------------------
xfbx:
FOR xbxwdth = y1 TO y2
     FOR xbxlngth = x1 TO x2
	POKE (((xbxwdth - 1) * 160) + ((xbxlngth) * 2)) + 1, c XOR PEEK((((xbxwdth - 1) * 160) + ((xbxlngth) * 2)) + 1)
     NEXT xbxlngth
NEXT xbxwdth
DEF SEG
EXIT SUB
'-----------------------------------------------------------------------------
xline:
 a = x2 - x1
 b = y2 - y1
 DX2 = 1: DY2 = 1
 IF a < 0 THEN a = -a: DX2 = -1
 IF b < 0 THEN b = -b: DY2 = -1
 DX1 = DX2: DY1 = 0
 IF a < b THEN SWAP a, b: DX1 = 0: DY1 = DY2
 I1 = b% * 2
 D = I1 - a
 I2 = D - a
 X = x1: Y = y1
 FOR i = 0 TO a
  xSET Y, X, c, c
  IF D < 0 THEN
    X = X + DX1
    Y = Y + DY1
    D = D + I1
  ELSE
    X = X + DX2
    Y = Y + DY2
    D = D + I2
  END IF
 NEXT
DEF SEG
END SUB

SUB xSET (X, Y, b, f)
c = (b * 16) + f
DEF SEG = &HB800
POKE (((Y - 1) * 160) + ((X - 1) * 2)) + 1, c XOR PEEK((((Y - 1) * 160) + ((X - 1) * 2)) + 1)
DEF SEG
END SUB

SUB zeroload (filename AS STRING)
DEF SEG = &HB800
BLOAD filename, 0
DEF SEG
END SUB

SUB zerosave (filename AS STRING)
DEF SEG = &HB800
BSAVE filename, 0, 8000
DEF SEG
END SUB

