[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]