Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
09-23-2023, 12:02 AM
(This post was last modified: 09-23-2023, 01:24 PM by 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
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
(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
Ah might be handy to replace Color + Locate + Print, do it in one statement.
Have you tested the memory helper routine against standard 3 above in a timed test?
I'd be interested in results.
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
09-23-2023, 06:20 PM
(This post was last modified: 09-23-2023, 06:21 PM by James D Jarvis.)
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.
![[Image: image.png]](https://i.ibb.co/jbvSx5s/image.png)
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
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
Remember, for speed, you can turn $CHECKING:OFF with mem to see a noticeable speed boost.
$CHECKING:OFF
_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
$CHECKING:ON
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
(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
ah this code is missing the display of results. I think timer(.001) gives us best precision unless mistaken about timer arguments.
Still checking out code....
b = b + ...
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
Change:
v = Asc(Mid$(txt$, cx, 1))
To:
v = ASC(txt$, cx)
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
OK I am getting original code as fastest:
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(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
b = b + ...
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
09-23-2023, 06:45 PM
(This post was last modified: 09-23-2023, 06:49 PM by bplus.)
(09-23-2023, 06:40 PM)SMcNeill Wrote: 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
b = b + ...
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
(09-23-2023, 06:45 PM)bplus Wrote: aye may take more than this?
Give this a shot and see how it compares for speed:
Code: (Select All)
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
Unless I screwed something up with how it's supposed to perform (I don't think I did), it seems to be a wee bit faster like this.
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
Interesting how you did checking on/off with subs!
But you left out comparing to standard way with Color + Locate + Print
I am weighing the cost of extra lines of code for subs and ease of typing one line instead of 3 with standard 3 maybe try good ole CLP sub:
Sub CLP(fg, bg, row, col, text$)
color fg, bg
locate row, col
print text$;
end sub
b = b + ...
|
