/
magic.4th
89 lines (72 loc) · 2.44 KB
/
magic.4th
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
( *
* LANGUAGE : ANS Forth
* PROJECT : Forth Environments
* DESCRIPTION : Magic squares demo
* CATEGORY : Example
* AUTHOR : Erwin Dondorp, August 19, 1991
* LAST CHANGE : March 6, 1993, Marcel Hendrix, Ansification
* LAST CHANGE : October 10, 1991, Marcel Hendrix
* LAST CHANGE : August 24, 2001, Krishna Myneni, core Ansification
* )
\ -----------------------------------------------------------
: SPACE bl emit ; ( needed for kForth only)
\ -----------------------------------------------------------
\ MARKER -magic
DECIMAL
( *
Magic squares by Erwin Dondorp
after a widely known algorithm:
- Start with value one in upper middle cell.
- next cell is one up and to the right, use circular wrap when passing edges
- if this cell is occupied, move one cell down
- if this cell is also occupied, stop
* )
VARIABLE ORDER
VARIABLE COL
VARIABLE ROW
create ADDR 99 dup * cells allot \ allocate maximum needed space
: MAGIC \ <n> --- <>
ORDER !
ORDER @ 1 AND 0= ABORT" Value should be odd"
ORDER @ 99 > ORDER @ 3 < OR ABORT" Value should be between 3 and 99"
ADDR ORDER @ DUP * CELLS ERASE
ORDER @ 2/ COL !
0 ROW !
ORDER @ DUP * 1+ 1
DO
I ROW @ ORDER @ * COL @ + CELLS ADDR + !
-1 ROW +!
1 COL +!
COL @ ORDER @ < INVERT ( >= )
IF
ORDER @ NEGATE COL @ + COL !
THEN
ROW @ 0<
IF
ORDER @ ROW @ + ROW !
THEN
ROW @ ORDER @ * COL @ + CELLS ADDR + @
IF
2 ROW +!
-1 COL +!
ROW @ ORDER @ MOD ROW !
COL @ ORDER @ + ORDER @ MOD COL !
THEN
LOOP
CR ." Magic square " ORDER @ DUP 1 .R [CHAR] x EMIT . CR
ORDER @ 0
DO
ORDER @ 0 CR
DO
ADDR J CELLS ORDER @ * + I CELLS + @
ORDER @ DUP * S>D <# #S #> NIP .R SPACE
LOOP
LOOP
CR CR ." Sum = "
ORDER @ DUP DUP * * ORDER @ + 2/ .
;
: HELP CR
." <n> MAGIC for a magic square n*n" CR
." <n> must be odd, >= 3, <= 99" CR
." <n> > 19 will be too wide for the screen" ;
HELP CR