
FoRTh Modoki 
ver 1.4.3  Mar. 4, 2001. 
Copyright (C) 1999-2001  ϲ ұ (Tomohide Naniwa)
naniwa@rbt.his.fukui-u.ac.jp

0. ѥ
 UNIX ǤΥѥ
ɬפ Makefile ѹƤ make  frtm Ǥ
ޤ

I. Ϥ
Υץ FORTH ϵեȤǤ FORTH Ƹ
ΤǤϤޤ󡥥ѥϻޤ󤬡桼ɤǤ
ɤ˲ᤷޤ

βϵեݡɵˡ˽äƹԤޤif ˤʬ
do-while, for-loop ʤɤΥ롼פΤι¤⤢ޤޤɤ
Ȥ߹碌ƿʥɤ뤳ȤǤޤ

ߤΤȤΤΤߤǤϤ 10 ʿ16 ʿ(Ƭ
0x դ)8 ʿ(Ƭ 0 դ)ǹԤޤ

frtm.h ǳƼ凉åΥƤޤ줾졤

#define STMAX 500    ; ͷ׻ѥå
#define DICMAX 100    ; 桼ɤκ
#define CSMAX 1000    ; 桼ɤΤεΰ
#define RSMAX 500    ; 桼ɼ¹ѥå
#define SSMAX 400     ; 롼פʤɤѥå
#define MAX_NAME 8   ; 桼̾κʸ
#define LINE 100     ; Ԥκʸ

ȤʤäƤޤŬѹƤ

II. ܵǽ
 ѥ
.	10 ɽ
.h	16 ɽ
.o	8 ɽ
cr	
sp	
+	
-	
*	
/	
%	;
=	Ʊ
<	꾮
<=	ʲ
>	礭
>=	ʾ
!	ȿž
1+	1 û
1-	1 
0=	0 Ʊ
abs	
max	
min	Ǿ
dup	ʣ
swap	
drop	
over	åΣܤʣ
rot	åξ̣Ĥžܤȥåפ
rotr	åξ̣Ĥžȥåפܤ
ndup	å n ܤʣ
nrot	åžn ܤȥåפ
nrotr	åžȥåפ n ܤ
ndrop	åξ n Ĥ
copy	åξ n Ĥʣ
SP	ƤӽФΥåο򥹥åΥȥåפɲ
minus	Ѵ
spaces  ʣĤζ
esc	ץ(0x1B)ν
help	ؿ̾
quit	λ

 ʸФ
 ɽ echo
(Hello_World) echo cr
åˤ
    '0dlr' 'oW_o' 'lleH'
˥ѥåʸ롥echo ʸ 0 ޤǽ
ɽ롥嵭κǽʸ¤Ӥ 0 Ͽ 0 ǡʸ '0' Ǥ
ʤ

ʸ \ (Хåå)ˤ륳ȥ롦ɤΥ
ǽǤ롥Ѳǽʸ '\n'()'\t'(ʿ), '\b'(Х
ڡ) '\ddd' (ddd ϣʿ) Ǥ롥ʿʸ
ϺǾ̤ο 0 Ǥ뤳ȤꤷƤ롥ʳʸϤΤ
ʸɲä롥

 ʸʬ򡦷 pack/unpack
(Hello_World) unpack 
å֤줿ѥå줿ʸʸĤʬ򤹤롥å
ˤ
    0 'd' 'l' 'r' 'o' 'W' '_' 'o' 'l' 'l' 'e' 'H'
ʬ򤵤줿롥

pack
unpack ǣʸĤʬ򤵤줿å򡤺Ƥ echo ɽ
ʸ˥ѥå롥

III. ץ๽¤
 ʬ
<cond> if <block 1> endif
<cond> if <block 1> else <block 2> endif


<cond>  0 ʳʤ <block 1> ¹ԡ
<cond>  0 ʤ <block 2> ¹ԡ



else ֥åʣ񤱤롥


0 if 1 else 2 endif . cr

 do 롼
do <block 1> <cond> while


<cond>  0 Ǥнλ0 ʳʤ do äƷ֤


1 do dup . cr 1 + dup 5 < while drop
1 do dup . sp 1 do dup . sp 1 + dup 5 < while cr drop 1 + dup 4 < while drop

 for 롼
<n1> <n2> for <block> loop
<n1> <n2> for <block> <n3> +loop


<block> λ n2 + 1(ޤn3) ¹Ԥn1 꾮 for 
Ʒ֤

I ꥿󥹥å n2 򥹥åɲä롥


n1, n2 οȤ롥


5 0 for I . cr loop
10 0 for I . sp 5 1 for I . sp loop cr 2 +loop

 ɤ
: name <block> ;


name ĥɤ롥


do  for Υ롼פǤϥɤϿϤǤʤ

桼Ͽ줿Τ˸뤿ᡤƵǽˤʤ
Ƥ롥ޤɤƤŤɤϤΤޤ޻Ĥ롥

 
ʿ
: ave + 2 / ;
10 28 ave . cr

 [fact(1) = 1, fact(n) = n*fact(n-1)]
: facti 1 swap 1+ 1 for I * loop ;
: fact dup 1 = if else dup 1- fact * endif ;
10 facti . cr
10 fact . cr

եܥʥå [fib(0) = 0, fib(1) = 1, fib(n) = fib(n-1) + fib(n-2)]
: fib dup 0= if else dup 1 = if else dup 1- fib swap 2 - fib + endif endif ;
7 fib . cr
: fibi dup 0= if else 0 1 rot 1 for swap over + loop swap drop endif ;
30 fibi . cr
20 0 for I fibi . sp loop cr

ϥΥ
: move1 (Move disk ) echo . swap  ( from ) echo . ( to ) echo . cr ;
: hanoi dup 1 = if move1 else
    3 ndup 3 ndup + 6 - minus 4 ndup swap 3 ndup 1- hanoi
    3 ndup 3 ndup 3 ndup move1
    1- rotr swap over + 6 - minus swap rot hanoi
  endif ;
1 2 2 hanoi
1 2 4 hanoi

N Queens
: N 2 * 3 + ;
: disp dup N ndup 0 for 
    dup N ndup 0 for over I = 
      if (Q ) echo else (. ) echo endif 
    loop cr drop drop 
  loop drop ;
: check over 0 for 
    3 ndup 6 ndup = if drop 0 else 
        3 ndup 6 ndup - abs 3 ndup 6 ndup - = if drop 0 else 1 = endif 
    endif
    5 nrot 5 nrot drop drop 
  loop rotr drop drop ;
: nq dup N ndup 0 for 
    I over 1+ dup N 1- copy 1 check if 
      dup N ndup over 1+ = if dup N copy disp cr else nq endif 
    endif
  drop drop loop ;
: queens dup 0 for I 0 nq drop drop loop drop ;

4 queens

puzzle ȤɤȤäƾ嵭ΥϥΥ N Queens ѥ
ɤ桼ɲä뤳ȤǤޤ

 񥳥ޥ
help  ƥɡ桼ɤΰɽ

forget <name>
<name> Ȥ̾ĥɰʹߤ˥桼ɤõ롥

fgall
桼ɤƾõ롥

def <name>
<name> Ȥ̾ĥɤ򡤺ɾǽʷɽ롥

load
åʸ̾ĥեƤɤ߹ɾ
롥

 ɤõ
ɤϥƥ༭񡤥桼νõ롥桼Ͽ
Ͽ줿Τ鸡롥

IV. ѿ
 ѿ
var name


name Ȥѿ롥ѿϼϿ롥ϥ桼
ɤη֤롥name ɾȡ桼Υǥå
¸롥


ѿϼ¹Բǽ֤ǤΤ߲ǽɤ䡤do  for Υ롼פ
ǤѿϽʤ

 ͤθƽФ
@


å鼭ΥǥåϤ˴ޤޤͤ򥹥
֤

 ͤ
$


å鼭ΥǥåȿͤϤϿ롥

 
var x
x @ . cr
10 x $
x @ . cr
: test x @ . cr ;
test

V. ե
UNIX ǥѥ뤷 X11 ĶǡEOTA ǥѥ뤷
 vga ⡼ɤǤΥեѤǤޤ

 
gm		ե⡼ɤ
tm		ƥȡ⡼ɤ
x y moveto	(x, y) ذư
x y lineto	֤߰ (x, y) ޤľ
x y rmoveto	֤߰ (x, y) ư
x y rlineto	֤߰ (x, y) ľ
x y w h rect	ΰ
x y w h rectf	ΰɤ٤
x y point	
x y w h ellips	ʱߤ
x y w h ellipsf	ʱߤɤ٤
c setcolor	(0:  пֻ粫 15: )
c setbgc	ʸطʿλ
n setfont	եȤλ (0: a14, 1: 7x14bold)
x y s drawstr	(x, y) ʸ s ɽ(طʤϤΤޤ)
x y s drawistr	(x, y) ʸ s ɽ(طʤɤ٤)
cls		̾õ

 
 Ѥʤΰɤ٤
: boxes 16 0 for I setcolor 10 20 I * + dup 100 100 rectf loop ;
gm boxes
tm

Ƶ޷(Koch )
: pre 5 copy drop ;
: genx 3 ndup 6 ndup - * minus 100 / swap 4 ndup 7 ndup - * 100 / + 5 ndup +
  5 nrotr 4 ndrop ;
: geny swap 3 ndup 6 ndup - * 100 / swap 4 ndup 7 ndup - * 100 / + 4 ndup +
  5 nrotr 4 ndrop ;
: gen 6 copy genx 7 nrotr geny ;
: keep 7 nrotr 7 nrotr pre ;
: post 9 nrot 9 nrot 4 nrot 4 nrot 5 ndup 1- ;
: line moveto lineto ;
: koch dup 0= if drop line else 
    pre 0 0 gen keep 33 0 gen post koch
    pre 33 0 gen keep 50 -28 gen post koch
    pre 50 -28 gen keep 66 0 gen post koch
    pre 66 0 gen keep 100 0 gen post koch
    5 ndrop
  endif ;
gm 50 250 600 250 4 koch
tm

: kochs 10 setcolor  89 440 551 440 4 koch
        11 setcolor 551 440 320  40 4 koch
        12 setcolor 320  40  89 440 4 koch ;
gm kochs
tm

graphics ȤɤȤäơboxes  Koch ɤ桼
ɲä뤳ȤǤޤ

VI. ɤˤĤơ
С 1.3.0 ʹߤ FoRTh Modoki (frtm)  GNU General Public
License ˽ΤȤޤ

ФϤߤˤʤޤ

---
(putprop 'ϲ֡ұ
    'affiliation  '(ʡعǽƥ๩ز)
    'e-mail	  '(naniwa@rbt.his.fukui-u.ac.jp)
    'URL  '(http://www.rbt.his.fukui-u.ac.jp/~naniwa/))
