MODULE WMSlideshow;
IMPORT
Codecs, Inputs, Modules, Streams, KernelLog, Files, Commands,
Raster,
Strings,
WMDropTarget,
WMWindowManager, WMGraphics, WMRectangles,
WMComponents, WMStandardComponents, WMDialogs,
WMTransitions,
XML, XMLObjects, XMLScanner, XMLParser;
CONST
DEBUG= FALSE;
TYPE String = Strings.String;
TYPE Image = WMGraphics.Image;
TYPE TransitionMask = WMTransitions.TransitionMask;
TYPE TransitionFade = WMTransitions.TransitionFade;
TYPE ObjectArray = POINTER TO ARRAY OF ANY;
TYPE Slide* = OBJECT
VAR
img, trans : String;
dur : LONGINT;
desc : String;
PROCEDURE &New*(img : String; trans : String; dur : LONGINT; desc : String);
BEGIN
SELF.img := img; SELF.trans := trans; SELF.dur := dur; SELF.desc := desc;
END New;
END Slide;
TYPE List* = OBJECT
VAR
list : ObjectArray;
count : LONGINT;
readLock : LONGINT;
PROCEDURE &New*(size: LONGINT);
BEGIN
NEW(list, size); readLock := 0
END New;
PROCEDURE GetCount*():LONGINT;
BEGIN
RETURN count
END GetCount;
PROCEDURE Grow;
VAR
old: ObjectArray; i : LONGINT;
BEGIN
old := list; NEW(list, LEN(list)*2);
FOR i := 0 TO count-1 DO list[i] := old[i] END;
END Grow;
PROCEDURE Add*(x : ANY);
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
IF (count = LEN(list)) THEN Grow END; list[count] := x; INC(count);
END Add;
PROCEDURE Replace*(x, y : ANY);
VAR
i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
i := IndexOf(x); IF (i >= 0) THEN list[i] := y END;
END Replace;
PROCEDURE IndexOf *(x:ANY) : LONGINT;
VAR
i : LONGINT;
BEGIN
i := 0 ;
WHILE (i < count) DO IF (list[i] = x) THEN RETURN i END; INC(i); END;
RETURN -1;
END IndexOf;
PROCEDURE Remove*(x : ANY);
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
i:=0;
WHILE ( (i<count) & (list[i]#x) ) DO INC(i) END;
IF (i<count) THEN
WHILE (i<count-1) DO list[i]:=list[i+1]; INC(i); END;
DEC(count); list[count]:=NIL
END
END Remove;
PROCEDURE RemoveByIndex*(index : LONGINT);
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
i := index;
IF (i >= 0) & (i < count) THEN
WHILE (i<count-1) DO list[i]:=list[i+1]; INC(i); END;
DEC(count); list[count]:=NIL;
END;
END RemoveByIndex;
PROCEDURE Clear*;
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
FOR i := 0 TO count - 1 DO list[i] := NIL; END;
count := 0
END Clear;
PROCEDURE GetItem*(i:LONGINT) : ANY;
BEGIN
ASSERT((i >= 0) & (i < count), 101);
RETURN list[i];
END GetItem;
PROCEDURE Lock*;
BEGIN {EXCLUSIVE}
INC(readLock);
ASSERT(readLock > 0);
END Lock;
PROCEDURE Unlock*;
BEGIN {EXCLUSIVE}
DEC(readLock);
ASSERT(readLock >= 0);
END Unlock;
END List;
TYPE SlideshowApp= OBJECT
VAR
data : SlideshowData;
win : SlideshowWindow;
nav : SlideshowNavigation;
slideNr : LONGINT;
fullscreen : BOOLEAN;
PROCEDURE &New*(CONST filename : ARRAY OF CHAR);
BEGIN
NEW(data);
IF (filename # "") THEN
data.LoadSlideshow(filename);
END;
IF app = NIL THEN app := SELF END;
NEW(win, 320, 240, FALSE, data);
fullscreen := FALSE;
WMWindowManager.DefaultAddWindow(win);
NEW(nav, data);
WMWindowManager.DefaultAddWindow(nav);
slideNr := 0;
END New;
PROCEDURE Next;
BEGIN
IF (data.CountSlides() = 0) THEN RETURN; END;
IF ( slideNr < data.CountSlides() ) THEN
win.Show(slideNr+1);
INC(slideNr);
nav.UpdatePreview();
END;
END Next;
PROCEDURE Previous;
BEGIN
IF (data.CountSlides() = 0) THEN RETURN; END;
slideNr := slideNr-1;
IF (slideNr < 0) THEN slideNr := 0; RETURN; END;
win.Update();
nav.UpdatePreview();
END Previous;
PROCEDURE First;
BEGIN
IF (data.CountSlides() = 0) THEN RETURN; END;
slideNr := 0;
win.Update();
nav.UpdatePreview();
END First;
PROCEDURE Last;
BEGIN
IF (data.CountSlides() = 0) THEN RETURN; END;
slideNr := data.CountSlides()-1;
IF (slideNr< 0) THEN slideNr := 0; END;
win.Update();
nav.UpdatePreview();
END Last;
PROCEDURE ToggleFullscreen;
VAR
view : WMWindowManager.ViewPort;
manager : WMWindowManager.WindowManager;
w, h : LONGINT;
BEGIN
IF (win = NIL) THEN RETURN; END;
fullscreen := ~fullscreen;
manager := WMWindowManager.GetDefaultManager();
view := WMWindowManager.GetDefaultView();
IF (fullscreen) THEN
w := ENTIER(view.range.r - view.range.l);
h := ENTIER(view.range.b - view.range.t);
manager.SetWindowSize(win, w, h);
manager.SetWindowPos(win, ENTIER(view.range.l), ENTIER(view.range.t));
win.Resized(w, h);
win.Invalidate( WMRectangles.MakeRect(0, 0, w, h) );
ELSE
w := win.img.width; h := win.img.height;
manager.SetWindowSize(win, w, h);
manager.SetWindowPos(win, ENTIER(view.range.l)+50, ENTIER(view.range.t)+50);
win.Resized(w, h);
win.Invalidate( WMRectangles.MakeRect(0, 0, w, h) );
END;
END ToggleFullscreen;
PROCEDURE ShowFileList;
VAR
dummy : ARRAY 2048 OF CHAR;
nl : ARRAY 2 OF CHAR;
slide : Slide;
i : LONGINT;
BEGIN
nl[0] := 0DX; nl[1] := 0X;
dummy[0] := 0X;
FOR i := 0 TO data.CountSlides()-1 DO
slide := data.GetSlide(i);
Strings.Append(dummy, slide.img^);
Strings.Append(dummy, nl);
END;
WMDialogs.Information("Slideshow file list", dummy);
END ShowFileList;
PROCEDURE ExitDialog;
BEGIN
IF (WMDialogs.Confirmation("Exit Slideshow?", "You pressed ESC. Do you really want to exit the slideshow?") = WMDialogs.ResOk) THEN
Cleanup();
END;
END ExitDialog;
PROCEDURE RemoveCurrentSlide;
VAR
isLast : BOOLEAN;
BEGIN
IF (DEBUG) THEN KernelLog.String("Remove slide nr."); KernelLog.Int(slideNr, 0); KernelLog.Ln; END;
isLast := slideNr = data.CountSlides()-1;
data.RemoveSlide(slideNr);
IF (~isLast) THEN
IF (data.CountSlides() > 0) THEN
nav.UpdatePreview();
win.Update();
ELSE
END;
ELSE
IF (DEBUG) THEN KernelLog.String("# of remaining slides is "); KernelLog.Int(data.CountSlides(), 0); KernelLog.Ln; END;
IF (data.CountSlides() > 0) THEN
DEC(slideNr);
win.Update();
ELSE
IF (DEBUG) THEN
KernelLog.String("All slides deleted!"); KernelLog.Ln;
END;
slideNr := 0;
win.Close();
data.ClearSlides();
NEW(win, 320, 240, FALSE, data);
WMWindowManager.DefaultAddWindow(win);
END;
END;
END RemoveCurrentSlide;
PROCEDURE Close;
BEGIN
win.Close();
nav.Close();
END Close;
END SlideshowApp;
TYPE SlideshowNavigation = OBJECT(WMComponents.FormWindow);
VAR
data : SlideshowData;
imageP : WMStandardComponents.ImagePanel;
prevLen : LONGINT;
PROCEDURE &New*(data : SlideshowData);
VAR
panel, nav: WMStandardComponents.Panel;
button : WMStandardComponents.Button;
manager : WMWindowManager.WindowManager;
windowStyle : WMWindowManager.WindowStyle;
BEGIN
SELF.data := data;
prevLen := 180;
Init(prevLen, prevLen+20, FALSE);
manager := WMWindowManager.GetDefaultManager();
windowStyle := manager.GetStyle();
NEW(panel);
panel.bounds.SetExtents(prevLen, prevLen+20);
panel.fillColor.Set(0000000H);
panel.takesFocus.Set(TRUE);
NEW(imageP);
imageP.bounds.SetExtents(prevLen, prevLen);
imageP.alignment.Set(WMComponents.AlignTop);
NEW(nav);
nav.bounds.SetExtents(prevLen, 20);
nav.fillColor.Set(LONGINT(0AAAAAAAAH));
nav.takesFocus.Set(TRUE);
nav.alignment.Set(WMComponents.AlignTop);
NEW(button);
button.caption.SetAOC("|<");
button.alignment.Set(WMComponents.AlignLeft);
button.onClick.Add(ButtonHandlerFirst);
button.bounds.SetWidth(40); button.bounds.SetHeight(20);
nav.AddContent(button);
NEW(button);
button.caption.SetAOC("Previous");
button.alignment.Set(WMComponents.AlignLeft);
button.onClick.Add(ButtonHandlerPrevious);
button.bounds.SetWidth(50); button.bounds.SetHeight(20);
nav.AddContent(button);
NEW(button);
button.caption.SetAOC("Next");
button.alignment.Set(WMComponents.AlignLeft);
button.onClick.Add(ButtonHandlerNext);
button.bounds.SetWidth(50); button.bounds.SetHeight(20);
nav.AddContent(button);
NEW(button);
button.caption.SetAOC(">|");
button.alignment.Set(WMComponents.AlignLeft);
button.onClick.Add(ButtonHandlerLast);
button.bounds.SetWidth(40); button.bounds.SetHeight(20);
nav.AddContent(button);
panel.AddContent(nav);
panel.AddContent(imageP);
SetContent(panel);
SetTitle( Strings.NewString("Slideshow Navigation") );
IF (data.CountSlides() > 0) THEN
UpdatePreview();
END;
END New;
PROCEDURE UpdatePreview;
VAR
nextSlide : Slide;
nextIndex : LONGINT;
image : Image;
fact : REAL;
c : WMGraphics.BufferCanvas;
w, h : LONGINT;
BEGIN
IF (app.slideNr >= data.CountSlides()-1) THEN
imageP.SetImage(SELF, NIL);
ELSE
nextIndex := app.slideNr+1;
nextSlide := data.GetSlide(nextIndex);
image := LoadImage(nextSlide.img^, Raster.BGR565);
WHILE (image = NIL) & (nextIndex < data.CountSlides()) DO
IF (DEBUG) THEN KernelLog.String("Error in UpdatePreview(): Remove invalid image "); KernelLog.String(nextSlide.img^); KernelLog.String("."); KernelLog.Ln; END;
data.RemoveSlide(nextIndex);
IF (nextIndex < data.CountSlides()) THEN
nextSlide := data.GetSlide(nextIndex);
image := LoadImage(nextSlide.img^, Raster.BGR565);
END;
END;
IF (image = NIL) THEN
imageP.SetImage(SELF, NIL);
ELSE
NEW(c, image);
IF (image.width > prevLen) OR (image.height > prevLen) THEN
IF (image.width >= image.height) THEN
fact := image.width / prevLen;
ELSE
fact := image.height / prevLen;
END;
c.ScaleImage(image, WMRectangles.MakeRect(0, 0, image.width, image.height),
WMRectangles.MakeRect(0, 0, ENTIER(image.width/fact), ENTIER(image.height/fact)), WMGraphics.ModeCopy, WMGraphics.ScaleBilinear);
image.width := ENTIER(image.width/fact);
image.height := ENTIER(image.height/fact);
END;
w := image.width; h := image.height + 20;
imageP.SetImage(SELF, image);
END;
END;
manager := WMWindowManager.GetDefaultManager();
w := Strings.Max(w, 180);
manager.SetWindowSize(SELF, w, h);
Resized(w, h);
Invalidate( WMRectangles.MakeRect(0, 0, w, h) );
END UpdatePreview;
PROCEDURE ButtonHandlerNext(sender, data: ANY);
BEGIN
app.Next();
END ButtonHandlerNext;
PROCEDURE ButtonHandlerPrevious(sender, data: ANY);
BEGIN
app.Previous();
END ButtonHandlerPrevious;
PROCEDURE ButtonHandlerFirst(sender, data: ANY);
BEGIN
app.First();
END ButtonHandlerFirst;
PROCEDURE ButtonHandlerLast(sender, data: ANY);
BEGIN
app.Last();
END ButtonHandlerLast;
PROCEDURE KeyEvent(ucs : LONGINT; flags : SET; keysym : LONGINT);
BEGIN
IF Inputs.Release IN flags THEN RETURN; END;
IF ucs = ORD("f") THEN
app.ToggleFullscreen();
RETURN;
ELSIF ucs = ORD("w") THEN
app.win.Close();
NEW(app.win, 320, 240, FALSE, data);
WMWindowManager.DefaultAddWindow(app.win);
RETURN;
ELSIF ucs = ORD("l") THEN
app.ShowFileList();
RETURN;
END;
IF (keysym = 0FF51H) THEN
app.Previous();
ELSIF (keysym = 0FF53H) THEN
app.Next();
ELSIF (keysym = 0FF54H) THEN
app.Last();
ELSIF (keysym = 0FF52H) THEN
app.First();
ELSIF (keysym = 0FF56H) THEN
app.Next();
ELSIF (keysym = 0FF55H) THEN
app.Previous();
ELSIF (keysym = 0FF50H) THEN
app.First();
ELSIF (keysym = 0FF57H) THEN
app.Last();
ELSIF (keysym = 00020H) THEN
app.Next();
ELSIF (keysym = 0FF1BH) THEN
app.ExitDialog();
ELSIF (keysym = 0FFFFH) THEN
app.RemoveCurrentSlide();
ELSE
IF (DEBUG) THEN KernelLog.String("unknown keysym= "); KernelLog.Int(keysym, 0); KernelLog.Ln; END;
END;
END KeyEvent;
PROCEDURE DragDropped*(x, y: LONGINT; dragInfo : WMWindowManager.DragInfo);
VAR
dropTarget : URLDropTarget;
BEGIN
KernelLog.Ln;
NEW(dropTarget);
dragInfo.data := dropTarget;
ConfirmDrag(TRUE, dragInfo)
END DragDropped;
END SlideshowNavigation;
TYPE URLDropTarget* = OBJECT(WMDropTarget.DropTarget);
PROCEDURE GetInterface*(type : LONGINT) : WMDropTarget.DropInterface;
VAR di : DropURL;
BEGIN
IF (type = WMDropTarget.TypeURL) THEN
NEW(di);
RETURN di;
ELSE
RETURN NIL;
END
END GetInterface;
END URLDropTarget;
TYPE DropURL* = OBJECT(WMDropTarget.DropURLs)
PROCEDURE URL*(CONST url : ARRAY OF CHAR; VAR res : LONGINT);
BEGIN
KernelLog.String("Dropped new URL: "); KernelLog.String(url); KernelLog.Ln;
IF (app # NIL) THEN
app.data.AddSlide(url);
IF (app.data.CountSlides() = 1) THEN
app.win.Update();
ELSE
app.nav.UpdatePreview();
END;
res := 0
ELSE
res := -1;
END;
END URL;
END DropURL;
TYPE SlideshowWindow = OBJECT(WMWindowManager.DoubleBufferWindow);
VAR
data: SlideshowData;
PROCEDURE &New*( width, height : LONGINT; alpha : BOOLEAN; data : SlideshowData);
BEGIN
Init(width, height, alpha);
SetTitle( Strings.NewString("Bluebottle Slideshow (ETHZ, 2005)") );
SELF.data := data;
IF (data.CountSlides() = 0) THEN RETURN; END;
Update();
END New;
PROCEDURE PointerDown(x, y : LONGINT; keys : SET);
BEGIN
IF (0 IN keys) THEN
app.Next();
END;
END PointerDown;
PROCEDURE KeyEvent(ucs : LONGINT; flags : SET; keysym : LONGINT);
BEGIN
IF Inputs.Release IN flags THEN RETURN; END;
IF ucs = ORD("f") THEN
app.ToggleFullscreen();
RETURN;
ELSIF ucs = ORD("n") THEN
app.nav.Close();
NEW(app.nav, data);
WMWindowManager.DefaultAddWindow(app.nav);
RETURN;
ELSIF ucs = ORD("l") THEN
app.ShowFileList();
RETURN;
END;
IF (keysym = 0FF51H) THEN
app.Previous();
ELSIF (keysym = 0FF53H) THEN
app.Next();
ELSIF (keysym = 0FF54H) THEN
app.Last();
ELSIF (keysym = 0FF52H) THEN
app.First();
ELSIF (keysym = 0FF56H) THEN
app.Next();
ELSIF (keysym = 0FF55H) THEN
app.Previous();
ELSIF (keysym = 0FF50H) THEN
app.First();
ELSIF (keysym = 0FF57H) THEN
app.Last();
ELSIF (keysym = 00020H) THEN
app.Next();
ELSIF (keysym = 0FF1BH) THEN
app.ExitDialog();
ELSIF (keysym = 0FFFFH) THEN
app.RemoveCurrentSlide();
ELSE
IF (DEBUG) THEN KernelLog.String("unknown keysym= "); KernelLog.Int(keysym, 0); KernelLog.Ln; END;
END;
END KeyEvent;
PROCEDURE Show(nextSlideNr : LONGINT );
VAR
current, next : Slide;
src, dest : Image;
maskFile : String;
BEGIN
IF (data.CountSlides() < 2) THEN RETURN; END;
IF (nextSlideNr > data.CountSlides()-1) THEN RETURN; END;
current := data.GetSlide(app.slideNr);
next := data.GetSlide(nextSlideNr);
src := LoadImage(current.img^, Raster.BGR565);
dest := LoadImage(next.img^, Raster.BGR565);
IF (dest = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error: Invalid image - no decoder found for "); KernelLog.String(next.img^); KernelLog.Ln; END;
data.RemoveSlide(nextSlideNr);
Update();
RETURN;
END;
IF (src = NIL) OR (dest = NIL) THEN HALT(99); END;
IF (current.trans^ = "") THEN
ShowNone(dest);
ELSIF (Strings.Match("mask:*", current.trans^)) THEN
maskFile := Strings.NewString(current.trans^);
Strings.Delete(maskFile^, 0, 5);
ShowMask(src, dest, maskFile^, current.dur);
ELSIF (Strings.Match("fade", current.trans^)) THEN
ShowFade(src, dest, current.dur);
ELSE
KernelLog.String("Invalid transition. Use 'mask:[URL]', 'fade' or '' (empty) in XML file!"); KernelLog.Ln;
HALT(99);
END;
END Show;
PROCEDURE ShowMask(current, next : Image; CONST mask: ARRAY OF CHAR; len : LONGINT);
VAR
tm : TransitionMask;
i, step: LONGINT;
w, h : LONGINT;
BEGIN
IF (DEBUG) THEN KernelLog.String("Mask transition: "); KernelLog.String(mask); KernelLog.Ln; END;
w := current.width; h := current.height;
i := 0;
step := 256 DIV len;
NEW(tm);
tm.Init(w, h);
tm.SetMask(WMGraphics.LoadImage(mask, TRUE));
WHILE (i < 256) DO
tm.CalcImage(next, current, img, i);
Invalidate(WMRectangles.MakeRect(0, 0, w, h));
i := i + step;
END;
IF (i # 255) THEN
img := next;
Invalidate(WMRectangles.MakeRect(0, 0, w, h));
END;
END ShowMask;
PROCEDURE ShowFade(current, next : Image; len : LONGINT);
VAR
tf : TransitionFade;
i,step : LONGINT;
w, h : LONGINT;
BEGIN
IF (DEBUG) THEN KernelLog.String("Fade transition"); KernelLog.Ln; END;
w := current.width; h := current.height;
i := 0;
step := 256 DIV len;
NEW(tf);
tf.Init(w, h);
WHILE (i < 256) DO
tf.CalcImage(current, next, img, i);
Invalidate(WMRectangles.MakeRect(0, 0, w, h));
i := i + step;
END;
IF (i #255) THEN
img := next;
Invalidate(WMRectangles.MakeRect(0, 0, w, h));
END;
END ShowFade;
PROCEDURE ShowNone(next : Image);
BEGIN
img := next;
Invalidate(WMRectangles.MakeRect(0, 0, next.width, next.height));
END ShowNone;
PROCEDURE Update;
VAR s : Slide;
w, h : LONGINT;
manager : WMWindowManager.WindowManager;
BEGIN
IF (app.slideNr > data.CountSlides()-1) THEN RETURN; END;
s := data.GetSlide(app.slideNr);
img := LoadImage(s.img^, Raster.BGR565);
WHILE (img = NIL) DO
IF (DEBUG) THEN KernelLog.String("Error: Invalid image - no decoder found for "); KernelLog.String(s.img^); KernelLog.Ln; END;
data.RemoveSlide(app.slideNr);
IF (app.slideNr < data.CountSlides()-1) THEN
s := data.GetSlide(app.slideNr);
img := LoadImage(s.img^, Raster.BGR565);
ELSIF ( (data.CountSlides() > 0) & (app.slideNr > 0) ) THEN
DEC(app.slideNr);
s := data.GetSlide(app.slideNr);
img := LoadImage(s.img^, Raster.BGR565);
ELSE
IF (DEBUG) THEN KernelLog.String("Error: No more images in slideshow. Add new ones by dropping URLs in navigation window."); KernelLog.Ln; END;
RETURN;
END;
END;
manager := WMWindowManager.GetDefaultManager();
w := img.width; h := img.height;
manager.SetWindowSize(SELF, w, h);
Resized(w, h);
Invalidate( WMRectangles.MakeRect(0, 0, w, h) );
IF (app.nav # NIL) THEN
app.nav.UpdatePreview();
END;
END Update;
END SlideshowWindow;
TYPE SlideshowData= OBJECT
VAR
slides : List;
hasErrors : BOOLEAN;
PROCEDURE &New*;
BEGIN
NEW(slides, 50);
IF (DEBUG) THEN KernelLog.String("All slides have been loaded!"); KernelLog.Ln; END;
END New;
PROCEDURE GetSlide(i : LONGINT) : Slide;
VAR
p : ANY; s : Slide;
BEGIN
p := slides.GetItem(i);
IF (p = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Slide nr. "); KernelLog.Int(i, 0); KernelLog.String(" doesn't exist!"); KernelLog.Ln; END;
RETURN NIL;
END;
s := p(Slide); RETURN s;
END GetSlide;
PROCEDURE CountSlides() : LONGINT;
BEGIN
RETURN slides.GetCount();
END CountSlides;
PROCEDURE LoadSlideshow(CONST name : ARRAY OF CHAR);
VAR
f : Files.File;
scanner : XMLScanner.Scanner;
parser : XMLParser.Parser;
reader : Files.Reader;
doc : XML.Document;
BEGIN {EXCLUSIVE}
hasErrors := FALSE;
f := Files.Old(name);
IF (f = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Couldn't open "); KernelLog.String(name); KernelLog.String(". Slideshow NOT loaded."); KernelLog.Ln; END;
HALT (99);
END;
NEW(reader, f, 0);
NEW(scanner, reader); scanner.reportError := ErrorReport;
NEW(parser, scanner); parser.reportError := ErrorReport;
doc := parser.Parse();
IF (hasErrors) THEN
IF (DEBUG) THEN KernelLog.String("Slideshow "); KernelLog.String(name); KernelLog.String("NOT ok."); KernelLog.Ln; END;
HALT (99);
END;
IF (LoadSlides(doc)) THEN
IF (DEBUG) THEN KernelLog.String("Slideshow "); KernelLog.String(name); KernelLog.String(" loaded."); KernelLog.Ln; END;
ELSE
IF (DEBUG) THEN KernelLog.String("Slideshow "); KernelLog.String(name); KernelLog.String(" NOT loaded."); KernelLog.Ln; END;
HALT (99);
END;
END LoadSlideshow;
PROCEDURE LoadSlides(doc: XML.Document) : BOOLEAN;
VAR
enum: XMLObjects.Enumerator;
e, root: XML.Element;
p: ANY;
s, imgStr, transStr, durStr, descStr : String;
dur : LONGINT;
slide : Slide;
BEGIN
IF (doc = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): doc = NIL"); END;
RETURN FALSE;
END;
root := doc.GetRoot();
IF (root = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): root = NIL"); END;
RETURN FALSE;
END;
enum := root.GetContents();
WHILE ( enum.HasMoreElements() ) DO
p := enum.GetNext();
IF ~(p IS XML.Element) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): p # XML.Element"); END;
RETURN FALSE;
END;
e := p(XML.Element);
s := e.GetName();
IF (s = NIL) OR (s^ # "Slide") THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): s = NIL OR s # 'Slide'"); END;
RETURN FALSE;
END;
s := e.GetAttributeValue("image");
IF (s = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): s(image) = NIL"); END;
RETURN FALSE;
END;
imgStr := Strings.NewString(s^);
IF ( (imgStr = NIL) OR (imgStr^ = "") ) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): filename = NIL OR empty"); END;
RETURN FALSE;
END;
s := e.GetAttributeValue("transition");
IF (s = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): s(transition) = NIL"); END;
RETURN FALSE;
END;
transStr := Strings.NewString(s^);
IF (transStr = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): transition = NIL"); END;
RETURN FALSE;
END;
s := e.GetAttributeValue("duration");
IF (s = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): s(duration) = NIL"); END;
RETURN FALSE;
END;
durStr := Strings.NewString(s^);
Strings.StrToInt(durStr^, dur);
s := e.GetAttributeValue("description");
IF (s = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): s(description) = NIL"); END;
RETURN FALSE;
END;
descStr := Strings.NewString(s^);
IF (descStr = NIL) THEN
IF (DEBUG) THEN KernelLog.String("Error in LoadSlides(): description = NIL"); END;
RETURN FALSE;
END;
IF (DEBUG) THEN
KernelLog.String("Loading Slide (image="); KernelLog.String(imgStr^); KernelLog.String(", transition="); KernelLog.String(transStr^); KernelLog.String(")."); KernelLog.Ln;
END;
NEW(slide, imgStr, transStr, dur, descStr);
slides.Add(slide);
END;
IF (slides.GetCount() = 0) THEN
IF (DEBUG) THEN KernelLog.String("Slideshow "); KernelLog.String(" NOT loaded (empty file)."); KernelLog.Ln; END;
RETURN FALSE;
ELSE
RETURN TRUE;
END;
END LoadSlides;
PROCEDURE ErrorReport(pos, line, row: LONGINT; CONST msg: ARRAY OF CHAR);
BEGIN
KernelLog.String("Parse error at pos "); KernelLog.Int(pos, 5); KernelLog.String(" in line "); KernelLog.Int(line, 5);
KernelLog.String(" row "); KernelLog.Int(row, 5); KernelLog.String(" - "); KernelLog.String(msg); KernelLog.Ln;
hasErrors := TRUE
END ErrorReport;
PROCEDURE AddSlide(CONST filename : ARRAY OF CHAR);
VAR
slide : Slide;
BEGIN
NEW(slide, Strings.NewString(filename), Strings.NewString("fade"), 15, Strings.NewString(filename));
slides.Add(slide);
END AddSlide;
PROCEDURE RemoveSlide(i : LONGINT);
BEGIN
slides.RemoveByIndex(i);
END RemoveSlide;
PROCEDURE ClearSlides;
BEGIN
slides.Clear();
END ClearSlides;
END SlideshowData;
VAR
app : SlideshowApp;
PROCEDURE Open*(context : Commands.Context);
VAR dstring : ARRAY 256 OF CHAR;
BEGIN {EXCLUSIVE}
IF (app # NIL) THEN
app.Close();
END;
context.arg.SkipWhitespace; context.arg.String(dstring);
NEW(app, dstring);
END Open;
PROCEDURE Cleanup;
BEGIN
IF (app # NIL) THEN app.Close(); END
END Cleanup;
PROCEDURE LoadImage(CONST name : ARRAY OF CHAR; fmt : Raster.Format): Image;
VAR img : Image;
res, w, h, x : LONGINT;
decoder : Codecs.ImageDecoder;
in : Streams.Reader;
ext : ARRAY 16 OF CHAR;
BEGIN
IF (name = "") THEN RETURN NIL END;
GetExtension(name, ext);
Strings.UpperCase(ext);
decoder := Codecs.GetImageDecoder(ext);
IF (decoder = NIL) THEN
KernelLog.String("No decoder found for "); KernelLog.String(ext); KernelLog.Ln;
RETURN NIL;
END;
in := Codecs.OpenInputStream(name);
IF (in # NIL) THEN
decoder.Open(in, res);
IF (res = 0) THEN
decoder.GetImageInfo(w, h, x, x);
NEW(img);
Raster.Create(img, w, h, fmt);
decoder.Render(img);
NEW(img.key, LEN(name)); COPY(name, img.key^);
END;
END;
RETURN img;
END LoadImage;
PROCEDURE GetExtension (CONST name: ARRAY OF CHAR; VAR ext: ARRAY OF CHAR);
VAR
i, j: LONGINT;
ch: CHAR;
BEGIN
i := 0; j := 0;
WHILE (name[i] # 0X) DO
IF (name[i] = ".") THEN j := i+1 END;
INC(i)
END;
i := 0;
REPEAT
ch := name[j]; ext[i] := ch; INC(i); INC(j)
UNTIL (ch = 0X) OR (i = LEN(ext));
ext[i-1] := 0X
END GetExtension;
BEGIN
Modules.InstallTermHandler(Cleanup)
END WMSlideshow.
(* Testing commands *)
SystemTools.Free WMSlideshow WMTransFade WMTransMask WMTrans ~
SystemTools.Free WMSlideshow~
PC.Compile RetoWMTrans.Mod RetoWMTransMask.Mod RetoWMTransFade.Mod RetoWMSlideshow.Mod~
WMSlideshow.Open ~
WMSlideshow.Open RetoWMSlideshow.XML~