$set sourceformat(variable) * Little program to show what colours are available and allow a * little experimenting to see what colour combinations look like program-id. colours. working-storage section. 78 black value 0. 78 blue value 1. 78 green value 2. 78 cyan value 3. 78 red value 4. 78 magenta value 5. 78 yellow value 6. 78 white value 7. 01 ws-colour pic x(7). 88 quit values "q" "quit". 88 valid-colour values "black" "blue" "green" "cyan" "red" "magenta" "yellow" "white". 01 ws-colour-name-tbl. 03 filler pic x(7) value "blue". 03 filler pic x(7) value "green". 03 filler pic x(7) value "cyan". 03 filler pic x(7) value "red". 03 filler pic x(7) value "magenta". 03 filler pic x(7) value "yellow". 03 filler pic x(7) value "white". 01 filler redefines ws-colour-name-tbl. 03 ws-colour-name pic x(7) occurs 7 times. 01 ws-text. 03 filler value " Background ". 03 ws-back-name pic x(7). 03 filler value " Foreground ". 03 ws-fore-name pic x(7). 01 ws-ctrl. 03 filler value "background-colour ". 03 ws-back-col pic 9. 03 filler value " foreground-colour ". 03 ws-fore-col pic 9. procedure division. a-control section. * Here's a small selection of colour combinations display " back black fore blue " at 0301 background-colour black foreground-colour blue " back blue fore black " background-colour blue foreground-colour black " back blue fore white " background-colour blue foreground-colour white display " back black fore green " at 0401 background-colour black foreground-colour green " back green fore black " background-colour green foreground-colour black " back green fore white " background-colour green foreground-colour white display " back black fore cyan " at 0501 background-colour black foreground-colour cyan " back cyan fore black " background-colour cyan foreground-colour black " back cyan fore white " background-colour cyan foreground-colour white display " back black fore red " at 0601 background-colour black foreground-colour red " back red fore black " background-colour red foreground-colour black " back red fore white " background-colour red foreground-colour white display " back black fore magenta " at 0701 background-colour black foreground-colour magenta " back magenta fore black " background-colour magenta foreground-colour black " back magenta fore white " background-colour magenta foreground-colour white display " back black fore yellow " at 0801 background-colour black foreground-colour yellow " back yellow fore black " background-colour yellow foreground-colour black " back yellow fore white " background-colour yellow foreground-colour white display " back black fore white " at 0901 background-colour black foreground-colour white " back white fore black " background-colour white foreground-colour black * Now allow the victim to show colour combinations perform b1-display-selected with test after until quit goback . b1-display-selected section. * Get a valid background colour display " Background colour? (q or quit to quit)" at 1101 perform with test after until quit or valid-colour accept ws-colour at 1121 move function lower-case(ws-colour) to ws-colour if quit exit section end-if if not valid-colour display "Valid colours: black, blue, green, cyan, red, " at 1201 "magenta, yellow, white" end-if end-perform display space at 1201 with erase eol * Convert it into a number in the control clause "background-colour" if ws-colour = "black" move zero to ws-back-col else perform varying ws-back-col from 1 by 1 until ws-colour-name(ws-back-col) = ws-colour end-perform end-if move ws-colour to ws-back-name * Get a valid foreground colour display " Foreground colour? (q or quit to quit)" at 1201 perform with test after until quit or valid-colour accept ws-colour at 1221 move function lower-case(ws-colour) to ws-colour if quit exit section end-if if not valid-colour display "Valid colours: black, blue, green, cyan, red, " at 1301 "magenta, yellow, white" end-if end-perform display space at 1301 with erase eol * Convert it into a number in the control clause "foreground-colour" if ws-colour = "black" move zero to ws-fore-col else perform varying ws-fore-col from 1 by 1 until ws-colour-name(ws-fore-col) = ws-colour end-perform end-if move ws-colour to ws-fore-name display ws-text at 1401 mode block *> Display fillers too control ws-ctrl .