| Home | Submit | Free Hosting | Link To Us | Contacts |
Pascal Vgautil Pascal
 Download (.zip)Unit VgaUtil; Interface {$G+,R-} Uses Crt; {-$DEFINE CLIPADDPUT} Const Long = $66; display1 : word = $0000; display2 : word = $4000; { Vga card 64k bank select } BankOfs : Array[0..3] of Word = (0, $4000, $8000, $A000); BankNum : Array[0..3] of Byte = (0, 1, 2, 3); Width = 80; Numsins = 255; HiNumsins = Numsins shl 6; Pi = 3.1415; MovPut = 0; AddPut = 1; SubPut = 2; AndPut = 3; OrPut = 4; XorPut = 5; TPut = 6; Type AnyString = String[127]; RGB = Record r, g, b : Byte; End; PaletteType = Array[0..255] of RGB; P2dType = Record x, y : Integer; End; P3dType = Record x, y, z : Integer; End; P2dArray = Array[0..255] of P2dType; P3dArray = Array[0..255] of P3dType; Var SinTable,CosTable: Array[0..Numsins] of integer; Sin2Table,Cos2Table: Array[0..Numsins] of integer; PageOffset : Word; OldScreenMode, CurPage : Byte; VLU : array[0..199] of word; OldExitProc : pointer; Pal : PaletteType; { For procedure comments you will have to hunt around, sorry... } Procedure CalcSine; Procedure CalcVLU; Procedure SetGraphicsMode(Mode : Byte); Procedure RefreshWait; Procedure SetSingleColor(Var TPal : PaletteType; Col, R, G, B : Byte); Procedure SetRGB(ColNum, R, G, B : Byte); Procedure SetSPalette(Palette : PaletteType); Procedure Fadepals(Startpal, Endpal : Palettetype; Steps : Integer); Procedure Fadepalsstep(Startpal, Endpal : Palettetype; TotalSteps, CurStep : Integer); Procedure GraphCLS; Procedure VgaGetPic(x1, y1, x2, y2 : Integer; DestPtr : Pointer); Procedure OldVgaPutPic(Mode : Byte; x1, y1: Integer; SrcPtr, DestPtr : Pointer); Procedure VGAClipPic(Mode : Byte; X1, Y1, XClip, YClip : Integer; SrcPtr, DestPtr : Pointer); Procedure VGAPutPic(Mode : Byte; X1, Y1 : Integer; SrcPtr, DestPtr : Pointer); Procedure RestoreBackground(X1, Y1, XSize, YSize : Integer; SrcPtr, DestPtr : Pointer); Procedure RestoreBackgroundVertical(Y1, Y2 : Integer; SrcPtr, DestPtr : Pointer); Procedure LoadPcx(FileName : AnyString; Var TPal : PaletteType; Orig : Pointer); Procedure LoadPcxPalette(FileName : AnyString; Var TPal : PaletteType); Procedure ClearPage(P : Pointer); Procedure CopyPage(P : Pointer); Procedure CopyPageOffset(P : Pointer; POffset : Word); Procedure Copy2Pages(SrcP, DestP : Pointer); Procedure SetStart(p:word); Procedure SetBank(bank:byte); Procedure Vgaline(const x1,y1,x2,y2,where:word;const c:byte); function LongDiv(x : longint; y : integer) : integer; inline($59/$58/$5A/$F7/$F9); function LongMul(x, y : integer) : longint; inline($5A/$58/$F7/$EA); procedure SetBitplanes(planes : byte); inline( $BA/$C4/$03/ {mov dx,$3C4} $58/ {pop ax} $88/$C4/ {mov ah,al} $B0/$02/ {mov al,$02} $EF); {out dx,ax} Implementation procedure CLI; inline($FA); procedure STI; inline($FB); Procedure CalcSine; {Creates sin/cos tables} Var direction:integer; angle:real; begin For Direction:=0 to Numsins do begin {use 256 degrees in circle} angle:=Direction; angle:=angle*3.14159265/128; SinTable[Direction]:=round(Sin(angle)*256); CosTable[Direction]:=round(Cos(angle)*256); Sin2Table[Direction]:=round(Sin(angle+3.14159265/2)*256*1.2); Cos2Table[Direction]:=round(Cos(angle+3.14159265/2)*256*1.2); end; { the 1.2 accounts for pixel aspect ratio } end; { Makes an array that speeds up pixel offset calculations } { Use like this... Mov bx, (Y value here) Shl bx, 1 Mov di, Word Ptr Vlu[bx] Add di, (X value here) DI now holds proper offset. >> CONTINUED IN NEXT MESSAGE << ================================================================================ Area: PASCAL Date: 24 Jul 96 21:11:56 Public From: Ryan Stowers To: All Subject: HERE IT IS FINALLY!!!!!!!!!! [2] ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ >> CONTINUED FROM PREVIOUS MESSAGE << VERY fast!!! } Procedure CalcVlu; Var A : Integer; Begin For a := 0 to 199 do Vlu[A] := A * 320; End; { Works for any graphics mode } Procedure SetGraphicsMode(Mode : Byte); Assembler; asm Mov al, Mode Xor ah, ah Int 10H end; { One of Bjarke's routines } {$F+} procedure ScreenExitProc; {$F-} begin ExitProc := OldExitProc; If (ExitCode <> 0) then Begin SetGraphicsMode($03); {if runtime error, restore screen} Writeln('Mega screw up error #',ExitCode); End; end; { Wait for vertical retrace } Procedure RefreshWait; Assembler; Asm Mov dx,$3da @Looper: In al,dx And al,8 Jz @Looper End; Procedure SetSingleColor(Var TPal : PaletteType; Col, R, G, B : Byte); Begin Pal[Col].r := R; Pal[Col].g := G; Pal[Col].b := B; End; { One of Bjarke's routines. Very useful. } Procedure SetRGB(ColNum, R, G, B : Byte); assembler; Asm Mov dx, $3c8 Mov al, ColNum Out dx, al Inc dx Mov al, R Out dx, al Mov al, G Out dx, al Mov al, B Out dx, al End; { One of Bjarke's routines, but i modified it to use a static array insted of a pointer. } Procedure SetSPalette(Palette : PaletteType); Var Count : Integer; Begin Asm Mov dx,$3c8 Xor al,al Out dx,al Inc dx Mov si,0 Mov cx,768 @Looper: Mov al,Byte Ptr [Palette+si] Out dx,al Inc si Dec cx Jnz @Looper End; End; Procedure Fadepals(Startpal, Endpal : Palettetype; Steps : Integer); Var Temppal : PaletteType; MCount, PCount : Integer; Begin For MCount := Steps downto 0 do Begin For PCount := 0 to 255 do Begin Temppal[PCount].r := ((startpal[PCount].r * MCount) div Steps)+ ((endpal[PCount].r * (Steps-MCount)) div Steps); Temppal[PCount].g := ((startpal[PCount].g * MCount) div Steps)+ ((endpal[PCount].g * (Steps-MCount)) div Steps); Temppal[PCount].b := ((startpal[PCount].b * MCount) div Steps)+ ((endpal[PCount].b * (Steps-MCount)) div Steps); End; SetSpalette(Temppal); RefreshWait; end; SetSPalette(Endpal); End; Procedure Fadepalsstep(Startpal, Endpal : Palettetype; TotalSteps, CurStep : Integer); Var Temppal : PaletteType; PCount : Integer; Begin For PCount := 0 to 255 do Begin SetRGB(PCount, ((startpal[PCount].r * CurStep) div TotalSteps)+ ((endpal[PCount].r * (TotalSteps-CurStep)) div TotalSteps), ((startpal[PCount].g * CurStep) div TotalSteps)+ ((endpal[PCount].g * (TotalSteps-CurStep)) div TotalSteps), ((startpal[PCount].b * CurStep) div TotalSteps)+ ((endpal[PCount].b * (TotalSteps-CurStep)) div TotalSteps)); End; End; { Ummm..... What does this procedure do... } Procedure GraphCLS; Begin Fillchar(Mem[Sega000:0], 64000, 0); End; { Just like GET in BASIC for grabbing screen images, but you dont need a { static array like in BASIC. Just use a pointer } { NOT optimized, but works. Just make sure you used GETMEM with DestPtr.} { x1,y1,x2,y2 = Coordinates of the screen you want to get } Procedure VgaGetPic(x1, y1, x2, y2 : Integer; DestPtr : Pointer); Var VCount, HCount, DestSeg, DestOfs, CurOfs, W, H :Integer; Begin DestSeg := Seg(DestPtr^); DestOfs := Ofs(DestPtr^); W := (x2 - x1); H := (y2 - y1); CurOfs := 0; MemW[DestSeg:DestOfs + CurOfs] := W; Inc(CurOfs,2); MemW[DestSeg:DestOfs + CurOfs] := H; Inc(CurOfs,2); For VCount := y1 to y2 do Begin For HCount := x1 to x2 do Begin Mem[DestSeg:DestOfs + CurOfs] := Mem[$a000:HCount + VCount * 320]; Inc(CurOfs); End; End; End; { Just like PUT in BASIC for putting images on the screen. Im pretty sure this one does all the clipping you need, but its older and slower than the newer one (look below) Mode = Use one of the constants for MOV, ADD, SUB, etc, etc x1,y1 = coordinates SrcPtr = source bitmap DestPtr = destination bitmap can be either direct video or a virtual page } Procedure OldVgaPutPic(Mode : Byte; x1, y1: Integer; SrcPtr, DestPtr : Pointer); Var DestSeg, Bytes, WordsLeft, BytesLeft : Word; DestStartx, DestStarty, XWriteLen, YWriteLen, SrcOfs : Integer; PicW, PicH, DestStartYOfs, StartYOfs, DestXerror, Xerror, Tilt : Integer; Begin PicW := MemW[Seg(SrcPtr^):Ofs(SrcPtr^) + 0] + 1; PicH := MemW[Seg(SrcPtr^):Ofs(SrcPtr^) + 2] + 1; If X1 > 319 then exit; If Y1 > 199 then Exit; If X1 < -PicW then exit; If Y1 < -PicH then exit; SrcOfs := Ofs(SrcPtr^); Asm Mov Tilt, 0 Mov ax, 16 Sub ax, PicW Mov Xerror, 0 { Xerror := (16 - PicW)} Mov ax, X1 { DestStartX := X1 } Mov DestStartx, ax Mov ax, Y1 { DestStarty := Y1 } Mov DestStartY, ax Mov ax, PicW { XWriteLen := PicW } Mov XWriteLen, ax Mov ax, PicH { YWriteLen := PicH } Mov YWriteLen, ax Mov StartYOfs, 4 Cmp Y1, 0 { If Y1 < 0 then } Jg @SkipY11 Mov ax, PicH Add ax, Y1 Mov YWriteLen, ax Mov DestStartY, 0 { DestStartY := 0 } Mov ax, Y1 { StartYOfs := StartYOfs + Abs(y1) * PicW } Not ax Add ax, 1 Mul PicW Add StartYOfs, ax @SkipY11: Mov ax, Y1 { If (Y1 + YWriteLen) > 199 then } Add ax, YWriteLen Cmp ax, 199 Jl @SkipY12 Mov ax, 200 { YWriteLen := 200 - Y1 } Sub ax, Y1 Mov YWriteLen, ax @SkipY12: Cmp X1, 0 { If X < 0 then } Jg @SkipX11 Mov ax, X1 { Xerror := Abs(X1) } Not ax add ax, 1 Mov Xerror, ax Mov ax, X1 { XWriteLen := XWriteLen + X1 } Add XWriteLen, ax Mov ax, Xerror { StartYofs := StartYOfs + Xerror } Add StartYOfs, ax Mov DestStartX, 0 { DestStartX := 0 } @SkipX11: Mov ax, X1 { If (X1 + XWriteLen) > 319 then } Add ax, XWriteLen Cmp ax, 319 Jl @SkipX12 Mov ax, 320 { XWriteLen := 320 - X1 } Sub ax, X1 Mov XWriteLen, ax Mov ax, 320 { Xerror := X1 - (320 - PicW) } Sub ax, PicW Mov bx, X1 Sub bx, ax Mov Xerror, bx @SkipX12: Cmp XWriteLen, 0 Jg @Oops1 Mov Tilt, 1 @Oops1: Cmp YWriteLen, 0 Jg @Oops2 Mov Tilt, 1 @Oops2: { Dest start coordinates computer } Mov ax, DestStartY { Y coordinate } Mov bx, ax Shl ax, 6 Add ah, bl Add ax, DestStartX { X coordinate } Mov DestStartYOfs, ax Mov ax, 320 { DestXError := 320 - XwriteLen } Sub ax, XwriteLen Mov DestXError, ax End; If Tilt <> 0 Then Exit; Case Mode of { MOV } 0:Begin Bytes := Word(XWriteLen div 4); WordsLeft := (Xwritelen mod 4) and 2; BytesLeft := (Xwritelen mod 4) and 1; If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Y Loop Count} Mov es, DestSeg {Dest segment } Mov si, StartYOfs {Src offset} Mov di, DestStartYOfs {Dest offset} Push ds {Save ds} Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: db 66h; Mov cx, Bytes; { Move double words at one to increase speed } db 66h; Rep Movsw Mov cx, WordsLeft Jcxz @SkipZero1 Movsw @SkipZero1: Mov cx, BytesLeft Jcxz @SkipZero2 Movsb @SkipZero2: Add si, XError {Fix offscreen clipping errors} Add di, DestXError Inc Ax {Increment Ax} Cmp ax, YWriteLen {If ax < YWritelen then.. } Jl @YLooper {Goto @YLooper} Pop Ds {All done, restore ds to prevent stack errors} End; End; { Addition PUT } 1:Begin If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Init Y Count } Mov es, DestSeg { Init dest segment } Mov si, StartYOfs { Init source offset } Mov di, DestStartYOfs {Get source segment and figure source start coordinates} Push Ds Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: { Loop length computer } Mov cx, XWriteLen Shr cx,1 Jnc @SkipSingle Mov dl, es:[di] Add dl, ds:[si] Mov es:[di], dl Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov dl, es:[di] Add dl, ds:[si] Mov dh, es:[di+1] Add dh, ds:[si+1] Mov es:[di], dx Add si, 2; Add di, 2 Loop @XLooper @Exit: Add si, XError {Fix offscreen clipping errors} Add di, DestXError Inc Ax {Increment ax counter} Cmp ax, YWriteLen {If y < YWriteLen then... } Jl @YLooper {Goto YLooper} Pop Ds { All done, restore Ds to prevent stack errors } End; End; { Subtraction PUT } 2:Begin If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Init Y Count } Mov es, DestSeg { Init dest segment } Mov si, StartYOfs { Init source offset } Mov di, DestStartYofs {Get source segment and figure source start coordinates} Push Ds Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: { Loop length computer } Mov cx, XWriteLen Shr cx,1 Jnc @SkipSingle Mov dl, es:[di] Sub dl, ds:[si] Mov es:[di], dl Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov dl, es:[di] Sub dl, ds:[si] Mov dh, es:[di+1] Sub dh, ds:[si+1] Mov es:[di], dx Add si, 2; Add di, 2 Loop @XLooper @Exit: Add si, XError {Fix offscreen clipping errors} Add di, DestXerror Inc Ax {Increment ax counter} Cmp ax, YWriteLen {If y < YWriteLen then... } Jl @YLooper {Goto YLooper} Pop Ds { All done, restore Ds to prevent stack errors } End; End; { XOR PUT } 3:Begin If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Init Y Count } Mov es, DestSeg { Init dest segment } Mov si, StartYOfs { Init source offset } Mov di, DestStartYofs {Get source segment and figure source start coordinates} Push Ds Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: { Loop length computer } Mov cx, XWriteLen Shr cx,1 Jnc @SkipSingle Mov dl, es:[di] Xor dl, ds:[si] Mov es:[di], dl Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov dl, es:[di] Xor dl, ds:[si] Mov dh, es:[di+1] Xor dh, ds:[si+1] Mov es:[di], dx Add si, 2; Add di, 2 Loop @XLooper @Exit: Add si, XError {Fix offscreen clipping errors} Add di, DestXError Inc Ax {Increment ax counter} Cmp ax, YWriteLen {If y < YWriteLen then... } Jl @YLooper {Goto YLooper} Pop Ds { All done, restore Ds to prevent stack errors } End; End; { AND PUT } 4:Begin If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Init Y Count } Mov es, DestSeg { Init dest segment } Mov si, StartYOfs { Init source offset } Mov di, DestStartYofs {Get source segment and figure source start coordinates} Push Ds Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: { Loop length computer } Mov cx, XWriteLen Shr cx,1 Jnc @SkipSingle Mov dl, es:[di] And dl, ds:[si] Mov es:[di], dl Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov dl, es:[di] And dl, ds:[si] Mov dh, es:[di+1] And dh, ds:[si+1] Mov es:[di], dx Add si, 2; Add di, 2 Loop @XLooper @Exit: Add si, XError {Fix offscreen clipping errors} Add di, DestXError Inc Ax {Increment ax counter} Cmp ax, YWriteLen {If y < YWriteLen then... } Jl @YLooper {Goto YLooper} Pop Ds { All done, restore Ds to prevent stack errors } End; End; { NOT PUT - This is good for some strange effects if used correctly } 5:Begin If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Init Y Count } Mov es, DestSeg { Init dest segment } Mov si, StartYOfs { Init source offset } Mov di, DestStartYofs {Get source segment and figure source start coordinates} Push Ds Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: { Loop length computer } Mov cx, XWriteLen Shr cx,1 Jnc @SkipSingle Mov dl, es:[di] Add dl, ds:[si]; Not dl Mov es:[di], dl Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov dl, es:[di] Add dl, ds:[si]; Not dl Mov dh, es:[di+1] Add dh, ds:[si+1]; Not dh Mov es:[di], dx Add si, 2; Add di, 2 Loop @XLooper @Exit: Add si, XError {Fix offscreen clipping errors} Add di, DestXerror Inc Ax {Increment ax counter} Cmp ax, YWriteLen {If y < YWriteLen then... } Jl @YLooper {Goto YLooper} Pop Ds { All done, restore Ds to prevent stack errors } End; End; { Transparent MOV } 6:Begin If DestPtr = Nil then DestSeg := $a000 else DestSeg := Seg(DestPtr^); Asm Mov ax, 0 {Init Y Count } Mov es, DestSeg { Init dest segment } Mov si, StartYOfs { Init source offset } Mov di, DestStartYOfs {Get source segment and figure source start coordinates} Push Ds Lds cx, SrcPtr {Load SrcPtr into ds} @YLooper: { Loop length computer } Mov cx, XWriteLen Shr cx,1 Jnc @SkipSingle Mov dl, ds:[si] Or dl, dl Jz @SkipZero1 Mov es:[di], dl @SkipZero1: Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov dx, ds:[si] Or dl, dl Jnz @SkipZero2 Mov dl, es:[di] @SkipZero2: Or dh, dh Jnz @SkipZero3 Mov dh, es:[di+1] @SkipZero3: Mov es:[di], dx Add si, 2; Add di, 2 Loop @XLooper @Exit: Add si, XError {Fix offscreen clipping errors} Add di, DestXerror Inc Ax {Increment ax counter} Cmp ax, YWriteLen {If y < YWriteLen then... } Jl @YLooper {Goto YLooper} Pop Ds { All done, restore Ds to prevent stack errors } End; End; End; {Case} End; { Same thing as OldVGAPutPic, this one (sort of) clips. Clipping not quite finished yet. Use this PUTPIC only if you know that a bitmap will go off screen. Routines are quicker (i think?) since I tried to use less local variables and more registers Mode = Use predefined constants from the top of the program X1 = X position of picture Y1 = Y position of picture Next two are user clip functions! I found this useful in displaying a fuse that is burning it self down (i.e. show less and less of the fuse as time goes on) XClip = Number of pixels to clip from X size YClip = Number of pixels to clip from Y size SrcPtr, DestPtr = Source and destination virtual pages } Procedure VGAClipPic(Mode : Byte; X1, Y1, XClip, YClip : Integer; SrcPtr, DestPtr : Pointer); Label _StopDraw; Var OutSeg, YSize, XSize, YOfs, XDiff, XSiDiff : Word; Begin If DestPtr = Nil then OutSeg := SegA000 else OutSeg := Seg(DestPtr^); If XClip < 0 then XClip := 0; If YClip < 0 then YClip := 0; Asm { ----- Determine start adress ----- } Mov XSiDiff, 0 Mov bx, Y1; Shl bx, 1; Mov ax, Word Ptr [Vlu+bx]; Mov Yofs, ax { ----- Load X and Y sizes ----- } Les di, SrcPtr Mov ax, es:[di]; Inc ax; Mov XSize, ax Mov bx, 320; Sub bx, XSize; Mov XDiff, bx Mov ax, es:[di+2]; Inc ax Mov YSize, ax Mov ax, OutSeg Mov es, ax { ----- Range checking ----- } Cmp Y1, 200 Jae _StopDraw Cmp X1, 320 Jae _StopDraw { ----- Clipping routines ----- } Mov dx, 200; Sub dx, YSize Cmp Y1, dx Jbe @SkipMaxY Mov ax, Y1 Sub ax, dx Sub YSize, ax @SkipMaxY: Mov dx, 320; Sub dx, XSize Cmp X1, dx Jbe @SkipMaxX Mov ax, X1 Sub ax, dx Sub XSize, ax Add XDiff, ax Mov XSiDiff, ax @SkipMaxX: { ----- User clip. sometimes VERY useful! ----- } Mov ax, XClip Sub XSize, ax Add XDiff, ax Add XSiDiff, ax Mov ax, YClip Sub YSize, ax { ----- if we aint even gonna see a sprite, exit for godsake! ----- } Mov ax, XSize And ax, ax Js _StopDraw And ax, ax Jz _StopDraw Mov ax, YSize And ax, ax Js _StopDraw And ax, ax Jz _StopDraw { ----- Misc stuff ----- } Mov di, Yofs Add di, X1 @Stop: End; Case Mode of { ----- MOV PUT ----- } 0: Asm Push ds Lds si, SrcPtr; Add si, 4 Mov cx, YSize Cld @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingleByte Movsb @SkipSingleByte: Jcxz @Exit Shr cx, 1 Jnc @SkipSingleWord Movsw @SkipSingleWord: Jcxz @Exit Db 66h; Rep Movsw @Exit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- ADD PUT ----- } 1: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Add al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov ax, [ds:si] Mov bx, [es:di] Add al, bl; {$IFDEF CLIPADDPUT} Jnc @ResetAL Mov al, 255; @ResetAL: {$ENDIF} Add ah, bh; {$IFDEF CLIPADDPUT} Jnc @ResetAH Mov ah, 255; @ResetAH: {$ENDIF} Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- SUB PUT ----- } 2: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Sub al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] Sub al, bl; Sub ah, bh Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- AND PUT ----- } 3: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] And al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] And al, bl; And ah, bh Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- OR PUT ----- } 4: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Or al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] Or al, bl; Or ah, bh Mov [es:di], ax Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- XOR PUT ----- } 5: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Xor al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] Xor al, bl; Xor ah, bh Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- TRANSPARENT PUT ----- } 6: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @TSkipSingle Mov al, [ds:si] Or al, al Jz @TSkipZeroB Mov [es:di], al @TSkipZeroB: Inc di; Inc si @TSkipSingle: Jcxz @TExit @XLooper: Mov ax, [ds:si]; Or al, al Je @TSkipZeroWL Mov [es:di], al @TSkipZeroWL: Or ah, ah Je @TSkipZeroWH Mov [es:di+1], ah @TSkipZeroWH: Add di, 2; Add si, 2 Dec cx Jnz @XLooper @TExit: Add di, XDiff Add si, XSiDiff Pop cx Dec cx Jnz @YLooper Pop ds End; End; _StopDraw:; End; { DOES NOT CLIP AT ALL! Just does renage checking. Use this for faster PUTs if your bitmap will stay within the screen boundaries } Procedure VGAPutPic(Mode : Byte; X1, Y1 : Integer; SrcPtr, DestPtr : Pointer); Label _StopDraw; Var OutSeg, YSize, XSize, YOfs, XDiff : Word; Begin If DestPtr = Nil then OutSeg := SegA000 else OutSeg := Seg(DestPtr^); Asm { ----- Determine start adress ----- } Mov bx, Y1; Shl bx, 1; Mov ax, Word Ptr [Vlu+bx]; Mov Yofs, ax { ----- Load X and Y sizes ----- } Les di, SrcPtr Mov ax, es:[di]; Inc ax; Mov XSize, ax Mov bx, 320; Sub bx, XSize; Mov XDiff, bx Mov ax, es:[di+2]; Inc ax Mov YSize, ax Mov ax, OutSeg Mov es, ax { ----- Range checking ----- } { Upper limit check (down and right) } Mov ax, Y1 Add ax, YSize Cmp ax, 200 Jae _StopDraw Mov ax, X1 Add ax, XSize Cmp ax, 320 Jae _StopDraw { Lower limit (up and left) } Mov ax, Y1 Cmp ax, 200 Jae _StopDraw Mov ax, X1 Cmp ax, 320 Jae _StopDraw { No clipping routines here!!! } { ----- Misc stuff ----- } Mov di, Yofs Add di, X1 @Stop: End; Case Mode of { ----- MOV PUT ----- } 0: Asm Push ds Lds si, SrcPtr; Add si, 4 Mov cx, YSize Cld @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingleByte Movsb @SkipSingleByte: Jcxz @Exit Shr cx, 1 Jnc @SkipSingleWord Movsw @SkipSingleWord: Jcxz @Exit Db 66h; Rep Movsw @Exit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- ADD PUT ----- } 1: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Add al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov ax, [ds:si] Mov bx, [es:di] Add al, bl; {$IFDEF CLIPADDPUT} Jnc @ResetAL Mov al, 255; @ResetAL: {$ENDIF} Add ah, bh; {$IFDEF CLIPADDPUT} Jnc @ResetAH Mov ah, 255; @ResetAH: >> CONTINUED IN NEXT MESSAGE << ================================================================================ Area: PASCAL Date: 24 Jul 96 21:14:55 Public From: Ryan Stowers To: All Subject: VGAUTIL 4/7 [2] ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ >> CONTINUED FROM PREVIOUS MESSAGE << {$ENDIF} Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- SUB PUT ----- } 2: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Sub al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] Sub al, bl; Sub ah, bh Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- AND PUT ----- } 3: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] And al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] And al, bl; And ah, bh Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- OR PUT ----- } 4: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Or al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] Or al, bl; Or ah, bh Mov [es:di], ax Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- XOR PUT ----- } 5: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Mov bl, [es:di] Mov al, [ds:si] Xor al, bl; Mov [es:di], al; Inc di; Inc si @SkipSingle: Jcxz @Exit @XLooper: Mov bx, [es:di] Mov ax, [ds:si] Xor al, bl; Xor ah, bh Mov [es:di], ax; Add di, 2; Add si, 2 Dec cx Jnz @XLooper @Exit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; { ----- TRANSPARENT PUT ----- } 6: Asm Push ds Cld Lds si, SrcPtr; Add si, 4 Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @TSkipSingle Mov al, [ds:si] Or al, al Jz @TSkipZeroB Mov [es:di], al Inc di; Inc si @TSkipZeroB: @TSkipSingle: Jcxz @TExit @XLooper: Mov ax, [ds:si]; Or al, al Je @TSkipZeroWL Mov [es:di], al @TSkipZeroWL: Or ah, ah Je @TSkipZeroWH Mov [es:di+1], ah @TSkipZeroWH: Add di, 2; Add si, 2 Dec cx Jnz @XLooper @TExit: Add di, XDiff Pop cx Dec cx Jnz @YLooper Pop ds End; End; _StopDraw:; End; { The next two procedures are used for restoring backgrounds in my sprite and vector routines. Ask me and ill give them to you } { RestoreBackgoround aint really that fast. It would be more useful in mode-x sprite programming } Procedure RestoreBackground(X1, Y1, XSize, YSize : Integer; SrcPtr, DestPtr : Pointer); Label _TotalExit; Var OutSeg, YOfs, XDiff : Word; Begin If DestPtr = Nil then OutSeg := $A000 else OutSeg := Seg(DestPtr^); Asm { ----- Determine starting offset ----- } Mov bx, Y1; Shl bx, 1; Mov ax, Word Ptr [Vlu+bx]; Mov Yofs, ax Mov ax, OutSeg Mov es, ax Mov bx, 320; Sub bx, XSize; Mov XDiff, bx Mov dx, 320; Sub dx, XSize { ----- Range checking ----- } Mov ax, Y1; Add ax, Xsize Cmp ax, 199 Jae @Stop Mov ax, X1; Add ax, Ysize Cmp ax, 319 Jae @Stop { ----- Clipping Routines ----- } Mov dx, 200; Sub dx, YSize Cmp Y1, dx Jbe @SkipMaxY Mov ax, Y1 Sub ax, dx Sub YSize, ax @SkipMaxY: Mov dx, 320; Sub dx, XSize Cmp X1, dx Jbe @SkipMaxX Mov ax, X1 Sub ax, dx Sub XSize, ax Add XDiff, ax @SkipMaxX: Mov di, Yofs Add di, X1 { ----- draw the sucker ----- } Push ds Lds si, SrcPtr; Mov si, Yofs; Add si, X1 Cld Mov cx, YSize @YLooper: Push cx Mov cx, XSize; Shr cx, 1 Jnc @SkipSingle Movsb @SkipSingle: Jcxz @Exit Rep Movsw @Exit: Add di, XDiff Add si, XDiff Pop cx Dec cx Jnz @YLooper Pop ds @Stop: End; End; { This one is really fast (386 instr). Y1 is the top line of SrcPtr and Y2 is the bottom line of ScrPtr to copy to DestPtr } Procedure RestoreBackgroundVertical(Y1, Y2 : Integer; SrcPtr, DestPtr : Pointer); Var Bytes, StartOfs : Word; Tmp : Integer; Begin If Y1 > Y2 then Begin Tmp := Y1; Y1 := Y2; Y2 := Tmp; End; If Y1 < 0 then Y1 := 0; If Y2 > 199 then Y2 := 199; Bytes := (Y2-Y1) * 80; If Bytes = 0 then Exit; StartOfs := Vlu[Y1]; Asm Mov cx, StartOfs Mov dx, Bytes Push ds Push es Cld Les di, DestPtr Lds si, SrcPtr Mov di, cx; Mov si, cx db 66h; Mov cx, dx; db 66h; Rep Movsw Pop es Pop ds End; End; { 'down and dirty' pcx loader. ONLY works with 256 color pictures and is limited to files <= 64k :(. If you try to load something over 64k the machine WILL NOT LOCK but pcx will be all screwed up and so will the palette. If you can, please modify it so it can take >64k pcx files and/or 16 color pictures FileName = String that holds the filename TPal = Palette of the picture. It's AUTOMATICALLY set when you use this procedure Orig = Pointer (remember to use GETMEM) that you want the extracted image to go } Procedure LoadPcx(FileName : AnyString; Var TPal : PaletteType; Orig : Pointer); Var Size : Word; TextureOffset : Word; Count, PcxW, PcxH, TmpCount : Word; RunLen : Byte; Value : Byte; RVal, GVal, BVal : Byte; PCXOffset, OutOfs : Word; PCXSeg, OutSeg : Word; PCXFile : File; PCXBuffer : Pointer; TmpLong : LongInt; Begin Assign(PcxFile, FileName); Reset(PcxFile, 1); TmpLong := FileSize(PcxFile); If TmpLong > $ffff then TmpLong := $ffff; GetMem(PcxBuffer, TmpLong); BlockRead(PcxFile, PcxBuffer^, TmpLong); OutSeg := Seg(Orig^); OutOfs := Ofs(Orig^); PcxSeg := Seg(PcxBuffer^); PcxOffset := Ofs(PcxBuffer^); { Get picture width and height } PcxW := MemW[PcxSeg:PcxOffset + 10]; PcxH := MemW[PcxSeg:PcxOffset + 12]; PcxOffset := Ofs(PcxBuffer^) + 128; TextureOffset := 0; Size := 65535; While TextureOffset < Size do Begin RunLen := Mem[PcxSeg:PcxOffset]; Inc(PcxOffset); If (RunLen and $C0) = $C0 Then Begin RunLen := RunLen And $3f; Value := Mem[PCXSeg:PcxOffset]; Inc(PcxOffset); End Else Begin Value := RunLen; RunLen := 1; End; While (RunLen >= 1) and (TextureOffset < Size) do Begin {If Value < MinCol then Value := MinCol; If Value > MaxCol then Value := MaxCol;} Mem[OutSeg:OutOfs+TextureOffset] := Value; TextureOffset := TextureOffset + 1; RunLen := RunLen - 1; End; End; { Get palette } PcxOffset := Ofs(PcxBuffer^); Count := TmpLong - 768; For TmpCount := 0 to 255 do Begin Port[$3c8] := TmpCount; RVal := Mem[PcxSeg : PcxOffset + Count]; If TmpCount = 0 then RVal := 0; Port[$3c9] := RVal div 4; Tpal[TmpCount].r := Rval div 4; Inc(Count); GVal := Mem[PcxSeg : PcxOffset + Count]; If TmpCount = 0 then gVal := 0; Port[$3c9] := GVal div 4; Tpal[TmpCount].g := Gval div 4; Inc(Count); BVal := Mem[PcxSeg : PcxOffset + Count]; If TmpCount = 0 then bVal := 0; Port[$3c9] := BVal div 4; Tpal[TmpCount].b := Bval div 4; Inc(Count); End; FreeMem(PcxBuffer, TmpLong); Close(PcxFile); End; { Just loads the pcx file's palette into TPal } Procedure LoadPcxPalette(FileName : AnyString; Var TPal : PaletteType); Var Size : Word; Count, TmpCount : Word; RVal, GVal, BVal : Byte; PCXSeg, PCXOffset : Word; PCXFile : File; PCXBuffer : Pointer; TmpLong : LongInt; Begin Assign(PcxFile, FileName); Reset(PcxFile, 1); TmpLong := FileSize(PcxFile); If TmpLong > $ffff then TmpLong := $ffff; GetMem(PcxBuffer, TmpLong); BlockRead(PcxFile, PcxBuffer^, TmpLong); PcxSeg := Seg(PcxBuffer^); PcxOffset := Ofs(PcxBuffer^); Count := TmpLong - 768; For TmpCount := 0 to 255 do Begin Port[$3c8] := TmpCount; RVal := Mem[PcxSeg : PcxOffset + Count]; If TmpCount = 0 then RVal := 0; Port[$3c9] := RVal div 4; Tpal[TmpCount].r := Rval div 4; Inc(Count); GVal := Mem[PcxSeg : PcxOffset + Count]; If TmpCount = 0 then gVal := 0; Port[$3c9] := GVal div 4; Tpal[TmpCount].g := Gval div 4; Inc(Count); BVal := Mem[PcxSeg : PcxOffset + Count]; If TmpCount = 0 then bVal := 0; Port[$3c9] := BVal div 4; Tpal[TmpCount].b := Bval div 4; Inc(Count); End; FreeMem(PcxBuffer, TmpLong); Close(PcxFile); End; { Clears a virtual page } Procedure ClearPage(P : Pointer); Assembler; Asm Les di,P Mov cx, 16000 db 66h; Xor ax, ax db 66h; Rep Stosw End; {Copies a virtual page to video memory} Procedure CopyPage(P : Pointer); Assembler; Asm Push ds Push es Cld Mov ax,$A000 Mov es,ax Mov di, 0 Lds si, P db 66h; Mov cx,16000; dw 0; db 66h; Rep Movsw Pop es Pop ds End; {Copies a virtual page to video memory with 'offset' :P} {Note: this routine causes a protection fault so dont use it unless you can debug it} Procedure CopyPageOffset(P : Pointer; POffset : Word); Assembler; Asm Push ds Push es Cld Mov ax,$A000 Mov es,ax Mov di, 0 Lds si, P db 66h; Mov cx,16000; dw 0; db 66h; Rep Movsw Pop es Pop ds End; { Copies a virtual page to another virtual page } Procedure Copy2Pages(SrcP, DestP : Pointer); assembler; Asm Push ds Les di, DestP Lds si, SrcP db 66h; Mov cx, 16000; dw 0; db 66h; Rep Movsw Pop ds End; { One of Bjarke's routines sets the start position of the video cards video memory. Use this for hardware scrolling } Procedure SetStart(p:word); assembler; Asm Mov dx,$3d4;Mov bx,p;Mov al,$c; Mov ah,bh;Out dx,ax;Inc al;Mov ah,bl;Out dx,ax;Mov Word Ptr PageOffset, bx; End; { Only works with my Tseng/ET4000 video card apparently. Selects different 256k sections of my card for SVGA modes. } Procedure SetBank(bank:byte); Begin Port[$03cd] := Bank; End; Procedure Vgaline(const x1,y1,x2,y2,where:word;const c:byte); var dex,dey,incf:Integer; offset:word; begin {I added the next 2 lines because this routine is not perfect. I get garbage whenever I use this im my vector program } If (y1 <= 0) or (y1 > 319) or (y2 <= 0) or (y2 > 319) then exit; {If (x2-x1 = 0) or (x1-x2 = 0) then exit;} asm mov ax,[x2] sub ax,[x1] jnc @@dont1 neg ax @@dont1: mov [dex],ax mov ax,[y2] sub ax,[y1] jnc @@dont2 neg ax @@dont2: mov [dey],ax cmp ax,[dex] jbe @@otherline mov ax,[y1] cmp ax,[y2] jbe @@DontSwap1 mov bx,[y2] mov [y1],bx mov [y2],ax mov ax,[x1] mov bx,[x2] mov [x1],bx mov [x2],ax @@dontswap1: mov [incf],1 mov ax,[x1] cmp ax,[x2] jbe @@skipnegate1 neg [incf] @@skipnegate1: mov di,[y1] mov bx,di shl di,8 shl bx,6 add di,bx add di,[x1] mov bx,[dey] mov cx,bx mov ax,where mov es,ax mov dl,[c] mov si,[dex] @@drawloop1: mov es:[di],dl add di,320 sub bx,si jnc @@goon1 add bx,[dey] add di,[incf] @@goon1: loop @@drawloop1 jmp @@exitline @@otherline: mov ax,[x1] cmp ax,[x2] jbe @@dontswap2 mov bx,[x2] mov [x1],bx mov [x2],ax mov ax,[y1] mov bx,[y2] mov [y1],bx mov [y2],ax @@dontswap2: mov [incf],320 mov ax,[y1] cmp ax,[y2] jbe @@skipnegate2 neg [incf] @@skipnegate2: mov di,[y1] mov bx,di shl di,8 shl bx,6 add di,bx add di,[x1] mov bx,[dex] mov cx,bx mov ax,where mov es,ax mov dl,[c] mov si,[dey] @@drawloop2: mov es:[di],dl inc di sub bx,si jnc @@goon2 add bx,[dex] add di,[incf] @@goon2: loop @@drawloop2 @@exitline: end; end; Begin End.
|
