{ TEXURE_P.PAS } { Vykresli texturu a otacajuci sa stvorec. } { } { Datum:07.11.2000 http://www.trsek.com } {$r-,g+} program texure_poly; uses crt; Type TE = Record X : Integer; px, py : Byte; End; Table = Array[0..199] of TE; PTable = ^Table; Var Left, Right : Table; stab:array[0..255] of integer; polyz:array[0..7] of integer; pind:array[0..7] of byte; page,virscr:pointer; pageseg,virseg:word; Frame, St, Et : Longint; Time : Longint Absolute $0000:$046c; pxVal, pxStep : Integer; pyVal, pyStep : Integer; Count, res : Integer; O1 : Word; b:byte; Const Bitmap :Array[0..16*16-1] of Byte = ( 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,5,5,5,5,5,5,2, 2,5,5,1,1,1,1,1,1,1,1,1,1,5,5,2,2,5,1,5,1,1,1,1,1,1,1,1,5,1,5,2, 2,5,1,1,5,1,1,1,1,1,1,5,1,1,5,2,2,5,1,1,1,5,1,1,1,1,5,1,1,1,5,2, 2,5,1,1,1,1,5,1,1,5,1,1,1,1,5,2,2,5,1,1,1,1,1,5,5,1,1,1,1,1,5,2, 2,5,1,1,1,1,1,5,5,1,1,1,1,1,5,2,2,5,1,1,1,1,5,1,1,5,1,1,1,1,5,2, 2,5,1,1,1,5,1,1,1,1,5,1,1,1,5,2,2,5,1,1,5,1,1,1,1,1,1,5,1,1,5,2, 2,5,1,5,1,1,1,1,1,1,1,1,5,1,5,2,2,5,5,1,1,1,1,1,1,1,1,1,1,5,5,2, 2,5,5,5,5,5,5,5,5,5,5,5,5,5,5,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2); pointnum=11; planenum=7; border=false; vidseg:word=$a000; divd=128; dist=200; points:array[0..pointnum,0..2] of integer=( (-20,-20, 30),( 20,-20, 30),( 40,-40, 0),( 20,-20,-30), (-20,-20,-30),(-40,-40, 0),(-20, 20, 30),( 20, 20, 30), ( 40, 40, 0),( 20, 20,-30),(-20, 20,-30),(-40, 40, 0)); planes:array[0..planenum,0..3] of byte=( (1,2,8,7),(9,8,2,3),(10,4,5,11),(6,11,5,0), (0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10)); { -------------------------------------------------------------------------- } Procedure TextureHLine(X1, X2, px1, py1, px2, py2, Y : Integer; Dim : Word); Begin pxStep := ((px2-px1) Shl 8) Div (x2-x1+1); pyStep := ((py2-py1) Shl 8) Div (x2-x1+1); asm mov bx, px1; shl bx, 8; mov pxval,bx; { pxVal := px1 Shl 8;} mov bx, py1; shl bx, 8; mov pyval,bx; { pyVal := py1 Shl 8;} mov ax,y; shl ax,6; mov di,ax; shl ax,2 add di,ax; add di,x1; mov o1, di; End; For Count := X1 to X2 do Begin b:= Bitmap[Hi(pxVal)+(Hi(pyVal)) Shl 4]; Asm mov ax,virseg; mov es,ax; mov ax,o1; mov di,ax; mov al, b; mov es:[di],al; mov ax, pxval; add ax, pxstep; mov pxval, ax; mov ax, pyval; add ax, pystep; mov pyval, ax; inc o1; end; End; End; Procedure Swap(Var A, B : Integer); Var t : Integer; Begin t := a; a := b; b := t; End; Procedure Texture4Poly(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim : Byte); Var yMin, yMax : Integer; xStart, xEnd : Integer; yStart, yEnd : Integer; pxStart, pxEnd : Integer; pyStart,pyEnd : Integer; XVal, XStep : Longint; pxVal, pxStep : Integer; pyVal, pyStep : Integer; Count : Integer; Side : PTable; Begin yMin := Y1; yMax := Y1; If Y2 > yMax Then yMax := Y2; If Y3 > yMax Then yMax := Y3; If Y4 > yMax Then yMax := Y4; If Y2 < yMin Then yMin := Y2; If Y3 < yMin Then yMin := Y3; If Y4 < yMin Then yMin := Y4; xStart := X1; yStart := Y1; xEnd := X2; yEnd := Y2; pxStart := 0; pyStart := 0; pxEnd := Dim-1; pyEnd := 0; If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd); Swap(pxStart, pxEnd); Side := @Left; End Else Side := @Right; XVal := Longint(xStart) Shl 8; XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1); pxVal := pxStart Shl 8; pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1); For Count := yStart to yEnd do Begin Side^[Count].x := XVal Shr 8; Side^[Count].px := pxVal Shr 8; Side^[Count].py := pyStart; XVal := XVal + XStep; pxVal := pxVal + pxStep; End; xStart := X2; yStart := Y2; xEnd := X3; yEnd := Y3; pxStart := Dim-1; pyStart := 0; pxEnd := Dim-1; pyEnd := Dim-1; If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd); Swap(pyStart, pyEnd); Side := @Left; End Else Side := @Right; XVal := Longint(xStart) Shl 8; XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1); pyVal := pyStart Shl 8; pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1); For Count := yStart to yEnd do Begin Side^[Count].x := XVal Shr 8; Side^[Count].py := pyVal Shr 8; Side^[Count].px := pxStart; XVal := XVal + XStep; pyVal := pyVal + pyStep; End; xStart := X3; yStart := Y3; xEnd := X4; yEnd := Y4; pxStart := Dim-1; pyStart := Dim-1; pxEnd := 0; pyEnd := Dim-1; If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd); Swap(pxStart, pxEnd); Side := @Left; End Else Side := @Right; XVal := Longint(xStart) Shl 8; XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1); pxVal := pxStart Shl 8; pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1); For Count := yStart to yEnd do Begin Side^[Count].x := XVal Shr 8; Side^[Count].px := pxVal Shr 8; Side^[Count].py := pyStart; XVal := XVal + XStep; pxVal := pxVal + pxStep; End; xStart := X4; yStart := Y4;xEnd := X1; yEnd := Y1; pxStart := 0; pyStart := Dim-1; pxEnd := 0; pyEnd := 0; If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd); Swap(pyStart, pyEnd); Side := @Left; End Else Side := @Right; XVal := Longint(xStart) Shl 8; XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1); pyVal := pyStart Shl 8; pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1); For Count := yStart to yEnd do Begin Side^[Count].x := XVal Shr 8; Side^[Count].py := pyVal Shr 8; Side^[Count].px := pxStart; XVal := XVal + XStep; pyVal := pyVal + pyStep; End; For Count := yMin to yMax do If Left[Count].x < Right[Count].x Then TextureHLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py, Right[Count].px, Right[Count].py, Count, Dim) Else TextureHLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py, Left[Count].px, Left[Count].py, Count, Dim); End; {Asi sa zastrelim..........} procedure setpal(c,r,g,b:byte); assembler; asm; mov dx,3c8h; mov al,[c]; 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 flip(src,dst:word); assembler; asm push ds; mov es,[dst]; mov ds,[src]; xor si,si; xor di,di; mov cx,320*200/2 rep movsw; pop ds; end; procedure quicksort(lo,hi:integer); procedure sort(l,r:integer); var i,j,x,y:integer; begin i:=l; j:=r; x:=polyz[(l+r) div 2]; repeat while polyz[i]j; if l