{*****************************************************************************}
{**************  Datei Anfang  ***********************************************}
{*****************************************************************************}
{***  Fuer Ausdruck: &r &n &d &u Seite &s / &r Seite &s ; Font: Fixsys 7Pt  **}

{Datei: <STICK>:/barbarossa/5_sudoku/sudoku.txt}
{13:15 20.11.2012}

{**************  Spielweise  **********************************************}
{
1. Datei mit Input laden
2. mit "NEU" ein neues Rätsel starten
3. mit "SETZEN" die kleinen Zahlen antippen, um sie als Startvorgabe zu setzen
4. mit "LOESCHEN" logisch ausgeschlossene Möglichkeiten zu eliminieren


Es gibt keine "UNDO"-Funktion. Bei Tippfehlern, muß neu begonnen werden.

}

{**************  Programmnamen  **********************************************}
{
sudoku_1
sud_start_neu
sud_linien
sud_grundzahlen
sud_elem_auswahl
sud_pos_bestimmungen
sud_loeschen
sud_loeschen_einzeln
sud_loeschen_pruef
sud_setzen
sud_zahl
sud_zahl_gewaehlt_pos
sud_kleinquadrat_start_pos
sud_grossquadrat_start_pos
sud_menu_zaehler
}

{**************  Globale Variablen  *****************************************}

define sud_zahl                   ''  end_define
define sud_zahl_gewaehlt_pos      0,0 end_define
define sud_kleinquadrat_start_pos 0,0 end_define
define sud_grossquadrat_start_pos 0,0 end_define
define sud_zahl_1                 0   end_define
define sud_zahl_2                 0   end_define
define sud_zahl_3                 0   end_define
define sud_zahl_4                 0   end_define
define sud_zahl_5                 0   end_define
define sud_zahl_6                 0   end_define
define sud_zahl_7                 0   end_define
define sud_zahl_8                 0   end_define
define sud_zahl_9                 0   end_define
define sud_elem_mp               ''   end_define

{**************  Sudoku Menu  *****************************************}

DEFINE Sudoku_1
  LET Lastmen 'Tm_create_1'
  IF (I_port)
    Check_i_port
  END_IF
  IF (NOT I_port)
    MENU_BUFFER ON
    CURRENT_MENU Sm_create_1_layout_name
    T_clear_menu
    Menu_control_icons
    MENU Colo1 Bcol4 CENTER 'Sudoku 1' '' 1 3

    MENU Colo1 Bcol0 '          ' ''     2 1
    MENU Colo0 Bcol7 'Ende      ' 'end'  2 2

    MENU Colo0 Bcol5 'Neu       ' 'delete all confirm sud_start_neu sud_setzen'  3 1
    MENU Colo1 Bcol0 '          ' ''  3 2
    MENU Colo1 Bcol0 'Setzen    ' 'sud_setzen'  4 1
    MENU Colo1 Bcol0 'Loeschen  ' 'sud_loeschen_einzeln'  4 2
    MENU Colo1 Bcol0 '          ' ''  5 1
    MENU Colo1 Bcol0 '          ' ''  5 2
    MENU Colo1 Bcol0 '          ' ''  6 1
    MENU Colo1 Bcol0 '          ' ''  6 2
    MENU Colo1 Bcol0 '          ' ''  7 1
    MENU Colo1 Bcol0 '          ' ''  7 2
    MENU Colo1 Bcol0 '          ' ''  8 1
    MENU Colo1 Bcol0 '          ' ''  8 2
    MENU Colo1 Bcol0 '          ' ''  9 1
    MENU Colo1 Bcol0 '          ' ''  9 2
    MENU Colo1 Bcol0 '          ' '' 10 1
    MENU Colo1 Bcol0 '          ' '' 10 2
    MENU Colo1 Bcol0 '          ' '' 11 1
    MENU Colo1 Bcol0 '          ' '' 11 2
    MENU Colo1 Bcol0 '          ' '' 12 1
    MENU Colo1 Bcol0 '          ' '' 12 2
    MENU Colo1 Bcol0 '          ' '' 13 1
    MENU Colo1 Bcol0 '          ' '' 13 2
    MENU Colo1 Bcol0 '          ' '' 14 1
    MENU Colo1 Bcol0 '          ' '' 14 2
    MENU Colo1 Bcol0 '          ' '' 15 1
    MENU Colo1 Bcol0 '          ' '' 15 2
    MENU Colo1 Bcol0 '          ' '' 16 1
    MENU Colo1 Bcol0 '          ' '' 16 2
    MENU Colo1 Bcol0 '          ' '' 17 1
    MENU Colo1 Bcol0 '          ' '' 17 2
    MENU Colo1 Bcol0 '          ' '' 18 1
    MENU Colo1 Bcol0 '          ' '' 18 2
    MENU Colo1 Bcol0 '          ' '' 19 1
    MENU Colo1 Bcol0 '          ' '' 19 2
    MENU Colo1 Bcol0 '          ' '' 20 1
    MENU Colo1 Bcol0 '          ' '' 20 2
    MENU Colo1 Bcol0 '          ' '' 21 1
    MENU Colo1 Bcol0 '          ' '' 21 2
    MENU Colo1 Bcol0 '          ' '' 22 1
    MENU Colo1 Bcol0 '          ' '' 22 2
    MENU Colo1 Bcol0 '          ' '' 23 1
    MENU Colo1 Bcol0 '          ' '' 23 2
    MENU Colo1 Bcol0 'DAC       ' 'delete all confirm' 24 1
    MENU Colo1 Bcol0 '          ' '' 24 2

    MENU Colo0 Bcol5 CENTER 'Create 1' 'Tm_create_1' 25 1
    MENU Colo0 Bcol5 CENTER '' '' 25 2
    Eight_menu_slots_add

  END_IF
END_DEFINE



{*****************************************************************************}

{**************  Globale Funktionen  *****************************************}

{*****************************************************************************}

{Funktion zur Erstellung eines neuen Spieles}
define sud_start_neu
  local pz0
  local zaehler_x0
  local zaehler_y0

  let pz0 2.5,2.5
  let zaehler_x0 0
  let zaehler_y0 0

  sud_linien

  loop
  exit_if (zaehler_y0 = 9)

    loop
    exit_if (zaehler_x0 = 9)
      let zaehler_x0 (zaehler_x0 + 1)
      sud_grundzahlen pz0
      let pz0 (pz0 + (15,0))
    end_loop
  
    let zaehler_x0 0
    let zaehler_y0 (zaehler_y0 + 1)
    let pz0 (pz0 + (-135,15))
  end_loop

  let sud_zahl ''
  let sud_zahl_1 0
  let sud_zahl_2 0
  let sud_zahl_3 0
  let sud_zahl_4 0
  let sud_zahl_5 0
  let sud_zahl_6 0
  let sud_zahl_7 0
  let sud_zahl_8 0
  let sud_zahl_9 0
  sud_menu_zaehler
end_define

{Erstellen des Linienrasters}
define sud_linien
  color white linetype solid
  linewidth 0.5
  line two_pts
    0,0 135,0    0,45 135,45   0,90 135,90    0,135 135,135
    0,0   0,135 45,0   45,135 90,0   90,135 135,0   135,135

  color yellow linetype solid
  linewidth 0
    0,15 135,15   0,30 135,30   0,60 135,60   0,75 135,75    0,105 135,105   0,120 135,120
   15,0   15,135 30,0   30,135 60,0   60,135 75,0   75,135 105,0   105,135 120,0   120,135
  end
  color white linetype solid
  window_fit end
end_define

{Fuellen eines Quadrates}
define sud_grundzahlen
  parameter startpunkt
  local pz
  local zaehler_text
  local zaehler_x
  local zaehler_y

  let pz startpunkt
  let zaehler_text 1
  let zaehler_x 0
  let zaehler_y 0
  
  current_font 'hp_d17_c'
  text_slant 0
  text_angle 0
  text_adjust 5
  text_size 1.8

  loop
  exit_if (zaehler_y = 3)

    loop
    exit_if (zaehler_x = 3)
      let zaehler_x (zaehler_x + 1)
      text (str zaehler_text) pz end
      let zaehler_text (zaehler_text + 1)
      let pz (pz + 5,0)
    end_loop
  
    let zaehler_x 0
    let zaehler_y (zaehler_y + 1)
    let pz (pz + (-15,5))
  end_loop
end_define

{Elementauswahl, Positionsbestimmung des Einzel-Elementes, Inhalt}
define sud_elem_auswahl
  local p

  loop
    read pnt 'Zahl antippen.' p
    inq_elem p
    let sud_zahl (inq 902)
  exit_if (sud_zahl <> 'END-OF-LIST')
  end_loop

  let sud_elem_mp (inq 101)
  let sud_zahl_gewaehlt_pos sud_elem_mp
end_define

{Positionsbestimmung im Gesamten}
define sud_pos_bestimmungen
  local p
  local p_x
  local p_y
  local p_x1
  local p_y1
  local p_x2
  local p_y2
  local q_x
  local q_y

  sud_elem_auswahl

  let p_x (x_of sud_zahl_gewaehlt_pos)
  let p_y (y_of sud_zahl_gewaehlt_pos)

{ X-Pos-Filter}
  if (p_x < 45)
    let q_x 0
    if (p_x < 15)
      let p_x1 2.5
    else_if (p_x < 30)
      let p_x1 17.5
    else
      let p_x1 32.5
    end_if
  else_if (p_x < 90)
    let q_x 1
    if (p_x < 60)
      let p_x1 47.5
    else_if (p_x < 75)
      let p_x1 62.5
    else
      let p_x1 77.5
    end_if
  else
    let q_x 2
    if (p_x < 105)
      let p_x1 92.5
    else_if (p_x < 120)
      let p_x1 107.5
    else
      let p_x1 122.5
    end_if
  end_if

{ Y-Pos-Filter}
  if (p_y < 45)
    let q_y 0
    if (p_y < 15)
      let p_y1 2.5
    else_if (p_y < 30)
      let p_y1 17.5
    else
      let p_y1 32.5
    end_if
  else_if (p_y < 90)
    let q_y 1
    if (p_y < 60)
      let p_y1 47.5
    else_if (p_y < 75)
      let p_y1 62.5
    else
      let p_y1 77.5
    end_if
  else
    let q_y 2
    if (p_y < 105)
      let p_y1 92.5
    else_if (p_y < 120)
      let p_y1 107.5
    else
      let p_y1 122.5
    end_if
  end_if

  let p_x2 ((p_x mod 15) + q_x*45)
  let p_y2 ((p_y mod 15) + q_y*45)

  let sud_kleinquadrat_start_pos (pnt_xy p_x1 p_y1)
  let sud_grossquadrat_start_pos (pnt_xy p_x2 p_y2)
end_define

{Loeschen von Elementen}
define sud_loeschen
  local pl
  local pl_x
  local pl_y
  local pl_x1
  local pl_y1
  local pl_x2
  local pl_y2
  local pl_x3
  local pl_y3
  local zaehler_x
  local zaehler_y

  sud_pos_bestimmungen

  let zaehler_x 0
  let zaehler_y 0
  let pl_x (x_of sud_zahl_gewaehlt_pos)
  let pl_y (y_of sud_zahl_gewaehlt_pos)
  let pl_x1 (pl_x mod 15)
  let pl_y1 (pl_y mod 15)
  let pl_x2 (x_of sud_kleinquadrat_start_pos)
  let pl_y2 (y_of sud_kleinquadrat_start_pos)
  let pl_x3 (x_of sud_grossquadrat_start_pos)
  let pl_y3 (y_of sud_grossquadrat_start_pos)

{ loeschen der Einzelelemente in der Zeile; konstantes Y}
  repeat
  let pl (pnt_xy pl_x1 pl_y)
    sud_loeschen_pruef pl
    let pl_x1 (pl_x1 + 15)
  until (pl_x1 > 132.5)
  end

{ loeschen der Einzelelemente in der Spalte; konstantes X}
  repeat
    let pl (pnt_xy pl_x pl_y1)
    sud_loeschen_pruef pl
    let pl_y1 (pl_y1 + 15)
  until (pl_y1 > 132.5)
  end

{ loeschen der Einzelelemente im Kleinquadrat}
  let pl (pnt_xy pl_x2 pl_y2)
  loop
  exit_if (zaehler_y = 3)

    loop
    exit_if (zaehler_x = 3)
      let zaehler_x (zaehler_x + 1)
      sud_loeschen_pruef pl
      let pl (pl + 5,0)
    end_loop
  
    let zaehler_x 0
    let zaehler_y (zaehler_y + 1)
    let pl (pl + (-15,5))
  end_loop
  end

{ loeschen der Einzelelemente im Grossquadrat}
  let zaehler_x 0
  let zaehler_y 0
  let pl (pnt_xy pl_x3 pl_y3)
  loop
  exit_if (zaehler_y = 3)

    loop
    exit_if (zaehler_x = 3)
      let zaehler_x (zaehler_x + 1)
      sud_loeschen_pruef pl
      let pl (pl + 15,0)
    end_loop
  
    let zaehler_x 0
    let zaehler_y (zaehler_y + 1)
    let pl (pl + (-45,15))
  end_loop
  end
end_define

{Loeschen von Elementen pruefen}
define sud_loeschen_pruef
  parameter p

  inq_elem p

  if ((inq 302) = 'hp_d17_c')
    delete p end
  end_if
end_define


{Setzen von Zahlen}
define sud_setzen
  local psz

  loop
    sud_loeschen
    let psz (sud_kleinquadrat_start_pos + 5,5)
    current_font 'hp_block_c'
    text_size 8
    text_fill on
    text sud_zahl psz end
    text_fill off
    current_font 'hp_d17_c'

    sud_menu_zaehler
  exit_if (sud_zahl = '')
  end_loop
end_define

{Loeschen von einzelnen kleinen Zahlen}
define sud_loeschen_einzeln
  loop
    sud_elem_auswahl
    sud_loeschen_pruef sud_zahl_gewaehlt_pos
  exit_if (sud_zahl = '')
  end_loop
end_define


define sud_menu_zaehler

  if (sud_zahl = '')
    MENU Colo1 Bcol4 CENTER '1' '' 12 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_1) '' 12 2
    MENU Colo1 Bcol4 CENTER '2' '' 13 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_2) '' 13 2
    MENU Colo1 Bcol4 CENTER '3' '' 14 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_3) '' 14 2
    MENU Colo1 Bcol4 CENTER '4' '' 15 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_4) '' 15 2
    MENU Colo1 Bcol4 CENTER '5' '' 16 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_5) '' 16 2
    MENU Colo1 Bcol4 CENTER '6' '' 17 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_6) '' 17 2
    MENU Colo1 Bcol4 CENTER '7' '' 18 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_7) '' 18 2
    MENU Colo1 Bcol4 CENTER '8' '' 19 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_8) '' 19 2
    MENU Colo1 Bcol4 CENTER '9' '' 20 1
    MENU Colo1 Bcol0 CENTER (str sud_zahl_9) '' 20 2
  else_if (sud_zahl = '1')
    let sud_zahl_1 (sud_zahl_1 + 1)
    MENU if (sud_zahl_1 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_1) '' 12 2
  else_if (sud_zahl = '2')
    let sud_zahl_2 (sud_zahl_2 + 1)
    MENU if (sud_zahl_2 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_2) '' 13 2
  else_if (sud_zahl = '3')
    let sud_zahl_3 (sud_zahl_3 + 1)
    MENU if (sud_zahl_3 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_3) '' 14 2
  else_if (sud_zahl = '4')
    let sud_zahl_4 (sud_zahl_4 + 1)
    MENU if (sud_zahl_4 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_4) '' 15 2
  else_if (sud_zahl = '5')
    let sud_zahl_5 (sud_zahl_5 + 1)
    MENU if (sud_zahl_5 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_5) '' 16 2
  else_if (sud_zahl = '6')
    let sud_zahl_6 (sud_zahl_6 + 1)
    MENU if (sud_zahl_6 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_6) '' 17 2
  else_if (sud_zahl = '7')
    let sud_zahl_7 (sud_zahl_7 + 1)
    MENU if (sud_zahl_7 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_7) '' 18 2
  else_if (sud_zahl = '8')
    let sud_zahl_8 (sud_zahl_8 + 1)
    MENU if (sud_zahl_8 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_8) '' 19 2
  else_if (sud_zahl = '9')
    let sud_zahl_9 (sud_zahl_9 + 1)
    MENU if (sud_zahl_9 = 9) Colo0 Bcol3 else Colo1 Bcol0 end_if CENTER (str sud_zahl_9) '' 20 2
  end_if
end_define