Author Topic: Shooter Start (Read 3380 times)

SMcNeill · « **on:** March 30, 2019, 08:31:53 pm »

Code: QB64: [Select]

CONST AliceBlue = &HFFF0F8FF~& ' _RGB32(240,248,255)
CONST Almond = &HFFEFDECD~& '_RGB32(239,222,205)
CONST AntiqueBrass = &HFFCD9575~& '_RGB32(205,149,117)
CONST AntiqueWhite = &HFFFAEBD7~& ' _RGB32(250,235,215)
CONST Apricot = &HFFFDD9B5~& '_RGB32(253,217,181)
CONST Aqua = &HFF00FFFF~& ' _RGB32(0,255,255)
CONST Aquamarine = &HFF7FFFD4~& ' _RGB32(127,255,212)
CONST Asparagus = &HFF87A96B~& '_RGB32(135,169,107)
CONST AtomicTangerine = &HFFFFA474~& '_RGB32(255,164,116)
CONST Azure = &HFFF0FFFF~& ' _RGB32(240,255,255)
CONST BananaMania = &HFFFAE7B5~& '_RGB32(250,231,181)
CONST Beaver = &HFF9F8170~& '_RGB32(159,129,112)
CONST Beige = &HFFF5F5DC~& ' _RGB32(245,245,220)
CONST Bisque = &HFFFFE4C4~& ' _RGB32(255,228,196)
CONST Bittersweet = &HFFFD7C6E~& '_RGB32(253,124,110)
CONST Black = &HFF000000~& ' _RGB32(0,0,0)
CONST BlanchedAlmond = &HFFFFEBCD~& ' _RGB32(255,235,205)
CONST BlizzardBlue = &HFFACE5EE~& '_RGB32(172,229,238)
CONST Blue = &HFF0000FF~& ' _RGB32(0,0,255)
CONST BlueBell = &HFFA2A2D0~& '_RGB32(162,162,208)
CONST BlueGray = &HFF6699CC~& '_RGB32(102,153,204)
CONST BlueGreen = &HFF0D98BA~& '_RGB32(13,152,186)
CONST BlueViolet = &HFF8A2BE2~& ' _RGB32(138,43,226)
CONST Blush = &HFFDE5D83~& '_RGB32(222,93,131)
CONST BrickRed = &HFFCB4154~& '_RGB32(203,65,84)
CONST Brown = &HFFA52A2A~& ' _RGB32(165,42,42)
CONST BurlyWood = &HFFDEB887~& ' _RGB32(222,184,135)
CONST BurntOrange = &HFFFF7F49~& '_RGB32(255,127,73)
CONST BurntSienna = &HFFEA7E5D~& '_RGB32(234,126,93)
CONST CadetBlue = &HFF5F9EA0~& ' _RGB32(95,158,160)
CONST Canary = &HFFFFFF99~& '_RGB32(255,255,153)
CONST CaribbeanGreen = &HFF1CD3A2~& '_RGB32(28,211,162)
CONST CarnationPink = &HFFFFAACC~& '_RGB32(255,170,204)
CONST Cerise = &HFFDD4492~& '_RGB32(221,68,146)
CONST Cerulean = &HFF1DACD6~& '_RGB32(29,172,214)
CONST ChartReuse = &HFF7FFF00~& ' _RGB32(127,255,0)
CONST Chestnut = &HFFBC5D58~& '_RGB32(188,93,88)
CONST Chocolate = &HFFD2691E~& ' _RGB32(210,105,30)
CONST Copper = &HFFDD9475~& '_RGB32(221,148,117)
CONST Coral = &HFFFF7F50~& ' _RGB32(255,127,80)
CONST Cornflower = &HFF9ACEEB~& '_RGB32(154,206,235)
CONST CornflowerBlue = &HFF6495ED~& ' _RGB32(100,149,237)
CONST Cornsilk = &HFFFFF8DC~& ' _RGB32(255,248,220)
CONST CottonCandy = &HFFFFBCD9~& '_RGB32(255,188,217)
CONST CrayolaAquamarine = &HFF78DBE2~& '_RGB32(120,219,226)
CONST CrayolaBlue = &HFF1F75FE~& '_RGB32(31,117,254)
CONST CrayolaBlueViolet = &HFF7366BD~& '_RGB32(115,102,189)
CONST CrayolaBrown = &HFFB4674D~& '_RGB32(180,103,77)
CONST CrayolaCadetBlue = &HFFB0B7C6~& '_RGB32(176,183,198)
CONST CrayolaForestGreen = &HFF6DAE81~& '_RGB32(109,174,129)
CONST CrayolaGold = &HFFE7C697~& '_RGB32(231,198,151)
CONST CrayolaGoldenrod = &HFFFCD975~& '_RGB32(252,217,117)
CONST CrayolaGray = &HFF95918C~& '_RGB32(149,145,140)
CONST CrayolaGreen = &HFF1CAC78~& '_RGB32(28,172,120)
CONST CrayolaGreenYellow = &HFFF0E891~& '_RGB32(240,232,145)
CONST CrayolaIndigo = &HFF5D76CB~& '_RGB32(93,118,203)
CONST CrayolaLavender = &HFFFCB4D5~& '_RGB32(252,180,213)
CONST CrayolaMagenta = &HFFF664AF~& '_RGB32(246,100,175)
CONST CrayolaMaroon = &HFFC8385A~& '_RGB32(200,56,90)
CONST CrayolaMidnightBlue = &HFF1A4876~& '_RGB32(26,72,118)
CONST CrayolaOrange = &HFFFF7538~& '_RGB32(255,117,56)
CONST CrayolaOrangeRed = &HFFFF2B2B~& '_RGB32(255,43,43)
CONST CrayolaOrchid = &HFFE6A8D7~& '_RGB32(230,168,215)
CONST CrayolaPlum = &HFF8E4585~& '_RGB32(142,69,133)
CONST CrayolaRed = &HFFEE204D~& '_RGB32(238,32,77)
CONST CrayolaSalmon = &HFFFF9BAA~& '_RGB32(255,155,170)
CONST CrayolaSeaGreen = &HFF9FE2BF~& '_RGB32(159,226,191)
CONST CrayolaSilver = &HFFCDC5C2~& '_RGB32(205,197,194)
CONST CrayolaSkyBlue = &HFF80DAEB~& '_RGB32(128,218,235)
CONST CrayolaSpringGreen = &HFFECEABE~& '_RGB32(236,234,190)
CONST CrayolaTann = &HFFFAA76C~& '_RGB32(250,167,108)
CONST CrayolaThistle = &HFFEBC7DF~& '_RGB32(235,199,223)
CONST CrayolaViolet = &HFF926EAE~& '_RGB32(146,110,174)
CONST CrayolaYellow = &HFFFCE883~& '_RGB32(252,232,131)
CONST CrayolaYellowGreen = &HFFC5E384~& '_RGB32(197,227,132)
CONST Crimson = &HFFDC143C~& ' _RGB32(220,20,60)
CONST Cyan = &HFF00FFFF~& ' _RGB32(0,255,255)
CONST Dandelion = &HFFFDDB6D~& '_RGB32(253,219,109)
CONST DarkBlue = &HFF00008B~& ' _RGB32(0,0,139)
CONST DarkCyan = &HFF008B8B~& ' _RGB32(0,139,139)
CONST DarkGoldenRod = &HFFB8860B~& ' _RGB32(184,134,11)
CONST DarkGray = &HFFA9A9A9~& ' _RGB32(169,169,169)
CONST DarkGreen = &HFF006400~& ' _RGB32(0,100,0)
CONST DarkKhaki = &HFFBDB76B~& ' _RGB32(189,183,107)
CONST DarkMagenta = &HFF8B008B~& ' _RGB32(139,0,139)
CONST DarkOliveGreen = &HFF556B2F~& ' _RGB32(85,107,47)
CONST DarkOrange = &HFFFF8C00~& ' _RGB32(255,140,0)
CONST DarkOrchid = &HFF9932CC~& ' _RGB32(153,50,204)
CONST DarkRed = &HFF8B0000~& ' _RGB32(139,0,0)
CONST DarkSalmon = &HFFE9967A~& ' _RGB32(233,150,122)
CONST DarkSeaGreen = &HFF8FBC8F~& ' _RGB32(143,188,143)
CONST DarkSlateBlue = &HFF483D8B~& ' _RGB32(72,61,139)
CONST DarkSlateGray = &HFF2F4F4F~& ' _RGB32(47,79,79)
CONST DarkTurquoise = &HFF00CED1~& ' _RGB32(0,206,209)
CONST DarkViolet = &HFF9400D3~& ' _RGB32(148,0,211)
CONST DeepPink = &HFFFF1493~& ' _RGB32(255,20,147)
CONST DeepSkyBlue = &HFF00BFFF~& ' _RGB32(0,191,255)
CONST Denim = &HFF2B6CC4~& '_RGB32(43,108,196)
CONST DesertSand = &HFFEFCDB8~& '_RGB32(239,205,184)
CONST DimGray = &HFF696969~& ' _RGB32(105,105,105)
CONST DodgerBlue = &HFF1E90FF~& ' _RGB32(30,144,255)
CONST Eggplant = &HFF6E5160~& '_RGB32(110,81,96)
CONST ElectricLime = &HFFCEFF1D~& '_RGB32(206,255,29)
CONST Fern = &HFF71BC78~& '_RGB32(113,188,120)
CONST FireBrick = &HFFB22222~& ' _RGB32(178,34,34)
CONST Floralwhite = &HFFFFFAF0~& ' _RGB32(255,250,240)
CONST ForestGreen = &HFF228B22~& ' _RGB32(34,139,34)
CONST Fuchsia = &HFFC364C5~& '_RGB32(195,100,197)
CONST FuzzyWuzzy = &HFFCC6666~& '_RGB32(204,102,102)
CONST Gainsboro = &HFFDCDCDC~& ' _RGB32(220,220,220)
CONST GhostWhite = &HFFF8F8FF~& ' _RGB32(248,248,255)
CONST Gold = &HFFFFD700~& ' _RGB32(255,215,0)
CONST GoldenRod = &HFFDAA520~& ' _RGB32(218,165,32)
CONST GrannySmithApple = &HFFA8E4A0~& '_RGB32(168,228,160)
CONST Gray = &HFF808080~& ' _RGB32(128,128,128)
CONST Green = &HFF008000~& ' _RGB32(0,128,0)
CONST GreenBlue = &HFF1164B4~& '_RGB32(17,100,180)
CONST GreenYellow = &HFFADFF2F~& ' _RGB32(173,255,47)
CONST HoneyDew = &HFFF0FFF0~& ' _RGB32(240,255,240)
CONST HotMagenta = &HFFFF1DCE~& '_RGB32(255,29,206)
CONST HotPink = &HFFFF69B4~& ' _RGB32(255,105,180)
CONST Inchworm = &HFFB2EC5D~& '_RGB32(178,236,93)
CONST IndianRed = &HFFCD5C5C~& ' _RGB32(205,92,92)
CONST Indigo = &HFF4B0082~& ' _RGB32(75,0,130)
CONST Ivory = &HFFFFFFF0~& ' _RGB32(255,255,240)
CONST JazzberryJam = &HFFCA3767~& '_RGB32(202,55,103)
CONST JungleGreen = &HFF3BB08F~& '_RGB32(59,176,143)
CONST Khaki = &HFFF0E68C~& ' _RGB32(240,230,140)
CONST LaserLemon = &HFFFEFE22~& '_RGB32(254,254,34)
CONST Lavender = &HFFE6E6FA~& ' _RGB32(230,230,250)
CONST LavenderBlush = &HFFFFF0F5~& ' _RGB32(255,240,245)
CONST LawnGreen = &HFF7CFC00~& ' _RGB32(124,252,0)
CONST LemonChiffon = &HFFFFFACD~& ' _RGB32(255,250,205)
CONST LemonYellow = &HFFFFF44F~& '_RGB32(255,244,79)
CONST LightBlue = &HFFADD8E6~& ' _RGB32(173,216,230)
CONST LightCoral = &HFFF08080~& ' _RGB32(240,128,128)
CONST LightCyan = &HFFE0FFFF~& ' _RGB32(224,255,255)
CONST LightGoldenRodYellow = &HFFFAFAD2~& ' _RGB32(250,250,210)
CONST LightGray = &HFFD3D3D3~& ' _RGB32(211,211,211)
CONST LightGreen = &HFF90EE90~& ' _RGB32(144,238,144)
CONST LightPink = &HFFFFB6C1~& ' _RGB32(255,182,193)
CONST LightSalmon = &HFFFFA07A~& ' _RGB32(255,160,122)
CONST LightSeaGreen = &HFF20B2AA~& ' _RGB32(32,178,170)
CONST LightSkyBlue = &HFF87CEFA~& ' _RGB32(135,206,250)
CONST LightSlateGray = &HFF778899~& ' _RGB32(119,136,153)
CONST LightSteelBlue = &HFFB0C4DE~& ' _RGB32(176,196,222)
CONST LightYellow = &HFFFFFFE0~& ' _RGB32(255,255,224)
CONST Lime = &HFF00FF00~& ' _RGB32(0,255,0)
CONST LimeGreen = &HFF32CD32~& ' _RGB32(50,205,50)
CONST Linen = &HFFFAF0E6~& ' _RGB32(250,240,230)
CONST MacaroniAndCheese = &HFFFFBD88~& '_RGB32(255,189,136)
CONST Magenta = &HFFFF00FF~& ' _RGB32(255,0,255)
CONST MagicMint = &HFFAAF0D1~& '_RGB32(170,240,209)
CONST Mahogany = &HFFCD4A4C~& '_RGB32(205,74,76)
CONST Maize = &HFFEDD19C~& '_RGB32(237,209,156)
CONST Manatee = &HFF979AAA~& '_RGB32(151,154,170)
CONST MangoTango = &HFFFF8243~& '_RGB32(255,130,67)
CONST Maroon = &HFF800000~& ' _RGB32(128,0,0)
CONST Mauvelous = &HFFEF98AA~& '_RGB32(239,152,170)
CONST MediumAquamarine = &HFF66CDAA~& ' _RGB32(102,205,170)
CONST MediumBlue = &HFF0000CD~& ' _RGB32(0,0,205)
CONST MediumOrchid = &HFFBA55D3~& ' _RGB32(186,85,211)
CONST MediumPurple = &HFF9370DB~& ' _RGB32(147,112,219)
CONST MediumSeaGreen = &HFF3CB371~& ' _RGB32(60,179,113)
CONST MediumSlateBlue = &HFF7B68EE~& ' _RGB32(123,104,238)
CONST MediumSpringGreen = &HFF00FA9A~& ' _RGB32(0,250,154)
CONST MediumTurquoise = &HFF48D1CC~& ' _RGB32(72,209,204)
CONST MediumVioletRed = &HFFC71585~& ' _RGB32(199,21,133)
CONST Melon = &HFFFDBCB4~& '_RGB32(253,188,180)
CONST MidnightBlue = &HFF191970~& ' _RGB32(25,25,112)
CONST MintCream = &HFFF5FFFA~& ' _RGB32(245,255,250)
CONST MistyRose = &HFFFFE4E1~& ' _RGB32(255,228,225)
CONST Moccasin = &HFFFFE4B5~& ' _RGB32(255,228,181)
CONST MountainMeadow = &HFF30BA8F~& '_RGB32(48,186,143)
CONST Mulberry = &HFFC54B8C~& '_RGB32(197,75,140)
CONST NavajoWhite = &HFFFFDEAD~& ' _RGB32(255,222,173)
CONST Navy = &HFF000080~& ' _RGB32(0,0,128)
CONST NavyBlue = &HFF1974D2~& '_RGB32(25,116,210)
CONST NeonCarrot = &HFFFFA343~& '_RGB32(255,163,67)
CONST OldLace = &HFFFDF5E6~& ' _RGB32(253,245,230)
CONST Olive = &HFF808000~& ' _RGB32(128,128,0)
CONST OliveDrab = &HFF6B8E23~& ' _RGB32(107,142,35)
CONST OliveGreen = &HFFBAB86C~& '_RGB32(186,184,108)
CONST Orange = &HFFFFA500~& ' _RGB32(255,165,0)
CONST OrangeRed = &HFFFF4500~& ' _RGB32(255,69,0)
CONST OrangeYellow = &HFFF8D568~& '_RGB32(248,213,104)
CONST Orchid = &HFFDA70D6~& ' _RGB32(218,112,214)
CONST OuterSpace = &HFF414A4C~& '_RGB32(65,74,76)
CONST OutrageousOrange = &HFFFF6E4A~& '_RGB32(255,110,74)
CONST PacificBlue = &HFF1CA9C9~& '_RGB32(28,169,201)
CONST PaleGoldenRod = &HFFEEE8AA~& ' _RGB32(238,232,170)
CONST PaleGreen = &HFF98FB98~& ' _RGB32(152,251,152)
CONST PaleTurquoise = &HFFAFEEEE~& ' _RGB32(175,238,238)
CONST PaleVioletRed = &HFFDB7093~& ' _RGB32(219,112,147)
CONST PapayaWhip = &HFFFFEFD5~& ' _RGB32(255,239,213)
CONST Peach = &HFFFFCFAB~& '_RGB32(255,207,171)
CONST PeachPuff = &HFFFFDAB9~& ' _RGB32(255,218,185)
CONST Periwinkle = &HFFC5D0E6~& '_RGB32(197,208,230)
CONST Peru = &HFFCD853F~& ' _RGB32(205,133,63)
CONST PiggyPink = &HFFFDDDE6~& '_RGB32(253,221,230)
CONST PineGreen = &HFF158078~& '_RGB32(21,128,120)
CONST Pink = &HFFFFC0CB~& ' _RGB32(255,192,203)
CONST PinkFlamingo = &HFFFC74FD~& '_RGB32(252,116,253)
CONST PinkSherbet = &HFFF78FA7~& '_RGB32(247,143,167)
CONST Plum = &HFFDDA0DD~& ' _RGB32(221,160,221)
CONST PowderBlue = &HFFB0E0E6~& ' _RGB32(176,224,230)
CONST Purple = &HFF800080~& ' _RGB32(128,0,128)
CONST PurpleHeart = &HFF7442C8~& '_RGB32(116,66,200)
CONST PurpleMountainsMajesty = &HFF9D81BA~& '_RGB32(157,129,186)
CONST PurplePizzazz = &HFFFE4EDA~& '_RGB32(254,78,218)
CONST RadicalRed = &HFFFF496C~& '_RGB32(255,73,108)
CONST RawSienna = &HFFD68A59~& '_RGB32(214,138,89)
CONST RawUmber = &HFF714B23~& '_RGB32(113,75,35)
CONST RazzleDazzleRose = &HFFFF48D0~& '_RGB32(255,72,208)
CONST Razzmatazz = &HFFE3256B~& '_RGB32(227,37,107)
CONST Red = &HFFFF0000~& ' _RGB32(255,0,0)
CONST RedOrange = &HFFFF5349~& '_RGB32(255,83,73)
CONST RedViolet = &HFFC0448F~& '_RGB32(192,68,143)
CONST RobinsEggBlue = &HFF1FCECB~& '_RGB32(31,206,203)
CONST RosyBrown = &HFFBC8F8F~& ' _RGB32(188,143,143)
CONST RoyalBlue = &HFF4169E1~& ' _RGB32(65,105,225)
CONST RoyalPurple = &HFF7851A9~& '_RGB32(120,81,169)
CONST SaddleBrown = &HFF8B4513~& ' _RGB32(139,69,19)
CONST Salmon = &HFFFA8072~& ' _RGB32(250,128,114)
CONST SandyBrown = &HFFF4A460~& ' _RGB32(244,164,96)
CONST Scarlet = &HFFFC2847~& '_RGB32(252,40,71)
CONST ScreaminGreen = &HFF76FF7A~& '_RGB32(118,255,122)
CONST SeaGreen = &HFF2E8B57~& ' _RGB32(46,139,87)
CONST SeaShell = &HFFFFF5EE~& ' _RGB32(255,245,238)
CONST Sepia = &HFFA5694F~& '_RGB32(165,105,79)
CONST Shadow = &HFF8A795D~& '_RGB32(138,121,93)
CONST Shamrock = &HFF45CEA2~& '_RGB32(69,206,162)
CONST ShockingPink = &HFFFB7EFD~& '_RGB32(251,126,253)
CONST Sienna = &HFFA0522D~& ' _RGB32(160,82,45)
CONST Silver = &HFFC0C0C0~& ' _RGB32(192,192,192)
CONST SkyBlue = &HFF87CEEB~& ' _RGB32(135,206,235)
CONST SlateBlue = &HFF6A5ACD~& ' _RGB32(106,90,205)
CONST SlateGray = &HFF708090~& ' _RGB32(112,128,144)
CONST Snow = &HFFFFFAFA~& ' _RGB32(255,250,250)
CONST SpringGreen = &HFF00FF7F~& ' _RGB32(0,255,127)
CONST SteelBlue = &HFF4682B4~& ' _RGB32(70,130,180)
CONST Sunglow = &HFFFFCF48~& '_RGB32(255,207,72)
CONST SunsetOrange = &HFFFD5E53~& '_RGB32(253,94,83)
CONST Tann = &HFFD2B48C~& ' _RGB32(210,180,140)
CONST Teal = &HFF008080~& ' _RGB32(0,128,128)
CONST TealBlue = &HFF18A7B5~& '_RGB32(24,167,181)
CONST Thistle = &HFFD8BFD8~& ' _RGB32(216,191,216)
CONST TickleMePink = &HFFFC89AC~& '_RGB32(252,137,172)
CONST Timberwolf = &HFFDBD7D2~& '_RGB32(219,215,210)
CONST Tomato = &HFFFF6347~& ' _RGB32(255,99,71)
CONST TropicalRainForest = &HFF17806D~& '_RGB32(23,128,109)
CONST Tumbleweed = &HFFDEAA88~& '_RGB32(222,170,136)
CONST Turquoise = &HFF40E0D0~& ' _RGB32(64,224,208)
CONST TurquoiseBlue = &HFF77DDE7~& '_RGB32(119,221,231)
CONST UnmellowYellow = &HFFFFFF66~& '_RGB32(255,255,102)
CONST Violet = &HFFEE82EE~& ' _RGB32(238,130,238)
CONST VioletBlue = &HFF324AB2~& '_RGB32(50,74,178)
CONST VioletRed = &HFFF75394~& '_RGB32(247,83,148)
CONST VividTangerine = &HFFFFA089~& '_RGB32(255,160,137)
CONST VividViolet = &HFF8F509D~& '_RGB32(143,80,157)
CONST Wheat = &HFFF5DEB3~& ' _RGB32(245,222,179)
CONST White = &HFFFFFFFF~& ' _RGB32(255,255,255)
CONST Whitesmoke = &HFFF5F5F5~& ' _RGB32(245,245,245)
CONST WildBlueYonder = &HFFA2ADD0~& '_RGB32(162,173,208)
CONST WildStrawberry = &HFFFF43A4~& '_RGB32(255,67,164)
CONST WildWatermelon = &HFFFC6C85~& '_RGB32(252,108,133)
CONST Wisteria = &HFFCDA4DE~& '_RGB32(205,164,222)
CONST Yellow = &HFFFFFF00~& ' _RGB32(255,255,0)
CONST YellowGreen = &HFF9ACD32~& ' _RGB32(154,205,50)
CONST YellowOrange = &HFFFFAE42~& '_RGB32(255,174,66)
 
 
DEFLNG A-Z
RANDOMIZE TIMER
WS = _NEWIMAGE(640, 480, 32)
SCREEN WS
_SCREENMOVE _MIDDLE
 
TYPE BulletInfo
    valid AS INTEGER
    x AS INTEGER
    y AS INTEGER
END TYPE
 
DIM SHARED Bullet(100) AS BulletInfo
DIM SHARED ROF AS INTEGER
DIM SHARED Ammo AS LONG
 
CLS , SkyBlue
LINE (0, 479)-(639, 460), Brown, BF
PCOPY 0, 1 'Save as the background
x = 290
ROF = 50
Ammo = 1000
 
DO
    PCOPY 1, 0
    _LIMIT 180
    IF _KEYDOWN(19200) THEN
        x = x - 1
    ELSEIF _KEYDOWN(19712) THEN
        x = x + 1
    END IF
    IF x < 0 THEN x = 0
    IF x > 570 THEN x = 570
    IF _KEYDOWN(27) THEN GameOver = -1
    IF _KEYDOWN(32) THEN Shoot x
 
    DrawPlayer x
    DrawBullets
    DrawStatus
    _DISPLAY
LOOP UNTIL GameOver
 
 
SUB DrawStatus
    _PRINTSTRING (10, 462), "AMMO:" + STR$(Ammo)
    _PRINTSTRING (560, 462), TIME$
END SUB
 
SUB DrawPlayer (x)
    LINE (x + i, 445)-STEP(70, 15), Red, BF
    LINE (x + 10, 425)-STEP(50, 20), Red, BF
    LINE (x + 30, 415)-STEP(10, 10), Red, BF
END SUB
 
SUB DrawBullets
    FOR i = 1 TO 100
        IF Bullet(i).valid THEN
            Bullet(i).y = Bullet(i).y - 1
            IF Bullet(i).y < 0 THEN Bullet(i).valid = 0: _CONTINUE
            LINE (Bullet(i).x, Bullet(i).y)-STEP(3, 5), Red, BF
        END IF
    NEXT
END SUB
 
 
SUB Shoot (x)
    STATIC Delay AS _FLOAT
    IF ExtendedTimer > Delay + ROF / 1000 THEN 'only shoot once every Rate Of Fire
        FOR i = 1 TO 100
            IF Bullet(i).valid = 0 THEN
                Bullet(i).valid = -1
                Bullet(i).x = x + 33
                Bullet(i).y = 410
                Ammo = Ammo - 1
                Delay = ExtendedTimer
                EXIT SUB
            END IF
        NEXT
    END IF
END SUB
 
 
FUNCTION ExtendedTimer##
    d$ = DATE$
    l = INSTR(d$, "-")
    l1 = INSTR(l + 1, d$, "-")
    m = VAL(LEFT$(d$, l))
    d = VAL(MID$(d$, l + 1))
    y = VAL(MID$(d$, l1 + 1)) - 1970
    FOR i = 1 TO m
        SELECT CASE i 'Add the number of days for each previous month passed
            CASE 1: d = d 'January doestn't have any carry over days.
            CASE 2, 4, 6, 8, 9, 11: d = d + 31
            CASE 3: d = d + 28
            CASE 5, 7, 10, 12: d = d + 30
        END SELECT
    NEXT
    FOR i = 1 TO y
        d = d + 365
    NEXT
    FOR i = 2 TO y STEP 4
        IF m > 2 THEN d = d + 1 'add an extra day for leap year every 4 years, starting in 2016
    NEXT
    s~&& = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
    ExtendedTimer## = (s~&& + TIMER)
END FUNCTION
 

I was playing around with making a simple little shooter type game earlier today, and when I got this far along, I thought I'd go ahead and share what I have here so people could use it as an easily expandable start for their own games.

Toss some little invaders that move left and right across the screen and a collision detection routine, and you have a basic version of Space Invaders. Toss in some airplanes which fly by the top of the screen and drop bombs, and you have a bomber game...

Right now, we don't really do much except provide the bare bones to expand upon to build/grow a game, but I thought I'd share it so folks can build upon it/study it as it currently exists. Enjoy. ;)

Pete · « **Reply #1 on:** March 30, 2019, 11:29:05 pm »

Oh, you mean like this?

Code: QB64: [Select]

DEFINT I
DECLARE SUB instructions ()
DECLARE SUB qbide ()
DECLARE SUB mship (imothership)
REM Adds multiple bullets (5) max.
REM Adds firing delay and ship turns red while reloading.
REM Adds aliens.
REM Adds collision for bullets from base to aliens.
REM Adds Mouse support.
REM Adds alien motion.
REM Adds 3 progressive levels.
REM Adds aliens move all the way to both sides.
REM Adds Aliens shoot back.
REM Adds sub-routines.
REM Adds counter.
REM Adds alien bullets finish before moving on to next level.
REM Adds mothership.
 
DECLARE SUB alienattack (ialiencolstat, ialiencol)
DECLARE SUB alienmissile (iresults)
DECLARE SUB checkcollision (ihitaliens, ialiencol, i4, i)
DECLARE SUB mdriver (ex%, key$, tankx%)
DECLARE SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
DECLARE SUB movealiens (ialiencol, ialiencolstat, iresults)
DECLARE SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
 
TYPE RegType
    AX AS INTEGER
    BX AS INTEGER
    CX AS INTEGER
    DX AS INTEGER
    BP AS INTEGER
    SI AS INTEGER
    DI AS INTEGER
    FLAGS AS INTEGER
    DS AS INTEGER
    ES AS INTEGER
END TYPE
 
DIM SHARED MOUSE$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX, CX
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits
 
imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3
screenwidth% = rmargin% - lmargin% + 1
ibk = 1
 
DIM SHARED a(imaxalienforce) AS STRING * 68
 
RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
COLOR 7, 1: CLS
 
REM Make aliens
a1$ = "-<" + CHR$(237) + ">-  "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
 
CALL qbide
CALL instructions
 
DO
    IF inextrnd = -1 THEN PCOPY 3, 0
    tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 7
    REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
    REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
    REDIM SHARED matrix(imaxalienforce) AS STRING * 10
    alienforce% = imaxalienforce
    level = .65
    iround = iround + 1
    level = level - iround / 15
    inextrnd = -1
    COLOR 7, ibk
 
    REM Set up aliens
    ialiencol = ialiencolstat
    LOCATE 2, ialiencol
    FOR i = 1 TO imaxalienforce
        IF i MOD 1 = 0 THEN PRINT
        LOCATE , ialiencol
        IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
        a(i) = a$
        PRINT a(i)
    NEXT
 
    REM Station
    LOCATE 24, 40, 1, 7, 7
    PRINT tank$;: LOCATE , POS(1) - 2: tanky% = CSRLIN: tankx% = POS(1) + 1
    key$ = INKEY$: SLEEP 1
    ex% = 1: CALL mdriver(ex%, key$, tankx%)
    DO
        z1 = TIMER
        DO
            IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
                IF imothership <> 0 THEN CALL mship(imothership)
            END IF
            IF ABS(TIMER - z1aliens) > level THEN
                CALL movealiens(ialiencol, ialiencolstat, iresults)
                z1aliens = TIMER
            END IF
            IF iresults < 0 THEN EXIT DO
            IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
            key$ = INKEY$
            IF key$ = "" THEN ex% = 2: CALL mdriver(ex%, key$, tankx%)
            SELECT CASE key$
                CASE CHR$(0) + "K"
                    IF POS(1) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(1) - 2: PRINT tank$ + " ";: LOCATE , POS(1) - 3
                    tanky% = CSRLIN: tankx% = POS(1)
                    IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                CASE CHR$(0) + "M"
                    IF POS(1) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(1) - 1: PRINT " " + tank$;: LOCATE , POS(1) - 2
                    tanky% = CSRLIN: tankx% = POS(1)
                    IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
                CASE CHR$(32)
                    IF icolor = 7 THEN
                        FOR i2 = 1 TO 5
                            IF bullet%(i2) = 0 THEN
                                icolor = 12: COLOR icolor, ibk: GOSUB redraw
                                bullet%(i2) = -1: reload = TIMER: EXIT FOR
                            END IF
                        NEXT
                    END IF
                CASE CHR$(27): SYSTEM
            END SELECT
 
            IF ABS(z1 - reload) > .7 AND reload <> 0 THEN
                GOSUB redraw
                icolor = 7: reload = 0
            END IF
 
            REM Fire
            FOR i = 1 TO 5
                SELECT CASE bullet%(i)
                    CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
                    CASE IS > 0
                        IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
                            CALL checkcollision(ihitaliens, ialiencol, i4, i)
                            z2bullet = TIMER: bulletdelay%(i) = 0
                            COLOR 7, ibk
                            LOCATE bullet%(i), bulletcol%(i)
                            IF bullet%(i) = topmargin% AND imothership <> 0 THEN
                                IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
                                    SOUND 1000, .75
                                    LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
                                    imothership = 0
                                END IF
                            END IF
                            PRINT CHR$(24)
                            IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
                            IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
                            LOCATE tanky%, tankx%
                            IF bullet%(i) > topmargin% THEN
                                bullet%(i) = bullet%(i) - 1
                            ELSE
                                GOSUB erasebullet
                            END IF
                        END IF
                END SELECT
            NEXT
 
            REM Bullet timer delay
            IF z2bullet <> 0 THEN
                IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
                IF z1 - z2bullet >= .06 THEN
                    FOR i2 = 1 TO 5
                        IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
                    NEXT i2
                END IF
                EXIT DO
            END IF
        LOOP
        IF iresults < 0 THEN EXIT DO
        IF alienforce% = 0 OR iresults = iwin THEN
            FOR i = 1 TO imaxalienmissiles
                IF ia(i) <> 0 THEN EXIT FOR
            NEXT
            IF i > imaxalienmissiles THEN iwait = -1
            IF iwait = -1 THEN
                EXIT DO
            END IF
        ELSE
            iwait = 1
        END IF
    LOOP
    ex% = -1: CALL mdriver(ex%, key$, tankx%)
    key$ = INKEY$
    SLEEP 2
    IF iresults = iwin OR iresults < 0 THEN
        REM end game
        EXIT DO
    END IF
    inextrnd = -1
LOOP
SELECT CASE iresults
    CASE IS < 0
        COLOR 7, ibk
        LOCATE tanky% - 1, lmargin%
        PRINT SPACE$(screenwidth%);
        LOCATE tanky%, lmargin%
        PRINT SPACE$(screenwidth%);
        key$ = INKEY$
        SOUND 140, 2
        SLEEP 2
END SELECT
CALL qbide
CALL instructions
SYSTEM
 
erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN
 
redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN
 
DATA "Well, I better get busy and finish the compiler..."
DATA "Or... I'll just do some more work on this IDE, instead..."
DATA ""
DATA " Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA ""
DATA "Now finish the compiler!"
DATA "EOF2"
 
SUB alienattack (ialiencolstat, ialiencol)
z2alienfire = TIMER
 
i3 = INT(RND * 10)
FOR i = 1 TO imaxalienmissiles
    IF ia(i) = 0 THEN
        FOR i2 = imaxalienforce TO 1 STEP -1
            IF RTRIM$(a(i2)) <> "" THEN
                IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
                    i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(237)) + ialiencol
                    EXIT FOR
                END IF
            END IF
        NEXT i2
        IF i4 <> 0 THEN
            ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
            EXIT FOR
        END IF
    END IF
NEXT i
 
END SUB
 
SUB alienmissile (iresults)
irow = CSRLIN: icol = POS(1)
FOR i = 1 TO imaxalienmissiles
    IF ia(i) <> 0 THEN
        IF iy(i) = 0 THEN
            iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
            IF ix(i) = 0 THEN ix(i) = screenwidth%
        END IF
        LOCATE iy(i) + 1, ix(i)
        COLOR 7, ibk
        IF CSRLIN <= 24 THEN
            IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
            PRINT CHR$(25);
        ELSE
            ia(i) = 0
            LOCATE iy(i), ix(i)
            PRINT " ";: iy(i) = 0
            ia(i) = 0
            LOCATE irow, icol
            EXIT SUB
        END IF
        LOCATE iy(i), ix(i): PRINT " ";
        iy(i) = iy(i) + 1
    END IF
NEXT
LOCATE irow, icol
 
END SUB
 
SUB checkcollision (ihitaliens, ialiencol, i4, i)
ihitaliens = 0
IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
    i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
    IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
        IF RTRIM$(a(i4)) <> "" THEN
            IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
                IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
                    ihitaliens = bulletcol%(i) - ialiencol + 1
                    i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
                    i2 = INSTR(i3 + 1, a(i4), "<") - 1
                    MID$(a(i4), i2, 7) = SPACE$(7)
                    MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
                END IF
            END IF
        END IF
    END IF
END IF
 
FOR i2 = 1 TO imaxalienmissiles
    IF ia(i2) <> 0 THEN
        IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
            ihitaliens = -i2
            EXIT FOR
        END IF
    END IF
NEXT
 
END SUB
 
SUB instructions
 
''in$ = "EOF"
IF in$ = "" THEN
    key$ = INKEY$
    LOCATE 3, 3, 1, 7, 7: COLOR 7, ibk
    SLEEP 2
    DO
        READ in$
        IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
        FOR i = 1 TO LEN(in$)
            SOUND 400, .1
            LOCATE , 2 + i
            PRINT MID$(in$, i, 1);
            z = TIMER
            DO
                IF ABS(z - TIMER) > .1 THEN EXIT DO
            LOOP
        NEXT
        LOCATE , , 0, 7, 0
        key$ = INKEY$
        SLEEP 1
        PRINT
        LOCATE , 3
    LOOP
    key$ = INKEY$
    SLEEP 1
END IF
 
IF in$ = "EOF" THEN
    COLOR 7, 1
    FOR i = 1 TO 5
        LOCATE 2 + i, 2: PRINT SPACE$(78)
    NEXT
    FOR i = 3 TO 24
        LOCATE i, 80: PRINT CHR$(179);
    NEXT
    LOCATE 21, 2: PRINT STRING$(78, " ");
    LOCATE 22, 1: PRINT CHR$(179);
    LOCATE 22, 80: PRINT CHR$(179);
    LOCATE 22, 2: PRINT STRING$(78, " ");
ELSE
    COLOR 0, 3
END IF
 
COLOR 0, 3
yy% = CSRLIN: xx% = POS(1)
LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
PRINT LTRIM$(STR$(ihits));
LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
PRINT "0";
LOCATE yy%, xx%
 
PCOPY 0, 3: REM save skin
 
END SUB
 
SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
COLOR 7, ibk
ileadingrow = ileadingrow + 1
ileadingmax = ileadingmax + 1
COLOR 7, ibk
FOR i = 1 TO imaxalienforce
    IF RTRIM$(a(i)) <> "" THEN
        ialiencol = ialiencolstat + imotion
        LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
        PRINT STRING$(screenwidth%, " ")
        LOCATE , ialiencol + INSTR(a(i), "-")
        iltalien(i) = POS(1)
        PRINT LTRIM$(RTRIM$(a(i)))
    END IF
NEXT
LOCATE irow, icol
level = level - .025
IF ileadingrow = 22 THEN iresults = -2
END SUB
 
DEFSNG I
SUB mdriver (ex%, key$, tankx%)
STATIC MOUSEACT%
 
REM INITIATE MOUSE
IF MOUSEACT% = 0 OR ex% = -1 THEN
    Registers.AX = 0: GOSUB CALLI
    MOUSEACT% = 1
END IF
 
IF ex% = 1 THEN
    Registers.AX = 4: Registers.DX = 184: Registers.CX = 304
    Registers.AX = 8: Registers.DX = 184: Registers.CX = 184
    GOSUB CALLI
    EXIT SUB
END IF
 
Registers.AX = 3: GOSUB CALLI
 
DX = Registers.DX
CX = Registers.CX
y% = DX \ 8 + 1: x% = CX \ 8 + 1
 
REM MOUSE BUTTONS
LB% = Registers.BX AND 1
RB% = (Registers.BX AND 2) \ 2
MB% = (Registers.BX AND 4) \ 4
 
IF LB% <> 0 THEN
    key$ = CHR$(32)
ELSE
    IF x% > tankx% THEN key$ = CHR$(0) + "M"
    IF x% < tankx% THEN key$ = CHR$(0) + "K"
END IF
EXIT SUB
 
CALLI:
CALL INTERRUPT(&H33, Registers, Registers)
RETURN
 
END SUB
 
DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
STATIC imotion, imarch, imotiondir
IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
irow = CSRLIN: icol = POS(1)
yy% = CSRLIN: xx% = POS(1)
PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
COLOR 7, ibk
 
FOR i = imaxalienforce TO 1 STEP -1
    IF RTRIM$(a(i)) <> "" THEN
        i2 = i2 + 2
        SOUND 400, .03
        ialiencol = ialiencolstat + imotion
        LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "-")
        IF POS(1) = lmargin% THEN imarch = 1
        iltalien(i) = POS(1)
        IF imotiondir = 0 THEN
            PRINT LTRIM$(RTRIM$(a(i))); " "
        ELSE
            LOCATE , POS(1) - 1
            PRINT " "; LTRIM$(RTRIM$(a(i)))
        END IF
        IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
    END IF
NEXT
 
IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
IF imarch = 0 THEN
    IF ABS(TIMER - z2alienfire) > firerate THEN
        firerate = (INT(RND * 10) + 1) / 20
        IF iwait = 0 THEN CALL alienattack(ialiencolstat, ialiencol)
    END IF
ELSE
    imarch = 0
END IF
PCOPY 1, 0: SCREEN 0, 0, 0, 0
LOCATE irow, icol, 1, 7, 7
END SUB
 
SUB mship (imothership)
STATIC x%, mov%, z4, mothership$
 
yy% = CSRLIN: xx% = POS(1): COLOR 7, ibk
IF imothership = -1 THEN
    imothership = 1
    x% = lmargin%
    mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
    mov% = 1
END IF
 
IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
''IF ABS(TIMER - z2) > .2 THEN GOSUB bullets: z2 = TIMER
LOCATE yy%, xx%
EXIT SUB
 
mothership:
IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
x% = x% + mov%
LOCATE topmargin%, x%
PRINT mothership$;
IF x% > 1 AND mov% = 1 THEN
    LOCATE , POS(1) - LEN(mothership$) - 1: PRINT " ";
END IF
IF mov% = -1 THEN PRINT " ";
RETURN
 
END SUB
 
DEFINT A-H, J-Z
SUB qbide
PALETTE 2, 59
COLOR 15, 1
CLS
 
COLOR 0, 7
LOCATE 1, 1
PRINT SPACE$(80)
LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
 
COLOR 7, 1
 
LOCATE 2, 1: PRINT CHR$(218)
LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
LOCATE 2, 80: PRINT CHR$(191)
 
LOCATE 2, 76: PRINT CHR$(180)
LOCATE 2, 78: PRINT CHR$(195)
 
COLOR 1, 7
LOCATE 2, 77: PRINT CHR$(24)
LOCATE 2, 36: PRINT " Untitled "
 
COLOR 7, 1
FOR Rows = 3 TO 24
    LOCATE Rows, 1: PRINT CHR$(179);
    LOCATE Rows, 80: PRINT CHR$(179);
NEXT Rows
 
LOCATE 22, 1: PRINT CHR$(195)
LOCATE 22, 80: PRINT CHR$(180)
LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
LOCATE 22, 35
PRINT " Immediate "
 
COLOR 0, 7
LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
LOCATE 21, 2: PRINT CHR$(27)
LOCATE 21, 3: PRINT CHR$(219)
LOCATE 21, 79: PRINT CHR$(26)
FOR Rows = 4 TO 19
    LOCATE Rows, 80: PRINT CHR$(176)
NEXT Rows
LOCATE 3, 80: PRINT CHR$(24)
LOCATE 4, 80: PRINT CHR$(219)
LOCATE 20, 80: PRINT CHR$(25)
 
COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
LOCATE 25, 59: PRINT SPACE$(4);
COLOR 0, 3
LOCATE 25, 63: PRINT CHR$(179);
LOCATE 25, 64: PRINT SPACE$(6);
LOCATE 25, 68: PRINT "C  00001:001 ";
 
END SUB
 
DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
IF ihitaliens > 0 THEN
    ihits = ihits + 1
    IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
    LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
    iltalien(i4) = POS(1)
 
    IF RTRIM$(a(i4)) = "" THEN
        alienforce% = alienforce% - 1
        IF alienforce% = 0 THEN iresults = iresults + 1
        IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
    ELSE
        LOCATE bullet%(i), ialiencol + INSTR(a(i4), "-"): PRINT LTRIM$(RTRIM$(a(i4)))
    END IF
ELSE
    i2 = ABS(ihitaliens)
    LOCATE iy(i2), ix(i2)
    PRINT " ";: iy(i2) = 0
    ia(i2) = 0
    LOCATE irow, icol
    SOUND 1000, .5
END IF
 
ihitaliens = 0
bullet%(i) = -bullet%(i)
 
COLOR 0, 3
yy% = CSRLIN: xx% = POS(1)
LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
PRINT LTRIM$(STR$(ihits));
LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
PRINT LTRIM$(STR$(imaxalienforce - alienforce%));
LOCATE yy%, xx%
COLOR 7, ibk
END SUB
 

Edit: Hey, I found the mother ship version! Mouse to move, left click to shoot.

qb4ever · « **Reply #2 on:** March 31, 2019, 07:36:13 am »

Woow !

Quote from: Pete on March 30, 2019, 11:29:05 pm

Oh, you mean like this?

Code: QB64: [Select]
DEFINT I
DECLARE SUB instructions ()
DECLARE SUB qbide ()
DECLARE SUB mship (imothership)
REM Adds multiple bullets (5) max.
REM Adds firing delay and ship turns red while reloading.
REM Adds aliens.
REM Adds collision for bullets from base to aliens.
REM Adds Mouse support.
REM Adds alien motion.
REM Adds 3 progressive levels.
REM Adds aliens move all the way to both sides.
REM Adds Aliens shoot back.
REM Adds sub-routines.
REM Adds counter.
REM Adds alien bullets finish before moving on to next level.
REM Adds mothership.

DECLARE SUB alienattack (ialiencolstat, ialiencol)
DECLARE SUB alienmissile (iresults)
DECLARE SUB checkcollision (ihitaliens, ialiencol, i4, i)
DECLARE SUB mdriver (ex%, key$, tankx%)
DECLARE SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
DECLARE SUB movealiens (ialiencol, ialiencolstat, iresults)
DECLARE SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)

TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE

DIM SHARED MOUSE$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX, CX
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits

imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3
screenwidth% = rmargin% - lmargin% + 1
ibk = 1

DIM SHARED a(imaxalienforce) AS STRING * 68

RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
COLOR 7, 1: CLS

REM Make aliens
a1$ = "-<" + CHR$(237) + ">- "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$

CALL qbide
CALL instructions

DO
IF inextrnd = -1 THEN PCOPY 3, 0
tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 7
REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
REDIM SHARED matrix(imaxalienforce) AS STRING * 10
alienforce% = imaxalienforce
level = .65
iround = iround + 1
level = level - iround / 15
inextrnd = -1
COLOR 7, ibk

REM Set up aliens
ialiencol = ialiencolstat
LOCATE 2, ialiencol
FOR i = 1 TO imaxalienforce
IF i MOD 1 = 0 THEN PRINT
LOCATE , ialiencol
IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
a(i) = a$
PRINT a(i)
NEXT

REM Station
LOCATE 24, 40, 1, 7, 7
PRINT tank$;: LOCATE , POS(1) - 2: tanky% = CSRLIN: tankx% = POS(1) + 1
key$ = INKEY$: SLEEP 1
ex% = 1: CALL mdriver(ex%, key$, tankx%)
DO
z1 = TIMER
DO
IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
IF imothership <> 0 THEN CALL mship(imothership)
END IF
IF ABS(TIMER - z1aliens) > level THEN
CALL movealiens(ialiencol, ialiencolstat, iresults)
z1aliens = TIMER
END IF
IF iresults < 0 THEN EXIT DO
IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
key$ = INKEY$
IF key$ = "" THEN ex% = 2: CALL mdriver(ex%, key$, tankx%)
SELECT CASE key$
CASE CHR$(0) + "K"
IF POS(1) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(1) - 2: PRINT tank$ + " ";: LOCATE , POS(1) - 3
tanky% = CSRLIN: tankx% = POS(1)
IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
CASE CHR$(0) + "M"
IF POS(1) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(1) - 1: PRINT " " + tank$;: LOCATE , POS(1) - 2
tanky% = CSRLIN: tankx% = POS(1)
IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
CASE CHR$(32)
IF icolor = 7 THEN
FOR i2 = 1 TO 5
IF bullet%(i2) = 0 THEN
icolor = 12: COLOR icolor, ibk: GOSUB redraw
bullet%(i2) = -1: reload = TIMER: EXIT FOR
END IF
NEXT
END IF
CASE CHR$(27): SYSTEM
END SELECT

IF ABS(z1 - reload) > .7 AND reload <> 0 THEN
GOSUB redraw
icolor = 7: reload = 0
END IF

REM Fire
FOR i = 1 TO 5
SELECT CASE bullet%(i)
CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
CASE IS > 0
IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
CALL checkcollision(ihitaliens, ialiencol, i4, i)
z2bullet = TIMER: bulletdelay%(i) = 0
COLOR 7, ibk
LOCATE bullet%(i), bulletcol%(i)
IF bullet%(i) = topmargin% AND imothership <> 0 THEN
IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
SOUND 1000, .75
LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
imothership = 0
END IF
END IF
PRINT CHR$(24)
IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
LOCATE tanky%, tankx%
IF bullet%(i) > topmargin% THEN
bullet%(i) = bullet%(i) - 1
ELSE
GOSUB erasebullet
END IF
END IF
END SELECT
NEXT

REM Bullet timer delay
IF z2bullet <> 0 THEN
IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
IF z1 - z2bullet >= .06 THEN
FOR i2 = 1 TO 5
IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
NEXT i2
END IF
EXIT DO
END IF
LOOP
IF iresults < 0 THEN EXIT DO
IF alienforce% = 0 OR iresults = iwin THEN
FOR i = 1 TO imaxalienmissiles
IF ia(i) <> 0 THEN EXIT FOR
NEXT
IF i > imaxalienmissiles THEN iwait = -1
IF iwait = -1 THEN
EXIT DO
END IF
ELSE
iwait = 1
END IF
LOOP
ex% = -1: CALL mdriver(ex%, key$, tankx%)
key$ = INKEY$
SLEEP 2
IF iresults = iwin OR iresults < 0 THEN
REM end game
EXIT DO
END IF
inextrnd = -1
LOOP
SELECT CASE iresults
CASE IS < 0
COLOR 7, ibk
LOCATE tanky% - 1, lmargin%
PRINT SPACE$(screenwidth%);
LOCATE tanky%, lmargin%
PRINT SPACE$(screenwidth%);
key$ = INKEY$
SOUND 140, 2
SLEEP 2
END SELECT
CALL qbide
CALL instructions
SYSTEM

erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN

redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN

DATA "Well, I better get busy and finish the compiler..."
DATA "Or... I'll just do some more work on this IDE, instead..."
DATA ""
DATA " Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA ""
DATA "Now finish the compiler!"
DATA "EOF2"

SUB alienattack (ialiencolstat, ialiencol)
z2alienfire = TIMER

i3 = INT(RND * 10)
FOR i = 1 TO imaxalienmissiles
IF ia(i) = 0 THEN
FOR i2 = imaxalienforce TO 1 STEP -1
IF RTRIM$(a(i2)) <> "" THEN
IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(237)) + ialiencol
EXIT FOR
END IF
END IF
NEXT i2
IF i4 <> 0 THEN
ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
EXIT FOR
END IF
END IF
NEXT i

END SUB

SUB alienmissile (iresults)
irow = CSRLIN: icol = POS(1)
FOR i = 1 TO imaxalienmissiles
IF ia(i) <> 0 THEN
IF iy(i) = 0 THEN
iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
IF ix(i) = 0 THEN ix(i) = screenwidth%
END IF
LOCATE iy(i) + 1, ix(i)
COLOR 7, ibk
IF CSRLIN <= 24 THEN
IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
PRINT CHR$(25);
ELSE
ia(i) = 0
LOCATE iy(i), ix(i)
PRINT " ";: iy(i) = 0
ia(i) = 0
LOCATE irow, icol
EXIT SUB
END IF
LOCATE iy(i), ix(i): PRINT " ";
iy(i) = iy(i) + 1
END IF
NEXT
LOCATE irow, icol

END SUB

SUB checkcollision (ihitaliens, ialiencol, i4, i)
ihitaliens = 0
IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
IF RTRIM$(a(i4)) <> "" THEN
IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
ihitaliens = bulletcol%(i) - ialiencol + 1
i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
i2 = INSTR(i3 + 1, a(i4), "<") - 1
MID$(a(i4), i2, 7) = SPACE$(7)
MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
END IF
END IF
END IF
END IF
END IF

FOR i2 = 1 TO imaxalienmissiles
IF ia(i2) <> 0 THEN
IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
ihitaliens = -i2
EXIT FOR
END IF
END IF
NEXT

END SUB

SUB instructions

''in$ = "EOF"
IF in$ = "" THEN
key$ = INKEY$
LOCATE 3, 3, 1, 7, 7: COLOR 7, ibk
SLEEP 2
DO
READ in$
IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
FOR i = 1 TO LEN(in$)
SOUND 400, .1
LOCATE , 2 + i
PRINT MID$(in$, i, 1);
z = TIMER
DO
IF ABS(z - TIMER) > .1 THEN EXIT DO
LOOP
NEXT
LOCATE , , 0, 7, 0
key$ = INKEY$
SLEEP 1
PRINT
LOCATE , 3
LOOP
key$ = INKEY$
SLEEP 1
END IF

IF in$ = "EOF" THEN
COLOR 7, 1
FOR i = 1 TO 5
LOCATE 2 + i, 2: PRINT SPACE$(78)
NEXT
FOR i = 3 TO 24
LOCATE i, 80: PRINT CHR$(179);
NEXT
LOCATE 21, 2: PRINT STRING$(78, " ");
LOCATE 22, 1: PRINT CHR$(179);
LOCATE 22, 80: PRINT CHR$(179);
LOCATE 22, 2: PRINT STRING$(78, " ");
ELSE
COLOR 0, 3
END IF

COLOR 0, 3
yy% = CSRLIN: xx% = POS(1)
LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
PRINT LTRIM$(STR$(ihits));
LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
PRINT "0";
LOCATE yy%, xx%

PCOPY 0, 3: REM save skin

END SUB

SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
COLOR 7, ibk
ileadingrow = ileadingrow + 1
ileadingmax = ileadingmax + 1
COLOR 7, ibk
FOR i = 1 TO imaxalienforce
IF RTRIM$(a(i)) <> "" THEN
ialiencol = ialiencolstat + imotion
LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
PRINT STRING$(screenwidth%, " ")
LOCATE , ialiencol + INSTR(a(i), "-")
iltalien(i) = POS(1)
PRINT LTRIM$(RTRIM$(a(i)))
END IF
NEXT
LOCATE irow, icol
level = level - .025
IF ileadingrow = 22 THEN iresults = -2
END SUB

DEFSNG I
SUB mdriver (ex%, key$, tankx%)
STATIC MOUSEACT%

REM INITIATE MOUSE
IF MOUSEACT% = 0 OR ex% = -1 THEN
Registers.AX = 0: GOSUB CALLI
MOUSEACT% = 1
END IF

IF ex% = 1 THEN
Registers.AX = 4: Registers.DX = 184: Registers.CX = 304
Registers.AX = 8: Registers.DX = 184: Registers.CX = 184
GOSUB CALLI
EXIT SUB
END IF

Registers.AX = 3: GOSUB CALLI

DX = Registers.DX
CX = Registers.CX
y% = DX \ 8 + 1: x% = CX \ 8 + 1

REM MOUSE BUTTONS
LB% = Registers.BX AND 1
RB% = (Registers.BX AND 2) \ 2
MB% = (Registers.BX AND 4) \ 4

IF LB% <> 0 THEN
key$ = CHR$(32)
ELSE
IF x% > tankx% THEN key$ = CHR$(0) + "M"
IF x% < tankx% THEN key$ = CHR$(0) + "K"
END IF
EXIT SUB

CALLI:
CALL INTERRUPT(&H33, Registers, Registers)
RETURN

END SUB

DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
STATIC imotion, imarch, imotiondir
IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
irow = CSRLIN: icol = POS(1)
yy% = CSRLIN: xx% = POS(1)
PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
COLOR 7, ibk

FOR i = imaxalienforce TO 1 STEP -1
IF RTRIM$(a(i)) <> "" THEN
i2 = i2 + 2
SOUND 400, .03
ialiencol = ialiencolstat + imotion
LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "-")
IF POS(1) = lmargin% THEN imarch = 1
iltalien(i) = POS(1)
IF imotiondir = 0 THEN
PRINT LTRIM$(RTRIM$(a(i))); " "
ELSE
LOCATE , POS(1) - 1
PRINT " "; LTRIM$(RTRIM$(a(i)))
END IF
IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
END IF
NEXT

IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
IF imarch = 0 THEN
IF ABS(TIMER - z2alienfire) > firerate THEN
firerate = (INT(RND * 10) + 1) / 20
IF iwait = 0 THEN CALL alienattack(ialiencolstat, ialiencol)
END IF
ELSE
imarch = 0
END IF
PCOPY 1, 0: SCREEN 0, 0, 0, 0
LOCATE irow, icol, 1, 7, 7
END SUB

SUB mship (imothership)
STATIC x%, mov%, z4, mothership$

yy% = CSRLIN: xx% = POS(1): COLOR 7, ibk
IF imothership = -1 THEN
imothership = 1
x% = lmargin%
mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
mov% = 1
END IF

IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
''IF ABS(TIMER - z2) > .2 THEN GOSUB bullets: z2 = TIMER
LOCATE yy%, xx%
EXIT SUB

mothership:
IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
x% = x% + mov%
LOCATE topmargin%, x%
PRINT mothership$;
IF x% > 1 AND mov% = 1 THEN
LOCATE , POS(1) - LEN(mothership$) - 1: PRINT " ";
END IF
IF mov% = -1 THEN PRINT " ";
RETURN

END SUB

DEFINT A-H, J-Z
SUB qbide
PALETTE 2, 59
COLOR 15, 1
CLS

COLOR 0, 7
LOCATE 1, 1
PRINT SPACE$(80)
LOCATE 1, 1: PRINT " File Edit View Search Run Debug Calls Options Help"

COLOR 7, 1

LOCATE 2, 1: PRINT CHR$(218)
LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
LOCATE 2, 80: PRINT CHR$(191)

LOCATE 2, 76: PRINT CHR$(180)
LOCATE 2, 78: PRINT CHR$(195)

COLOR 1, 7
LOCATE 2, 77: PRINT CHR$(24)
LOCATE 2, 36: PRINT " Untitled "

COLOR 7, 1
FOR Rows = 3 TO 24
LOCATE Rows, 1: PRINT CHR$(179);
LOCATE Rows, 80: PRINT CHR$(179);
NEXT Rows

LOCATE 22, 1: PRINT CHR$(195)
LOCATE 22, 80: PRINT CHR$(180)
LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
LOCATE 22, 35
PRINT " Immediate "

COLOR 0, 7
LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
LOCATE 21, 2: PRINT CHR$(27)
LOCATE 21, 3: PRINT CHR$(219)
LOCATE 21, 79: PRINT CHR$(26)
FOR Rows = 4 TO 19
LOCATE Rows, 80: PRINT CHR$(176)
NEXT Rows
LOCATE 3, 80: PRINT CHR$(24)
LOCATE 4, 80: PRINT CHR$(219)
LOCATE 20, 80: PRINT CHR$(25)

COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
LOCATE 25, 59: PRINT SPACE$(4);
COLOR 0, 3
LOCATE 25, 63: PRINT CHR$(179);
LOCATE 25, 64: PRINT SPACE$(6);
LOCATE 25, 68: PRINT "C 00001:001 ";

END SUB

DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
IF ihitaliens > 0 THEN
ihits = ihits + 1
IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
iltalien(i4) = POS(1)

IF RTRIM$(a(i4)) = "" THEN
alienforce% = alienforce% - 1
IF alienforce% = 0 THEN iresults = iresults + 1
IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
ELSE
LOCATE bullet%(i), ialiencol + INSTR(a(i4), "-"): PRINT LTRIM$(RTRIM$(a(i4)))
END IF
ELSE
i2 = ABS(ihitaliens)
LOCATE iy(i2), ix(i2)
PRINT " ";: iy(i2) = 0
ia(i2) = 0
LOCATE irow, icol
SOUND 1000, .5
END IF

ihitaliens = 0
bullet%(i) = -bullet%(i)

COLOR 0, 3
yy% = CSRLIN: xx% = POS(1)
LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
PRINT LTRIM$(STR$(ihits));
LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
PRINT LTRIM$(STR$(imaxalienforce - alienforce%));
LOCATE yy%, xx%
COLOR 7, ibk
END SUB

Edit: Hey, I found the mother ship version! Mouse to move, left click to shoot.

bplus · « **Reply #3 on:** March 31, 2019, 10:51:35 am »

I don't know about you guys but I get tired of pounding buttons.

Here is a mouse action double barreled shooter:

Code: QB64: [Select]

_TITLE "Mouse Action Shooter Left Button for CCW rotation, Right Button for CW roatation" 'B+ 2019-03-31
'from eRATication 5 by bplus 2018-08-06"
 
'screen dimensions
CONST ww = 1200
CONST wh = 700
CONST nBullets = 1000
CONST bSpeed = 60
CONST shooterRadius = 50
 
TYPE shooterType
    x AS SINGLE
    y AS SINGLE
    a AS SINGLE
END TYPE
 
TYPE bulletType
    x AS INTEGER
    y AS INTEGER
    dx AS INTEGER
    dy AS INTEGER
    live AS INTEGER
END TYPE
 
SCREEN _NEWIMAGE(ww, wh, 32)
_SCREENMOVE 100, 20
RANDOMIZE TIMER
 
 
DIM SHARED GameOn, newRound, fire
 
DIM SHARED b(nBullets) AS bulletType
DIM SHARED shooter AS shooterType
shooter.x = ww / 2
shooter.y = wh / 2
shooter.a = 0
lastx = ww / 2: lasty = wh / 2
GameOn = 1
_MOUSEHIDE
WHILE GameOn
    CLS
 
    WHILE _MOUSEINPUT: WEND
    shooter.x = _MOUSEX: shooter.y = _MOUSEY
    IF ABS(lastx - shooter.x) > 3 AND ABS(lasty - shooter.y) > 3 THEN
        shooter.a = _ATAN2(shooter.y - lasty, shooter.x - lastx)
        lastx = shooter.x: lasty = shooter.y
    END IF
    IF _MOUSEBUTTON(1) THEN shooter.a = (shooter.a - _PI(1 / 72))
    IF _MOUSEBUTTON(2) THEN shooter.a = (shooter.a + _PI(1 / 72))
 
    'lc loop count mod, controls how fast bullets come
    lc = (lc + 1) MOD 4
    IF lc = 0 THEN fire = 2 ELSE fire = 0
    IF _KEYDOWN(27) THEN _MOUSESHOW: END
    drawshooter
    handleBullets
    _DISPLAY
    _LIMIT 30
WEND
 
SUB handleBullets ()
    FOR i = 0 TO nBullets
        IF b(i).live = 0 AND fire = 1 THEN 'have in active bullet index to use
            b(i).x = shooter.x + (shooterRadius) * COS(shooter.a + _PI(7 / 8))
            b(i).y = shooter.y + (shooterRadius) * SIN(shooter.a + _PI(7 / 8))
            b(i).dx = bSpeed * COS(shooter.a)
            b(i).dy = bSpeed * SIN(shooter.a)
            b(i).live = 1
            fire = 0
        ELSEIF b(i).live = 0 AND fire = 2 THEN
            b(i).x = shooter.x + (shooterRadius) * COS(shooter.a - _PI(7 / 8))
            b(i).y = shooter.y + (shooterRadius) * SIN(shooter.a - _PI(7 / 8))
            b(i).dx = bSpeed * COS(shooter.a)
            b(i).dy = bSpeed * SIN(shooter.a)
            b(i).live = 1
            fire = 1
        END IF
        IF b(i).live = 1 THEN 'new location
            b(i).x = b(i).x + b(i).dx
            b(i).y = b(i).y + b(i).dy
            IF b(i).x > 0 AND b(i).x < ww AND b(i).y > 0 AND b(i).y < wh THEN 'in bounds draw it
                'check for collision with ...
                'else draw bullet
                ba = _ATAN2(b(i).dy, b(i).dx): b = 15
                x1 = b(i).x + b * COS(ba)
                y1 = b(i).y + b * SIN(ba)
                x2 = b(i).x + b * COS(ba + _PI(5 / 6))
                y2 = b(i).y + b * SIN(ba + _PI(5 / 6))
                x3 = b(i).x + b * COS(ba + _PI(7 / 6))
                y3 = b(i).y + b * SIN(ba + _PI(7 / 6))
                fTri x1, y1, x2, y2, x3, y3, _RGB32(0, 0, 160)
                'fcirc b(i).x, b(i).y, 4, _RGB32(64, 0, 0)
            ELSE
                b(i).live = 0
            END IF
        END IF
    NEXT
END SUB
 
SUB drawshooter ()
    'just a wedge
    x1 = shooter.x + shooterRadius * COS(shooter.a)
    y1 = shooter.y + shooterRadius * SIN(shooter.a)
    x2 = shooter.x + shooterRadius * COS(shooter.a + _PI(7 / 8))
    y2 = shooter.y + shooterRadius * SIN(shooter.a + _PI(7 / 8))
    x3 = shooter.x + shooterRadius * COS(shooter.a - _PI(7 / 8))
    y3 = shooter.y + shooterRadius * SIN(shooter.a - _PI(7 / 8))
    fTri x1, y1, x2, y2, x3, y3, _RGB32(155, 55, 0)
    x2 = shooter.x + shooterRadius * COS(shooter.a + _PI(15 / 16))
    y2 = shooter.y + shooterRadius * SIN(shooter.a + _PI(15 / 16))
    x3 = shooter.x + shooterRadius * COS(shooter.a - _PI(15 / 16))
    y3 = shooter.y + shooterRadius * SIN(shooter.a - _PI(15 / 16))
    fTri x1, y1, x2, y2, x3, y3, _RGB32(255, 255, 255)
END SUB
 
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
SUB fTri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB
 

FellippeHeitor · « **Reply #4 on:** March 31, 2019, 11:21:58 am »

Quote from: Pete on March 30, 2019, 11:29:05 pm

Oh, you mean like this?

Code: QB64: [Select]
DEFINT I
DECLARE SUB instructions ()
DECLARE SUB qbide ()
DECLARE SUB mship (imothership)
REM Adds multiple bullets (5) max.
REM Adds firing delay and ship turns red while reloading.
REM Adds aliens.
REM Adds collision for bullets from base to aliens.
REM Adds Mouse support.
REM Adds alien motion.
REM Adds 3 progressive levels.
REM Adds aliens move all the way to both sides.
REM Adds Aliens shoot back.
REM Adds sub-routines.
REM Adds counter.
REM Adds alien bullets finish before moving on to next level.
REM Adds mothership.

DECLARE SUB alienattack (ialiencolstat, ialiencol)
DECLARE SUB alienmissile (iresults)
DECLARE SUB checkcollision (ihitaliens, ialiencol, i4, i)
DECLARE SUB mdriver (ex%, key$, tankx%)
DECLARE SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
DECLARE SUB movealiens (ialiencol, ialiencolstat, iresults)
DECLARE SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)

TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE

DIM SHARED MOUSE$
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX, CX
DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits

imaxalienforce = 6
imaxalienmissiles = 3
lmargin% = 2
rmargin% = 79
topmargin% = 3
ialiencolstat = 6
iwin = 3
screenwidth% = rmargin% - lmargin% + 1
ibk = 1

DIM SHARED a(imaxalienforce) AS STRING * 68

RANDOMIZE TIMER
SCREEN 0, 0, 0, 0
COLOR 7, 1: CLS

REM Make aliens
a1$ = "-<" + CHR$(237) + ">- "
a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$

CALL qbide
CALL instructions

DO
IF inextrnd = -1 THEN PCOPY 3, 0
tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 7
REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
REDIM SHARED matrix(imaxalienforce) AS STRING * 10
alienforce% = imaxalienforce
level = .65
iround = iround + 1
level = level - iround / 15
inextrnd = -1
COLOR 7, ibk

REM Set up aliens
ialiencol = ialiencolstat
LOCATE 2, ialiencol
FOR i = 1 TO imaxalienforce
IF i MOD 1 = 0 THEN PRINT
LOCATE , ialiencol
IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
a(i) = a$
PRINT a(i)
NEXT

REM Station
LOCATE 24, 40, 1, 7, 7
PRINT tank$;: LOCATE , POS(1) - 2: tanky% = CSRLIN: tankx% = POS(1) + 1
key$ = INKEY$: SLEEP 1
ex% = 1: CALL mdriver(ex%, key$, tankx%)
DO
z1 = TIMER
DO
IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
IF imothership <> 0 THEN CALL mship(imothership)
END IF
IF ABS(TIMER - z1aliens) > level THEN
CALL movealiens(ialiencol, ialiencolstat, iresults)
z1aliens = TIMER
END IF
IF iresults < 0 THEN EXIT DO
IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
key$ = INKEY$
IF key$ = "" THEN ex% = 2: CALL mdriver(ex%, key$, tankx%)
SELECT CASE key$
CASE CHR$(0) + "K"
IF POS(1) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(1) - 2: PRINT tank$ + " ";: LOCATE , POS(1) - 3
tanky% = CSRLIN: tankx% = POS(1)
IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
CASE CHR$(0) + "M"
IF POS(1) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(1) - 1: PRINT " " + tank$;: LOCATE , POS(1) - 2
tanky% = CSRLIN: tankx% = POS(1)
IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
CASE CHR$(32)
IF icolor = 7 THEN
FOR i2 = 1 TO 5
IF bullet%(i2) = 0 THEN
icolor = 12: COLOR icolor, ibk: GOSUB redraw
bullet%(i2) = -1: reload = TIMER: EXIT FOR
END IF
NEXT
END IF
CASE CHR$(27): SYSTEM
END SELECT

IF ABS(z1 - reload) > .7 AND reload <> 0 THEN
GOSUB redraw
icolor = 7: reload = 0
END IF

REM Fire
FOR i = 1 TO 5
SELECT CASE bullet%(i)
CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
CASE IS > 0
IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
CALL checkcollision(ihitaliens, ialiencol, i4, i)
z2bullet = TIMER: bulletdelay%(i) = 0
COLOR 7, ibk
LOCATE bullet%(i), bulletcol%(i)
IF bullet%(i) = topmargin% AND imothership <> 0 THEN
IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
SOUND 1000, .75
LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
imothership = 0
END IF
END IF
PRINT CHR$(24)
IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
LOCATE tanky%, tankx%
IF bullet%(i) > topmargin% THEN
bullet%(i) = bullet%(i) - 1
ELSE
GOSUB erasebullet
END IF
END IF
END SELECT
NEXT

REM Bullet timer delay
IF z2bullet <> 0 THEN
IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
IF z1 - z2bullet >= .06 THEN
FOR i2 = 1 TO 5
IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
NEXT i2
END IF
EXIT DO
END IF
LOOP
IF iresults < 0 THEN EXIT DO
IF alienforce% = 0 OR iresults = iwin THEN
FOR i = 1 TO imaxalienmissiles
IF ia(i) <> 0 THEN EXIT FOR
NEXT
IF i > imaxalienmissiles THEN iwait = -1
IF iwait = -1 THEN
EXIT DO
END IF
ELSE
iwait = 1
END IF
LOOP
ex% = -1: CALL mdriver(ex%, key$, tankx%)
key$ = INKEY$
SLEEP 2
IF iresults = iwin OR iresults < 0 THEN
REM end game
EXIT DO
END IF
inextrnd = -1
LOOP
SELECT CASE iresults
CASE IS < 0
COLOR 7, ibk
LOCATE tanky% - 1, lmargin%
PRINT SPACE$(screenwidth%);
LOCATE tanky%, lmargin%
PRINT SPACE$(screenwidth%);
key$ = INKEY$
SOUND 140, 2
SLEEP 2
END SELECT
CALL qbide
CALL instructions
SYSTEM

erasebullet:
LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
LOCATE tanky%, tankx%
RETURN

redraw:
COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
RETURN

DATA "Well, I better get busy and finish the compiler..."
DATA "Or... I'll just do some more work on this IDE, instead..."
DATA ""
DATA " Loading..."
DATA "EOF"
DATA "Game Over. Thanks for playing..."
DATA ""
DATA "Now finish the compiler!"
DATA "EOF2"

SUB alienattack (ialiencolstat, ialiencol)
z2alienfire = TIMER

i3 = INT(RND * 10)
FOR i = 1 TO imaxalienmissiles
IF ia(i) = 0 THEN
FOR i2 = imaxalienforce TO 1 STEP -1
IF RTRIM$(a(i2)) <> "" THEN
IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(237)) + ialiencol
EXIT FOR
END IF
END IF
NEXT i2
IF i4 <> 0 THEN
ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
EXIT FOR
END IF
END IF
NEXT i

END SUB

SUB alienmissile (iresults)
irow = CSRLIN: icol = POS(1)
FOR i = 1 TO imaxalienmissiles
IF ia(i) <> 0 THEN
IF iy(i) = 0 THEN
iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
IF ix(i) = 0 THEN ix(i) = screenwidth%
END IF
LOCATE iy(i) + 1, ix(i)
COLOR 7, ibk
IF CSRLIN <= 24 THEN
IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
PRINT CHR$(25);
ELSE
ia(i) = 0
LOCATE iy(i), ix(i)
PRINT " ";: iy(i) = 0
ia(i) = 0
LOCATE irow, icol
EXIT SUB
END IF
LOCATE iy(i), ix(i): PRINT " ";
iy(i) = iy(i) + 1
END IF
NEXT
LOCATE irow, icol

END SUB

SUB checkcollision (ihitaliens, ialiencol, i4, i)
ihitaliens = 0
IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
IF RTRIM$(a(i4)) <> "" THEN
IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
ihitaliens = bulletcol%(i) - ialiencol + 1
i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
i2 = INSTR(i3 + 1, a(i4), "<") - 1
MID$(a(i4), i2, 7) = SPACE$(7)
MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
END IF
END IF
END IF
END IF
END IF

FOR i2 = 1 TO imaxalienmissiles
IF ia(i2) <> 0 THEN
IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
ihitaliens = -i2
EXIT FOR
END IF
END IF
NEXT

END SUB

SUB instructions

''in$ = "EOF"
IF in$ = "" THEN
key$ = INKEY$
LOCATE 3, 3, 1, 7, 7: COLOR 7, ibk
SLEEP 2
DO
READ in$
IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
FOR i = 1 TO LEN(in$)
SOUND 400, .1
LOCATE , 2 + i
PRINT MID$(in$, i, 1);
z = TIMER
DO
IF ABS(z - TIMER) > .1 THEN EXIT DO
LOOP
NEXT
LOCATE , , 0, 7, 0
key$ = INKEY$
SLEEP 1
PRINT
LOCATE , 3
LOOP
key$ = INKEY$
SLEEP 1
END IF

IF in$ = "EOF" THEN
COLOR 7, 1
FOR i = 1 TO 5
LOCATE 2 + i, 2: PRINT SPACE$(78)
NEXT
FOR i = 3 TO 24
LOCATE i, 80: PRINT CHR$(179);
NEXT
LOCATE 21, 2: PRINT STRING$(78, " ");
LOCATE 22, 1: PRINT CHR$(179);
LOCATE 22, 80: PRINT CHR$(179);
LOCATE 22, 2: PRINT STRING$(78, " ");
ELSE
COLOR 0, 3
END IF

COLOR 0, 3
yy% = CSRLIN: xx% = POS(1)
LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
PRINT LTRIM$(STR$(ihits));
LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
PRINT "0";
LOCATE yy%, xx%

PCOPY 0, 3: REM save skin

END SUB

SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
COLOR 7, ibk
ileadingrow = ileadingrow + 1
ileadingmax = ileadingmax + 1
COLOR 7, ibk
FOR i = 1 TO imaxalienforce
IF RTRIM$(a(i)) <> "" THEN
ialiencol = ialiencolstat + imotion
LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
PRINT STRING$(screenwidth%, " ")
LOCATE , ialiencol + INSTR(a(i), "-")
iltalien(i) = POS(1)
PRINT LTRIM$(RTRIM$(a(i)))
END IF
NEXT
LOCATE irow, icol
level = level - .025
IF ileadingrow = 22 THEN iresults = -2
END SUB

DEFSNG I
SUB mdriver (ex%, key$, tankx%)
STATIC MOUSEACT%

REM INITIATE MOUSE
IF MOUSEACT% = 0 OR ex% = -1 THEN
Registers.AX = 0: GOSUB CALLI
MOUSEACT% = 1
END IF

IF ex% = 1 THEN
Registers.AX = 4: Registers.DX = 184: Registers.CX = 304
Registers.AX = 8: Registers.DX = 184: Registers.CX = 184
GOSUB CALLI
EXIT SUB
END IF

Registers.AX = 3: GOSUB CALLI

DX = Registers.DX
CX = Registers.CX
y% = DX \ 8 + 1: x% = CX \ 8 + 1

REM MOUSE BUTTONS
LB% = Registers.BX AND 1
RB% = (Registers.BX AND 2) \ 2
MB% = (Registers.BX AND 4) \ 4

IF LB% <> 0 THEN
key$ = CHR$(32)
ELSE
IF x% > tankx% THEN key$ = CHR$(0) + "M"
IF x% < tankx% THEN key$ = CHR$(0) + "K"
END IF
EXIT SUB

CALLI:
CALL INTERRUPT(&H33, Registers, Registers)
RETURN

END SUB

DEFINT I
SUB movealiens (ialiencol, ialiencolstat, iresults)
STATIC imotion, imarch, imotiondir
IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
irow = CSRLIN: icol = POS(1)
yy% = CSRLIN: xx% = POS(1)
PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
COLOR 7, ibk

FOR i = imaxalienforce TO 1 STEP -1
IF RTRIM$(a(i)) <> "" THEN
i2 = i2 + 2
SOUND 400, .03
ialiencol = ialiencolstat + imotion
LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "-")
IF POS(1) = lmargin% THEN imarch = 1
iltalien(i) = POS(1)
IF imotiondir = 0 THEN
PRINT LTRIM$(RTRIM$(a(i))); " "
ELSE
LOCATE , POS(1) - 1
PRINT " "; LTRIM$(RTRIM$(a(i)))
END IF
IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
END IF
NEXT

IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
IF imarch = 0 THEN
IF ABS(TIMER - z2alienfire) > firerate THEN
firerate = (INT(RND * 10) + 1) / 20
IF iwait = 0 THEN CALL alienattack(ialiencolstat, ialiencol)
END IF
ELSE
imarch = 0
END IF
PCOPY 1, 0: SCREEN 0, 0, 0, 0
LOCATE irow, icol, 1, 7, 7
END SUB

SUB mship (imothership)
STATIC x%, mov%, z4, mothership$

yy% = CSRLIN: xx% = POS(1): COLOR 7, ibk
IF imothership = -1 THEN
imothership = 1
x% = lmargin%
mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
mov% = 1
END IF

IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
''IF ABS(TIMER - z2) > .2 THEN GOSUB bullets: z2 = TIMER
LOCATE yy%, xx%
EXIT SUB

mothership:
IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
x% = x% + mov%
LOCATE topmargin%, x%
PRINT mothership$;
IF x% > 1 AND mov% = 1 THEN
LOCATE , POS(1) - LEN(mothership$) - 1: PRINT " ";
END IF
IF mov% = -1 THEN PRINT " ";
RETURN

END SUB

DEFINT A-H, J-Z
SUB qbide
PALETTE 2, 59
COLOR 15, 1
CLS

COLOR 0, 7
LOCATE 1, 1
PRINT SPACE$(80)
LOCATE 1, 1: PRINT " File Edit View Search Run Debug Calls Options Help"

COLOR 7, 1

LOCATE 2, 1: PRINT CHR$(218)
LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
LOCATE 2, 80: PRINT CHR$(191)

LOCATE 2, 76: PRINT CHR$(180)
LOCATE 2, 78: PRINT CHR$(195)

COLOR 1, 7
LOCATE 2, 77: PRINT CHR$(24)
LOCATE 2, 36: PRINT " Untitled "

COLOR 7, 1
FOR Rows = 3 TO 24
LOCATE Rows, 1: PRINT CHR$(179);
LOCATE Rows, 80: PRINT CHR$(179);
NEXT Rows

LOCATE 22, 1: PRINT CHR$(195)
LOCATE 22, 80: PRINT CHR$(180)
LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
LOCATE 22, 35
PRINT " Immediate "

COLOR 0, 7
LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
LOCATE 21, 2: PRINT CHR$(27)
LOCATE 21, 3: PRINT CHR$(219)
LOCATE 21, 79: PRINT CHR$(26)
FOR Rows = 4 TO 19
LOCATE Rows, 80: PRINT CHR$(176)
NEXT Rows
LOCATE 3, 80: PRINT CHR$(24)
LOCATE 4, 80: PRINT CHR$(219)
LOCATE 20, 80: PRINT CHR$(25)

COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
LOCATE 25, 59: PRINT SPACE$(4);
COLOR 0, 3
LOCATE 25, 63: PRINT CHR$(179);
LOCATE 25, 64: PRINT SPACE$(6);
LOCATE 25, 68: PRINT "C 00001:001 ";

END SUB

DEFSNG A-H, J-Z
SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
IF ihitaliens > 0 THEN
ihits = ihits + 1
IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
iltalien(i4) = POS(1)

IF RTRIM$(a(i4)) = "" THEN
alienforce% = alienforce% - 1
IF alienforce% = 0 THEN iresults = iresults + 1
IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
ELSE
LOCATE bullet%(i), ialiencol + INSTR(a(i4), "-"): PRINT LTRIM$(RTRIM$(a(i4)))
END IF
ELSE
i2 = ABS(ihitaliens)
LOCATE iy(i2), ix(i2)
PRINT " ";: iy(i2) = 0
ia(i2) = 0
LOCATE irow, icol
SOUND 1000, .5
END IF

ihitaliens = 0
bullet%(i) = -bullet%(i)

COLOR 0, 3
yy% = CSRLIN: xx% = POS(1)
LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
PRINT LTRIM$(STR$(ihits));
LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
PRINT LTRIM$(STR$(imaxalienforce - alienforce%));
LOCATE yy%, xx%
COLOR 7, ibk
END SUB

Edit: Hey, I found the mother ship version! Mouse to move, left click to shoot.

Aurel · « **Reply #5 on:** March 31, 2019, 04:03:34 pm »

I am not gamer but i must say that i like SMcNeill shooter
Please just rebuild this ugly shape of cannon or ship .
mooving and fire works fine

mark ..sorry but what is that ?

pete
finish compiler...also shooter is craAAzy !

bplus · « **Reply #6 on:** March 31, 2019, 04:14:13 pm »

Code: QB64: [Select]

mark ..sorry but what is that ?

Sorry, it's a free moving shooter that points in any direction you move or swings around CCW or CW depending which mouse button you press. Try out the shooter here in Reply #1: https://www.qb64.org/forum/index.php?topic=392.msg3613#msg3613

Perhaps you'd rather be stuck on a track only able to shoot in one direction by pumping the arrow and spacebar keys. ;-))

Aurel · « **Reply #7 on:** April 01, 2019, 02:10:14 am »

yo mark

Quote

Perhaps you'd rather be stuck on a track only able to shoot in one direction by pumping the arrow and spacebar keys. ;-))

Yes...and you know why?
simply because ...sorry man but your "mooving" is very " so so "
i will found one old shooter in CB i should post it on rtroB written in dx...then you will see difference.
for a simple shooter i prefer < - > space

_vince · « **Reply #8 on:** April 01, 2019, 09:17:55 am »

You're quite the critic, Aurel

bplus · « **Reply #9 on:** April 01, 2019, 10:22:33 am »

Quote from: Aurel on April 01, 2019, 02:10:14 am

yo mark
Quote
Perhaps you'd rather be stuck on a track only able to shoot in one direction by pumping the arrow and spacebar keys. ;-))

Yes...and you know why?
simply because ...sorry man but your "mooving" is very " so so "
i will found one old shooter in CB i should post it on rtroB written in dx...then you will see difference.
for a simple shooter i prefer < - > space

Ha! One track mind stuck in Recursive Decent Parsing! ;-))

I am not much of a gamer either but I love the sweeping mouse control over pounding little arrow keys. Perhaps I should have used a mouse button for firing shots instead of rotating a machine gun like turret with unlimited ammo. But when you are fighting off invaders for survival, who wants to worry about having enough ammo? :)

OK the fix is on it's way.

(On my keyboard, they jammed 4 arrow keys in the space of three letter buttons making it miserable to play games.)

bplus · « **Reply #10 on:** April 01, 2019, 12:08:57 pm »

OK now mouse buttons trigger shots and limited to 3 active bullets, move mouse towards target and click.

Code: QB64: [Select]

_TITLE "Mouse Action Shooter MB triggers" 'B+ 2019-04-01
'Mouse Action Shooter started from eRATication 5 by bplus 2018-08-06"
' upodate Mouse Action Shooter with MB triggers 2019-04-01
 
'screen dimensions
CONST ww = 1200
CONST wh = 700
CONST nBullets = 3
CONST bSpeed = 20
CONST shooterRadius = 50
 
TYPE shooterType
    x AS SINGLE
    y AS SINGLE
    a AS SINGLE
END TYPE
 
TYPE bulletType
    x AS INTEGER
    y AS INTEGER
    dx AS INTEGER
    dy AS INTEGER
    live AS INTEGER
END TYPE
 
SCREEN _NEWIMAGE(ww, wh, 32)
_SCREENMOVE 100, 20
RANDOMIZE TIMER
 
 
DIM SHARED GameOn, newRound, fire, mb1, mb2, last1, last2
 
DIM SHARED b(nBullets) AS bulletType
DIM SHARED shooter AS shooterType
shooter.x = ww / 2
shooter.y = wh / 2
shooter.a = 0
lastx = ww / 2: lasty = wh / 2
GameOn = 1
_MOUSEHIDE
WHILE GameOn
    CLS
    fire = 0: mb1 = 0: mb2 = 0
    WHILE _MOUSEINPUT: WEND
    shooter.x = _MOUSEX: shooter.y = _MOUSEY
    IF ABS(lastx - shooter.x) > 3 AND ABS(lasty - shooter.y) > 3 THEN
        shooter.a = _ATAN2(shooter.y - lasty, shooter.x - lastx)
        lastx = shooter.x: lasty = shooter.y
    END IF
    t = TIMER(.001)
    IF _MOUSEBUTTON(1) THEN 'when ship is heading north the left button should be left
        IF t - last2 > .25 THEN mb2 = 1: last2 = t
    END IF
    IF _MOUSEBUTTON(2) THEN
        IF t - last1 > .25 THEN mb1 = 1: last1 = t
    END IF
    IF _KEYDOWN(27) THEN _MOUSESHOW: END
    drawshooter
    handleBullets
    _DISPLAY
    _LIMIT 30
WEND
 
SUB handleBullets ()
    FOR i = 0 TO nBullets - 1
        IF b(i).live = 0 AND mb1 = 1 THEN 'have in active bullet index to use
            b(i).x = shooter.x + (shooterRadius) * COS(shooter.a + _PI(7 / 8))
            b(i).y = shooter.y + (shooterRadius) * SIN(shooter.a + _PI(7 / 8))
            b(i).dx = bSpeed * COS(shooter.a)
            b(i).dy = bSpeed * SIN(shooter.a)
            b(i).live = 1
            mb1 = 0
        ELSEIF b(i).live = 0 AND mb2 = 1 THEN
            b(i).x = shooter.x + (shooterRadius) * COS(shooter.a - _PI(7 / 8))
            b(i).y = shooter.y + (shooterRadius) * SIN(shooter.a - _PI(7 / 8))
            b(i).dx = bSpeed * COS(shooter.a)
            b(i).dy = bSpeed * SIN(shooter.a)
            b(i).live = 1
            mb2 = 0
 
        ELSEIF b(i).live = 1 THEN 'new location
            b(i).x = b(i).x + b(i).dx
            b(i).y = b(i).y + b(i).dy
            IF b(i).x > 0 AND b(i).x < ww AND b(i).y > 0 AND b(i).y < wh THEN 'in bounds draw it
                'check for collision with ...
 
                'else draw bullet
                ba = _ATAN2(b(i).dy, b(i).dx): b = 15
                x1 = b(i).x + b * COS(ba)
                y1 = b(i).y + b * SIN(ba)
                x2 = b(i).x + b * COS(ba + _PI(5 / 6))
                y2 = b(i).y + b * SIN(ba + _PI(5 / 6))
                x3 = b(i).x + b * COS(ba + _PI(7 / 6))
                y3 = b(i).y + b * SIN(ba + _PI(7 / 6))
                fTri x1, y1, x2, y2, x3, y3, _RGB32(0, 0, 160)
                'fcirc b(i).x, b(i).y, 4, _RGB32(64, 0, 0)
            ELSE
                b(i).live = 0 'dectiveate
            END IF
        END IF
    NEXT
END SUB
 
SUB drawshooter ()
    'just a wedge
    x1 = shooter.x + shooterRadius * COS(shooter.a)
    y1 = shooter.y + shooterRadius * SIN(shooter.a)
    x2 = shooter.x + shooterRadius * COS(shooter.a + _PI(7 / 8))
    y2 = shooter.y + shooterRadius * SIN(shooter.a + _PI(7 / 8))
    x3 = shooter.x + shooterRadius * COS(shooter.a - _PI(7 / 8))
    y3 = shooter.y + shooterRadius * SIN(shooter.a - _PI(7 / 8))
    fTri x1, y1, x2, y2, x3, y3, _RGB32(155, 55, 0)
    x2 = shooter.x + shooterRadius * COS(shooter.a + _PI(15 / 16))
    y2 = shooter.y + shooterRadius * SIN(shooter.a + _PI(15 / 16))
    x3 = shooter.x + shooterRadius * COS(shooter.a - _PI(15 / 16))
    y3 = shooter.y + shooterRadius * SIN(shooter.a - _PI(15 / 16))
    fTri x1, y1, x2, y2, x3, y3, _RGB32(255, 255, 255)
END SUB
 
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
SUB fTri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB
 

Aurel · « **Reply #11 on:** April 01, 2019, 01:59:09 pm »

Quote

You're quite the critic, Aurel

ahh no...Mark is my old online friend and i know that he can better.

Ashish · « **Reply #12 on:** April 03, 2019, 01:09:37 am »

@Pete
Impressive.
@bplus
It is nice in your program that direction can be easily controlled by mouse.

News:

Author Topic: Shooter Start (Read 3380 times)

SMcNeill

Shooter Start

Pete

Re: Shooter Start

qb4ever

Re: Shooter Start

bplus

Re: Shooter Start

FellippeHeitor

Re: Shooter Start

Aurel

Re: Shooter Start

bplus

Re: Shooter Start

Aurel

Re: Shooter Start

_vince

Re: Shooter Start

bplus

Re: Shooter Start

bplus

Re: Shooter Start

Aurel

Re: Shooter Start

Ashish

Re: Shooter Start