OpenEuphoria

BMP & TGA image displayer

• Posted by Hawke <mdeland at NWINFO.NET> Nov 05, 1998
• 795 views

i've seen several people hammering away and having
problems creating (especially) bmp viewers...
so, i created this little program that will
load and display bmp & targa images, easily.

take a look, some of the code in here may help you,
and it is a good demo of the trueEU library as well...

it's also kinda handy once you bind it and put it on
your path...

enjoy--Hawke'


----------------CUTLINE--------------------
include truecolr.e

constant USAGE={
        "SHOW: A reader/viewer for up to 256 color BMP's",
        "      and 24bit uncompressed TARGA (.TGA) images.",
        "      Created using TrueEU, by Hawke'",
        " ",
        "USAGE:",
        "show /b filename filename...etc",
        "   this will display .BMP files, autoappending .BMP",
        " ",
        "show /t filename filename...etc",
        "   this will display .TGA files, autoappending .TGA",
        " ",
        "show filename.ext filename.ext...etc",
        "   this won't autoappend the extension, usefull",
        "   when you want to see a mix of BMP and TGA pics"}

constant
        BMP      = ".bmp",
        TGA      = ".tga",
        OPT_BMP  = "/b",   --OPTion_BMP
        OPT_TGA  = "/t",   --OPTion_TarGA
        OPT_HLP  = "/h",   --OPTion_HeLP (technically unneeded)
        DO_BMP   = 1,
        DO_TGA   = 2,
        DO_MIX   = 3,
        TO_LOWER = 'a' - 'A'

sequence command, filename, current
object junk

-------------------------------FUNC/PROC
function StripLeft(sequence data)
--if you dunno wot dis does, fer shame ;)
   return data[2..length(data)]
end function
----------------------------------------
function lower(object x)
--convert atom or sequence to lower case
    return x + (x >= 'A' and x <= 'Z') * TO_LOWER
end function
----------------------------------------
function upper(object x)
-- convert atom or sequence to upper case
    return x - (x >= 'a' and x <= 'z') * TO_LOWER
end function
----------------------------------------
procedure ShowUSAGE()
   if InTruMode() then ExitTruMode() end if
   text_color(BLUE)
   for i=1 to length(USAGE) do
       puts(1,USAGE[i] & "\n")
   end for
   text_color(WHITE)
   puts(1," \n") --to reset dos to white
   abort(1)
end procedure
----------------------------------------
procedure ShowTGA(sequence fname)
object temp
   temp = read_targa(fname)     --this will autoerror...
   --we wait until as much as possible has been checked before
   --flipping screen modes... BUT! we may have been here already...
   if not InTruMode() then InitDisplay() end if
   set_virtual_screen(ORIGIN,{},temp)
   free(temp)                   --DON'T FORGET TO FREE()!
end procedure
----------------------------------------
procedure ShowBMP(sequence fname)
object temp
   --you may ask why not use display_true_image?
   --this is a 'cleaner' displaying of an image, less... flicker?
   --it may actually be *faster* too, cuz disp_tru_img calls
   --true_pixel *abunch*, but set_virt_scr slaps it up all at once
   --lastly, it closely mimics ShowTGA, and helps those new to
   --trueEU develop the habit of using virtual screens.

   temp = read_bitmap(fname)    --this will not autoerror...
   if atom(temp) then           --so we Error() ourselves
      if    temp = BMP_OPEN_FAILED        then
            Error("BMP_OPEN_FAILED: file not found?")
      elsif temp = BMP_UNEXPECTED_EOF     then
            Error("BMP_UNEXPECTED_EOF")
      elsif temp = BMP_UNSUPPORTED_FORMAT then
            Error("BMP_UNSUPPORTED_FORMAT")
      end if
   end if
   temp = convert_bitmap(temp)  --isn't this easier than all that
   temp = bitmap2virtual(temp)  --palette nonsense???

   --we wait until as much as possible has been checked before
   --flipping screen modes... BUT! we may have been here already...
   if not InTruMode() then InitDisplay() end if
   set_virtual_screen(ORIGIN,{},temp)
   free(temp)                   --DON'T FORGET TO FREE()!

end procedure
----------------------------------------
procedure ShowMIX(sequence fname)
object dot, ext, len
   len = length(fname)
   dot = find('.',fname)
   if dot <= 1 then ShowUSAGE() end if --can't be first, or missing

   ext = fname[dot..len] --ext is 'extension'...
   if length(ext) < 4 then ShowUSAGE() end if  --extension to short

   if    IsSame(ext,BMP) then ShowBMP(fname)
   elsif IsSame(ext,TGA) then ShowTGA(fname)
   else  ShowUSAGE() --cuz they typed some kinda wierdness...
   end if            --but, i do wonder about longfilenames here...
end procedure
----------------------------------------
procedure SlideShow(sequence list,integer case)
   if length(list) then
        for i = 1 to length(list) do
           if    case = DO_BMP then ShowBMP(list[i] & BMP)
           elsif case = DO_TGA then ShowTGA(list[i] & TGA)
           elsif case = DO_MIX then ShowMIX(list[i])
           --and how we would get to this next line... hrm...
           else  Error("Sumfin is *real* wrong here...")
           end if
           if wait_key() then end if
        end for
   else ShowUSAGE() --cuz they forgot to type a filename
   end if
end procedure
----------------------------------------


----------------------------------MAIN

command = command_line()
if length(command)<3 then
   ShowUSAGE() --cuz they didn't type squat
end if

command = StripLeft(command) --ex.exe
command = StripLeft(command) --show.ex
command = lower(command)

   current = command[1]

   if    IsSame(current,OPT_BMP) then
         command = StripLeft(command)
         SlideShow(command,DO_BMP)

   elsif IsSame(current,OPT_TGA) then
         command = StripLeft(command)
         SlideShow(command,DO_TGA)

   elsif IsSame(current,OPT_HLP) then
         ShowUSAGE()

   else  SlideShow(command,DO_MIX)
   end if

GoodBye()

------------------------------CUTLINE----------------------