Код:
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.