'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