QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: SMcNeill on November 23, 2021, 12:21:00 pm

Title: PutText
Post by: SMcNeill on November 23, 2021, 12:21:00 pm

For all you SCREEN 0 herpes out there like Pete, here's PutText -- it's like PutImage, but for TextScreens!

Code: QB64: [Select]

1. FooBar = _NewImage(10, 5, 0)
2. _Dest FooBar
3. Color 4, 15: Locate 1, 1: Print "**********";
4. Color 15, 4: Locate 2, 1: Print "*-Foobar-*";
5. Color 4, 15: Locate 3, 1: Print "**********";
6. Color 2, 0: Locate 4, 1: Print "**********";
7. Locate 5, 1: Print "**********";
8. _Dest 0
9.  
10. PutText "(10,1)", FooBar, 0, "(1,1) to (10,3)"
11.  
12. Sleep
13.  
14. 'let's try to put the text at an off image coordinate
15. PutText "(0,0)", FooBar, 0, "(1,1) to  (10,5)"
16.  
17. Sleep
18.  
19. 'or off the right of the screen
20. PutText "(75,20)", FooBar, 0, "(1,1) to step (9,2)"
21. Sleep
22.  
23. _Delay .25
24. _KeyClear
25.  
26. x = 80
27. Do
28.     Cls
29.     PutText Str$(x) + ",3", FooBar, 0, "(1,1) to step (9,2)"
30.     _Limit 30
31.     _Display
32.     x = x - 1
33.     If x < -10 Then x = 80
34. Loop Until _KeyHit
35.  
36.  
37. Sub PutText (dest$, source, dest, source$)
38.     CurrentDest = _Dest: CurrentSource = _Source
39.     DC = _DefaultColor: BG = _BackgroundColor
40.     Type PutType
41.         x1 As Integer
42.         y1 As Integer
43.         x2 As Integer
44.         y2 As Integer
45.     End Type
46.     Dim As PutType d, s
47.  
48.  
49.     ParsePutParam dest$, d
50.     ParsePutParam source$, s
51.  
52.     _Source source: _Dest dest
53.     For x = s.x1 To s.x2 'Step Sgn(s.x2 - s.x1)
54.         For y = s.y1 To s.y2 'Step Sgn(s.y2 - s.y1)
55.             If x > 0 And x <= _Width(source) And y > 0 And y <= _Height(source) Then
56.                 p = Screen(y, x, 0)
57.                 c = Screen(y, x, 1)
58.                 x1 = d.x1 + x - s.x1: y1 = d.y1 + y - s.y1
59.                 If x1 > 0 And x1 <= _Width(dest) And y1 > 0 And y1 <= _Height(dest) Then
60.                     Color c Mod 16, c \ 16
61.                     _PrintString (x1, y1), Chr$(p)
62.                 End If
63.             End If
64.         Next
65.     Next
66.     _Dest CurrentDest: _Source CurrentSource
67.     Color DC, BG
68. End Sub
69.  
70. Sub ParsePutParam (param$, o As PutType)
71.     p$ = UCase$(_Trim$(param$))
72.     strip$ = "() "
73.     For j = 1 To Len(strip$)
74.         Do
75.             i = InStr(p$, Mid$(strip$, j, 1))
76.             If i Then p$ = Left$(p$, i - 1) + Mid$(p$, i + 1)
77.         Loop Until i = 0
78.     Next
79.     o.x1 = Val(p$)
80.     comma = InStr(p$, ",")
81.     If comma Then p$ = Mid$(p$, comma + 1) Else Exit Sub
82.  
83.     o.y1 = Val(p$)
84.     p$ = Mid$(p$, Len(_Trim$(Str$(o.y1))) + 1)
85.  
86.     If Left$(p$, 2) = "TO" Then p$ = Mid$(p$, 3) Else Exit Sub
87.  
88.     If Left$(p$, 4) = "STEP" Then
89.         o.x2 = o.x1: o.y2 = o.y1: p$ = Mid$(p$, 5)
90.     Else
91.         o.x2 = 0: o.y2 = 0
92.     End If
93.  
94.     o.x2 = o.x2 + Val(p$)
95.     comma = InStr(p$, ",")
96.  
97.     If comma Then p$ = Mid$(p$, comma + 1) Else Exit Sub
98.     o.y2 = o.y2 + Val(p$)
99. End Sub
100.  

I was going to build this to  work more like PutImage, but then I realized that wouldn't be possible with a text screen.  For instance, there's no way to stretch or scale the "image" here, since all text screens are stuck with a single font in use at a time, so I figured all I really needed was a singular destination point (x,y) rather than (x,y) to (x2,y2).   

Get the portion of text you want, put it where you want it.  It's that simple.

Another little change is that I tweaked the syntax to use "TO" instead of a dash ("-") to separate points. You never know -- somebody, somewhere, might be using WINDOW to work with negative screen coordinates, so I didn't want to run into issues with that dash getting screwed up with the parsing of a negative location.   "(10,10) TO STEP (-10,0)", for an example.

Currently I'm only printing text in an incremental fashion (from position 0 to 10, for instance rather than from 10 to 0), but I do plan on adding in the optionality later for bidirectional putting of text so we can reverse and flip text as wanted with one little command.  (I'll just need to wake up enough to sort out how to do it first!  LOL!)
 

Title: Re: PutText
Post by: SMcNeill on November 23, 2021, 04:42:04 pm

We now can flip and reverse text, just like we can with _PUTIMAGE:

Code: QB64: [Select]

1. FooBar = _NewImage(10, 5, 0)
2. _Dest FooBar
3. Color 4, 15: Locate 1, 1: Print "1********1";
4. Color 15, 4: Locate 2, 1: Print "2-Foobar-2";
5. Color 4, 15: Locate 3, 1: Print "3********3";
6. Color 2, 0: Locate 4, 1: Print "4********4";
7. Locate 5, 1: Print "*5*******5";
8. _Dest 0
9.  
10. PutText "(10,1)", FooBar, 0, "(1,1) to (10,3)"
11.  
12. Sleep
13.  
14. 'let's try to put the text backwards
15. PutText "(30,1)", FooBar, 0, "(10,1) to  (1,3)"
16.  
17. Sleep
18.  
19. 'next test is flipping from bottom to top
20. PutText "(50,1)", FooBar, 0, "(1,3) to (10,1)"
21. Sleep
22.  
23. _Delay .25
24. _KeyClear
25.  
26. x = 80
27. Do
28.     Cls
29.     PutText Str$(x) + ",3", FooBar, 0, "(10,1) to step (-9,2)"
30.     _Limit 30
31.     _Display
32.     x = x - 1
33.     If x < -10 Then x = 80
34. Loop Until _KeyHit
35.  
36.  
37. Sub PutText (dest$, source, dest, source$)
38.     CurrentDest = _Dest: CurrentSource = _Source
39.     DC = _DefaultColor: BG = _BackgroundColor
40.     Type PutType
41.         x1 As Integer
42.         y1 As Integer
43.         x2 As Integer
44.         y2 As Integer
45.     End Type
46.     Dim As PutType d, s
47.  
48.  
49.     ParsePutParam dest$, d
50.     ParsePutParam source$, s
51.  
52.     _Source source: _Dest dest
53.     For x = s.x1 To s.x2 Step Sgn(s.x2 - s.x1)
54.         y0 = 0
55.         For y = s.y1 To s.y2 Step Sgn(s.y2 - s.y1)
56.             If x > 0 And x <= _Width(source) And y > 0 And y <= _Height(source) Then
57.                 p = Screen(y, x, 0)
58.                 c = Screen(y, x, 1)
59.                 x1 = d.x1 + x0: y1 = d.y1 + y0
60.                 If x1 > 0 And x1 <= _Width(dest) And y1 > 0 And y1 <= _Height(dest) Then
61.                     Color c Mod 16, c \ 16
62.                     _PrintString (x1, y1), Chr$(p)
63.                 End If
64.             End If
65.             y0 = y0 + 1
66.         Next
67.         x0 = x0 + 1
68.     Next
69.     _Dest CurrentDest: _Source CurrentSource
70.     Color DC, BG
71. End Sub
72.  
73. Sub ParsePutParam (param$, o As PutType)
74.     p$ = UCase$(_Trim$(param$))
75.     strip$ = "() "
76.     For j = 1 To Len(strip$)
77.         Do
78.             i = InStr(p$, Mid$(strip$, j, 1))
79.             If i Then p$ = Left$(p$, i - 1) + Mid$(p$, i + 1)
80.         Loop Until i = 0
81.     Next
82.     o.x1 = Val(p$)
83.     comma = InStr(p$, ",")
84.     If comma Then p$ = Mid$(p$, comma + 1) Else Exit Sub
85.  
86.     o.y1 = Val(p$)
87.     p$ = Mid$(p$, Len(_Trim$(Str$(o.y1))) + 1)
88.  
89.     If Left$(p$, 2) = "TO" Then p$ = Mid$(p$, 3) Else Exit Sub
90.  
91.     If Left$(p$, 4) = "STEP" Then
92.         o.x2 = o.x1: o.y2 = o.y1: p$ = Mid$(p$, 5)
93.     Else
94.         o.x2 = 0: o.y2 = 0
95.     End If
96.  
97.     o.x2 = o.x2 + Val(p$)
98.     comma = InStr(p$, ",")
99.  
100.     If comma Then p$ = Mid$(p$, comma + 1) Else Exit Sub
101.     o.y2 = o.y2 + Val(p$)
102. End Sub
103.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Is there anything I'm overlooking for a text-style routine to mimic _PUTIMAGE?  It seems to me that this handles everything I can think to toss at it.  Selectable images/screens to copy/paste to; forward, backward, reverse, and bottom to top text; with safety built in for off-screen coordinates so it doesn't toss errors...   What am I missing?  If anything?

Title: Re: PutText
Post by: Dav on November 23, 2021, 06:51:17 pm

That's pretty slick!  I keep forgetting TYPE can be used inside a SUB.

Works fine here.

- Dav

Text Only | Text with Attachments