Qbasicnews.com

Qbasicnews.com > QbasicNews.Com > Challenges > wormhole
Full Version: wormhole
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2 3 4 5 6 7 8

Rattrapmax6

03-27-2005, 07:35 PM
Smile Worm hole, under 32, says 32, but you asked for comments, that added to the lines... This is in FreeBasic, hits 6600 FPS on mine, if it goes to fast for you to see it, you might need a minor delay... :wink: But, since it spirals, if it goes faster, it might just look better... Big Grin

Code:
'Set screen mode to 800*600 RGB
SCREEN 19, 32, 2, 1
'Set the center of the screen..
cntx = 400
cnty = 300
'Set are camera lens..
LENS = 256
'Start timer for frames per second
T! = TIMER
'Main LOOP
DO
   r = 40' Radius of worm hole
   z = z + 1 'Z cord of worm hole
   Rang! = ang * 3.14/180 'Degrees to Radians
   x! = r * COS(Rang!) 'Polar to Cartesain X
   y! = r * SIN(Rang!) 'Polar to Cartesain Y
   Dist = LENZ - z ' Find distance
   IF z > 256 THEN ' Check for max Z,..
      z = 0 'If true, reduce back to 0
   END IF 'End code block
   IF z > 0 AND z < 256 THEN 'Make sure z is still on screen
      nx! = cntx + (LENS * x! / Dist)'Find new X
      ny! = cnty - (LENS * y! / Dist)'Find new Y
   ELSE 'So we don't divide by 0
END IF 'End code block
PSET (nx!, ny!), RGB(0, 0, z) 'Place blue pixel
PSET (nx! + 1, ny! - 1), RGB(0, z, 0) 'Place green pixel
ang = (ang + 1) MOD 360 'Add angle, MOD keeps it from going over 360
F = F + 1 'Frame counter
LOOP UNTIL INKEY$ = CHR$(27)' LOOP until Esc is pressed
PRINT "Average FPS:"; F / (TIMER - T!)' Frames per second equation.
SLEEP 'Wait until key is pressed..

xteraco

03-27-2005, 08:23 PM
comments arent counted as lines of code in this compo, only functional code is counted Big Grin :wink:

xteraco

03-27-2005, 08:25 PM
WOW! thats a good entry!!! good work man :bounce: it looks great!

urger

03-27-2005, 09:26 PM
Do you mean like the Stargate's "Wush" effect?

Mitthrawnuruodo

03-27-2005, 09:58 PM
You mean when the event horizon burst out while intializing a stable wormhole?
Ummm...Also that thing that you want to be out of the way of unless you want to become a smoking pair of shoes?

Confusedhifty: Ummm...don't ask. Big Grin That all was a joke above. :lol: LAUGH! :o

Ya you try that and make it your entry, it will look cool but its not the thing I think that he wants.

Rattrapmax6

03-27-2005, 10:08 PM
Smile Seems to like mine, which spirals into the screen were a black hole is...

Mitthrawnuruodo

03-27-2005, 10:10 PM
Nice....sorry I couldn't see it Rattra Cry

DefHo

03-28-2005, 11:54 AM
Here's my entry:

Code:
SCREEN 9
'This sets the first five colors to gray shade and the last eleven to white.
'For some reason SCREEN 9 wont let me change the other colors using OUT.
OUT 968, 0
FOR i = 0 TO 15
  OUT 969, i * 8 / 3
  IF i > 4 THEN PALETTE i, 7
NEXT
DEFINT A-Z
DIM x(50), y(50), z(50)
FOR i = 0 TO 50
  z(i) = i * 40
NEXT
p1 = 1
DO
a! = a! + .05
SWAP p1, p2
SCREEN 9, 0, p1, p2   'This handy little trick switches between video pages.
CLS
FOR i = 0 TO 50
   z(i) = z(i) - 10
   IF z(i) < 0 THEN
      x(i) = COS(a!) * (100 + SIN(a!) * 50)
      y(i) = SIN(a!) * (100 + SIN(a! * 1.1 * 50))
      z(i) = z(i) + 2000
      furthest = i
   END IF
NEXT
FOR i = furthest TO 50  'Draw them in the right order.
   'Only draw if it's been going long enough for the circles to be in place.
   'Ugly, ugly line!
   IF a! > 10 THEN CIRCLE ((256 * (x(i) / (56 + z(i))) + 320), (256 * (y(i) / (56 + z(i))) + 175)), ABS((256 * (x(i) / (56 + z(i))) + 320) - (256 * ((x(i) + 200) / (56 + z(i))) + 320)), (2000 - z(i)) * .0075
NEXT
FOR i = 0 TO furthest - 1
   IF a! > 10 THEN CIRCLE ((256 * (x(i) / (56 + z(i))) + 320), (256 * (y(i) / (56 + z(i))) + 175)), ABS((256 * (x(i) / (56 + z(i))) + 320) - (256 * ((x(i) + 200) / (56 + z(i))) + 320)), (2000 - z(i)) * .0075
NEXT
LOOP UNTIL LEN(INKEY$)  '33 lines not counting comments.


and some other wormholes that have way to many lines for this cahllenge:
Code:
DECLARE SUB ffix (Mode%)
DECLARE SUB flatpoly (x%(), y%(), c%, np%)
SCREEN 13


ffix 0

FOR i = 0 TO 63
OUT 968, i
OUT 969, i
OUT 969, i
OUT 969, i
OUT 968, i + 64
OUT 969, 0
OUT 969, 0
OUT 969, i
NEXT

DIM SHARED luy(199) AS LONG

FOR i = 0 TO 199
luy(i) = i * 320
NEXT

DIM luc(6000, 2) AS INTEGER

FOR i = 0 TO 3000
n = (3000 - i) * 63 / 3000
luc(i, 0) = n
luc(i, 1) = n + 64
luc(i, 2) = n + 128
NEXT


DEFINT A-Z

REDIM scrn(32001)
scrn(0) = 2560
scrn(1) = 200

DEF SEG = VARSEG(scrn(2))

DIM SHARED offset AS LONG
offset = VARPTR(scrn(2))


REDIM SHARED span(199, 1)


DIM sine!(359), cosi!(359)
CONST pi = 3.14159

FOR i = 0 TO 359
sine!(i) = SIN(i * pi / 180)
cosi!(i) = COS(i * pi / 180)
NEXT

TYPE vector
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE

DIM v(9, 9) AS vector
DIM cent(9) AS vector
DIM rx(9, 9), ry(9, 9)

FOR i = 0 TO 9
cent(i).z = ((9 - i) * 100 + 100) * 3 + 3000
FOR j = 0 TO 9
  v(i, j).x = cosi!(j * 36) * 190 + cent(i).x
  v(i, j).y = sine!(j * 36) * 190 + cent(i).y
  v(i, j).z = cent(i).z
NEXT
NEXT

furthest = 0

zv = -50


t! = TIMER


DO
zc = zc + 50
a! = a! + .07
b! = b! + .05
cx = COS(a!) * 80
cy = SIN(b!) * 60
f = f + 1
FOR i = 0 TO 9
  FOR j = 0 TO 9
   v(i, j).z = v(i, j).z + zv
  NEXT
  IF v(i, 0).z < 1 THEN
   furthest = i
   FOR j = 0 TO 9
    v(i, j).x = cosi!(j * 36) * 190 + cx
    v(i, j).y = sine!(j * 36) * 190 + cy
    v(i, j).z = v(i, j).z + 3000
   NEXT
  END IF
  FOR j = 0 TO 9
   rx(i, j) = 350 * (v(i, j).x / (v(i, j).z)) + 160
   ry(i, j) = 350 * (v(i, j).y / (v(i, j).z)) + 100
  NEXT
NEXT
ri = furthest
FOR i = 0 TO 8
  ri2 = (ri + 1) MOD 10
  FOR j = 0 TO 9
   j2 = (j + 1) MOD 10
   x(0) = rx(ri, j)
   y(0) = ry(ri, j)
   x(1) = rx(ri, j2)
   y(1) = ry(ri, j2)
   x(2) = rx(ri2, j2)
   y(2) = ry(ri2, j2)
   x(3) = rx(ri2, j)
   y(3) = ry(ri2, j)
   IF zc + v(ri, j).z < 20000 THEN
    'IF (ri XOR j) AND 1 THEN
     c = (ri XOR j) AND 1
     flatpoly x(), y(), luc(v(ri, j).z, c), 4
    'END IF
   END IF
  NEXT
  ri = (ri + 1) MOD 10
NEXT
WAIT &H3DA, 8
PUT (0, 0), scrn, PSET
REDIM scrn(32001)
scrn(0) = 2560
scrn(1) = 200
LOOP UNTIL LEN(INKEY$) OR zc > 20000

fps! = f / (TIMER - t!)
SCREEN 0
PRINT fps!, zc
ffix -1

SLEEP

SUB ffix (Mode%) STATIC
'FFix by Dav,Plasma and v1ctor
IF Mode% = 0 THEN
    DIM isr(0 TO 5) AS LONG
    isr(0) = &H53EC8B55: isr(1) = &H83025E8B
    isr(2) = &H8E0602EB: isr(3) = &HC7260446
    isr(4) = &H79B9007: isr(5) = &HCF9B5D5B
    DEF SEG = 0
    OldISR1 = PEEK(&HF4)
    OldISR2 = PEEK(&HF5)
    OldISR3 = PEEK(&HF6)
    OldISR4 = PEEK(&HF7)
    POKE &HF4, VARPTR(isr(0)) AND 255
    POKE &HF5, (CLNG(VARPTR(isr(0))) AND &HFF00&) \ 256
    POKE &HF6, VARSEG(isr(0)) AND 255
    POKE &HF7, (CLNG(VARSEG(isr(0))) AND &HFF00&) \ 256

ELSE

DEF SEG = 0
POKE &HF4, OldISR1
POKE &HF5, OldISR2
POKE &HF6, OldISR3
POKE &HF7, OldISR4


END IF

END SUB

SUB flatpoly (x(), y(), c, np)

spanmin = 199
spanmax = -1

FOR i = 0 TO 199
span(i, 0) = 320
span(i, 1) = -1
NEXT

FOR i = 0 TO np - 1
i2 = (i + 1) MOD np
IF y(i) < y(i2) THEN
  sx! = x(i)
  ex! = x(i2)
  sy = y(i)
  ey = y(i2)
ELSE
  sx! = x(i2)
  ex! = x(i)
  sy = y(i2)
  ey = y(i)
END IF
length = (ey - sy)
IF length <> 0 THEN
  xinc! = (ex! - sx!) / length
ELSE
  xinc! = 0
END IF

FOR y = sy TO ey
  IF spanmin > y THEN spanmin = y
  IF spanmax < y THEN spanmax = y
  IF y > 0 AND y < 199 THEN
   IF span(y, 0) > sx! THEN
    span(y, 0) = INT(sx!)
   END IF
   IF span(y, 1) < sx! THEN
    span(y, 1) = INT(sx!)
   END IF
  END IF
  sx! = sx! + xinc!
NEXT
NEXT

IF spanmin < 0 THEN spanmin = 0
IF spanmax > 199 THEN spanmax = 199
FOR y = spanmin TO spanmax
IF span(y, 0) < 0 THEN span(y, 0) = 0
IF span(y, 1) > 319 THEN span(y, 1) = 319
o& = offset + span(y, 0) + luy(y)
FOR x = span(y, 0) TO span(y, 1)
  POKE o&, c
  o& = o& + 1
NEXT
NEXT


END SUB

Code:
DECLARE SUB ffix (Mode%)
SCREEN 13

ffix 0

DIM luy(199) AS LONG

FOR i = 0 TO 199
luy(i) = i * 320
NEXT

DEFINT A-Z

REDIM SHARED scrn(32001) AS INTEGER
scrn(0) = 2560
scrn(1) = 200

DIM SHARED offset AS LONG
offset = VARPTR(scrn(2))

DIM sine!(360), cosi!(360)

FOR i = 0 TO 360
sine!(i) = SIN(i * 3.1415926535897# / 180)
cosi!(i) = COS(i * 3.1415926535897# / 180)
NEXT

TYPE xyz
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE

DIM cent(30) AS xyz

FOR i = 1 TO 30
cent(i).x = cosi!(i * 12) * 40
cent(i).y = sine!(i * 6) * 60 - 30
cent(i).z = i * 1000 / 30
NEXT

DIM star(30, 60) AS xyz

FOR i = 1 TO 30
FOR j = 1 TO 60
  star(i, j).x = cosi!(j * 6) * 100 + cent(i).x
  star(i, j).y = sine!(j * 6) * 100 + cent(i).y
  star(i, j).z = cent(i).z
NEXT
NEXT

DEF SEG = VARSEG(scrn(2))

zv = 10

fade! = 0

t! = TIMER
FOR over = 1 TO 1500
f = f + 1
a! = a! + .01
xc = SIN(a! * 2) * 100
yc = (SIN(a!)) * 100
IF fade! < 1 THEN fade! = fade! + .01
  FOR i = 1 TO 63
   OUT 968, i
   OUT 969, i * fade!
   OUT 969, i * fade!
   OUT 969, i * fade!
  NEXT
  FOR i = 1 TO 30
  FOR j = 1 TO 60
   star(i, j).z = star(i, j).z - zv
   IF star(i, j).z < 1 AND over < 1400 THEN
    IF over < 1250 THEN
      star(i, j).z = star(i, j).z + 1000
      star(i, j).x = cosi!(j * 6) * 100 + cent(i).x
      star(i, j).y = sine!(j * 6) * 100 + cent(i).y
    END IF
    IF over >= 1250 THEN
      star(i, j).x = INT(RND * 2000 - 1000)
      star(i, j).y = INT(RND * 500 - 250)
      star(i, j).z = 1000 - INT(RND * 20)
    END IF
   END IF
   IF star(i, j).z < 1 THEN star(i, j).z = 1
   rx = 256 * ((star(i, j).x + xc) / (10 + star(i, j).z)) + 160
   ry = 256 * ((star(i, j).y + yc) / (10 + star(i, j).z)) + 100
   IF rx >= 0 AND rx < 320 AND ry >= 0 AND ry < 200 THEN
    c = (1000 - star(i, j).z) / 600 * (((j / 4) AND 1) * 24 + 16)
    POKE offset + rx + luy(ry), c
   END IF
  NEXT
NEXT
PUT (0, 0), scrn, PSET
REDIM scrn(32001) AS INTEGER
scrn(0) = 2560
scrn(1) = 200
IF LEN(INKEY$) THEN EXIT FOR
NEXT

fps! = f / (TIMER - t!)

ffix -1

SCREEN 0
PRINT fps!
SLEEP

DEFSNG A-Z
SUB delay (n)
t! = TIMER * 100
DO
LOOP WHILE TIMER * 100 - t! < n
END SUB

DEFINT A-Z
SUB ffix (Mode%) STATIC
'FFix by Dav,Plasma and v1ctor
IF Mode% = 0 THEN
    DIM isr(0 TO 5) AS LONG
    isr(0) = &H53EC8B55: isr(1) = &H83025E8B
    isr(2) = &H8E0602EB: isr(3) = &HC7260446
    isr(4) = &H79B9007: isr(5) = &HCF9B5D5B
    DEF SEG = 0
    OldISR1 = PEEK(&HF4)
    OldISR2 = PEEK(&HF5)
    OldISR3 = PEEK(&HF6)
    OldISR4 = PEEK(&HF7)
    POKE &HF4, VARPTR(isr(0)) AND 255
    POKE &HF5, (CLNG(VARPTR(isr(0))) AND &HFF00&) \ 256
    POKE &HF6, VARSEG(isr(0)) AND 255
    POKE &HF7, (CLNG(VARSEG(isr(0))) AND &HFF00&) \ 256

ELSE

DEF SEG = 0
POKE &HF4, OldISR1
POKE &HF5, OldISR2
POKE &HF6, OldISR3
POKE &HF7, OldISR4


END IF

END SUB

Code:
DECLARE SUB ffix (Mode%)
SCREEN 13

ffix 0

DIM luy(199) AS LONG

FOR i = 0 TO 199
luy(i) = i * 320
NEXT

DEFINT A-Z

REDIM SHARED scrn(32001) AS INTEGER
scrn(0) = 2560
scrn(1) = 200

DIM SHARED offset AS LONG
offset = VARPTR(scrn(2))

DIM sine!(360), cosi!(360)

FOR i = 0 TO 360
sine!(i) = SIN(i * 3.1415926535897# / 180)
cosi!(i) = COS(i * 3.1415926535897# / 180)
NEXT

TYPE xyz
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE


DIM star(30, 120) AS xyz

xr = 40
yr = 60

DIM xc(99) AS SINGLE
DIM yc(99) AS SINGLE

FOR i = 99 TO 0 STEP -1
  xa = (xa + 2) MOD 360
  ya = (ya + 1) MOD 360
  xc(i) = cosi!(xa) * xr
  yc(i) = sine!(ya) * yr
NEXT


FOR i = 1 TO 30
FOR j = 1 TO 120
  star(i, j).x = cosi!(j * 3) * 100 + xc((30 - i) * 99 / 30)
  star(i, j).y = sine!(j * 3) * 100 + yc((30 - i) * 99 / 30)
  star(i, j).z = i * 1000 / 30
NEXT
NEXT

DEF SEG = VARSEG(scrn(2))


zv = 10

fade! = 0

t! = TIMER

DO
f = f + 1
IF fade! < 1 THEN fade! = fade! + .01
  FOR i = 1 TO 63
   OUT 968, i
   OUT 969, i * fade!
   OUT 969, i * fade!
   OUT 969, i * fade!
  NEXT

  xa = (xa + 2) MOD 360
  ya = (ya + 1) MOD 360
  xc(0) = cosi!(xa) * xr
  yc(0) = sine!(ya) * yr

  IF f MOD 10 = 0 THEN
   xr = xr + 1
   yr = yr + 1
  END IF

  
  FOR i = 99 TO 1 STEP -1
   xc(i) = xc(i - 1)
   yc(i) = yc(i - 1)
  NEXT

  FOR i = 1 TO 30
  FOR j = 1 TO 120
   star(i, j).z = star(i, j).z - zv
   IF star(i, j).z < 1 AND f < 1400 THEN
    IF f < 1250 THEN
      star(i, j).z = star(i, j).z + 1000
      star(i, j).x = cosi!(j * 3) * 100 + xc(0)
      star(i, j).y = sine!(j * 3) * 100 + yc(0)
    END IF
    IF f >= 1250 THEN
      star(i, j).x = INT(RND * 2000 - 1000)
      star(i, j).y = INT(RND * 500 - 250)
      star(i, j).z = 1000 - INT(RND * 20)
    END IF
   END IF
   IF star(i, j).z < 1 THEN star(i, j).z = 1
   rx = 256 * ((star(i, j).x - xc(99)) / (10 + star(i, j).z)) + 160
   ry = 256 * ((star(i, j).y - yc(99)) / (10 + star(i, j).z)) + 100
   IF rx > -1 AND rx < 320 AND ry > -1 AND ry < 200 THEN
    c = (1000 - star(i, j).z) / 600 * (((j / 4) AND 1) * 24 + 16)
    POKE offset + rx + luy(ry), c
   END IF
  NEXT
NEXT
PUT (0, 0), scrn, PSET
REDIM scrn(32001) AS INTEGER
scrn(0) = 2560
scrn(1) = 200
LOOP WHILE INKEY$ = "" AND f < 1500


fps! = f / (TIMER - t!)

SCREEN 0
PRINT fps!
ffix -1
SLEEP

DEFSNG A-Z
SUB delay (n)
t! = TIMER * 100
DO
LOOP WHILE TIMER * 100 - t! < n
END SUB

DEFINT A-Z
SUB ffix (Mode%) STATIC
'FFix by Dav,Plasma and v1ctor
IF Mode% = 0 THEN
    DIM isr(0 TO 5) AS LONG
    isr(0) = &H53EC8B55: isr(1) = &H83025E8B
    isr(2) = &H8E0602EB: isr(3) = &HC7260446
    isr(4) = &H79B9007: isr(5) = &HCF9B5D5B
    DEF SEG = 0
    OldISR1 = PEEK(&HF4)
    OldISR2 = PEEK(&HF5)
    OldISR3 = PEEK(&HF6)
    OldISR4 = PEEK(&HF7)
    POKE &HF4, VARPTR(isr(0)) AND 255
    POKE &HF5, (CLNG(VARPTR(isr(0))) AND &HFF00&) \ 256
    POKE &HF6, VARSEG(isr(0)) AND 255
    POKE &HF7, (CLNG(VARSEG(isr(0))) AND &HFF00&) \ 256

ELSE

DEF SEG = 0
POKE &HF4, OldISR1
POKE &HF5, OldISR2
POKE &HF6, OldISR3
POKE &HF7, OldISR4


END IF

END SUB


Enjoy Smile

TheBigBasicQ

03-28-2005, 08:35 PM
What the hell was that? =P Nice program dude. Next time please put a link :roll:

DefHo

03-28-2005, 10:09 PM
Quote:Next time please put a link :roll:
Yeah, sorry about that. I don't have access to a web page at the moment so I wouldn't have anything to link to.
Pages: 1 2 3 4 5 6 7 8
Qbasicnews.com > QbasicNews.Com > Challenges > wormhole