102 lines
2.0 KiB
Forth
Executable File
102 lines
2.0 KiB
Forth
Executable File
\ starting.fs - Exercises from "Stating Forth" by Leo Brodie
|
|
|
|
\ 7. A Number of Kinds of Numbers
|
|
|
|
\ .DATE - Print double-length as date
|
|
: .date ( d -- )
|
|
<# # # [char] / hold # # [char] / hold #s #> type space ;
|
|
|
|
\ 8. Variables, Constants, and Arrays
|
|
|
|
\ Exercise 1.
|
|
|
|
variable pies
|
|
variable frozen-pies
|
|
|
|
: bake-pie ( -- ) 1 pies +! ;
|
|
|
|
: eat-pie ( -- )
|
|
pies @ 0= if
|
|
." What pie?" cr
|
|
else
|
|
-1 pies +!
|
|
." Thank you!" cr
|
|
then
|
|
|
|
;
|
|
|
|
\ Exercise 2.
|
|
|
|
: freeze-pies ( -- )
|
|
pies @ frozen-pies ! 0 pies !
|
|
;
|
|
|
|
\ Exercise 3.
|
|
|
|
: .base ( -- ) base @ dup decimal . base ! ;
|
|
|
|
\ Exercise 4.
|
|
|
|
variable places
|
|
2 places !
|
|
|
|
: m. ( s|d -- )
|
|
tuck dabs
|
|
<#
|
|
places @ dup -1 <> if
|
|
0 ?do # loop
|
|
[char] . hold
|
|
else
|
|
drop s>d
|
|
then
|
|
#s rot sign #> type space
|
|
;
|
|
|
|
\ Exercise 6.
|
|
\ Tic-tac-toe application
|
|
|
|
create pos 9 allot
|
|
create symb 9 allot
|
|
|
|
: u>c ( u -- c ) 49 + ;
|
|
: clear ( -- )
|
|
pos 9 erase
|
|
9 0 do i dup u>c swap symb + c! loop
|
|
;
|
|
: hline ( -- ) cr space ." ---------" ;
|
|
: vbar ( -- ) space ." | " ;
|
|
: row ( c1 c2 c3 -- ) cr space emit vbar emit vbar emit ;
|
|
: display ( -- )
|
|
3 0 do
|
|
i 0= invert if hline then \ Print horiz. line before rows 2, 3
|
|
i 3 * symb + \ Addr. of 1st symbol in row
|
|
dup 1+ c@ \ 2nd symbol in row
|
|
over 2 + c@ \ 3rd symbol in row
|
|
swap rot c@ \ Arrange symbols 3 2 1, 1st symbol
|
|
row
|
|
loop cr
|
|
;
|
|
: symbol ( n -- c ) 1 = if [char] X else [char] O then ;
|
|
: move ( n-player u-position -- )
|
|
1- 2dup \ Offset in pos, symb
|
|
pos + dup \ pos addr.
|
|
c@ 0= if \ Test pos contents
|
|
c! \ Store pos
|
|
symb + swap \ symb addr.
|
|
symbol swap \ Getplayer symbol
|
|
c! \ Store symb
|
|
else
|
|
drop drop cr ." Position " 1+ . ." already taken."
|
|
drop
|
|
then
|
|
;
|
|
: x! ( u-position -- ) 1 swap move display ;
|
|
: o! ( u-position -- ) -1 swap move display ;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|