Author Topic: Nested triangles  (Read 5326 times)

0 Members and 1 Guest are viewing this topic.

Offline petoro

  • Newbie
  • Posts: 27
    • View Profile
Nested triangles
« on: August 18, 2019, 08:21:41 am »
This is an old vintage program to draw nested triangles and tetrahedra


Code: QB64: [Select]
  1. 'cdg 1.03     (c) Jose Angel Gonzalez Rodriguez
  2. 'Noviembre de 1997                      November 1997
  3. 'Creado con QuickBasic 4.5              Created with QuickBasic 4.5
  4. 'Compilado con PBasic 3.1               Compiled with PBasic 3.1
  5.  
  6.  
  7. DEFINT A-Z
  8. DECLARE SUB DibuFrameNegro ()
  9. DECLARE SUB DibuNegro () : DECLARE SUB Mensajes ()
  10. DECLARE SUB DibuFrame () : DECLARE SUB DibuCDG3 (col)
  11. DECLARE SUB LineaEspanol () : DECLARE SUB LineaIngles ()
  12. DECLARE SUB CDG3 (x1!, x2!, x3!, x4!, y1!, y2!, y3!, y4!, z1!, z2!, z3!, z4!, cont%, col)
  13. DECLARE SUB CDG2 (x1!, x2!, x3!, y1!, y2!, y3!, z1!, z2!, z3!, cont%, col)
  14. DECLARE SUB DibuCDG2 (col) : DECLARE SUB CogeTecla ()
  15. DECLARE SUB Izquierda () : DECLARE SUB Arriba ()
  16. DECLARE SUB Pitido1 () : DECLARE SUB SalidaOK ()
  17. DECLARE SUB Resalta (a$, N%) : DECLARE SUB DibuCDG ()
  18. DECLARE SUB cdg (x1!, x2!, x3!, x4!, y1!, y2!, y3!, y4!, z1!, z2!, z3!, z4!, cont)
  19. DECLARE SUB Info () : DECLARE SUB BeepFallo ()
  20. REM ON ERROR GOTO RutinaError
  21.  
  22. DIM b!(3 ^ 6, 10)
  23. blanco = 15
  24. negro = 0
  25. pi! = 3.141592
  26. paso! = pi! / 32
  27. D3 = 0
  28. D2 = 1
  29. NIter = 3
  30. py = 19
  31. yy = py
  32. ArMin! = 0
  33. NVert = 4
  34. DIM VertXY!(NVert, 3)
  35. DIM f!(NVert, 3)
  36. pot! = 3
  37. dist! = 1
  38.  
  39. r! = 640 / 480
  40. WINDOW (-r!, -1)-(r!, 1)
  41.  
  42. PALETTE 0, 8
  43. blue = 56: green = 63: red = 13
  44. ColorNumber& = 65536 * blue + 256 * green + red
  45. 'PALETTE 15, ColorNumber&
  46.  
  47. Empezar:
  48.  
  49. IF D3 = 1 THEN
  50.   NVert = 4
  51.   VertXY!(1, 1) = .4926414
  52.   VertXY!(2, 1) = .54941
  53.   VertXY!(3, 1) = -.1704186
  54.   VertXY!(4, 1) = -.8716328
  55.   VertXY!(1, 2) = -.5649168
  56.   VertXY!(2, 2) = .804424
  57.   VertXY!(3, 2) = -.5311065
  58.   VertXY!(4, 2) = .2915995
  59.   VertXY!(1, 3) = .6619467
  60.   VertXY!(2, 3) = -.2259439
  61.   VertXY!(3, 3) = -.82999
  62.   VertXY!(4, 3) = .3939873
  63.   NVert = 3
  64.   VertXY!(1, 1) = .5877291
  65.   VertXY!(2, 1) = -.8816133
  66.   VertXY!(3, 1) = .2938841
  67.   VertXY!(1, 2) = -.4518031
  68.   VertXY!(2, 2) = -.4036101
  69.   VertXY!(3, 2) = .8554131
  70.   VertXY!(1, 3) = .6711546
  71.   VertXY!(2, 3) = -.2446566
  72.   VertXY!(3, 3) = -.426498
  73.  
  74. Arriba
  75. Izquierda
  76.  
  77. L1$ = CHR$(24)
  78. L2$ = CHR$(27) + " " + CHR$(25) + " " + CHR$(26)
  79.  
  80. Redibuja:
  81. REM dibujar poliedro
  82. REM para saltar si es estable:
  83.  
  84. Mensajes
  85. Dibujar:
  86. CIRCLE (0, 0), 1
  87.  
  88. Redi:
  89. DibuFrame
  90. CogeTecla
  91. IF NVert = 4 THEN
  92.   DibuCDG3 blanco
  93.   DibuCDG2 blanco
  94.  
  95. 'Girando = 0
  96. IntroduceCaracter:
  97.  
  98. K$ = INKEY$
  99. IF K$ <> "" THEN
  100.   kkk = ASC(RIGHT$(K$, 1))
  101.   IF LEN(K$) = 2 THEN           '2 caracteres
  102.     SELECT CASE kkk
  103.       CASE 75                   'izquierda
  104.                         REM h = 1
  105.                         REM PRINT VertXY!(h, 1): PRINT VertXY!(h, 2): PRINT VertXY!(h, 3)
  106.         DibuNegro
  107.         FOR i = 1 TO NVert
  108.           alfa! = ATN(VertXY!(i, 2) / SQR(VertXY!(i, 3) ^ 2 + VertXY!(i, 1) ^ 2))
  109.           beta! = ATN(VertXY!(i, 1) / VertXY!(i, 3)) + paso!
  110.           VertXY!(i, 2) = SIN(alfa!)
  111.           VertXY!(i, 1) = SGN(VertXY!(i, 3)) * COS(alfa!) * SIN(beta!)
  112.           VertXY!(i, 3) = SGN(VertXY!(i, 3)) * COS(alfa!) * COS(beta!)
  113.         NEXT i
  114.                         REM PRINT : PRINT VertXY!(h, 1): PRINT VertXY!(h, 2): PRINT VertXY!(h, 3)
  115.                         REM END
  116.       CASE 77                   'derecha
  117.         DibuNegro
  118.         FOR i = 1 TO NVert
  119.           alfa! = ATN(VertXY!(i, 2) / SQR(VertXY!(i, 3) ^ 2 + VertXY!(i, 1) ^ 2))
  120.           beta! = ATN(VertXY!(i, 1) / VertXY!(i, 3)) - paso!
  121.           VertXY!(i, 2) = SIN(alfa!)
  122.           VertXY!(i, 1) = SGN(VertXY!(i, 3)) * COS(alfa!) * SIN(beta!)
  123.           VertXY!(i, 3) = SGN(VertXY!(i, 3)) * COS(alfa!) * COS(beta!)
  124.         NEXT i
  125.       CASE 72                   'arriba
  126.         DibuNegro
  127.         FOR i = 1 TO NVert
  128.           alfa! = ATN(VertXY!(i, 1) / SQR(VertXY!(i, 2) ^ 2 + VertXY!(i, 3) ^ 2))
  129.           beta! = ATN(VertXY!(i, 3) / VertXY!(i, 2)) + paso!
  130.           VertXY!(i, 1) = SIN(alfa!)
  131.           VertXY!(i, 3) = SGN(VertXY!(i, 2)) * COS(alfa!) * SIN(beta!)
  132.           VertXY!(i, 2) = SGN(VertXY!(i, 2)) * COS(alfa!) * COS(beta!)
  133.         NEXT i
  134.       CASE 80                   'abajo
  135.         DibuNegro
  136.         FOR i = 1 TO NVert
  137.           alfa! = ATN(VertXY!(i, 1) / SQR(VertXY!(i, 2) ^ 2 + VertXY!(i, 3) ^ 2))
  138.           beta! = ATN(VertXY!(i, 3) / VertXY!(i, 2)) - paso!
  139.           VertXY!(i, 1) = SIN(alfa!)
  140.           VertXY!(i, 3) = SGN(VertXY!(i, 2)) * COS(alfa!) * SIN(beta!)
  141.           VertXY!(i, 2) = SGN(VertXY!(i, 2)) * COS(alfa!) * COS(beta!)
  142.         NEXT i
  143.       CASE 59                 'pulsar F1
  144.         CLS : Info
  145.         keyy$ = "": DO WHILE keyy$ = "": keyy$ = INKEY$: LOOP
  146.         CLS
  147.         GOTO Redibuja:
  148.     END SELECT
  149.     Girando = 1
  150.   ELSE                          '1 caracteres
  151.     SELECT CASE kkk
  152.       CASE 43, 62       '+ y >
  153.         IF NIter = 6 THEN
  154.           SOUND 240, 2
  155.           GOTO IntroduceCaracter
  156.         ELSE
  157.           Pitido1
  158.           NIter = NIter + 1
  159.           GOTO Dibujar
  160.         END IF
  161.       CASE 45, 60       '- y <
  162.         DibuNegro
  163.         IF NIter = 0 THEN
  164.           SOUND 240, 2
  165.           GOTO Redi
  166.         ELSE
  167.           Pitido1
  168.           NIter = NIter - 1
  169.           GOTO Dibujar
  170.         END IF
  171.       CASE 50                   '2 --> 2-D
  172.         DibuNegro
  173.         D2 = 1: D3 = 0
  174.         GOTO Empezar
  175.       CASE 51                   '3 --> 3D
  176.         DibuNegro
  177.         D2 = 0: D3 = 1
  178.         GOTO Empezar
  179.       CASE 27
  180.         SalidaOK
  181.       CASE ELSE
  182.     END SELECT
  183.   END IF
  184.   GOTO Dibujar
  185.   'GOTO ReDibuja
  186.   GOTO IntroduceCaracter
  187.  
  188. SUB Arriba
  189.  
  190.   SHARED NVert, VertXY!(), pi!
  191.  
  192.   a! = RND * pi!
  193.  
  194.   FOR i = 1 TO NVert
  195.     alfa! = ATN(VertXY!(i, 1) / SQR(VertXY!(i, 2) ^ 2 + VertXY!(i, 3) ^ 2))
  196.     beta! = ATN(VertXY!(i, 3) / VertXY!(i, 2)) + a!
  197.     VertXY!(i, 1) = SIN(alfa!)
  198.     IF VertXY!(i, 2) > 0 THEN VertXY!(i, 3) = COS(alfa!) * SIN(beta!) ELSE VertXY!(i, 3) = -COS(alfa!) * SIN(beta!)
  199.     IF VertXY!(i, 2) > 0 THEN VertXY!(i, 2) = COS(alfa!) * COS(beta!) ELSE VertXY!(i, 2) = -COS(alfa!) * COS(beta!)
  200.   NEXT i
  201.  
  202.  
  203. SUB BeepFallo
  204.   SOUND 100, .8
  205.  
  206. SUB CDG2 (x1!, x2!, x3!, y1!, y2!, y3!, z1!, z2!, z3!, cont, col)
  207. SHARED b!(), c
  208. IF cont = 0 THEN EXIT SUB
  209.  
  210. xc! = (x1! + x2! + x3!) / 3
  211. yc! = (y1! + y2! + y3!) / 3
  212. zc! = (z1! + z2! + z3!) / 3
  213. LINE (x1!, y1!)-(xc!, yc!), col
  214. LINE (x2!, y2!)-(xc!, yc!), col
  215. LINE (x3!, y3!)-(xc!, yc!), col
  216.  
  217. CDG2 x1!, x2!, xc!, y1!, y2!, yc!, z1!, z2!, zc!, cont - 1, col
  218. CDG2 x1!, xc!, x3!, y1!, yc!, y3!, z1!, zc!, z3!, cont - 1, col
  219. CDG2 xc!, x2!, x3!, yc!, y2!, y3!, zc!, z2!, z3!, cont - 1, col
  220.  
  221.  
  222. SUB CDG3 (x1!, x2!, x3!, x4!, y1!, y2!, y3!, y4!, z1!, z2!, z3!, z4!, cont, col)
  223.  
  224. IF cont = 0 THEN EXIT SUB
  225.  
  226. xc! = (x1! + x2! + x3! + x4!) / 4
  227. yc! = (y1! + y2! + y3! + y4!) / 4
  228. zc! = (z1! + z2! + z3! + z4!) / 4
  229.  
  230. LINE (x1!, y1!)-(xc!, yc!), col
  231. LINE (x2!, y2!)-(xc!, yc!), col
  232. LINE (x3!, y3!)-(xc!, yc!), col
  233. LINE (x4!, y4!)-(xc!, yc!), col
  234.  
  235. CDG3 x1!, x2!, x3!, xc!, y1!, y2!, y3!, yc!, z1!, z2!, z3!, zc!, cont - 1, col
  236. CDG3 x1!, x2!, xc!, x4!, y1!, y2!, yc!, y4!, z1!, z2!, zc!, z4!, cont - 1, col
  237. CDG3 x1!, xc!, x3!, x4!, y1!, yc!, y3!, y4!, z1!, zc!, z3!, z4!, cont - 1, col
  238. CDG3 xc!, x2!, x3!, x4!, yc!, y2!, y3!, y4!, zc!, z2!, z3!, z4!, cont - 1, col
  239.  
  240.  
  241.  
  242. SUB CogeTecla
  243.  
  244. K$ = INKEY$
  245. IF K$ <> "" THEN
  246.   IF ASC(K$) = 27 THEN SalidaOK
  247.  
  248.  
  249.  
  250. SUB DibuCDG2 (col)
  251.  
  252. SHARED VertXY!(), NIter
  253.  
  254. x1! = VertXY!(1, 1)
  255. x2! = VertXY!(2, 1)
  256. x3! = VertXY!(3, 1)
  257.  
  258. y1! = VertXY!(1, 2)
  259. y2! = VertXY!(2, 2)
  260. y3! = VertXY!(3, 2)
  261.  
  262. z1! = VertXY!(1, 3)
  263. z2! = VertXY!(2, 3)
  264. z3! = VertXY!(3, 3)
  265.  
  266. CDG2 x1!, x2!, x3!, y1!, y2!, y3!, z1!, z2!, z3!, NIter, col
  267.  
  268.  
  269.  
  270. SUB DibuCDG3 (col)
  271. SHARED VertXY!(), NIter
  272.  
  273. x1! = VertXY!(1, 1)
  274. x2! = VertXY!(2, 1)
  275. x3! = VertXY!(3, 1)
  276. x4! = VertXY!(4, 1)
  277.  
  278. y1! = VertXY!(1, 2)
  279. y2! = VertXY!(2, 2)
  280. y3! = VertXY!(3, 2)
  281. y4! = VertXY!(4, 2)
  282.  
  283. z1! = VertXY!(1, 3)
  284. z2! = VertXY!(2, 3)
  285. z3! = VertXY!(3, 3)
  286. z4! = VertXY!(4, 3)
  287.  
  288. CDG3 x1!, x2!, x3!, x4!, y1!, y2!, y3!, y4!, z1!, z2!, z3!, z4!, NIter, col
  289.  
  290.  
  291. SUB DibuFrame
  292. SHARED NVert, VertXY!(), f!()
  293. negro = 0
  294. FOR i = 1 TO NVert - 1
  295.   FOR j = i + 1 TO NVert
  296.     LINE (f!(i, 1), f!(i, 2))-(f!(j, 1), f!(j, 2)), negro
  297.   NEXT j
  298.  
  299.  
  300. FOR i = 1 TO NVert - 1
  301.   FOR j = i + 1 TO NVert
  302.     LINE (VertXY!(i, 1), VertXY!(i, 2))-(VertXY!(j, 1), VertXY!(j, 2))
  303.   NEXT j
  304.  
  305. FOR i = 1 TO NVert - 1
  306.   FOR j = i + 1 TO NVert
  307.     f!(i, 1) = VertXY!(i, 1)
  308.     f!(i, 2) = VertXY!(i, 2)
  309.     f!(j, 1) = VertXY!(j, 1)
  310.     f!(j, 2) = VertXY!(j, 2)
  311.   NEXT j
  312.  
  313.  
  314. SUB DibuFrameNegro
  315. SHARED NVert, VertXY!(), f!()
  316. negro = 0
  317. FOR i = 1 TO NVert - 1
  318.   FOR j = i + 1 TO NVert
  319.     LINE (f!(i, 1), f!(i, 2))-(f!(j, 1), f!(j, 2)), negro
  320.   NEXT j
  321.  
  322.  
  323. SUB DibuNegro
  324. SHARED NVert
  325. DibuFrameNegro
  326. negro = 0
  327. IF NVert = 4 THEN
  328.   DibuCDG3 negro
  329.   DibuCDG2 negro
  330.  
  331.  
  332. SUB EscapeParaSalir (Lin)
  333.    LOCATE Lin, 62
  334.      Resalta "Esc para salir", 3
  335.  
  336.  
  337. SUB Info
  338. SHARED colorres
  339. COLOR colorres
  340. PRINT "-----------------------------------------------------------------------------";
  341. LOCATE 2, 1
  342. COLOR colorres: PRINT "                                Espa\A4ol:": PRINT
  343. LineaEspanol
  344. PRINT "Dibujemos un triangulo y su Centro De Gravedad."
  345. PRINT "Tracemos lineas desde este C.D.G. hasta los vertices del"
  346. PRINT "triangulo. Si hacemos lo mismo con los 3 nuevos triangulos"
  347. PRINT "que se forman y obramos asi sucesivamente, conseguimos este fractal."
  348. PRINT "Si lo hacemos con tetraedros conseguimos la version tridimensional."
  349. COLOR colorres
  350. PRINT "-----------------------------------------------------------------------------";
  351. PRINT "                                English:": PRINT
  352. LineaIngles
  353. PRINT "Let us draw a triangle and its Centre Of Gravity."
  354. PRINT "Then we draw lines from this C.O.G to the vertex of the"
  355. PRINT "triangle. If we do the same with the 3 new triangles and so on,"
  356. PRINT "we get this fractal."
  357. PRINT "We can get it in 3-Dimensions if we do it with tetrahedrons."
  358. COLOR colorres
  359. PRINT "-----------------------------------------------------------------------------";
  360. PRINT "Sugerencias: FidoNet 2:344/18.8 -- Correo: Jose Angel Gonzalez"
  361. PRINT "                                           Capuchinos, 9 - 6 C "
  362. PRINT "E-Mail: jgonzalezr@nexo.es                 31500 Tudela (Navarra) SPAIN";
  363. COLOR 7: PRINT " ";
  364.  
  365. SUB Izquierda
  366.   SHARED NVert, VertXY!(), pi!
  367.  
  368.   a! = RND * pi!
  369.  
  370.   FOR i = 1 TO NVert
  371.     alfa! = ATN(VertXY!(i, 2) / SQR(VertXY!(i, 3) ^ 2 + VertXY!(i, 1) ^ 2))
  372.     beta! = ATN(VertXY!(i, 1) / VertXY!(i, 3)) + a!
  373.     VertXY!(i, 2) = SIN(alfa!)
  374.     IF VertXY!(i, 3) > 0 THEN VertXY!(i, 1) = COS(alfa!) * SIN(beta!) ELSE VertXY!(i, 1) = -COS(alfa!) * SIN(beta!)
  375.     IF VertXY!(i, 3) > 0 THEN VertXY!(i, 3) = COS(alfa!) * COS(beta!) ELSE VertXY!(i, 3) = -COS(alfa!) * COS(beta!)
  376.   NEXT i
  377.  
  378.  
  379. SUB LineaEspanol
  380.   SHARED colorres, colornormal
  381.   N = 3
  382.   COLOR colornormal
  383.   LOCATE N, 1: PRINT "Con + / - se cambia la densidad del fractal. Con las flechas puede girar.";
  384.   COLOR colorres
  385.   LOCATE N, 5: PRINT "+"
  386.   LOCATE N, 9: PRINT "-"
  387.  
  388.  
  389. SUB LineaIngles
  390.  
  391.   SHARED colorres, colornormal
  392.   N = 13
  393.   COLOR colornormal
  394.   LOCATE N, 1
  395.   PRINT "With + / - you change the fractal's density. With arrows, you rotate it.";
  396.   COLOR colorres
  397.   LOCATE N, 6: PRINT "+"
  398.   LOCATE N, 10: PRINT "-"
  399.  
  400.  
  401. SUB Mensajes
  402. SHARED py, colorres, colornormal, NIter, L1$, L2$
  403. py = 28: colorres = 14: colornormal = 7
  404. COLOR 7: LOCATE py, 2: PRINT " -D   -D";
  405. LOCATE 3, 65: Resalta "F1: Help", 2
  406. LOCATE 3, 3: PRINT NIter; " Iteraciones";
  407. COLOR colorres: LOCATE py, 2: PRINT "2"; : LOCATE py, 7: PRINT "3";
  408. LOCATE py - 1, 72: PRINT L1$
  409. LOCATE py, 70: PRINT L2$;
  410. LOCATE py + 2, 3: PRINT "+   -";
  411. LOCATE 30, 67: Resalta "Esc to exit", 3
  412. LOCATE py + 2, 5: PRINT "/";
  413.  
  414.  
  415. SUB Pitido1
  416.   SOUND 740, .2
  417.  
  418. SUB Resalta (a$, N)
  419.  
  420.   SHARED colorres, colornormal
  421.   l = LEN(a$)
  422.   b$ = LTRIM$(a$)
  423.   L2 = LEN(b$)
  424.   PRINT STRING$(l - L2, " ");
  425.   COLOR colorres
  426.   PRINT LEFT$(b$, N);
  427.   COLOR colornormal
  428.   PRINT RIGHT$(b$, L2 - N);
  429.  
  430.  
  431. SUB SalidaOK
  432.   SHARED colornormal
  433.   SCREEN 0
  434.   Info
  435.   END
  436.  
  437.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Nested triangles
« Reply #1 on: August 18, 2019, 09:12:00 am »
Nice fractal, I've not seen that before, thanks for sharing!

Oh, what would be nice would be to fill the triangles with transparent colors!
This will draw filled triangle, just need the 3 points (x, y) numbers:
Code: QB64: [Select]
  1. ' 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
  2. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  3.     DIM a&
  4.     a& = _NEWIMAGE(1, 1, 32)
  5.     _DEST a&
  6.     PSET (0, 0), K
  7.     _DEST 0
  8.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  9.     _FREEIMAGE a& '<<< this is important!
  10.  

Do you know about transparent colors?
« Last Edit: August 18, 2019, 09:36:27 am by bplus »

Offline petoro

  • Newbie
  • Posts: 27
    • View Profile
Re: Nested triangles
« Reply #2 on: August 18, 2019, 09:30:40 am »
Glad you liked it.

I hadn't seen them anywhere until a couple of years ago or so.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Nested triangles
« Reply #3 on: August 18, 2019, 09:46:32 am »
Hi petoro,

I left code for drawing a filled triangle, don't worry about understanding how it works (yet), just feed it 3 points and an _RGBA color and it will draw a triangular colored glass panel if you use low alpha colors. Maybe you'd like to color the fractal or practice with the triangle code.

Offline petoro

  • Newbie
  • Posts: 27
    • View Profile
Re: Nested triangles
« Reply #4 on: August 18, 2019, 11:15:45 am »
I can not make your code fragment run.

Could you show it with a particular example?

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Nested triangles
« Reply #5 on: August 18, 2019, 12:31:32 pm »
I can not make your code fragment run.

Could you show it with a particular example?

Love to! I forgot to mention you need to setup a graphics screen, you probably didn't have much luck with screen 12 if you use color numbers 0 - 15, I included brief comments about setting up a graphics screen.
Code: QB64: [Select]
  1. _TITLE "Demo for triangle fill sub called ftri" 'b+ 2019-08-18
  2.  
  3. ' you will need to set up a graphics screen
  4. SCREEN _NEWIMAGE(800, 600, 32) 'this sets the screen size to 800 pixels wide by 600 pixels high
  5. '                               the 32 means _RGBA colors will work (allows transparencies)
  6.  
  7. _SCREENMOVE 300, 20 'this puts the screen towards center of display screen front and center
  8.  
  9. ' 3 points and one color
  10. x1 = 0: y1 = 0 'top left screen corner
  11.  
  12. x2 = _WIDTH / 2 'middle screen x axis
  13. y2 = 20 'move down a bit from 0 at top
  14.  
  15. x3 = _WIDTH / 4 ' 1/4 to right from left edge
  16. y3 = _HEIGHT / 2 '1/2 down screen
  17.  
  18. 'for color solid dark red  _rgba(128, 0, 0, 255) 'the 4th argument is transparency 255 is solid no transparency
  19. ftri x1, y1, x2, y2, x3, y3, _RGBA(128, 0, 0, 255)
  20.  
  21. 'make another yellow triangle using edge of last again a solid, non transparent color
  22. ftri x2, y2, x3, y3, _WIDTH * .6, _HEIGHT * .8, _RGBA(255, 255, 0, 255)
  23.  
  24. 'now overlap these 2 triangles with a 128/255 = .5 transparent blue triangle
  25. ftri 50, 75, _WIDTH * .8, 100, _WIDTH * .2, _HEIGHT * .5, _RGBA(0, 0, 255, 128)
  26.  
  27. LOCATE 35, 15: INPUT "For fun how about a morphing triangle screen saver, press enter ", wait$
  28.  
  29. WHILE _KEYDOWN(27) = 0 'while no escape key press
  30.  
  31.     'pick pick 3 random points on screen
  32.     x1 = RND * _WIDTH: x2 = RND * _WIDTH: x3 = RND * _WIDTH
  33.     y1 = RND * _HEIGHT: y2 = RND * _HEIGHT: y3 = RND * _HEIGHT
  34.     r = RND * 255: g = RND * 255: b = RND * 255: a = 255
  35.     dx1 = RND * 5 - 2.5: dx2 = RND * 5 - 2.5: dx3 = RND * 5 - 2.5
  36.     dy1 = RND * 5 - 2.5: dy2 = RND * 5 - 2.5: dy3 = RND * 5 - 2.5
  37.     dr = RND * 10 - 5: dg = RND * 10 - 5: db = RND * 10 - 5: da = -5: da = -3
  38.     'morph triangle
  39.     loopCnt = 0
  40.     DO
  41.         'draw it
  42.         ftri x1, y1, x2, y2, x3, y3, _RGBA(r, g, b, a)
  43.  
  44.         'update morph
  45.         x1 = x1 + dx1: IF x1 < 0 OR x1 > _WIDTH THEN dx1 = -dx1
  46.         y1 = y1 + dy1: IF y1 < 0 OR y1 > _HEIGHT THEN dy1 = -dy1
  47.  
  48.         x2 = x2 + dx2: IF x2 < 0 OR x2 > _WIDTH THEN dx2 = -dx2
  49.         y2 = y2 + dy2: IF y2 < 0 OR y2 > _HEIGHT THEN dy2 = -dy2
  50.  
  51.         x3 = x3 + dx3: IF x3 < 0 OR x3 > _WIDTH THEN dx3 = -dx3
  52.         y3 = y3 + dy3: IF y3 < 0 OR y3 > _HEIGHT THEN dy3 = -dy3
  53.  
  54.         r = r + dr: IF r < 0 OR r > 255 THEN dr = -dr
  55.         g = g + dg: IF g < 0 OR g > 255 THEN dg = -dg
  56.         b = b + db: IF b < 0 OR b > 255 THEN db = -db
  57.         a = a + 3: IF a < 10 OR a > 252 THEN da = -da
  58.         loopCnt = loopCnt + 1
  59.  
  60.         _DISPLAY ' stops flickering specially when allot of CLS
  61.         _LIMIT 60 ' << updates screen 60 times per secound
  62.  
  63.     LOOP UNTIL loopCnt = 1000
  64.     CLS
  65.  
  66.  
  67. ' 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
  68. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  69.     DIM a&
  70.     a& = _NEWIMAGE(1, 1, 32)
  71.     _DEST a&
  72.     PSET (0, 0), K
  73.     _DEST 0
  74.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  75.     _FREEIMAGE a& '<<< this is important!
  76.  
  77.  

Offline petoro

  • Newbie
  • Posts: 27
    • View Profile
Re: Nested triangles
« Reply #6 on: August 18, 2019, 01:16:20 pm »
That is beautiful, there are several very interesting functions in your code, such as the Universal Resizer of the screen, the transparency fourth argument, the WAIT$ argument... and a lot more that I didn't knew. Thanks for sharing.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Nested triangles
« Reply #7 on: August 18, 2019, 02:21:28 pm »
That is beautiful, there are several very interesting functions in your code, such as the Universal Resizer of the screen, the transparency fourth argument, the WAIT$ argument... and a lot more that I didn't knew. Thanks for sharing.

Yeah welcome to QB64! with SCREEN _NEWIMAGE(wide, heigh, 32)

The WAIT$ is just a dummy variable name describing what it was doing at the end of an INPUT statement, nothing special and not sure if I did all caps on purpose or not (it was not.) OK I just looked it up, there is a keyword WAIT, I guess I better stick to w$ abbreviated wait$, though it works OK.

Offline petoro

  • Newbie
  • Posts: 27
    • View Profile
Re: Nested triangles
« Reply #8 on: August 18, 2019, 03:43:59 pm »
Yeah welcome to QB64! with SCREEN _NEWIMAGE(wide, heigh, 32)

The WAIT$ is just a dummy variable name describing what it was doing at the end of an INPUT statement, nothing special and not sure if I did all caps on purpose or not (it was not.) OK I just looked it up, there is a keyword WAIT, I guess I better stick to w$ abbreviated wait$, though it works OK.

My fault, I misinterpreted its meaning...

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Nested triangles
« Reply #9 on: August 19, 2019, 11:22:09 am »
Amazing!!
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials