home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / euphor10.zip / SCREEN.E < prev    next >
Text File  |  1993-06-15  |  6KB  |  227 lines
  1. -- screen.e: access to the screen
  2.  
  3.           ---------------------
  4.           -- graphics screen --
  5.           ---------------------
  6. -- in calls to read_screen and write_screen
  7. -- the screen looks like:
  8.  
  9. -- (1,1)..................(1,HSIZE)
  10. -- ................................
  11. -- ................................
  12. -- (VSIZE,1)..........(VSIZE,HSIZE)
  13.  
  14. -- "y" (second arg) is the row or line starting from the top
  15. -- "x" (first arg) is the character position starting at the left
  16. --  within the y-line. This is consistent with Atari Startrek.
  17.  
  18. -- However, for better efficiency in Euphoria, the screen variable
  19. -- is implemented such that the first subscript selects the line
  20. -- and the second selects the character within that line. This helps
  21. -- when multiple characters are read or written on one line, since
  22. -- we can use a slice.
  23.  
  24. global constant HSIZE = 80,  -- horizontal size (char positions)
  25.         VSIZE = 21   -- vertical size (lines)
  26.  
  27.  
  28. global type h_coord(integer x)
  29. -- true if x is a horizontal screen coordinate
  30.     return x >= 1 and x <= HSIZE
  31. end type
  32.  
  33. global type v_coord(integer y)
  34. -- true if y is a vertical screen coordinate
  35.     return y >= 1 and y <= VSIZE
  36. end type
  37.  
  38. global type extended_h_coord(atom x)
  39.     -- horizontal coordinate, can be slightly off screen
  40.     return x >= -10 and x <= HSIZE + 10
  41. end type
  42.  
  43. global type extended_v_coord(atom y)
  44.     -- vertical coordinate, can be slightly off screen
  45.     return y >= -10 and y <= VSIZE + 10
  46. end type
  47.  
  48. global type screen_pos(sequence x)
  49. -- true if x is a valid screen position
  50. -- n.b. position() wants to see (x[2],x[1])
  51.     return length(x) = 2 and h_coord(x[1]) and v_coord(x[2])
  52. end type
  53.  
  54. sequence screen
  55.  
  56. -- COLOR related stuff:
  57. global constant BLACK = 0,
  58.         BLUE  = 1,
  59.         GREEN = 2,
  60.         CYAN =  3,
  61.         RED   = 4,
  62.         MAGENTA = 5,
  63.         BROWN = 6,
  64.         WHITE = 7,
  65.         GRAY  = 8,
  66.         LIGHT_BLUE = 9,
  67.         LIGHT_GREEN = 10,
  68.         LIGHT_CYAN = 11,
  69.         LIGHT_RED = 12,
  70.         LIGHT_MAGENTA = 13,
  71.         YELLOW = 14,
  72.         BRIGHT_WHITE = 15
  73.  
  74. global constant BLINKING = 16
  75.  
  76. integer mono_monitor
  77.  
  78. sequence vc
  79. vc = video_config()
  80. mono_monitor = not vc[VC_COLOR]
  81.  
  82. global procedure set_color(integer color)
  83.     if mono_monitor then
  84.     return
  85.     else
  86.     text_color(color)
  87.     end if
  88. end procedure
  89.  
  90. global procedure set_bk_color(integer color)
  91.     if mono_monitor then
  92.     return
  93.     else
  94.     bk_color(color)
  95.     end if
  96. end procedure
  97.  
  98.  
  99. global boolean scanon -- galaxy scan on/off
  100.  
  101. global function read_screen(object x,
  102.                 v_coord y)
  103. -- return one or more characters at logical position (x, y)
  104.     if atom(x) then
  105.     return screen[y][x]
  106.     else
  107.     return screen[y][x[1]..x[1]+x[2]-1]
  108.     end if
  109. end function
  110.  
  111. constant object_color = {YELLOW, YELLOW,
  112.              LIGHT_BLUE, LIGHT_BLUE,
  113.              LIGHT_RED, LIGHT_RED,
  114.              LIGHT_RED, LIGHT_RED,
  115.              LIGHT_GREEN, LIGHT_GREEN,
  116.              BROWN,
  117.              BROWN,
  118.              YELLOW, YELLOW,
  119.              YELLOW,
  120.              LIGHT_RED, LIGHT_RED
  121.              }
  122.  
  123. constant shape_list =    {ENTERPRISE_L, ENTERPRISE_R,
  124.             ROMULAN_L, ROMULAN_R,
  125.             S_KLINGON_L, S_KLINGON_R,
  126.             B_KLINGON_L, B_KLINGON_R,
  127.             THOLIAN_L, THOLIAN_R,
  128.             PLANET_TOP,
  129.             PLANET_MIDDLE,
  130.             SHUTTLE_L, SHUTTLE_R,
  131.             BASE,
  132.             J_KLINGON_L, J_KLINGON_R}
  133.  
  134. function which_color(object shape)
  135. -- Return color for an object based on its "shape".
  136. -- This is grossly inefficient but makes it easy to add color
  137. -- to this old mono TRS-80 program
  138.     integer object_number
  139.  
  140.     if atom(shape) then
  141.     if shape = '+' or shape = '-' then
  142.         return object_color[9] -- tholian phasor
  143.     else
  144.         return 7
  145.     end if
  146.     end if
  147.     object_number = find(shape, shape_list)
  148.     if object_number then
  149.     return object_color[object_number]
  150.     else
  151.     return 7 -- not found (blanks, stars)
  152.     end if
  153. end function
  154.  
  155. global procedure write_screen(h_coord x, v_coord y, object c)
  156. -- write a character or string to the screen variable
  157. -- and to the physical screen
  158.  
  159.     if atom(c) then
  160.     screen[y][x] = c
  161.     else
  162.     screen[y][x..x+length(c)-1] = c
  163.     end if
  164.     if not scanon then
  165.     set_bk_color(0)
  166.     set_color(which_color(c))
  167.     position(y, x)
  168.     puts(CRT, c)
  169.     end if
  170. end procedure
  171.  
  172. global procedure display_screen(h_coord x, v_coord y, object c)
  173. -- display a character or string on the screen, but it does not affect
  174. -- the logic of the game at all (blank is actually stored)
  175.     if atom(c) then
  176.     screen[y][x] = ' '
  177.     else
  178.     screen[y][x..x + length(c) - 1] = ' '
  179.     end if
  180.     if not scanon then
  181.     position(y, x)
  182.     puts(CRT, c)
  183.     end if
  184. end procedure
  185.  
  186. global constant BLANK_LINE = repeat(' ', HSIZE)
  187.  
  188. global procedure BlankScreen(boolean var_too)
  189. -- set physical upper screen to all blanks
  190. -- and optionally blank the screen variable too
  191. -- initially the screen variable is undefined
  192.  
  193.     if not scanon then
  194.     for i = 1 to VSIZE do
  195.         position(i, 1)
  196.         puts(CRT, BLANK_LINE) -- blank upper 3/4 of screen
  197.     end for
  198.     end if
  199.     if var_too then
  200.     screen = repeat(BLANK_LINE, VSIZE) -- new blank screen
  201.     end if
  202. end procedure
  203.  
  204. global procedure ShowScreen()
  205. -- rewrite screen after galaxy scan
  206.     set_bk_color(BLACK)
  207.     set_color(WHITE)
  208.     position(1, 1)
  209.     for i = 1 to VSIZE do
  210.     position(i, 1)
  211.     puts(CRT, screen[i])
  212.     end for
  213. end procedure
  214.  
  215.  
  216.        ----------------------------
  217.        -- text portion of screen --
  218.        ----------------------------
  219.  
  220. global constant QUAD_LINE = VSIZE + 1,
  221.         WARP_LINE = VSIZE + 2,
  222.         CMD_LINE  = VSIZE + 3,
  223.         MSG_LINE  = VSIZE + 4
  224.  
  225. global constant CMD_POS = 31
  226.  
  227.