\ sudoku -- albert nijhof -- dec2007

anew -sdk

\ : align ; immediate
\ : at-xy 2drop page ;

      3 constant zb   \ Zijde van een blok, 3
zb zb * constant z    \ Zijde van de sudoku, 9
z  z  * constant zz   \ Totaal aantal vakjes, 81


\ ----- De symbolen -----

create (symbolen   z allot
  char : c,   \ teken voor lege vakjes
  align

: !symbolen ( adr len -- )   z min   (symbolen swap move ;

s" 123456789" !symbolen
\ s" MAISFORTH" !symbolen

: >symbool ( icode -- ch )   z min   (symbolen +   c@ ;


\ ----- Sudoku afdrukken -----

\ Voor de sudoku
create (sdk   zz allot   align

\ Voor de naam van de sudoku ( zie PiF 9)
create naam 1 c, char ? c, 30 allot align

0 value hier   \ Cursorpositie

 : .vakje ( nr -- )
   hier over = [char] > and bl or emit
   (sdk + c@ >symbool emit
   space ;


: .sdk ( -- )
  0                  \ teller
           zb 0 do
  cr cr    zb 0 do
  cr cr    zb 0 do
  3 spaces zb 0 do   dup .vakje 1+
                loop loop loop loop   drop ;


\ ----- Cursorbewegingen, zie PiF 8 -----

: west  ( vaknr -- vaknr )       z 2dup mod 0= and +   1- ;
: oost  ( vaknr -- vaknr )  1+   z 2dup mod 0= and - ;
: noord ( vaknr -- vaknr )  z -  s>d zz and + ;
: zuid  ( vaknr -- vaknr )
           [ zz z - ] literal -  s>d zz and + ;


\ ----- Stack voor de ingevulde vakjes -----

 create (historie zz allot align \ Genoeg bytes voor alle vaknummers
 (historie 1- value hp           \ Stackpointer, wijst naar topelement.

 : >h     ( x -- )    hp 1+ dup to hp c! ;
 : h>     ( -- x )    hp c@ hp 1- to hp ;
 : hleeg? ( -- vlag ) hp (historie u< ;
 : h-ini  ( -- )      (historie 1- to hp ;   \ Initiëer de stack


\ ----- Een vakje invullen, zie PiF 8 -----

 : symbool? ( key -- false | icode true )
   (symbolen z rot scan nip  \ Offset terug vanaf stringeinde
   dup 0= ?exit
   negate z + true ;         \ Bereken de icode.

 : ingevuld? ( hier -- vlag )    (sdk + c@ z < ;
 : noteer    ( icode hier -- )   (sdk + c! ;

: invullen ( icode hier -- )
  dup ingevuld? if 2drop exit then
  tuck noteer       \ Noteer de icode in het vakje
  >h ;              \ Zet het vaknr op de historie-stack


\ ----- Vakjes wissen -----

\ Wis een vakje, maar alleen als dit het laatstingevulde vakje is.
\ : wis ( hier -- ) ...

\ De actie die bij char \ hoort is:
\ Verplaats de cursor naar het laatstingevulde vakje, als dat er is.


\ ----- Het hoofdwoord SU -----

: doen ( key -- key )
  [char] [ over = if  hier west  to hier  exit then
  [char] ] over = if  hier oost  to hier  exit then
  [char] = over = if  hier noord to hier  exit then
  [char] ' over = if  hier zuid  to hier  exit then
  dup symbool? if hier invullen exit then
\  [char] \ over = if  ... exit then
\ bl        over = if  hier wis exit then
\ ...   ( Andere opties)
;

: su ( -- ) \ Het hoofdwoord
  page
  begin 0 0 at-xy    \ of PAGE of een 'escape-code' voor de terminal.
        cr space naam count type
        .sdk
        cr cr .s            \ Tijdens de testfase
        key    27 over <>   \ Stop met [escape] 
  while doen drop
  repeat
  drop ;



\ ---- Sudoku's importeren (zie PiF 9) -----

: schoon ( -- ) (sdk zz 255 fill h-ini ;   \ Wis de hele sudoku
: !string ( adr len adr2 -- )  \ Zet de string adr,len als
  tuck c! count move ;         \    counted string in adr2.


\ BL-WORD is een 'BL WORD' die ook over een regeleinde heen werkt.

: bl-word ( -- counted-string )
  begin bl word
        dup c@ ?exit     \ Er is tekst gevonden.
        drop refill      \ Volgende regel in de invoerbuffer.
        0=               \ Niet mogelijk?
  until -39 throw ;      \ Onverwacht inputeinde

: sudoku ( <sudokunaam> <sudoku-inhoud> -- )
  schoon
  bl-word count            \ Naam
  31 min naam !string
  bl-word count            \ Eerste brok sudoku-inhoud
  zz 0
  do   dup 0=                    \ De string is leeg?
       if   2drop bl-word count  \ Volgende woord
       then over c@              \ Volgende karakter
       symbool? if i noteer then
       1 /string
  loop 2drop ;



\ <sudokunaam> mag geen spatie bevatten.
\ <sudokutekst> mag elk denkbaar formaat hebben:
\ Spaties worden genegeerd
\ Geldige symbolen worden ingevuld
\ ALLE ANDERE KARAKTERS veroorzaken lege vakjes.

 sudoku Demo-1
  ---5----6 -4--6932- -9-2--4-1
  2-------- -78----63 --3--8---
  5---8---7 ---4---1- --69732--

cr .(  ----- sudo3.f is geladen ----- )
