Author Topic: Another line editor (Read 4237 times)

NOVARSEG · « **Reply #15 on:** April 19, 2021, 03:24:34 am »

Basic mouse select

Code: QB64: [Select]

DIM T AS _UNSIGNED LONG
DIM Handle AS LONG
DIM curWidth AS INTEGER
DIM curPosX AS INTEGER
DIM curOffset AS _UNSIGNED LONG
DIM newcurOffset AS _UNSIGNED LONG
DIM mouseOffset AS _UNSIGNED LONG
DIM newmouseOffset AS _UNSIGNED LONG
DIM newSelectOffset AS _UNSIGNED LONG
DIM selectOffset AS _UNSIGNED LONG
 
 
DIM CharWidth AS INTEGER
DIM printPos AS INTEGER
DIM kh AS LONG
DIM T1 AS SINGLE
DIM F AS _UNSIGNED _BIT
DIM F1 AS INTEGER
 
DIM insertKeyToggle AS _UNSIGNED _BIT
DIM pixelUpDown AS INTEGER
DIM Text AS STRING
DIM X AS INTEGER
DIM X1 AS INTEGER
DIM Y AS INTEGER
DIM X2 AS INTEGER
DIM Z AS INTEGER
 
DIM selectPosLeftX AS INTEGER
DIM selectPosTopY AS INTEGER
DIM selectPosRightX AS INTEGER
DIM selectPosLowY AS INTEGER
 
 
DIM lines AS INTEGER
lines = 5 * 16
 
 
Text = "Some text to edit"
 
Handle = _NEWIMAGE(400, 400, 32)
SCREEN Handle
DIM M AS _MEM
M = _MEMIMAGE(Handle)
 
DIM r AS _UNSIGNED _BYTE
DIM g AS _UNSIGNED _BYTE
DIM b AS _UNSIGNED _BYTE
 
_FULLSCREEN
 
PRINT
PRINT "Move cursor with left / right arrow"
 
PRINT "Insert / Type over, Append, Delete, Backspace"
 
PRINT "Move text with up / down arrow. ESC to exit"
PRINT
PRINT Text
 
curWidth = (_PRINTWIDTH(CHR$(a)) - 2)
 
CharHeight = _FONTHEIGHT
CharWidth = _PRINTWIDTH(CHR$(a))
 
 
curPosX = _PRINTWIDTH(Text)
curOffset = _WIDTH * (15 + lines) + curPosX 'initial
 
 
GOSUB curon
F = 0
 
 
DO
    X = 0
    T1 = TIMER
    DO
 
        _LIMIT 1000
 
        IF _MOUSEINPUT = -1 THEN
            X = _MOUSEX
            Y = _MOUSEY
            IF X < 0 THEN EXIT DO
            IF Y < 0 THEN EXIT DO
            GOSUB curmouseoff
            IF Y + CharHeight < _HEIGHT THEN mouseOffset = Y * _WIDTH + X
            GOSUB curmouseon
 
            IF _MOUSEBUTTON(1) = 0 AND F1 = 1 THEN F1 = 0
            ' IF _MOUSEBUTTON(1) = 0 AND F1 = 3 THEN F1 = 0
 
            IF _MOUSEBUTTON(1) = -1 AND F1 = 1 THEN 'Left mouse button held down to select
                selectPosRightX = X
                selectPosLowY = Y
                GOSUB curSelect
            END IF
 
            IF _MOUSEBUTTON(1) = -1 AND F1 = 0 THEN 'Initial top left position of select block
                F1 = 1
                selectOffset = mouseOffset
                selectPosLeftX = X
                selectPosTopY = Y
            END IF
 
 
        END IF
 
 
        kh = _KEYHIT
 
        IF kh = 20992 AND insertKeyToggle = 0 AND LEN(Text) >= printPos THEN
            insertKeyToggle = 1 'TYPEOVER mode
            kh = 0
            T1 = TIMER
            GOSUB curoff
            GOSUB cursolidon
            F = 0
        END IF
 
        IF kh = 20992 AND insertKeyToggle = 1 AND LEN(Text) >= printPos THEN
            insertKeyToggle = 0 'INSERT MODE
            kh = 0
            T1 = TIMER
            GOSUB cursolidoff
            GOSUB curon
            F = 0
        END IF
 
        IF insertKeyToggle = 1 THEN
            IF TIMER - T1 > .3 AND F = 1 THEN
                F = 0
                T1 = TIMER
                GOSUB cursolidon
            END IF
        END IF
 
        IF insertKeyToggle = 1 THEN
            IF TIMER - T1 > .3 AND F = 0 THEN
                F = 1
                T1 = TIMER
                GOSUB cursolidoff
            END IF
        END IF
 
        IF insertKeyToggle = 0 THEN
            IF TIMER - T1 > .3 AND F = 0 THEN
                F = 1
                T1 = TIMER
                GOSUB curoff
            END IF
            IF TIMER - T1 > .3 AND F = 1 THEN
                F = 0
                T1 = TIMER
                GOSUB curon
            END IF
        END IF
 
        IF kh > 0 AND insertKeyToggle = 1 THEN GOSUB cursolidon: EXIT DO
        IF kh > 0 AND insertKeyToggle = 0 THEN GOSUB curon: EXIT DO
    LOOP
 
 
    ' PRINT kh
 
    IF kh = 27 THEN END
 
    IF kh = 8 AND curPosX > 0 THEN 'BACKSPACE
        IF insertKeyToggle = 1 THEN GOSUB cursolidoff: insertKeyToggle = 0: GOTO LL3
        GOSUB curoff
        Text = LEFT$(Text, printPos - 2) + MID$(Text, printPos, LEN(Text) - (printPos - 1))
        curPosX = curPosX - CharWidth
        curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
        _PRINTSTRING (0, lines + pixelUpDown), Text + " "
        GOSUB curon
        LL3:
    END IF
    '****
 
    '****
    IF kh > 31 AND kh < 127 AND LEN(Text) < printPos AND _PRINTWIDTH(Text) + CharWidth < _WIDTH THEN 'APPEND
        Text = Text + CHR$(kh)
        curPosX = _PRINTWIDTH(Text)
        curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
        _PRINTSTRING (0, lines + pixelUpDown), Text
        GOSUB curon
    END IF
    '****
 
    '****
    IF kh > 31 AND kh < 127 AND LEN(Text) >= printPos AND _PRINTWIDTH(Text) + CharWidth < _WIDTH THEN 'INSERT TYPE OVER
        IF insertKeyToggle = 0 THEN 'INSERT MODE
            Text = LEFT$(Text, printPos - 1) + CHR$(kh) + MID$(Text, printPos, LEN(Text) - printPos + 1)
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB curon
        END IF
 
        IF insertKeyToggle = 1 AND LEN(Text) = printPos THEN 'cursor is pointing to last character
            insertKeyToggle = 0
            GOSUB cursolidoff
            Text = LEFT$(Text, printPos - 1) + CHR$(kh) + MID$(Text, printPos + 1, LEN(Text) - (printPos))
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text + " "
            GOSUB curon
        END IF
 
        IF insertKeyToggle = 1 AND LEN(Text) > printPos THEN 'cursor is pointing to any char except last char
            GOSUB cursolidoff
            Text = LEFT$(Text, printPos - 1) + CHR$(kh) + MID$(Text, printPos + 1, LEN(Text) - (printPos))
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text + " "
            GOSUB cursolidon
        END IF
    END IF 'END INSERT OR TYPE OVER
 
    '****
 
    '****
 
    IF kh = 21248 AND LEN(Text) >= printPos AND _PRINTWIDTH(Text) <= _WIDTH THEN 'DELETE
        IF insertKeyToggle = 1 THEN GOSUB cursolidoff: insertKeyToggle = 0: GOTO LL1
 
        Text = LEFT$(Text, printPos - 1) + MID$(Text, printPos + 1, LEN(Text) - printPos + 1)
        curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX '
        _PRINTSTRING (0, lines + pixelUpDown), Text + " "
        GOSUB curon
        LL1:
    END IF
 
    '****
 
    '****
 
    IF kh = 19200 AND curPosX > 0 THEN 'LEFT ARROW
 
        IF insertKeyToggle = 1 AND LEN(Text) >= printPos THEN
            GOSUB cursolidoff
            curPosX = curPosX - CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB cursolidon
        END IF
 
        IF insertKeyToggle = 0 THEN
            GOSUB curoff
            curPosX = curPosX - CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB curon
        END IF
 
    END IF 'END LEFT ARROW
 
    '****
 
    '****
    IF kh = 19712 AND curPosX < _PRINTWIDTH(Text) AND _PRINTWIDTH(Text) < _WIDTH THEN 'RIGHT ARROW
 
        IF insertKeyToggle = 1 AND LEN(Text) = printPos THEN
            insertKeyToggle = 0
            GOSUB cursolidoff
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB curon
            GOTO LL2
        END IF
 
        IF insertKeyToggle = 1 AND LEN(Text) > printPos THEN
            GOSUB cursolidoff
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB cursolidon
        END IF
 
        IF insertKeyToggle = 0 THEN
            GOSUB curoff
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB curon
        END IF
        LL2:
 
    END IF 'END RIGHT ARROW
    '****
 
    '****
    IF kh = 20480 AND lines + pixelUpDown + CharHeight < _HEIGHT THEN 'DOWN ARROW
 
        IF insertKeyToggle = 1 THEN
            pixelUpDown = pixelUpDown + 1
            GOSUB cursolidoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB cursolidon
        END IF
 
        IF insertKeyToggle = 0 THEN
            pixelUpDown = pixelUpDown + 1
            GOSUB curoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB curon
        END IF
    END IF
    '**** END DOWN ARROW
 
    '****
    IF kh = 18432 AND lines + pixelUpDown > lines THEN 'UP ARROW
 
        IF insertKeyToggle = 1 THEN
            pixelUpDown = pixelUpDown - 1
            GOSUB cursolidoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB cursolidon
        END IF
        IF insertKeyToggle = 0 THEN
            pixelUpDown = pixelUpDown - 1
            GOSUB curoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB curon
        END IF
    END IF
    '**** END UP ARROW
 
LOOP
'****
 
'****
curmouseon:
FOR Z = 0 TO CharHeight - 1
    newmouseOffset = mouseOffset + Z * _WIDTH
    FOR T = newmouseOffset * 4 TO newmouseOffset * 4 + curWidth * 4 STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 255 THEN b = 0: g = 0: r = 255
        IF b = 0 AND g = 0 AND r = 0 THEN b = 255: g = 255: r = 0
        ' _MEMPUT M, M.OFFSET + T + 100, b
        ' _MEMPUT M, M.OFFSET + T + 1 + 100, g
        ' _MEMPUT M, M.OFFSET + T + 2 + 100, r
 
 
 
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
RETURN
 
'****
curmouseoff:
FOR Z = 0 TO CharHeight - 1
    newmouseOffset = mouseOffset + Z * _WIDTH
 
    FOR T = newmouseOffset * 4 TO newmouseOffset * 4 + curWidth * 4 STEP 4
        'locate 100,100: print t
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 0 AND g = 0 AND r = 255 THEN b = 255: g = 255: r = 255
        IF b = 255 AND g = 255 AND r = 0 THEN b = 0: g = 0: r = 0
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
 
RETURN
 
'****
cursolidon: 'Cursor for TYPE OVER mode  - ON
FOR Z = 0 TO CharHeight - 1
    newcurOffset = curOffset - Z * _WIDTH
 
    FOR T = newcurOffset * 4 TO newcurOffset * 4 + curWidth * 4 STEP 4
 
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        b = b XOR 255
        _MEMPUT M, M.OFFSET + T, b
 
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        g = g XOR 255
        _MEMPUT M, M.OFFSET + T + 1, g
 
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        r = r XOR 0
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
 
NEXT Z
printPos = curPosX / CharWidth + 1
RETURN
 
'****
cursolidoff: 'Cursor for TYPE OVER mode - OFF
FOR Z = 0 TO CharHeight
    newcurOffset = curOffset - Z * _WIDTH
 
    FOR T = newcurOffset * 4 TO newcurOffset * 4 + curWidth * 4 STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 0 THEN b = 0: g = 0: r = 0
        IF b = 0 AND g = 0 AND r = 255 THEN b = 255: g = 255: r = 255
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
printPos = curPosX / CharWidth + 1
RETURN
'****
 
curon:
FOR T = curOffset * 4 TO curOffset * 4 + curWidth * 4 STEP 4
    b = 255
    _MEMPUT M, M.OFFSET + T, b
 
    g = 255
    _MEMPUT M, M.OFFSET + T + 1, g
 
    r = 0
    _MEMPUT M, M.OFFSET + T + 2, r
NEXT T
printPos = curPosX / CharWidth + 1
RETURN
 
'****
curoff:
 
FOR T = curOffset * 4 TO curOffset * 4 + curWidth * 4 STEP 4
 
    b = 0
    _MEMPUT M, M.OFFSET + T, b
 
    g = 0
    _MEMPUT M, M.OFFSET + T + 1, g
 
    r = 0
    _MEMPUT M, M.OFFSET + T + 2, r
NEXT T
printPos = curPosX / CharWidth + 1
RETURN
 
curSelect:
 
FOR Z = 0 TO ABS(selectPosLowY - selectPosTopY) 'select block height
    newSelectOffset = selectOffset + Z * _WIDTH
    '*                                                            select block width
    FOR T = newSelectOffset * 4 TO newSelectOffset * 4 + (ABS(selectPosRightX - selectPosLeftX) * 4) STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 255 THEN b = 0: g = 0: r = 255
        IF b = 0 AND g = 0 AND r = 0 THEN b = 255: g = 255: r = 0
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
RETURN

NOVARSEG · « **Reply #16 on:** May 03, 2021, 08:16:57 pm »

Basic mouse select with copy / paste feature The moved text can not be edited yet.

The code shows some uses of MEMGET and MEMPUT. Very useful for selecting areas of the screen and making cursors of any shape or color etc. Also the basic editing of a single line of text is shown.

FULLSCREEN has no issues with MEMGET or MEMPUT.

The code does not use the ELSE statement and does not have any SUBS or FUNCTIONS

Lots of gosubs though :)

Code: QB64: [Select]

DIM T AS _UNSIGNED LONG
DIM Handle AS LONG
DIM curWidth AS INTEGER
DIM curPosX AS INTEGER
DIM curOffset AS _UNSIGNED LONG
DIM newcurOffset AS _UNSIGNED LONG
DIM mouseOffset AS _UNSIGNED LONG
DIM newmouseOffset AS _UNSIGNED LONG
DIM newSelectOffset AS _UNSIGNED LONG
DIM selectOffset AS _UNSIGNED LONG
DIM MoveSelectOffset AS _UNSIGNED LONG
 
DIM CharWidth AS INTEGER
DIM printPos AS INTEGER
DIM kh AS LONG
DIM T1 AS SINGLE
DIM T2 AS _UNSIGNED LONG
DIM F AS _UNSIGNED _BIT
DIM F1 AS INTEGER
 
DIM insertKeyToggle AS _UNSIGNED _BIT
DIM pixelUpDown AS INTEGER
DIM Text AS STRING
DIM X AS INTEGER
DIM X1 AS INTEGER
DIM Y AS INTEGER
DIM X2 AS INTEGER
DIM Z AS INTEGER
 
DIM selectPosLeftX AS INTEGER
DIM selectPosTopY AS INTEGER
DIM selectPosRightX AS INTEGER
DIM selectPosLowY AS INTEGER
 
 
DIM lines AS INTEGER
lines = 5 * 16
 
 
Text = "Some text to edit"
 
Handle = _NEWIMAGE(400, 400, 32)
SCREEN Handle
DIM M AS _MEM
M = _MEMIMAGE(Handle)
 
DIM r AS _UNSIGNED _BYTE
DIM g AS _UNSIGNED _BYTE
DIM b AS _UNSIGNED _BYTE
 
_FULLSCREEN
 
PRINT
PRINT "Move cursor with left / right arrow"
 
PRINT "Insert / Type over, Append, Delete, Backspace"
 
PRINT "Move text with up / down arrow. ESC to exit"
PRINT
PRINT Text
 
curWidth = (_PRINTWIDTH(CHR$(a)) - 2)
 
CharHeight = _FONTHEIGHT
CharWidth = _PRINTWIDTH(CHR$(a))
 
 
curPosX = _PRINTWIDTH(Text)
curOffset = _WIDTH * (15 + lines) + curPosX 'initial
 
 
GOSUB curon
F1 = 0
F = 0
 
DO
    X = 0
    T1 = TIMER
    DO
 
        _LIMIT 1000
 
        IF _MOUSEINPUT = -1 THEN
            X = _MOUSEX
            Y = _MOUSEY
            IF X < 0 THEN EXIT DO
            IF Y < 0 THEN EXIT DO
            GOSUB curmouseoff
            IF Y + CharHeight < _HEIGHT THEN mouseOffset = Y * _WIDTH + X
            GOSUB curmouseon
 
 
            IF _MOUSEBUTTON(1) = 0 AND F1 = 3 THEN F1 = 0 'reset back to zero after paste
 
            IF _MOUSEBUTTON(1) = -1 AND F1 = 2 THEN 'Left mouse button down, pastes image / text
                F1 = 3
                MoveSelectOffset = Y * _WIDTH + X
                GOSUB DropBlock
            END IF
 
            IF _MOUSEBUTTON(1) = 0 AND F1 = 1 THEN F1 = 2 'release left mouse button to get ready for paste
 
 
            IF _MOUSEBUTTON(1) = -1 AND F1 = 1 THEN 'Left mouse button held down to select area
                selectPosRightX = X
                selectPosLowY = Y
                GOSUB curSelect
            END IF
 
            IF _MOUSEBUTTON(1) = -1 AND F1 = 0 THEN 'Initial top left position of select block
                F1 = 1
                selectOffset = Y * _WIDTH + X
                selectPosLeftX = X
                selectPosTopY = Y
            END IF
 
 
        END IF
 
 
        kh = _KEYHIT
 
        IF kh = 20992 AND insertKeyToggle = 0 AND LEN(Text) >= printPos THEN
            insertKeyToggle = 1 'TYPEOVER mode
            kh = 0
            T1 = TIMER
            GOSUB curoff
            GOSUB cursolidon
            F = 0
        END IF
 
        IF kh = 20992 AND insertKeyToggle = 1 AND LEN(Text) >= printPos THEN
            insertKeyToggle = 0 'INSERT MODE
            kh = 0
            T1 = TIMER
            GOSUB cursolidoff
            GOSUB curon
            F = 0
        END IF
 
        IF insertKeyToggle = 1 THEN
            IF TIMER - T1 > .3 AND F = 1 THEN
                F = 0
                T1 = TIMER
                GOSUB cursolidon
            END IF
        END IF
 
        IF insertKeyToggle = 1 THEN
            IF TIMER - T1 > .3 AND F = 0 THEN
                F = 1
                T1 = TIMER
                GOSUB cursolidoff
            END IF
        END IF
 
        IF insertKeyToggle = 0 THEN
            IF TIMER - T1 > .3 AND F = 0 THEN
                F = 1
                T1 = TIMER
                GOSUB curoff
            END IF
            IF TIMER - T1 > .3 AND F = 1 THEN
                F = 0
                T1 = TIMER
                GOSUB curon
            END IF
        END IF
 
        IF kh > 0 AND insertKeyToggle = 1 THEN GOSUB cursolidon: EXIT DO
        IF kh > 0 AND insertKeyToggle = 0 THEN GOSUB curon: EXIT DO
    LOOP
 
 
    ' PRINT kh
 
    IF kh = 27 THEN END
 
    IF kh = 8 AND curPosX > 0 THEN 'BACKSPACE
        IF insertKeyToggle = 1 THEN GOSUB cursolidoff: insertKeyToggle = 0: GOTO LL3
        GOSUB curoff
        Text = LEFT$(Text, printPos - 2) + MID$(Text, printPos, LEN(Text) - (printPos - 1))
        curPosX = curPosX - CharWidth
        curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
        _PRINTSTRING (0, lines + pixelUpDown), Text + " "
        GOSUB curon
        LL3:
    END IF
    '****
 
    '****
    IF kh > 31 AND kh < 127 AND LEN(Text) < printPos AND _PRINTWIDTH(Text) + CharWidth < _WIDTH THEN 'APPEND
        Text = Text + CHR$(kh)
        curPosX = _PRINTWIDTH(Text)
        curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
        _PRINTSTRING (0, lines + pixelUpDown), Text
        GOSUB curon
    END IF
    '****
 
    '****
    IF kh > 31 AND kh < 127 AND LEN(Text) >= printPos AND _PRINTWIDTH(Text) + CharWidth < _WIDTH THEN 'INSERT TYPE OVER
        IF insertKeyToggle = 0 THEN 'INSERT MODE
            Text = LEFT$(Text, printPos - 1) + CHR$(kh) + MID$(Text, printPos, LEN(Text) - printPos + 1)
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB curon
        END IF
 
        IF insertKeyToggle = 1 AND LEN(Text) = printPos THEN 'cursor is pointing to last character
            insertKeyToggle = 0
            GOSUB cursolidoff
            Text = LEFT$(Text, printPos - 1) + CHR$(kh) + MID$(Text, printPos + 1, LEN(Text) - (printPos))
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text + " "
            GOSUB curon
        END IF
 
        IF insertKeyToggle = 1 AND LEN(Text) > printPos THEN 'cursor is pointing to any char except last char
            GOSUB cursolidoff
            Text = LEFT$(Text, printPos - 1) + CHR$(kh) + MID$(Text, printPos + 1, LEN(Text) - (printPos))
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text + " "
            GOSUB cursolidon
        END IF
    END IF 'END INSERT OR TYPE OVER
 
    '****
 
    '****
 
    IF kh = 21248 AND LEN(Text) >= printPos AND _PRINTWIDTH(Text) <= _WIDTH THEN 'DELETE
        IF insertKeyToggle = 1 THEN GOSUB cursolidoff: insertKeyToggle = 0: GOTO LL1
 
        Text = LEFT$(Text, printPos - 1) + MID$(Text, printPos + 1, LEN(Text) - printPos + 1)
        curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX '
        _PRINTSTRING (0, lines + pixelUpDown), Text + " "
        GOSUB curon
        LL1:
    END IF
 
    '****
 
    '****
 
    IF kh = 19200 AND curPosX > 0 THEN 'LEFT ARROW
 
        IF insertKeyToggle = 1 AND LEN(Text) >= printPos THEN
            GOSUB cursolidoff
            curPosX = curPosX - CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB cursolidon
        END IF
 
        IF insertKeyToggle = 0 THEN
            GOSUB curoff
            curPosX = curPosX - CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB curon
        END IF
 
    END IF 'END LEFT ARROW
 
    '****
 
    '****
    IF kh = 19712 AND curPosX < _PRINTWIDTH(Text) AND _PRINTWIDTH(Text) < _WIDTH THEN 'RIGHT ARROW
 
        IF insertKeyToggle = 1 AND LEN(Text) = printPos THEN
            insertKeyToggle = 0
            GOSUB cursolidoff
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB curon
            GOTO LL2
        END IF
 
        IF insertKeyToggle = 1 AND LEN(Text) > printPos THEN
            GOSUB cursolidoff
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB cursolidon
        END IF
 
        IF insertKeyToggle = 0 THEN
            GOSUB curoff
            curPosX = curPosX + CharWidth
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            GOSUB curon
        END IF
        LL2:
 
    END IF 'END RIGHT ARROW
    '****
 
    '****
    IF kh = 20480 AND lines + pixelUpDown + CharHeight < _HEIGHT THEN 'DOWN ARROW
 
        IF insertKeyToggle = 1 THEN
            pixelUpDown = pixelUpDown + 1
            GOSUB cursolidoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB cursolidon
        END IF
 
        IF insertKeyToggle = 0 THEN
            pixelUpDown = pixelUpDown + 1
            GOSUB curoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB curon
        END IF
    END IF
    '**** END DOWN ARROW
 
    '****
    IF kh = 18432 AND lines + pixelUpDown > lines THEN 'UP ARROW
 
        IF insertKeyToggle = 1 THEN
            pixelUpDown = pixelUpDown - 1
            GOSUB cursolidoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB cursolidon
        END IF
        IF insertKeyToggle = 0 THEN
            pixelUpDown = pixelUpDown - 1
            GOSUB curoff
            curOffset = _WIDTH * (15 + lines + pixelUpDown) + curPosX
            _PRINTSTRING (0, lines + pixelUpDown), Text
            GOSUB curon
        END IF
    END IF
    '**** END UP ARROW
 
LOOP
'****
 
'****
curmouseon:
FOR Z = 0 TO CharHeight - 1
    newmouseOffset = mouseOffset + Z * _WIDTH
    FOR T = newmouseOffset * 4 TO newmouseOffset * 4 + curWidth * 4 STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 255 THEN b = 0: g = 0: r = 255
        IF b = 0 AND g = 0 AND r = 0 THEN b = 255: g = 255: r = 0
        ' _MEMPUT M, M.OFFSET + T + 100, b
        ' _MEMPUT M, M.OFFSET + T + 1 + 100, g
        ' _MEMPUT M, M.OFFSET + T + 2 + 100, r
 
 
 
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
RETURN
 
'****
curmouseoff:
FOR Z = 0 TO CharHeight - 1
    newmouseOffset = mouseOffset + Z * _WIDTH
 
    FOR T = newmouseOffset * 4 TO newmouseOffset * 4 + curWidth * 4 STEP 4
        'locate 100,100: print t
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 0 AND g = 0 AND r = 255 THEN b = 255: g = 255: r = 255
        IF b = 255 AND g = 255 AND r = 0 THEN b = 0: g = 0: r = 0
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
 
RETURN
 
'****
cursolidon: 'Cursor for TYPE OVER mode  - ON
FOR Z = 0 TO CharHeight - 1
    newcurOffset = curOffset - Z * _WIDTH
 
    FOR T = newcurOffset * 4 TO newcurOffset * 4 + curWidth * 4 STEP 4
 
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        b = b XOR 255
        _MEMPUT M, M.OFFSET + T, b
 
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        g = g XOR 255
        _MEMPUT M, M.OFFSET + T + 1, g
 
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        r = r XOR 0
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
 
NEXT Z
printPos = curPosX / CharWidth + 1
RETURN
 
'****
cursolidoff: 'Cursor for TYPE OVER mode - OFF
FOR Z = 0 TO CharHeight - 1
    newcurOffset = curOffset - Z * _WIDTH
 
    FOR T = newcurOffset * 4 TO newcurOffset * 4 + curWidth * 4 STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 0 THEN b = 0: g = 0: r = 0
        IF b = 0 AND g = 0 AND r = 255 THEN b = 255: g = 255: r = 255
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
printPos = curPosX / CharWidth + 1
RETURN
'****
 
curon:
FOR T = curOffset * 4 TO curOffset * 4 + curWidth * 4 STEP 4
    b = 255
    _MEMPUT M, M.OFFSET + T, b
 
    g = 255
    _MEMPUT M, M.OFFSET + T + 1, g
 
    r = 0
    _MEMPUT M, M.OFFSET + T + 2, r
NEXT T
printPos = curPosX / CharWidth + 1
RETURN
 
'****
curoff:
 
FOR T = curOffset * 4 TO curOffset * 4 + curWidth * 4 STEP 4
 
    b = 0
    _MEMPUT M, M.OFFSET + T, b
 
    g = 0
    _MEMPUT M, M.OFFSET + T + 1, g
 
    r = 0
    _MEMPUT M, M.OFFSET + T + 2, r
NEXT T
printPos = curPosX / CharWidth + 1
RETURN
'****
 
'*****
curSelect:
FOR Z = 0 TO ABS(selectPosLowY - selectPosTopY) 'select block height
    newSelectOffset = selectOffset + Z * _WIDTH
    '*                                                            select block width
    FOR T = newSelectOffset * 4 TO newSelectOffset * 4 + (ABS(selectPosRightX - selectPosLeftX) * 4) STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 255 THEN b = 0: g = 0: r = 255
        IF b = 0 AND g = 0 AND r = 0 THEN b = 255: g = 255: r = 0
        _MEMPUT M, M.OFFSET + T, b
        _MEMPUT M, M.OFFSET + T + 1, g
        _MEMPUT M, M.OFFSET + T + 2, r
    NEXT T
NEXT Z
RETURN
'****
 
'*****
DropBlock:
FOR Z = 0 TO ABS(selectPosLowY - selectPosTopY) 'select block height
    newSelectOffset = selectOffset + Z * _WIDTH
    '*                                                            select block width
    FOR T = newSelectOffset * 4 TO newSelectOffset * 4 + (ABS(selectPosRightX - selectPosLeftX) * 4) STEP 4
        b = _MEMGET(M, M.OFFSET + T, _UNSIGNED _BYTE)
        g = _MEMGET(M, M.OFFSET + T + 1, _UNSIGNED _BYTE)
        r = _MEMGET(M, M.OFFSET + T + 2, _UNSIGNED _BYTE)
        IF b = 255 AND g = 255 AND r = 0 THEN b = 0: g = 0: r = 0
        IF b = 0 AND g = 0 AND r = 255 THEN b = 255: g = 255: r = 255
        T2 = T + ((MoveSelectOffset + Z * _WIDTH) - (selectOffset + Z * _WIDTH)) * 4
 
        _MEMPUT M, M.OFFSET + T2, b
        _MEMPUT M, M.OFFSET + T2 + 1, g
        _MEMPUT M, M.OFFSET + T2 + 2, r
 
    NEXT T
NEXT Z
 
RETURN
 

LM · « **Reply #17 on:** May 08, 2021, 08:09:18 pm »

@NOVARSEG
Great work. I can think of uses for this. I like it!

euklides · « **Reply #18 on:** May 09, 2021, 08:46:26 am »

Very big armada for a single input...

News:

Author Topic: Another line editor (Read 4237 times)

NOVARSEG

Re: Another line editor

NOVARSEG

Re: Another line editor

LM

Re: Another line editor

euklides

Re: Another line editor