home *** CD-ROM | disk | FTP | other *** search
- ; A_VGA.ASM -- graphics routines // A.R-M. 7/93
-
- IDEAL
- MODEL Compact, Pascal
- Radix 16
- P286
-
- FARDATA S_Finale
-
- EXTRN W_Finale : Byte
-
- DATASEG
-
- PUBLIC CurrentPage, CurrentBase
-
- PageOffsets DW 0, 16000d, 32000d, 48000d
- ; start offsets for pages 0,1,2,3
- ; (only need 0,1,2 for animation)
-
- CurrentBase DW 0
- CurrentPage DW 0
-
- CODESEG
-
- PUBLIC RasterOff ; disables raster
- PUBLIC RasterOn ; enables raster
- PUBLIC InitPageMode ; Init VGA 13h mode & tweak it for 4 planes
- PUBLIC SetActivePage ; (pageno:byte) Set CurrentPage value
- PUBLIC SetViewPage ; (pageno:byte) Set display start addr
-
- PUBLIC BlankPage ; Sets whole page to 0
-
- PUBLIC MapColumn ; (X,Y:Pointer; X0,X1,Y0,Y1:Word; Ofs:Word)
- ; Map X[X0..X1] onto Y[Y0..Y1,Ofs]
-
- PUBLIC FillColumn ; (Y:Pointer; Y0,Y1:Word; Ofs:Word; C:Byte)
- ; Fills Y[Y0..Y1,Ofs] with C
-
- PUBLIC PlotFullScreen ; (Y:Pointer; Y0,Y1,Ofs,X:Word) Plots stored screen image
-
- PUBLIC FilterColumn ; (Y:Pointer; Y0,Y1:Word; Ofs:Word; Filt:Byte)
- ; adds Filt to lower nibble of ea. byte in
- ; ScreenColumns[Y0..Y1,Ofs]
-
- PUBLIC DumpColumns ; (Columns:pointer;ScreenOffset,LoY,HiY,ColumnMask : Word)
- ; Dump ScreenColumns to screen
-
- ;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
-
- PUBLIC PonPaletaInicial
- PUBLIC PonPaletaFinal
-
- ; Las dos paletas
-
- PALETA_INICIAL:
- DB 0, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
- DB 30, 0, 0
-
- PALETA_FINAL:
- DB 0, 0, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
- DB 0, 30, 0
-
- MACRO PonPaleta nombre
- LOCAL @@1
-
- mov bl,0
- mov di, offset nombre
-
- mov cx, 16d
- @@1:
- mov dx, 3c8h
- mov al,bl
- out dx, al
- inc dx
- mov al, [cs:(di+0)]
- out dx,al
- mov al, [cs:(di+1)]
- out dx,al
- mov al, [cs:(di+2)]
- out dx,al
-
- add bl,16d
- add di,3
- loop @@1
- ENDM
-
-
- PROC PonPaletaInicial NEAR
- PonPaleta PALETA_INICIAL
- ret
- ENDP
-
-
- PROC PonPaletaFinal NEAR
- PonPaleta PALETA_FINAL
- ret
- ENDP
-
-
-
- ;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
-
- ; // RGB Palette (not worth wasting DS space for this)
-
- RGBPalette:
- RADIX 10
- INCLUDE "data\PALETTE.inc"
- RADIX 16
-
- ; // RasterOff
-
- PROC RasterOff NEAR
- USES ax, dx
-
- mov dx,3c4
- mov al,01
- out dx,al
- nop
- inc dx
- in al,dx
- or al,00100000b ; screen inhibit bit 5 on
- out dx,al
-
- dec dx
- mov al,2
- out dx,al ; always leave idx reg prg'd to 2!
- ret
- ENDP
-
-
- ; // RasterOn
-
- PROC RasterOn NEAR
- USES ax, dx
-
- mov dx,3c4
- mov al,01
- out dx,al
- nop
- inc dx
- in al,dx
- and al,11011111b ; screen inhibit bit 5 on
- out dx,al
-
- dec dx
- mov al,2
- out dx,al ; leave idx reg prg'd to 2
- ret
- ENDP
-
-
- ; // InitPageMode
-
- ; Kind'a copied this little routine from Wolfenstein 3D... you know? O:-)
-
- PROC InitPageMode NEAR
- P386
- USES eax, cx, dx, si
-
- ; Assumes VGA is already in standard 320x200x256 mode 13h
- ; (initialized by BIOS call AX=0013/INT 10) when called.
-
- mov dx, 3c4
- mov al, 4 ; Seq mem mode reg
- out dx, al
-
- mov dx, 3c5
- in al, dx
- and al, 11110111b
- mov dx, 3c5 ; <- extra ops like this one slow down
- out dx, al ; port writes, just to be on the
- ; safe side...
-
- mov dx, 3d4
- mov al, 14 ; UL reg
- out dx, al
-
- mov dx, 3d5
- in al, dx
- and al, 10111111b
- mov dx, 3d5
- out dx, al
-
- mov dx, 3d4
- mov al, 17 ; CRTC mode ctrl reg.
- out dx, al
- mov dx, 3d5
- in al, dx
- or al, 01000000b
- mov dx, 3d5
- out dx, al
-
- mov dx, 3c4
- mov al, 2
- out dx, al ; set index to map mask reg
-
- ; Load color palette
-
- push ds
- mov ax, seg RGBPalette
- mov ds, ax
- mov si, offset RGBPalette
-
- xor al, al
- mov dx, 3c8
- out dx, al
- inc dx
- mov cx, 300
- cld
- rep outsb
- pop ds
-
- ; / JCAB: si tocas algo por aquí, no te olvides de dejar el
- ;/ índice en 3c4 programado a 2 antes de salir!! :-)
-
- ret
- P286
- ENDP
-
-
- ; // SetActivePage
-
- PROC SetActivePage NEAR
- ARG pageNo : Byte
- USES ax, bx
-
- mov bl, [pageNo]
- xor bh,bh
- mov [CurrentPage], bx
- mov dl, bl
- shl bl,1
- xor bh,bh
- mov ax, [PageOffsets+bx]
- mov [CurrentBase], ax ; Update current base addr
-
- ret
- ENDP
-
-
- ; // SetViewPage
-
- PROC SetViewPage NEAR
- ARG pageNo : Byte
- USES ax, bx, dx
-
- ; wait for next end of VR
-
- mov dx, 3da
- @@waitVR:
- in al, dx
- test al,8
- jz @@waitVR ; wait till in VR
- @@whileVR:
- in al, dx
- test al,8
- jnz @@whileVR ; wait till end of VR
-
- mov bl, [pageNo]
- shl bl,1
- xor bh,bh
- mov bx, [PageOffsets+bx]
-
- mov dx, 3d4
- mov al, 0c
- mov ah, bh
- cli ; This should stop some of those sporadic screen hops...
- out dx, ax ; SEND HIGH BYTE
- mov al, 0dh ; whoops! "0d" means "0 decimal"!
- mov ah, bl
- out dx, ax ; SEND LOW BYTE
- sti
- ret
- ENDP
-
-
- ; // BlankPage
-
- PROC BlankPage NEAR
- P386
- USES es, eax, dx, ecx, edi
-
- mov dx, 3c5
- mov al, 0f
- out dx, al
-
- mov ax, 0a000
- mov es, ax
-
- movzx edi, [word ptr CurrentBase]
-
- mov ecx, 4000d
- xor eax,eax
- cld
- rep stosd
-
- ret
- P286
- ENDP
-
-
- ; // Map Column
-
- PROC MapColumn NEAR
- ARG X : FAR PTR BYTE, Y : FAR PTR BYTE, \
- X0:Word, X1:Word, Y0:Word, Y1:Word, \
- Ofs : Word
- pusha
- push ds
- push es
-
- les di, [Y]
- add di, [Ofs]
- mov ax, [Y0]
- shl ax,2
- add di,ax ; es:di -> destination
-
- lds si, [X]
- add si, [X0] ; ds:si -> source
-
- mov cx, [Y1]
- sub cx, [Y0] ; cx = Y1-Y0 = dY
- mov bx, [X1]
- sub bx, [X0] ; bx = X1-X0 = dX
- cmp cx, bx ; Compare dX w/ dY, and enter the proper...
- jb @@horizontal ; ...Bresenham algorithm (hor or ver line)
-
- ; ////// dX <= dY - "vertical line" //////
-
- @@vertical: ; use up some symbol space... hey, it's free! ;-)
-
- shl bx,1 ; bx = 2dX = increment for d<0
- mov dx, bx
- sub dx, cx ; dx = 2dX-dY = initial value for d
- mov bp, dx ; (running out of regs here...)
- sub bp, cx ; bp = 2dX-2dY = 2(dX-dY) = inc for d>=0
- ; cx = dY (from before) = no. of steps
-
- mov al, [ds:si] ; get value from X
- @@VerLoop:
- mov [es:di], al
- add di,4
- or dx, dx
- jns @@V1 ; jmp if d>=0 (last add dx,??? set SF)
-
- add dx, bx ; if d<0, update d...
- loop @@VerLoop ; ...and keep looping
- jmp @@V2
- @@V1: ; if d>=0, step X
- mov al, [ds:si]
- inc si
- add dx, bp ; increment d
- loop @@VerLoop
- @@V2:
- mov [es:di], al ; draw that last pixel!
- jmp @@leave
-
- ; ////// dX > dY - "horizontal line" //////
-
- @@horizontal:
- xchg bx, cx ; cx=dX & bx=dY now
- shl bx,1 ; bx = 2dY = increment for d<0
- mov dx, bx
- sub dx, cx ; dx = 2dY - dX = initial d
- mov bp, dx
- sub bp, cx ; bp = 2dY - 2dX = 2(dY-dX) = inc for d>=0
- ; cx = dX = no. pts.
- or dx,dx
-
- @@HorLoop:
- inc si ; inc source ptr
- or dx, dx
- jns @@H1
-
- add dx, bx ; d<0, update d & loop
- loop @@HorLoop
- jmp @@H2
- @@H1:
- mov al,[ds:si]
- mov [es:di], al ; copy src to destination
- add di,4
- add dx, bp
- loop @@HorLoop
- @@H2:
- mov [es:di], al ; copy the last pixel
-
- @@leave:
- pop es
- pop ds
- popa
- ret
- ENDP
-
-
- ; // Fill Column
-
- PROC FillColumn NEAR
- ARG Y : FAR PTR Byte, Y0:Word, Y1:Word, Ofs:Word, C:Byte
- pusha
- push ds
-
- lds di, [Y]
- add di, [Ofs]
- mov ax, [Y0]
- mov cx, ax
- shl ax,2
- add di, ax
- sub cx, [Y1]
- neg cx
- inc cx
-
- mov al, [C]
- @@fill:
- mov [ds:di], al
- add di,4
- loop @@fill
-
- pop ds
- popa
- ret
- ENDP
-
-
- ; // PlotFullScreen
-
- PROC PlotFullScreen NEAR
- ARG Y : FAR PTR Byte, Y0:Word, Y1:Word, Ofs:Word, X:Word
- pusha
- push ds
- push es
-
- lds di, [Y]
- add di, [Ofs]
- mov ax, [Y0]
- mov cx, ax
- shl ax,2
- add di, ax
- sub cx, [Y1]
- neg cx
- inc cx
-
- mov ax, seg w_Finale
- mov es,ax
- mov si, offset w_Finale
- mov ax, [Y0]
- mov bh,al
- xor bl,bl
- shl ax,6
- add ax, bx
-
- add ax,[X]
- ; add ax,320d
- ; sub ax,[X] ;*
- add si,ax
-
- @@copy:
- mov al,[es:si]
- add si,320d
- mov [ds:di], al
- add di,4
- loop @@copy
-
- pop es
- pop ds
- popa
- ret
- ENDP
-
-
- ; // Filter Column
-
- PROC FilterColumn NEAR
- ARG Y : FAR PTR Byte, Y0:Word, Y1:Word, Ofs:Word, Filt:Byte
- pusha
- push ds
-
- lds di, [Y]
- add di, [Ofs]
- mov ax, [Y0]
- mov cx, ax
- shl ax,2
- add di, ax
- sub cx, [Y1]
- neg cx
- inc cx
-
- mov dl, [Filt]
- @@FilterLoop:
- mov al, [di]
- mov bh, al ; al = bh = color byte
- and al, 00001111b ; lower nibble: lightness bits
- sub al, dl ; darken color
- jnle @@1 ; below black? (<=0 ?)
- mov al,1 ; if so then make lightness=0
- @@1: and bh,11110000b
- add al, bh ; put lightness nibble back in place
- mov [di],al ; save, & do next
- add di,4
- loop @@FilterLoop
-
- pop ds
- popa
- ret
- ENDP
-
-
- ; // DumpColumns
-
- ; ...as fast as you can, that is :-(
-
- PROC DumpColumns NEAR
- ARG Columns : FAR PTR Byte, \
- ScreenOffset : Word, Y0 : Word, Y1 : Word, \
- ColumnMask : Word
- pusha
- push ds
- push es
-
- mov dx, 3c5
- mov ax, [ColumnMask]
- out dx, al ; set mask
-
- mov ax, 0a000
- mov es, ax
- mov di, [CurrentBase]
- add di, [ScreenOffset] ; es:di -> screen start addr
-
- mov ax, [Y0]
- shl ax,4
- add di, ax
- shl ax,2
- add di, ax ; ax=ax+80*Y0
-
- lds si, [Columns] ; ds:si -> columns
- mov ax, [Y0]
- shl ax,2
- add si, ax ; +4*Y0
-
- mov ax, 199d
- add ax, [Y0]
- sub ax, [Y1] ; ax = 200-(Y1-Y0+1) = no.blocks to skip
- mov bx, ax ; bx = ax
- shl ax,1
- add bx, ax ; + 2*ax
- shl ax,2 ; + 8*ax
- add bx, ax ; bx = #blocks * 11 bytes/block
-
- add bx, offset ColumnEntryPoint ; bx = entry address
-
- jmp bx
-
- P386
-
- ; Copies by dwords. Actually, I think it doesn't make much of a
- ; difference (it's the VGA slowing us down, not the CPU), and, besides,
- ; dumping by bytes would leave my hands free to improve the renderer -?
-
- ColumnEntryPoint:
- ROW = 0
- REPT 200d
- HERE = $
- ROW = ROW + 1
- mov eax, [si+4*(200d-ROW)]
- mov [es:di+80d*(200d-ROW)], eax
- BLOCKSIZE = $-HERE
- IF BLOCKSIZE GT 11d
-
- Display "Block is > 11d bytes long!"
- ERR
- ENDIF
- REPT 11d-BLOCKSIZE ;; fill in so each block is
- cld ;; exactly 11d bytes long
- ENDM ;; (that's the worst-case size
- ENDM ;; of the 2 ops above)
- P286
- pop es
- pop ds
- popa
- ret
- ENDP
-
-
- END
-