Colour bars/Display: Difference between revisions
Line 1:
{{task}}
The task is to display a series of vertical color bars across the width of the display. The color bars should either use the system palette, or the sequence of colors: Black, Red, Green, Blue, Magenta, Cyan, Yellow, White.
=={{header|Icon}} and {{header|Unicon}}==
The procedure below is generalized to take a description of a ''test card'' and display it.
<lang Icon>link graphics,printf
procedure main() # generalized colour bars
DrawTestCard(Simple_TestCard())
WDone()
end
procedure DrawTestCard(TC)
size := sprintf("size=%d,%d",TC.width,TC.height)
&window := TC.window := open(TC.id,"g","bg=black",size) |
stop("Unable to open window")
every R := TC.bands[r := 1 to *TC.bands -1] do
every C := R.bars[c := 1 to *R.bars - 1] do {
Fg(R.bars[c].colour)
FillRectangle( C.left, R.top,
R.bars[c+1].left-C.left, TC.bands[r+1].top-R.top )
}
return TC
end
record testcard(window,id,width,height,bands)
record band(top,bars)
record bar(left,colour)
procedure Simple_TestCard() #: return structure simple testcard
return testcard(,"Simple Test Card",width := 800,height := 600,
[ band( 1, [ bar( 1, "black"),
bar(114, "red"),
bar(228, "green"),
bar(342, "blue"),
bar(456, "magenta"),
bar(570, "cyan"),
bar(684, "yellow"),
bar(width) ] ),
band(height) ])
end</lang>
The following example is a wee tiny bit more interesting.
<lang Icon>procedure SMPTE_TestCard() #: return structure with 480i(ish) testcard
return testcard(,"SMPTE TV Test Card",width := 672,height := 504,
[ band( 1, [ bar( 1, "#c0c0c0"),
bar( 95, "#c0c000"),
bar(191, "#00c0c0"),
bar(288, "#00c000"),
bar(383, "#c000c0"),
bar(480, "#c00000"),
bar(575, "#0000c0"),
bar(width) ] ),
band(335, [ bar( 1, "#0000c0"),
bar( 95, "#131313"),
bar(191, "#c000c0"),
bar(288, "#131313"),
bar(383, "#00c0c0"),
bar(480, "#131313"),
bar(575, "#c0c0c0"),
bar(width) ] ),
band(378, [ bar( 1, "#00214c"),
bar(120, "#ffffff"),
bar(240, "#32006a"),
bar(360, "#131313"),
bar(480, "#090909"),
bar(512, "#131313"),
bar(544, "#1d1d1d"),
bar(576, "#131313"),
bar(width) ] ),
band(height) ])
end</lang>
{{libheader|Icon Programming Library}}
[http://www.cs.arizona.edu/icon/library/src/procs/graphics.icn graphics.icn provides graphics]
[http://www.cs.arizona.edu/icon/library/src/procs/printf.icn printf.icn provides sprintf]
=={{header|J}}==
|
Revision as of 01:56, 14 July 2011
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
The task is to display a series of vertical color bars across the width of the display. The color bars should either use the system palette, or the sequence of colors: Black, Red, Green, Blue, Magenta, Cyan, Yellow, White.
Icon and Unicon
The procedure below is generalized to take a description of a test card and display it.
<lang Icon>link graphics,printf
procedure main() # generalized colour bars
DrawTestCard(Simple_TestCard()) WDone()
end
procedure DrawTestCard(TC)
size := sprintf("size=%d,%d",TC.width,TC.height) &window := TC.window := open(TC.id,"g","bg=black",size) | stop("Unable to open window")
every R := TC.bands[r := 1 to *TC.bands -1] do every C := R.bars[c := 1 to *R.bars - 1] do {
Fg(R.bars[c].colour) FillRectangle( C.left, R.top, R.bars[c+1].left-C.left, TC.bands[r+1].top-R.top ) }
return TC
end
record testcard(window,id,width,height,bands) record band(top,bars) record bar(left,colour)
procedure Simple_TestCard() #: return structure simple testcard
return testcard(,"Simple Test Card",width := 800,height := 600,
[ band( 1, [ bar( 1, "black"), bar(114, "red"), bar(228, "green"), bar(342, "blue"),
bar(456, "magenta"), bar(570, "cyan"), bar(684, "yellow"), bar(width) ] ),
band(height) ]) end</lang>
The following example is a wee tiny bit more interesting. <lang Icon>procedure SMPTE_TestCard() #: return structure with 480i(ish) testcard
return testcard(,"SMPTE TV Test Card",width := 672,height := 504,
[ band( 1, [ bar( 1, "#c0c0c0"), bar( 95, "#c0c000"),
bar(191, "#00c0c0"),
bar(288, "#00c000"), bar(383, "#c000c0"), bar(480, "#c00000"), bar(575, "#0000c0"), bar(width) ] ), band(335, [ bar( 1, "#0000c0"), bar( 95, "#131313"), bar(191, "#c000c0"), bar(288, "#131313"), bar(383, "#00c0c0"), bar(480, "#131313"), bar(575, "#c0c0c0"), bar(width) ] ), band(378, [ bar( 1, "#00214c"), bar(120, "#ffffff"), bar(240, "#32006a"), bar(360, "#131313"), bar(480, "#090909"), bar(512, "#131313"), bar(544, "#1d1d1d"), bar(576, "#131313"), bar(width) ] ), band(height) ]) end</lang>
graphics.icn provides graphics printf.icn provides sprintf
J
<lang j> load 'viewmat'
size=. 2{.".wd'qm' NB. J6 size=. getscreenwh_jgtk_ NB. J7 'rgb'viewmat (|.size){. (>.&.(%&160)|.size)$ 20# 256#.255*#:i.8</lang>
Liberty BASIC
<lang lb>nomainwin colors$="black red green blue pink cyan yellow white" WindowWidth=DisplayWidth:WindowHeight=DisplayHeight UpperLeftX=1:UpperLeftY=1 barWidth=DisplayWidth/8 graphicbox #main.g, 0,0,DisplayWidth,DisplayHeight open "" for window_popup as #main
- main "trapclose [quit]"
- main.g "down; setfocus; when characterInput [quit]"
- main.g "when leftButtonUp [quit]"
- main.g "size ";barWidth
for x = barWidth/2 to DisplayWidth step barWidth
i=i+1 if i>8 then i=1 col$=word$(colors$,i) #main.g "color ";col$;"; line ";x;" 0 ";x;" ";DisplayHeight
next wait [quit] close #main:end
</lang>
PicoLisp
<lang PicoLisp>(call 'clear)
(let Width (in '(tput cols) (read))
(do (in '(tput lines) (read)) (for B (range 0 7) (call 'tput 'setab B) (space (/ Width 8)) ) (prinl) ) )
(call 'tput 'sgr0) # reset</lang>
PureBasic
Press Enter or Escape to exit the program. <lang PureBasic>Dim color(7) color(0) = RGB($00, $00, $00) ;black color(1) = RGB($FF, $00, $00) ;red color(2) = RGB($00, $FF, $00) ;green color(3) = RGB($00, $00, $FF) ;blue color(4) = RGB($FF, $00, $FF) ;magenta color(5) = RGB($00, $FF, $FF) ;cyan color(6) = RGB($FF, $FF, $00) ;yellow color(7) = RGB($FF, $FF, $FF) ;white
If Not InitKeyboard(): End: EndIf ;can't init keyboard If Not InitSprite(): End: EndIf ;can't init sprite/screen library If Not ExamineDesktops(): End: EndIf ;can't retrieve information about desktop
height = DesktopHeight(0) width = DesktopWidth(0) depth = DesktopDepth(0) If OpenScreen(width, height, depth, "Press ENTER to exit")
StartDrawing(ScreenOutput()) For c = 0 To 7 Box((width * c) / 8, 0, width / 8, height, color(c)) Next StopDrawing() FlipBuffers()
Repeat Delay(10) ExamineKeyboard() Until KeyboardPushed(#PB_Key_Escape) Or KeyboardPushed(#PB_Key_Return) CloseScreen()
EndIf</lang>
Alternate method using console
<lang PureBasic>DataSection
;Black, Red, Green, Blue, Magenta, Cyan, Yellow, White Data.i 0, 12, 10, 9, 13, 11, 14, 15
EndDataSection
Dim colors(7) For c = 0 To 7
Read.i colors(c)
Next
If OpenConsole()
;The console display is 80 columns wide by 25 rows For r = 0 To 24 For c = 0 To 7 ConsoleColor(colors(c), colors(c)) Print(Space(80 / 8)) Next Next EnableGraphicalConsole(1) ConsoleLocate(0, 0) ConsoleTitle("Press ENTER to exit"): Input() CloseConsole()
EndIf</lang>
Tcl
<lang tcl>package require Tcl 8.5 package require Tk 8.5
wm attributes . -fullscreen 1 pack [canvas .c -highlightthick 0] -fill both -expand 1 set colors {black red green blue magenta cyan yellow white}
for {set x 0} {$x < [winfo screenwidth .c]} {incr x 8} {
.c create rectangle $x 0 [expr {$x+7}] [winfo screenheight .c] \ -fill [lindex $colors 0] -outline {} set colors [list {*}[lrange $colors 1 end] [lindex $colors 0]]
}</lang>
UNIX Shell
<lang sh>#!/bin/sh clear WIDTH=`tput cols` HEIGHT=`tput lines` NUMBARS=8 BARWIDTH=`expr $WIDTH / $NUMBARS`
l="1" # Set the line counter to 1 while [ "$l" -lt $HEIGHT ]; do
b="0" # Bar counter while [ "$b" -lt $NUMBARS ]; do tput setab $b s="0" while [ "$s" -lt $BARWIDTH ]; do echo -n " " s=`expr $s + 1` done b=`expr $b + 1` done echo # newline l=`expr $l + 1`
done
tput sgr0 # reset</lang>
ZX Spectrum Basic
<lang basic>10 REM The ZX Spectrum display is 32 columns wide, so we have 8 columns of 4 spaces 20 FOR r=0 TO 20: REM There are 21 rows 30 FOR c=0 TO 7: REM We use the native colour sequence here 40 PAPER c: REM set the background colour for the spaces to be printed 50 PRINT " ";: REM four spaces, the semicolon prevents newline 60 NEXT c 70 REM at this point the cursor has wrapped, so we don't need a newline 80 NEXT r</lang>