$ include "seed7_05.s7i";
include "imagefile.s7i";
include "osfiles.s7i";
include "time.s7i";
include "duration.s7i";
include "console.s7i";
include "draw.s7i";
include "stdfont24.s7i";
const proc: writeMessage (in string: message) is func
local
var text: screen is text.value;
begin
clear(curr_win, black);
rect((width(curr_win) - width(stdFont24, message)) div 2 - 50,
height(curr_win) mdiv 2 - 50,
width(stdFont24, message) + 100, 100, white);
screen := openPixmapFontFile(curr_win);
color(screen, black, white);
setFont(screen, stdFont24);
setPosXY(screen, (width(curr_win) - width(stdFont24, message)) div 2,
(height(curr_win) + capHeight(stdFont24)) div 2);
write(screen, message);
end func;
const proc: nextImageFile (in string: dirPath, in array string: fileList, inout integer: index) is func
begin
if index <= length(fileList) then
repeat
incr(index);
until index > length(fileList) or hasImageExtension(dirPath & fileList[index]);
end if;
end func;
const proc: previousImageFile (in string: dirPath, in array string: fileList, inout integer: index) is func
begin
if index >= 1 then
repeat
decr(index);
until index < 1 or hasImageExtension(dirPath & fileList[index]);
end if;
end func;
const proc: findFileWithName (in array string: fileList, in string: fileName, inout integer: index) is func
begin
index := 1;
while index <= length(fileList) and fileList[index] <> fileName do
incr(index);
end while;
if index > length(fileList) then
index := 0;
end if;
end func;
const type: sectionData is new struct
var float: left is 0.0;
var float: upper is 0.0;
var float: width is 0.0;
var float: height is 0.0;
end struct;
const proc: displayImage (in PRIMITIVE_WINDOW: pixmap, inout sectionData: section) is func
local
var integer: width is 0;
var integer: height is 0;
var integer: border is 0;
begin
if width(curr_win) * height(pixmap) >= width(pixmap) * height(curr_win) then
width := width(pixmap) * height(curr_win) mdiv height(pixmap);
border := (width(curr_win) - width) mdiv 2;
put(curr_win, border, 0, width, height(curr_win), pixmap);
rect(curr_win, 0, 0, border, height(curr_win), black);
rect(curr_win, border + width, 0, width(curr_win) - border - width, height(curr_win), black);
section.width := float(height(pixmap) * width(curr_win)) / float(height(curr_win));
section.height := float(height(pixmap));
section.left := (float(width(pixmap)) - section.width) / 2.0;
section.upper := 0.0;
else
height := height(pixmap) * width(curr_win) mdiv width(pixmap);
border := (height(curr_win) - height) mdiv 2;
put(curr_win, 0, border, width(curr_win), height, pixmap);
rect(curr_win, 0, 0, width(curr_win), border, black);
rect(curr_win, 0, border + height, width(curr_win), height(curr_win) - border - height, black);
section.width := float(width(pixmap));
section.height := float(width(pixmap) * height(curr_win)) / float(width(curr_win));
section.left := 0.0;
section.upper := (float(height(pixmap)) - section.height) / 2.0;
end if;
end func;
const proc: move (in PRIMITIVE_WINDOW: pixmap, inout sectionData: section) is func
local
var integer: oldXPos is 0;
var integer: oldYPos is 0;
var integer: newXPos is 0;
var integer: newYPos is 0;
var PRIMITIVE_WINDOW: sectionToCopy is PRIMITIVE_WINDOW.value;
begin
oldXPos := pointerXPos(curr_win);
oldYPos := pointerYPos(curr_win);
repeat
newXPos := pointerXPos(curr_win);
newYPos := pointerYPos(curr_win);
if newXPos <> oldXPos or newYPos <> oldYPos then
section.left +:= (float(oldXPos - newXPos) * section.width) / float(width(curr_win));
section.upper +:= (float(oldYPos - newYPos) *section.height) / float(height(curr_win));
oldXPos := newXPos;
oldYPos := newYPos;
sectionToCopy := getPixmap(pixmap, round(section.left), round(section.upper),
round(section.width), round(section.height),
width(curr_win), height(curr_win), black);
put(curr_win, 0, 0, sectionToCopy);
flushGraphic;
end if;
wait(30000 . MICRO_SECONDS);
until inputReady(KEYBOARD) or not buttonPressed(KEYBOARD, KEY_MOUSE1);
end func;
const proc: zoomIn (in PRIMITIVE_WINDOW: pixmap, inout sectionData: section) is func
local
var float: destXPos is 0.0;
var float: destYPos is 0.0;
var float: sectionXPos is 0.0;
var float: sectionYPos is 0.0;
var PRIMITIVE_WINDOW: sectionToCopy is PRIMITIVE_WINDOW.value;
begin
if section.width >= 5.0 and section.height >= 5.0 then
destXPos := float(clickedXPos(KEYBOARD));
destYPos := float(clickedYPos(KEYBOARD));
sectionXPos := section.left + (destXPos * section.width) / float(width(curr_win));
sectionYPos := section.upper + (destYPos *section.height) / float(height(curr_win));
section.left := sectionXPos - ((sectionXPos - section.left) * 9.0) / 10.0;
section.upper := sectionYPos - ((sectionYPos - section.upper) * 9.0) / 10.0;
section.width := (section.width * 9.0) / 10.0;
section.height := (section.height * 9.0) / 10.0;
sectionToCopy := getPixmap(pixmap, round(section.left), round(section.upper),
round(section.width), round(section.height),
width(curr_win), height(curr_win), black);
put(curr_win, 0, 0, sectionToCopy);
flushGraphic;
end if;
end func;
const proc: zoomOut (in PRIMITIVE_WINDOW: pixmap, inout sectionData: section) is func
local
var float: destXPos is 0.0;
var float: destYPos is 0.0;
var float: sectionXPos is 0.0;
var float: sectionYPos is 0.0;
var PRIMITIVE_WINDOW: sectionToCopy is PRIMITIVE_WINDOW.value;
begin
if section.width <= 1.0e9 and section.height <= 1.0e9 then
destXPos := float(clickedXPos(KEYBOARD));
destYPos := float(clickedYPos(KEYBOARD));
sectionXPos := section.left + (destXPos * section.width) / float(width(curr_win));
sectionYPos := section.upper + (destYPos * section.height) / float(height(curr_win));
section.left := sectionXPos - ((sectionXPos - section.left) * 10.0) / 9.0;
section.upper := sectionYPos - ((sectionYPos - section.upper) * 10.0) / 9.0;
section.width := (section.width * 10.0) / 9.0;
section.height := (section.height * 10.0) / 9.0;
sectionToCopy := getPixmap(pixmap, round(section.left), round(section.upper),
round(section.width), round(section.height),
width(curr_win), height(curr_win), black);
put(curr_win, 0, 0, sectionToCopy);
flushGraphic;
end if;
end func;
const proc: main is func
local
var string: fileName is "";
var integer: slashPos is 0;
var string: dirPath is "";
var array string: fileList is 0 times "";
var integer: index is 0;
var file: imageFile is STD_NULL;
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
var boolean: commandPresent is FALSE;
var char: command is ' ';
var sectionData: section is sectionData.value;
begin
screen(1024, 688);
selectInput(curr_win, KEY_RESIZE, TRUE);
clear(curr_win, black);
flushGraphic;
KEYBOARD := GRAPH_KEYBOARD;
OUT := STD_CONSOLE;
if length(argv(PROGRAM)) >= 1 then
fileName := convDosPath(argv(PROGRAM)[1]);
if fileType(fileName) = FILE_DIR then
dirPath := fileName & "/";
fileList := readDir(fileName);
else
slashPos := rpos(fileName, '/');
if slashPos <> 0 then
if slashPos = 1 then
dirPath := "/";
fileList := readDir("/");
else
dirPath := fileName[.. slashPos];
fileList := readDir(fileName[.. pred(slashPos)]);
end if;
fileName := fileName[succ(slashPos) ..];
else
dirPath := getcwd & "/";
fileList := readDir(getcwd);
end if;
findFileWithName(fileList, fileName, index);
end if;
else
dirPath := getcwd & "/";
fileList := readDir(getcwd);
end if;
if index = 0 or not hasImageExtension(dirPath & fileList[index]) then
nextImageFile(dirPath, fileList, index);
end if;
repeat
command := KEY_NONE;
if index < 1 then
setWindowName(curr_win, "Start");
writeMessage("Start");
elsif index > length(fileList) then
setWindowName(curr_win, "End");
writeMessage("End");
else
setWindowName(curr_win, fileList[index]);
imageFile := open(dirPath & fileList[index], "r");
if imageFile <> STD_NULL then
pixmap := readImage(imageFile);
close(imageFile);
command := KEY_RESIZE;
repeat
if command = KEY_RESIZE then
if pixmap <> PRIMITIVE_WINDOW.value then
displayImage(pixmap, section);
else
writeMessage("Error reading " <& fileList[index]);
end if;
flushGraphic;
elsif command = KEY_MOUSE1 and pixmap <> PRIMITIVE_WINDOW.value then
move(pixmap, section);
elsif command = KEY_MOUSE4 and pixmap <> PRIMITIVE_WINDOW.value then
zoomIn(pixmap, section);
elsif command = KEY_MOUSE5 and pixmap <> PRIMITIVE_WINDOW.value then
zoomOut(pixmap, section);
end if;
command := getc(KEYBOARD);
until command <> KEY_RESIZE and command <> KEY_MOUSE1 and
command <> KEY_MOUSE4 and command <> KEY_MOUSE5;
commandPresent := TRUE;
else
writeMessage("Cannot open: " <& fileList[index]);
end if;
end if;
repeat
if not commandPresent then
command := getc(KEYBOARD);
end if;
if command = KEY_MOUSE3 or command = KEY_MOUSE_FWD or
command = KEY_NL or command = KEY_TAB or command = KEY_RIGHT then
nextImageFile(dirPath, fileList, index);
elsif command = KEY_MOUSE2 or command = KEY_MOUSE_BACK or
command = KEY_BACKTAB or command = KEY_LEFT then
previousImageFile(dirPath, fileList, index);
end if;
commandPresent := FALSE;
until not inputReady(KEYBOARD);
until lower(command) = 'q' or command = KEY_ESC;
end func;