1
2(********************************************************************)
3(*                                                                  *)
4(*  pv7.sd7       Picture viewer for several graphic formats.       *)
5(*  Copyright (C) 2021  Thomas Mertes                               *)
6(*                                                                  *)
7(*  This program is free software; you can redistribute it and/or   *)
8(*  modify it under the terms of the GNU General Public License as  *)
9(*  published by the Free Software Foundation; either version 2 of  *)
10(*  the License, or (at your option) any later version.             *)
11(*                                                                  *)
12(*  This program is distributed in the hope that it will be useful, *)
13(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
14(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
15(*  GNU General Public License for more details.                    *)
16(*                                                                  *)
17(*  You should have received a copy of the GNU General Public       *)
18(*  License along with this program; if not, write to the           *)
19(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
20(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
21(*                                                                  *)
22(********************************************************************)
23
24
25$ include "seed7_05.s7i";
26  include "imagefile.s7i";
27  include "osfiles.s7i";
28  include "time.s7i";
29  include "duration.s7i";
30  include "console.s7i";
31  include "draw.s7i";
32  include "stdfont24.s7i";
33
34
35const proc: writeMessage (in string: message) is func
36
37  local
38    var text: screen is text.value;
39  begin
40    clear(curr_win, black);
41    rect((width(curr_win) - width(stdFont24, message)) div 2 - 50,
42         height(curr_win) div 2 - 50,
43         width(stdFont24, message) + 100, 100, white);
44    screen := openPixmapFontFile(curr_win);
45    color(screen, black, white);
46    setFont(screen, stdFont24);
47    setPosXY(screen, (width(curr_win) - width(stdFont24, message)) div 2,
48             (height(curr_win) + capHeight(stdFont24)) div 2);
49    write(screen, message);
50  end func;
51
52
53const func boolean: hasImageExtension (in var string: fileName) is func
54  result
55    var boolean: hasImageExtension is FALSE;
56  begin
57    fileName := lower(fileName);
58    hasImageExtension := endsWith(fileName, ".png") or
59                         endsWith(fileName, ".gif") or
60                         endsWith(fileName, ".jpeg") or
61                         endsWith(fileName, ".jpg") or
62                         endsWith(fileName, ".ppm") or
63                         endsWith(fileName, ".bmp") or
64                         endsWith(fileName, ".ico");
65  end func;
66
67
68const proc: nextImageFile (in array string: fileList, inout integer: index) is func
69  begin
70    if index <= length(fileList) then
71      repeat
72        incr(index);
73      until index > length(fileList) or hasImageExtension(fileList[index]);
74    end if;
75  end func;
76
77
78const proc: previousImageFile (in array string: fileList, inout integer: index) is func
79  begin
80    if index >= 1 then
81      repeat
82        decr(index);
83      until index < 1 or hasImageExtension(fileList[index]);
84    end if;
85  end func;
86
87
88const proc: findFileWithName (in array string: fileList, in string: fileName, inout integer: index) is func
89  begin
90    index := 1;
91    while index <= length(fileList) and fileList[index] <> fileName do
92      incr(index);
93    end while;
94    if index > length(fileList) then
95      index := 0;
96    end if;
97  end func;
98
99
100const proc: displayImage (in PRIMITIVE_WINDOW: pixmap) is func
101  local
102    var integer: width is 0;
103    var integer: height is 0;
104    var integer: border is 0;
105  begin
106    if width(curr_win) * height(pixmap) >= width(pixmap) * height(curr_win) then
107      width := width(pixmap) * height(curr_win) div height(pixmap);
108      border := (width(curr_win) - width) div 2;
109      put(curr_win, border, 0, width, height(curr_win), pixmap);
110      rect(curr_win, 0, 0, border, height(curr_win), black);
111      rect(curr_win, border + width, 0, width(curr_win) - border - width, height(curr_win), black);
112    else
113      height := height(pixmap) * width(curr_win) div width(pixmap);
114      border := (height(curr_win) - height) div 2;
115      put(curr_win, 0, border, width(curr_win), height, pixmap);
116      rect(curr_win, 0, 0, width(curr_win), border, black);
117      rect(curr_win, 0, border + height, width(curr_win), height(curr_win) - border - height, black);
118    end if;
119  end func;
120
121
122const proc: main is func
123  local
124    var array string: fileList is 0 times "";
125    var integer: index is 0;
126    var file: imageFile is STD_NULL;
127    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
128    var boolean: commandPresent is FALSE;
129    var char: command is ' ';
130  begin
131    screen(1024, 688);
132    selectInput(curr_win, KEY_RESIZE, TRUE);
133    clear(curr_win, black);
134    flushGraphic;
135    KEYBOARD := GRAPH_KEYBOARD;
136    OUT := STD_CONSOLE;
137    fileList := readDir(getcwd);
138    if length(argv(PROGRAM)) >= 1 then
139      findFileWithName(fileList, argv(PROGRAM)[1], index);
140      if index = 0 or not hasImageExtension(fileList[index]) then
141        nextImageFile(fileList, index);
142      end if;
143    else
144      nextImageFile(fileList, index);
145    end if;
146    repeat
147      command := KEY_NONE;
148      if index < 1 then
149        setWindowName(curr_win, "Start");
150        writeMessage("Start");
151      elsif index > length(fileList) then
152        setWindowName(curr_win, "End");
153        writeMessage("End");
154      else
155        setWindowName(curr_win, fileList[index]);
156        imageFile := open(fileList[index], "r");
157        if imageFile <> STD_NULL then
158          # writeln(fileList[index]);
159          pixmap := readImage(imageFile);
160          close(imageFile);
161          command := KEY_RESIZE;
162          repeat
163            if command = KEY_RESIZE then
164              if pixmap <> PRIMITIVE_WINDOW.value then
165                displayImage(pixmap);
166              else
167                writeMessage("Error reading " <& fileList[index]);
168              end if;
169              flushGraphic;
170            else
171              await(time(NOW) + 30000 . MICRO_SECONDS);
172            end if;
173            command := busy_getc(KEYBOARD);
174          until command <> KEY_NONE and command <> KEY_RESIZE;
175          commandPresent := TRUE;
176        else
177          writeMessage("Cannot open: " <& fileList[index]);
178        end if;
179      end if;
180      repeat
181        if not commandPresent then
182          command := getc(KEYBOARD);
183        end if;
184        if command = KEY_MOUSE1 or command = KEY_NL or command = KEY_TAB or command = KEY_RIGHT then
185          nextImageFile(fileList, index);
186        elsif command = KEY_MOUSE3 or command = KEY_BACKTAB or command = KEY_LEFT then
187          previousImageFile(fileList, index);
188        end if;
189        commandPresent := FALSE;
190      until not keypressed(KEYBOARD);
191    until lower(command) = 'q' or command = KEY_ESC;
192  end func;
193