Rotating Cube with textures build 2019-02-24

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Rotating Cube with textures build 2019-02-24

Post by UEZ »

Here an additional code to rotate a cube with texture. It is not very fast with larger images and thus a lot of room for speedup improvements...

Sorry, with larger images the source code (80977 chars) is too long (exceeded 60000 chars) to post it here. :-(

Preview:
Image

Rotating cube with texture.bas

Code: Select all

'Rotating cube with texture coded by UEZ build 2019-02-24
'Original trapezoid transformation code by Ben321
'Runs "fastest" as x64 with -gen gcc -Wc -Ofast -fpmode FAST -fpu SSE at least on my system :-)

#Include "fbgfx.bi"
#include "file.bi"

Using FB

#Define Round(x) ((x * 100 + 0.5) / 100 Shr 0) '2 decimal places 10^2 = 100
#Define PixelSet(_x, _y, colour)    *CPtr(Ulong ptr, imgData_d + (_y) * pitch_d + (_x) Shl 2) = (colour)
#Define _Red(_colors) 	(((_colors) Shr 16) And 255)
#Define _Green(_colors) (((_colors) Shr 8) And 255)
#Define _Blue(_colors) 	((_colors) And 255)
#Define _Min(a, b)  (Iif(a < b, a, b))
	
Dim Shared As Integer pitch_s, pitch_d
Dim Shared As Image Ptr Img_Dest, Img_Bg
Dim Shared As Any Ptr imgData_d

Type tImgInfo
	As Image Ptr img
	As Integer pitch
	As Any Ptr imgdata
End Type

Dim Shared As tImgInfo ImgInfo(5)

Const fRad = Acos(-1) / 180, scrw = 1000, scrh = 666, img_w = 250, img_h = 166, iCenterX = scrw \ 2, iCenterY = scrh \ 2, iMouseSense = 150,_
	  iPersp_correction = 1000, fCube_Size = 100, fMin_brightness = fCube_Size, fZoomMinus = 0.95, fZoomPlus = 1.05

Dim Shared as Double fZoomCounter = 1.0

Type DPOINT
	As Double x, y, z
End Type

Declare Sub Calculate(fAngleX As Double, fAngleY As Double, iPos As Ubyte)
Declare Sub DrawCube(p1 As Ubyte, p2 As Ubyte, p3 As Ubyte, p4 As Ubyte, img As Ubyte)
Declare Function Transform(x As Short, y As Short, ImgWidth As Ushort, ImgHeight As Ushort, Points() As DPOINT) As DPOINT
Declare Sub Trapezoid(aPoints() As DPOINT, ww As Ushort, hh As Ushort, img As Ubyte, fBrightness As Double)
Declare Function Base91Decode(sString As String, Byref iBase91Len As Ulong) As Ubyte Ptr
Declare Function _WinAPI_LZNTDecompress(aBinary As Ubyte Ptr, iFileSize As Ulong, iCompressedSize As Ulong) As Ubyte Ptr
Declare Sub CreateFile(sFilename as String, sBase91 as String, iLines As Ulong, bCompressed As Ulong, iFileSize As Ulong, iCompressedSize As Ulong)
Declare Sub ExtractDe()
Declare Sub ExtractGb()
Declare Sub ExtractGr()
Declare Sub ExtractJa()
Declare Sub ExtractTr()
Declare Sub ExtractUs()


Screenres (scrw, scrh, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_HIGH_PRIORITY Or GFX_NO_SWITCH)
Screenset 1, 0

Windowtitle "Rotating Cube with textures coded by UEZ"

Dim as String aFiles(5) = {"De.bmp", "Tr.bmp", "Gb.bmp", "Us.bmp", "Gr.bmp", "Ja.bmp"}
For i As Ubyte = 0 To 5
	ImgInfo(i).img = Imagecreate(img_w, img_h)
    If FileExists(CurDir & "\" & aFiles(i)) = 0 Then
        select case i
            case 0
                ExtractDe()
            Case 1
                ExtractTr()
            Case 2
                ExtractGb()
            Case 3
                ExtractUs()
            Case 4
                ExtractGr()
            Case 5
                ExtractJa()
        end select
    end if
    Bload(aFiles(i), ImgInfo(i).img)
Next
Img_Dest = Imagecreate(scrw, scrh, 0, 32)
Img_Bg = Imagecreate(scrw, scrh, &h50505050, 32)

Imageinfo(ImgInfo(0).img, , , , ImgInfo(0).pitch, ImgInfo(0).imgdata)
Imageinfo(ImgInfo(1).img, , , , ImgInfo(1).pitch, ImgInfo(1).imgdata)
Imageinfo(ImgInfo(2).img, , , , ImgInfo(2).pitch, ImgInfo(2).imgdata)
Imageinfo(ImgInfo(3).img, , , , ImgInfo(3).pitch, ImgInfo(3).imgdata)
Imageinfo(ImgInfo(4).img, , , , ImgInfo(4).pitch, ImgInfo(4).imgdata)
Imageinfo(ImgInfo(5).img, , , , ImgInfo(5).pitch, ImgInfo(5).imgdata)
Imageinfo(Img_Dest, , , , pitch_d, imgData_d)



'       0 -- - - - 1
'     / |        / |
'    4 - -  - - 5  |
'    |  |       |  |
'    |  3 -- - -|- 2
'    | /        | /	
'    7 - -  - - 6

Dim Shared As DPOINT aCoords(0 To 7), aTrapezoid(0 To 3)

aCoords(0).x = -fCube_Size : aCoords(0).y = -fCube_Size : aCoords(0).z = -fCube_Size 
aCoords(1).x =  fCube_Size : aCoords(1).y = -fCube_Size : aCoords(1).z = -fCube_Size 
aCoords(2).x =  fCube_Size : aCoords(2).y =  fCube_Size : aCoords(2).z = -fCube_Size
aCoords(3).x = -fCube_Size : aCoords(3).y =  fCube_Size : aCoords(3).z = -fCube_Size
aCoords(4).x = -fCube_Size : aCoords(4).y = -fCube_Size : aCoords(4).z =  fCube_Size 
aCoords(5).x =  fCube_Size : aCoords(5).y = -fCube_Size : aCoords(5).z =  fCube_Size 
aCoords(6).x =  fCube_Size : aCoords(6).y =  fCube_Size : aCoords(6).z =  fCube_Size
aCoords(7).x = -fCube_Size : aCoords(7).y =  fCube_Size : aCoords(7).z =  fCube_Size

Dim As Integer mx, my, mw, mwo

SetMouse iCenterX, iCenterY

Dim As Ushort iFPS = 0, iFPS_current = 0
Dim as Boolean bOk

Dim As Double fTimer = Timer

Do
	'Line Img_Dest, (0, 0) - (scrw, scrh), Rgb(64, 64, 64), BF
	Put Img_Dest, (0, 0), Img_Bg, PSet
	Getmouse mx, my, mw
	
	For j As Ubyte = 0 To 7
		Calculate((iCenterY - my) / iMouseSense * fRad, (-iCenterX + mx) / iMouseSense * fRad, j)
	Next
	
	DrawCube(7, 6, 4, 5, 0) 'front
	DrawCube(1, 2, 0, 3, 1) 'back
	DrawCube(0, 3, 4, 7, 2) 'left
	DrawCube(6, 2, 5, 1, 3) 'right
	DrawCube(5, 1, 4, 0, 4) 'top
	DrawCube(3, 2, 7, 6, 5) 'bottom
	
	Put (0, 0), Img_Dest, PSet
    
    'zoom
    #Macro Zoom(fFactor)
        For j as UByte = 0 to 7
            aCoords(j).x *= fFactor
            aCoords(j).y *= fFactor
            aCoords(j).z *= fFactor
        next  
    #EndMacro
     
    mwo -= mw
    If mwo <> 0 then
        Select Case mwo
            case -1
                If fZoomCounter > 0.15 Then
                    fZoomCounter *= fZoomMinus
                    Zoom(fZoomMinus)
                End If
            Case else
                If fZoomCounter < 1.90 Then
                    fZoomCounter *= fZoomPlus
                    Zoom(fZoomPlus)
                End If
        end Select
    end if
    mwo = mw
    
	Draw String(1, 1), iFPS_current & " fps", Rgb(&hF0, &hF0, &hF0)
	Flip

	If Timer - fTimer > 0.99 Then
		iFPS_current = iFPS
		iFPS = 0
		fTimer = Timer
	Else
		iFPS += 1
	Endif
	
	Sleep (1, 1)
Loop Until Inkey = Chr(27)

For i As Ubyte = 0 To 5
	Imagedestroy(ImgInfo(i).img)
Next
Imagedestroy(Img_Dest)
Imagedestroy(Img_Bg)


Sub Calculate(fAngleX As Double, fAngleY As Double, iPos As Ubyte)
	Dim As Double py, pz
	py = aCoords(iPos).y
	pz = -aCoords(iPos).x * Sin(fAngleY) + aCoords(iPos).z * Cos(fAngleY)
	aCoords(iPos).x	= aCoords(iPos).x * Cos(fAngleY) + aCoords(iPos).z * Sin(fAngleY)
	aCoords(iPos).y	= py * Cos(fAngleX) - pz * Sin(fAngleX)
	aCoords(iPos).z	= py * Sin(fAngleX) + pz * Cos(fAngleX)
End Sub

Sub DrawCube(p1 As Ubyte, p2 As Ubyte, p3 As Ubyte, p4 As Ubyte, img As Ubyte)
	Dim As Double k1, k2, k3, k4, x1, y1, x2, y2, x3, y3, x4, y4, z1, z2, z3, cor
	
	cor = (1 + aCoords(p1).z / iPersp_correction)
	x1 = aCoords(p1).x * cor
	y1 = aCoords(p1).y * cor
	z1 = aCoords(p1).z
	
	cor = (1 + aCoords(p2).z / iPersp_correction)
	x2 = aCoords(p2).x * cor
	y2 = aCoords(p2).y * cor
	z2 = aCoords(p2).z
	
	cor = (1 + aCoords(p3).z / iPersp_correction)
	x3 = aCoords(p3).x * cor
	y3 = aCoords(p3).y * cor
	z3 = aCoords(p3).z
	
	cor = (1 + aCoords(p4).z / iPersp_correction)
	x4 = aCoords(p4).x * cor
	y4 = aCoords(p4).y * cor

	k1 = x1 - x2
	k2 = y3 - y2
	k3 = y1 - y2
	k4 = x3 - x2	
	
	If (k1 * k2 - k3 * k4) > 0.0 Then
		aTrapezoid(0).x = iCenterX + x1:     aTrapezoid(0).y = iCenterY + y1
		aTrapezoid(1).x = iCenterX + x2:     aTrapezoid(1).y = iCenterY + y2
		aTrapezoid(2).x = iCenterX + x3:     aTrapezoid(2).y = iCenterY + y3
		aTrapezoid(3).x = iCenterX + x4:     aTrapezoid(3).y = iCenterY + y4	
		Trapezoid(aTrapezoid(), img_w, img_h, img, ((aCoords(p1).z + aCoords(p2).z + aCoords(p3).z + aCoords(p4).z) shr 2) / fMin_brightness)
		/'
		Line Img_Dest, (aTrapezoid(0).x, aTrapezoid(0).y) - (aTrapezoid(1).x, aTrapezoid(1).y), Rgb(0, 0, 0)
		Line Img_Dest, (aTrapezoid(1).x, aTrapezoid(1).y) - (aTrapezoid(3).x, aTrapezoid(3).y), Rgb(0, 0, 0)
		Line Img_Dest, (aTrapezoid(3).x, aTrapezoid(3).y) - (aTrapezoid(2).x, aTrapezoid(2).y), Rgb(0, 0, 0)
		Line Img_Dest, (aTrapezoid(2).x, aTrapezoid(2).y) - (aTrapezoid(0).x, aTrapezoid(0).y), Rgb(0, 0, 0)
        '/
	Endif
End Sub

Function Transform(x As Short, y As Short, ImgWidth As Ushort, ImgHeight As Ushort, Points() As DPOINT) As DPOINT
	Dim As Ushort ww = (ImgWidth - 1), hh = (ImgHeight - 1)
	Dim As Double a, b, c, d = img_w * hh
	Dim As DPOINT Result
	'x
	b = (Points(1).x - Points(0).x) / ww
	c = (Points(2).x - Points(0).x) / hh
	a = (Points(3).x - hh * c - Points(0).x - ww * b) / d
	Result.x = x * (y * a + b) + y * c + Points(0).x
	'y
	b = (Points(2).y - Points(0).y) / hh
	c = (Points(1).y - Points(0).y) / ww
	a = (Points(3).y - hh * b - ww * c - Points(0).y) / d
	Result.y =  y * (x * a + b) + x * c + Points(0).y
	Return Result
End Function

Sub Trapezoid(aPoints() As DPOINT, ww As Ushort, hh As Ushort, img As Ubyte, fBrightness As Double)
	Dim As Ushort xx, yy
	Dim As DPOINT Points
	Dim As Ulong iCol, iCol2
	For y As Ushort = 0 To hh - 1
		For x As Ushort = 0 To ww - 1
			Points = Transform(x, y, ww, hh, aPoints())
            If Not (Points.x < 1 or Points.x > scrw - 2 or Points.y < 1 or Points.y > scrh - 2) then
                'Points.x = Iif(Points.x < 1, 1, Iif(Points.x > scrw - 2, scrw - 2, Points.x))
                'Points.y = Iif(Points.y < 1, 1, Iif(Points.y > scrh - 2, scrh - 2, Points.y))
                xx = Points.x
                yy = Points.y
                iCol = *Cptr(Ulong ptr, ImgInfo(img).imgdata + y * ImgInfo(img).pitch + x Shl 2)
                iCol2 = Rgb(_Min(255, _Red(iCol) * fBrightness), _Min(255, _Green(iCol) * fBrightness), _Min(_Blue(iCol) * fBrightness, 255))
                If fZoomCounter > 0.75 then
                    PixelSet(xx - 1, yy - 1, iCol2) 
                    PixelSet(xx, yy - 1, iCol2)
                    PixelSet(xx + 1, yy - 1, iCol2)
                    PixelSet(xx - 1, yy, iCol2)
                    PixelSet(xx, yy, iCol2)
                    PixelSet(xx + 1, yy, iCol2)
                    PixelSet(xx - 1, yy + 1, iCol2)
                    PixelSet(xx, yy + 1, iCol2)
                    PixelSet(xx + 1, yy + 1, iCol2)
                Else
                    PixelSet(xx, yy, iCol2)
                End If
            End If
		Next x
	Next y	
End Sub

'Generated by FB File2Bas Code Generator v0.80 build 2019-01-05 beta by UEZ

__Grbmp:
Data 3,1,21366,1995,"Base91"
Data "?xM7e2rTH´AAbBVxWcC´´V@Q7DVxAAOawAwA4M:)oIVR|LAA>Q7L4}B´=WT|RyOA4F7vLAuAqW7LT|9G)0k_|4hAKcDANA*>NWd~sD,b4}SPN´d+YLQ´FOEG9~NCURd~cR(´#~n_EtB´+>J´fAjBHL3r+>F´PAA´CtPA!A&C/Vk_CtPA!A`~HAfAhB]KT|v(HAfAhB9~fAhB]KT|v(HAfAhB]KT|/C/Vk_CtHAeAdByKk_BttW+>D´HAeAdByKk_BtHAA´BtHAeAdByKk_BtHAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeAt[DAPA8A6CrP*hISPAP|D´HAeAdByK[9Bt:(gtezjqv(DAPA8A6CJVY4SEe+4}2RfAdByKk_BttW+>D´GA8s%9NV+>D´HAA´BtHAcA`~zKk_BtHAeA`~DAPA~~ZFSqv(DAPA8A=~HA´s6CJV+>D´HAeAdBd~At6CJV+>D´HAeAdBd~z_/CJV+>D´HAeAdBd~z_Bt.V+>D´HAeAdBd~9WBtp*TVFnAAAA#T]~j_tW]|d+PAB´`~k~T)5yR_n`J´PAmA4QPL2WtFh=kB]K;vBt#((_CtPA!A`~HAfAhB]KT|v(HAfAhB9~fAhB]KT|v(HAfAhB]KT|/C/Vk_CtPAeAdByKk_BttW+>D´HAeAdByKk_BtHAA´BtHAeAdByKk_BtHAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA%`DAPA8AQAvDY{BtHAs{BtHAeAdB(HC´6}ydB´BtHAeAdByKk_BtGA8s9~ksu`D´HAeAdByKk_M/B´N{D´HAeAdByKk_"
Data "BtWL~~D´HAeAdByKk_BtWL8A=~HAeAdByKk_BtWL8A6C3r8A6CJV+>D´WL+´SfOZ@EAAAA&6A´c~0[B´y|w(tWA´>~,}P@J´PAA´:vPA!A&Cd~(_CtPA!A59QL1|<tPA!A1B1Rd~Zlx29AbvBGhBfBfAG]DABAiC.Cpw8AR9v3pi&AxFhB]K:Cv(g;e~´C@Q~}+hwM&C/Vk_>D4}q?F´PAA´=~MV+>D´tW+>D´HA´s=~MV+>D´HAA´BtHA´s=~MV+>D´HAeA`~DAtW`~zKk_BtHAeAdBd~fA`~zKk_BtHAeAdByKk_B´MV+>D´HAeAdByKk_lutW+>D´HAeAdByKk_luWL~~D´HAeAdByKk_luWL8A=~HAeAdByKk_luWL8A6C4}#A6CJV+>/CtWdByKk_BttW+>D´WL~~ZFSqv(DAPA~~D´WL~~ZFSqv(DAPA8A=~HA´s`B3rW_D´HAeA`~qvAt=~DA*tA*HAeA|^DANA__BCtWvrNJC,zyHAeAdBr?[qAA.iUDFB@QZ)C´KtdA|s>>7CZFT~*>AtA´>~,}P@B´y|d+tWA´>~,}q?F´tW~~4FAt&Cd~(_:vtWhB9~i|B´<Vk_:vtW~~^KT|^)WLR|:vPAA´=~#}q?DAiW!WVYPAHL2F2:=(HA~sjHF2fA?^qB__dA9&0}/tHAeAdB1R8su+i(;>BAGAWu&CJV+>D´xRBtyaeWKqzKN/AAW&O`BtHAeANB_E´s6CQ@#A´C^}0@D´HAeA`~e~fAdBd~z_BtHAeA`~zKk_/C4}K?D´HAeA`~zKk_BtB´K?D´HAeA`~zKk_BtWL~~D´HAeA`~zKk_BtWL8A=~HAeA`~zKk_BtWL8A6C4}#A=~MV+>D´WL8A6CJV+>B´Zqv(DAtWdByKk_BtHAA´"
Data "luHA´svTLV+>D´HA´s=~HAeA`~zKk_BtHA´s6C4}#A=~MV+>D´HA´s6CJV+>$~Zqv(DAPA~~~Fgx1g+a*hEtjAL50uF>apK´4}jG&s:LDtO´1!trEAO7bCWK)KD.IAo0w(p&~~BAQKMiO8kVRF1RQbpN$s&a9C0[w(tWA´>~,}P@WLfA~~!~At`~<Vk_:vtWhB]KT|^)B´(_CttW~~!~i|v(WLA´=~tWhB9~i|^)WL!A`~g~(_4F4}q?4FoF`~zKk_BtHAA´luvI~~9~Zqv(DAPA~~9~ER`~e~z_BtHAeA`~zKw_B´7}K?D´HAeA`~zKw_lumIY4jyWqv(DAPAh~pFoIB´pI*hp;cW+>D´HA,/C´]sv_lu%C44~d;sv(DAPA0AH7HI~~E_,>2(GhR}BtHAA´)C4}K?j_Tqv(DAPA8A6C4}K?/CAtv(DAPA8A6C4}K?/CPA~~D´HAeAdBd~z_luHAeA`~DAPA8A=~7}K?D´HAeA`~DAPA~~9~Zqv(DAPA8A=~HA´s=~MV+>D´HAeAdBd~fA`~zKk_BtHAeAdB5F@Q}e/AMARdYE@Q]9y(L/O´B´´~)~y|d+tWLBbv^Jlu!sP<AA"

__Gbbmp:
Data 7,1,21366,4566,"Base91"
Data "R3M7e2rTH´AAbBVxWcC´´V@Q7DVxAAOawAwA4M:)oIVR|LAA~~;sy:.>Mcv(k~9APRHtnuJA?7PjOE(XOvDAs8ViF´oMnAC´IP7AC+qUAAfy}Ps8DOIAWeuGOtR9ZFU´*8wBC´_Y[BXLVHv+skMAX7M0q)JLzB?^~RGOxE(,+O~FRA|Jt4n|_AHG/FE?GTK´vB+OPwLHlB|L7Fp1VOeWYUnEsA;hK64Wu}ZO/NbL8p&G&>hxeCBNRAxdu`VeeG=J@WLDNk!}~IjAKVhNy:lH`|m7eeCq:>QJEUf|09y:d+d~LTv##s/*>tL7`~=WMc5EqC3v1tlOc+hxU>(W8ShB#~(_])LBL@,cd~}}bS,tQ7vDTx$@tWl[<c{[&´g)URkBokAS$y$wM}KDAt!!´E,B[>HA;T+CiWFx@iEB|~rsEB!n!Iqs)Q*stxpsU|4FdWU@kxjn<_@/URg5Iv8(d.8Z`~v8a/GRAK9[E;%s&qGB+G4W.}m_4Fs*0MwIAi>?tu{;PYr]DA2k0KgIt~wdk1^ncj**PAkIAAD3!YbLT|RE6Kk_:vWLZ~U)URV%knj#mA1FrvoaqIL&NG<C.Qe~z_luHASSR9,B]X@jb4!JY@PAf{.7WBSAYMCGxk6}K?,~ZqBtUC9HV(^2%u|?:S$}_Xjn?z#r2[D´.~P@/CPAWanbW@tY1F7PCA%E!WlK&tHC19At`~zKBtkuzuh´zXn_4+sz%y$t4W>C8u`Gq{/CtWdBUE|9)(hLh`+z]$Q~vW/hFK&IuB%~EB|~e~z_C´&s;laO´;fADGD3[*qI+G7k[sXY=~,}K?D´8rZ,]w|UZN1Fem!W5FL3^Xf}P/w~(_luHA6_Ktehoj]%RW$}xU?v?2TzdSNLY|A´e~z_BtW>L7_DU|~[Er]`"
Data "THPLzPdRTS,*=t|_UZN~K?/CPAv|j$tOSX4}.BkB!)3R0vcM8[!DA´;]WLq{.´B:c^2?&T;v9!!sAw[BsBeA+KB^s>5C´~g~z_BtHL5J_3%QcnEEcy6F1+=WD%$([=MH1FRZN~K?/CPA:>Sz6fn*O5NGYFQLB5gGxZ9/?Q_N|>duA´9~Zqt[:V0|oh`x=WcehW#TiN.4FB!yev]>´Aw(n)B´>~<`o?I[j}:4B]R´SA:C:3#yAYr?4!]FBtGA0AbL7F3dBMmGH7952W5dy:atiCQM;v#BU8PDE´AY@QHBjJnmCAPA0ESal_AABtYE!O_9+hBw@@ceJuaOdLP.^$.+KPZzIA#Wznpl^(hLUk<A{qwQZ|[uDDHl&+kHo)rnAAa42GyOF]*!ZLEClK1jOWVRM´II!}BYt4HAW)FF(L=hydnzi5+7:oiA3Ar#WO:LM:PjeO#DwW$_FG`A/ya`DR3za/m_%Z`xzk8s1TN)OD#AlR,y{LO6Bt)<eCLR_aHLU´;vmW4gS9/VL?=m.I7*L]W02y]o([zDgSQ:fj>CKC1B7<N?m7!e0AgB]t>xmTEAKBq?6=Q/3|EtYJj?f+q+;P}B7FYYLg)h{tbBSKKL8D@)_ZT3gWAGul|x7{pN5DOcjgp`4F<YWa[(9Wk?/yb|09mM|h2F$A}v95$RDtxG#%=~[ChF}EJaS=Jw_5pVkW!iwBFRc.$kyBCi!:)qe~W7Uc$y3!tJRW´C.)Kf&YS<}FY7|;,>g$mg1x2.ywPvK1A´2DJAp9R+TfS?]Hf//v5dV0#f*T),Di};5y`v2yk{Jaq2HLMogWoW;,w´;`&=Ltja,Df|=Wj1A5Wm$!wt]X;7tBm´?m[?J#R=>=$}´vI!8zGV>uAVu`2FnUEP~*=DF~[C^{jwuDgl"
Data "^XWya|´X_w`h=Xr{)m/BpB8}%´luE]JStJ.&9Z&Cuc^,|}K?d,KDXAVE@w{W#mw_luo?0WgWb|J/!|´sgAXL(Z}QABZvHz[AG:lB6|T)OBaY!FoImx`jJyt/#k´s.YwA4_8yWL5%/CzG{ty9x´&`k~F!`;q*[hrv)U3U*~bckB^eWqE´|Eb?@~ZqKAAArpQ@140C´~fGuwIJ!&16_b0}#A6FHr7kNXB´<sEC]>!v|kt[4FhH~lu6SNa?jHt)2W´s(|fZzBd~9VSXP|as>~&T~Y.Mr@th?(@Q8yWLl~FBY*Z<2sAr_Nz~K?Q#3C/MLA?5V~4FnHht%KL?X0dll>4F(~BtduCk=t?D%_4FFH>{hRtdDB4Ir,0F´sYI,r/DckY8P/4Fqi{O2uT)qvi|x[s~z_AAZBMu:o&KTJe?}}SXQM*#+[[`$=>Y^K)>y~z_AA](@A7&/*_|lu|(<GWGA4q<FW|}>~MVuW14BCSGBB#(:?H~=WgWkJ#,^Kk_lu0SuWdHB$0fS)KAHun8AtxtUh0iM#p+g>DAO/T)djtIrCxd(D$ARAC´C´Pj:LC´ck:CE´7E/F;C$DqSPcctCY9Fw(x^q1H#I´,Ae8euIGAABtUA!_hYGD0kOu_I,Gy´1tf?PALtA)eGF5/IyC<GYO`}+tzH6G)IIA}K}W:TXCotLR.C:C]Q~W8y8XC<´lc43JvA/vlH[<AA(t.B]tF8OAP^$seq]CpFj18#amMH8s?DZtMA|LTDUxQw%t[q.CfzOA+Wizn/ODrPX|j=fL3BiQH~u5u=~CWxltBt6y8/CAiWDBD|At`~)=`!C´7[i|ut&hcwxFdZ+>l[n4_|LEaUCt:i*[DAIA$Y}´u2#<#!3I$Ad5itq?DDB´v(HAfAoA=~!r+>F´tW~~F´"
Data "PA!A`~<Vk_CtPAA´=~PA!A&Cd~(_BtHAeAdBd~fA`~zKk_BtHAeAdByKk_B´MV+>D´HAeAdByKk_lutW+>D´HAeAdByKk_luHAA´BtHAeAdByKk_luHAeA`~DAPA8A6C4}K?/CPA8A=~HAeAdByKk_luHAeAdBd~fAdByKk_luHAeAdByKk_/CJV+>/CPA8A6CJV+>D´tW+>/CPA8A6CJV+>D´HAA´luHAeAdByKk_BtHA´s=~HAeAdByKk_BtHA´s6C4}!A6CJV+>D´HA}stJae]|D´HAKAd~Al``ftHAv~C´]*8s`%HAeAdBe+[6v}R:$_#´HAeA?(B_[~}/ba,hFAC.UAtJ+!q&|B5FBt_XNB5F5Lfn*S)A3FX38P=B3DYLpF9MF`]v!W!a(s@DAG.DcM|L:SZZBA_13FzW9ltB6Ful3!GO>*bes8$womAA[4,y=(WCXLS^iWeqtBY,MAMCOgzDPLe/C´[d;F3BIADJ2EUw7X;LgAWCU]x´$As<bv)M1BBzIDauqZ´:2QX~$DRo6WGA$J%)rn8MjH*h^}6F$A/hQoKwOmmOdZ5dsW2cc7PWCtPjis;fHLy4?vkWvD}A:y%1^XvE_WBFx7;CsWzD;XLGwwmJwoBf<vlB*E7uc}DA]tQcHO+h&oR70BaE=}]X.U7Mu2o7@B]:k02cSL,BpTQA:m_´rSgT^zVjeZ4F:[:ICY&e>u%IiN)QRwKYL>rcRQH;lBQj?S_)2+fdWE9[{LwB9[D53pF,xWB){LCAIAiLiB+H/*G*GD%H0_gt*w}Wz_.NhL)y0WxBk_F*{L^d)EmuEnAd*(SAG!EEg@$t45TcS)~oEIPL_XJ7K`mLiYXt@B|BR2hvDr=JvDuP(n/Cd~w_tphUZC&CCH7tmW7(IA>`V!"
Data "{irPzI{)w_:vLL]2uVTK2+Brw.?~gZw47FuFStob}4CM9r2[/C|}yV)Q#n<t}B85XHtWR*r~:B&2iZxOvfEB|~2RCHw6dyg8+CZ}<C,7bk=~hS&(tcTq&&EkEYi!.tn]/Cn}´AaF´9k/Zj!zWCtWSi1R64.Bi^O6[ygZ.Cj~_hREwm6{THPdqg´lH{luaIQMXde+7<[v+Y4Dxb~~ZFT|1FpwfH1Fyd+W#~|QftztEtTXx´Qc#C8}K?])d4J/fW/H1Ii!~~~*{9EeVtN#p_DSE)OEtW=[K(${SJ](8}*B=hL|4F7J>WRNwtMKRs_)4FVDkuX>v({%ZBZQmIU{/CEI)wRG,(G`$yXZ8y+UL?/Cd~z#@QO[}6%s~~Y}w1ODdZwtU3{z_)rItWQ.HI3`P.|}JiA´%yzEIA;hDHW>_|lu<j.C}XiG~N@N´s;PRj9QtJIgBJPGUF3~rIu:P(P4V<´Hr_/C.C9FjL;)o{](´sr#a?pvmlW|Bx<mAtoY<CXx`N(Lf+*Ht_s~>v)LvdH(,(j<v_luW$WWUiLA8sG#JV^:4FG$[$!rvBgAv.~~em4<guLXJC?P`[h´2fIY^D$ARAAA2Of+5XAA[0XLAGJt84IGMA_AHGDtX76yp!I7IA6wXBi$uWHAWEBl%G3A8AhNww#WFA8MknVx}W6(mL|QsEJwWCtZQAH?[y3Y+!^9BAn/hN.´PA,zcL!O9sA?H?|EcQ[4`|hEPtmGiSEg,BS4Xj)HFhAR]+$kXCM)[ScA})@dh/D8´U,H>´?D^XHM`|^@tn0(+vI6%I6y<CP8lJ´´Q4GGii9*AR;*´t>(]6OzFO^dX7s_fEOAf2(n$A4@_w5n2ys´@`vC´I$,*kU|}/{<dG|O:´KXLtmJ),hlOC8jhW~dHO:IA.HL"
Data "LBPL,TMccD*y]XFp~F8cGF$A0LFB5d!?$dwM;t}F~AaFL!Yt2j%a9H$~>nH´aS9xlC$AJl9vjc2yptC!{!%}CVgQ3|@~pSf+&NOEEdzf3VxHgW@@=m1|k*vHA´w$xW3HaiPBQu^XrR/vR7Lo<A]JyksAE3t]4F(8pAAgf+j3<HxB0![,!kw?W7#;8svZp1OW^#)0d|M/BA:D4D8y(/Ood;g+r?)[<C*Am_I~9s+Kp5.:>@WLM´kgCpuWMXPzp=YL+u|4msxNiPx7,|@~|Q|L2aMc{[g;/Xc4wu|4gG5MM!0b.C!!]}´~aF;v|5KS@´PGzv{yWOeWb3$5WRdGA?,hhj?~0[T}PA4R+m[>x1hGd~qi,.j0pX]Af?+BAt`~zK[9<n_X;CN1hMt1tB8s<MXWlBu;c40fN[!_>D2V+>/CtWn(|X2!J15V.s.Cm~bfoM{}>~7}K?D´J4lBWYgA8_bL}BB~[@7IWO*AL`?tAt~~ZF|;RQgA,TQIF[Qt|b%+P|_3PA~~!~ZqU)M&nNfuc+fAuMTa;>_3$N`~03o_Lq[ty]LFT98}vWzn}.Rxub´ywN`~e~z_BtQ?dV`h^9S+|v$A5}Z4?/&,fA|}7C4}P@/CPA?,)}sclR2)OJkB_}W`t>q|<Qe~z_ltx´Hh$AlEo4/#PLL|}W~qk?DAtWm{4FeAkUyCC@IAU5<{C/HA´s=~MVY4`hAGp*q1BSX|~e$(F5i|hBFhB´>~MVY4AE]F;ChE:y,}8F:N4´(s8A=~#}K?4Fp1/Wv^TH2}XE´G2qPA~~D´WL~~ZF@Q|_Wt.s´yg~q?sFT|T)4FeABV{{z_}.tW+>WLtWdBd~RN}Qs´+sS´n?EE`C=5QM!MH795%FTXC2CARBIG:CH,5[%BAwIAGG:1Q@AAuWoI"
Data "Ou{Q:CtB)Am|a[NGU8d#AA>2VAVB85:1Di,>ItC4&MlW:FOH´])AscOWZ|´L)(H´6i6uAMlWz+_Cht%AY.´COjG6QCH%nO</Lc:O~F5FI%:CA)34eJJtV;d5H5%tWLBwRj$$<O1R9sVZQMAG/w}4w~AwlZCY??WRc+EY7!J;Wj.$?()Iw_H"

__Debmp:
Data 2,1,21366,1417,"Base91"
Data "YxM7e2rTH´AAbBVxWcC´´V@Q7DVxAAOawAwA4M:)oIVR}45F+>fA``VLSKOcItfs4FEE4~pKhN%eccFA$+y(B´A´@~fAA´IL4}P@J´AthB]KT|/Cd~(_CtPA!A`~<Vk_CtB´q?F´PA!A`~<Vk_CtPAA´:vPA!A&Cd~(_CtPAA´=~PA!A&Cd~(_CtHAeAdBd~fA`~zKk_BtHAeAdByKk_B´MV+>D´HAeAdByKk_lutW+>D´HAeAdByKk_luWL~~D´HAeAdByKk_BtWL8A=~HAeAdByKk_BtWL8A6C4}#A6CJV+>D´WL8A6CJV+>4FSqv(DAtWdByKk_BtHAA´BtHA´s6CJV+>D´HAeA`~DAtWdByKk_BtHAeAdBd~At6CJV+>D´HAeAdBd~z_/CJV+>D´HAeAdBd~z_lutW+>D´HAeAdByKk_luHAA´BtHAeAdByKk_luHAeAW+DAPA8A6CT|34g!KI+JAAAAnb´~3}M/B´I`EtAt~~$~y|d+PAfA~~4FfAhB]KT|^)HAfAhB9~At&C/Vk_:vtWhB]KT|^)tWk_CtPAA´pF3r+>F´tW~~F´PA!A`~1Kk_BtHAeA`~DAtWdByKk_BtHAeAdBd~At6CJV+>D´HAeAdBd~z_/CJV+>D´HAeAdBd~z_BttW+>D´HAeAdBd~z_BtHA[|BtHAeAdB4}9W´4HA2}BtHAeAdByK[9C´{>!(+7iV+>D´HAeAdByKMcJCy:d~~FPA8A6CJV+>4FSquWDAtWdByKk_BtHAA´BtHA´s6CJV+>D´HAeA`~DAtWdByKk_BtHAeAdBd~At6CJV+>D´HAeAdBd~z_/CJV+>D´HAeAdBd~z_BttW+>D´HAeAdBd~z_BtHA,`BtHAeAdBd~_hBtd*TVFnAAAA#T]~j_"
Data "tWB´d+PAB´`~k~I`5yfA!A`~WL!A&C/Vk_:vPA!A&Cd~B´pF3r+>4FAt&C/Vk_:vAt+>F´PAA´pF3r+>F´tW~~F´PA!A`~1Kk_BtHAeA`~DAtWdByKk_BtHAeAdBd~At6CJV+>D´HAeAdBd~z_/CJV+>D´HAeAdBd~z_BttW+>D´HAeAdBd~z_BtHAA´BtHAeAdBd~z_BtHAeA`~DAPA8A=~7}K?D´HAeA`~DAPA8A=~MV+>D´HAeA`~DAPA~~ZFSqv(DAPA8A=~HA´s6CJV+>D´HAeAdBd~At6CJV+>D´HAeAdBd~z_/CJV+>D´HAeAdBd~z_BttW+>D´HAeAdBd~z_BtHAA´BtHAeAdBd~z_BtHAeAW+DAPA8A=~/>fAQfOZ@EAAAA&6A´c~0[B´y|w(tWA´>~,}P@J´PAA´:vPA!A&Cd~(_CtPA!A`~WL!A&Cd~(_:vPA!A`~g~#A&C/Vk_:vPA!A&CN/K?T!9GhB]K6yBt0((_CttW+>D´HAeAdByKk_BtHAA´BtHAeAdByKk_BtHAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA2WBAEtVA4}3Is8AA#JA"

__Usbmp:
Data 5,1,21366,3440,"Base91"
Data "AyM7e2rTH´AAbBVxWcC´´V@Q7DVxAAOawAwA4M:)oIVR|LAA3JVB4}*>rc$$c~9APRHt4rJA>ODHx;)m*hOM(@6ygQUEaEzn;vhH!+;V2(FAv40W%w8EEk%lZE`[6yAbeAB´}~AtjB=~,}+>WL#A~~`KT|/C/Vk_:vPA!A&Cd~(_CtAt+>4FfAhB]KT|^)HAfAp~DAkWqCILT|v(HARAks{>~CC*HAfAhB~FN/8BPLN`CtPA!A9Bd~(_/CJV+>D´HAeA`~zKk_BttW+>D´HAeA`~zKk_BtHAA´BtHAeA`~zKk_BtHAeA`~DAPA~~ZFSqv(DAPA8A=~HA´s6CJV+>D´HAeAdBd~At6CJV+>D´HAeAdBd~z_B´MV+>D´HAeAdByKk_lutW+>D´HAeAdByKXLlu)hy[D´HAeAdByKk_qPAAn(}=HAeAdByKk_BtHAZ(Bt_*_xhFSqv(DAPA5~D´HAWAl/B´eAdByKk_/CJV+>D´WL!A6CJV+>D´tW+>D´WL8A6CJV+>D´HAA´BtWL8A6CJV+>D´HAeA,(4FAAbfl*w`GAAABtL}B´A´O#At+CU)34u/PA1ASO6(^k~{PA1AlJPL)nG*PAfA<APDeWY@F´At+>F´JAA´pF3r+>4FfA~~F´PAA´pF3r+>F´tWhB9~fAhB9~i|v(HAAt&C/Vk_4F4}q?D´HAeAdByKk_BtB´K?D´HAeAdByKk_BtWL~~D´HAeAdByKk_C´3F´sN4HAeAdByKk_Bt)hBA8s8V+>D´HAeAdByKN/BtB´D_D´HAeAdByKk_C´g_A´((HAeAdByKk_BtWLA´9~PA8A6CJV+>D´HA´s6C4}#A6CJV+>D´HA´s6CJV+>4FSqv(DAPA~~ZFSqv(DAAtv(DAPA~~ZFSqv(DAPA"
Data "~~D´HA´s6CJV+>D´HAeA`~DAtWdByKk_BtHAeAdBd~At6CJV+>D´HAeAdBd~z_G7JV+>D´HAeAdBd~/yr8H,)y+moICAC´;@YLX´Kvv?OAJA7MbV4}B´)~y|d+PAB´xFd~I`CtAt+>F´tWhB]KT|v(WL!A`~HAAt&C/Vk_CttWhB]KT|/Ch=(_{;PA!AV~ZW6yBAu|w`CtLA%`MvsWW:<z#AmCZ*OO)U4YD´{syADAJNv(T|^)DAPAYAI}nG´>[B@Ay(YDaamucsVPEU4}K?D´HA]sAAnDN6C5Uqf&6@0QVxC8*B´ch=f4w@*9*XiB(FgtWL8A6C^X=~gA/lD(NJR7yBRE<@2_RLEA?=#;1W)DX7Qty?n_lusV+>BAVL>OlH*QP7UM,~|7AYG:@{BAOWaGy/!(4FeAdBT|$tAQ3W´&[d1EClpZD´4u9[dzgt7vX(k{6F$rd~z_BtHA]sAgCX=vjF.!&F7L@WaB(W:VC6yDk)iB0K_32W}?/CPA8AN~gZsH´F@u>dXeCPHe&toG_E>E>*1vCA{t9X>]4~AA]KZFu~q?D´HA}s}7meUjLFLO~diZBArHf5PhHa8dP&n5e+rsvDlHLtWL8A6Ck_*u~Bi$Lc,O%[?85gp~%´+CeWsFSqv(DADA*9Kc(%CX!hUA_svDv(wQUW+>D´HAGAwoiELNBPy}UAV7.J,{OhsQrH}L]KGupB(7mF$$dBd~pC!wMc^5L?0z)k2F!´~(g#oG:[RLO&6]jW6:H}eAc_DA`~Psg~/M^2RLrL%´W;l]/CPA8A=~+,LwuQ;>}0e]R´(chctH(}T|I@/CPA8A=~@JibaG)w:C8LCgrMv(4ZNitF)kAMvXaB&C/`)5T|T)DAPA~~)_~|+Pzd*DgADHhJ]dw(KA´tB8dX"
Data "t45I,7%Xfi:&X7pTTBoAGaoUXL6iAAoX5dl8$y[t@uWaOcc4s02DgcX7kSE?l´Oc`[PAwH7Db#!FSXDai|Wu`X9_Z}l~%AFh9r%A;v.Tiu<s]CK8a4k8*B+N|BWK[donHB>Jj*It´WNEociuFHT|cMB´AAL?0z<_OVe6wG%md4gggTbfhgCFfy_KnX5(a|cZ7PG5<vnhAM~BjOjvXXc@9ESHhL<4c7{_ri7}FwcA]W[1lZR5gIby<_D85L?GG_%|Z*u7ImpF[hUGdAMON<AY((QGBw5csBAGP5Ptn4^XvWAYeS|V5FAAbnC5PAuAkc+J8b1NcLVp:7zDpl~dq2gzt7G$:y´KHr]S{6u_:,hBoI@Q~iOp5j~CsVrVd?su?|5*2|:v)~#AM6yT~,FAlBxakB?9cLd~(_:v`Nt|}`Pm>(8~(_:v2kqx3WmVVuAr,>`´(CWO=~#}$t{a{dOO:1XLEuT+Pob@Etwt7,ah;vtW~~R@B!6ud<W>[FX)(Wy@/}V|vD?{:vtW|,jGIn´W+`QHprTwKWO{c|T)DA5qv(4Fxdi´GaZcd/22&AFw:yy4)_CMGtj)`O>~MV+>D´WLv(P{F+VHoAo4JJoA/uU@t]MN:B.A}_luHAeA`~gzQ´5d~w2c>F4%a]F1XtWzpAxQ&S9~d{BtlW*h`e{NWsh)inG´1?nSAdA<=>=pPA8A6C5F+>LcU2p*_x]KU)27z`RqPA?|BA)>M?nT.AvD8Za:t[mAtWhByKv(cZreE(uZUO´d]xgcGu´7Z7s´K@b#[7/B]´J6W}P@DAPA~~9c#xy0@75LW8Ml>&6`NcZ,ULel/FzuA´aFT|kBd~(_d+nWV^#~SH_ahB&_luHAeA1~Z4bLbynzlDg!54pbBA7ROU,zPXLt@uJDL´?("
Data "V@_~Zqv(DApWcE$[QHWc4}S,f|4wVGahGL]qB~K?D´HWBtnI*w3j{^yBXqB~[Ks00__/4FeAdBT|n4}*;2E´d+R=(N%´L,~~ZFT|kB^|Qts54>G>:6b)!($(?QgtWL8A6C4}fgKIIoD34[+Bcr|HD?&yH7&Acay|3}DAPA~~T|yPF[KGSeM´AARcDe8MYYN/(dRAM´F,U?zGn_~w3r:CAYLoXL(´HBY4@v_0.tvD|O?Ye~5L$wGGk))F[QVZ4D!A*Bs1YBEk8}kPAG8P$wSM2cQ4NZ!WSHH71?MVWccsGMEDJ´FNbZ5LcLKy6uwch1@u(5pBGttf9FJimWL/yCqC*O.okMN?EX$Te+EYFoCB*BJtA@DAMc6yAt)oQL,7Kznt@etVAA/5hs^XyZ!W´RS)tW+}Hu)yrLeCjOlBiW5F0TGH~~tC/Vzv_E:hMM´]7_cAdZ´~;.UR<u´A}O(XIAA´=~HAFh1Q|R?(+BAPax:7?B`L,B^r*B29*X(Ctn2_5}q?4F?C&qP8@Wo7o2sRs@VO2W_?#Klc|WlV?~i|lu4o+s|*dJp8V[FY>(1M@Vm!tW~~+B*yuO+(WfC.xTdX0@WV=WV)%K5Q3u`>4FAte+nMI$mtl2.TbzelU|*hh]AQQZqE7LT´VvPwfABBGu/I+6mMNFpzZ8%X|7yDWu%XS5pz()&SC8gK5((CY4l#/lvH(H1|v(FAxOw7]7n~~7yIcL6@x7&4U)PO@A)C(F+=LtmLC4q+C´XDQW~i5y~5srA~f4$´WL8A6C/`@~C´F|z(VW=79W)cRL}.WL8A6C/`=WQC{t)&LyAxXqmHDa@B{OB*czs{luHAeA`~`)HGD,SATHK8s;>(Pc]s:+SEuC!$]~K?D´HA´s=~;0[&OGJ|9ke]yn;M&CJ/"
Data "/vtWdByKk_kB+JX>:B[/KYw3tH}y&gWa0!uFBtV^2|luHAeAl/4F.ot/AYDv;F{[8VVHPj6Oh*f44ypF1[[C0_luHAeA`~BAacgf.gNn7;wIID|YP{%Cdz3D=~MV+>D´WLu>9[M7o+czEo<5*J{V4}I7wOj~z_BtHA´sN~@Vp>FZc)_/ULEN7CJV+>4FXLv($xyy!C:C#)$´tWj_D´HA`~(r(=I`8Z|sd1!D_K=~$V+>D´s(sLJp[<F~KVa@vqnHYM~Fk+pt1&vBuvnZAH$´B´9A6Ck_0RXJ1T*nbX^o]´XXc@r}k_hS&{nz!(4FeAdBT|.11r*em=n1p)^c>Qnyq>J*=>/CPA8Ad~A*4+dnU)Dl%W!Z1vx(LwrLI}g/OP?Aw{4FeAdBu{n4qB?YxVIC4uFAAAGOVp:7]KCAOAH74:W9xWaI)gP8WcYL(W,ChBHr]S(DAAzkD5EtI7BP`d^QFA6y{t~d;C;FdozdK&[dy9FHHOk_(´]Q(F)D3r5[R´ouNzRdGOgYQDXLGdGHHTbzL<`PlB!}09=&}$nvkR<AAA´XRXC´TEd+DA0wwA=~O^+>WL7A=hd~fA"

__Jabmp:
Data 4,1,21366,2912,"Base91"
Data "D0M7e2rTH´AAbBVxWcC´´V@Q7DVxAAOawAwA4M:)oIVR|LkAMcLAg~tW(HBIv(M8yW:r5AC´aLSAuWLEC´GBKCC´%wCA9p/`CAkU6A+>9FmAN/;jXL)BO25IAA^BfHDALiK7vEDHs_<xiAGaHtEHfO4ueUIcUQXje4(1[!kU$}BY@C~~DAHA.M3zVU:}BwDF(>;1gAy61vocbZzD/CEW.};C{Jo~.QS:@|2yrnJuBLj|v([3@yqCkW_U7FEB)Cb#HoS{h#$tBGY|_)HAXAu6e!#>]X4kjBsFgg/v?3^sR=?&/`D´b>$)lvlWY)M%qv+CH7V!Q4nWB52$EB)CPjFul$HthL4mx(nCOtn1pFuWEOXb,ygC`BiG1e|e@EiF$$fByK[9kuk&=W._$FnWAdQwNLdV+>D´HA{}+BH7dq.C?nMA!Qyqv(DACrAA,CR`ztgY&s~Fr8]S^3frv(DAPA{]2C@Q8BdF&s´y!{<>5WPA_}D´HAos}4T|2L6CiW`~8Fft6CJV+>D´vhZ~IoO7M~Gh>K;v>L9A6CJVY4!?,$(`@`z_H0;,,C29PA8A6CuWEBZQ.qb<>//s´y?Tht]Kqqv(DA#sBt#.AGqFcK5~wQyqUS_Kk_BtHA0Wl9rYZV?/tWtZ~=~`WxHAm}Btx&W~J`ZUl~8f9Nm>7VL?D´HA0s%9jwQ[`[nW´C$V/YDc9V+>D´NlbM<nYPB=CF@s´yJ&%^,kPA8A]6´nc^/CEA0},k9WdByKBtSx_rc^/C!TBt}Bku8CJV+>MnWV|~BAAG{x´WAMAGNY0Ak)!Z/>I´,WN)xGMc!A!G@Q^t´X`=Z1#:iNZT;JMcpJ>:{BbU2yAMfmOC[vPB0Atg/>eW&<F`3Qs+^XOt*ZvM;06:hW{k)X$5GT6(wL{Zt?"
Data "J</`NOiGA+JHPCJB0DeHk~F~´F?UH0VntJPD#{&I`Ezy]XP?HqMOahykB+xVkuRL?A}zkWai])(s;~~F`TftCp^|+Xvhi@nBpY;LF{.Fk#UttD&#<B4´!Gr+;43FeDm}RQ&SyFwIY4xv{V7v=~&n4hcs*heWQ}1FWLuioe!Ld`8FAsd0o~RXWvt>{L7F$tRA^XO~I@WL$K6(9W/`9Sb]!`WL)A=08FRTHqMVP@wm_9F/{b´s6C3r2[5WPAjLCL|}]le~z_BtM5BM^d_~Da(s_}{x:H~~ZFSqTXkBuWYIOmz)dyYV|~zKk_:Az3k|GHMLv,IBv~~(4~z_Bt>LNA|;_h}}2et{+({b´s6CoI+>X!rr_)j_F}15aH~~ZFT|$<y/#t´V>3[/yhVO`~zK6yBt`~u3gFg42<Z>*b=~MV+>cL^ev(xhJ`Q#i39A=~MV+>Yn:´Q@;C=p/0hW7~=t^}K?r´GAl`T^_h[hX(YVlPe~z_luHAY<kEYt8s^XJ}2<DAtW`~zKMcG7{i]GnSKsx}zKk_luhW+>cLx´Btrhf}2<DA&|T)DA&XSAmu3WYAhFTU´GzK[9kBO+dXsI:CBYDAFtvW>EuW_$T/tMs1HAv(PNktCwg~>WJBeGZ8CF|yg:[KaS.L6}.YheMmZV6dI}mHl+kQfBO2ydlJ9_vGt4/vAMhnVv?CoB3t:1:0&s/~tZmKTXFA8k/G[*Uqg0c]^k?G+WjaEA,y=d)_At.kE´{T_iEYfont:6.Yf{´vx**EBpIc+^_x=~4dv(RFj|t:WL!Ab3BAx@ku?&0_/CMAK:s~kZQE!~i|W@OL!A`~wpCHXC0k0}9~)[uWB9K?pyn}A´^K[9^)OLA´6C4}JC|3a|2<DAPA~~ZFSqv(*>~`kuHAeA`~zKk_Bt"
Data "M5´~fkPA8A=~MV+>D´(t,Ci~x|I@DAtW`~zKk_Bt>L´~hWPA8A=~MV+>BAz?[E(}:F<2yKk_luWL8AYI}}c~^3Wrv(DAtWdByKk_J7B´?@D´HA´s6CJV+>8T|}}~DAPA~~ZFSqv(X4M{*C4}#A=~MV+>D´e>P|lNyqU)OLk_luHAeA4A)_IVxFv~fAdBd~z_BtHA{}%QpV+>4FT|T)DAPAP|lFaqv(DA<~T)DAPAAA0_JK+CoFT|kBd~z_BtHA1raI[V+>D´5}fABt6+{c2K:CBYDA@vQBmxB`6*DAAAAA$fdwYu^kvuwv_vx]6PJo8E#6uW!P=O082:uDTBMT;BxFSY<!@D#14ynK;cxIOW9p^XzB=*tWeAFxO#/d?L/VAA57XTx4LIB´VB=JSXF)PAuW<8RU/W|~afv(}JmR9LIGjBC´6gT]U)j}:vCADq&G?´{LC´YQ5}P/WLwAf(&TZD_$RW*huWqv~~TQY4zNVWl9eWDAWCaQX|m{6HA´$AU)A%Vx.}lAyK#B4AUn9}$tvho4MK!sGA0cCW)_/CJAy>Y1Rc=|+hI}W@WL[|TAs8/$PLk´&@q+T~q?4F0rPSq5fAP/M5B´6C^XB&>B<[tw6Fswgy`G~~m>PAW]H]a|´ZWt^`:$KHP|/CPA{]q+xq$t6F?`k#e(´>/CPA?|.Bp1)`|QDX78e{[>BcY|T)DA(U.~AAXr/v7F=DDcR~K?D´B´u@fkPAC´|b!&A?/CPA´{MnBA´OfkPAvDgY&X$>]D´s6CJVND$6dWNB:Co{jST&B?/CPAp*^M,2.`5KuWlBeL+C&~ZquWk=/y~.oVAAwA>tA´k#HA´s1h(sc^D´HAuwl(jMA´E_r_I@(seA1BL79^(5eL~~ay^cv(y>z_BtNGL?,kXY}~2R"
Data "vKkCa4V}}NPA,Dx1WY.[nE´sl[i3|]lFSqv(Zluw|N7}B´^31!J/0FeAbX/~J}Muk_2L8!;FpArP*kuWov6y%H5FD,MvHRU_BA6y#B1d04oxf!xFAAh7v,ZYzN!h9JAo(´SiU}Et*PgiRJPA[MgW)n2eJkn`EtO/aO;xO?9[%KbZj4p)jBRtho4uH(</tvBfM^%spB.0UN(^3yw$1<)d(|jA]WQ´s}r.=oqkfm#Av(kExE)S]l^)~Ed7J/vQ@Q#<,u!V^K`sI@!(b~:]x´^Bi{R&u!5F|}rC1d#@;B=<{LhbB<L|:7@E.(<O153F3p~G4;b~Dn:´e´/*TL&__<~sz[F´oj4R2F,}X+RWN/mL;P!N?[ynl<5K#A[F<<h´G!SL4]J5OL8A6Cxd9ABtM5y5/Ce_Rt8rc|Q#HAeAdB*hvzuCA<1m/CYVW<{beAdByKk_s|N&RwpZjW,;ORW{,tNW+>D´HAuw.a%/2L,3]|i_7Kk_BtHA<AKt8FSwT~QL{]w0dWdByKk_Bt:LK~,kjW$w0FT|2yHAeAg.DAqv)AE_hW?;wLU{S|QV+>D´HAuwGQZ*K?fkAtc+DAPA8A|bhp2Eu´Q=6$M_Zqv(DAPA;LVz8WPL}Asp2}zKk_BtHAsw^5x}F?/Cv+];;Kk_BtHAP~AA,y´st~.h?|cFSqkByKk_AA04#`lui39AI4HAeAdByK+>k#VLV5WW(UgByKk_BtHA/BR5V~´~lherv(DAPA8A6C5F[hcLoW+G´WAGlEqAECO2´T.´AAuWo4VE~(]](kK7yti~9|MLC´8MQRn~~h=h#A&$/zdG(*0sAA?(O5$tSd´}SxG´Ym[|LIQ9oAH´6KkB"

__Trbmp:
Data 4,1,21366,2597,"Base91"
Data ",xM7e2rTH´AAbBVxWcC´´V@Q7DVxAAOawAwA4M:)oIVR|LAA$4Io/`X4fA4}B´h´ARZVIASt.hc~+CVB2A*hK´e´[PLKC´&8`JZlIgHA1[s>ItGZgFC´AGYF_kd[rI*%K92(V`uWb?B´/>R´fAjBHL4}+>J´fAA´CtPA!A&C/Vk_CtPA!A`~HAfAhB]KT|v(HAfAhB9~fAhB]KT|v(HAfAhB]KT|/C/Vk_CtPA!A&CyKk_BttW+>D´HAeAdByKk_BtHAA´BtHAeAdByKk_BtHAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAKAT3kYjn/AFF4CBtVEn?<BfAhBUEp17´|jZIC´EY´|`)HAfAoAXLI2987.RDC´7_HTu<´Vw_CtPAMA_)ixQ$k4´XA8wu*w#TK&pZ+$cJH?F´PAGAhtehBM.uQArc[QxdAPGMaGN_*W!A&Ce+DBQi5wc@]dVAXL2cht`xfE9{XuPA!AAASq/X)dGWy{(nlBwW?JY!.C=Vk_BA1[&{*/>,1L@CyAbX9*D)L|DAPA8A6CQ@6MY?]vS)]]=W>vYw8_;CPA8AA@HAeAwAqClzg|2[JiX7o(EAAw,ZC*gWFueByKk_BtHAKAPzhFgs^|It@Xe]K6´FLvPfIG&d/thsbr,(DAPA8A6CMc/idQAGT)TLSq1:mWB_OA:I*8NMBz>+;s"
Data "Z`BtHAeAdBi6kR1(vE.A´C|XAYLkV26(q!uocM=ZDY8};Bs:yKk_BtHAeA9[/M(Ty57d2[lG64m4=3=hLLH!*[OBxqv(DAPA8Ak_O7*MmM}r.}A5ui5s#I+xbM&s_)DAPA8A6CBt$t´/=I:E)Q+_GLXLU.INCXeByKk_BtHAjno.mw#^8yGD%t8k}l/rXLV/dFiqv(DAPA8A&arw{AI4nWF5fyh|vq~VJ`BtHAeAdB6yXr7IoWGaDT~S;F+<g}P+JV+>D´HAaA1xaaLBhunWc)Zn?Fv(´]c_A!_B8A6CJVY4pK8spNULy@W_8dFB0v!D%`DAPA8A5*u8%MYW>sV%K>{i:CNX)OZFSqv(TL[9C´mB´r1|R&{LD´[ae]D´HAeAdB$$QPBtCA.M~7iYHaOeAAnXK$1R´]FAdL_C;bk_@yAe!iU´$AMO4!#(R`/Z[Xjt+Od|e7BwZbbjhvM`jEPPA4d~cX;*MiMfpz~l[yz|<YmW:I10@Y;YE´daiEn(!~b&wiHRyF#Dv(ZBxA!TTLl<Y&4iBxz,=Wg|2/^|]CiG64iO|)%LdMC:+[w&)BULnWT`#EgWzDviUJGCD:m}EBNAnTj/vwG7QO{|C)PLLNLzk0dtXjxH3(HA^&BtUan~XO:rG71F8y<C/[F*pOp4L^zcaA[hON1|>C%5[hj_G0{LLN~RPJ)ujGbu|rv(hD%~TH=Cq`Du:I.A9m|>(5ucODO|e,{Lg(})`}tcBzQOh~<=8Tp.a|u?~y|;LEl~k_ZDv(´LbsO|FuJCV3P%Km5>?C~1l)dG;vnZ@)O]dA@Y.{_h{~zKC´=Ez$jG`uYAOie_cV*hmFe+$t3^s/F|{r>(E<SHuZX;f#/0kx8AI4HA@s)_*+q?eV4&bf_9VQCw´Kl~fGnIgBcs"
Data "eA1~6*iH:vvowAcM,|chvFXe$}J>D|BtHA}st5oW~~UE|;DwlZgf/}f^´OeF*qv(DAAt`~x{fA$}@/oo<}!rU[D´HA{}5yAt8ALfLGsE8eAW^&TL]WsyKV+>D´u(l~6*#|&,Tcj;´yh44k9sO(fByKk_X4B´8A;?t2#>E|]|6<DAPA=~,~Grv(+o.oG7y&|?D´HAA´o|Zqh])hPAcEX|c5yryKk_/C1[Q93FAtgBk_HI~2n4F`D´HAA.^|4d4w[~fghBa]zk7WCedlTW;$dByKBtkBO;1!{cUWvryKuWcZ[yfOK5#Hn+p6fAdBeGBtM}zU#?X4PA5~+X&TOGT;UQm01W8A6CH7(U}`m7V,EteA}}jY3Y+T{nwu[~Tqv(DAAA*h|!iAMAFB&dBAX7ptAPAeGUjAFK5F{X&5]AU´uC7Re?aZAkBAmBBeBA|L+>CP&Fm@tG<uE*DHpnsM{};WvHuJ%h;OzjVXCpEO7*+L0jIAaPMH|rV||@$4Yc.3ezH;OO)Ad5kX$}*Gwwvub(7+wAKCbF*h<sLNq`sw&a=Nc~%A0AvD@9RjTaADJ*A}QFEAnj=FXrb|}d64^CCTA`E/EA2CwW>~;7{chTG/KAXL:Q{VBtoIYa$i%hlB*Z]0_{9u$rAAy(Cv.}qH?ya&9QTXl+gNhBeGfDz:<)ez7yJO%_aDfASCoM%tv|=OOiV,y/p}&s{|BtEA4Dz:mWDN*nz.ewDn^~o:HA?<d5iah~4naa{u@_7(6tnew:1FMcKZJMjQ/CXLlX/[]vWkBLe+lFMYeX/CYAui4Cz(>(9R$qP,DAPA8A*xHAlhr##(p~kHvGp4hU_ocM#wr|2FAtv(DAPA8A.Id*dZ´QvW?(´+R^lU>PCYTWExeByKk_BtHAP?|L;KIAk|sB"
Data "44ETp%Et*h.>JtIJIbUMkIc?EdeAdByKk_AA]lvL&woWG´~Fz2Ab^XBAtxy>AG3udm|}8CJV+>D´HAVv|(h+tc3FlBuuAYa6|vs.#zR!W7IYns{r8CJV+>D´HA}i0qRt=t3FRD7utBMc|Oc|9@GnPA8A6CJVC´VEyq>O:C?stBnBgGBwV?eX.0bseByKk_BtHAL1mukw|XzFBWxV+M.QU:(s8A6CJV+>D´fitM4?Q$V~|).OvGg~Z~ZFSqv(DAPA2´1ReJ+MQO^suuDf#|kuYV+>D´HAeA{G=,gO7`Ki>´´C´>a^,CPA8AO+HAeAdBY4#z<er´xX}ytZh6G1avgByKk_6CJV+>BACglEDwEFG^dsf2l5VW8A6CJV8A6CJVBtAAYA8WPo;1FA2!A~p?D´HA&_BtHAeA@AFBB2B.~&m_BtHAeAdBKC@Q{eBA`~wA[BXL3A"


Sub CreateFile(sFilename as String, sBase91 as String, iLines As Ulong, bCompressed As Ulong, iFileSize As Ulong, iCompressedSize As Ulong)
	Dim As Ulong l 
	Dim As Ubyte Ptr aBinary = Base91Decode(sBase91, l)
	Dim As Boolean bError = False
	If bCompressed Then 
		If iCompressedSize <> l Then bError = TRUE
	Else
		If iFileSize <> l Then bError = TRUE
	Endif
	If bError = TRUE Then 
		? "Something went wrong"
		End
	End If
	
	Dim As Long hFile = Freefile()
	Open Curdir & "\" & sFilename For Binary Access Write As #hFile

	If bCompressed Then
        Dim as UByte Ptr aBinaryC = _WinAPI_LZNTDecompress(aBinary, iFileSize, iCompressedSize)
        Put #hFile, 0, aBinaryC[0], iFileSize
        Close #hFile
        Deallocate (aBinaryC)
    Else
        Put #hFile, 0, aBinary[0], iFileSize
        Close #hFile
	Endif
    aBinary = 0
End Sub

Sub ExtractDe()
    Dim As String sBaseType
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Restore __Debmp:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
    Dim As String sBase91, aB91(1)
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next    
    CreateFile("De.bmp", sBase91, iLines, bCompressed, iFileSize, iCompressedSize)
End Sub

Sub ExtractGb()
    Dim As String sBaseType
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Restore __Gbbmp:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
    Dim As String sBase91, aB91(1)
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next    
    CreateFile("Gb.bmp", sBase91, iLines, bCompressed, iFileSize, iCompressedSize)
End Sub

Sub ExtractGr()
    Dim As String sBaseType
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Restore __Grbmp:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
    Dim As String sBase91, aB91(1)
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next    
    CreateFile("Gr.bmp", sBase91, iLines, bCompressed, iFileSize, iCompressedSize)
End Sub

Sub ExtractJa()
    Dim As String sBaseType
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Restore __Jabmp:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
    Dim As String sBase91, aB91(1)
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next    
    CreateFile("Ja.bmp", sBase91, iLines, bCompressed, iFileSize, iCompressedSize)
End Sub

Sub ExtractTr()
    Dim As String sBaseType
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Restore __Trbmp:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
    Dim As String sBase91, aB91(1)
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next    
    CreateFile("Tr.bmp", sBase91, iLines, bCompressed, iFileSize, iCompressedSize)
End Sub

Sub ExtractUs()
    Dim As String sBaseType
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Restore __Usbmp:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
    Dim As String sBase91, aB91(1)
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next    
    CreateFile("Us.bmp", sBase91, iLines, bCompressed, iFileSize, iCompressedSize)
End Sub

Function Base91Decode(sString As String, Byref iBase91Len As Ulong) As Ubyte Ptr
   Dim As String sB91, sDecoded 
   sB91 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~´" '´ instead of "
   Dim As Long i, n = 0, c, b = 0, v = -1

   Dim aChr(0 To Len(sString) - 1) As String
   For i = 0 To Ubound(aChr)             
      aChr(i) = Mid(sString, i + 1, 1)
   Next
   
   For i = 0 To Ubound(aChr)
      c = Instr(sB91, aChr(i)) - 1
      If v < 0 Then
         v = c
      Else
         v += c * 91
         b = b Or (v Shl n)
         n += 13 + (((v And 8191) <= 88) * -1)
         Do Until  (n > 7)=0
            sDecoded &= Chr(b And 255)
            b = b Shr 8
            n -= 8
         Loop
         v = -1
      Endif
    Next
    If (v + 1) Then 
        sDecoded &= Chr((b Or (v Shl n)) And 255) 
    End If
    iBase91Len = Len(sDecoded)
       
    'workaround for multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To iBase91Len - 1)
    Redim aReturn(0 To iBase91Len - 1) As Ubyte
      
    For i = 0 To iBase91Len - 1 'convert result String To ascii code values
        aReturn(i) = Asc(sDecoded, i + 1)
    Next
    Return @aReturn(0) 'Return Pointer To the array
End Function

Function _WinAPI_LZNTDecompress(aBinary As Ubyte Ptr, iFileSize As Ulong, iCompressedSize As Ulong) As Ubyte Ptr
   #Define COMPRESSION_FORMAT_LZNT1 2
   
   Dim As Any Ptr hLib = Dylibload("Ntdll.dll")
   Dim pRtlDecompressBuffer As Function _
                (Byval CompressionFormat As Ushort, _
                 Byval UncompressedBuffer As Ubyte Ptr, _
                 Byval UncompressedBufferSize As Ulong, _
                 Byval CompressedBuffer As Ubyte Ptr, _
                 Byval CompressedBufferSize As Ulong, _
                 Byval FinalUncompressedSize As Ulong Ptr) As Ulong
   pRtlDecompressBuffer = Dylibsymbol(hLib, "RtlDecompressBuffer") 'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbuffer
  
   Dim As Ubyte Ptr pDecompress = Allocate(iFileSize)
   Dim As Ulong iUSize
   Dim As Ulong iReturn = pRtlDecompressBuffer(COMPRESSION_FORMAT_LZNT1, _
                                    pDecompress, _
                                    iFileSize, _
                                    aBinary, _
                                    iCompressedSize, _
                                    @iUSize)
   Dylibfree(hLib)
   Return pDecompress
End Function
If you want to see it with larger images visit pastebin.com



I assume that this code will not run with other os than windows because of the decompress function in Ntdll.dll which is required to uncompress and save the bitmaps to disk.

¯\_(ツ)_/¯

Update1: added zoom option. Use mouse wheel to zoom in/out
Update2: small modification in Trapezoid sub.
Last edited by UEZ on Feb 24, 2019 17:09, edited 3 times in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Rotating Cube with textures build 2019-02-22

Post by dodicat »

Very nice UEZ.
Turkey is the one I have not visited.
I now have six flags on my desktop, but they look OK, so I'll leave them there.
Here is similar, but for the gambler, not the tourist.

Code: Select all

Const pi=4*Atn(1)

Function Filter(Byref tim As Ulong Pointer,_
    Byval rad As Single,_
    Byval destroy As Integer=1,_
    Byval fade As Integer=0) As Ulong Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Integer x,y
        As Ulong col
    End Type
    #macro _ppoint(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As Integer=-ymin To ymax
        For x1 As Integer=-xmin To xmax
            inc=inc+1 
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Ulong Pointer im=Imagecreate(_x,_y)
    Dim As Integer pitch
    Dim  As Any Pointer row
    Dim As Ulong Pointer pixel
    Dim As Ulong col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As Integer=0 To (_y)-1
        For x As Integer=0 To (_x)-1
            _ppoint(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Ulong averagecolour
    Dim As Integer ar,ag,ab
    Dim As Integer xmin,xmax,ymin,ymax,inc
    Imageinfo im,,,,pitch,row
    For y As Integer=0 To _y-1
        For x As Integer=0 To _x-1  
            average()
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour) 
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function

Type v3
    As Single x,y,z
    As Ulong c
End Type

Type _float
    As Single x,y,z
End Type

Type sincos 'FLOATS for angles
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As sincos
End Type

Function distance(p1 As v3,p2 As v3) As Single
    Return Sqr((p1.x-p2.x)^2 + (p1.y-p2.y)^2)
End Function

Function map(a As Single,b As Single,x As Single,c As Single,d As Single) As Single
    Return ((d)-(c))*((x)-(a))/((b)-(a))+(c)
End Function

Function dot(v1 As v3,v2 As v3) As Single 
    Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y + v1.z*v1.z)
    Dim As Single d2=Sqr(v2.x*v2.x + v2.y*v2.y + v2.z*v2.z)
    Dim As Single v1x=v1.x/d1,v1y=v1.y/d1,v1z=v1.z/d1 'normalize
    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
    Return v1x*v2x+v1y*v2y+v1z*v2z  'dot product
End Function

Function sincos.construct(x As Single,y As Single,z As Single) As sincos
    Return   Type <sincos>(Sin(x),Sin(y),Sin(z), _
    Cos(x),Cos(y),Cos(z))
End Function
Dim Shared As v3 eyepoint

Sub load(im As Any Ptr,w() As V3,Byref ctr As V3,T As Long)
    Dim As Ulong c,bc=Rgb(255,0,255)
    Dim As Integer pitch
    Dim As Any Ptr row
    Dim As Ulong Ptr pixel
    Dim As Integer ddx,ddy,count
    Imageinfo im,ddx,ddy,,pitch,row
    For y As Long=0 To ddy-1
        For x As Long=0 To ddx-1
            pixel=row+pitch*(y)+(x) Shl 2
            (c)=*pixel 
            count+=1
            Redim Preserve w(1 To count)
            Select Case As Const T
            Case 1 :w(count)=Type(x,y,0,c) 'front
            Case 2 :w(count)=Type(y,0,x,c)'top
            Case 3 :w(count)=Type(y,x,ddy,c)'back 
            Case 4 :w(count)=Type(x,ddy,y,c)'base
            Case 5 :w(count)=Type(ddx,y,x,c)'r side
            Case 6 :w(count)=Type(0,x,y,c)'l side
            End Select
            If x=ddx\2 Andalso y=ddy\2 Then ctr=w(count):ctr.c=count
        Next x
    Next y
End Sub

Function Rotate(c As V3,p As V3,a As sincos,scale As _float=Type<_float>(1,1,1)) As V3
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.c)
End Function 

Sub RotateImage(wa() As V3,angle As _float,Byref centroid As V3,ctr As V3,sc As Single=1.75,nflag As Long,n() As V3,flag As Byte)
    ' #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    Var s=sincos.construct(angle.x,angle.y,angle.z)
    Var g=Rotate(Type(0,0,0),n(nflag),s)
    Var dt=dot(g,Type(.5,1,0))
    Var cp=map(-1,1,dt,.2,1)
    Dim As Ubyte rd,gr,bl
    Dim  As Single dx,dy,dz,w
    Dim As Single SinAX=Sin(angle.x)
    Dim As Single SinAY=Sin(angle.y)
    Dim As Single SinAZ=Sin(angle.z)
    Dim As Single CosAX=Cos(angle.x)
    Dim As Single CosAY=Cos(angle.y)
    Dim As Single CosAZ=Cos(angle.z)
    Dim As V3 centre=Type(100,100,100) '=ctr'the centre of rotation (fulcrum)
    Dim As V3 result
    Dim As Single dp=.6*sc
    Dim As Ulong cc=Rgb(255,0,255)
    For z As Long=Lbound(wa) To Ubound(wa)
        dx=wa(z).x-centre.x
        dy=wa(z).y-centre.y
        dz=wa(z).z-centre.z
        Result.x=sc*((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
        result.y=sc*((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
        result.z=sc*((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z'-100
        If z=ctr.c Then  centroid=result:If flag=0 Then Exit Sub
        If flag Then
            'this bit is to add perspective ================
            w = 1 + (result.z/eyepoint.z)
            result.x = (result.x-eyepoint.x)/w+eyepoint.x +300
            result.y = (result.y-eyepoint.y)/w+eyepoint.y +200
            result.z = (result.z-eyepoint.z)/w+eyepoint.z
            rd= Cptr(Ubyte Ptr,@wa(z).c)[2] 
            gr= Cptr(Ubyte Ptr,@wa(z).c)[1] 'handle the shader
            bl= Cptr(Ubyte Ptr,@wa(z).c)[0]
            rd=cp*rd:gr=cp*gr:bl=cp*bl
            Line(result.x-dp,result.y-dp)-(result.x+dp,result.y+dp),Rgb(rd,gr,bl),bf
        End If
    Next z
End Sub

'sort by .z distance
Sub sort(array() As V3,painter() As Long)
    For p1 As Long  = 1 To Ubound(array,1) - 1
        For p2 As Long  = p1 + 1 To Ubound(array,1)  
            If array(p1).z<array(p2).z Then Swap painter(p1),painter(p2):Swap array(p1),array(p2)
        Next p2
    Next p1
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Sub setdice(i() As Any Ptr,size As Long) 'create images
    Type v
        As Long x,y
    End Type
    Dim As v p(1 To 7)
    Redim i(1 To 6)
    Dim As Long sz=size,dt=sz/12
    p(1)=Type(sz/4,sz/4)
    p(2)=Type(sz/4,sz/2)
    p(3)=Type(sz/4,3*sz/4)
    p(4)=Type(3*sz/4,sz/4)
    p(5)=Type(3*sz/4,sz/2)
    p(6)=Type(3*sz/4,3*sz/4)
    p(7)=Type(sz/2,sz/2)
    
    For n As Long=1 To 6
        i(n)=Imagecreate(sz,sz,Rgb(200,200,100))
        ''line i(n),(0,0)-(sz-1,sz-1),0,b
        Select Case n
        Case 1
            Circle i(1),(p(7).x,p(7).y),dt,0,,,,f
        Case 2
            Circle i(2),(p(1).x,p(1).y),dt,0,,,,f
            Circle i(2),(p(6).x,p(6).y),dt,0,,,,f
        Case 3
            Circle i(3),(p(1).x,p(1).y),dt,0,,,,f
            Circle i(3),(p(7).x,p(7).y),dt,0,,,,f
            Circle i(3),(p(6).x,p(6).y),dt,0,,,,f
        Case 4
            Circle i(4),(p(1).x,p(1).y),dt,0,,,,f 
            Circle i(4),(p(3).x,p(3).y),dt,0,,,,f 
            Circle i(4),(p(4).x,p(4).y),dt,0,,,,f 
            Circle i(4),(p(6).x,p(6).y),dt,0,,,,f 
        Case 5
            Circle i(5),(p(1).x,p(1).y),dt,0,,,,f 
            Circle i(5),(p(3).x,p(3).y),dt,0,,,,f 
            Circle i(5),(p(4).x,p(4).y),dt,0,,,,f 
            Circle i(5),(p(6).x,p(6).y),dt,0,,,,f 
            Circle i(5),(p(7).x,p(7).y),dt,0,,,,f 
        Case 6
            For z As Long=1 To 6
                Circle i(6),(p(z).x,p(z).y),dt,0,,,,f 
            Next z
        End Select
    Next
End Sub

Sub handlemouse(angle As _float,mx As Long,my As Long)
    Static As Integer dd=1000
    Var dx=map(0,dd,400-mx,0,.13)
    Var dy=map(0,dd,300-my,0,pi/2)
    angle.x+=dx+0  :If angle.x>=2*pi Then angle.x=0
    angle.y=dy
    If my=-1 Then my=300
    Var zz=300-my
    angle.z=pi/2+(map(-300,300,zz,-.2,.2))*(400-mx)/400   
End Sub


'============================ set up   ==========================================

Screen 19,32,2

Dim As Any Ptr image(),backdrop=Imagecreate(800,600)

For n As Long=0 To 800
    Line backdrop,(n,0)-(n,600),Rgb(n/4,255-n/4,n/40)
Next n

Dim As V3 norm(1 To 6)={(0,0,1),(0,1,0),(0,0,-1),(0,-1,0),(-1,0,0),(1,0,0)}

eyepoint=Type(100,100,800) 'behind image centres

setdice(image(),200)

For n As Long=1 To 6
    image(n)=filter(image(n),1)
Next

Redim As V3 w1(),w2(),w3(),w4(),w5(),w6()
Dim As V3 centroid(1 To 6),ctr(1 To 6)
load(image(1),w1(),ctr(1),1)''
load(image(2),w2(),ctr(2),2)
load(image(6),w3(),ctr(3),3)''
load(image(5),w4(),ctr(4),4)
load(image(4),w5(),ctr(5),5)
load(image(3),w6(),ctr(6),6)
'Dim As Single pi=4*Atn(1)
Var s=sincos.construct(0,pi/2,0)

#macro turn(w,k)

For n As Long=Lbound(w) To Ubound(w)
    w(n)=rotate(Type(k,k,0),w(n),s)
    w(n).x-=k
Next
#endmacro
'set initial aspect
turn(w1,200)
turn(w2,200)
turn(w3,200)
turn(w4,200)
turn(w5,200)
turn(w6,200)
turn(norm,0)

Dim As Single dx,dy,dz,dd=1000
Dim As _float angle
Dim As Long fps,mx,my
Dim As Long painter(1 To 6)
For n As Long=1 To 6:painter(n)=n:Next n
    
    angle.z=pi/2  'offset .z by 90 degrees 
    
    Screenset 1,0
    Do
        Getmouse mx,my
        handlemouse(angle,mx,my)
        'sort by .z to reset painter and centroids
        sort(centroid(),painter())
        
        Cls
        Put(0,0),backdrop,Pset
        Draw String(20,20), "framerate "&fps
        
        'draw in 3D order, cull hidden faces
        For n As Long=1 To 6
            Select Case As Const painter(n)
            Case 1:RotateImage(w1(),angle,centroid(1),ctr(1),,1,norm(),n>3)
            Case 2:RotateImage(w2(),angle,centroid(2),ctr(2),,2,norm(),n>3)
            Case 3:RotateImage(w3(),angle,centroid(3),ctr(3),,3,norm(),n>3)
            Case 4:RotateImage(w4(),angle,centroid(4),ctr(4),,4,norm(),n>3)
            Case 5:RotateImage(w5(),angle,centroid(5),ctr(5),,5,norm(),n>3)
            Case 6:RotateImage(w6(),angle,centroid(6),ctr(6),,6,norm(),n>3)
            End Select
        Next n
        
        Flip
        For n As Long=1 To 6:painter(n)=n:Next n 'reset the painter
            Sleep regulate(30,fps),1
        Loop Until Len(Inkey)
        Sleep
        For n As Long=1 To 6
            Imagedestroy image(n)
        Next n
        Imagedestroy backdrop
        
        
          
Your code runs well on 32 bits (especially -O3), but the best is -gen gas.
As usual 64 bits is jumpy here.
I shall post my Euroflag doodle again just before brexit with the flag suitably adjusted to celebrate the occasion.
Tested on the new 1.06 version.
Thank you.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Rotating Cube with textures build 2019-02-22

Post by UEZ »

As always, well done dodicat. Did you create it from scratch? You are usually so fast providing your example.

One question: where is the code for transformation of the image to the cube? I didn't find it yet. ^^ Can it handle small image on large objects without
perforation?

Well, on my system "-gen gcc -Wc -Ofast -fpmode FAST -fpu SSE" using x64 is the fast settings. Getting ~110 fps. With -gen gas x86 ~37 fps.

Turkey is a wonderful country but current government is not the best choice to make the country great (again).
Last edited by UEZ on Feb 22, 2019 14:47, edited 1 time in total.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Rotating Cube with textures build 2019-02-22

Post by Tourist Trap »

dodicat wrote: Here is similar, but for the gambler, not the tourist.
I also do gamble casually!

Both pretty examples this said.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Rotating Cube with textures build 2019-02-22

Post by BasicCoder2 »

Both very nice rotating cube demos.

The compression of images into the source code is interesting. UEZ do you have code to make the data statements from images?

I would see the compression and decompression of images as a separate Tips and Tricks example.

UEZ's cube rotates toward the mouse. Dodi's cube will tip up or down but only rotates around the vertical axis.

I recognise some of Dodi's functions but the maths is beyond me. Maybe someone with the knowledge can break the maths down as a tutorial?
Or even show how to use Dodi's functions with their own set of pixel points.

What would be a nice is if someone had the ability to write a program that could draw textured polygons in a walk through 3d world.

Or a walk through 3d world that uses pixels instead of polygons. That is, a 3d version of the pixel based objects I used in this example I used for the ambulance as a rotatable isometric object.
viewtopic.php?f=15&t=27052
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Rotating Cube with textures build 2019-02-22

Post by UEZ »

BasicCoder2 wrote:Both very nice rotating cube demos.

The compression of images into the source code is interesting. UEZ do you have code to make the data statements from images?

I would see the compression and decompression of images as a separate Tips and Tricks example.
Well, I've written the converter with AutoIt which can be found here: FB File2Bas Code Generator v0.80 build 2019-01-05 beta.zip. Just start the exe and a small GUI with FB Logo will appear. You can use the rmb to change some settings. Just drag'n'drop some file to it and it will generate the FB code. Source code is included.

If I'm too bored I will try to convert it to FB. ^^
BasicCoder2 wrote: UEZ's cube rotates toward the mouse. Dodi's cube will tip up or down but only rotates around the vertical axis.

I recognise some of Dodi's functions but the maths is beyond me. Maybe someone with the knowledge can break the maths down as a tutorial?
Or even show how to use Dodi's functions with their own set of pixel points.
Look here for some information about the math: http://petercollingridge.appspot.com/3D ... ng-objects
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Rotating Cube with textures build 2019-02-22

Post by BasicCoder2 »

UEZ wrote:Look here for some information about the math: http://petercollingridge.appspot.com/3D ... ng-objects
I have read those kinds of basic explanations and have posted some of my efforts to the forum including the rotating textured cube demo.
None of it is like the condensed maths Dodicat uses for a fast computation for converting 3d data to 2d display.
Also getting control over the cube's rotational position, as for example you can with Blender, would be a nice addition.
Paul Doe attempted to explain it with a flying paper plane example but it was all a bit complicated.
See example in general section of forum posts on positioning the cube.
Post Reply