![]() |
Font from a string pattern - help needed - Printable Version +- QB64 Phoenix Edition (https://qb64phoenix.com/forum) +-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1) +--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3) +---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9) +---- Thread: Font from a string pattern - help needed (/showthread.php?tid=1937) |
RE: Font from a string pattern - help needed - grymmjack - 08-27-2023 (08-27-2023, 01:42 AM)SMcNeill Wrote: I remember _PUTIMAGE from writing. In English class, we wrote essays and my teachers always told me they needed to include Who, What, When, Where, and How. _PUTIMAGE is very similar: Where, what, Which, How. Ah! This should go in the wiki! ![]() RE: Font from a string pattern - help needed - grymmjack - 08-27-2023 (08-27-2023, 01:15 AM)TerryRitchie Wrote:This also makes sense. Thanks @TerryRitchie.(08-26-2023, 11:59 PM)grymmjack Wrote: thanks @bplus I will try to use the full argument list. What the heck does `STEP` do in `_PUTIMAGE` ? Does this let us use like snap to grid or something? RE: Font from a string pattern - help needed - SMcNeill - 08-27-2023 (08-27-2023, 02:06 AM)grymmjack Wrote:STEP is basically from the last point, just like with LINE.(08-27-2023, 01:15 AM)TerryRitchie Wrote:This also makes sense. Thanks @TerryRitchie.(08-26-2023, 11:59 PM)grymmjack Wrote: thanks @bplus I will try to use the full argument list. LINE (100, 100) - STEP(300, 100), Red, BF The above draws a box starting at 100, 100 and draws it 300 pixels wide and 100 pixels high. It's the equivalent of: LINE (100, 100) - (400, 200), Red, BF Reason for usage?? Drawing set graphics at various points. LINE (x, y) - STEP (300, 100), Red, BF _PUTIMAGE works on that same style Widht/Height concept with STEP. RE: Font from a string pattern - help needed - bplus - 08-27-2023 I redid the print of font without kerning just spacing like extra pixel positions in letter block, much more manageable: Code: (Select All) Option _Explicit RE: Font from a string pattern - help needed - bplus - 08-27-2023 Ah! This should go in the wiki! ![]() Word for the day: https://qb64phoenix.com/forum/showthread.php?tid=1119 RE: Font from a string pattern - help needed - bplus - 08-27-2023 Tweaked testing demo to show spacing 0 to 4 for Scale 1 plus commented out an unnecessary pset in Font print routine: ``` Option _Explicit Option _ExplicitArray Const CHARS = 8 Const COLS = 9 Const ROWS = 9 Const BPP = 32 ' screen setup Dim CANVAS As Long CANVAS& = _NewImage(1200, 700, 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 Color &HFFFFFF00 _PrintString (50, 20), "Testing spacing 0 to 4 with scale = 1" For spacing% = 0 To 4 x% = 200 * spacing% + 50: y% = 50: scale% = 1 Call F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, spacing%) Next ' test 2 x% = 50: y% = 100: scale% = 4: kerning% = 0: spacing% = 4 Call F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, spacing%) ' test 3 x% = 50: y% = 200: scale% = 7: kerning% = 0: spacing% = 2 Call F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, spacing%) ' test 4 x% = 50: y% = 400: scale% = 8: spacing% = 2 Call F0NT.print("STARFIGHTER", STARFIGHTER_FONT(), x%, y%, scale%, 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%, spacing%) Dim As Integer i, l, dx1, dy1, dx2, dy2, orig_x Dim c As String Dim g As Long l% = Len(s$) ' PSet (x%, y%) For i% = 1 To l% c$ = Mid$(s$, i%, 1) 'g& = '_Source g& dx1% = x% + (i% - 1) * (COLS + spacing%) * scale% dy1% = y% 'dx2% = (COLS * scale%) + dx1% 'dy2% = (ROWS * scale%) + dy1% _PutImage (dx1%, dy1%)-Step(COLS * scale% - 1, ROWS * scale% - 1), F0NT.get_glyph(c$, f()) Next i% End Sub ``` RE: Font from a string pattern - help needed - grymmjack - 08-27-2023 (08-27-2023, 02:14 AM)bplus Wrote: I redid the print of font without kerning just spacing like extra pixel positions in letter block, much more manageable: @bplus Thanks! I will study this and compare it to the fixed version I landed on. Appreciate your help! ![]() RE: Font from a string pattern - help needed - grymmjack - 08-27-2023 (08-27-2023, 02:51 AM)bplus Wrote: Tweaked testing demo to show spacing 0 to 4 for Scale 1 plus commented out an unnecessary pset in Font print routine: Awesome! Thanks again! ![]() RE: Font from a string pattern - help needed - bplus - 08-27-2023 (08-27-2023, 04:07 PM)grymmjack Wrote:(08-27-2023, 02:51 AM)bplus Wrote: Tweaked testing demo to show spacing 0 to 4 for Scale 1 plus commented out an unnecessary pset in Font print routine: I reworked the whole deal to it's essence here: https://qb64phoenix.com/forum/showthread.php?tid=1938 RE: Font from a string pattern - help needed - grymmjack - 08-27-2023 (08-27-2023, 03:58 PM)grymmjack Wrote:This is so much nicer @bplus thank you.(08-27-2023, 02:14 AM)bplus Wrote: I redid the print of font without kerning just spacing like extra pixel positions in letter block, much more manageable: I am still studying, but simplified the code by a lot for `F0NT.print` ! |