Author Topic: gl shaders in text mode... (Read 6076 times)

PMACKAY · « **on:** April 15, 2019, 08:27:42 pm »

how would i use gl... would like to use a simple shadder to put light on screen on dark images (torch light) as in circle (100,100),10,light

i do not know where to start or how to implement

like a dungeon with a torch light on

Raven_Singularity · « **Reply #1 on:** April 15, 2019, 08:56:28 pm »

Why text mode, and not 32bit graphical mode? OpenGL lighting is clearly graphical. :-)

Petr · « **Reply #2 on:** April 16, 2019, 02:57:34 pm »

So you say - text mode? Well, try this. I wish you good luck in recalculating the coordinates between the text screen and the hardware image. I mean, I'll be glad if you can do it because I don't want to think of it, but I would definitely use it.

Code: QB64: [Select]

himage = _NEWIMAGE(100, 100, 32)
_DEST himage
FOR x = 1 TO 255
    FOR R = 0 TO _PI(2) STEP .001
        PSET (50 + SIN(R) * x, 50 + COS(R) * x), _RGBA32(0, 0, 0, x)
    NEXT R
NEXT x
_DEST 0
himage = _COPYIMAGE(himage, 33) '! HARDWARE IMAGE need DISPLAY!
 
_DISPLAYORDER _SOFTWARE , _HARDWARE
SCREEN 0
CLS , 15
 
FOR print_something = 1 TO 1000
    char = RND * 127 + 31
    PRINT CHR$(char);
NEXT
 
 
 
 
DO
    _MAPTRIANGLE (100, 100)-(0, 100)-(100, 0), himage TO(1, -1, -1)-(-1, -1, -1)-(1, 1, -1), 0
    _MAPTRIANGLE (0, 100)-(100, 0)-(0, 0), himage TO(-1, -1, -1)-(1, 1, -1)-(-1, 1, -1), 0
 
 
    _DISPLAY
LOOP
 

or better...

Code: QB64: [Select]

 
himage = _NEWIMAGE(512, 512, 32)
_DEST himage
FOR x = 1 TO 255
    FOR R = 0 TO _PI(2) STEP .001
        PSET (256 + (SIN(R) * x), 256 + (COS(R) * x)), _RGBA32(0, 0, 0, x - 20)
    NEXT R
NEXT x
_DEST 0
himage = _COPYIMAGE(himage, 33) '! HARDWARE IMAGE need DISPLAY!
 
_DISPLAYORDER _SOFTWARE , _HARDWARE
SCREEN 0
CLS , 15
COLOR 0, 15
 
FOR print_something = 1 TO 2000
    char = RND * 127 + 31
    PRINT CHR$(char);
NEXT
 
D = -1
W = 512
H = 512
 
DO
 
    _MAPTRIANGLE (W, H)-(0, H)-(W, 0), himage TO(1, -1, D)-(-1, -1, D)-(1, 1, D), 0
    _MAPTRIANGLE (0, H)-(W, 0)-(0, 0), himage TO(-1, -1, D)-(1, 1, D)-(-1, 1, D), 0
 
 
    _DISPLAY
    _LIMIT 15
 
LOOP
 

bplus · « **Reply #3 on:** April 16, 2019, 05:25:03 pm »

Nice effect Petr!

PMACKAY · « **Reply #4 on:** April 27, 2019, 06:50:34 am »

that is cool... just now to work it out...

Petr · « **Reply #5 on:** April 27, 2019, 07:35:36 am »

Hi. I do it much easier and functional. For this use you need none depth, so is much easyest using PUTIMAGE for hardware image. To completely hide the text, just make the circle so large that it covers the entire area of the text screen. Option for realize using PUTIMAGE for hardware images thought me, when I read the program here https://www.qb64.org/forum/index.php?topic=1310.msg105090#msg105090

Use mouse.

Code: QB64: [Select]

 
himage = _NEWIMAGE(512, 512, 32)
_DEST himage
 
FOR x = 1 TO 255
    FOR R = 0 TO _PI(2) STEP .001
        PSET (256 + (SIN(R) * x), 256 + (COS(R) * x)), _RGBA32(0, 0, 0, x - 20)
    NEXT R
NEXT x
_DEST 0
himage = _COPYIMAGE(himage, 33) '! HARDWARE IMAGE need DISPLAY!
 
_DISPLAYORDER _SOFTWARE , _HARDWARE
SCREEN 0
CLS , 15
COLOR 0, 15
 
FOR print_something = 1 TO 2000
    char = RND * 127 + 31
    PRINT CHR$(char);
NEXT
 
D = -1
W = 512
H = 512
 
DO
    WHILE _MOUSEINPUT: WEND
 
    x = (-32 + _MOUSEX) * 8 ' -40 is one half from maximum MOUSEX value. Because X is coordinate SCREEN 0, it is maximal value 80. 8 is font witdh for basic text font. Image width is 512, so 512/2/8 = 32 for image middle in X
    y = (-16 + _MOUSEY) * 16 '16 is one half from maximum MOUSEY value. Because Y coordinate is also SCREEN 0, is maximal Y value 32. Font height is 16. Image height is 512, so 512/2/16 = 16 for image middle in Y
    LOCATE 1, 1: PRINT x, y
 
    _PUTIMAGE (x, y), himage, 0
 
    _DISPLAY
    _LIMIT 15
LOOP
 
 

Petr · « **Reply #6 on:** April 28, 2019, 03:50:34 am »

For smooth running I recommend to compile in version 1.1, where the mouse coordinates in text mode are returned as a decimal number and not as an integer from newer versions.

PMACKAY · « **Reply #7 on:** April 28, 2019, 09:29:35 am »

works great and very easy...

any chance on this having about eight different lights on screen.... eg (just light up enemys and surrounds (eg.black screen with eight areas visible in ascii)

wanting this for a dungeon like map game in ascii.... so can see enemys and chests and items moving around in my maps

char data like 3x3 cell so light maybe 6x6 or 7x7.....

run smooth in qb64 1.3 on linux mint. thank you very simple :) cheers

bplus · « **Reply #8 on:** April 28, 2019, 01:19:26 pm »

Quote from: Raven_Singularity on April 15, 2019, 08:56:28 pm

Why text mode, and not 32bit graphical mode? OpenGL lighting is clearly graphical. :-)

+1

Let's see Petr or Pete do this in Text mode ;-))

Code: QB64: [Select]

_TITLE "Bouncing Search Lights" 'started 2019-04-28 B+
 
CONST xmax = 800
CONST ymax = 600
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE _MIDDLE
 
DIM txt(1 TO 37) AS STRING, v(1 TO 37)
FOR i = 1 TO 37
    b$ = ""
    FOR j = 1 TO 100
        b$ = b$ + CHR$(INT(RND * 96) + 32)
    NEXT
    txt(i) = b$: v(i) = INT(RND * 3) + 1
NEXT
 
COLOR 0, 1
balls = 20
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(10, 65)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(1, 5) * rdir
    dy(i) = rand(1, 5) * rdir
    rr(i) = rand(150, 255)
    gg(i) = rand(150, 255)
    bb(i) = rand(150, 255)
NEXT
 
WHILE _KEYDOWN(27) = 0
    CLS
    FOR i = 1 TO balls
        'ready for collision
        a(i) = _ATAN2(dy(i), dx(i))
        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        imoved = 0
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                imoved = 1
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                'update new dx, dy for i and j balls
                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
                power = (power1 + power2) / 2
                dx(i) = power * COS(a(i))
                dy(i) = power * SIN(a(i))
                dx(j) = power * COS(a(j))
                dy(j) = power * SIN(a(j))
                x(i) = x(i) + dx(i)
                y(i) = y(i) + dy(i)
                x(j) = x(j) + dx(j)
                y(j) = y(j) + dy(j)
                EXIT FOR
            END IF
        NEXT
        IF imoved = 0 THEN
            x(i) = x(i) + dx(i)
            y(i) = y(i) + dy(i)
        END IF
        IF x(i) < r(i) THEN dx(i) = -dx(i): x(i) = r(i)
        IF x(i) > xmax - r(i) THEN dx(i) = -dx(i): x(i) = xmax - r(i)
        IF y(i) < r(i) THEN dy(i) = -dy(i): y(i) = r(i)
        IF y(i) > ymax - r(i) THEN dy(i) = -dy(i): y(i) = ymax - r(i)
 
        FOR rad = r(i) TO 0 STEP -1
            'COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
            'fcirc x(i), y(i), rad, _RGBA32((r(i) - rad) / r(i) * rr(i), (rad - i) / r(i) * gg(i), (rad - i) / r(i) * bb(i), 20)
            fcirc x(i), y(i), rad, _RGBA32(rr(i), gg(i), bb(i), 12)
        NEXT
    NEXT
    FOR i = 1 TO 37
        txt(i) = MID$(txt(i), v(i)) + MID$(txt(i), 1, v(i) - 1)
        FOR l = 1 TO 100
            IF i MOD 2 THEN midInk 60, 0, 0, 0, 0, 60, l / 100 ELSE midInk 0, 0, 60, 60, 0, 0, l / 100
            LOCATE i, l: PRINT MID$(txt(i), l, 1);
        NEXT
    NEXT
 
    _DISPLAY
    _LIMIT 10
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    COLOR _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
END SUB
 

BTW does it really count to draw stuff in a graphics _DEST and then paste it into the Text Mode screen?
What would Pete say? :D

Petr · « **Reply #9 on:** April 28, 2019, 04:23:49 pm »

Chacha, good try! And you almost got me! The reason why it could not be implanted directly, is the CLS command in your loop. CLS will do _RGBA32 (0,0,0,255) everywhere, but the default NEWIMAGE window (just at the beginning) is _RGBA32 (0,0,0,0) and this just ensures transparency between layers. If you leave the CLS there, then the CLS color is not transparent and this is undesirable in this case. You have to start drawing on a transparent background - then where you set alpha to zero, there is transparency to the next layer. Where you don't set it, then i do _RGBA32 (0,0,0,255) - just in this program, rows 85-90 in this source. It took a while to figure it me out. You're responsible for the smoke from my brain :-D

Code: QB64: [Select]

'upgrade for real text mode
 
 
 
_TITLE "Bouncing Search Lights" 'started 2019-04-28 B+, continued by Petr to REAL TEXT SCREEN :-D
 
CONST xmax = 800
CONST ymax = 600
 
DIM txt(1 TO 37) AS STRING, v(1 TO 37)
FOR i = 1 TO 37
    b$ = ""
    FOR j = 1 TO 100
        b$ = b$ + CHR$(INT(RND * 96) + 32)
    NEXT
    txt(i) = b$: v(i) = INT(RND * 3) + 1
NEXT
 
 
balls = 20
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(10, 65)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(1, 5) * rdir
    dy(i) = rand(1, 5) * rdir
    rr(i) = rand(150, 255)
    gg(i) = rand(150, 255)
    bb(i) = rand(150, 255)
NEXT
 
SCREEN 0
 
 
WHILE _KEYDOWN(27) = 0
    Bplus = _NEWIMAGE(xmax, ymax, 32)
    _DEST Bplus
    _SCREENMOVE _MIDDLE
 
 
 
    ' CLS , _RGB32(0, 0, 0)
    FOR i = 1 TO balls
        'ready for collision
        a(i) = _ATAN2(dy(i), dx(i))
        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        imoved = 0
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                imoved = 1
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                'update new dx, dy for i and j balls
                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
                power = (power1 + power2) / 2
                dx(i) = power * COS(a(i))
                dy(i) = power * SIN(a(i))
                dx(j) = power * COS(a(j))
                dy(j) = power * SIN(a(j))
                x(i) = x(i) + dx(i)
                y(i) = y(i) + dy(i)
                x(j) = x(j) + dx(j)
                y(j) = y(j) + dy(j)
                EXIT FOR
            END IF
        NEXT
        IF imoved = 0 THEN
            x(i) = x(i) + dx(i)
            y(i) = y(i) + dy(i)
        END IF
        IF x(i) < r(i) THEN dx(i) = -dx(i): x(i) = r(i)
        IF x(i) > xmax - r(i) THEN dx(i) = -dx(i): x(i) = xmax - r(i)
        IF y(i) < r(i) THEN dy(i) = -dy(i): y(i) = r(i)
        IF y(i) > ymax - r(i) THEN dy(i) = -dy(i): y(i) = ymax - r(i)
 
 
        FOR rad = r(i) TO 0 STEP -1
            fcirc x(i), y(i), rad, _RGBA32(rr(i), gg(i), bb(i), 12)
        NEXT
    NEXT
 
    'do untransparently unusued areas. More better is do this with MEM
    FOR dby = 0 TO 599
        FOR dbx = 0 TO 799
            _SOURCE Bplus
            IF POINT(dbx, dby) = 0 THEN PSET (dbx, dby), _RGB32(1, 1, 1)
        NEXT
    NEXT
 
    _SOURCE 0
    _DEST 0 'redirecting to text screen
    ' COLOR 0, 1
    FOR i = 1 TO 37
        txt(i) = MID$(txt(i), v(i)) + MID$(txt(i), 1, v(i) - 1)
        FOR l = 1 TO 80
            ' IF i MOD 2 THEN midInk 60, 0, 0, 0, 0, 60, l / 100 ELSE midInk 0, 0, 60, 60, 0, 0, l / 100
 
            p = i * 1.3
 
            LOCATE p, l: PRINT MID$(txt(i), l, 1);
            LOCATE p, l: PRINT MID$(txt(i), l, 1);
 
        NEXT
    NEXT
 
    _DEST 0
    Himage = _COPYIMAGE(Bplus, 33)
    _PUTIMAGE (0, 0)-(800, 600), Himage, 0
    _DISPLAYORDER _SOFTWARE , _HARDWARE
    _DISPLAY
    _LIMIT 20
    _FREEIMAGE Himage
    _FREEIMAGE Bplus
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    COLOR _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
END SUB
 

bplus · « **Reply #10 on:** April 28, 2019, 05:09:41 pm »

Wow Petr! Nice! :)

Not sure what is going on and why I can't make the letters Black but at least I can make them better sized:

Code: QB64: [Select]

'upgrade for real text mod
 
_TITLE "Bouncing Search Lights" 'started 2019-04-28 B+, continued by Petr to REAL TEXT SCREEN :-D
'continued by B+ with normal letter size :-))
 
CONST xmax = 800
CONST ymax = 600
 
DIM txt(1 TO 25) AS STRING, v(1 TO 25)
FOR i = 1 TO 25
    b$ = ""
    FOR j = 1 TO 100
        b$ = b$ + CHR$(INT(RND * 96) + 32)
    NEXT
    txt(i) = b$: v(i) = INT(RND * 3) + 1
NEXT
 
 
balls = 20
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
FOR i = 1 TO balls
    r(i) = rand(10, 65)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(1, 5) * rdir
    dy(i) = rand(1, 5) * rdir
    rr(i) = rand(50, 255)
    gg(i) = rand(50, 255)
    bb(i) = rand(50, 255)
NEXT
 
SCREEN 0
 
 
WHILE _KEYDOWN(27) = 0
    Bplus = _NEWIMAGE(xmax, ymax, 32)
    _DEST Bplus
    _SCREENMOVE _MIDDLE
 
 
 
    ' CLS , _RGB32(0, 0, 0)
    FOR i = 1 TO balls
        'ready for collision
        a(i) = _ATAN2(dy(i), dx(i))
        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        imoved = 0
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                imoved = 1
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                'update new dx, dy for i and j balls
                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
                power = (power1 + power2) / 2
                dx(i) = power * COS(a(i))
                dy(i) = power * SIN(a(i))
                dx(j) = power * COS(a(j))
                dy(j) = power * SIN(a(j))
                x(i) = x(i) + dx(i)
                y(i) = y(i) + dy(i)
                x(j) = x(j) + dx(j)
                y(j) = y(j) + dy(j)
                EXIT FOR
            END IF
        NEXT
        IF imoved = 0 THEN
            x(i) = x(i) + dx(i)
            y(i) = y(i) + dy(i)
        END IF
        IF x(i) < r(i) THEN dx(i) = -dx(i): x(i) = r(i)
        IF x(i) > xmax - r(i) THEN dx(i) = -dx(i): x(i) = xmax - r(i)
        IF y(i) < r(i) THEN dy(i) = -dy(i): y(i) = r(i)
        IF y(i) > ymax - r(i) THEN dy(i) = -dy(i): y(i) = ymax - r(i)
 
 
        FOR rad = r(i) TO 0 STEP -1
            fcirc x(i), y(i), rad, _RGBA32(rr(i), gg(i), bb(i), 12)
        NEXT
    NEXT
 
    'do untransparently unusued areas. More better is do this with MEM
    FOR dby = 0 TO 599
        FOR dbx = 0 TO 799
            _SOURCE Bplus
            IF POINT(dbx, dby) = 0 THEN PSET (dbx, dby), _RGB32(1, 1, 1)
        NEXT
    NEXT
 
    _SOURCE 0
    _DEST 0 'redirecting to text screen
 
 
    _DEST 0
    Himage = _COPYIMAGE(Bplus, 33)
    _PUTIMAGE (0, 0)-(800, 600), Himage, 0
 
    FOR i = 1 TO 25
        txt(i) = MID$(txt(i), v(i)) + MID$(txt(i), 1, v(i) - 1)
        FOR l = 1 TO 80
            ' IF i MOD 2 THEN midInk 60, 0, 0, 0, 0, 60, l / 100 ELSE midInk 0, 0, 60, 60, 0, 0, l / 100
 
            'p = i * 1.3
            COLOR 15
            LOCATE i, l: PRINT MID$(txt(i), l, 1);
            LOCATE i, l: PRINT MID$(txt(i), l, 1);
 
        NEXT
    NEXT
 
    _DISPLAYORDER _SOFTWARE , _HARDWARE
    _DISPLAY
    _LIMIT 20
    _FREEIMAGE Himage
    _FREEIMAGE Bplus
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    COLOR _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
END SUB
 
 
 

Petr · « **Reply #11 on:** April 28, 2019, 05:21:54 pm »

Hi. Rewrite Color 15 to Color 0, 15 on row 105. Just Color 0 do unvisible, because it is black on black background. Also color 0,14 is good :-D

bplus · « **Reply #12 on:** April 28, 2019, 05:28:20 pm »

Yeah, I tried that but I didn't want white background. I ideally the black letters would only appear only over the colored spheres.
Like this:
[ You are not allowed to view this attachment ]

More smoke? :)

Petr · « **Reply #13 on:** April 28, 2019, 05:44:30 pm »

I really do not want to recalculate the coordinates between the text screen and the balls on the graphics screen and print only those letters that are above the ball...

Because the background of the text is on a text screen, but you have a black background on the graphical screen with the balls, and you want black letters on the text screen, the only way I can think of it is set the background on the text screen of the ball by using RGB colors as much as possible with balls colors. BUT we already have midnight here....

bplus · « **Reply #14 on:** April 28, 2019, 10:40:20 pm »

OK forget about colors then:

Code: QB64: [Select]

'upgrade for real text mod
 
_TITLE "Bouncing Search Lights" 'started 2019-04-28 B+, continued by Petr to REAL TEXT SCREEN :-D
'continued by B+ with normal letter size :-))
'mod 2 B+ forget about color to get black letters ending at edge of circles
 
CONST xmax = 640
CONST ymax = 400
 
DIM txt(1 TO 25) AS STRING, v(1 TO 25)
FOR i = 1 TO 25
    b$ = ""
    FOR j = 1 TO 100
        b$ = b$ + CHR$(INT(RND * 96) + 32)
    NEXT
    txt(i) = b$: v(i) = INT(RND * 3) + 1
NEXT
 
balls = 10
DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls)
FOR i = 1 TO balls
    r(i) = rand(10, 60)
    x(i) = rand(r(i), xmax - r(i))
    y(i) = rand(r(i), ymax - r(i))
    c(i) = rand(1, 15)
    dx(i) = rand(1, 5) * rdir
    dy(i) = rand(1, 5) * rdir
NEXT
 
SCREEN 0
 
COLOR 0, 15
WHILE _KEYDOWN(27) = 0
    Bplus = _NEWIMAGE(xmax, ymax, 32)
    _DEST Bplus
    _SCREENMOVE _MIDDLE
    FOR i = 1 TO balls
        'ready for collision
        a(i) = _ATAN2(dy(i), dx(i))
        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
        imoved = 0
        FOR j = i + 1 TO balls
            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
                imoved = 1
                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
                'update new dx, dy for i and j balls
                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
                power = (power1 + power2) / 2
                dx(i) = power * COS(a(i))
                dy(i) = power * SIN(a(i))
                dx(j) = power * COS(a(j))
                dy(j) = power * SIN(a(j))
                x(i) = x(i) + dx(i)
                y(i) = y(i) + dy(i)
                x(j) = x(j) + dx(j)
                y(j) = y(j) + dy(j)
                EXIT FOR
            END IF
        NEXT
        IF imoved = 0 THEN
            x(i) = x(i) + dx(i)
            y(i) = y(i) + dy(i)
        END IF
        IF x(i) < r(i) THEN dx(i) = -dx(i): x(i) = r(i)
        IF x(i) > xmax - r(i) THEN dx(i) = -dx(i): x(i) = xmax - r(i)
        IF y(i) < r(i) THEN dy(i) = -dy(i): y(i) = r(i)
        IF y(i) > ymax - r(i) THEN dy(i) = -dy(i): y(i) = ymax - r(i)
        fcirc x(i), y(i), r(i), _RGBA32(255, 255, 255, 20)
    NEXT
 
 
    'do untransparently unusued areas. More better is do this with MEM
    FOR dby = 0 TO ymax - 1
        FOR dbx = 0 TO xmax - 1
            _SOURCE Bplus
            IF POINT(dbx, dby) = 0 THEN PSET (dbx, dby), _RGB32(1, 1, 1)
        NEXT
    NEXT
 
    _SOURCE 0
    _DEST 0 'redirecting to text screen
    Himage = _COPYIMAGE(Bplus, 33)
    _PUTIMAGE (0, 0)-(xmax, ymax), Himage, 0
    FOR i = 1 TO 25
        txt(i) = MID$(txt(i), v(i)) + MID$(txt(i), 1, v(i) - 1)
        FOR l = 1 TO 80
            LOCATE i, l: PRINT MID$(txt(i), l, 1);
            LOCATE i, l: PRINT MID$(txt(i), l, 1);
        NEXT
    NEXT
    _DISPLAY
    _LIMIT 20
    _FREEIMAGE Himage
    _FREEIMAGE Bplus
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
FUNCTION rdir ()
    IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
 

News:

Author Topic: gl shaders in text mode... (Read 6076 times)

PMACKAY

gl shaders in text mode...

Raven_Singularity

Re: gl shaders in text mode...

Petr

Re: gl shaders in text mode...

bplus

Re: gl shaders in text mode...

PMACKAY

Re: gl shaders in text mode...

Petr

Re: gl shaders in text mode...

Petr

Re: gl shaders in text mode...

PMACKAY

Re: gl shaders in text mode...

bplus

Re: gl shaders in text mode...

Petr

Re: gl shaders in text mode...

bplus

Re: gl shaders in text mode...

Petr

Re: gl shaders in text mode...

bplus

Re: gl shaders in text mode...

Petr

Re: gl shaders in text mode...

bplus

Re: gl shaders in text mode...