Christmas Challenge

[okwatts]

I'm a forth newb and a first time contest entrant but it reminded me of the example from "Starting Forth"
I did it in a simple minded way, I'm sure there is an elegant way using loops to do the 1,3,5,7,etc as two loops with i=0to 3 and j=0 to i except for the last 2 rows of 3. I just couldn't get my head around the logic in the time available. No excuse now though!
Nowhere near 40 or 50 bytes though at 153 bytes.
Edit: Sorry I added the attachment before I figured out how to include code with keeping the formatting.

Code: Select all

> .......
CRCMon ver 0.8eps2w 12/07/21

> boot applications
1--EhBASIC,
2--Memory Diag,
3--CRCFig-Forth,
4--Secnd9-Forth 3 press Return to execute command

CRC65 FIG-FORTH SYM 2021
3 load OK
words DUMP HEXOUT NYBOUT ?ASCII WORDS FREE DUMPBLK 2/ 2* >> << J T.S .S P REPLACE-LINE -MOVE LINE TEXT MON VLIST TRIAD INDEX LIST ? . .R D. D.R #S # SIGN #> <# SPACES WHILE ELSE IF REPEAT AGAIN END UNTIL +LOOP LOOP DO THEN ENDIF BEGIN BACK FORGET ' R/W -BCD --> LOAD MESSAGE .LINE (LINE) BLOCK BUFFER EMPTY-BUFFERS FLUSH UPDATE +BUF PREV USE M/MOD */ */MOD MOD / /MOD * M/ M* MAX MIN DABS ABS D+- +- S->D COLD ABORT QUIT ( DEFINITIONS FORTH VOCABULARY IMMEDIATE INTERPRET ?STACK DLITERAL LITERAL [COMPILE] CREATE ID. ERROR (ABORT) -FIND NUMBER (NUMBER) UPPER WORD PAD HOLD BLANKS ERASE FILL  QUERY EXPECT ." (.") -TRAILING TYPE COUNT DOES> <BUILDS ;CODE (;CODE) DECIMAL HEX SMUDGE ] [ COMPILE ?LOADING ?CSP ?PAIRS ?EXEC ?COMP ?ERROR !CSP PFA NFA CFA LFA LATEST TRAVERSE -DUP SPACE ROT > < U< = - C, , ALLOT HERE 2+ 1+ HLD R# CSP FLD DPL BASE STATE CURRENT CONTEXT OFFSET SCR OUT IN BLK VOC-LINK DP FENCE WARNING WIDTH TIB +ORIGIN B/SCR B/BUF LIMIT FIRST C/L BL 3 2 1 0 USER VARIABLE CONSTANT ; : C! ! C@ @ TOGGLE +! DUP SWAP DROP OVER DMINUS MINUS D+ + 0< 0= R R> >R LEAVE ;S RP! SP! SP@ XOR OR AND U/ U* CMOVE CR ?TERMINAL KEY EMIT ENCLOSE (FIND) DIGIT I (DO) (+LOOP) (LOOP) 0BRANCH BRANCH EXECUTE CLIT LIT OK
free 
22250 Bytes available
OK
8 load OK
8 list 
SCR#8 
 0 ( Christmas Challenge )
 1 : star dup 0 do 42 emit loop ;
 2 : sline dup 61 swap - 2 / dup spaces swap star spaces cr ;
 3 
 4 : ntree cr 1 sline 3 sline 5 sline 7 sline 3 sline 7 sline
 5 11 sline 15 sline 5 sline 11 sline 17 sline 23 sline
 6 3 sline 3 sline ;
 7 
 8 
 9 
10 
11 
12 
13 
14 
15 
OK
ntree 
                              * 
                             ***   
                            *****     
                           *******       
                             ***   
                           *******       
                         ***********           
                       ***************               
                            *****     
                         ***********           
                      *****************                 
                   ***********************                       
                             ***   
                             ***   
OK
free 
22097 Bytes available
OK

[IamRob]

Applesoft one. This one comes in at 77 bytes

2 READ J: IF J THEN HTAB 20-J/2: FOR K=1 TO J: ? "*";: NEXT : ?: GOTO 2: DATA 1,3,5,7,3,7,11,15,5,11,17,23,3,3,0


ML one

with the Monitor bug is 50 bytes
without the bug is 43 bytes

Code: Select all

 ORG  $300 
 SHT 
  
 LDY  #13  
]LOOP  LDA  STARS,Y
 LSR
 EOR  #$FF
 ADC  #20
 TAX
 JSR  $F94A

 LDX  STARS,Y
 LDA  #"*"+$80
 JSR  APBUG		; could have been a call to $F94C

 JSR  $FD8E
 DEY
 BPL  ]LOOP
 RTS

STARS  DFB  3,3,23,17,11,5,15,11,7,3,7,5,3,1

	LDA #$A0		; this is the bug in the Monitor, where the BNE below branches here instead and forces the character to a space
APBUG	JSR $FDED
	DEX
	BNE APBUG
	RTS

[John West]

I knew I could do better. 36 'bytes' (of 16 bits each).

This one stores the run-lengths of spaces and stars in 6 bit fields, packed 5 to a 32 bit word. The runs of spaces include enough to wrap to the next line after each run of stars. There's no explicit end-of-data marker: the code follows immediately, and I've sneakily arranged that the top bit of the first 32 bit value in the code is set. So if the data is negative, we can exit the loop.

Before printing each run of characters, it switches to the other character with eor #$0a. That's an 8 bit instruction which clears the rest of the register, so the $802a loaded by the first instruction (which needed an operand with bit 15 set, so it can act as an 'end' mark when interpreted as data) becomes an 8 bit value before it's given to chrout.

The only other trick is hiding the RTS instruction in the data table. There happens to be a value of $2460 in there, and in the current version of the processor, the top 8 bits of RTS are ignored. I score points for interpreting data as code AND code as data, right?

Code: Select all

                                 109 	* = $f000
0000f000:                        110 treedata
0000f000: 0e53 2460              111 	.long %100100_000011_100110_000001_010011
0000f002: 8845 0398              112 	.long %000011_100010_001001_100001_000101
0000f004: 2de3 1bf1              113 	.long %011011_001011_011111_000111_100011
0000f006: 784f 0d77              114 	.long %001101_011110_000111_011101_001111
0000f008: 65d8 1a24              115 	.long %011010_011001_010010_010011_011000
0000f00a: 4c43 0039              116 	.long %000000_010011_000011_100101_000011
0000f00c:                        117 tree
0000f00c: 01a9 802a              118 	ldr.w a0, #$802a
0000f00e: a4fc                   119 	sub a1, a1
0000f00f:                        120 loop
0000f00f: 16b4 f000              121 	ldr.l y0, treedata, a1
0000f011: 0030 00ee              122 	bmi treedata+1
0000f013: 36e8                   123 	inc.l a1, #2
0000f014:                        124 branches
0000f014: 30a8                   125 	mov y1, y0
0000f015: 2037 003f              126 	and y1, #63
0000f017: 0049 000a              127 	eor a0, #$0a
0000f019:                        128 chars
0000f019: 90f0 f24e              129 	bra.l chrout
0000f01b: 0488                   130 	dec y1
0000f01c: 00d0 00fb              131 	bne chars
0000f01e: 2242 0006              132 	lsr.l y0, #6
0000f020: 00d0 00f2              133 	bne branches
0000f022: 80f0 00eb              134 	bra loop

[IamRob]

I like the one entry using the inline variable and has got my vote for the best entry. Here it is converted to Applesoft at 75 bytes.

0 ACEGCGKOEKQWCC=0: FOR I=0 TO 13: X= PEEK(2053+I)-64: FOR J=1 TO X:? TAB(20-X/2)"*";: NEXT: ?: NEXT

[okwatts]

I cleaned up my code to correct some stack creep and made an attempt to be a bit more "algorythmic". Still takes 152 bytes and perhaps losing some readability but I'm not anywhere close to the smallest code even if those examples stretch my ability to comprehend what is taking place.
( PS I am having an issue with my code loading going into nether regions hence the need to stick in a deliberate error in the screen. <sigh> more debugging required! )

Code: Select all

forget stars OK
free 
21971 Bytes available
OK
29 load 
21819 Bytes available
.s [0 ] OK
free 
21819 Bytes available
OK
29 list 
SCR#29 
 0 ( Christmas Challenge variable corrected )
 1 : stars 0 do 42 emit loop ;
 2 : sline dup 61 swap - 2 / dup spaces swap stars spaces cr ;
 3 
 4 0 variable cl
 5 : sp cl ! 4 0 do cl @ dup 1 + i * + sline loop ;
 6 : ctree cr 1 sp 3 sp 5 sp 3 sline 3 sline ;
 7 free
 8 ; ( required to get control back ??? )
 9 
10 
11 
12 
13 
14 
15 
OK
ctree 
                              *                              
                             ***                             
                            *****                            
                           *******                           
                             ***                             
                           *******                           
                         ***********                         
                       ***************                       
                            *****                            
                         ***********                         
                      *****************                      
                   ***********************                   
                             ***                             
                             ***                             
OK
.s [0 ] OK

[IamRob]

okwatts wrote:

I cleaned up my code to correct some stack creep and made an attempt to be a bit more "algorythmic". Still takes 152 bytes and perhaps losing some readability but I'm not anywhere close to the smallest code even if those examples stretch my ability to comprehend what is taking place.
( PS I am having an issue with my code loading going into nether regions hence the need to stick in a deliberate error in the screen. <sigh> more debugging required! )

Code: Select all

forget stars OK[/quote]

I took the one posted code and converted it to Forth.

10 FOR X=1 TO 5: FOR Y=1 TO 4: A=X*Y: IF X>3 then A=2:Y=4
20 PRINT TAB(21-A): for z=1 to A+A-1: ?"*";: next: ?: next: next

Here is the smallest I got in Forth at 102 bytes

: t 6 1 do i 5 1 do dup dup i * swap 3 > if drop R> R> drop 1 >R >R 
 2 then dup 20 swap - spaces dup + 1- 0 do 42 emit loop cr loop loop ;

[IamRob]

Here is the another conversion to Forth from another entry comes in at 99 bytes

: IT ;
: ACEGCGKOEKQWCCC ' IT 4 + 15 1 DO 1+ DUP C@ 64 - DUP 2 / 20 SWAP - SPACES
0 DO 42 EMIT LOOP CR LOOP DROP ;

[Dr Jefyll]

Adapted from the above, and about a dozen bytes shorter...

HERE
: ACEGCGKOEKQWCCC [ LITERAL ] 15 1 DO 1+ DUP C@ 64 - DUP 2 / 20 SWAP - SPACES
0 DO 42 EMIT LOOP CR LOOP DROP ;

[IamRob]

Yeah, but now try typing the word in to try to forget it. I just have to type FORGET IT.

[beethead]

I'm too late but my attempt comes in at 66 bytes on the C256 Foenix's 65816 using my own assembler.

Code: Select all

cpu '65816'
org $60
const width=72
const treepattern=array(1,3,5,9,3,7,11,15,19,5,11,17,23,3,3)
PUTC             = $001018
main:
	phk
	plb
	sep #$30
	ldy #sizeof(treepattern)-1
	-
		lda #' '
		ldx treedata,y,b
		jsr draw
		lda #'*'
		ldx tree,y,b
		jsr draw
		dey
		bpl -
	rtl
draw:
	pha
	jsl PUTC
	pla
	dex
	bne draw
	rts
var space1,space2=0
var treespace=array()
for i=0 to sizeof(treepattern)-1
	space1=trunc((width-treepattern[i])/2)
	treespace[i]=space1+space2
	space2=width-(space1+treepattern[i])
next
treedata:
	for i=sizeof(treepattern)-1 to 0 step-1
		byte treespace[i]
	next
tree:
	for i=sizeof(treepattern)-1 to 0 step-1
		byte treepattern[i]
	next

[drogon]

Just because you can doesn't mean you should.... (famous last words!)

So I thought just because... I'll do it in Sweet16... Naively thinking it might be smaller than some of the 6502 asm versions here, however, at $54 or decimal 84 bytes, then sadly no. Much is taken up by switching into and out of sweet16 mode, also given that sweet16 doesn't have any logical operators (e.g. shift) then my standard (terminal width - stars) / 2 calculation to get the leading spaces was going to be tricky, and I couldn't be bothered being clever, so I implemented a 2nd table.

The output is as it ought to be:

Code: Select all

* load tree 8000
* go
Starting program at $8000 (Emulation)
                                       *
                                      ***
                                     *****
                                    *******
                                      ***
                                    *******
                                  ***********
                                ***************
                                     *****
                                  ***********
                               *****************
                            ***********************
                                      ***
                                      ***

The source code... OK, here it is....

Code: Select all

; runTree.s:
;********************************************************************************

	.include	"sw16.h"
	.include	"sw16regs.h"
	.include	"runTree.h"
	.include	"osVectors.h"

.proc	runTree

	goSweet16

	set	r12,$0100	; Sweet16 stack pointer
	set	r2,1		; Constant 1
	set	r3,40		; Constant 40 - width / 2
	set	r8,treeData	; Address of the tree data table
	set	r9,spaceData	; Address of the tree branch spaces

loop:
	ld	@r9		; Loads and increments r9
	bz	done		; Reached the end
	set	r7,' '		; r7 has character to print
	bs	printIt	
	ld	@r8		; Loads and increments r8
	set	r7,'*'
	bs	printIt

; Newline

	rtn			; Back to 6502 land
	.setcpu "65c02"

	jsr	osNewl

	jsr	_sweet16	; Back to sweet16 land
	.setcpu	"sweet16"

	br	loop

; printIt:
;    Print Acc's worth of r7's...

printIt:
	rtn			; Back to 6502 land
	.setcpu "65c02"

	lda	r7l		; r7l has character to print
	jsr	osWrch

	jsr	_sweet16	; Back to sweet16 land
	.setcpu	"sweet16"

	sub	r2		; Subtract r1 (1) from Acc
	bnz	printIt
	rs			; Return from subroutine

done:
	exSweet16
	rts

.endproc


; treeData:
;********************************************************************************

treeData:
	.byte	1,3,5,7, 3,7,11,15, 5,11,17,23, 3,3

spaceData:
	.byte	39,38,37,36,38,36,34,32,37,34,31,28,38,38,0

So if anyone ever wanted to know what sweet16 looks like then there you are

Oh, small confession, actually the whole thing is rather longer as my Ruby 816 OS no-longer has Sweet16 as a part of it (the 6502 version still has, but I'm running this on my '816 board), so I had to include the sweet16 code too (my version which can be assembled anywhere), as well as the standard code header I use (to make it an Acorn compatible ROM. That takes it to

Code: Select all

-rw-rw-r-- 1 gordon gordon 782 Dec 22 20:21 tree

So, 782 bytes in total... But then I could also include the Ruby 816 OS, but where would you stop...

Cheers,

-Gordon

[barrym95838]

Regarding:

Code: Select all

set r2,1
...
sub r2

I think

Code: Select all

dcr r0

should be your friend here (unless I messed up and dcr doesn't affect flags). Also, I noticed that there are always an odd number of stars, so you could go back to a single table with entries of (stars-1)/2 and then

Code: Select all

ld @r8
st r1
set r0,20
sub r1

for your space count and

Code: Select all

ld r1
add r1
inr r0

for your star count (or something like that ...)

[drogon]

barrym95838 wrote:

Regarding:

Code: Select all

set r2,1
...
sub r2

I think

Code: Select all

dcr r0

should be your friend here.

Duh! Why did I forget the inr/dcr instructions. Obviously had too many sherrys last night, or something!

I'll have a look at the rest when I've done the morning tasks (dog, horse, house, etc.)

Cheers,

-Gordon

Quote:

Also, I noticed that there are always an odd number of stars, so you could go back to a single table with entries of (stars-1)/2 and then

Code: Select all

ld @r8
st r1
set r0,20
sub r1

for your space count and

Code: Select all

ld r1
add r1
inr r0

for your star count (or something like that ...)

[drogon]

barrym95838 wrote:

Regarding:

Code: Select all

set r2,1
...
sub r2

I think

Code: Select all

dcr r0

should be your friend here (unless I messed up and dcr doesn't affect flags). Also, I noticed that there are always an odd number of stars, so you could go back to a single table with entries of (stars-1)/2 and then

Code: Select all

ld @r8
st r1
set r0,20
sub r1

for your space count and

Code: Select all

ld r1
add r1
inr r0

for your star count (or something like that ...)

And yes, that works. Output:

Code: Select all

* ftp get tree
*load tree 8000
* go
Starting program at $8000 (Emulation)
                                        *
                                       ***
                                      *****
                                     *******
                                       ***
                                     *******
                                   ***********
                                 ***************
                                      *****
                                   ***********
                                *****************
                             ***********************
                                       ***
                                       ***

code length is now $47, or decimal 71 bytes.

Code: Select all

; runTree.s:
;********************************************************************************

	.include	"sw16.h"
	.include	"sw16regs.h"
	.include	"runTree.h"
	.include	"osVectors.h"

.proc	runTree

	goSweet16

	set	r12,$0100	; Sweet16 stack pointer
	set	r3,40		; Constant 40 - tWidth / 2, also end of data marker
	set	r8,treeData	; Address of the tree data table

loop:
	ld	@r8		; Fetch data into Acc; Loads and increments r8
	cpr	r3		; End of data?
	bz	done		; Reached the end
	st	r1		; Temp. store

	ld	r3		; 40 -> Acc
	sub	r1		; To get No. spaces
	set	r7,' '		; r7 has character to print
	bs	printIt		; Subroutine to print leading spaces

	ld	r1		; Get original table data
	add	r1		; double it
	inr	r0		; Add 1
	set	r7,'*'
	bs	printIt		; Subroutine to print a banch of cones

; Newline
	exSweet16		; To 6502 land
	jsr	osNewl
	goSweet16		; Back to sweet16 land
	br	loop

printIt:
	exSweet16		; To 6502 land

	lda	r7l		; r7l has character to print
	jsr	osWrch

	goSweet16		; Back to sweet16 land

	dcr	r0		; Subtract 1 from Acc
	bnz	printIt
	rs			; Return from subroutine

done:
	exSweet16
	rts
.endproc


; treeData:
;	As per the suggestion iof  barrym95838, we're storing a computed
;	number here - it's the number (stars - 1) / 2.
;	So the number of spaces is 40 - n
;	and the numbe of stars  is n + n + 1.
;********************************************************************************

treeData:
	.byte	0,1,2,3, 1,3, 5, 7, 2, 5, 8,11, 1,1, 40
;	.byte	1,3,5,7, 3,7,11,15, 5,11,17,23, 3,3

Minor improvements can be made by utilising the 3 unused sweet16 non-register opcodes - e.g. one could be print new line and another could be print Acc - that saves the jump to 6502 land and back again twice, however is that overstepping the mark?

for those wondering, exSweet16 and goSweet16 are macros:

Code: Select all

.macro	goSweet16
    	jsr	_sweet16
	.setcpu "sweet16"
.endmacro

.macro	exSweet16
	rtn
	.setcpu "65c02"
.endmacro

Anyway, that is I think, enough for now!

Cheers,

-Gordon

[barrym95838]

drogon wrote:

Minor improvements can be made by utilising the 3 unused sweet16 non-register opcodes - e.g. one could be print new line and another could be print Acc - that saves the jump to 6502 land and back again twice, however is that overstepping the mark?

Trade-offs are part of the game. Charlie liked Sweet16 enough to install an optimized (!) version on his PET and added opcodes for EXT, a DTC Forth NEXT, DUP and DROP. I hope he's doing well ... I haven't heard from him in months.