Author Topic: Random landscape  (Read 1805 times)

0 Members and 1 Guest are viewing this topic.

Offline 191Brian

  • Newbie
  • Posts: 91
    • My Itch page
Random landscape
« on: January 27, 2021, 03:24:51 pm »
Hi
I am new to the exciting world of QB64. Just starting work on a invaders style game as a way to learn, in the game before you get to shoot anything you need to land your spaceship. So I have written a couple of subs to generate a random channel that the player will have fly down.

Is  there a way to paint textures as well as solid colours?

Code: QB64: [Select]
  1.  
  2. 'Program to test drawing a random channel for lander mini game
  3. '-------------------------------------------------------------
  4.  
  5. CONST qbWHITE = _RGB32(255)
  6. CONST qbGREY = _RGB32(127)
  7.  
  8. 'Declare cords of the lefthand side of the channel mouth
  9. '-------------------------------------------------------
  10.  
  11.  
  12. SCREEN _NEWIMAGE(800, 600, 32)
  13.  
  14. 'calculate cords of the lefthand side of the channel mouth
  15. '---------------------------------------------------------
  16. 'lastX = 0
  17. 'lastY = 100
  18. newX = _WIDTH / 4 + RND * (_WIDTH / 4)
  19. newY = 100
  20.  
  21. DrawDownRndChan newX, newY, _HEIGHT - 1, 64, qbWHITE
  22. 'Paint the sides of the channel
  23. '------------------------------
  24. PAINT (newX - 50, newY + 10), qbGREY, qbWHITE
  25. PAINT (_WIDTH - 50, newY + 100), qbGREY, qbWHITE
  26.  
  27.  
  28. SUB DrawDownRndChan (startX AS SINGLE, startY AS SINGLE, maxY AS SINGLE, minWidth AS SINGLE, lineColour AS LONG)
  29.     ' Draw a channel down the screen in a randowm fashion to simulate a rocky terrain
  30.     '--------------------------------------------------------------------------------
  31.     '
  32.     '/\/\//////\///\////        \/\///\/\/\/\/\/\/\/
  33.     '                   |       /
  34.     '                   \      \
  35.     '                    \      \
  36.     '--------------------------------------------------------------------------------
  37.     'Parameters
  38.     'startX, startY cords of the lefthand side of the channel opening
  39.     'minWidth the minimum width of the channel
  40.     'lineColour rgb colour to draw the lines
  41.     'Calls
  42.     'calls sub DrawRightRnd to draw wiggly horizontal line from the edges of the screen to the mouth of the channel
  43.     DIM lastX, lastRx AS SINGLE '   end point of the last line
  44.     DIM lastY AS SINGLE '           ------------"--------------
  45.     DIM newX, newRx AS SINGLE '     next x cord either side of the channel
  46.     DIM newY AS SINGLE '            next y cord (going down)
  47.  
  48.     newX = startX
  49.     newY = startY
  50.     lastRx = startX + minWidth + (RND * 10) 'calc inital width of the channel
  51.     newRx = lastRx
  52.  
  53.     'draw wiggly line from the sides of the screen to the mouth of the channel
  54.     LineHorizRnd 0, startY, startX, startY, lineColour
  55.     LineHorizRnd lastRx, startY, _WIDTH - 1, startY, lineColour
  56.  
  57.     'Channel drawing loop
  58.     '--------------------
  59.     DO UNTIL newY = maxY
  60.         lastX = newX
  61.         lastY = newY
  62.         lastRx = newRx
  63.         newX = lastX + (RND * 40 - 20)
  64.         newRx = newX + minWidth + (RND * 10)
  65.         newY = lastY + RND * 50
  66.         IF newY >= maxY THEN
  67.             newY = maxY
  68.         END IF
  69.         LINE (lastX, lastY)-(newX, newY), lineColour '  draw lefthand section of channel
  70.         LINE (lastRx, lastY)-(newRx, newY), lineColour ' draw rigthand section of channel
  71.     LOOP
  72.  
  73.  
  74. SUB LineHorizRnd (startX AS SINGLE, startY AS SINGLE, endX AS SINGLE, endY AS SINGLE, lineColour AS LONG)
  75.     'draw a wiggly horizontal line from left to right
  76.     '------------------------------------------------
  77.     DIM newX AS SINGLE
  78.     DIM newY AS SINGLE
  79.  
  80.     PSET (startX, startY), lineColour ' Set the start point for the line
  81.  
  82.     newX = startX
  83.     newY = startY
  84.     'Main line drawing loop
  85.     '----------------------
  86.     DO UNTIL newX = endX
  87.         newX = newX + (RND * 30) + 10
  88.         newY = startY + (RND * 20 - 10)
  89.         IF newX >= endX THEN '  make sure we end at the right place
  90.             newX = endX
  91.             newY = endY
  92.         END IF
  93.         LINE -(newX, newY), lineColour
  94.     LOOP
  95.  
  96.  

ran chan 2.png
* ran chan 2.png (Filesize: 7.06 KB, Dimensions: 799x624, Views: 214)
ran chan 2.png
* ran chan 2.png (Filesize: 7.06 KB, Dimensions: 799x624, Views: 230)
Brian ...

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
Re: Random landscape
« Reply #1 on: January 27, 2021, 03:41:02 pm »
Hi. Welcome to the forum!

For textures use _LOADIMAGE (only 32 bit images are directly supported), _CLEARCOLOR for erase background color, or _SETALPHA for the same, then _MAPTRIANGLE or _PUTIMAGE for drawing textures. Also you can using standard QBasic statements as GET for graphic...., virtual screens with _SOURCE and _DEST, OpenGL graphic using OpenGL statements, software or hardware graphic layers or both.... here is many options :) You can use also directly hardware images and 3D space, this use OpenGL coordinate system...

https://www.qb64.org/forum/index.php?topic=300.msg109338#msg109338
https://www.qb64.org/forum/index.php?topic=1723.msg109567#msg109567
https://www.qb64.org/forum/index.php?topic=2258.msg114959#msg114959

You have many options!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: Random landscape
« Reply #2 on: January 27, 2021, 03:49:17 pm »
Paint Images:
Code: QB64: [Select]
  1. SUB paintImage (x, y, Border~&, destHandle&, imageHandle&)
  2.     d = _DEST: s = _SOURCE
  3.     _DEST destHandle&
  4.     PAINT (x, y), _RGB(119, 24, 49), Border~&
  5.     FOR y = 0 TO _HEIGHT(destHandle&)
  6.         FOR x = 0 TO _WIDTH(destHandle&)
  7.             _SOURCE destHandle&
  8.             IF POINT(x, y) = _RGB(119, 24, 49) THEN
  9.                 _SOURCE imageHandle&
  10.                 PSET (x, y), POINT(x MOD _WIDTH(imageHandle&), y MOD _HEIGHT(imageHandle&))
  11.             END IF
  12.         NEXT
  13.     NEXT
  14.     _DEST d: _SOURCE s
  15.  

* Paint Image pkg.zip (Filesize: 70.55 KB, Downloads: 125)

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
Re: Random landscape
« Reply #3 on: January 27, 2021, 06:48:50 pm »
Space Invaders? Didn't you know? you can already play that inside the QB64 IDE...

Code: QB64: [Select]
  1.     DEFINT I
  2.     DECLARE SUB instructions ()
  3.     DECLARE SUB qbide ()
  4.     DECLARE SUB mship (imothership)
  5.     REM Adds multiple bullets (5) max.
  6.     REM Adds firing delay AND ship turns red WHILE reloading.
  7.     REM Adds aliens.
  8.     REM Adds collision FOR bullets from BASE TO aliens.
  9.     REM Adds Mouse support.
  10.     REM Adds alien motion.
  11.     REM Adds 3 progressive levels.
  12.     REM Adds aliens move all the way TO both sides.
  13.     REM Adds Aliens shoot back.
  14.     REM Adds sub-routines.
  15.     REM Adds counter.
  16.     REM Adds alien bullets finish before moving ON TO NEXT level.
  17.     REM Adds mothership.
  18.      
  19.     DECLARE SUB alienattack (ialiencolstat, ialiencol)
  20.     DECLARE SUB alienmissile (iresults)
  21.     DECLARE SUB checkcollision (ihitaliens, ialiencol, i4, i)
  22.     DECLARE SUB mdriver (ex%, KEY$, tankx%)
  23.     DECLARE SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
  24.     DECLARE SUB movealiens (ialiencol, ialiencolstat, iresults)
  25.     DECLARE SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
  26.      
  27.     TYPE RegType
  28.         AX AS INTEGER
  29.         BX AS INTEGER
  30.         CX AS INTEGER
  31.         DX AS INTEGER
  32.         BP AS INTEGER
  33.         SI AS INTEGER
  34.         DI AS INTEGER
  35.         FLAGS AS INTEGER
  36.         DS AS INTEGER
  37.         ES AS INTEGER
  38.     END TYPE
  39.      
  40.     DIM SHARED MOUSE$
  41.     DIM SHARED Registers AS RegType
  42.     DIM SHARED LB%, RB%, MB%, DX, CX
  43.     DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
  44.     DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits
  45.      
  46.     imaxalienforce = 6
  47.     imaxalienmissiles = 3
  48.     lmargin% = 2
  49.     rmargin% = 79
  50.     topmargin% = 3
  51.     ialiencolstat = 6
  52.     iwin = 3
  53.     screenwidth% = rmargin% - lmargin% + 1
  54.     ibk = 1
  55.      
  56.     DIM SHARED a(imaxalienforce) AS STRING * 68
  57.      
  58.     SCREEN 0, 0, 0, 0
  59.     COLOR 7, 1: CLS
  60.      
  61.     REM Make aliens
  62.     a1$ = "-<" + CHR$(237) + ">-  "
  63.     a$ = a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$ + a1$
  64.      
  65.     CALL qbide
  66.     CALL instructions
  67.      
  68.     DO
  69.         IF inextrnd = -1 THEN PCOPY 3, 0
  70.         tank$ = CHR$(218) + CHR$(127) + CHR$(191): icolor = 7
  71.         REDIM SHARED bullet%(5), bulletcol%(5), bulletdelay%(5), iltalien(imaxalienforce)
  72.         REDIM SHARED ia(imaxalienmissiles), iy(imaxalienmissiles), ix(imaxalienmissiles)
  73.         REDIM SHARED matrix(imaxalienforce) AS STRING * 10
  74.         alienforce% = imaxalienforce
  75.         level = .65
  76.         iround = iround + 1
  77.         level = level - iround / 15
  78.         inextrnd = -1
  79.         COLOR 7, ibk
  80.      
  81.         REM Set up aliens
  82.         ialiencol = ialiencolstat
  83.         LOCATE 2, ialiencol
  84.         FOR i = 1 TO imaxalienforce
  85.             IF i MOD 1 = 0 THEN PRINT
  86.             LOCATE , ialiencol
  87.             IF i = imaxalienforce THEN ileadingrow = CSRLIN: ileadingmax = ileadingrow
  88.             a(i) = a$
  89.             PRINT a(i)
  90.         NEXT
  91.      
  92.         REM Station
  93.         LOCATE 24, 40, 1, 7, 7
  94.         PRINT tank$;: LOCATE , POS(1) - 2: tanky% = CSRLIN: tankx% = POS(1) + 1
  95.         KEY$ = INKEY$: SLEEP 1
  96.         ex% = 1: CALL mdriver(ex%, KEY$, tankx%)
  97.         DO
  98.             z1 = TIMER
  99.             DO
  100.                 IF topmargin% + ileadingmax - (imaxalienforce * 2) >= topmargin% + 2 THEN
  101.                     IF imothership <> 0 THEN CALL mship(imothership)
  102.                 END IF
  103.                 IF ABS(TIMER - z1aliens) > level THEN
  104.                     CALL movealiens(ialiencol, ialiencolstat, iresults)
  105.                     z1aliens = TIMER
  106.                 END IF
  107.                 IF iresults < 0 THEN EXIT DO
  108.                 IF ABS(TIMER - z1ia) > .3 THEN CALL alienmissile(iresults): z1ia = TIMER
  109.                 KEY$ = INKEY$
  110.                 IF KEY$ = "" THEN ex% = 2: CALL mdriver(ex%, KEY$, tankx%)
  111.                 SELECT CASE KEY$
  112.                     CASE CHR$(0) + "K"
  113.                         IF POS(1) > lmargin% + 1 THEN COLOR icolor, ibk: LOCATE , POS(1) - 2: PRINT tank$ + " ";: LOCATE , POS(1) - 3
  114.                         tanky% = CSRLIN: tankx% = POS(1)
  115.                         IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
  116.                     CASE CHR$(0) + "M"
  117.                         IF POS(1) < screenwidth% THEN COLOR icolor, ibk: LOCATE , POS(1) - 1: PRINT " " + tank$;: LOCATE , POS(1) - 2
  118.                         tanky% = CSRLIN: tankx% = POS(1)
  119.                         IF SCREEN(tanky%, tankx% - 2) = 25 OR SCREEN(tanky%, tankx% + 2) = 25 THEN result = -1: EXIT DO
  120.                     CASE CHR$(32)
  121.                         IF icolor = 7 THEN
  122.                             FOR i2 = 1 TO 5
  123.                                 IF bullet%(i2) = 0 THEN
  124.                                     icolor = 12: COLOR icolor, ibk: GOSUB redraw
  125.                                     bullet%(i2) = -1: reload = TIMER: EXIT FOR
  126.                                 END IF
  127.                             NEXT
  128.                         END IF
  129.                     CASE CHR$(27): SYSTEM
  130.                 END SELECT
  131.      
  132.                 IF ABS(z1 - reload) > .7 AND reload <> 0 THEN
  133.                     GOSUB redraw
  134.                     icolor = 7: reload = 0
  135.                 END IF
  136.      
  137.                 REM Fire
  138.                 FOR i = 1 TO 5
  139.                     SELECT CASE bullet%(i)
  140.                         CASE -1: bullet%(i) = tanky% - 1: bulletcol%(i) = tankx%
  141.                         CASE IS > 0
  142.                             IF bulletdelay%(i) = -1 OR bullet%(i) = tanky% - 1 THEN
  143.                                 CALL checkcollision(ihitaliens, ialiencol, i4, i)
  144.                                 z2bullet = TIMER: bulletdelay%(i) = 0
  145.                                 COLOR 7, ibk
  146.                                 LOCATE bullet%(i), bulletcol%(i)
  147.                                 IF bullet%(i) = topmargin% AND imothership <> 0 THEN
  148.                                     IF SCREEN(ABS(bullet%(i)), bulletcol%(i)) <> 32 THEN
  149.                                         SOUND 1000, .75
  150.                                         LOCATE topmargin%, lmargin%: PRINT SPACE$(screenwidth%);
  151.                                         imothership = 0
  152.                                     END IF
  153.                                 END IF
  154.                                 PRINT CHR$(24)
  155.                                 IF CSRLIN <> 24 THEN LOCATE , bulletcol%(i): PRINT " ";
  156.                                 IF ihitaliens <> 0 THEN CALL reprintaliens(ialiencol, ihitaliens, iresults, i4, i, imothership)
  157.                                 LOCATE tanky%, tankx%
  158.                                 IF bullet%(i) > topmargin% THEN
  159.                                     bullet%(i) = bullet%(i) - 1
  160.                                 ELSE
  161.                                     GOSUB erasebullet
  162.                                 END IF
  163.                             END IF
  164.                     END SELECT
  165.                 NEXT
  166.      
  167.                 REM Bullet TIMER delay
  168.                 IF z2bullet <> 0 THEN
  169.                     IF z1 < z2bullet THEN z2bullet = z2bullet - 86400
  170.                     IF z1 - z2bullet >= .06 THEN
  171.                         FOR i2 = 1 TO 5
  172.                             IF bullet%(i2) <> 0 THEN bulletdelay%(i2) = -1
  173.                         NEXT i2
  174.                     END IF
  175.                     EXIT DO
  176.                 END IF
  177.             LOOP
  178.             IF iresults < 0 THEN EXIT DO
  179.             IF alienforce% = 0 OR iresults = iwin THEN
  180.                 FOR i = 1 TO imaxalienmissiles
  181.                     IF ia(i) <> 0 THEN EXIT FOR
  182.                 NEXT
  183.                 IF i > imaxalienmissiles THEN iwait = -1
  184.                 IF iwait = -1 THEN
  185.                     EXIT DO
  186.                 END IF
  187.             ELSE
  188.                 iwait = 1
  189.             END IF
  190.         LOOP
  191.         ex% = -1: CALL mdriver(ex%, KEY$, tankx%)
  192.         KEY$ = INKEY$
  193.         SLEEP 2
  194.         IF iresults = iwin OR iresults < 0 THEN
  195.             REM END game
  196.             EXIT DO
  197.         END IF
  198.         inextrnd = -1
  199.     LOOP
  200.     SELECT CASE iresults
  201.         CASE IS < 0
  202.             COLOR 7, ibk
  203.             LOCATE tanky% - 1, lmargin%
  204.             PRINT SPACE$(screenwidth%);
  205.             LOCATE tanky%, lmargin%
  206.             PRINT SPACE$(screenwidth%);
  207.             KEY$ = INKEY$
  208.             SOUND 140, 2
  209.             SLEEP 2
  210.     END SELECT
  211.     CALL qbide
  212.     CALL instructions
  213.     SYSTEM
  214.      
  215.     erasebullet:
  216.     LOCATE ABS(bullet%(i)), bulletcol%(i): PRINT " ";
  217.     bullet%(i) = 0: bulletcol%(i) = 0: bulletdelay%(i) = 0
  218.     LOCATE tanky%, tankx%
  219.     RETURN
  220.      
  221.     redraw:
  222.     COLOR , ibk: LOCATE tanky%, tankx% - 1: PRINT tank$;: LOCATE tanky%, tankx%: COLOR 7, ibk
  223.     RETURN
  224.      
  225.     DATA "Well, I better get busy and finish the compiler..."
  226.     DATA "Or... I'll just do some more work on this IDE, instead..."
  227.     DATA ""
  228.     DATA " Loading..."
  229.     DATA "EOF"
  230.     DATA "Game Over. Thanks for playing..."
  231.     DATA ""
  232.     DATA "Now finish the compiler!"
  233.     DATA "EOF2"
  234.      
  235.     SUB alienattack (ialiencolstat, ialiencol)
  236.     z2alienfire = TIMER
  237.      
  238.     i3 = INT(RND * 10)
  239.     FOR i = 1 TO imaxalienmissiles
  240.         IF ia(i) = 0 THEN
  241.             FOR i2 = imaxalienforce TO 1 STEP -1
  242.                 IF RTRIM$(a(i2)) <> "" THEN
  243.                     IF MID$(matrix(i2), i3 + 1, 1) <> "0" THEN
  244.                         i4 = INSTR(i3 * 7 + 1, a(i2), CHR$(237)) + ialiencol
  245.                         EXIT FOR
  246.                     END IF
  247.                 END IF
  248.             NEXT i2
  249.             IF i4 <> 0 THEN
  250.                 ia(i) = (ileadingmax - (imaxalienforce - i2) * 2) * 80 + i4
  251.                 EXIT FOR
  252.             END IF
  253.         END IF
  254.     NEXT i
  255.      
  256.     END SUB
  257.      
  258.     SUB alienmissile (iresults)
  259.     irow = CSRLIN: icol = POS(1)
  260.     FOR i = 1 TO imaxalienmissiles
  261.         IF ia(i) <> 0 THEN
  262.             IF iy(i) = 0 THEN
  263.                 iy(i) = ia(i) \ 80: ix(i) = ia(i) MOD 80
  264.                 IF ix(i) = 0 THEN ix(i) = screenwidth%
  265.             END IF
  266.             LOCATE iy(i) + 1, ix(i)
  267.             COLOR 7, ibk
  268.             IF CSRLIN <= 24 THEN
  269.                 IF CSRLIN = 24 THEN IF SCREEN(CSRLIN, ix(i)) <> 32 THEN iresults = -1
  270.                 PRINT CHR$(25);
  271.             ELSE
  272.                 ia(i) = 0
  273.                 LOCATE iy(i), ix(i)
  274.                 PRINT " ";: iy(i) = 0
  275.                 ia(i) = 0
  276.                 LOCATE irow, icol
  277.                 EXIT SUB
  278.             END IF
  279.             LOCATE iy(i), ix(i): PRINT " ";
  280.             iy(i) = iy(i) + 1
  281.         END IF
  282.     NEXT
  283.     LOCATE irow, icol
  284.      
  285.     END SUB
  286.      
  287.     SUB checkcollision (ihitaliens, ialiencol, i4, i)
  288.     ihitaliens = 0
  289.     IF ileadingmax MOD 2 = bullet%(i) MOD 2 THEN
  290.         i4 = imaxalienforce - (ileadingmax - bullet%(i)) \ 2
  291.         IF bullet%(i) <= ileadingrow AND i4 > 0 AND i4 <= imaxalienforce THEN
  292.             IF RTRIM$(a(i4)) <> "" THEN
  293.                 IF bulletcol%(i) >= iltalien(i4) AND bulletcol%(i) - ialiencol <= LEN(RTRIM$(a(i4))) THEN
  294.                     IF MID$(a(i4), bulletcol%(i) - ialiencol, 1) > CHR$(32) THEN
  295.                         ihitaliens = bulletcol%(i) - ialiencol + 1
  296.                         i3 = ihitaliens - 7 + 1: IF i3 < 1 THEN i3 = 1: REM count from the "<" symbol.
  297.                         i2 = INSTR(i3 + 1, a(i4), "<") - 1
  298.                         MID$(a(i4), i2, 7) = SPACE$(7)
  299.                         MID$(matrix(i4), (i2 + 1) \ 7 + 1, 1) = "0"
  300.                     END IF
  301.                 END IF
  302.             END IF
  303.         END IF
  304.     END IF
  305.      
  306.     FOR i2 = 1 TO imaxalienmissiles
  307.         IF ia(i2) <> 0 THEN
  308.             IF iy(i2) >= bullet%(i) AND ix(i2) = bulletcol%(i) THEN
  309.                 ihitaliens = -i2
  310.                 EXIT FOR
  311.             END IF
  312.         END IF
  313.     NEXT
  314.      
  315.     END SUB
  316.      
  317.     SUB instructions
  318.      
  319.     'in$ = "EOF"
  320.     IF in$ = "" THEN
  321.         KEY$ = INKEY$
  322.         LOCATE 3, 3, 1, 7, 7: COLOR 7, ibk
  323.         SLEEP 2
  324.         DO
  325.             READ in$
  326.             IF MID$(in$, 1, 3) = "EOF" THEN EXIT DO
  327.             FOR i = 1 TO LEN(in$)
  328.                 SOUND 400, .1
  329.                 LOCATE , 2 + i
  330.                 PRINT MID$(in$, i, 1);
  331.                 z = TIMER
  332.                 DO
  333.                     IF ABS(z - TIMER) > .1 THEN EXIT DO
  334.                 LOOP
  335.             NEXT
  336.             LOCATE , , 0, 7, 0
  337.             KEY$ = INKEY$
  338.             SLEEP 1
  339.             PRINT
  340.             LOCATE , 3
  341.         LOOP
  342.         KEY$ = INKEY$
  343.         SLEEP 1
  344.     END IF
  345.      
  346.     IF in$ = "EOF" THEN
  347.         COLOR 7, 1
  348.         FOR i = 1 TO 5
  349.             LOCATE 2 + i, 2: PRINT SPACE$(78)
  350.         NEXT
  351.         FOR i = 3 TO 24
  352.             LOCATE i, 80: PRINT CHR$(179);
  353.         NEXT
  354.         LOCATE 21, 2: PRINT STRING$(78, " ");
  355.         LOCATE 22, 1: PRINT CHR$(179);
  356.         LOCATE 22, 80: PRINT CHR$(179);
  357.         LOCATE 22, 2: PRINT STRING$(78, " ");
  358.     ELSE
  359.         COLOR 0, 3
  360.     END IF
  361.      
  362.     COLOR 0, 3
  363.     yy% = CSRLIN: xx% = POS(1)
  364.     LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
  365.     PRINT LTRIM$(STR$(ihits));
  366.     LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
  367.     PRINT "0";
  368.     LOCATE yy%, xx%
  369.      
  370.     PCOPY 0, 3: REM save skin
  371.      
  372.     END SUB
  373.      
  374.     SUB marchdown (ialiencol, ialiencolstat, imotion, iresults)
  375.     COLOR 7, ibk
  376.     ileadingrow = ileadingrow + 1
  377.     ileadingmax = ileadingmax + 1
  378.     COLOR 7, ibk
  379.     FOR i = 1 TO imaxalienforce
  380.         IF RTRIM$(a(i)) <> "" THEN
  381.             ialiencol = ialiencolstat + imotion
  382.             LOCATE ileadingmax - (imaxalienforce * 2) + i * 2 - 1, lmargin%
  383.             PRINT STRING$(screenwidth%, " ")
  384.             LOCATE , ialiencol + INSTR(a(i), "-")
  385.             iltalien(i) = POS(1)
  386.             PRINT LTRIM$(RTRIM$(a(i)))
  387.         END IF
  388.     NEXT
  389.     LOCATE irow, icol
  390.     level = level - .025
  391.     IF ileadingrow = 22 THEN iresults = -2
  392.     END SUB
  393.      
  394.     DEFSNG I
  395.     SUB mdriver (ex%, KEY$, tankx%)
  396.     STATIC MOUSEACT%
  397.      
  398.     REM INITIATE MOUSE
  399.     IF MOUSEACT% = 0 OR ex% = -1 THEN
  400.         Registers.AX = 0: GOSUB CALLI
  401.         MOUSEACT% = 1
  402.     END IF
  403.      
  404.     IF ex% = 1 THEN
  405.         Registers.AX = 4: Registers.DX = 184: Registers.CX = 304
  406.         Registers.AX = 8: Registers.DX = 184: Registers.CX = 184
  407.         GOSUB CALLI
  408.         EXIT SUB
  409.     END IF
  410.      
  411.     Registers.AX = 3: GOSUB CALLI
  412.      
  413.     DX = Registers.DX
  414.     CX = Registers.CX
  415.     y% = DX \ 8 + 1: x% = CX \ 8 + 1
  416.      
  417.     REM MOUSE BUTTONS
  418.     LB% = Registers.BX AND 1
  419.     RB% = (Registers.BX AND 2) \ 2
  420.     MB% = (Registers.BX AND 4) \ 4
  421.      
  422.     IF LB% <> 0 THEN
  423.         KEY$ = CHR$(32)
  424.     ELSE
  425.         IF x% > tankx% THEN KEY$ = CHR$(0) + "M"
  426.         IF x% < tankx% THEN KEY$ = CHR$(0) + "K"
  427.     END IF
  428.     EXIT SUB
  429.      
  430.     CALLI:
  431.     CALL INTERRUPT(&H33, Registers, Registers)
  432.     RETURN
  433.      
  434.     END SUB
  435.      
  436.     DEFINT I
  437.     SUB movealiens (ialiencol, ialiencolstat, iresults)
  438.     STATIC imotion, imarch, imotiondir
  439.     IF inextrnd = -1 THEN inextrnd = 0: imotion = 0: imarch = 0: imotiondir = 0
  440.     irow = CSRLIN: icol = POS(1)
  441.     yy% = CSRLIN: xx% = POS(1)
  442.     PCOPY 0, 1: SCREEN 0, 0, 1, 0: LOCATE yy%, xx%, 0, 7, 0
  443.     IF imotiondir = 0 THEN imotion = imotion - 1 ELSE imotion = imotion + 1
  444.     COLOR 7, ibk
  445.      
  446.     FOR i = imaxalienforce TO 1 STEP -1
  447.         IF RTRIM$(a(i)) <> "" THEN
  448.             i2 = i2 + 2
  449.             SOUND 400, .03
  450.             ialiencol = ialiencolstat + imotion
  451.             LOCATE ileadingmax - (imaxalienforce - i) * 2, ialiencol + INSTR(a(i), "-")
  452.             IF POS(1) = lmargin% THEN imarch = 1
  453.             iltalien(i) = POS(1)
  454.             IF imotiondir = 0 THEN
  455.                 PRINT LTRIM$(RTRIM$(a(i))); " "
  456.             ELSE
  457.                 LOCATE , POS(1) - 1
  458.                 PRINT " "; LTRIM$(RTRIM$(a(i)))
  459.             END IF
  460.             IF ialiencol + LEN(RTRIM$(a(i))) = screenwidth% THEN imarch = -1
  461.         END IF
  462.     NEXT
  463.      
  464.     IF imarch = 1 THEN imotiondir = 1: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
  465.     IF imarch = -1 THEN imotiondir = 0: CALL marchdown(ialiencol, ialiencolstat, imotion, iresults)
  466.     IF imarch = 0 THEN
  467.         IF ABS(TIMER - z2alienfire) > firerate THEN
  468.             firerate = (INT(RND * 10) + 1) / 20
  469.             IF iwait = 0 THEN CALL alienattack(ialiencolstat, ialiencol)
  470.         END IF
  471.     ELSE
  472.         imarch = 0
  473.     END IF
  474.     PCOPY 1, 0: SCREEN 0, 0, 0, 0
  475.     LOCATE irow, icol, 1, 7, 7
  476.     END SUB
  477.      
  478.     SUB mship (imothership)
  479.     STATIC x%, mov%, z4, mothership$
  480.      
  481.     yy% = CSRLIN: xx% = POS(1): COLOR 7, ibk
  482.     IF imothership = -1 THEN
  483.         imothership = 1
  484.         x% = lmargin%
  485.         mothership$ = CHR$(254) + CHR$(254) + "O" + CHR$(254) + CHR$(254)
  486.         mov% = 1
  487.     END IF
  488.      
  489.     IF ABS(TIMER - z4) > .05 THEN GOSUB mothership: z4 = TIMER: LOCATE yy%, xx%: EXIT SUB
  490.     ''IF ABS(TIMER - z2) > .2 THEN GOSUB bullets: z2 = TIMER
  491.     LOCATE yy%, xx%
  492.     EXIT SUB
  493.      
  494.     mothership:
  495.     IF x% + LEN(mothership$) = screenwidth% + lmargin% THEN mov% = -1 ELSE IF x% = lmargin% THEN mov% = 1
  496.     x% = x% + mov%
  497.     LOCATE topmargin%, x%
  498.     PRINT mothership$;
  499.     IF x% > 1 AND mov% = 1 THEN
  500.         LOCATE , POS(1) - LEN(mothership$) - 1: PRINT " ";
  501.     END IF
  502.     IF mov% = -1 THEN PRINT " ";
  503.     RETURN
  504.      
  505.     END SUB
  506.      
  507.     DEFINT A-H, J-Z
  508.     SUB qbide
  509.     PALETTE 2, 59
  510.     COLOR 15, 1
  511.     CLS
  512.      
  513.     COLOR 0, 7
  514.     LOCATE 1, 1
  515.     PRINT SPACE$(80)
  516.     LOCATE 1, 1: PRINT "   File  Edit  View  Search  Run  Debug  Calls  Options                   Help"
  517.      
  518.     COLOR 7, 1
  519.      
  520.     LOCATE 2, 1: PRINT CHR$(218)
  521.     LOCATE 2, 2: PRINT STRING$(78, CHR$(196))
  522.     LOCATE 2, 80: PRINT CHR$(191)
  523.      
  524.     LOCATE 2, 76: PRINT CHR$(180)
  525.     LOCATE 2, 78: PRINT CHR$(195)
  526.      
  527.     COLOR 1, 7
  528.     LOCATE 2, 77: PRINT CHR$(24)
  529.     LOCATE 2, 36: PRINT " Untitled "
  530.      
  531.     COLOR 7, 1
  532.     FOR Rows = 3 TO 24
  533.         LOCATE Rows, 1: PRINT CHR$(179);
  534.         LOCATE Rows, 80: PRINT CHR$(179);
  535.     NEXT Rows
  536.      
  537.     LOCATE 22, 1: PRINT CHR$(195)
  538.     LOCATE 22, 80: PRINT CHR$(180)
  539.     LOCATE 22, 2: PRINT STRING$(78, CHR$(196))
  540.     LOCATE 22, 35
  541.     PRINT " Immediate "
  542.      
  543.     COLOR 0, 7
  544.     LOCATE 21, 3: PRINT STRING$(76, CHR$(176))
  545.     LOCATE 21, 2: PRINT CHR$(27)
  546.     LOCATE 21, 3: PRINT CHR$(219)
  547.     LOCATE 21, 79: PRINT CHR$(26)
  548.     FOR Rows = 4 TO 19
  549.         LOCATE Rows, 80: PRINT CHR$(176)
  550.     NEXT Rows
  551.     LOCATE 3, 80: PRINT CHR$(24)
  552.     LOCATE 4, 80: PRINT CHR$(219)
  553.     LOCATE 20, 80: PRINT CHR$(25)
  554.      
  555.     COLOR 0, 3: LOCATE 25, 1: PRINT " <Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step> ";
  556.     LOCATE 25, 59: PRINT SPACE$(4);
  557.     COLOR 0, 3
  558.     LOCATE 25, 63: PRINT CHR$(179);
  559.     LOCATE 25, 64: PRINT SPACE$(6);
  560.     LOCATE 25, 68: PRINT "C  00001:001 ";
  561.      
  562.     END SUB
  563.      
  564.     DEFSNG A-H, J-Z
  565.     SUB reprintaliens (ialiencol, ihitaliens, iresults, i4, i, imothership)
  566.     IF ihitaliens > 0 THEN
  567.         ihits = ihits + 1
  568.         IF (ihits + 15) MOD 20 = 0 AND imothership = 0 THEN imothership = -1
  569.         LOCATE bullet%(i), lmargin%: PRINT SPACE$(screenwidth%);
  570.         iltalien(i4) = POS(1)
  571.      
  572.         IF RTRIM$(a(i4)) = "" THEN
  573.             alienforce% = alienforce% - 1
  574.             IF alienforce% = 0 THEN iresults = iresults + 1
  575.             IF bullet%(i) = ileadingrow THEN ileadingrow = ileadingrow - 2
  576.         ELSE
  577.             LOCATE bullet%(i), ialiencol + INSTR(a(i4), "-"): PRINT LTRIM$(RTRIM$(a(i4)))
  578.         END IF
  579.     ELSE
  580.         i2 = ABS(ihitaliens)
  581.         LOCATE iy(i2), ix(i2)
  582.         PRINT " ";: iy(i2) = 0
  583.         ia(i2) = 0
  584.         LOCATE irow, icol
  585.         SOUND 1000, .5
  586.     END IF
  587.      
  588.     ihitaliens = 0
  589.     bullet%(i) = -bullet%(i)
  590.      
  591.     COLOR 0, 3
  592.     yy% = CSRLIN: xx% = POS(1)
  593.     LOCATE 25, 76 - LEN(LTRIM$(STR$(ihits)))
  594.     PRINT LTRIM$(STR$(ihits));
  595.     LOCATE 25, 80 - LEN(LTRIM$(STR$(imaxalienforce - alienforce%)))
  596.     PRINT LTRIM$(STR$(imaxalienforce - alienforce%));
  597.     LOCATE yy%, xx%
  598.     COLOR 7, ibk
  599.      
  600.     END SUB

I am a little bit jealous after Mark, (BPlus) made his saucer. Of course that wasn't done in SCREEN 0, so it doesn't really matter.

Pete :D

Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • Danilin youtube
Re: Random landscape
« Reply #4 on: January 27, 2021, 07:15:09 pm »
use pseudo 3d relief qb64 my milli program:

on: March 29, 2019, 07:01:25 AM

https://www.qb64.org/forum/index.php?topic=702.msg103948#msg103948

 
reliefqb.gif


Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself