Hey graphic gurus, top this!!!

[Pete]

Going through some age old QB4.5 stuff I made during the Jurassic Period, and I came across this little ge I used back then to get a cursor effect in SCREEN 12. So is there a better way now in QB64?

Code: QB64: [Select]

1. SCREEN 12
2. startpos% = 5
3. word$ = "This is a demo of a flashing cursor for a graphics screen."
4. LOCATE 5, startpos%: PRINT word$;
5.  
6. cur$ = "_"
7. z1 = TIMER
8. DO
9.     flag = 0
10.     _LIMIT 30
11.     b$ = INKEY$
12.     IF b$ = CHR$(27) THEN SYSTEM
13.  
14.     IF LEN(b$) THEN
15.         IF b$ = CHR$(0) + "R" THEN
16.             IF cur$ = "_" THEN
17.                 cur$ = CHR$(219)
18.             ELSE
19.                 cur$ = "_"
20.             END IF
21.         END IF
22.  
23.         IF b$ = CHR$(0) + "K" THEN
24.             IF POS(0) > startpos% THEN
25.                 GOSUB reprint
26.                 LOCATE , POS(0) - 1
27.             ELSE
28.                 flag = 0
29.             END IF
30.         END IF
31.  
32.         IF b$ = CHR$(0) + "M" THEN
33.             IF POS(0) < startpos% + LEN(word$) THEN
34.                 flag = 1
35.                 GOSUB reprint
36.             ELSE
37.                 flag = 0
38.             END IF
39.         END IF
40.  
41.     END IF
42.  
43.     IF ABS(z1 - TIMER) > .4 OR flag THEN
44.         SELECT CASE cursor
45.             CASE 0
46.                 cursor = -1
47.                 PRINT cur$;
48.                 LOCATE , POS(0) - 1
49.             CASE -1
50.                 cursor = 0
51.                 GOSUB reprint
52.         END SELECT
53.         z1 = TIMER
54.     END IF
55. LOOP
56.  
57. reprint:
58. c$ = MID$(word$, POS(0) - (startpos% - 1), 1)
59. IF c$ = "" THEN PRINT " "; ELSE PRINT c$;
60. IF flag <> 1 THEN LOCATE , POS(0) - 1
61. flag = -1
62. RETURN
63.  

Use arrow left and right, or press Insert key to change from a line to a full block cursor.

Pete

[bplus]

Could probably do this before:

Code: QB64: [Select]

1. Screen 12
2. start = 5
3. word$ = "This is a demo of a flashing cursor for a graphics screen."
4. Locate 5, start: Print word$;
5. On Timer(.4) GoSub cursim
6. cur = start + Len(word$)
7. Timer On
8. Do
9.     b$ = InKey$
10.     If b$ = Chr$(27) Then
11.         System
12.     ElseIf b$ = Chr$(0) + "R" Then
13.         insert = 1 - insert
14.     ElseIf b$ = Chr$(0) + "K" Then
15.         If cur > start Then cur = cur - 1
16.     ElseIf b$ = Chr$(0) + "M" Then
17.         If cur < start + Len(word$) Then cur = cur + 1
18.     End If
19.     _Limit 20
20. Loop
21. cursim:
22. If insert Then c$ = Chr$(219) Else c$ = "_"
23. blink = 1 - blink
24. If blink Then Locate , cur: Print c$; Else Locate 5, start: Print word$; " ";
25. Return
26.  

[Pete]

Same method... just more optimistic! :D

What's funny is using SELECT CASE instead of IF/THEN/ELSE actually would have added one extra line.

Anyway, optimization aside, and that was a nice job, btw, I'm still wondering if anyone has devised, or if QB64 has a native way, of putting a working cursor into a graphics word processor, other than this???

Pete

[Petr]

If graphic mode cursor, so why LOCATE? Oh i see, it is program created using QB4.5!

So here is my version (modified @bplus version), it calculate graphics coordinates from text coordinates and then use _PRINTSTRING.

Code: QB64: [Select]

1. SCREEN 12
2. start = 5
3. word$ = "This is a demo of a flashing cursor for a graphics screen."
4. LOCATE 5, start: PRINT word$;
5. StartGraphicX = _FONTWIDTH * (POS(_DEST) - LEN(word$) - 1)
6. StartGraphicY = _FONTHEIGHT * CSRLIN - (_FONTHEIGHT)
7. CursorY = _FONTHEIGHT * CSRLIN - (_FONTHEIGHT - 2) 'draw cursor two pixels under text
8.  
9. ON TIMER(.08) GOSUB cursim
10. cur = start + LEN(word$)
11. TIMER ON
12.  
13. DO
14.     b$ = INKEY$
15.     IF b$ = CHR$(27) THEN
16.         SYSTEM
17.     ELSEIF b$ = CHR$(0) + "R" THEN
18.         insert = 1 - insert
19.     ELSEIF b$ = CHR$(0) + "K" THEN
20.         IF cur > start THEN cur = cur - 1
21.     ELSEIF b$ = CHR$(0) + "M" THEN
22.         IF cur < start + LEN(word$) THEN cur = cur + 1
23.     END IF
24.     _LIMIT 20
25. LOOP
26. cursim:
27. CursorX = _FONTWIDTH * (cur - 1)
28. IF blink THEN c$ = " " ELSE c$ = "_"
29. blink = 1 - blink
30.  
31. _PRINTMODE _FILLBACKGROUND
32. _PRINTSTRING (StartGraphicX, StartGraphicY), word$ + " "
33. _PRINTMODE _KEEPBACKGROUND
34. IF blink THEN _PRINTSTRING (CursorX, CursorY), c$
35. RETURN
36.  

[Petr]

Or faster:

Code: QB64: [Select]

1. SCREEN 12
2. start = 5
3. word$ = "This is a demo of a flashing cursor for a graphics screen."
4. LOCATE 5, start: PRINT word$;
5. StartGraphicX = _FONTWIDTH * (POS(_DEST) - LEN(word$) - 1)
6. StartGraphicY = _FONTHEIGHT * CSRLIN - (_FONTHEIGHT)
7. CursorY = _FONTHEIGHT * CSRLIN - (_FONTHEIGHT - 2) 'draw cursor two pixels under text
8. StartTime = TIMER + .4
9.  
10. cur = start + LEN(word$)
11.  
12. DO
13.     b$ = INKEY$
14.     IF b$ = CHR$(27) THEN
15.         SYSTEM
16.     ELSEIF b$ = CHR$(0) + "R" THEN
17.         insert = 1 - insert
18.         GOSUB cursim
19.     ELSEIF b$ = CHR$(0) + "K" THEN
20.         IF cur > start THEN cur = cur - 1: GOSUB cursim
21.     ELSEIF b$ = CHR$(0) + "M" THEN
22.         IF cur < start + LEN(word$) THEN cur = cur + 1: GOSUB cursim
23.     END IF
24.     IF TIMER > StartTime THEN
25.         StartTime = TIMER + .4
26.         GOSUB cursim
27.     END IF
28.  
29.     _PRINTMODE _FILLBACKGROUND
30.     _PRINTSTRING (StartGraphicX, StartGraphicY), word$ + " "
31.     _PRINTMODE _KEEPBACKGROUND
32.     IF blink THEN _PRINTSTRING (CursorX, CursorY), c$
33.     _LIMIT 20
34. LOOP
35.  
36. cursim:
37. CursorX = _FONTWIDTH * (cur - 1)
38. IF blink THEN c$ = " " ELSE c$ = "_"
39. blink = 1 - blink
40. RETURN
41.  

[Pete]

Cool! You got the cursor to move under the characters, without the characters swapping out with the cursor (my blinking effect for when the cursor was under a character). That's a performance improvement on top of Mark's optimization improvement.

Oh wait, the insert wasn't completed in your example, so we can't change the cursor to a block by pressing the Insert key....

This part:

    ELSEIF b$ = CHR$(0) + "R" THEN
        insert = 1 - insert
        GOSUB cursim

So if you could add a way to show the cursor as a block instead of an underscore, when the Inert key is press once, that would be amazing, but I wonder if there is a way the block cursor could be made translucent, like it is in a SCREEN 0 app? Again, my approach in the old days was to swap out the letter characters with the block character to make an alternating blinking cursor and letter effect.

Pete

[bplus]

In 32 color mode:

Code: QB64: [Select]

1. Screen _NewImage(800, 600, 32)
2. start = 5
3. word$ = "This is a demo of a flashing cursor for a graphics screen."
4. Locate 5, start: Print word$;
5. On Timer(.4) GoSub cursim
6. cur = start + Len(word$)
7. Timer On
8. Do
9.     b$ = InKey$
10.     If b$ = Chr$(27) Then
11.         System
12.     ElseIf b$ = Chr$(0) + "R" Then
13.         insert = 1 - insert
14.     ElseIf b$ = Chr$(0) + "K" Then
15.         If cur > start Then cur = cur - 1
16.     ElseIf b$ = Chr$(0) + "M" Then
17.         If cur < start + Len(word$) Then cur = cur + 1
18.     End If
19.     _Limit 20
20. Loop
21. cursim:
22. Cls
23. If insert Then c$ = Chr$(219): Else c$ = "_"
24. Locate 5, start: Print word$; " ";
25. blink = 1 - blink
26. If blink Then
27.     Color _RGB32(255, 255, 255, 160), 0
28.     Locate 5, cur: Print c$;
29.     Color &HFFFFFFFF
30. End If
31. Return
32.  

[Petr]

INSERT key supported now:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 240, 32)
2. start = 5
3. word$ = "This is a demo of a flashing cursor for a graphics screen."
4. LOCATE 5, start: PRINT word$;
5. StartGraphicX = _FONTWIDTH * (POS(_DEST) - LEN(word$) - 1)
6. StartGraphicY = _FONTHEIGHT * CSRLIN - (_FONTHEIGHT)
7. CursorY = _FONTHEIGHT * CSRLIN - (_FONTHEIGHT - 2) 'draw cursor two pixels under text
8. StartTime = TIMER + .4
9.  
10. cur = start + LEN(word$)
11.  
12. DO
13.     b$ = INKEY$
14.     IF b$ = CHR$(27) THEN
15.         SYSTEM
16.     ELSEIF b$ = CHR$(0) + "R" THEN
17.         insert = 1 - insert
18.         GOSUB cursim
19.     ELSEIF b$ = CHR$(0) + "K" THEN
20.         IF cur > start THEN cur = cur - 1: GOSUB cursim
21.     ELSEIF b$ = CHR$(0) + "M" THEN
22.         IF cur < start + LEN(word$) THEN cur = cur + 1: GOSUB cursim
23.     END IF
24.     IF TIMER > StartTime THEN
25.         StartTime = TIMER + .4
26.         GOSUB cursim
27.     END IF
28.  
29.  
30.     _PRINTMODE _FILLBACKGROUND
31.     _PRINTSTRING (StartGraphicX, StartGraphicY), word$ + " "
32.  
33.  
34.     _PRINTMODE _KEEPBACKGROUND
35.     COLOR _RGB32(255)
36.     IF insert THEN c$ = CHR$(219)
37.     IF insert AND blink THEN COLOR _RGBA32(255, 255, 255, 127): _PRINTSTRING (CursorX, StartGraphicY), c$: _LIMIT 20: _CONTINUE 'character Ű is printed to the same coordinates as word$ characters
38.     IF insert AND NOT blink THEN COLOR _RGB32(255): _PRINTSTRING (CursorX, StartGraphicY), c$: _LIMIT 20: _CONTINUE
39.     IF blink THEN _PRINTSTRING (CursorX, CursorY), c$
40.     _LIMIT 20
41. LOOP
42.  
43. cursim:
44. CursorX = _FONTWIDTH * (cur - 1)
45. IF blink THEN c$ = " " ELSE c$ = "_"
46. blink = 1 - blink
47. RETURN
48.  

[Pete]

Wow, we're certainly getting somewhere with this. I do know my system is the slowest of the bunch here, and as such, the CLS in Mark's example makes the sentence jump around a bit. Also, the arrow keys are not quite as smooth. The translucent cursor appearance, however, is reMarkable! I wish the QB64 IDE switched to it.

While Petr is twice as much code, the absence of CLS makes it so there is no jittery effects on my slow-ascii system and the arrow keys create a smooth movement, better than my initial SCREEN 12 example. I'm not sure if the cursor could be made to look like the effect mark posted, or not. I tried to fiddle with a marriage between the two, but since graphics isn't my thing, I came up empty.

Now if SCREEN 0 didn't have a native cursor, I'd make a more complex version of this tiny demo:

Code: QB64: [Select]

1. LOCATE 5, 5
2. PRINT "This is a flashing block cursor example in SCREEN 0."
3. LOCATE 5, 24
4. DO
5.     COLOR 0, 7: PRINT "b";: LOCATE , POS(0) - 1
6.     _DELAY .4
7.     COLOR 7, 0: PRINT "b";: LOCATE , POS(0) - 1
8.     _DELAY .4
9. LOOP UNTIL INKEY$ = CHR$(27)

Of course with any build we have to consider printing to the far right edge of the screen (screws with locate) or for a block cursor, especially the one I coded above, what the appearance will be over color or especially already highlighted text.

Pete

[Richard Frost]

For 32 bit screens and a more advanced font:

Code: QB64: [Select]

1. $COLOR:32
2. DEFLNG A-Z
3. SCREEN _NEWIMAGE(800, 600, 32)
4. f& = _LOADFONT("liberati.ttf", 16)
5. _FONT f&
6. x = 100
7. y = 100
8. maxchars = 60
9. _PRINTSTRING (x, y + 99), "Ins, Del, Home, End, arrow keys and Esc active."
10. z$ = GetField("Mary had a little lamb, some peas, and a salad.", x, y, maxchars)
11. COLOR Black, White
12. _PRINTSTRING (x, y + 40), z$
13. END
14.  
15. FUNCTION GetField$ (t$, x, y, maxchars)
16.     DIM a, i, p, tx, c$
17.     t$ = LEFT$(t$ + SPACE$(maxchars), maxchars)
18.     p = 1
19.     DO: _LIMIT 20
20.         tx = x
21.         LINE (x, y)-(x + _PRINTWIDTH(t$) + 20, y + 16), _RGB32(0), BF
22.         FOR i = 1 TO maxchars
23.             c$ = MID$(t$, i, 1)
24.             COLOR White, _RGB32(0, 0, 0, 0)
25.             IF i = p THEN
26.                 sx = x
27.                 IF TIMER > cc! THEN
28.                     bit = bit XOR 1
29.                     cc! = TIMER + .2
30.                 END IF
31.                 IF insertmode THEN
32.                     LINE (tx, y)-(tx + _PRINTWIDTH(c$), y + 16), _RGB32(bit * 200), BF ' insert cursor
33.                     IF bit THEN COLOR Black, _RGB32(0, 0, 0, 0) '                        black on zip
34.                 ELSE
35.                     LINE (tx, y + 16)-STEP(_PRINTWIDTH(c$), 0), _RGB32(bit * 200) '      underline cursor
36.                 END IF
37.             END IF
38.             _PRINTSTRING (tx, y), c$
39.             tx = tx + _PRINTWIDTH(c$)
40.         NEXT i
41.         _DISPLAY '                                                                       text and cursor
42.         COLOR White, Black '                                                             regular colors
43.         _PRINTSTRING (x, y), t$ '                                                        text only, preparing for Enter
44.         i$ = INKEY$
45.         SELECT CASE LEN(i$)
46.             CASE IS = 1
47.                 IF i$ = CHR$(27) THEN SYSTEM '                                           Esc
48.                 IF i$ = CHR$(13) THEN '                                                  Enter
49.                     GetField$ = LTRIM$(RTRIM$(t$))
50.                     _DISPLAY
51.                     _AUTODISPLAY
52.                     EXIT FUNCTION
53.                 END IF
54.                 IF i$ = CHR$(8) THEN '                                                   backspace
55.                     p = p - 1 - (p = 1)
56.                     t$ = LEFT$(t$, p - 1) + RIGHT$(t$, maxchars - p) + " "
57.                     _CONTINUE
58.                 END IF
59.                 IF insertmode THEN
60.                     t$ = LEFT$(LEFT$(t$, p - 1) + i$ + RIGHT$(t$, LEN(t$) - p + 1) + SPACE$(10), maxchars)
61.                 ELSE
62.                     MID$(t$, p, 1) = i$
63.                 END IF
64.                 p = p + 1
65.                 IF p > maxchars THEN p = maxchars: SOUND 4444, 1
66.             CASE IS = 2
67.                 a = ASC(RIGHT$(i$, 1))
68.                 IF a = 71 THEN p = 1 '                                                   Home
69.                 IF a = 79 THEN p = LEN(RTRIM$(t$)) + 1 '                                 End
70.                 IF a = 82 THEN insertmode = insertmode XOR 1 '                           Ins
71.                 IF a = 83 THEN t$ = LEFT$(t$, p - 1) + RIGHT$(t$, maxchars - p) + " " '  Del
72.                 p = p + (a = 75) - (a = 77) '                                            left or right arrow
73.                 IF p < 1 THEN p = 1
74.                 IF p > maxchars THEN p = maxchars
75.         END SELECT
76.     LOOP
77. END FUNCTION
78.  
79.  

[bplus]

@Richard Frost

Nice works fine without the font. This looks better than Pete spec'd as long as doesn't give him the jitters. ;-))

I could use this over my graphics Input fix, better cursor.

[Pete]

@Richard Frost : Very nice! I see it's limited to 32-color use. I'm not sure how that would effect all users. It's very smooth and looks exactly like a SCREEN 0 cursor routine.

I think it works with the block cursor like the example I showed where the background and foreground colors get swapped in a time loop. The only problem I see here is a user always needs a blank space at the end of the sentence, or the cursor disappears. You can see that by trying my stripped down version of it, below...

Code: QB64: [Select]

1. $COLOR:32
2. SCREEN _NEWIMAGE(800, 600, 32)
3. x = 100 ' start column
4. y = 100 ' start row
5. sentence$ = "This is a demo of a flashing cursor for a graphics screen."
6. maxchars = LEN(sentence$)
7. z$ = GetField(sentence$, x, y, maxchars)
8. COLOR Black, White
9. _PRINTSTRING (x, y + 40), z$
10. END
11.  
12. FUNCTION GetField$ (t$, x, y, maxchars)
13.     t$ = LEFT$(t$ + SPACE$(maxchars), maxchars)
14.     DO: _LIMIT 20
15.         tx = x
16.         LINE (x, y)-(x + _PRINTWIDTH(t$) + 20, y + 16), _RGB32(0), BF
17.         FOR i = 1 TO maxchars
18.             c$ = MID$(t$, i, 1)
19.             COLOR White, _RGB32(0, 0, 0, 0)
20.             IF i = POS(0) THEN
21.                 sx = x
22.                 IF TIMER > cc! THEN
23.                     bit = bit XOR 1
24.                     cc! = TIMER + .2
25.                 END IF
26.                 IF insertmode THEN
27.                     LINE (tx, y)-(tx + _PRINTWIDTH(c$), y + 16), _RGB32(bit * 200), BF ' insert cursor
28.                     IF bit THEN COLOR Black, _RGB32(0, 0, 0, 0) '                        black on zip
29.                 ELSE
30.                     LINE (tx, y + 16)-STEP(_PRINTWIDTH(c$), 0), _RGB32(bit * 200) '      underline cursor
31.                 END IF
32.             END IF
33.             _PRINTSTRING (tx, y), c$
34.             tx = tx + _PRINTWIDTH(c$)
35.         NEXT i
36.         _DISPLAY ' text and cursor
37.         COLOR White, Black ' default colors
38.         _PRINTSTRING (x, y), t$
39.         i$ = INKEY$
40.         SELECT CASE LEN(i$)
41.             CASE IS = 1
42.                 IF i$ = CHR$(27) THEN SYSTEM
43.                 IF insertmode THEN
44.                     t$ = LEFT$(LEFT$(t$, POS(0) - 1) + i$ + RIGHT$(t$, LEN(t$) - POS(0) + 1), maxchars)
45.                 ELSE
46.                     MID$(t$, POS(0), 1) = i$
47.                 END IF
48.             CASE IS = 2
49.                 IF RIGHT$(i$, 1) = "M" THEN LOCATE , POS(0) + 1 ' No limiter added yet!
50.                 IF RIGHT$(i$, 1) = "K" THEN if pos(0)> 1 then LOCATE , POS(0) - 1
51.                 IF ASC(RIGHT$(i$, 1)) = 82 THEN insertmode = insertmode XOR 1 ' Ins
52.         END SELECT
53.     LOOP
54. END FUNCTION
55.  

Notes:

I did not make a way to stop the left and right cursor movement.

I replaced the "p" variable with pos(0). It works, but it would need a limitation using maxchars if a way to get the cursor showing after the last character of the sentence is figured out.


Pete