Téma: Škola hrou - interaktivní modelovací prostředí pro všechny varianty zobrazení "pic ..."
ČeV-OCP ~ ~ ~ JDoodle Online COBOL Compiler IDE ... ~ ~ ~ a05.txt
program-id.
a05-vlastnosti-datovych-polozek.
*> povinný vstup CMD-line >> Arg a 7 řádků ze Stdin nebo z klávesnice
data division.
working-storage section.
1 Arg global.
2 A1 pic x. *> volba položky: elementární A až N, skupinová 0 až 3
2 A2 pic x. *> volba zobrazení: b = taky binární,
*> jinak jen znakové a hexadecimální
2 A3 pic 9. *> volba dat: 0 = vždy 7 řádků,
*> 1 = dle hodnoty položky v paměti
88 Prace value 0.
88 Prvni value 1.
88 Dalsi value 2.
88 Konec value 3.
1 S0 global.
2 S1.
3 A pic x(20) value "xčč".
3 B pic x(20) just.
3 C pic x(2) value "y".
2 S2.
3 D pic 999 value 153.
3 E pic 9(5) value 456.
3 F pic s999v99 comp value 23.51.
3 G pic 99 comp-x value 255.
3 H pic x.
2 S3.
3 I pic zz9 value 18.
3 J pic xx.
3 K pic x.
3 L pic x.
3 M pic x.
3 N pic x.
procedure division.
*> pro volbu Prvni" je zde možnost naplnit položky příkazem "move"
move high-value to J
move low-value to K
initialize S2
call "a05-vstup"
stop run.
*> Služební podprogramy **********************************************
program-id.
a05-vstup.
procedure division.
accept Arg from command-line
display "----- Arg = " Arg
perform UNTIL Konec
call "a05-hexad"
end-perform
display "----- Konec"
goback.
*> *******************************************************************
program-id.
a05-hexad.
data division.
working-storage section.
77 II pic 999.
77 HH pic 999.
77 BB pic 999.
77 DL pic 99.
77 Radek-I pic x(50).
77 Radek-H pic x(150).
77 Radek-B pic x(100).
77 Pocet pic 9.
1 BAJT pic x.
1 BITY.
2 LB.
3 L1 pic 99 comp-x.
3 L2 pic 99 comp-x.
3 L3 pic 99 comp-x.
3 L4 pic 99 comp-x.
2 PB.
3 P1 pic 99 comp-x.
3 P2 pic 99 comp-x.
3 P3 pic 99 comp-x.
3 P4 pic 99 comp-x.
1 KODY.
2 LB.
3 L1 pic 9.
3 L2 pic 9.
3 L3 pic 9.
3 L4 pic 9.
2 PB.
3 P1 pic 9.
3 P2 pic 9.
3 P3 pic 9.
3 P4 pic 9.
1 TT pic 9999.
1 TV pic x.
1 VV.
2 V1 pic x.
2 V2 pic x.
procedure division.
display " ....*....1....*....2....*....3....*....4....*....5....*....6....*....7"
evaluate A1
when "A" move length of A to DL if A3 not = 1 accept A end-if
display DL " " A move A(1:DL) to Radek-I perform HEXAD
when "B" move length of B to DL if A3 not = 1 accept B end-if
display DL " " B move B(1:DL) to Radek-I perform HEXAD
when "C" move length of C to DL if A3 not = 1 accept C end-if
display DL " " C move C(1:DL) to Radek-I perform HEXAD
when "D" move length of D to DL if A3 not = 1 accept D end-if
display DL " " D move D(1:DL) to Radek-I perform HEXAD
when "E" move length of E to DL if A3 not = 1 accept E end-if
display DL " " E move E(1:DL) to Radek-I perform HEXAD
when "F" move length of F to DL if A3 not = 1 accept F end-if
display DL " " F move F(1:DL) to Radek-I perform HEXAD
when "G" move length of G to DL if A3 not = 1 accept G end-if
display DL " " G move G(1:DL) to Radek-I perform HEXAD
when "H" move length of H to DL if A3 not = 1 accept H end-if
display DL " " H move H(1:DL) to Radek-I perform HEXAD
when "I" move length of I to DL if A3 not = 1 accept I end-if
display DL " " I move I(1:DL) to Radek-I perform HEXAD
when "J" move length of J to DL if A3 not = 1 accept J end-if
display DL " " J move J(1:DL) to Radek-I perform HEXAD
when "K" move length of K to DL if A3 not = 1 accept K end-if
display DL " " K move K(1:DL) to Radek-I perform HEXAD
when "L" move length of L to DL if A3 not = 1 accept L end-if
display DL " " L move L(1:DL) to Radek-I perform HEXAD
when "M" move length of M to DL if A3 not = 1 accept M end-if
display DL " " M move M(1:DL) to Radek-I perform HEXAD
when "N" move length of N to DL if A3 not = 1 accept N end-if
display DL " " N move N(1:DL) to Radek-I perform HEXAD
when "0" move length of S0 to DL if A3 not = 1 accept S0 end-if
display DL " " S0 move S0(1:DL) to Radek-I perform HEXAD
when "1" move length of S1 to DL if A3 not = 1 accept S1 end-if
display DL " " S1 move S1(1:DL) to Radek-I perform HEXAD
when "2" move length of S2 to DL if A3 not = 1 accept S2 end-if
display DL " " S2 move S2(1:DL) to Radek-I perform HEXAD
when "3" move length of S3 to DL if A3 not = 1 accept S3 end-if
display DL " " S3 move S3(1:DL) to Radek-I perform HEXAD
when other
display "--- chybne zadání CMD-line !!!" set Konec to true
end-evaluate
evaluate true
when Prvni set Konec to true
when Prace set Dalsi to true move 1 to Pocet
when Dalsi and Pocet < 6 add 1 to Pocet
when other
set Konec to true
end-evaluate
goback.
HEXAD.
move space to RADEK-H RADEK-B
move 1 to HH BB
perform varying II from 1 by 1 until II > DL
move Radek-I(II:1) to BAJT
call x"F5" using BAJT BITY
move corr BITY to KODY
move LB of KODY to TT perform TST move TV to V1
move PB of KODY to TT perform TST move TV to V2
move VV to Radek-H(HH:2)
add 3 to HH
if A2 = "b" and II not > 10
string LB of KODY "-" PB of KODY delimited size
into Radek-B(BB:9)
add 10 to BB
end-if end-perform
display " " Radek-H
.
if A2 = "b"
display " " Radek-B
end-if
.
TST.
evaluate TT
when 0000 move "0" to TV
when 0001 move "1" to TV
when 0010 move "2" to TV
when 0011 move "3" to TV
when 0100 move "4" to TV
when 0101 move "5" to TV
when 0110 move "6" to TV
when 0111 move "7" to TV
when 1000 move "8" to TV
when 1001 move "9" to TV
when 1010 move "a" to TV
when 1011 move "b" to TV
when 1100 move "c" to TV
when 1101 move "d" to TV
when 1110 move "e" to TV
when 1111 move "f" to TV
end-evaluate
.
end program a05-hexad.
*> ******************************************************************
end program a05-vstup.
end program a05-vlastnosti-datovych-polozek.
ČeV - 30.5.2020