OpenEuphoria

Re: ***release***

• Posted by Matt Z Nunyabidness <matt1421 at JUNO.COM> Sep 25, 1998
• 556 views

sure! more versions to come:
--                      --------------------------------
--                      --**functions and procedures**--
--                      --------------------------------
-- I collected these functions and procedure from the euphoria mailing
-- list, which you can subscribe to by Mailing a message to
-- listserv at miamiu.acs.muohio.edu saying:
-- SUBSCRIBE EUPHORIA ANONYMOUS
-- If you want to unsubscribe, send another message to
-- listserv at miamiu.acs.muohio.edu saying SIGNOFF EUPHORIA
-- there, you will find flamers, programmers, hypocrites, band-width
eaters,
-- and newbies.
-- O, and BTW. Some of these i made
include image.e
include graphics.e
include get.e
include machine.e
constant ERR=2
object vc
global object ver,maj,min
global procedure cls()
vc=video_config()
for a=  1 to vc[3] do --the third argument supplies the ammount of lines
puts(1,"\n")
position(1,1)
end for
end procedure
    --Tim Jiri's trim function from the thread
    global function trim(sequence s)
      -- trim 'white space' from both ends of string s
      -- 'short-circuit' optimized
      integer c,i,j,len
        len=length(s)
        i=1
      while i<=len do
        c=s[i]
        if c=32 then i=i+1
        elsif c=10 then i=i+1
        elsif c=13 then i=i+1
        elsif c=9 then i=i+1
        else exit end if
      end while
      j=len
      while j>=i do
        c=s[j]
        if c=32 then j=j-1
        elsif c=10 then j=j-1
        elsif c=13 then j=j-1
        elsif c=9 then j=j-1
        else exit end if
      end while
      return s[i..j]
    end function
--I made this one.
--Variables: x and y: where to display the image
--filename: the picture to display
global procedure bmpview(object filename, integer x, integer y)
-- declare variables
integer mode
object source,pal,pixels
-- trim white space from the filename
filename=trim(filename)
-- read the bitmap
source=read_bitmap(filename)
-- seperate the palette from the rest of the picture
pal=source[1]
-- scale the palette
pal=pal/4
-- get the picture
pixels=source[2]
if length(pal)>16 then
mode=257 -- works on some computers
else
mode=18 -- works on all computers
end if
if graphics_mode(mode) then
end if
all_palette(pal) -- set the palette
display_image({x,y},pixels) -- finally, display the picture at x,y
end procedure
global procedure txtshow(object fname)
--txtshow.ex by Ralf
--[Variables]

    sequence arg, image
    integer fhandle

--[Getting filename]

    arg = fname
    if arg="" then
      puts (1,"\nFileName: ")
      fname = trim(gets(0))
    end if

--[Opening file for input]

    fhandle = open (fname, "r")
    if fhandle = -1 then
      puts (1, "File IO error!\n")
      abort (3)
    end if

--[Loading & showing textimage]

    image = get (fhandle)
    if image[1] = GET_EOF then
        puts (1, "Unexpected end of file!\n")
        abort (1)
    elsif image[1] = GET_FAIL then
        puts (1, "This file does not contain a valid text image!\n")
        abort (2)
    end if
    display_text_image({1,1}, image[2])
if wait_key() then
end if
--object pos
--pos=get_position()
position(23,1)
--[Finished]

    close (fhandle) -- Cleaner, but Ex.exe would have closed it anyway.
end procedure
global procedure discard(object trash)
if compare(trash,"") then
end if
end procedure
global function version(integer flag)
sequence reg_list -- list of register values

reg_list = repeat(0, 10)
reg_list[REG_AX] = #3000   -- function: AH = #30 ==> Get MS-DOS Version
Number

reg_list = dos_interrupt(#21, reg_list) -- Call DOS interrupt #21

if remainder(reg_list[REG_FLAGS], 2) then
    puts(ERR, "Problem with Get DOS version interrupt\n")
end if
maj=remainder(reg_list[REG_AX], #100)
min=floor(reg_list[REG_AX] / #100)
ver=maj&"."&min
if flag>0 then
puts(1,"You are running DOS ")
printf(1,"%d.%d",{maj,min})
end if
return ver
end function



-------------------------------------
When it comes to programming languages, Euphoria is a cut above -
matt1278 at juno.com and matt1421 at juno.com(and soon to be
irisnmatt at prodigy.net. Then again, maybe not) Euphoria programmer

___________________________________________________________________
You don't need to buy Internet access to use free Internet e-mail.
Get completely free e-mail from Juno at http://www.juno.com
Or call Juno at (800) 654-JUNO [654-5866]