[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]
{$G+}
UNIT MODEX;
INTERFACE
TYPE
Virtual_Scr = Array [1..64000] of byte; {The size of our Virtual Screen}
Virtual_Pal = Array [0..255, 1..3] Of Byte; {Our virtual Palette}
Virt_ScrPtr = ^Virtual_Scr; {Pointer to the virtual screen}
Virt_PalPtr = ^Virtual_Pal; {Pointer to the virtual palette}
CONST
View_Page : Word = $A000; {the viewable page}
PROCEDURE Init_VGA; {Puts you in 320x200x256 VGA}
PROCEDURE Init_VGA2; {Puts you in 320x200x256 VGA}
PROCEDURE Init_TEXT; {Puts you back in 80x25 text mode}
PROCEDURE Clear_VGA(Page: Word); {Clears the 320x200x256 VGA}
PROCEDURE Stretch(Value : byte);
PROCEDURE WaitVR;
PROCEDURE WaitDE;
PROCEDURE MoveCursor (X,Y : byte); {Moves the cursor to (X,Y)}
FUNCTION ReadCursorX: byte; {Get X position of cursor}
FUNCTION ReadCursorY: byte; {Get Y position of cursor}
PROCEDURE BIOSWrite(Str : String; Color : Byte);
PROCEDURE SetPix(x, y: integer; c: Byte; Page: Word);
PROCEDURE Move_Up(x1, y1, x2, y2: Word);
PROCEDURE Move_Up2(x1, y1, x2, y2: Word);
PROCEDURE Move_Up3(x1, y1, x2, y2: Word);
PROCEDURE Move_Left(x1, y1, x2, y2: Word);
PROCEDURE Screen_Pan(ScrOfs : Word);
PROCEDURE Synk;
PROCEDURE Set_Color(ColorNum, R, G, B: Byte);
PROCEDURE Get_Color(ColorNum: Byte; Var R, G, B: Byte);
FUNCTION GetPix(x, y, Page : Word) : Byte;
PROCEDURE Flip(Source, Dest: Word);
PROCEDURE ScaleBitmap(VAR bmp2scale; actualx, actualy : Byte;
bstrtx, bstrty, bendx, bendy : Word);
PROCEDURE GetImage (X1, Y1, X2, Y2: Integer; Var Dest);
PROCEDURE PutImage(X1, Y1: Integer; Var Source);
PROCEDURE DrawBar(X1, Y1, X2, Y2: Integer; Color: Byte);
PROCEDURE Pan(X,Y: Word);
PROCEDURE VgaBase(Xscroll,Yscroll:integer; Var Slide: Word);
PROCEDURE SetAddress(ad:word);
PROCEDURE SetLinecomp(ad:word);
PROCEDURE Draw_Line( x, y, x2, y2: Word; Color: Byte; Page: word);
PROCEDURE Fade_Area(x, y, x2, y2: Word; Difference: Integer; Page: Word);
IMPLEMENTATION
CONST
Crtadress : Word = $3d4;
Inputstatus : Word = $3DA;
TYPE
Fixed = RECORD
CASE Boolean OF
True : (w : LongInt);
False : (f, i : Word);
END;
PROCEDURE Init_VGA; ASSEMBLER; {Puts you in 320x200x256 VGA}
ASM
XOR AH, AH {save as MOV AH, 0 but faster}
MOV AL, $13
{MOV AX, $13}
INT $10
End;
PROCEDURE Init_VGA2; ASSEMBLER;
ASM
mov ax,13h
int 10h
mov dx,3c4h
mov ax,0604h
out dx,ax
mov ax,0f02h
out dx,ax
mov cx,320*200
mov es,view_page
xor ax,ax
mov di,ax
rep stosw
mov dx,3d4h
mov ax,0014h
out dx,ax
mov ax,0e317h
out dx,ax
END;
PROCEDURE Init_TEXT; ASSEMBLER; {Puts you back in 80x25 text mode}
ASM
XOR AH, AH {save as MOV AH, 0 but faster}
MOV AL, $3
{MOV AX, $3}
INT $10
End;
PROCEDURE Clear_VGA(Page: Word); Assembler;
ASM
cld
mov ax, [Page]
mov es, ax
xor di, di
xor ah, ah
mov cx, 32000
rep stosw
End;
{stretches the screen : EFFECT}
PROCEDURE Stretch(Value : byte); assembler;
ASM
push ax {Save the necessary registers}
push dx
mov al, $9 {Index 09h }
mov dx, $3D4 {CRTC register }
out dx, al {Output with a value of 0 }
mov dx, $3D5 {Get ready to read the port }
in al, dx {read from it }
and al, $0E0
add al, Value {Put the value in al }
out dx, al {go ahead and do it }
pop dx
pop ax {Restore the registers }
End;
{Wait for a vertical retrace}
PROCEDURE WaitVR; assembler;
asm
mov dx, $03DA
@wvr:
in al,dx
test al,8
jz @wvr
end;
{wait for Display Enable}
PROCEDURE WaitDE; assembler;
asm
mov dx, $03DA
@wde:
in al,dx
test al,1
jnz @wde
end;
PROCEDURE MoveCursor (X,Y : byte); Assembler; {Moves the cursor to (X,Y)}
ASM
MOV ah, $02
XOR bx, bx
MOV dh, Y
MOV dl, X
INT $10
End;
FUNCTION ReadCursorX: byte; assembler; {Get X position of cursor}
ASM
MOV ah, $03
XOR bx, bx
INT $10
MOV al, dl
End;
FUNCTION ReadCursorY: byte; assembler; {Get Y position of cursor}
ASM
MOV ah, $03
XOR bx, bx
INT $10
MOV al, dh
End;
PROCEDURE BIOSWrite(Str : String; Color : Byte); Assembler;
ASM
les di, Str
mov cl, es:[di] { cl = longueur chane }
inc di { es:di pointe sur 1er caractre }
xor ch, ch { cx = longueur chane }
mov bl, Color { bl:=coul }
jcxz @ExitBW { sortie si Length(s)=0 }
@BoucleBW:
mov ah, 0eh { sortie TTY }
mov al, es:[di] { al=caractre afficher }
int 10h { et hop }
inc di { caractre suivant }
loop @BoucleBW
@ExitBW:
End;
PROCEDURE SetPix(x, y: integer; c: Byte; Page: Word);
Begin
Mem[View_Page: y * 320 + x] := c;
End;
PROCEDURE SetPix2(x, y: integer; c: Byte; Page: Word); Assembler;
asm
mov ax, [Page]
mov es, ax
mov ax, y
mov bx, 320
mul bx
mov di, x
add di, ax
mov al, c
mov es:[di],al
End;
PROCEDURE Move_Up(x1, y1, x2, y2: Word);
type t_bmp_type = Array[0..63999] of Byte;
pt_bmp_type = ^t_bmp_type;
var
t_bmp : pt_bmp_type;
Begin
New(t_bmp);
GetImage(x1, y1, x2, y2, t_bmp^);
PutImage(x1, y1 - 1, t_bmp^);
Dispose(t_bmp);
End;
PROCEDURE Move_Up2(x1, y1, x2, y2: Word);
Var
x,
y : Word;
Begin
For Y := y1 to y2 Do
For X := x1 To x2 Do
SetPix(x, y, GetPix(x, y + 1, View_Page), View_Page);
End;
PROCEDURE Move_Up3(x1, y1, x2, y2: Word);
Var
y : Word;
Begin
for y := y1 to y2 do
Move(MEM[$A000:y*320], MEM[$A000:pred(y)*320], 320);
End;
PROCEDURE Move_Left(x1, y1, x2, y2: Word);
type t_bmp_type = Array[0..63999] of Byte;
pt_bmp_type = ^t_bmp_type;
var
t_bmp : pt_bmp_type;
Begin
New(t_bmp);
GetImage(x1 + 1, y1, x2, y2, t_bmp^);
PutImage(x1, y1, t_bmp^);
Dispose(t_bmp);
End;
PROCEDURE Screen_Pan(ScrOfs : Word); Assembler;
Asm
mov bx, ScrOfs
mov dx, $3d4
mov ah, bh
mov al, 0ch
out dx, ax
mov ah, bl
inc al
out dx, ax
End;
PROCEDURE Synk; Assembler;
Asm
mov dx, $3da
@L1:
in al, dx
test al, $8
jne @L1
@L2:
in al, dx
test al, $8
je @L2
End;
PROCEDURE Set_Color(ColorNum, R, G, B: Byte);
Begin
Port[$3C8] := ColorNum;
Port[$3C9] := R;
Port[$3C9] := G;
Port[$3C9] := B;
End;
PROCEDURE Get_Color(ColorNum: Byte; Var R, G, B: Byte);
Begin
Port[$3C8] := ColorNum;
R := Port[$3C9];
G := Port[$3C9];
B := Port[$3C9];
If ColorNum = 0 Then
Begin
R := 0;
G := 0;
B := 0;
End;
End;
FUNCTION GetPix(x, y, Page : Word) : Byte;
Begin
GetPix := Mem[View_Page: y * 320 + x];
End;
FUNCTION GetPix2(x, y, Page : Word) : Byte; Assembler;
ASM
push ds
mov ax, [Page]
mov ds, ax
mov ax, y
shl ax, 6
mov si, ax
shl ax, 2
add si, ax
add si, x
lodsb
pop ds
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;
{ originally by SEAN PALMER, I just mangled it :^) }
PROCEDURE ScaleBitmap(VAR bmp2scale; actualx, actualy : Byte;
bstrtx, bstrty, bendx, bendy: Word);
{ These are notes I added, so they might be wrong. :^) }
{ - bmp2scale is an array [0..actualx, 0..actualy] of byte }
{ which contains the original bitmap }
{ - actualx and actualy are the actual width and height of }
{ the normal bitmap }
{ - bstrtx and bstrty are the x and y values for the upper- }
{ left-hand corner of the scaled bitmap }
{ - bendx and bendy are the lower-right-hand corner of the }
{ scaled version of the original bitmap }
{ - eg. to paste an unscaled version of a bitmap that is }
{ 64x64 pixels in size in the top left-hand corner of the }
{ screen, fill the array with data and call: }
{ ScaleBitmap(bitmap, 64, 64, 0, 0, 63, 63); }
{ - apparently, the bitmap is read starting at (0,0) and }
{ then going to (0,1), then (0,2), etc; meaning that it's }
{ not read horizontally, but vertically }
VAR
bmp_sx, bmp_sy, bmp_cy : Fixed;
bmp_s, bmp_w, bmp_h : Word;
BEGIN
bmp_w := bendx - bstrtx + 1;
bmp_h := bendy - bstrty + 1;
bmp_sx.w := actualx * $10000 DIV bmp_w;
bmp_sy.w := actualy * $10000 DIV bmp_h;
bmp_s := 320 - bmp_w;
bmp_cy.w := 0;
ASM
PUSH DS
MOV DS,WORD PTR bmp2scale + 2
MOV AX,$A000;
MOV ES,AX;
CLD;
MOV AX,320;
MUL bstrty;
ADD ax,bstrtx;
MOV DI,AX;
@L2:
MOV AX,bmp_cy.i;
MUL actualx;
MOV BX,AX;
ADD BX,WORD PTR bmp2scale;
MOV CX,bmp_w;
XOR SI,SI; {MOV SI,0}
MOV DX,bmp_sx.f;
@L:
MOV AL,[BX];
STOSB;
ADD SI,DX;
ADC BX,bmp_sx.i;
LOOP @L
ADD DI,bmp_s;
MOV AX,bmp_sy.f;
MOV bx,bmp_sy.i;
ADD bmp_cy.f,AX;
ADC bmp_cy.i,BX;
DEC WORD PTR bmp_h;
JNZ @L2;
POP DS;
END;
END;
PROCEDURE GetImage (X1, Y1, X2, Y2: Integer; Var Dest);
Var
Width,
S,
O : Word;
Begin
S := SEG (DEST);
O := OFS (DEST);
ASM
PUSH DS
MOV DX, $A000
MOV DS, DX
MOV BX, 320
MOV AX, Y1; MUL BX
ADD AX, X1; MOV SI, AX
MOV DX, S
MOV ES, DX
MOV DI, O
MOV DX, Y2; SUB DX, Y1; INC DX
MOV BX, X2; SUB BX, X1; INC BX
MOV WIDTH, BX
MOV AX, WIDTH
STOSW
MOV AX, DX
STOSW
@LOOP:
MOV CX, WIDTH
REP MOVSB
ADD SI, 320;
SUB SI, WIDTH
DEC DX
JNZ @LOOP
POP DS
End; {end of assembler}
End; {end of procedure}
PROCEDURE PutImage(X1, Y1: Integer; Var Source);
Var
Width,
S,
O : Word;
Begin
S := SEG (SOURCE);
O := OFS (SOURCE);
ASM
PUSH DS
MOV DX, $A000
MOV ES, DX
MOV BX, 320 { Setup Dest Addr }
MOV AX, Y1; MUL BX
ADD AX, X1; MOV DI, AX
MOV DX, S { Setup Source Addr }
MOV DS, DX
MOV SI, O
LODSW { Get Width and Height }
MOV WIDTH, AX
LODSW
MOV DX, AX
@LOOP:
MOV CX, WIDTH
REP MOVSB
ADD DI, 320
SUB DI, WIDTH
DEC DX
JNZ @LOOP
POP DS
End; {end of the ASM}
End; {end of the procedure}
PROCEDURE DrawBar(X1, Y1, X2, Y2: Integer; Color: Byte);
Var
Row : Word;
Begin
IF X1 < 1 Then
X1 := 1;
If Y1 < 1 Then
Y1 := 1;
If X2 > 320 Then
X2 := 320;
If Y2 > 200 Then
Y2 := 200;
For Row := Y1 To Y2 Do
FillChar(MEM[$A000:(320 * Row) + X1], X2 - X1, Color);
End;
PROCEDURE Pan(X,Y: Word); Assembler;
ASM
mov bx, 320
mov ax, y
mul bx
add ax, x
push ax
pop bx
mov dx, InputStatus
@WaitDE:
in al,dx
test al,01h
jnz @WaitDE {display enable is active?}
mov dx, Crtadress
mov al, $0C
mov ah, bh
out dx, ax
mov al, $0D
mov ah, bl
out dx, ax
MOV dx, InputStatus
@wait:
in al,dx
test al,8 {?End Vertical Retrace?}
jz @wait
End;
Procedure VgaBase(Xscroll,Yscroll:integer; Var Slide: Word);
var dum:byte;
Begin
Dec(Slide, (Xscroll+320*Yscroll)); { slide scrolling state }
Port[$03d4]:=13; { LO register of VGAMEM offset }
Port[$03d5]:=(SLIDE shr 2) and $FF; { use 8 bits: [9..2] }
Port[$03d4]:=12; { HI register of VGAMEM offset }
Port[$03d5]:= SLIDE shr 10; { use 6 bits [16..10] }
Dum:=Port[$03DA]; { reset to input by dummy read }
Port[$03C0]:=$20 or $13; { smooth pan = register $13 }
Port[$03C0]:=(SLIDE and 3) Shl 1; { use bits [1..0], make it 0-2-4-6
}
End;
PROCEDURE SetAddress(ad:word); assembler;
ASM
mov dx,3d4h
mov al,0ch
mov ah,[byte(ad)+1]
out dx,ax
mov al,0dh
mov ah,[byte(ad)]
out dx,ax
End;
PROCEDURE SetLinecomp(ad:word); assembler;
ASM
mov dx,3d4h
mov al,18h
mov ah,[byte(ad)]
out dx,ax
mov al,7
out dx,al
inc dx
in al,dx
dec dx
mov ah,[byte(ad)+1]
and ah,00000001b
shl ah,4
and al,11101111b
or al,ah
mov ah,al
mov al,7
out dx,ax
mov al,9
out dx,al
inc dx
in al,dx
dec dx
mov ah,[byte(ad)+1]
and ah,00000010b
shl ah,5
and al,10111111b
or al,ah
mov ah,al
mov al,9
out dx,ax
End;
PROCEDURE Draw_Line( x, y, x2, y2: Word; Color: Byte; Page: word); Assembler;
asm
mov ax,[Page];
mov es,ax
mov bx,x
mov ax,y
mov cx,x2
mov si,y2
cmp ax,si
jbe @NO_SWAP {always draw downwards}
xchg bx,cx
xchg ax,si
@NO_SWAP:
sub si,ax {yd (pos)}
sub cx,bx {xd (+/-)}
cld {set up direction flag}
jns @H_ABS
neg cx {make x positive}
std
@H_ABS:
mov di,320
mul di
mov di,ax
add di,bx {di:adr}
or si,si
jnz @NOT_H
{horizontal line}
cld
mov al,color
inc cx
rep stosb
jmp @EXIT
@NOT_H:
or cx,cx
jnz @NOT_V
{vertical line}
cld
mov al,color
mov cx,si
inc cx
mov bx,320-1
@VLINE_LOOP:
stosb
add di,bx
loop @VLINE_LOOP
jmp @EXIT
@NOT_V:
cmp cx,si {which is greater distance?}
lahf {then store flags}
ja @H_IND
xchg cx,si {swap for redundant calcs}
@H_IND:
mov dx,si {inc2 (adjustment when decision var rolls over)}
sub dx,cx
shl dx,1
shl si,1 {inc1 (step for decision var)}
mov bx,si {decision var, tells when we need to go secondary direction}
sub bx,cx
inc cx
push bp {need another register to hold often-used constant}
mov bp,320
mov al,color
sahf {restore flags}
jb @DIAG_V
{mostly-horizontal diagonal line}
or bx,bx {set flags initially, set at end of loop for other iterations}
@LH:
stosb {plot and move x, doesn't affect flags}
jns @SH {decision var rollover in bx?}
add bx,si
loop @LH {doesn't affect flags}
jmp @X
@SH:
add di,bp
add bx,dx
loop @LH {doesn't affect flags}
jmp @X
@DIAG_V:
{mostly-vertical diagonal line}
or bx,bx {set flags initially, set at end of loop for other iterations}
@LV:
mov es:[di],al {plot, doesn't affect flags}
jns @SV {decision var rollover in bx?}
add di,bp {update y coord}
add bx,si
loop @LV {doesn't affect flags}
jmp @X
@SV:
scasb {sure this is superfluous but it's a quick way to inc/dec x coord!}
add di,bp {update y coord}
add bx,dx
loop @LV {doesn't affect flags}
@X:
pop bp
@EXIT:
end;
PROCEDURE Fade_Area(x, y, x2, y2: Word; Difference: Integer; Page: Word);
Var
Color: Byte;
ty,
tx : Word;
Begin
For ty := y to y2 Do
for tx := x to x2 Do
SetPix(tx, ty, GetPix(tx, ty, View_Page) + Difference, View_Page);
End;
BEGIN
END.
[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]