'=========================================================================== ' Subject: APPLY CUSTOM EFFECTS TO IMAGE Date: 05-15-99 (13:43) ' Author: Jernej Simoncic Code: QB, PDS ' Origin: jernej.simoncic@guest.arnes.si Packet: DIRECTQB.ABC '=========================================================================== ' ' Shows how to do effects with DirectQB ' ' For usage notes see ApplyEffect sub ' ' Credits: ' Programmed by Jernej Simoncic ' Based on information by Scott Scriven ' FindCol was programmed by Wafn ' ' Jernej Simoncic ' e-mail: jernej.simoncic@guest.arnes.si ' ICQ#: 26266467 ' Homepage: http://www2.arnes.si/~sopjsimo/ ' ' Note: For demo TEXTURE1.PCX is used, from DQb texture mapping example. ' ' DECLARE FUNCTION FindCol% (Pal AS STRING, R%, G%, B%) DECLARE SUB ApplyEffect (Layer%, tmplayer%, x1%, y1%, x2%, y2%, Array() AS INTEGER, ex%, ey%, comp%) '$INCLUDE: 'directqb.bi' CONST R = 1, G = 2, B = 4 '============================================================================= ' DEMO '============================================================================= DIM Effect(4, 4) AS INTEGER, Pal AS STRING * 768 IF DQBinit(1, 0) THEN DQBclose: END FOR y% = 0 TO 4 FOR x% = 0 TO 4 READ Effect(x%, y%) NEXT NEXT SCREEN 13 IF DQBloadLayer(0, "texture1.pcx", Pal) THEN PRINT "Error" DQBsetPal Pal ApplyEffect 0, 1, 0, 0, 63, 63, Effect(), 4, 4, G 'This will disort the DQBclose 'DIRECTQB title on image 'Sample effects 'Diagonal "shatter" DATA 1,0,0,0,1 DATA 0,0,0,0,0 DATA 0,0,0,0,0 DATA 0,0,0,0,0 DATA 1,0,0,0,1 'Soften 'DATA 0,0,0,0,0 'DATA 0,1,3,1,0 'DATA 0,3,5,3,0 'DATA 0,1,3,1,0 'DATA 0,0,0,0,0 'Sharpen 'DATA -1,-1,-1,-1,-1 'DATA -1,-1,-1,-1,-1 'DATA -1,-1,49,-1,-1 'DATA -1,-1,-1,-1,-1 'DATA -1,-1,-1,-1,-1 '"Fire" 'DATA 0,0,0,0,0 'DATA 0,0,0,0,0 'DATA 0,0,1,0,0 'DATA 0,1,1,1,0 'DATA 0,0,0,0,0 'Horizontal blur 'DATA 0,0,0,0,0 'DATA 0,0,0,0,0 'DATA 1,3,5,3,1 'DATA 0,0,0,0,0 'DATA 0,0,0,0,0 'Vertical blur 'DATA 0,0,1,0,0 'DATA 0,0,3,0,0 'DATA 0,0,5,0,0 'DATA 0,0,3,0,0 'DATA 0,0,1,0,0 REM $DYNAMIC ' ' ApplyEffect layer%, templayer%, x1%, y1%, x2%, y2%, Array%(), ex%, ey%, _ ' comp% ' ' layer% Layer to aply effect to ' templayer% Temporary layer (must not be same as layer%) ' x1%,y1%,x2%,y2% Coordinates for effect ' Array%() 2D Array with effect ' ex%,ey% Effect array resolution (should be 2,4,6,etc.) ' comp% Channel to use effect on (1 - red, 2 - green, 4 - blue; ' to apply on all, use 7; to use effect on more channels, ' combine them with OR or +; you can use constants R, G, B) ' '----------------------------------------------------------------------------- ' How to make effect array: ' (simple blur effect) ' The simplest way of doing it is to make a serie of DATA statements and then ' read them to array: ' ' DATA 1,3,1 ' DATA 3,5,3 ' DATA 1,3,1 ' DIM Effect(2, 2) AS INTEGER ' FOR y% = 0 TO 2 ' FOR x% = 0 TO 2 ' READ Effect(x%, y%) ' NEXT x%, y% ' ApplyEffect 0, 1, 0, 0, 319, 199, Effect(), 2, 2, 1 + 2 + 4 '----------------------------------------------------------------------------- ' ' Programmed by Jernej Simoncic, based on information by Scott Scriven ' Use as you wish, just give me a credit ' SUB ApplyEffect (Layer%, tmplayer%, x1%, y1%, x2%, y2%, Array() AS INTEGER, ex%, ey%, comp%) IF comp% < 1 AND comp% > 7 THEN EXIT SUB IF Layer% = tmplayer% THEN EXIT SUB 'The temporary layer is needed, DQBcopyLayer Layer%, tmplayer% 'otherwise effects don't look good. DIM Temp(ex%, ey%, 3) AS INTEGER, Pal AS STRING * 768, clr%(2) red% = comp% AND 1 grn% = comp% AND 2 blu% = comp% AND 4 DQBgetPal Pal 'Effects are palette-specific FOR x% = 0 TO ex% 'Calculate division factor FOR y% = 0 TO ey% div% = div% + Array(x%, y%) NEXT y%, x% IF div% = 0 THEN EXIT SUB 'That would give us an error xx1% = -ex% \ 2 xx2% = ex% \ 2 yy1% = -ey% \ 2 yy2% = ey% \ 2 IF ex% MOD 2 = 1 THEN xx2% = xx2% - 1 IF ey% MOD 2 = 1 THEN yy2% = yy2% - 1 FOR x% = x1% TO x2% FOR y% = y1% TO y2% FOR xx% = xx1% TO xx2% 'Read points for to use with effect FOR yy% = yy1% TO yy2% cx% = x% + xx% cy% = y% + yy% IF cx% < x1% THEN cx% = x1% IF cx% > x2% THEN cx% = x2% IF cy% < y1% THEN cy% = y1% IF cy% > y2% THEN cy% = y2% Temp(xx% + ex% \ 2, yy% + ey% \ 2, 0) = DQBpoint(tmplayer%, cx%, cy%) NEXT yy%, xx% FOR xx% = 0 TO ex% 'Get RGB valuse of points FOR yy% = 0 TO ey% FOR i% = 1 TO 3 Temp(xx%, yy%, i%) = ASC(MID$(Pal, Temp(xx%, yy%, 0) * 3 + i%)) NEXT i%, yy%, xx% FOR xx% = 0 TO ex% 'Apply the effect FOR yy% = 0 TO ey% IF red% THEN Temp(xx%, yy%, 1) = Temp(xx%, yy%, 1) * Array(xx%, yy%) IF grn% THEN Temp(xx%, yy%, 2) = Temp(xx%, yy%, 2) * Array(xx%, yy%) IF blu% THEN Temp(xx%, yy%, 3) = Temp(xx%, yy%, 3) * Array(xx%, yy%) NEXT yy%, xx% clr%(0) = 0: clr%(1) = 0: clr%(2) = 0 FOR xx% = 0 TO ex% FOR yy% = 0 TO ey% IF red% THEN clr%(0) = clr%(0) + Temp(xx%, yy%, 1) ELSE clr%(0) = Temp(xx2%, yy2%, 1) IF grn% THEN clr%(1) = clr%(1) + Temp(xx%, yy%, 2) ELSE clr%(1) = Temp(xx2%, yy2%, 2) IF blu% THEN clr%(2) = clr%(2) + Temp(xx%, yy%, 3) ELSE clr%(2) = Temp(xx2%, yy2%, 3) NEXT yy%, xx% IF red% THEN clr%(0) = clr%(0) \ div% IF grn% THEN clr%(1) = clr%(1) \ div% IF blu% THEN clr%(2) = clr%(2) \ div% 'Find color in palette 'c% = DQBfindPalCol(Pal, clr%(0), clr%(1), clr%(2)) 'Thisone is faster c% = FindCol(Pal, clr%(0), clr%(1), clr%(2)) 'Thisone looks better DQBpset Layer%, x%, y%, c% NEXT IF INKEY$ = CHR$(27) THEN EXIT FOR 'Effects are slow, allow 'em to NEXT 'exit END SUB FUNCTION FindCol (Pal AS STRING, R, G, B) Closest = 0: td = 12000 FOR cfl = 0 TO 255 rr = ASC(MID$(Pal, cfl * 3 + 1, 1)): gg = ASC(MID$(Pal, cfl * 3 + 2, 1)): bb = ASC(MID$(Pal, cfl * 3 + 3, 1)) rd = R - rr: gd = G - gg: bd = B - bb td2 = (rd * rd) + (gd * gd) + (bd * bd) IF td2 < td THEN td = td2 Closest = cfl IF td = 0 THEN EXIT FOR END IF NEXT cfl FindCol = Closest END FUNCTION