home *** CD-ROM | disk | FTP | other *** search
/ PC Consument 1998 January / PCC11998.bin / demos / euphor.exe / GRAPHICS.E < prev    next >
Encoding:
Text File  |  1997-02-16  |  6.4 KB  |  234 lines
  1.         ----------------------
  2.         -- Graphics & Sound --
  3.         ----------------------
  4.  
  5. --    GRAPHICS MODES --  argument to graphics_mode()
  6.  
  7. -- mode  description
  8. -- ----  -----------
  9. --   -1  restore to original default mode
  10. --    0  40 x 25 text, 16 grey
  11. --    1  40 x 25 text, 16/8 color
  12. --    2  80 x 25 text, 16 grey
  13. --    3  80 x 25 text, 16/8 color
  14. --    4  320 x 200, 4 color
  15. --    5  320 x 200, 4 grey
  16. --    6  640 x 200, BW
  17. --    7  80 x 25 text, BW
  18. --   11  720 x 350, BW  (many video cards are lacking this one)
  19. --   13  320 x 200, 16 color
  20. --   14  640 x 200, 16 color
  21. --   15  640 x 350, BW  (may be 4-color with blinking)
  22. --   16  640 x 350, 4 or 16 color
  23. --   17  640 x 480, BW
  24. --   18  640 x 480, 16 color
  25. --   19  320 x 200, 256 color
  26. --  256  640 x 400, 256 color  (some cards are missing this one)
  27. --  257  640 x 480, 256 color  (some cards are missing this one)
  28. --  258  800 x 600, 16 color
  29. --  259  800 x 600, 256 color
  30. --  260  1024 x 768, 16 color
  31. --  261  1024 x 768, 256 color
  32.  
  33. -- COLOR values -- for characters and pixels
  34. global constant BLACK = 0,  -- in graphics modes this is "transparent"
  35.         BLUE  = 1,
  36.         GREEN = 2,
  37.         CYAN =  3,
  38.         RED   = 4,
  39.         MAGENTA = 5,
  40.         BROWN = 6,
  41.         WHITE = 7,
  42.         GRAY  = 8,
  43.         BRIGHT_BLUE = 9,
  44.         BRIGHT_GREEN = 10,
  45.         BRIGHT_CYAN = 11,
  46.         BRIGHT_RED = 12,
  47.         BRIGHT_MAGENTA = 13,
  48.         YELLOW = 14,
  49.         BRIGHT_WHITE = 15
  50.  
  51. global constant BLINKING = 16  -- add to color to get blinking text
  52.  
  53.  
  54. -- machine() commands
  55. constant M_SOUND          = 1,
  56.      M_LINE           = 2,
  57.      M_PALETTE        = 3,
  58.      M_PIXEL          = 4,
  59.      M_GRAPHICS_MODE  = 5,
  60.      M_CURSOR         = 6,
  61.      M_WRAP           = 7,
  62.      M_SCROLL         = 8,
  63.      M_SET_T_COLOR    = 9,
  64.      M_SET_B_COLOR    = 10,
  65.      M_POLYGON        = 11,
  66.      M_TEXTROWS       = 12,
  67.      M_VIDEO_CONFIG   = 13,
  68.      M_ELLIPSE        = 18,
  69.      M_GET_PIXEL      = 21,
  70.      M_GET_POSITION   = 25,
  71.      M_ALL_PALETTE    = 27
  72.  
  73. type mode(integer x)
  74.     return (x >= -3 and x <= 19) or (x >= 256 and x <= 263)
  75. end type
  76.  
  77. type color(integer x)
  78.     return x >= 0 and x <= 255
  79. end type
  80.  
  81. type boolean(integer x)
  82.     return x = 0 or x = 1
  83. end type
  84.  
  85. type positive_int(integer x)
  86.     return x >= 1
  87. end type
  88.  
  89. type point(sequence x)
  90.     return length(x) = 2
  91. end type
  92.  
  93. type multi_point(sequence x)
  94.     return length(x) = 2 or length(x) = 3
  95. end type
  96.  
  97. type point_sequence(sequence x)
  98.     return length(x) >= 2
  99. end type
  100.  
  101. global procedure draw_line(color c, point_sequence xyarray)
  102. -- draw a line connecting the 2 or more points
  103. -- in xyarray: {{x1, y1}, {x2, y2}, ...}
  104. -- using a certain color 
  105.     machine_proc(M_LINE, {c, 0, xyarray})
  106. end procedure
  107.  
  108. global procedure polygon(color c,
  109.              boolean fill,
  110.              point_sequence xyarray)
  111. -- draw a polygon using a certain color
  112. -- fill the area if fill is TRUE
  113. -- 3 or more vertices are given in xyarray
  114.     machine_proc(M_POLYGON, {c, fill, xyarray})
  115. end procedure
  116.  
  117. global procedure ellipse(color c, boolean fill, point p1, point p2)
  118. -- draw an ellipse with a certain color that fits in the
  119. -- rectangle defined by diagonal points p1 and p2, i.e. 
  120. -- {x1, y1} and {x2, y2}. The ellipse may be filled or just an outline.   
  121.     machine_proc(M_ELLIPSE, {c, fill, p1, p2})
  122. end procedure
  123.  
  124. global procedure pixel(object c, point p)
  125. -- set the color for a single pixel (when c is an atom)
  126. -- or a horizontal line of pixels (when c is a sequence)
  127.     machine_proc(M_PIXEL, {c, p})
  128. end procedure
  129.  
  130. global function get_pixel(multi_point p)
  131. -- read color number of a single pixel when p is {x, y}, or
  132. -- read a horizontal line of pixels, when p is {x, y, length} 
  133.     return machine_func(M_GET_PIXEL, p)
  134. end function
  135.  
  136. global function graphics_mode(mode m)
  137. -- try to set up a new graphics mode
  138. -- return 0 if successful, non-zero if failed
  139.    return machine_func(M_GRAPHICS_MODE, m)
  140. end function
  141.  
  142. global constant VC_COLOR = 1,
  143.         VC_MODE  = 2,
  144.         VC_LINES = 3,
  145.         VC_COLUMNS = 4,
  146.         VC_XPIXELS = 5,
  147.         VC_YPIXELS = 6,
  148.         VC_NCOLORS = 7,
  149.         VC_PAGES = 8
  150. global function video_config()
  151. -- return sequence of information on video configuration
  152. -- {color?, mode, text lines, text columns, xpixels, ypixels, #colors, pages}
  153.     return machine_func(M_VIDEO_CONFIG, 0)
  154. end function
  155.  
  156. -- cursor styles:
  157. global constant NO_CURSOR       = #2000,
  158.      UNDERLINE_CURSOR       = #0607,
  159.      THICK_UNDERLINE_CURSOR = #0507,
  160.      HALF_BLOCK_CURSOR      = #0407,
  161.      BLOCK_CURSOR           = #0007
  162.      
  163.  
  164. global procedure cursor(integer style)
  165. -- choose a cursor style
  166.     machine_proc(M_CURSOR, style)
  167. end procedure
  168.  
  169. global function get_position()
  170. -- return {line, column} of current cursor position
  171.     return machine_func(M_GET_POSITION, 0)
  172. end function
  173.  
  174. global function text_rows(positive_int rows)
  175.     return machine_func(M_TEXTROWS, rows)
  176. end function
  177.  
  178. global procedure wrap(boolean on)
  179. -- on = 1: characters will wrap at end of long line
  180. -- on = 0: lines will be truncated
  181.     machine_proc(M_WRAP, on)
  182. end procedure
  183.  
  184. global procedure scroll(integer amount, 
  185.             positive_int top_line, 
  186.             positive_int bottom_line)
  187. -- scroll lines of text on screen between top_line and bottom_line
  188. -- amount > 0: scroll text up by amount lines
  189. -- amount < 0: scroll text down by amount lines
  190. -- (had only the first parameter in v1.2)   
  191.     machine_proc(M_SCROLL, {amount, top_line, bottom_line})
  192. end procedure
  193.  
  194. global procedure text_color(color c)
  195. -- set the foreground text color to c - text or graphics modes
  196. -- add 16 to get blinking
  197.     machine_proc(M_SET_T_COLOR, c)
  198. end procedure
  199.  
  200. global procedure bk_color(color c)
  201. -- set the background color to c - text or graphics modes
  202.     machine_proc(M_SET_B_COLOR, c)
  203. end procedure
  204.  
  205. type mixture(sequence s)
  206.     return length(s) = 3 -- {red, green, blue}
  207. end type
  208.  
  209. global function palette(color c, mixture s)
  210. -- choose a new mix of {red, green, blue} to be shown on the screen for
  211. -- color number c. Returns previous mixture as {red, green, blue}.
  212.     return machine_func(M_PALETTE, {c, s})
  213. end function
  214.  
  215. global procedure all_palette(sequence s)
  216. -- s is a sequence of the form: {{r,g,b},{r,g,b}, ...{r,g,b}}
  217. -- that specifies new color intensities for the entire set of
  218. -- colors in the current graphics mode.  
  219.     machine_proc(M_ALL_PALETTE, s)
  220. end procedure
  221.  
  222. -- Sound Effects --
  223.  
  224. type frequency(integer x)
  225.     return x >= 0
  226. end type
  227.  
  228. global procedure sound(frequency f)
  229. -- turn on speaker at frequency f
  230. -- turn off speaker if f is 0
  231.     machine_proc(M_SOUND, f)
  232. end procedure
  233.  
  234.