'===========================================================================
' Subject: ANY PALETTE TRANSLUCENCY EFFECT   Date: 08-19-98 (03:45)       
' Author:  Victor Woeltjen                   Code: QB, QBasic, PDS        
' Origin:  skywise@fix.net                 Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB TranslucentBox (x1%, y1%, x2%, y2%, TableSeg%, TableOff%)
DECLARE SUB InitTrans ()
DEFINT A-Z
DECLARE SUB MakeIndex (segm%, offs%, BaseColor%, Spread%)

'Before doing anything, initialise TSRout% and run InitTrans (seen below)
'
'Then you're set up... Before you can use the transparency effects you need
'to make an index. The MakeIndex routine works under any palette, though you
'must be in screen 13. Look below to see the syntax for MakeIndex.
'
'Once you have an index (or indices, if you want multiple translucent colors)
'set up, you can use the TranslucentBox routine to create a translucent
'square over a chosen portion of the screen. Again, look below for syntax.
'
'Enjoy...
'
'Copyright 1998 Rev. Victor Woeltjen
'Use freely, but give me credit if you use any of these routines.
'
'Note: In VBDOS and possibly in QB 4.5 you cannot run this from the
'evironment. It should compile just fine, though.
'
'Second note: You need 2K free to run the MakeIndex sub. It may be best to
'create a few indexes outside of your main program and then save them to
'disk.

DIM SHARED TSRout%(40)     'These two lines are required!
InitTrans                  '!!!

DIM Blah(127)              'This is the array in which the color switching
                           'table will be stored. You can have as many
                           'different tables for as many different colors
                           'as you like... Each needs to be 256 bytes in
                           'size.

Colour = 32                'The colour you want to use as a base for the
                           'transparency.
                                                    
SCREEN 13

MakeIndex VARSEG(Blah(0)), VARPTR(Blah(0)), Colour, 15  'Make the table.

'VARSEG(Blah(0)), and VARPTR(Blah(0)) - The place in memory where you want
'   the table to be stored...
'Colour - You can replace this with any number or integer variable. This
'   indicates the color you want the table to me mapped for. To make a
'   blue translucency table, select a blue color (use brighter colors for
'   clearer translucency)
'15 - This is the number of levels of brightness you want to have. Higher
'   values give better effect, but if you're making your indices on the fly
'   you should use a lower value.


RANDOMIZE 44                        'Fill the screen with lines.
FOR n = 1 TO 1000
  x1 = RND * 319
  x2 = RND * 319
  y1 = RND * 199
  y2 = RND * 199
  LINE (x1, y1)-(x2, y2), RND * 255
NEXT n

DO: LOOP UNTIL INKEY$ <> ""

TranslucentBox 20, 20, 299, 179, VARSEG(Blah(0)), VARPTR(Blah(0))

'20, 20 - Upper left hand corner of the box.
'299, 179 - Lower right hand corner.
'VARSEG(Blah(0)), VARPTR(Blah(0)) - Location of the color switching table to
'   be used.

DO: LOOP UNTIL INKEY$ <> ""

DEFLNG A-Z
SUB InitTrans

ASM$ = "1E5589E58B76088B4E128B5610B800A08ED889D389D0C1E008C1E30601C"
ASM$ = ASM$ + "301CBB800008A0701C68B460A8ED88A048B760850B800A08ED8588807418"
ASM$ = ASM$ + "B460E39C17ECB8B4E12428B460C39C27EC05D1FCA0600"

DEF SEG = VARSEG(TSRout%(0))
 FOR PokeAsm% = 0 TO 81
  POKE VARPTR(TSRout%(0)) + PokeAsm%, VAL("&H" + MID$(ASM$, PokeAsm% * 2 + 1, 2))
 NEXT PokeAsm%
DEF SEG


END SUB

DEFINT A-Z
SUB MakeIndex (segm, offs, BaseColor, Spread)

BCol = BaseColor MOD 256        'Make sure BaseColor and
Sprd = Spread MOD 256           'Spread fit the correct bounds by assigning
                                'new variables to them.

DIM Bright(0 TO 255)            'Index of brightness
DIM RGBVal(0 TO 255, 1 TO 3)    'Index of RGB values
DIM RplVal(0 TO (Sprd - 1))     'Index of replacement values for specific
                                'brightnesses.


FOR attr = 0 TO 255             'Get all the colors...
  OUT &H3C7, attr               'Get ready to read palette info...
  red = INP(&H3C9)              'And read that info.
  gre = INP(&H3C9)
  blu = INP(&H3C9)
  Bright(attr) = (Sprd - 1) * ((red + gre + blu) / 189!) 'Get average brightness.
  RGBVal(attr, 1) = red         'Store the RGB Values
  RGBVal(attr, 2) = gre
  RGBVal(attr, 3) = blu
NEXT attr
                          
delta! = 1 / Sprd               'Change in percentage per step.
cp! = 0                         'Reset the percentage counter.

FOR CS = 0 TO Sprd - 1          'Step through the spread...
  cp! = cp! + delta!            'Increment the percentage counter.
  red = RGBVal(BCol, 1) * cp!   'Define the target RGB value.
  gre = RGBVal(BCol, 2) * cp!
  blu = RGBVal(BCol, 3) * cp!
  closest = 0                   'Reset closest and maximum difference.
  maxdiff = 255
  FOR check = 0 TO 255          'Check the colors for a match.
    rd = ABS(RGBVal(check, 1) - red)   'Get the difference from the
    gd = ABS(RGBVal(check, 2) - gre)   'target RGB value.
    bd = ABS(RGBVal(check, 3) - blu)
    diff = rd + gd + bd                'Compute the total difference
    IF diff < maxdiff THEN      'If this is the least different so far
      closest = check           'set closest to the current attribute
      maxdiff = diff            'and set the maximum difference.
    END IF
  NEXT check
  RplVal(CS) = closest          'Set the replacement value.
NEXT CS

FOR pokeidx = 0 TO 255          'Now save the index into the specified
  DEF SEG = segm                'segment and offset.
    POKE offs + pokeidx, RplVal(Bright(pokeidx))
  DEF SEG
NEXT pokeidx

END SUB

SUB SourceCode

'Not really a routine, just assembly source for the translucent box
'routine :)

';Overview of the stack:
';bp              0
';ds              2
';BAS off         4
';BAS seg *       6
';VARPTR(Blah)    8
';VARSEG(Blah)    A
';y2              C
';x2              E
';y1             10
';x1             12

';cx = curx
';dx = cury

'push ds
'push bp

'mov bp, sp

'mov si, [bp+0x8]      ;Set si to the offset of the color table.
'mov cx, [bp+0x12]     ;Set cx to the starting x pos
'mov dx, [bp+0x10]     ;Set dx to the starting y pos
'
'ChangeColor
'mov ax, 0xA000        ;Set ds to the screen segment
'mov ds, ax
'mov bx, dx            ;And put the ypos in bx,
'mov ax, dx            ;then multiply it by 320 using SHLs for speed.
'shl ax, 8        
'shl bx, 6
'add bx, ax
'add bx, cx            ;Finally, add the xpos to bx to get the screen offset.
'mov ax, 0             ;Clear out ax,
'mov al, [bx]          ;Now get the pixel color,
'add si, ax            ;and add it to si...
'mov ax, [bp+0xA]      ;Put the color table's segment in ds
'mov ds, ax
'mov al, [si]          ;And get the replacement color.
'mov si, [bp+0x8]      ;Replace si with the beginning table offset for later.
'push ax               ;Save the color momentarily...
'mov ax, 0xA000        ;Set ds to the screen seg,
'mov ds, ax
'pop ax                ;Get back the color,
'mov [bx], al          ;and put it on screen!

'inc cx                ;Increment the xpos
'mov ax, [bp+0xE]      ;and compare it with x2
'cmp cx, ax            ;to see if the right boundary has been passed.
'jle ChangeColor       ;if not, go ahead and draw.
'mov cx, [bp+0x12]     ;Otherwise, restore x1,
'inc dx                ;and increment the ypos.
'mov ax, [bp+0xC]      ;Now compare it with y2...
'cmp dx, ax
'jle ChangeColor
'
'pop bp
'pop ds

'retf 0x6

END SUB

SUB TranslucentBox (x1, y1, x2, y2, TableSeg, TableOff)

'x1,y1,x2,y2: Endpoints for square.
'TableSeg,TableOff: VARSEG and VARPTR of the variable or array in
'                   which the color table is stored.

DEF SEG = VARSEG(TSRout%(0))
  CALL Absolute(BYVAL x1, BYVAL y1, BYVAL x2, BYVAL y2, BYVAL TableSeg, BYVAL TableOff, VARPTR(TSRout%(0)))
DEF SEG

END SUB