'===========================================================================
' Subject: ASM FADER FIX                     Date: 11-21-92 (00:00:00)    
' Author:  Rich Geldreich                    Code: TASM, QB, PDS          
' Keys:    ASM,FADER,FIX                   Packet: GRAPHICS.ABC
'===========================================================================
;Noiseless VGA DAC fading routines for QB4.5/PDS(works on 286's and up)
;By Rich Geldreich 1992
;Assembled with TASM v2.0
.286
IDEAL
MODEL SMALL
DATASEG
Palette    db 768 dup (?)
NewPalette db 768 dup (?)
CODESEG
PUBLIC GetPalette, SetPalette
EVEN
PROC    SetPalette              ;Sets the pallette retrieved by 
                                ;GetPalette to a specified brightness
;DECLARE SUB SetPalette (BYVAL Brigtness, BYVAL Start, BYVAL Num)
Brightness EQU [ss:bp+10] ;0-128
Start      EQU [ss:bp+08] ;0-255
Num        EQU [ss:bp+06] ;1-256
Parameters = 3
        Push    bp              ;set us up a stack frame
        Mov     bp, sp
        Push    es ds si di     ;lets not get QB mad now
        Mov     ax, @data       ;get access to palette buffers
        Mov     ds, ax
        Mov     es, ax
        Xor     ax, ax
        Mov     al, Start       ;get start color
        Mov     dx, 03C7h       ;tell the VGA some DAC values will
        Out     dx, al          ;be coming
        Inc     dx
        Out     dx, al
        Inc     dx              ;dh=3
        Mov     si, ax          ;add start*3 to the palette offset
        Shl     si, 1
        Add     si, ax
        Add     si, offset Palette
        Mov     bl, Brightness  
        Cmp     bl, 128         ;limit brightness if too high
        Jna     @@Ok1
        Mov     bl, 128
@@Ok1:        
        Mov     cx, Num         ;CX=# of registers to change
        Jcxz    @@Done          ;if no registers to change then exit
        Add     ax, cx          ;calculate the last register to change
        Sub     ax, 256         ;if too many then limit
        Jna     @@OK2
        Sub     cx, ax
@@OK2:        
        Mov     di, offset NewPalette
        Mov     bp, cx          ;save cx for later
EVEN                            ;color precalculation loop
@@10:   REPT    3               ;repeat 3 times(for Red, Green, & Blue)
        Lodsb                   ;
        Mul     bl              ;new=old*brightness
        Shl     ax, 1           ;new=(new*2)\256 or new=new\128
        Mov     al, ah
        Stosb
        ENDM
        Loop    @@10
        Mov     cx, bp          ;multiply number of colors by 3
        Shl     cx, 1
        Add     cx, bp
        Mov     si, offset NewPalette
        Mov     dl, 0DAh        ;wait for vertical retrace
@@15:   In      al, dx          ;wait for end of vertical retrace
        Test    al, 8           ;(for very fast machines)
        Jnz     @@15
@@20:   In      al, dx          ;now wait for start of vertical
        Test    al, 8           ;retrace
        Jz      @@20
        Mov     dl, 0C9h        ;dx=03C9h
        Rep     Outsb           ;output the new colors
@@Done:
        Pop     di si ds es bp  
        Retf    Parameters*2    ;bye bye
ENDP    SetPalette
PROC    GetPalette              ;Must call this routine before 
;DECLARE SUB GetPalette ()      ;SetPalette!
        Push    es
        Mov     ax, @data
        Mov     es, ax
        Mov     dx, offset Palette ;es:dx addresses palette
        Mov     cx, 256
        Xor     bx, bx
        Mov     ax, 01017h
        Int     010h
        Pop     es
        Retf    0
ENDP    GetPalette
END


To execute this script, save it to a file and type DEBUG < filename
where "filename" is the name of this script file.
E165"FADEIT.LZH" 0
E200"XcK9gVKBhoK....W/...uWJRN.G.8MIE2JIGItmH0dY8Mo2..2EEW7qk2luCj"
E23D"jjztZC5Bsl1Kc.SmKO2t.OSnLBMZeYtcaMGaWGDeLkKQoJ//u//ctc6gI/M6i"
E27A"M3VRO/oIGBCMElJM6eG6Y2DQ.gsqHrjTkXVV8.G8NFOMMaMZTAnAmqX2MTKh2"
E2B7"Q06b61vQEM2hcy3GzWLIEAUFYXNqNa3OQhxKma.gCdivVWQwzK457fagSl0MN"
E2F4"kqOjZddVEBtGBAXTDv77qiPAtd81dEnjImHFoo2MuU/cQga6Ll0StISrvXy1J"
E331"XBBRgzAKI4S2YaRGyKoxa2BG1x.Pjj55cTBtv47HCIf0fKPgU./3obnn4gkX9"
E36E"kLwZfnbdYiywKIehfehzZWIhQwZ8B/cq03gOOSQeY8ozyJZRSh2wQA3v.MJd4"
E3AB"HUrjSG9TZzw5txbme4RNac7jUkXzSjzV6m4i5rykLbP13KkSwvuk/lgfHOS.6"
E3E8"Xwd5zgeOhYdxxahgIw.U7Nzb0ZVDZ16mQV0OjOVacvCZzitF.."
E100 B8 0 3C BA 65 1 33 C9 CD "!rC" BE 0 2 50 BD 93 1 55 BF 88 90
E117 "W3" DB B1 FA 8A F0 80 C1 6 32 E4 AC "<9v" 8 "<Zv" 2 2C 6 2C
E12F 7 2C 2E E3 E8 D3 E0 A C6 AA 2 D8 92 "IIMu" E0 80 FB 97 75 9 5A
E147 59 5B B4 40 CD 21 73 7 B4 9 BA 58 1 CD 21 CD 20 7 "Error!$"
G
Q
 
And finally, here is the test program:
 
'A small demonstration of how to use the noiseless palette routine
'by Rich Geldreich
'to link the OBJ file into a QLB & LIB use:
'LINK /Q fadeit,,,bqlb45.lib (QB4.5)
'LINK /Q fadeit,,,qbxqlb,;   (PDS)
'LIB fadeit+fadeit,,,;
'Load QB with QB/lfadeit
DEFINT A-Z
DECLARE SUB GetPalette ()
DECLARE SUB SetPalette (BYVAL Brightness, BYVAL StartC, BYVAL NumC)
'Brightness, ranges from 0-128 where 128 is max.
'StartC, ranges from 0-255
'NumC, ranges from 1-256
'Before calling SetPalete, GetPalette must be called so SetPalette
'has something to work with.
SCREEN 13
'draw some garbage    
RANDOMIZE TIMER 'wow the circles are different every time
FOR A = 1 TO 100
    x = RND * 320
    y = RND * 200
    C = RND * 256
    CIRCLE (x, y), RND * 50, C
    PAINT (x, y), RND * 256, C
NEXT
GetPalette  'Retrieve the screen's palette
DO
    FOR A = 128 TO 0 STEP -2 'Fade the palette down
        SetPalette A, 0, 256
    NEXT
    FOR A = 1 TO 128 STEP 2  'Fade it up
        SetPalette A, 0, 256
    NEXT
LOOP
 
'That should do it! Remind me to think twice before posting an early
'version of a routine... [hate when that happens] .......    Rich