315 lines
15 KiB
QBasic
315 lines
15 KiB
QBasic
|
''''''''''''''''
|
||
|
|
' Let's see if we can make us some 3D graphics! In Basic, Hehe.
|
||
|
|
|
||
|
|
DECLARE FUNCTION maxval% (v1%, v2%, limit%)
|
||
|
|
DECLARE FUNCTION minval% (v1%, v2%, v3%)
|
||
|
|
DECLARE SUB hline (x1%, x2%, y%, c%)
|
||
|
|
DECLARE FUNCTION min% (v1%, v2%, v3%)
|
||
|
|
DECLARE FUNCTION max% (v1%, v2%, v3%)
|
||
|
|
DECLARE SUB pal ()
|
||
|
|
DECLARE SUB pixel (x%, y%, c%)
|
||
|
|
|
||
|
|
DEFINT A-Z 'set default var type to int 'cos it's my fav.
|
||
|
|
'$STATIC 'use static arrays
|
||
|
|
CLS 'clear the screen. duh
|
||
|
|
SCREEN 13 'initialize screen mode 13 (0x013 (19) 4 real)
|
||
|
|
|
||
|
|
CONST SCRX = 320 'sort of like #define so I can use SCRX/Y instead
|
||
|
|
CONST SCRY = 200 'of the actual #'s in case the width changes, etc.
|
||
|
|
CONST CLRS = 255 'ditto w/ color depth
|
||
|
|
CONST HLFX = 160 'half the screen width
|
||
|
|
CONST HLFY = 100 'half screen height (both use lots, should save calc.)
|
||
|
|
CONST PI = 3.141592654# 'close enuf
|
||
|
|
CONST VIEWRANGE = 16 'how far before fade to blackness
|
||
|
|
CONST MSZE = 16 'size of the map (x & y are = )
|
||
|
|
CONST MHGT = 4 'height of random mountains (TEMP)
|
||
|
|
CONST MININT = -32768 'lowest possible integer
|
||
|
|
CONST CONTRAST = 20 'multiplied by light values
|
||
|
|
CONST AMBIENT = 50 'added to light values
|
||
|
|
|
||
|
|
LOCATE 1, 1: COLOR 200: PRINT "Loading"
|
||
|
|
|
||
|
|
' make lookup-tables
|
||
|
|
DIM sine(0 TO 255) AS SINGLE
|
||
|
|
DIM cosine(0 TO 255) AS SINGLE
|
||
|
|
FOR i = 0 TO 255
|
||
|
|
sine(i) = SIN(i) * PI / 200 'Convert rad to "hex"
|
||
|
|
cosine(i) = COS(i) * PI / 200 'Convert rad to "hex"
|
||
|
|
NEXT i
|
||
|
|
'Note to self: REMEMBER I'm using "hexians" (256) NOT degrees (360)
|
||
|
|
|
||
|
|
'Layout of the landscape. . . just some random sample data for now!
|
||
|
|
DIM land(1 TO MSZE, 1 TO MSZE) AS INTEGER 'array containing landscape
|
||
|
|
RANDOMIZE TIMER 'use timer to seed random
|
||
|
|
'# generator
|
||
|
|
FOR x = 1 TO MSZE
|
||
|
|
FOR y = 1 TO MSZE
|
||
|
|
land(x, y) = INT(RND * MHGT) 'fill w/ random data
|
||
|
|
NEXT y
|
||
|
|
NEXT x
|
||
|
|
|
||
|
|
'make a variable to hold edge buffers
|
||
|
|
TYPE edge
|
||
|
|
ls AS INTEGER
|
||
|
|
rs AS INTEGER
|
||
|
|
END TYPE
|
||
|
|
DIM edge(0 TO SCRY) AS edge
|
||
|
|
|
||
|
|
'. . . and make an gradiant green palette
|
||
|
|
OUT &H3C8, 0 ' tell port whole palette is coming (otherwise # of color)
|
||
|
|
FOR i = 0 TO 255
|
||
|
|
OUT &H3C9, 0 'red
|
||
|
|
OUT &H3C9, INT(i / 4) 'green
|
||
|
|
OUT &H3C9, 0 'blue
|
||
|
|
'Hahaha! I'll never use THIS command again,
|
||
|
|
'PALETTE i, INT(i / 4) * 256
|
||
|
|
NEXT i
|
||
|
|
|
||
|
|
' Initialize the player variale to hold info on player position
|
||
|
|
TYPE spot
|
||
|
|
x AS INTEGER 'x runs horizontally to player (pitch)
|
||
|
|
y AS INTEGER 'y runs out from player (roll)
|
||
|
|
z AS INTEGER 'z runs up and down (yaw) aka altitude
|
||
|
|
'I know these are not std. but they fit better w/ the flat map
|
||
|
|
END TYPE
|
||
|
|
DIM pov AS spot
|
||
|
|
DIM currentpoint AS spot ' used w/i the program loop
|
||
|
|
pov.x = 8
|
||
|
|
pov.y = -8
|
||
|
|
pov.z = 7
|
||
|
|
|
||
|
|
'temp
|
||
|
|
DIM points(1 TO MSZE, 1 TO MSZE) AS spot'uses x and y as screen co-ords & z as
|
||
|
|
'distance
|
||
|
|
DIM ver(1 TO 3) AS spot 'vertex: used for drawing polygons, x
|
||
|
|
'and y are co-ords & z is color
|
||
|
|
DIM tmp(1 TO 3) AS spot 'used w/ ver for sorting
|
||
|
|
|
||
|
|
BEEP
|
||
|
|
CLS
|
||
|
|
|
||
|
|
DO
|
||
|
|
a$ = INKEY$
|
||
|
|
SELECT CASE a$
|
||
|
|
CASE "a": pov.x = pov.x + 1: CLS
|
||
|
|
CASE "d": pov.x = pov.x - 1: CLS
|
||
|
|
CASE "w": pov.y = pov.y + 1: CLS
|
||
|
|
CASE "s": pov.y = pov.y - 1: CLS
|
||
|
|
CASE "e": pov.z = pov.z + 1: CLS
|
||
|
|
CASE "c": pov.z = pov.z - 1: CLS
|
||
|
|
CASE CHR$(27): SYSTEM
|
||
|
|
END SELECT
|
||
|
|
FOR x = 1 TO MSZE
|
||
|
|
FOR y = 1 TO MSZE
|
||
|
|
'in front of us
|
||
|
|
rely = y - pov.y
|
||
|
|
relx = x - pov.x
|
||
|
|
relz = land(x, y) - pov.z
|
||
|
|
IF rely > 0 AND ABS(relx) <= rely AND ABS(relz) <= rely THEN
|
||
|
|
points(x, y).y = HLFY - relz * HLFY / rely
|
||
|
|
points(x, y).x = HLFX - relx * HLFX / rely
|
||
|
|
'a^3 = b^3 + c^3 + d^3 to find z (pixel dist.)
|
||
|
|
points(x, y).z = (ABS(relz) ^ 3 + ABS(rely) ^ 3 + ABS(relx) ^ 3) ^ (1 / 3)
|
||
|
|
ELSE points(x, y).z = -1
|
||
|
|
IF points(x, y).y < 0 OR points(x, y).y > SCRY OR points(x, y).x < 0 OR points(x, y).x > SCRX OR points(x, y).z > VIEWRANGE THEN points(x, y).z = -1
|
||
|
|
END IF
|
||
|
|
NEXT y
|
||
|
|
NEXT x
|
||
|
|
|
||
|
|
FOR y = MSZE - 1 TO 1 STEP -1
|
||
|
|
FOR x = MSZE - 1 TO 1 STEP -1
|
||
|
|
'if the current point has not been flagged as offscreen, out of FOV, or not w/i range of VIEWRANGE (z=-1)
|
||
|
|
IF points(x, y).z >= 0 THEN
|
||
|
|
'seperate into two triangles
|
||
|
|
FOR p = 0 TO 1
|
||
|
|
'get points of tri.
|
||
|
|
IF p = 0 THEN
|
||
|
|
ver(1).x = points(x, y).x: ver(1).y = points(x, y).y: ver(1).z = points(x, y).z
|
||
|
|
ver(2).x = points(x, y + 1).x: ver(2).y = points(x, y + 1).y: ver(2).z = points(x, y + 1).z
|
||
|
|
ver(3).x = points(x + 1, y + 1).x: ver(3).y = points(x + 1, y + 1).y: ver(3).z = points(x + 1, y + 1).z
|
||
|
|
ELSE
|
||
|
|
'sides 1 & 3 are reversed so will be
|
||
|
|
'in same rotational order (this could
|
||
|
|
'be more efficient - swap lables)
|
||
|
|
ver(3).x = points(x, y).x: ver(3).y = points(x, y).y: ver(3).z = points(x, y).z
|
||
|
|
ver(1).x = points(x + 1, y + 1).x: ver(1).y = points(x + 1, y + 1).y: ver(1).z = points(x + 1, y + 1).z
|
||
|
|
'side 2 is other corner of square
|
||
|
|
ver(2).x = points(x + 1, y).x: ver(2).y = points(x + 1, y).y: ver(2).z = points(x + 1, y).z
|
||
|
|
END IF
|
||
|
|
|
||
|
|
'translate tri. so ver[1] is origin
|
||
|
|
'of tmp, w/ V2 & V3 as vectors
|
||
|
|
tmp(2).x = ver(2).x - ver(1).x
|
||
|
|
tmp(2).y = ver(2).y - ver(1).y
|
||
|
|
tmp(3).x = ver(3).x - ver(1).x
|
||
|
|
tmp(3).y = ver(3).y - ver(1).y
|
||
|
|
|
||
|
|
'if we are facing the polygon (uses
|
||
|
|
'vectors to find if c.clockwise)
|
||
|
|
IF tmp(2).x * tmp(3).y < tmp(3).x * tmp(2).y THEN
|
||
|
|
'sort ver[] tp-bt
|
||
|
|
GOSUB sort
|
||
|
|
|
||
|
|
'find tri. height
|
||
|
|
dy = ver(1).y - ver(3).y
|
||
|
|
|
||
|
|
'delta-y for short side 1
|
||
|
|
dy1 = ver(1).y - ver(2).y
|
||
|
|
|
||
|
|
'slope of long side
|
||
|
|
m! = (ver(3).x - ver(1).x) / dy
|
||
|
|
|
||
|
|
'find width at middle
|
||
|
|
midwidth = ver(2).x - (ver(1).x + (m! * dy1))
|
||
|
|
|
||
|
|
'if long side is on the left
|
||
|
|
'IF midwidth > 1 THEN
|
||
|
|
'if width is big enough to see
|
||
|
|
IF ABS(midwidth) > 1 THEN
|
||
|
|
'if height is big enough to see
|
||
|
|
IF dy > 1 THEN
|
||
|
|
'delta-y of short side 2
|
||
|
|
dy2 = ver(2).y - ver(3).y
|
||
|
|
'slope of short side 1 (clause prevents div by 0)
|
||
|
|
IF ABS(dy1) > 0 THEN m1! = (ver(2).x - ver(1).x) / dy1
|
||
|
|
'slope of short side 2 (clause prevents division by 0)
|
||
|
|
IF ABS(dy2) > 0 THEN m2! = (ver(3).x - ver(2).x) / dy2
|
||
|
|
'calculate the color
|
||
|
|
'colr = points(x, y).y - points(x + 1, y + 1).y + 30'VIEWRANGE - ver(1).z + 20
|
||
|
|
IF p = 0 THEN
|
||
|
|
colr = (land(x, y + 1) - (land(x, y) + land(x + 1, y + 1)) / 2) * CONTRAST + AMBIENT
|
||
|
|
ELSE
|
||
|
|
colr = ((land(x, y) + land(x + 1, y + 1)) / 2 - land(x + 1, y)) * CONTRAST + AMBIENT
|
||
|
|
END IF
|
||
|
|
FOR h = 0 TO dy
|
||
|
|
ypos = ver(1).y - h
|
||
|
|
IF h <= dy1 THEN
|
||
|
|
LINE (ver(1).x + (m! * h), ypos)-(ver(1).x + (m1! * h), ypos), colr
|
||
|
|
'xa = ver(1).x + (m! * h)
|
||
|
|
'xb = ver(1).x + (m1! * h)
|
||
|
|
'x1 = minval(xa, xb, 0)
|
||
|
|
'x2 = maxval(xa, xb, SCRX)
|
||
|
|
'hline x1, x2, ypos, colr
|
||
|
|
ELSE
|
||
|
|
LINE (ver(1).x + (m! * h), ypos)-(ver(2).x + (m2! * (h - dy1)), ypos), colr
|
||
|
|
'xa = ver(1).x + (m! * h)
|
||
|
|
'xb = ver(2).x + (m2! * h)
|
||
|
|
'x1 = minval(xa, xb, 0)
|
||
|
|
'x2 = maxval(xa, xb, SCRX)
|
||
|
|
'hline x1, x2, ypos, colr
|
||
|
|
END IF
|
||
|
|
NEXT h
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
'END IF
|
||
|
|
|
||
|
|
'if long side is on the right
|
||
|
|
'IF midwidth < -1 THEN
|
||
|
|
'END IF
|
||
|
|
|
||
|
|
'else is too thin to see
|
||
|
|
'LINE (ver(1).x, ver(1).y)-(ver(2).x, ver(2).y), 255'VIEWRANGE - ver(1).z
|
||
|
|
'LINE (ver(2).x, ver(2).y)-(ver(3).x, ver(3).y), 255'VIEWRANGE - ver(1).z
|
||
|
|
'LINE (ver(3).x, ver(3).y)-(ver(1).x, ver(1).y), 255'VIEWRANGE - ver(1).z
|
||
|
|
END IF
|
||
|
|
NEXT p
|
||
|
|
END IF
|
||
|
|
NEXT x
|
||
|
|
NEXT y
|
||
|
|
LOOP
|
||
|
|
|
||
|
|
sort:
|
||
|
|
'assign tmp the values of ver
|
||
|
|
FOR i = 1 TO 3
|
||
|
|
tmp(i).x = ver(i).x
|
||
|
|
tmp(i).y = ver(i).y
|
||
|
|
tmp(i).z = ver(i).z
|
||
|
|
NEXT i
|
||
|
|
|
||
|
|
'order them top to bottom [1st pnt]
|
||
|
|
flag = max(tmp(1).y, tmp(2).y, tmp(3).y)
|
||
|
|
'used to skip 3rd calculation
|
||
|
|
topflag = flag
|
||
|
|
'assign values to the first vertex
|
||
|
|
ver(1).x = tmp(flag).x: ver(1).y = tmp(flag).y: ver(1).z = tmp(flag).z
|
||
|
|
'make y lowest possible # 4 further compares
|
||
|
|
tmp(flag).y = MININT
|
||
|
|
|
||
|
|
'order top-bottom 2 (prev. top is now -32768)
|
||
|
|
flag = max(tmp(1).y, tmp(2).y, tmp(3).y)
|
||
|
|
'add to flag to find which of 3 is not used
|
||
|
|
topflag = topflag + flag
|
||
|
|
'assign values to the 2nd vertex
|
||
|
|
ver(2).x = tmp(flag).x: ver(2).y = tmp(flag).y: ver(2).z = tmp(flag).z
|
||
|
|
|
||
|
|
'use topflag to find last point in order
|
||
|
|
SELECT CASE topflag
|
||
|
|
CASE 3 'used 1 & 2
|
||
|
|
flag = 3
|
||
|
|
CASE 4 'used 1 & 3
|
||
|
|
flag = 2
|
||
|
|
CASE 5 'used 2 & 3
|
||
|
|
flag = 1
|
||
|
|
CASE ELSE 'just in case
|
||
|
|
BEEP
|
||
|
|
flag = 1
|
||
|
|
END SELECT
|
||
|
|
'assign values to the 3rd vertex
|
||
|
|
ver(3).x = tmp(flag).x: ver(3).y = tmp(flag).y: ver(3).z = tmp(flag).z
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
SUB hline (x1, x2, y, c)
|
||
|
|
FOR i = x1 TO x2
|
||
|
|
pixel i, y, c
|
||
|
|
NEXT i
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
''''''''''''''''
|
||
|
|
' Returns 1, 2, or 3, depending on which value: 1st, 2nd, or 3d is largest
|
||
|
|
FUNCTION max (v1, v2, v3)
|
||
|
|
r = 0
|
||
|
|
IF v1 >= v2 AND v1 >= v3 THEN r = 1
|
||
|
|
IF v2 >= v1 AND v2 >= v3 THEN r = 2
|
||
|
|
IF v3 >= v2 AND v3 >= v1 THEN r = 3
|
||
|
|
max = r
|
||
|
|
END FUNCTION
|
||
|
|
|
||
|
|
''''''''''''''''
|
||
|
|
' Returns the largest of the three values passed to it w/i limit
|
||
|
|
FUNCTION maxval (v1, v2, limit)
|
||
|
|
r = 0
|
||
|
|
IF v1 >= v2 THEN r = v1
|
||
|
|
IF v2 >= v1 THEN r = v2
|
||
|
|
IF r > limit THEN r = limit
|
||
|
|
maxval = r
|
||
|
|
END FUNCTION
|
||
|
|
|
||
|
|
''''''''''''''''
|
||
|
|
' Returns the smallest of the three values passed to it w/i limit
|
||
|
|
FUNCTION minval (v1, v2, limit)
|
||
|
|
r = 0
|
||
|
|
IF v1 <= v2 THEN r = v1
|
||
|
|
IF v2 <= v1 THEN r = v2
|
||
|
|
IF r < limit THEN r = limit
|
||
|
|
minval = r
|
||
|
|
END FUNCTION
|
||
|
|
|
||
|
|
'This SUB does the same thing as PSET only by writing directly to the video
|
||
|
|
'memory which *should* be much faster (Muahahaha!)
|
||
|
|
'
|
||
|
|
SUB pixel (x, y, c)
|
||
|
|
DEF SEG = &HA000 'A000h is where the video mem. starts in mode
|
||
|
|
'13h, which we're using
|
||
|
|
IF x < 0 OR x > SCRX THEN EXIT SUB 'make sure x is on the screen
|
||
|
|
IF y < 0 OR y > SCRY THEN EXIT SUB 'make sure y is on the screen
|
||
|
|
'(We do NOT want to be writing directly into
|
||
|
|
'memory somewhere we're not supposed to!)
|
||
|
|
IF c < 0 OR c > CLRS THEN EXIT SUB 'make sure c is w/i the color palette
|
||
|
|
y& = y 'needed to prevent overflow (where's an
|
||
|
|
'unsigned int when you need it?)
|
||
|
|
POKE y& * SCRX + x, c 'put c into the right spot offset from A000h
|
||
|
|
'(pixels go lt-rt, tp-bt in a linear fashion)
|
||
|
|
END SUB
|
||
|
|
|