Teinpähän viime vuonna joskus hienon starfieldin ja piti siihen alkaa lisäilemään kaikenlaista. Tässä se nyt on pienen valikkoexamppelin kanssa. Tuon intropuheen sanoista oli niin vaikeaa saada selvää että siitä ei kannata ottaa mallia. Tuskin tästä vinkistä kukaan mitään oppii kun koodia on niin paljon (en kai edes kommentoinut) mutta olipahan minun aika jo lisätä uusi vinkki. Vinkki tarvii vissiin qbx:än, ei ainakaan tolla ykkösellä toiminu.
DECLARE SUB MainTitle ()
DECLARE SUB Menus ()
DECLARE SUB Story ()
DECLARE SUB NewStar ()
DECLARE SUB DrawStars ()
DECLARE SUB HideStars ()
DECLARE FUNCTION MenuResult! (XPos!, YPos!, DefaultIndex!, MenuCount!)
DECLARE SUB OUTColor (ColorSlot!)
DECLARE SUB Pause (Delay AS SINGLE)
DECLARE SUB SetColors ()
DECLARE FUNCTION SolveAngle! (x1!, y1!, x2!, y2!)
DECLARE SUB DrawShots ()
DECLARE SUB HideShots ()
DIM SHARED OnAir AS INTEGER
DIM SHARED Menu(1 TO 7) AS STRING
'Background stars
TYPE BackgroundStar
X AS SINGLE
Y AS SINGLE
StartX AS SINGLE
StartY AS SINGLE
Angle AS SINGLE
Speed AS SINGLE
Distance AS SINGLE
Visible AS INTEGER
Shown AS INTEGER
END TYPE
DIM SHARED Star(50) AS BackgroundStar
DIM SHARED NewStarDelay AS INTEGER
CONST StarDelay = 1
TYPE ShotType
Speed AS SINGLE
Angle AS INTEGER
Clr AS SINGLE
Distance AS SINGLE
Visible AS INTEGER
CX AS SINGLE
CY AS SINGLE
END TYPE
DIM SHARED Shot(9) AS ShotType
DIM SHARED LastShotSide
LastShotSide = 70
'Color tables
TYPE ColorTable
Red AS SINGLE
Green AS SINGLE
Blue AS SINGLE
END TYPE
DIM SHARED RGBColor(0 TO 255) AS ColorTable
DIM SHARED Brightness AS SINGLE
DIM SHARED XTurning AS SINGLE, YTurning AS SINGLE
DIM SHARED Spin AS SINGLE, SpinAccel AS SINGLE
ON ERROR RESUME NEXT
'Settings
DIM SHARED ShowStars AS INTEGER
DIM SHARED FancyMenu AS INTEGER
FancyMenu = -1
SCREEN 13
Brightness = 100
OnAir = 0
SetColors
Story
MainTitle
Menus
'(!) DISTANCE:
'eX = Star(i).StartX - Star(i).x: eY = Star(i).StartY - Star(i).y
'Dist = SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY)))
CLS
DO
HideStars
HideShots
XTurning = (ABS(XTurning) - .05) * SGN(XTurning)
IF ABS(XTurning) < .05 THEN XTurning = 0
IF ABS(XTurning) > 2 THEN XTurning = 2 * SGN(XTurning)
YTurning = (ABS(YTurning) - .05) * SGN(YTurning)
IF ABS(YTurning) < .05 THEN YTurning = 0
IF ABS(YTurning) > 2 THEN YTurning = 2 * SGN(YTurning)
SpinAccel = (ABS(SpinAccel) - .02) * SGN(SpinAccel)
IF ABS(SpinAccel) < .02 THEN SpinAccel = 0
Spin = Spin + SpinAccel
DrawStars
DrawShots
LINE (157, 100)-(163, 100), 32
LINE (160, 97)-(160, 103), 32
PSET (160, 100), 45
CIRCLE (160, 100), 2, 40
SELECT CASE INKEY$
CASE CHR$(0) + "K": XTurning = XTurning - .2: SpinAccel = SpinAccel + .04
CASE CHR$(0) + "H": YTurning = YTurning - .2
CASE CHR$(0) + "M": XTurning = XTurning + .2: SpinAccel = SpinAccel - .04
CASE CHR$(0) + "P": YTurning = YTurning + .2
CASE CHR$(13)
FOR i = 0 TO UBOUND(Shot)
IF NOT Shot(i).Visible THEN
Shot(i).Distance = 0
Shot(i).CX = 160: Shot(i).CY = 100
Shot(i).Speed = 10
Shot(i).Angle = 180 - LastShotSide - Spin
LastShotSide = -LastShotSide
Shot(i).Clr = 126
Shot(i).Visible = -1
FOR f = 3500 TO 1000 STEP -250
SOUND f, .05
NEXT
EXIT FOR
END IF
NEXT
CASE CHR$(27): END
END SELECT
Pause .01
LOOP
SUB DrawShots
FOR i = 0 TO UBOUND(Shot)
IF Shot(i).Visible THEN
Shot(i).Distance = Shot(i).Distance + Shot(i).Speed
Shot(i).Speed = Shot(i).Speed * .89
Clr = Shot(i).Clr
Shot(i).Clr = Shot(i).Clr - 3
Shot(i).CX = Shot(i).CX - XTurning
Shot(i).CY = Shot(i).CY + YTurning
IF Shot(i).Clr < 66 THEN Shot(i).Visible = False: GOTO NextShot
Dist1 = 150 - (Shot(i).Distance / 63 * 110)
Dist2 = Dist1 + (150 - Shot(i).Distance * 2) / 5
a = (Shot(i).Angle + Spin - 90) * 3.141592 / 180
x1 = COS(a) * Dist1 + Shot(i).CX
y1 = SIN(a) * Dist1 + Shot(i).CY
x2 = COS(a) * Dist2 + Shot(i).CX
y2 = SIN(a) * Dist2 + Shot(i).CY
LINE (x1, y1)-(x2, y2), Clr
END IF
NextShot:
NEXT
END SUB
SUB DrawStars
NewStarDelay = NewStarDelay - 1
IF NewStarDelay <= 0 THEN
NewStar
NewStarDelay = StarDelay
END IF
FOR i = 0 TO UBOUND(Star)
IF Star(i).Visible THEN
a = (Star(i).Angle - 90) * 3.141592 / 180
Star(i).X = COS(a) * Star(i).Distance / 3 + Star(i).StartX
Star(i).Y = SIN(a) * Star(i).Distance / 3 + Star(i).StartY
Star(i).StartX = Star(i).StartX - XTurning
Star(i).StartY = Star(i).StartY + YTurning
IF Star(i).X < 0 OR Star(i).X > 319 OR Star(i).Y < 0 OR Star(i).Y > 199 THEN
Star(i).Visible = 0
GOTO NextStar
END IF
Clr = Star(i).Distance * .5
IF Clr > 65 THEN Clr = 65
a = SolveAngle(160, 100, Star(i).X, Star(i).Y)
eX = 160 - Star(i).X: eY = 100 - Star(i).Y
Dist = SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY)))
a = (a + Spin - 90) * 3.141592 / 180
X = COS(a) * Dist + 160
Y = SIN(a) * Dist + 100
IF Clr >= 0 AND POINT(Star(i).X, Star(i).Y) = 0 THEN
PSET (X, Y), Clr
Star(i).Shown = -1
ELSE
Star(i).Shown = 0
END IF
Star(i).Distance = Star(i).Distance + Star(i).Speed
Star(i).Speed = Star(i).Speed * 1.1
END IF
NextStar:
NEXT
END SUB
SUB HideShots
FOR i = 0 TO UBOUND(Shot)
IF Shot(i).Visible THEN
Dist1 = 150 - (Shot(i).Distance / 63 * 110)
Dist2 = Dist1 + (150 - Shot(i).Distance * 2) / 5
a = (Shot(i).Angle + Spin - 90) * 3.141592 / 180
x1 = COS(a) * Dist1 + Shot(i).CX
y1 = SIN(a) * Dist1 + Shot(i).CY
x2 = COS(a) * Dist2 + Shot(i).CX
y2 = SIN(a) * Dist2 + Shot(i).CY
LINE (x1, y1)-(x2, y2), 0
END IF
NEXT
END SUB
SUB HideStars
FOR i = 0 TO UBOUND(Star)
IF Star(i).Visible AND Star(i).Shown THEN
a = SolveAngle(160, 100, Star(i).X, Star(i).Y)
eX = 160 - Star(i).X: eY = 100 - Star(i).Y
Dist = SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY)))
a = (a + Spin - 90) * 3.141592 / 180
X = COS(a) * Dist + 160
Y = SIN(a) * Dist + 100
PSET (X, Y), 0
END IF
NEXT
END SUB
SUB MainTitle
Title$ = "STARTREK"
CLS : COLOR 1: LOCATE 1, 1: PRINT Title$
FOR Size = 0 TO 4 STEP .1
YPos = YPos - .5
Clr = Clr + .6
BaseColor = Clr
HideStars
DrawStars
Pause .01
FOR Y = 0 TO 7
Top = 60
FOR X = 0 TO LEN(Title$) * 8
c = POINT(X, Y)
Tx1 = 160 - (Size * LEN(Title$) * 8 / 2) + (X * Size)
Ty1 = Top - (Size * LEN(Title$) / 2) + (Y * Size) + YPos
Tx2 = Tx1 + Size - 1: Ty2 = Ty1 + Size - 1
Top = Top - .2
BaseColor = BaseColor - .01
DrawColor = BaseColor - (X / 8) - (Y / 3) + RND
IF DrawColor < 0 THEN DrawColor = 0
IF c > 0 THEN LINE (Tx1, Ty1)-(Tx2, Ty2), DrawColor, BF
NEXT X, Y, Size
COLOR 0: LOCATE 1, 1: PRINT Title$
Clr = 100
Title$ = "Puhveli 2004"
COLOR 1
LOCATE 15, 1: PRINT Title$
LOCATE 16, 1: PRINT SPACE$(LEN(Title$))
SpeedStep = .01
Size = 0
DO
Size = Size + SpeedStep
Clr = Clr + .2
SpeedStep = SpeedStep + .02
BaseColor = Clr
HideStars
DrawStars
Pause .01
FOR Y = 0 TO 14
Top = 80
FOR X = 0 TO LEN(Title$) * 8
c = POINT(X, Y + 112)
Tx1 = 160 - (Size * LEN(Title$) * 8 / 2) + (X * Size)
Ty1 = Top - (Size * LEN(Title$) / 2) + (Y * Size)
Tx2 = INT(Tx1 + Size - 1): Ty2 = INT(Ty1 + Size - 1)
Top = Top + ((1 - Size) / 10)
BaseColor = BaseColor - .002
DrawColor = (BaseColor - (X / 8) - (Y / 3) + RND) * SGN(c)
IF DrawColor < 1 OR DrawColor > 64 THEN LINE (Tx1, Ty1)-(Tx2, Ty2), DrawColor, BF
NEXT X, Y
LOOP UNTIL Size >= 1
LINE (0, 70)-(319, 199), 0, BF
END SUB
FUNCTION MenuResult (XPos, YPos, DefaultIndex, MenuCount)
Index = DefaultIndex
ShadowClr = 0
ShadowFade = 0
GOSUB DrawMenus
IF FancyMenu THEN MenuBrightness = 0 ELSE MenuBrightness = 1: GOSUB DrawMenus
DO
IF ShadowClr > 30 THEN ShadowFade = ShadowFade - .1
IF ShadowClr < 30 THEN ShadowFade = ShadowFade + .1
ShadowClr = ShadowClr + ShadowFade
IF MenuBrightness < 1 THEN MenuBrightness = MenuBrightness + .2: GOSUB DrawMenus
Pause .01
HideStars
DrawStars
SELECT CASE INKEY$
CASE CHR$(0) + "H": Index = Index - 1
IF Index < 1 THEN Index = MenuCount
GOSUB DrawMenus
CASE CHR$(0) + "P": Index = Index + 1
IF Index > MenuCount THEN Index = 1
GOSUB DrawMenus
CASE CHR$(13): EXIT DO
CASE CHR$(27): Index = 0: EXIT DO
END SELECT
LOOP
IF FancyMenu THEN
FOR MenuBrightness = 1 TO 0 STEP -.2
HideStars
DrawStars
GOSUB DrawMenus
Pause .01
NEXT
ELSE
MenuBrightness = 0: GOSUB DrawMenus
END IF
MenuResult = Index
EXIT FUNCTION
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
DrawMenus:
FOR i = 1 TO MenuCount
X = INT(XPosition - (LEN(Menu(i)) / 2 * 8))
Y = INT(YPosition - (MenuCount / 2) + ((i - 1) * 2 * 7))
COLOR 1
LOCATE 23, 1
PRINT Menu(i)
FOR Y = 0 TO 9
FOR X = 0 TO LEN(Menu(i)) * 8
Tx = INT(XPos - (LEN(Menu(i)) * 4) + X)
Ty = INT(YPos - (MenuCount * 17 / 2) + (i * 17) + Y)
SelY = INT(YPos - (MenuCount * 17 / 2) + (Index * 17) + Y)
c = POINT(X, Y + 176)
IF FancyMenu THEN
eX = XPos - Tx: eY = SelY - Ty
Clr = 50 - (SQR((ABS(eX) * ABS(eX)) + (ABS(eY) * ABS(eY))) / 1.7)
IF i = Index THEN Clr = Clr + 15
ELSE
IF i = Index THEN Clr = 50 ELSE Clr = 20
END IF
IF Clr < 0 THEN Clr = 0
Clr = Clr * MenuBrightness
IF c = 1 THEN
PSET (Tx, Ty), Clr
IF FancyMenu THEN PSET (Tx, Ty + 1), Clr / 2
ELSEIF FancyMenu THEN
IF POINT(X, Y + 177) = 1 THEN PSET (Tx, Ty), Clr / 2
END IF
NEXT X, Y
NEXT
RETURN
END FUNCTION
SUB Menus
LastMenu = 1
MainMenu:
Menu(1) = "Play intro"
Menu(2) = "Set things"
Menu(3) = "Give a poo ('Xit)"
SELECT CASE MenuResult(160, 120, LastMenu, 3)
CASE 1: EXIT SUB
CASE 2: LastMenu = 1: GOTO Settings
CASE ELSE
FOR Brightness = Brightness TO 0 STEP -.5
FOR c = 0 TO 255: OUTColor c: NEXT
NEXT
END
END SELECT
Settings:
IF FancyMenu THEN Menu(1) = "Show plain menus" ELSE Menu(1) = "Show fancy menus"
Menu(2) = "Validate"
LastMenu = MenuResult(160, 120, LastMenu, 2)
SELECT CASE LastMenu
CASE 1: FancyMenu = NOT FancyMenu
CASE ELSE: LastMenu = 2: GOTO MainMenu
END SELECT: GOTO Settings
END SUB
SUB NewStar
FOR i = 0 TO UBOUND(Star)
IF NOT Star(i).Visible THEN
Star(i).X = RND * 320: Star(i).Y = RND * 200
Star(i).StartX = Star(i).X: Star(i).StartY = Star(i).Y
Star(i).Angle = SolveAngle(160, 100, Star(i).X, Star(i).Y)
Star(i).Speed = RND * .1
Star(i).Distance = 1: Star(i).Visible = -1
Star(i).Shown = 0
EXIT FOR
END IF
NEXT
END SUB
SUB OUTColor (ColorSlot)
OUT &H3C8, ColorSlot
OUT &H3C9, RGBColor(ColorSlot).Red * Brightness / 100
OUT &H3C9, RGBColor(ColorSlot).Green * Brightness / 100
OUT &H3C9, RGBColor(ColorSlot).Blue * Brightness / 100
END SUB
SUB Pause (Delay AS SINGLE)
DIM StartTime AS SINGLE
DIM CurrentTime AS SINGLE
StartTime = TIMER: DO: CurrentTime = TIMER
LOOP UNTIL CurrentTime - StartTime > Delay OR CurrentTime < StartTime
END SUB
SUB SetColors
RGBColor(1).Red = 0
RGBColor(1).Green = 0
RGBColor(1).Blue = 0
OUTColor 1
FOR i = 2 TO 65
RGBColor(i).Red = i - 2
RGBColor(i).Green = i - 2
RGBColor(i).Blue = i - 2
OUTColor i
NEXT
FOR i = 66 TO 130
RGBColor(i).Red = i - 66
RGBColor(i).Green = i - 66
RGBColor(i).Blue = 0
OUTColor i
NEXT
END SUB
FUNCTION SolveAngle (x1, y1, x2, y2)
eX = x1 - x2
eY = y1 - y2
IF x2 > x1 AND eY = 0 THEN
Angle = 90
ELSE
Angle = -45 / ATN(1) * ATN(eX / eY)
IF y2 > y1 THEN Angle = Angle + 180
IF x2 < x1 AND y2 < y1 THEN Angle = Angle + 360
END IF
SolveAngle = Angle
END FUNCTION
SUB Story
DIM Wave(999) AS LONG
WaveWidth = 2
DIM Text(1 TO 4) AS STRING
Clr = 0
Index = 0
DO
d = d + 1
c = c - .05
Clr = Clr + c
IF Clr < 0 THEN d = 0: Clr = 0: c = 2.5: Index = Index + 1
SELECT CASE Index
CASE 1
Text(1) = "Space, the final frontier..."
TextCount = 1
CASE 2
Text(1) = "These are the voyagers"
Text(2) = "of the starship Enterprise"
TextCount = 2
CASE 3
Text(1) = "Its continuing mission"
Text(2) = "to explore strange new worlds"
TextCount = 2
CASE 4
Text(1) = "To seek out new life"
Text(2) = "and new civilizations"
TextCount = 2
CASE 5
Text(1) = "To offer us a great"
Text(2) = "ZIUUM*FOOM*BAM experience"
TextCount = 2
CASE ELSE: EXIT DO
END SELECT
FOR i = 1 TO TextCount
Title$ = Text(i)
Row = 10 - INT(TextCount / 2) + i * 2
Column = 20 - INT(LEN(Title$) / 2)
COLOR Clr: IF Clr < 5 THEN COLOR 0
LOCATE Row, Column: PRINT Title$
Top = (Row * 8) - 9
FOR X = Column * 8 - 8 TO Column * 8 + (LEN(Title$) * 8) STEP WaveWidth
Y = INT(SIN((X - d) / 5)) + Top + 1
GET (X, Top)-(X + WaveWidth, Top + 8), Wave
LINE (X, Top - 1)-(X + WaveWidth, Top + 11), 0, BF
PUT (X, Y), Wave, PSET
NEXT
NEXT
HideStars
DrawStars
Pause .01
LOOP WHILE INKEY$ = ""
END SUBKyllä se introteksti ihan oikein menee. :) On tämä kyllä hieno, varsinkin säväytti se iso star trek -logo
Binääri?
Hieno valikko.
Käsittääkseni tuossa oli jonkinlainen ohjaus? Yritin ainakin ohjata tuota intro juttua :D en tiedä näinkö harhoja, vai liikkuiko se oikeasti, mutta sitten kun pidin yhtä nuolinäppäintä pohjassa, niin PC-speaker alko vinkumaan.
Ihan hieno. Sä sitte jaksat tehä noista alkuvalikoista ite ohjelmaa hienompia =)
Tämä ohjelma kirjoitti:
To offer us a great
ZIUUM*FOOM*BAM experience
:DD
Tein tosta binäärin. http://sooda.afraid.org/foo/sfield.exe
sooda: Missäs siinä oli se ohjelma, alkuvalikkoahan tuo kaikki on :D? Kiitti kun teit binaarin kun en itse jaksanut.
edit: T.M: Tuo kuulostaa huolestuttavalta :D! No ei, on siinä näköjään vieläkin tuo kamerankääntelymahdollisuus, luulin vaan ottaneeni sen pois käytöstä kun se ei oikein toiminut kunnolla. Nii, ja enteriä painamalla se ampuu vaiheisilla ;)
Loistotyötä! :)
Sisennykset mun makuun.
Kommentointia olisin kaivannut joihinkin kohtiin, mutta jos jokin asia kiinnostaa, niin kokeillaan muutta sitä ja katsotaan mitä tapahtuu. Näinhän sen saa myöskin selville. :)
lainaus:
To offer us a great ZIUUM*FOOM*BAM experience
Tuo oli kyllä hieno kaikkien tavanomaisten tekstien jälkeen. :)
Ihan hieno starfield.
Aihe on jo aika vanha, joten et voi enää vastata siihen.