Pygmy Forth on FreeDOS:
80 CONSTANT WIDTH
VARIABLE X
: FILLER ( N - ) WIDTH SWAP - 2 / SPACES ;
: ROW ( N - ) DUP FILLER FOR 42 EMIT NEXT CR ;
: XMASTR ( - )
CR
3 FOR
8 I 1 + 2 * - X !
4 FOR
4 I -
X @ * 1 - ROW
NEXT
NEXT
3 ROW 3 ROW
;
It looks like assigning to quad might be the way:
⎕←2 4⍴'WINEMART'
Or, possibly, doing that mid-line:
If
⎕appears to the left of the←symbol, it causes the result so far to be displayed. This may not be the result of evaluating the complete line as⎕can occur anywhere on the line. The data is output together with a newline (carriage return) character
I learned a few more tricks. Here’s a more APL-ish solution without a loop, though it uses a lot more memory, and I haven’t been able to get it to run on TOPS-20. (This was coded in Dyalog on my PC.)
It considers the display as an array of characters, and creates a series of arrays to store the display row and column of each cell, as well as the number of stars and the first and last columns of printed stars on each cell’s row. Finally, a map for printing stars is generated by comparing each cell’s column with the first and last star columns for the cell’s row.
∇xmast2[⎕]∇
[0] xmast2 width;height;cells;celrow;celcol;nstars;first;last
[1] height←14
[2] cells←⍳height×width
[3] celrow←⌈cells÷width
[4] celcol←1+width|cells-1
[5] nstars←¯1+(2×1+⌊(celrow-1)÷4)×1+4|celrow-1
[6] nstars←((¯2×width)↓nstars),(2×width)⍴3
[7] first←⌈(80-nstars)÷2
[8] last←first+nstars-1
[9] ⎕UCS height width⍴32+10×(celcol≥first)∧celcol≤last
xmast2 80
*
***
*****
*******
***
*******
***********
***************
*****
***********
*****************
***********************
***
***
(I see the video review of competition entries has begun, as a livestream
)
main() {
extrn T;
auto i,s,o;
i = -1;
while(o=T[++i]) {
s=11-o/2;
while(s--) putchar(' ');
while(o--) putchar('*');
putchar('*n');
}
}
T[14] 1,3,5,7,3,7,11,15,5,11,17,23,3,3,0;
I tried it in SIMH’s PDP7 with Unix-V0 first, but wasn’t patient (or caffeinated?) enough to bear its ed, so I took the easier shortcut with ybc.
since we’re still playing (and why not!) I re-did my BCPL one in RTB Basic (which is my own version of Basic, written in C, runs under Linux)
It covers all bases this time…
// VC3 2021
// Gordon Henderson - RTB Basic
print "Data/Table driven..."
print
data 1,3,5,7, 3,7,11,15, 5,11,17,23, 3,3, 0
read numCones
while numCones <> 0 cycle
spaces = (tWidth - numCones) / 2
proc lineOfCones (spaces, numCones)
read numCones
repeat
print
print "Algorithm driven..."
print
for section = 1 to 3 cycle
for branch = 1 to 4 cycle
numCones = 2 * section * branch - 1
spaces = (twidth - numCones) / 2
proc lineOfCones (spaces, numCones)
repeat
repeat
for base = 1 to 2 cycle
numCones = 3
spaces = (twidth - numCones) / 2
proc lineOfCones (spaces, numCones)
repeat
print
print "Done."
end
def proc lineOfCones (s, c)
proc many (s, " ")
proc many (c, "*")
print
endproc
def proc many (n, thing$)
while n > 0 cycle
print thing$;
n = n - 1
repeat
endproc
Image of the run:
Cheers,
-Gordon
And just to get this completely out of my system (!!!) some years ago when I was into Pi stuff, I wrote a CESIL interpreter in my RTB Basic - which would normally be somewhat boring however I added a ‘tree’ command in to it with some “lights” that could be “lit up” via a CESIL program…
This is a link to my old blog post in 2012…
CESIL Controlled Christmas Tree
The tree:
Cheers,
-Gordon
FORTRAN-20 on TOPS-20
@type xmastr.for
c xmastr - Vintage Computing Christmas Challenge 2021
c Print Xmas tree centered on screen
c 2021 David Meyer <[email protected]> +JMJ
program xmastr
parameter nwidth = 80, nrows = 14
character*23 cstars
character*40 cspaces
cstars = '***********************'
cspaces = ' '
do 1000 irow = 1, nrows
istars = nrowstars (irow)
ifill = (nwidth - istars) / 2
write (5,10) cspaces(1:ifill)//cstars(1:istars)
10 format (1x,a)
1000 continue
stop
end
c nrowstars - Return number os stars to print on row <nrow>
function nrowstars (nrow)
if (nrow.gt.12) then
nrowstars = 3
else
nrowstars = 2 * (1 + (nrow-1)/4) * (1 + mod(nrow-1,4)) - 1
end if
return
end
@exec xmastr
LINK: Loading
[LNKXCT XMASTR execution]
*
***
*****
*******
***
*******
***********
***************
*****
***********
*****************
***********************
***
***
CPU time 0.01 Elapsed time 0.00
@
REAL PROGRAMS ARE PUNCHED ON CARDS 
What version of FORTRAN are you using?
How does modern FORTRAN handle program
data that come on punched cards after the FORTAN
SOURCE deck?
Ben.
NOTICES FORTRAN-20 ON TOPS-20 AFTER POSTING.
Nice to see another algorithmic approach!
One of my first experiences of programming was at a Summer camp during Junior High in the late 1970s with FORTRAN on punch cards.Video terminals were for wimpy BASIC programmers. 
It’s not obvious, but that algorithm is lifted from my second APL version.
Didn’t quite get down to JGH’s 78 characters, but this is a non-algorithmic BBC BASIC version in 79 characters:
1A$="LKJIKIGEJGDAKK":F.I=1TO14:S=ASC(M.A$,I,1))-64:P.SPC(S);STRI.25-2*S,"*"):N.
C64 BASIC can be pretty small, despite the lack of STRING$():
1a$="lkjikigejgdakk":fori=1to14:s=asc(mid$(a$,i,1))-64:?spc(s);:forj=1to25-2*s
2?"*";:next:?:next
Turns out encoding for the spaces and calculating the number of asterisks makes for slightly shorter code than vice versa. I’m sure I could write something truly incomprehensible in PostScript or Perl, but I don’t want to unleash the Old High Ones again …
“Ph’nglui mglw’nafh Perl R’lyeh wgah’nagl fhtagn.”
for($r=1;$r<15;++$r){$s=$r<13?2*(1+int(($r-1)/4))*(1+($r-1)%4)-1:3;print ' 'x((79-$s)/2),'*'x$s,"\n";}
(102 bytes)
scruss’s encoding approach is fascinating the way it stores an integer array in the form of a character string. Here’s the Perl version:
$a='lkjikigejgdakk';for($i=0;$i<14;++$i){$s=ord(substr($a,$i,1))-69;print ' 'x$s,'*'x(79-2*$s),"\n";}
(101 bytes)
Obfuscated C
#include <stdio.h>
int main(){int r,s,c;for(r=1;r<15;++r){s=r>12?3:2*(1+(r-1)/4)*(1+(r-1)%4)-1;for(c=0;c<(79-s)/2;++c)printf(" ");for(c=0;c<s;++c)printf("*");printf("\n");}return 0;}
(185 bytes)
Okayyy then … Perl, 74 characters, and remarkably easy to understand, too:
print map{" "x$_."*"x(25-2*$_)."\n"}map{ord()-64}split //,"LKJIKIGEJGDAKK"
Best explained backwards:
split //,"LKJIKIGEJGDAKK" returns a list of characters: “L”, “K”, “J”, …map{ord()-64} transforms the list from characters to integers based on their ASCII code (ord()) less 64: 12, 11, 10, …map{" "x$_."*"x(25-2*$_)."\n"} converts those numbers (via the $_ default variable) into a string of that number of spaces, plus that-number-massaged-a-bit number of asterisks, plus a newline.If I were a good Perl programmer, I’d make the source look like something related to the output. I’m merely a mediocre one, though.
Sadly, my attempt to paste the program written using Perl’s Acme::Bleach was foiled by Markdown. Let’s just say it works just like Wile E. Coyote might expect it would …
asc() shouldn’t care if you leave off the ,1 (for what it’s worth, which is only two bytes).
I guess PostScript counts as retro, right, 'cos no-one (except Don Lancaster, perhaps) uses it as a programming language these days. So here’s a super-fancy one that prints centre-justified on A4 paper:
%!
/ZapfDingbats 14 selectfont 297.5 519 moveto (ACEGCGKOEKQWCC) dup length
exch { 64 sub } forall 2 1 count 2 sub { -1 roll } for {dup /n exch def
gsave {(O)} repeat n array astore 0 1 index { length add } forall string
0 3 2 roll { 3 copy putinterval length add } forall pop dup stringwidth
pop 2 div neg 0 rmoveto show grestore 0 -14 rmoveto } repeat showpage
which looks approximately like:
for {..., it’s ...} for that matters.dup /n exch def crop up frequently in handwritten PostScript: it means “store a copy of the value at the top of the stack in the variable n”(O) in the code is just a very fancy asterisk. If I felt suitably retro, I could replace it with ('), which Zapf Dingbats understands to be ✇ (U+2707, “Tape Drive”) …
So, here you are, @scruss 's Perl program on punch cards:
(Sadly, just a bit too long for a single card.)
Note: Since simple EBCD for the 029 doesn’t feature { and }, these are transcribed to (* and *), and back again.
Instructions:
