• Print

Author Topic: Digital Knife Monkey Productions!!!!  (Read 23560 times)

DarthWho

  • Hero Member
  • *****
  • Posts: 3853
  • 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 »
Rassilon: My lord Doctor; My lord Master; My lord DarthWho
The Doctor and the master at the same time :WHAT!?!?!

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

unseenmachine

  • Hero Member
  • *****
  • Posts: 3285
  • A fish, a fish, a fishy o!
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
UnseenGDK Download : http://dl.dropbox.com/u/8822351/UnseenGDK.bm
GDK Tutorial : http://dl.dropbox.com/u/8822351/UnseenGDK_Tutorial.doc
VQB02 : http://dl.dropbox.com/u/8822351/VQB02.zip

DarthWho

  • Hero Member
  • *****
  • Posts: 3853
  • 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)
Rassilon: My lord Doctor; My lord Master; My lord DarthWho
The Doctor and the master at the same time :WHAT!?!?!

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

codeguy

  • Hero Member
  • *****
  • Posts: 3552
  • what the h3ll did i name that code?
    • stuff at dkm
    • Email
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!
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

DarthWho

  • Hero Member
  • *****
  • Posts: 3853
  • 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....
Rassilon: My lord Doctor; My lord Master; My lord DarthWho
The Doctor and the master at the same time :WHAT!?!?!

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

unseenmachine

  • Hero Member
  • *****
  • Posts: 3285
  • A fish, a fish, a fishy o!
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 »
UnseenGDK Download : http://dl.dropbox.com/u/8822351/UnseenGDK.bm
GDK Tutorial : http://dl.dropbox.com/u/8822351/UnseenGDK_Tutorial.doc
VQB02 : http://dl.dropbox.com/u/8822351/VQB02.zip

codeguy

  • Hero Member
  • *****
  • Posts: 3552
  • what the h3ll did i name that code?
    • stuff at dkm
    • Email
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 »
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

unseenmachine

  • Hero Member
  • *****
  • Posts: 3285
  • A fish, a fish, a fishy o!
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.
UnseenGDK Download : http://dl.dropbox.com/u/8822351/UnseenGDK.bm
GDK Tutorial : http://dl.dropbox.com/u/8822351/UnseenGDK_Tutorial.doc
VQB02 : http://dl.dropbox.com/u/8822351/VQB02.zip

codeguy

  • Hero Member
  • *****
  • Posts: 3552
  • what the h3ll did i name that code?
    • stuff at dkm
    • Email
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!
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

unseenmachine

  • Hero Member
  • *****
  • Posts: 3285
  • A fish, a fish, a fishy o!
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 »
UnseenGDK Download : http://dl.dropbox.com/u/8822351/UnseenGDK.bm
GDK Tutorial : http://dl.dropbox.com/u/8822351/UnseenGDK_Tutorial.doc
VQB02 : http://dl.dropbox.com/u/8822351/VQB02.zip

unseenmachine

  • Hero Member
  • *****
  • Posts: 3285
  • A fish, a fish, a fishy o!
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...
UnseenGDK Download : http://dl.dropbox.com/u/8822351/UnseenGDK.bm
GDK Tutorial : http://dl.dropbox.com/u/8822351/UnseenGDK_Tutorial.doc
VQB02 : http://dl.dropbox.com/u/8822351/VQB02.zip

codeguy

  • Hero Member
  • *****
  • Posts: 3552
  • what the h3ll did i name that code?
    • stuff at dkm
    • Email
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!
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

codeguy

  • Hero Member
  • *****
  • Posts: 3552
  • what the h3ll did i name that code?
    • stuff at dkm
    • Email
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 »
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

DarthWho

  • Hero Member
  • *****
  • Posts: 3853
  • 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....
Rassilon: My lord Doctor; My lord Master; My lord DarthWho
The Doctor and the master at the same time :WHAT!?!?!

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

codeguy

  • Hero Member
  • *****
  • Posts: 3552
  • what the h3ll did i name that code?
    • stuff at dkm
    • Email
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
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

  • Print