Author Topic: ₒ₀₁₄₇₈ ³ᐟ⁷⁸ #1 viewed QB64.net topic = Digital Knife Monkey Productions!!!!  (Read 277 times)

Offline Richard

  • Forum Regular
  • Posts: 118
o01478-01
 Author Topic: Digital Knife Monkey Productions!!!!  (Read 96045 times)



2020jun01   66 views
2020jun02  177 views

Quote

 

   
News:
Instructions for creating Android Apps:
http://www.qb64.net/forum/index.php?topic=13162.0

Home
Help
Search
Login
Register

QB64 Community »
Development »
Development (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Digital Knife Monkey Productions!!!!

« previous next »
Print
Pages: [1] 2 3 ... 78
 Author Topic: Digital Knife Monkey Productions!!!!  (Read 96045 times)
DarthWho
Hero Member

 
Posts: 4039
Timelord of the Sith

 
Digital Knife Monkey Productions!!!!
« on: September 21, 2010, 07:37:08 pm »

Well thanks to Unseenmachine's Suggestion this is the new home thread of Digital Knife Monkey Productions!!!! Welcome members. For non members DKM productions is a place where you can request help form a member who is experienced in a subject or ask for error testing any form of help with your programs. signing up as a member does not necessarily guarantee that your name will be in lights in the credits to all DKM Productions you actually must be the main programmer or have helped in some way with the project. it is encouraged that one becomes a member before asking for assistance but it is not necessary as long as in the finished project you say that DKM helped you and list the member(s) who(m) provided the assistance.
Myself (I shall not speak for the other members because this is a group of individuals) I encourage Newbies to join the qb64 community and ask questions.
ANNOUNCEMENT: Unseen has been kind enough to Give DKM Productions a home on the web:
http://digitalknifemonkeyproductions.webs.com/
associated sites:
http://unseengdk.webs.com/
« Last Edit: December 07, 2010, 05:46:55 am by DarthWho »
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7

unseenmachine
Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

 
Re: Digital Knife Monkey Productions!!!!
« Reply #1 on: September 21, 2010, 09:11:06 pm »

It needs tweaking, but heres the start of a DKM intro screen.Feel free to modify as you wish.

Code: [Select]
'rotating text version 0.1
'by unseen machine

DECLARE SUB redraw ()
DECLARE SUB analyse ()

DIM SHARED text AS STRING
text$ = " DKM Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)
CALL analyse
CLS
CALL redraw

SUB analyse
CLS
SCREEN 12

COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

  word(px, py) = POINT(px, py)

  PSET (px, py), 1
  px = px + 1

  IF px = LEN(text$) * 8 THEN

    px = 1
    py = py + 1

  END IF

LOOP UNTIL py = 16

END SUB

SUB redraw

CLS

DIM row AS INTEGER, cnt AS INTEGER, cstart AS SINGLE, cend AS SINGLE
DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

cstart = 0: cend = 6.2


yrot = 6: scale = 3

DO

  xrot = 50

  FOR a = xrot TO (xrot - 50) STEP -1

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    row = 2

    DO

      DO

        FOR i = cstart TO cend STEP .035

          x = (scale * 60 - (row * a)) * COS(i)
          y = (scale * 60 - (row * yrot)) * SIN(i)

          cnt = cnt + 1

          IF word(cnt, row) > 0 THEN

            CIRCLE (x + 320, y + 220), scale, 1

          END IF

          IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

        NEXT

      LOOP

      row = row + 1

    LOOP UNTIL row = 16

    cend = cend + .1
    cstart = cstart + .1

    _DELAY 0.1
    CLS

  NEXT

LOOP UNTIL INKEY$ = CHR$(27)

END SUB

 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0

DarthWho
Hero Member

 
Posts: 4039
Timelord of the Sith

 
Re: Digital Knife Monkey Productions!!!!
« Reply #2 on: September 22, 2010, 04:55:42 am »

that is just plain cool but i will tweak it a bit might also be a cool loading screen (with loader bar at the bottom)

 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7

codeguy
Hero Member

Posts: 3986
what the h3ll did i name that code?

 
Re: Digital Knife Monkey Productions!!!!
« Reply #3 on: September 22, 2010, 05:03:19 am »

i think it's a neat opening intro screen. maybe a little sound to go along with it might be nice. or even a plasma background!

 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

DarthWho
Hero Member

 
Posts: 4039
Timelord of the Sith

 
Re: Digital Knife Monkey Productions!!!!
« Reply #4 on: September 22, 2010, 06:24:19 am »

interesting concept there let's try the one that came with qb64 just to see how that looks though i have an interesting fire routine if i can find it....

 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7

unseenmachine
Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

 
Re: Digital Knife Monkey Productions!!!!
« Reply #5 on: September 22, 2010, 07:06:21 am »

A plasma background suonds interesting, cant wait to see that one.

This one has been qb64'd and squared, it looks a bit like a snake stuck in a box to me but hey, who cares! LOL!!!

Code: [Select]
SCREEN _NEWIMAGE(800, 600, 12)

DIM SHARED text AS STRING
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

'#################################################################################################

CALL analyse
CLS
CALL redraw

'#################################################################################################


SUB analyse
CLS
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

  word(px, py) = POINT(px, py)

  PSET (px, py), 1
  px = px + 1

  IF px = LEN(text$) * 8 THEN

    px = 1
    py = py + 1

  END IF

LOOP UNTIL py = 16

END SUB

'#################################################################################################

SUB redraw

CLS

DIM row AS INTEGER, cnt AS INTEGER, cstart AS SINGLE, cend AS SINGLE
DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

cstart = 0: cend = 6.2

xrot = 6: yrot = 6: scale = 3

DO

  OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

  row = 2

  DO

    DO

      FOR i = cstart TO cend STEP .04

        x = (scale * 60 - (row * xrot)) * TAN(COS(i))
        y = (scale * 60 - (row * yrot)) * TAN(SIN(i))

        cnt = cnt + 1

        IF word(cnt, row) > 0 THEN

          CIRCLE (x + 400, y + 300), scale, 1
          PAINT STEP(0, 0), 1, 1

        END IF

        IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

      NEXT

    LOOP

    row = row + 1

  LOOP UNTIL row = 16

  cend = cend + .1
  cstart = cstart + .1

  _DISPLAY
  _DELAY 0.05
  CLS

LOOP UNTIL INKEY$ = CHR$(27)

END SUB
« Last Edit: September 22, 2010, 07:16:25 am by unseenmachine »
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0

codeguy
Hero Member

Posts: 3986
what the h3ll did i name that code?

 
Re: Digital Knife Monkey Productions!!!!
« Reply #6 on: September 22, 2010, 07:23:49 am »

it would be COOL to have:
Code: [Select]
'* nspace3.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 4
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
DIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%)
FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS INTEGER
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS INTEGER
    nsides AS INTEGER
END TYPE

MaxPolys% = 511
DIM Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% 'SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '*SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).color = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
NEXT
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
DO
    CLS
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    FOR i% = LBOUND(Polys) TO UBOUND(Polys)
        'PSET (Polys(i%).x, Polys(i%).y), 0
        Position Polys(i%), dimensionFlags%
        DrawPoly Polys(i%)
        'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
        GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
        'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
        'IF CollidedWithPlayer% THEN
        'END IF
    NEXT
    '* check to see if objects collide with each other
    FOR ax% = 0 TO NXDivs%
        FOR ay% = 0 TO NYDivs%
            FOR xj% = 0 TO counts%(ax%, ay%) - 1
                p1% = PolysInRegion%(ax%, ay%, xj%)
                FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                    p2% = PolysInRegion%(ax%, ay%, aj%)
                    IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                        CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                    END IF
                NEXT

            NEXT
            counts%(ax%, ay%) = 0
        NEXT
    NEXT
    REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
    _LIMIT 256
    _DISPLAY
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF
IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF
END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
collided% = 0
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 2) THEN
    IF ABS(T1.y - t2.y) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 4) THEN
    IF ABS(T1.z - t2.z) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
Collision% = collided%
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB
running in the background. of course, you'll have to change _delay to _limit to do so
here's what i have so far!
Code: [Select]
'* nspace3.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 4
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)


FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS INTEGER
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS INTEGER
    nsides AS INTEGER
END TYPE

MaxPolys% = 895
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% 'SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '*SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).color = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
NEXT
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
DO
    redraw
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    IF -1 THEN
        FOR i% = LBOUND(Polys) TO UBOUND(Polys)
            'PSET (Polys(i%).x, Polys(i%).y), 0
            Position Polys(i%), dimensionFlags%
            DrawPoly Polys(i%)
            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
            GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
            'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
            'IF CollidedWithPlayer% THEN
            'END IF
        NEXT
    END IF
    FOR ax% = 0 TO NXDivs%
        FOR ay% = 0 TO NYDivs%
            FOR xj% = 0 TO counts%(ax%, ay%) - 1
                p1% = PolysInRegion%(ax%, ay%, xj%)
                FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                    p2% = PolysInRegion%(ax%, ay%, aj%)
                    IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                        CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                    END IF
                NEXT

            NEXT
            counts%(ax%, ay%) = 0
        NEXT
    NEXT
    REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
    analyse
    _LIMIT 256
    _DISPLAY
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF
IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF
END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
collided% = 0
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 2) THEN
    IF ABS(T1.y - t2.y) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 4) THEN
    IF ABS(T1.z - t2.z) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
Collision% = collided%
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB


SUB redraw

DIM row AS INTEGER, cnt AS INTEGER, cstart AS SINGLE, cend AS SINGLE
DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER
cstart = 0: cend = 6.2

xrot = 6: yrot = 6: scale = 3

LOCATE 2, 1: PRINT text$;
analyse
OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

time! = TIMER
DO
    row = 2
    DO

        DO

            FOR i = cstart TO cend STEP .04

                x = (scale * 60 - (row * xrot)) * TAN(COS(i))
                y = (scale * 60 - (row * yrot)) * TAN(SIN(i))

                cnt = cnt + 1

                IF word(cnt, row) > 0 THEN

                    CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
                    PAINT STEP(0, 0), 1, 1

                END IF

                IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

            NEXT

        LOOP

        row = row + 1

    LOOP UNTIL row = 16

    cend = cend + .1
    cstart = cstart + .1
    FOR i% = LBOUND(Polys) TO UBOUND(Polys)
        DrawPoly Polys(i%)
    NEXT
    _DISPLAY
    CLS
LOOP UNTIL ABS(TIMER - time!) > .05
END SUB
« Last Edit: September 22, 2010, 08:12:06 am by codeguy »
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

unseenmachine
Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

 
Re: Digital Knife Monkey Productions!!!!
« Reply #7 on: September 22, 2010, 07:51:46 am »

NICE COLLISION DETECTION!!! That looks pretty neat to me. Don't think i'll be the one to merge them, but yes it will look pretty sweet.

 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0

codeguy
Hero Member

Posts: 3986
what the h3ll did i name that code?

 
Re: Digital Knife Monkey Productions!!!!
« Reply #8 on: September 22, 2010, 08:06:40 am »

already merged 'em, but i still keep seeing the blue bar and dkm productions printed!

 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

unseenmachine
Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

 
Re: Digital Knife Monkey Productions!!!!
« Reply #9 on: September 22, 2010, 08:35:48 am »

This any better? - I have edited the post eand change the code...works nicely now.

Code: [Select]
'* nspace3.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 4
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
  SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
  CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
  x AS SINGLE
  y AS SINGLE
  z AS SINGLE
  mass AS INTEGER
  radius AS INTEGER
  speedx AS SINGLE
  speedy AS SINGLE
  speedz AS SINGLE
  color AS INTEGER
  mass AS INTEGER
  nsides AS INTEGER
END TYPE

MaxPolys% = 895
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
  Polys(i%).nsides = SetRand(3, 5)
  Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
  Polys(i%).x = x% 'SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
  Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).y = y% '*SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
  Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
  Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).color = SetRand(43, 127)
  Polys(i%).mass = Polys(i%).nsides \ 2 + 1
  IF x% > MaxScreenX% - MaxObjectRadius% THEN
    y% = y% + 2 * MaxObjectRadius%
    x% = MaxObjectRadius%
  ELSE
    x% = x% + 2 * MaxObjectRadius%
  END IF
NEXT
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
  dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
  BitSet% = BitSet% + 1
  TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
LOCATE 2, 1: PRINT text$;
analyse
DO
  '_AUTODISPLAY
  IF _MOUSEINPUT THEN
    PlayerX% = _MOUSEX
    PlayerY% = _MOUSEY
    lmb% = _MOUSEBUTTON(1)
    rmb% = _MOUSEBUTTON(2)
  END IF
  '* check to see if objects collide with each other
  IF -1 THEN
    FOR i% = LBOUND(Polys) TO UBOUND(Polys)
      'PSET (Polys(i%).x, Polys(i%).y), 0
      Position Polys(i%), dimensionFlags%
      DrawPoly Polys(i%)
      'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
      GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
      'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
      'IF CollidedWithPlayer% THEN
      'END IF
    NEXT
  END IF
  FOR ax% = 0 TO NXDivs%
    FOR ay% = 0 TO NYDivs%
      FOR xj% = 0 TO counts%(ax%, ay%) - 1
        p1% = PolysInRegion%(ax%, ay%, xj%)
        FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
          p2% = PolysInRegion%(ax%, ay%, aj%)
          IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
            CalcVelocities Polys(), p1%, p2%, dimensionFlags%
          END IF
        NEXT

      NEXT
      counts%(ax%, ay%) = 0
    NEXT
  NEXT
  REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
  redraw
  _LIMIT 200
  _DISPLAY
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 1 THEN
  IF P.x + P.speedx < MinScreenX% THEN
    P.speedx = -P.speedx
  ELSEIF P.x + P.speedx > MaxScreenX% THEN
    P.speedx = -P.speedx
  END IF
  P.x = P.x + P.speedx
END IF
IF flags% AND 2 THEN
  IF P.y + P.speedy < MinScreenY% THEN
    P.speedy = -P.speedy
  ELSEIF P.y + P.speedy > MaxScreenY% THEN
    P.speedy = -P.speedy
  END IF
  P.y = P.y + P.speedy
END IF
IF flags% AND 4 THEN
  IF P.z + P.speedz < MinScreenZ% THEN
    P.speedz = -P.speedz
  ELSEIF P.z + P.speedz > MaxScreenZ% THEN
    P.speedz = -P.speedz
  END IF
  P.z = P.z + P.speedz
END IF
END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
collided% = 0
IF flags% AND 1 THEN
  IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
    Collision% = 0
    EXIT FUNCTION
  ELSE
    collided% = -1
  END IF
END IF
IF (flags% AND 2) THEN
  IF ABS(T1.y - t2.y) > T1.radius + t2.radius THEN
    Collision% = 0
    EXIT FUNCTION
  ELSE
    collided% = -1
  END IF
END IF
IF (flags% AND 4) THEN
  IF ABS(T1.z - t2.z) > T1.radius + t2.radius THEN
    Collision% = 0
    EXIT FUNCTION
  ELSE
    collided% = -1
  END IF
END IF
Collision% = collided%
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
  oldix% = -1
  oldiy% = -1
  FOR i% = -radius% TO radius% STEP radius%
    SELECT CASE x%
      CASE MinSX% + radius% TO MaxSX% - radius%
        SELECT CASE y%
          CASE MinSY% + radius% TO MaxSY% - radius%
            ax% = (x% + i%) \ NxDivSize%
            ay% = (y% + i%) \ NyDivSize%
            IF ax% <> oldix% OR ay% <> oldiy% THEN
              IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
              END IF
              PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
              counts%(ax%, ay%) = counts%(ax%, ay%) + 1
              oldix% = ax%
              oldiy% = ay%
            END IF
        END SELECT
    END SELECT
  NEXT
ELSE
  ax% = (x%) \ NxDivSize%
  ay% = (y%) \ NyDivSize%
  PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
  counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
  temp1 = b(i&).speedx
  temp2 = b(j&).speedx
  totalMass = (b(i&).mass + b(j&).mass)
  b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
IF flags% AND 2 THEN
  temp1 = b(i&).speedy
  temp2 = b(j&).speedy
  b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
IF flags% AND 4 THEN
  temp1 = b(i&).speedz
  temp2 = b(j&).speedz
  b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
  IF T.radius > 0 THEN
    CircleStepDeg% = (ubst% + 1) / T.nsides
    Newx = T.x + T.radius * CosTable!(0)
    Newy = T.y + T.radius * SinTable!(0)
    angle% = 0
    fpx = Newx
    fpy = Newy
    angle% = CircleStepDeg%
    DO
      IF angle% > ubst% THEN
        LINE (fpx, fpy)-(Newx, Newy), T.color
        EXIT DO
      ELSE
        lastx = Newx
        lasty = Newy
        Newx = T.x + T.radius * CosTable!(angle%)
        Newy = T.y + T.radius * SinTable!(angle%)
        LINE (lastx, lasty)-(Newx, Newy), T.color
        angle% = angle% + CircleStepDeg%
      END IF
    LOOP
  ELSE
    PSET (T.x, T.y), T.color
  END IF
ELSE
  PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

  word(px, py) = POINT(px, py)

  PSET (px, py), 1
  px = px + 1

  IF px = LEN(text$) * 8 THEN

    px = 1
    py = py + 1

  END IF

LOOP UNTIL py = 16

END SUB


SUB redraw

DIM row AS INTEGER, cnt AS INTEGER
DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

xrot = 6: yrot = 6: scale = 4

OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

time! = TIMER
DO
  CLS
  row = 2
  DO

    DO

      FOR i = cstart TO cend STEP .04

        x = (scale * 60 - (row * xrot)) * TAN(COS(i))
        y = (scale * 60 - (row * yrot)) * TAN(SIN(i))

        cnt = cnt + 1

        IF word(cnt, row) > 0 THEN

          CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
          PAINT STEP(0, 0), 1, 1

        END IF

        IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

      NEXT

    LOOP

    row = row + 1

  LOOP UNTIL row = 16

  cend = cend + .1
  cstart = cstart + .1
  FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    DrawPoly Polys(i%)
  NEXT

  _DISPLAY

LOOP UNTIL ABS(TIMER - time!) > .05
END SUB
« Last Edit: September 22, 2010, 08:43:46 am by unseenmachine »
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0

unseenmachine
Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

 
Re: Digital Knife Monkey Productions!!!!
« Reply #10 on: September 22, 2010, 08:54:22 am »

I think the best view, is (in redraw sub change values for these)

xrot = 6: yrot = 14: scale = 6

and it looks pretty neat.

Is it me or are the shapes draw on top of the text?

Unseen...

 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0

codeguy
Hero Member

Posts: 3986
what the h3ll did i name that code?

 
Re: Digital Knife Monkey Productions!!!!
« Reply #11 on: September 22, 2010, 09:17:06 am »

the shapes are meant to cascade as if in front of the text. yes, you are seeing correctly. if you change the subs to be called after the shapes are drawn, i think it will appear the other way!

 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

codeguy
Hero Member

Posts: 3986
what the h3ll did i name that code?

 
Re: Digital Knife Monkey Productions!!!!
« Reply #12 on: September 22, 2010, 09:35:09 am »

Nice, Unseenmachine! in don't think there's any way qbxx would've been able to handle that stunning feat! cool -- i think we'll have to wait for DarthWho's approval on this one, though! if some of this code looks familiar, it's because it is adapted from my n-space (tm, (c), (r)) collision detection algo, which if you run it by itself, you can see it's REALLY efficient and reasonably accurate.
« Last Edit: September 22, 2010, 09:41:49 am by codeguy »
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

DarthWho
Hero Member

 
Posts: 4039
Timelord of the Sith

 
Re: Digital Knife Monkey Productions!!!!
« Reply #13 on: September 22, 2010, 09:51:56 am »

All very nice though I am having trouble running the program in Unseen's last post the nspace3 one i am going to try a different computer weird that the desktop is having problems while my laptop does not....

 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7

codeguy
Hero Member

Posts: 3986
what the h3ll did i name that code?

 
Re: Digital Knife Monkey Productions!!!!
« Reply #14 on: September 22, 2010, 11:15:52 am »

This one does not obscure the DKM logo:
Code: [Select]
'* nspace3.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 25
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS INTEGER
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS INTEGER
    nsides AS INTEGER
END TYPE

MaxPolys% = 2047
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).color = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
NEXT
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
LOCATE 2, 1: PRINT text$;
analyse
DO
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    DIM row AS INTEGER, cnt AS INTEGER
    DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

    xrot = 6: yrot = 6: scale = 4

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    time! = TIMER
    DO
        CLS
        row = 2
        Ltime! = TIMER
        DO

            DO
                LINE (minx, miny)-(max, maxy), 0, BF
                minx = 32767
                miny = 32767
                FOR i = cstart TO cend STEP .04

                    x = (scale * 60 - (row * xrot)) * TAN(COS(i))
                    IF x < minx THEN
                        minx = x
                    END IF
                    IF x > maxx THEN
                        maxx = x
                    END IF
                    y = (scale * 60 - (row * yrot)) * TAN(SIN(i))
                    IF y < miny THEN
                        miny = y
                    END IF
                    IF y > maxy THEN
                        maxy = y
                    END IF
                    cnt = cnt + 1

                    IF word(cnt, row) > 0 THEN

                        CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
                        PAINT STEP(0, 0), 1, 1

                    END IF

                    IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

                NEXT

            LOOP

            row = row + 1

        LOOP UNTIL row = 16

        cend = cend + .1
        cstart = cstart + .1
        IF -1 THEN
            FOR i% = LBOUND(Polys) TO UBOUND(Polys)
                'PSET (Polys(i%).x, Polys(i%).y), 0
                Position Polys(i%), dimensionFlags%
                IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
                    DrawPoly Polys(i%)
                    'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
                    DrawPoly Polys(i%)
                    'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                ELSE
                    m% = (m% + 1) MOD 2
                    IF m% THEN
                        Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
                    ELSE
                        Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
                    END IF
                END IF
                GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
                'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
                'IF CollidedWithPlayer% THEN
                'END IF
            NEXT
        END IF
        FOR ax% = 0 TO NXDivs%
            FOR ay% = 0 TO NYDivs%
                FOR xj% = 0 TO counts%(ax%, ay%) - 1
                    p1% = PolysInRegion%(ax%, ay%, xj%)
                    FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                        p2% = PolysInRegion%(ax%, ay%, aj%)
                        IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                            CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                        END IF
                    NEXT

                NEXT
                counts%(ax%, ay%) = 0
            NEXT
        NEXT
        REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
        Dtime! = ABS(TIMER - Ltime!)
        IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
            MaxPolys% = MaxPolys% + 1
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
            Polys(MaxPolys%).nsides = SetRand(3, 5)
            Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
            Polys(MaxPolys%).x = x% 'SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
            Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).y = y% '*SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
            Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
            Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).color = SetRand(43, 127)
            Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
        ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
            MaxPolys% = MaxPolys% - 100
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
        END IF
        _DISPLAY
    LOOP UNTIL ABS(TIMER - time!) > .15

LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF
IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF
END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
collided% = 0
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 2) THEN
    IF ABS(T1.y - t2.y) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 4) THEN
    IF ABS(T1.z - t2.z) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
Collision% = collided%
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB

 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

Print
Pages: [1] 2 3 ... 78
« previous next »
QB64 Community »
Development »
Development (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Digital Knife Monkey Productions!!!!

 


SMF 2.0.3 | SMF © 2011, Simple Machines
XHTML
RSS
WAP2


2020jun01  66 views
« Last Edit: June 03, 2020, 06:58:32 AM by Richard »

Offline Richard

  • Forum Regular
  • Posts: 118
Re: ₒ₀₁₄₇₈
« Reply #1 on: June 02, 2020, 08:35:34 PM »
o01478-02





 
Quote

   
News:

Instructions for creating Android Apps:
http://www.qb64.net/forum/index.php?topic=13162.0


Home
Help
Search
Login
Register

QB64 Community »
Development »
Development (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Digital Knife Monkey Productions!!!!

« previous next »
Print
Pages: 1 [2] 3 4 ... 78
 Author Topic: Digital Knife Monkey Productions!!!!  (Read 96047 times)

unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #15 on: September 22, 2010, 01:30:59 pm »
Thats much better, much more legible. What would be super cool, were if the background objects could hit the logo and react to it as they do to each other. Would that be asking to much of QB? Or Codeguy? Also, i really have to re-iterate that using xrot = 6: yrot = 14: scale = 6 as the settings for the display creates a much nicer looking, and easier to read logo. (only my opinion though)

 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #16 on: September 22, 2010, 01:58:18 pm »
i have given you my super-duper collision detection algo, which should gain SOMEONE enough time to do the various (x,y,z) rotations of the logo (or perhaps just simply an x-rotation would be nice. but then we have to make the logo a bunch of relatively coherent particles. i will leave that task to another member of our team as my brain is currently on strike. make it circular and it'll be lots easier than solving linear equations (i think, don't quote me on that).
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #17 on: September 22, 2010, 02:07:15 pm »
well i had the idea of if we go with the first candidate and have a plasma going on behind it i think it would be cool if when ti reaches the frame before it loops back to the start it instead stops there we hear a monkey or chimp scream and a knife appears in the middle "pinning" the words in place. Any takers? but i do like where the current train of thought is going very interesting.
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #18 on: September 22, 2010, 02:42:03 pm »
Heck, i had enough trouble making the rotating text program!!! Heres a purely circular version edit of codeguys latest.

Code: [Select]
'* nspace3.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 25
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
  SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
  CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
  x AS SINGLE
  y AS SINGLE
  z AS SINGLE
  mass AS INTEGER
  radius AS INTEGER
  speedx AS SINGLE
  speedy AS SINGLE
  speedz AS SINGLE
  color AS INTEGER
  mass AS INTEGER
  nsides AS INTEGER
END TYPE

MaxPolys% = 2047
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
  Polys(i%).nsides = SetRand(3, 5)
  Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
  Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
  Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
  Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
  Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).color = SetRand(43, 127)
  Polys(i%).mass = Polys(i%).nsides \ 2 + 1
  IF x% > MaxScreenX% - MaxObjectRadius% THEN
    y% = y% + 2 * MaxObjectRadius%
    x% = MaxObjectRadius%
  ELSE
    x% = x% + 2 * MaxObjectRadius%
  END IF
NEXT
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
  dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
  BitSet% = BitSet% + 1
  TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
LOCATE 2, 1: PRINT text$;
analyse
DO
  '_AUTODISPLAY
  IF _MOUSEINPUT THEN
    PlayerX% = _MOUSEX
    PlayerY% = _MOUSEY
    lmb% = _MOUSEBUTTON(1)
    rmb% = _MOUSEBUTTON(2)
  END IF
  '* check to see if objects collide with each other
  DIM row AS INTEGER, cnt AS INTEGER
  DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

  xrot = 6: yrot = 6: scale = 4

  OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

  time! = TIMER
  DO
    CLS
    row = 2
    Ltime! = TIMER
    DO

      DO
        LINE (minx, miny)-(max, maxy), 0, BF
        minx = 32767
        miny = 32767
        FOR i = cstart TO cend STEP .04

          x = (scale * 60 - (row * xrot)) * (COS(i))
          IF x < minx THEN
            minx = x
          END IF
          IF x > maxx THEN
            maxx = x
          END IF
          y = (scale * 60 - (row * yrot)) * (SIN(i))
          IF y < miny THEN
            miny = y
          END IF
          IF y > maxy THEN
            maxy = y
          END IF
          cnt = cnt + 1

          IF word(cnt, row) > 0 THEN

            CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
            PAINT STEP(0, 0), 1, 1

          END IF

          IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

        NEXT

      LOOP

      row = row + 1

    LOOP UNTIL row = 16

    cend = cend + .1
    cstart = cstart + .1
    IF -1 THEN
      FOR i% = LBOUND(Polys) TO UBOUND(Polys)
        'PSET (Polys(i%).x, Polys(i%).y), 0
        Position Polys(i%), dimensionFlags%
        IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
          DrawPoly Polys(i%)
          'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
        ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
          DrawPoly Polys(i%)
          'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
        ELSE
          m% = (m% + 1) MOD 2
          IF m% THEN
            Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
          ELSE
            Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
          END IF
        END IF
        GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
        'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
        'IF CollidedWithPlayer% THEN
        'END IF
      NEXT
    END IF
    FOR ax% = 0 TO NXDivs%
      FOR ay% = 0 TO NYDivs%
        FOR xj% = 0 TO counts%(ax%, ay%) - 1
          p1% = PolysInRegion%(ax%, ay%, xj%)
          FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
            p2% = PolysInRegion%(ax%, ay%, aj%)
            IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
              CalcVelocities Polys(), p1%, p2%, dimensionFlags%
            END IF
          NEXT

        NEXT
        counts%(ax%, ay%) = 0
      NEXT
    NEXT
    REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
    Dtime! = ABS(TIMER - Ltime!)
    IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
      MaxPolys% = MaxPolys% + 1
      REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
      Polys(MaxPolys%).nsides = SetRand(3, 5)
      Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
      Polys(MaxPolys%).x = x% 'SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
      Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)
      Polys(MaxPolys%).y = y% '*SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
      Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
      Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
      Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
      Polys(MaxPolys%).color = SetRand(43, 127)
      Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
    ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
      MaxPolys% = MaxPolys% - 100
      REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
    END IF
    _DISPLAY
  LOOP UNTIL ABS(TIMER - time!) > .15

LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 1 THEN
  IF P.x + P.speedx < MinScreenX% THEN
    P.speedx = -P.speedx
  ELSEIF P.x + P.speedx > MaxScreenX% THEN
    P.speedx = -P.speedx
  END IF
  P.x = P.x + P.speedx
END IF
IF flags% AND 2 THEN
  IF P.y + P.speedy < MinScreenY% THEN
    P.speedy = -P.speedy
  ELSEIF P.y + P.speedy > MaxScreenY% THEN
    P.speedy = -P.speedy
  END IF
  P.y = P.y + P.speedy
END IF
IF flags% AND 4 THEN
  IF P.z + P.speedz < MinScreenZ% THEN
    P.speedz = -P.speedz
  ELSEIF P.z + P.speedz > MaxScreenZ% THEN
    P.speedz = -P.speedz
  END IF
  P.z = P.z + P.speedz
END IF
END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
collided% = 0
IF flags% AND 1 THEN
  IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
    Collision% = 0
    EXIT FUNCTION
  ELSE
    collided% = -1
  END IF
END IF
IF (flags% AND 2) THEN
  IF ABS(T1.y - t2.y) > T1.radius + t2.radius THEN
    Collision% = 0
    EXIT FUNCTION
  ELSE
    collided% = -1
  END IF
END IF
IF (flags% AND 4) THEN
  IF ABS(T1.z - t2.z) > T1.radius + t2.radius THEN
    Collision% = 0
    EXIT FUNCTION
  ELSE
    collided% = -1
  END IF
END IF
Collision% = collided%
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
  oldix% = -1
  oldiy% = -1
  FOR i% = -radius% TO radius% STEP radius%
    SELECT CASE x%
      CASE MinSX% + radius% TO MaxSX% - radius%
        SELECT CASE y%
          CASE MinSY% + radius% TO MaxSY% - radius%
            ax% = (x% + i%) \ NxDivSize%
            ay% = (y% + i%) \ NyDivSize%
            IF ax% <> oldix% OR ay% <> oldiy% THEN
              IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
              END IF
              PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
              counts%(ax%, ay%) = counts%(ax%, ay%) + 1
              oldix% = ax%
              oldiy% = ay%
            END IF
        END SELECT
    END SELECT
  NEXT
ELSE
  ax% = (x%) \ NxDivSize%
  ay% = (y%) \ NyDivSize%
  PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
  counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
  temp1 = b(i&).speedx
  temp2 = b(j&).speedx
  totalMass = (b(i&).mass + b(j&).mass)
  b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
IF flags% AND 2 THEN
  temp1 = b(i&).speedy
  temp2 = b(j&).speedy
  b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
IF flags% AND 4 THEN
  temp1 = b(i&).speedz
  temp2 = b(j&).speedz
  b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
  IF T.radius > 0 THEN
    CircleStepDeg% = (ubst% + 1) / T.nsides
    Newx = T.x + T.radius * CosTable!(0)
    Newy = T.y + T.radius * SinTable!(0)
    angle% = 0
    fpx = Newx
    fpy = Newy
    angle% = CircleStepDeg%
    DO
      IF angle% > ubst% THEN
        LINE (fpx, fpy)-(Newx, Newy), T.color
        EXIT DO
      ELSE
        lastx = Newx
        lasty = Newy
        Newx = T.x + T.radius * CosTable!(angle%)
        Newy = T.y + T.radius * SinTable!(angle%)
        LINE (lastx, lasty)-(Newx, Newy), T.color
        angle% = angle% + CircleStepDeg%
      END IF
    LOOP
  ELSE
    PSET (T.x, T.y), T.color
  END IF
ELSE
  PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

  word(px, py) = POINT(px, py)

  PSET (px, py), 1
  px = px + 1

  IF px = LEN(text$) * 8 THEN

    px = 1
    py = py + 1

  END IF

LOOP UNTIL py = 16

END SUB
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #19 on: September 22, 2010, 02:51:09 pm »
i think i can work with this to make collisions with the logo work! as long as i know the radius from the center, it should be pretty straightforward and it'll be back to letting the polys run freely, rather than in the confined areas they are now!
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #20 on: September 22, 2010, 03:03:59 pm »
I'll try the mod wish me luck.
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #21 on: September 22, 2010, 03:43:30 pm »
Code: [Select]
'* nspace3.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 25
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS INTEGER
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS INTEGER
    nsides AS INTEGER
END TYPE

MaxPolys% = 2047
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).color = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    DIM row AS INTEGER, cnt AS INTEGER
    DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

    xrot = 6: yrot = 6: scale = 4

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    time! = TIMER
    DO
        CLS
        row = 2
        Ltime! = TIMER
        DO

            DO
                'LINE (minx, miny)-(max, maxy), 0, BF
                minx = 32767
                miny = 32767
                FOR i = cstart TO cend STEP .04

                    x = (scale * 60 - (row * xrot)) * (COS(i))
                    IF x < minx THEN
                        minx = x
                    END IF
                    IF x > maxx THEN
                        maxx = x
                    END IF
                    y = (scale * 60 - (row * yrot)) * (SIN(i))
                    IF y < miny THEN
                        miny = y
                    END IF
                    IF y > maxy THEN
                        maxy = y
                    END IF
                    cnt = cnt + 1

                    IF word(cnt, row) > 0 THEN

                        CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
                        PAINT STEP(0, 0), 1, 1

                    END IF

                    IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

                NEXT
            LOOP

            row = row + 1

        LOOP UNTIL row = 16

        cend = cend + .1
        cstart = cstart + .1
        IF ABS(maxx) > ABS(maxy) THEN
            logo.radius = ABS(maxx) / 2
        ELSE
            logo.radius = ABS(maxy) / 2
        END IF
        logo.speedx = logo.radius * 3.14159 * xrot
        logo.speedy = logo.speedy * 3.14159 * yrot
        logo.mass = 10
        IF -1 THEN
            FOR i% = LBOUND(Polys) TO UBOUND(Polys)
                IF Collision%(logo, Polys(i%), dimensionFlags%) THEN
                    DIM b(0 TO 1) AS Polygons
                    b(0) = logo
                    b(1) = Polys(i%)
                    CalcVelocities b(), 0, 1, dimensionFlags%
                    Polys(i%) = b(1)
                ELSE
                    'PSET (Polys(i%).x, Polys(i%).y), 0
                    Position Polys(i%), dimensionFlags%
                    IF 0 THEN
                        IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSE
                            m% = (m% + 1) MOD 2
                            IF m% THEN
                                Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
                            ELSE
                                Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
                            END IF
                        END IF
                    ELSE
                        DrawPoly Polys(i%)
                    END IF
                    GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
                    'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
                    'IF CollidedWithPlayer% THEN
                    'END IF
                END IF
            NEXT
        END IF
        FOR ax% = 0 TO NXDivs%
            FOR ay% = 0 TO NYDivs%
                FOR xj% = 0 TO counts%(ax%, ay%) - 1
                    p1% = PolysInRegion%(ax%, ay%, xj%)
                    FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                        p2% = PolysInRegion%(ax%, ay%, aj%)
                        IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                            CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                        END IF
                    NEXT

                NEXT
                counts%(ax%, ay%) = 0
            NEXT
        NEXT
        REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
        Dtime! = ABS(TIMER - Ltime!)
        IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
            MaxPolys% = MaxPolys% + 1
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
            Polys(MaxPolys%).nsides = SetRand(3, 5)
            Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
            Polys(MaxPolys%).x = x% 'SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
            Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).y = y% '*SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
            Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
            Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).color = SetRand(43, 127)
            Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
        ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
            MaxPolys% = MaxPolys% - 100
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
        END IF
        _DISPLAY
        '_LIMIT 20
    LOOP UNTIL ABS(TIMER - time!) > .15

LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF
IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF
END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
collided% = 0
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 2) THEN
    IF ABS(T1.y - t2.y) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
IF (flags% AND 4) THEN
    IF ABS(T1.z - t2.z) > T1.radius + t2.radius THEN
        Collision% = 0
        EXIT FUNCTION
    ELSE
        collided% = -1
    END IF
END IF
Collision% = collided%
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB
now featuring -- NO POLYS INSIDE RADIUS OF LOGO!
« Last Edit: September 22, 2010, 03:50:09 pm by codeguy »
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #22 on: September 22, 2010, 04:35:41 pm »
cool give me a couple minutes and i will post some code for the mod.
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #23 on: September 22, 2010, 04:57:25 pm »
Excellant!!! Now thats what i'm talking about!!! Nice work CodeGuy!!!
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #24 on: September 22, 2010, 05:03:41 pm »
here is the prototype mod that when i had free time today i worked on to the first submission remember it is supposed to be a knife imagine a plasma background and just when it stops you hear a Monkey or chimp screaming sound and then the knife appears from off screen and it all fades away after a second with a chorus of ook ook eek it took a while to get the blade shape about  right.
Code: [Select]
DECLARE SUB redraw ()
DECLARE SUB analyse ()

DIM SHARED text AS STRING
text$ = " DKM Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)
CALL analyse
CLS
CALL redraw
END
SUB analyse
CLS
SCREEN 12

COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB

SUB redraw

CLS

DIM row AS INTEGER, cnt AS INTEGER, cstart AS SINGLE, cend AS SINGLE
DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

cstart = 0: cend = 6.2


yrot = 6: scale = 3

'DO

xrot = 55

FOR a = xrot TO (xrot - 50) STEP -1
    CLS
    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    row = 2

    DO

        DO

            FOR i = cstart TO cend STEP .035

                x = (scale * 60 - (row * a)) * COS(i)
                y = (scale * 60 - (row * yrot)) * SIN(i)

                cnt = cnt + 1

                IF word(cnt, row) > 0 THEN

                    CIRCLE (x + 320, y + 220), scale, 1

                END IF

                IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

            NEXT

        LOOP

        row = row + 1

    LOOP UNTIL row = 16

    cend = cend + .1
    cstart = cstart + .1
    _DISPLAY
    _DELAY 0.06


NEXT
LINE (160, 70)-(300, 210), 15
LINE -(320, 180), 15
LINE -(230, 40), 15
LINE -(160, 70), 15
LINE -(130, 130), 15
LINE -(250, 210), 15
LINE -(300, 210), 15
PAINT (167, 90), 7, 15
PAINT (167, 72), 7, 15
'LOOP UNTIL INKEY$ = CHR$(27)
_DISPLAY
END SUB

EDIT I have not had much free time today.
« Last Edit: September 22, 2010, 05:28:46 pm by DarthWho »
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
Cyperium

Hero Member

 
Posts: 3660
Knowledge is good, but understanding is better


Re: Digital Knife Monkey Productions!!!!

« Reply #25 on: September 22, 2010, 06:09:12 pm »
Really nice! I like it!
 Logged
Venture - New Prototype, QB64 Editor v1.97, SDL dll files
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #26 on: September 22, 2010, 06:12:47 pm »
finally got stuff to wrap around the circle correctly: gave it a new version, too.
Code: [Select]
'* nspace5.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 64
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "     D.K.M  Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS SINGLE
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS SINGLE
    nsides AS INTEGER
    radius2 AS SINGLE
END TYPE
REDIM b(0 TO 1) AS Polygons
MaxPolys% = 127
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).color = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
    Polys(i%).radius2 = Polys(i%).radius ^ 2
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    DIM row AS INTEGER, cnt AS INTEGER
    DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

    xrot = 6: yrot = 6: scale = 4

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    time! = TIMER
    DO
        CLS
        row = 2
        Ltime! = TIMER
        DO

            DO
                'LINE (minx, miny)-(max, maxy), 0, BF
                minx = 32767
                miny = 32767
                FOR i = cstart TO cend STEP .04

                    x = (scale * 60 - (row * xrot)) * (COS(i))
                    IF x < minx THEN
                        minx = x
                    END IF
                    IF x > maxx THEN
                        maxx = x
                    END IF
                    y = (scale * 60 - (row * yrot)) * (SIN(i))
                    IF y < miny THEN
                        miny = y
                    END IF
                    IF y > maxy THEN
                        maxy = y
                    END IF
                    cnt = cnt + 1

                    IF word(cnt, row) > 0 THEN

                        CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
                        PAINT STEP(0, 0), 1, 1

                    END IF

                    IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

                NEXT
            LOOP

            row = row + 1

        LOOP UNTIL row = 16

        cend = cend + .1
        cstart = cstart + .1
        IF ABS(maxx) > ABS(maxy) THEN
            logo.radius = ABS(maxx) / 2
        ELSE
            logo.radius = ABS(maxy) / 2
        END IF
        logo.mass = 1
        logo.radius2 = logo.radius ^ 2
        IF -1 THEN
            FOR i% = LBOUND(polys) TO UBOUND(polys)
                IF Collision%(logo, Polys(i%), dimensionFlags%) THEN
                    IF (logo.x = Polys(i%).x) THEN
                        logo.speedx = (logo.radius / (scale ^ 2))
                        logo.speedy = 1
                    ELSE
                        slope! = (logo.y - Polys(i%).y) / (logo.x - Polys(i%).x)
                        IF Polys(i%).y >= logo.y THEN '* either going N or E (270-90)
                            IF Polys(i%).x >= logo.x THEN 'going east
                                Theta! = slope! * 90
                            ELSE 'going north
                                Theta! = 270 + slope! * 90
                            END IF
                        ELSE
                            IF Polys(i%).x >= logo.x THEN
                                Theta! = 90 + slope! * 90
                            ELSE
                                Theta! = 180 + 90 * slope!
                            END IF
                        END IF
                        logo.speedx = logo.radius / (scale ^ 2) * COS(Theta! * 3.14159 / 180)
                        logo.speedy = logo.radius / (scale ^ 2) * SIN(Theta! * 3.14159 / 180)
                    END IF
                    b(0) = logo
                    b(1) = Polys(i%)
                    CalcVelocities b(), 0, 1, dimensionFlags%
                    Polys(i%) = b(1)
                    Position Polys(i%), dimensionFlags%
                    '* DrawPoly Polys(i%)
                ELSE
                    Position Polys(i%), dimensionFlags%
                    IF 0 THEN
                        IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSE
                            m% = (m% + 1) MOD 2
                            IF m% THEN
                                Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
                            ELSE
                                Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
                            END IF
                        END IF
                    ELSE
                        DrawPoly Polys(i%)
                    END IF
                    GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
                    'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
                    'IF CollidedWithPlayer% THEN
                    'END IF
                END IF
            NEXT
        END IF
        FOR ax% = 0 TO NXDivs%
            FOR ay% = 0 TO NYDivs%
                FOR xj% = 0 TO counts%(ax%, ay%) - 1
                    p1% = PolysInRegion%(ax%, ay%, xj%)
                    FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                        p2% = PolysInRegion%(ax%, ay%, aj%)
                        IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                            CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                        END IF
                    NEXT

                NEXT
                counts%(ax%, ay%) = 0
            NEXT
        NEXT
        REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
        Dtime! = ABS(TIMER - Ltime!)
        IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
            MaxPolys% = MaxPolys% + 1
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
            Polys(MaxPolys%).nsides = SetRand(3, 5)
            Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
            IF MaxPolys% MOD 2 THEN
                Polys(MaxPolys%).x = SetRand(MinScreenX% + Polys(i%).radius, MinScreenX% + Polys(i%).radius)
                Polys(MaxPolys%).y = SetRand(MinScreenY% + Polys(i%).radius, MinScreenY% + Polys(i%).radius)
            ELSE
                Polys(MaxPolys%).x = SetRand(MaxScreenX% - Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
                Polys(MaxPolys%).y = SetRand(MaxScreenY% - Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
            END IF
            Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)

            Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
            Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
            Polys(MaxPolys%).color = SetRand(43, 127)
            Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
            Polys(i%).radius2 = Polys(i%).radius ^ 2
        ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
            MaxPolys% = MaxPolys% - 100
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
        END IF
        _DISPLAY
        '_LIMIT 20
    LOOP UNTIL ABS(TIMER - time!) > .15
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF

IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF

IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF

END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
IF (flags% AND 4) THEN
    dx! = (T1.x - t2.x) ^ 2
    dy! = (T1.y - t2.y) ^ 2
    IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
        Collision% = 0
    ELSE
        IF ABS(T1.z - t2.z) > (T1.radius + t2.radius) THEN
            Collision% = 0
        ELSE
            Collision% = -1
        END IF
    END IF
    EXIT FUNCTION
END IF
IF (flags% AND 2) THEN
    dx! = (T1.x - t2.x) ^ 2
    dy! = (T1.y - t2.y) ^ 2
    IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
    EXIT FUNCTION
END IF
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
    EXIT FUNCTION
END IF
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB
it seems no matter how hard we try, we just cannot escape the pythagorean theorem. for smaller scales, it is not a big deal, but for larger ones, it makes a world of difference. so now you have the mathematically correct, although quite a bit slower version. but that said, if it weren't for my algo, this would be substantially slower. perhaps a precalc on the radii would come in handy! also, this "throws" objects in the correct direction depending on the quadrant it hits the logo. unfortunately, it's required to find the quadrant it hits because sin and cos return the same values for some values and it is impossible to tell exactly what quadrant produced the function. quadrants 1 and 3 and 2 and 4 produce the same ATN values (that is -1/2, returns the same value as 1/-2, although they are in quadrants exactly opposite each other). and while i am at it, i will replace this with my latest version, including radius^2 precalcs, which somewhat compensates for the mathematically correct but slower collision algo. but even at that, it is still WAY faster than the old method most other people try.
« Last Edit: September 22, 2010, 07:48:41 pm by codeguy »
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #27 on: September 22, 2010, 06:25:08 pm »
I am almost at the point where i can actually make the first puzzle with the water simulator i just have to find the right images to graft the puzzle onto.
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
Clippy

Hero Member

 
Posts: 19402
I LOVE π = 4 * ATN(1)    Use the QB64 WIKI >>>


Re: Digital Knife Monkey Productions!!!!

« Reply #28 on: September 22, 2010, 06:36:05 pm »
WHAT IS that white object in the water? A diving board or a boat dock?
 Logged
QB64 WIKI: Main Page
Download Q-Basics Demo: Q-Basics.zip
Download QB64 BAT, IconAdder and VBS shortcuts: QB64BAT.zip
QB64 SDL
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #29 on: September 22, 2010, 06:52:49 pm »
That is still part of the prototype stage Clippy. it is part of a wall nothing more
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
Print
Pages: 1 [2] 3 4 ... 78
« previous next »
QB64 Community »
Development »
Development (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Digital Knife Monkey Productions!!!!
 


SMF 2.0.3 | SMF © 2011, Simple Machines
XHTML
RSS
WAP2


« Last Edit: June 02, 2020, 08:39:55 PM by Richard »

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 809
  • Savage.
    • WFBarnes
Re: ₒ₀₁₄₇₈ ₀
« Reply #2 on: June 02, 2020, 08:58:13 PM »
Allllright.

So I'm gonna let people stare at this before we call it spam. Am I missing something here?

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 2116
  • LET IT = BE
    • QB64.org
Re: ₒ₀₁₄₇₈ ₀
« Reply #3 on: June 02, 2020, 08:59:25 PM »
Richard is apparently attempting to restore lost .net content.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2523
    • Steve’s QB64 Archive Forum
Re: ₒ₀₁₄₇₈ ₀
« Reply #4 on: June 02, 2020, 09:02:33 PM »
Richard is apparently attempting to restore lost .net content.

But what is it??  First thing I see is:

Quote
   
News:
Instructions for creating Android Apps:
http://www.qb64.net/forum/index.php?topic=13162.0

Is there any point at all to post information about Android App creation??  If this isn't that, then what is it?  What topic exactly is being shared here?
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 809
  • Savage.
    • WFBarnes
Re: ₒ₀₁₄₇₈ ₀
« Reply #5 on: June 02, 2020, 09:19:09 PM »
I'm with Steve. If someone's gonna do this, it needs to either be pre-digested nicely, or posted elsewhere. This is copy+paste from a spam site so far as I can see. Needless to say, off-topic.

Offline Cobalt

  • Forum Resident
  • Posts: 562
  • At 60 I become highly radioactive!
Re: ₒ₀₁₄₇₈ ₀
« Reply #6 on: June 02, 2020, 09:44:29 PM »
Well technically there is some code in there.... But a better layout would be better. or even just save the code and toss anything else.

Whats with the Micro-Font subject line?

OH HEY, missed it the first time through but there are posts from none other than Clippy in that!

Gotta save that for the nostalgia!
« Last Edit: June 02, 2020, 09:46:24 PM by Cobalt »
Granted after becoming radioactive I only have a half-life!

Offline bplus

  • Forum Resident
  • Posts: 4296
  • Chip off the old B+
Re: ₒ₀₁₄₇₈ ₀
« Reply #7 on: June 02, 2020, 10:17:53 PM »
Hey it's a super duper collision detector, pretty nice! for the 10 secs I've seen it work!
commented out duplicate mass in UDT and uncommented _limit in main loop
Code: QB64: [Select]
  1. '* nspace5.bas
  2. '$checking: off
  3. CONST NXDivs% = 16
  4. CONST NYDivs% = 16
  5. CONST NZDivs% = 16
  6. CONST ubst% = 2519
  7. CONST NDimensions% = 2
  8. CONST MaxObjectRadius% = 3
  9. MaxFPS% = 64
  10. DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
  11. DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
  12. cstart = 0: cend = 6.2
  13. REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
  14. REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
  15. '***********
  16. DIM SHARED text$
  17. text$ = "     D.K.M  Productions"
  18.  
  19. DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)
  20.  
  21. FOR i& = 0 TO ubst%
  22.     SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
  23.     CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
  24. oscreen& = _SCREENIMAGE
  25. MaxScreenX% = _WIDTH(oscreen&) / 2
  26. MaxScreenY% = _HEIGHT(oscreen&) / 2
  27. MaxScreenZ% = 0
  28. _FREEIMAGE oscreen&
  29. MinScreenX% = 0
  30. MinScreenY% = 0
  31. MinScreenZ% = 0
  32. ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
  33. ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
  34. ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
  35. NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
  36. NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
  37. NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%
  38.  
  39. TYPE Polygons
  40.     x AS SINGLE
  41.     y AS SINGLE
  42.     z AS SINGLE
  43.     mass AS SINGLE
  44.     radius AS INTEGER
  45.     speedx AS SINGLE
  46.     speedy AS SINGLE
  47.     speedz AS SINGLE
  48.     'mass AS SINGLE
  49.     nsides AS INTEGER
  50.     radius2 AS SINGLE
  51. REDIM b(0 TO 1) AS Polygons
  52. MaxPolys% = 127
  53. DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
  54. SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
  55. accum% = MaxObjectRadius%
  56. x% = MaxObjectRadius%
  57. y% = MaxObjectRadius%
  58. FOR i% = LBOUND(Polys) TO UBOUND(Polys)
  59.     Polys(i%).nsides = SetRand(3, 5)
  60.     Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
  61.     Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
  62.     Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
  63.     Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
  64.     Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
  65.     Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
  66.     Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
  67.     Polys(i%).COLOR = SetRand(43, 127)
  68.     Polys(i%).mass = Polys(i%).nsides \ 2 + 1
  69.     IF x% > MaxScreenX% - MaxObjectRadius% THEN
  70.         y% = y% + 2 * MaxObjectRadius%
  71.         x% = MaxObjectRadius%
  72.     ELSE
  73.         x% = x% + 2 * MaxObjectRadius%
  74.     END IF
  75.     Polys(i%).radius2 = Polys(i%).radius ^ 2
  76. DIM logo AS Polygons
  77. logo.z = 0
  78. logo.speedx = 0
  79. logo.speedy = 0
  80. logo.speedz = 0
  81. logo.mass = 1
  82. GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
  83. dimensionFlags% = 1
  84. TempX% = (NDimensions% - 1)
  85. BitSet% = 1
  86. WHILE TempX% > 0
  87.     dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
  88.     BitSet% = BitSet% + 1
  89.     TempX% = TempX% \ 2
  90. SCREEN GameScreen&
  91. logo.x = _WIDTH / 2
  92. logo.y = _HEIGHT / 2
  93. LOCATE 2, 1: PRINT text$;
  94. analyse
  95.     '_AUTODISPLAY
  96.         PlayerX% = _MOUSEX
  97.         PlayerY% = _MOUSEY
  98.         lmb% = _MOUSEBUTTON(1)
  99.         rmb% = _MOUSEBUTTON(2)
  100.     END IF
  101.     '* check to see if objects collide with each other
  102.     DIM row AS INTEGER, cnt AS INTEGER
  103.     DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER
  104.  
  105.     xrot = 6: yrot = 6: scale = 4
  106.  
  107.     OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63
  108.  
  109.     time! = TIMER
  110.     DO
  111.         CLS
  112.         row = 2
  113.         Ltime! = TIMER
  114.         DO
  115.  
  116.             DO
  117.                 'LINE (minx, miny)-(max, maxy), 0, BF
  118.                 minx = 32767
  119.                 miny = 32767
  120.                 FOR i = cstart TO cend STEP .04
  121.  
  122.                     x = (scale * 60 - (row * xrot)) * (COS(i))
  123.                     IF x < minx THEN
  124.                         minx = x
  125.                     END IF
  126.                     IF x > maxx THEN
  127.                         maxx = x
  128.                     END IF
  129.                     y = (scale * 60 - (row * yrot)) * (SIN(i))
  130.                     IF y < miny THEN
  131.                         miny = y
  132.                     END IF
  133.                     IF y > maxy THEN
  134.                         maxy = y
  135.                     END IF
  136.                     cnt = cnt + 1
  137.  
  138.                     IF word(cnt, row) > 0 THEN
  139.  
  140.                         CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
  141.                         PAINT STEP(0, 0), 1, 1
  142.  
  143.                     END IF
  144.  
  145.                     IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO
  146.  
  147.                 NEXT
  148.             LOOP
  149.  
  150.             row = row + 1
  151.  
  152.         LOOP UNTIL row = 16
  153.  
  154.         cend = cend + .1
  155.         cstart = cstart + .1
  156.         IF ABS(maxx) > ABS(maxy) THEN
  157.             logo.radius = ABS(maxx) / 2
  158.         ELSE
  159.             logo.radius = ABS(maxy) / 2
  160.         END IF
  161.         logo.mass = 1
  162.         logo.radius2 = logo.radius ^ 2
  163.         IF -1 THEN
  164.             FOR i% = LBOUND(polys) TO UBOUND(polys)
  165.                 IF Collision%(logo, Polys(i%), dimensionFlags%) THEN
  166.                     IF (logo.x = Polys(i%).x) THEN
  167.                         logo.speedx = (logo.radius / (scale ^ 2))
  168.                         logo.speedy = 1
  169.                     ELSE
  170.                         slope! = (logo.y - Polys(i%).y) / (logo.x - Polys(i%).x)
  171.                         IF Polys(i%).y >= logo.y THEN '* either going N or E (270-90)
  172.                             IF Polys(i%).x >= logo.x THEN 'going east
  173.                                 Theta! = slope! * 90
  174.                             ELSE 'going north
  175.                                 Theta! = 270 + slope! * 90
  176.                             END IF
  177.                         ELSE
  178.                             IF Polys(i%).x >= logo.x THEN
  179.                                 Theta! = 90 + slope! * 90
  180.                             ELSE
  181.                                 Theta! = 180 + 90 * slope!
  182.                             END IF
  183.                         END IF
  184.                         logo.speedx = logo.radius / (scale ^ 2) * COS(Theta! * 3.14159 / 180)
  185.                         logo.speedy = logo.radius / (scale ^ 2) * SIN(Theta! * 3.14159 / 180)
  186.                     END IF
  187.                     b(0) = logo
  188.                     b(1) = Polys(i%)
  189.                     CalcVelocities b(), 0, 1, dimensionFlags%
  190.                     Polys(i%) = b(1)
  191.                     Position Polys(i%), dimensionFlags%
  192.                     '* DrawPoly Polys(i%)
  193.                 ELSE
  194.                     Position Polys(i%), dimensionFlags%
  195.                     IF 0 THEN
  196.                         IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
  197.                             DrawPoly Polys(i%)
  198.                             'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
  199.                         ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
  200.                             DrawPoly Polys(i%)
  201.                             'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
  202.                         ELSE
  203.                             m% = (m% + 1) MOD 2
  204.                             IF m% THEN
  205.                                 Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
  206.                             ELSE
  207.                                 Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
  208.                             END IF
  209.                         END IF
  210.                     ELSE
  211.                         DrawPoly Polys(i%)
  212.                     END IF
  213.                     GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
  214.                     'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
  215.                     'IF CollidedWithPlayer% THEN
  216.                     'END IF
  217.                 END IF
  218.             NEXT
  219.         END IF
  220.         FOR ax% = 0 TO NXDivs%
  221.             FOR ay% = 0 TO NYDivs%
  222.                 FOR xj% = 0 TO counts%(ax%, ay%) - 1
  223.                     p1% = PolysInRegion%(ax%, ay%, xj%)
  224.                     FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
  225.                         p2% = PolysInRegion%(ax%, ay%, aj%)
  226.                         IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
  227.                             CalcVelocities Polys(), p1%, p2%, dimensionFlags%
  228.                         END IF
  229.                     NEXT
  230.  
  231.                 NEXT
  232.                 counts%(ax%, ay%) = 0
  233.             NEXT
  234.         NEXT
  235.         REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
  236.         Dtime! = ABS(TIMER - Ltime!)
  237.         IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
  238.             MaxPolys% = MaxPolys% + 1
  239.             REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
  240.             Polys(MaxPolys%).nsides = SetRand(3, 5)
  241.             Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
  242.             IF MaxPolys% MOD 2 THEN
  243.                 Polys(MaxPolys%).x = SetRand(MinScreenX% + Polys(i%).radius, MinScreenX% + Polys(i%).radius)
  244.                 Polys(MaxPolys%).y = SetRand(MinScreenY% + Polys(i%).radius, MinScreenY% + Polys(i%).radius)
  245.             ELSE
  246.                 Polys(MaxPolys%).x = SetRand(MaxScreenX% - Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
  247.                 Polys(MaxPolys%).y = SetRand(MaxScreenY% - Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
  248.             END IF
  249.             Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)
  250.  
  251.             Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
  252.             Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
  253.             Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
  254.             Polys(MaxPolys%).COLOR = SetRand(43, 127)
  255.             Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
  256.             Polys(i%).radius2 = Polys(i%).radius ^ 2
  257.         ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
  258.             MaxPolys% = MaxPolys% - 100
  259.             REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
  260.         END IF
  261.         _DISPLAY
  262.         _LIMIT 20
  263.     LOOP UNTIL ABS(TIMER - time!) > .15
  264. LOOP UNTIL INKEY$ > "" OR rmb%
  265.  
  266. SUB Position (P AS Polygons, flags%)
  267.     IF flags% AND 4 THEN
  268.         IF P.z + P.speedz < MinScreenZ% THEN
  269.             P.speedz = -P.speedz
  270.         ELSEIF P.z + P.speedz > MaxScreenZ% THEN
  271.             P.speedz = -P.speedz
  272.         END IF
  273.         P.z = P.z + P.speedz
  274.     END IF
  275.  
  276.     IF flags% AND 2 THEN
  277.         IF P.y + P.speedy < MinScreenY% THEN
  278.             P.speedy = -P.speedy
  279.         ELSEIF P.y + P.speedy > MaxScreenY% THEN
  280.             P.speedy = -P.speedy
  281.         END IF
  282.         P.y = P.y + P.speedy
  283.     END IF
  284.  
  285.     IF flags% AND 1 THEN
  286.         IF P.x + P.speedx < MinScreenX% THEN
  287.             P.speedx = -P.speedx
  288.         ELSEIF P.x + P.speedx > MaxScreenX% THEN
  289.             P.speedx = -P.speedx
  290.         END IF
  291.         P.x = P.x + P.speedx
  292.     END IF
  293.  
  294.  
  295. FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
  296.     IF (flags% AND 4) THEN
  297.         dx! = (T1.x - t2.x) ^ 2
  298.         dy! = (T1.y - t2.y) ^ 2
  299.         IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
  300.             Collision% = 0
  301.         ELSE
  302.             IF ABS(T1.z - t2.z) > (T1.radius + t2.radius) THEN
  303.                 Collision% = 0
  304.             ELSE
  305.                 Collision% = -1
  306.             END IF
  307.         END IF
  308.         EXIT FUNCTION
  309.     END IF
  310.     IF (flags% AND 2) THEN
  311.         dx! = (T1.x - t2.x) ^ 2
  312.         dy! = (T1.y - t2.y) ^ 2
  313.         IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
  314.             Collision% = 0
  315.         ELSE
  316.             Collision% = -1
  317.         END IF
  318.         EXIT FUNCTION
  319.     END IF
  320.     IF flags% AND 1 THEN
  321.         IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
  322.             Collision% = 0
  323.         ELSE
  324.             Collision% = -1
  325.         END IF
  326.         EXIT FUNCTION
  327.     END IF
  328.  
  329. FUNCTION SetRand% (MinValue%, MaxValue%)
  330.     SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
  331.  
  332. SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
  333.     IF radius% > 0 THEN
  334.         oldix% = -1
  335.         oldiy% = -1
  336.         FOR i% = -radius% TO radius% STEP radius%
  337.             SELECT CASE x%
  338.                 CASE MinSX% + radius% TO MaxSX% - radius%
  339.                     SELECT CASE y%
  340.                         CASE MinSY% + radius% TO MaxSY% - radius%
  341.                             ax% = (x% + i%) \ NxDivSize%
  342.                             ay% = (y% + i%) \ NyDivSize%
  343.                             IF ax% <> oldix% OR ay% <> oldiy% THEN
  344.                                 IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
  345.                                     REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
  346.                                 END IF
  347.                                 PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
  348.                                 counts%(ax%, ay%) = counts%(ax%, ay%) + 1
  349.                                 oldix% = ax%
  350.                                 oldiy% = ay%
  351.                             END IF
  352.                     END SELECT
  353.             END SELECT
  354.         NEXT
  355.     ELSE
  356.         ax% = (x%) \ NxDivSize%
  357.         ay% = (y%) \ NyDivSize%
  358.         PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
  359.         counts%(ax%, ay%) = counts%(ax%, ay%) + 1
  360.     END IF
  361.  
  362. SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
  363.     IF flags% AND 1 THEN
  364.         temp1 = b(i&).speedx
  365.         temp2 = b(j&).speedx
  366.         totalMass = (b(i&).mass + b(j&).mass)
  367.         b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  368.         b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
  369.     ELSE
  370.         EXIT SUB
  371.     END IF
  372.     IF flags% AND 2 THEN
  373.         temp1 = b(i&).speedy
  374.         temp2 = b(j&).speedy
  375.         b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  376.         b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
  377.     ELSE
  378.         EXIT SUB
  379.     END IF
  380.     IF flags% AND 4 THEN
  381.         temp1 = b(i&).speedz
  382.         temp2 = b(j&).speedz
  383.         b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  384.         b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
  385.     ELSE
  386.         EXIT SUB
  387.     END IF
  388.  
  389. SUB DrawPoly (T AS Polygons)
  390.     IF T.nsides > 0 THEN
  391.         IF T.radius > 0 THEN
  392.             CircleStepDeg% = (ubst% + 1) / T.nsides
  393.             Newx = T.x + T.radius * CosTable!(0)
  394.             Newy = T.y + T.radius * SinTable!(0)
  395.             angle% = 0
  396.             fpx = Newx
  397.             fpy = Newy
  398.             angle% = CircleStepDeg%
  399.             DO
  400.                 IF angle% > ubst% THEN
  401.                     LINE (fpx, fpy)-(Newx, Newy), T.COLOR
  402.                     EXIT DO
  403.                 ELSE
  404.                     lastx = Newx
  405.                     lasty = Newy
  406.                     Newx = T.x + T.radius * CosTable!(angle%)
  407.                     Newy = T.y + T.radius * SinTable!(angle%)
  408.                     LINE (lastx, lasty)-(Newx, Newy), T.COLOR
  409.                     angle% = angle% + CircleStepDeg%
  410.                 END IF
  411.             LOOP
  412.         ELSE
  413.             PSET (T.x, T.y), T.COLOR
  414.         END IF
  415.     ELSE
  416.         PSET (T.x, T.y), T.COLOR
  417.     END IF
  418.  
  419. SUB analyse
  420.     COLOR 2: LOCATE 1, 1: PRINT text$
  421.  
  422.     DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER
  423.  
  424.     px = 1: py = 1
  425.  
  426.     DO
  427.  
  428.         word(px, py) = POINT(px, py)
  429.  
  430.         PSET (px, py), 1
  431.         px = px + 1
  432.  
  433.         IF px = LEN(text$) * 8 THEN
  434.  
  435.             px = 1
  436.             py = py + 1
  437.  
  438.         END IF
  439.  
  440.     LOOP UNTIL py = 16
  441.  
  442.  
  443.  

BTW from reply #26
« Last Edit: June 02, 2020, 11:15:26 PM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 4296
  • Chip off the old B+
Re: ₒ₀₁₄₇₈ ₀
« Reply #8 on: June 02, 2020, 10:49:20 PM »
Looks like Richard posted the most popular thread from net and the Android crap at top was what was the Header at the forum at the time.

It has 78 pages where is the rest of it? LOL

@Richard you might give this thread a snappy title like the most viewed thread at Net. A number doesn't do it justice.
« Last Edit: June 02, 2020, 11:17:36 PM by bplus »

Offline codeguy

  • Forum Regular
  • Posts: 178
Re: ₒ₀₁₄₇₈ ₀
« Reply #9 on: June 02, 2020, 11:29:40 PM »
That's my semi-famous NSpace collision detection algorithm and DarthWho effects with physically correct rebounds. IsItFast? Yes. No _LIMIT o_O :). Thanks for the complement, BPlus.
« Last Edit: June 02, 2020, 11:32:15 PM by codeguy »

Offline bplus

  • Forum Resident
  • Posts: 4296
  • Chip off the old B+
Re: ₒ₀₁₄₇₈ ₀
« Reply #10 on: June 02, 2020, 11:59:39 PM »
That's my semi-famous NSpace collision detection algorithm and DarthWho effects with physically correct rebounds. IsItFast? Yes. No _LIMIT o_O :). Thanks for the complement, BPlus.

Oh hey you, @codeguy, at 3986 posts THEN! I am just getting close to that now about 55 to go! LOL

Offline Richard

  • Forum Regular
  • Posts: 118
o01478-03


Quote



 
 

   
News:

Instructions for creating Android Apps:
http://www.qb64.net/forum/index.php?topic=13162.0


Home
Help
Search
Login
Register

QB64 Community »
Development »
Development (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Digital Knife Monkey Productions!!!!

« previous next »
Print
Pages: 1 2 [3] 4 5 ... 78
 Author Topic: Digital Knife Monkey Productions!!!!  (Read 96047 times)

DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #30 on: September 22, 2010, 08:29:09 pm »
within five days i will release the preliminary code for the puzzle editor for the puzzle game that uses the water simulation engine it will be posted in it's topic so look for that herehttp://www.qb64.net/forum/index.php?topic=1379.135 it will be there and you will need jpgs to link to the puzzles that you create
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #31 on: September 23, 2010, 04:24:03 am »
hey does anyone know if either _LOADIMAGE and then repeatedly using _PUTIMAGE or _LOADIMAGE _PUTIMAGE GET then repeatedly PUTting is faster?
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #32 on: September 23, 2010, 08:22:20 am »
Once you load it, you have it until you free it. You can _putimage it anywhere, even on top of itself!! Using _display after all drawing/putting is done will help a bit also. As qb64 exists, PUT & GET for graphics are now pretty much defunct. There is a thread in QB64 samples on _Putimage. http://www.qb64.net/forum/index.php?topic=1281.0 the link to my work with _putimage is on page 4. Need anyhelp, fell fre to ask as _putimage is one of my strengths in QB64.
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
Clippy

Hero Member

 
Posts: 19402
I LOVE π = 4 * ATN(1)    Use the QB64 WIKI >>>


Re: Digital Knife Monkey Productions!!!!

« Reply #33 on: September 23, 2010, 08:37:10 am »
_PUTIMAGE cannot PUT using AND, OR, PSET, PRESET or XOR.

GET can place the image into an array that QB64 can save to a Binary file using PUT #.

So they ARE NOT DEFUNCT!
 Logged
QB64 WIKI: Main Page
Download Q-Basics Demo: Q-Basics.zip
Download QB64 BAT, IconAdder and VBS shortcuts: QB64BAT.zip
QB64 SDL
unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #34 on: September 23, 2010, 09:25:54 am »
Fair enough...but, POINT can put image data into an array, and the array will only need to be the exact size of the image, rather than the annoyingly odd sized arrays needed with GET. Why  would you want a binary file of an image? Now days we just use the image! No need for saving memory as i have an abundance of it, so they are DEFUNCT in regards to the way I program, I am glad you still find them usefull though.

But it raises a good question. Which is faster? GETing a binary image file, and then PUTing it, or _LOADIMAGEing and then _PUTIMAGEing? I dont use GET/PUT for graphics so i cant really test it.

Newskool vs. Oldskool - round 1 DING DING!!
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #35 on: September 23, 2010, 09:30:29 am »
well there is one thing that i do know for uniform speed one can never beat a good formula but that does not play nice with images...

EDIT: unless the image is self referential of course.
« Last Edit: September 23, 2010, 05:01:37 pm by DarthWho »
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
Clippy

Hero Member

 
Posts: 19402
I LOVE π = 4 * ATN(1)    Use the QB64 WIKI >>>


Re: Digital Knife Monkey Productions!!!!

« Reply #36 on: September 23, 2010, 05:27:45 pm »
I WIN canvas back! 

GET is DEFINITELY faster than POINT!

Time of round: .0000001 seconds
 Logged
QB64 WIKI: Main Page
Download Q-Basics Demo: Q-Basics.zip
Download QB64 BAT, IconAdder and VBS shortcuts: QB64BAT.zip
QB64 SDL
unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #37 on: September 23, 2010, 05:57:34 pm »
No doubt get beats point, but what about get/put vs _loadimage/_putimage???

ROUND TWO...and i did not know qb could be so precise with timing!!! DING DING
 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #38 on: September 23, 2010, 07:04:06 pm »
it is called doing it 10,000,000 times that adds up to a one second difference in the end... divide that by 10,000,000 and you get .0000001 seconds i will hopefully answer the question soon.
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #39 on: September 23, 2010, 07:49:21 pm »
Due to time constraints i had to limit the number of iterations but it still works. the end results for the runs
_PUTIMAGE is faster but only just barely (comparison using pset option on put)
« Last Edit: September 24, 2010, 06:43:06 am by DarthWho »
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #40 on: September 24, 2010, 11:15:25 am »
Code: [Select]
'* nspace9.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 64
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "  DKM Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
QuarterPi% = (ubst% + 1) / 4
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) * .4
MaxScreenY% = _HEIGHT(oscreen&) * .4
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS SINGLE
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS SINGLE
    nsides AS INTEGER
    radius2 AS SINGLE
END TYPE
REDIM b(0 TO 1) AS Polygons
MaxPolys% = 127
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    Polys(i%).nsides = SetRand(3, 5)
    Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
    Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
    Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
    Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
    Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
    Polys(i%).color = SetRand(43, 127)
    Polys(i%).mass = Polys(i%).nsides \ 2 + 1
    IF x% > MaxScreenX% - MaxObjectRadius% THEN
        y% = y% + 2 * MaxObjectRadius%
        x% = MaxObjectRadius%
    ELSE
        x% = x% + 2 * MaxObjectRadius%
    END IF
    Polys(i%).radius2 = Polys(i%).radius ^ 2
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    DIM row AS INTEGER, cnt AS INTEGER
    DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

    xrot = 6: yrot = 10: scale = 5

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    time! = TIMER
    DO
        CLS
        row = 2
        Ltime! = TIMER
        DO

            DO
                'LINE (minx, miny)-(max, maxy), 0, BF
                minx = 32767
                miny = 32767
                FOR i = cstart TO cend STEP 1 / (LEN(text$) * 1.2)

                    x = (scale * 60 - (row * xrot)) * (COS(i))
                    IF x < minx THEN
                        minx = x
                    END IF
                    IF x > maxx THEN
                        maxx = x
                    END IF
                    y = (scale * 60 - (row * yrot)) * (SIN(i))
                    IF y < miny THEN
                        miny = y
                    END IF
                    IF y > maxy THEN
                        maxy = y
                    END IF
                    cnt = cnt + 1

                    IF word(cnt, row) > 0 THEN
                        m! = 1
                        stepx% = 0
                        WHILE m! < 5
                            IF stepx% MOD 2 THEN
                                CIRCLE ((y * -1) / (2 ^ m!) - m! + _WIDTH / 2, (x * -1) / (2 ^ m!) + m! + _HEIGHT / 2), 1, 1
                            ELSE
                                CIRCLE (x / (2 ^ m!) - m! + _WIDTH / 2, y / (2 ^ m!) + m! + _HEIGHT / 2), 1, 1
                            END IF
                            IF m! < 5 THEN
                                PAINT STEP(0, 0), 1, 1
                            END IF
                            m! = m! + (1 / 2)
                            stepx% = stepx% + 1
                        WEND
                    END IF

                    IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

                NEXT
            LOOP

            row = row + 1

        LOOP UNTIL row = 16
        _LIMIT 15
        cend = cend + .1
        cstart = cstart + .1
    LOOP UNTIL ABS(TIMER - time!) > .15
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF

IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF

IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF

END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
IF T1.nsides = 4 THEN
    MaxD! = T1.radius + t2.radius
    dist! = ABS(T1.x - t2.x) + ABS(T1.y - t2.y)
ELSE
    MaxD! = (T1.radius2 + t2.radius2)
    dist! = (T1.x - t2.x) ^ 2 + (T1.y - t2.y) ^ 2
END IF
zd! = T1.radius + t2.radius
IF (flags% AND 4) THEN
    IF dist! > MaxD! THEN
        Collision% = 0
    ELSE
        IF ABS(T1.z - t2.z) > zd! THEN
            Collision% = 0
        ELSE
            Collision% = -1
        END IF
    END IF
    EXIT FUNCTION
END IF
IF (flags% AND 2) THEN
    IF dist! > MaxD! THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
    EXIT FUNCTION
END IF
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > zd! THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
    EXIT FUNCTION
END IF
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB

FUNCTION ThetaQ! (p1 AS Polygons, p2 AS Polygons, quadrant)
IF p1.y >= p2.y THEN '* either going N or E (270-90)
    IF p1.x >= p2.x THEN '* going east
        quadrant = 1
    ELSE 'going north
        qudrant = 4
    END IF
ELSE
    IF p1.x >= p2.x THEN
        quadrant = 2
    ELSE
        quadrant = 3
    END IF
END IF
ThetaQ! = (quadrant - 1) * 90 + 90 * slope
END FUNCTION
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
unseenmachine

Hero Member

 
Posts: 3663
Make the Game not the ENGINE!!!

Re: Digital Knife Monkey Productions!!!!

« Reply #41 on: September 24, 2010, 12:23:46 pm »
NICE!!! Thats really neat CodeGuy! I have modded it, though I've just changes the xrot yrot values, what do you think.

Code: [Select]
'* nspace9.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 64
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = "  DKM Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
  SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
  CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
QuarterPi% = (ubst% + 1) / 4
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) * .4
MaxScreenY% = _HEIGHT(oscreen&) * .4
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
  x AS SINGLE
  y AS SINGLE
  z AS SINGLE
  mass AS SINGLE
  radius AS INTEGER
  speedx AS SINGLE
  speedy AS SINGLE
  speedz AS SINGLE
  color AS INTEGER
  mass AS SINGLE
  nsides AS INTEGER
  radius2 AS SINGLE
END TYPE
REDIM b(0 TO 1) AS Polygons
MaxPolys% = 127
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
  Polys(i%).nsides = SetRand(3, 5)
  Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
  Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
  Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
  Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
  Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
  Polys(i%).color = SetRand(43, 127)
  Polys(i%).mass = Polys(i%).nsides \ 2 + 1
  IF x% > MaxScreenX% - MaxObjectRadius% THEN
    y% = y% + 2 * MaxObjectRadius%
    x% = MaxObjectRadius%
  ELSE
    x% = x% + 2 * MaxObjectRadius%
  END IF
  Polys(i%).radius2 = Polys(i%).radius ^ 2
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
  dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
  BitSet% = BitSet% + 1
  TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO
  '_AUTODISPLAY
  IF _MOUSEINPUT THEN
    PlayerX% = _MOUSEX
    PlayerY% = _MOUSEY
    lmb% = _MOUSEBUTTON(1)
    rmb% = _MOUSEBUTTON(2)
  END IF
  '* check to see if objects collide with each other
  DIM row AS INTEGER, cnt AS INTEGER
  DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

  xrot = 16: yrot = 1: scale = 5

  OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

  time! = TIMER
  DO
    CLS
    row = 2
    Ltime! = TIMER
    DO

      DO
        'LINE (minx, miny)-(max, maxy), 0, BF
        minx = 32767
        miny = 32767
        FOR i = cstart TO cend STEP 1 / (LEN(text$) * 1.2)

          x = (scale * 60 - (row * xrot)) * (COS(i))
          IF x < minx THEN
            minx = x
          END IF
          IF x > maxx THEN
            maxx = x
          END IF
          y = (scale * 60 - (row * yrot)) * (SIN(i))
          IF y < miny THEN
            miny = y
          END IF
          IF y > maxy THEN
            maxy = y
          END IF
          cnt = cnt + 1

          IF word(cnt, row) > 0 THEN
            m! = 1
            stepx% = 0
            WHILE m! < 5
              IF stepx% MOD 2 THEN
                CIRCLE ((y * -1) / (2 ^ m!) - m! + _WIDTH / 2, (x * -1) / (2 ^ m!) + m! + _HEIGHT / 2), 1, 1
              ELSE
                CIRCLE (x / (2 ^ m!) - m! + _WIDTH / 2, y / (2 ^ m!) + m! + _HEIGHT / 2), 1, 1
              END IF
              IF m! < 5 THEN
                PAINT STEP(0, 0), 1, 1
              END IF
              m! = m! + (1 / 2)
              stepx% = stepx% + 1
            WEND
          END IF

          IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

        NEXT
      LOOP

      row = row + 1

    LOOP UNTIL row = 16
    _LIMIT 10
    cend = cend + .1
    cstart = cstart + .1
  LOOP UNTIL ABS(TIMER - time!) > .15
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 4 THEN
  IF P.z + P.speedz < MinScreenZ% THEN
    P.speedz = -P.speedz
  ELSEIF P.z + P.speedz > MaxScreenZ% THEN
    P.speedz = -P.speedz
  END IF
  P.z = P.z + P.speedz
END IF

IF flags% AND 2 THEN
  IF P.y + P.speedy < MinScreenY% THEN
    P.speedy = -P.speedy
  ELSEIF P.y + P.speedy > MaxScreenY% THEN
    P.speedy = -P.speedy
  END IF
  P.y = P.y + P.speedy
END IF

IF flags% AND 1 THEN
  IF P.x + P.speedx < MinScreenX% THEN
    P.speedx = -P.speedx
  ELSEIF P.x + P.speedx > MaxScreenX% THEN
    P.speedx = -P.speedx
  END IF
  P.x = P.x + P.speedx
END IF

END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
IF T1.nsides = 4 THEN
  MaxD! = T1.radius + t2.radius
  dist! = ABS(T1.x - t2.x) + ABS(T1.y - t2.y)
ELSE
  MaxD! = (T1.radius2 + t2.radius2)
  dist! = (T1.x - t2.x) ^ 2 + (T1.y - t2.y) ^ 2
END IF
zd! = T1.radius + t2.radius
IF (flags% AND 4) THEN
  IF dist! > MaxD! THEN
    Collision% = 0
  ELSE
    IF ABS(T1.z - t2.z) > zd! THEN
      Collision% = 0
    ELSE
      Collision% = -1
    END IF
  END IF
  EXIT FUNCTION
END IF
IF (flags% AND 2) THEN
  IF dist! > MaxD! THEN
    Collision% = 0
  ELSE
    Collision% = -1
  END IF
  EXIT FUNCTION
END IF
IF flags% AND 1 THEN
  IF ABS(T1.x - t2.x) > zd! THEN
    Collision% = 0
  ELSE
    Collision% = -1
  END IF
  EXIT FUNCTION
END IF
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
  oldix% = -1
  oldiy% = -1
  FOR i% = -radius% TO radius% STEP radius%
    SELECT CASE x%
      CASE MinSX% + radius% TO MaxSX% - radius%
        SELECT CASE y%
          CASE MinSY% + radius% TO MaxSY% - radius%
            ax% = (x% + i%) \ NxDivSize%
            ay% = (y% + i%) \ NyDivSize%
            IF ax% <> oldix% OR ay% <> oldiy% THEN
              IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
              END IF
              PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
              counts%(ax%, ay%) = counts%(ax%, ay%) + 1
              oldix% = ax%
              oldiy% = ay%
            END IF
        END SELECT
    END SELECT
  NEXT
ELSE
  ax% = (x%) \ NxDivSize%
  ay% = (y%) \ NyDivSize%
  PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
  counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
  temp1 = b(i&).speedx
  temp2 = b(j&).speedx
  totalMass = (b(i&).mass + b(j&).mass)
  b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
IF flags% AND 2 THEN
  temp1 = b(i&).speedy
  temp2 = b(j&).speedy
  b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
IF flags% AND 4 THEN
  temp1 = b(i&).speedz
  temp2 = b(j&).speedz
  b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
  EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
  IF T.radius > 0 THEN
    CircleStepDeg% = (ubst% + 1) / T.nsides
    Newx = T.x + T.radius * CosTable!(0)
    Newy = T.y + T.radius * SinTable!(0)
    angle% = 0
    fpx = Newx
    fpy = Newy
    angle% = CircleStepDeg%
    DO
      IF angle% > ubst% THEN
        LINE (fpx, fpy)-(Newx, Newy), T.color
        EXIT DO
      ELSE
        lastx = Newx
        lasty = Newy
        Newx = T.x + T.radius * CosTable!(angle%)
        Newy = T.y + T.radius * SinTable!(angle%)
        LINE (lastx, lasty)-(Newx, Newy), T.color
        angle% = angle% + CircleStepDeg%
      END IF
    LOOP
  ELSE
    PSET (T.x, T.y), T.color
  END IF
ELSE
  PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

  word(px, py) = POINT(px, py)

  PSET (px, py), 1
  px = px + 1

  IF px = LEN(text$) * 8 THEN

    px = 1
    py = py + 1

  END IF

LOOP UNTIL py = 16

END SUB

FUNCTION ThetaQ! (p1 AS Polygons, p2 AS Polygons, quadrant)
IF p1.y >= p2.y THEN '* either going N or E (270-90)
  IF p1.x >= p2.x THEN '* going east
    quadrant = 1
  ELSE 'going north
    qudrant = 4
  END IF
ELSE
  IF p1.x >= p2.x THEN
    quadrant = 2
  ELSE
    quadrant = 3
  END IF
END IF
ThetaQ! = (quadrant - 1) * 90 + 90 * slope
END FUNCTION




 Logged
UnseenGDK Download : https://www.dropbox.com/s/vn1m3aqj21jnp3d/UnseenGDK.bm?dl=0
GDK Tutorial : https://www.dropbox.com/s/9a3z0x0spleexd8/UnseenGDK_Tutorial.pdf?dl=0
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #42 on: September 24, 2010, 12:41:32 pm »
now if we could just find a way to create a title-barless output window (besides fullscreen), this would be a complete knockout! and by the way, the previous version contains a correct way to keep stuff from smacking the logo if we wanna do something dynamic. and it would also be good for the plasma effect. just make sure you plot the polys as points and do not call calcvelocities after a collision. just don't plot the point if Collision% returns true. i have done the hard part, now take my polyarray, create a bunch of zero-radius one-dimensionsonal polys and make us proud, unseen! umm, we could get our DKM chief (DarthWho) to do the next mod!
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
codeguy

Hero Member

Posts: 3986
what the h3ll did i name that code?


Re: Digital Knife Monkey Productions!!!!

« Reply #43 on: September 24, 2010, 01:36:45 pm »
another interesting version
Code: [Select]
'* nspace5.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 64
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$
text$ = " Team DKM Productions"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
    SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
    CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
QuarterPi% = (ubst% + 1) / 4
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) * .5
MaxScreenY% = _HEIGHT(oscreen&) * .5
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    mass AS SINGLE
    radius AS INTEGER
    speedx AS SINGLE
    speedy AS SINGLE
    speedz AS SINGLE
    color AS INTEGER
    mass AS SINGLE
    nsides AS INTEGER
    radius2 AS SINGLE
END TYPE
REDIM b(0 TO 1) AS Polygons
MaxPolys% = 127
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
    CreateNewPolys Polys(), i%
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
    dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
    BitSet% = BitSet% + 1
    TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO
    '_AUTODISPLAY
    IF _MOUSEINPUT THEN
        PlayerX% = _MOUSEX
        PlayerY% = _MOUSEY
        lmb% = _MOUSEBUTTON(1)
        rmb% = _MOUSEBUTTON(2)
    END IF
    '* check to see if objects collide with each other
    DIM row AS INTEGER, cnt AS INTEGER
    DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

    xrot = 6: yrot = 10: scale = 5

    OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

    time! = TIMER
    DO
        CLS
        row = 2
        Ltime! = TIMER
        DO

            DO
                'LINE (minx, miny)-(max, maxy), 0, BF
                minx = 32767
                miny = 32767
                FOR i = cstart TO cend STEP .04

                    x = (scale * 60 - (row * xrot)) * (COS(i))
                    IF x < minx THEN
                        minx = x
                    END IF
                    IF x > maxx THEN
                        maxx = x
                    END IF
                    y = (scale * 60 - (row * yrot)) * (SIN(i))
                    IF y < miny THEN
                        miny = y
                    END IF
                    IF y > maxy THEN
                        maxy = y
                    END IF
                    cnt = cnt + 1

                    IF word(cnt, row) > 0 THEN
                        m! = 1
                        stepx% = 0
                        WHILE m! < 5
                            IF stepx% MOD 2 THEN
                                CIRCLE ((y * -1) / (2 ^ m!) - m! + _WIDTH / 2, (x * -1) / (2 ^ m!) + m! + _HEIGHT / 2), 1, 1
                            ELSE
                                CIRCLE (x / (2 ^ m!) - m! + _WIDTH / 2, y / (2 ^ m!) + m! + _HEIGHT / 2), 1, 1
                            END IF
                            IF m! < 1.5 THEN
                                PAINT STEP(0, 0), 1, 1
                            END IF
                            m! = m! + (1 / 2)
                            stepx% = stepx% + 1
                        WEND
                    END IF

                    IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

                NEXT
            LOOP

            row = row + 1

        LOOP UNTIL row = 16

        cend = cend + .1
        cstart = cstart + .1
        IF ABS(maxx) > ABS(maxy) THEN
            logo.radius = ABS(maxx) / 2
        ELSE
            logo.radius = ABS(maxy) / 2
        END IF
        logo.mass = 1
        logo.radius2 = logo.radius ^ 2
        IF -1 THEN
            FOR i% = LBOUND(polys) TO UBOUND(polys)
                IF Collision%(logo, Polys(i%), dimensionFlags%) THEN
                    IF (logo.x = Polys(i%).x) THEN
                        logo.speedx = (logo.radius / (scale ^ 2))
                        logo.speedy = 1
                    ELSE

                        slope! = (logo.y - Polys(i%).y) / (logo.x - Polys(i%).x)
                        IF Polys(i%).y < logo.y THEN '* going S or W
                            IF Polys(i%).x < logo.x THEN '* west
                                Theta! = 2 * QuarterPi% + QuarterPi% * slope!
                            ELSE '* south
                                Theta! = QuarterPi% + slope! * QuarterPi%
                            END IF
                        ELSE '* either going N or E (270-90)
                            IF Polys(i%).x < logo.x THEN 'going north
                                Theta! = 3 * QuarterPi% + slope! * QuarterPi%
                            ELSE 'going east
                                Theta! = slope! * QuarterPi%
                            END IF
                        END IF
                        Theta! = ABS(Theta! MOD (ubst% + 1))
                        logo.speedx = logo.radius / (scale ^ 2) * CosTable!(Theta!)
                        logo.speedy = logo.radius / (scale ^ 2) * SinTable!(Theta!)
                    END IF
                    b(0) = logo
                    b(1) = Polys(i%)
                    'CalcVelocities b(), 0, 1, dimensionFlags%
                    Polys(i%) = b(1)
                    Position Polys(i%), dimensionFlags%
                    '* DrawPoly Polys(i%)
                ELSE
                    Position Polys(i%), dimensionFlags%
                    IF 0 THEN
                        IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
                            DrawPoly Polys(i%)
                            'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
                        ELSE
                            m% = (m% + 1) MOD 2
                            IF m% THEN
                                Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
                            ELSE
                                Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
                            END IF
                        END IF
                    ELSE
                        DrawPoly Polys(i%)
                    END IF
                    GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
                    'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
                    'IF CollidedWithPlayer% THEN
                    'END IF
                END IF
            NEXT
        END IF
        FOR ax% = 0 TO NXDivs%
            FOR ay% = 0 TO NYDivs%
                FOR xj% = 0 TO counts%(ax%, ay%) - 1
                    p1% = PolysInRegion%(ax%, ay%, xj%)
                    FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
                        p2% = PolysInRegion%(ax%, ay%, aj%)
                        IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
                            'CalcVelocities Polys(), p1%, p2%, dimensionFlags%
                        END IF
                    NEXT

                NEXT
                counts%(ax%, ay%) = 0
            NEXT
        NEXT
        REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
        Dtime! = ABS(TIMER - Ltime!)
        IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
            MaxPolys% = MaxPolys% + 1
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
            CreateNewPolys Polys(), MaxPolys%
        ELSE 'IF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
            MaxPolys% = MaxPolys% - 100
            REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
        END IF
        _DISPLAY
        '_LIMIT 20
    LOOP UNTIL ABS(TIMER - time!) > .15
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 4 THEN
    IF P.z + P.speedz < MinScreenZ% THEN
        P.speedz = -P.speedz
    ELSEIF P.z + P.speedz > MaxScreenZ% THEN
        P.speedz = -P.speedz
    END IF
    P.z = P.z + P.speedz
END IF

IF flags% AND 2 THEN
    IF P.y + P.speedy < MinScreenY% THEN
        P.speedy = -P.speedy
    ELSEIF P.y + P.speedy > MaxScreenY% THEN
        P.speedy = -P.speedy
    END IF
    P.y = P.y + P.speedy
END IF

IF flags% AND 1 THEN
    IF P.x + P.speedx < MinScreenX% THEN
        P.speedx = -P.speedx
    ELSEIF P.x + P.speedx > MaxScreenX% THEN
        P.speedx = -P.speedx
    END IF
    P.x = P.x + P.speedx
END IF

END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
IF T1.nsides = 4 THEN
    MaxD! = T1.radius + t2.radius
    dist! = ABS(T1.x - t2.x) + ABS(T1.y - t2.y)
ELSE
    MaxD! = (T1.radius2 + t2.radius2)
    dist! = (T1.x - t2.x) ^ 2 + (T1.y - t2.y) ^ 2
END IF
zd! = T1.radius + t2.radius
IF (flags% AND 4) THEN
    IF dist! > MaxD! THEN
        Collision% = 0
    ELSE
        IF ABS(T1.z - t2.z) > zd! THEN
            Collision% = 0
        ELSE
            Collision% = -1
        END IF
    END IF
    EXIT FUNCTION
END IF
IF (flags% AND 2) THEN
    IF dist! > MaxD! THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
    EXIT FUNCTION
END IF
IF flags% AND 1 THEN
    IF ABS(T1.x - t2.x) > zd! THEN
        Collision% = 0
    ELSE
        Collision% = -1
    END IF
    EXIT FUNCTION
END IF
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
    oldix% = -1
    oldiy% = -1
    FOR i% = -radius% TO radius% STEP radius%
        SELECT CASE x%
            CASE MinSX% + radius% TO MaxSX% - radius%
                SELECT CASE y%
                    CASE MinSY% + radius% TO MaxSY% - radius%
                        ax% = (x% + i%) \ NxDivSize%
                        ay% = (y% + i%) \ NyDivSize%
                        IF ax% <> oldix% OR ay% <> oldiy% THEN
                            IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
                                REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
                            END IF
                            PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
                            counts%(ax%, ay%) = counts%(ax%, ay%) + 1
                            oldix% = ax%
                            oldiy% = ay%
                        END IF
                END SELECT
        END SELECT
    NEXT
ELSE
    ax% = (x%) \ NxDivSize%
    ay% = (y%) \ NyDivSize%
    PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
    counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
    temp1 = b(i&).speedx
    temp2 = b(j&).speedx
    totalMass = (b(i&).mass + b(j&).mass)
    b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 2 THEN
    temp1 = b(i&).speedy
    temp2 = b(j&).speedy
    b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
IF flags% AND 4 THEN
    temp1 = b(i&).speedz
    temp2 = b(j&).speedz
    b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
    b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
    EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
    IF T.radius > 0 THEN
        CircleStepDeg% = (ubst% + 1) / T.nsides
        Newx = T.x + T.radius * CosTable!(0)
        Newy = T.y + T.radius * SinTable!(0)
        angle% = 0
        fpx = Newx
        fpy = Newy
        angle% = CircleStepDeg%
        DO
            IF angle% > ubst% THEN
                LINE (fpx, fpy)-(Newx, Newy), T.color
                EXIT DO
            ELSE
                lastx = Newx
                lasty = Newy
                Newx = T.x + T.radius * CosTable!(angle%)
                Newy = T.y + T.radius * SinTable!(angle%)
                LINE (lastx, lasty)-(Newx, Newy), T.color
                angle% = angle% + CircleStepDeg%
            END IF
        LOOP
    ELSE
        PSET (T.x, T.y), T.color
    END IF
ELSE
    PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1
    px = px + 1

    IF px = LEN(text$) * 8 THEN

        px = 1
        py = py + 1

    END IF

LOOP UNTIL py = 16

END SUB

FUNCTION ThetaQ! (p1 AS Polygons, p2 AS Polygons, quadrant)
IF p1.y >= p2.y THEN '* either going N or E (270-90)
    IF p1.x >= p2.x THEN '* going east
        quadrant = 1
    ELSE 'going north
        qudrant = 4
    END IF
ELSE
    IF p1.x >= p2.x THEN
        quadrant = 2
    ELSE
        quadrant = 3
    END IF
END IF
ThetaQ! = (quadrant - 1) * 90 + 90 * slope
END FUNCTION

SUB CreateNewPolys (Polys() AS Polygons, i%)
Polys(i%).nsides = 3 'SetRand(3, 5)
Polys(i%).radius = 2 'MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
Polys(i%).speedx = SetRand(1, 5)
Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
Polys(i%).speedy = SetRand(1, 5)
Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
Polys(i%).color = SetRand(43, 127)
Polys(i%).mass = Polys(i%).nsides \ 2 + 1
IF x% > MaxScreenX% - MaxObjectRadius% THEN
    y% = y% + 2 * MaxObjectRadius%
    x% = MaxObjectRadius%
ELSE
    x% = x% + 2 * MaxObjectRadius%
END IF
Polys(i%).radius2 = Polys(i%).radius ^ 2
END SUB
 Logged
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html
DarthWho

Hero Member

 
Posts: 4039
Timelord of the Sith

Re: Digital Knife Monkey Productions!!!!

« Reply #44 on: September 24, 2010, 01:56:00 pm »
o come on what happened to me doing the next mod codeguy? but i digress..

I like the idea of a barless window and i will look into how to do that... If anyone else want's to help with that it is technically called a borderless form. By the way which C language does galleon use (C++,C#)? Because if this cannot be accessed through Shell or something like that there seem to be two options:
1 giving up (not suggested)
2 getting Galleon to include some form of _FORMBORDERSTYLE command if he can do this I can try to supply source i have friends who program in both C++ and C#.
by the way I have to study the code for the current icon system then i will supply a mod.
 Logged
FastMath 1.1.0 released: http://dl.dropbox.com/u/12359848/fastmath.h

BTC: 1DGmy7rBZ15Y1nFJXkoE8BkvmMu6DxSMM4
LTC: LRNzAapRvQEuuEGwuLTG1f6nuHaf7tqkn7
Print
Pages: 1 2 [3] 4 5 ... 78
« previous next »
QB64 Community »
Development »
Development (Moderators: Galleon, OlDosLover, SMcNeill, Kobolt) »
Digital Knife Monkey Productions!!!!
 


SMF 2.0.3 | SMF © 2011, Simple Machines
XHTML
RSS
WAP2


Offline Unseen Machine

  • Forum Regular
  • Posts: 102
  • QB64 Elite
I cant understand why someone would post that dump of our old website, but it was nice to see code i wrote a decade ago...and yes Clippy was defo about, he's one of the people that taught me to code!