(09-23-2023, 12:02 AM)James D Jarvis Wrote: cprint and cfprint are 2 text mode routines that allow printing to specific location on a text screen (or text image) with colored text without changing global text values. cfprint prints in just a foreground text color without changing the existing background color at the location simulating a part of _printmode _keepbackground.  
there is also an "internal function" thebit$ that extracts a row of bits from a starting position to an end postion in a value. It is used here to read the background color for cfprint.

Code: (Select All)

Sub cprint (x, y, fg, bg, txt$)
    'print color text txt$ at location x,y color fg,bg without altering global color values
    'txt$ may  contain control characters without using  _controlchr
    'use on screen mode 0 screens only
    Dim o As _MEM
    ii& = _Dest
    o = _MemImage(ii&)
    w = (_Width(ii&)) * 2
    ts = (y - 1) * w + (x - 1) * 2
    n = 0
    If fg > 15 Then
        ff = fg - 16
        bb = 1
    Else
        ff = fg
        bb = 0
    End If
    c = bb * 128 + ff + bg * 16
    For cx = 1 To Len(txt$)
        v = Asc(Mid$(txt$, cx, 1))
        _MemPut o, o.OFFSET + ts + (cx - 1) * 2, v As _UNSIGNED _BYTE
        _MemPut o, o.OFFSET + ts + (cx - 1) * 2 + 1, c As _UNSIGNED _BYTE
    Next cx
    _MemFree o
End Sub
Sub cfprint (x, y, fg, txt$)
    'print color text txt$ at location x,y color fg without altering global color values or background colors under txt$
    'txt$ may  contain control characters without using  _controlchr
    'this simulates some of the behavior of _printmode _keepbackground
    'use on screen mode 0 screens only
    Dim o As _MEM
    ii& = _Dest
    o = _MemImage(ii&)
    w = (_Width(ii&)) * 2
    ts = (y - 1) * w + (x - 1) * 2
    n = 0
    If fg > 15 Then
        ff = fg - 16
        bb = 1
    Else
        ff = fg
        bb = 0
    End If
    For cx = 1 To Len(txt$)
        v = Asc(Mid$(txt$, cx, 1))
        c1 = _MemGet(o, o.OFFSET + ts + (cx - 1) * 2 + 1, _Unsigned _Byte)
        ccb$ = thebit$(c1, 6, 4)
        bg = Val("&B" + ccb$)
        c = bb * 128 + ff + bg * 16
        _MemPut o, o.OFFSET + ts + (cx - 1) * 2, v As _UNSIGNED _BYTE
        _MemPut o, o.OFFSET + ts + (cx - 1) * 2 + 1, c As _UNSIGNED _BYTE
    Next cx
    _MemFree o
End Sub
Function thebit$ (n, sb, eb)
    'grabs  bits from starting bit SB to end bit eb
    If eb > sb Then Exit Function
    a$ = ""
    For b = sb To eb Step -1
        If _ReadBit(n, b) = 0 Then a$ = a$ + "0" Else a$ = a$ + "1"
    Next b
    thebit$ = a$
End Function

(09-23-2023, 06:20 PM)James D Jarvis Wrote: It's not the speediest. May be able to improve it but I'd say it's still useable.  

results from my machine on a simple test.


that works out to about 1,000 pages a second for the slowest method on my machine. 

Code: (Select All)

'don't forget to add the subroutines if you want to test it on your computer
t1 = Timer
For r = 1 To 100
    For b = 0 To 7
        For c = 0 To 31
            For y = 1 To 20
                For x = 1 To 26
                    Color c, b
                    Locate y, x
                    Print Chr$(x + 64)
                Next x
            Next y
        Next c
    Next b
Next r
t2 = Timer
Color 15, 0
t3 = Timer
For r = 1 To 100
    For b = 0 To 7
        For c = 0 To 31
            For y = 1 To 20
                For x = 1 To 26
                    cprint x, y, c, b, Chr$(x + 64)
                Next x
            Next y
        Next c
    Next b
Next r
t4 = Timer
t5 = Timer
For r = 1 To 100
    For b = 0 To 7
        For c = 0 To 31
            For y = 1 To 20
                For x = 1 To 26
                    cfprint x, y, c, Chr$(x + 64)
                Next x
            Next y
        Next c
    Next b
Next r
t6 = Timer

(09-23-2023, 06:40 PM)SMcNeill Wrote: Change:

v = Asc(Mid$(txt$, cx, 1))

To:

v = ASC(txt$, cx)

(09-23-2023, 06:45 PM)bplus Wrote: aye may take more than this?

CONST limit = 1000000



PRINT "Let's do some time tests!"

PRINT "Running cprint "; limit; "times!"

t## = TIMER

FOR i = 1 TO limit

    x = INT(RND * 70) + 1

    y = INT(RND * 20) + 1

    cprint x, y, INT(RND * 32), INT(RND * 16), "CPRINT!!"

NEXT

t1## = TIMER

CLS

PRINT "Running cprintFAST "; limit; "times!"

t2## = TIMER

FOR i = 1 TO limit

    x = INT(RND * 65) + 1

    y = INT(RND * 20) + 1

    cprintFAST x, y, INT(RND * 32), INT(RND * 16), "CPRINTFAST!!"

NEXT

t3## = TIMER

CLS

PRINT "Running cfprint "; limit; "times!"

t4## = TIMER

FOR i = 1 TO limit

    x = INT(RND * 70) + 1

    y = INT(RND * 20) + 1

    cfprint x, y, INT(RND * 32), "CPRINT!!"

NEXT

t5## = TIMER

CLS

PRINT "Running cfprintFAST "; limit; "times!"

t6## = TIMER

FOR i = 1 TO limit

    x = INT(RND * 65) + 1

    y = INT(RND * 20) + 1

    cfprintFAST x, y, INT(RND * 32), "CPRINTFAST!!"

NEXT

t7## = TIMER



LOCATE 21, 1

PRINT "Printing results for"; limit; "runs:"

PRINT USING "###.###### seconds for cprint"; t1## - t##

PRINT USING "###.###### seconds for cprintFAST"; t3## - t2##

PRINT USING "###.###### seconds for cprint"; t5## - t4##

PRINT USING "###.###### seconds for cprintFAST"; t7## - t6##









SUB cprint (x, y, fg, bg, txt$)

    'print color text txt$ at location x,y color fg,bg without altering global color values

    'txt$ may  contain control characters without using  _controlchr

    'use on screen mode 0 screens only

    DIM o AS _MEM

    ii& = _DEST

    o = _MEMIMAGE(ii&)

    w = (_WIDTH(ii&)) * 2

    ts = (y - 1) * w + (x - 1) * 2

    n = 0

    IF fg > 15 THEN

        ff = fg - 16

        bb = 1

    ELSE

        ff = fg

        bb = 0

    END IF

    c = bb * 128 + ff + bg * 16

    FOR cx = 1 TO LEN(txt$)

        v = ASC(MID$(txt$, cx, 1))

        _MEMPUT o, o.OFFSET + ts + (cx - 1) * 2, v AS _UNSIGNED _BYTE

        _MEMPUT o, o.OFFSET + ts + (cx - 1) * 2 + 1, c AS _UNSIGNED _BYTE

    NEXT cx

    _MEMFREE o

END SUB

SUB cfprint (x, y, fg, txt$)

    'print color text txt$ at location x,y color fg without altering global color values or background colors under txt$

    'txt$ may  contain control characters without using  _controlchr

    'this simulates some of the behavior of _printmode _keepbackground

    'use on screen mode 0 screens only

    DIM o AS _MEM

    ii& = _DEST

    o = _MEMIMAGE(ii&)

    w = (_WIDTH(ii&)) * 2

    ts = (y - 1) * w + (x - 1) * 2

    n = 0

    IF fg > 15 THEN

        ff = fg - 16

        bb = 1

    ELSE

        ff = fg

        bb = 0

    END IF

    FOR cx = 1 TO LEN(txt$)

        v = ASC(MID$(txt$, cx, 1))

        c1 = _MEMGET(o, o.OFFSET + ts + (cx - 1) * 2 + 1, _UNSIGNED _BYTE)

        ccb$ = thebit$(c1, 6, 4)

        bg = VAL("&B" + ccb$)

        c = bb * 128 + ff + bg * 16

        _MEMPUT o, o.OFFSET + ts + (cx - 1) * 2, v AS _UNSIGNED _BYTE

        _MEMPUT o, o.OFFSET + ts + (cx - 1) * 2 + 1, c AS _UNSIGNED _BYTE

    NEXT cx

    _MEMFREE o

END SUB

FUNCTION thebit$ (n, sb, eb)

    'grabs  bits from starting bit SB to end bit eb

    IF eb > sb THEN EXIT FUNCTION

    a$ = ""

    FOR b = sb TO eb STEP -1

        IF _READBIT(n, b) = 0 THEN a$ = a$ + "0" ELSE a$ = a$ + "1"

    NEXT b

    thebit$ = a$

END FUNCTION





$CHECKING:OFF

SUB cprintFAST (x, y, fg, bg, txt$)

    'print color text txt$ at location x,y color fg,bg without altering global color values

    'txt$ may  contain control characters without using  _controlchr

    'use on screen mode 0 screens only

    DIM o AS _MEM

    DIM AS _OFFSET ts, math_once

    o = _MEMIMAGE(_DEST)

    w = (_WIDTH(_DEST)) * 2

    ts = o.OFFSET + (y - 1) * w + (x - 1) * 2

    c = (fg \ 16) * 128 + (fg MOD 16) + bg * 16

    FOR cx = 1 TO LEN(txt$)

        math_once = ts + (cx - 1) * 2

        v = ASC(txt$, cx)

        _MEMPUT o, math_once, v AS _UNSIGNED _BYTE

        _MEMPUT o, math_once + 1, c AS _UNSIGNED _BYTE

    NEXT cx

    _MEMFREE o

END SUB

SUB cfprintFAST (x, y, fg, txt$)

    'print color text txt$ at location x,y color fg without altering global color values or background colors under txt$

    'txt$ may  contain control characters without using  _controlchr

    'this simulates some of the behavior of _printmode _keepbackground

    'use on screen mode 0 screens only

    DIM o AS _MEM

    DIM AS _OFFSET ts, math_once

    o = _MEMIMAGE(_DEST)

    w = (_WIDTH(_DEST)) * 2

    ts = o.OFFSET + ((y - 1) * w + (x - 1) * 2)

    ff = fg MOD 16

    cc = INT(fg / 16) * 128 + ff

    FOR cx = 1 TO LEN(txt$)

        math_once = ts + (cx - 1) * 2

        v = ASC(txt$, cx)

        c1 = _MEMGET(o, math_once + 1, _UNSIGNED _BYTE)

        c = cc + (c1 \ 16) * 16

        _MEMPUT o, math_once, v AS _UNSIGNED _BYTE

        _MEMPUT o, math_once + 1, c AS _UNSIGNED _BYTE

    NEXT cx

    _MEMFREE o

END SUB

$CHECKING:ON