cprint and cfprint text mode routines

[James D Jarvis]

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