MODULE LabTester;

   IMPORT Views, Ports, Properties, Controllers, Strings, TextModels, TextViews, TextSetters, Fonts, Stores, Dialog, Files, Models, Containers, StdCmds;

   CONST
      cbSize = 7*Ports.mm;
      cbBorder = Ports.blue;
      cbBack = 099FFFAH;
      cbSign = Ports.blue;
      hFontSize = 16* Ports.point;
      hBack = 099FFFAH;
      hFontColor = Ports.red;
      version = 0;
      
      code = "ACFGHSBXPDHCKNY";

   TYPE
      CheckBox = POINTER TO RECORD (Views.View)
         answer, edit, checked, lock: BOOLEAN
      END;

      Question = POINTER TO RECORD (Views.View) END;

      Password = ARRAY 16 OF CHAR;

   VAR
      testView: TextViews.View;
      password*, confirm*: Password;

   PROCEDURE (cb: CheckBox) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
   BEGIN
      f.DrawRect(0, 0, cbSize, cbSize, 0, cbBorder);
      IF cb.edit & cb.answer OR ~cb.edit & cb.checked THEN
         f.DrawLine(2*Ports.mm, 2*Ports.mm, cbSize DIV 2, cbSize - 2* Ports.mm, 0, cbSign);
         f.DrawLine(cbSize - 2*Ports.mm, 2*Ports.mm, cbSize DIV 2, cbSize - 2* Ports.mm, 0, cbSign)
      END
   END Restore;

   PROCEDURE (cb: CheckBox) GetBackground* (VAR color: INTEGER);
   BEGIN
      color := cbBack
   END GetBackground;

   PROCEDURE (cb: CheckBox) HandlePropMsg- (VAR msg: Properties.Message);
   BEGIN
      WITH msg: Properties.SizePref DO
         msg.w := cbSize;
         msg.h := msg.w;
         msg.fixedW := TRUE; msg.fixedH := TRUE
      | msg: Properties.FocusPref DO
         msg.hotFocus := TRUE;
         msg.setFocus := TRUE
      ELSE
      END
   END HandlePropMsg;

   PROCEDURE (cb: CheckBox) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
   BEGIN
      WITH msg: Controllers.TrackMsg DO
         IF cb.edit THEN
            cb.answer := ~cb.answer;
            cb.checked := FALSE;
            Models.SetDirty(cb.context.ThisModel())
         ELSIF ~cb.lock THEN
            cb.checked := ~cb.checked
         END;
         Views.Update(cb, Views.keepFrames)
      ELSE
      END
   END HandleCtrlMsg;

   PROCEDURE (cb: CheckBox) Externalize- (VAR wr: Stores.Writer);
   BEGIN
      wr.WriteVersion(version);
      wr.WriteBool(cb.answer)
   END Externalize;

   PROCEDURE (cb: CheckBox) Internalize- (VAR rd: Stores.Reader);
      VAR ver: INTEGER;
   BEGIN
      rd.ReadVersion(version, version, ver);
      IF ~rd.cancelled THEN
         rd.ReadBool(cb.answer);
         cb.edit := TRUE
      END
   END Internalize;

   PROCEDURE DepositCheckBox*;
      VAR cb: CheckBox;
   BEGIN
      NEW(cb);
      cb.edit := TRUE;
      Views.Deposit(cb)
   END DepositCheckBox;


   PROCEDURE (q: Question) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
      VAR s: ARRAY 64 OF CHAR;
            rd: TextModels.Reader;
            n: INTEGER;
            v: Views.View;
            font: Fonts.Font;
   BEGIN
      IF (q.context.ThisModel() # NIL) & (q.context.ThisModel() IS TextModels.Model) THEN
         rd := q.context.ThisModel()(TextModels.Model).NewReader(rd);
         n := 1;
         rd.ReadView(v);
         WHILE v # q DO
            IF v IS Question THEN INC(n) END;
            rd.ReadView(v)
         END;
         Strings.IntToString(n, s);
         s := "Вопрос " + s;
         font := Fonts.dir.Default();
         font := Fonts.dir.This(font.typeface, hFontSize, {Fonts.italic}, Fonts.bold);
         f.DrawString(0, hFontSize, hFontColor, s, font)
      END
   END Restore;

   PROCEDURE (q: Question) GetBackground* (VAR color: INTEGER);
   BEGIN
      color := cbBack
   END GetBackground;

   PROCEDURE (q: Question) HandlePropMsg- (VAR msg: Properties.Message);
   BEGIN
      WITH msg: Properties.SizePref DO
         msg.w := 10000 * Ports.mm; msg.h := hFontSize + hFontSize DIV 2
      | msg: Properties.ResizePref DO
         msg.fixed := TRUE
      | msg: Properties.FocusPref DO
         msg.hotFocus := TRUE
      | msg: TextSetters.Pref DO
         msg.opts := {TextSetters.lineBreak}
      ELSE
      END
   END HandlePropMsg;


   PROCEDURE DepositQuestion*;
      VAR q: Question;
   BEGIN
      NEW(q);
      Views.Deposit(q)
   END DepositQuestion;

   PROCEDURE SetMode (txt: TextModels.Model; edit, lock: BOOLEAN);
      VAR rd: TextModels.Reader;
            v: Views.View;
   BEGIN
      rd := txt.NewReader(rd);
      rd.ReadView(v);
      WHILE v # NIL DO
         WITH v: CheckBox DO
            v.edit := edit; v.lock := lock
         ELSE
         END;
         rd.ReadView(v)
      END
   END SetMode;

   PROCEDURE Check*;
      VAR tv: TextViews.View;
            rd: TextModels.Reader;
            v: Views.View;
            all, right: INTEGER;
            error: BOOLEAN;
            s, msg: ARRAY 256 OF CHAR;
   BEGIN
      tv := TextViews.Focus();
      IF tv # NIL THEN
         SetMode(tv.ThisModel(), FALSE, TRUE);
         rd := tv.ThisModel().NewReader(rd);
         all := 0; right := 0; error := FALSE;
         rd.ReadView(v);
         WHILE (v # NIL) & ~ (v IS Question) DO
            rd.ReadView(v)
         END;
         rd.ReadView(v);
         IF v # NIL THEN
            all := 1;
            WHILE v # NIL DO
               WHILE (v # NIL) & ~(v IS CheckBox) & ~ (v IS Question) DO
                  rd.ReadView(v)
               END;
               IF v # NIL THEN
                  WITH v: CheckBox DO
                     IF v.checked # v.answer THEN error := TRUE END                        
                  | v: Question DO
                     IF ~error THEN INC(right) END;
                     INC(all);
                     error := FALSE
                  END;
                  rd.ReadView(v)
               END
            END;
            IF ~error THEN INC(right) END
         END;
         msg := "Правильных ответов: ";
         Strings.IntToString(right, s); msg := msg + s;
         msg := msg + " из ";
         Strings.IntToString(all, s); msg := msg + s;
         Dialog.ShowMsg(msg)
      END   
   END Check;

   PROCEDURE NewTest*;
      VAR tv: TextViews.View;
   BEGIN
      tv := TextViews.dir.New(NIL);
      Views.OpenAux(tv, "Редактирование теста")
   END NewTest;

   PROCEDURE SaveWithKey*;
      VAR tv: TextViews.View;
   BEGIN
      tv := TextViews.Focus();
      IF tv # NIL THEN
         testView := tv;
         password := "";
         confirm := "";
         StdCmds.OpenToolDialog("Lab/Rsrc/TesterKey", "Установка пароля")
      END
   END SaveWithKey;

   PROCEDURE Encode (VAR password: Password);
      VAR i: INTEGER;
            cod: Password;
   BEGIN
      cod := code;
      FOR i := 0 TO LEN(password$)-1 DO
         password[i] := CHR(ORD(password[i]) + ORD(cod[i]))
      END
   END Encode;

   PROCEDURE Decode (VAR password: Password);
      VAR i: INTEGER;
            cod: Password;
   BEGIN
      cod := code;
      FOR i := 0 TO LEN(password$)-1 DO
         password[i] := CHR(ORD(password[i]) - ORD(cod[i]))
      END
   END Decode;

   PROCEDURE SaveCommit*;
      VAR loc: Files.Locator;
            name: Files.Name;
            f: Files.File;
            wr: Stores.Writer;
            pwd: Password;
            res: INTEGER;
   BEGIN
      IF (testView # NIL) & (password = confirm) THEN
         loc := Files.dir.This("");
         Dialog.GetExtSpec("", "test", loc, name);
         IF loc # NIL THEN
            f := Files.dir.New(loc, FALSE);
            IF f # NIL THEN
               wr.ConnectTo(f);
               wr.WriteVersion(version);
               pwd := password;
               Encode(pwd);
               wr.WriteString(pwd);
               wr.WriteStore(testView);
               f.Register(name, "test", FALSE, res)
            END
         END
      END
   END SaveCommit;

   PROCEDURE SaveCommitGuard* (VAR par: Dialog.Par);
   BEGIN
      IF password # confirm THEN
         par.disabled := TRUE
      END
   END SaveCommitGuard;

   PROCEDURE OpenForTest*;
      VAR loc: Files.Locator;
            name: Files.Name;
            f: Files.File;
            rd: Stores.Reader;
            ver: INTEGER;
            s: Stores.Store;
            v: TextViews.View;
            pwd: Password;
   BEGIN
      loc := Files.dir.This("");
      Dialog.GetIntSpec("test", loc, name);
      IF loc # NIL THEN
         f := Files.dir.Old(loc, name, TRUE);
         IF f # NIL THEN
            rd.ConnectTo(f);
            rd.ReadVersion(version, version, ver);
            IF ~ rd.cancelled THEN
               rd.ReadString(pwd);
               rd.ReadStore(s);
               v := s(TextViews.View);
               SetMode(v.ThisModel(), FALSE, FALSE);
               Views.OpenAux(v, "Прохождение теста");
               v.ThisController().SetOpts({Containers.noCaret})
            END
         ELSE
         END
      END
   END OpenForTest;

   PROCEDURE OpenForEdit*;
      VAR loc: Files.Locator;
            name: Files.Name;
            f: Files.File;
            rd: Stores.Reader;
            ver: INTEGER;
            s: Stores.Store;
            pwd: Password;
   BEGIN
      loc := Files.dir.This("");
      Dialog.GetIntSpec("test", loc, name);
      IF loc # NIL THEN
         f := Files.dir.Old(loc, name, TRUE);
         IF f # NIL THEN
            rd.ConnectTo(f);
            rd.ReadVersion(version, version, ver);
            IF ~ rd.cancelled THEN
               rd.ReadString(pwd);
               rd.ReadStore(s);
               testView := s(TextViews.View);
               Decode(pwd);
               confirm := pwd;
               StdCmds.OpenToolDialog("Lab/Rsrc/TesterEnter", "Введите пароль")
            END
         ELSE
         END
      END
   END OpenForEdit;

   PROCEDURE OpenCommit*;
   BEGIN
      IF password = confirm THEN
         Views.OpenAux(testView, "Редактирование теста");
         testView := NIL
      END
   END OpenCommit;

   PROCEDURE OpenCommitGuard* (VAR par: Dialog.Par);
   BEGIN
      IF password # confirm THEN
         par.disabled := TRUE
      END
   END OpenCommitGuard;

END LabTester.