The sample program logoper.cbl, shown below, illustrates the use of bit manipulation routines. It uses three of the logical call-by-name routines, namely, CBL_OR, CBL_AND, and CBL_XOR.
working-storage section.
01 clr-char pic x value space.
01 clr-attr pic x value x"0f".
78 text-start value 29.
78 text-len value 23.
78 text-end value 51.
01 text-scr-pos.
03 text-row pic 9(2) comp-x value 12.
03 text-col pic 9(2) comp-x value text-start.
01 text-char-buffer pic x(text-len)
value "Text-in-various-colours".
01 text-attr-buffer.
03 first-word pic x(4) value all x"0f".
03 second-word pic x(4) value all x"2c".
03 third-word pic x(7) value all x"14".
03 third-space pic x value x"30".
03 fourth-word pic x(7) value all x"59".
01 text-length pic 9(4) comp-x value text-len.
01 char-read pic x.
01 char-length pic 9(9) comp-5 value 1.
01 quit-flag pic 9 comp-x.
88 not-ready-to-quit value 0.
88 ready-to-quit value 1.
01 csr-pos.
03 csr-row pic 9(2) comp-x value 12.
03 csr-col pic 9(2) comp-x value 39.
01 csr-attr pic x.
01 csr-length pic 9(4) comp-x value 1.
01 blink-mask pic x value x"80".
01 steady-mask pic x value x"7f".
01 invert-mask pic x(text-len) value all x"7f".
78 instr-len value 41.
01 instr-length pic 9(4) comp-x value instr-len.
01 instr pic x(instr-len)
value "Press (L)eft, (R)ight, (I)nvert or (Q)uit".
01 instr-pos.
03 instr-row pic 9(2) comp-x value 8.
03 instr-col pic 9(2) comp-x value 19.
procedure division.
main section.
perform init-screen
set not-ready-to-quit to true
perform until ready-to-quit
perform read-keyboard
evaluate char-read
when "L"
perform csr-move-left
when "R"
perform csr-move-right
when "I"
perform invert-text
when "Q"
set ready-to-quit to true
end-evaluate
end-perform
stop run
.
init-screen section.
call "CBL_CLEAR_SCR" using clr-char
clr-attr
call "CBL_WRITE_SCR_CHARS" using instr-pos
instr
instr-length
call "CBL_WRITE_SCR_CHARS" using text-scr-pos
text-char-buffer
text-length
perform put-attrs-on-screen
perform blink-cursor
.
read-keyboard section.
call "CBL_READ_KBD_CHAR" using char-read
call "CBL_TOUPPER" using char-read
by value char-length
.
csr-move-left section.
perform steady-cursor
subtract 1 from csr-col
if csr-col < text-start
move text-end to csr-col
end-if
perform blink-cursor
.
csr-move-right section.
perform steady-cursor
add 1 to csr-col
if csr-col > text-end
move text-start to csr-col
end-if
perform blink-cursor
.
blink-cursor section.
*> Turn on the blink bit at the current attribute.
call "CBL_READ_SCR_ATTRS" using csr-pos
csr-attr
csr-length
call "CBL_OR" using blink-mask
csr-attr
by value 1
call "CBL_WRITE_SCR_ATTRS" using csr-pos
csr-attr
csr-length
.
steady-cursor section.
*> Turn off the blink bit at the current attribute.
call "CBL_READ_SCR_ATTRS" using csr-pos
csr-attr
csr-length
call "CBL_AND" using steady-mask
csr-attr
by value 1
call "CBL_WRITE_SCR_ATTRS" using csr-pos
csr-attr
csr-length
.
invert-text section.
*> invert the bits that set the foreground colour, the background
*> colour, and the intensity bits, but leave the blink bit alone.
call "CBL_READ_SCR_ATTRS" using text-scr-pos
text-attr-buffer
text-length
call "CBL_XOR" using invert-mask
text-attr-buffer
by value text-len
perform put-attrs-on-screen
.
put-attrs-on-screen section.
call "CBL_WRITE_SCR_ATTRS" using text-scr-pos
text-attr-buffer
text-length
.
In the sample program, the section blink-cursor makes the cursor character (the character the cursor is pointing to) blink by its attributes. To see how you would create code to make the cursor blink, first consider the form of the display attribute. The following table shows the structure of the attribute byte for a personal computer with a monochrome display.
Thus, for example, setting bit 7 to 1 turns blinking on. In the Working-Storage Section of the program, the mask for the "blink" attribute is defined as:
01 blink-mask pic x value x"80".
This hex value translates to the following bit pattern:
1 0 0 0 0 0 0 0
The CBL_READ_SCR_ATTRS routine reads the current attributes of the screen into an attribute buffer that in this case is one character long.
call "CBL_READ_SCR_ATTRS" using csr-pos
csr-attr
csr-length
The CBL_OR routine does a logical OR on the current attributes and the blinking mask. This in effect turns on the blinking attribute. Note that the length parameter is 1. This says the OR operation is for one byte.
call "CBL_OR" using blink-mask csr-attr by value 1
The CBL_WRITE_SCR_ATTRS routine writes the updated attributes buffer to the screen causing the character to "blink".
call "CBL_OR" using blink-mask
csr-attr
by value 1