Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: gooner on September 03, 2008
-
Here is my source code for my entry flagmatic.Hope it might help somebody at the same level as me if you can get that low. ;) ;) ;)
''
' FlAGMATIC
'
OPTION EXPLICIT
SCREEN 18,,2,1
SCREENSET 1,0
DECLARE SUB RECT(BYVAL x1 as integer ,BYVAL Y1 as integer , BYVAL X2 AS INTEGER , BYVAL y2 as integer , BYVAL FILLED AS INTEGER , BYVAL COL AS INTEGER )
DECLARE SUB RENDER()
DECLARE SUB DOUBLE_BUFFER()
DIM SHARED AS INTEGER BXRES,BYRES'WHOLE NUMBERS THAT CAN BE VIEWED BY THE WHOLE PROGRAM
BXRES=160
BYRES=120
DIM SHARED AS UINTEGER FRAMEBUFFER(BXRES,BYRES)
DIM SHARED AS INTEGER COLOUR,COLOUR1,COLOUR3,COLOUR4,COLOUR5,COLOUR6,COLOUR7,COLOUR8,COLOUR9,COLOUR10,COLOUR11,COLOUR12,COLOUR13,colour14,colour15,colour16,X1,Y1,Y2,FILLED
DIM SHARED AS DOUBLE XA,YA,D,E,F,G,H,I,J,K,P,Q,R,S,U,V,z,DX,XX2,X2,x3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,x14,x15,x16,X
DIM SHARED ADD AS DOUBLE
DO
ADD=ADD+3
' TO USE THIS SUB ; RECT (X1,Y1,X2,Y2,FILL,COLOUR)
RECT(20,10,30,35,1,COLOUR1)'GREEN TO BLUE
RECT(31,10,40,35,1,15)'WHITE
RECT(41,10,50,35,1,COLOUR)'ORANG TO RED
RECT(20,45,30,70,1,COLOUR7)'BLACK TO GREEN
RECT(31,45,40,70,1,COLOUR8)'YELLOW TO RED
RECT(41,45,50,70,1,COLOUR9)'RED TO YELLOW
RECT(20,80,30,110,1,COLOUR4)'GREEN TO BLACK
RECT(31,80,40,110,1,COLOUR5)'WHITE TO RED
RECT(41,80,50,110,1,COLOUR6)'RED TO GREEN
'
RECT(65,10,95,33,1,COLOUR14)'BLUE TO GREEN
rect(78,10,82,33,1,COLOUR13)'YELLOW TO BLUE
RECT(65,18,95,22,1,COLOUR13)'YELLOW TO BLIE
RECT(65,42,95,70,1,COLOUR5)'WHITE TO RED
RECT(77,42,82,70,1,COLOUR3)'RED TO LIGHT BLUE
RECT(65,53,95,58,1,COLOUR3'RED TO LIGHT BLUE
RECT(65,80,95,110,1,COLOUR16)
RECT(78,80,82,110,1,COLOUR15)'RED TO WHITE
RECT(65,93,95,97,1,COLOUR15)'RED TO WHITE
RECT(110,10,150,20,1,COLOUR3)'RED TO LIGHT BLUE
RECT(110,21,150,30,1,COLOUR10)'YELLOW TO WHITE
RECT(110,31,150,40,1,COLOUR3)'RED TO LIGHT BLUE
RECT(110,51,150,60,1,COLOUR11)'BLACK TO RED
RECT(110,61,150,70,1,COLOUR12)'RED TO WHITE
RECT(110,71,150,80,1,COLOUR13) 'YELLOW TO BLUE
RECT(110,90,150,112,1,4)'GREEN TO BLACK
RECT(124,100,135,103,1,15)'RED TO WHITE
RECT(128,97,131,107,1,15)'RED TO WHITE
IF D=0 THEN X3=X3+.1'
IF D=0 THEN COLOUR1=2' GREEN
IF X3>78 THEN D=1'
IF D=1 THEN
COLOUR1=1'BLUE
X3=X3-.1
END IF
IF X3<0 THEN D=0
'END IF
if dx=0 then Xx2=Xx2+.1'
IF DX=0 THEN COLOUR=42'ORANG
IF XX2>78 THEN DX=1'
IF DX=1 THEN COLOUR=4'RED
IF DX=1 THEN XX2=XX2-.1'
IF XX2<0 THEN DX=0'
IF E=0 THEN X4=X4+.1
IF E=0 THEN COLOUR3=4'RED
IF X4>78 THEN E=1
IF E=1 THEN COLOUR3=3'LIGHT BLUE
IF E=1 THEN X4=X4-.1
IF X4<0 THEN E=0
IF F=0 THEN X5=X5+.1
IF F=0 THEN COLOUR4=2'GREEN
IF X5>78 THEN F=1
IF F=1 THEN COLOUR4=0'BLACK
IF F=1 THEN X5=X5-.1
IF X5<0 THEN F=0
IF G=0 THEN X6=X6+.1
IF G=0 THEN COLOUR5=15'WHITE
IF X6>78 THEN G=1
IF G=1 THEN COLOUR5=4'RED
IF G=1 THEN X6=X6-.1
IF X6<0 THEN G=0
IF H=0 THEN X7=X7+.1
IF H=0 THEN COLOUR6=4'RED
IF X7>78 THEN H=1
IF H=1 THEN COLOUR6=2'GREEN
IF H=1 THEN X7=X7-.1
IF X7<0 THEN H=0
IF I=0 THEN X8=X8+.1
IF I=0 THEN COLOUR7=0'BLACK
IF X8>78 THEN I=1
IF I=1 THEN COLOUR7=2'GREEN
IF I=1 THEN X8=X8-.1
IF X8<0 THEN I=0
IF J=0 THEN X9=X9+.1
IF j=0 THEN COLOUR8=14'YELL
IF X9>78 THEN J=1
IF J=1 THEN COLOUR8=4'RED
IF J=1 THEN X9=X9-.1
IF X9<0 THEN J=0
IF K=0 THEN X10=X10+.1
IF K=0 THEN COLOUR9=4'RED
IF X10>78 THEN K=1
IF K=1 THEN COLOUR9=14'YELLO
IF K=1 THEN X10=X10-.1
IF X10<0 THEN K=0
IF P=0 THEN X11=X11+.1
IF P=0 THEN COLOUR10=14'YELLO
IF X11>78 THEN P=1
IF P=1 THEN COLOUR10=15'WHITE
IF P=1 THEN X11=X11-.1
IF X11<0 THEN P=0
IF Q=0 THEN X12=X12+.1
IF Q=0 THEN COLOUR11=0'BLACJK
IF X12>78 THEN Q=1
IF Q=1 THEN COLOUR11=4'RED
IF Q=1 THEN X12=X12-.1
IF X12<0 THEN Q=0
IF R=0 THEN X13=X13+.1
IF R=0 THEN COLOUR12=4'RED
IF X13>78 THEN R=1
IF R=1 THEN COLOUR12=15'WHITE
IF R=1 THEN X13=X13-.1
IF X13<0 THEN R=0
IF S=0 THEN X14=X14+.1
IF S=0 THEN COLOUR13=14'YELL
IF X14>78 THEN S=1
IF S=1 THEN COLOUR13=1'BLUE
IF S=1 THEN X14=X14-.1
IF X14<0 THEN S=0
IF U=0 THEN X15=X15+.1
IF U=0 THEN COLOUR14=1'BLU
IF X15>78 THEN U=1
IF U=1 THEN COLOUR14=4'green
IF U=1 THEN X15=X15-.1
IF X15<0 THEN U=0
IF V=0 THEN X16=X16+.1
IF V=0 THEN COLOUR15=4'RED
IF X16>78 THEN V=1
IF V=1 THEN COLOUR15=15'WHITE
IF V=1 THEN X16=X16-.1
IF X16<0 THEN V=0
IF Z=0 THEN X16=X16+.1
IF Z=0 THEN COLOUR16=1'BLU
IF X16>78 THEN Z=1
IF Z=1 THEN COLOUR16=2'RED
IF Z=1 THEN X16=X16-.1
IF X16<0 THEN Z=0
render()
DOUBLE_BUFFER()
LOOP UNTIL INKEY$<>""
END
'-------------------------------------------------------------------------------
SUB RECT(BYVAL x1 as integer ,BYVAL Y1 as integer , BYVAL X2 AS INTEGER , BYVAL y2 as integer, BYVAL FILLED AS INTEGER , BYVAL COL AS INTEGER )
dim as integer l,SWP,M
' MAKE SURE THAT ORDER IS CORRECT IE X1 AND Y1 ARE TOP LEFT! IF NOT, FIX THEM!
IF X2<X1 THEN'
SWP=X2'
X2=X1'SWAPS X2 WITH X1 IF X1 IS GREATER THAN X2
X1=SWP'
END IF
IF Y2<Y1 THEN
SWP=Y2'
Y2=Y1'SWAPS Y2 WITH Y1 IF Y1 IS GREATER THAN Y2
Y1=SWP'
END IF
'MAKE SURE ALL POINTS ARE ON SCREEN!
IF X1<0 THEN X1=0'
IF X1>BXRES-1 THEN X1=BXRES-1'
IF X2<0 THEN X2=0
IF X2>BXRES-1 THEN X2=BXRES-1'
IF Y1<0 THEN X1=0
IF Y1>BYRES-1 THEN Y1=BYRES-1'
IF Y2<0 THEN Y2=0
IF Y2>BYRES-1 THEN Y2=BYRES-1'
FOR L=X1 TO X2 '
FRAMEBUFFER(L,Y1+5*SIN((L+ADD)*3.14/180))=COL'
FRAMEBUFFER(L,Y2+5*SIN((L+ADD)*3.14/180))=COL '
NEXT
' NOT A FILLED RECTANGLE? JUST DRAW THE SIDES.
IF FILLED<>1 THEN
FOR L=Y1 TO Y2 '
FRAMEBUFFER(X1,L)=COL'
FRAMEBUFFER(X2,L)=COL '
NEXT
ELSE
' FILLED RECTANGLE;
FOR M=X1 TO X2
FOR L=Y1 TO Y2 '
FRAMEBUFFER(M,L+5*SIN((M+ADD)*3.14/180))=COL'
FRAMEBUFFER(M,L+5*SIN((M+ADD)*3.14/180))=COL '
NEXT
NEXT
END IF
END SUB
sub render()
dim as integer x,y,tx,ty'
for y=0 to byres-1'
ty=y*4'
for x=0 to bxres-1'
tx=x*4'
line (tx,ty)-(tx+4,ty+4),framebuffer(X,Y),bf'
next
next
END SUB
SUB DOUBLE_BUFFER()
dim as integer x,y
for y=0 to byres-1'
for x=0 to bxres-1'
framebuffer(x,y)=220'
next
next
SCREENCOPY
CLS
SLEEP 1
END SUB
-
Here is my source code for my entry flagmatic.Hope it might help somebody at the same level as me if you can get that low. ;) ;) ;)
We'll have less of that...
Considering how recently you picked up programming, you're already achieving some very impressive stuff. Stop pulling yourself down. Besides, we all had to start with the basics.
-
Considering how recently you picked up programming, you're already achieving some very impressive stuff. Stop pulling yourself down. Besides, we all had to start with the basics.
Cheers for that Xalthorn i'm enjoying the learning process and i've got this far mainly thanks to Shockie ,Rain ,yourself and all the other great people on this forum.Going through your code and deciphering what is going on will definitely help me.
:|| :||
-
just one little optimisation that I noticed here. you are doing two comparisons when only one is required
IF E=0 THEN X4=X4+.1
IF E=0 THEN COLOUR3=4'RED
IF X4>78 THEN E=1
IF E=1 THEN COLOUR3=3'LIGHT BLUE
IF E=1 THEN X4=X4-.1
IF X4<0 THEN E=0
thi E=0 comparisons can be optimised to a single comparison -
IF E=0 THEN
X4=X4+.1
COLOUR3=4'RED
ENDIF
IF X4>78 THEN E=1
IF E=1 THEN
COLOUR3=3'LIGHT BLUE
X4=X4-.1
ENDIF
IF X4<0 THEN E=0
I checked the disassembly and Freebasic does not perform this optimisation for you which is stupid really this is exactly the kind of thing compilers should catch. Apart from that theres nothing wrong. Your coding style has become very clear and tidy, which is nice to see
-
Thanks for the hint there Rain.That will save me a little less code cheers dude. ;)