Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Pete on August 15, 2021, 09:15:17 pm

Title: Hey graphic gurus, top this!!!
Post by: Pete on August 15, 2021, 09:15:17 pm
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]
  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
  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
  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
  63.  


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

Pete
Title: Re: Hey graphic gurus, top this!!!
Post by: bplus on August 15, 2021, 10:47:06 pm
Could probably do this before:
Code: QB64: [Select]
  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$)
  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
  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$; " ";
  26.  
Title: Re: Hey graphic gurus, top this!!!
Post by: Pete on August 16, 2021, 03:22:43 am
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

Title: Re: Hey graphic gurus, top this!!!
Post by: Petr on August 16, 2021, 01:19:33 pm
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]
  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$)
  12.  
  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
  26. cursim:
  27. CursorX = _FONTWIDTH * (cur - 1)
  28. IF blink THEN c$ = " " ELSE c$ = "_"
  29. blink = 1 - blink
  30.  
  32. _PRINTSTRING (StartGraphicX, StartGraphicY), word$ + " "
  34. IF blink THEN _PRINTSTRING (CursorX, CursorY), c$
  36.  
Title: Re: Hey graphic gurus, top this!!!
Post by: Petr on August 16, 2021, 01:48:44 pm
Or faster:

Code: QB64: [Select]
  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.  
  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.  
  30.     _PRINTSTRING (StartGraphicX, StartGraphicY), word$ + " "
  32.     IF blink THEN _PRINTSTRING (CursorX, CursorY), c$
  33.     _LIMIT 20
  35.  
  36. cursim:
  37. CursorX = _FONTWIDTH * (cur - 1)
  38. IF blink THEN c$ = " " ELSE c$ = "_"
  39. blink = 1 - blink
  41.  
Title: Re: Hey graphic gurus, top this!!!
Post by: Pete on August 16, 2021, 03:12:22 pm
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
Title: Re: Hey graphic gurus, top this!!!
Post by: bplus on August 16, 2021, 03:35:00 pm
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$)
  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
  21. cursim:
  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
  32.  
Title: Re: Hey graphic gurus, top this!!!
Post by: Petr on August 16, 2021, 03:45:39 pm
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.  
  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.  
  31.     _PRINTSTRING (StartGraphicX, StartGraphicY), word$ + " "
  32.  
  33.  
  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
  42.  
  43. cursim:
  44. CursorX = _FONTWIDTH * (cur - 1)
  45. IF blink THEN c$ = " " ELSE c$ = "_"
  46. blink = 1 - blink
  48.  
Title: Re: Hey graphic gurus, top this!!!
Post by: Pete on August 16, 2021, 04:27:55 pm
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
  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

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
Title: Re: Hey graphic gurus, top this!!!
Post by: Richard Frost on August 16, 2021, 11:24:50 pm
For 32 bit screens and a more advanced font:

Code: QB64: [Select]
  2. DEFLNG A-Z
  3. SCREEN _NEWIMAGE(800, 600, 32)
  4. f& = _LOADFONT("liberati.ttf", 16)
  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$
  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
  78.  
  79.  
Title: Re: Hey graphic gurus, top this!!!
Post by: bplus on August 17, 2021, 10:36:16 am
@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.
Title: Re: Hey graphic gurus, top this!!!
Post by: Pete on August 17, 2021, 03:22:46 pm
@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]
  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$
  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
  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

Text Only | Text with Attachments