home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / euphoria / display.e < prev    next >
Text File  |  1994-02-10  |  12KB  |  459 lines
  1. -- display.e
  2. -- graphics, sound and text display on screen
  3.  
  4. global sequence ship
  5.  
  6. global sequence ds -- Euphoria deflectors
  7. global sequence ts -- Euphoria torpedos
  8. global sequence ps -- Euphoria anti-matter pods 
  9.  
  10. global function c_remaining()
  11. -- number of C ships (of all types) left
  12.     return nobj[G_KRC] + nobj[G_ANC] + nobj[G_CPP]
  13. end function
  14.  
  15. type negative_atom(atom x)
  16.     return x <= 0
  17. end type
  18.  
  19. global procedure p_energy(negative_atom delta)
  20. -- print Euphoria energy
  21.     atom energy
  22.  
  23.     energy = quadrant[EUPHORIA][Q_EN] + delta
  24.     quadrant[EUPHORIA][Q_EN] = energy
  25.     if energy < 0 then
  26.     energy = 0
  27.     gameover = TRUE
  28.     end if
  29.     position(WARP_LINE, ENERGY_POS+7)
  30.     set_bk_color(WHITE)
  31.     if energy < 5000 then
  32.     set_color(RED+BLINKING)
  33.     else
  34.     set_color(BLACK)
  35.     end if
  36.     printf(CRT, "%d    ", floor(energy))
  37. end procedure
  38.  
  39. global procedure task_life()
  40. -- independent task: life support energy 
  41.     if shuttle then
  42.     p_energy(-3)
  43.     else
  44.     p_energy(-17)
  45.     end if
  46. end procedure
  47.  
  48. ------------------------- message handler -----------------------------
  49. -- All messages come here. An independent task ensures that messages
  50. -- will be displayed on the screen for at least a second or so, before
  51. -- being overwritten by the next message. If there is no queue, a
  52. -- message will be printed immediately, otherwise it is added to the queue.
  53. -- A message is deleted from the queue when its time on the screen
  54. -- is up.
  55.  
  56. constant MESSAGE_GAP = 1.2  -- seconds between messages for readability
  57.  
  58. sequence message_queue
  59. message_queue = {}
  60.  
  61. global procedure set_msg()
  62. -- prepare to print a message
  63.     set_bk_color(WHITE)
  64.     set_color(RED)
  65.     position(MSG_LINE, MSG_POS)
  66.     puts(CRT, BLANK_LINE[1..50])
  67.     position(MSG_LINE, MSG_POS)
  68. end procedure
  69.  
  70. global procedure msg(sequence text)
  71. -- print a plain text message on the message line
  72.     if length(message_queue) = 0 then
  73.     -- print it right away
  74.     set_msg()
  75.     puts(CRT, text)
  76.     sched(TASK_MESSAGE, MESSAGE_GAP)    
  77.     end if
  78.     message_queue = append(message_queue, {text})
  79. end procedure
  80.  
  81. global procedure fmsg(sequence format, object values)
  82. -- print a formatted message on the message line
  83.     if length(message_queue) = 0 then
  84.     -- print it right away
  85.     set_msg()
  86.     printf(CRT, format, values)    
  87.     sched(TASK_MESSAGE, MESSAGE_GAP)    
  88.     end if
  89.     message_queue = append(message_queue, {format, values})
  90. end procedure
  91.  
  92. global procedure task_message()
  93. -- display next message in message queue
  94.     sequence message
  95.  
  96.     -- first message is already on the screen - delete it
  97.     message_queue = message_queue[2..length(message_queue)]
  98.     if length(message_queue) = 0 then
  99.     wait[TASK_MESSAGE] = INACTIVE   -- deactivate this task
  100.     else
  101.         message = message_queue[1]
  102.         set_msg()
  103.         if length(message) = 1 then
  104.         puts(CRT, message[1])
  105.         else
  106.         printf(CRT, message[1], message[2])        
  107.         end if
  108.     wait[TASK_MESSAGE] = MESSAGE_GAP
  109.     end if
  110. end procedure
  111.  
  112. ----------------------------------------------------------------------------
  113.  
  114. global procedure show_warp()
  115. -- show current speed (with warning)
  116.     set_bk_color(WHITE)
  117.     set_color(BLACK)
  118.     position(WARP_LINE, WARP_POS)
  119.     puts(CRT, "WARP:")
  120.     if curwarp > wlimit then
  121.     set_color(RED+BLINKING)
  122.     end if
  123.     printf(CRT, "%d", curwarp)
  124. end procedure
  125.  
  126. -- how long it takes Euphoria to move at warp 0 thru 5:
  127. constant warp_time = {0, 20, 4.5, 1.5, .67, .25}
  128.  
  129. global procedure setwarp(warp new)
  130. -- establish a new warp speed for the Euphoria
  131.  
  132.     if new != curwarp then
  133.     wait[TASK_EMOVE] = warp_time[new+1]
  134.     eat[TASK_EMOVE] = (5-new)/20 + 0.05
  135.     sched(TASK_EMOVE, wait[TASK_EMOVE])
  136.     curwarp = new
  137.     show_warp()
  138.     end if
  139. end procedure
  140.  
  141. global procedure gtext()
  142. -- print text portion of galaxy scan
  143.     set_bk_color(BLUE)
  144.     position(2, 37)
  145.     set_color(LIGHT_RED)
  146.     puts(CRT, "C ")
  147.     set_color(BROWN)
  148.     puts(CRT, "P ")
  149.     set_color(YELLOW)
  150.     puts(CRT, "B")
  151.     set_color(WHITE)
  152.     position(3, 15)
  153.     puts(CRT, "1       2       3       4       5       6       7")
  154.     for i = 1 to 7 do
  155.     position(2*i + 2, 10)
  156.     printf(CRT, "%d.", i)
  157.     end for
  158.     position(18, 37)
  159.     set_color(BRIGHT_WHITE)
  160.     printf(CRT, "C: %d ", c_remaining())
  161.     position(19, 24)
  162.     set_color(WHITE)
  163.     printf(CRT, "Planets: %d   BASIC: %d", {nobj[G_PL], nobj[G_BAS]})
  164.     if bstat = TRUCE then
  165.     puts(CRT, " TRUCE   ")
  166.     elsif bstat = HOSTILE then
  167.     puts(CRT, " HOSTILE ")
  168.     else
  169.     set_color(WHITE+BLINKING)
  170.     puts(CRT, " CLOAKING")
  171.     set_color(WHITE)
  172.     end if
  173.     position(20, 24)
  174.     printf(CRT, "Bases: %d     Fortran: %d ", {nobj[G_BS], nobj[G_FOR]})
  175.     position(20, 67)
  176.     set_color(BLUE)
  177.     set_bk_color(WHITE)
  178.     if level = 'n' then
  179.         puts(CRT, "NOVICE LEVEL")
  180.     else
  181.         puts(CRT, "EXPERT LEVEL")
  182.     end if
  183. end procedure
  184.  
  185. function source_of_energy(g_index qrow, g_index qcol, object_type t)
  186. -- see if there is any energy left from planets / bases in this quadrant
  187.     pb_row start, stop
  188.  
  189.     if t = G_BS then
  190.     start = 1
  191.     stop = NBASES
  192.     else
  193.     start = NBASES + 1
  194.     stop = length(pb)
  195.     end if
  196.     for pbi = start to stop do
  197.     if pb[pbi][P_TYPE] != DEAD then
  198.         if pb[pbi][P_QR] = qrow then
  199.         if pb[pbi][P_QC] = qcol then
  200.             if pb[pbi][P_EN] > 0 then
  201.             return TRUE
  202.             end if
  203.         end if
  204.         end if
  205.     end if
  206.     end for
  207.     return FALSE
  208. end function
  209.  
  210. function g_screen_pos(g_index qrow, g_index qcol)
  211. -- compute position on screen to display a galaxy scan quadrant
  212.     return {5 + qcol * 8, qrow * 2 + 2}
  213. end function
  214.  
  215. global procedure gquad(g_index qrow, g_index qcol)
  216. -- print one galaxy scan quadrant
  217.  
  218.     natural nk, np, nb
  219.     sequence quad_info
  220.     screen_pos gpos
  221.  
  222.     gpos = g_screen_pos(qrow, qcol)
  223.     position(gpos[2], gpos[1])
  224.     quad_info = galaxy[qrow][qcol]
  225.     if quad_info[1] then
  226.     nk = quad_info[G_KRC] + quad_info[G_ANC] + quad_info[G_CPP]
  227.     set_color(LIGHT_RED)
  228.     printf(CRT, "%d ", nk)
  229.  
  230.     np = quad_info[G_PL]
  231.     if np = 0 then
  232.         set_color(BROWN)
  233.     elsif source_of_energy(qrow, qcol, G_PL) then
  234.         set_color(BROWN)
  235.     else
  236.         set_color(GRAY)
  237.     end if
  238.     printf(CRT, "%d ", np)
  239.  
  240.     nb = quad_info[G_BS]
  241.     if nb = 0 then
  242.         set_color(YELLOW)
  243.     elsif source_of_energy(qrow, qcol, G_BS) then
  244.         set_color(YELLOW)
  245.     else
  246.         set_color(GRAY)
  247.     end if
  248.     printf(CRT, "%d",  nb)
  249.  
  250.     set_color(WHITE)
  251.     else
  252.     puts(CRT, "*****")
  253.     end if
  254. end procedure
  255.  
  256. global procedure upg(g_index qrow, g_index qcol)
  257. -- update galaxy scan quadrant
  258.     if scanon then
  259.     set_bk_color(BLUE)
  260.     set_color(WHITE)
  261.     gquad(qrow, qcol)
  262.     end if
  263. end procedure
  264.  
  265. sequence prev_box
  266. prev_box = {}
  267.  
  268. global procedure gsbox(g_index qrow, g_index qcol)
  269. -- indicate current quadrant on galaxy scan
  270.     screen_pos gpos
  271.  
  272.     if scanon then
  273.     set_bk_color(BLUE)
  274.     if length(prev_box) = 2 then
  275.         -- clear the previous "box" (could be gone already)
  276.         position(prev_box[2], prev_box[1]-1)
  277.         puts(CRT, ' ')
  278.         position(prev_box[2], prev_box[1]+5)
  279.         puts(CRT, ' ')
  280.     end if
  281.     set_color(WHITE)
  282.     gquad(qrow, qcol)
  283.     gpos = g_screen_pos(qrow, qcol)
  284.     position(gpos[2], gpos[1]-1)
  285.     set_color(BRIGHT_WHITE)
  286.     puts(CRT, '[')
  287.     position(gpos[2], gpos[1]+5)
  288.     puts(CRT, ']')
  289.     prev_box = gpos
  290.     end if
  291. end procedure
  292.  
  293. constant dir_places = {{1, 6},{0, 6},{0, 3},{0, 0},{1, 0},{2, 0},{2, 3},{2, 6}}
  294.  
  295. global procedure dir_box()
  296.     -- direction box
  297.     sequence place
  298.  
  299.     set_bk_color(RED)
  300.     set_color(BLACK)
  301.     position(WARP_LINE, DIRECTIONS_POS)
  302.     puts(CRT, "4  3  2")
  303.     position(CMD_LINE, DIRECTIONS_POS)
  304.     puts(CRT, "5  +  1")
  305.     position(MSG_LINE, DIRECTIONS_POS)
  306.     puts(CRT, "6  7  8")
  307.     place = dir_places[curdir]
  308.     position(place[1]+WARP_LINE,place[2]+DIRECTIONS_POS) 
  309.     set_bk_color(GREEN)
  310.     printf(CRT, "%d", curdir)
  311.     set_bk_color(WHITE)
  312. end procedure
  313.  
  314. global procedure wtext()
  315. -- print torpedos, pods, deflectors in text window
  316.     set_bk_color(WHITE)
  317.     set_color(BLACK)
  318.     position(WARP_LINE, WEAPONS_POS)
  319.     printf(CRT, "%s %s %s ", {ts, ds, ps}) 
  320. end procedure
  321.  
  322. global procedure stext()
  323. -- print text window info
  324.     position(QUAD_LINE, 1)
  325.     set_bk_color(CYAN)
  326.     set_color(MAGENTA)
  327.     printf(CRT,
  328.     "--------------------------------- QUADRANT %d.%d ---------------------------------"
  329.        ,{qrow, qcol})
  330.     set_bk_color(WHITE)
  331.     set_color(BLACK)
  332.     show_warp()
  333.     wtext()
  334.     position(WARP_LINE, ENERGY_POS)
  335.     printf(CRT, "ENERGY:%d    ", floor(quadrant[EUPHORIA][Q_EN]))
  336.     position(CMD_LINE, CMD_POS-30)
  337.     puts(CRT, "COMMAND(1-8 w p t a g $ ! x): ")
  338.     dir_box()
  339. end procedure
  340.  
  341. procedure p_source(valid_quadrant_row row)
  342. -- print a base or planet
  343.     h_coord x
  344.     v_coord y
  345.  
  346.     x = quadrant[row][Q_X]
  347.     y = quadrant[row][Q_Y]
  348.     if quadrant[row][Q_TYPE] = G_PL then
  349.     write_screen(x, y, PLANET_TOP)
  350.     write_screen(x, y+1, PLANET_MIDDLE)
  351.     write_screen(x, y+2, PLANET_BOTTOM)
  352.     else
  353.     write_screen(x, y, BASE)
  354.     write_screen(x, y+1, BASE)
  355.     end if
  356. end procedure
  357.  
  358. procedure p_ship(valid_quadrant_row row)
  359. -- reprint a ship to get color
  360.     h_coord x
  361.     v_coord y
  362.     object_type t
  363.     sequence shape
  364.  
  365.     x = quadrant[row][Q_X]
  366.     y = quadrant[row][Q_Y]
  367.     t = quadrant[row][Q_TYPE]
  368.     shape = read_screen({x, length(ship[t][1])},  y)
  369.     write_screen(x, y, shape)
  370. end procedure
  371.  
  372. procedure refresh_obj()
  373. -- reprint objects after a galaxy scan
  374.     for i = 1 to length(quadrant) do
  375.     if quadrant[i][Q_TYPE] = G_BS or quadrant[i][Q_TYPE] = G_PL then
  376.         p_source(i)
  377.     elsif quadrant[i][Q_TYPE] != DEAD then
  378.         p_ship(i)
  379.     end if
  380.     end for
  381. end procedure
  382.  
  383. global procedure setg1()
  384. -- end display of galaxy scan
  385.     if scanon then
  386.     scanon = FALSE
  387.     ShowScreen()
  388.     refresh_obj()
  389.     end if
  390. end procedure
  391.  
  392.  
  393. global procedure pobj()
  394. -- print objects in a new quadrant
  395.     h_coord x
  396.     v_coord y
  397.     sequence c
  398.     natural len
  399.     object_type t
  400.     sequence taken
  401.  
  402.     set_bk_color(BLACK)
  403.     set_color(WHITE)
  404.     BlankScreen(TRUE)
  405.  
  406.     -- print stars
  407.     for i = 1 to 15 do
  408.     write_screen(rand(HSIZE), rand(VSIZE), STAR)
  409.     end for
  410.  
  411.     -- print planets and bases
  412.     taken = {}
  413.     for row = 2 to length(quadrant) do
  414.     if find(quadrant[row][Q_TYPE], {G_PL, G_BS}) then
  415.         -- look it up in pb sequence
  416.         for pbi = 1 to length(pb) do
  417.             if pb[pbi][P_TYPE] = quadrant[row][Q_TYPE] then
  418.             if pb[pbi][P_QR] = qrow and pb[pbi][P_QC] = qcol then
  419.             if not find(pbi, taken) then
  420.                 quadrant[row][Q_X] = pb[pbi][P_X]
  421.                 quadrant[row][Q_Y] = pb[pbi][P_Y]
  422.                 quadrant[row][Q_PBX] = pbi
  423.                 taken = taken & pbi
  424.                 exit
  425.                 end if
  426.             end if
  427.             end if
  428.         end for
  429.         p_source(row)
  430.     end if
  431.     end for
  432.  
  433.     -- print ships
  434.     for row = 2 to length(quadrant) do
  435.     if not find(quadrant[row][Q_TYPE], {G_PL, G_BS})  then
  436.         len = length(ship[quadrant[row][Q_TYPE]][1])
  437.         while TRUE do
  438.             -- look for an empty place to put the ship
  439.             x = rand(HSIZE - len - 5) + 3 -- allow space for Euphoria to enter
  440.             y = rand(VSIZE - 2) + 1
  441.             c = read_screen({x, len}, y)
  442.             if not find(FALSE, c = ' ' or c = STAR) then
  443.             exit
  444.             end if
  445.         end while
  446.         quadrant[row][Q_UNDER] = c
  447.         quadrant[row][Q_X] = x
  448.         quadrant[row][Q_Y] = y
  449.         t = quadrant[row][Q_TYPE]
  450.         if x < quadrant[EUPHORIA][Q_X] then
  451.             c = ship[t][2]
  452.         else
  453.             c = ship[t][1]
  454.         end if
  455.         write_screen(x, y, c)
  456.     end if
  457.     end for
  458. end procedure
  459.