home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
euphor10.zip
/
GRAPHICS.E
< prev
next >
Wrap
Text File
|
1993-06-18
|
4KB
|
171 lines
-------------------------------------
-- graphics & sound: MSDOS version --
-------------------------------------
-- machine() commands
constant SOUND = 1,
LINE = 2,
PALETTE = 3,
PIXEL = 4,
GRAPHICS_MODE = 5,
CURSOR = 6,
WRAP = 7,
SCROLL = 8,
SET_T_COLOR = 9,
SET_B_COLOR =10,
POLYGON =11,
TEXTROWS =12,
VIDEO_CONFIG =13
-- graphics modes: argument to graphics_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
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,
positive_int w,
point_sequence xyarray)
-- draw a line connecting the 2 or more points
-- in xyarray: {{x1, y1}, {x2, y2}, ...}
-- using a certain color and width w
machine_proc(LINE, {c, w, 0, xyarray})
end procedure
global procedure polygon(color c,
positive_int w,
boolean fill,
point_sequence xyarray)
-- draw a polygon
-- 3 or more vertices are given in xyarray
-- using a certain color and width w
-- fill the area if fill is TRUE
machine_proc(POLYGON, {c, w, fill, xyarray})
end procedure
global procedure pixel(color c, point p)
-- set a pixel to a certain color
machine_proc(PIXEL, {c, p})
end procedure
global procedure graphics_mode(mode m)
-- set up a graphics mode
machine_proc(GRAPHICS_MODE, m)
end procedure
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(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(CURSOR, style)
end procedure
global function text_rows(positive_int rows)
return machine_func(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(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(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(SET_T_COLOR, c)
end procedure
global procedure bk_color(color c)
-- set the background color to c - text or graphics modes
machine_proc(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(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(SOUND, f)
end procedure