1. Some useful routines [LONG]
(Continued from previous message)
radius * sin(int_angle) + center[Y]}
circ_points = append(circ_points,newpoint)
end for
polygon(colr,fill,circ_points)
end procedure
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-- sets.e
-- implements a generic set type for Euphoria.
-- set type - just a sequence, including an empty one
global type set(sequence s)
return 1
end type
-- s = set_incl(s,o) - includes object o as element of s.
global function set_incl(set s, object o)
integer found
if s = {} then
return {o}
end if
found = find(o,s)
if not found then
return append(s,o)
else
return s
end if
end function
-- s = set_excl(s,o) - excludes object o from set s
global function set_excl(set s, object o)
integer found
found = find(o,s)
if found then
return s[1..found-1] & s[found+1..length(s)]
else
return s
end if
end function
-- s = set_union(s1,s2) - returns set of all elements from either set
global function set_union(set s1, set s2)
set newset
newset = s1
for i = 1 to length(s2) do
newset = set_incl(newset,s2[i])
end for
return newset
end function
-- b = set_member(s,o) - returns 1 (true) if o is a member of s
global function set_member(set s, object o)
return (find(o,s) != 0)
end function
-- b = set_empty(s) - returns 1 (true) if set is empty (no members)
global function set_empty(set s)
return (length(s) = 0)
end function
-- s = set_intersection(s1, s2) - return set of elements in both sets
global function set_intersection(set s1, set s2)
set newset
newset = {}
for i = 1 to length(s1) do
if set_member(s2,s1[i]) then
newset = set_incl(newset,s1[i])
end if
end for
return newset
end function
-- s = set_difference(s1, s2) - return elements of s1 not in s2.
global function set_difference(set s1, set s2)
set newset
newset = {}
for i = 1 to length(s1) do
if not set_member(s2,s1[i]) then
newset = set_incl(newset,s1[i])
end if
end for
return newset
end function
-- s = set_symmdiff(s1, s2) returns elements of both s1 and s2 that are not
-- in both.
global function set_symmdiff(set s1, set s2)
set union
set intersect
set newset
union = set_union(s1, s2)
intersect = set_intersection(s1, s2)
newset = set_difference(union, intersect)
return newset
end function
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
...more to come....
=========================================================================
Jeff Zeitlin jeff.zeitlin at execnet.com
---
~ OLXWin 1.00b ~ I used to have a handle on life, then it broke.
2. Some useful routines [LONG]
Based on some of the remarks that were made in response to my
suggestion to extend the Euphoria slice mechanism, I got to
thinking about just how flexible Euphoria is. To prove it to
myself, I came up with a whole bunch of useful routines. I've
included them here. Most of them have sufficient comments to
make any additional comments superfluous; those that aren't,
I've added comments as appropriate.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-- stddefs.e
-- Standard definitions for general use
-- bool type - FALSE and TRUE
global constant bFALSE=0
global constant bTRUE=1
global type bool(integer b)
return b=bFALSE or b=bTRUE
end type
-- standard file handles
global constant STD_IN=0
global constant STD_OUT=1
global constant STD_ERR=2
-- errorexit - prints message and exits, setting exit code.
global procedure errorexit(integer exitcode, sequence msg)
puts(STD_ERR, msg)
abort(exitcode)
end procedure
-- xslice - extended slices - allows discontinuous subscripts
global function xslice(sequence var, sequence subscripts)
sequence result
result = {}
for i = 1 to length(subscripts) do
if subscripts[i] > length(var) then
errorexit(1,"Invalid subscript in extended slice.\n")
end if
result = append(result,var[subscripts[i]])
end for
return result
end function
-- trim function - returns string stripped of leading and trailing spaces
global function trim(sequence s)
sequence t
if length(s)=0 then
return s
end if
t = s
while (t[1]=' ') or (t[1]='\t') or (t[1]='\n') or (t[1]='\r') do
t = t[2..length(t)]
if length(t)=0 then
return t
end if
end while
while (t[length(t)]=' ') or (t[length(t)]='\t') or
(t[length(t)]='\n') or (t[length(t)]='\r') do
t = t[1..length(t)-1]
if length(t)=0 then
return t
end if
end while
return t
end function
-- left - returns leftmost slice of length i of a string
global function left(sequence s, integer i)
if i > length(s) then
errorexit(1,"Can't slice more than the whole thing.\n")
end if
return s[1..i]
end function
-- right - returns rightmost slice of length i of a string
global function right(sequence s, integer i)
if i > length(s) then
errorexit(1,"Can't slice more than the whole thing.\n")
end if
return s[length(s)-i+1..length(s)]
end function
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-- cmdline.e - provides enhanced command line processing
-- Jeff Zeitlin (jeff.zeitlin at execnet.com)
-- switch processing - switches are case-sensitive; i.e., /s != /S
-- switch(object s)
-- Is there a switch s on the command line?
-- Accepts either /s or -s as valid switch.
-- Returns 0 for no switch, param # if exists
-- switchval(object s, integer valrequired)
-- returns sequence containing one of:
-- switch /s not present: 0 (atom)
-- switch /s present: param # (atom)
-- valrequired = 1:
-- switch of form /sx: x as sequence (text)
-- switch of form /s x: x as sequence (text)
-- switch not present: 0 (atom)
-- valrequired = 0
-- switch of form /sx: x as sequence (text)
-- switch of form /s x: param # (x may != value) (atom)
-- switch not present: 0 (atom)
-- leading character of switch may be - or /
global function switch(object s)
sequence cmdline
sequence sw1, sw2
integer found, i
cmdline = command_line()
sw1 = "/" & s
sw2 = "-" & s
found = 0
i = 1
while (not found) and (i <= length(cmdline)) do
found = (match(sw1,cmdline[i]) = 1) or (match(sw2,cmdline[i]) = 1)
if found then
return i
else
i = i + 1
end if
end while
return found
end function
global function switchval(object s, integer required)
sequence cmdline
sequence val
integer i
cmdline = command_line()
i = switch(s)
if i = 0 then
return 0
else
val = cmdline[i][length(s)+2..length(cmdline[i])]
if required then
if compare(val,{}) = 0 then
val = cmdline[i+1]
end if
else
if compare(val,{}) = 0 then
return i
end if
end if
end if
return val
end function
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-- extgraph.e - extended graphics routines for Euphoria
-- Jeff Zeitlin (jeff.zeitlin at execnet.com)
-- builds on routines in graphics.e
include graphics.e
-- regular_polygon
-- draws an n-sided polygon with all sides and angles equal.
-- user specifies center location, radius, and rotation angle;
-- regular_polygon computes the points and calls polygon.
-- an angle of zero places a corner directly to the right on
-- a horizontal line with the center point (i.e., a square is
-- displayed as a diamond, rotated 45 degrees).
constant pi = 3.141592653585
constant X = 1
constant Y = 2
global procedure regular_polygon(sequence center,-- {x,y} center of polygon
integer sides, -- number of sides
integer radius, -- size corner-to-center
atom angle, -- clockwise rotation (radians)
integer colr, -- color to draw/fill
integer fill) -- fill in with color?
sequence circ_points
atom int_angle
atom angle_incr
sequence newpoint
circ_points = {}
angle_incr = 2 * pi / sides
for i = 0 to sides do
int_angle = angle_incr * i + angle
newpoint = {radius * cos(int_angle) + center[X],
(Continued to next message)
---
~ OLXWin 1.00b ~ I used to have a handle on life, then it broke.
