home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / games / galaxy / galaxy.bas next >
Encoding:
BASIC Source File  |  1993-05-25  |  12.1 KB  |  360 lines
  1.     ' *******************************************************************
  2.     '
  3.     '          GALAXY.BAS - QuickBASIC or QBX/PDS source code
  4.     '
  5.     '          Generates a random galaxy map.  Star systems may
  6.     '          include planets and population.  The mouse is used
  7.     '          to select a system for display.
  8.     '
  9.     '          QB or QBX must be started with the /L option to
  10.     '          use the interrupt driven mouse routines.
  11.     '
  12.     '          Written by Rich Dersheimer in May of 1993.
  13.     '          72123,1521
  14.     '
  15.     ' *******************************************************************
  16.  
  17.     DEFINT A-Z
  18.  
  19.     TYPE RegType
  20.         ax      AS INTEGER          ' This stuff sets up the
  21.         bx      AS INTEGER          ' data passed to the Interrupt
  22.         cx      AS INTEGER          ' routine that calls the mouse driver.
  23.         dx      AS INTEGER
  24.         bp      AS INTEGER          ' You must have started QB or QBX
  25.         si      AS INTEGER          ' with the /L option to load the
  26.         di      AS INTEGER          ' QB or QBX quick library.
  27.         flags   AS INTEGER
  28.     END TYPE
  29.     
  30.     TYPE StarSystem
  31.         StarX AS INTEGER
  32.         StarY AS INTEGER
  33.         Starname AS STRING * 20     ' This sets up the different data
  34.         Planet1 AS STRING * 20      ' fields for each system location,
  35.         Planet1Pop AS INTEGER       ' name, number of planets, and each
  36.         Planet2 AS STRING * 20      ' planets population.  You could add
  37.         Planet2Pop AS INTEGER       ' more info, like planet defenses,
  38.         Planet3 AS STRING * 20      ' production value, etc.
  39.         Planet3Pop AS INTEGER
  40.     END TYPE
  41.  
  42.     ' This is the Interrupt routine in your QBX or QB Quick Library.
  43.     ' In GALAXY, it is used to control the mouse driver.
  44.     DECLARE SUB Interrupt (IntNum%, iReg AS RegType, oReg AS RegType)
  45.  
  46.     ' The DrawFont Sub draws whatever text you need to display on
  47.     ' the screen.  You pass it the text coordinates (1 to 43 vertical,
  48.     ' 1 to 80 horizontal), the string to display, and the color for the
  49.     ' characters.  It calculates the graphics position for the string,
  50.     ' draws it in the proper color, with a black shadow.
  51.     DECLARE SUB DrawFont (DrawFontY, DrawFontX, Display$, FontColor)
  52.  
  53.     ' These Subs handle the mouse functions.
  54.     DECLARE SUB MouseInit ()
  55.     DECLARE SUB ShowMouse ()
  56.     DECLARE SUB HideMouse ()
  57.     DECLARE SUB PollMouse ()
  58.  
  59.  
  60.     ' A bunch of variables I'm using in various Subs.
  61.     DIM SHARED CurX, CurY
  62.     DIM SHARED Star(1 TO 50) AS StarSystem
  63.     DIM SHARED iReg AS RegType
  64.     DIM SHARED oReg AS RegType
  65.     DIM SHARED Font$(0 TO 40)
  66.  
  67.     Null$ = STRING$(20, 0)  ' Initial value for StarSystem strings.
  68.  
  69.     Font$(0) = ""                       ' space
  70.     Font$(1) = "u5er2fd2l4r4d3bl4"      ' A
  71.     Font$(2) = "u6r3fdgl3r3fdgl3"       ' B
  72.     Font$(3) = "buu4er2fbd4gl2hbd"      ' C
  73.     Font$(4) = "u6r2f2d2g2l2"           ' D
  74.     Font$(5) = "u6r4lbd3l3d3r4l4"       ' E
  75.     Font$(6) = "u6r4l4d3r3l3d3"         ' F     These are the upper-case
  76.     Font$(7) = "buu4er2fbg2r2d3l3hbd"   ' G     characters and some symbols.
  77.     Font$(8) = "u6d3r4u3d6bl4"          ' H     You can add to or change
  78.     Font$(9) = "r4l2u6r2l4bd6"          ' I     these to suit your needs.
  79.     Font$(10) = "bu3d2fr2eu5l2bl2bd6"   ' J
  80.     Font$(11) = "u6d3re3g3f3bl4"        ' K
  81.     Font$(12) = "u6d6r4l4"              ' L
  82.     Font$(13) = "u6f2e2d6bl4"           ' M
  83.     Font$(14) = "u6f4u4d6bl4"           ' N
  84.     Font$(15) = "buu4er2fd4gl2hbd"      ' O
  85.     Font$(16) = "u6r3fdgl3d3"           ' P
  86.     Font$(17) = "buu4er2fd4guhf2l3hbd"  ' Q
  87.     Font$(18) = "u6r3fdgl2f3bl4"        ' R
  88.     Font$(19) = "bufr2euhl2huer2fbd5bl4"' S
  89.     Font$(20) = "br2u6r2l4bd6"          ' T
  90.     Font$(21) = "bu6d5fr2eu5bl4bd6"     ' U
  91.     Font$(22) = "bu6d4f2e2u4bl4bd6"     ' V
  92.     Font$(23) = "bu6d5feu2d2feu5bl4bd6" ' W
  93.     Font$(24) = "bu6df2e2ubd6uh2g2d"    ' X
  94.     Font$(25) = "bu6d2f2d2u2e2u2bl4bd6" ' Y
  95.     Font$(26) = "bu6r4dg4dr4l4"         ' Z
  96.     Font$(27) = "brr2lu6gbd5bl"         ' 1
  97.     Font$(28) = "r4l4u3r4u3l4bd6"       ' 2
  98.     Font$(29) = "r4u3l3r3u3l4bd6"       ' 3
  99.     Font$(30) = "br4u6d3l4u3bd6"        ' 4
  100.     Font$(31) = "r4u3l4u3r4l4bd6"       ' 5
  101.     Font$(32) = "u6d3r4d3l4"            ' 6
  102.     Font$(33) = "bu5er3d6bl4"           ' 7
  103.     Font$(34) = "u6r4d3l4r4d3l4"        ' 8
  104.     Font$(35) = "bu3r4l4u3r4d6bl4"      ' 9
  105.     Font$(36) = "u6r4d6l4"              ' 0
  106.     Font$(37) = "br2buubu2ubl2bd5"      ' :
  107.     Font$(38) = "bu3r4l4bd3"            ' -
  108.     Font$(39) = "br2bu6d2bd4bl3"        ' '
  109.     Font$(40) = "brruldbl"              ' .
  110.  
  111.     SCREEN 9
  112.     WIDTH 80, 43
  113.     RANDOMIZE -TIMER
  114.     COLOR 7, 0
  115.     CLS
  116.  
  117.     ' Draw the main screen - light gray with a black inset box.
  118.     LINE (0, 0)-(640, 350), 7, BF
  119.     LINE (16, 8)-(624, 240), 0, BF
  120.     LINE (14, 6)-(626, 6), 8
  121.     LINE (15, 7)-(625, 7), 8
  122.     LINE (14, 6)-(14, 241), 8
  123.     LINE (15, 7)-(15, 240), 8
  124.     LINE (626, 6)-(626, 241), 15
  125.     LINE (625, 7)-(625, 240), 15
  126.     LINE (14, 242)-(626, 242), 15
  127.     LINE (15, 241)-(625, 241), 15
  128.  
  129.     ' Add some sprinkles in the background.
  130.     FOR Sprinkle = 1 TO 250
  131.         PSET (RND(1) * 608 + 16, RND(1) * 232 + 8), 7
  132.     NEXT Sprinkle
  133.  
  134.     ' Set the number of star systems in the galaxy.
  135.     ' The number should match the number used in the
  136.     ' DIMENSION statement for the Star() StarSystem-type array.
  137.     NumberOfStars = 50
  138.  
  139.     FOR C = 1 TO NumberOfStars
  140.  
  141.         DO
  142.             RndX = INT(RND(1) * 76 + 3)     ' Give each system a unique
  143.             RndY = INT(RND(1) * 29 + 2)     ' coordinate location.
  144.             StarDuplicated = -1
  145.  
  146.             FOR S = 1 TO C
  147.                 IF RndX = Star(S).StarX AND RndY = Star(S).StarY THEN
  148.                     StarDuplicated = 0
  149.                 END IF
  150.             NEXT S
  151.  
  152.         LOOP WHILE NOT StarDuplicated
  153.  
  154.         Star(C).StarX = RndX                ' Give each system a name.
  155.         Star(C).StarY = RndY
  156.         READ Star(C).Starname
  157.         LName$ = RTRIM$(Star(C).Starname)   ' Trim the extra spaces off.
  158.  
  159.         ' Decide how many habitable planets &
  160.         ' how much population each system has.
  161.         ' The probablity for having planets
  162.         ' is 1 in 10 for a Venus orbit type
  163.         ' planet, 1 in 3 for an Earth orbit
  164.         ' planet, and 1 in 8 for a Mars orbit
  165.         ' habitable planet.  These can be changed
  166.         ' to suit your personal universe preference.
  167.  
  168.         IF INT(RND(1) * 10) = 1 THEN
  169.             Star(C).Planet1 = LName$ + "-2"
  170.             Star(C).Planet1Pop = INT(RND(1) * 100 + 1)
  171.         END IF
  172.  
  173.         IF INT(RND(1) * 3) = 1 THEN
  174.             Star(C).Planet2 = LName$ + "-3"
  175.             Star(C).Planet2Pop = INT(RND(1) * 100 + 1)
  176.         END IF
  177.  
  178.         IF INT(RND(1) * 8) = 1 THEN
  179.             Star(C).Planet3 = LName$ + "-4"
  180.             Star(C).Planet3Pop = INT(RND(1) * 100 + 1)
  181.         END IF
  182.  
  183.         ' Draw a little sun at each system location.
  184.         ' You could use different PAINT colors to show star
  185.         ' type (Type-G, white dwarf, red giant, whatever), or
  186.         ' ownership, or if the system has been scouted, etc.
  187.         CIRCLE ((RndX - 1) * 8 + 3, (RndY - 1) * 8 + 3), 3, 12
  188.         PAINT ((RndX - 1) * 8 + 3, (RndY - 1) * 8 + 3), 14, 12
  189.     NEXT C
  190.  
  191.     DrawFont 33, 3, "GALAXY SECTOR MAP 1", 14
  192.     
  193.     MouseInit   ' Set up the mouse cursor.
  194.     ShowMouse
  195.  
  196.     ' Here's the main loop for program execution.
  197.  
  198.     DO
  199.  
  200.     ShowMouse   ' Wait for a left-button click.
  201.     PollMouse
  202.     HideMouse
  203.     
  204.     DRAW "S8"   ' Change to large typestyle.
  205.  
  206.     LINE (175, 245)-(630, 350), 7, BF    ' Clear the text area.
  207.     
  208.     FOR C = 1 TO NumberOfStars
  209.  
  210.         ' If the player clicked on a star system,
  211.         ' display the system name, coordinates,
  212.         ' number of planets, and total population.
  213.         IF Star(C).StarX = CurX AND Star(C).StarY = CurY THEN
  214.             DrawFont 34, 32, "SYSTEM:", 14
  215.             DrawFont 34, 46, (RTRIM$(Star(C).Starname)), 15
  216.             DrawFont 37, 32, "SECTOR:", 14
  217.             COORD$ = LTRIM$(STR$(CurX - 2)) + "-" + LTRIM$(STR$(CurY - 1))
  218.             DrawFont 37, 46, COORD$, 15
  219.             DrawFont 40, 30, "PLANETS:", 14
  220.             Planets = 0
  221.             IF Star(C).Planet1 <> Null$ THEN Planets = Planets + 1
  222.             IF Star(C).Planet2 <> Null$ THEN Planets = Planets + 1
  223.             IF Star(C).Planet3 <> Null$ THEN Planets = Planets + 1
  224.             TotalPop = Star(C).Planet1Pop + Star(C).Planet2Pop
  225.             TotalPop = TotalPop + Star(C).Planet3Pop
  226.             
  227.             IF Planets THEN
  228.                 DrawFont 40, 46, LTRIM$(STR$(Planets)), 15
  229.                 DrawFont 43, 24, "Population:", 14
  230.                 DrawFont 43, 44, STR$(TotalPop), 15
  231.             ELSE
  232.                 DrawFont 40, 46, "NONE", 15
  233.             END IF
  234.  
  235.             EXIT FOR    ' If you've displayed a system, don't look for more.
  236.         END IF
  237.  
  238.     NEXT C
  239.     
  240.     LOOP
  241.  
  242.         ' Here are the system names.  You can change them,
  243.         ' or even have the player name the systems.
  244.         DATA Lee's Gate, Procyon, Antares, Agena, Adara, Sigh-Mee
  245.         DATA Nihal, Vega, Saiph, Algol, Schedar, Rastaban
  246.         DATA Izar, Sirius, Nunki, Etamin, Alioth, Wesen
  247.         DATA Mirzam, Ascella, Spica, Gemma, Wolf, Arneb
  248.         DATA Mintaka, Aron Minor, Canopus, Altair, Mizar, Polaris
  249.         DATA Rich-D-37, Capella, Zosma, Almak, Alhena, Chan
  250.         DATA Thuban, Nath, Deneb, Ross, Regulus, Hamal, Castor
  251.         DATA Centauri, Rigel, Acrux, Pollux, Phaeda, Sabik, Megrez
  252.  
  253. '
  254. '
  255. '
  256. ' SUBROUTINE: DrawFont **********************************************
  257. SUB DrawFont (DrawFontY, DrawFontX, Display$, FontColor) STATIC
  258.  
  259.     ' Test$ is searched to find a valid, displayable character.
  260.     Test$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890:-'."
  261.  
  262.     ' Find the graphic location for the first character.
  263.     DFX = (DrawFontX - 1) * 8 + 1
  264.     DFY = (DrawFontY - 1) * 8 + 1
  265.  
  266.     ' Move the graphic cursor to the first character location.
  267.     DRAW "BM" + STR$(DFX) + "," + STR$(DFY)
  268.  
  269.     ' Make sure there are no lower case letters.
  270.     Display$ = UCASE$(Display$)
  271.  
  272.     ' Draw the shadow, then the main color for each character.
  273.     FOR x = 1 TO LEN(Display$)
  274.         a = INSTR(Test$, MID$(Display$, x, 1)) - 1
  275.         IF a < 0 THEN a = 0
  276.         DRAW "C0"                       ' Use 0 for the shadow color.
  277.         DRAW Font$(a)                   ' Draw the shadow.
  278.         DRAW "bhc" + STR$(FontColor)    ' Shift up & left and use the
  279.         DRAW Font$(a)                   ' main color to draw the character.
  280.         DRAW "br8bf"                    ' Move to next character place.
  281.     NEXT x
  282.  
  283. END SUB
  284.  
  285. '
  286. '
  287. '
  288. ' SUBROUTINE: HideMouse *********************************************
  289. SUB HideMouse
  290.  
  291.     ' Hide the mouse cursor.
  292.     iReg.ax = 2
  293.     Interrupt &H33, iReg, oReg
  294.  
  295. END SUB
  296.  
  297. '
  298. '
  299. '
  300. ' SUBROUTINE: MouseInit *********************************************
  301. SUB MouseInit
  302.  
  303.     ' Reset the mouse driver.
  304.     iReg.ax = 0
  305.     Interrupt &H33, iReg, oReg
  306.  
  307.     ' Tell the mouse driver what video mode you are using.
  308.     iReg.ax = 40
  309.     iReg.cx = 9
  310.     iReg.dx = 0
  311.     Interrupt &H33, iReg, oReg
  312.  
  313. END SUB
  314.  
  315. '
  316. '
  317. '
  318. ' SUBROUTINE: PollMouse *********************************************
  319. SUB PollMouse
  320.  
  321.     ' Poll the mouse for a left-button press
  322.     oReg.bx = 0
  323.     
  324.     DO
  325.  
  326.         iReg.ax = 5
  327.         iReg.bx = 0
  328.         Interrupt &H33, iReg, oReg
  329.  
  330.         ' This returns the text screen y and x for the mouse cursor.
  331.         CurX = INT(oReg.cx / 8) + 1
  332.         CurY = INT(oReg.dx / 8) + 1
  333.  
  334.         ' Press the ESC key to end the program.
  335.         IF INKEY$ = CHR$(27) THEN
  336.             HideMouse                   ' Make sure you hide the mouse
  337.             SCREEN 0                    ' cursor & reset the screen width!
  338.             WIDTH 80, 25
  339.             COLOR 7, 0
  340.             CLS
  341.             END
  342.         END IF
  343.  
  344.     LOOP WHILE oReg.bx = 0
  345.  
  346. END SUB
  347.  
  348. '
  349. '
  350. '
  351. ' SUBROUTINE: ShowMouse *********************************************
  352. SUB ShowMouse
  353.  
  354.     ' Show the mouse cursor.
  355.     iReg.ax = 1
  356.     Interrupt &H33, iReg, oReg
  357.  
  358. END SUB
  359.  
  360.