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