This dusty diskette from ages past was sitting in my closet. "Danger," it says, with a skull.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

266 lines
9.3 KiB

'default integer type
DEFINT A-Z
'screen mode 13h
SCREEN 13
'set palette
'. . . 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, 10 'red
OUT &H3C9, INT(i / 4) 'green
OUT &H3C9, 50 'blue
NEXT i
'define program constants
'CONST SCRX = 320 unused
'CONST SCRY = 200
'CONST CLRS = 255
CONST HLFX = 160
CONST HLFY = 100
CONST PI = 3.141592654#
CONST FACES = 11
CONST SHAPES = 0
'trig lookup-tables
DIM sine(255) AS SINGLE: DIM cosine(255) AS SINGLE
FOR i = 0 TO 255
sine(i) = SIN(i * PI / 128)
cosine(i) = COS(i * PI / 128)
NEXT i
'data types:
'integer vector (for initial shape data)
TYPE vec3it
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE
'real vector
TYPE vec3t
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE
'a face
TYPE face3t
'object vertices
ov1 AS vec3it
ov2 AS vec3it
ov3 AS vec3it
'world verteces
wv1 AS vec3t
wv2 AS vec3t
wv3 AS vec3t
END TYPE
'an object
TYPE objt
p AS vec3t 'position
r AS vec3it 'rotation
END TYPE
'a pixel point
TYPE vec2it
x AS INTEGER
y AS INTEGER
END TYPE
'a triangle on-screen
TYPE face2t
v1 AS vec2it
v2 AS vec2it
v3 AS vec2it
END TYPE
'make a 12-polygon shape
DIM shape(0 TO SHAPES, 0 TO FACES) AS face3t 'holds shape's form (obj spc)
DIM obj(0 TO SHAPES) AS objt 'holds shape's pos (wrld spc)
'make the viewer
DIM pov AS objt
'make a variable to hold mapped 2d drawing data
DIM tri AS face2t
'load the shape's data
'base (-y)
DATA -10,-10,-10, -10,-10,10, 10,-10,-10
DATA -10,-10,10, 10,-10,10, 10,-10,-10
'front (-z)
DATA -10,-10,-10, 10,-10,-10, -10,10,-10
DATA -10,10,-10, 10,-10,-10, 10,10,-10
'left (-x)
DATA -10,-10,-10, -10,10,-10, -10,-10,10
DATA -10,-10,10, -10,10,-10, -10,10,10
'top (+y)
DATA 10,10,10, -10,10,-10, 10,10,-10
DATA 10,10,10, -10,10,10, -10,10,-10
'back (+z)
DATA 10,10,10, 10,-10,10, -10,10,10
DATA -10,10,10, 10,-10,10, -10,-10,10
'right (+x)
DATA 10,10,10, 10,10,-10, 10,-10,10
DATA 10,-10,10, 10,10,-10, 10,-10,-10
FOR i = 0 TO FACES
READ shape(0, i).ov1.x 'read first vertex position
READ shape(0, i).ov1.y
READ shape(0, i).ov1.z
READ shape(0, i).ov2.x 'read second vertex position
READ shape(0, i).ov2.y
READ shape(0, i).ov2.z
READ shape(0, i).ov3.x 'read third vertex position
READ shape(0, i).ov3.y
READ shape(0, i).ov3.z
NEXT i
'read shape's starting position
'imput strating pov position
pov.p.x = 20
pov.p.y = 30
pov.p.z = -70
DO
'draw the shapes
FOR j = 0 TO SHAPES 'go through @ shape
FOR i = 0 TO FACES 'go through @ face
obj(j).r.y = (obj(j).r.y + 1) MOD 256
'transform @ point from object to world space
rx = obj(j).r.x 'extra 2-letter vars are for
ry = obj(j).r.y 'simplification only
rz = obj(j).r.z
vx = shape(j, i).ov1.x
vy = shape(j, i).ov1.y
vz = shape(j, i).ov1.z
shape(j, i).wv1.x = ((vx * cosine(ry) - vz * sine(ry)) - pov.p.x)' * sine(pov.r.y)
shape(j, i).wv1.y = vy - pov.p.y
shape(j, i).wv1.z = ((vx * sine(ry) + vz * cosine(ry)) - pov.p.z)' * cosine(pov.r.y)
vx = shape(j, i).ov2.x
vy = shape(j, i).ov2.y
vz = shape(j, i).ov2.z
shape(j, i).wv2.x = ((vx * cosine(ry) - vz * sine(ry)) - pov.p.x)' * sine(pov.r.y)
shape(j, i).wv2.y = vy - pov.p.y
shape(j, i).wv2.z = ((vx * sine(ry) + vz * cosine(ry)) - pov.p.z)' * cosine(pov.r.y)
vx = shape(j, i).ov3.x
vy = shape(j, i).ov3.y
vz = shape(j, i).ov3.z
shape(j, i).wv3.x = ((vx * cosine(ry) - vz * sine(ry)) - pov.p.x)' * sine(pov.r.y)
shape(j, i).wv3.y = vy - pov.p.y
shape(j, i).wv3.z = ((vx * sine(ry) + vz * cosine(ry)) - pov.p.z)' * cosine(pov.r.y)
'map the world-space coords into a 2d triangle
tri.v1.x = HLFX + (shape(j, i).wv1.x / shape(j, i).wv1.z * HLFX)
tri.v1.y = HLFY - (shape(j, i).wv1.y / shape(j, i).wv1.z * HLFY)
tri.v2.x = HLFX + (shape(j, i).wv2.x / shape(j, i).wv2.z * HLFX)
tri.v2.y = HLFY - (shape(j, i).wv2.y / shape(j, i).wv2.z * HLFY)
tri.v3.x = HLFX + (shape(j, i).wv3.x / shape(j, i).wv3.z * HLFX)
tri.v3.y = HLFY - (shape(j, i).wv3.y / shape(j, i).wv3.z * HLFY)
'check if clockwise (backface culling)
x1 = tri.v2.x - tri.v1.x 'make (x1, y1) & (x2, y2)
x2 = tri.v3.x - tri.v1.x 'normalized
y1 = tri.v2.y - tri.v1.y
y2 = tri.v3.y - tri.v1.y
IF x1 * y2 < x2 * y1 THEN
'order the vertices top-bottom
IF tri.v1.y > tri.v2.y THEN
tmp = tri.v1.y
tri.v1.y = tri.v2.y
tri.v2.y = tmp
tmp = tri.v1.x
tri.v1.x = tri.v2.x
tri.v2.x = tmp
END IF
IF tri.v1.y > tri.v3.y THEN
tmp = tri.v1.y
tri.v1.y = tri.v3.y
tri.v3.y = tmp
tmp = tri.v1.x
tri.v1.x = tri.v3.x
tri.v3.x = tmp
END IF
IF tri.v2.y > tri.v3.y THEN
tmp = tri.v2.y
tri.v2.y = tri.v3.y
tri.v3.y = tmp
tmp = tri.v2.x
tri.v2.x = tri.v3.x
tri.v3.x = tmp
END IF
'find the color of the face
colr = 255 - shape(j, i).wv1.z
''fill in the 2d triangle
'dx = tri.v3.x - tri.v1.x
'dy = tri.v3.y - tri.v1.y
'dx1 = tri.v2.x - tri.v1.x
'dy1 = tri.v2.y - tri.v1.y
'dx1 = tri.v3.x - tri.v2.x
'dy1 = tri.v3.y - tri.v2.y
'
'sdx = SGN(dx) 'sign of dy is always positive
'sdx1 = SGN(dx1) 'since they've been sorted top to
'sdx2 = SGN(dx2) 'bottom: sdy = 1; ady = dy
'
'adx = ABS(dx)
'adx1 = ABS(dx1)
'adx2 = ABS(dx2)
'
'px = tri.v1.x
'px1 = tri.v1.x
'x = 0
'x1 = 0
'x2 = 0
'IF dy > adx THEN 'the line is tall
' FOR h = 0 TO dy
' x = x + adx
' IF x > dy THEN px = px + sdx: x = x - dy
' NEXT h
'ELSE 'the line is wide
'END IF
'wireframe
IF colr >= 0 AND colr <= 255 THEN
LINE (tri.v1.x, tri.v1.y)-(tri.v2.x, tri.v2.y), colr
LINE (tri.v2.x, tri.v2.y)-(tri.v3.x, tri.v3.y), colr
LINE (tri.v3.x, tri.v3.y)-(tri.v1.x, tri.v1.y), colr
END IF
END IF 'end backface cull
NEXT i
NEXT j
a$ = INKEY$
SELECT CASE a$
CASE CHR$(27)
SYSTEM
CASE CHR$(13)
SYSTEM
CASE "w" 'forward
pov.p.z = pov.p.z + 1
CASE "s" 'back
pov.p.z = pov.p.z - 1
CASE "a" 'strafe left
pov.p.x = pov.p.x - 1
CASE "d" 'strafe right
pov.p.x = pov.p.x + 1
CASE "e" 'jump
pov.p.y = pov.p.y + 1
CASE "c" 'crouch
pov.p.y = pov.p.y - 1
CASE "f" 'yaw left
pov.r.y = pov.r.y + 1
CASE "h" 'yaw right
pov.r.y = pov.r.y - 1
CASE "e" 'roll left
pov.r.z = pov.r.z + 1
CASE "t" 'roll right
pov.r.z = pov.r.z - 1
CASE "r" 'pitch forward
pov.r.x = pov.r.x - 1
CASE "f" 'pitch backward
pov.r.x = pov.r.x + 1
END SELECT
t! = TIMER: DO: LOOP UNTIL TIMER > t! + .01
CLS
LOOP