Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on April 05, 2019, 10:25:06 am

Title: Guts translation from past
Post by: bplus on April 05, 2019, 10:25:06 am
_vince
Quote
Bplus, can you repost the tapeworm example?  I think I saw it on [banned user]'s forum or maybe it was on the justbasic forum.

Sure let's have another look at this classic! (probably was at both forums)
Code: QB64: [Select]
  1. _TITLE "Guts" 'passed down through ages, I first encountered it through Richard Russel author BBC 4 Windows
  2. ' 2019-04-05 B+ translation to QB64 from: Guts.bas SmallBASIC 0.12.0 2015-11-17 MGA/B+
  3. 'modified  > GUTS  Original ARM BBC BASIC version by Jan Vibe, 800x600 ?
  4.  
  6. CONST xmax = 800
  7. CONST ymax = 600
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10.  
  11. DIM bX(15), bY(15), bZ(15), COLR(15) AS _UNSIGNED LONG
  12. bX(1) = -100: A = 0
  13. FOR N = 1 TO 15
  14.     COLR(16 - N) = _RGB32(7 * N + 150, 14 * N + 45, 14 * N + 45)
  16.  
  17. X1 = RND * xmax: Y1 = RND * ymax: DX1 = (RND * 16 + 1) * (RND - .5): DY1 = (RND * 16 + 1) * (RND - .5)
  18. X2 = RND * xmax: Y2 = RND * ymax: DX2 = (RND * 16 + 1) * (RND - .5): DY2 = (RND * 16 + 1) * (RND - .5)
  20.     H = X1 + DX1: IF H < 0 OR H > xmax THEN DX1 = (RND * 16 + 1) * -SGN(DX1)
  21.     H = Y1 + DY1: IF H < 0 OR H > ymax THEN DY1 = (RND * 16 + 1) * -SGN(DY1)
  22.     X1 = X1 + DX1: Y1 = Y1 + DY1
  23.     IF X2 < X1 AND DX2 < 24 THEN DX2 = DX2 + 1
  24.     IF X2 > X1 AND DX2 > -24 THEN DX2 = DX2 - 1
  25.     IF Y2 < Y1 AND DY2 < 24 THEN DY2 = DY2 + 1
  26.     IF Y2 > Y1 AND DY2 > -24 THEN DY2 = DY2 - 1
  27.     X2 = X2 + DX2: Y2 = Y2 + DY2: A = (A + 10) MOD 360: Z = (SIN(_D2R(A) + 1)) + 2
  28.     FOR N = 2 TO 15
  29.         bX(N - 1) = bX(N): bY(N - 1) = bY(N): bZ(N - 1) = bZ(N)
  30.     NEXT
  31.     bX(15) = X2: bY(15) = Y2: bZ(15) = Z
  32.     FOR N = 1 TO 15: fcirc bX(N), bY(N), N * bZ(N) + 5, COLR(N): NEXT
  33.     _DISPLAY
  34.     _LIMIT 60
  36.  
  37. 'from Steve Gold standard
  38. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  39.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  40.     DIM X AS INTEGER, Y AS INTEGER
  41.  
  42.     Radius = ABS(R)
  43.     RadiusError = -Radius
  44.     X = Radius
  45.     Y = 0
  46.  
  47.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  48.  
  49.     ' Draw the middle span here so we don't draw it twice in the main loop,
  50.     ' which would be a problem with blending turned on.
  51.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  52.  
  53.     WHILE X > Y
  54.         RadiusError = RadiusError + Y * 2 + 1
  55.         IF RadiusError >= 0 THEN
  56.             IF X <> Y + 1 THEN
  57.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  58.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  59.             END IF
  60.             X = X - 1
  61.             RadiusError = RadiusError - X * 2
  62.         END IF
  63.         Y = Y + 1
  64.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  65.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  66.     WEND
  68.  
  69.  
Title: Re: Guts translation from past
Post by: bplus on April 05, 2019, 11:40:39 am
How about a Glowing Tapeworm?

Code: QB64: [Select]
  1. _TITLE "Glowing Tapeworm" ' 2019-04-05 B_ modified Guts
  2. ' 2019-04-05 B+ translation to QB64 from: Guts.bas SmallBASIC 0.12.0 2015-11-17 MGA/B+
  3. 'modified  > GUTS  Original ARM BBC BASIC version by Jan Vibe, 800x600 ?
  4.  
  6. CONST xmax = 800
  7. CONST ymax = 600
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10.  
  11. DIM bX(63), bY(63), bZ(63), COLR(63) AS _UNSIGNED LONG
  12. bX(1) = -100: A = 0
  13.  
  14. ' gut palette
  15. FOR N = 1 TO 63
  16.     COLR(64 - N) = _RGB32(1.5 * N + 150, 3 * N + 45, 3 * N + 45)
  18.  
  19. X1 = RND * xmax: Y1 = RND * ymax: DX1 = (RND * 16 + 1) * (RND - .5): DY1 = (RND * 16 + 1) * (RND - .5)
  20. X2 = RND * xmax: Y2 = RND * ymax: DX2 = (RND * 16 + 1) * (RND - .5): DY2 = (RND * 16 + 1) * (RND - .5)
  22.     LINE (0, 0)-(xmax, ymax), _RGBA32(0, 0, 0, 15), BF
  23.     H = X1 + DX1: IF H < 0 OR H > xmax THEN DX1 = (RND * 16 + 1) * -SGN(DX1)
  24.     H = Y1 + DY1: IF H < 0 OR H > ymax THEN DY1 = (RND * 16 + 1) * -SGN(DY1)
  25.     X1 = X1 + DX1: Y1 = Y1 + DY1
  26.     IF X2 < X1 AND DX2 < 24 THEN DX2 = DX2 + 1
  27.     IF X2 > X1 AND DX2 > -24 THEN DX2 = DX2 - 1
  28.     IF Y2 < Y1 AND DY2 < 24 THEN DY2 = DY2 + 1
  29.     IF Y2 > Y1 AND DY2 > -24 THEN DY2 = DY2 - 1
  30.     X2 = X2 + DX2: Y2 = Y2 + DY2: A = (A + 10) MOD 360: Z = (SIN(_D2R(A) + 1)) + 2
  31.     FOR N = 1 TO 63
  32.         bX(N - 1) = bX(N): bY(N - 1) = bY(N): bZ(N - 1) = bZ(N)
  33.     NEXT
  34.     bX(63) = X2: bY(63) = Y2: bZ(63) = Z
  35.     FOR N = 1 TO 63: fcirc bX(N), bY(N), .6 * N * bZ(N), COLR(N): NEXT
  36.     _DISPLAY
  37.     _LIMIT 60
  39.  
  40. 'from Steve Gold standard
  41. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  42.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  43.     DIM X AS INTEGER, Y AS INTEGER
  44.  
  45.     Radius = ABS(R)
  46.     RadiusError = -Radius
  47.     X = Radius
  48.     Y = 0
  49.  
  50.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  51.  
  52.     ' Draw the middle span here so we don't draw it twice in the main loop,
  53.     ' which would be a problem with blending turned on.
  54.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  55.  
  56.     WHILE X > Y
  57.         RadiusError = RadiusError + Y * 2 + 1
  58.         IF RadiusError >= 0 THEN
  59.             IF X <> Y + 1 THEN
  60.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  61.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  62.             END IF
  63.             X = X - 1
  64.             RadiusError = RadiusError - X * 2
  65.         END IF
  66.         Y = Y + 1
  67.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  68.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  69.     WEND
  71.  
  72.  
Title: Re: Guts translation from past
Post by: FellippeHeitor on April 05, 2019, 11:57:39 am
Quote from: bplus on April 05, 2019, 11:40:39 am
How about a Glowing Tapeworm?

Code: QB64: [Select]
  1. _TITLE "Glowing Tapeworm" ' 2019-04-05 B_ modified Guts
  2. ' 2019-04-05 B+ translation to QB64 from: Guts.bas SmallBASIC 0.12.0 2015-11-17 MGA/B+
  3. 'modified  > GUTS  Original ARM BBC BASIC version by Jan Vibe, 800x600 ?
  4.  
  6. CONST xmax = 800
  7. CONST ymax = 600
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10.  
  11. DIM bX(63), bY(63), bZ(63), COLR(63) AS _UNSIGNED LONG
  12. bX(1) = -100: A = 0
  13.  
  14. ' gut palette
  15. FOR N = 1 TO 63
  16.     COLR(64 - N) = _RGB32(1.5 * N + 150, 3 * N + 45, 3 * N + 45)
  18.  
  19. X1 = RND * xmax: Y1 = RND * ymax: DX1 = (RND * 16 + 1) * (RND - .5): DY1 = (RND * 16 + 1) * (RND - .5)
  20. X2 = RND * xmax: Y2 = RND * ymax: DX2 = (RND * 16 + 1) * (RND - .5): DY2 = (RND * 16 + 1) * (RND - .5)
  22.     LINE (0, 0)-(xmax, ymax), _RGBA32(0, 0, 0, 15), BF
  23.     H = X1 + DX1: IF H < 0 OR H > xmax THEN DX1 = (RND * 16 + 1) * -SGN(DX1)
  24.     H = Y1 + DY1: IF H < 0 OR H > ymax THEN DY1 = (RND * 16 + 1) * -SGN(DY1)
  25.     X1 = X1 + DX1: Y1 = Y1 + DY1
  26.     IF X2 < X1 AND DX2 < 24 THEN DX2 = DX2 + 1
  27.     IF X2 > X1 AND DX2 > -24 THEN DX2 = DX2 - 1
  28.     IF Y2 < Y1 AND DY2 < 24 THEN DY2 = DY2 + 1
  29.     IF Y2 > Y1 AND DY2 > -24 THEN DY2 = DY2 - 1
  30.     X2 = X2 + DX2: Y2 = Y2 + DY2: A = (A + 10) MOD 360: Z = (SIN(_D2R(A) + 1)) + 2
  31.     FOR N = 1 TO 63
  32.         bX(N - 1) = bX(N): bY(N - 1) = bY(N): bZ(N - 1) = bZ(N)
  33.     NEXT
  34.     bX(63) = X2: bY(63) = Y2: bZ(63) = Z
  35.     FOR N = 1 TO 63: fcirc bX(N), bY(N), .6 * N * bZ(N), COLR(N): NEXT
  36.     _DISPLAY
  37.     _LIMIT 60
  39.  
  40. 'from Steve Gold standard
  41. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  42.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  43.     DIM X AS INTEGER, Y AS INTEGER
  44.  
  45.     Radius = ABS(R)
  46.     RadiusError = -Radius
  47.     X = Radius
  48.     Y = 0
  49.  
  50.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  51.  
  52.     ' Draw the middle span here so we don't draw it twice in the main loop,
  53.     ' which would be a problem with blending turned on.
  54.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  55.  
  56.     WHILE X > Y
  57.         RadiusError = RadiusError + Y * 2 + 1
  58.         IF RadiusError >= 0 THEN
  59.             IF X <> Y + 1 THEN
  60.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  61.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  62.             END IF
  63.             X = X - 1
  64.             RadiusError = RadiusError - X * 2
  65.         END IF
  66.         Y = Y + 1
  67.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  68.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  69.     WEND
  71.  
  72.  

Cool!!
Title: Re: Guts translation from past
Post by: _vince on April 05, 2019, 01:35:12 pm
nice, bplus, thanks
Title: Re: Guts translation from past
Post by: TempodiBasic on April 05, 2019, 05:42:51 pm
fine! the first one. Cool the second...do you plan to make a clone of Slither.io?
Title: Re: Guts translation from past
Post by: bplus on April 05, 2019, 06:13:48 pm
Thanks guys!

Slither.io never heard of it, checked it out, reminds me of the Snake Game with company.
Title: Re: Guts translation from past
Post by: Ashish on April 06, 2019, 12:53:55 am
Perfect bplus! :)
Title: Re: Guts translation from past
Post by: Petr on April 06, 2019, 04:13:27 am
What? That's great, Bplus!
Text Only | Text with Attachments