Author Topic: Oracle sinemania remake source (Read 1291 times)

Shockwave · « **on:** October 16, 2008 »

Here's the source for the quicky remake of sinemania by Oracle.



'-------------------------------------------------------------------------------
'
'                                ORACLE REMAKE
'                            oOoOoOoOoOoOoOoOoOoOo
'                               BY SCHLOCK WAVE
'
'             Concentrated Super Fuckings to all who deserve them.
'
'    Greetings to my good friends including You!  &  gun owners everywhere.
'
'
'-------------------------------------------------------------------------------

    '---------------------------------------------------------------------------
    ' libs;
    '---------------------------------------------------------------------------
    
    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"
    
    '---------------------------------------------------------------------------
    ' font;    
    '---------------------------------------------------------------------------
    
    #INCLUDE "orapal.bas"
    #INCLUDE "oraraw.bas"


    OPTION STATIC
    OPTION EXPLICIT
    
    '---------------------------------------------------------------------------
    ' 800 * 600 will be best for this one;
    '---------------------------------------------------------------------------
    
    CONST   XRES    =    800
    CONST   YRES    =    600

    DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )

    '---------------------------------------------------------------------------
    ' 2 Sine tables, one calculated each 2 pixels (for scroll) and 32 pixels (background)
    ' and copperlist storage.
    '---------------------------------------------------------------------------

    DIM SHARED AS INTEGER SINETABLE (XRES)
    DIM SHARED AS INTEGER SINETABLE2(XRES)
    DIM SHARED AS INTEGER COPPERS(YRES)

    '---------------------------------------------------------------------------
    ' Dec subs to create sinewave movement and copperlist.
    '---------------------------------------------------------------------------

    DECLARE SUB SINEWAVE ()
    DECLARE SUB SINEWAVE2()
    DECLARE SUB COPPERLIST()

    '---------------------------------------------------------------------------
    ' Used in delta timing;
    '---------------------------------------------------------------------------
    
    DIM SHARED AS DOUBLE OLD,DV,GADD
    
    
    '---------------------------------------------------------------------------
    ' Set up all things to do with the font; (then load it).
    '---------------------------------------------------------------------------
   
    Const LfimgX = 1888
    Const LfimgY = 32
    
    DECLARE SUB LARGETEXT (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 LARGETEXT2  (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING)    
    Declare Sub LfDrawImage2(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()


    '---------------------------------------------------------------------------
    ' Set up all to do with the scroller;
    '---------------------------------------------------------------------------

    DIM SHARED AS STRING SCROLLER
    DIM SHARED AS DOUBLE SCXP=0
    DIM SHARED AS INTEGER TP=1
    DECLARE SUB SINETEXT ()
            
    SCROLLER="                                                              "
    SCROLLER=SCROLLER+"WELL GUYZ, THIS IS #PHOTON$ HERE, LIKE YOU ALREADY DONT KNOW, WITH MY FIFTH INTRO THAT I HAVE CODED FOR YOU AND THIS ONE IS ENTITLED  "
    SCROLLER=SCROLLER+"#SINE MANIA$ AND INCLUDES THIS RATHER NICE 1 PIXEL SINE SCROLL AND BEHIND IT AN EVEN NICER 16 PIXEL PICTURE WAVER!!      "
    SCROLLER=SCROLLER+"THIS INTRO HAS BEEN DESIGNED TO BE REALLY SMALL AND STICK ON A DISK, AND IT CERTAINLY HAS TURNED OUT THAT WAY SO SLAM "
    SCROLLER=SCROLLER+"IT ONTO ALL YOUR DISKS AND IMPRESS YOUR FRIENDS AND FAMILY ALIKE!!!      AH WELL I SHALL CATCH YOU ALL LATER, SO BYE ZEE BYE!!!               WIN32 REMAKE BY SHOCKWAVE FOR WWW.RETRO-REMAKES.NET                  "
    SCROLLER=SCROLLER+"GREETINGS TO ALL OUR FRIENDS AND VISITORS...             "

    '---------------------------------------------------------------------------
    ' Open the screen;
    '---------------------------------------------------------------------------
    
    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        

    '---------------------------------------------------------------------------
    ' Main Loop;
    '---------------------------------------------------------------------------
    
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)  
    
    '---------------------------------------------------------------------------
    ' Grab old timer value for delta;
    '---------------------------------------------------------------------------

    OLD=TIMER
    
    '---------------------------------------------------------------------------
    ' Calc CopperColours and sinewaves;
    '---------------------------------------------------------------------------
    
    COPPERLIST()
    SINEWAVE()
    SINEWAVE2()    

    '---------------------------------------------------------------------------
    ' Quick 'n dirty hack to draw the background text;
    '---------------------------------------------------------------------------

    LARGETEXT2(16, 30,"     ORACLE PRESENT      ")
    LARGETEXT2(16, 65,"   ANOTHER COOL CRACK    ")
    LARGETEXT2(16,100," ")
    LARGETEXT2(16,135,"   #INSERT NAME HERE$    ")
    LARGETEXT2(16,170," ")
    LARGETEXT2(16,205,"  CALL #THE JUNGLE$ ON   ")
    LARGETEXT2(16,240,"      708-983-5764       ")
    

    '---------------------------------------------------------------------------
    ' Call the sine scroller;
    '---------------------------------------------------------------------------

    SINETEXT()    
      
    '---------------------------------------------------------------------------
    ' Swap screen buffers etc.....
    '---------------------------------------------------------------------------
  
        PTC_UPDATE@BUFFER(0)
        ERASE BUFFER
        SLEEP 1
    '---------------------------------------------------------------------------
    ' Delta movement;
    '---------------------------------------------------------------------------
        
        DV=(TIMER-OLD)*200
        GADD=GADD-DV*.5

WEND

    '---------------------------------------------------------------------------
    ' Subroutines;
    '---------------------------------------------------------------------------
    
SUB COPPERLIST()

    DIM AS INTEGER Y,S
    DIM AS DOUBLE R,G,B,R2D,YY
    R2D=3.14/180
    S=0
    YY=0
    
    '---------------------------------------------------------------------------
    ' Draw a copperlist in the coppers array;
    '---------------------------------------------------------------------------

    
FOR Y=0 TO YRES/2
    YY=YY+3
    R=  125+124*SIN(((YY-(GADD*4)))*R2D)
    G=  125+124*SIN(((YY-(GADD*4))+120)*R2D)
    B=  125+124*SIN(((YY-(GADD*4))+240)*R2D)
    
    R=R*1.1
    G=G*1.1
    B=B*1.1
    
    IF R>255 THEN R=255
    IF G>255 THEN G=255
    IF B>255 THEN B=255
    COPPERS(S)=RGB(INT(R),INT(G),INT(B))
    COPPERS(S+1)=COPPERS(S)
    S=S+2
NEXT
END SUB

    '---------------------------------------------------------------------------
    ' Lame scroll routine;
    '---------------------------------------------------------------------------


SUB SINETEXT()
        LARGETEXT(SCXP,0,MID(SCROLLER,TP,30))    
        SCXP=SCXP-(DV*2)
        IF SCXP<=-32 THEN
                TP=TP+1
                SCXP=SCXP+32
                IF TP>=LEN(SCROLLER) THEN TP=1
        END IF
END SUB


    '---------------------------------------------------------------------------
    ' Lame routine to make a sinewave for the scroller;
    '---------------------------------------------------------------------------


SUB SINEWAVE()
    DIM AS INTEGER L,X,VV
    X=0
    FOR L=0 TO (XRES/2) 
        VV=220+150*SIN((L+GADD)*3.14/210)
        SINETABLE(X  )=VV
        SINETABLE(X+1)=VV
    X=X+2
    NEXT    
END SUB

    '---------------------------------------------------------------------------
    ' Make a sine wave for the background writing;
    '---------------------------------------------------------------------------

SUB SINEWAVE2()
    DIM AS INTEGER L,X,VV,C
    X=16
    FOR L=0 TO 23
        VV=91+70*SIN((X-(GADD*10))*3.14/900)
        FOR C=0 TO 31
        SINETABLE2(X+C)=VV
        NEXT        
        X=X+32
    NEXT
END SUB

    '---------------------------------------------------------------------------
    ' Used for drawing a text string for sine scroll;
    '---------------------------------------------------------------------------

SUB LARGETEXT(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 NNN >0 THEN 
    OOO=0    
    MMM = NNN * 32
    LFDRAWIMAGE( LTX,LTY, MMM , OOO )
    END IF

    LTX=LTX+32

    NEXT

END SUB

'-------------------------------------------------------------------------------
' Load Font;
'-------------------------------------------------------------------------------

  Sub LFLoadDataImage()
    dim i as integer
    'Loads Color palette
    for i = 0 to 255
         LFimg_r( i ) = orafont.bmp.pal (i*3)'Red color
         LFimg_g( i ) = orafont.bmp.pal (i*3+1)'Green color
         LFimg_b( i ) = orafont.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) = orafont.bmp.raw (i)
    next  
        
End Sub

    '---------------------------------------------------------------------------
    ' Draw sine scroll letter;
    '---------------------------------------------------------------------------

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(INTX)
                if MONG<>0 AND INTX>=0 AND INTX<XRES then 
                    MONG=&hffffff
                 Buffer( intX  +(intY * XRES  )) = MONG
                end if
            
            xxx=xxx+1
        next
        
            yyy=yyy+1
            xxx=xpos
    next
    
End Sub


    '---------------------------------------------------------------------------
    ' Used to draw letters of the background;
    '---------------------------------------------------------------------------


SUB LARGETEXT2(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 NNN >0 THEN 
    OOO=0    
    MMM = NNN * 32
    LFDRAWIMAGE2( LTX,LTY, MMM , OOO )
    END IF

    LTX=LTX+32

    NEXT

END SUB

    '---------------------------------------------------------------------------
    ' Actually draw the background letters;
    '---------------------------------------------------------------------------

Sub LFDrawImage2(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+SINETABLE2(INTX)
                if MONG<>0 AND INTX>=0 AND INTX<XRES then 
                    MONG=COPPERS(INTY)
                 Buffer( intX  +(intY * XRES  )) = MONG
                end if
            
            xxx=xxx+1
        next
        
            yyy=yyy+1
            xxx=xpos
    next
    
End Sub

If you want to run it, download the zip please because it needs to load the font :-)

benny! · « **Reply #1 on:** October 16, 2008 »

DrewPee · « **Reply #2 on:** October 23, 2008 »

I like that one - thanks for the code shockwave!

Shockwave · « **Reply #3 on:** October 23, 2008 »

matthew · « **Reply #4 on:** December 17, 2008 »

I'm using FreeBASIC v0.20.0 & I've got TinyPtc_Ext installed, I compile the program with the following...

Code: [Select]

fbc -lang deprecated oraclescroller.bas
But when I run the program, the font doesn't seem to get loaded.

Am I compiling the program correctly?

Shockwave · « **Reply #5 on:** December 17, 2008 »

Hi matthew.

I think it's compiling fine, it seems to be ignoring the masking colour on your computer though, good one.

I'll have a look at the source.

Shockwave · « **Reply #6 on:** December 17, 2008 »

Thats wierd, I cant duplicate the bug..

Are you compiling the source code from the zip that was attached to the post?
Sorry if that seems a stupid question to you.

matthew · « **Reply #7 on:** December 17, 2008 »

Yeah, I just downloaded another copy of the zip but after compiling I got the same result.

The copy of the exe that I downloaded here works fine though.

Shockwave · « **Reply #8 on:** December 17, 2008 »

Ok, well I couldn't ask for more to go on really and since it is my source I should be able to work out why it won't work properly for you.

You'd have to have ptc_ext installed because it just wouldn't compile otherwise.

There is a difference between versions of fb here though, you are running a very new version, maybe it's an incompatibility with tinyptc_ext and freebasic 2.0 whatever..

I don't know.

It seems like the font is being drawn totally without masking then you could look at the two subs;

lfdrawimage and lfdrawimage2

They are both virtually identical, one blits in plain white, the other blits the copperlist.

Code: [Select]

Sub LFDrawImage2(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+SINETABLE2(INTX)
                if MONG<>0 AND INTX>=0 AND INTX<XRES then 
                    MONG=COPPERS(INTY)
                 Buffer( intX  +(intY * XRES  )) = MONG
                end if
            
            xxx=xxx+1
        next
        
            yyy=yyy+1
            xxx=xpos
    next
    
End Sub

Paying particular attention to this bit;

Code: [Select]

            pixel = LFimg_buffer(x+(y*lfimgx))            
            mong = (LFimg_r(pixel) )            
            
                intx = XXX
                inty = YYY+SINETABLE2(INTX)
                if MONG<>0 AND INTX>=0 AND INTX<XRES then

To explain what is going on there, the variable "pixel" is loaded with a colour table look up.
"mong" is loaded with the value relating to that look up.

the pixel is blitted if the value of "mong" is not 0 and if the pixel is on the screen.

So maybe there is some difference in syntax between old FB and the version you have..

If not, then something has happened in this sub here;

Code: [Select]

  Sub LFLoadDataImage()
    dim i as integer
    'Loads Color palette
    for i = 0 to 255
         LFimg_r( i ) = orafont.bmp.pal (i*3)'Red color
         LFimg_g( i ) = orafont.bmp.pal (i*3+1)'Green color
         LFimg_b( i ) = orafont.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) = orafont.bmp.raw (i)
    next  
        
End Sub

you might be able to fix it by changing the sub to look like this;

Code: [Select]

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

If those things don't work then I will put it down to a problem with syntax..
If it does work I will be happy

And by the way, welcome to the forum.

matthew · « **Reply #9 on:** December 17, 2008 »

Whoot, it works, I changed the LFLoadDataImage Sub for the new one that you posted.

Quote

And by the way, welcome to the forum.

thanks

Shockwave · « **Reply #10 on:** December 17, 2008 »

Glad to be of help Matthew, have fun with the source and I hope you stick around

bikerboy · « **Reply #11 on:** December 17, 2008 »

i don't get it, i have the same version as matthew but it won't even bother to compile, all i get is a bunch of errors from the orapal.bas

@shockwave

this version i have is starting to bug me big time....

what version do you use? , time to downgrade

Shockwave · « **Reply #12 on:** December 17, 2008 »

Bikerboy,

I understand your frustration, but what you are asking is like saying...

What are next Saturday's lottery numbers going to be?

So to give me more to go on you should post your errors, I won't tell you the lottery numbers but the chances are that I'd be able to fix your problem.

bikerboy · « **Reply #13 on:** December 17, 2008 »

Code: [Select]

Compiler output:
C:/Documents and Settings/bikerboy/Desktop/oraclesource/orapal.bas(2) error 136: Default types or suffixes are only valid in -lang deprecated or fblite or qb, found '.' in 'dim shared orafont.bmp.pal(0 to 767) as ubyte = { _'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/oraraw.bas(2) error 136: Default types or suffixes are only valid in -lang deprecated or fblite or qb, found '.' in 'dim shared orafont.bmp.raw(0 to 60415) as ubyte = { _'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(81) error 136: Default types or suffixes are only valid in -lang deprecated or fblite or qb, found ',' in 'Dim Shared LFimg_r(256), LFimg_g(256), LFimg_b(256) as short'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(285) error 213: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'LFimg_r( i ) = orafont.bmp.pal (i*3)'Red color'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(285) warning 12(0): Implicit variable allocation, bmp
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(286) error 213: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'LFimg_g( i ) = orafont.bmp.pal (i*3+1)'Green color'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(286) warning 12(0): Implicit variable allocation, bmp
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(287) error 213: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'LFimg_b( i ) = orafont.bmp.pal (i*3+2)'Blue color'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(287) warning 12(0): Implicit variable allocation, bmp
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(294) error 213: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'LFimg_buffer(i) = orafont.bmp.raw (i)'
C:/Documents and Settings/bikerboy/Desktop/oraclesource/FBIDETEMP.bas(294) warning 12(0): Implicit variable allocation, bmp

Results:
Compilation failed

System:
FBIde: 0.4.6
fbc:   FreeBASIC Compiler - Version 0.20.0 (08-10-2008) for win32 (target:win32)
OS:    Windows XP (build 2600, Service Pack 3)

Shockwave · « **Reply #14 on:** December 17, 2008 »

Yep, same errors as in the other one, see my reply in the other topic first for guidance of how to fix it

Once you have the images program working then you should be able to work out this one for yourself, if not please do let me know

bikerboy · « **Reply #15 on:** December 17, 2008 »

ok in his one i had a bunch of errors too, managed to cut the errors down to 1

~~in line 82 , i got this error~~

Code: [Select]

[s]error 136: Default types or suffixes are only valid in -lang deprecated or fblite or qb, found ',' in 'Dim Shared LFimg_r(256), LFimg_g(256), LFimg_b(256) as short'[/s]

EDIT: discard the error , i did what what you said changed the code and also did what matthew said with the settings, now i only see the rainbow scroller and not the white one

EDIT:2 i tried to change the rainbow scroller text and when i compiled it , it crashed FBIde.

when i reversed the text to what it was it compiled without a prob (except the white scroller prob).

Shockwave · « **Reply #16 on:** December 17, 2008 »

I feel really happy that you are learning something with your experiments Bikerboy.

Rememebr that crashes are a part of the fun when you are new and the satisfaction of getting past these problems makes it all worth while.

And eventually you'll be making your own things.

bikerboy · « **Reply #17 on:** December 17, 2008 »

i'm happy i'm rearning those things too mate

i figured out why it crashed, the rainbow scroller has a specific letter limit and i exceeded it.

now i've changed the letters but this time i've count them

and it plays fine

for example the first line is

LARGETEXT2(16, 30," ORACLE PRESENT ") and i made it
LARGETEXT2(16, 30," 123456 1234567 ") and it plays just fine, but if i make it
LARGETEXT2(16, 30," Hello Shockwave ") , it crashes

so the letters in the rainbow scroller need to be in the exact same place as the original ones

the weird thing about the white sine scroller is that sometimes it appears, sometimes it dissapears

dunno why it does that

Author Topic: Oracle sinemania remake source (Read 1291 times)

Shockwave

Oracle sinemania remake source

benny!

Re: Oracle sinemania remake source

DrewPee

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

matthew

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

matthew

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

matthew

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

bikerboy

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

bikerboy

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

bikerboy

Re: Oracle sinemania remake source

Shockwave

Re: Oracle sinemania remake source

bikerboy

Re: Oracle sinemania remake source