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:
PostScript, like FORTH, uses RPN. Don’t get waylaid by for {..., it’s ...} for that matters.
I used the same concept of an ASCII string encoding the length of the lines. Using PostScript graphics, centre-justifying strings is easy, so I don’t need to care about the spaces.
There’s no facility for joining strings in the language. Here I used a horribly inefficient method of joining an array of single characters into a string. I’ll admit to nicking it from here: How to concatenate strings?
I’d have preferred to rely entirely on the stack instead of using any variables, but my stack-fu was weak and I had to use a temporary counter variable. You’ll see code like 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”
You’ll notice the lack of asterisks in the code. PostScript fonts don’t have a strict adherence to any one standard encoding, and Zapf Dingbats has an especially odd one. It places ✯ (U+272F, “Pinwheel Star”) in the position of Latin Capital Letter O, so the (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”) …
(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.
I decided to up my game and take the challenge with TOP-20 MACRO assembly language. This is a data-driven solution, but handles the tree shape and centering by encoding them in the form of two arrays, one for the column position of the first star on each line, and another for the column position of the last star on each line (octal values).
Ways I would like to improve this:
The two arrays FIRST and LAST use a 36-bit word to store each column position, which wastes a lot of memory since the highest value stored is only 51. Is there a way to compress the arrays?
An algorithmic solution. This will take time since I still have a long way to go in my textbook before I get to enough arithmetic techniques to code the algorithm in MACRO.
@type xmastr.mac
TITLE XMASTR - Vintage Computing Christmas Challenge 2021
SEARCH MONSYM
COMMENT / Print Xmas tree centered on 79-character diaplay
2021 David Meyer <[email protected]> +JMJ
/
START: RESET
MOVEI 10,0 ;current line no
LINE: MOVEI 11,1 ;current column
MOVE 12,FIRST(10) ;col. of 1st star on line
MOVE 13,LAST(10) ;col. of last star on line
CHAR: CAMLE 11,12
JRST PSTAR
HRROI 1,SPACE
JRST PRINT
PSTAR: HRROI 1,STAR
PRINT: PSOUT
CAMG 11,13
AOJA 11,CHAR
HRROI 1,NEWLIN
PSOUT
CAIGE 10,15
AOJA 10,LINE
HALTF
FIRST: 50 ;column of first star on line
47
46
45
47
45
43
41
46
43
40
35
47
47
LAST: 50 ;column of last star on line
51
52
53
51
53
55
57
52
55
60
63
51
51
SPACE: ASCIZ / /
STAR: ASCIZ /*/
NEWLIN: ASCIZ /
/
END START
@exec xmastr.mac
LINK: Loading
[LNKXCT XMASTR execution]
*
***
*****
*******
***
*******
***********
***************
*****
***********
*****************
***********************
***
***
I did part of Advent of Code 2021 in Racket, which is a dialect of Scheme (the 7.x version of Racket that I am using is built on top of Chez Scheme, although 8.0 and beyond use a different implementation), but I did not solve this challenge there. I would do so, but since your implementation can be very quickly translated, it seems moot now.
I note that your version runs in Common Lisp under SBCL or CMUCL with only trivial changes to the // and '/ operators:
(defun branch (n)
(loop for i from 0 to (- 12 (/ n 2)) do (princ #\ ))
(loop for i from 1 to n do (princ #\*))
(terpri))
Yes, Common Lisp got a lot from Lisp Machine Lisp, and some features were backported from the latter into Maclisp. So it’s not very hard to write code that can be shared between all those dialects.
I also implemented it in KAP, which is my own APL-based programming language. It lacks rendering of 2-dimensional character arrays as regular text, so one needs a call to io:println which makes in longer than the APL solution. It’s 61 characters.
I have also implemented this in COBOL for MVJ 3.8j. This is a free version of MVS that was released in the 70’s and can be run on the Hercules emulator. The source includes the necessary JCL to run it on TK4 (a distribution of MVS that includes all the software you need. http://wotho.ethz.ch/tk4-/)
//TREE JOB (COBOL),
// 'TREE DISPLAY',
// CLASS=A,
// MSGCLASS=A,
// REGION=8M,TIME=1440,
// MSGLEVEL=(1,1)
//TREE EXEC COBUCG,
// PARM.COB='FLAGW,LOAD,SUPMAP,SIZE=2048K,BUF=1024K'
//COB.SYSPUNCH DD DUMMY
//COB.SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. 'TREE'.
*
ENVIRONMENT DIVISION.
*
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-360.
OBJECT-COMPUTER. IBM-360.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
77 I1 PIC 99.
77 I2 PIC 99.
77 OUTPUT-INDEX PIC 99.
77 OUTS PIC X.
77 N1 PIC 99.
77 N2 PIC 99.
77 DRAW-LINE-START PIC 99.
77 DRAW-LINE-SIZE PIC 99.
77 EMPTY-STRING PIC X(40) VALUE ' '.
01 OUT-STRING.
02 OUT-VALUES PIC X OCCURS 40.
01 OUT-LINE REDEFINES OUT-STRING.
02 RESULT PIC X(40).
*
PROCEDURE DIVISION.
*
MAIN-PART.
MOVE 1 TO I1.
PERFORM DRAW-BLOCK1 UNTIL I1 IS GREATER THAN 3.
*
MOVE 1 TO I1.
MOVE 18 TO DRAW-LINE-START.
MOVE 3 TO DRAW-LINE-SIZE.
PERFORM DRAW-MULTI-LINE UNTIL I1 IS GREATER THAN 3.
STOP RUN.
DRAW-BLOCK1.
MOVE 1 TO I2.
PERFORM DRAW-BLOCK2 UNTIL I2 IS GREATER THAN 4.
ADD 1 TO I1.
DRAW-BLOCK2.
MULTIPLY I1 BY I2 GIVING N2.
SUBTRACT N2 FROM 20 GIVING DRAW-LINE-START.
*
MULTIPLY N2 BY 2 GIVING N1.
SUBTRACT 1 FROM N1 GIVING DRAW-LINE-SIZE.
*
PERFORM DRAW-SINGLE-LINE.
ADD 1 TO I2.
ADD 1 TO I2.
SUBTRACT 1 FROM I2.
DRAW-MULTI-LINE.
PERFORM DRAW-SINGLE-LINE.
ADD 1 TO I1.
DRAW-SINGLE-LINE.
MOVE EMPTY-STRING TO RESULT.
MOVE 1 TO OUTPUT-INDEX.
MOVE ' ' TO OUTS.
PERFORM DRAW-CHAR UNTIL
OUTPUT-INDEX IS GREATER THAN DRAW-LINE-START.
MOVE '*' TO OUTS.
ADD DRAW-LINE-START TO DRAW-LINE-SIZE GIVING N1.
PERFORM DRAW-CHAR UNTIL OUTPUT-INDEX IS GREATER THAN N1.
DISPLAY RESULT.
DRAW-CHAR.
MOVE OUTS TO OUT-VALUES (OUTPUT-INDEX).
ADD 1 TO OUTPUT-INDEX.
/*
//COB.SYSLIB DD DSNAME=SYS1.COBLIB,DISP=SHR
//GO.SYSOUT DD SYSOUT=*,DCB=(RECFM=FBA,LRECL=161,BLKSIZE=16100)
/*
//
