cprint and cfprint text mode routines

[bplus]

Change:

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

To:

v = ASC(txt$, cx)

aye may take more than this?

Any improvement?

Code: (Select All)

'don't forget to add the subroutines if you want to test it on your computer
t1 = Timer(.001)
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(.001)
Color 15, 0
t3 = Timer(.001)
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(.001)
t5 = Timer(.001)
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(.001)
Print t2 - t1
Print t4 - t3
Print t6 - t5

' jarvis subs we are testing

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(txt$, cx)
        _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(txt$, cx)
        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