Path: csiph.com!usenet.pasdenom.info!gegeweb.org!eternal-september.org!feeder.eternal-september.org!mx02.eternal-september.org!.POSTED!not-for-mail From: Paul Rubin Newsgroups: comp.lang.forth Subject: Re: FORTH on the Advanced Placement Computer Science ! Date: Thu, 15 Jan 2015 22:34:22 -0800 Organization: A noiseless patient Spider Lines: 72 Message-ID: <874mrrnsi9.fsf@jester.gateway.pace.com> References: <878uhs4zxk.fsf@jester.gateway.sonic.net> <871tnd9dg0.fsf@jester.gateway.pace.com> <87387q5hi8.fsf@jester.gateway.sonic.net> <87iogkweeq.fsf@jester.gateway.sonic.net> <87zj9vrhe5.fsf@jester.gateway.sonic.net> <87mw5vbnf9.fsf@jester.gateway.sonic.net> <87iogjwkp5.fsf@jester.gateway.sonic.net> <87d26rw9v3.fsf@jester.gateway.sonic.net> <878uhfw4qm.fsf@jester.gateway.sonic.net> <93b1c15c-4b83-4110-8ea0-5076293cda6e@googlegroups.com> <877fwvqo1v.fsf@jester.gateway.sonic.net> <35eb95a4-c31a-4381-aad0-94813f7ae797@googlegroups.com> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: mx02.eternal-september.org; posting-host="cf2250d04a15656821738afa87e3379c"; logging-data="30792"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX1+GyRIntqH1wznzIwUy4Ain" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) Cancel-Lock: sha1:V/8FoGZwwRO57JNiVMDXoM5Agy8= sha1:jqwdr4/ructFlyniB8++SL0W5wQ= Xref: csiph.com comp.lang.forth:35838 humptydumpty writes: > I think that 'locate*' should not be rewrited 'locate ( char -- index ) > to support something'[CHAR] * locate', not even for 'factoring' sake. > It would be an overdoing. Here's some of the factoring I was thinking of. I don't know if the factored version is better or worse than the unfactored one. Basically the * index is split into coordinates to simplify the left/right/up/down words. It may be possible to press this idea to clean up the code further, since it now uses both representations in a messy way. ==== \ refactored version ' noop IS bootmessage 4 CONSTANT COLS 4 CONSTANT ROWS CREATE Board COLS ROWS * chars allot : init-board ( -- ) s" 123456789ABCDEF*" Board swap move ; : .board ( -- ) CR ROWS 0 DO COLS 0 DO J ROWS * I + Board + c@ emit LOOP cr LOOP ; : chars-exchange ( a0 a1 -- ; exchange chars at addresses ) over c@ over c@ swap rot c! swap c! ; : indexes-exchange ( i0 i1 -- ; exchange chars at indexes on Board ) Board + swap Board + chars-exchange ; : locate* ( -- index ; return INDEX of * in Board ) 0 BEGIN dup Board + c@ [CHAR] * <> WHILE 1+ REPEAT ; \ x,y coordinates of * in board : locate-xy ( -- row col ) locate* dup ROWS / swap COLS mod ; \ check that 0 <= n < limit : xy-check.1 ( n limit -- flag ) over > swap 0 >= and ; \ check that x,y is in bounds : xy-check ( row col -- flag ) COLS xy-check.1 swap ROWS xy-check.1 and ; \ swap piece at row,col with empty square. precondition: move is valid : m-move ( row col -- ) swap rows * + locate* indexes-exchange ; \ check if move to row,col is valid and if yes, make the move. : check-move ( row col -- ) 2dup xy-check if m-move else 2drop then ; \ move to (row+drow, col+dcol) if move is valid. : move-by ( drow dcol -- ) locate-xy rot + -rot + swap check-move ; : left ( -- ) 0 -1 move-by ; : right ( -- ) 0 1 move-by ; : up ( -- ) -1 0 move-by ; : down ( -- ) 1 0 move-by ; : refresh ( -- ) page 0 0 AT-XY .board ; : l ( -- ) left refresh ; : r ( -- ) right refresh ; : u ( -- ) up refresh ; : d ( -- ) down refresh ; include random.fs CREATE Moves ' left , ' down , ' up , ' right , : n ( -- ) init-board 99 0 DO 4 random cells Moves + perform LOOP refresh ; : h ( -- ) ." Moves: l left r right u up d down; n new-game; refresh " ." refresh board; h help; bye exit game." cr ; n h