home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / misc / euphoria / screen.e < prev    next >
Encoding:
Text File  |  1994-01-08  |  5.8 KB  |  237 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 the TRS-80 version.
  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. global sequence object_color 
  112. object_color =         {
  113.             YELLOW, YELLOW,
  114.             LIGHT_BLUE, LIGHT_BLUE,
  115.             LIGHT_RED, LIGHT_RED,
  116.             LIGHT_RED, LIGHT_RED,
  117.             LIGHT_GREEN, LIGHT_GREEN,
  118.             BROWN,
  119.             BROWN,
  120.             YELLOW, YELLOW,
  121.             YELLOW,
  122.             LIGHT_MAGENTA, LIGHT_MAGENTA
  123.             }
  124.  
  125. constant shape_list =    {
  126.             EUPHORIA_L, EUPHORIA_R,
  127.             BASIC_L, BASIC_R,
  128.             KRC_L, KRC_R,
  129.             ANC_L, ANC_R,
  130.             FORTRAN_L, FORTRAN_R,
  131.             PLANET_TOP,
  132.             PLANET_MIDDLE,
  133.             SHUTTLE_L, SHUTTLE_R,
  134.             BASE,
  135.             CPP_L, CPP_R
  136.             }
  137.  
  138. global constant BASIC_COL = find(BASIC_L, shape_list)
  139.  
  140. function which_color(object shape)
  141. -- Return color for an object based on its "shape".
  142. -- This makes it easy to add color to this old mono TRS-80 program.
  143.     integer object_number
  144.  
  145.     if atom(shape) then
  146.     if shape = '+' or shape = '-' then
  147.         return object_color[9] -- Fortran phasor
  148.     else
  149.         return WHITE
  150.     end if
  151.     end if
  152.     object_number = find(shape, shape_list)
  153.     if object_number then
  154.     return object_color[object_number]
  155.     else
  156.     return WHITE -- not found (blanks, stars)
  157.     end if
  158. end function
  159.  
  160. global procedure write_screen(h_coord x, v_coord y, object c)
  161. -- write a character or string to the screen variable
  162. -- and to the physical screen
  163.  
  164.     if atom(c) then
  165.     screen[y][x] = c
  166.     else
  167.     screen[y][x..x+length(c)-1] = c
  168.     end if
  169.     if not scanon then
  170.     set_bk_color(BLACK)
  171.     set_color(which_color(c))
  172.     position(y, x)
  173.     puts(CRT, c)
  174.     end if
  175. end procedure
  176.  
  177. global procedure display_screen(h_coord x, v_coord y, object c)
  178. -- display a character or string on the screen, but it does not affect
  179. -- the logic of the game at all (blank is actually stored)
  180.     if atom(c) then
  181.     screen[y][x] = ' '
  182.     else
  183.     screen[y][x..x + length(c) - 1] = ' '
  184.     end if
  185.     if not scanon then
  186.     position(y, x)
  187.     puts(CRT, c)
  188.     end if
  189. end procedure
  190.  
  191. global constant BLANK_LINE = repeat(' ', HSIZE)
  192.  
  193. global procedure BlankScreen(boolean var_too)
  194. -- set physical upper screen to all blanks
  195. -- and optionally blank the screen variable too
  196. -- initially the screen variable is undefined
  197.  
  198.     if not scanon then
  199.     for i = 1 to VSIZE do
  200.         position(i, 1)
  201.         puts(CRT, BLANK_LINE) -- blank upper 3/4 of screen
  202.     end for
  203.     end if
  204.     if var_too then
  205.     screen = repeat(BLANK_LINE, VSIZE) -- new blank screen
  206.     end if
  207. end procedure
  208.  
  209. global procedure ShowScreen()
  210. -- rewrite screen after galaxy scan
  211.     set_bk_color(BLACK)
  212.     set_color(WHITE)
  213.     position(1, 1)
  214.     for i = 1 to VSIZE do
  215.     position(i, 1)
  216.     puts(CRT, screen[i])
  217.     end for
  218. end procedure
  219.  
  220.        ----------------------------
  221.        -- text portion of screen --
  222.        ----------------------------
  223.  
  224. global constant QUAD_LINE = VSIZE + 1,
  225.         WARP_LINE = VSIZE + 2,
  226.         CMD_LINE  = VSIZE + 3,
  227.         MSG_LINE  = VSIZE + 4
  228.  
  229. global constant CMD_POS = 39,     -- place for first char of user command
  230.            WARP_POS = 9,      -- place for "WARP:" to appear
  231.            DREP_POS = 51,     -- place for damage report
  232.            WEAPONS_POS = 34,  -- place for torpedos/pos/deflectors display
  233.            ENERGY_POS = 67,   -- place for ENERGY display
  234.            MSG_POS = 16,      -- place for messages to start
  235.            DIRECTIONS_POS = 1 -- place to put directions
  236.  
  237.