home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / misc / euphoria / commands.e < prev    next >
Encoding:
Text File  |  1994-04-04  |  6.8 KB  |  353 lines
  1. -- commands.e
  2. -- process user commands
  3.  
  4. global natural nchars
  5.  
  6. natural pen
  7.  
  8. type keycode(integer x)  
  9. -- a keyboard code
  10.     return x >= -1 and x < 512
  11. end type
  12.  
  13. keycode curcom
  14.  
  15. direction dir
  16.  
  17. type digit_char(integer x)
  18.     return x >= '0' and x <= '9'
  19. end type
  20.  
  21. procedure echo(char com)
  22. -- echo first char of new command
  23.     set_bk_color(WHITE)
  24.     set_color(BLUE)
  25.     position(CMD_LINE, CMD_POS)
  26.     puts(CRT, com)
  27.     puts(CRT, "        ")
  28.     position(CMD_LINE, CMD_POS + 2)
  29. end procedure
  30.  
  31. procedure dircom(digit_char dir)
  32. -- process direction change commands
  33.     nchars = 0
  34.     if reptime[GUIDANCE] then
  35.     errbeep()
  36.     msg("GUIDANCE SYSTEM DAMAGED")
  37.     return
  38.     end if
  39.  
  40.     if dir = '9' then
  41.     dir = '1'
  42.     elsif dir = '0' then
  43.     dir = '8'
  44.     end if  
  45.  
  46.     echo(dir)
  47.     curdir = dir - '0'
  48.     dir_box()
  49.  
  50.     if dir = '1' then
  51.     exi = 3
  52.     eyi = 0
  53.     esym = esymr
  54.     elsif dir = '2' then
  55.     exi = 3
  56.     eyi = -1
  57.     esym = esymr
  58.     elsif dir = '3' then
  59.     exi = 0
  60.     eyi = -1
  61.     elsif dir = '4' then
  62.     exi = -3
  63.     eyi = -1
  64.     esym = esyml
  65.     elsif dir = '5' then
  66.     exi = -3
  67.     eyi = 0
  68.     esym = esyml
  69.     elsif dir = '6' then
  70.     exi = -3
  71.     eyi = 1
  72.     esym = esyml
  73.     elsif dir = '7' then
  74.     exi = 0
  75.     eyi = 1
  76.     elsif dir = '8' then
  77.     exi = 3
  78.     eyi = 1
  79.     esym = esymr
  80.     end if
  81. end procedure
  82.  
  83. function docom(keycode com, keycode chr)
  84. -- process commands
  85.     natural t
  86.     positive_atom t_stop
  87.  
  88.     set_bk_color(WHITE)
  89.     set_color(BLUE)
  90.     if com = 'p' then      -- phasor
  91.     if nchars = 0 then
  92.         echo(chr)
  93.         set_color(BLUE+BLINKING)
  94.         puts(CRT, '_')
  95.         set_color(BLUE)
  96.         puts(CRT, "00 _._ ")
  97.         nchars = 1
  98.     elsif nchars = 1 then
  99.         position(CMD_LINE, CMD_POS+2)
  100.         pen = 100 * (chr - '0')
  101.         puts(CRT, chr)
  102.         position(CMD_LINE, CMD_POS+6)
  103.         set_color(BLUE+BLINKING)
  104.         puts(CRT, '_')
  105.         nchars = 2
  106.     elsif nchars = 2 then
  107.         position(CMD_LINE, CMD_POS+6)
  108.         if chr = '0' then
  109.         chr = '8'
  110.         elsif chr = '9' then
  111.         chr = '1'
  112.         end if
  113.         puts(CRT, chr)
  114.         position(CMD_LINE, CMD_POS+8)
  115.         set_color(BLUE+BLINKING)
  116.         puts(CRT, '_')
  117.         dir = chr - '0'
  118.         nchars = 3
  119.     else
  120.         position(CMD_LINE, CMD_POS+8)
  121.         puts(CRT, chr)
  122.         if reptime[PHASORS] then
  123.         errbeep()
  124.         msg("PHASORS DAMAGED")
  125.         elsif quadrant[EUPHORIA][Q_EN] <= pen then
  126.         errbeep()
  127.         msg("NOT ENOUGH ENERGY")
  128.         else
  129.         dir = dir + (chr - '0')/10
  130.         p_energy(-pen)
  131.         esetpt(dir)
  132.         weapon(W_PHASOR, pen)
  133.         end if
  134.         nchars = 0
  135.     end if
  136.  
  137.     elsif com = 'w' then    -- warp change
  138.     if nchars = 0 then
  139.         echo(chr)
  140.         nchars = 1
  141.         set_color(BLUE+BLINKING)
  142.         puts(CRT, '_')
  143.     else
  144.         if chr < '6' then
  145.         position(CMD_LINE, CMD_POS+2)
  146.         puts(CRT, chr)
  147.         nchars = 0
  148.         if wlimit then
  149.             setwarp(chr - '0')
  150.         else
  151.             errbeep()
  152.             msg("ALL ENGINES DAMAGED")
  153.         end if
  154.         end if
  155.     end if
  156.  
  157.     elsif com = 't' then    -- torpedo
  158.     if nchars = 0 then
  159.         echo(chr)
  160.         nchars = 1
  161.         set_color(BLUE+BLINKING)
  162.         puts(CRT, '_')
  163.         set_color(BLUE)
  164.         puts(CRT, "._")
  165.     elsif nchars = 1 then
  166.         position(CMD_LINE, CMD_POS+2)
  167.         if chr = '0' then
  168.         chr = '8'
  169.         elsif chr = '9' then
  170.         chr = '1'
  171.         end if
  172.         puts(CRT, chr)
  173.         position(CMD_LINE, CMD_POS+4)
  174.         set_color(BLUE+BLINKING)
  175.         puts(CRT, '_')
  176.         dir = chr - '0'
  177.         nchars = 2
  178.     else
  179.         position(CMD_LINE, CMD_POS+4)
  180.         puts(CRT, chr)
  181.         dir = dir + (chr - '0')/10
  182.         if reptime[TORPEDOS] then
  183.         errbeep()
  184.         msg("TORPEDO LAUNCHER DAMAGED")
  185.         else
  186.         t = quadrant[EUPHORIA][Q_TORP]
  187.         if t then
  188.             t = t - 1
  189.             quadrant[EUPHORIA][Q_TORP] = t
  190.             ts = ts[2..length(ts)]
  191.             wtext()
  192.             esetpt(dir)
  193.             weapon(W_TORPEDO, 4000)
  194.         else
  195.             errbeep()
  196.             msg("OUT OF TORPEDOS")
  197.         end if
  198.         end if
  199.         nchars = 0
  200.     end if
  201.  
  202.     elsif com = 'g' then    -- galaxy scan
  203.     echo(chr)
  204.     if scanon then
  205.         setg1()
  206.     else
  207.         if reptime[GALAXY_SENSORS] then
  208.         errbeep()
  209.         msg("SENSORS DAMAGED")
  210.         else
  211.         set_bk_color(BLUE)
  212.         set_color(WHITE)
  213.         BlankScreen(FALSE)
  214.         scanon = TRUE
  215.         for r = 1 to G_SIZE do
  216.             for c = 1 to G_SIZE do
  217.             gquad(r, c)
  218.             end for
  219.         end for
  220.         gtext()
  221.         gsbox(qrow, qcol)
  222.         set_bk_color(BLACK)
  223.         end if
  224.     end if
  225.     nchars = 0
  226.  
  227.     elsif com = 'a' then   -- antimatter pod
  228.     if nchars = 0 then
  229.         echo(chr)
  230.         nchars = 1
  231.         set_color(BLUE+BLINKING)
  232.         puts(CRT, '_')
  233.         set_color(BLUE)
  234.         puts(CRT, "._")
  235.     elsif nchars = 1 then
  236.         position(CMD_LINE, CMD_POS+2)
  237.         if chr = '0' then
  238.         chr = '8'
  239.         elsif chr = '9' then
  240.         chr = '1'
  241.         end if
  242.         puts(CRT, chr)
  243.         position(CMD_LINE, CMD_POS+4)
  244.         set_color(BLUE+BLINKING)
  245.         puts(CRT, '_')
  246.         dir = chr - '0'
  247.         nchars = 2
  248.     else
  249.         position(CMD_LINE, CMD_POS+4)
  250.         puts(CRT, chr)
  251.         if length(ps) > 0 then
  252.             set_color(BLUE+BLINKING)
  253.             puts(CRT, " Enter")
  254.             dir = dir + (chr - '0')/10
  255.         ps = ps[2..length(ps)]
  256.         wtext()
  257.         esetpt(dir)
  258.         weapon(W_POD, 1500)
  259.             position(CMD_LINE, CMD_POS+6)
  260.             set_bk_color(WHITE)
  261.             puts(CRT, "     ") 
  262.         else
  263.         errbeep()
  264.         msg("OUT OF PODS")
  265.         end if
  266.         nchars = 0
  267.     end if
  268.  
  269.     elsif com = '$' then   -- shuttlecraft
  270.     echo(chr)
  271.     if not shuttle then
  272.         if esym[1] = esymr[1] then
  273.         esym = SHUTTLE_R
  274.         else
  275.         esym = SHUTTLE_L
  276.         end if
  277.         esyml = SHUTTLE_L
  278.         esymr = SHUTTLE_R
  279.         otype[G_EU] = "SHUTTLE"
  280.         write_screen(quadrant[EUPHORIA][Q_X], 
  281.                  quadrant[EUPHORIA][Q_Y], esym)
  282.         for r = 1 to NSYS do
  283.         if reptime[r] then
  284.             reptime[r] = 0
  285.             repair(r)
  286.         end if
  287.         end for
  288.         quadrant[EUPHORIA][Q_DEFL] = 1
  289.         ds = repeat(DEFLECTOR, 1)
  290.         quadrant[EUPHORIA][Q_TORP] = 0
  291.         quadrant[EUPHORIA][Q_EN] = 5000
  292.         ts = ""
  293.         ps = ""
  294.         wtext()
  295.         puts(CRT, "         ")
  296.         shuttle = TRUE
  297.         p_energy(0)
  298.     end if
  299.  
  300.     elsif com = 'x' then   -- cancel
  301.     chr = ' '
  302.     echo(chr)
  303.     nchars = 0
  304.  
  305.     elsif com = '!' then   -- pause
  306.     echo(chr)
  307.     t_stop = time()
  308.     while get_key() != 'x' do
  309.     end while
  310.     tcb = tcb + time() - t_stop -- adjust all task activation times
  311.     echo(' ')
  312.     nchars = 0
  313.  
  314.     else
  315.     return FALSE
  316.  
  317.     end if
  318.  
  319.     return TRUE
  320. end function
  321.  
  322. without warning
  323. global procedure task_keyb()
  324. -- independent task: check the keyboard for command input
  325.     boolean x
  326.     natural tempchars
  327.     keycode chr
  328.  
  329.     while TRUE do
  330.     chr = get_key()
  331.     if not char(chr) then
  332.         exit
  333.     end if
  334.     if chr >= '0' and chr <= '9' then
  335.         if nchars then
  336.         x = docom(curcom, chr)
  337.         else
  338.         dircom(chr)
  339.         end if
  340.     else
  341.         tempchars = nchars
  342.         nchars = 0
  343.         if docom(chr, chr) then
  344.         curcom = chr
  345.         else
  346.         nchars = tempchars
  347.         end if
  348.     end if
  349.     end while
  350. end procedure
  351. with warning
  352.  
  353.