Author Topic: Quick remake source codes.. (Read 5438 times)

Shockwave · « **on:** January 21, 2009 »

I made two quick remakes this week, the first one is a trainer menu by Haujobb, the second is a bootblock intro by Paradox.

Both are very quick looking intros, the source is here just in case anyone else finds similar text intros that they want to remake for retro remakes.

Exes and media are included in the attached zip.

Cheers

Haujobb intro:

Code: [Select]

' HAUJOBB TRAINER REMAKE
'
' QUICKLY MADE BY SHOCKWAVE
'
'-------------------------------------------------------------------------------

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"
    
    #INCLUDE "amypal.bas"
    #INCLUDE "amyraw.bas"

    '#include "ufmod.bi"
    '#include "tdk.bas"
    'Dim hWave As HWAVEOUT  
    
    OPTION STATIC
    OPTION EXPLICIT
    
    CONST   XRES    =    800
    CONST   YRES    =    600    
    
    DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
'-------------------------------------------------------------------------------
'   LOAD THE FONT;
'-------------------------------------------------------------------------------
   
    Const LfimgX = 960
    Const LfimgY = 18
    
    DECLARE SUB BERASE()
    DECLARE SUB LARGETEXT (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING, byval c as uinteger)    
    DECLARE SUB SINTEXT (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, byval c as uinteger)
    Declare Sub LfSINImage(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 integer lines=19
    dim shared as string txt(lines)
    declare sub textt()
    txt(01)="                           Haujobb presents ya today:"
    txt(02)="                                  Lamborghini +"
    txt(03)="                              Release Date: 94-03-03"
    txt(04)="                      Trainer & very Ugly Intro Done by DSP"
    txt(05)=""
    txt(06)=""
    txt(07)=""
    txt(08)="                        Press Left-Button for normal Money"
    txt(09)="                      Press Right-Button for 9999999 Creditz"
    txt(10)=""
    txt(11)=""
    txt(12)=""
    txt(13)="                   Greetings to all my Friends!!! Especially to :"
    txt(14)="             Zap/Sanity, Microforce/Sanity, Cosmos/Trsi and Bodnes/Trsi  "
    txt(15)="                                 Zack and da Haifush"
    txt(16)="                       Karl and the Rest of the Quietsch-boyz"
    txt(17)=""
    txt(18)=""
    txt(19)=""


    dim shared as double sps
    dim shared as integer p=1
    dim shared as string scroller
    
    SCROLLER=SCROLLER+"                                                                                    "
    SCROLLER=SCROLLER+"Yo Guys, the first Microtrainer from Haujobb. Sorry for only 1 option, but i haven't no time for more "
    
    declare sub scroll()
    
    

'-------------------------------------------------------------------------------
'   OPEN THE SCREEN;
'-------------------------------------------------------------------------------

    PTC_ALLOWCLOSE(0)
    PTC_SETDIALOG(1,"WWW.RETRO-REMAKES.NET"+CHR$(13)+"FULL SCREEN?",0,1)               
    IF (PTC_OPEN("Remake code by Shockwave",XRES,YRES)=0) THEN
    END-1
    END IF    

'-------------------------------------------------------------------------------
    
'-------------------------------------------------------------------------------
'   MAIN LOOP;
'-------------------------------------------------------------------------------
    DIM SHARED AS DOUBLE OLD,DV
    dim shared as double fd,glop
    glop=timer+2.5
    fd=0
    'hWave = uFMOD_PlaySong(@tdk.xm(0),31839,XM_MEMORY)
    
WHILE (GETASYNCKEYSTATE(VK_ESCAPE) <> -32768 AND PTC_GETLEFTBUTTON = FALSE AND PTC_GETRIGHTBUTTON = FALSE) 

    OLD=TIMER
    TEXTT()
    if timer>glop then
        fd=fd+(dv*2)
        if fd>1 then fd=1
        scroll()
    end if    
    
    PTC_UPDATE@BUFFER(0)
    BERASE()
    SLEEP 1
    DV=(TIMER-OLD)
WEND
'uFMOD_StopSong()
EXITPROCESS(0)
END 





SUB SCROLL()
    SPS=SPS-(DV*200)
    LARGETEXT(INT(SPS),464,MID(SCROLLER,P,90),rgb(255,255,255)) 
    IF SPS<-10 THEN
        P=P+1
        IF P>LEN(SCROLLER) THEN P=1
        SPS=SPS+10
    END IF
END SUB





SUB TEXTT()
DIM AS INTEGER Y,L
Y=60
FOR L=1 TO LINES
   LARGETEXT(0,Y,TXT(L),rgb(255,255,255))    
   Y=Y+22
NEXT

END SUB




SUB LARGETEXT(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
    LFDRAWIMAGE( LTX,LTY, MMM , OOO ,c)
    END IF

    LTX=LTX+10

    NEXT

END SUB

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

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

Sub LFDrawImage(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 = LFimg_buffer(x+(y*lfimgx))            
            IF XXX>30 AND XXX<XRES-30 THEN
            mong = (LFimg_r(pixel) )                            
                intx = xxx
                inty = yyy
                
                if MONG<>0 and intx>0 and intx<xres then 
                    
                 Buffer( intX  +(intY * XRES)) = tc
                 'Buffer( intX  +1+(intY * XRES)) = tc
                end if
            END IF
            xxx=xxx+1
        next    
        
            yyy=yyy+1
            xxx=xpos
    next
    
End Sub

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

SUB BERASE()


    DIM PP AS UINTEGER PTR
    DIM SLICE AS INTEGER
    DIM TC AS INTEGER
    DIM L AS INTEGER
    DIM TOP AS INTEGER
    DIM AS INTEGER R,G,B
    
    for l=0 to yres-1
        SLICE=XRES
        PP=@BUFFER(L*XRES)
        select case l
        case 48 to 58 , 144 to 154
        TC=RGB(136,34,85)            
        case 59 to 143
        TC=RGB(102,0,51)            
        
        case 186 to 196 , 270 to 280
        TC=RGB(34,85,136)            
        case 197 to 269
        TC=RGB(0,51,102)

        case 310 to 320 , 408 to 418
        TC=RGB(85,34,136)                 
        
        case 321 to 407
        TC=RGB(51,0,102)                 


        case 450 to 460 , 482 to 492
        TC=RGB(34*fd,138*fd,85*fd)                 

        case 451 to 481
        TC=RGB(0,102*fd,51*fd)                 


        case else
        TC=RGB(0,0,0)
        end select
    
        asm
            mov eax,dword ptr[TC]
            mov ecx, [slice]
            mov edi, [PP]
            rep stosd
        end asm           
    next
    
    
END SUB

Paradox intro:

Code: [Select]

' PARADOX BOOT INTRO
'
' QUICKLY MADE BY SHOCKWAVE
'
'-------------------------------------------------------------------------------

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"
    
    #INCLUDE "amypal.bas"
    #INCLUDE "amyraw.bas"
    
    OPTION STATIC
    OPTION EXPLICIT
    
    CONST   XRES    =    800
    CONST   YRES    =    600    
    
    DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
'-------------------------------------------------------------------------------
'   LOAD THE FONT;
'-------------------------------------------------------------------------------
   
    Const LfimgX = 960
    Const LfimgY = 18
    
    DECLARE SUB BERASE()
    DECLARE SUB LARGETEXT (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING, byval c as uinteger)    
    DECLARE SUB SINTEXT (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, byval c as uinteger)
    Declare Sub LfSINImage(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 integer lines=19
    dim shared as string txt(lines)
    declare sub textt()
    txt(01)="                               ABANDONED PLACES 100%"
    txt(02)="                      Cracked by PARADOX 29-3-93 by BLACKHAWK"
    txt(03)=""
    txt(04)=""
    txt(05)=""
    txt(06)="                     TO BUY THE LATEST ON AMIGA, PC AND CONSOLE"
    txt(07)=""
    txt(08)="                        OR FOR CONSOLES COPIERS WRITE TO"
    txt(09)=""
    txt(10)="                       SKID ROW               P.O.BOX 92556"
    txt(11)="                       B.P.13           or    RIYADH 11663"
    txt(12)="                       9537 MONTIGNY          SAUDI ARABIA"
    txt(13)="                       FRANCE"
    txt(14)=""
    txt(15)=""
    txt(16)=""
    txt(17)=""
    txt(18)="                            PRESS LEFT BUTTON TO CONTINUE"
    txt(19)=""


    dim shared as double sps
    dim shared as integer p=1
    dim shared as string scroller
    
    SCROLLER=SCROLLER+"                                                                                    "
    SCROLLER=SCROLLER+"Yo Guys, the first Microtrainer from Haujobb. Sorry for only 1 option, but i haven't no time for more "
    
    declare sub scroll()
    
    

'-------------------------------------------------------------------------------
'   OPEN THE SCREEN;
'-------------------------------------------------------------------------------

    PTC_ALLOWCLOSE(0)
    PTC_SETDIALOG(1,"WWW.RETRO-REMAKES.NET"+CHR$(13)+"FULL SCREEN?",0,1)               
    IF (PTC_OPEN("Remake code by Shockwave",XRES,YRES)=0) THEN
    END-1
    END IF    

'-------------------------------------------------------------------------------
    
'-------------------------------------------------------------------------------
'   MAIN LOOP;
'-------------------------------------------------------------------------------
    DIM SHARED AS DOUBLE OLD,DV
    dim shared as double fd,glop
    glop=timer+.2
    fd=0
DIM SHARED LDS AS INTEGER
LDS=0
    
WHILE (GETASYNCKEYSTATE(VK_ESCAPE) <> -32768 AND PTC_GETLEFTBUTTON = FALSE AND PTC_GETRIGHTBUTTON = FALSE) 

    OLD=TIMER
    TEXTT()
    if timer>glop then
    LDS=LDS+1
    IF LDS>LINES THEN LDS=LINES
    GLOP=TIMER+.005
    end if    
    
    PTC_UPDATE@BUFFER(0)
    BERASE()
    SLEEP 1
    DV=(TIMER-OLD)
WEND
EXITPROCESS(0)
END 





SUB SCROLL()
    SPS=SPS-(DV*200)
    LARGETEXT(INT(SPS),464,MID(SCROLLER,P,90),rgb(255,255,255)) 
    IF SPS<-10 THEN
        P=P+1
        IF P>LEN(SCROLLER) THEN P=1
        SPS=SPS+10
    END IF
END SUB





SUB TEXTT()
DIM AS INTEGER Y,L
Y=90
FOR L=1 TO LDS
   LARGETEXT(-10,Y,TXT(L),rgb(255,255,0))    
   Y=Y+22
NEXT

END SUB




SUB LARGETEXT(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
    LFDRAWIMAGE( LTX,LTY, MMM , OOO ,c)
    END IF

    LTX=LTX+10

    NEXT

END SUB

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

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

Sub LFDrawImage(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 = LFimg_buffer(x+(y*lfimgx))            
            IF XXX>30 AND XXX<XRES-30 THEN
            mong = (LFimg_r(pixel) )                            
                intx = xxx
                inty = yyy
                
                if MONG<>0 and intx>0 and intx<xres then 
                    
                 Buffer( intX  +(intY * XRES)) = tc
                 'Buffer( intX  +1+(intY * XRES)) = tc
                end if
            END IF
            xxx=xxx+1
        next    
        
            yyy=yyy+1
            xxx=xpos
    next
    
End Sub

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

SUB BERASE()


    DIM PP AS UINTEGER PTR
    DIM SLICE AS INTEGER
    DIM TC AS INTEGER
    DIM L AS INTEGER
    DIM TOP AS INTEGER
    DIM AS INTEGER R,G,B
    
    for l=0 to yres-1
        SLICE=XRES
        PP=@BUFFER(L*XRES)
        select case l
        
        CASE 65,66,151,150,425,426,515,516
        TC=RGB(255,255,255)            
        CASE 67 TO 149
        TC=RGB(102,0,0)            
        CASE 427 TO 514
        TC=RGB(0,102,0)            
        
        CASE ELSE
        TC=RGB(51,0,51)
        end select
    
        asm
            mov eax,dword ptr[TC]
            mov ecx, [slice]
            mov edi, [PP]
            rep stosd
        end asm           
    next
    
    
END SUB

DrewPee · « **Reply #1 on:** January 21, 2009 »

Hello Shockwave, when i run the code the font seems to be just blocks? What do I do to help with this?
.exe's work fine - nice work! again!

DrewPee

hellfire · « **Reply #2 on:** January 21, 2009 »

Quote

a trainer menu by Haujobb

cool, i didn't even know that one. where can i find the original?

Shockwave · « **Reply #3 on:** January 21, 2009 »

Hellfire, you can find the original amiga intro here;

http://www.retro-remakes.net/archive/amiga/H/Haujobb.tr01

I was as surprised as you to find something warez related for Haujobb, as far as I know it's the only one that exists.

My complete collection of well over a thousand unique cracktros are online here;

http://www.retro-remakes.net/archive/amiga

There are screen shots for each intro too.

Drewpee,

That sounds like the same problem that matthew had in the thread here;

http://www.dbfinteractive.com/forum/index.php/topic,3621.0.html

There has been a slight change in syntax in fb, so if you follow the steps I gave in that thread it will fix the problem

DrewPee · « **Reply #4 on:** January 21, 2009 »

Thanks Shockwave!

hellfire · « **Reply #5 on:** January 21, 2009 »

Quote from: Shockwave on January 21, 2009

I was as surprised as you to find something warez related for Haujobb, as far as I know it's the only one that exists.

No, here's another one (which was the only one i knew about)

Shockwave · « **Reply #6 on:** January 21, 2009 »

Wow that one really rocks Hellfire!

I've never seen it before, it wasn't in my collection.

K+

Do you mind if it gets converted by me or Stormbringer?

hellfire · « **Reply #7 on:** January 21, 2009 »

Quote

Do you mind if it gets converted by me or Stormbringer?

Of course not.

Shockwave · « **Reply #8 on:** January 21, 2009 »

Thanks

benny! · « **Reply #9 on:** January 22, 2009 »

@Shocky:
Nice littel two convertions. K++ for supplying code.

Hotshot · « **Reply #10 on:** January 22, 2009 »

that good one for people who want learn from it

bikerboy · « **Reply #11 on:** January 22, 2009 »

thanx for the source Shockie

might come in handy someday

rdc · « **Reply #12 on:** January 24, 2009 »

Cool. Interesting list of retros too.

Author Topic: Quick remake source codes.. (Read 5438 times)

Shockwave

Quick remake source codes..

DrewPee

Re: Quick remake source codes..

hellfire

Re: Quick remake source codes..

Shockwave

Re: Quick remake source codes..

DrewPee

Re: Quick remake source codes..

hellfire

Re: Quick remake source codes..

Shockwave

Re: Quick remake source codes..

hellfire

Re: Quick remake source codes..

Shockwave

Re: Quick remake source codes..

benny!

Re: Quick remake source codes..

Hotshot

Re: Quick remake source codes..

bikerboy

Re: Quick remake source codes..

rdc

Re: Quick remake source codes..