Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- cpu 386
- org 100h
- _BDACurMode equ 0x449
- _FontSeg equ 0xF000
- _FontOff equ 0xFA6E
- _LineSz equ (640/8)
- _AttReg equ 3C0h
- _SeqReg equ 3C4h
- __SeqPlaneMask equ 02h
- _SeqPal equ 3C8h
- _GfxReg equ 3CEh
- __GfxLogicOp equ 03h
- __GfxMode equ 05h
- __GfxMem equ 06h
- __GfxBitMask equ 08h
- _StatReg equ 3DAh
- ; --- [wFlags] ---
- _bUseMouse equ 1
- _bNeedUpdate equ 2
- %macro If8 1+
- %1
- %endmacro
- %macro If16 1+
- ;%1
- %endmacro
- %macro If1632 1+
- ;%1
- %endmacro
- %macro If32 1+
- ;%1
- %endmacro
- %define SetFlag(_flag_) or byte [wFlags], (_flag_)
- %define TestFlag(_flag_) test byte [wFlags], (_flag_)
- %define ResetFlag(_flag_) and byte [wFlags], (~(_flag_))
- section .text
- Start:
- call InitApp
- call InitPalette
- call LinearMode
- mov dx, sBmpFile
- .ReloadBitmap:
- call LoadBitmap
- SetFlag(_bNeedUpdate)
- .MainLoop:
- TestFlag(_bNeedUpdate)
- jz .NoPalUpdate
- xor si,si
- xor cx, cx
- call CalculatePaletteConversion
- .NoPalUpdate:
- call Blit256to16x2
- mov si, sMessage+5
- mov ax, [iShowFPS]
- call IntToStr
- mov byte [si], 0
- mov si, sMessage
- xor di, di
- call DrawText
- mov al, [iCurPage]
- mov ah, 05h
- int 10h
- inc word [iCountFPS]
- mov ah, 02h
- int 1Ah
- cmp [iSecondsBCD], dh
- je .SkipAdjust
- mov ax, [iCountFPS]
- mov [iShowFPS], ax
- mov word [iCountFPS], 0
- mov [iSecondsBCD], dh
- .SkipAdjust:
- ;mov ax, 0C07h ;clear keyboard / wait for key
- ResetFlag(_bNeedUpdate) ; non zero when it's to update
- ;---------- Checking Keyboard ----------
- .NextKey:
- mov ah,0Bh
- int 21h
- test al, al
- jz .NoMoreKeys
- mov ah,07
- int 21h
- test al, al
- jnz .GotNormalKey
- mov ah,07
- int 21h
- .GotExtendedKey:
- jmp .NextKey
- .GotNormalKey:
- cmp al, 27
- je .Done
- cmp al, 'A'
- jb .NotUpper
- cmp al, 'Z'
- ja .NotUpper
- mov [sBmpLoad+7],al
- mov dx, sBmpLoad
- jmp .ReloadBitmap
- .NotUpper:
- cmp al, 'a'
- jb .NotLower
- cmp al, 'z'
- ja .NotLower
- mov [sBmpLoad+7],al
- mov dx, sBmpLoad
- jmp .ReloadBitmap
- .NotLower:
- jmp .NextKey
- .NoMoreKeys:
- ;----------- Checking Mouse ----------
- TestFlag(_bUseMouse)
- jz .NoMouseEvents
- mov ax, 3
- int 33h
- test bl, 1
- jz .NoMouseEvents
- cmp [iMouseX], cx
- jne .MouseMoved
- cmp [iMouseY], dx
- je .NoMouseEvents
- .MouseMoved:
- SetFlag(_bNeedUpdate)
- mov [iMouseX], cx
- mov [iMouseY], dx
- cmp dx, 10
- mov ax, 63
- jl .SetBrightness
- shl dx, 7
- mov ax, dx
- xor dx, dx
- .InLimitY:
- div word [iMaxY]
- .SetBrightness:
- mov dx, 640
- sub dx, cx
- shr dx, 5
- add dx, 4
- cmp ax, dx
- jg .BrightInLimit
- mov ax, dx
- .BrightInLimit:
- mov [iBrightness], ax
- cmp cx,10
- mov ax, -1
- jl .SetContrast
- mov bx, cx
- and bx, (~1)
- mov ax,[ContrastTab+bx]
- test cx, 1
- jz .NoOddContrast
- add ax,[ContrastTab+bx+2]
- shr ax, 1
- .NoOddContrast:
- .SetContrast:
- mov [iContrast], ax
- .NoMouseEvents:
- TestFlag(_bNeedUpdate)
- ;jnz .MainLoop
- ;call ScreenSync
- jmp .MainLoop
- jmp .NextKey
- .Done:
- pop ax ;return previous mode
- int 10h
- pop ax
- mov sp,ax
- add sp, 2
- push 0
- ret ;done
- ; -------------------------------------------------------------------------------------------------
- ; -------------------------------------------------------------------------------------------------
- ; -------------------------------------------------------------------------------------------------
- InitApp:
- mov ah,0Fh ;get current mode
- int 10h
- xor ah,ah
- cli
- pop cx
- mov dx, sp
- mov sp, EndStack
- push dx
- push ax
- push cx
- sti
- mov al,10h ;gfx mode (640x350x16)
- int 10h
- ;push ds
- ;mov ds, [EgaRgb] ;0000:xxxx
- ;mov byte [_BDACurMode], 0x13 ; Current Video Mode = 0x13 (hack)
- ;pop ds
- push bp
- push es
- mov ax, 1130h
- mov bh, 3h ;8x8 font
- int 10h
- mov ax, es
- mov [cs:pFontSeg], ax
- mov [cs:iFontOff], bp
- pop es
- pop bp
- ;mov ax, 0C0Bh ;clear keyboard '(07 would be to wait)
- ;int 21h
- mov ax, ds
- mov dx, Buffer
- shr dx, 4
- add ax, dx
- mov [pBuffSeg], ax
- xor ax, ax
- int 33h
- test ax,ax
- jz .NoMouse
- SetFlag(_bUseMouse)
- mov ax,8 ;**
- mov CX,0 ;** Mouse Min/Max
- mov DX,349 ;** 0 to 349
- int 33h ;**
- ;mov ax,1 ; Show Cursor
- ;int 33h ;
- .NoMouse:
- ret
- ; -------------------------------------------------------------------------------------------------
- ScreenSync:
- push ax
- push dx
- mov dx, 0x3DA
- .vBlank:
- in al, dx
- test al, 8
- jz .vBlank
- .vSync:
- in al, dx
- test al, 8
- jnz .vSync
- pop dx
- pop ax
- ret
- ; -------------------------------------------------------------------------------------------------
- InitPalette:
- pusha
- ;mov dx, _SeqReg
- ;mov ax, __SeqPlaneMask+0x0F00
- ;out dx, ax
- ;mov dx, _GfxReg
- ;mov ax, 0x0001
- ;out dx, ax
- ;mov ax, 0x0002
- ;out dx, ax
- ;mov ax, 0x0003
- ;out dx, ax
- ;mov ax, 0xFF08
- ;out dx, ax
- ;mov ax, 0x0F07
- ;out dx, ax
- ;mov ax, 0x0005
- ;out dx, ax
- mov bx, _AttReg
- mov dx, _StatReg ; reading from this register
- in al, dx ; Attribute in index mode
- mov si, EgaPal ; ega Pal array (out of 64 colors)
- xchg bx, dx ; attribute Register att,color,att,color,...
- xor ax,ax ; counter 0 to 15
- .NextAtt:
- out dx, al ; write Attribute #
- out dx, al
- ;outsb ; write next color from DS:SI
- add ax, 0x1001 ; point to next att (also add 16 to high byte)
- jnc .NextAtt ; when high byte overflows it's done (16/256)
- mov al, 0x20 ;
- out dx, al ; PAS = 1 (for normal operation)
- xchg bx, dx ; status register
- in al, dx ; Attribute in index mode
- popa
- ret
- ; -------------------------------------------------------------------------------------------------
- ; -------------------------------------------------------------------------------------------------
- LinearMode:
- pusha
- mov dx, _GfxReg
- mov al, __GfxMode
- out dx, al
- inc dx
- in al, dx
- and al, (~3) ;Write Mode 0
- or al, 64 ;CHAIN-4 ON :]
- out dx, al
- mov si, EgaRgb
- mov dx, _SeqPal
- xor al, al
- out dx, al
- inc dx
- mov cx, (16*3)
- .NextPAL:
- lodsb
- shr al, 2
- out dx, al
- loop .NextPAL
- sub si, (16*3)
- mov cl, 0x10
- xor bx, bx
- xor ax, ax
- .NextColor:
- mov bl, cl
- and bl, 15
- mov di, bx
- shl di, 1
- lea si, [bx+di+EgaRgb]
- mov bl, cl
- shr bl, 4
- mov di, bx
- shl di, 1
- lea di, [bx+di+EgaRgb]
- mov al, [si]
- mov bl, [di]
- add ax, bx
- shr ax, 3
- out dx, al ;R
- mov al, [si+1]
- mov bl, [di+1]
- add ax, bx
- shr ax, 3
- out dx, al ;G
- mov al, [si+2]
- mov bl, [di+2]
- add ax, bx
- shr ax, 3
- out dx, al ;B
- inc cl
- jnz .NextColor
- popa
- ret
- ; -------------------------------------------------------------------------------------------------
- DrawText: ; SS:SI = zstring, VidSeg:DI = target
- pusha
- push ds
- push es
- mov ax,[iCurPage]
- mov cx,[iFontOff]
- mov bp, si
- shl ax, 15
- mov es, [pVideoSeg]
- add di, ax
- mov ds, [pFontSeg]
- mov dx, _SeqReg ; Select plane (0-3)
- mov al, __SeqPlaneMask ; will be used from now on
- out dx, al ; to write pixel per pixel
- inc dx
- .NextChar:
- xor bx, bx
- add bl, [bp]
- mov si, cx
- jz .EndString
- shl bx, 3
- add si, bx
- mov bx, 0x08FF
- .NextLine:
- mov al, 0xFF
- out dx, al
- mov word [es:di+_LineSz*0],0
- mov word [es:di+_LineSz*1],0
- mov ah,[si]
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- shr ah, 1
- adc al, al
- out dx, al
- mov [es:di+_LineSz*0+0],bl
- shr al, 4
- mov [es:di+_LineSz*1+0],bl
- out dx, al
- mov [es:di+_LineSz*0+1],bl
- inc si
- mov [es:di+_LineSz*1+1],bl
- add di, (_LineSz*2)
- dec bh
- jnz .NextLine
- sub di, ((_LineSz*16)-2)
- inc bp
- jmp .NextChar
- .EndString:
- pop es
- pop ds
- popa
- ret
- ; -------------------------------------------------------------------------------------------------
- IntToStr: ;AX = number ; SS:SI target ; (SI updated on return)
- push ax
- push cx
- push dx
- inc si
- cmp ax, 10
- jb .WriteNum
- inc si
- cmp ax, 100
- jb .WriteNum
- inc si
- cmp ax, 1000
- jb .WriteNum
- inc si
- cmp ax, 10000
- jb .WriteNum
- inc si
- .WriteNum:
- mov cx, 10
- push si
- .NextDig:
- xor dx,dx
- dec si
- div cx
- add dl, '0'
- test ax,ax
- mov [ss:si], dl
- jnz .NextDig
- pop si
- pop dx
- pop cx
- pop ax
- ret
- ; -------------------------------------------------------------------------------------------------
- LoadBitmap: ;DS:DX = bitmap name
- pusha
- mov ax, 3D00h ;Open File for read
- int 21h
- jc .Done
- mov bx,ax
- mov ax,4200h ;Seek from start
- xor cx,cx
- mov dx,54 ;palette start?
- int 21h
- mov dx, pal256
- mov cx,1024
- mov ah,3Fh ;read palette
- int 21h
- mov ax, 0x3F3F
- mov si, 1024
- .Pal256to64:
- shr word [pal256+si], 2
- shr word [pal256+si+2], 2
- and word [pal256+si], ax
- and word [pal256+si+2], ax
- sub si, 4
- jns .Pal256to64
- push ds
- mov ds, [pBuffSeg]
- mov dx, 174*320
- mov cx, 320
- .NextLine:
- mov ah, 3Fh ;read a line
- int 21h
- sub dx, cx
- jnc .NextLine
- pop ds
- mov ah, 3Eh ;close file
- int 21h
- .Done:
- popa
- ret
- ; -------------------------------------------------------------------------------------------------
- %push
- CalculatePaletteConversion: ; SI = iStart ; CX = iCount
- %define %$CNT bp+0
- %define %$IR bp+1
- %define %$IG bp+2
- %define %$IB bp+3
- %define %$RD bp+4
- %define %$GD bp+5
- %define %$BD bp+6
- pusha ;-
- sub sp, 8 ;| Prologue
- mov bp, sp ;-
- mov ax, si ;-
- test ah,ah ;|
- jnz .EndSub ;| if cuint(iStart) > 255 then exit sub
- add ax, cx ;| if cuint(iStart+iCount) > 255 then exit sub
- test ah, ah ;|
- jnz .EndSub ;-
- mov [%$CNT], cl
- ; IIGGRRBBiiggrrbb
- mov di, si
- shl di, 6 ;di = iStart*16*2 (16 dither * 4 planes * 2 rows * 2 pixels) (bytes)
- shl si, 2 ;si = iStart*4 (RGBZ666 palette array)
- add di, ColorPat
- add si, pal256
- .StartEntry:
- mov cl, 85 ; CL = color step
- ;xor dh,dh ; -
- ;xor al,al ; |
- ;mov ah, [si+0] ; | AX = (pPal->R)*255
- ;mov dl, ah ; |
- ;sub ax, dx ; -
- ; ==== adjust brightness/contrast of RGB and get dither difference ====
- mov al, 255 ; AX = (pPal->R)*255
- mul byte [si+2] ;
- xor dx, dx ; AX /= iBrightness
- div word [iBrightness] ;
- cmp word [iContrast],0 ; if iContrast >= 0 then
- jle .NoContrastR ;
- mul ax ; AX = (AX*AX) / iContrast
- div word [iContrast] ;
- .NoContrastR: ;
- test ah,ah ; if AX > 255 then AX = 255
- jz .NoOverflowR ;
- mov ax,255 ;
- .NoOverflowR: ;
- mov ch, al ; RD = (AL mod &h85): IR = AL-RD
- div cl ;
- mov [%$RD], ah ;
- sub ch, ah ;
- mov [%$IR], ch ;
- mov al, 255 ; AX = (pPal->G)*255
- mul byte [si+1] ;
- xor dx, dx ; AX /= iBrightness
- div word [iBrightness] ;
- cmp word [iContrast],0 ; if iContrast >= 0 then
- jle .NoContrastG ;
- mul ax ; AX = (AX*AX) / iContrast
- div word [iContrast] ;
- .NoContrastG: ;
- test ah,ah ; if AX > 255 then AX = 255
- jz .NoOverflowG ;
- mov ax,255 ;
- .NoOverflowG: ;
- mov ch, al ; GD = (AL mod &h85): IG = AL-GD
- div cl ;
- mov [%$GD], ah ;
- sub ch, ah ;
- mov [%$IG], ch ;
- mov al, 255 ; AX = (pPal->B)*255
- mul byte [si+0] ;
- xor dx, dx ; AX /= iBrightness
- div word [iBrightness] ;
- cmp word [iContrast],0 ; if iContrast >= 0 then
- jle .NoContrastB ;
- mul ax ; AX = (AX*AX) / iContrast
- div word [iContrast] ;
- .NoContrastB: ;
- test ah,ah ; if AX > 255 then AX = 255
- jz .NoOverflowB ;
- mov ax,255 ;
- .NoOverflowB: ;
- mov ch, al ; BD = (AL mod &h85): IB = AL-BD
- div cl ;
- mov [%$BD], ah ;
- sub ch, ah ;
- mov [%$IB], ch ;
- ; ==== Dither Loops ====
- xor bx,bx ; Start Point of dither tab (iY = 0 to 63 step 2)
- xor cx,cx
- push si ; SI needed to access palette table
- .NextDither:
- mov dx, [bx+DitTab] ; Dither Pixels 0/1
- cmp dl, [%$RD] ; extra level on Red?
- sbb cl, cl ; cl = (RD>DitTab) and 85
- and cl, 85 ;
- add cl, [%$IR] ; R0 = IR+Dither
- shr cl, 2 ; N1 = RGBTab( R0 shr 6 , ... , ... )
- and cl, 0b110000 ;
- mov si, cx ;
- cmp dh, [%$GD] ; extra level on Green?
- sbb cl, cl ; cl = (GD>DitTab+1) and 85
- and cl, 85 ;
- add cl, [%$IG] ; G0 = IG+Dither
- shr cl, 4 ; N1 = RGBTab( ... , G1 shr 6 , ... )
- and cl, 0b001100 ;
- add si, cx ;
- cmp dl, [%$BD] ; extra level on Blue?
- sbb cl, cl ; cl = (BD>DitTab) and 85
- and cl, 85 ;
- add cl, [%$IB] ; B0 = IB+Dither
- shr cl, 6 ; N1 = RGBTab( ... , ... , B0 shr 6 )
- add si, cx ;
- mov al, [RGBTab+si] ; var N1 = RGBTab(R0 shr 6,G1 shr 6,B0 shr 6)
- ;mov [di],al ; tColorTab(IDX+0) = N1
- ;inc di ; 'IDX += 2'
- mov dx, [bx+DitTab+8] ; Dither Pixels 8/9
- cmp dl, [%$RD] ; extra level on Red?
- sbb cl, cl ; cl = (RD>DitTab) and 85
- and cl, 85 ;
- add cl, [%$IR] ; R2 = IR+Dither
- shr cl, 2 ; N3 = RGBTab( R2 shr 6 , ... , ... )
- and cl, 0b110000 ;
- mov si, cx ;
- cmp dh, [%$GD] ; extra level on Green?
- sbb cl, cl ; cl = (GD>DitTab+1) and 85
- and cl, 85 ;
- add cl, [%$IG] ; G3 = IG+Dither
- shr cl, 4 ; N3 = RGBTab( ... , G3 shr 6 , ... )
- and cl, 0b001100 ;
- add si, cx ;
- cmp dl, [%$BD] ; extra level on Blue?
- sbb cl, cl ; cl = (BD>DitTab) and 85
- and cl, 85 ;
- add cl, [%$IB] ; B2 = IB+Dither
- shr cl, 6 ; N3 = RGBTab( ... , ... , B2 shr 6 )
- add si, cx ;
- mov ah, [RGBTab+si] ; var N1 = RGBTab(R0 shr 6,G1 shr 6,B0 shr 6)
- ;mov [di], ah ; tColorTab(IDX+1) = N1
- ;inc di ; 'IDX += 1'
- mov [di], ax
- add di, 2
- add bl, 2 ; if ((iY+2) and 7)=0 then iY += 8
- test bl, 7 ; every row finished must skip another row
- jnz .NextDither ;
- add bl, 8 ;
- cmp bl, 63 ; 'next iY'
- jle .NextDither ; that only need to be checked each row
- dec byte [%$CNT] ; next entry
- pop si ; restore saved SI
- lea si, [si+4]
- jnz .StartEntry
- .EndSub:
- add sp, 8 ;-
- popa ;| Epilogue
- ret ;-
- %pop
- ; -------------------------------------------------------------------------------------------------
- %push
- Blit256to16x2:
- pusha
- push ds
- push es
- ;xor di, di ; es:di is the 640x350 planar screen
- xor bx, bx ; ds:bx is the source bitmap
- xor byte [iCurPage], 1
- mov di,[iCurPage]
- shl di, 15
- mov es, [pVideoSeg]
- mov ds, [pBuffSeg]
- mov dx, _GfxReg ;**
- mov al, __GfxMode ;**
- out dx, al ;**
- inc dx ;**
- in al,dx ;** Set EGA Mode X / Write 0
- and al, (~3) ;**
- or al, 64 ;**
- out dx, al ;**
- mov dx, _SeqReg ; Select plane (0-3)
- mov al, __SeqPlaneMask ; will be used from now on
- out dx, al ; to write pixel per pixel
- mov bp, ColorPat ; bp is used to access ColorPat on SS=CS
- mov word [cs:bPlane], 0x1001
- .NextPlane:
- push bp ; save dither X too
- push di ; save pointers to restart
- push bx ; src and target :)
- mov dx, (_SeqReg+1) ; Sequencer data (PlaneMask)
- mov cl,175 ; 175 input lines
- mov al, [cs:bPlane] ; Set New plane
- out dx,al ; on PlaneMask register (already selected)
- .NextRow:
- mov ch,20
- .NextBlk:
- movzx si, byte [bx+8] ; pixel 8 from 256 color source
- shl si,5 ; si = pIN[X] shl 5
- mov dx,[bp+si] ; pixels pattern for line 1/2 (dither column 0-1, row 0-1)
- If8 mov [es:di+2], dl ; - 8 bit (first unroll the write)
- movzx si, byte [bx+12] ; pixel 12 from 256 color source
- shl si,5 ; si = pIN[X] shl 5
- If8 mov [es:di+82], dh ; - 8 bit (first unroll the write)
- mov ax,[bp+si] ; pixels pattern for line 1/2 (dither column 0-1, row 0-1)
- If1632 xchg al, dh ; --- 16/32 bit (swap row/col order)
- If32 shl edx, 16 ; ---- 32 bit (just rotate to do single 32bit write)
- If32 shl eax, 16 ; ---- 32 bit (just rotate to do single 32bit write)
- If16 mov [es:di+2], dx ; -- 16 bit (first unroll the write)
- If8 mov [es:di+3], al ; - 8 bit (second unroll the write)
- movzx si, byte [bx+0] ; pixel 0 from 256 color source
- shl si,5 ; si = pIN[X] shl 5
- If16 mov [es:di+82], ax ; -- 16 bit (second unroll the write)
- If8 mov [es:di+83], ah ; - 8 bit (second unroll the write)
- mov dx,[bp+si] ; pixels pattern for line 1/2 (dither column 0-1, row 0-1)
- If8 mov [es:di+0], dl ; - 8 bit (third unroll the write)
- movzx si, byte [bx+4] ; pixel 4 from 256 color source
- shl si,5 ; si = pIN[X] shl 5
- If8 mov [es:di+80], dh ; - 8 bit (third unroll the write)
- mov ax,[bp+si] ; pixels pattern for line 1/2 (dither column 0-1, row 0-1)
- If1632 xchg al, dh ; --- 16/32 bit (swap row/col order)
- If32 mov [es:di], edx ; ---- 32 bit (write the final 32bit)
- If16 mov [es:di], dx ; -- 16 bit (write the last 16 bit unroll)
- If8 mov [es:di+1], al ; - 8 bit (last unroll the write)
- add bx, 16 ; end of unroll... 4 input pixels read
- add di, 4 ; and 4 output pixels (1 byte : 2 lines of a plane)
- dec ch ; next block (20 blocks = 80 pixels of 320 on 4 planes)
- If32 mov [es:di+80-4], eax ; ---- 32 bit (write the final 32bit)
- If16 mov [es:di+80-4], ax ; -- 16 bit (write the last 8 bit unroll)
- If8 mov [es:di+81-4], ah ; - 8 bit (last unroll the write)
- jnz .NextBlk ; continue until all blocks are done
- add bp, 8 ; end of a row so advance dither row...
- add di, 80 ; two output lines are done so skip one
- and bp, (~32) ; and mod the dither row 0-7. (&31 preservering >=128)
- dec cl ; there's more lines to read?
- jnz .NextRow ; keep going until all 175 is read
- pop bx ; Restore initial source
- pop di ; Restore initial target
- pop bp ; Restore current dither X
- inc bx ; Source on next plane
- add bp,2 ; Next Dither (2 pixels)
- shl word [cs:bPlane], 1 ; Next Plane / Counter
- jnc .NextPlane ; and go back until all 4 planes is done
- .EndSub:
- pop es
- pop ds
- TestFlag(_bUseMouse)
- jz .NoMouse
- ;mov ax,2
- ;int 33h
- ;mov ax,1Dh
- ;mov bx,[iCurPage]
- ;int 33h
- ;mov ax,1
- ;int 33h
- jmp .DoneFlip
- .NoMouse:
- .DoneFlip:
- popa
- ret
- %pop
- ; -------------------------------------------------------------------------------------------------
- ; -------------------------------------------------------------------------------------------------
- ; -------------------------------------------------------------------------------------------------
- section .data
- sBmpLoad: db "BMP\VGAA.BMP",0
- sBmpFile: db "vga.bmp",0
- sMessage: db "Fps: ",0
- wFlags: db 0
- iSecondsBCD: db -1
- bPlane db 0 ;Write on 4 planes of 16 colors
- align 4
- iShowFPS: dw 0
- iCountFPS: dw 0
- iCurPage: dw 0
- iMouseX: dw -1
- iMouseY: dw -1
- iMaxY: dw 349
- iBrightness: dw 63
- iContrast: dw -1
- pBuffSeg: dw 0
- pVideoSeg: dw 0xA000
- pFontSeg: dw _FontSeg
- iFontOff: dw _FontOff
- align 4
- EgaPal:
- db 00,08,01,09,32,33,41,04
- db 05,13,36,37,45,24,10,26
- DitTab: ;8x8 ordered dither mask (0-84)
- db 00,64,16,80,04,68,20,84
- db 43,21,59,37,47,25,63,41
- db 11,75,05,69,15,79,09,73
- db 53,32,48,27,57,36,52,31
- db 03,67,19,83,01,65,17,81
- db 45,24,61,40,44,23,60,39
- db 13,77,08,72,12,76,07,71
- db 56,35,51,29,55,33,49,28
- EgaRgb:
- db 000,000,000, 000,000,085
- db 000,000,170, 000,000,255
- db 085,000,000, 085,000,170
- db 085,000,255, 170,000,000
- db 170,000,170, 170,000,255
- db 255,000,000, 255,000,170
- db 255,000,255, 000,085,085
- db 000,170,085, 000,255,085
- RGBTab:
- db 000,001,002,003,208,208,210,211
- db 224,224,226,227,240,240,242,243
- db 004,020,005,006,212,212,213,214
- db 228,228,229,230,244,244,245,246
- db 007,023,008,009,215,215,216,217
- db 231,231,232,233,247,247,248,249
- db 010,026,011,012,218,218,219,220
- db 234,234,235,236,250,250,251,252
- ContrastTab:
- dw 11, 11, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 15, 15, 15
- dw 15, 15, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 19, 19, 19, 19, 20, 20, 20
- dw 21, 21, 21, 22, 22, 22, 23, 23, 23, 24, 24, 24, 25, 25, 26, 26, 26, 27, 27, 28
- dw 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 33, 34, 34, 35, 35, 36, 36, 37, 37
- dw 38, 38, 39, 40, 40, 41, 42, 42, 43, 43, 44, 45, 45, 46, 47, 48, 48, 49, 50, 51
- dw 51, 52, 53, 54, 55, 55, 56, 57, 58, 59, 60, 61, 62, 63, 63, 64, 65, 66, 67, 68
- dw 70, 71, 72, 73, 74, 75, 76, 77, 78, 80, 81, 82, 83, 85, 86, 87, 89, 90, 91, 93
- dw 94, 96, 97, 99, 100, 102, 103, 105, 106, 108, 110, 111, 113, 115, 116, 118, 120
- dw 122, 124, 126, 127, 129, 131, 133, 135, 138, 140, 142, 144, 146, 148, 151, 153
- dw 155, 158, 160, 162, 165, 167, 170, 173, 175, 178, 181, 183, 186, 189, 192, 195
- dw 198, 201, 204, 207, 210, 213, 217, 220, 223, 227, 230, 234, 237, 241, 245, 248
- dw 252, 256, 260, 264, 268, 272, 276, 280, 285, 289, 293, 298, 303, 307, 312, 317
- dw 321, 326, 331, 336, 342, 347, 352, 357, 363, 368, 374, 380, 386, 391, 397, 404
- dw 410, 416, 422, 429, 435, 442, 449, 456, 463, 470, 477, 484, 491, 499, 507, 514
- dw 522, 530, 538, 546, 555, 563, 572, 581, 590, 599, 608, 617, 626, 636, 646, 656
- dw 666, 676, 686, 697, 707, 718, 729, 740, 751, 763, 775, 786, 798, 811, 823, 836
- dw 848, 861, 874, 888, 901, 915, 929, 943, 958, 972, 987, 1002, 1018, 1033, 1049
- dw 1065, 1081, 1098, 1114, 1131, 1149, 1166, 1184, 1202, 1221, 1239, 1258, 1277
- dw 1297, 1317, 1337, 1357, 1378, 1399, 1420
- ;ColorPat: incbin "ColorTab.bin"
- ;ColorPat: times 16384 db 255
- section .bss
- alignb 64
- stack: resb 256 ;times 256 db 0
- EndStack:
- ColorPat: resb 8192 ;times 16384 db 0
- pal256: resb 1024 ;times 1024 db 0
- Buffer: resb 64000 ;times 64000 db 0
- EOF:
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement