hex \ Diesmal ist es einfacher, alles im Hexmodus zu betreiben 12 Value spielebenen \ So viele Ebenen brauche ich Create Aufgabe \ ab hier wird die Aufgabe gespeichert ," E A 56 F8 " ," 65 E 18 F 03A" ," 3 7B 65 D 2 " ," 8 B 34 5 " ," 07 19 2 " ," 9B 2 0F7 8D 6" ," 5 E7 FBD16 C " ," D 6 3 2 0 A 7" ," D C 287 " ," 73BE 9C0A82 6 " ," A 1 7E B9 " ," 29 0 64D A " ," 476 F A0 2" ," B C3A 5480 EF " ," DE9 0C2 4 F5 18" ," F 5 B 19 4D3" Create Spielfeld \ Jetzt folgt der Speicherbereich fuer das Spiel 10 10 spielebenen * * \ so viele Bytes braucht's schon allot here value spielfeldende \ ---------------------------------------------- Verwaltung ------------------------- \ Da es nur ein Spielfeld gibt, wird mit absoluten Adressen gerechnet : ebene ( n -- adr ) \ gibt die Anfangsadresse der Ebene n zurueck 10 10 * * spielfeld + ; : zse>adr ( zeile spalte ebene -- adr ) \ gibt die Adresse der gewaehlten Speicherstelle 10 10 * * -rot swap 10 * + + spielfeld + ; : leer? ( zeile spalte ebene -- flag ) \ ist die gewaehlte Zelle leer? zse>adr c@ FF = ; : neu ( -- ) \ Aufgabe ins Spielfeld uebertragen Aufgabe 10 0 DO count 0 DO count bl = IF FF ELSE dup 1- 1 s>number drop THEN 0 ebene J 10 * i + + c! LOOP LOOP drop ; : vorbesetzen ( -- ) \ Jede Ebene wird mit 'ihrem' Wert gefuellt 10 0 DO 10 0 DO 10 0 DO K J I 1+ zse>adr I swap c! LOOP LOOP LOOP 11 ebene 10 10 * erase ; : fuelle_zeile ( n zeile ebene -- ) \ eine ganze Zeile mit einem Wert fuellen ebene swap 10 * + 10 rot fill ; : fuelle_spalte ( n spalte ebene -- ) \ eine ganze Spalte mit einem Wert fuellen ebene + 10 0 DO 2dup c! 10 + LOOP 2drop ; : fuelle_quadrat ( n Index ebene -- ) \ Ein Spielquadrat mit einem Wert fuellen (Index 0-F) ebene swap 4 /mod 40 * swap 4 * + + 4 0 DO 2dup swap 4 swap fill 10 + LOOP 2drop ; : loesche_saeule? ( zeile spalte -- ) \ bei besetzter Zelle alle Moeglichkeiten stornieren 2dup 0 leer? \ wenn Spielfeld (noch) leer ist ... IF 2drop \ tu nichts ELSE swap 10 * + 10 0 \ ansonsten: DO FF over I 1+ ebene + c! \ trage in jeder Ebene den Leermarker (FF) ein LOOP drop THEN ; : zaehle_saeule ( zeile spalte -- ) \ Eintraege einer Saeule ( moegliche Werte fuer die swap 10 * + \ entsprechende Zelle) zaehlen, Ergebnis in Ebene 11 0 pad ! \ speichern 10 0 DO dup I 1+ ebene + c@ FF <> IF 1 pad +! THEN LOOP 11 ebene + pad @ swap c! ; : zaehle_saeulen ( -- ) \ fuer jede Zelle die Anzahl der Moeglichkeiten ermitteln 10 0 DO 10 0 DO I J loesche_saeule? I J zaehle_saeule LOOP LOOP ; Variable gueltige_Zahl \ hier wird der gueltige Wert gespeichert : notiere_wert ( zeile spalte -- ) \ falls es nur einen Wert gibt, ihn notieren 0 gueltige_Zahl ! swap 10 * + dup 11 ebene + c@ 1 = IF 10 0 DO dup I 1+ ebene + c@ dup FF <> IF gueltige_Zahl +! ELSE drop THEN LOOP dup 11 ebene + 0 swap c! gueltige_Zahl @ swap 0 ebene + c! ELSE drop THEN ; : schreibe_zahlen ( -- ) \ fuer jede Zelle den 'einen' Wert notieren 10 0 DO 10 0 DO J I notiere_wert LOOP LOOP ; : wert! ( n zeile spalte -- ) \ einen Wert in eine Zelle schreiben swap 10 * + 0 ebene + c! ; \ ----------------------------- Erlaubte Zahlen pruefen ------------------------- : markiere_zeile ( zeile -- ) \ benutzte Zahlen als besetzt markieren (Zeilen/Ebene) dup 10 * spielfeld + 10 0 DO dup I + c@ dup FF <> \ zeile adr n flag IF FF 3 pick rot 1+ fuelle_zeile ELSE drop THEN LOOP 2drop ; : markiere_zeilen ( -- ) \ dies fuer alle Zeilen 10 0 DO I markiere_zeile LOOP ; : markiere_spalte ( spalte -- ) \ benutzte Zahlen als besetzt markieren (Spalten/Ebene) dup spielfeld + 10 0 DO dup I 10 * + c@ dup FF <> IF FF 3 pick rot 1+ fuelle_spalte ELSE drop THEN LOOP 2drop ; : markiere_spalten ( -- ) \ ... fuer alle Spalten 10 0 DO I markiere_spalte LOOP ; : sz>index ( spalte zeile -- index ) \ errechne aus Koordinaten den Index eines Quadrates 4 / swap 4 / 4 * + ; : markiere_quadrat ( Index -- ) \ benutzte Zahlen als besetzt markieren (Quadrate/Ebene) dup 4 /mod 40 * swap 4 * + 0 ebene + 4 0 DO 4 0 DO count dup FF <> IF 1+ 2 pick swap FF -rot fuelle_quadrat ELSE drop THEN LOOP 10 4 - + LOOP 2drop ; : markiere_quadrate ( -- ) \ fuer alle Quadrate 10 0 DO I markiere_quadrat LOOP ; : markiere_spiel \ alle Felder des Spieles pruefen und markieren markiere_quadrate markiere_zeilen markiere_spalten ; Variable minimum \ Speicherstelle : finde_minima ( -- ) \ welche 'leere' Zelle hat die wenigsten Loesungen 10 minimum ! 11 ebene 10 10 * 0 DO count dup 0<> IF minimum @ min minimum ! ELSE drop THEN LOOP drop ; : loese_1 ( -- flag ) \ alle Zellen, die eindeutig (1) sind, loesen vorbesetzen markiere_spiel zaehle_saeulen finde_minima minimum @ 1 = IF schreibe_zahlen true ELSE false THEN ; \ ----------------------------- Spielstaende merken ---------------------------- Create zug_stack 3 10 10 * * allot \ einen Stack fuer die Spielzuege einrichten Variable zug# 0 zug# \ sozusagen der Zug-Stackpointer : merke_zug ( n n n -- ) \ Wertetripel in den Zugstack schreiben 2dup zug# @ 3 * zug_stack + dup >R 2 + c! R@ 1 + c! 2 pick R> c! zug# @ 1+ 10 10 * mod zug# ! ; \ 'ueberfluessige' ? Ueberlaufsicherung : hole_zug ( n -- n n n ) \ Wertetripel vom Zugstack holen 3 * zug_stack + count swap count swap c@ ; : .zuege ( -- ) \ den Zugstack ausgeben (jeweils letzte Eintraege) 0 50 at ." Wert Zeile Spalte" zug# @ dup 18 - dup 0 <= IF drop 0 0 ELSE dup THEN -rot ?DO I over - 2+ 50 at I hole_zug rot 4 .r swap 6 .r 6 .r LOOP drop ; : zeige_dateien ( -- ) s" dir zuege*.f " evaluate ; \ der Name sagt's Variable datei_ID \ Platzhalter : save_zuege ( -- ) \ Zugstack (human readable) in Datei speichern s" zuege_" pad place base @ &10 base ! time&date rot 0 <# [char] _ hold # # #> pad +place swap 0 <# [char] _ hold # # #> pad +place 0 <# [char] _ hold # # # # #> pad +place 0 <# [char] : hold # # #> pad +place 0 <# [char] : hold # # #> pad +place 0 <# # # #> pad +place s" .f" pad +place base ! pad count r/w create-file cr drop datei_ID ! zug# @ 0 DO 3 0 DO J 3 * I + zug_stack + c@ 0 <# bl hold # # #> datei_ID @ write-file drop LOOP 0A pad c! pad 1 datei_ID @ write-file drop LOOP datei_ID @ close-file drop ." Getan!" ; : lade_zuege ( c-addr count -- ) \ Zugstack aus Datei fuellen 0 zug# ! r/o open-file IF datei_ID ! BEGIN pad &10 datei_ID @ read-file nip nip WHILE zug# @ 3 * zug_stack + 3 0 DO I over + pad I + 2 s>number drop swap c! LOOP drop zug# @ 1+ zug# ! REPEAT datei_ID @ close-file THEN ; \ ----------------------------- Statistik -------------------------------------- Create Doppelte 16 cells allot \ Speicherbereich fuer benutzte Werte Variable Fehler Fehler off \ flag : frei_vorbereiten ( -- ) \ Fehlerabfrage initialisieren 0 pad ! Fehler off Doppelte 16 FF fill ; : gueltig_zaehlen ( n -- ) \ sind Eintraege doppelt vorhanden? dup FF = IF drop 1 pad +! ELSE dup doppelte + dup c@ ff <> IF 2drop Fehler on bell ELSE c! THEN THEN ; : frei_quadrat ( index -- n ) \ alle Werte eines Spielquadrates miteinander vergleichen frei_vorbereiten 4 /mod 40 * swap 4 * + 0 ebene + 4 0 DO 4 0 DO count gueltig_zaehlen LOOP 10 4 - + LOOP drop pad @ ; : frei_zeile ( zeile -- n ) \ alle Werte einer Zeile miteinander vergleichen frei_vorbereiten 10 * 0 ebene + 10 0 DO count gueltig_zaehlen LOOP drop pad @ ; : frei_spalte ( spalte -- n ) \ alle Werte einer Spalte miteinander vergleichen frei_vorbereiten 0 ebene + 10 0 DO dup c@ gueltig_zaehlen 10 + LOOP drop pad @ ; : Moeglichkeiten ( -- d ) \ Moeglichkeiten errechnen (Ueberlauf!!!!!) 1 s>d 10 0 do 10 0 do J I 11 zse>adr c@ dup 0<> IF s>d d* ELSE drop THEN LOOP LOOP ; : .Moeglichkeiten ( -- ) \ Ausgeben Moeglichkeiten ." Moegl.: " ud. ; \ ----------------------------- Anzeige ---------------------------------------- : .wert ( c -- ) \ Spielfeldwert ausgeben, wenn gueltig! dup FF = IF drop ." " ELSE 2 .r THEN ; : .trenner ( -- ) ." +-----------+-----------+-----------+-----------+" ; : .spalten ( -- ) ." 0 1 2 3 4 5 6 7 8 9 A B C D E F" ; : .zeile ( adr -- adr ) ." |" 4 0 DO 3 0 DO count .wert ." " LOOP count .wert ." |" LOOP ; : .saeule ( zeile spalte -- ) \ alle Moeglichkeiten einer Zelle anzeigen 1 zse>adr 10 0 DO dup c@ dup FF <> IF . ELSE drop THEN 10 10 * + LOOP drop ; Variable Statistik? Statistik? on \ flag : .Fehler ( -- ) \ gibt ein X aus, falls ein Fehler bemerkt wurde Fehler @ IF ." X" ELSE ." " THEN ; : .ebene ( n -- ) \ Zeigt eine Spielfeldebene formatiert an page ebene cr .spalten cr .trenner 4 0 DO 4 0 DO cr j 4 * I + . .zeile j 4 * I + 2 .r Statistik? @ IF ." --> " J 4 * I + frei_zeile . .Fehler THEN LOOP cr .trenner Statistik? @ IF ." " 4 0 DO ." - " J 4 * I + frei_quadrat . .Fehler LOOP THEN LOOP drop cr .spalten Statistik? @ IF cr ." " 10 0 DO I frei_spalte . .Fehler LOOP THEN .zuege 1A 2 at ; : .spielfeld \ Zeigt das Spielfeld 0 .ebene ; \ \ : .wuerfel \ Tasteneingabe bei eingeschaltetem Numpad dort ... schei... 'key' \ cr 0 .ebene 1 \ BEGIN cr dup ." Ebene: " . \ key \ dup 1b = IF 2drop true THEN \ dup 38 ( FF52 ) = IF drop 1+ 11 min dup .ebene false then \ dup 32 ( FF54 ) = IF drop 1- 0 max dup .ebene false then \ UNTIL ; \ ------------------------- Kuerzel ----------------- : start ( -- ) neu vorbesetzen 0 .ebene ; : automatik ( -- n ) \ loest alle eindeutigen Zellen 0 >R Begin r> 1+ >R loese_1 false = UNTIL r> ; : au ( -- ) automatik drop \ zeigt das Spielfeld 0 .ebene ." " .moeglichkeiten ; : z! ( wert zeile spalte -- ) \ einen Wert bei den Koordinaten eintragen merke_zug wert! automatik 0 .ebene ." " . ." Zuege!" .moeglichkeiten ; : wiederhole ( -- ) \ alle Eintraege des Zugstacks nochmal abspielen neu zug# @ 0 ?DO I hole_zug wert! automatik drop LOOP 0 .ebene ." " .moeglichkeiten ; : ? ( zeile spalte -- werte ) \ Moegliche Werte fuer die Koordinaten anzeigen ." :" .saeule ; : .v 11 .ebene .moeglichkeiten ; \ Anzahl der Moeglichkeiten pro Zelle anzeigen : z ( -- ) zug# @ 1- 0 max zug# ! wiederhole ; \ einen Zug zurueckgehen : n ( -- ) zug# @ 1+ 100 min zug# ! wiederhole ; \ einen Zug wiederherstellen (nochmal) \ ----------------------- Loslegen ----------------- start 2 f 1 z! \ drei 6 8 0 z! \ moegliche E 5 E z! \ Eingaben \ 10 0 [do] [i] dup 6 swap z! [loop] \ 10 0 [do] [i] dup 7 swap z! [loop]