'=========================================================================== ' Subject: 3D TEXTURED POLYGON ENGINE V2.0 Date: 12-24-97 (15:25) ' Author: Sami Kyostila Code: QB, QBasic, PDS ' Origin: hiteck@freenet.hut.fi Packet: GRAPHICS.ABC '=========================================================================== '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' 3D Polygon Engine v2.0 (C) Sami Ky봲til� 1997 '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Comments & questions can be sent to hiteck@freenet.hut.fi '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' ' Here's a new version of my previous 3d engine. Actually it's almost a ' complete rewrite, with tons of new features. Currently there are 4 ' drawing modes: ' ' + Z-Shaded Wireframe ' + Z-Gouraud shaded and filled ' + Z-Shaded Flat, ASM-Filled ' + Z-Gouraud shaded and texturemapped ' ' These drawing modes can be selected with the F1-F4 keys. In addition ' there are also 4 animated textures: ' ' + Fire - Looks very kewl ' + BumpMap - Nice and fast bumpmap ' + Panning textures - Looks like flowing green ooze ' + Sinus plasma - An animated plasma ' ' These can be toggled on/off with the F9-F12 keys. NOTE: After you have ' selected an animated texture, you must press that same key again to ' disable it. ' ' The object is rotated with the arrow keys and the plus/minus keys. Zoom ' in/out with the A/Z keys. The object can be panned with the J/K/L/I keys. ' 5 stops movement, and 0 resets the object to the starting position. ' You can also rotate the object with the mouse by pressing the left mouse ' button. ' ' All of the drawing modes are shaded, and the ambient lighting level can ' be varied with the F5/F6 keys. F7 toggles point number display on/off ' F9 toggles FPS display on/off (this slows the engine down a bit, you can ' also see the FPS in the exit screen) ' ' If the texture mapping seems too slow, you can adjust the texture size ' by changing the TSize-constant below. ' ' See the end of the program to find out how to make your own objects ' If you want to save you objects to a file, insert the following ' statement to the SUB TheEnd: ' ' SaveObject "filename.dat" ' ' When you press ESC, the object is saved. To load a saved object, use the ' SUB LoadObject ' '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' You may use any of this code freely in you own programs, as long as you ' mention my name somewhere in you program. '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 DEFINT A-Z '$DYNAMIC DECLARE SUB HiiriLue (vasen%, oikea%, keski%, x%, y%) DECLARE SUB Hiiriajuri (ax%, bx%, cx%, dx%) DECLARE FUNCTION Hiiritarkista% () DECLARE SUB LoadObject (File$) DECLARE SUB SaveObject (File$) DECLARE SUB HandleKeys () DECLARE SUB TheEnd () DECLARE SUB RotatePoints () DECLARE SUB ColPrint (Text$) DECLARE FUNCTION ShadeName$ (Model%) DECLARE SUB Separator (Col&, Char$) DECLARE SUB MakePalette () DECLARE SUB MakeFirePalette (MaxColors%) DECLARE SUB MakeTexture () DECLARE SUB Switch (Var%, Value1%, Value2%) DECLARE SUB MakeLight () DECLARE SUB Fillchar (segment%, offset%, value%, bytes%) DECLARE SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%) DECLARE SUB t3d2d (x%, y%, z%, SX%, SY%) DECLARE SUB RotatePoint (x%, y%, z%, Rx%, Ry%, Rz%, Nx%, Ny%, Nz%) DECLARE SUB DrawPoly (x%, y%, x2%, y2%, x3%, y3%, P1%, P2%, P3%, Num) DECLARE SUB DrawLine (x%, y%, x2%, y2%, Col1%, Col2%, Tx1, Ty1, Tx2, Ty2) DEFINT A-Z TYPE Filltype 'Buffer to hold polygon data x1 AS INTEGER x2 AS INTEGER Col1 AS INTEGER Col2 AS INTEGER Tx AS INTEGER Ty AS INTEGER Tx2 AS INTEGER Ty2 AS INTEGER END TYPE TYPE PointType x3 AS INTEGER 'Original X y3 AS INTEGER 'Original Y z3 AS INTEGER 'Original Z x AS INTEGER 'Screen X y AS INTEGER 'Screen Y Nx AS INTEGER 'New X Ny AS INTEGER 'New Y Nz AS INTEGER 'New Z Shade AS INTEGER 'Shade END TYPE TYPE Polygontype P1 AS INTEGER 'Point 1 P2 AS INTEGER 'Point 2 P3 AS INTEGER 'Point 3 Col AS INTEGER 'Color Culled AS INTEGER 'Culled/Not Culled AvgZ AS INTEGER END TYPE '---------------------------------------------------------------------------- ' Constants '---------------------------------------------------------------------------- CONST True = 0 CONST False = NOT True CONST PI = 22 / 7 CONST TSize = 40 CONST LSize = TSize \ 2 DIM SHARED Polygons, Points DIM SHARED Sine(360) AS INTEGER 'SIN table DIM SHARED Cosine(360) AS INTEGER 'COS table DIM SHARED Fill(199) AS Filltype 'Polygon data buffer DIM SHARED Upper AS INTEGER DIM SHARED Lower AS INTEGER DIM SHARED SrX AS INTEGER DIM SHARED SrY AS INTEGER DIM SHARED Zoom AS INTEGER DIM SHARED Buffer(319, 199) AS STRING * 1 DIM SHARED ShadingModel AS INTEGER DIM SHARED Ambient AS INTEGER DIM SHARED Mx, My DIM SHARED Fire AS INTEGER DIM SHARED Anim AS INTEGER DIM SHARED AnimType AS INTEGER DIM SHARED l(0 TO LSize, 0 TO LSize) AS INTEGER DIM SHARED MaxPoints, MaxPolygons DIM SHARED Xr AS INTEGER DIM SHARED Yr AS INTEGER DIM SHARED Zr AS INTEGER DIM SHARED Vx, Vy, Vz DIM SHARED FDisp, PDisp DIM SHARED FPS& DIM SHARED WaveSide1, WaveSide2, WaveSide3 DIM SHARED R1, R2, R3 FOR i = 0 TO 360 Sine(i) = SIN(i * PI / 180) * 1024 Cosine(i) = COS(i * PI / 180) * 1024 NEXT SrX = 320 \ 2 'Screen center SrY = 200 \ 2 Zoom = 700 'Initial values Xr = 200 Yr = 315 Zr = 100 Mx = 0 My = 0 Ambient = 10 PDisp = False FDisp = False Fire = False ShadingModel = 2 SCREEN 0: CLS WIDTH 80, 25 COLOR 15, 4 LOCATE 1, 1 PRINT STRING$(80, " ") LOCATE 1, 1 PRINT " 3D Polygon Engine v2.0 by Sami Ky봲til� 1997" COLOR 3, 0 PRINT RESTORE ObjectData READ MaxPoints READ MaxPolygons DIM SHARED Pnt(1 TO MaxPoints) AS PointType DIM SHARED Poly(1 TO MaxPolygons) AS Polygontype DIM SHARED Pointer(1 TO MaxPolygons) DIM SHARED Txt(-1 TO TSize + 1, -1 TO TSize + 1) AS INTEGER DIM SHARED ASMMemCopy$ DIM SHARED ASMFillChar$ asm$ = "" asm$ = asm$ + CHR$(85) asm$ = asm$ + CHR$(137) + CHR$(229) asm$ = asm$ + CHR$(30) asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) asm$ = asm$ + CHR$(142) + CHR$(192) asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) asm$ = asm$ + CHR$(142) + CHR$(216) asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) asm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12) asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6) asm$ = asm$ + CHR$(243) asm$ = asm$ + CHR$(164) asm$ = asm$ + CHR$(31) asm$ = asm$ + CHR$(93) asm$ = asm$ + CHR$(203) ASMMemCopy$ = asm$ asm$ = "" asm$ = asm$ + CHR$(85) asm$ = asm$ + CHR$(137) + CHR$(229) asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6) asm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8) asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12) asm$ = asm$ + CHR$(30) asm$ = asm$ + CHR$(142) + CHR$(216) asm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10) asm$ = asm$ + CHR$(136) + CHR$(23) asm$ = asm$ + CHR$(67) asm$ = asm$ + CHR$(226) + CHR$(251) asm$ = asm$ + CHR$(31) asm$ = asm$ + CHR$(93) asm$ = asm$ + CHR$(203) ASMFillChar$ = asm$ PRINT "Number of points:", , MaxPoints PRINT "Number of polygons:", , MaxPolygons PRINT "Starting position (XYZ)", , Xr; Yr; Zr PRINT "Texture size: ", , TSize; "x"; TSize PRINT "Initial shading model:", , " "; ShadeName$(ShadingModel) PRINT "Ambient lighting level:", , Ambient Separator 1, "�" COLOR 7 PRINT " � Reading points..."; FOR i = 1 TO MaxPoints READ Pnt(i).x3 READ Pnt(i).y3 READ Pnt(i).z3 NEXT PRINT "Done" PRINT " � Reading polygons..."; FOR i = 1 TO MaxPolygons READ Poly(i).P1 READ Poly(i).P2 READ Poly(i).P3 READ Poly(i).Col Poly(i).Col = Poly(i).Col * 64 NEXT PRINT "Done" PRINT " � Generating texture..."; MakeTexture PRINT "Done" PRINT " � Initializing mouse..."; RESTORE MouseData DIM SHARED hiiri$ hiiri$ = SPACE$(57) FOR i% = 1 TO 57 READ a$ h$ = CHR$(VAL("&H" + a$)) MID$(hiiri$, i%, 1) = h$ NEXT i% napit% = Hiiritarkista% IF (napit% = 0) THEN PRINT "Mouse not found!" MouseNotFound = 1 ELSE PRINT "Done (Press left MButton to rotate)" END IF PRINT Separator 3, "�" ColPrint " &FF1&7 - Wireframe &FF2&7 - Z-Gouraud &FF3&7 - Z-Flat &FF4&7 - Textured" PRINT ColPrint " &FArrows/-/+&7 - Rotate &FA/Z&7 - Zoom In/Out &FJ/K/L/I&7 - Pan &F5&7 - Stop &F0&7 - Reset" PRINT ColPrint " &FF5&7/&FF6&7 - Adjust ambient lighting level " PRINT ColPrint " &FF7&7 - Point display toggle" PRINT ColPrint " &FF8&7 - Frame rate toggle" PRINT ColPrint " &FF9&7 - Animated texture 1 - &EFire" PRINT ColPrint " &FF10&7 - Animated texture 2 - &EBumpmap" PRINT ColPrint " &FF11&7 - Animated texture 3 - &ETexture panning" PRINT ColPrint " &FF12&7 - Animated texture 4 - &EPlasma" MakeLight DO: LOOP UNTIL INKEY$ <> "" SCREEN 13: CLS MakePalette COLOR 255 DIM Temp(0 TO TSize, 0 TO TSize) AS INTEGER FOR y& = 0 TO TSize FOR x& = 0 TO TSize Temp(x&, y&) = Txt(x&, y&) NEXT NEXT DIM Cosinus(160) AS INTEGER DIM Rand(255) AS INTEGER FOR c = 0 TO 160 Cosinus(c) = COS(c * 2 * PI / 80) * 16 + 16 NEXT FOR c = 0 TO 255 Rand(c) = INT(RND * 4) + 1 NEXT XAdd& = 1 YAdd& = 1 Anim = False DO RotatePoints FOR i& = 1 TO MaxPolygons Poly(i&).AvgZ = (Pnt(Poly(i&).P1).Nz + Pnt(Poly(i&).P2).Nz + Pnt(Poly(i&).P3).Nz) \ 3 Pointer(i&) = i& Poly(i&).Culled = False NEXT FOR i& = 1 TO MaxPolygons coord1 = Poly(i&).P1 coord2 = Poly(i&).P2 coord3 = Poly(i&).P3 z1& = Pnt(coord1).Nz z2& = Pnt(coord2).Nz z3& = Pnt(coord3).Nz x1& = Pnt(coord1).Nx x2& = Pnt(coord2).Nx x3& = Pnt(coord3).Nx y1& = Pnt(coord1).Ny y2& = Pnt(coord2).Ny y3& = Pnt(coord3).Ny IF (x1& - x2&) * (y3& - y2&) - (y1& - y2&) * (x3& - x2&) < 0 THEN Poly(i&).Culled = True NEXT FOR i& = 1 TO MaxPolygons FOR ii& = 1 TO MaxPolygons - 1 IF Poly(Pointer(ii&)).AvgZ > Poly(Pointer(ii& + 1)).AvgZ THEN SWAP Pointer(ii&), Pointer(ii& + 1) NEXT NEXT FOR ii& = 1 TO MaxPolygons i& = Pointer(ii&) IF NOT Poly(i&).Culled = True THEN DrawPoly Pnt(Poly(i&).P1).x + SrX, Pnt(Poly(i&).P1).y + SrY, Pnt(Poly(i&).P2).x + SrX, Pnt(Poly(i&).P2).y + SrY, Pnt(Poly(i&).P3).x + SrX, Pnt(Poly(i&).P3).y + SrY, Pnt(Poly(i&).P1).Shade + Poly(i&).Col, Pnt(Poly(i&).P2).Shade + Poly(i&).Col, _ Pnt(Poly(i&).P3).Shade + Poly(i&).Col, INT(i&) END IF NEXT Memcopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 Fillchar VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), 0, &HFA00 'Print Point numbers IF PDisp = True THEN FOR i = 1 TO MaxPoints Ty = (Pnt(i).y + SrY) \ 8 + 1 Tx = (Pnt(i).x + SrX) \ 8 + 1 IF Ty > 23 THEN Ty = 23 IF Ty < 1 THEN Ty = 1 IF Tx < 1 THEN Tx = 1 IF Tx > 40 THEN Tx = 40 LOCATE Ty, Tx PRINT LTRIM$(RTRIM$(STR$((i)))) NEXT END IF HandleKeys SELECT CASE AnimType CASE 1 ShadingModel = 4 FOR y = 0 TO TSize - 1 FOR x = 0 TO TSize Txt(x, y + 1) = (Txt(x - 1, y - 1) + Txt(x, y - 1) + Txt(x + 1, y - 1) + Txt(x + 1, y) + Txt(x + 1, y + 1) + Txt(x, y + 1) + Txt(x - 1, y + 1) + Txt(x - 1, y)) \ 8 - 1 NEXT NEXT FOR i = 0 TO TSize \ 4 XPos = RND * TSize Temp = RND * 63 Txt(XPos, -1) = RND * Temp Txt(XPos, 0) = RND * Temp NEXT CASE 2 ShadingModel = 4 Lx& = Lx& + XAdd& Ly& = Ly& + YAdd& FOR y& = 0 TO TSize FOR x& = 0 TO TSize Txt(x&, y&) = Temp(x&, y&) NEXT NEXT FOR y& = 0 TO LSize FOR x& = 0 TO LSize Txt((x& + Lx&) MOD TSize, (y& + Ly&) MOD TSize) = Txt((x& + Lx&) MOD TSize, (y& + Ly&) MOD TSize) + l(x&, y&) NEXT NEXT Lx& = Lx& + XAdd& Ly& = Ly& + YAdd& IF Lx& = TSize THEN XAdd& = -XAdd& IF Lx& = 0 THEN XAdd& = -XAdd& IF Ly& = TSize - 2 THEN YAdd& = -YAdd& IF Ly& = 0 THEN YAdd& = -YAdd& CASE 3 ShadingModel = 4 FOR y = 1 TO TSize - 1 FOR x = 0 TO TSize Txt(x, y - 1) = Txt(x, y) NEXT NEXT FOR i = 0 TO TSize Txt(i, TSize - 1) = Txt(i, 0) NEXT CASE 4 ShadingModel = 4 WAVE1 = WAVE1 + WaveSide1 IF WAVE1 >= 80 THEN WAVE1 = 0 R1 = (R1 + 1) AND 255 WaveSide1 = Rand(R1) END IF WAVE2 = WAVE2 + WaveSide2 IF WAVE2 >= 80 THEN WAVE2 = 0 R2 = (R2 + 2) AND 255 WaveSide2 = Rand(R2) END IF WAVE3 = WAVE3 + WaveSide3 IF WAVE3 >= 80 THEN WAVE3 = 0 R3 = (R3 + 2) AND 255 WaveSide3 = Rand(R3) END IF FOR y& = 0 TO TSize E = Cosinus(y& + WAVE1) FOR x& = 0 TO TSize Col = Cosinus(x& + WAVE2) + E + Cosinus(x& + WAVE3) + Cosinus(x& + y&) IF Col > 127 THEN Col = 127 Txt(x&, y&) = Col NEXT NEXT END SELECT '---------------------------------------------------------------------------- ' Update rotation velocities '---------------------------------------------------------------------------- Xr = Xr + Vx Yr = Yr + Vy Zr = Zr + Vz IF Xr < 0 THEN Xr = 360 + Xr IF Yr < 0 THEN Yr = 360 + Yr IF Zr < 0 THEN Zr = 360 + Zr Xr = Xr MOD 361 Yr = Yr MOD 361 Zr = Zr MOD 361 IF TIMER >= start& + 2 THEN FPS& = INT(Frame / 2) Frame = 0 start& = INT(TIMER) END IF Frame = Frame + 1 IF FDisp = True THEN COLOR 255 LOCATE 1, 1: PRINT FPS&; "fps " END IF IF MouseNotFound = 0 THEN HiiriLue B1, B2, B3, MouseX, MouseY IF B1 = -1 THEN Xr = MouseX Zr = MouseY END IF END IF LOOP '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Object data '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ObjectData: ' Number of points DATA 5 ' Number of polygons DATA 6 ' Point data ' ' X Y Z DATA -100, 0, 100 DATA -100, 0, -100 DATA 100, 0, -100 DATA 100, 0, 100 DATA 0, -190, 0 ' Polygon data ' ' Pnt1 Pnt2 Pnt3 Color (1-4) DATA 5, 1, 4, 1 DATA 5, 4, 3, 2 DATA 5, 2, 1, 3 DATA 5, 3, 2, 4 DATA 4, 1, 2, 1 DATA 4, 2, 3, 1 MouseData: DATA 55, 89, E5, 8B, 5E, 0C, 8B, 07, 50, 8B, 5E, 0A, 8B, 07, 50, 8B DATA 5E, 08, 8B, 0F, 8B, 5E, 06, 8B, 17, 5B, 58, 1E, 07, CD, 33, 53 DATA 8B, 5E, 0C, 89, 07, 58, 8B, 5E, 0A, 89, 07, 8B, 5E, 08, 89, 0F DATA 8B, 5E, 06, 89, 17, 5D, CA, 08, 00 REM $STATIC SUB ColPrint (Text$) '---------------------------------------------------------------------------- ' S�Y�S�T�E�M '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Prints color-coded text '---------------------------------------------------------------------------- ' Color codes: ' ' & followed by a color value between 0-15 (in hex) ' ' Example: ' ' This text is &Cred '---------------------------------------------------------------------------- FOR i = 1 TO LEN(Text$) Done = 0 DO IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN COLOR VAL("&H" + MID$(Text$, i + 1, 1)) i = i + 2 ELSE Done = 1 END IF LOOP UNTIL Done PRINT MID$(Text$, i, 1); NEXT END SUB SUB DrawLine (x, y, x2, y2, Col1, Col2, Tx1, Ty1, Tx2, Ty2) '---------------------------------------------------------------------------- ' Calculate the points of a polygon into the buffer '---------------------------------------------------------------------------- IF y < Upper THEN Upper = y IF y > Lower THEN Lower = y IF Upper < 0 THEN Upper = 0 IF Lower > 199 THEN Lower = 199 'Calculate deltas and scale by 1024 Steps = SQR((x2 - x) ^ 2 + ((y2 - y) ^ 2)) IF Steps > 0 THEN XStep& = ((x2 - x) / Steps) * 1024 YStep& = ((y2 - y) / Steps) * 1024 ColStep& = ((Col2 - Col1) / Steps) * 1024 ELSE EXIT SUB END IF Tempxx& = x Tempyy& = y xxx& = Tempxx& * 1024 yyy& = Tempyy& * 1024 Col& = CLNG(Col1) * 1024 IF ShadingModel = 4 THEN Tx& = CLNG(Tx1) * 1024 Ty& = CLNG(Ty1) * 1024 TxDelta& = ((Tx2 - Tx1) / Steps) * 1024 TyDelta& = ((Ty2 - Ty1) / Steps) * 1024 FOR i& = 1 TO Steps IF yyy& >= 0 AND yyy& < 204800 THEN IF xxx& \ 1024 < Fill(yyy& \ 1024).x1 THEN Fill(yyy& \ 1024).x1 = xxx& \ 1024 Fill(yyy& \ 1024).Tx = Tx& \ 1024 Fill(yyy& \ 1024).Ty = Ty& \ 1024 Fill(yyy& \ 1024).Col1 = Col& \ 1024 END IF IF xxx& \ 1024 > Fill(yyy& \ 1024).x2 THEN Fill(yyy& \ 1024).x2 = xxx& \ 1024 Fill(yyy& \ 1024).Tx2 = Tx& \ 1024 Fill(yyy& \ 1024).Ty2 = Ty& \ 1024 Fill(yyy& \ 1024).Col2 = Col& \ 1024 END IF END IF xxx& = xxx& + XStep& yyy& = yyy& + YStep& Tx& = Tx& + TxDelta& Ty& = Ty& + TyDelta& Col& = Col& + ColStep& NEXT ELSE FOR i& = 1 TO Steps IF yyy& >= 0 AND yyy& < 204800 THEN IF xxx& \ 1024 < Fill(yyy& \ 1024).x1 THEN Fill(yyy& \ 1024).x1 = xxx& \ 1024 Fill(yyy& \ 1024).Col1 = Col& \ 1024 END IF IF xxx& \ 1024 > Fill(yyy& \ 1024).x2 THEN Fill(yyy& \ 1024).x2 = xxx& \ 1024 Fill(yyy& \ 1024).Col2 = Col& \ 1024 END IF END IF xxx& = xxx& + XStep& yyy& = yyy& + YStep& Col& = Col& + ColStep& NEXT END IF END SUB SUB DrawPoly (x, y, x2, y2, x3, y3, P1, P2, P3, Num) FOR i2 = 1 TO 199 Fill(i2).x1 = 321 Fill(i2).x2 = -1 Fill(i2 - 1).x1 = 321 Fill(i2 - 1).x2 = -1 Fill(i2).Col1 = 0 Fill(i2).Col2 = 0 Fill(i2 - 1).Col1 = 0 Fill(i2 - 1).Col2 = 0 NEXT DrawLine x, y, x2, y2, P1, P2, TSize \ 2, TSize, TSize, 0 DrawLine x3, y3, x, y, P3, P1, 0, 0, TSize \ 2, TSize DrawLine x2, y2, x3, y3, P2, P3, TSize, 0, 0, 0 SELECT CASE ShadingModel CASE 1 OldPos1 = 321 OldPos2 = 321 FOR yy& = Upper TO Lower - 1 XLen = Fill(yy&).x2 - Fill(yy&).x1 IF XLen > 0 AND Fill(yy&).x1 > 0 AND Fill(yy&).x2 < 319 AND Fill(yy&).x1 < 319 AND Fill(yy&).x2 > 0 THEN IF OldPos1 < 320 AND OldPos1 > 0 THEN IF OldPos1 > Fill(yy&).x1 THEN FOR xx& = OldPos1 - 1 TO Fill(yy&).x1 STEP -1 Buffer(xx&, yy&) = CHR$(Fill(yy&).Col1 MOD 255) NEXT ELSE FOR xx& = OldPos1 + 1 TO Fill(yy&).x1 Buffer(xx&, yy&) = CHR$(Fill(yy&).Col1 MOD 255) NEXT END IF ELSE Buffer(Fill(yy&).x1, yy&) = CHR$(Fill(yy&).Col1 MOD 255) END IF IF OldPos2 < 320 AND OldPos2 > 0 THEN IF OldPos2 > Fill(yy&).x2 THEN FOR xx& = OldPos2 TO Fill(yy&).x2 STEP -1 Buffer(xx&, yy&) = CHR$(Fill(yy&).Col2 MOD 255) NEXT ELSE FOR xx& = OldPos2 TO Fill(yy&).x2 Buffer(xx&, yy&) = CHR$(Fill(yy&).Col2 MOD 255) NEXT END IF ELSE Buffer(Fill(yy&).x2, yy&) = CHR$(Fill(yy&).Col2 MOD 255) END IF END IF OldPos1 = Fill(yy&).x1 OldPos2 = Fill(yy&).x2 NEXT CASE 2 FOR yy& = Upper TO Lower - 1 XLen = Fill(yy&).x2 - Fill(yy&).x1 IF XLen > 0 THEN ColDelta& = (Fill(yy&).Col2 - Fill(yy&).Col1) / XLen * 1024 Col& = CLNG(Fill(yy&).Col1) * 1024 IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1 IF Fill(yy&).x1 < 0 THEN XLen = XLen + Fill(yy&).x1: Col& = Col& + ColDelta& * -Fill(yy&).x1: Fill(yy&).x1 = 0 FOR xx& = Fill(yy&).x1 TO Fill(yy&).x1 + XLen Buffer(xx&, yy&) = CHR$(ABS(Col& \ 1024) MOD 255) Col& = Col& + ColDelta& NEXT END IF NEXT CASE 3 FOR yy& = Upper TO Lower - 1 XLen = Fill(yy&).x2 - Fill(yy&).x1 IF XLen > 0 THEN IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1 IF Fill(yy&).x1 < 0 THEN XLen = XLen + Fill(yy&).x1 Fill(yy&).x1 = 0 END IF IF Fill(yy&).x1 < 319 AND XLen > 0 THEN Fillchar VARSEG(Buffer(Fill(yy&).x1, yy&)), VARPTR(Buffer(Fill(yy&).x1, yy&)), (Pnt(Poly(Num).P1).Shade + Pnt(Poly(Num).P2).Shade + Pnt(Poly(Num).P3).Shade) \ 3 + Poly(Num).Col, XLen + 1 END IF NEXT CASE 4 IF Anim = False THEN FOR yy& = Upper TO Lower - 1 XLen = Fill(yy&).x2 - Fill(yy&).x1 IF XLen > 0 THEN TxDelta& = (Fill(yy&).Tx2 - Fill(yy&).Tx) / XLen * 1024 TyDelta& = (Fill(yy&).Ty2 - Fill(yy&).Ty) / XLen * 1024 Tx& = CLNG(Fill(yy&).Tx) * 1024 Ty& = CLNG(Fill(yy&).Ty) * 1024 ColDelta& = (Fill(yy&).Col2 - Fill(yy&).Col1) / XLen * 1024 Col& = CLNG(Fill(yy&).Col1) * 1024 IF Fill(yy&).x2 > 319 THEN Fill(yy&).x2 = 319 IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1 IF Fill(yy&).x1 < 0 THEN XLen = XLen + Fill(yy&).x1 Col& = Col& + ColDelta& * -Fill(yy&).x1 Tx& = Tx& + TxDelta& * -Fill(yy&).x1 Ty& = Ty& + TyDelta& * -Fill(yy&).x1 Fill(yy&).x1 = 0 END IF FOR xx& = Fill(yy&).x1 TO Fill(yy&).x1 + XLen XPos& = Tx& \ 1024 YPos& = Ty& \ 1024 Buffer(xx&, yy&) = CHR$((Txt(XPos&, YPos&) + ((Col& \ 1024))) MOD 255) Tx& = Tx& + TxDelta& Ty& = Ty& + TyDelta& Col& = Col& + ColDelta& NEXT END IF NEXT ELSE FOR yy& = Upper TO Lower - 1 XLen = Fill(yy&).x2 - Fill(yy&).x1 IF XLen > 0 THEN TxDelta& = (Fill(yy&).Tx2 - Fill(yy&).Tx) / XLen * 1024 TyDelta& = (Fill(yy&).Ty2 - Fill(yy&).Ty) / XLen * 1024 Tx& = CLNG(Fill(yy&).Tx) * 1024 Ty& = CLNG(Fill(yy&).Ty) * 1024 IF Fill(yy&).x2 > 319 THEN Fill(yy&).x2 = 319 IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1 IF Fill(yy&).x1 < 0 THEN XLen = XLen + Fill(yy&).x1 Col& = Col& + ColDelta& * -Fill(yy&).x1 Tx& = Tx& + TxDelta& * -Fill(yy&).x1 Ty& = Ty& + TyDelta& * -Fill(yy&).x1 Fill(yy&).x1 = 0 END IF FOR xx& = Fill(yy&).x1 TO Fill(yy&).x2 XPos& = Tx& \ 1024 YPos& = Ty& \ 1024 Buffer(xx&, yy&) = CHR$(ABS((Txt(XPos&, YPos&)) + Ambient) MOD 255) Tx& = Tx& + TxDelta& Ty& = Ty& + TyDelta& NEXT END IF NEXT END IF END SELECT END SUB SUB Fillchar (segment%, offset%, value%, bytes%) DEF SEG = VARSEG(ASMFillChar$) CALL absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(ASMFillChar$)) DEF SEG END SUB SUB HandleKeys DEF SEG = 0: k = INP(&H60) WHILE LEN(INKEY$): WEND 'Empty keyboard buffer SELECT CASE k CASE &H3B 'F1 ShadingModel = 1 CASE &H3C 'F2 ShadingModel = 2 CASE &H3D 'F3 ShadingModel = 3 CASE &H3E 'F4 ShadingModel = 4 CASE &H3F 'F5 Ambient = Ambient - 1 IF Ambient < 0 THEN Ambient = 0 CASE &H40 'F6 Ambient = Ambient + 1 IF Ambient > 63 THEN Ambient = 63 CASE &H41 'F7 Switch PDisp, True, False CASE &H42 'F8 Switch FDisp, True, False CASE &H43 'F9 Switch Anim, True, False IF Anim = True THEN AnimType = 1 MakeFirePalette 63 FOR x = 0 TO TSize FOR y = 0 TO TSize Txt(x, y) = 0 NEXT NEXT FOR i = 64 TO 255 OUT &H3C8, i OUT &H3C9, 63 OUT &H3C9, 63 OUT &H3C9, 63 NEXT ELSE MakePalette MakeTexture AnimType = 0 END IF CASE &H44 'F10 Switch Anim, True, False IF Anim = True THEN AnimType = 2 FOR i = 1 TO 63 OUT &H3C8, i OUT &H3C9, 0 OUT &H3C9, 0 OUT &H3C9, i NEXT FOR i = 64 TO 128 OUT &H3C8, i OUT &H3C9, i OUT &H3C9, i OUT &H3C9, 63 NEXT FOR i = 128 TO 255 OUT &H3C8, i OUT &H3C9, 63 OUT &H3C9, 63 OUT &H3C9, 63 NEXT FOR y = 0 TO TSize FOR x = 0 TO TSize Txt(x, y) = RND * 64 NEXT NEXT ELSE MakePalette MakeTexture AnimType = 0 END IF CASE &H57 'F11 Switch Anim, True, False IF Anim = True THEN AnimType = 3 FOR i = 1 TO 63 OUT &H3C8, i OUT &H3C9, 0 OUT &H3C9, i OUT &H3C9, 0 NEXT FOR i = 64 TO 128 OUT &H3C8, i OUT &H3C9, i OUT &H3C9, 63 OUT &H3C9, i NEXT FOR i = 128 TO 255 OUT &H3C8, i OUT &H3C9, 63 OUT &H3C9, 63 OUT &H3C9, 63 NEXT ELSE MakePalette MakeTexture AnimType = 0 END IF CASE &H58 'F12 Switch Anim, True, False IF Anim = True THEN AnimType = 4 WaveSide1 = 1 WaveSide2 = 3 WaveSide3 = 2 R1 = 1 R2 = 10 R3 = 20 FOR i = 1 TO 63 OUT &H3C8, i OUT &H3C9, i OUT &H3C9, 0 OUT &H3C9, 0 NEXT FOR i = 64 TO 128 OUT &H3C8, i OUT &H3C9, 63 OUT &H3C9, i OUT &H3C9, i NEXT FOR i = 128 TO 255 OUT &H3C8, i OUT &H3C9, 63 OUT &H3C9, 63 OUT &H3C9, 63 NEXT ELSE MakePalette MakeTexture AnimType = 0 END IF CASE &H52 '0 Zoom = 700 Xr = 400 Yr = 315 Zr = 0 Mx = 0 My = 0 CASE &H4C '5 Vx = 0 Vy = 0 Vz = 0 CASE &H1E 'A Zoom = Zoom - 10 IF Zoom < 0 THEN Zoom = 0 CASE &H50 '2 Vx = Vx + 1 CASE &H48 '8 Vx = Vx - 1 CASE &H4B '4 Vy = Vy + 1 CASE &H4D '6 Vy = Vy - 1 CASE &H4A '+ Vz = Vz + 1 CASE &H4E '- Vz = Vz - 1 CASE &H2C 'Z Zoom = Zoom + 10 CASE &H17 'I My = My + 5 CASE &H25 'K My = My - 5 CASE &H24 'J Mx = Mx + 5 CASE &H26 'L Mx = Mx - 5 CASE 1 'ESC TheEnd END SELECT END SUB SUB Hiiriajuri (ax%, bx%, cx%, dx%) DEF SEG = VARSEG(hiiri$) 'Segmentti talteen hiiri% = SADD(hiiri$) 'Offsetti talteen CALL absolute(ax%, bx%, cx%, dx%, hiiri%) 'Kutsu END SUB SUB HiiriLue (vasen%, oikea%, keski%, x%, y%) ax% = 3 'Funktio 3 Hiiriajuri ax%, bx%, cx%, dx% 'Kutsutaan hiiriajuria vasen% = ((bx% AND 1) <> 0) 'Luetaan nappien asennot oikea% = ((bx% AND 2) <> 0) 'bx:st� keski% = ((bx% AND 4) <> 0) x% = cx% 'ja hiiren koordinaatit y% = dx% 'cx:st� ja dx:st� END SUB FUNCTION Hiiritarkista% ax% = 0 'Funktio 0 Hiiriajuri ax%, bx%, 0, 0 'Kutsutaan hiiriajuria IF (ax% = 0) THEN 'Onko ajuri k꼢t봲s�? Hiiritarkista% = 0 'jos ei, palautetaan 0 ELSEIF (bx% = 3) THEN 'Kolminappinen hiiri? Hiiritarkista% = 3 ELSEIF (bx% = 0) THEN 'Ep꼜tandardi hiiri? Hiiritarkista% = 1 ELSE Hiiritarkista% = 2 'Tavallinen kaksinappinen hiiri? END IF END FUNCTION DEFSNG A-Z SUB InterPolate (x, y, x2, y2) P1 = POINT(x, y) P2 = POINT(x2, y) P3 = POINT(x, y2) P4 = POINT(x2, y2) YDelta1& = (P3 - P1) / (y2 - y) * 1024 YDelta2& = (P4 - P2) / (y2 - y) * 1024 Col1& = P1 * 1024 Col2& = P3 * 1024 FOR yy& = y TO y2 PSET (x, yy&), Col1& \ 1024 PSET (x2, yy&), Col2& \ 1024 Col1& = Col1& + YDelta1& Col2& = Col2& + YDelta2& NEXT XLen = x2 - x FOR yy& = y TO y2 P1 = POINT(x, yy&) P2 = POINT(x2, yy&) XDelta& = (P2 - P1) / XLen * 1024 Col& = P1 * 1024 FOR xx& = x TO x2 PSET (xx&, yy&), Col& \ 1024 Col& = Col& + XDelta& NEXT NEXT END SUB DEFINT A-Z SUB LoadObject (File$) OPEN File$ FOR INPUT AS #1 LINE INPUT #1, Temp$ INPUT #1, MaxPoints INPUT #1, MaxPolygons LINE INPUT #1, Temp$ LINE INPUT #1, Temp$ FOR i = 1 TO MaxPoints INPUT #1, Pnt(i).x3, Pnt(i).y3, Pnt(i).z3 NEXT LINE INPUT #1, Temp$ LINE INPUT #1, Temp$ FOR i = 1 TO MaxPolygons INPUT #1, Poly(i).P1, Poly(i).P2, Poly(i).P3, Poly(i).Col NEXT CLOSE #1 END SUB SUB MakeFirePalette (MaxColors) 'Asettaa paletin FOR x% = 1 TO MaxColors OUT &H3C8, x% OUT &H3C9, 63 OUT &H3C9, 63 OUT &H3C9, 63 NEXT FOR x% = 0 TO (MaxColors \ 4) - 1 OUT &H3C8, x% OUT &H3C9, x% * (63 / (MaxColors \ 4)) OUT &H3C9, 0 OUT &H3C9, 0 OUT &H3C8, x% + (MaxColors \ 4) OUT &H3C9, 63 OUT &H3C9, x% * (63 / (MaxColors \ 4)) OUT &H3C9, 0 OUT &H3C8, x% + ((MaxColors \ 4) * 2) OUT &H3C9, 63 OUT &H3C9, 63 OUT &H3C9, x% * (63 / (MaxColors \ 4)) NEXT x% END SUB SUB MakeLight FOR x& = 0 TO LSize FOR y& = 0 TO LSize Xd! = (x& - (LSize \ 2)) / (LSize \ 2) Yd! = (y& - (LSize \ 2)) / (LSize \ 2) Light! = (1 - SQR(Xd! ^ 2 + Yd! ^ 2)) IF Light! < 0 THEN Light! = 0 l(x&, y&) = CINT(Light! * (LSize * 4)) NEXT NEXT END SUB SUB MakePalette FOR i = 0 TO 63 OUT &H3C8, i OUT &H3C9, i OUT &H3C9, i OUT &H3C9, 0 NEXT FOR i = 64 TO 128 OUT &H3C8, i OUT &H3C9, i OUT &H3C9, 0 OUT &H3C9, 0 NEXT FOR i = 129 TO 192 OUT &H3C8, i OUT &H3C9, 0 OUT &H3C9, i OUT &H3C9, 0 NEXT FOR i = 193 TO 255 OUT &H3C8, i OUT &H3C9, 0 OUT &H3C9, 0 OUT &H3C9, i NEXT END SUB SUB MakeTexture FOR y = 0 TO TSize FOR x = 0 TO TSize Txt(x, y) = RND * 32 NEXT NEXT FOR Iter = 0 TO 0 FOR y = 0 TO TSize FOR x = 0 TO TSize Txt(x, y) = (Txt(x - 1, y - 1) + Txt(x, y - 1) + Txt(x + 1, y - 1) + Txt(x + 1, y) + Txt(x + 1, y + 1) + Txt(x, y + 1) + Txt(x - 1, y + 1) + Txt(x - 1, y)) \ 8 NEXT NEXT NEXT END SUB SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%) DEF SEG = VARSEG(ASMMemCopy$) CALL absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(ASMMemCopy$)) DEF SEG END SUB SUB ReadObject (File$) IF File$ = "" THEN END IF END SUB SUB RotatePoint (xo, yo, zo, Rx, Ry, Rz, Nx, Ny, Nz) '---------------------------------------------------------------------------- ' Rotate a point in 3D space '---------------------------------------------------------------------------- s1& = Sine(Rx MOD 360) s2& = Sine(Ry MOD 360) s3& = Sine(Rz MOD 360) c1& = Cosine(Rx MOD 360) c2& = Cosine(Ry MOD 360) c3& = Cosine(Rz MOD 360) x1 = (xo * c1& - zo * s1&) \ 1024 z1 = (xo * s1& + zo * c1&) \ 1024 z3 = (z1 * c3& - yo * s3&) \ 1024 + oz y2 = (z1 * s3& + yo * c3&) \ 1024 x2 = (x1 * c2& + y2 * s2&) \ 1024 + ox y3 = (y2 * c2& - x1 * s2&) \ 1024 + oy Nx = x2 Ny = y3 Nz = z3 END SUB SUB RotatePoints FOR i& = 1 TO MaxPoints RotatePoint Pnt(i&).x3, Pnt(i&).y3, Pnt(i&).z3, Xr, Yr, Zr, x3, y3, z3 t3d2d x3, y3, z3, SX, SY Pnt(i&).Nx = x3 Pnt(i&).Ny = y3 Pnt(i&).Nz = z3 Pnt(i&).x = SX Pnt(i&).y = SY Pnt(i&).Shade = z3 / 6 + Ambient IF ShadingModel = 4 THEN IF Pnt(i&).Shade > 32 THEN Pnt(i&).Shade = 32 ELSE IF Pnt(i&).Shade > 63 THEN Pnt(i&).Shade = 63 END IF IF Pnt(i&).Shade < 1 THEN Pnt(i&).Shade = 1 NEXT END SUB SUB SaveObject (File$) OPEN File$ FOR OUTPUT AS #1 PRINT #1, "--------[ 3D Engine (C) Sami Ky봲til� - Object Data file ]--------" PRINT #1, MaxPoints PRINT #1, MaxPolygons PRINT #1, "---------------------------------------------[ Start Point data ]-" PRINT #1, "X", "Y", "Z" FOR i = 1 TO MaxPoints PRINT #1, Pnt(i).x3, Pnt(i).y3, Pnt(i).z3 NEXT PRINT #1, "-------------------------------------------[ Start Polygon data ]-" PRINT #1, "Point 1", "Point 2", "Point 3", "Color" FOR i = 1 TO MaxPolygons PRINT #1, Poly(i).P1, Poly(i).P2, Poly(i).P3, Poly(i).Col NEXT CLOSE #1 END SUB DEFLNG A-Z SUB Separator (Col, Char$) '---------------------------------------------------------------------------- ' Prints a separator line '---------------------------------------------------------------------------- SELECT CASE Col CASE IS = 1 Col1 = 1 Col2 = 9 Col3 = 3 Col4 = 11 Col5 = 15 CASE IS = 2 Col1 = 2 Col2 = 10 Col3 = 14 Col4 = 15 Col5 = 15 CASE IS = 3 Col1 = 8 Col2 = 7 Col3 = 15 Col4 = 15 Col5 = 15 END SELECT COLOR Col1 PRINT STRING$(5, Char$); COLOR Col2 PRINT STRING$(5, Char$); COLOR Col3 PRINT STRING$(5, Char$); COLOR Col4 PRINT STRING$(5, Char$); COLOR Col5 PRINT STRING$(40, Char$); COLOR Col4 PRINT STRING$(5, Char$); COLOR Col3 PRINT STRING$(5, Char$); COLOR Col2 PRINT STRING$(5, Char$); COLOR Col1 PRINT STRING$(5, Char$) END SUB DEFINT A-Z FUNCTION ShadeName$ (Model) SELECT CASE Model CASE 1: ShadeName$ = "Wireframe" CASE 2: ShadeName$ = "Z-Gouraud" CASE 3: ShadeName$ = "Z-Flat" CASE 4: ShadeName$ = "Textured" END SELECT END FUNCTION SUB Switch (Var, Value1, Value2) '---------------------------------------------------------------------------- ' Switches values '---------------------------------------------------------------------------- ' ' Var - Variable to be changed ' Value1 - Value 1 ' Value2 - Value 2 ' '---------------------------------------------------------------------------- ' ' if Var = Value1 then Value2 will be assigned to Var ' ' if Var = Value2 then Value1 will be assigned to Var ' ' This SUB is used with Checkboxes and Radiobuttons ' '---------------------------------------------------------------------------- IF Var = Value1 THEN Var = Value2: EXIT SUB IF Var = Value2 THEN Var = Value1 END SUB SUB t3d2d (x, y, z, SX, SY) '---------------------------------------------------------------------------- ' Transforms 3D coordinates into 2D screen coordinates '---------------------------------------------------------------------------- IF z - Zoom <> 0 THEN SY = CLNG(y + My) * 100 \ INT(z - Zoom) IF z - Zoom <> 0 THEN SX = CLNG(x + Mx) * 100 \ INT(z - Zoom) END SUB SUB TheEnd SCREEN 0: CLS WIDTH 80, 25 COLOR 15, 4 LOCATE 1, 1 PRINT STRING$(80, " ") LOCATE 1, 1 PRINT " 3D Polygon Engine v2.0 by Sami Ky봲til� 1997" COLOR 3, 0 PRINT PRINT "Average FPS:", , , FPS&; "fps" PRINT "Ending position (XYZ)", , Xr; Yr; Zr PRINT "Shading model:", , " "; ShadeName$(ShadingModel) PRINT "Ambient lighting level:", , Ambient SYSTEM END SUB