[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    unit gru; { GRaphic Unit. }
    {$g+}

    INTERFACE

    type
      palrec=record
               r,g,b:byte;
             end;
      paltype=array[0..255]of palrec;
      palptr=^paltype;
    const
      vidseg:word=$a000;

    procedure plot(const x,y:word;const c:byte);
    procedure plot2(const x,y,where:word;const c:byte);
    procedure setmode(const mode:word);
    procedure flip386(const a,b:word);
    procedure clear386(const where:word;const c:byte);
    procedure flip286(const a,b:word);
    procedure clear286(const where:word;const c:byte);
    procedure flip(const a,b:word);
    procedure clear(const where:word;const c:byte);
    procedure vret;
    procedure hline(const x1,x2,y:word;const c:byte);
    procedure hline2(const x1,x2,y,where:word;const c:byte);
    procedure vline(const x,y1,y2:word;const c:byte);
    procedure vline2(const x,y1,y2,where:word;const c:byte);
    procedure line(const x1,y1,x2,y2:word;const c:byte);
    procedure line2(const x1,y1,x2,y2,where:word;const c:byte);
    function  getpix(const x,y:word):byte;
    function  getpix2(const x,y,where:word):byte;
    function  rad(theta:real):real;
    procedure setpal(c,r,g,b:byte);
    procedure getvgapal(var pal:paltype);
    procedure setvgapal(var pal:paltype);
    procedure smooth(where:word);
    procedure smooth1(x,y,where:word);
    procedure smooth2(where,size:word);
    procedure drawsprite(const x,y,where:word;const w,h,c:byte;var sprite);
    procedure fadefrompaltopal(oldpal,newpal:paltype);
    procedure ffblack(palin:paltype);
    procedure f2black(palin:paltype);
    procedure scanlines(numl:word);
    procedure combine(const in1,in2,out,eline:word);

    var
      clipon:boolean;
      cx1,cx2,cy1,cy2:word;

    IMPLEMENTATION

    var
      scrofs:array[0..199]of word; { Holding screen offsets. }
      blackp:paltype;
      whitep:paltype;
      tempal:paltype;

    procedure plot(const x,y:word;const c:byte); assembler;
    asm
      cmp clipon,0
      je @@sc
      mov ax,[x]
      cmp ax,cx1
      jb @@exit
      cmp ax,cx2
      ja @@exit
      mov ax,[y]
      cmp ax,cy1
      jb @@exit
      cmp ax,cy2
      ja @@exit
      @@sc: { SkipCheck :-) }
      mov es,sega000
      mov bx,[y]
      shl bx,1
      mov di,word ptr[scrofs+bx]
      add di,[x]
      mov al,[c]
      mov es:[di],al
    @@exit:
    end;

    procedure plot2(const x,y,where:word;const c:byte); assembler;
    asm
      cmp clipon,0
      je @@sc
      mov ax,[x]
      cmp ax,cx1
      jb @@exit
      cmp ax,cx2
      ja @@exit
      mov ax,[y]
      cmp ax,cy1
      jb @@exit
      cmp ax,cy2
      ja @@exit
      @@sc: { SkipCheck :-) }
      mov ax,where
      mov es,ax
      mov bx,[y]
      shl bx,1
      mov di,word ptr[scrofs+bx]
      add di,[x]
      mov al,[c]
      mov es:[di],al
    @@exit:
    end;

    procedure setmode(const mode:word);assembler;
    asm
      mov ax,mode
      int 10h
    end;

    procedure flip386(const a,b:word); assembler;
    asm
      push ds
      mov ds,a
      mov es,b
      xor si,si
      xor di,di
      mov cx,16000
      db 66h; rep movsw
      pop ds
    end;

    procedure clear386(const where:word;const c:byte); assembler;
    asm
      mov es,where
      xor ax,ax
      xor di,di
      mov al,[c]
      mov ah,al
      db 66h; shr ax,16
      mov al,[c]
      mov ah,al
      mov cx,16000
      db 66h; rep stosw
    end;

    procedure flip286(const a,b:word); assembler;
    asm
      push ds
      mov ds,a
      mov es,b
      xor si,si
      xor di,di
      mov cx,32000
      rep movsw
      pop ds
    end;

    procedure clear286(const where:word;const c:byte); assembler;
    asm
      mov es,where
      xor ax,ax
      xor di,di
      mov al,[c]
      mov ah,al
      mov cx,32000
      rep stosw
    end;

    procedure flip(const a,b:word); assembler;
    asm
      push ds
      mov ds,a
      mov es,b
      xor si,si
      xor di,di
      mov cx,64000
      rep movsb
      pop ds
    end;

    procedure clear(const where:word;const c:byte); assembler;
    asm
      mov es,where
      xor ax,ax
      xor di,di
      mov al,[c]
      mov cx,64000
      rep stosb
    end;

    procedure vret; assembler;
    asm
            mov dx,3dah;
    @vert1: in al,dx
            test al,8
            jz @vert1
    @vert2: in al,dx
            test al,8
            jnz @vert2
    end;

    procedure hline(const x1,x2,y:word;const c:byte); assembler;
    asm
      cld
      mov es,sega000
      mov ax,[x1]
      mov cx,[x2]
      sub cx,ax
      mov di,[y]
      mov bx,di
      shl di,8
      shl bx,6
      add di,bx
      add di,ax
      mov al,[c]
      mov ah,al
      shr cx,1
      rep stosw
      adc cx,cx
      rep stosb
    end;

    procedure hline2(const x1,x2,y,where:word;const c:byte); assembler;
    asm
      cld
      mov ax,where
      mov es,ax
      mov ax,[x1]
      mov cx,[x2]
      sub cx,ax
      mov di,[y]
      mov bx,di
      shl di,8
      shl bx,6
      add di,bx
      add di,ax
      mov al,[c]
      mov ah,al
      shr cx,1
      rep stosw
      adc cx,cx
      rep stosb
    end;

    procedure vline(const x,y1,y2:word;const c:byte);assembler;
    asm
      mov es,sega000
      mov ax,[y1]
      mov bx,ax
      shl ax,8
      shl bx,6
      add ax,bx
      mov di,ax
      mov ax,[y2]
      mov bx,ax
      shl ax,8
      shl bx,6
      add bx,ax
      mov al,[c]
      mov cx,[x]
      add di,cx
      add bx,cx

      @@loop1:
        mov es:[di],al
        add di,320
        cmp di,bx
        jne @@loop1
    end;

    procedure vline2(const x,y1,y2,where:word;const c:byte);assembler;
    asm
      mov ax,where
      mov es,ax
      mov ax,[y1]
      mov bx,ax
      shl ax,8
      shl bx,6
      add ax,bx
      mov di,ax
      mov ax,[y2]
      mov bx,ax
      shl ax,8
      shl bx,6
      add bx,ax
      mov al,[c]
      mov cx,[x]
      add di,cx
      add bx,cx

      @@loop1:
        mov es:[di],al
        add di,320
        cmp di,bx
        jne @@loop1
    end;

    procedure line(const x1,y1,x2,y2:word;const c:byte);assembler;
    var
      dex,dey,incf:Integer;
      offset:word;
    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,$a000
      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,$a000
      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;

    procedure line2(const x1,y1,x2,y2,where:word;const c:byte);assembler;
    var
      dex,dey,incf:Integer;
      offset:word;
    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;

    function getpix(const x,y:word):byte; assembler;
    asm
      cmp clipon,0
      je @@sc
      mov ax,[x]
      cmp ax,cx1
      jb @@exit
      cmp ax,cx2
      ja @@exit
      mov ax,[y]
      cmp ax,cy1
      jb @@exit
      cmp ax,cy2
      ja @@exit
      @@sc: { SkipCheck :-) }
      mov es,sega000
      mov bx,[y]
      shl bx,1
      mov di,word ptr[scrofs+bx]
      add di,[x]
      mov al,es:[di]
    @@exit:
    end;

    function getpix2(const x,y,where:word):byte; assembler;
    asm
      cmp clipon,0
      je @@sc
      mov ax,[x]
      cmp ax,cx1
      jb @@exit
      cmp ax,cx2
      ja @@exit
      mov ax,[y]
      cmp ax,cy1
      jb @@exit
      cmp ax,cy2
      ja @@exit
      @@sc: { SkipCheck :-) }
      mov ax,where
      mov es,ax
      mov bx,[y]
      shl bx,1
      mov di,word ptr[scrofs+bx]
      add di,[x]
      mov al,es:[di]
    @@exit:
    end;

    function rad(theta:real):real;
    begin
      rad:=theta*pi/180;
    end;

    procedure setpal(c,r,g,b:byte); assembler;
    asm
      mov dx,3c8h
      mov al,[c]
      out dx,al
      inc dx
      mov al,[r]
      out dx,al
      mov al,[g]
      out dx,al
      mov al,[b]
      out dx,al
    end;

    procedure getvgapal(var pal:paltype); assembler;
    asm
      push ds
      xor ax,ax
      mov cx,0300h
      les di,pal
      mov dx,03c7h
      out dx,al
      inc dx
      inc dx
      cld
      rep insb
      pop ds
    end;

    procedure setvgapal(var pal:paltype); assembler;
    asm
      push ds
      xor ax,ax
      mov cx,0300h/2
      lds si,pal
      mov dx,03c8h
      out dx,al
      inc dx
      mov bx,dx
      cld
      mov dx,03dah
      @vsync0:
        in al,dx
        test al,8
      jz @vsync0
      mov dx,bx
      rep outsb
      mov bx,dx
      mov dx,03dah
      @vsync1:
        in al,dx
        test al,8
      jz @vsync1
      mov dx,bx
      mov cx,0300h/2
      rep outsb
      pop ds
    end;

    procedure smooth(where:word); assembler;
    asm
      mov ax,where
      mov es,ax
      xor di,di
      mov cx,64000-320
      xor bh,bh
      @@loop:
        xor ax,ax
        mov al,es:[di]
        mov bl,es:[di+320] ;add ax,bx
        mov bl,es:[di+1]   ;add ax,bx
        mov bl,es:[di+321] ;add ax,bx
        shr ax,2
        mov es:[di],al
        inc di
        loop @@loop
    end;

    procedure smooth1(x,y,where:word); assembler;
    asm
      mov ax,where
      mov es,ax
      mov di,[y]
      mov bx,di
      shl di,8
      shl bx,6
      add di,bx
      add di,[x]
      xor bh,bh
      xor ax,ax
      mov al,es:[di]
      mov bl,es:[di+320] ;add ax,bx
      mov bl,es:[di+1]   ;add ax,bx
      mov bl,es:[di+321] ;add ax,bx
      shr ax,2
      mov es:[di],al
    end;

    procedure smooth2(where,size:word); assembler;
    asm
      mov ax,where
      mov es,ax
      xor di,di
      mov cx,size
      xor bh,bh
      @@loop:
        xor ax,ax
        mov al,es:[di]
        mov bl,es:[di+320] ;add ax,bx
        mov bl,es:[di+1]   ;add ax,bx
        mov bl,es:[di+321] ;add ax,bx
        shr ax,2
        mov es:[di],al
        inc di
        loop @@loop
    end;

    procedure drawsprite(const x,y,where:word;const w,h,c:byte;var sprite); assembler;
    asm
      push ds
      lds si,[sprite]
      mov ax,where
      mov es,ax
      cld
      mov ax,[y]
      shl ax,6
      mov di,ax
      shl ax,2
      add di,ax
      add di,[x]
      mov bh,[h]
      mov cx,320
      sub cl,[w]
      sbb ch,0
     @l:
      mov bl,[w]
     @l2:
      lodsb
      cmp al,[c]
      je @s
      mov dl,[es:di]
      add dl,al
      mov es:[di],dl
     @s:
      inc di
      dec bl
      jnz @l2
      add di,cx
      dec bh
      jnz @l
      pop ds
    end;

    procedure fadefrompaltopal(oldpal,newpal:paltype);
    var
      dac,c:word;
    begin
      for c:=32 downto 0 do
      begin
        for dac:=0 to 255 do
        begin
          tempal[dac].r:=((oldpal[dac].r*c)div 32)+((newpal[dac].r*(32-c))div 32);
          tempal[dac].g:=((oldpal[dac].g*c)div 32)+((newpal[dac].g*(32-c))div 32);
          tempal[dac].b:=((oldpal[dac].b*c)div 32)+((newpal[dac].b*(32-c))div 32);
        end;
        setvgapal(tempal);
      end;
    end;

    procedure ffblack(palin:paltype);
    var dac,i:word;
    begin
      for i:=0 to 32 do
      begin
        for dac:=0 to 255 do
        begin
          tempal[dac].r:=(palin[dac].r*i)div 32;
          tempal[dac].g:=(palin[dac].g*i)div 32;
          tempal[dac].b:=(palin[dac].b*i)div 32;
        end;
        setvgapal(tempal);
      end;
    end;

    procedure f2black(palin:paltype);
    var
      dac,i:word;
    begin
      for i:=32 downto 0 do
      begin
        for dac:=0 to 255 do
        begin
          tempal[dac].r:=(palin[dac].r*i)div 32;
          tempal[dac].g:=(palin[dac].g*i)div 32;
          tempal[dac].b:=(palin[dac].b*i)div 32;
        end;
        setvgapal(tempal);
      end;
    end;

    procedure scanlines(numl:word); assembler;
    asm
      mov dx, 3d4h
      mov al, 9
      out dx, al
      inc dx
      in al, dx
      and al, 0E0h
      add ax, numl
      out dx, al
    end;

    procedure combine(const in1,in2,out,eline:word); assembler;
    asm
      push ds
      mov ax,out; mov es,ax; xor di,di
      cld
      mov cx,[eline]
      mov bx,cx
      shl cx,8
      shl bx,6
      add cx,bx
      mov bx,cx
      shr cx,2
      mov ax,in1; mov ds,ax; xor si,si
      db 66h; rep movsw; adc cx,cx; rep movsw
      mov ax,in2; mov ds,ax; mov si,bx
      mov cx,64000
      sub cx,bx
      shr cx,2
      db 66h; rep movsw; adc cx,cx; rep movsw
      pop ds
    end;

    var
      count:word;

    begin
      clipon:=false;
      cx1:=0; cx2:=319; cy1:=0; cy2:=199;
      for count:=0 to 199 do scrofs[count]:=count*320; { Set up the offsets. }
      for count:=0 to 255 do
      begin
        blackp[count].r:=0;
        blackp[count].g:=0;
        blackp[count].b:=0;
        whitep[count].r:=63;
        whitep[count].g:=63;
        whitep[count].b:=63;
      end;
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]