mirror of
https://github.com/LIV2/amiberry.git
synced 2025-12-05 22:22:44 +00:00
374 lines
6.6 KiB
Plaintext
374 lines
6.6 KiB
Plaintext
'
|
|
'
|
|
' New AMIGA ONLINE / FS-ARCADE / PSPUAE etc splash screen prog.
|
|
'
|
|
'
|
|
' By Hungry Horace
|
|
'
|
|
'
|
|
'
|
|
|
|
Set Buffer 200
|
|
|
|
Dim PALSTORE(31)
|
|
Global RANCOL,PALSTORE()
|
|
|
|
|
|
' this program is pointless if we have a key file!
|
|
' If Exist("C:whdload.key") or Exist("L:whdload.key") or Exist("DEVS:whdload.key") or Exist("S:whdload.key") or Exist("LIBS:whdload.key") or Exist(PICKSLAVEFOLDER$+"whdload.key") Then End
|
|
If Exist("S:booter.key") Then End
|
|
|
|
' _GET_TEXT["s:ProgramTitle"]
|
|
' PROGTITLE$=Param$
|
|
|
|
' _GET_TEXT["s:WebTitle"]
|
|
' WEBTITLE$=Param$
|
|
|
|
|
|
PROGTITLE$="Amiberry WHDLoad AutoBooter"
|
|
WEBTITLE$="www.ultimateamiga.co.uk"
|
|
|
|
|
|
' set up a nice new clean hi-res screen to play with
|
|
|
|
Screen Open 0,640,200,16,Hires : Screen Hide 0
|
|
|
|
Curs Off : Flash Off : Hide
|
|
Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
|
|
|
|
Cls 0
|
|
Screen Show 0
|
|
|
|
|
|
' decide on our theme colour....
|
|
|
|
_STANPAL
|
|
|
|
Rem Goto WHDSPLASH :
|
|
|
|
_ULTIMATEAMIGA
|
|
|
|
' If Exist("C:whdload.key") or Exist("L:whdload.key") or Exist("DEVS:whdload.key") or Exist("S:whdload.key") or Exist("LIBS:whdload.key") or Exist(PICKSLAVEFOLDER$+"whdload.key") Then End
|
|
|
|
Screen Open 0,640,200,16,Hires : Screen Hide 0
|
|
|
|
Curs Off : Flash Off : Hide
|
|
Cls 0
|
|
Screen Show 0
|
|
|
|
_STANPAL
|
|
|
|
Goto LEAVER :
|
|
WHDSPLASH:
|
|
Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
|
|
|
|
MYY=1 : MYZ=11 : TXT$=PROGTITLE$
|
|
Gosub CENTXT
|
|
|
|
MYY=19 : MYZ=13 : TXT$=WEBTITLE$
|
|
Gosub CENTXT
|
|
|
|
Wait Vbl
|
|
Fade 3,,PALSTORE(1),PALSTORE(2),PALSTORE(3),PALSTORE(4),PALSTORE(5),PALSTORE(6),PALSTORE(7),PALSTORE(8),,,,
|
|
Wait 35
|
|
|
|
|
|
'MYY=5 : MYZ=6 : TXT$="UAE Config Maker"
|
|
'Gosub CENTXT
|
|
'MYY=5 : MYZ=6 : TXT$="- Please Wait -"
|
|
'Gosub CENTXT
|
|
|
|
MYY=6 : MYZ=6 : TXT$="Please show your appreciation for this work"
|
|
Gosub CENTXT
|
|
|
|
MYY=7 : MYZ=6 : TXT$="and support future development."
|
|
Gosub CENTXT
|
|
|
|
|
|
_GET_TEXT["s:URL"]
|
|
TXT$=" - "+Param$+" - "
|
|
MYY=12 : MYZ=28
|
|
Gosub CENTXT
|
|
|
|
|
|
LEAVER:
|
|
Wait 100
|
|
Fade 3,,,,,,,,,,,,PALSTORE(11),PALSTORE(12),PALSTORE(13),PALSTORE(14)
|
|
|
|
Wait 160
|
|
Fade 3
|
|
Wait 10
|
|
|
|
|
|
|
|
End
|
|
|
|
|
|
' ************* SUB-ROUTINES *************
|
|
CENTXT: YY=MYY*10 : XX=320-((Len(TXT$)*8)/2) : ZZ=MYZ : Ink ZZ,0 : Text XX,YY,TXT$ : YY=0 : XX=0 : ZZ=0 : TXT$="" : Return
|
|
LEFTXT: YY=MYY*10 : XX=320-((Len(TXT$)*8)/2) : ZZ=MYZ : Ink ZZ,0 : Text 0,YY,TXT$ : YY=0 : XX=0 : ZZ=0 : TXT$="" : Return
|
|
|
|
|
|
Procedure _STANPAL
|
|
|
|
Randomize Timer*Ct Second(Current Time) : RANCOL=Rnd(14)
|
|
|
|
|
|
For A=0 To $10
|
|
If Exist("T:PAL"+Hex$(A)) Then Exit 1
|
|
Next A
|
|
|
|
|
|
If A>=$10
|
|
A=RANCOL
|
|
Reserve As Work 8,1
|
|
Wsave "T:PAL"+Hex$(A),8
|
|
Erase 8
|
|
End If
|
|
|
|
If A=0 or A1 or A=2 : Gosub RED
|
|
Else If A=3 or A=4 or A=5 : Gosub BLUE
|
|
Else If A=6 or A=7 or A=8 : Gosub GREEN
|
|
Else If A=9 or A=10 : Gosub YELLOW
|
|
Else If A=11 or A=12 or A=13 : Gosub CYAN
|
|
Else If A=14 : Gosub PINK
|
|
Else
|
|
Gosub RED
|
|
End If
|
|
|
|
|
|
Colour 7,$FFF
|
|
|
|
Pal Get Screen 0,0
|
|
|
|
For A=0 To 15
|
|
PALSTORE(A)=Pal Get(0,A)
|
|
Next A
|
|
|
|
|
|
|
|
|
|
|
|
Pop Proc
|
|
|
|
|
|
|
|
RED:
|
|
Pal Spread 0,$0 To 6,$FFF
|
|
Pal Spread 8,$EDD To 10,$F00
|
|
Pal Spread 11,$F00 To 15,$300
|
|
|
|
CULN=$100 : Gosub MAKEFLSH
|
|
|
|
Return
|
|
|
|
GREEN:
|
|
Pal Spread 0,$0 To 6,$FFF
|
|
Pal Spread 8,$DED To 10,$D0
|
|
Pal Spread 11,$D0 To 15,$30
|
|
|
|
CULN=$10 : Gosub MAKEFLSH
|
|
|
|
Return
|
|
|
|
CYAN:
|
|
Pal Spread 0,$0 To 6,$FFF
|
|
Pal Spread 8,$DEE To 10,$FF
|
|
Pal Spread 11,$FF To 15,$33
|
|
|
|
CULN=$11 : Gosub MAKEFLSH
|
|
|
|
Return
|
|
|
|
PINK:
|
|
Pal Spread 0,$0 To 6,$FFF
|
|
Pal Spread 8,$EDE To 10,$F0F
|
|
Pal Spread 11,$F0F To 15,$303
|
|
|
|
CULN=$101 : Gosub MAKEFLSH
|
|
|
|
Return
|
|
|
|
BLUE:
|
|
Pal Spread 0,$0 To 6,$FFF
|
|
Pal Spread 8,$DDE To 10,$F
|
|
Pal Spread 11,$F To 15,$3
|
|
|
|
CULN=$1 : Gosub MAKEFLSH
|
|
|
|
|
|
Return
|
|
|
|
YELLOW:
|
|
Pal Spread 0,$0 To 6,$FFF
|
|
Pal Spread 8,$EED To 10,$FF0
|
|
Pal Spread 11,$FF0 To 15,$330
|
|
|
|
CULN=$110 : Gosub MAKEFLSH
|
|
|
|
Return
|
|
|
|
MAKEFLSH:
|
|
MADEUP$=""
|
|
For Q=5 To 15 Step 1 : MADEUP$=MADEUP$+"("+Right$(Hex$(0+(Q*CULN)+$1000),3)+",5)" : Next Q
|
|
For Q=15 To 8 Step -2 : MADEUP$=MADEUP$+"("+Right$(Hex$(0+(Q*CULN)+$1000),3)+",5)" : Next Q
|
|
Flash 7,MADEUP$
|
|
Return
|
|
|
|
End Proc
|
|
Procedure _ULTIMATEAMIGA
|
|
|
|
|
|
Rem Reserve As Chip Data 12,86552
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Screen Open 0,320,256,16,Lowres : Curs Off : Hide
|
|
Colour 0,$0 : Colour 1,$0
|
|
Colour 2,$0 : Colour 3,$0
|
|
Cls 0 :
|
|
|
|
|
|
Default Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
|
|
|
|
Screen 0
|
|
|
|
|
|
Randomize Timer*Ct Second(Current Time) : RANCOL=Rnd(14)
|
|
|
|
For A=0 To $10
|
|
If Exist("T:PAL"+Hex$(A)) Then Exit 1
|
|
Next A
|
|
|
|
If A=$10
|
|
A=RANCOL
|
|
Reserve As Work 8,1
|
|
Wsave "T:PAL"+Hex$(A),8
|
|
Erase 8
|
|
End If
|
|
|
|
Colour 15,$373
|
|
|
|
If A=0 or A1 or A=2 : Gosub RED
|
|
Else If A=3 or A=4 or A=5 : Gosub BLUE
|
|
Else If A=6 or A=7 or A=8 : Gosub GREEN
|
|
Else If A=9 or A=10 : Gosub YELLOW
|
|
Else If A=11 or A=12 or A=13 : Gosub CYAN
|
|
Else If A=14 : Gosub PINK
|
|
|
|
Else
|
|
Gosub RED
|
|
End If
|
|
|
|
|
|
|
|
Pal Get Screen 0,0
|
|
|
|
For A=0 To 31
|
|
PALSTORE(A)=Pal Get(0,A)
|
|
Next A
|
|
|
|
Load Iff "Splash/Intro_000A.iff",0 : Screen Hide 0
|
|
Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
|
|
|
|
|
|
'Wload "splash/titlesound",-12 : Bank Name 12,"U.A.Snd"
|
|
|
|
|
|
Screen Show 0 : Led On
|
|
Pt Voice %1111
|
|
Pt Raw Play %1001,Start(12),Length(12),22050 : Wait 6
|
|
Pt Raw Play %110,Start(12),Length(12),22050 : Wait 20
|
|
|
|
Rem --- BODGE-IT CODE!!
|
|
|
|
A=PALSTORE(0) : B=PALSTORE(1) : C=PALSTORE(2) : D=PALSTORE(3)
|
|
E=PALSTORE(4) : F=PALSTORE(5) : G=PALSTORE(6) : H=PALSTORE(7)
|
|
I=PALSTORE(8) : J=PALSTORE(9) : K=PALSTORE(10) : L=PALSTORE(11)
|
|
M=PALSTORE(12) : N=PALSTORE(13) : O=PALSTORE(14) : P=PALSTORE(15)
|
|
Q=PALSTORE(16) : R=PALSTORE(17) : S=PALSTORE(18) : T=PALSTORE(19)
|
|
U=PALSTORE(20) : V=PALSTORE(21) : W=PALSTORE(22) : X=PALSTORE(23)
|
|
Y=PALSTORE(24) : Z=PALSTORE(25) : AA=PALSTORE(26) : BB=PALSTORE(27)
|
|
CC=PALSTORE(28) : DD=PALSTORE(29) : EE=PALSTORE(30) : FF=PALSTORE(31)
|
|
|
|
Fade 6,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,BB,CC,DD,EE,FF
|
|
|
|
|
|
COUNT=0
|
|
|
|
While COUNT<380
|
|
Wait Vbl
|
|
COUNT=COUNT+1
|
|
Wend
|
|
|
|
Fade 5
|
|
|
|
Wait 150
|
|
|
|
Screen Close 0 : Erase 12 : Led Off
|
|
|
|
Pop Proc
|
|
|
|
|
|
RED:
|
|
Pal Spread 0,$0 To 14,$FFF
|
|
Pal Spread 16,$EDD To 21,$F00
|
|
Pal Spread 21,$F00 To 31,$300
|
|
Return
|
|
|
|
GREEN:
|
|
Pal Spread 0,$0 To 14,$FFF
|
|
Pal Spread 16,$DED To 21,$D0
|
|
Pal Spread 21,$D0 To 31,$30
|
|
Return
|
|
|
|
CYAN:
|
|
Pal Spread 0,$0 To 14,$FFF
|
|
Pal Spread 16,$DEE To 21,$FF
|
|
Pal Spread 21,$FF To 31,$33
|
|
Return
|
|
|
|
PINK:
|
|
Pal Spread 0,$0 To 14,$FFF
|
|
Pal Spread 16,$EDE To 21,$F0F
|
|
Pal Spread 21,$F0F To 31,$303
|
|
Return
|
|
|
|
BLUE:
|
|
Pal Spread 0,$0 To 14,$FFF
|
|
Pal Spread 16,$DDE To 21,$F
|
|
Pal Spread 21,$F To 31,$3
|
|
Return
|
|
|
|
YELLOW:
|
|
Pal Spread 0,$0 To 14,$FFF
|
|
Pal Spread 16,$EED To 21,$FF0
|
|
Pal Spread 21,$FF0 To 31,$330
|
|
Return
|
|
|
|
|
|
End Proc
|
|
|
|
Procedure _GET_TEXT[INFILE$]
|
|
|
|
|
|
If Exist(INFILE$)
|
|
|
|
Wload INFILE$,1
|
|
For COUNT=0 To Length(1)
|
|
OUTPUT$=OUTPUT$+Chr$(Peek(Start(1)+COUNT-1))
|
|
Next COUNT
|
|
|
|
End If
|
|
|
|
OUTPUT$=Replacestr$(OUTPUT$,Chr$($A) To "")
|
|
|
|
|
|
End Proc[OUTPUT$]
|
|
|
|
|
|
|