Author Topic: Vector Scroll Source Code  (Read 6335 times)

0 Members and 1 Guest are viewing this topic.

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17394
  • Karma: 498
  • evil/good
    • View Profile
    • My Homepage
Vector Scroll Source Code
« on: June 11, 2011 »
Here's the source to my entry for the wireframe challenge.

Code: [Select]
'
'                     Vector Scroll By Shockwave
'                     ==========================
'
'                 Greetings to gun owners everywhere.
'                    http://www.dbfinteractive.com
'
'===============================================================================

    RANDOMIZE TIMER

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

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"

    #INCLUDE "disgracepal.bas"
    #INCLUDE "disgraceraw.bas"
    #INCLUDE "some.bas"
    #INCLUDE "minifmod170.bi"


    OPTION STATIC
    OPTION EXPLICIT
   
'===============================================================================
'   INITIALISE PICTURE TEMPLATE;
'===============================================================================

    DIM SHARED AS INTEGER IMGX,IMGY

'===============================================================================
'   Be aware.. these variables are for the template of the image.
'   Make sure that they are the exact size of the template picture.
'   Make sure that the width divides by 8 with no remainder or you
'   Will surely get awful errors.
'===============================================================================

    IMGX=304:' WIDTH
    IMGY=44:'  HEIGHT

    DIM SHARED AS INTEGER IMG_COLOURS(256)
    DIM SHARED AS INTEGER IMG_RAW(IMGX * IMGY)
    DECLARE SUB LOAD_IMAGE()
    DECLARE SUB DRAW_IMAGE  (BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL W AS INTEGER, BYVAL H AS INTEGER, BYVAL SX AS INTEGER , BYVAL SY AS INTEGER , BYVAL MASK AS UINTEGER )
    LOAD_IMAGE()


'-------------------------------------------------------------------------------
'   Consts, Variables and Arrays.
'-------------------------------------------------------------------------------
   
    CONST   XRES    =   800
    CONST   YRES    =   600 
   
    CONST   HALFX   =   400
    CONST   HALFY   =   300   
   
    ' *
    ' * How Many Letters We Can Display On Screen At Once.
    ' * 
   
    CONST MAXLETTERS = 38
   
    ' *
    ' * Each Letter Is Made From A 3*3 Matrix.
    ' *
   
    CONST   VERTX   =   3
    CONST   VERTY   =   3
       
    ' *
    ' * Define The Letters.
    ' *
   
    DIM SHARED AS DOUBLE  POINTX (VERTX,VERTY,MAXLETTERS)
    DIM SHARED AS DOUBLE  POINTY (VERTX,VERTY,MAXLETTERS)
    DIM SHARED AS DOUBLE  POINTZ (VERTX,VERTY,MAXLETTERS)

    DIM SHARED AS INTEGER TPX    (VERTX,VERTY)
    DIM SHARED AS INTEGER TPY    (VERTX,VERTY)

    DIM SHARED AS INTEGER TPX2   (VERTX,VERTY)
    DIM SHARED AS INTEGER TPY2   (VERTX,VERTY)
   

    DIM SHARED AS UINTEGER COLOUR_PALETTE(100000)

    ' *
    ' * Letter Structures
    ' *

    DIM SHARED AS SHORT  STRUCT  (20 , 65)

    ' *
    ' * Scrolly Message!
    ' *
   
    DIM SHARED AS STRING SCROLL_TEXT
    DIM SHARED AS INTEGER P
   
    P=1
   
    SCROLL_TEXT ="                "
    SCROLL_TEXT=SCROLL_TEXT+"PARANOIMIA  --  COURTESY OF PERFECT CRACKS  --   HAHA...    JUST KIDDING... "
    SCROLL_TEXT=SCROLL_TEXT+"  ACTUALLY IT'S SHOCKWAVE HERE WITH HIS ENTRY TO    &&& DARK BIT FACTORY &&&    --WIREFRAME CHALLENGE 2011--       ** IF YOU ARE FINDING THIS HARD TO READ TRY CURSORS UP AND DOWN TO ROTATE AND CURSORS LEFT AND RIGHT TO ADJUST THE SPEED **"
    SCROLL_TEXT=SCROLL_TEXT+"THIS INTRO TAKES IT'S INSPIRATION AND IT'S MUSIC (BY JESPER KYD) FROM THE ORIGINAL SUPERCARS CRACKTRO____          "
    SCROLL_TEXT=SCROLL_TEXT+"THE BIG DIFFERENCE IS THE LARGE AMOUNT OF GLOW THAT I PUT ON THIS VECTOR SCROLL AND ALSO THAT COOLJ'S INTRO ACTUALLY LOOKED &&GOOD&&   "
    SCROLL_TEXT=SCROLL_TEXT+"I AM UNDECIDED WHETHER I LIKE THIS OR NOT AND I WOULD RATHER MAKE SOMETHING BETTER FOR THE CHALLENGE...   THE TROUBLE IS THAT I WILL NOT BE ABLE TO SPEND ANY MORE TIME ON IT THIS MONTH "
    SCROLL_TEXT=SCROLL_TEXT+"SO THIS WILL HAVE TO DO...  WHICH MEANS I'LL GET OWNED BY ABOUT 12 PEOPLE && HAHA &&  IT'S ALL GOOD THOUGH ___        "
    SCROLL_TEXT=SCROLL_TEXT+"I'D BETTER DO SOME GREETINGS (I WILL PROBABLY FORGET ABOUT 98213465 PEOPLE - SORRY)  IN RANDOM ORDER, TOO MUCH GLOW TO THE FOLLOWING PEOPLE    "
    SCROLL_TEXT=SCROLL_TEXT+"* JIM * RBZ * HELLFIRE * DR_DEATH * PADMAN * COMBATKING * KIRL * NINOGENIO * RDC * MOROBOSHISAN * RELSOFT * STORMBRINGER * LITTLEWHITE * SLINKS * YALOOPY * XETICK * EFECTO * BIKEMADNESS * WENLOCK * HOTSHOT *"
    SCROLL_TEXT=SCROLL_TEXT+" FERRIS * CLYDE * JANER * DICAB * ZAWRAN * MICHU * AMPLI * NUKE * JONCOM * TETRA * DRUID * TAJ * IROKOS * BEN GARRETT * ENZYMER * ALPHA ONE * WIDOWMAKER * STU EVERSON * AND EVERYONE ELSE WHO I HAVE FORGOTTEN -- THERE ARE DEFINITELY LOADS OF YOU AND I AM A TWAT WITH A BAD MEMORY "
    SCROLL_TEXT=SCROLL_TEXT+"____ IF YOU KNOW ME PLEASE CONSIDER YOURSELF GREETED ____  FUCKINGS TO PUKI - YOU CUNT ____  THAT'S ALL I HAVE TIME FOR SO LET'S WRAP.....    "
    SCROLL_TEXT=SCROLL_TEXT+"LAID HER"
    SCROLL_TEXT=SCROLL_TEXT+"                                    "
    SCROLL_TEXT=UCASE(SCROLL_TEXT)

    ' *
    ' * Delta timing and screen buffers.
    ' *   
   
    DIM SHARED AS DOUBLE DV , OLD , GADD , SCX,SCRLROT,MULT
    DIM SHARED AS UINTEGER SCREEN_BUFFER ( XRES * YRES )     
    DIM SHARED AS UINTEGER PROCESS_BUFFER ( XRES * YRES )     
   
    SCX = 0
   
    CONST STARNUM =2000
   
    DIM SHARED AS DOUBLE STRX (STARNUM)
    DIM SHARED AS DOUBLE STRY (STARNUM)
    DIM SHARED AS DOUBLE STRZ (STARNUM)
   
   
'-------------------------------------------------------------------------------
'   Define the Subs.
'-------------------------------------------------------------------------------

    DECLARE SUB EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER)
    DECLARE SUB PREPARE_LETTERS()
    DECLARE SUB SET_PALETTE()
    DECLARE SUB RENDER_SCREEN_BUFFER()
    DECLARE SUB DARKEN_BUFFER()

    DECLARE SUB PREPARE_GRID()
    DECLARE SUB DRAW_GRID()
   
    DECLARE SUB SETSTARS()
    DECLARE SUB DRAWSTARS()

    PREPARE_GRID()
    PREPARE_LETTERS()
    SET_PALETTE()
    SETSTARS()
   
'-------------------------------------------------------------------------------

    ' *
    ' * Open the window
    ' *
   
    PTC_ALLOWCLOSE(0)   
    PTC_SETDIALOG(1,"Test"+CHR$(13)+"Full Screen?",0,1)               
    IF (PTC_OPEN("Shockwave 2011",XRES,YRES)=0) THEN
    END-1
    END IF   
    SLEEP 10   
   
'-------------------------------------------------------------------------------
'   PLAY THE FUCKING MUSIC;
'-------------------------------------------------------------------------------

    If MiniFmod_Init(@some.xm(0), 25168)  =  0  Then
        end-1
    End If
    MiniFmod_Play()   
    DIM TWAT AS INTEGER
    TWAT=SHOWCURSOR(0)
   
'-------------------------------------------------------------------------------
'   Loop
'-------------------------------------------------------------------------------
    SCRLROT=0
    MULT=60
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE) 
   
   
    OLD=TIMER
   
    IF GETASYNCKEYSTATE(VK_UP) THEN
        SCRLROT=SCRLROT-.1
        IF SCRLROT<-3.6 THEN SCRLROT=-3.6
    END IF
   
    IF GETASYNCKEYSTATE(VK_DOWN) THEN
        SCRLROT=SCRLROT+.1
        IF SCRLROT>3.6 THEN SCRLROT=3.6
    END IF

    IF GETASYNCKEYSTATE(VK_LEFT) THEN
        MULT=MULT+1
        IF MULT>120 THEN MULT=120
    END IF

    IF GETASYNCKEYSTATE(VK_RIGHT) THEN
        MULT=MULT-1
        IF MULT<30 THEN MULT=30
    END IF
    DRAW_GRID()       
    DRAWSTARS()
   
    DRAW_IMAGE(0,0,290,30,40,30,0)
    DRAW_IMAGE(0,31,90,10,680,530,0)
    DARKEN_BUFFER()
   
    RENDER_SCREEN_BUFFER()
   
    PTC_UPDATE@SCREEN_BUFFER(0)             
    ERASE PROCESS_BUFFER
   
    DV=TIMER-OLD
    GADD = GADD + ( DV*10 )
    IF DV>=1 THEN DV=1
   
WEND
  MiniFmod_Stop()
 
EXITPROCESS(0)

'-------------------------------------------------------------------------------
'   Subroutines
'-------------------------------------------------------------------------------

SUB SETSTARS()
   
    ' *
    ' * - Set the initial Star Points.
    ' *
   
    DIM LP AS INTEGER
    FOR LP=1 TO STARNUM
        STRX(LP)=(RND(1)*1000)-900
        STRY(LP)=(RND(1)*450)-150
        STRZ(LP)=(RND(1)*16)
    NEXT
END SUB

SUB DRAWSTARS()   
   
    ' * 
    ' * - Lame Ass 3D Starfield
    ' *   
   
    DIM AS INTEGER LP,TX,TY,ADD
   
    FOR LP=1 TO STARNUM
        TX=(STRX(LP)/STRZ(LP))+780
        TY=(STRY(LP)/STRZ(LP))+100
       
        IF TX>5 AND TX<XRES-10 AND TY>10 AND TY<YRES-10 AND STRZ(LP)<13 THEN
            ADD=32+(-STRZ(LP))
            PROCESS_BUFFER(TX+(TY*XRES))+=ADD*8
        END IF

            STRZ(LP)=STRZ(LP)-(DV*.6)
            STRX(LP)=STRX(LP)-DV*45
            STRY(LP)=STRY(LP)+DV*25
           
            IF STRZ(LP)<0 THEN STRZ(LP)+=16
            IF STRX(LP)<= -900 THEN STRX(LP)+=1000
            IF STRY(LP)>=  300 THEN STRY(LP)-=450           
       
    NEXT
   
END SUB


SUB DARKEN_BUFFER()

    DIM AS UINTEGER PTR PP1,PP2,PP3,PP4,PP5
   
    '  *
    '  * - Cheap and fast Anti-Alias Blurr with botton right bias.
    '  *
   
    DIM LP AS INTEGER
    DIM TOT AS INTEGER
    PP1=@PROCESS_BUFFER(XRES+1)
    PP2=@PROCESS_BUFFER(XRES)
    PP3=@PROCESS_BUFFER(XRES+2)
    PP4=@PROCESS_BUFFER(1)
    PP5=@PROCESS_BUFFER(XRES+XRES+1)
   
    FOR LP=XRES*20 TO (XRES*(YRES-20))-(XRES)
           
        TOT= (*PP1 + *PP2 + *PP3 +*PP4 + *PP5) *.45
       
        *PP1 = TOT
       
        PP1+=1
        PP2+=1
        PP3+=1
        PP4+=1
        PP5+=1
       
    NEXT

END SUB


SUB DRAW_GRID()
   
    ' *
    ' * 3D Scroll Routine.
    ' *
   
    DIM AS INTEGER LP,TX,TY,X,Y,CC,RGBB,LEP
    DIM AS DOUBLE XPS,JUMP,SCALE
    DIM AS DOUBLE VX1,VY1,VZ1
    SCALE=10
    DIM AS DOUBLE VRXR ,VRYR,VRZR,VZZ,VXX,VYY,VDV
    VRYR=1.43
    VRZR=-.2+.02*SIN(GADD*.1)
    VRXR=0.9+SCRLROT
   
    JUMP = 24

    SCX  = SCX + DV * MULT
 
    IF SCX > JUMP THEN

        P=P+1
        IF P>LEN(SCROLL_TEXT)-MAXLETTERS THEN
            P=1
        END IF
       
        SCX=SCX-JUMP
       
    END IF

    XPS=-((MAXLETTERS*JUMP) / 2 )
    XPS =XPS -SCX
    CC=300
   
   
    FOR LP = 1 TO MAXLETTERS
       
        FOR X=1 TO 3
           
            FOR Y=1 TO 3

                VX1=POINTX(X,Y,LP)+XPS
                VY1=POINTY(X,Y,LP)
                VZ1=POINTZ(X,Y,LP)+7

                Vxx=Vx1
                Vyy=Vy1*cos(VRxr)+Vz1*sin(VRxr)
                Vzz=Vz1*cos(VRxr)-Vy1*sin(VRxr)
 
                Vy1=Vyy
                Vx1=Vxx*cos(VRyr)-Vzz*sin(VRyr)
                Vz1=Vxx*sin(VRyr)+Vzz*cos(VRyr)
 
                Vzz=Vz1
                Vxx=Vx1*cos(VRzr)-Vy1*sin(VRzr)
                Vyy=Vx1*sin(VRzr)+Vy1*cos(VRzr)

                Vdv=(Vzz/60.15)+8.5
                Vxx=(SCALE*(Vxx/Vdv))+(HALFX)+410
                Vyy=(SCALE*(Vyy/Vdv))+HALFY-200
 
                TPX(X,Y)=Int(Vxx)
                TPY(X,Y)=Int(Vyy)



                VX1=POINTX(X,Y,LP)+XPS
                VY1=POINTY(X,Y,LP)
                VZ1=POINTZ(X,Y,LP)+7.5

                Vxx=Vx1
                Vyy=Vy1*cos(VRxr)+Vz1*sin(VRxr)
                Vzz=Vz1*cos(VRxr)-Vy1*sin(VRxr)
 
                Vy1=Vyy
                Vx1=Vxx*cos(VRyr)-Vzz*sin(VRyr)
                Vz1=Vxx*sin(VRyr)+Vzz*cos(VRyr)
 
                Vzz=Vz1
                Vxx=Vx1*cos(VRzr)-Vy1*sin(VRzr)
                Vyy=Vx1*sin(VRzr)+Vy1*cos(VRzr)

                Vdv=(Vzz/60.15)+8.5
                Vxx=(SCALE*(Vxx/Vdv))+(HALFX)+410
                Vyy=(SCALE*(Vyy/Vdv))+HALFY-200
 
                TPX2(X,Y)=Int(Vxx)
                TPY2(X,Y)=Int(Vyy)
               
            NEXT
           
        NEXT
       
        if cc>=0 then CC-=20
        if cc<0 then cc=0
        RGBB=CC
       
       
    XPS =XPS+JUMP
   
    LEP=ASC(MID(SCROLL_TEXT,P+LP,1))-31
    IF LEP<1 THEN LEP=1
    IF LEP>65 THEN LEP=1

    if STRUCT (1,LEP)=1  THEN EDGE(TPX(1,1),TPY(1,1),TPX(1,2),TPY(1,2),RGBB)
    if STRUCT (2,LEP)=1  THEN EDGE(TPX(1,2),TPY(1,2),TPX(1,3),TPY(1,3),RGBB)
    if STRUCT (3,LEP)=1  THEN EDGE(TPX(1,3),TPY(1,3),TPX(2,3),TPY(2,3),RGBB)
    if STRUCT (4,LEP)=1  THEN EDGE(TPX(2,3),TPY(2,3),TPX(3,3),TPY(3,3),RGBB)
    if STRUCT (5,LEP)=1  THEN EDGE(TPX(3,3),TPY(3,3),TPX(3,2),TPY(3,2),RGBB)
    if STRUCT (6,LEP)=1  THEN EDGE(TPX(3,2),TPY(3,2),TPX(3,1),TPY(3,1),RGBB)
    if STRUCT (7,LEP)=1  THEN EDGE(TPX(3,1),TPY(3,1),TPX(2,1),TPY(2,1),RGBB)
    if STRUCT (8,LEP)=1  THEN EDGE(TPX(2,1),TPY(2,1),TPX(1,1),TPY(1,1),RGBB)

    if STRUCT (9,LEP)=1  THEN EDGE(TPX(2,1),TPY(2,1),TPX(2,2),TPY(2,2),RGBB)
    if STRUCT (10,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(2,3),TPY(2,3),RGBB)
    if STRUCT (11,LEP)=1 THEN EDGE(TPX(1,2),TPY(1,2),TPX(2,2),TPY(2,2),RGBB)
    if STRUCT (12,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(3,2),TPY(3,2),RGBB)

    if STRUCT (13,LEP)=1 THEN EDGE(TPX(1,1),TPY(1,1),TPX(2,2),TPY(2,2),RGBB)
    if STRUCT (14,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(3,3),TPY(3,3),RGBB)

    if STRUCT (15,LEP)=1 THEN EDGE(TPX(3,1),TPY(3,1),TPX(2,2),TPY(2,2),RGBB)
    if STRUCT (16,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(1,3),TPY(1,3),RGBB)

    if STRUCT (17,LEP)=1 THEN EDGE(TPX(2,1),TPY(2,1),TPX(1,2),TPY(1,2),RGBB)
    if STRUCT (18,LEP)=1 THEN EDGE(TPX(2,1),TPY(2,1),TPX(3,2),TPY(3,2),RGBB)
   
    if STRUCT (19,LEP)=1 THEN EDGE(TPX(1,2),TPY(1,2),TPX(2,3),TPY(2,3),RGBB)
    if STRUCT (20,LEP)=1 THEN EDGE(TPX(3,2),TPY(3,2),TPX(2,3),TPY(2,3),RGBB)


    if STRUCT (1,LEP)=1  THEN EDGE(TPX2(1,1),TPY2(1,1),TPX2(1,2),TPY2(1,2),RGBB)
    if STRUCT (2,LEP)=1  THEN EDGE(TPX2(1,2),TPY2(1,2),TPX2(1,3),TPY2(1,3),RGBB)
    if STRUCT (3,LEP)=1  THEN EDGE(TPX2(1,3),TPY2(1,3),TPX2(2,3),TPY2(2,3),RGBB)
    if STRUCT (4,LEP)=1  THEN EDGE(TPX2(2,3),TPY2(2,3),TPX2(3,3),TPY2(3,3),RGBB)
    if STRUCT (5,LEP)=1  THEN EDGE(TPX2(3,3),TPY2(3,3),TPX2(3,2),TPY2(3,2),RGBB)
    if STRUCT (6,LEP)=1  THEN EDGE(TPX2(3,2),TPY2(3,2),TPX2(3,1),TPY2(3,1),RGBB)
    if STRUCT (7,LEP)=1  THEN EDGE(TPX2(3,1),TPY2(3,1),TPX2(2,1),TPY2(2,1),RGBB)
    if STRUCT (8,LEP)=1  THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(1,1),TPY2(1,1),RGBB)

    if STRUCT (9,LEP)=1  THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(2,2),TPY2(2,2),RGBB)
    if STRUCT (10,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(2,3),TPY2(2,3),RGBB)
    if STRUCT (11,LEP)=1 THEN EDGE(TPX2(1,2),TPY2(1,2),TPX2(2,2),TPY2(2,2),RGBB)
    if STRUCT (12,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(3,2),TPY2(3,2),RGBB)

    if STRUCT (13,LEP)=1 THEN EDGE(TPX2(1,1),TPY2(1,1),TPX2(2,2),TPY2(2,2),RGBB)
    if STRUCT (14,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(3,3),TPY2(3,3),RGBB)

    if STRUCT (15,LEP)=1 THEN EDGE(TPX2(3,1),TPY2(3,1),TPX2(2,2),TPY2(2,2),RGBB)
    if STRUCT (16,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(1,3),TPY2(1,3),RGBB)

    if STRUCT (17,LEP)=1 THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(1,2),TPY2(1,2),RGBB)
    if STRUCT (18,LEP)=1 THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(3,2),TPY2(3,2),RGBB)
   
    if STRUCT (19,LEP)=1 THEN EDGE(TPX2(1,2),TPY2(1,2),TPX2(2,3),TPY2(2,3),RGBB)
    if STRUCT (20,LEP)=1 THEN EDGE(TPX2(3,2),TPY2(3,2),TPX2(2,3),TPY2(2,3),RGBB)
   


    NEXT LP   
   
END SUB

SUB PREPARE_LETTERS()
   
    ' *
    ' *
    ' * Define which letters are connected.
    ' *
    ' *
   
    DIM AS INTEGER LP,LP2,VALUE   
   
    FOR LP=1 TO 65
   
        FOR LP2=1 TO 20
           
            READ VALUE

            STRUCT(LP2,LP)=VALUE
           
        NEXT
       
    NEXT
   
   
END SUB


SUB PREPARE_GRID()
   
    ' *
    ' * This one just sets the vertices of the 3*3 grid in the letters.
    ' * Also it makes sure that the connections for each letter are clear.
    ' *   
   
    DIM LP AS INTEGER
    DIM AS INTEGER X,Y,L
   
    DIM AS DOUBLE TXP,TYP,TZP,GAP

    GAP =   10
   
    ' *
    ' * Loop through each of the letters
    ' *
   
    FOR L=1 TO MAXLETTERS
       
        TXP =   -GAP
        TYP =   -(GAP*1.2)
        TZP =   1.0
       
        ' *
        ' * X Co-Ords
        ' *
       
        FOR X=1 TO VERTX   
            ' *
            ' * Y Co-Ords
            ' *
            FOR Y=1 TO VERTY
               
                ' *
                ' * Set the vertices
                ' *
               
                POINTX ( X,Y,L )    =   TXP
                POINTY ( X,Y,L )    =   TYP
                POINTZ ( X,Y,L )    =   TZP
                TYP =   TYP +   (GAP*1.2)
           
        NEXT Y
       
            TXP =   TXP +   GAP
            TYP =   -(GAP*1.2)
           
        NEXT X
       
        TXP =   -GAP
        TZP =   0.0
       
    NEXT L       
   
END SUB


SUB EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER)

    ' *
    ' * - Line Draw Routine.
    ' *

        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

        DIM BUFF AS INTEGER
       
        TC =  LR
        xdistance = X2 - X1
        ydistance = Y2 - Y1
        h2 = sqr( xdistance * xdistance + ydistance * ydistance )       
        if h2>1200 then exit sub       
        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-15 AND STARTY>0 AND STARTY<YRES-1 THEN
               
            PROCESS_BUFFER ( INT((StartX) + (INT(StartY) * XRES )) ) = TC           
           
            END IF
       
            StartX = StartX + XRatio
            StartY = StartY + YRatio
           
        next i
       
END SUB


SUB RENDER_SCREEN_BUFFER()

    ' *
    ' * - Plot Those Dots!
    ' *

    DIM AS UINTEGER PTR PP1,PP2
    DIM AS UINTEGER LP
   
    PP1 =@SCREEN_BUFFER(0)
    PP2 =@PROCESS_BUFFER(0)
   
    FOR LP=0 TO XRES*YRES
   
        *PP1 = COLOUR_PALETTE( *PP2 )
   
        PP1 += 1
        PP2 += 1
       
    NEXT
   
   
END SUB

SUB SET_PALETTE()

' *
' * - PRE-CALCULATE A PALETTE THIS WILL SAVE A LOT OF TIME LATER :-)
' *

    DIM AS DOUBLE RR,GG,BB
    DIM AS INTEGER LP
    DIM AS UINTEGER TC
   
    RR = 0.0
    GG = 0.0
    BB = 0.0
   
    FOR LP=0 TO 9999
       
        TC=RGB(INT(RR),INT(GG),INT(BB))
       
        COLOUR_PALETTE(LP) = TC
        IF LP>50 THEN
        RR += .30
        GG += .60
        BB += .8
        END IF
        IF RR > 255 THEN RR = 255
        IF GG > 255 THEN GG = 255
        IF BB > 255 THEN BB = 255
       
    NEXT
   
END SUB


SUB DRAW_IMAGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL W AS INTEGER, BYVAL H AS INTEGER, BYVAL SX AS INTEGER , BYVAL SY AS INTEGER , BYVAL MASK AS UINTEGER)

'-------------------------------------------------------------------------------
' *
' * DRAW_IMAGE BY SHOCKWAVE^CODIGOS
' *
' * USAGE :  DRAWIMAGE ( X1 , Y1 , WIDTH , HEIGHT , SCREENX , SCREENY , MASK COLOUR &HRRGGBB)
' *
' * THIS FUNCTION DOES NOT CHECK WHERE YOU ARE COPYING FROM.
' * IF YOU TRY TO COPY FROM AN AREA OUTSIDE YOUR TEMPLATE, IT WILL CRASH.
' * IT IS DONE THIS WAY FOR SPEED.
' *
' * THIS FUNCTION DOES CLIP THE IMAGE TO THE DISPLAY SCREEN.
' * IT IS SAFE TO DRAW PARTLY OR COMPLETELY OFF THE DISPLAY SCREEN.
' *
'-------------------------------------------------------------------------------


    DIM AS INTEGER X,Y,XX,YY,PIXEL,Q,GLOW
    DIM AS UINTEGER PTR PP1,PP2   
    YY=SY
    GLOW=10+9*SIN(GADD*.5)
    FOR Y=Y1 TO Y1+H
        XX=SX
        PP1=@IMG_RAW(X1+(Y*IMGX))
        PP2=@PROCESS_BUFFER (XX+(YY*XRES))
        if  YY>0 AND YY<YRES then
        FOR X=X1 TO X1+W
       
            PIXEL=*PP1
            Q=IMG_COLOURS(PIXEL)
            IF Q<>&H000000 THEN *PP2=60+GLOW
       
            PP2+=1
            PP1+=1                       
            XX=XX+1
        NEXT
        end if
        YY=YY+1
    NEXT   
END SUB

SUB LOAD_IMAGE()
   
DIM AS INTEGER L,RR,GG,BB

'-------------------------------------------------------------------------------
' PALETTE FIRST..
'-------------------------------------------------------------------------------

    RR=0
    GG=1
    BB=2
   
    FOR L=0 TO 255
       
        IMG_COLOURS(L)=RGB(disgrace.bmp.pal(RR),disgrace.bmp.pal(GG),disgrace.bmp.pal(BB))
        RR=RR+3
        GG=GG+3
        BB=BB+3
    NEXT
   
'-------------------------------------------------------------------------------
' RAW DATA NEXT..
'-------------------------------------------------------------------------------

    FOR L=0 TO (IMGX*IMGY)-1
        IMG_RAW(L)=disgrace.bmp.raw(L)
    NEXT
   
END SUB

'*******************************************************************************
'* The Alphabet ;-)
'*******************************************************************************

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' Space
DATA 0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0' !
DATA 1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0' "
DATA 1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0' #
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' $
DATA 1,0,0,1,1,0,0,1,0,0,0,0,0,0,1,1,1,0,0,1' %
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1' & = DIAMOND
DATA 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0' `
DATA 0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0' (
DATA 0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1' )
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0' *
DATA 0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0' +
DATA 0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1' ,
DATA 0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0' -
DATA 0,0,1,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0' .
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0' /
DATA 1,1,1,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0' 0
DATA 0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,0,0,0' 1
DATA 0,1,1,1,0,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0' 2
DATA 0,0,1,1,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0' 3
DATA 0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,0,0,0' 4
DATA 1,0,1,1,1,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0' 5
DATA 0,1,1,1,1,0,1,0,0,0,1,1,0,0,0,0,1,0,0,0' 6
DATA 0,0,0,0,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0' 7
DATA 0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0' 8
DATA 1,0,0,0,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0' 9
DATA 0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0' :
DATA 0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0' :
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0' <
DATA 0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0' =
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1' >
DATA 0,0,0,0,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0' ?
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' @
DATA 0,1,0,0,1,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0' A
DATA 1,1,1,1,1,0,0,1,0,0,1,1,0,0,0,0,0,1,0,0' B
DATA 0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0' C
DATA 1,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0' D
DATA 0,0,0,1,0,0,1,0,0,0,1,1,0,0,0,0,1,0,1,0' E
DATA 0,1,0,0,0,0,1,0,0,0,1,1,0,0,0,0,1,0,0,0' F
DATA 0,1,1,1,1,0,1,0,0,0,0,1,0,0,0,0,1,0,0,0' G
DATA 1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0' H
DATA 0,0,1,1,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0' I
DATA 0,1,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1' J
DATA 1,1,0,0,1,0,0,0,0,0,1,1,0,0,1,0,0,0,0,0' K
DATA 1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' L
DATA 1,1,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0' M
DATA 1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0' N
DATA 1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0' O
DATA 1,1,0,0,0,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0' P
DATA 1,1,1,0,0,1,1,1,0,0,0,0,0,1,0,0,0,0,0,1' Q
DATA 1,1,0,0,0,0,1,1,0,0,1,0,0,1,1,0,0,0,0,0' R
DATA 1,0,1,1,1,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0' S
DATA 0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0' T
DATA 1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0' U
DATA 1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1' V
DATA 1,1,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0' W
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0' X
DATA 1,0,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0' Y
DATA 0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0' Z
DATA 1,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0' [
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0' \
DATA 0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0' ]
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0' ^
DATA 0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' _
Shockwave ^ Codigos
Challenge Trophies Won:

Offline va!n

  • Pentium
  • *****
  • Posts: 1431
  • Karma: 109
    • View Profile
    • http://www.secretly.de
Re: Vector Scroll Source Code
« Reply #1 on: June 11, 2011 »
Very cool and karma for sharing the source! Btw in windowed mode it seems to have a small bug. Running windowed mode and click mouse outside the window, intro is freezed while music still playing. Anyway very nice! Sadly i am only for a few mins at home to get new clean clothes for hospital. So i dont have the time now to take a look to the source. K++
- hp EliteBook 8540p, 4 GB RAM, Windows 8.1 x64
- Asus P5Q, Intel Q8200, 6 GB DDR2, Radeon 4870, Windows 8.1 x64
http://www.secretly.de
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17394
  • Karma: 498
  • evil/good
    • View Profile
    • My Homepage
Re: Vector Scroll Source Code
« Reply #2 on: June 11, 2011 »
Hi mate, no that's not a bug it's the way that rbz's tiny ptc framework is :)

It's great to see you here, even if it's only briefly.  Hope you're feeling better soon Thorsten.
Shockwave ^ Codigos
Challenge Trophies Won:

Offline Moroboshisan

  • Senior Member
  • Amiga 1200
  • ********
  • Posts: 454
  • Karma: 18
  • C=64
    • View Profile
Re: Vector Scroll Source Code
« Reply #3 on: June 11, 2011 »
K++ for the source pal! ;)

Offline Rbz

  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 2750
  • Karma: 493
    • View Profile
    • http://www.rbraz.com/
Re: Vector Scroll Source Code
« Reply #4 on: June 11, 2011 »
Hi mate, no that's not a bug it's the way that rbz's tiny ptc framework is :)
It's more likely an unwanted feature  ::)

Shockwave, please test this one:
http://www.rbraz.com/source/tinyptc_ext.zip
If everything is ok I'll update tinyptc_ext thread with this archive.
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17394
  • Karma: 498
  • evil/good
    • View Profile
    • My Homepage
Re: Vector Scroll Source Code
« Reply #5 on: June 11, 2011 »
Works great Rbz :)

K+
Shockwave ^ Codigos
Challenge Trophies Won:

Offline relsoft

  • DBF Aficionado
  • ******
  • Posts: 3303
  • Karma: 47
    • View Profile
Re: Vector Scroll Source Code
« Reply #6 on: June 23, 2011 »
Thumbs up!
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17394
  • Karma: 498
  • evil/good
    • View Profile
    • My Homepage
Re: Vector Scroll Source Code
« Reply #7 on: June 23, 2011 »
Cheers Rel :)
Shockwave ^ Codigos
Challenge Trophies Won:

Offline DrewPee

  • I Toast Therefore I am
  • Pentium
  • *****
  • Posts: 563
  • Karma: 25
  • Eat Cheese - It's good for you!
    • View Profile
    • Retro Computer Museum
Re: Vector Scroll Source Code
« Reply #8 on: January 24, 2012 »
Shockwave - just downloaded the source for this - I have to say one thing - STUNNING - loving what you have done. Sorry it has taken me so long to download it! ;)

Drew
DrewPee
aka Falcon of The Lost Boyz (Amiga)
Ex-Amiga Coder and Graphic Designer
Administrator of > www.retrocomputermuseum.co.uk