_MAPTRIANGLE EXAMPLES

[NakedApe]

I'd like to learn more tricks that I can do with QBPE since I enjoy writing action games. I've got a pretty good handle on most things now after hanging out here for a few years, but I don't really have much of a clue as to how to use _MAPTRIANGLE to good effect. If someone with the knowledge could post a few examples of simple things to do with that command I'd be thankful.

I know @Magdha you've posted a few 3D progs recently, so maybe you'd be interested in dumbing down a couple little ditties for me, or maybe @bplus or @SMcNeill. I would be a most appreciative primate.  

Ted

[Unseen Machine]

ME! ID SAY DONT USE IT! No normals, no lighting, etc...and unless Qwerky makes his stuff into a lib for shapes and mapping textures to em and then adds scaling etc...its a mine field...

Learn GL (Qb64 does nartive supprt for v 1.1) @MasterGY will be happy to help ya there and so will I. I now am all about doing it in C++ and passing commands to QB64...and for me...its been one hell of a hill to climb so i wouldnt recommend it lightly!

For fast images ask @Pete for hardware advice...failing that....Googles ai will in a few mins teach you what you want to know...like i know how to use it but two questions and i got this....

Code: (Select All)

' Solid Rotating 3D Cube with Multi-Color Faces

SCREEN _NEWIMAGE(800, 600, 32)



' 1. Create a Hardware Texture Atlas

temp& = _NEWIMAGE(1536, 256, 32) ' 6 faces * 256 pixels

_DEST temp&

FOR i = 0 TO 5

  LINE (i * 256, 0)-((i + 1) * 256 - 1, 255), _RGB32(i * 40, 200 - i * 30, 255 - i * 20), BF

NEXT i

_DEST 0

tex& = _COPYIMAGE(temp&, 33): _FREEIMAGE temp&



' Define the 8 static corners of a cube (local coordinates)

TYPE Point3D

  x AS SINGLE: y AS SINGLE: z AS SINGLE

END TYPE

DIM v(1 TO 8) AS Point3D ' Vertices

v(1).x = -1: v(1).y = 1: v(1).z = 1 ' Front-Top-Left

v(2).x = 1: v(2).y = 1: v(2).z = 1 ' Front-Top-Right

v(3).x = 1: v(3).y = -1: v(3).z = 1 ' Front-Bot-Right

v(4).x = -1: v(4).y = -1: v(4).z = 1 ' Front-Bot-Left

v(5).x = -1: v(5).y = 1: v(5).z = -1 ' Back-Top-Left

v(6).x = 1: v(6).y = 1: v(6).z = -1 ' Back-Top-Right

v(7).x = 1: v(7).y = -1: v(7).z = -1 ' Back-Bot-Right

v(8).x = -1: v(8).y = -1: v(8).z = -1 ' Back-Bot-Left



DIM rv(1 TO 8) AS Point3D ' Rotated Vertices



DO

  _LIMIT 60: CLS

  a! = TIMER * 0.5: zo = -5 ' Angle and Depth



  ' 2. Rotate all vertices first as a single solid unit

  FOR i = 1 TO 8

    x = v(i).x: y = v(i).y: z = v(i).z

    ' Rotate Y

    nx = x * COS(a!) - z * SIN(a!): nz = x * SIN(a!) + z * COS(a!)

    x = nx: z = nz

    ' Rotate X

    ny = y * COS(a! * 0.7) - z * SIN(a! * 0.7): nz = y * SIN(a! * 0.7) + z * COS(a! * 0.7)

    ' Store final position with depth offset

    rv(i).x = x: rv(i).y = ny: rv(i).z = nz + zo

  NEXT i



  ' 3. Draw faces using the pre-rotated vertices

  ' Front face (v1, v2, v3, v4)

  DrawFace rv(1), rv(2), rv(3), rv(4), tex&, 0

  ' Back face (v6, v5, v8, v7)

  DrawFace rv(6), rv(5), rv(8), rv(7), tex&, 256

  ' Left face (v5, v1, v4, v8)

  DrawFace rv(5), rv(1), rv(4), rv(8), tex&, 512

  ' Right face (v2, v6, v7, v3)

  DrawFace rv(2), rv(6), rv(7), rv(3), tex&, 768

  ' Top face (v5, v6, v2, v1)

  DrawFace rv(5), rv(6), rv(2), rv(1), tex&, 1024

  ' Bottom face (v4, v3, v7, v8)

  DrawFace rv(4), rv(3), rv(7), rv(8), tex&, 1280



  _DISPLAY

LOOP UNTIL INKEY$ = CHR$(27)



SUB DrawFace (p1 AS Point3D, p2 AS Point3D, p3 AS Point3D, p4 AS Point3D, img&, tx)

  ' Each face is 2 triangles.

  _MAPTRIANGLE (tx, 0)-(tx + 255, 0)-(tx + 255, 255), img& TO(p1.x, p1.y, p1.z)-(p2.x, p2.y, p2.z)-(p3.x, p3.y, p3.z)

  _MAPTRIANGLE (tx, 0)-(tx + 255, 255)-(tx, 255), img& TO(p1.x, p1.y, p1.z)-(p3.x, p3.y, p3.z)-(p4.x, p4.y, p4.z)

END SUB

Then one more question got me this : 

Code: (Select All)

' QB64-PE: 3D Bouncing Spheres and Cubes (No Culling)

SCREEN _NEWIMAGE(1000, 700, 32)

RANDOMIZE TIMER



' 1. Create a Hardware Texture for our objects

t& = _NEWIMAGE(256, 256, 32): _DEST t&

FOR i = 0 TO 255: LINE (i, 0)-(i, 255), _RGB32(i, 100, 255 - i): NEXT i

_DEST 0: tex& = _COPYIMAGE(t&, 33): _FREEIMAGE t&



' Object Definitions

TYPE Point3D: x AS SINGLE: y AS SINGLE: z AS SINGLE: END TYPE

TYPE Entity

  x AS SINGLE: y AS SINGLE: z AS SINGLE ' World Position

  dx AS SINGLE: dy AS SINGLE: dz AS SINGLE ' Velocity

  rot AS SINGLE: rotV AS SINGLE ' Rotation state

  isSphere AS INTEGER

END TYPE



' Pre-calculate geometry

CONST S_RES = 10 ' Sphere resolution (Higher = smoother, but slower)

DIM SHARED SphereV((S_RES + 1) * (S_RES + 1)) AS Point3D

DIM SHARED CubeV(1 TO 8) AS Point3D



' Generate Sphere Vertices

n = 1

FOR lat = 0 TO S_RES

  phi! = 3.14159 * lat / S_RES

  FOR lon = 0 TO S_RES

    theta! = 2 * 3.14159 * lon / S_RES

    SphereV(n).x = SIN(phi!) * COS(theta!)

    SphereV(n).y = COS(phi!)

    SphereV(n).z = SIN(phi!) * SIN(theta!)

    n = n + 1

  NEXT

NEXT



' Generate Cube Vertices

DATA -1,1,1,1,1,1,1,-1,1,-1,-1,1,-1,1,-1,1,1,-1,1,-1,-1,-1,-1,-1

FOR i = 1 TO 8: READ CubeV(i).x, CubeV(i).y, CubeV(i).z: NEXT



' Create Entities

CONST MAX_OBJS = 20

DIM e(1 TO MAX_OBJS) AS Entity

FOR i = 1 TO MAX_OBJS

  e(i).x = RND * 4 - 2: e(i).y = RND * 2 - 1: e(i).z = -5 - RND * 5

  e(i).dx = (RND - 0.5) * 0.05: e(i).dy = (RND - 0.5) * 0.05: e(i).dz = (RND - 0.5) * 0.05

  e(i).rotV = RND * 0.1: e(i).isSphere = (RND > 0.5)

NEXT



' Main Loop

DO

  _LIMIT 60: CLS

  FOR i = 1 TO MAX_OBJS

    ' Move and Bounce

    e(i).x = e(i).x + e(i).dx: e(i).y = e(i).y + e(i).dy: e(i).z = e(i).z + e(i).dz

    IF ABS(e(i).x) > 3 THEN e(i).dx = -e(i).dx

    IF ABS(e(i).y) > 2 THEN e(i).dy = -e(i).dy

    IF e(i).z > -2 OR e(i).z < -12 THEN e(i).dz = -e(i).dz

    e(i).rot = e(i).rot + e(i).rotV



    ' Render Object

    IF e(i).isSphere THEN DrawSphere e(i), tex& ELSE DrawCube e(i), tex&

  NEXT

  _DISPLAY

LOOP UNTIL INKEY$ = CHR$(27)

CubeIndices: DATA 1,2,3,4,6,5,8,7,5,1,4,8,2,6,7,3,5,6,2,1,4,3,7,8





SUB DrawSphere (ent AS Entity, img&)

  FOR lat = 0 TO S_RES - 1

    FOR lon = 0 TO S_RES - 1

      idx = lat * (S_RES + 1) + lon + 1

      ' Map 4 points of a sphere segment

      DrawTri SphereV(idx), SphereV(idx + 1), SphereV(idx + S_RES + 1), ent, img&

      DrawTri SphereV(idx + 1), SphereV(idx + S_RES + 2), SphereV(idx + S_RES + 1), ent, img&

    NEXT

  NEXT

END SUB



SUB DrawCube (ent AS Entity, img&)

  ' Simplistic Cube Draw using vertex indices

  RESTORE CubeIndices: FOR f = 1 TO 6: READ v1, v2, v3, v4

    DrawTri CubeV(v1), CubeV(v2), CubeV(v3), ent, img&

    DrawTri CubeV(v1), CubeV(v3), CubeV(v4), ent, img&

NEXT: END SUB

SUB DrawTri (p1 AS Point3D, p2 AS Point3D, p3 AS Point3D, ent AS Entity, img&)

  DIM rP(1 TO 3) AS Point3D: rP(1) = p1: rP(2) = p2: rP(3) = p3

  FOR i = 1 TO 3

    ' Rotate and Offset

    x = rP(i).x: y = rP(i).y: z = rP(i).z

    nx = x * COS(ent.rot) - z * SIN(ent.rot): nz = x * SIN(ent.rot) + z * COS(ent.rot)

    rP(i).x = nx + ent.x: rP(i).y = y + ent.y: rP(i).z = nz + ent.z

  NEXT

  ' _MAPTRIANGLE without flags renders both sides (solid or wireframe effect depending on texture)

  _MAPTRIANGLE (0, 0)-(255, 0)-(128, 255), img& TO(rP(1).x, rP(1).y, rP(1).z)-(rP(2).x, rP(2).y, rP(2).z)-(rP(3).x, rP(3).y, rP(3).z)

END SUB

If you ask it to add comments step by step it will, and also it make you anything you want!

john

[Unseen Machine]

Here ya go...simple coloured primitives lib...enjoy!

Code: (Select All)

' PAC-3D S-TIER ENGINE: DEFINITIVE 2026 BUILD

' Fix: Parameter Mismatch in Floor Render + Cohesive Mesh Logic

' No colons - No placeholders - Pro-Grade



$CHECKING:OFF

SCREEN _NEWIMAGE(800, 600, 32)

_TITLE "S-Tier 3D Engine (2026 Fix)"



' --- 1. HARDWARE ASSET INITIALIZATION ---

DIM SHARED RED&, GRN&, BLU&, YEL&, WHT&, BLK&, MAG&

RED& = CreateSolid&(255, 50, 50)

GRN& = CreateSolid&(50, 255, 50)

BLU& = CreateSolid&(50, 50, 255)

YEL& = CreateSolid&(255, 255, 0)

WHT& = CreateSolid&(255, 255, 255)

BLK& = CreateSolid&(20, 20, 20)

MAG& = CreateSolid&(255, 50, 255)



' --- 2. MAIN DEMO LOOP ---

DIM angle AS SINGLE

DO

  _LIMIT 60

  CLS

  angle = angle + 0.01



  ' Render Old-School Checkerboard Floor

  DrawCheckerboardFloor -4.0



  ' Render Primitives

  DrawCube -4.5, 0, -15, 1.5, angle, angle * 0.5, RED&

  DrawSphere 0, 0, -15, 2, angle, YEL&

  DrawCylinder 4.5, -4, -15, 1, 4, angle, BLU&

  DrawCone -4.5, -4, -15, 1.5, 3, angle, GRN&

  DrawDisk 0, 4, -15, 3, angle, MAG&



  _DISPLAY

LOOP UNTIL _KEYDOWN(27)



' --- 3. PRIMITIVE PROCEDURES ---



SUB DrawCheckerboardFloor (floorY!)

  DIM size!

  size! = 1.0

  DIM count

  count = 20

  DIM startX!, startZ!

  startX! = -(count / 2) * size!

  startZ! = startX! - 20



  FOR x = 0 TO count - 1

    FOR z = 0 TO count - 1

      cx! = startX! + x * size! + size! / 2

      cz! = startZ! + z * size! + size! / 2



      IF (x + z) MOD 2 = 0 THEN

        tex& = WHT&

      ELSE

        tex& = BLK&

      END IF



      ' Corrected RenderFace Call (No extra rotation params)

      RenderFace cx!, floorY!, cz!, -size! / 2, 0, -size! / 2, size! / 2, 0, -size! / 2, size! / 2, 0, size! / 2, -size! / 2, 0, size! / 2, tex&

    NEXT z

  NEXT x

END SUB



SUB DrawCube (cx!, cy!, cz!, s!, rx!, ry!, tex&)

  DIM x(8), y(8), z(8) AS SINGLE

  x(1) = -s!: y(1) = -s!: z(1) = -s!: x(2) = s!: y(2) = -s!: z(2) = -s!

  x(3) = s!: y(3) = s!: z(3) = -s!: x(4) = -s!: y(4) = s!: z(4) = -s!

  x(5) = -s!: y(5) = -s!: z(5) = s!: x(6) = s!: y(6) = -s!: z(6) = s!

  x(7) = s!: y(7) = s!: z(7) = s!: x(8) = -s!: y(8) = s!: z(8) = s!



  FOR i = 1 TO 8

    ApplyRotation x(i), y(i), z(i), rx!, ry!

  NEXT i



  RenderFace cx!, cy!, cz!, x(1), y(1), z(1), x(2), y(2), z(2), x(3), y(3), z(3), x(4), y(4), z(4), tex&

  RenderFace cx!, cy!, cz!, x(2), y(2), z(2), x(6), y(6), z(6), x(7), y(7), z(7), x(3), y(3), z(3), tex&

  RenderFace cx!, cy!, cz!, x(6), y(6), z(6), x(5), y(5), z(5), x(8), y(8), z(8), x(7), y(7), z(7), tex&

  RenderFace cx!, cy!, cz!, x(5), y(5), z(5), x(1), y(1), z(1), x(4), y(4), z(4), x(8), y(8), z(8), tex&

  RenderFace cx!, cy!, cz!, x(4), y(4), z(4), x(3), y(3), z(3), x(7), y(7), z(7), x(8), y(8), z(8), tex&

  RenderFace cx!, cy!, cz!, x(1), y(1), z(1), x(5), y(5), z(5), x(6), y(6), z(6), x(2), y(2), z(2), tex&

END SUB



SUB DrawSphere (cx!, cy!, cz!, r!, rot!, tex&)

  DIM vstep!

  vstep! = 0.4

  FOR lat! = 0 TO 3.14159 STEP vstep!

    FOR lon! = 0 TO 6.28318 STEP vstep!

      x1! = r! * SIN(lat!) * COS(lon!): y1! = r! * COS(lat!): z1! = r! * SIN(lat!) * SIN(lon!)

      x2! = r! * SIN(lat! + vstep!) * COS(lon!): y2! = r! * COS(lat! + vstep!): z2! = r! * SIN(lat! + vstep!) * SIN(lon!)

      x3! = r! * SIN(lat! + vstep!) * COS(lon! + vstep!): y3! = r! * COS(lat! + vstep!): z3! = r! * SIN(lat! + vstep!) * SIN(lon! + vstep!)

      x4! = r! * SIN(lat!) * COS(lon! + vstep!): y4! = r! * COS(lat!): z4! = r! * SIN(lat!) * SIN(lon! + vstep!)

      ApplyRotation x1!, y1!, z1!, rot!, rot!

      ApplyRotation x2!, y2!, z2!, rot!, rot!

      ApplyRotation x3!, y3!, z3!, rot!, rot!

      ApplyRotation x4!, y4!, z4!, rot!, rot!

      RenderFace cx!, cy!, cz!, x1!, y1!, z1!, x2!, y2!, z2!, x3!, y3!, z3!, x4!, y4!, z4!, tex&

    NEXT lon!

  NEXT lat!

END SUB



SUB DrawCylinder (cx!, cy!, cz!, r!, h!, rot!, tex&)

  DIM vstep!

  vstep! = 0.4

  FOR a! = 0 TO 6.28318 STEP vstep!

    x1! = r! * COS(a!): z1! = r! * SIN(a!): x2! = r! * COS(a! + vstep!): z2! = r! * SIN(a! + vstep!)

    ApplyRotation x1!, z1!, 0, 0, rot! ' Reuse rot logic

    ApplyRotation x2!, z2!, 0, 0, rot!

    RenderFace cx!, cy!, cz!, x1!, 0, z1!, x2!, 0, z2!, x2!, h!, z2!, x1!, h!, z1!, tex&

  NEXT a!

END SUB



SUB DrawCone (cx!, cy!, cz!, r!, h!, rot!, tex&)

  DIM vstep!

  vstep! = 0.4

  FOR a! = 0 TO 6.28318 STEP vstep!

    x1! = r! * COS(a!): z1! = r! * SIN(a!): x2! = r! * COS(a! + vstep!): z2! = r! * SIN(a! + vstep!)

    RenderTri cx!, cy!, cz!, 0, h!, 0, x1!, 0, z1!, x2!, 0, z2!, tex&

    RenderTri cx!, cy!, cz!, 0, 0, 0, x1!, 0, z1!, x2!, 0, z2!, tex&

  NEXT a!

END SUB



SUB DrawDisk (cx!, cy!, cz!, r!, rot!, tex&)

  DIM vstep!

  vstep! = 0.4

  FOR a! = 0 TO 6.28318 STEP vstep!

    x1! = r! * COS(a!): z1! = r! * SIN(a!): x2! = r! * COS(a! + vstep!): z2! = r! * SIN(a! + vstep!)

    RenderTri cx!, cy!, cz!, 0, 0, 0, x1!, 0, z1!, x2!, 0, z2!, tex&

  NEXT a!

END SUB



' --- 4. ENGINE CORE SUBS ---



SUB ApplyRotation (x!, y!, z!, rx!, ry!)

  tx! = x! * COS(ry!) - z! * SIN(ry!)

  tz! = x! * SIN(ry!) + z! * COS(ry!)

  x! = tx!: z! = tz!

  ty! = y! * COS(rx!) - z! * SIN(rx!)

  tz! = y! * SIN(rx!) + z! * COS(rx!)

  y! = ty!: z! = tz!

END SUB



SUB RenderFace (cx!, cy!, cz!, x1!, y1!, z1!, x2!, y2!, z2!, x3!, y3!, z3!, x4!, y4!, z4!, t&)

  _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), t& TO(x1! + cx!, y1! + cy!, z1! + cz!)-(x2! + cx!, y2! + cy!, z2! + cz!)-(x3! + cx!, y3! + cy!, z3! + cz!)

  _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), t& TO(x1! + cx!, y1! + cy!, z1! + cz!)-(x3! + cx!, y3! + cy!, z3! + cz!)-(x4! + cx!, y4! + cy!, z4! + cz!)

END SUB



SUB RenderTri (cx!, cy!, cz!, x1!, y1!, z1!, x2!, y2!, z2!, x3!, y3!, z3!, t&)

  _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), t& TO(x1! + cx!, y1! + cy!, z1! + cz!)-(x2! + cx!, y2! + cy!, z2! + cz!)-(x3! + cx!, y3! + cy!, z3! + cz!)

END SUB



FUNCTION CreateSolid& (r, g, b)

  temp& = _NEWIMAGE(1, 1, 32): _DEST temp&

  PSET (0, 0), _RGB32(r, g, b)

  _DEST 0: CreateSolid& = _COPYIMAGE(temp&, 33)

  _FREEIMAGE temp&

END FUNCTION

[SMcNeill]

John doesn't quite understand the concept of *simple* examples.

Let me give you the simple lowdown. 

_PUTIMAGE takes 4 points and moves a rectangle around on your screen.

_PUTIMAGE (left, top) - (right, bottom)    <-- see how this makes a rectangle for us?  It just cuts a plain and normal rectangle chunk out of the screen and moves it.

---

So how does _MAPTRIANGLE work?

It just takes three points for the end pieces of the triangle, cuts a triangle out of something, and then lets us move it.

So we can use _Maptriangle to mimic _PUTIMAGE easily enough!   (Just imagine a diagonal in that rectangle and now you can see the two triangles.)

Code: (Select All)

Screen _NewImage(800, 600, 32)

$Color:32



aImage = _NewImage(100, 100, 32) 'just a 100x100 image



_Dest aImage

Cls , SkyBlue

Color , 0

Print "Hello World"

Print "This is Steve being Steve"

_Dest 0



_PutImage (100, 100)-(200, 200), aImage 'see the rectangle?



_MapTriangle (0, 0)-(100, 0)-(0, 100), aImage To(300, 100)-(400, 100)-(300, 200), 0 'see my two triangles?

_MapTriangle (100, 0)-(0, 100)-(100, 100), aImage To(500, 100)-(400, 200)-(500, 200), 0

The advantage to this?   You don't have to put it back to the screen in the same square shape!   Let's move that top left point further left 40 pixels.  Move the top right point left 40 pixels as well.  And PRESTO!!

Code: (Select All)

Screen _NewImage(800, 600, 32)

$Color:32



aImage = _NewImage(100, 100, 32) 'just a 100x100 image



_Dest aImage

Cls , SkyBlue

Color , 0

Print "Hello World"

Print "This is Steve being Steve"

_Dest 0



_PutImage (100, 100)-(200, 200), aImage 'see the rectangle?



_MapTriangle (0, 0)-(100, 0)-(0, 100), aImage To(300, 100)-(400, 100)-(300, 200), 0 'see my two triangles?

_MapTriangle (100, 0)-(0, 100)-(100, 100), aImage To(500, 100)-(400, 200)-(500, 200), 0





_MapTriangle (0, 0)-(100, 0)-(0, 100), aImage To(300 - 40, 300)-(400 - 40, 300)-(300, 400), 0 'and see me put my triangles together,

_MapTriangle (100, 0)-(0, 100)-(100, 100), aImage To(400 - 40, 300)-(300, 400)-(400, 400), 0 'but I've shifted them left here to slant them?

See how much more flexible that is?  You can't get a rectangle and put a rectangle and do something like that!  But we're getting a triangle and putting a triangle, so all we have to do is adjust those 3 points and we can shape and rotate and move that image however we desire.

You're looking at something that can do everything that _PUTIMAGE can do, but which can *ALSO* do a whole lot more!!

This is how we rotate and spin and skew and slant and do all those other little things that simply working with square images wouldn't do for us at all. 

[bplus]

One of my first uses of _MapTriangle was for drawing solid filled triangles. Once you have that you have any polygon filled and once you have that you can change triangles into rectangles

see here!
https://qb64phoenix.com/forum/showthread.php?tid=339

Also Rotozooms absolutely need _MapTriangle! as Steve has put together a demo in post above.

[Magdha]

@NakedApe as far as _MAPTRIANGLE is concerned, Steve & bplus have given you guidance to get started.

Much to Unseen's chagrin, I shall stick with _MAPTRIANGLE (and won't be creating any libraries).  If you have a go with what Steve & bplus have shown you, and then reply with comments here, I'll see if I can come up with some more examples.

Richard

[NakedApe]

Excellent, many thanks for the replies! I’ll kick the tires on these examples and try to teach this old dog some new tricks.

[bplus]

I would start with something needing filled triangles, perhaps solid polygons made from connected triangles instead of painting from interior point (which is slower).

[Petr]

@NakedApe https://qb64phoenix.com/forum/showthread.php?tid=1565

[ahenry3068]

Ok.    I stole MAPTRIANGLE code from Petr and combined it with my Video library (In one hit wonders !) 

 

REQUIRES THE SPV-VIDS LIBRARY !

Code: (Select All)

$Resize:On

Option _Explicit

$Embed:'./ba.jpg','applebg'



Dim Shared IM As Long

Dim Shared IMG As Long

Dim Shared e As Long

Dim Shared V As Long

Dim Shared SX0, SY0, SX1, SY1, SX2, SX3, SY2, SY3

Dim Shared tt, t, DX0, DY0, DX1, DY1, DX2, DY2, DX3, DY3, StredX, RR, SS, R, s, vx, vy, Mxx, Myy, W, H, d

Dim Shared Mx As Long

Dim Shared My As Long



Dim Shared APPLE As Long

APPLE = _LoadImage(_Embedded$("applebg"), 32, "MEMORY")



Screen _NewImage(1024, 768, 32)

IM& = _ScreenImage

IMG& = _CopyImage(IM&, 33)

_FreeImage IM&

SX0 = 0: SY0 = 0: SX1 = 0: SY1 = _Height: SX2 = _Width: SY2 = 0: SX3 = _Width: SY3 = _Height

DX0 = -2: DY0 = 2: DX1 = -2: DY1 = -2: DX2 = 2: DY2 = 2: DX3 = 2: DY3 = -2



'    SX0            SX2                                                                    y

'    dx0                                  X left = -  right = +                - x      -z      +x

'                                          Y dole = -  nahore = +                        -y

'                                          Z vzadu = max - 10, normalne ale -1

'    SX1            SX3

tt = .01: t = .1





' IF FRAME_CALLBACK IS ON THEN THE SUB

' FRAME_CALLBACK WILL BE CALLED FOR EACH FRAME OF THE VIDEO

' REMOVING THE DEFINE FOR FRAME_CALLBACK TURNS THIS OFF

' THE SUB FRAME_CALLBACK Is defined by the end Developer

$Let FRAME_CALLBACK = "ON"







' If this DEFINE is used then a User function

' V_Custom_Controller& that should return type LONG is used instead of

' _keyhit for video playback.    Should return the same as _keyhit control

' _key_spc - Pause

' _key_esc - End (and bookmark if bookmarking is on)

' _key_left - Seek back four seconds

' _key_right - Seek forward four seconds

' _key_up, _key_down PCM volume control

' M key Mutes Audio

' L key pops up the Key control Legend

' T key toggles Video Countdown Timer display

' If you do not want the Popup Messages on the Video Image then

' Set VID_LEGENDS_OFF to _True





' $Include: './SPV-VIDS.BI'



Dim BG As Long

Dim Shared XWid As Long

Dim Shared YHei As Long

Dim Shared XInc As Integer

Dim Shared YInc As Integer

Dim Shared XBounce As Integer

Dim Shared YBounce As Integer

Dim Shared AppleImg As Long





Randomize Timer

XWid = 1024

YHei = 768

XInc = Int(Rnd * 6) + 1

YInc = Int(Rnd * 6) + 1



GETVIDEO:



' With this on Video will Bookmark current Frame to a .MARK

' File.  When next played (if Bookmarking ON) Play will resume at

' The Bookmark.  If BookMarking is OFF then Video plays from beginning

' and no bookmark is saved when ESC is pressed.

TURNON_BOOKMARKING





_Title "SPV Video Selection"

VIDEO_FILE$ = _OpenFileDialog$("SIMPLE X16 MOVIE PLAYER - Select SPV Video File(s) to Play", "", "*.SPV|*.spv", "X16 Movie Files", 0)

If BG <> 0 Then

    Screen 0

    _FreeImage BG

    _Display

End If



' Video_XOrigin = XOrg

' Video_YOrigin = YOrg



' VIDEO_WINDOW_WIDTH = VWidth



' VIDEO_WINDOW_HEIGHT = INT(VWidth * .75)





' This player selects proper resolution and background for Widescreen and 4:3 Videos

' In the Call to WINDOWED_VIDEO only the Width is specified, Height is calculated properly

' For the Video ASPECT Ration

If OpenVideo(VIDEO_FILE$) Then

    PlayTheVideo

    CLEAN_UP_VIDEO

    GoTo GETVIDEO

End If

System





' The below sub & funtion are for the Custom Callbacks.

' Simple implemenation to show the principle.





' Very simple CUSTOM Control that just duplicates

' The Normal Keyboard Control functionality.

Function V_Custom_Controller&

    Static C As Long

    C = _KeyHit

    If C = Asc("U") Or C = Asc("u") Then

        If VIDEO_FPS < 60 Then

            Change_VideoFPS VIDEO_FPS + .25

        End If

    End If

    If C = Asc("D") Or C = Asc("d") Then

        If VIDEO_FPS > .5 Then

            Change_VideoFPS VIDEO_FPS - .25

        End If

    End If



    If C = Asc("r") Or C = Asc("R") Then

        ' Restore Orignal Encoded FPS

        Change_VideoFPS 0

    End If

    V_Custom_Controller = C

End Function





Sub Frame_CallBack

    e& = ell&

    Mx = _MouseX: My = _MouseY

    StredX = Mx

    t = t + tt: If t > _Pi(2) Or t < -_Pi(2) Then tt = tt * -1

    RR = Sin(t) - 4

    SS = Cos(t) - 10

    R = -Sin(t) * -2

    s = -Cos(t) * 2

    _Dest LEGEND_DESTINATION

    Line (0, 0)-(_Width - 1, _Height - 1), _RGB32(50, 50, 90, 255), BF

    _MapTriangle (SX0, SY0)-(SX3, SY3)-(SX1, SY1), e& To(DX0 * R, DY0 * s, RR)-(DX3 * R, DY3 * s, SS)-(DX1 * R, DY1 * s, RR), 0, _Smooth

    _MapTriangle (SX0, SY0)-(SX3, SY3)-(SX2, SY2), e& To(DX0 * R, DY0 * s, RR)-(DX3 * R, DY3 * s, SS)-(DX2 * R, DY2 * s, SS), 0, _Smooth

    _Dest 0

End Sub



Function ell&

    V& = _NewImage(1024, 768, 32)

    _Dest V&

    W = 1024: H = 768

    If Mxx = 0 Then Mxx = 10: Myy = 10

    vx = vx + Mxx: If vx > W Or vx < 0 Then Mxx = Mxx * -1

    vy = vy + Myy: If vy > H Or vy < 0 Then Myy = Myy * -1

    Cls , _RGB32(1, 55, 132)

    _PutImage , FRAME_IMAGE

    _Dest 0

    ell& = _CopyImage(V&, 33)

    _FreeImage V&

End Function







' $Include: './SPV-VIDS.BM'