_Title "Fake sphere mapping Mod 4 trans world 2" 'b+ 2022-01-02
' new 2022-01-01 part =========================================================================
' need to find the actual top, left and bottom right points inside map
'Do
' Cls
' _PutImage (0, 0), surface&, 0
' While _MouseInput: Wend
' Print _MouseX, _MouseY
' _Display
' _Limit 100
'Loop
' 48 to 688 = 640 pixels found by pointing at spots I wanted
' 37 to 356 = 320 pixels
gw = 639
gh = 320
'_Dest map&
_PutImage (0, 0)-(638, 319), surface&
, map&
, (48, 37)-Step(gw
, gh
) ' get the world section without labeling and such _PutImage (0, 0), map&
, 0 ' OK one pixel off from (48, 36) If IsNear&
(clr~&
, &HFFFFFFFF, 80) Then _PutImage (0, 0), 0, map
, (0, 0)-(638, 319) ' screen to map 'Color , &HFFFFFF00 'checking
'Cls
'_PutImage (0, 0), map&, 0 ' there is someting off white around the black lines
'Sleep ' OK got the image
' ==================================================================================
xo = 0: xo2 = .5 * gw
' new ============================= the backside!
tv
= (_Asin(y
/ r
) + 1.5) / 3 For x
= -x1
+ 1 To x1
- 1 tu
= (_Asin(-x
/ x1
) + 1.5) / 6 pc~&
= Point((xo2
+ tu
* gw
) Mod gw
, tv
* gh
) cAnalysis pc~&, rd, gr, bl, al
PSet (x
+ xc
, y
+ yc
), _RGB32(rd
- 50, gr
- 50, bl
, al
) fcirc xc
, yc
, r
, _RGB32(255, 255, 255, 30) ' fill with some haze
fcirc xc
, yc
, rr
, _RGB32(30, 10, 30, 40) '=======================================================================
tv
= (_Asin(y
/ r
) + 1.5) / 3 For x
= -x1
+ 1 To x1
- 1 tu
= (_Asin(x
/ x1
) + 1.5) / 6 pc~&
= Point((xo
+ tu
* gw
) Mod gw
, tv
* gh
) PSet (x
+ xc
, y
+ yc
), pc~&
'Print "cAnalysis says:"; outRed; outGrn; outBlu; outAlp
'this function needs: cAnalysis (c As _Unsigned Long, outRed as long, outGrn as long, outBlu as long, outAlp as long)
'try color +-5 on RGB as near
Dim As Long cRed
, cGrn
, cBlu
, dummy
, nRed
, nGrn
, nBlu
cAnalysis colr, cRed, cGrn, cBlu, dummy
'Print cRed, cGrn, cBlu
cAnalysis nearColr, nRed, nGrn, nBlu, dummy
'Print nRed, nGrn, nBlu
If Abs(cBlu
- nBlu
) <= nearness
Then IsNear&
= -1
Radius
= Abs(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 Line (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
Line (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
Line (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
Line (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
Line (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF