MODULE ObxOrders;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT
Files, Dialog, Fonts, Stores, Views,
TextModels, TextViews, TextMappers, TextRulers, StdCmds, StdStamps;
CONST
(* values for card field of interactor *)
amex = 0; master = 1; visa = 2;
(* prices in 1/100 Swiss Francs *)
ofwinfullVal = 45000; ofmacfullVal = 45000; ofwineduVal = 15000; ofmaceduVal = 15000;
odfVal = 5000; vatVal = 65;
type = "dat"; (* file type *)
TYPE
Interactor* = RECORD
name*, company*, adr1*, adr2*, adr3*, email*: ARRAY 128 OF CHAR;
phone*, fax*: ARRAY 32 OF CHAR;
ofwinfull*, ofmacfull*, ofwinedu*, ofmacedu*, odf*: INTEGER;
card*: INTEGER;
cardno*: ARRAY 24 OF CHAR;
vat*: BOOLEAN
END;
Element = POINTER TO RECORD
prev, next: Element;
data: Interactor
END;
VAR
par*: Interactor;
root, cur: Element; (* header and current element of doubly-linked ring *)
name: Files.Name;
loc: Files.Locator;
PROCEDURE ReadElem (VAR rd: Stores.Reader; e: Element);
BEGIN
rd.ReadString(e.data.name);rd.ReadString(e.data.company);
rd.ReadString(e.data.adr1); rd.ReadString(e.data.adr2); rd.ReadString(e.data.adr3);
rd.ReadString(e.data.email);
rd.ReadString(e.data.phone); rd.ReadString(e.data.fax);
rd.ReadString(e.data.cardno);
rd.ReadInt(e.data.ofwinfull); rd.ReadInt(e.data.ofmacfull);
rd.ReadInt(e.data.ofwinedu); rd.ReadInt(e.data.ofmacedu);
rd.ReadInt(e.data.odf);
rd.ReadInt(e.data.card);
rd.ReadBool(e.data.vat)
END ReadElem;
PROCEDURE WriteElem (VAR wr: Stores.Writer; e: Element);
BEGIN
wr.WriteString(e.data.name); wr.WriteString(e.data.company);
wr.WriteString(e.data.adr1); wr.WriteString(e.data.adr2); wr.WriteString(e.data.adr3);
wr.WriteString(e.data.email);
wr.WriteString(e.data.phone); wr.WriteString(e.data.fax);
wr.WriteString(e.data.cardno);
wr.WriteInt(e.data.ofwinfull); wr.WriteInt(e.data.ofmacfull);
wr.WriteInt(e.data.ofwinedu); wr.WriteInt(e.data.ofmacedu);
wr.WriteInt(e.data.odf);
wr.WriteInt(e.data.card);
wr.WriteBool(e.data.vat)
END WriteElem;
PROCEDURE Init;
BEGIN
cur := root; root.next := root; root.prev := root
END Init;
PROCEDURE Update;
BEGIN
par := cur.data; Dialog.Update(par)
END Update;
PROCEDURE Load*;
VAR e: Element; f: Files.File; rd: Stores.Reader; count: INTEGER;
BEGIN
Dialog.GetIntSpec(type, loc, name);
IF loc # NIL THEN
f := Files.dir.Old(loc, name, Files.shared);
IF (f # NIL) & (f.type = type) THEN
rd.ConnectTo(f);
rd.ReadInt(count);
Init;
WHILE count # 0 DO
NEW(e);
IF e # NIL THEN
e.prev := cur; e.next := cur.next; e.prev.next := e; e.next.prev := e;
ReadElem(rd, e);
cur := e; DEC(count)
ELSE
Dialog.ShowMsg("out of memory"); Dialog.Beep;
count := 0; root.next := root; root.prev := root; cur := root
END
END;
Update
ELSE
Dialog.ShowMsg("cannot open file"); Dialog.Beep
END
END
END Load;
PROCEDURE Save*;
VAR e: Element; f: Files.File; wr: Stores.Writer; count, res: INTEGER;
BEGIN
IF (loc = NIL) OR (name = "") THEN Dialog.GetExtSpec("", "", loc, name) END;
IF (loc # NIL) & (name # "") THEN
f := Files.dir.New(loc, Files.dontAsk); wr.ConnectTo(f);
e := root.next; count := 0; WHILE e # root DO INC(count); e := e.next END; (* count elements *)
wr.WriteInt(count);
e := root.next; WHILE e # root DO WriteElem(wr, e); e := e.next END; (* write elements *)
f.Register(name, type, Files.dontAsk, res);
Init; name := ""; loc := NIL; (* close database *)
Update
END
END Save;
PROCEDURE Insert*;
VAR e: Element;
BEGIN
NEW(e);
IF e # NIL THEN (* insert new record at end of database *)
IF cur # root THEN cur.data := par END; (* save current record, in case it was changed *)
e.prev := root.prev; e.next := root; e.prev.next := e; e.next.prev := e;
cur := e;
Update
ELSE
Dialog.ShowMsg("out of memory"); Dialog.Beep
END
END Insert;
PROCEDURE Delete*;
BEGIN
IF cur # root THEN
StdCmds.CloseDialog;
cur.next.prev := cur.prev; cur.prev.next := cur.next;
cur := cur.prev; IF cur = root THEN cur := root.next END;
Update
END
END Delete;
PROCEDURE Next*;
BEGIN
IF cur.next # root THEN
cur.data := par; cur := cur.next; Update
END
END Next;
PROCEDURE Prev*;
BEGIN
IF cur.prev # root THEN
cur.data := par; cur := cur.prev; Update
END
END Prev;
PROCEDURE NonemptyGuard* (VAR par: Dialog.Par);
BEGIN
par.disabled := cur = root
END NonemptyGuard;
PROCEDURE NextGuard* (VAR par: Dialog.Par);
BEGIN
par.disabled := cur.next = root
END NextGuard;
PROCEDURE PrevGuard* (VAR par: Dialog.Par);
BEGIN
par.disabled := cur.prev = root
END PrevGuard;
PROCEDURE WriteLine (VAR f: TextMappers.Formatter; no, val: INTEGER; name: ARRAY OF CHAR;
VAR total, vat: INTEGER);
BEGIN
IF no # 0 THEN
val := no * val;
f.WriteInt(no); f.WriteString(name);
INC(total, val); INC(vat, val);
f. WriteTab;
f.WriteIntForm(val DIV 100, 10, 5, TextModels.digitspace, FALSE);
f.WriteChar(".");
f.WriteIntForm(val MOD 100, 10, 2, "0", FALSE);
f.WriteLn
END
END WriteLine;
PROCEDURE NewRuler (): TextRulers.Ruler;
VAR r: TextRulers.Ruler;
BEGIN
r := TextRulers.dir.New(NIL);
(*
TextRulers.SetLeft(r, 30 * Ports.mm);
TextRulers.SetRight(r, 165 * Ports.mm);
TextRulers.AddTab(r, 130 * Ports.mm);
*)
RETURN r
END NewRuler;
PROCEDURE Invoice*;
VAR v: TextViews.View; f: TextMappers.Formatter; a: TextModels.Attributes;
total, vat: INTEGER;
BEGIN
IF cur # root THEN
v := TextViews.dir.New(TextModels.dir.New());
f.ConnectTo(v.ThisModel());
f.WriteView(NewRuler());
(* create header of invoice *)
f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn;
f.WriteTab;
f.WriteString("Basel, "); f.WriteView(StdStamps.New());
f.WriteLn; f.WriteLn; f.WriteLn;
(* write address *)
IF par.name # "" THEN f.WriteString(par.name); f.WriteLn END;
IF par.company # "" THEN f.WriteString(par.company); f.WriteLn END;
IF par.adr1 # "" THEN f.WriteString(par.adr1); f.WriteLn END;
IF par.adr2 # "" THEN f.WriteString(par.adr2); f.WriteLn END;
IF par.adr3 # "" THEN f.WriteString(par.adr3); f.WriteLn END;
f.WriteLn; f.WriteLn; f.WriteLn;
(* set bold font weight *)
a := f.rider.attr;
f.rider.SetAttr(TextModels.NewWeight(a, Fonts.bold));
f.WriteString("Invoice"); (* this string will appear in bold face *)
f.rider.SetAttr(a); (* restore default weight *)
f.WriteLn; f.WriteLn;
f.WriteString("Creditcard: ");
CASE par.card OF
| amex: f.WriteString("American Express")
| master: f.WriteString("Euro/MasterCard")
| visa: f.WriteString("Visa")
END;
f.WriteLn; f.WriteLn; f.WriteLn;
(* write products with subtotals *)
total := 0; vat := 0;
WriteLine(f, par.ofwinfull, ofwinfullVal, " ofwin full", total, vat);
WriteLine(f, par.ofmacfull, ofmacfullVal, " ofmac full", total, vat);
WriteLine(f, par.ofwinedu, ofwineduVal, " ofwin edu", total, vat);
WriteLine(f, par.ofmacedu, ofmaceduVal, " ofmac edu", total, vat);
WriteLine(f, par.odf, odfVal, " odf", total, vat);
(* write vat *)
IF par.vat THEN
f.WriteLn;
INC(total, (vat * vatVal) DIV 1000); (* vat is 6.5% *)
f.WriteString("value added tax (");
f.WriteInt(vatVal DIV 10); f.WriteChar("."); f.WriteInt(vatVal MOD 10);
f.WriteString("% on ");
f.WriteInt(vat DIV 100); f.WriteChar("."); f.WriteIntForm(vat MOD 100, 10, 2, "0", FALSE);
f.WriteString(")");
f.WriteTab;
f.WriteIntForm((vat * vatVal) DIV 100000, 10, 5, TextModels.digitspace, FALSE);
f.WriteChar("."); f.WriteIntForm(((vat * vatVal) DIV 1000) MOD 100, 10, 2, "0", FALSE);
f.WriteLn
END;
(* write total *)
f.WriteLn;
f.WriteString("Total"); f.WriteTab;
f.WriteIntForm(total DIV 100, 10, 5, TextModels.digitspace, FALSE);
f.WriteChar("."); f.WriteIntForm(total MOD 100, 10, 2, "0", FALSE);
f.WriteString(" sFr.");
f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn;
f.WriteLn; f.WriteLn; f.WriteLn; f.WriteLn;
f.WriteString("The exporter of the products covered by this document declares that, except where otherwise clearly indicated, these products are of Swiss preferential origin.");
f.WriteLn;
Views.OpenAux(v, "Invoice")
END
END Invoice;
BEGIN
NEW(root); Init
END ObxOrders.