Rosetta Code

Pinstripe/Display: Difference between revisions

Page Discussion

Pinstripe/Display (view source)

Revision as of 11:52, 25 January 2024

18,318 bytes added ,  4 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
m (bold important info and format the task)
m (→‎{{header|Wren}}: Changed to Wren S/H)
(23 intermediate revisions by 13 users not shown)
Line 1:
{{task|Test card}}
[[File:Pinstripe-mono-unicon.gif|thumb|right|Sample image]]
 
The task is to demonstrate the creation of a series of vertical pinstripes across '''the entire width of the display'''.
* in the first quarter the pinstripes should alternate one pixel white, one pixel black = 1 pixel wide vertical pinestripes
Line 6 ⟶ 7:
* Half way down the display, we switch to 3 pixels wide,
* for the lower quarter of the display we use 4 pixels.
 
 
c.f. [[Colour_pinstripe/Display]]
<br><br>
=={{header|6502 Assembly}}==
{{works with|https://skilldrick.github.io/easy6502/ Easy6502}}
This is very similar to the color pinstripe task. It actually takes <i>more</i> code to execute, though not by much.
Output can be viewed by copying this source code, then clicking "Assemble" then "Run."
<syntaxhighlight lang="6502asm">define color $00
define looptemp $01
lda #1
sta color
 
loop_1wide:
lda color
and #$01
; this takes advantage of the fact that Easy6502 maps black to 0 and white to 1.
; Thus if we clear all but bit 0 the color will be either black or white, alternating infinitely regardless of the actual value
; of the color variable.
 
sta $0200,x
inc color
inx
bne loop_1wide
 
loop_2wide:
lda color
and #$01
sta $0300,x
inx
sta $0300,x
inc color
inx
bne loop_2wide
 
lda #1
sta color
lda #0
tax
tay
sta looptemp ;reset regs
 
loop_3wide:
lda color
and #$01
sta $0400,x
inc looptemp
inx
 
sta $0400,x
inc looptemp
inx
 
sta $0400,x
inc looptemp
inc color
inx
 
lda looptemp
cmp #$1e
bne loop_3wide
 
lda color ;loop overhead
and #$01
sta $0400,x ;can't fit all of this stripe.
;two columns will have to do.
inx
lda color
and #$01
sta $0400,x
inx
 
lda #1
sta color
lda #0
sta looptemp ;reset color and looptemp
iny
cpy #$08 ;check secondary loop counter
bne loop_3wide
 
lda #1
sta color
lda #0
tax
tay
sta looptemp
 
loop_4wide:
lda color
and #$01
sta $0500,x
inx
inc looptemp
 
sta $0500,x
inx
inc looptemp
 
sta $0500,x
inx
inc looptemp
 
sta $0500,x
inc color
inc looptemp
inx
 
lda looptemp
cmp #$20
bne loop_4wide
lda #0
sta looptemp
lda #1
sta color
 
iny
cpy #$8
bcc loop_4wide
 
brk ;program end</syntaxhighlight>
 
=={{header|8086 Assembly}}==
<syntaxhighlight lang="asm"> ;;; Display pinstripes on a PC, using 8086 assembly.
;;; The 640x200 CGA video mode is used. If you are on an MDA, the
;;; program does not run.
bits 16
cpu 8086
;;; IBM BIOS (INT 10h) calls
vmode: equ 0Fh ; Get current video mode
;;; Video modes
MDATXT: equ 7 ; MDA text mode (to check current mode against)
CGAHI: equ 6 ; CGA "high resolution" mode (640x200)
;;; Video memory
M_EVEN: equ 0B800h ; Video memory segment for even scanlines
M_ODD: equ 0BA00h ; Video memory segment for odd scanlines
section .text
org 100h
cld ; Make sure string instructions go forward
mov ah,vmode ; Get current video mode
int 10h
cmp al,MDATXT ; Are we in MDA text mode?
jne gr_ok
ret ; Then stop (no graphics support)
gr_ok: mov [oldmod],al ; otherwise, store old graphics mode,
mov ax,CGAHI ; and switch to hi-res CGA mode
int 10h
;;; There are 200 lines on the screen, but even and odd scanlines
;;; are stored separately. Because we're drawing vertical lines
;;; at a quarter of the screen, every odd scanline matches the
;;; even one before it. This means we really only need 100 lines,
;;; which means a quarter of the screen is 25 lines. There are
;;; 640 pixels per line, so each quarter consists of 16.000 pixels,
;;; or 2000 bytes, or 1000 words.
mov bp,1000 ; Keep a '1000' constant loaded
mov ax,M_EVEN ; Start with the even scan lines
mov dl,2 ; Let DL = 2 (we are doing the loop twice)
screen: mov es,ax ; Let ES be the video segment
xor di,di ; Start at the beginning
mov si,one ; Starting with pattern one
lodsw
mov cx,bp ; Write 1000 words of pattern one
rep stosw
lodsw
mov cx,bp ; Write 1000 words of pattern two
rep stosw
lodsb ; Pattern three is more complicated
xchg al,bl ; Let BL be the 3rd byte,
lodsw ; and AX be the first two.
mov bh,25 ; We need to write 25 lines,
quart3: mov cx,26 ; and every line we need to write 26*3 bytes
line3: stosw
xchg al,bl
stosb
xchg al,bl
loop line3
stosw ; Plus two final bytes per line
dec bh
jnz quart3
lodsw ; Finally, write 1000 words of pattern four
mov cx,bp
rep stosw
mov ax,M_ODD ; Then, do the odd scanlines
dec dl ; If we haven't already done them
jnz screen
;;; We are now done. Wait for a key, restore the old video mode,
;;; and exit.
xor ah,ah ; Wait for a key
int 16h
xor ah,ah ; Restore the old video mode
mov al,[oldmod]
int 10h
ret ; And exit
section .data
;;; Pattern data
one: dw 0AAAAh ; one on, one off pattern
two: dw 0CCCCh ; two on, two off pattern
three: db 38h ; three isn't divisible by 16
dw 8EE3h ; we need 24 bits for the pattern to repeat
four: dw 0F0F0h ; four on, four off pattern
section .bss
oldmod: resb 1 ; place to keep old video mode, in order to
; restore it. </syntaxhighlight>
 
 
=={{header|Action!}}==
<syntaxhighlight lang="action!">PROC Main()
BYTE
CH=$02FC, ;Internal hardware value for last key pressed
COLOR0=$02C4,COLOR1=$02C5,COLOR2=$02C6,COLOR4=$02C8
CARD i
Graphics(8+16)
COLOR4=$04 ;gray
COLOR1=$00 ;black
COLOR2=$0F ;white
 
FOR i=0 TO 319
DO
Color=i MOD 2
Plot(i,0) DrawTo(i,47)
 
Color=i/2 MOD 2
Plot(i,48) DrawTo(i,95)
 
Color=i/3 MOD 2
Plot(i,96) DrawTo(i,143)
 
Color=i/4 MOD 2
Plot(i,144) DrawTo(i,191)
OD
 
DO UNTIL CH#$FF OD
CH=$FF
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Pinstripe_display.png Screenshot from Atari 8-bit computer]
 
=={{header|ActionScript}}==
<syntaxhighlight lang="actionscript3">
<lang ActionScript3>
package {
Line 63 ⟶ 298:
 
}
</syntaxhighlight>
</lang>
 
=={{header|Ada}}==
{{libheader|SDLAda}}
<langsyntaxhighlight Adalang="ada">with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;
Line 134 ⟶ 369:
Window.Finalize;
SDL.Finalise;
end Pinstripe_Display;</langsyntaxhighlight>
 
=={{header|AutoHotkey}}==
Requires the GDI+ standard library: http://www.autohotkey.com/forum/viewtopic.php?t=32238<br/>
It is worth noting that this fills the whole screen; press Esc to exit.
<langsyntaxhighlight AHKlang="ahk">h := A_ScreenHeight
w := A_ScreenWidth
pToken := Gdip_Startup()
Line 178 ⟶ 413:
Exit:
Gdip_Shutdown(pToken)
ExitApp</langsyntaxhighlight>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> GWL_STYLE = -16
HWND_TOPMOST = -1
WS_VISIBLE = &10000000
Line 205 ⟶ 441:
FOR X% = 0 TO xscreen%*4-16 STEP 16
RECTANGLE FILL X%,yscreen%*0/2,8,yscreen%/2
NEXT</langsyntaxhighlight>
 
=={{header|Befunge}}==
Line 213 ⟶ 449:
The dimensions of the image are specified by the first two values on the stack: 1366 (<tt>"%":*3-</tt>) by 768 (<tt>"`"8*</tt>).
 
<langsyntaxhighlight lang="befunge">"%":*3-"`"8*>4/::8%00p8/10p4*\55+"1P",,v
,:.\.5vv-g025:\-1_$$55+,\:v1+*8g01g00_@>
024,+5<>/2%.1+\:>^<:\0:\-1_$20g1-:20p^1p</langsyntaxhighlight>
 
=={{header|C}}==
This code is only a slight variation of my [http://rosettacode.org/wiki/Colour_pinstripe/Display#C Colour Pinstripe C code]. It also uses Borland's Turbo C graphics library.
 
<syntaxhighlight lang="c">
<lang C>
#include<graphics.h>
#include<conio.h>
Line 248 ⟶ 484:
return 0;
}
</syntaxhighlight>
</lang>
 
=={{header|C sharp}}==
 
Using System.Drawing, and writing the output to a file.
 
<syntaxhighlight lang="csharp">
using System.Drawing;
 
public class Pinstripe
{
static void Main(string[] args)
{
var pinstripe = MakePinstripeImage(1366, 768);
pinstripe.Save("pinstripe.png");
}
 
public static Bitmap MakePinstripeImage(int width, int height)
{
var image = new Bitmap(width, height);
var quarterHeight = height / 4;
for (var y = 0; y < height; y++)
{
var stripeWidth = (y / quarterHeight) + 1;
for (var x = 0; x < width; x++)
{
var color = ((x / stripeWidth) % 2) == 0 ? Color.White : Color.Black;
image.SetPixel(x, y, color);
}
}
return image;
}
}
</syntaxhighlight>
 
=={{header|C++}}==
[[File:bw_pinstripe_cpp.png|300px]]
<langsyntaxhighlight lang="cpp">
#include <windows.h>
 
Line 370 ⟶ 642:
}
//--------------------------------------------------------------------------------------------------
</syntaxhighlight>
</lang>
 
=={{header|C sharpDelphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
 
Using System.Drawing, and writing the output to a file.
 
<syntaxhighlight lang="Delphi">
<lang csharp>
using System.Drawing;
 
procedure DrawVerticalStripes(Image: TImage; PenWidth,Top,Bottom: integer);
public class Pinstripe
{Draw vertical stripes across full width of image}
{
{Top/Bottom Control the position of the band of stripes}
static void Main(string[] args)
{PenWidth controls width of the line drawn}
{
var X,X2,Y: integer;
var pinstripe = MakePinstripeImage(1366, 768);
begin
pinstripe.Save("pinstripe.png");
Image.Canvas.Pen.Width:=PenWidth;
}
for X:=0 to (Image.Width div PenWidth)-1 do
begin
if (X mod 2)=0 then Image.Canvas.Pen.Color:=clWhite
else Image.Canvas.Pen.Color:=clBlack;
X2:=X * PenWidth;
Image.Canvas.MoveTo(X2,Top);
Image.Canvas.LineTo(X2,Bottom);
end;
end;
 
procedure ShowVerticalStripes(Image: TImage);
{Draw all four bands of stripes}
var SHeight: integer;
var I: integer;
begin
SHeight:=Image.Height div 4;
for I:=0 to 4-1 do
begin
DrawVerticalStripes(Image,I+1,SHeight*I,SHeight*(I+1));
end;
end;
 
 
</syntaxhighlight>
{{out}}
[[File:DelphiPinstripes.png|thumb|none]]
<pre>
Elapsed Time: 26.113 ms.
</pre>
 
public static Bitmap MakePinstripeImage(int width, int height)
{
var image = new Bitmap(width, height);
var quarterHeight = height / 4;
for (var y = 0; y < height; y++)
{
var stripeWidth = (y / quarterHeight) + 1;
for (var x = 0; x < width; x++)
{
var color = ((x / stripeWidth) % 2) == 0 ? Color.White : Color.Black;
image.SetPixel(x, y, color);
}
}
return image;
}
}
</lang>
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">' version 14-03-2017
' compile with: fbc -s console
' or compile with: fbc -s gui
Line 434 ⟶ 715:
'Print : Print "hit any key to end program"
Sleep
End</langsyntaxhighlight>
 
=={{header|Gambas}}==
<langsyntaxhighlight lang="gambas">'WARNING this takes a time to display
'Use the 'gb.qt4' component
 
Line 464 ⟶ 745:
Next
End</langsyntaxhighlight>
 
'''[http://www.cogier.com/gambas/Pinstripe.png Click here for an image of the output]'''
Line 471 ⟶ 752:
{{libheader|Go Graphics}}
The code here is the same as that for the [https://rosettacode.org/wiki/Colour_pinstripe/Display#Go Color pinstripe task] except that the palette is limited to the two colors, white and black.
<langsyntaxhighlight lang="go">package main
 
import "github.com/fogleman/gg"
Line 497 ⟶ 778:
pinstripe(dc)
dc.SavePNG("w_pinstripe.png")
}</langsyntaxhighlight>
 
{{out}}
Line 506 ⟶ 787:
=={{header|Icon}} and {{header|Unicon}}==
Icon and Unicon can't access the screen directly, so this pinstripe is produced in a maximal sized window. The maximal dimensions have been empirically reduced to keep the boundary on the screen.
<langsyntaxhighlight Iconlang="icon">link graphics
procedure main() # pinstripe
Line 528 ⟶ 809:
}
WDone(W) # q to exit
end</langsyntaxhighlight>
 
{{libheader|Icon Programming Library}}
Line 535 ⟶ 816:
=={{header|J}}==
 
<langsyntaxhighlight lang="j"> load'viewmat'
NB. size=. 2{.".wd'qm' NB. J6
NB. size=. getscreenwh_jgtk_ '' NB. J7
size=. 3{".wd'qscreen' NB. J8
'rgb'viewmat- (4<.@%~{:size)# ({.size) $&> 1 2 3 4#&.> <0 1</langsyntaxhighlight>
 
=={{header|Java}}==
<langsyntaxhighlight lang="java">import java.awt.*;
import javax.swing.*;
 
Line 579 ⟶ 860:
});
}
}</langsyntaxhighlight>
 
=={{header|Julia}}==
In the Luxor module, the setline() function sets the line width in pixels, which is convenient for pinstriping.
<langsyntaxhighlight lang="julia">
using Luxor
 
Line 604 ⟶ 885:
finish()
preview()
</syntaxhighlight>
</lang>
 
=={{header|Kotlin}}==
{{trans|Java}}
<langsyntaxhighlight lang="scala">// version 1.1.0
 
import java.awt.*
Line 648 ⟶ 929:
f.setVisible(true)
}
}</langsyntaxhighlight>
 
=={{header|Lambdatalk}}==
Using HTML+CSS
<syntaxhighlight lang="scheme">
{def window
{lambda {:w :h}
div
{@ style="position:relative;
top:0; left:0;
width::wpx; height::hpx;
background:#eee;"}}}
-> window
 
{def rec
{lambda {:x :y :w :h :c}
{div
{@ style="position:absolute;
top::ypx; left::xpx;
width::wpx; height::hpx;
background::c;"}}}}
-> rec
 
{def row
{lambda {:w :h :k}
{S.map {{lambda {:dx :dy :h :i}
{rec :i :dy :dx :h #000}
{rec {+ :i :dx} :dy :dx :h #fff}
} {pow 2 :k} {* :k {/ :w 8}} {/ :h 4}}
{S.serie 0 {- :w 1} {pow 2 {+ :k 1}}}}}}
-> row
 
{def WIDTH 512}
-> WIDTH
{def HEIGHT 256}
-> HEIGHT
 
{{window {WIDTH} {WIDTH}}
{S.map {row {WIDTH} {HEIGHT}}
0 1 2 3}}
</syntaxhighlight>
Output visible in http://lambdaway.free.fr/lambdawalks/?view=color_bar_display
 
=={{header|Liberty BASIC}}==
Fills whole screen; use Alt-F4 to close program.
<syntaxhighlight lang="lb">
<lang lb>
nomainwin
 
Line 679 ⟶ 1,001:
close #gr
end
</syntaxhighlight>
</lang>
 
=={{header|Locomotive Basic}}==
 
<langsyntaxhighlight lang="locobasic">10 MODE 2 ' finest resolution
20 sh=400 ' screen height
30 sw=640 ' screen width
Line 702 ⟶ 1,024:
180 IF dc>1 THEN dc=0
190 NEXT l
200 NEXT sn</langsyntaxhighlight>
 
=={{header|Lua}}==
{{libheader|LÖVE}}
{{works with|LÖVE|011.9.23}}
<langsyntaxhighlight lang="lua">
function love.load()
WIDTH = love.windowgraphics.getWidth()
ROW_HEIGHT = math.floor(love.windowgraphics.getHeight()/4)
love.graphics.setBackgroundColor({0,0,0})
love.graphics.setLineWidth(1)
Line 726 ⟶ 1,048:
end
end
</syntaxhighlight>
</lang>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">color[y_] := {White, Black}[[Mod[y, 2] + 1]];
Graphics[Join[{Thickness[1/408]},
Flatten[{color[#], Line[{{# - 1/2, 408}, {# - 1/2, 307}}]} & /@
Line 738 ⟶ 1,060:
Range[136]], {Thickness[1/102]},
Flatten[{color[#], Line[{{4 # - 2, 102}, {4 # - 2, 1}}]} & /@
Range[102]]], ImageSize -> {408, 408}]</langsyntaxhighlight>
{{out}}
See [https://www.dropbox.com/s/2ukd07ja3ubyjma/Mathematica_Pinstripes.png?dl=0 here].
 
=={{header|Nim}}==
{{libheader|gintro}}
The code is almost the same as for [[https://rosettacode.org/wiki/Colour_pinstripe/Display#Nim Color pinstripe task]].
<syntaxhighlight lang="nim">import gintro/[glib, gobject, gtk, gio, cairo]
 
const
Width = 420
Height = 420
 
const Colors = [[255.0, 255.0, 255.0], [0.0, 0.0, 0.0]]
 
#---------------------------------------------------------------------------------------------------
 
proc draw(area: DrawingArea; context: Context) =
## Draw the bars.
 
const lineHeight = Height div 4
 
var y = 0.0
for lineWidth in [1.0, 2.0, 3.0, 4.0]:
context.setLineWidth(lineWidth)
var x = 0.0
var colorIndex = 0
while x < Width:
context.setSource(Colors[colorIndex])
context.moveTo(x, y)
context.lineTo(x, y + lineHeight)
context.stroke()
colorIndex = 1 - colorIndex
x += lineWidth
y += lineHeight
 
#---------------------------------------------------------------------------------------------------
 
proc onDraw(area: DrawingArea; context: Context; data: pointer): bool =
## Callback to draw/redraw the drawing area contents.
 
area.draw(context)
result = true
 
#---------------------------------------------------------------------------------------------------
 
proc activate(app: Application) =
## Activate the application.
 
let window = app.newApplicationWindow()
window.setSizeRequest(Width, Height)
window.setTitle("Color pinstripe")
 
# Create the drawing area.
let area = newDrawingArea()
window.add(area)
 
# Connect the "draw" event to the callback to draw the bars.
discard area.connect("draw", ondraw, pointer(nil))
 
window.showAll()
 
#———————————————————————————————————————————————————————————————————————————————————————————————————
 
let app = newApplication(Application, "Rosetta.Pinstripe")
discard app.connect("activate", activate)
discard app.run()</syntaxhighlight>
 
=={{header|Perl}}==
<langsyntaxhighlight lang="perl">use Imager;
 
my($xsize,$ysize) = (640,400);
Line 761 ⟶ 1,147:
}
 
$img->write(file => 'pinstripes-bw.png');</langsyntaxhighlight>
[https://github.com/SqrtNegInf/Rosettacode-Perl5-Smoke/blob/master/ref/pinstripes-bw.png Pinstripes] (offsite image)
 
=={{header|Perl 6}}==
{{Works with|rakudo|2018.10}}
<lang perl6>my ($x,$y) = 1280,720;
my @colors = 0, 1;
 
spurt "pinstripes.pgm", qq:to/EOH/ orelse .die;
P5
# pinstripes.pgm
$x $y
1
EOH
 
my $img = open "pinstripes.pgm", :a, :bin orelse .die;
 
my $vzones = $y div 4;
for 1..4 -> $w {
my $stripes = ceiling $x / $w / +@colors;
my $line = Buf.new: (flat((@colors Xxx $w) xx $stripes).Array).splice(0,$x); # DH change 2015-12-20
$img.write: $line for ^$vzones;
}
 
$img.close;</lang>
 
=={{header|Phix}}==
<!--(phixonline)-->
Just change [http://rosettacode.org/wiki/Colour_pinstripe/Display#Phix Colour Pinstripe] such that colours = {CD_BLACK, CD_WHITE}
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(let Pbm # Create PBM of 384 x 288 pixels
(make
(for N 4
Line 804 ⟶ 1,168:
(prinl "P1")
(prinl (length (car Pbm)) " " (length Pbm))
(mapc prinl Pbm) ) )</langsyntaxhighlight>
 
=={{header|PureBasic}}==
<langsyntaxhighlight PureBasiclang="purebasic">#White = $FFFFFF ;color
 
;Create a Pinstripe image
Line 836 ⟶ 1,200:
While WaitWindowEvent() <> #PB_Event_CloseWindow
Wend
EndIf</langsyntaxhighlight>
 
=={{header|Python}}==
<syntaxhighlight lang="python">
<lang Python>
#Python task for Pinstripe/Display
#Tested for Python2.7 by Benjamin Curutchet
Line 896 ⟶ 1,260:
im.save('PictureResult.jpg')
 
</syntaxhighlight>
</lang>
 
=={{header|Quackery}}==
 
Adapted from [[Colour pinstripe/Display#Quackery]].
 
<syntaxhighlight lang="Quackery"> [ $ "turtleduck.qky" loadfile ] now!
 
[ 1280 ] is width ( --> n )
[ 720 ] is height ( --> n )
 
[ 0 0 0 ] is black ( --> n n n )
[ 255 255 255 ] is white ( --> n n n )
 
[ [] swap
' [ black white ]
witheach
[ over times
[ dip swap tuck
nested join
unrot ]
drop ]
drop ] is colours ( n --> [ )
 
[ behead
dup dip
[ nested join ] ] is nextcolour ( [ --> [ [ )
 
[ nextcolour colour
-1 4 turn
height n->v
4 n->v v/ 2dup walk
-v fly
1 4 turn
1 n->v fly ] is stripe ( [ --> [ )
 
[ turtle
50 frames
width n->v 2 1 v/ fly
-1 4 turn
height n->v 2 1 v/ fly
-1 4 turn
4 times
[ i^ 1+ colours
width times stripe
drop
width n->v -v fly
-1 4 turn
height n->v
4 n->v v/ fly
1 4 turn ]
1 frames ] is pinstripes ( --> )</syntaxhighlight>
 
{{out}}
 
[[File:Quackery pinstripes.png|thumb|center]]
 
=={{header|Racket}}==
(As usual with Racket, this code works on all platforms.)
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket/gui
 
Line 930 ⟶ 1,347:
 
(void (new full-frame%))
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
{{Works with|rakudo|2018.10}}
<syntaxhighlight lang="raku" line>my ($x,$y) = 1280,720;
my @colors = 0, 1;
 
spurt "pinstripes.pgm", qq:to/EOH/ orelse .die;
P5
# pinstripes.pgm
$x $y
1
EOH
 
my $img = open "pinstripes.pgm", :a, :bin orelse .die;
 
my $vzones = $y div 4;
for 1..4 -> $w {
my $stripes = ceiling $x / $w / +@colors;
my $line = Buf.new: (flat((@colors Xxx $w) xx $stripes).Array).splice(0,$x); # DH change 2015-12-20
$img.write: $line for ^$vzones;
}
 
$img.close;</syntaxhighlight>
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
# Project : Pinstripe/Display
 
Line 995 ⟶ 1,436:
label1 { setpicture(p1) show() }
return
</syntaxhighlight>
</lang>
Output:
 
Line 1,002 ⟶ 1,443:
=={{header|Scala}}==
===Java Swing Interoperability===
<langsyntaxhighlight Scalalang="scala">import java.awt._
 
import javax.swing._
Line 1,038 ⟶ 1,479:
})
 
}</langsyntaxhighlight>
 
=={{header|Sinclair ZX81 BASIC}}==
Requires at least 2k of RAM. (Why? Because the whole screen is in use: we have no separate video RAM, so the 1k model runs out of memory trying to plot the bottom quarter of the display.)
 
The ZX81's graphics resolution is only 64x44, so this is quite a blocky pinstripe. It would be 64x48, in fact; but a strip along the bottom of the screen is reserved for system messages and user input and cannot be made available for other purposes (at least not from BASIC).
<langsyntaxhighlight lang="basic">10 FOR W=1 TO 4
20 FOR I=0 TO 63 STEP 2*W
30 FOR J=1 TO W
Line 1,051 ⟶ 1,493:
70 NEXT J
80 NEXT I
90 NEXT W</langsyntaxhighlight>
{{out}}
Screenshot [http://www.edmundgriffiths.com/zx81pinstripe.jpg here].
Line 1,057 ⟶ 1,499:
=={{header|Tcl}}==
{{libheader|Tk}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
package require Tk 8.5
Line 1,073 ⟶ 1,515:
}
incr y $dy
}</langsyntaxhighlight>
 
=={{header|Wren}}==
{{trans|Go}}
{{libheader|DOME}}
<syntaxhighlight lang="wren">import "graphics" for Canvas, Color
import "dome" for Window
 
class Game {
static init() {
Window.title = "Pinstripe"
__width = 900
__height = 600
Canvas.resize(__width, __height)
Window.resize(__width, __height)
var colors = [
Color.hex("FFFFFF"), // white
Color.hex("000000") // black
]
pinstripe(colors)
}
 
static pinstripe(colors) {
var w = __width
var h = (__height/4).floor
for (b in 1..4) {
var x = 0
var ci = 0
while (x < w) {
var y = h * (b - 1)
Canvas.rectfill(x, y, b, h, colors[ci%2])
x = x + b
ci = ci + 1
}
}
}
 
static update() {}
 
static draw(dt) {}
}</syntaxhighlight>
 
=={{header|XPL0}}==
<langsyntaxhighlight XPL0lang="xpl0">include c:\cxpl\codes; \include 'code' declarations
int X, Y, W, C;
[SetVid($13); \320x200x8 graphics
Line 1,089 ⟶ 1,571:
X:= ChIn(1); \wait for keystroke
SetVid(3); \restore normal text display
]</langsyntaxhighlight>
 
Output: [[File:PinsXPL0.png]]
 
=={{header|Z80 Assembly}}==
 
This program works on the MSX. It draws the lines by redefining part of the character set.
Given the restrictions of the platform, this is actually the best way to do it.
If your MSX supports the high resolution mode, and you have it active, the program detects
it and fills the whole screen with twice as many lines.
 
<syntaxhighlight lang="z80"> ;;; Display pinstripes on an MSX, using Z80 assembly.
;;; We'll use the monochrome 'text' mode to do it, by changing
;;; a few characters in the VDP font. This program will use
;;; either low resolution mode (240x192) or high resolution
;;; mode (480x192) depending on which is already active.
;;; (In MSX-DOS, `MODE 40` and `MODE 80` switch between them.)
;;;
;;; The characters are 6x8, stored row-wise, and the low two
;;; bits are ignored. This means that one-pixel alternating
;;; pinstripes are created using the following pattern:
onep: equ 0A8h ; 1 0 1 0 1 0 (0 0)
;;; A 2-pixel pattern needs two alternating characters:
twop1: equ 0CCh ; 1 1 0 0 1 1 (0 0)
twop2: equ 030h ; 0 0 1 1 0 0 (0 0)
;;; 3 * 2 = 6, so the 3-pixel pattern fits in one character:
threep: equ 0E0h ; 1 1 1 0 0 0 (0 0)
;;; And we need four characters for the 4-pixel pattern:
fourp1: equ 0F0h ; 1 1 1 1 0 0 (0 0)
fourp2: equ 03Ch ; 0 0 1 1 1 1 (0 0)
fourp3: equ 0Ch ; 0 0 0 0 1 1 (0 0)
fourp4: equ 0C0h ; 1 1 0 0 0 0 (0 0)
;;; -------------------------------------------------------------
bdos: equ 5 ; Use the BDOS routine to wait for a keypress
dirio: equ 6 ; after the drawing is done
;;; MSX ROM calls
calslt: equ 1Ch ; Interslot call
rom: equ 0FCC0h ; Main ROM slot
initxt: equ 6Ch ; Initialize text mode
;;; RAM location
linlen: equ 0F3B0h ; Contains line length, if <=40 we're in low res mode
;;; VDP data
vreg: equ 99h ; Port on which the VDP registers are accessed
vdata: equ 98h ; Port on which the VRAM is accessed
VWRITE: equ 40h ; Bit 6 in VDP address = enable writing
;;; (these are for low-res mode, high-res mode has them doubled)
font: equ 0800h ; Location of start of font data
qrtr: equ 240 ; Amount of bytes that fill a quarter of the screen
;;; -------------------------------------------------------------
org 100h
;;; Redefine characters 0-7 to the eight characters we need
ld hl,font ; Get VDP font location
call reshl ; Correct for hires mode if necessary
call setadr ; Set the VDP to read from that address
ld hl,pats ; Pattern data
ld c,8 ; Write 8 characters
wrpats: ld b,8 ; 8 lines per character
ld a,(hl) ; Load current pattern byte
wrpat: out (vdata),a ; Write it to the VDP,
djnz wrpat ; 8 times.
inc hl ; Next pattern
dec c ; Any patterns left?
jr nz,wrpats ; If so, write next pattern
ld hl,0 ; Set the VDP to write to address 0
call setadr ; which is the beginning of the text screen.
;;; Figure out how big a quarter of the screen is
ld hl,qrtr ; Get value for low resolution,
call reshl ; Correct for high res mode if necessary
push hl ; Store number on the stack
;;; Write the first quarter of the screen: 1-pixel stripes
;;; (character 0).
ld b,0
call qrtrch
;;; Write the second quarter of the screen: 2-pixel stripes
;;; (characters 1 and 2 alternating).
pop hl ; Load size from the stack
push hl
or a ; Clear carry
rr h ; Divide by 2
rr l
q2loop: ld a,1 ; Character 1,
out (vdata),a
inc a ; and character 2.
nop ; Slowdown to make sure the VDP can keep up
nop
out (vdata),a
dec hl
ld a,h ; HL = 0?
or l
jr nz,q2loop ; If not, next 2 bytes
;;; Write the third quarter of the screen: 3-pixel stripes
;;; (character 3)
ld b,3
call qrtrch
;;; Write the fourth quarter of the screen: 4-pixel stripes
;;; (characters 4, 5, 6, and 7 alternating)
pop hl ; Load size from stack
or a ; Divide by 4
rr h
rr l
or a
rr h
rr l
q4loop: ld a,4 ; Character 4
ld b,a ; 4 characters at a time
q4out: out (vdata),a ; Write the character,
inc a ; Next character,
djnz q4out ; 4 times.
dec hl
ld a,h ; Done yet?
or l
jr nz,q4loop ; If not, next 4 bytes
;;; -------------------------------------------------------------
;;; We're done, now wait for a keypress.
clear: ld c,dirio ; First, wait while a key IS pressed
ld e,0FFh ; (so we don't quit immediately if the user
call bdos ; has held the enter key a bit too long)
and a
jr nz,clear
wait: ld c,dirio ; Then, wait while a key is NOT pressed
ld e,0FFh
call bdos
and a
jr z,wait
;;; Afterwards, use a BIOS routine to reinitialize the screen
;;; (this will reload the default font).
ld iy,rom ; BIOS call to initialize text mode
ld ix,initxt
jp calslt
;;; -------------------------------------------------------------
;;; Subroutine: write character in B to a quarter of the screen
qrtrch: pop de ; Return address
pop hl ; Load size from the stack
push hl
push de ; Put return address back
qloop: ld a,b ; Write character in B
out (vdata),a
dec hl ; One fewer byte left
ld a,h ; Done yet?
or l
jr nz,qloop ; If not, next byte
ret
;;; -------------------------------------------------------------
;;; Subroutine: double HL if we are in high resolution mode
reshl: ld a,(linlen) ; Check which mode we're in
cp 41 ; Higher than 40?
ret c ; If not, we're not in hires mode
add hl,hl ; We are in hires mode, so double HL
ret
;;; -------------------------------------------------------------
;;; Subroutine: set the VDP to write to address HL.
setadr: di ; No interrupts while we're messing with VDP
xor a ; High address bits for MSX-2 VDP are all 0
out (vreg),a ; (MSX-1 VDP will just ignore the zeroes)
ld a,14|128 ; Write to register 14
out (vreg),a
ld a,l ; Write the low address byte
out (vreg),a
ld a,h
or VWRITE ; High address bits bits (5..0)
out (vreg),a ; Write high addr bits and write flag
ei ; Reenable interrupts
ret
;;; Patterns to replace the first characters with
pats: db onep,twop1,twop2,threep
db fourp1,fourp2,fourp3,fourp4</syntaxhighlight>
 
{{omit from|Blast}}
PureFox
9,482

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/182218...350747"