Tangram

[bplus]

 

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
19. END TYPE
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)
54. NEXT
55.  
56. DO
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
63.     WHILE _MOUSEINPUT
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
77. LOOP
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
90. END SUB
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
103. END SUB
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
114. END SUB
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
129. END SUB
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)
142. END SUB
143.  
144.  

Does bplus like to play with blocks?

Sure ;-))
 

[bplus]

@Kiara87  no longer missing from QB64 :)

Thanks for the challenge.
 

[Kiara87]

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

[TempodiBasic]

@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
 

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

Thanks to share

[bplus]

And how did r key press work out for you?

[TempodiBasic]

as you can imagine R key works very well!

[_vince]

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

[bplus]

Ah the primary colors of childhood! :)

[Dav]

Really neat.  I tried to make a puzzle game like this once, but gave up.   This inspires me to try again.

- Dav 

[bplus]

Thanks Dav, for me, the key was figuring out an easy way to grab and rotate the pieces.