Bobs Mainly for the benefit of those who are trying to learn this language like me, I decided to have a go at making bobs in FB with tinyPCT, since the only way is pixelwise, here's a program with a hard coded bob routine with clipping.
Original post by Shockwave taken from the ezboard forum.
' Hard Coded Bob Starfield
' Entirely Using TintPCT.
' Small Exe And A Rough Example Of A Way To Do A Bob Routine Of Sorts.
' Hopefully This Will Become An Intro Maybe.
'
' By Shockwave / DBF 2006
'
'*** Only 12.5kb When Crunched!!!!!! ***
'
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
' Includes.
'-------------------------------------------------------------------------
#Include Once "tinyptc.bi"
'-------------------------------------------------------------------------
' Open 640 X 480 Screen.
'-------------------------------------------------------------------------
If( ptc_open( "Stars", 640, 480 ) = 0 ) Then
End -1
End If
'-------------------------------------------------------------------------
' Variable Definitions.
'-------------------------------------------------------------------------
Dim Shared LP As Integer: ' Used In Loops.
Dim Shared As Integer Buffer( 640 * 480 ):' Screen Buffer.
DIM SHARED AS INTEGER CPAL (255):' Holds Palette.
Dim Shared GADD As Integer:' General Purpose Variable Just Ticks Up.
Dim Shared SMSIN As DOUBLE:' Holds X Movement.
DIM SHARED SMCOS As DOUBLE:' Holds Y Movement.
DIM SHARED ZMCOS As DOUBLE:' Holds Z Movement.
DIM SHARED STPTR AS INTEGER:' Pointer Used When Looping Through Stars.
DIM SHARED STST AS INTEGER:' Holds Deepest Star Pos.
DIM SHARED A AS INTEGER:' Holds Colour Multiplier.
'--------------------------
' Read In Our Star Bobs;---
'--------------------------
dim shared BOB (36*4) AS INTEGER
FOR LP=1 TO (36*3)
READ BOB(LP)
NEXT
'-------------------------------------------------------------------------
' Subroutine Definitions.
'-------------------------------------------------------------------------
Declare Sub STARFIELD()
DECLARE SUB DRAWBOB (BYVAL BX AS INTEGER , BYVAL BY AS INTEGER , BYVAL BNM AS INTEGER , BYVAL CL AS INTEGER)
Declare Sub Clearscreen()
'----------------------------
'--- Set Up Starfield; ---
'----------------------------
Dim Shared STARS As Integer:' Holds Max Number Of Stars
Dim Shared INZP As Double:' Used When Defining Stars To Hold ZP
Dim Shared INZPA As Double:' Used When Defining Stars (ZP Increment)
Dim Shared TX AS INTEGER:' Holds Translated Star X
Dim Shared TY As Integer:' Holds Translated Star Y
STARS = 2000:' How Many Stars?
DIM SHARED STX (1 TO STARS) AS DOUBLE: ' Hold X Pos Of Star
DIM SHARED STY (1 TO STARS) AS DOUBLE: ' Hold Y Pos Of Star
DIM SHARED STZ (1 TO STARS) AS DOUBLE: ' Hold Z Pos Of Star
INZP=30:' Initial Z = 0.
INZPA = 30 / STARS:' Calculate Increment.
STPTR=1:' Holds Star Number During Starfield Sub Loop.
STST=1:' Used To Store Starting Star (deepest).
For LP = 1 To Stars
STX (LP) = ((RND(1) * 20000)-10000 )
STY (LP) = ((RND(1) * 20000)-10000 )
STZ (LP) = INZP
INZP=INZP-INZPA
next
'-----------------------
' Generate A Palette;---
'-----------------------
DIM SHARED R1,G1,B1 AS integer
FOR LP=1 TO 255
CPAL(LP) =RGB(R1,G1,B1)
IF R1<255 THEN R1=R1+3
IF G1<255 THEN G1=G1+2
IF B1<255 THEN B1=B1+1
NEXT LP
'--------------------------------------------------
'--- Main Loop, Repeat Until Escape Pressed. ---
'--------------------------------------------------
DO
Clearscreen():' Clear The Screen.
STARFIELD():' Do The Starfield.
'----------------------------
' Draw White Lines On Screen;
'----------------------------
FOR LP = 0 TO 639
Buffer ((50*640)+LP)=RGB (255,155,55)
Buffer ((430*640)+LP)=RGB (255,155,55)
NEXT
Ptc_Update @Buffer(0):' Update The Buffer.
LOOP UNTIL INKEY$ = CHR$(27)
Ptc_Close()
END
'---------------------------------------
'--- MULTI DIRECTIONAL STARFIELD. ---
'---------------------------------------
SUB STARFIELD()
GADD=GADD+1
'---------------
' Movements; ---
'---------------
SMSIN=30*SIN(GADD/470)
SMCOS=40*COS(GADD/777)
ZMCOS=0.1*COS(GADD/907)
'---------------------------
' Get Deepest Star First;---
'---------------------------
STPTR=STST
for LP = 1 To STARS
'---------------------------------
' Translate Star To 2D Co-Ords ---
'---------------------------------
TX = INT((STX(STPTR) / STZ(STPTR))+320)
TY = INT((STY(STPTR) / STZ(STPTR))+240)
'--------------------
' Is It Onscreen? ---
'--------------------
if TX>-5 and TX<639 AND TY>-5 And TY<479 THEN
'--------------------------------
' Calculate Colour Multiplier;---
'--------------------------------
A=INT(-STZ(STPTR) + 32)
'-------------------------------------
' Draw Bob Size According To Depth;---
'-------------------------------------
IF STZ(STPTR) < 10 THEN DRAWBOB (TX,TY,3,A)
IF STZ(STPTR >= 10) AND (STZ(STPTR) <20 ) THEN DRAWBOB (TX,TY,2,A)
IF STZ(STPTR) >= 20 THEN DRAWBOB (TX,TY,1,A)
ENDIF
'---------------
' Move Star; ---
'---------------
STX(STPTR)=STX(STPTR)+SMSIN
STY(STPTR)=STY(STPTR)+SMCOS
STZ(STPTR)=STZ(STPTR)+ZMCOS
'------------------
' Bounds Checks;---
'------------------
' X Checks;
IF SMSIN>0 THEN
IF STX(STPTR)>=10000 THEN STX(STPTR)=STX(STPTR)-20000
ENDIF
IF SMSIN<0 THEN
IF STX(STPTR)<=-10000 THEN STX(STPTR)=STX(STPTR)+20000
ENDIF
' Y Checks;
IF SMCOS>0 THEN
IF STY(STPTR)>=10000 THEN STY(STPTR)=STY(STPTR)-20000
ENDIF
IF SMCOS<0 THEN
IF STY(STPTR)<=-10000 THEN STY(STPTR)=STY(STPTR)+20000
ENDIF
' Z Checks;
IF ZMCOS>0 THEN
IF STZ(STPTR)>=30 THEN STZ(STPTR)=STZ(STPTR)-30
STST=STST-1
IF STST<1 THEN STST=STARS
ENDIF
IF ZMCOS<0 THEN
IF STZ(STPTR)<=0 THEN STZ(STPTR)=STZ(STPTR)+30
STST=STST+1
IF STST>STARS THEN STST=1
ENDIF
STPTR=STPTR+1:' Update Pointer.
IF STPTR>STARS THEN STPTR=1:'Bounds Check.
next
END SUB
'-------------------------------------------------------------------------
' Sub To Draw A Bob Anywhere On The Screen;
'-------------------------------------------------------------------------
SUB DRAWBOB (BYVAL BX AS INTEGER , BYVAL BY AS INTEGER, BYVAL BNM AS INTEGER , BYVAL CL AS INTEGER)
DIM BLX , BLY AS INTEGER
'-------------------------------------
' Shit Code To Set Offset In Bob Bank;
'-------------------------------------
IF BNM=1 THEN BM=0
IF BNM=2 THEN BM=36
IF BNM=3 THEN BM=72
FOR BLY=0 TO 5
FOR BLX=1 TO 6
'---------
'CLIPPING;
'---------
IF (BX+BLX>0) AND (BX+BLX<639) AND (BY+BLY>0) AND (BY+BLY<479) THEN
'-------------
'COLOUR VALUE;
'-------------
if (by+BLY> 50) and (by+bly<430) then
MM= (BOB(((BLY*6)+BLX)+BM))*CL
else
MM= ((BOB(((BLY*6)+BLX)+BM))*CL) shr 1
endif
'------------------
'DRAW PIXEL OF BOB;
'------------------
IF MM >0 THEN BUFFER (((BY+BLY)*640)+BX+BLX)=CPAL(MM)
END IF
NEXT
NEXT
END SUB
'--------------------------------------------------------
' Clear Out Old Screen Buffer With Our Fake "Copperlist"
'--------------------------------------------------------
Sub ClearScreen()
Dim i as integer
for i = 0 to 640*480
IF i <640*50 or i>640*430 then
Buffer(i) = &h100401
else
Buffer(i) = h100000
endif
next
End Sub
'--------------------------------------------------------
' Our "Bobs"
' 0's are not blitted.
' The Higher The Number, The Brighter The Pixel.
'--------------------------------------------------------
'small;
data 0,0,1,1,0,0
data 0,1,2,2,1,0
data 1,1,0,5,2,1
data 1,2,3,0,2,1
data 0,1,2,1,1,0
data 0,0,1,1,0,0
'middle;
data 0,1,2,2,1,0
data 1,1,0,2,3,1
data 2,0,1,7,2,2
data 2,3,0,1,0,2
data 1,3,3,0,1,1
data 0,1,2,2,1,0
'close;
data 0,1,2,3,1,0
data 1,0,0,3,4,1
data 2,2,0,9,3,3
data 3,3,1,0,0,2
data 1,0,3,2,0,1
data 0,1,3,2,1,0
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18260
(19/4/06 20:29)
Reply
Re: Bobs
Nice one mate
5H0CKW4VE
*Administrator*
Posts: 8013
(20/4/06 12:12)
Reply
ezSupporter
Re: Bobs
Thanks Clyde, I got some text done as well now and I posted it in a new topic. Hope it helps some people.
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
rbraz
CBM 128
Posts: 179
(20/4/06 17:29)
Reply
Re: Bobs
Nice effect and colors dude
