Colour pinstripe/Display: Difference between revisions
No edit summary |
|||
Line 206:
//--------------------------------------------------------------------------------------------------
</lang>
=={{header|Common Lisp}}==
Using Allegro's Common Graphics. As stated in the comments, I'm using line drawing here
which causes the line caps to make the edges between regions to be a bit ragged. I mention
a couple of alternatives there which I'm too lazy to implement right now.
<lang lisp>(in-package :cg-user)
;;; We only need a bitmap pane - nothing fancy
(defclass draw-pane (bitmap-pane)())
;;; close it down by clicking on it
(defmethod mouse-left-down ((pane draw-pane) buttons data)
(declare (ignore buttons data))
(close pane))
;;; Create the window and draw the pinstripes
(defun make-draw-window ()
(let ((win (make-window :one :class 'draw-pane :width 300 :height 200)))
(draw win)))
;;; Function to draw the pinstripes. The lines are a bit ragged at the intersections
;;; between pinstripe sections due to the fact that common graphics uses round line
;;; caps and there doesn't appear any way to change that. Could be fixed by using
;;; rectangles rather than lines or, perhaps, by setting rectangular clipping regions.
(defun draw (win)
(do ((lwidth 1 (+ 1 lwidth))
(top 0 bottom)
(colors (make-array 8 :initial-contents
'(black red green blue magenta cyan yellow white)))
(bottom (/ (height win) 4) (+ (/ (height win) 4) bottom)))
((eql 5 lwidth) t)
(with-line-width (win lwidth)
(do ((xpos 0 (+ xpos lwidth))
(clr-ndx 0 (mod (+ clr-ndx 1) 8)))
((> xpos (width win)) t)
(with-foreground-color (win (aref colors clr-ndx))
(draw-line win
(make-position xpos top)
(make-position xpos bottom)))))))</lang>
=={{header|Icon}} and {{header|Unicon}}==
|
Revision as of 10:14, 9 July 2013
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 display, 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.
AutoHotkey
Requires the GDI+ standard library: http://www.autohotkey.com/forum/viewtopic.php?t=32238
It is worth noting that this fills the whole screen; press Esc to exit.
<lang AHK>h := A_ScreenHeight
w := A_ScreenWidth
pToken := gdip_Startup()
hdc := CreateCompatibleDC()
hbm := CreateDIBSection(w, h)
obm := SelectObject(hdc, hbm)
G := Gdip_GraphicsFromHDC(hdc)
OnExit, Exit
Gui -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop Gui Show, NA hwnd := WinExist()
colors := [0xFF000000, 0xFFFF0000, 0xFF00FF00, 0xFF0000FF , 0xFFFF00FF, 0xFF00FFFF, 0xFFFFFF00, 0xFFFFFFFF] ; ARGB pBrush := [] Loop % colors.MaxIndex() pBrush[A_Index] := Gdip_BrushCreateSolid(colors[A_Index]) Loop 4 { n := A_Index Loop % w Gdip_FillRectangle(G, pBrush[Mod(A_Index-1, colors.MaxIndex())+1] , A_Index*n-n, (n-1)*h/4, n, h/4) }
UpdateLayeredWindow(hwnd, hdc, 0, 0, W, H)
Loop % colors.MaxIndex() Gdip_DeleteBrush(pBrush[A_Index])
SelectObject(hdc, obm) DeleteObject(hbm) DeleteDC(hdc) Gdip_DeleteGraphics(G) Return
Esc:: Exit: Gdip_Shutdown(pToken) ExitApp</lang>
BBC BASIC
<lang bbcbasic> SW_MAXIMIZE = 3
SYS "ShowWindow", @hwnd%, SW_MAXIMIZE VDU 26 W% = @vdu%!208 * 2 H% = @vdu%!212 / 2 COLOUR 1,9 COLOUR 2,10 COLOUR 3,12 COLOUR 4,13 COLOUR 5,14 COLOUR 6,11 COLOUR 7,15 Y% = H%*4 FOR P% = 1 TO 4 Y% -= H% FOR X% = 0 TO W% STEP 4*P% C% = (C% + 1) MOD 8 GCOL C% RECTANGLE FILL X%, Y%, 2*P%, H% NEXT NEXT P%
</lang>
C++
- include <windows.h>
//-------------------------------------------------------------------------------------------------- class pinstripe { public:
pinstripe() { createColors(); } void setDimensions( int x, int y ) { _mw = x; _mh = y; } void createColors() {
colors[0] = 0; colors[1] = 255; colors[2] = RGB( 0, 255, 0 ); colors[3] = RGB( 0, 0, 255 ); colors[4] = RGB( 255, 0, 255 ); colors[5] = RGB( 0, 255, 255 ); colors[6] = RGB( 255, 255, 0 ); colors[7] = RGB( 255, 255, 255 );
}
void draw( HDC dc ) { HPEN pen;
int lh = _mh / 4, row, cp; for( int lw = 1; lw < 5; lw++ ) { cp = 0;
row = ( lw - 1 ) * lh;
for( int x = 0 + lw > 1 ? lw > 3 ? 2 : 1 : 0; x < _mw; x += lw ) { pen = CreatePen( PS_SOLID, lw, colors[cp] ); ++cp %= 8;
SelectObject( dc, pen ); MoveToEx( dc, x, row, NULL ); LineTo( dc, x, row + lh ); DeleteObject( pen ); } }
}
private:
int _mw, _mh; DWORD colors[8];
}; //-------------------------------------------------------------------------------------------------- pinstripe pin;
//-------------------------------------------------------------------------------------------------- void PaintWnd( HWND hWnd ) {
PAINTSTRUCT ps; HDC hdc = BeginPaint( hWnd, &ps ); pin.draw( hdc ); EndPaint( hWnd, &ps );
} //-------------------------------------------------------------------------------------------------- LRESULT CALLBACK WndProc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam ) {
switch( msg ) {
case WM_DESTROY: PostQuitMessage( 0 ); break; case WM_PAINT: PaintWnd( hWnd ); break; default: return DefWindowProc( hWnd, msg, wParam, lParam );
} return 0;
} //-------------------------------------------------------------------------------------------------- HWND InitAll( HINSTANCE hInstance ) {
WNDCLASSEX wcex; ZeroMemory( &wcex, sizeof( wcex ) );
wcex.cbSize = sizeof( WNDCLASSEX ); wcex.style = CS_HREDRAW | CS_VREDRAW; wcex.lpfnWndProc = WndProc; wcex.hInstance = hInstance; wcex.hCursor = LoadCursor( NULL, IDC_ARROW ); wcex.hbrBackground = ( HBRUSH )( COLOR_WINDOW + 1 ); wcex.lpszClassName = "_CLR_PS_";
RegisterClassEx( &wcex ); return CreateWindow( "_CLR_PS_", ".: Clr Pinstripe -- PJorente :.", WS_POPUP, CW_USEDEFAULT, 0, 200, 200, NULL, NULL, hInstance, NULL );
} //-------------------------------------------------------------------------------------------------- int APIENTRY _tWinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPTSTR lpCmdLine, int nCmdShow ) {
srand( GetTickCount() );
HWND hwnd = InitAll( hInstance ); if( !hwnd ) return -1;
int mw = GetSystemMetrics( SM_CXSCREEN ),
mh = GetSystemMetrics( SM_CYSCREEN );
pin.setDimensions( mw, mh );
RECT rc = { 0, 0, mw, mh };
AdjustWindowRectEx( &rc, WS_POPUP, FALSE, 0 ); int w = rc.right - rc.left,
h = rc.bottom - rc.top;
int posX = ( GetSystemMetrics( SM_CXSCREEN ) >> 1 ) - ( w >> 1 ),
posY = ( GetSystemMetrics( SM_CYSCREEN ) >> 1 ) - ( h >> 1 );
SetWindowPos( hwnd, HWND_TOP, posX, posY, w, h, SWP_NOZORDER ); ShowWindow( hwnd, nCmdShow ); UpdateWindow( hwnd );
MSG msg; ZeroMemory( &msg, sizeof( msg ) ); while( msg.message != WM_QUIT ) {
if( PeekMessage( &msg, NULL, 0, 0, PM_REMOVE ) != 0 ) { TranslateMessage( &msg ); DispatchMessage( &msg ); }
} return UnregisterClass( "_CLR_PS_", hInstance );
} //-------------------------------------------------------------------------------------------------- </lang>
Common Lisp
Using Allegro's Common Graphics. As stated in the comments, I'm using line drawing here which causes the line caps to make the edges between regions to be a bit ragged. I mention a couple of alternatives there which I'm too lazy to implement right now. <lang lisp>(in-package :cg-user)
- We only need a bitmap pane - nothing fancy
(defclass draw-pane (bitmap-pane)())
- close it down by clicking on it
(defmethod mouse-left-down ((pane draw-pane) buttons data)
(declare (ignore buttons data)) (close pane))
- Create the window and draw the pinstripes
(defun make-draw-window ()
(let ((win (make-window :one :class 'draw-pane :width 300 :height 200))) (draw win)))
- Function to draw the pinstripes. The lines are a bit ragged at the intersections
- between pinstripe sections due to the fact that common graphics uses round line
- caps and there doesn't appear any way to change that. Could be fixed by using
- rectangles rather than lines or, perhaps, by setting rectangular clipping regions.
(defun draw (win)
(do ((lwidth 1 (+ 1 lwidth)) (top 0 bottom) (colors (make-array 8 :initial-contents '(black red green blue magenta cyan yellow white))) (bottom (/ (height win) 4) (+ (/ (height win) 4) bottom))) ((eql 5 lwidth) t) (with-line-width (win lwidth) (do ((xpos 0 (+ xpos lwidth)) (clr-ndx 0 (mod (+ clr-ndx 1) 8))) ((> xpos (width win)) t) (with-foreground-color (win (aref colors clr-ndx)) (draw-line win (make-position xpos top) (make-position xpos bottom)))))))</lang>
Icon and Unicon
This is a modified version of the Pinstripe/Display solution. A shrunken screenshot is included.
<lang Icon>link graphics,numbers,printf
procedure main() # pinstripe
&window := open("Colour Pinstripe","g","bg=black") | stop("Unable to open window")
WAttrib("canvas=hidden") WAttrib(sprintf("size=%d,%d",WAttrib("displaywidth"),WAttrib("displayheight"))) WAttrib("canvas=maximal") Colours := ["black", "red", "green", "blue", "magenta", "cyan", "yellow", "white"] height := WAttrib("height") width := WAttrib("width") maxbands := 4 # bands to draw bandheight := height / maxbands # height of each band every bands := 1 to maxbands do { # for each band top := 1 + bandheight * (bands-1) # .. top of band every c := 1 to width do { colour := Colours[ceil((c+0.)/bands)%*Colours+1] if colour == "black" then next # skip black else { Fg(colour) DrawLine(c,top,c,top+bandheight-1) } } } WDone()
end</lang>
graphics.icn provides graphics numbers.icn provides ceil printf.icn provides sprintf
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>
OCaml
<lang ocaml>open Graphics
let () =
open_graph ""; let width = size_x () and height = size_y () in let colors = [| black; red; green; blue; magenta; cyan; yellow; white |] in let num_colors = Array.length colors in let h = height / 4 in for i = 1 to 4 do let j = 4 - i in for x = 0 to pred width do set_color colors.((x / i) mod num_colors); moveto x (j * h); lineto x (j * h + h); done done; ignore(read_key())</lang>
run with:
$ ocaml graphics.cma pinstripe.ml
Perl
<lang Perl>#!/usr/bin/perl -w use strict ; use GD ;
my $image = new GD::Image( 320 , 240 ) ; my %colors = ( "white" => [ 255 , 255 , 255 ] , "red" => [255 , 0 , 0 ] ,
"green" => [ 0 , 255 , 0 ] , "blue" => [ 0 , 0 , 255 ] , "magenta" => [ 255 , 0 , 255 ] , "yellow" => [ 255 , 255 , 0 ] , "cyan" => [ 0 , 255 , 255 ] , "black" => [ 0 , 0 , 0 ] ) ;
my @paintcolors ; foreach my $color ( keys %colors ) {
my $paintcolor = $image->colorAllocate( @{$colors{ $color }} ) ; push @paintcolors, $paintcolor ;
} my $startx = 0 ; my $starty = 0 ; my $run = 0 ; my $barheight = 240 / 4 ; my $colorindex = 0 ; while ( $run < 4 ) {
my $barwidth = $run + 1 ; while ( $startx + $barwidth < 320 ) { $image->filledRectangle( $startx , $starty , $startx + $barwidth ,
$starty + $barheight - 1 , $paintcolors[ $colorindex % 8 ] ) ;
$startx += $barwidth ; $colorindex++ ; } $starty += $barheight ; $startx = 0 ; $colorindex = 0 ; $run++ ; }
open ( DISPLAY , ">" , "pinstripes.png" ) || die ; binmode DISPLAY ; print DISPLAY $image->png ; close DISPLAY ;</lang>
Perl 6
<lang perl6>my $HOR = 1280; my $VERT = 720;
my @colors = map -> $r, $g, $b { [$r, $g, $b] },
0, 0, 0, 255, 0, 0, 0,255, 0, 0, 0,255, 255, 0,255, 0,255,255, 255,255, 0, 255,255,255;
my $PPM = open "pinstripes.ppm", :w, :bin or die "Can't create pinstripes.ppm: $!";
$PPM.print: qq:to/EOH/;
P6 # pinstripes.ppm $HOR $VERT 255 EOH
my $vzones = $VERT div 4; for 1..4 -> $w {
my $hzones = ceiling $HOR / $w / +@colors; my $line = Buf.new: ((@colors Xxx $w) xx $hzones).splice(0,$HOR).map: *.values; $PPM.write: $line for ^$vzones;
}
$PPM.close;</lang>
PicoLisp
<lang PicoLisp>(de *Colors # Black Red Green Blue Magenta Cyan Yellow White
((0 0 0) (255 0 0) (0 255 0) (0 0 255) (255 0 255) (0 255 255) (255 255 0) (255 255 255) .) )
(let Ppm # Create PPM of 384 x 288 pixels
(make (for N 4 (let L (make (do (/ 384 N) (let C (pop *Colors) (do N (link C)) ) ) ) (do 72 (link L)) ) ) ) (out '(display) # Pipe to ImageMagick (prinl "P6") # NetPBM format (prinl (length (car Ppm)) " " (length Ppm)) (prinl 255) (for Y Ppm (for X Y (apply wr X))) ) )</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>
Racket
<lang Racket>
- lang racket/gui
(define-values [W H] (get-display-size #t))
(define parts 4) (define colors
'("Black" "Red" "Green" "Blue" "Magenta" "Cyan" "Yellow" "White"))
(define (paint-pinstripe canvas dc)
(send dc set-pen "black" 0 'transparent) (send dc set-brush "black" 'solid) (define H* (round (/ H parts))) (for ([row parts]) (define Y (* row H*)) (for ([X (in-range 0 W (add1 row))] [c (in-cycle colors)]) (send dc set-brush c 'solid) (send dc draw-rectangle X Y (add1 row) H*))))
(define full-frame%
(class frame% (define/override (on-subwindow-char r e) (when (eq? 'escape (send e get-key-code)) (send this show #f))) (super-new [label "Color Pinstripe"] [width W] [height H] [style '(no-caption no-resize-border hide-menu-bar no-system-menu)]) (define c (new canvas% [parent this] [paint-callback paint-pinstripe])) (send this show #t)))
(void (new full-frame%)) </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}
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>
XPL0
<lang XPL0>code ChIn=7, Point=41, SetVid=45; int X, Y, W, C; [SetVid($13); \set 320x200 graphics mode in 256 colors for Y:= 0 to 200-1 do \for all the scan lines...
[W:= Y/50 + 1; \width of stripe = 1, 2, 3, 4 C:= 0; \set color to black so first pixel becomes blue for X:= 0 to 320-1 do \for all the pixels on a scan line... [if rem(X/W) = 0 then C:= C+1; \cycle through all system colors Point(X, Y, C); \set pixel at X,Y to color C ]; ];
X:= ChIn(1); \wait for keystroke SetVid(3); \restore normal text mode display ]</lang>