[Back to SCROLL SWAG index] [Back to Main SWAG index] [Original]
{
;
; Adapted from Programmer's Guide to PC & PS/2 Video Systems (1-55615-103-9)
;
; Routine written by Richard Wilton
;
;
; Name: ScreenOrigin
;
; Function: Set screen origin on EGA and VGA.
;
; Caller: Pascal:
;
; ScreenOrigin(x,y : integer);
;
; x,y (* pixel x,y coordinates *)
;
; Pascal calling convention
ARGx EQU word ptr [bp+8] ; stack frame addressing
ARGy EQU word ptr [bp+6]
;
; C calling convention
;
; ARGx EQU word ptr [bp+4]
; ARGy EQU word ptr [bp+6]
CRT_MODE EQU 49h ; addresses in video BIOS data area
ADDR_6845 EQU 63h
POINTS EQU 85h
BIOS_FLAGS EQU 89h
DGROUP GROUP _DATA
_TEXT SEGMENT byte public 'CODE'
ASSUME cs:_TEXT,ds:DGROUP
PUBLIC ScreenOrigin
ScreenOrigin PROC far
push bp ; preserve caller registers
mov bp,sp
push si
push di
mov ax,40h
mov es,ax ; ES -> video BIOS data area
mov cl,es:[CRT_MODE]
mov ax,ARGx ; AX := pixel x-coordinate
mov bx,ARGy ; BX := pixel y-coordinate
cmp cl,7
ja L01 ; jump if graphics mode
je L02 ; jump if monochrome alpha
test byte ptr es:[BIOS_FLAGS],1
jnz L02 ; jump if VGA
jmp short L03
; setup for graphics modes (8 pixels per byte)
L01:
mov cx,8 ; CL := 8 (displayed pixels per byte)
; CH := 0
div cl ; AH := bit offset in byte
; AL := byte offset in pixel row
mov cl,ah ; CL := bit offset (for Horiz Pel Pan)
xor ah,ah
xchg ax,bx ; AX := Y
; BX := byte offset in pixel row
mul word ptr BytesPerRow
; AX := byte offset of start of row
jmp short L05
; setup for VGA alphanumeric modes and EGA monochrome alphanumeric mode
; (9 pixels per byte)
L02: ; routine for alpha modes
mov cx,9 ; CL := 9 (displayed pixels per byte)
; CH := 0
div cl ; AH := bit offset in byte
; AL := byte offset in pixel row
dec ah ; AH := -1, 0-7
jns L04 ; jump if bit offset 0-7
mov ah,8 ; AH := 8
jmp short L04
; setup for EGA color alphanumeric modes (8 pixels per byte)
L03:
mov cx,8 ; CL := 8 (displayed pixels per byte)
; CH := 0
div cl ; AH := bit offset in byte
; AL := byte offset in pixel row
L04:
mov cl,ah ; CL := value for Horiz Pel Pan reg
xor ah,ah
xchg ax,bx ; AX := y
; BX := byte offset in row
div byte ptr es:[POINTS] ; AL := character row
; AH := scan line in char matrix
xchg ah,ch ; AX := character row
; CH := scan line (value for Preset
; Row Scan register)
mul word ptr BytesPerRow ; AX := byte offset of char row
shr ax,1 ; AX := word offset of character row
L05:
call SetOrigin
pop di ; restore registers and exit
pop si
mov sp,bp
pop bp
ret 4
ScreenOrigin ENDP
SetOrigin PROC near ; Caller: AX = offset of character row
; BX = byte offset within row
; CH = Preset Row Scan value
; CL = Horizontal Pel Pan value
add bx,ax ; BX := buffer offset
mov dx,es:[ADDR_6845] ; CRTC I/O port (3B4h or 3D4h)
add dl,6 ; video status port (3BAh or 3DAh)
; update Start Address High and Low registers
L20:
in al,dx ; wait for start of vertical retrace
test al,8
jz L20
L21:
in al,dx ; wait for end of vertical retrace
test al,8
jnz L21
cli ; disable interrupts
sub dl,6 ; DX := 3B4h or 3D4h
mov ah,bh ; AH := value for Start Address High
mov al,0Ch ; AL := Start Address High reg number
out dx,ax ; update this register
mov ah,bl ; AH := value for Start Address Low
inc al ; AL := Start Address Low reg number
out dx,ax ; update this register
sti ; enable interrupts
add dl,6 ; DX := video status port
L22:
in al,dx ; wait for start of vertical retrace
test al,8
jz L22
cli ; disable interrupts
sub dl,6 ; DX := 3B4h or 3D4h
mov ah,ch ; AH := value for Preset Row Scan reg
mov al,8 ; AL := Preset Row Scan reg number
out dx,ax ; update this register
mov dl,0C0h ; DX := 3C0h (Attribute Controller
port)
mov al,13h OR 20h ; AL bit 0-4 := Horiz Pel Pan reg
number
; AL bit 5 := 1
out dx,al ; write Attribute Controller Address
reg
; (The Attribute Controller address
; flip-flop.)
mov al,cl ; AL := value for Horiz Pel Pan reg
out dx,al ; update this register
sti ; enable interrupts
ret
SetOrigin ENDP
_TEXT ENDS
_DATA SEGMENT word public 'DATA'
EXTRN BytesPerRow : word ; bytes per pixel row
_DATA ENDS
END
}
{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+,Y+}
{$M 65520,0,655360}
(****************************************************************************)
{ }
{ MODULE : SCROLL }
{ }
{ DESCRIPTION : Generic unit for perform smooth scrolling. }
{ }
{ AUTHOR : John M. Beck }
{ }
{ MODIFICATIONS: None }
{ }
{ HISTORY : 29-Dec-1993 Coded. }
{ }
(****************************************************************************)
unit scroll;
interface
const
charwidth = 8;
charheight = 14; { depends on adapter }
var
screenseg : word;
bytesperrow : word;
function getvideomode : byte;
procedure smoothscroll;
procedure gotoxy (x,y : byte);
procedure wherexy(var x,y : byte);
procedure cursoroff;
procedure setcursor(top,bot : byte);
procedure getcursor(var top,bot : byte);
procedure clearline(line : word);
procedure setvideomode(mode : byte);
procedure panscreen(x0,y0,x1,y1 : integer);
implementation
{$L SCRORG.OBJ}
{
;
; Name: ScreenOrigin
;
; Function: Set screen origin on EGA and VGA.
;
; Caller: Pascal:
;
; procedure ScreenOrigin(x,y : integer);
;
; x,y (* pixel x,y coordinates *)
;
}
procedure screenorigin(x,y : integer); external;
function getvideomode : byte; assembler;
asm
mov ax,0F00h
int 10h
end;
procedure cursoroff; assembler;
asm
mov cx,2000h
mov ah,1
int 10h
end;
procedure gotoxy(x,y : byte); assembler;
asm
mov ah,2
xor bx,bx
mov dl,x
dec dl
mov dh,y
dec dh
int 10h
end;
procedure wherexy(var x,y : byte); assembler;
asm
mov ax,0300h
xor bx,bx
int 10h
xchg dx,ax
les di,x
stosb
mov al,ah
les di,y
stosb
end;
procedure setvideomode(mode : byte); assembler;
asm
mov ah,00
mov al,mode
int 10h
end;
procedure setcursor(top,bot : byte); assembler;
asm
mov ax,0100h
mov ch,top
mov cl,bot
int 10h
end;
procedure getcursor(var top,bot : byte); assembler;
asm
mov ax,0300h
xor bx,bx
int 10h
xchg cx,ax
les di,bot
stosb
mov al,ah
les di,top
stosb
end;
procedure clearline(line : word); assembler;
asm
mov ax,screenseg { ; AX := screen segment }
mov es,ax { ; ES := AX }
mov ax,bytesperrow { ; AX := # chars per row * 2 }
push ax { ; preserve this value }
mov cx,line { ; CX := Line }
dec cx { ; CX-- (zero based) }
mul cx { ; AX := bytesperrow * 25 }
mov di,ax { ; ES:DI -> 25th line }
pop cx { ; CX := bytesperrow }
shr cx,1 { ; CX := CX / 2 (word moves) }
mov ax,1824 { ; AH := 7 (white on black) }
{ ; AL := 32 (space) }
rep stosw { ; clear line }
end;
procedure panscreen(x0,y0,x1,y1 : integer);
{
Routine originally in Microsoft C by Richard Wilton
}
var
i,j : integer;
xinc,
yinc : integer;
begin
i := x0; j := y0;
if (x0 < x1) then
xinc := 1
else
xinc := -1;
if (y0 < y1) then
yinc := 1
else
yinc := -1;
while (i <> x1) or (j <> y1) do
begin
if i <> x1 then inc(i,xinc);
if j <> y1 then inc(j,yinc);
screenorigin(i,j);
end;
end;
procedure smoothscroll;
{
Smooth scrolls one line up and puts cursor on bottom line.
}
var
top,bot : byte;
begin
clearline(26); { blank 26th line }
panscreen(0,0,0,charheight); { smooth scroll one line down }
screenorigin(0,0); { restore screen origin }
asm
push ds { ; preserve data segment }
mov ax,screenseg { ; AX := 0B000h or 0B800 }
mov ds,ax { ; DS := screen segment }
mov si,160 { ; SI := offset of (0,1) }
{ ; DS:SI -> (0,1) of video buffer }
mov es,ax { ; ES := screen segment }
xor di,di { ; DI := offset of (0,0) }
mov cx,1920 { ; CX := bytesperrow * 24 / 2 }
rep movsw { ; move screen one line up }
pop ds { ; restore data segment }
end;
getcursor(top,bot); { save cursor settings }
clearline(25); { blank new bottom line }
gotoxy(1,25); { goto last line }
end;
begin
if getvideomode = 7 then
screenseg := $B000
else
screenseg := $B800;
bytesperrow := 80*2; { 80 bytes for text and attributes }
end.
{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+,Y+}
{$M 65520,0,655360}
(****************************************************************************)
{ }
{ PROGRAM : PANTEST }
{ }
{ DESCRIPTION : Tests the scroll unit. }
{ }
{ AUTHOR : John M. Beck }
{ }
{ MODIFICATIONS: None }
{ }
{ HISTORY : 29-Dec-1993 Coded. }
{ }
(****************************************************************************)
program pantest;
uses crt, scroll;
var
count : byte;
begin
clrscr;
gotoxy(1,1);
textattr := (black shl 4) or lightgray;
for count := 1 to 24 do writeln('Hello ',count);
write('Press any key to smooth scroll up one line ... ');
readkey;
smoothscroll;
write('Press any key to pan demonstration ... ');
readkey;
clrscr;
gotoxy(65,25);
textattr := (black shl 4) or lightgreen;
write('... Groovy ...');
panscreen(0,0,65 * charwidth,25 * charheight);
panscreen(65 * charwidth,25 * charheight,0,0);
gotoxy(1,25);
textattr := (black shl 4) or lightblue;
write('Any key to exit ... ');
readkey;
end.
[Back to SCROLL SWAG index] [Back to Main SWAG index] [Original]