' Texture mapping
' by Svjatoslav Agejenko
' 04.2003

DECLARE SUB demo3 ()
DECLARE SUB demo2 ()
DECLARE SUB demo1 ()
DECLARE SUB hline (x1!, y!, x2!, tx1!, ty1!, tx2!, ty2!)
DECLARE SUB polygon (x1!, y1!, x2!, y2!, x3!, y3!, tx1!, ty1!, tx2!, ty2!, tx3!, ty3!)
DECLARE SUB pline (x1!, y1!, x2!, y2!, tx1!, ty1!, tx2!, ty2!)
DECLARE SUB start ()
DIM SHARED img(0 TO 100, 0 TO 100)

DIM SHARED bufx(0 TO 199)
DIM SHARED buftx(0 TO 199)
DIM SHARED bufty(0 TO 199)

start
demo1
demo2
demo3
SYSTEM

SUB demo1
polygon 10, 10, 300, 80, 100, 180, 1, 1, 99, 1, 30, 99

a$ = INPUT$(1)
3
x1 = RND * 300 + 10
x2 = RND * 300 + 10
x3 = RND * 300 + 10
y1 = RND * 180 + 10
y2 = RND * 180 + 10
y3 = RND * 180 + 10
polygon x1, y1, x2, y2, x3, y3, 1, 1, 99, 1, 30, 99
IF INKEY$ = "" THEN GOTO 3
CLS
END SUB

SUB demo2

n = 0
4
x1 = SIN(n) * 80 + 160
y1 = COS(n) * 80 + 100
x2 = SIN(n + 2) * 80 + 160
y2 = COS(n + 2) * 80 + 100
x3 = SIN(n + 4) * 90 + 160
y3 = COS(n + 4) * 90 + 100
polygon x1, y1, x2, y2, x3, y3, 1, 1, 99, 1, 30, 99
n = n + .1
IF INKEY$ = "" THEN GOTO 4
CLS
END SUB

SUB demo3

n = 0
5
x1 = SIN(n) * 40 + 50
y1 = COS(n) * 40 + 50
x2 = SIN(n + 2) * 40 + 50
y2 = COS(n + 2) * 40 + 50
x3 = SIN(n + 4) * 40 + 50
y3 = COS(n + 4) * 40 + 50
polygon 1, 50, 300, 1, 100, 180, x1, y1, x2, y2, x3, y3
n = n + .1
IF INKEY$ = "" THEN GOTO 5
CLS

END SUB

SUB hline (x1, y, x2, tx1, ty1, tx2, ty2)

IF INT(x2) = INT(x1) THEN GOTO 2
IF x2 > x1 THEN
  nx1 = INT(x1)
  nx2 = INT(x2)
  ntx1 = tx1
  nty1 = ty1
  ntx2 = tx2
  nty2 = ty2
ELSE
  nx1 = INT(x2)
  nx2 = INT(x1)
  ntx1 = tx2
  nty1 = ty2
  ntx2 = tx1
  nty2 = ty1
END IF

v = nx2 - nx1
tvx = ntx2 - ntx1
tvy = nty2 - nty1

FOR a = 0 TO v
  rtx = tvx * a / v + ntx1
  rty = tvy * a / v + nty1
  PSET (a + nx1, y), img(rtx, rty)
NEXT a

2
END SUB

SUB pline (x1, y1, x2, y2, tx1, ty1, tx2, ty2)
m = ABS(y2 - y1)
IF m = 0 THEN GOTO 1

vy = y2 - y1
vx = x2 - x1

tvy = ty2 - ty1
tvx = tx2 - tx1

FOR a = 0 TO m
  rx = vx * a / m + x1
  ry = vy * a / m + y1
  trx = tvx * a / m + tx1
  try = tvy * a / m + ty1
' PSET (rx, ry), 14
  IF bufx(ry) = -1 THEN
    bufx(ry) = rx
    buftx(ry) = trx
    bufty(ry) = try
  ELSE
    hline bufx(ry), ry, rx, buftx(ry), bufty(ry), trx, try
  END IF
NEXT a

1
END SUB

SUB polygon (x1, y1, x2, y2, x3, y3, tx1, ty1, tx2, ty2, tx3, ty3)

FOR a = 0 TO 199
  bufx(a) = -1
NEXT a

pline x1, y1, x2, y2, tx1, ty1, tx2, ty2
pline x1, y1, x3, y3, tx1, ty1, tx3, ty3
pline x3, y3, x2, y2, tx3, ty3, tx2, ty2

END SUB

SUB start

SCREEN 13

FOR a = 1 TO 100
  x = RND * 150
  y = RND * 150
  c = RND * 255
  CIRCLE (x, y), RND * 20 + 3, c
  PAINT (x, y), c
NEXT a

LOCATE 8, 8
PRINT "Test!"
a$ = INPUT$(1)

FOR y = 0 TO 100
  FOR x = 0 TO 100
    img(x, y) = POINT(x + 20, y + 20)
    PSET (x + 20, y + 20), 0
  NEXT x
NEXT y
CLS

END SUB