Flagmatic source code

[gooner]

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.

Code: [Select]

                             ''
' 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


[Xalthorn]

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.

[gooner]

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.
 

[rain_storm]

just one little optimisation that I noticed here. you are doing two comparisons when only one is required

Code: [Select]

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 -

Code: [Select]

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

[gooner]

Thanks for the hint there Rain.That will save me a little less code cheers dude.