下のサンプル プログラム logoper.cbl では、ビット操作のルーチンの使用方法を説明します。ここでは、3 つの名前呼び出し論理ルーチン CBL_OR、CBL_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
.
サンプル プログラムでは、節 blink-cursor でカーソル文字(カーソルがポイントしている文字)をその属性によって点滅させます。カーソルを点滅させるコードの作成方法を考える場合は、まず表示属性の形式を考えます。次の表に、白黒ディスプレイの PC の属性バイト構成を示します。
したがって、たとえば、ビット 7 を 1 に設定すると、点滅が有効になります。プログラムの作業場所節には、「点滅」属性のマスクが次のように定義されています。
01 blink-mask pic x value x"80".
この 16 進数は、次のようなビットパターンに変換されます。
1 0 0 0 0 0 0 0
CBL_READ_SCR_ATTRS ルーチンにより、画面の現在の属性が属性バッファ(この例では長さ 1 文字)に読み込まれます。
call "CBL_READ_SCR_ATTRS" using csr-pos
csr-attr
csr-length
CBL_OR ルーチンは、現在の属性と blinking mask の論理和を計算します。これにより、点滅属性がオンになります。長さのパラメータは 1 です。つまり、OR 演算は 1 バイトに対して行われます。
call "CBL_OR" using blink-mask csr-attr by value 1
CBL_WRITE_SCR_ATTRS ルーチンにより、更新された属性バッファが画面に書き込まれ、文字が「点滅」するようになります。
call "CBL_OR" using blink-mask
csr-attr
by value 1