Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - Voltage

Pages: [1] 2
1
General chat / 3D Computational Fluids
« on: February 11, 2011 »
Check out this cool collection of 3d fluids.

[youtube]http://www.youtube.com/watch?v=nJWz0PaMlkI&feature=related[/youtube]

2
Projects / GLSL Ocean
« on: December 14, 2010 »
I'm happy with this so far, what do you think?

It's 1,484 bytes at the moment.  I'm gonna try to squeeze it down to 1024 and release it as my 1st 1k deemo.

Edit: Added screenshot...

[youtube]http://www.youtube.com/watch?v=IKmsmfYo9Ig[/youtube]

3
Projects / GLSL Soft Particles
« on: September 08, 2010 »
Hey guys,

As discussed in another thread, I'm working away at a demo release for Syntax 2010.

Can you please test the attached "Soft Particles Test" on your hardware and report back.

It's a GLSL conversion from the Direct X version found here:
http://developer.download.nvidia.com/SDK/10/direct3d/Source/SoftParticles/doc/SoftParticles_hi.pdf

Cheers Volt

4
Freebasic / Almighty sphere cow
« on: March 12, 2010 »
Another productive day in the office.

Data from here http://isg.cs.tcd.ie/spheretree/

5
C / C++ /C# / [C/C++] Linker errors - Express 2008
« on: March 11, 2010 »
Hey all,

I'm getting these linker errors in Release mode only:
Code: [Select]
1>msys_soundOS.obj : error LNK2019: unresolved external symbol @FMUSIC_LoadSong@8 referenced in function "void __fastcall msys_musicInit(void)" (?msys_musicInit@@YIXXZ)
1>msys_soundOS.obj : error LNK2019: unresolved external symbol @FSOUND_File_SetCallbacks@20 referenced in function "void __fastcall msys_musicInit(void)" (?msys_musicInit@@YIXXZ)
1>msys_soundOS.obj : error LNK2019: unresolved external symbol @FMUSIC_PlaySong@4 referenced in function "void __fastcall msys_musicStart(void)" (?msys_musicStart@@YIXXZ)
1>msys_soundOS.obj : error LNK2019: unresolved external symbol @FMUSIC_FreeSong@4 referenced in function "void __fastcall msys_musicEnd(void)" (?msys_musicEnd@@YIXXZ)

The linker 'Additional dependancies' are the same for both debug and release configs.
opengl32.lib minifmod.lib winmm.lib glu32.lib

I've been at this for a couple of hours now. 

Any ideas?

6
I've been watching a lot of demos lately (old and new) and I wanted to capture things that I like about the good ones, for inspiration.  Here's a quick list of terms that came to mind as scenes flashed by:

 - Reflection
 - Smooth
 - Depth
 - Distortion 2D
 - Distortion 3D
 - Shadow
 - Glow
 - Off Centre
 - Alive (Breathing, growing)
 - Particle
 - Camera
 - Sound Effects
 - Sync
 - Humour
 - Fast / Slow
 - Occluded / Masked
 - Wireframe
 - Partial
 - Dying
 - Atmosphere
 - Recursion
 - Light Beams / God Rays
 - Aspect Ratio / Field of view
 - Interesting path / Splines
 - Transparency / Blending
 - Noise / Fractals / Perlin
 - Cubes
 - Rounded / Smoothed
 - Antialiased
 - Motion Blur

Combine them, use them as themes for scenes, use them as you will.

7
I'm trying to work out algorithm to create 16 frames of a heightmap... in this case the heightmap represents the surface of some water.  My proggy will loop through and render each of these frames one after the other, and then loop back and start at the first frame again.

I also need these frames to be tileable / seamless.

I've had a few attempts at it but everytime I get an interesting animated water like effect... the frames don't stay tileable.

Any ideas on an algo to solve this problem?


8
GFX & sound / Request for C64 music (SID)
« on: October 02, 2009 »
Hi all,

As you may have read in another post I am attending Syntax 2009 in Melbourne Australia at the end of the month.

I will be releasing a c64 demo at the party.

I have all bases covered cept for music.  And I am sadly lacking in this area.

So I pretty much have 2 options.  Reuse an existing sid, or ask.

All work would be proudly credited on the big screen of course.

The running time for the demo is a maximum of 7 minutes.

Let me know if you're willing to contribute.

9
General chat / Syntax 09 - Australian Demo Party
« on: September 07, 2009 »
I've booked my flights down to Melbourne for Syntax 09.  http://www.syntaxparty.org/

This will be my first demo party since the early 90s...  :updance:

I'll be entering the oldschool compo with a c64 demo which is coming along nicely.

All encouragement welcome.  This will be my first demo on the big screen.

12
Java,JS & Flash / [FLASH] My first flash
« on: February 21, 2009 »
http://www.labwebdesign.com.au/johnweb/flash/

This is my first attempt at AS3, and so far I really like the language.  It's fairly forgiving of newbie mistakes, and there are lots of tutorials on how to get started.

The development cost is zero, as I'm using FlashDevelop and the flex sdk.

The particle engine is nearly complete, but I'm not sure what type of game I'll make yet.  Idea's are welcome.

As far as flash games are concerned, I think simplicity of controls plays a big part in their success.  Mouse movement and left click, plus maybe a space bar thrown in now and again.

What do you think?

13
C / C++ /C# / Learning c++ - Please critique this code
« on: November 06, 2008 »
I've just finished this Tic Tac Toe console app in C++.  It works, but I'd like some ideas/advice on best practices.

The idea being that I swap out FreeBASIC as my default tool, and replace it with VS c++ in the long run.

Code: [Select]
// TicTacToe.cpp : Defines the entry point for the console application.
//

#include "stdafx.h"
#include <iostream>
#include <string>

using namespace std;

#define TTT_X 1
#define TTT_O 2

class classTicTacToe
{
public:
int board[9];

classTicTacToe()
{
for (int a=0;a<9;a++)
board[a]=0;
}
~classTicTacToe() {}
void PutX(int x, int y)
{
if (x>=0 && x<3 && y>=0 && y<3) board[y*3+x] = TTT_X;
}
void PutO(int x, int y)
{
if (x>=0 && x<3 && y>=0 && y<3) board[y*3+x] = TTT_O;
}
void Clear(int x, int y)
{
if (x>=0 && x<3 && y>=0 && y<3) board[y*3+x] = 0;
}

int Check(int x, int y)
{
if (x>=0 && x<3 && y>=0 && y<3)
return board[y*3+x];
else
return 0;
}

int GameWon(void)
{
// Check for horizontal wins
for (int y=0;y<3;y++)
{
if (Check(0,y)==TTT_X && Check(1,y)==TTT_X && Check(2,y)==TTT_X) return TTT_X;
if (Check(0,y)==TTT_O && Check(1,y)==TTT_O && Check(2,y)==TTT_O) return TTT_O;
}

// Check for Vertical wins
for (int x=0;x<3;x++)
{
if (Check(x,0)==TTT_X && Check(x,1)==TTT_X && Check(x,2)==TTT_X) return TTT_X;
if (Check(x,0)==TTT_O && Check(x,1)==TTT_O && Check(x,2)==TTT_O) return TTT_O;
}

// Check for Diagonal wins
if (Check(0,0)==TTT_X && Check(1,1)==TTT_X && Check(2,2)==TTT_X) return TTT_X;
if (Check(0,0)==TTT_O && Check(1,1)==TTT_O && Check(2,2)==TTT_O) return TTT_O;
if (Check(2,0)==TTT_X && Check(1,1)==TTT_X && Check(0,2)==TTT_X) return TTT_X;
if (Check(2,0)==TTT_O && Check(1,1)==TTT_O && Check(0,2)==TTT_O) return TTT_O;

// else return 0
return 0;
}

int GameDrawn(void)
{
for (int y=0;y<3;y++)
for (int x=0;x<3;x++)
if (Check(x,y)==0) return 0;

// else return true
return -1;
}

char GetChar(int x, int y)
{
if (Check(x,y)==TTT_X) return 'X';
if (Check(x,y)==TTT_O) return 'O';
return ' ';
}

void DrawBoard()
{
cout << "  a b c" << endl;
cout << "1 " << GetChar(0,0) << "|" << GetChar(1,0) << "|" << GetChar(2,0) << endl;
cout << "  -+-+-" << endl;
cout << "2 " << GetChar(0,1) << "|" << GetChar(1,1) << "|" << GetChar(2,1) << endl;
cout << "  -+-+-" << endl;
cout << "3 " << GetChar(0,2) << "|" << GetChar(1,2) << "|" << GetChar(2,2) << endl;
}
};

int _tmain(int argc, _TCHAR* argv[])
{
classTicTacToe myTTT;
string inputBuffer;

int whosTurn = 0;
int exitPressed = 0;

while (!exitPressed)
{
myTTT.DrawBoard();
if (whosTurn==0)
cout << "X's turn" << endl;
else
cout << "O's turn" << endl;

cout << endl << "Enter a move or x to exit.  Ex a1<enter>" << endl;
std::getline(std::cin, inputBuffer);
cout << endl << endl;


if (inputBuffer=="x")
exitPressed=1;
else
{
// Check for a valid move
if (inputBuffer.length()!=2)
cout << "Please enter a 2 character board location and press enter.  Ex b3<enter>" << endl;
else
{
char iB1=inputBuffer[0];
char iB2=inputBuffer[1];
int x=-1;
int y=-1;
if (iB1=='a') x=0;
if (iB1=='b') x=1;
if (iB1=='c') x=2;
if (iB2=='1') y=0;
if (iB2=='2') y=1;
if (iB2=='3') y=2;
if (x<0 || y<0)
cout << "Invalid move. Bad coordinates." << endl;
else
{
// Check if the square is free
if (myTTT.Check(x,y)!=0)
cout << "Invalid move.  Square already occupied." << endl;
else
{
if (whosTurn==0)
{
whosTurn=1;
myTTT.PutX(x,y);
}
else
{
whosTurn=0;
myTTT.PutO(x,y);
}
}
}
}
}
// Check for a draw
if (myTTT.GameDrawn())
{
myTTT.DrawBoard();
cout << "Game drawn!  Press <enter> to finish." << endl;
std::getline(std::cin, inputBuffer);
exitPressed=1;
}

// Check for a win
if (int winner=myTTT.GameWon())
{
myTTT.DrawBoard();
if (winner==TTT_X)
cout << "X Wins the game!  Press <enter> to finish." << endl;
else
cout << "O Wins the game!  Press <enter> to finish." << endl;
std::getline(std::cin, inputBuffer);
exitPressed=1;
}
}
return 0;
}

14
Challenges & Competitions / [REMAKES] Brutal 3 - Light
« on: September 25, 2008 »
One of my favourite C64 demos.  This is just the first part of the demo, there are about 7 parts in the original.

To see the original you can download the .d64 file from http://www.c64.ch/demos/download.php?id=83

And WinVICE (C64 emulator) from http://www.viceteam.org/#download

This is my first remake, and it was harder than I thought it would be.  Trying to extract the exact fade colours was a bitch. :)

Edit: Fixed some bugs, added some greets to the end of the scrolltext, allowed windowed version, now exits as per the original on pressing space or esc exits straight away.

Edit 2: Removed ugly console window from background

New version attached in this post.

15
General chat / Look out Ireland
« on: September 07, 2008 »
So I'm saving my ass off, with the grand plan of heading to the country of my ancestors heritage. 

The plan is simple so far... save about 10K Australian, book some flights early next year, belt over to Ireland round about September, spend 1 month exploring, and then exhausted and broke, head home to the wife and kids.

This'll be my first excursion outside of Oz, and I'd appreciate some advice on some cool shit to check out.

I'm thinking Guinness factory, some castles, some Irish pubs, some travel to neighbouring countries.  What are some must sees?  But my mental list seems too... touristy.  What are some recommended sights, places or people to see?

I'd fucking beyond love to go to a top notch (<-not an actual requirement) demo party somewhere in Scandanavia, or Finland, Germany.  I always thought of it as too far, too expensive, and too unrealistic.  Australia is like bum fuck Idaho to the scene, a really long way from Europe, in the middle of nowhere.   

.... I really wanna see Venice before I die... how far is that from Ireland?  Fuck it I'll hire a pushy and ride there.  Everything's close in Europe.

16
Can some check the attached proggy for me?

It looks like the memory buffer is not sent to the screen pixel perfect.  Some lines are doubled up.

There is a screen shot, some code, and an exe in the attached file.

I am running this under Vista Ultimate, on an Nvidia 5700.  FreeBasic 0.18.3.

17
Freebasic / Frustum Culling
« on: June 03, 2008 »
Some code that:

1) Rotates the camera
2) Extracts the view frustum planes from OpenGL
3) Loops through all objects (30 000)
4) Compares the objects bounding sphere to the frustum
5) Draws if possibly inside the view

The OpenGL window setup code is by rbraz (what a guy), thank you.

The frustum clipping is all explained http://www.crownandcutlass.com/features/technicaldetails/frustum.html.

The next steps on my list are:
1) Delta timing
2) FPS counter
3) Quadtree
4) Skydome

My goal for this engine is to be able to walk around a large world, with terrain with many objects.

18
Challenges & Competitions / [PROCEDURAL] Waterworks
« on: April 20, 2008 »
This is my entry in the procedural comp, I hope you like it.


19
Freebasic / Realtime Ray Tracing in Freebasic
« on: March 22, 2007 »
Howdy all,

I've been doing some research and a little coding, and I have come up with a realtime raytracer in FB.

Does anyone here have any previous experience with ray tracing?  I have a coupla questions, specifically to do with optimizations. 

I don't have the code with me right now, but I'll post some code and an .exe a bit later.

EDIT: Added source and .exe

20
Freebasic / 20 Seconds - Little gem source
« on: March 17, 2007 »
Here is the source that may help someone at some point with some thing  :buddies:

This compiles under FreeBASIC v0.16, using RbRaz's awesome PTC library.

ThisLittleGemNoTunes.zip

Code: [Select]
'***********************************
'This Little Gem
'by Voltage - March 2007
'Coded for the dbfinteractive.com 20 Seconds compo
'Feel free to use any of this source for whatever purpose
'Send me a greet, or email me voltage_123@yahoo.com
'
'DONE! - Make Sub CreateGemFaces() 
'DONE! - Make Sub LineDraw() to buffer
'DONE! - Make Function FrontFacing()
'DONE! - Make Sub DrawTriangle()
'DONE! - Create Stars
'DONE! - Make Blending Functionality
'DONE! - Timer countdown
'DONE! - Proper greets

'$include: 'tinyptc.bi'

Declare Sub Decompress()
Declare Sub Smooth()
Declare Sub DrawScrollerChar(a$,x)
Declare Sub DrawFontChar(a$,x,y,tr)
Declare Function ysin(a) As Integer
Declare Sub ReadFontData()
Declare Sub DrawScroller
Declare Sub ClearBuffer
Declare Sub DrawUglyTimer
Declare Sub DrawSexyTimer
Declare Sub CreateGem
Declare Sub ProjectGem
Declare Sub RotateGem
Declare Sub DrawGemPoints
Declare Sub DrawGemLines
Declare Sub DrawGemFaces
Declare Sub LineDraw(x1,y1,x2,y2,r,g,b)
Declare Function isBackFacing(x1,y1,x2,y2,x3,y3) As Integer
Declare Sub DrawTriangle(x1,y1,x2,y2,x3,y3,r,g,b)
Declare Sub Add2Buffer(x,y)
Declare Sub LineDrawToBuffer(x1,y1,x2,y2)
Declare Sub SetupStars
Declare Sub MoveStars
Declare Sub DrawStars
Declare Sub FadeBackGround
Declare Sub DecompressCredits
Declare Sub DrawCredits

Type FontCharType
  x1 As Integer
  y1 As Integer
  x2 As Integer
  y2 As Integer
End Type

Type VerticeType
  x As Double
  y As Double
  z As Double
  rx As Double
  ry As Double
  rz As Double
  px As Integer
  py As Integer
End Type

Type TriangleType
  v1 As Integer
  v2 As Integer
  v3 As Integer
  r As Integer
  g As Integer
  b As Integer
End Type

Type TriangleBufferType
  x1 As Integer
  x2 As Integer
End Type

Type StarType
  x As Single
  xSpeed As Single
  Shade As Integer
  y As Integer
End Type

Const SCR_W = 640
Const SCR_H = 480
Const SCR_H2 = 315
Const SCR_SIZE = SCR_W * SCR_H

Const F_W = 600
Const F_H = 400
Const F_SIZE = F_W * F_H

Const ViewDistance = 275
Const Pi=Atn(1)*4.0
Const NumStars = 500
Const FadeSpeed = 20
Const GEMSCALE=70

Dim Shared As Double RotX,RotY,Rotz
Dim Shared FontChars(1 To 48) As FontCharType
Dim Shared FontCharList As String * 48
Dim Shared FontXPos As Integer
Dim Shared As Long Ticks, Clock
Dim Shared buffer( 0 To SCR_SIZE-1 ) As Integer
Dim Shared font(0 To F_SIZE) As Integer
Dim Shared Timer2 As Double
Dim Shared ScrollerMessage As String
Dim Shared As Integer ScrollerXPos,ScrollerCharPos
Dim Shared As VerticeType GemVertices(0 To 19)
Dim Shared As TriangleType GemFaces(0 To 35)
Dim Shared As TriangleBufferType TriangleBuffer(0 To SCR_H2)
Dim Shared As StarType Stars(1 To NumStars)
Dim Shared As UByte BlendTable(0 To 255, 0 To 255)
Dim Shared As UByte Credits(89*207)

ScrollerMessage = "                                "
ScrollerMessage += "dbfinteractive.com 20 second compo entry... "
ScrollerMessage += "greets to shockwave, roly, and the dbf forums crew! time up!"

'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*****************************************  MAIN   *******************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************

If (ptc_open( "Scroller", SCR_W, SCR_H ) = 0) Then End -1

Restore FontImageData
Decompress
Smooth
Restore FontCharData
ReadFontData
Restore CreditsData
DecompressCredits

ScrollerXPos=0
ScrollerCharPos=1

SetupStars
CreateGem

Clock=Timer
Ticks=30

Do
  Timer2 = 21-Int((Timer-Clock))
Loop Until Timer2<=20

Do
  'Draw
  ClearBuffer
  MoveStars
  DrawStars
  DrawScroller
  RotY=RotY+.02
  RotX=RotX+.01
  RotZ=RotZ+.025
  RotateGem
  ProjectGem
  DrawGemFaces
  DrawGemPoints
  DrawCredits

  'Timer
  Timer2 = 21-Int((Timer-Clock))
  DrawSexyTimer

  Ticks+=1

  'Update
  ptc_update @buffer(0)
Loop Until InKey$=Chr$(27) Or Timer2=0

ptc_close

'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*****************************************  SUBS   *******************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************

Sub DrawUglyTimer
  Timer1$=Str$(Timer2)
  DrawFontChar(Left$(Timer1$,1),0,0,-1)
  L=Len(Timer1$)
  For a=2 To L
    DrawFontChar(Mid$(Timer1$,a,1),-999,0,-1)
  Next a
End Sub

Sub DrawSexyTimer
  Timer1$=Bin$(Timer2)
  L=Len(Timer1$)
  If L<5 Then
    For a=1 To (5-L)
      Timer1$="0" + Timer1$
    Next a
  End If
  For a=1 To 5
    bt=Val(Mid$(Timer1$,a,1))
    If bt=0 Then
      bt=1
    Else
      bt=0
    End if
    For y=20*bt To 30
      y1=a*15+(y+10)*SCR_W
      For x=0 To 10
        buffer(y1+x)=RGB(155-y*4,255-y*6,155-y*4)
      Next x
    Next y
  Next a
End Sub


Sub ClearBuffer
  FadeBackGround

  FadeR=0
  FadeG=0
  FadeB=0
  For y=1 To 9
    y1=(305+y)*SCR_W
    For x=0 To SCR_W-1
      buffer(y1+x)=RGB(FadeR,FadeG,FadeB)
    Next x
    FadeR=FadeR+(((Font(0) Shr 16) And 255)/8)
    FadeG=FadeG+(((Font(0) Shr 8) And 255)/8)
    FadeB=FadeB+(((Font(0)) And 255)/8)
  Next y

  For y=SCR_W*315 To SCR_SIZE-1
    buffer(y)=font(0)
  Next y
End Sub

Sub Decompress()
  Read datacount
  Read IW
  Read IH
  Read c
  Read c1
 
  'OverWrite FontColours
  c=RGB(15,15,75)
  c1=RGB(50,50,255)

  x=0
  y=0

  For a=0 To datacount
    Read count
    Do
      font(y*F_W+x)=c
      x=x+1
      If x=IW Then
        x=0
        y=y+1
      End If
      count-=1
    Loop Until count=0
    Swap c,c1
  Next a
End Sub

Sub Smooth()
  For y=1 To 381-2
    For x=1 To 591-2
      r=0:g=0:b=0
      y1=0
      For x1=-1 To 1
        c=font((y+y1)*F_W+x+x1)
        r=r+((c Shr 16) And 255)
        g=g+((c Shr 8) And 255)
        b=b+(c And 255)
      Next x1
      x1=0
      For y1=-1 To 1
        c=font((y+y1)*F_W+x+x1)
        r=r+((c Shr 16) And 255)
        g=g+((c Shr 8) And 255)
        b=b+(c And 255)
      Next y1
      font(y*F_W+x)=rgb(r/6,g/6,b/6)
    Next x
  Next y
End Sub

Sub ReadFontData()
  Read FontCharList
  For a=1 To 48
    Read FontChars(a).x1
    Read FontChars(a).y1
    Read FontChars(a).x2
    Read FontChars(a).y2
  Next a
End Sub

Sub DrawScrollerChar(a$,x)
    c=Instr(FontCharList,a$)
    If c=0 Then c=48 ' If the char isn't part of our font, then set it to a space

    If x<>-999 then FontXPos=x

    x1=FontChars(c).x1
    x2=FontChars(c).x2+2
    For xs=x1 To x2
      If (FontXPos+xs-x1)>=0 And (FontXPos+xs-x1)<SCR_W Then
        ys1=ysin(FontXPos+xs-x1)
        For ys=FontChars(c).y1 To FontChars(c).y2
          If ys1>=0 And ys1<SCR_H Then
            buffer(ys1*SCR_W+FontXPos+xs-x1)=font(ys*F_W+xs)
          End If
          ys1=ys1+1
        Next ys
      End If
    Next xs

    FontXPos=FontXPos + (FontChars(c).x2-FontChars(c).x1)+4
End Sub

Sub DrawFontChar(a$,x,y,tr)
    c=InStr(FontCharList,a$)
    If c=0 Then c=48 ' If the char isn't part of our font, then set it to a space

    If x<>-999 then FontXPos=x

    x1=FontChars(c).x1
    x2=FontChars(c).x2+3
    For xs=x1 To x2
      If (FontXPos+xs-x1)>=0 And (FontXPos+xs-x1)<SCR_W Then
        ys1=y
        If tr Then
          'Transparent background
          For ys=FontChars(c).y1 To FontChars(c).y2
            If ys1>=0 And ys1<SCR_H Then
              cc=font(ys*F_W+xs)
              If cc<>font(0) Then
                buffer(ys1*SCR_W+FontXPos+xs-x1)=cc
              End If
            End If
            ys1=ys1+1
          Next ys
        Else
          For ys=FontChars(c).y1 To FontChars(c).y2
            If ys1>=0 And ys1<SCR_H Then
              buffer(ys1*SCR_W+FontXPos+xs-x1)=font(ys*F_W+xs)
            End If
            ys1=ys1+1
          Next ys
        End If
      End If
    Next xs

    FontXPos=FontXPos + (FontChars(c).x2-FontChars(c).x1)+4
End Sub

Function ysin(a) As Integer
    ysin=380 + Sin((a+ticks*2)/80.0)*40+Sin((a-ticks)/40.0)*25
End Function

Sub DrawScroller
  'Get Char Width
  FrontChar=InStr(FontCharList,Mid$(ScrollerMessage,ScrollerCharPos,1))
  If FrontChar=0 Then FrontChar=48 ' If the char isn't part of our font, then set it to a space
  FrontCharWidth=-(FontChars(FrontChar).x2-FontChars(FrontChar).x1+4)

  'Scroll the scroller
  ScrollerXPos = ScrollerXPos - 4

  'Check if the first char is completely off screen
  If ScrollerXPos < FrontCharWidth Then
    ScrollerXPos=ScrollerXPos-FrontCharWidth
    ScrollerCharPos+=1
    If ScrollerCharPos>Len(ScrollerMessage) Then ScrollerCharPos=1
  End If

  TmpScrollerCharPos=ScrollerCharPos
  DrawScrollerChar(Mid$(ScrollerMessage,TmpScrollerCharPos,1),ScrollerXPos)
  For b=2 To 40
    TmpScrollerCharPos+=1
    If TmpScrollerCharPos>Len(ScrollerMessage) Then TmpScrollerCharPos=1
    DrawScrollerChar(Mid$(ScrollerMessage,TmpScrollerCharPos,1),-999)
    If FontXPos>SCR_W Then Exit For
  Next b
End Sub

Sub CreateGem
  Dim AngStep As Double

  'Top Centre
  GemVertices(0).x=0
  GemVertices(0).y=-2
  GemVertices(0).z=0

  'Bottom point
  GemVertices(1).x=0
  GemVertices(1).y=2
  GemVertices(1).z=0

  AngStep = 2.0*Pi/9.0
  For a=0 To 8
    'Top ring
    GemVertices(2+a).x=1 * Sin(a * AngStep)
    GemVertices(2+a).y=-2
    GemVertices(2+a).z=1 * Cos(a * AngStep)

    'Second (wider) ring
    GemVertices(11+a).x=2 * Sin(a * AngStep)
    GemVertices(11+a).y=-1
    GemVertices(11+a).z=2 * Cos(a * AngStep)
  Next a
 
  'Create faces
  For a=0 To 8
    a1=(a+1) Mod 9
   
    'Top faces
    GemFaces(a).v1=0
    GemFaces(a).v2=a+2
    GemFaces(a).v3=a1+2

    r=Int(Rnd(1)*210)+45
    g=Int(Rnd(1)*210)+45
    b=Int(Rnd(1)*210)+45

    GemFaces(a).r = r
    GemFaces(a).g = g
    GemFaces(a).b = b
   
    'Middle faces 1
    GemFaces(a+9).v1=a+2
    GemFaces(a+9).v2=a+11
    GemFaces(a+9).v3=a1+11
    GemFaces(a+9).r = r
    GemFaces(a+9).g = g
    GemFaces(a+9).b = b

    'Middle faces 2
    GemFaces(a+18).v1=a+2
    GemFaces(a+18).v2=a1+11
    GemFaces(a+18).v3=a1+2
    GemFaces(a+18).r = r
    GemFaces(a+18).g = g
    GemFaces(a+18).b = b

    'Bottom faces
    GemFaces(a+27).v1=a1+11
    GemFaces(a+27).v2=a+11
    GemFaces(a+27).v3=1
    GemFaces(a+27).r = r
    GemFaces(a+27).g = g
    GemFaces(a+27).b = b
  Next a
End Sub

Sub ProjectGem
  For a=0 To 19
    GemVertices(a).px=SCR_W/2 + Sin(Ticks/60.0) * 280 + (GemVertices(a).rx * ViewDistance) / (GemVertices(a).rz + ViewDistance)
    GemVertices(a).py=220 - Abs(Cos(Ticks/35.0)*140) + (GemVertices(a).ry * ViewDistance) / (GemVertices(a).rz + ViewDistance)
  Next a
End Sub

Sub RotateGem
  Dim As Double x,y,z,x1,y1,z1,x2,y2,z2

  For a=0 To 19
    'Scale the thing
    x=GemVertices(a).x*GEMSCALE
    y=GemVertices(a).y*GEMSCALE
    z=GemVertices(a).z*GEMSCALE

    'Rot X
    x1 = x*Cos(RotY) + z*Sin(RotY)
    z1 = z*Cos(RotY) - x*Sin(RotY)

    'Rot Y
    y1 = y*Cos(RotX) + z1*Sin(RotX)
    z2 = z1*Cos(RotX) - y*Sin(RotX)

    'Rot Z
    x2 = x1*Cos(RotZ) + y1*Sin(RotZ)
    y2 = y1*Cos(RotZ) - x1*Sin(RotZ)

    GemVertices(a).rx=x2
    GemVertices(a).ry=y2
    GemVertices(a).rz=z2
  Next a
End Sub

Sub DrawGemPoints
  For a=0 To 19
    x=GemVertices(a).px
    y=GemVertices(a).py
    If x>=0 And x<SCR_W And y>=0 And y<SCR_H2 Then
      buffer(y*SCR_W+x)=RGB(255,255,255)
    End If
  Next a
End Sub

Sub DrawGemLines
  For a=0 To 35
    x1=GemVertices(GemFaces(a).v1).px
    y1=GemVertices(GemFaces(a).v1).py
    x2=GemVertices(GemFaces(a).v2).px
    y2=GemVertices(GemFaces(a).v2).py
    x3=GemVertices(GemFaces(a).v3).px
    y3=GemVertices(GemFaces(a).v3).py

    If isBackFacing(x1,y1,x2,y2,x3,y3)=1 Then
      LineDraw x1,y1,x2,y2,125,125,125
      LineDraw x2,y2,x3,y3,125,125,125
      LineDraw x3,y3,x1,y1,125,125,125
    End If
  Next a
End Sub

Sub DrawGemFaces
  For a=0 To 35
    x1=GemVertices(GemFaces(a).v1).px
    y1=GemVertices(GemFaces(a).v1).py
    x2=GemVertices(GemFaces(a).v2).px
    y2=GemVertices(GemFaces(a).v2).py
    x3=GemVertices(GemFaces(a).v3).px
    y3=GemVertices(GemFaces(a).v3).py

    If isBackFacing(x1,y1,x2,y2,x3,y3)=-1 Then
      DrawTriangle x1,y1,x2,y2,x3,y3,GemFaces(a).r,GemFaces(a).g,GemFaces(a).b
    End If
  Next a
  For a=0 To 35
    x1=GemVertices(GemFaces(a).v1).px
    y1=GemVertices(GemFaces(a).v1).py
    x2=GemVertices(GemFaces(a).v2).px
    y2=GemVertices(GemFaces(a).v2).py
    x3=GemVertices(GemFaces(a).v3).px
    y3=GemVertices(GemFaces(a).v3).py

    If isBackFacing(x1,y1,x2,y2,x3,y3)=1 Then
      DrawTriangle x1,y1,x2,y2,x3,y3,GemFaces(a).r,GemFaces(a).g,GemFaces(a).b
    End If
  Next a
End Sub

Sub LineDraw(x1,y1,x2,y2,r,g,b)
  xd=Abs(x2-x1)
  xs=Sgn(x2-x1)
  yd=Abs(y2-y1)
  ys=Sgn(y2-y1)
   
  If xs=0 And ys=0 Then
    'Pset only
    If x1>-1 And x1<SCR_W And y1>-1 And y1<SCR_H2 Then buffer(y1*SCR_W+x1)=rgb(r,g,b)
    Exit Sub
  End If

  If xs=0 Then
    'Vertical only
    For y=y1 To y2 Step ys
      If x1>-1 And x1<SCR_W And y>-1 And y<SCR_H2 Then buffer(y*SCR_W+x1)=rgb(r,g,b)
    Next y
    Exit Sub
  End If

  If ys=0 Then
    'Horizontal only
    For x=x1 To x2 Step xs
      If x>-1 And x<SCR_W And y1>-1 And y1<SCR_H2 Then buffer(y1*SCR_W+x)=rgb(r,g,b)
    Next x
    Exit Sub
  End If

  'Arbitary line
  If yd>xd Then
    a=yd/2
    x=x1
    For y=y1 To y2 Step ys
      If x>-1 And x<SCR_W And y>-1 And y<SCR_H2 Then buffer(y*SCR_W+x)=rgb(r,g,b)
      a=a+xd
      If a>yd Then
        a=a-yd
        x=x+xs
      End If
    Next y
  Else
    a=xd/2
    y=y1
    For x=x1 To x2 Step xs
      If x>-1 And x<SCR_W And y>-1 And y<SCR_H2 Then buffer(y*SCR_W+x)=rgb(r,g,b)
      a=a+yd
      If a>xd Then
        a=a-xd
        y=y+ys
      End If
    Next x
  End If
End Sub

Function isBackFacing(x1,y1,x2,y2,x3,y3) As Integer
  isBackFacing = Sgn((x2-x1) * (y3-y1) - (x3-x1) * (y2-y1))
End Function

Sub DrawTriangle(x1,y1,x2,y2,x3,y3,r,g,b)
  'Get miny and maxy
  miny=y1
  If y2<miny Then miny=y2
  If y3<miny Then miny=y3
  If miny<0 Then miny=0

  maxy=y1
  If y2>maxy Then maxy=y2
  If y3>maxy Then maxy=y3
  If maxy>SCR_H2 Then maxy=SCR_H2
 
  'Clear the triangle buffer within {miny to maxy}
  For y=miny To maxy
    TriangleBuffer(y).x1=SCR_W
    TriangleBuffer(y).x2=-1
  Next y

  'Add each line to the buffer
  LineDrawToBuffer x1,y1,x2,y2
  LineDrawToBuffer x2,y2,x3,y3
  LineDrawToBuffer x3,y3,x1,y1
 
  'Now draw each line
  For y=miny To maxy
    x1=TriangleBuffer(y).x1
    x2=TriangleBuffer(y).x2

    If x1=SCR_W Then
      If x2=-1 Then
        'Don't Draw
      Else
        x1=x2
        y1=y*SCR_W
        For x=x1 To x2
          c2=Buffer(y1+x)
          r2=(c2 Shr 16) And 255
          g2=(c2 Shr 8) And 255
          b2=(c2 And 255)
          Buffer(y1+x)=RGB((r+r2)Shr 1,(g+g2)Shr 1,(b+b2)Shr 1)
          'Buffer(y1+x)=Blend(r,g,b,Buffer(y1+x))
        Next x
      End If
    Else
      If x2=-1 Then
        x2=x1
        y1=y*SCR_W
        For x=x1 To x2
          c2=Buffer(y1+x)
          r2=(c2 Shr 16) And 255
          g2=(c2 Shr 8) And 255
          b2=(c2 And 255)
          Buffer(y1+x)=RGB((r+r2)Shr 1,(g+g2)Shr 1,(b+b2)Shr 1)
          'Buffer(y1+x)=Blend(r,g,b,Buffer(y1+x))
        Next x
      Else
        y1=y*SCR_W
        For x=x1 To x2
          c2=Buffer(y1+x)
          r2=(c2 Shr 16) And 255
          g2=(c2 Shr 8) And 255
          b2=(c2 And 255)
          Buffer(y1+x)=RGB((r+r2)Shr 1,(g+g2)Shr 1,(b+b2)Shr 1)
          'Buffer(y1+x)=Blend(r,g,b,Buffer(y1+x))
        Next x
      End If
    End If
  Next y
End Sub

Sub LineDrawToBuffer(x1,y1,x2,y2)
  xd=Abs(x2-x1)
  xs=Sgn(x2-x1)
  yd=Abs(y2-y1)
  ys=Sgn(y2-y1)
   
  If xs=0 And ys=0 Then
    'Pset only
    If y1>-1 And y1<SCR_H2 Then Add2Buffer x1,y1
    Exit Sub
  End If

  If xs=0 Then
    'Vertical only
    For y=y1 To y2 Step ys
      If y>-1 And y<SCR_H2 Then Add2Buffer x1,y
    Next y
    Exit Sub
  End If

  If ys=0 Then
    'Horizontal only
    For x=x1 To x2 Step xs
      If y1>-1 And y1<SCR_H2 Then Add2Buffer x,y1
    Next x
    Exit Sub
  End If

  'Arbitary line
  If yd>xd Then
    a=yd/2
    x=x1
    For y=y1 To y2 Step ys
      If y>-1 And y<SCR_H2 Then Add2Buffer x,y
      a=a+xd
      If a>yd Then
        a=a-yd
        x=x+xs
      End If
    Next y
  Else
    a=xd/2
    y=y1
    For x=x1 To x2 Step xs
      If y>-1 And y<SCR_H2 Then Add2Buffer x,y
      a=a+yd
      If a>xd Then
        a=a-xd
        y=y+ys
      End If
    Next x
  End If
End Sub

Sub Add2Buffer(x,y)
  If x<0 Then
    x1=0
  Else
    x1=x
  End If

  If x1>(SCR_W-1) Then
    x1=SCR_W-1
  End If
 
  If x1<TriangleBuffer(y).x1 Then TriangleBuffer(y).x1=x1
  If x1>TriangleBuffer(y).x2 Then TriangleBuffer(y).x2=x1
End Sub

Sub SetupStars
  Randomize Timer

  For a=1 To NumStars
    Stars(a).x=Rnd(1)*SCR_W
    Stars(a).y=Rnd(1)*(SCR_H2-10)
    Stars(a).xSpeed = (3.0/NumStars)*a+0.5
    Stars(a).Shade = Int((230.0/NumStars)*a)+25
  Next a
End Sub

Sub MoveStars
  Dim x As Single

  For a=1 To NumStars
    x=Stars(a).x
    x=x-Stars(a).xSpeed
    If x<0 Then x=x+SCR_W
    Stars(a).x=x
  Next a
End Sub

Sub DrawStars
  For a=1 To NumStars
    x=Stars(a).x
    y=Stars(a).y
    s=Stars(a).Shade
    Buffer(y*SCR_W+x)=RGB(s,s,s)
  Next a
End Sub

Sub FadeBackGround
dim As Integer ptr mem

mem=@buffer(0)

Asm
mov ecx,SCR_W*SCR_H2
mov eax,[mem]
InnerLoop4:
cmp dword ptr[eax],0
je ok3
sub Byte Ptr[eax],FadeSpeed
jnc ok1
mov Byte Ptr[eax],0
ok1:
sub Byte Ptr[eax+1],FadeSpeed
jnc ok2
mov Byte Ptr[eax+1],0
ok2:
sub Byte Ptr[eax+2],FadeSpeed
jnc ok3
mov Byte Ptr[eax+2],0
ok3:
add eax,4
dec ecx
jne InnerLoop4
End Asm

End Sub

Sub DecompressCredits
  x=0:y=0
  Read Colour,Count
  While count<>-1 And y<228
    Credits(x+y*87)=Colour
    x=x+1
    If x=87 Then
      y=y+1
      x=0
    End if
    Count=Count-1
    If Count=0 Then
      Read Colour, Count
    End If
  Wend

End Sub

Sub DrawCredits
  If Timer2>8 And Timer2<12 Then
    For y=0 To 206/3
      y1=(y+Int(SCR_H2/2)-35)*SCR_W+500
      For x=0 To 88
        c=Credits(y*89+x)
        If c<>0 Then buffer(y1+x)=RGB(c,c,c)
      Next x
    Next y
  End If

  If Timer2>5 And Timer2<9 Then
    For y=0 To 206/3
      y1=(y+Int(SCR_H2/2)-35)*SCR_W+10
      For x=0 To 88
        c=Credits((y+68)*89+x)
        If c<>0 Then buffer(y1+x)=RGB(c,c,c)
      Next x
    Next y
  End If

  If Timer2>2 And Timer2<6 Then
    For y=0 To 206/3
      y1=(y+Int(SCR_H2/2)-35)*SCR_W+500
      For x=0 To 88
        c=Credits((y+136)*89+x)
        If c<>0 Then buffer(y1+x)=RGB(c,c,c)
      Next x
    Next y
  End If
End Sub


'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*****************************************  DATA   *******************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************
'*********************************************************************************************

FontCharData:
  Data "abcdefghijklmnopqrstuvwxyz1234567890'?.,:()=+-! "
  Data 27, 6, 72, 46
  Data 125, 6, 169, 46
  Data 225, 6, 269, 46
  Data 323, 6, 367, 46
  Data 421, 6, 466, 46
  Data 520, 6, 564, 46
  Data 28, 53, 72, 93
  Data 126, 53, 170, 93
  Data 245, 53, 248, 93
  Data 305, 53, 348, 93
  Data 422, 53, 466, 93
  Data 519, 53, 564, 93
  Data 27, 100, 72, 140
  Data 126, 100, 170, 140
  Data 225, 100, 269, 140
  Data 323, 100, 367, 140
  Data 422, 100, 466, 140
  Data 519, 100, 563, 140
  Data 25, 147, 74, 187
  Data 126, 147, 170, 187
  Data 225, 147, 268, 187
  Data 323, 147, 367, 187
  Data 421, 147, 466, 187
  Data 520, 147, 564, 187
  Data 28, 194, 72, 234
  Data 126, 194, 170, 234
  Data 245, 194, 252, 234
  Data 323, 194, 366, 234
  Data 422, 194, 466, 234
  Data 520, 194, 564, 234
  Data 27, 241, 72, 281
  Data 126, 241, 169, 281
  Data 225, 241, 269, 281
  Data 323, 241, 366, 281
  Data 422, 241, 466, 281
  Data 520, 241, 564, 281
  Data 46, 288, 53, 328
  Data 126, 288, 169, 328
  Data 244, 288, 249, 328
  Data 341, 288, 348, 328
  Data 441, 288, 446, 328
  Data 537, 288, 546, 328
  Data 45, 335, 54, 375
  Data 138, 335, 157, 375
  Data 241, 335, 252, 375
  Data 339, 335, 349, 375
  Data 442, 335, 445, 375
  'Data 537, 335, 546, 375
  Data 530, 335, 553, 375


See the next post for the remaining code.

Pages: [1] 2