Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on November 10, 2020, 01:05:01 am

Title: Tangram
Post by: bplus on November 10, 2020, 01:05:01 am
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Here is start screen

Code: QB64: [Select]
  1. _TITLE "Tangram 1   press r  reset   if handles get stuck" 'b+ 2020-11-09 & 10
  2.  
  3. ' ============================= Instructions ==================================================
  4. '
  5. ' The little dot on the pieces are handles for dragging pieces or rotating them with mousewheel.
  6. ' Don't drag a handle near another or the pieces will stick together, press r if they do.
  7. '
  8. '=================================================================================================
  9.  
  10. CONST sqr2d2 = SQR(2) / 2 ' for converting lengths with 45/90 triangles.
  11.  
  12. TYPE objType
  13.     cx AS SINGLE
  14.     cy AS SINGLE
  15.     lenBase AS SINGLE
  16.     rotDegrees AS SINGLE
  17.     colr AS _UNSIGNED LONG
  18.     typ AS LONG
  20.  
  21. SCREEN _NEWIMAGE(1280, 740, 32)
  22. _DELAY .25
  23. _SCREENMOVE 70, 5 'sorry this works for my screen, yours is likely different
  24.  
  25. REDIM SHARED obj(1 TO 7) AS objType
  26. REDIM copy(1 TO 7) AS objType
  27.  
  28. obj(1).typ = 1: obj(1).cx = _WIDTH / 2 - 125: obj(1).cy = _HEIGHT / 2: obj(1).lenBase = 500: obj(1).rotDegrees = 90: obj(1).colr = &HFFFF8800
  29. drawObj 1
  30.  
  31. obj(2).typ = 1: obj(2).cx = _WIDTH / 2: obj(2).cy = _HEIGHT / 2 - 125: obj(2).lenBase = 500: obj(2).rotDegrees = 180: obj(2).colr = &HFF008800
  32. drawObj 2
  33.  
  34. obj(3).typ = 1: obj(3).cx = _WIDTH / 2 - 2: obj(3).cy = _HEIGHT / 2 + 65: obj(3).lenBase = 250: obj(3).rotDegrees = 0: obj(3).colr = &HFF000066
  35. drawObj 3
  36.  
  37. obj(4).typ = 1: obj(4).cx = _WIDTH / 2 + 125 + 64: obj(4).cy = _HEIGHT / 2 - 125: obj(4).lenBase = 250: obj(4).rotDegrees = 270: obj(4).colr = &HFF00DDDD
  38. drawObj 4
  39.  
  40. obj(5).typ = 1: obj(5).cx = _WIDTH / 2 + 125 + 64: obj(5).cy = _HEIGHT / 2 + 125 + 62.5: obj(5).lenBase = 500 * sqr2d2: obj(5).rotDegrees = 135
  41. obj(5).colr = &HFF880000
  42. drawObj 5
  43.  
  44. obj(6).typ = 2: obj(6).cx = _WIDTH / 2 + 125: obj(6).cy = _HEIGHT / 2: obj(6).lenBase = 250 * sqr2d2: obj(6).rotDegrees = 0
  45. obj(6).colr = &HFFFFFF00
  46. drawObj 6
  47.  
  48. obj(7).typ = 3: obj(7).cx = _WIDTH / 2 - 62.5: obj(7).cy = _HEIGHT / 2 + 125 + 62.5: obj(7).lenBase = 250: obj(7).rotDegrees = 0
  49. obj(7).colr = &HFF0000FF
  50. drawObj 7
  51.  
  52. FOR i = 1 TO 7 'make a copy of settings in case a handle gets stuck on another
  53.     copy(i) = obj(i)
  55.  
  57.     CLS
  58.     IF INKEY$ = "r" THEN 'reset or fix
  59.         FOR i = 1 TO 7
  60.             obj(i) = copy(i)
  61.         NEXT
  62.     END IF
  64.         mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1): mw = _MOUSEWHEEL
  65.         FOR i = 1 TO 7
  66.             IF _HYPOT(obj(i).cx - mx, obj(i).cy - my) < 20 THEN ' mouse is down near a piece center
  67.                 IF mb THEN obj(i).cx = mx: obj(i).cy = my
  68.                 IF mw THEN obj(i).rotDegrees = obj(i).rotDegrees + mw
  69.             END IF
  70.         NEXT
  71.     WEND
  72.     FOR i = 1 TO 7
  73.         drawObj i
  74.     NEXT
  75.     _DISPLAY
  76.     _LIMIT 60
  78.  
  79. SUB drawObj (i AS LONG)
  80.     SELECT CASE obj(i).typ
  81.         CASE 1 'tri45
  82.             tri45 obj(i).cx, obj(i).cy, obj(i).lenBase, obj(i).rotDegrees, obj(i).colr
  83.         CASE 2 ' square
  84.             square obj(i).cx, obj(i).cy, obj(i).lenBase, obj(i).rotDegrees, obj(i).colr
  85.         CASE 3 ' parallel
  86.             parallel obj(i).cx, obj(i).cy, obj(i).lenBase, obj(i).rotDegrees, obj(i).colr
  87.     END SELECT
  88.     CIRCLE (obj(i).cx, obj(i).cy), 2, &HFF000000
  89.     CIRCLE (obj(i).cx, obj(i).cy), 3, &HFFFFFFFF
  91.  
  92. SUB tri45 (cX, cY, lenBase, rotDegrees, colr AS _UNSIGNED LONG) ' 5 triangles
  93.     rotRad = _D2R(rotDegrees)
  94.     bx = cX + .25 * lenBase * COS(_PI(.5) + rotRad)
  95.     by = cY + .25 * lenBase * SIN(_PI(.5) + rotRad)
  96.     x1 = bx + .5 * lenBase * COS(_PI + rotRad)
  97.     y1 = by + .5 * lenBase * SIN(_PI + rotRad)
  98.     x2 = bx + .5 * lenBase * COS(rotRad)
  99.     y2 = by + .5 * lenBase * SIN(rotRad)
  100.     x3 = cX + .25 * lenBase * COS(_PI(1.5) + rotRad)
  101.     y3 = cY + .25 * lenBase * SIN(_PI(1.5) + rotRad)
  102.     ftri x1, y1, x2, y2, x3, y3, colr
  104.  
  105. SUB square (centerX, centerY, lenSide, rotDegrees, colr AS _UNSIGNED LONG) ' 1 square
  106.     REDIM xx(3), yy(3)
  107.     rotRad = _D2R(rotDegrees)
  108.     FOR i = 0 TO 3
  109.         xx(i) = centerX + lenSide * sqr2d2 * COS(_PI / 2 * i + rotRad)
  110.         yy(i) = centerY + lenSide * sqr2d2 * SIN(_PI / 2 * i + rotRad)
  111.     NEXT
  112.     ftri xx(0), yy(0), xx(1), yy(1), xx(2), yy(2), colr
  113.     ftri xx(2), yy(2), xx(3), yy(3), xx(0), yy(0), colr
  115.  
  116. SUB parallel (centerX, centerY, lenBase, rotDegrees, colr AS _UNSIGNED LONG) ' 1
  117.     rotRad = _D2R(rotDegrees)
  118.     arm = .5 * lenBase * sqr2d2
  119.     x1 = centerX + arm * COS(_PI(1.25) + rotRad)
  120.     y1 = centerY + arm * SIN(_PI(1.25) + rotRad)
  121.     x2 = x1 + lenBase * COS(0 + rotRad)
  122.     y2 = y1 + lenBase * SIN(0 + rotRad)
  123.     x3 = centerX + arm * COS(_PI(.25) + rotRad)
  124.     y3 = centerY + arm * SIN(_PI(.25) + rotRad)
  125.     x4 = x3 + lenBase * COS(_PI + rotRad)
  126.     y4 = y3 + lenBase * SIN(_PI + rotRad)
  127.     ftri x1, y1, x2, y2, x3, y3, colr
  128.     ftri x3, y3, x4, y4, x1, y1, colr
  130.  
  131. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  132.     DIM D AS LONG
  133.     STATIC a&
  134.     D = _DEST
  135.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
  136.     _DEST a&
  137.     _DONTBLEND a& '  '<<<< new 2019-12-16 fix
  138.     PSET (0, 0), K
  139.     _BLEND a& '<<<< new 2019-12-16 fix
  140.     _DEST D
  141.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  143.  
  144.  

Does bplus like to play with blocks?

Sure ;-))
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Tangram
Post by: bplus on November 10, 2020, 01:20:09 am
@Kiara87  no longer missing from QB64 :)

Thanks for the challenge.
 

Title: Re: Tangram
Post by: Kiara87 on November 10, 2020, 05:02:00 am
how did you do it so fast

really fantastic you can create anything in no time

now I try it

however compliments anything you can do without limits a good programmer
Title: Re: Tangram
Post by: TempodiBasic on November 14, 2020, 05:55:05 am
@bplus
Cool!
I got my stack of polygons, it's clear a my sillyness, it's clear the warning don't bring too near the polygons among them
see here
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

newer version will bring a z order or an impenetralibity of poligons for dummy users :-)

Thanks to share
Title: Re: Tangram
Post by: bplus on November 14, 2020, 06:47:10 am
And how did r key press work out for you?
Title: Re: Tangram
Post by: TempodiBasic on November 15, 2020, 01:27:01 pm
as you can imagine R key works very well!
Title: Re: Tangram
Post by: _vince on November 18, 2020, 08:44:32 pm
Somehow this brings back a very rough memory, I feel like a had a plastic set of this as a kid, that square piece in the middle is really hitting me in a vivid way.  Never knew wtf it's for, still don't
Title: Re: Tangram
Post by: bplus on November 18, 2020, 09:12:09 pm
Ah the primary colors of childhood! :)
Title: Re: Tangram
Post by: Dav on November 19, 2020, 04:37:14 pm
Really neat.  I tried to make a puzzle game like this once, but gave up.   This inspires me to try again.

- Dav 
Title: Re: Tangram
Post by: bplus on November 19, 2020, 07:05:43 pm
Thanks Dav, for me, the key was figuring out an easy way to grab and rotate the pieces.
Text Only | Text with Attachments