Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: 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 :-)
-
K++
-
I like that one - thanks for the code shockwave!
-
YW.
-
I'm using FreeBASIC v0.20.0 & I've got TinyPtc_Ext installed, I compile the program with the following...
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?
(http://matthew-4gl.wikispaces.com/space/showimage/resized_sine_scroll_ptc.png)
-
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.
-
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.
-
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 (http://www.retro-remakes.net/viewproduction.php?prod=6ee119da7e9135d635bc7f19bd9724a6560d2fda) works fine though.
-
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.
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;
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;
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;
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.
-
Whoot, it works, I changed the LFLoadDataImage Sub for the new one that you posted. :||
And by the way, welcome to the forum.
thanks ;)
-
Glad to be of help Matthew, have fun with the source and I hope you stick around :D
-
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 :stirrer:
-
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.
-
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)
-
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 :)
-
ok in his one i had a bunch of errors too, managed to cut the errors down to 1 ;D
in line 82 , i got this error
[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).
-
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.
-
i'm happy i'm rearning those things too mate ;D
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 :P and it plays fine :D
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 :skint: