POINT Software Programming/PPROG1.ISO/misc/euphoria/graphics.e

Text File | 1994-01-12 | 5.4 KB | 199 lines

        -------------------------------------
        -- Graphics & Sound: MSDOS version --
        -------------------------------------

--    GRAPHICS MODES --  argument to graphics_mode()

--   -1  restore to original default mode
--    0  40 x 25 text, 16 grey
--    1  40 x 25 text, 16/8 color
--    2  80 x 25 text, 16 grey
--    3  80 x 25 text, 16/8 color
--    4  320 x 200, 4 color
--    5  320 x 200, 4 grey
--    6  640 x 200, BW
--    7  80 x 25 text, BW
--   11  720 x 350, BW
--   13  320 x 200, 16 color
--   14  640 x 200, 16 color
--   15  640 x 350, BW
--   16  640 x 350, 4 or 16 color
--   17  640 x 480, BW
--   18  640 x 480, 16 color
--   19  320 x 200, 256 color
--  256  640 x 400, 256 color
--  257  640 x 480, 256 color
--  258  800 x 600, 16 color
--  259  800 x 600, 256 color
--  260  1024 x 768, 16 color
--  261  1024 x 768, 256 color

-- COLOR values -- for characters and pixels
--
--   0   black          8   gray
--   1   blue           9   light blue
--   2   green         10   light green
--   3   cyan          11   light cyan
--   4   red           12   light red
--   5   magenta       13   light magenta
--   6   brown         14   yellow
--   7   white         15   bright white

--   add 16 to get blinking text

-- machine() commands
constant M_SOUND          = 1,
     M_LINE           = 2,
     M_PALETTE        = 3,
     M_PIXEL          = 4,
     M_GRAPHICS_MODE  = 5,
     M_CURSOR         = 6,
     M_WRAP           = 7,
     M_SCROLL         = 8,
     M_SET_T_COLOR    = 9,
     M_SET_B_COLOR    = 10,
     M_POLYGON        = 11,
     M_TEXTROWS       = 12,
     M_VIDEO_CONFIG   = 13,
     M_ELLIPSE        = 18,
     M_GET_PIXEL      = 21

type mode(integer x)
    return (x >= -3 and x <= 19) or (x >= 256 and x <= 261)
end type

type color(integer x)
    return x >= 0 and x <= 255
end type

type boolean(integer x)
    return x = 0 or x = 1
end type

type positive_int(integer x)
    return x >= 1
end type

type point(sequence x)
    return length(x) = 2
end type

type point_sequence(sequence x)
    return length(x) >= 2
end type

global procedure draw_line(color c, point_sequence xyarray)
-- draw a line connecting the 2 or more points
-- in xyarray: {{x1, y1}, {x2, y2}, ...}
-- using a certain color
-- (the width parameter of v1.0 has been dropped)
    machine_proc(M_LINE, {c, 0, xyarray})
end procedure

global procedure polygon(color c,
             boolean fill,
             point_sequence xyarray)
-- draw a polygon using a certain color
-- fill the area if fill is TRUE
-- 3 or more vertices are given in xyarray
-- (the width parameter of v1.0 has been dropped)
    machine_proc(M_POLYGON, {c, fill, xyarray})
end procedure

global procedure ellipse(color c, boolean fill, point p1, point p2)
-- draw an ellipse with a certain color that fits in the
-- rectangle defined by diagonal points p1 and p2, i.e.
-- {x1, y1} and {x2, y2}. The ellipse may be filled or just an outline.
    machine_proc(M_ELLIPSE, {c, fill, p1, p2})
end procedure

global procedure pixel(color c, point p)
-- set a pixel to a certain color
    machine_proc(M_PIXEL, {c, p})
end procedure

global function get_pixel(point p)
-- read color number of a pixel on the screen
    return machine_func(M_GET_PIXEL, p)
end function

global function graphics_mode(mode m)
-- try to set up a new graphics mode
-- return 0 if successful, non-zero if failed
   return machine_func(M_GRAPHICS_MODE, m)
end function

global constant VC_COLOR = 1,
        VC_MODE  = 2,
        VC_LINES = 3,
        VC_COLUMNS = 4,
        VC_XPIXELS = 5,
        VC_YPIXELS = 6,
        VC_NCOLORS = 7
global function video_config()
-- return sequence of information on video configuration
-- {color?, mode, text lines, text columns, xpixels, ypixels, #colors}
    return machine_func(M_VIDEO_CONFIG, 0)
end function

-- cursor styles:
global constant NO_CURSOR  = 8192,
     UNDERLINE_CURSOR  = 1543,
     BLOCK_CURSOR      = 7,
     HALF_BLOCK_CURSOR = 1031

global procedure cursor(integer style)
-- choose a cursor style
    machine_proc(M_CURSOR, style)
end procedure

global function text_rows(positive_int rows)
    return machine_func(M_TEXTROWS, rows)
end function

global procedure wrap(boolean on)
-- on = 1: characters will wrap at end of long line
-- on = 0: lines will be truncated
    machine_proc(M_WRAP, on)
end procedure

global procedure scroll(integer amount)
-- amount > 0: scroll the screen up by amount lines
-- amount < 0: scroll down by amount lines
    machine_proc(M_SCROLL, amount)
end procedure

global procedure text_color(color c)
-- set the foreground text color to c - text or graphics modes
-- add 16 to get blinking
    machine_proc(M_SET_T_COLOR, c)
end procedure

global procedure bk_color(color c)
-- set the background color to c - text or graphics modes
    machine_proc(M_SET_B_COLOR, c)
end procedure

type mixture(sequence s)
    return length(s) = 3 -- {red, green, blue}
end type

global function palette(color c, mixture s)
-- choose a new mix of {red, green, blue} to be shown on the screen for
-- color number c. Returns previous mixture as {red, green, blue}.
    return machine_func(M_PALETTE, {c, s})
end function

-- Sound Effects --

type frequency(integer x)
    return x >= 0
end type

global procedure sound(frequency f)
-- turn on speaker at frequency f
-- turn off speaker if f is 0
    machine_proc(M_SOUND, f)
end procedure