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`
''
' 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
```
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.
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.
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?
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 ?
Code: (Select All)
SUB RgbaPset(x,y,r,g,b,a)
c = POINT(x,y)
c$ = RIGHT$("000000" + HEX$(c), 6)
cr = VAL("0x" + LEFT$(c$,2)) * 256 ^ 2
cg = VAL("0x" + MID$(c$,3,2)) * 256 ^ 1
cb = VAL("0x" + RIGHT$(c$,2))
PSET(x,y), { [cr * (255-a)/255 + r * a / 255] _
+ [cg * (255-a)/255 + g * a / 255] _
+ [cb * (255-a)/255 + b * a / 255] }
END SUB
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
Code: (Select All)
'===========
'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.
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
Code: (Select All)
'=============
'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
It's not fancy but it draws lines over 1 pixel in thickness.
Code: (Select All)
'draw_lineFT
' By James D. Jarvis August 21,2023
'draw a line with a defined thickness
Screen _NewImage(400, 500, 32)
Dim Shared tk&
tk& = _NewImage(3, 3, 32)
'*********************************************
'demo
'*********************************************
x1 = 100: y1 = 100
x2 = 300: y2 = 300
x3 = 100: y3 = 200
lineFT x1, y1, x2, y2, 10, _RGB32(200, 100, 0)
lineFT x2, y2, x3, y3, 10, _RGB32(200, 100, 0)
lineFT x1, y1, x3, y3, 10, _RGB32(200, 100, 0)
'*************** routines **********************
'lineFT - draw a thick line constructed from 2 mapped triangles
'DegTo - return angle (in degrees) between two points , used as an internal function in lineFT
'*********************************************
Sub lineFT (x1, y1, x2, y2, thk, klr As _Unsigned Long)
'draw a line of thickness thk on color klr from x1,y1 to x2,y2
'orientation of line is set in the middle of line thickness
_Dest tk&
Line (0, 0)-(2, 2), klr, BF 'set the color for the line
_Dest 0
cang = DegTo(x1, y1, x2, y2) 'get the angle from x1,y1 to x2,y2
ta = cang + 90
tb = ta + 180
tax1 = x1 + (thk / 2) * Cos(0.01745329 * ta)
tay1 = y1 + (thk / 2) * Sin(0.01745329 * ta)
tax4 = x1 + (thk / 2) * Cos(0.01745329 * tb)
tay4 = y1 + (thk / 2) * Sin(0.01745329 * tb)
tax2 = x2 + (thk / 2) * Cos(0.01745329 * ta)
tay2 = y2 + (thk / 2) * Sin(0.01745329 * ta)
tax3 = x2 + (thk / 2) * Cos(0.01745329 * tb)
tay3 = y2 + (thk / 2) * Sin(0.01745329 * tb)
_MapTriangle (0, 0)-(0, 2)-(2, 0), tk& To(tax1, tay1)-(tax2, tay2)-(tax4, tay4)
_MapTriangle (0, 0)-(0, 2)-(2, 0), tk& To(tax2, tay2)-(tax3, tay3)-(tax4, tay4)
End Sub
Function DegTo! (x1, y1, x2, y2)
'========================
' returns an angle in degrees from point x1,y1 to point x2,y2
aa! = _Atan2((y2 - y1), (x2 - x1)) / 0.01745329
DegTo! = aa!
End Function
