What the hell is wrong with this. I can't figure out why the kerning and x position is messed up.

I can't figure out why the scale of 1 is showing crunchy as if it's out of proportion on x or y.
I can't figure out why I need to kludge the x position to start it with a negative offset in

F0NT.print

 
OPTION _EXPLICIT
OPTION _EXPLICITARRAY
 
CONST CHARS = 8
CONST COLS  = 9
CONST ROWS  = 9
CONST BPP   = 32
 
' screen setup
DIM CANVAS AS LONG
CANVAS& = _NEWIMAGE(COLS * 150, ROWS * 100, BPP)
SCREEN CANVAS&
_DEST CANVAS&
 
' glyph data
DIM GD(CHARS) AS STRING
         GD$(0) = "XXXXXXXXX"
GD$(0) = GD$(0) + ".X......."
GD$(0) = GD$(0) + "..X......"
GD$(0) = GD$(0) + "...X....."
GD$(0) = GD$(0) + "....X...."
GD$(0) = GD$(0) + ".....X..."
GD$(0) = GD$(0) + "......X.."
GD$(0) = GD$(0) + ".......X."
GD$(0) = GD$(0) + "XXXXXXXXX"
 
         GD$(1) = "XXXXXXXXX"
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
GD$(1) = GD$(1) + "....X...."
 
         GD$(2) = "....X...."
GD$(2) = GD$(2) + "...X.X..."
GD$(2) = GD$(2) + "..X...X.."
GD$(2) = GD$(2) + ".X.....X."
GD$(2) = GD$(2) + "XXXXXXXXX"
GD$(2) = GD$(2) + "X.......X"
GD$(2) = GD$(2) + "X.......X"
GD$(2) = GD$(2) + "X.......X"
GD$(2) = GD$(2) + "X.......X"
 
         GD$(3) = "XXXXXXXXX"
GD$(3) = GD$(3) + "X......X."
GD$(3) = GD$(3) + "X.....X.."
GD$(3) = GD$(3) + "X....X..."
GD$(3) = GD$(3) + "X...X...."
GD$(3) = GD$(3) + "X..X....."
GD$(3) = GD$(3) + "X.X......"
GD$(3) = GD$(3) + "XX......."
GD$(3) = GD$(3) + "XXXXXXXXX"
 
         GD$(4) = "XXXXXXXXX"
GD$(4) = GD$(4) + ".X......."
GD$(4) = GD$(4) + "..X......"
GD$(4) = GD$(4) + "...XXXXXX"
GD$(4) = GD$(4) + "..X......"
GD$(4) = GD$(4) + ".X......."
GD$(4) = GD$(4) + "X........"
GD$(4) = GD$(4) + "X........"
GD$(4) = GD$(4) + "X........"
 
         GD$(5) = "XXXXXXXXX"
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "....X...."
GD$(5) = GD$(5) + "XXXXXXXXX"
 
         GD$(6) = "XXXXXXXXX"
GD$(6) = GD$(6) + "X........"
GD$(6) = GD$(6) + "X........"
GD$(6) = GD$(6) + "X..XXXXXX"
GD$(6) = GD$(6) + "X...X...."
GD$(6) = GD$(6) + "X....X..."
GD$(6) = GD$(6) + "X.....X.."
GD$(6) = GD$(6) + "X......X."
GD$(6) = GD$(6) + "XXXXXXXXX"
 
         GD$(7) = "X.......X"
GD$(7) = GD$(7) + "X.......X"
GD$(7) = GD$(7) + "X.......X"
GD$(7) = GD$(7) + "X.......X"
GD$(7) = GD$(7) + "XXXXXXXXX"
GD$(7) = GD$(7) + "X.......X"
GD$(7) = GD$(7) + "X.......X"
GD$(7) = GD$(7) + "X.......X"
GD$(7) = GD$(7) + "X.......X"
 
         GD$(8) = "XXXXXXXXX"
GD$(8) = GD$(8) + ".X......."
GD$(8) = GD$(8) + "..X......"
GD$(8) = GD$(8) + "...X....."
GD$(8) = GD$(8) + "....XXXXX"
GD$(8) = GD$(8) + "...X....."
GD$(8) = GD$(8) + "..X......"
GD$(8) = GD$(8) + ".X......."
GD$(8) = GD$(8) + "XXXXXXXXX"
 
' F0NT UDT
TYPE F0NT
    glyph_width AS INTEGER
    glyph_height AS INTEGER
    char AS STRING
    img AS LONG
END TYPE
DIM STARFIGHTER_FONT(CHARS) AS F0NT
 
' create the glyph images from the glyph data
DIM kolor AS LONG
kolor& = _RGB32(&HFF, &HFF, &HFF)
CALL F0NT.make_glyph("S", STARFIGHTER_FONT(0), GD$(0), kolor&)
CALL F0NT.make_glyph("T", STARFIGHTER_FONT(1), GD$(1), kolor&)
CALL F0NT.make_glyph("A", STARFIGHTER_FONT(2), GD$(2), kolor&)
CALL F0NT.make_glyph("R", STARFIGHTER_FONT(3), GD$(3), kolor&)
CALL F0NT.make_glyph("F", STARFIGHTER_FONT(4), GD$(4), kolor&)
CALL F0NT.make_glyph("I", STARFIGHTER_FONT(5), GD$(5), kolor&)
CALL F0NT.make_glyph("G", STARFIGHTER_FONT(6), GD$(6), kolor&)
CALL F0NT.make_glyph("H", STARFIGHTER_FONT(7), GD$(7), kolor&)
CALL F0NT.make_glyph("E", STARFIGHTER_FONT(8), GD$(8), kolor&)
 
' prepare for output
_DEST CANVAS&
COLOR 0, _RGB32(&H00, &H00, &HAA)
CLS
 
' test 1
DIM AS INTEGER x, y, scale, kerning, spacing
x% = 50 : y% = 50 : scale% = 1 : kerning% = 2 : spacing% = 0
CALL F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, kerning%, spacing%)
 
' test 2
x% = 50 : y% = 150 : scale% = 4 : kerning% = 0 : spacing% = 4
CALL F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, kerning%, spacing%)
 
' test 3
x% = 0 : y% = 450 : scale% = 7 : kerning% = 0 : spacing% = 1
CALL F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, kerning%, spacing%)
 
' test 4
x% = 0 : y% = 600 : scale% = 8 : kerning% = -5 : spacing% = 0
CALL F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, kerning%, spacing%)
CALL F0NT.free(STARFIGHTER_FONT())
 
 
 
''
' Free the font glyph images from memory
'
' @param F0NT ARRAY f()
' 
SUB F0NT.free(f() AS F0NT)
    DIM AS INTEGER i, lb, ub
    lb% = LBOUND(f) : ub% = UBOUND(f)
    FOR i% = lb% TO ub%
        _FREEIMAGE f(i%).img&
    NEXT i%
END SUB
 
 
''
' Make a glyph from glyph data and store it in F0NT
'
' @param STRING c$ glyph character identifier
' @param F0NT ARRAY f() 
' @param STRING ARRAY glyph_data$() 
' @param LONG kolor& to make glyphs
' 
SUB F0NT.make_glyph(c$, f AS F0NT, glyph_data$, kolor&)
    DIM AS INTEGER y, x, p, dbg
    DIM s AS STRING
    DIM old_dest AS LONG
    ' dbg% = -1
    f.char$ = c$
    IF dbg% THEN PRINT c$
    f.img&  = _NEWIMAGE(COLS, ROWS, BPP)
    old_dest& = _DEST : _DEST f.img&
    _CLEARCOLOR _RGB32(&H00, &H00, &H00)
    FOR y% = 0 TO ROWS
        FOR x% = 0 TO COLS
            p% = (y% * COLS) + x% + 1
            s$ = MID$(glyph_data$, p%, 1)
            IF dbg% THEN
                _DEST old_dest& : PRINT s$; : _DEST f.img&
            END IF
            IF s$ <> "." THEN
                CALL PSET((x%, y%), kolor&)
            END IF            
        NEXT x%
        IF dbg% THEN
            _DEST old_dest& : PRINT : _DEST f.img&
        END IF
    NEXT y%
    IF dbg% THEN SLEEP
    _DEST old_dest&
END SUB
 
 
''
' Get a glyph image from a F0NT by character identifier
'
' @param STRING c$ character identifier of glyph to get
' @param F0NT ARRAY f()
' @return LONG image handle for glyph image of F0NT
'
FUNCTION F0NT.get_glyph&(c$, f() AS F0NT)
    DIM AS INTEGER i, lb, ub
    lb% = LBOUND(f) : ub% = UBOUND(f)
    FOR i% = lb% TO ub%
        IF f(i%).char$ = c$ THEN
            F0NT.get_glyph& = f(i%).img&
            EXIT FUNCTION
        END IF
    NEXT i%
END FUNCTION
 
 
''
' Print something using a F0NT
'
' @param STRING s$ what to print
' @param F0NT ARRAY f()
' @param INTEGER x% position
' @param INTEGER y% position
' @param INTEGER scale% size multiplier
' @param INTEGER kerning% scaling space between characters
' @param INTEGER spacing% spaces between characters
'
SUB F0NT.print(s$, f() AS F0NT, x%, y%, scale%, kerning%, spacing%)
    DIM AS INTEGER i, l, dx1, dy1, dx2, dy2, orig_x
    DIM c AS STRING
    DIM g AS LONG
    l% = LEN(s$)
    orig_x% = x%
    x% = -scale% * (COLS + 1) + orig_x%
    PSET (x%, y%)
    FOR i% = 0 TO l%
        c$ = MID$(s$, i%, 1)
        g& = F0NT.get_glyph(c$, f()) 
        _SOURCE g&
        dx1%  = x% + ((i% * (COLS + kerning%) * scale%)) + (i% * (spacing% * COLS))
        dy1%  = y%
        dx2%  = (COLS * scale%) + dx1%
        dy2%  = (ROWS * scale%) + dy1%
        _PUTIMAGE (dx1%, dy1%)-(dx2%, dy2%)
    NEXT i%
END SUB

Attached Files

Thumbnail(s)
   

https://www.reddit.com/r/BASICAnywhereMa..._bamified/

https://www.reddit.com/r/BASICAnywhereMa...r_palette/

Greetings QB64 PE fam!

Since the rest of the universe uses

CODE

_NEWIMAGE(800, 600, 32)

" and "

 
PRINT "HELLO QB64 PE Fam!"

Good morning!

I am very pleased to see that the development of QB64 has not stopped. Thank you all for your commitment and perseverance!
I also hope that you are all well because these are very difficult times.

A question: I had found, here on the forums, a procedure for a simple but very efficient and streamlined word processor but now I just can not find it.

Can someone tell me where it is?

Thank you!

My program generates 12 output files that then need to be sorted, and I'd rather do those sorts from within the app (via SHELL) than have to use SORT standalone from the command line afterwards.

Here's an example of how I'm calling it:

Sort_Command$ = "SORT " + "x.x" + " >> " + "y.y"
SHELL Sort_Command$

If I type that sort command on the command line I get y.y as a sorted version of x.x ... which is desired.

However when executed via SHELL a message flashes up in the output window (too fast to read before a blank window replaces it), and no sort occurs.

I have used SHELL previously with other commands and experienced no problems.

Is there a way of directing the contents of the output window to a file, so that I can read whatever is being shown on that?

I vaguely remember something about this at the old .com forum, but I forget the reason, so I thought I'd just ask about it here.

Why are variable used with FOR/NEXT +1 more at the end?  I was doing a count using a FOR/NEXT variable and couldn't figure out why afterwards the variable end up +1 number higher when over. 

In this example, the FOR/NEXT prints all 10 t's, but when printing the last t value over, it's at 11, and the FOR/NEXT never went to 11.  Why is that?

- Dav

 
'print 10 t's
 
For t = 1 To 10 'stop t at 10
    Print t
Next
 
'so t is 10...but...
 
Print
Print
Print t 'this show 11 now?

Implementing _RGBA in BAM would be, I think, I real nightmare.

Instead, I'm thinking better to set an include library with this "RgbaPset" function.  Question is: am I right in thinking this yields the same as what _RGBA  would do color-wise ?

Started updating my little Ball SUB (filled circle), thought I'd build it up over time by adding different kinds of textures to the balls, instead of just plain solid colors.   Although this is nowhere near the speed of the gold standard fcirc routine, it can be handy, and it's easy to drop the SUB in your programs.

So far it can draw 6 kinds of filled balls.  Solid, Gradient, and some textures like grainy, striped, plasma, mixed.  

I will come up with some more textures. If you'd like to add one, please do.

- Dav

 
'===========
'BALLSUB.BAS v1.0
'===========
'Simple Ball SUB that draws balls of different textures.
'Solid, Gradient, planet, plasma, noisey, striped, mixed.
'Coded by Dav, AUGUST/2023
 
Randomize Timer
 
Screen _NewImage(1000, 600, 32)
 
Do
    'make random ball to show all kinds
    ball Int(Rnd * 7), Rnd * _Width, Rnd * _Height, Rnd * 300 + 25, Rnd * 255, Rnd * 255, Rnd * 255, 100 + Rnd * 155
    _Limit 10
Loop Until InKey$ <> ""
 
 
Sub ball (kind, x, y, size, r, g, b, a)
    'SUB by Dav that draws many types of filled balls (circles).
    'Not super fast, but small and easy to add to your programs.
 
    'kind=0 (Gradient)
    'kind=1 (noisey)
    'kind=2 (planets)
    'kind=3 (plasma)
    'kind=4 (striped)
    'kind=5 (plasma mix with gradient noise)
    'kind=6 (solid)
 
    'get current display status to restore later
    displayStatus%% = _AutoDisplay
 
    'turn off screen updates while we draw
    _Display
 
    t = Timer
    For y2 = y - size To y + size
        For x2 = x - size To x + size
            If Sqr((x2 - x) ^ 2 + (y2 - y) ^ 2) <= size Then
                clr = (size - (Sqr((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size
                Select Case kind
                    Case 1: 'noisey (grainy)
                        noise = Rnd * 255
                    Case 2: 'planet
                        noise = 20 * Sin((x2 + y2) / 30) + 10 * Sin((x2 + y2) / 10)
                    Case 3: 'plasma
                        r = (Sin(x2 / (size / 4)) + Sin(y2 / size / 2)) * 128 + 128
                        g = (Sin(x2 / (size / 6)) + Cos(y2 / (size / 4))) * 128 + 128
                        b = (Cos(x2 / (size / 4)) + Sin(y2 / (size / 6))) * 128 + 128
                    Case 4: 'striped
                        dx = x2 - size: dy = y2 - size
                        dis = Sqr(dx * dx + dy * dy)
                        r = Sin(dis / 5) * 255
                        g = Cos(dis / 25) * 255
                        b = 255 - Sin(dis / 50) * 255
                    Case 5: 'plasma mix with gradient & noise
                        noise = Int(Rnd * 50)
                        r = Sin(6.005 * t) * size - y2 + size + 255
                        g = Sin(3.001 * t) * size - x2 + size + 255
                        b = Sin(2.001 * x2 / size + t + y2 / size) * r + 255
                        t = t + .00195
                    Case Else: 'solid & gradient (no noise)
                        noise = 0
                End Select
                If kind = 6 Then
                    'if solid color
                    PSet (x2, y2), _RGBA(r, g, b, a)
                Else
                    'all others, noise & gradient color aware
                    PSet (x2, y2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, a)
                End If
            End If
        Next
    Next
 
    'show the ball on the screen
    _Display
 
    'If autodislay was previously on, turn it back on
    If displayStatus%% = 1 Then _AutoDisplay
 
End Sub

Here's a little screen saver showing pulsating orbs over a starry background with plasma clouds.  I was playing around some old code, turned it into something new. Tested and runs OK under Windows and Linux.

- Dav 

 
'=============
'SpaceOrbs.bas
'=============
'Screensaver of Orbs pulsating in space
'Coded by Dav for QB64-PE, AUGUST/2023
 
RANDOMIZE TIMER
 
SCREEN _NEWIMAGE(1000, 640, 32)
 
 
'=== orb settings
 
orbs = 60 'number of orbs on screen
OrbSizeMin = 5 'smallest size an orb can get
OrbSizeMax = 60 'largest size an orb can get
 
DIM OrbX(orbs), OrbY(orbs), OrbSize(orbs), OrbGrowth(orbs)
 
 
'=== generate some random orb values
 
FOR i = 1 TO orbs
    OrbX(i) = RND * _WIDTH 'x pos
    OrbY(i) = RND * _HEIGHT 'y pos
    OrbSize(i) = OrbSizeMin + (RND * (OrbSizeMax - OrbSizeMin)) 'orb size
    OrbGrowth(i) = INT(RND * 2) 'way orb is changing, 0=shrinking, 1=growing
NEXT
 
 
'=== make a space background image
 
FOR i = 1 TO 100000
    PSET (RND * _WIDTH, RND * _HEIGHT), _RGBA(0, 0, RND * 255, RND * 225)
NEXT
FOR i = 1 TO 1000
    x = RND * _WIDTH: y = RND * _HEIGHT
    LINE (x, y)-(x + RND * 3, y + RND * 3), _RGBA(192, 192, 255, RND * 100), BF
NEXT
 
 
'=== grab screen image for repeated use
 
back& = _COPYIMAGE(_DISPLAY)
 
 
DO
 
    '=== place starry background first
 
    _PUTIMAGE (0, 0), back&
 
 
    '=== draw moving plasma curtain next
 
    t = TIMER
    FOR x = 0 TO _WIDTH STEP 3
        FOR y = 0 TO _HEIGHT STEP 3
            b = SIN(x / (_WIDTH / 2) + t + y / (_HEIGHT / 2))
            b = b * (SIN(1.1 * t) * (_HEIGHT / 2) - y + (_HEIGHT / 2))
            LINE (x, y)-STEP(2, 2), _RGBA(b / 3, 0, b, RND * 25), BF
        NEXT: t = t + .085
    NEXT
 
 
    '=== now process all the orbs
 
    FOR i = 1 TO orbs
 
        '=== draw orb on screen
 
        FOR y2 = OrbY(i) - OrbSize(i) TO OrbY(i) + OrbSize(i) STEP 3
            FOR x2 = OrbX(i) - OrbSize(i) TO OrbX(i) + OrbSize(i) STEP 3
                'make gradient plasma color
                IF SQR((x2 - OrbX(i)) ^ 2 + (y2 - OrbY(i)) ^ 2) <= OrbSize(i) THEN
                    clr = (OrbSize(i) - (SQR((x2 - OrbX(i)) * (x2 - OrbX(i)) + (y2 - OrbY(i)) * (y2 - OrbY(i))))) / OrbSize(i)
                    r = SIN(6.005 * t) * OrbSize(i) - y2 + OrbSize(i) + 255
                    g = SIN(3.001 * t) * OrbSize(i) - x2 + OrbSize(i) + 255
                    b = SIN(2.001 * x2 / OrbSize(i) + t + y2 / OrbSize(i)) * r + 255
                    LINE (x2, y2)-STEP(2, 2), _RGBA(clr * r, clr * g, clr * b, 5 + RND * 15), BF
                END IF
            NEXT
        NEXT
 
        '=== change orb values
 
        'if orb is shrinking, subtract from size, else add to it
        IF OrbGrowth(i) = 0 THEN OrbSize(i) = OrbSize(i) - 1 ELSE OrbSize(i) = OrbSize(i) + 1
        'if orb reaches maximum size, switch growth value to 0 to start shrinking now
        IF OrbSize(i) >= OrbSizeMax THEN OrbGrowth(i) = 0
        'if orb reaches minimum size, switch growth value to 1 to start growing now
        IF OrbSize(i) <= OrbSizeMin THEN OrbGrowth(i) = 1
        'creates the shakiness. randomly adjust x/y positions by +/-3 each
        IF INT(RND * 2) = 0 THEN OrbX(i) = OrbX(i) + 3 ELSE OrbX(i) = OrbX(i) - 3
        IF INT(RND * 2) = 0 THEN OrbY(i) = OrbY(i) + 3 ELSE OrbY(i) = OrbY(i) - 3
 
    NEXT
 
    _DISPLAY
 
    _LIMIT 15
 
LOOP UNTIL INKEY$ <> ""