Author Topic: Timesoldier remake source  (Read 1667 times)

0 Members and 1 Guest are viewing this topic.

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17376
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Timesoldier remake source
« on: September 25, 2008 »
Again, no libs included so you can't compile it and some of this is pretty unoptimised, but in the hope that it helps someone..

Code: [Select]
'
'                                CLASIC  TIMESOLDIER
'                              REMAKE BY: COCK SHAVE
'
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


'   LIBS:

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"
   
'   SINE SCROLL FONT;   

    #INCLUDE "cfbigpal.bas"
    #INCLUDE "cfbigraw.bas"
   
'   AMIGA SYSTEM FONT;       

    #INCLUDE "amypal.bas"
    #INCLUDE "amyraw.bas"
   
'   MUSIC;

    #include "ufmod.bi"
    #include "a0.bas"
    Dim hWave As HWAVEOUT 

'-------------------------------------------------------------------------------

    OPTION STATIC
    OPTION EXPLICIT
   
    CONST   XRES    =    800
    CONST   YRES    =    600
   

    DIM SHARED AS INTEGER INTRO_HALFX,INTRO_HALFY
   
    INTRO_HALFX = XRES / 2
    INTRO_HALFY = (YRES / 2)-70
   
   
    DIM SHARED AS INTEGER MOUSE   
    DIM SHARED COPPERLIST(YRES)
    DIM SHARED AS UINTEGER STARS = 120
   
    DIM SHARED AS DOUBLE STX(STARS)
    DIM SHARED AS DOUBLE STY(STARS)
   
   
    DECLARE SUB BERASE()
    DECLARE SUB PRECALC()
    DECLARE SUB STARFIELD()
    DECLARE SUB INTRO_EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER, BYVAL LG AS INTEGER, BYVAL LB AS INTEGER)
    DECLARE SUB INTRO_READVECPOINTS()
    DECLARE SUB INTRO_ROTATE(BYVAL RRX AS DOUBLE,BYVAL RRY AS DOUBLE,BYVAL RRZ AS DOUBLE )
    DECLARE SUB INTRO_CONSTRUCT(BYVAL LR AS INTEGER, BYVAL LG AS INTEGER, BYVAL LB AS INTEGER)

    PRECALC()

'-------------------------------------------------------------------------------
'   Vector Logo;
'-------------------------------------------------------------------------------

    DIM SHARED AS UINTEGER INTRO_VLPOINTS = 23      :' # Of Vertices In Logo.
    DIM SHARED AS UINTEGER INTRO_VLLINES  = 20      :' # Of Lines In Logo.
   
    DIM SHARED AS DOUBLE INTRO_VX(INTRO_VLPOINTS)   :' Original X
    DIM SHARED AS DOUBLE INTRO_VY(INTRO_VLPOINTS)   :' Original Y
    DIM SHARED AS DOUBLE INTRO_VZ(INTRO_VLPOINTS)   :' Original Z
   
   DIM SHARED AS INTEGER INTRO_VTX(INTRO_VLPOINTS)  :' Transformed X
   DIM SHARED AS INTEGER INTRO_VTY(INTRO_VLPOINTS)  :' Transformed Y
   DIM SHARED AS INTEGER INTRO_VTZ(INTRO_VLPOINTS)  :' Transformed Z

    DIM SHARED AS INTEGER INTRO_LINEFROM(INTRO_VLLINES):' Line Start (Vertice No.)
    DIM SHARED AS INTEGER INTRO_LINE_TO (INTRO_VLLINES):' Line End   (Vertice No.)
   
   DIM SHARED AS DOUBLE INTRO_VXR,INTRO_VYR,INTRO_VZR,INTRO_SIZE
   INTRO_SIZE=.1

'-------------------------------------------------------------------------------
'   AMIGA SYSTEM FONT;
'-------------------------------------------------------------------------------
   
    Const ALfimgX = 960
    Const ALfimgY = 18
       
    DECLARE SUB ALARGETEXT (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING, byval c as uinteger)       
    Declare Sub ALfDrawImage(byval imxpos as integer,byval imypos as integer,byval SX as integer,byval SY as integer, byval c as uinteger)   
    Declare Sub ALFLoadDataImage()   
    Dim Shared ALFimg_buffer( Alfimgx * Alfimgy ) as integer   
    Dim Shared ALFimg_r(256), ALFimg_g(256), ALFimg_b(256) as short   
    ALFLoadDataImage()
       
'-------------------------------------------------------------------------------
'   SINE SCROLLER FONT;
'-------------------------------------------------------------------------------
   
    Const LfimgX = 1952
    Const LfimgY = 32
   
    DECLARE SUB sineLARGETEXT (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING)   
    Declare Sub LfDrawImage(byval imxpos as integer,byval imypos as integer,byval SX as integer,byval SY as integer)
    Declare Sub LFLoadDataImage()   
    Dim Shared LFimg_buffer( lfimgx * lfimgy ) as integer   
    Dim Shared LFimg_r(256), LFimg_g(256), LFimg_b(256) as short   
    LFLoadDataImage()   
    DIM SHARED AS UINTEGER SINETABLE(XRES)
   
   
    DIM SHARED AS UINTEGER TP=1
    DIM SHARED AS DOUBLE TOFF=0
    DIM SHARED AS STRING TXT
    TXT="                                "
    TXT=TXT+"YEAH!!  CLASSIC BRINGS YA:a    TIME SOLDIER 100%    WITH MEGATRAINER..... "
    TXT=TXT+"ORIGINALLY CRACKED BY PARADOX..... LOADERFIX AND MEGATRAINER BY CLASSIC.......    A BIG WELCOME TO OUR NEW MEMBER...a  - THE RUNNING MAN -    TUNE BY DEZECRATOR.....           "
    TXT=TXT+"WATCH OUT FOR THE FOLLOWING LAMERS ON YOUR BOARDS!!!!     STRIDER/FAGLIGHT AND THE REST OF THE LAMERS IN FAGLIGHT!  JUST SIMPLY DELETE THEM BEFORE THEY SPREAD THEIR LAMENESS ALL OVER THE PLACE... "
    TXT=TXT+"SPECIAL MESSAGE TO:  -STRIDDLER- YOUR ASSLICKING CHANGES BUT YOUR LAMENESS STAYS!!              NOW WE PUT OUT SOME FAST REGARDS TO THE FOLLOWING COOL DUDEZ: "
    TXT=TXT+"RAGAMUFFIN IN SLEAZE - ZELNIK/ORACLE - ONYX - BAMBAM/ORACLE - ZODIAC/VF - PHS/CCS - EVIL PRIEST/PARANOIMIA - TARKUS TEAM - "
    TXT=TXT+"HAMSTERN AND BUG - JETAZA/VISION - ADJ/TRISTAR - SLEEPING BAG - SCIENCE/ORACLE - BARON/DEFJAM - JUNIOR - PAPILLON - MAGNETIC/QUARTEX - MIKE/PARANOIMIA - KRISTIAN/PARANOIMIA - ALCATRAZ AND SETROX - STATIC/PARADOX - THE BEATBOX/PARANOIMIA - "
    TXT=TXT+"PSYCHO/VISION - LOVERBOY/PARADOX - PHIL/THRUST   AND THE REST OF THE BEST....           "
    TXT=TXT+"OKEY IF YOU DARE THEN CALL THESE BOARDS:a      313-685-0708 a       CLASSIC WHQ.       OR a     +49-511-2110635 a     CLASSIC EURO HQ.     SEE YOU ALL IN OUR NEXT PRODUCTION..........10"
    TXT=TXT+"..........9..........8..........7..........6..........5..........4..........3..........2..........1..........0..........a     FUCK NERDLIGHT!       "
    TXT=TXT+"WIN32 REMAKE BY SHOCKWAVE OF CODIGOS FOR WWW.RETRO-REMAKES.NET     BIG GREETINGS TO ALL MY FRIENDS AND ESPECIALLY THESE GREAT PEOPLE : "
    TXT=TXT+"DICAB - STORMBRINGER - JIM - AMPLI - RBZ - TETRA - BENNY - HELLFIRE - HEZAD - GOONER - DREWPEE - PHOENIX - JANER - ENZYMER - ALPHA ONE - "
    TXT=TXT+"MUSASHI9 - HOTSHOT - STINGRAY - NUKE - IKS - PIXEL OUTLAW - MIND - GHOST - JIZZY - STATMAT - SLIPPY - RAIN STORM - ANIMALMOTHER - ZAWRAN - SLINKS AND EVERYONE I KNOW I FORGOT... I AM REALLY SORRY AS I KNOW THERE WERE LOADS OF YOU.. "
    TXT=TXT+"   SEE YOU NEXT TIME....     AND A SPECIAL MESSAGE TO STORMBRINGER, THANKS FOR THE BRIGHT IDEA OF REMAKING THIS ONE :-P NOW FINISH BOULDERS AND XENOMORPHS! ;-)          WRAP...     "
   
    DECLARE SUB SCROLLER()
    dim shared as double scrollpause
    scrollpause=timer
'-------------------------------------------------------------------------------   
'   MENU SETUP
'-------------------------------------------------------------------------------
    DIM SHARED AS DOUBLE OLDMOUSEY
   
    DIM SHARED SELECTED(7) AS INTEGER = {1,1,1,1,1,1,1,1}
    DIM SHARED AS INTEGER MENUON=1
    DIM SHARED AS STRING  OPTIONS(7,2)
    OPTIONS(1,1)="          UNLIMITED ENERGY       OFF"
    OPTIONS(2,1)="          UNLIMITED SIDE SHOTS   OFF"
    OPTIONS(3,1)="          UNLIMITED SPEED UP     OFF"
    OPTIONS(4,1)="          UNLIMITED FIRE POWER   OFF"
    OPTIONS(5,1)=""
    OPTIONS(6,1)=""
    OPTIONS(7,1)="               ** S T A R T **"

    OPTIONS(1,2)="          UNLIMITED ENERGY        ON"
    OPTIONS(2,2)="          UNLIMITED SIDE SHOTS    ON"
    OPTIONS(3,2)="          UNLIMITED SPEED UP      ON"
    OPTIONS(4,2)="          UNLIMITED FIRE POWER    ON"
    OPTIONS(5,2)=""
    OPTIONS(6,2)=""
    OPTIONS(7,2)="               ** S T A R T **"

    DECLARE SUB MENU()
    DECLARE SUB CONTROL_VECTOR()
    DIM SHARED AS DOUBLE VECTOR_TIMER
    VECTOR_TIMER=TIMER
    INTRO_READVECPOINTS()
'-------------------------------------------------------------------------------   
'   SCREEN SETUP;   
'-------------------------------------------------------------------------------
   
    DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
    PTC_ALLOWCLOSE(0)
    PTC_SETDIALOG(1,"WWW.RETRO-REMAKES.NET"+CHR$(13)+"FULL SCREEN?",0,1)               
    IF (PTC_OPEN("Remade by Shockwave^Codigos",XRES,YRES)=0) THEN
    END-1
    END IF   

'-------------------------------------------------------------------------------

    SLEEP 5   
    DIM SHARED AS DOUBLE GADD
    GADD=0
    DIM SHARED AS DOUBLE OLD,NEW,DV
    OLDMOUSEY=PTC_GETMOUSEY
    DIM SHARED AS DOUBLE MOUSEYDELAY,TICKER
    MOUSEYDELAY=TIMER
    MOUSE=SHOWCURSOR(0)

'-------------------------------------------------------------------------------

    DIM SHARED AS DOUBLE XO1,XO2,YO1,YO2,ZO1,ZO2
    DIM SHARED AS INTEGER BOUNCER=0
    TICKER=TIMER
   
'-------------------------------------------------------------------------------   

    hWave = uFMOD_PlaySong(@a0.xm(0),40807,XM_MEMORY)
   
'-------------------------------------------------------------------------------   
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 AND SELECTED(7)=1) 
    OLD=TIMER
    GADD=GADD+(DV*7)
   
    STARFIELD()
    XO2=XO1
    XO1=INTRO_VXR
    YO2=YO1
    YO1=INTRO_VYR
    ZO2=ZO1
    ZO1=INTRO_VZR   
    CONTROL_VECTOR()
    INTRO_ROTATE(XO2-.02,YO2-.02,ZO2-.02)
    INTRO_CONSTRUCT(70,70,70)
    INTRO_ROTATE(XO1-.01,YO1-.01,ZO1-.01)
    INTRO_CONSTRUCT(160,160,160)
    INTRO_ROTATE(INTRO_VXR,INTRO_VYR,INTRO_VZR)
    INTRO_CONSTRUCT(255,255,255)


    MENU()
    SCROLLER()   
    PTC_UPDATE@BUFFER(0)
    BERASE()
   
    NEW = (TIMER-OLD)+.001
    DV=NEW*75
   
WEND
uFMOD_StopSong()
END

'-------------------------------------------------------------------------------

SUB CONTROL_VECTOR()
   
    IF BOUNCER=0 THEN
    IF TIMER-VECTOR_TIMER <10 THEN
        INTRO_VXr=INTRO_VXr+(DV/30)
        IF INTRO_SIZE<3.5 THEN INTRO_SIZE=INTRO_SIZE+(DV/140)
    END IF

    IF TIMER-VECTOR_TIMER <20 AND TIMER-VECTOR_TIMER >=10 THEN
    INTRO_VXr=INTRO_VXr+(DV/30)
    IF INTRO_SIZE>.2 THEN
        INTRO_SIZE=INTRO_SIZE-(DV/140)
        IF INTRO_SIZE<=.2 THEN BOUNCER=1       
    END IF
    END IF
    END IF

    IF BOUNCER>0 THEN
    IF BOUNCER=1 THEN
        IF INTRO_SIZE<3.5 THEN
        INTRO_SIZE=INTRO_SIZE+(DV/140)
        ELSE
        BOUNCER=2
        TICKER=TIMER+2
    END IF
    END IF
   
    IF BOUNCER=2 AND TIMER>=TICKER THEN
        IF INTRO_SIZE>.2 THEN
        INTRO_SIZE=INTRO_SIZE-(DV/140)
        ELSE
        BOUNCER=1
        END IF
    END IF
            INTRO_VXr=INTRO_VXr+(DV/80)
            INTRO_VYr=INTRO_VYr+(DV/50)
            INTRO_VZr=INTRO_VZr+(DV/60)
    END IF
   
END SUB

'-------------------------------------------------------------------------------

SUB MENU()
    DIM AS DOUBLE MCHECK
    MCHECK=PTC_GETMOUSEY
    IF MCHECK-OLDMOUSEY > 10 THEN
            IF MENUON<7 THEN
                MENUON=MENUON+1
                OLDMOUSEY=PTC_GETMOUSEY
            END IF
    END IF
    IF MCHECK-OLDMOUSEY < -10 THEN
            IF MENUON>1 THEN
                MENUON=MENUON-1
                OLDMOUSEY=PTC_GETMOUSEY
            END IF
    END IF   
    IF PTC_GETLEFTBUTTON=TRUE AND MOUSEYDELAY<TIMER THEN
        MOUSEYDELAY=TIMER+.2
        SELECTED(MENUON)=SELECTED(MENUON)+1
        IF SELECTED(MENUON)>2 THEN SELECTED(MENUON)=1
    END IF
       
    DIM AS INTEGER L,TOP,TC
    TOP=376
   
    FOR L=1 TO 7
        IF MENUON=L THEN
            TC=RGB(125+100*SIN(GADD/73),0,0)
        ELSE
            TC=&HB60000
        END IF
            ALARGETEXT(0,TOP,OPTIONS(L,SELECTED(L)),TC)
            TOP=TOP+18
    NEXT
   
END SUB

'-------------------------------------------------------------------------------

SUB STARFIELD()
DIM AS INTEGER L,TX,TY,CUT1,CUT2,TC
dim as double m1,m2,m3

m1=dv*2
m2=dv*5
m3=dv*9

CUT1=INT(STARS/3)
CUT2=CUT1*2

FOR L=0 TO STARS
   
   
    TX=INT(STX(L))
    TY=INT(STY(L))
   
        SELECT CASE L
        CASE 0 TO CUT1
            TC=&H757575
            stx(l)=stx(l)+m1
        CASE CUT1-1 TO CUT2
            TC=&Ha6a6a6
            stx(l)=stx(l)+m2
        CASE ELSE
            TC=&Hffffff
            stx(l)=stx(l)+m3
        END SELECT
    IF TX>1 AND TX<XRES-2 AND TY>1 AND TY<YRES-1 THEN
        BUFFER(TX+(TY*XRES))=TC
        BUFFER(TX+1+(TY*XRES))=TC
        BUFFER(TX+1+((TY+1)*XRES))=TC
        BUFFER(TX+((TY+1)*XRES))=TC
       
    END IF
            if stx(l)>xres+30 then stx(l)=stx(l)-(xres+60)
NEXT

END SUB

'-------------------------------------------------------------------------------

SUB SCROLLER()
    DIM L,SV
    DIM AS DOUBLE CONV
    CONV=3.14/350
   
    FOR L=0 TO XRES-5 STEP 6
        SV=425+50*SIN((L-GADD)*CONV)
        SINETABLE(L)=SV
        SINETABLE(L+1)=SV
        SINETABLE(L+2)=SV
        SINETABLE(L+3)=SV
        SINETABLE(L+4)=SV
        SINETABLE(L+5)=SV
       
    NEXT
   
   
   
    if timer>= scrollpause then TOFF=TOFF-(DV*3)
    IF TOFF<=-32 THEN
        TOFF=TOFF+32
        TP=TP+1
        IF TP>LEN(TXT) THEN TP=1
        if mid(txt,tp,1)="a" then scrollpause=timer+4
    END IF
   
    sinelargetext(TOFF,0,MID(TXT,TP,30))
END SUB

'-------------------------------------------------------------------------------

SUB PRECALC()
DIM AS INTEGER L,TC
DIM AS DOUBLE R,G,B
R=255
G=187
B=255
FOR L=300 TO 360 STEP 2
   
    TC=RGB(INT(R),INT(G),INT(B))
    SELECT CASE L
    CASE 308 TO 330
        R=R-13
        B=B-13
'        g=g-5
    CASE 330 TO 352
        R=R+13
        B=B+13
'        g=g+5
    END SELECT
    if r<0 then r=0
    if b<0 then b=0
    if r>255 then r=255
    if b>255 then b=255
    COPPERLIST(L+1)   = TC
    COPPERLIST(L)     = TC   
    COPPERLIST(L+1+60)= TC
    COPPERLIST(L+60)  = TC
    COPPERLIST(L+1+120)= TC
    COPPERLIST(L+120)  = TC
    COPPERLIST(L+1+180)= TC
    COPPERLIST(L+180)  = TC
   
NEXT

FOR L=0 TO STARS

    STX(L)=RND(1)*XRES
    STY(L)=(RND(1)*324)+25
   
NEXT


END SUB


'-------------------------------------------------------------------------------
' Clear screen and draw background copper bars
'-------------------------------------------------------------------------------

SUB BERASE()
    DIM AS INTEGER TC,PP,Y,SLICE
    FOR Y=0 TO YRES-1
    SELECT CASE Y
    CASE 366,367,510,511
    TC=RGB(136,0,0)
    CASE ELSE
    TC=&H000000
    END SELECT
    PP = @BUFFER((Y*XRES))   
    SLICE=XRES
    asm
        mov eax,dword ptr[TC]
        mov ecx, [slice]
        mov edi, [PP]
        rep stosd
    end asm   
    NEXT
END SUB




SUB sineLARGETEXT(BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING)
   
    DIM AS INTEGER A,MMM,NNN,ZERO,OOO
    FOR A=1 TO LEN(LTS)
    NNN=(ASC(MID(LTS,A,1)))-32
   
    IF NNN<0 THEN NNN=0
   
    IF MID(LTS,A,1) <>" "  AND MID(LTS,A,1) <>"a" AND NNN >0 THEN
    OOO=0   
    MMM = NNN * 32
    LFDRAWIMAGE( LTX,LTY, MMM , OOO )
    END IF

    LTX=LTX+32

    NEXT

END SUB

'-------------------------------------------------------------------------------
' LARGE FONT;
'-------------------------------------------------------------------------------

  Sub LFLoadDataImage()
    dim i as integer
   
    'Loads Color palette
   
    for i = 0 to 255
         LFimg_r( i ) = cfbig.bmp.pal (i*3)'Red color
         LFimg_g( i ) = cfbig.bmp.pal (i*3+1)'Green color
         LFimg_b( i ) = cfbig.bmp.pal (i*3+2)'Blue color
         
         LFimg_r( i ) = rgb (LFimg_r(i),LFimg_g(i),LFimg_b(i))
         
    Next   
   
    for i = 1 to (LFimgx*LFimgy) - 1
         LFimg_buffer(i) = cfbig.bmp.raw (i)
    next 
       
End Sub

Sub LFDrawImage(byval xpos as integer,byval ypos as integer,byval SX as integer,byval SY as integer)
    dim as integer x,y,pixel,mong,intx,inty,xxx,yyy,VLU,TT
   
    xxx=xpos
    yyy=ypos
   
    TT=1
    for Y = SY to SY+31
        for X = SX to SX+31
           
            pixel = LFimg_buffer(x+(y*lfimgx))           
            mong = (LFimg_r(pixel) )           
           
                intx = XXX
                inty = YYY+SINETABLE(XXX)
                if MONG<>0 AND INTX>=0 AND INTX<XRES then
                    MONG=COPPERLIST(INTY)
                 Buffer( intX  +(intY * XRES  )) = MONG
                end if
           
            xxx=xxx+1
        next
       
            yyy=yyy+1
            xxx=xpos
    next
   
End Sub

'-------------------------------------------------------------------------------
' AMIGA SYSTEM FONT;
'-------------------------------------------------------------------------------

SUB ALARGETEXT(BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING, byval c as uinteger)
    DIM AS INTEGER HEIGHT
    DIM AS INTEGER A,MMM,NNN,ZERO,OOO
    FOR A=1 TO LEN(LTS)
    NNN=(ASC(MID(LTS,A,1)))-32
   
    IF NNN<0 THEN NNN=0
   
    IF MID(LTS,A,1) <>" "  AND NNN >0 THEN
    OOO=0   
    MMM = (NNN * 10)+1
    ALFDRAWIMAGE( LTX,LTY, MMM , OOO ,c)
    END IF

    LTX=LTX+18

    NEXT

END SUB

'-------------------------------------------------------------------------------
' LARGE FONT;
'-------------------------------------------------------------------------------

Sub ALFLoadDataImage()
    dim i as integer
    'Loads Color palette
    for i = 0 to 255
         ALFimg_r( i ) = amy.bmp.pal (i*3)'Red color
         ALFimg_g( i ) = amy.bmp.pal (i*3+1)'Green color
         ALFimg_b( i ) = amy.bmp.pal (i*3+2)'Blue color
         
         ALFimg_r( i ) = rgb (ALFimg_r(i),ALFimg_g(i),ALFimg_b(i))
         
    Next   
   
    for i = 1 to (ALFimgx*ALFimgy) - 1
         ALFimg_buffer(i) = amy.bmp.raw (i)
    next 
       
End Sub

Sub ALFDrawImage(byval xpos as integer,byval ypos as integer,byval SX as integer,byval SY as integer, byval c as uinteger)
    dim as integer x,y,pixel,mong,intx,inty,xxx,yyy,VLU,TT,Z,tc


    tc=c
    dim huh as integer
   
    xxx=xpos
    yyy=ypos
   
    TT=1

    for Y = 0 to 17
        for X = SX to SX+9
           
            pixel = ALFimg_buffer(x+(y*Alfimgx))           
            IF XXX>0 AND XXX<XRES THEN
            mong = (LFimg_r(pixel) )                           
                intx = xxx
                inty = yyy
               
                if MONG<>0 and intx>0 and intx<xres-2 then
                   
                 Buffer( intX  +(intY * XRES)) = tc
                 Buffer( intX  +1+(intY * XRES)) = tc
                 Buffer( intX  +2+(intY * XRES)) = tc
                end if
            END IF
            xxx=xxx+2
        next   
       
            yyy=yyy+1
            xxx=xpos
    next
   
End Sub

'-------------------------------------------------------------------------------

SUB INTRO_EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER, BYVAL LG AS INTEGER, BYVAL LB AS INTEGER)
'-------------------------------------------------------------------------------
'
' THIS LINE ROUTINE IS NOT VERY FAST BUT IT WORKS.
' USAGE:
' INTRO_EDGE ( X1 , Y1 , X2 , Y2 , R , G , B )
'
'-------------------------------------------------------------------------------
        DIM xdistance AS DOUBLE
        DIM ydistance AS DOUBLE
        DIM TC AS INTEGER       
        DIM i AS INTEGER
        DIM h2 AS INTEGER
       
        DIM StartX AS DOUBLE
        DIM StartY AS DOUBLE
        DIM XRatio AS DOUBLE
        DIM YRatio AS DOUBLE

        TC = RGB ( LR,LG,LB )

        xdistance = X2 - X1
        ydistance = Y2 - Y1

        h2 = sqr( xdistance * xdistance + ydistance * ydistance )
       
        StartX = X1
        StartY = Y1
       
        XRatio = xdistance * ( 1.0 / h2 )
        YRatio = ydistance * ( 1.0 / h2 )
       
        for i = 0 to h2
            IF STARTX>1 AND STARTX<XRES-1 AND STARTY>1 AND STARTY<365 THEN
            BUFFER ( INT(StartX) + (INT(StartY) * XRES ) ) = TC
            BUFFER ( INT(StartX) + (INT(StartY+1) * XRES ) ) = TC
            BUFFER ( INT(StartX) + (INT(StartY-1) * XRES ) ) = TC
            BUFFER ( INT(StartX) + 1 + (INT(StartY) * XRES ) ) = TC
            BUFFER ( INT(StartX) -1 + (INT(StartY) * XRES ) ) = TC
            END IF
            StartX = StartX + XRatio
            StartY = StartY + YRatio
        next i
       
END SUB






SUB INTRO_READVECPOINTS()
    DIM A AS INTEGER
    '---------------------------------------------------------------------------
    ' READ AND STORE POINTS;
    '---------------------------------------------------------------------------
    FOR A=1 TO INTRO_VLPOINTS
       
        READ INTRO_VX(A)
        READ INTRO_VY(A)
        INTRO_VY(A)=INTRO_VY(A)*3.1
        INTRO_VX(A)=INTRO_VX(A)*6.5
        READ INTRO_VZ(A)
       
    NEXT

    '---------------------------------------------------------------------------
    ' READ AND STORE CONNECTIONS;
    '---------------------------------------------------------------------------
   
    FOR A=1 TO INTRO_VLLINES
        READ INTRO_LINEFROM(A)
        READ INTRO_LINE_TO(A)
    NEXT
   
END SUB


SUB INTRO_CONSTRUCT(BYVAL LR AS INTEGER, BYVAL LG AS INTEGER, BYVAL LB AS INTEGER)
    DIM AS INTEGER A,TX,TY
   
    FOR A=1 TO INTRO_VLLINES
        INTRO_EDGE(INTRO_VTX(INTRO_LINEFROM(A)),INTRO_VTY(INTRO_LINEFROM(A)),INTRO_VTX(INTRO_LINE_TO(A)),INTRO_VTY(INTRO_LINE_TO(A)),LR,LG,LB)
    NEXT
   
   
    '---------------------------------------------------------------------------
    ' DEBUG SHOW VERTICES;
    '---------------------------------------------------------------------------
   
 '   FOR A=1 TO INTRO_VLPOINTS
 '       TX= INTRO_VTX(A)
 '       TY= INTRO_VTY(A)
 '       IF TX>0 AND TX<INTRO_XRES AND TY>0 AND TY<INTRO_YRES THEN
 '           INTRO_BUFFER (TX+(TY*INTRO_XRES)) = &HFF0000
 '       END IF
 '   NEXT
 
END SUB

SUB INTRO_ROTATE(BYVAL RRX AS DOUBLE,BYVAL RRY AS DOUBLE,BYVAL RRZ AS DOUBLE )
DIM A AS INTEGER

    DIM INTRO_VX1 AS DOUBLE
    dim INTRO_VY1 AS DOUBLE
    dim INTRO_VZ1 AS DOUBLE
   
    DIM INTRO_VZZ AS DOUBLE   
    dim INTRO_VXx as double
    dim INTRO_VYy as double
   
    DIM VDV AS DOUBLE

'###############################################
'## INTRO_ROTATE And Scale Each Point! Store Result ##
'###############################################
 For A=1 To INTRO_VLPOINTS

    INTRO_VX1=INTRO_VX(A)
    INTRO_VY1=INTRO_VY(A)
   
    INTRO_VZ1=INTRO_VZ(A)
   
'######################
'## X,Y,Z rotations! ##
'######################
  INTRO_VXx=INTRO_VX1
  INTRO_VYy=INTRO_VY1*cos(RRX)+INTRO_VZ1*sin(RRX)
  INTRO_VZz=INTRO_VZ1*cos(RRX)-INTRO_VY1*sin(RRX)
 
  INTRO_VY1=INTRO_VYy
  INTRO_VX1=INTRO_VXx*cos(RRY)-INTRO_VZz*sin(RRY)
  INTRO_VZ1=INTRO_VXx*sin(RRY)+INTRO_VZz*cos(RRY)
 
  INTRO_VZz=INTRO_VZ1
  INTRO_VXx=INTRO_VX1*cos(RRZ)-INTRO_VY1*sin(RRZ)
  INTRO_VYy=INTRO_VX1*sin(RRZ)+INTRO_VY1*cos(RRZ)
'########################
'## Apply Perspective! ##
'########################
  Vdv=(INTRO_VZz/500)+1

  INTRO_VXx=(INTRO_SIZE*(INTRO_VXx/Vdv))+INTRO_HALFX
 
  INTRO_VYy=(INTRO_SIZE*(INTRO_VYy/Vdv))+INTRO_HALFY
 
  INTRO_VTX(a)=Int(INTRO_VXx)
  INTRO_VTY(a)=Int(INTRO_VYy)
  INTRO_VTZ(a)=Int(INTRO_VZz)

 Next



END SUB


'-------------------------------------------------------------------------------
' LOGO DATA (POINTS)X Y Z
'-------------------------------------------------------------------------------
'LARGE C
DATA -7,-5,0,-11,-5,0,-11, 5,0,11, 5,0
'L
DATA -7,3,0,-5,3,0
'A
DATA -3,-5,0,-1,3,0
'S
DATA 2,3,0,2,-1,0,-1,-1,0,-1,-5,0,7,-5,0
'I
DATA 7,3,0
'S
DATA 3,3,0,6,3,0,6,-1,0,3,-1,0,3,-3,0
'C
DATA 11,-5,0,8,-5,0,8,3,0,11,3,0
'-------------------------------------------------------------------------------
' CONNECTIONS;
'-------------------------------------------------------------------------------
'LARGE C
DATA 1,2,2,3,3,4
'L
DATA 1,5,5,6
'A
DATA 6,7,7,8
'S
DATA 8,9,9,10,10,11,11,12,12,13
'I
DATA 13,14
'S
DATA 15,16,16,17,17,18,18,19
'C
DATA 20,21,21,22,22,23
Shockwave ^ Codigos
Challenge Trophies Won:

Offline donvito

  • n00bzor
  • ZX 81
  • *
  • Posts: 15
  • Karma: 1
  • programming <3
    • View Profile
Re: Timesoldier remake source
« Reply #1 on: September 25, 2008 »
awesome!  :clap:

thanks a lot, the scroller code is really helpful.

EDIT: haha! cock shave...

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17376
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: Timesoldier remake source
« Reply #2 on: September 26, 2008 »
Feel free to use the code in your own things :)
Shockwave ^ Codigos
Challenge Trophies Won:

Offline benny!

  • Senior Member
  • DBF Aficionado
  • ********
  • Posts: 4380
  • Karma: 228
  • in this place forever!
    • View Profile
    • bennyschuetz.com - mycroBlog
Re: Timesoldier remake source
« Reply #3 on: September 26, 2008 »
...
EDIT: haha! cock shave...

rofl ...

thanks for sharing code, shocky! :carrot:
[ mycroBLOG - POUET :: whatever keeps us longing - for another breath of air - is getting rare ]

Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17376
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: Timesoldier remake source
« Reply #4 on: January 18, 2010 »
The attached rar file contains everything you need for the intro.

Enjoy :)
Shockwave ^ Codigos
Challenge Trophies Won:

Offline rdc

  • Pentium
  • *****
  • Posts: 1495
  • Karma: 140
  • Yes, it is me.
    • View Profile
    • Clark Productions
Re: Timesoldier remake source
« Reply #5 on: January 18, 2010 »
Very cool indeed.