Texture Mapping ีอออออออออออออออออออออออออออออออธ ณ W E L C O M E ณ ณ To the VGA Trainer Program ณ ณ ณ By ณ ณ ณ DENTHOR of ASPHYXIA ณ ณ ณ ิอออออออออออออออออออออออออออออออพ ณ ณ ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤู ณ ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤู --==[ PART 21 ]==-- =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � Introduction Hi there! It's been quite a long time (again) since the last tutorial ... I'll bet some of you had given up one me ;-) Today is my 21st birthday, so I decided it would be the perfect time to finish up this trainer which I have been meaning to send out for weeks. It's on texure mapping. I know, I know, I said light sourcing, then gourad, then texture mapping, but I got enough mail (a deluge in fact ;) telling me to do texure mapping... I'll be using the code from Tut 20 quite extensively, so make sure you know whats going on in there... well, on with the show! BTW, I've improved my web page quite a bit... give it a visit, I want to really ramp up that hit count :) If you would like to contact me, or the team, there are many ways you can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail on the ASPHYXIA BBS. 2) Write to : Grant Smith P.O.Box 270 Kloof 3640 Natal South Africa 3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you call during work hours). Call +27-31-73-2129 if you call from outside South Africa. (It's YOUR phone bill ;-)) 4) Write to denthor@goth.vironix.co.za in E-Mail. 5) Write to asphyxia@beastie.cs.und.ac.za to get to all of us at once. http://www.vironix.co.za/~grants (WWW) ftp.eng.ufl.edu pub/msdos/demos/code/graph/tutor (FTP) =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � Free Direction Texture Mapping There are two things you should know before we begin. Firstly, I am cheating. The texture mapping I am going to show you is not perspective-correct, with clever divides for z-placement etc. This method looks almost as good and is quite a bit faster too. Secondly, you will find it all rather easy. The reason for this is that it's all rather simple. I first made the routine by sitting down with some paper and a pencil and had it on the machine in a few hours. A while later when people on the net started discussing their methods, they were remarkably similar. Let me show you what I mean. Let us assume you have a texture of 128x128 (a straight array of bytes [0..127, 0..127]) which you want to map onto the side of a polygon. The problem of course being that the polygon can be all over the place, with one side longer then the other etc. Our first step is to make sure we know which end is up... let me demonstrate... 1 + / \ / \ 4 + + 2 \ / \ / + 3 Let us say that the above is the chosen polygon. We have decided that point 1 is the top left, point 3 is bottom right. This means that 1 - 2 is the top of the texture 2 - 3 is the right of the texture 3 - 4 is the bottom of the texture 4 - 1 is the left of the texture The same polygon, but rotated : 3 + / \ / \ 2 + + 4 \ / \ / + 1 Although the positions of the points are different, point 1 is still the top left of our texture. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � How to put it to screen Okay, so now you have four points and know which one of them is also the top left of our texture. What next? If you think back to our tutorial on polygons, you will remember we draw it scanline by scanline. We do texture mapping the same way. Lets look at that picture again : 1 + a / \ b / \ 4 + + 2 \ / \ / + 3 We know that point 1 is at [0,0] in our texture. Point 2 is at [127,0], Point 3 is at [127,127], and Point 4 is at [0,127]. The clever bit, and the entire key to texture mapping, is making the logical leap that precisely half way between Point 1 and Point 2 (b), we are at [64,0] in our texture. (a) is in the same manner at [0,64]. That's it. All we need to know per y scanline is : The starting position on the x axis of the polgon line The position on the x in the texture map referenced by that point The position on the y in the texture map referenced by that point The ending position on the x axis of the polgon line The position on the x in the texture map referenced by that point The position on the y in the texture map referenced by that point Let me give you an example. Let's sat that (a) and (b) from the above picture are on the same y scanline. We know that the x of that scanline is (say) 100 pixels at the start and 200 pixels at the end, making it's width 100 pixels. We know that on the left hand side, the texture is at [0,64], and at the right hand side, the texture is at [64,0]. In 100 pixels we have to traverse our texture from [0,64] to [64,0]. Assume at the start we have figured out the starting and ending points in the texture textureX = 0; textureY = 64; textureEndX = 64; textureEndY = 0; dx := (TextureEndX-TextureX)/(maxx-minx); dy := (TextureEndY-TextureY)/(maxx-minx); for loop1 := minx to maxx do BEGIN PutPixel (loop1, ypos, texture [textureX, textureY], VGA); textureX = textureX + dx; textureY = textureY + dy; END; Do the above for all the scanlines, and you have a texture mapped polygon! It's that simple. We find our beginning and ending positions in the usual fasion. We know that Point 1 is [0,0]. We know that Point 2 is [127,0]. We know the number of scanlines on the y axis between Point 1 and Point 2. textureDX = 127/abs (point2.y - point1.y) We run though all the y scanlines, starting from [0,0] and adding the above formula to the X every time. When we hit the last scanline, we will be at point [127,0] in the texure. Repeat for all four sides, and you have the six needed variables per scanline. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � In closing As you can see, texture mapping (this type at least) is quite easy, and produces quite a good result. You will however notice a bit of distortion if you bring the polygon too close. This can be fixed by a) Subdividing the polygon, so the one is made up of four or more smaller polygons. Much bigger, but works; b) Using more accurate fixed point; or c) Figuring out perspective correct texture mapping, mapping along constant-z lines etc. When people write me, they often refer to my "tutes". This stems back to Mark Feldman calling them such in the PCGPE. I always though a "tute" was something you did with your car to gain someones attention. I dunno, maybe its an Australian thing ;-) I have been coding almost exclusively in C/C++ for the past year or so. Sorry guys, thats all they will pay me for ;) Anyway, the trainers will continue to be in Pascal for ease of understanding by beginners, but if someone (*ahem* Snowman) doesn't start converting them to C soon, I will do it myself. He also corrected any mistakes I made while he was converting, so I'd prefer he did it (sort of a proofreader after release...) Send me presents! It's my birthday! Byeeeee..... - Denthor 16-04-96 Unit GFX3; INTERFACE USES crt; CONST VGA = $A000; TYPE Virtual = Array [1..64000] of byte; { The size of our Virtual Screen } VirtPtr = ^Virtual; { Pointer to the virtual screen } VAR Virscr : VirtPtr; { Our first Virtual screen } Vaddr : word; { The segment of our virtual screen} Scr_Ofs : Array[0..199] of Word; Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. } Procedure SetText; { This procedure returns you to text mode. } Procedure Cls (Where:word;Col : Byte); { This clears the screen to the specified color } Procedure SetUpVirtual; { This sets up the memory needed for the virtual screen } Procedure ShutDown; { This frees the memory used by the virtual screen } procedure flip(source,dest:Word); { This copies the entire screen at "source" to destination } Procedure Pal(Col,R,G,B : Byte); { This sets the Red, Green and Blue values of a certain color } Procedure GetPal(Col : Byte; Var R,G,B : Byte); { This gets the Red, Green and Blue values of a certain color } procedure WaitRetrace; { This waits for a vertical retrace to reduce snow on the screen } Procedure Hline (x1,x2,y:word;col:byte;where:word); { This draws a horizontal line from x1 to x2 on line y in color col } Procedure Line(a,b,c,d:integer;col:byte;where:word); { This draws a solid line from a,b to c,d in colour col } Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word); { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4 in color col } Function rad (theta : real) : real; { This calculates the degrees of an angle } Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); { This puts a pixel on the screen by writing directly to memory. } Function Getpixel (X,Y : Integer; where:word) :Byte; { This gets the pixel on the screen by reading directly to memory. } Procedure LoadCEL (FileName : string; ScrPtr : pointer); { This loads the cel 'filename' into the pointer scrptr } Procedure LoadPal (FileName : string); { This loads in an Autodesk Animator V1 pallette file } IMPLEMENTATION {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. } BEGIN asm mov ax,0013h int 10h end; END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetText; { This procedure returns you to text mode. } BEGIN asm mov ax,0003h int 10h end; END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Cls (Where:word;Col : Byte); assembler; { This clears the screen to the specified color } asm push es mov cx, 32000; mov es,[where] xor di,di mov al,[col] mov ah,al rep stosw pop es End; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetUpVirtual; { This sets up the memory needed for the virtual screen } BEGIN GetMem (VirScr,64000); vaddr := seg (virscr^); END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure ShutDown; { This frees the memory used by the virtual screen } BEGIN FreeMem (VirScr,64000); END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} procedure flip(source,dest:Word); assembler; { This copies the entire screen at "source" to destination } asm push ds mov ax, [Dest] mov es, ax mov ax, [Source] mov ds, ax xor si, si xor di, di mov cx, 32000 rep movsw pop ds end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Pal(Col,R,G,B : Byte); assembler; { This sets the Red, Green and Blue values of a certain color } asm mov dx,3c8h mov al,[col] out dx,al inc dx mov al,[r] out dx,al mov al,[g] out dx,al mov al,[b] out dx,al end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure GetPal(Col : Byte; Var R,G,B : Byte); { This gets the Red, Green and Blue values of a certain color } Var rr,gg,bb : Byte; Begin asm mov dx,3c7h mov al,col out dx,al add dx,2 in al,dx mov [rr],al in al,dx mov [gg],al in al,dx mov [bb],al end; r := rr; g := gg; b := bb; end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} procedure WaitRetrace; assembler; { This waits for a vertical retrace to reduce snow on the screen } label l1, l2; asm mov dx,3DAh l1: in al,dx and al,08h jnz l1 l2: in al,dx and al,08h jz l2 end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler; { This draws a horizontal line from x1 to x2 on line y in color col } asm mov ax,where mov es,ax mov ax,y mov di,ax shl ax,8 shl di,6 add di,ax add di,x1 mov al,col mov ah,al mov cx,x2 sub cx,x1 shr cx,1 jnc @start stosb @Start : rep stosw end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Line(a,b,c,d:integer;col:byte;where:word); { This draws a solid line from a,b to c,d in colour col } function sgn(a:real):integer; begin if a>0 then sgn:=+1; if a<0 then sgn:=-1; if a=0 then sgn:=0; end; var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer; begin u:= c - a; v:= d - b; d1x:= SGN(u); d1y:= SGN(v); d2x:= SGN(u); d2y:= 0; m:= ABS(u); n := ABS(v); IF NOT (M>N) then BEGIN d2x := 0 ; d2y := SGN(v); m := ABS(v); n := ABS(u); END; s := m shr 1; FOR i := 0 TO m DO BEGIN putpixel(a,b,col,where); s := s + n; IF not (smxy then mxy:=y2; if y3mxy then mxy:=y3; { Choose the min y mny and max y mxy } if y4mxy then mxy:=y4; if mny<0 then mny:=0; if mxy>199 then mxy:=199; if mny>199 then exit; if mxy<0 then exit; { Verticle range checking } mul1:=x1-x4; div1:=y1-y4; mul2:=x2-x1; div2:=y2-y1; mul3:=x3-x2; div3:=y3-y2; mul4:=x4-x3; div4:=y4-y3; { Constansts needed for intersection calc } for yc:=mny to mxy do begin mnx:=320; mxx:=-1; if (y4>=yc) or (y1>=yc) then if (y4<=yc) or (y1<=yc) then { Check that yc is between y1 and y4 } if not(y4=y1) then begin x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if (y1>=yc) or (y2>=yc) then if (y1<=yc) or (y2<=yc) then { Check that yc is between y1 and y2 } if not(y1=y2) then begin x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if (y2>=yc) or (y3>=yc) then if (y2<=yc) or (y3<=yc) then { Check that yc is between y2 and y3 } if not(y2=y3) then begin x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if (y3>=yc) or (y4>=yc) then if (y3<=yc) or (y4<=yc) then { Check that yc is between y3 and y4 } if not(y3=y4) then begin x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if mnx<0 then mnx:=0; if mxx>319 then mxx:=319; { Range checking on horizontal line } if mnx<=mxx then hline (mnx,mxx,yc,color,where); { Draw the horizontal line } end; end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Function rad (theta : real) : real; { This calculates the degrees of an angle } BEGIN rad := theta * pi / 180 END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler; { This puts a pixel on the screen by writing directly to memory. } asm mov ax,where mov es,ax mov bx,[y] shl bx,1 mov di,word ptr [Scr_Ofs + bx] add di,[x] mov al,[col] mov es:[di],al end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Function Getpixel (X,Y : Integer; where:word):byte; assembler; { This puts a pixel on the screen by writing directly to memory. } asm mov ax,where mov es,ax mov bx,[y] shl bx,1 mov di,word ptr [Scr_Ofs + bx] add di,[x] mov al,es:[di] end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure LoadCEL (FileName : string; ScrPtr : pointer); { This loads the cel 'filename' into the pointer scrptr } var Fil : file; Buf : array [1..1024] of byte; BlocksRead, Count : word; begin assign (Fil, FileName); reset (Fil, 1); BlockRead (Fil, Buf, 800); { Read and ignore the 800 byte header } Count := 0; BlocksRead := $FFFF; while (not eof (Fil)) and (BlocksRead <> 0) do begin BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead); Count := Count + 1024; end; close (Fil); end; procedure LoadPal (FileName : string); var F:file; loop1:integer; pall:array[0..255,1..3] of byte; begin assign (F, FileName); reset (F,1); blockread (F, pall,768); close (F); for loop1 := 0 to 255 do Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]); end; VAR Loop1:integer; BEGIN For Loop1 := 0 to 199 do Scr_Ofs[Loop1] := Loop1 * 320; END.{$X+} USES Crt,GFX3; CONST VGA = $A000; maxpolys = 18; A : Array [1..maxpolys,1..4,1..3] of integer = ( ((-10, -10, 10 ), (10 , -10, 10 ), (10 , 10 , 10 ), (-10, 10 , 10 )), ((-10, 10 , -10), (10 , 10 , -10), (10 , -10, -10), (-10, -10, -10)), ((-10, 10 , 10 ), (-10, 10 , -10), (-10, -10, -10), (-10, -10, 10 )), ((10 , -10, 10 ), (10 , -10, -10), (10 , 10 , -10), (10 , 10 , 10 )), ((10 , 10 , 10 ), (10 , 10 , -10), (-10, 10 , -10), (-10, 10 , 10 )), ((-10, -10, 10 ), (-10, -10, -10), (10 , -10, -10), (10 , -10, 10 )), (*********) ((-10, -10,-20 ), (10 , -10,-20 ), (10 , 10 ,-20 ), (-10, 10 ,-20 )), ((-10, 10 , -30), (10 , 10 , -30), (10 , -10, -30), (-10, -10, -30)), ((-10, 10 ,-20 ), (-10, 10 , -30), (-10, -10, -30), (-10, -10,-20 )), ((10 , -10,-20 ), (10 , -10, -30), (10 , 10 , -30), (10 , 10 ,-20 )), ((10 , 10 ,-20 ), (10 , 10 , -30), (-10, 10 , -30), (-10, 10 ,-20 )), ((-10, -10,-20 ), (-10, -10, -30), (10 , -10, -30), (10 , -10,-20 )), (*********) ((-30, -10, 10 ), (-20, -10, 10 ), (-20, 10 , 10 ), (-30, 10 , 10 )), ((-30, 10 , -10), (-20, 10 , -10), (-20, -10, -10), (-30, -10, -10)), ((-30, 10 , 10 ), (-30, 10 , -10), (-30, -10, -10), (-30, -10, 10 )), ((-20, -10, 10 ), (-20, -10, -10), (-20, 10 , -10), (-20, 10 , 10 )), ((-20, 10 , 10 ), (-20, 10 , -10), (-30, 10 , -10), (-30, 10 , 10 )), ((-30, -10, 10 ), (-30, -10, -10), (-20, -10, -10), (-20, -10, 10 )) ); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), } { (X2,Y2,Z2) ... for the 4 points of a poly } XOfs = 100; YOfs = 160; Type Point = Record x,y,z:integer; { The data on every point we rotate} END; Pictype = array [0..127,0..127] of byte; VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object to be rotated } Translated : Array [1..maxpolys,1..4] of Point; { The rotated object } centre, tcentre : Array [1..maxpolys] of Point; Order : Array[1..maxpolys] of integer; lookup : Array [0..360,1..2] of integer; { Our sin and cos lookup table } poly : array [0..199,1..2] of integer; ytopclip,ybotclip:integer; {where to clip our polys to} xoff,yoff,zoff:integer; pic : ^pictype; lefttable : array [-200..400,0..2] of integer; righttable : array [-200..400,0..2] of integer; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. } BEGIN asm mov ax,0013h int 10h end; END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Hline (x1,x2,y:integer;col:byte;where:word); assembler; { This draws a horizontal line from x1 to x2 on line y in color col } asm mov ax,x1 cmp ax,0 jge @X1Okay mov x1,0 @X1Okay : mov ax,x2 cmp ax,319 jle @X2Okay mov x2,319 @X2Okay : mov ax,x1 cmp ax,x2 jg @Exit mov ax,where mov es,ax mov ax,y mov di,ax shl ax,8 shl di,6 add di,ax add di,x1 mov al,col mov ah,al mov cx,x2 sub cx,x1 shr cx,1 jnc @start stosb @Start : rep stosw @Exit : end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word); { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4 in color col } var miny,maxy:integer; loop1:integer; Procedure doside (x1,y1,x2,y2:integer); { This scans the side of a polygon and updates the poly variable } VAR temp:integer; x,xinc:integer; loop1:integer; BEGIN if y1=y2 then exit; if y2(ytopclip)) and (loop1<(ybotclip)) then BEGIN if (x shr 7poly[loop1,2]) then poly[loop1,2]:=x shr 7; END; x:=x+xinc; END; END; begin asm mov si,offset poly mov cx,200 @Loop1: mov ax,32766 mov ds:[si],ax inc si inc si mov ax,-32767 mov ds:[si],ax inc si inc si loop @loop1 end; { Setting the minx and maxx values to extremes } miny:=y1; maxy:=y1; if y2maxy then maxy:=y2; if y3>maxy then maxy:=y3; if y4>maxy then maxy:=y4; if minyybotclip then maxy:=ybotclip; if (miny>199) or (maxy<0) then exit; Doside (x1,y1,x2,y2); Doside (x2,y2,x3,y3); Doside (x3,y3,x4,y4); Doside (x4,y4,x1,y1); for loop1:= miny to maxy do hline (poly[loop1,1],poly[loop1,2],loop1,color,where); end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetUpPoints; { This creates the lookup table } VAR loop1,loop2:integer; BEGIN For loop1:=0 to 360 do BEGIN lookup [loop1,1]:=round(sin (rad (loop1))*16384); lookup [loop1,2]:=round(cos (rad (loop1))*16384); END; For loop1:=1 to maxpolys do BEGIN centre[loop1].x := (lines[loop1,1].x + lines[loop1,2].x + lines[loop1,3].x + lines[loop1,4].x) div 4; centre[loop1].y := (lines[loop1,1].y + lines[loop1,2].y + lines[loop1,3].y + lines[loop1,4].y) div 4; centre[loop1].z := (lines[loop1,1].z + lines[loop1,2].z + lines[loop1,3].z + lines[loop1,4].z) div 4; END; END; Procedure LoadGFX; { This loads up our texture } VAR f1 : File; bob : array [0..255, 1..3] of byte; loop1 : Integer; BEGIN getmem (pic,sizeof(pic^)); loadcel ('side1.cel',pic); assign (f1, 'side1.cel'); reset (f1, 1); seek (f1, 32); blockread (f1, bob, 768); close (f1); for loop1:=0 to 255 do Pal (loop1, bob[loop1,1], bob[loop1,2], bob[loop1,3]); END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure RotatePoints (x,Y,z:Integer); { This rotates the objecct in lines to translated } VAR loop1,loop2:integer; a,b,c:integer; BEGIN For loop1:=1 to maxpolys do BEGIN for loop2:=1 to 4 do BEGIN b:=lookup[y,2]; c:=lines[loop1,loop2].x; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[y,1]; c:=lines[loop1,loop2].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; translated[loop1,loop2].x:=a; translated[loop1,loop2].y:=lines[loop1,loop2].y; b:=-lookup[y,1]; c:=lines[loop1,loop2].x; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[y,2]; c:=lines[loop1,loop2].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; translated[loop1,loop2].z:=a; if x<>0 then BEGIN b:=lookup[x,2]; c:=translated[loop1,loop2].y; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[x,1]; c:=translated[loop1,loop2].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 sub a,dx end; b:=lookup[x,1]; c:=translated[loop1,loop2].y; translated[loop1,loop2].y:=a; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[x,2]; c:=translated[loop1,loop2].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; translated[loop1,loop2].z:=a; END; if z<>0 then BEGIN b:=lookup[z,2]; c:=translated[loop1,loop2].x; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[z,1]; c:=translated[loop1,loop2].y; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 sub a,dx end; b:=lookup[z,1]; c:=translated[loop1,loop2].x; translated[loop1,loop2].x:=a; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[z,2]; c:=translated[loop1,loop2].y; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; translated[loop1,loop2].y:=a; END; END; END; {******************} For loop1:=1 to maxpolys do BEGIN b:=lookup[y,2]; c:=centre[loop1].x; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[y,1]; c:=centre[loop1].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; tcentre[loop1].x:=a; tcentre[loop1].y:=centre[loop1].y; b:=-lookup[y,1]; c:=centre[loop1].x; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[y,2]; c:=centre[loop1].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; tcentre[loop1].z:=a; if x<>0 then BEGIN b:=lookup[x,2]; c:=tcentre[loop1].y; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[x,1]; c:=tcentre[loop1].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 sub a,dx end; b:=lookup[x,1]; c:=tcentre[loop1].y; tcentre[loop1].y:=a; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[x,2]; c:=tcentre[loop1].z; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; tcentre[loop1].z:=a; END; if z<>0 then BEGIN b:=lookup[z,2]; c:=tcentre[loop1].x; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[z,1]; c:=tcentre[loop1].y; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 sub a,dx end; b:=lookup[z,1]; c:=tcentre[loop1].x; tcentre[loop1].x:=a; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 mov a,dx end; b:=lookup[z,2]; c:=tcentre[loop1].y; asm mov ax,b imul c sal ax,1 rcl dx,1 sal ax,1 rcl dx,1 add a,dx end; tcentre[loop1].y:=a; END; END; END; Procedure TextureMapPoly (x1,y1,x2,y2,x3,y3,x4,y4:integer;where:word); { The main procedure, contains various nested procedures } VAR miny, maxy, loop1 : integer; Procedure scanleftside (x1,x2,ytop,lineheight:integer;side:byte); { Scan in our needed variables ... X on the left, texturmap X, texturemap Y} VAR x,px,py,xadd,pxadd,pyadd:integer; y:integer; BEGIN lineheight:=lineheight+1; xadd:=(x2-x1) shl 7 div lineheight; if side = 1 then BEGIN px:=(127-1) shl 7; py:=0; pxadd:=(-127 shl 7) div lineheight; pyadd:=0; END; if side = 2 then BEGIN px:=127 shl 7; py:=127 shl 7; pxadd:=0; pyadd:=(-127 shl 7) div lineheight; END; if side = 3 then BEGIN px:=0; py:=127 shl 7; pxadd:=127 shl 7 div lineheight; pyadd:=0; END; if side = 4 then BEGIN px:=0; py:=0; pxadd:=0; pyadd:=127 shl 7 div lineheight; END; x:=x1 shl 7; for y:=0 to lineheight do BEGIN lefttable[ytop+y,0]:=x shr 7; lefttable[ytop+y,1]:=px shr 7; lefttable[ytop+y,2]:=py shr 7; x:=x+xadd; px:=px+pxadd; py:=py+pyadd; END; END; Procedure scanrightside (x1,x2,ytop,lineheight:integer;side:byte); { Scan in our needed variables ... X on the right, texturmap X, texturemap Y} VAR x,px,py,xadd,pxadd,pyadd:integer; y:integer; BEGIN lineheight:=lineheight+1; xadd:=(x2-x1) shl 7 div lineheight; if side = 1 then BEGIN px:=0; py:=0; pxadd:=127 shl 7 div lineheight; pyadd:=0; END; if side = 2 then BEGIN px:=127 shl 7; py:=0; pxadd:=0; pyadd:=127 shl 7 div lineheight; END; if side = 3 then BEGIN px:=127 shl 7; py:=127 shl 7; pxadd:=(-127) shl 7 div lineheight; pyadd:=0; END; if side = 4 then BEGIN px:=0; py:=127 shl 7; pxadd:=0; pyadd:=(-127) shl 7 div lineheight; END; x:=x1 shl 7; for y:=0 to lineheight do BEGIN righttable[ytop+y,0]:=x shr 7; righttable[ytop+y,1]:=px shr 7; righttable[ytop+y,2]:=py shr 7; x:=x+xadd; px:=px+pxadd; py:=py+pyadd; END; END; Procedure Texturemap; { This uses the tables we have created to actually draw the texture } VAR px1,py1:integer; px2,py2:integer; polyx1,polyx2,y,linewidth:integer; pxadd,pyadd:integer; bob, twhere :word; BEGIN bob:=seg (pic^); tWhere := Where; { ds is used elsewhere ... variables are not accessable } if miny<0 then miny:=0; if maxy>199 then maxy:=199; if minyybotclip then maxy:=ybotclip; if maxy-miny<2 then exit; if miny>199 then exit; if maxy<0 then exit; for y:=miny to maxy do BEGIN polyx1:=lefttable[y,0]; { X Starting position } px1:=lefttable[y,1] shl 7; { Texture X at start } py1:=lefttable[y,2] shl 7; { Texture Y at stary } polyx2:=righttable[y,0]; { X Ending position } px2:=righttable[y,1] shl 7; { Texture X at end } py2:=righttable[y,2] shl 7; { Texture Y at end } linewidth:=polyx2-polyx1; { Width of line } if linewidth<=0 then linewidth:=1; pxadd:=(px2-px1) div linewidth; pyadd:=(py2-py1) div linewidth; asm push ds mov bx,polyx1 mov di,bx mov dx,[Y] mov bx, dx shl dx, 8 shl bx, 6 add dx, bx add di, dx mov ax,twhere { es:di points to start of line } mov es,ax mov bx, px1 mov cx,lineWidth mov dx, bob mov ds, dx mov dx,py1 @Loop1 : xor si,si mov ax,bx and ax,1111111110000000b; { Get rid of fixed point } add si,ax mov ax,dx shr ax,7 add si,ax { get the pixel in our texture } movsb { draw the pixel to the screen } mov ax,pxadd add bx,ax mov ax,pyadd add dx,ax { increment our position in the texture } loop @loop1 pop ds end; END; END; BEGIN miny:=32767; maxy:=0; if y1maxy then maxy:=y1; if y2maxy then maxy:=y2; if y3maxy then maxy:=y3; if y4maxy then maxy:=y4; if miny>maxy-5 then exit; { Why paint slivers? } if (y2 tcentre[curpos+1].z then BEGIN temp := tcentre[curpos+1].x; tcentre[curpos+1].x := tcentre[curpos].x; tcentre[curpos].x := temp; temp := tcentre[curpos+1].y; tcentre[curpos+1].y := tcentre[curpos].y; tcentre[curpos].y := temp; temp := tcentre[curpos+1].z; tcentre[curpos+1].z := tcentre[curpos].z; tcentre[curpos].z := temp; temp := order[curpos+1]; order[curpos+1] := order[curpos]; order[curpos] := temp; curpos:=0; END; curpos:=curpos+1; END; END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure MoveAround; { This is the main display procedure. } VAR deg,deg2,loop1,loop2:integer; ch:char; BEGIN pal (1, 0, 0,63); pal (2, 0,32,63); pal (3, 32, 0,63); pal (4, 32,32,63); pal (5, 0,63,63); pal (6, 32,63,63); pal ( 7, 0,63, 0); pal ( 8, 0,63,32); pal ( 9, 32,63, 0); pal (10, 32,63,32); pal (11, 0,63,63); pal (12, 32,63,63); pal (13, 63, 0, 0); pal (14, 63,32, 0); pal (15, 63, 0,32); pal (16, 63,32,32); pal (17, 63,63, 0); pal (18, 63,63,32); { for loop1:=1 to 15 do pal (loop1,0,loop1*4+3,63-(loop1*4+3));} pal (100,50,50,50); deg:=0; deg2:=0; ch:=#0; Cls (vaddr,0); For loop1:=1 to maxpolys do For loop2:=1 to 4 do BEGIN Lines [loop1,loop2].x:=a [loop1,loop2,1]*8; Lines [loop1,loop2].y:=a [loop1,loop2,2]*8; Lines [loop1,loop2].z:=a [loop1,loop2,3]*8; END; SetUpPoints; LoadGFX; cls (vaddr,0); cls (vga,0); Xoff := 160; Yoff:=100; zoff:=-600; ytopclip:=101; ybotclip:=100; line (0,100,319,100,100,vga); delay (2000); for loop1:=1 to 25 do BEGIN RotatePoints (deg2,deg,deg2); SortPoints; DrawPoints; line (0,ytopclip,319,ytopclip,100,vaddr); line (0,ybotclip,319,ybotclip,100,vaddr); flip (vaddr,vga); cls (vaddr,0); deg:=(deg+5) mod 360; deg2:=(deg2+1) mod 360; ytopclip:=ytopclip-4; ybotclip:=ybotclip+4; END; Repeat if keypressed then ch:=upcase (Readkey); RotatePoints (deg2,deg,deg2); SortPoints; DrawPoints; line (0,0,319,0,100,vaddr); line (0,199,319,199,100,vaddr); flip (vaddr,vga); cls (vaddr,0); deg:=(deg+5) mod 360; deg2:=(deg2+3) mod 360; Until ch=#27; for loop1:=1 to 25 do BEGIN ytopclip:=ytopclip+4; ybotclip:=ybotclip-4; RotatePoints (deg2,deg,deg2); SortPoints; DrawPoints; line (0,ytopclip,319,ytopclip,100,vaddr); line (0,ybotclip,319,ybotclip,100,vaddr); flip (vaddr,vga); cls (vaddr,0); deg:=(deg+5) mod 360; deg2:=(deg2+1) mod 360; END; END; BEGIN clrscr; writeln ('Welcome to the twenty first trainer! This one is on texure mapping.'); writeln; writeln ('Just sit bak and watch, it''s non interactive. Total reuse of Tut 20''s'); writeln ('code, aside from the texure mapping procedure. Have fun!'); writeln; writeln; write ('Hit any key to continue ...'); readkey; SetUpVirtual; SetMCGA; MoveAround; SetText; ShutDown; Writeln ('All done. This concludes the twenty first sample program in the ASPHYXIA'); Writeln ('Training series. You may reach DENTHOR under the names of GRANT'); Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally'); Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :'); Writeln (' denthor@goth.vironix.co.za'); Writeln ('The numbers are available in the main text. You may also write to me at:'); Writeln (' Grant Smith'); Writeln (' P.O. Box 270'); Writeln (' Kloof'); Writeln (' 3640'); Writeln (' Natal'); Writeln (' South Africa'); Writeln ('I hope to hear from you soon!'); Writeln; Writeln; Write ('Hit any key to exit ...'); readkey; END.