Colour pinstripe/Display

From Rosetta Code
Task
Colour pinstripe/Display
You are encouraged to solve this task according to the task description, using any language you may know.

The task is to create 1 pixel wide coloured vertical pinstripes with a sufficient number of pinstripes to span the entire width of the graphics display. The pinstripes should either follow the system palette sequence or a sequence that includes Black, Red, Green, Blue, Magenta, Cyan, Yellow, White.

After filling the top quarter of the, we switch to a wider 2 pixel wide vertical pinstripe pattern. Halfway down the display we switch to 3 pixel wide vertical pinstripe and then finally to a 4 pixels wide vertical pinstripe for the last quarter of the display.

J

<lang j> load 'viewmat'

  size=. 2{.".wd'qm' NB. J6
  size=. getscreenwh_jgtk_  NB. J7
  'rgb'viewmat (4<.@%~{:size)# ({.size) $&> 1 2 3 4#&.> <256#.255*#:i.8</lang>

PureBasic

<lang PureBasic>;Create a Pinstripe image with a pattern of vertical stripe colors Procedure PinstripeDisplay(width, height, Array psColors(1), numColors = 0)

 Protected x, imgID, psHeight = height / 4, psWidth = 1, psTop, horzBand, curColor
 If numColors < 1: numColors = ArraySize(psColors()) + 1: EndIf
   
 imgID = CreateImage(#PB_Any, width, height)
 If imgID
   StartDrawing(ImageOutput(imgID))
     Repeat 
       x = 0
       curColor = 0
       Repeat
         Box(x, psTop, psWidth, psHeight, psColors(curColor))
         curColor = (curColor + 1) % numColors
         x + psWidth
       Until x >= width
       psWidth + 1
       horzBand + 1
       psTop = horzBand * height / 4  ;move to the top of next horizontal band of image
     Until psTop >= height 
   StopDrawing()
 EndIf
 ProcedureReturn imgID

EndProcedure

Open a window and display the pinstripe

If OpenWindow(0, 0, 0, 1, 1,"PureBasic Pinstripe", #PB_Window_Maximize | #PB_Window_SystemMenu)

 Dim psColors(7)
 psColors(0) = RGB($00, $00, $00) ;black
 psColors(1) = RGB($FF, $00, $00) ;red
 psColors(2) = RGB($00, $FF, $00) ;green
 psColors(3) = RGB($00, $00, $FF) ;blue
 psColors(4) = RGB($FF, $00, $FF) ;magenta
 psColors(5) = RGB($00, $FF, $FF) ;cyan
 psColors(6) = RGB($FF, $FF, $00) ;yellow
 psColors(7) = RGB($FF, $FF, $FF) ;white 
 PicID = PinstripeDisplay(WindowWidth(0), WindowHeight(0), psColors())
 ImageGadget(0, 0, 0, WindowWidth(0), WindowHeight(0), ImageID(PicID))
 While WaitWindowEvent() <> #PB_Event_CloseWindow
 Wend  

EndIf</lang>

Tcl

Library: Tk

<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}

set dy [expr {[winfo screenheight .c]/4}] set y 0 foreach dx {1 2 3 4} {

   for {set x 0} {$x < [winfo screenwidth .c]} {incr x $dx} {

.c create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \

           -fill [lindex $colors 0] -outline {}

set colors [list {*}[lrange $colors 1 end] [lindex $colors 0]]

   }
   incr y $dy

}</lang>