'Depth Demo CLS SCREEN 18 'resets the depth array DECLARE SUB fResetDepth 'Tests and draws the pixel DECLARE SUB fPixel(AS SINGLE, AS SINGLE, AS SINGLE) 'Returns the pixel x coordinate DECLARE FUNCTION fGetX(AS SINGLE, AS SINGLE) AS SINGLE 'Returns the pixel x coordinate DECLARE FUNCTION fGetY(AS SINGLE, AS SINGLE) AS SINGLE 'draws a line DECLARE SUB fLine(AS SINGLE, AS SINGLE, AS SINGLE, AS SINGLE, AS SINGLE, AS SINGLE) 'gets a coordinate on a line DECLARE FUNCTION fPoint(AS SINGLE, AS SINGLE, AS SINGLE, AS SINGLE, AS SINGLE) AS SINGLE 'draws a triangle DECLARE SUB fTri(as single, as single, as single,_ as single, as single, as single,_ as single, as single, as single) 'Declare the variables DIM SHARED Pi AS SINGLE DIM SHARED Wdth AS INTEGER DIM SHARED Height AS INTEGER DIM SHARED OffsetX AS SINGLE DIM SHARED OffsetY AS SINGLE DIM SHARED ScaleX AS SINGLE DIM SHARED ScaleY AS SINGLE DIM SHARED MaxDepth AS USHORT 'Loop variables DIM SHARED r AS SHORT DIM SHARED c AS SHORT DIM SHARED i AS SINGLE DIM SHARED j AS SINGLE '3.14159265358979323... Pi = ATN(1) * 4 'screen dimensions SCREENINFO Wdth, Height DIM SHARED aDepth(0 TO Wdth - 1, 0 TO Height - 1) AS SINGLE 'middle of the screen OffsetX = Wdth / 2 OffsetY = Height / 2 'depth scale ScaleX = Wdth / TAN(90 * 180 / Pi) ScaleY = Height / TAN(90 * 180 / Pi) 'maximum depth MaxDepth = 65365 'Load up the depth array, otherwise nothing can be drawn to it. fResetDepth SUB fResetDepth FOR r = 0 TO Height-1 FOR c = 0 TO Wdth-1 aDepth(c, r) = MaxDepth NEXT c NEXT r END SUB SUB fPixel(Px AS SINGLE, Py AS SINGLE, Vz AS SINGLE) IF Px >= 0 AND Px <= Wdth - 1 AND Py >= 0 AND Py <= Height - 1 THEN IF Vz <= aDepth(Px, Py) AND Vz>=1 THEN PSET (Px, Py) aDepth (Px, Py) = Vz END IF END IF END SUB FUNCTION fGetX (Vx AS SINGLE, Vz AS SINGLE) AS SINGLE RETURN OffsetX + (Vx - OffsetX) * ScaleX / Vz END FUNCTION FUNCTION fGetY (Vy AS SINGLE, Vz AS SINGLE) AS SINGLE RETURN OffsetY + (Vy - OffsetY) * ScaleY / Vz END FUNCTION SUB fLine (Vx1 AS SINGLE, Vy1 AS SINGLE, Vz1 AS SINGLE, _ Vx2 AS SINGLE, Vy2 AS SINGLE, Vz2 AS SINGLE) 'Temprorary coordinates DIM AS SINGLE Vx3 DIM AS SINGLE Vy3 DIM AS SINGLE Vz3 DIM AS SINGLE Px DIM AS SINGLE Py 'if the slope is less than 1, iterate along the x points IF ABS(Vx1 - Vx2) >= ABS (Vy1 - Vy2) THEN FOR Vx3 = Vx1 TO Vx2 STEP ABS(Vx2-Vx1)/(Vx2-Vx1) Vy3 = fPoint(Vx3, Vx1, Vx2, Vy1, Vy2) Vz3 = fPoint(Vx3, Vx1, Vx2, Vz1, Vz2) Px = fGetX(Vx3, Vz3) Py = fGetY(Vy3, Vz3) fPixel(Px, Py, Vz3) NEXT I ELSE FOR Vy3 = Vy1 TO Vy2 STEP ABS(Vy2-Vy1)/(Vy2-Vy1) Vx3 = fPoint(Vy3, Vy1, Vy2, Vx1, Vx2) Vz3 = fPoint(Vy3, Vy1, Vy2, Vz1, Vz2) Px = fGetX(Vx3, Vz3) Py = fGetY(Vy3, Vz3) fPixel(Px, Py, Vz3) NEXT I END IF END SUB FUNCTION fPoint(X AS SINGLE, X1 AS SINGLE, X2 AS SINGLE,_ Y1 AS SINGLE, Y2 AS SINGLE) AS SINGLE RETURN Y1 + (X - X1) * (Y1 - Y2) / (X1 - X2) END FUNCTION SUB fTri (Vx1 AS SINGLE, Vy1 AS SINGLE, Vz1 AS SINGLE,_ Vx2 AS SINGLE, Vy2 AS SINGLE, Vz2 AS SINGLE,_ Vx3 AS SINGLE, Vy3 AS SINGLE, Vz3 AS SINGLE) 'sweeping point DIM X AS SINGLE DIM Top AS SINGLE DIM Bottom AS SINGLE DIM TopDepth AS SINGLE DIM BottomDepth AS SINGLE 'set the points such that X1 < X2 < X3 IF Vx1 > Vx2 THEN SWAP Vx1, Vx2 SWAP Vy1, Vy2 SWAP Vz1, Vz2 END IF IF Vx2 > Vx3 THEN SWAP Vx2, Vx3 SWAP Vy2, Vy3 SWAP Vz2, Vz3 END IF IF Vx1 > Vx3 THEN SWAP Vx1, Vx3 SWAP Vy1, Vy3 SWAP Vz1, Vz3 END IF 'draw left half of the triangle IF Vx1<>Vx2 THEN FOR X = Vx1 TO Vx2 Top = fPoint(X, Vx1, Vx2, Vy1, Vy2) Bottom = fPoint(X, Vx1, Vx3, Vy1, Vy3) TopDepth = fPoint(X, Vx1, Vx2, Vz1, Vz2) BottomDepth = fPoint(X, Vx1, Vx3, Vz1, Vz3) fLine(X,Top,TopDepth, X, Bottom, BottomDepth) NEXT X END IF 'draw right half of the triangle IF Vx2<>Vx3 THEN FOR X = Vx2 TO Vx3 Top = fPoint(X, Vx2, Vx3, Vy2, Vy3) Bottom = fPoint(X, Vx1, Vx3, Vy1, Vy3) TopDepth = fPoint(X, Vx2, Vx3, Vz2, Vz3) BottomDepth = fPoint(X, Vx1, Vx3, Vz1, Vz3) fLine(X,Top,TopDepth, X, Bottom, BottomDepth) NEXT X END IF END SUB