YOUREWINNER.COM
 
   

WINNERcode
 
Thunder
#1 16-05-2012, 22:03:26 PM
- Last Edit: 18-05-2012, 15:58:33 PM
Do you use FreeBASIC? Do you use FreeGDK? Do you ever wish FreeGDK could be more :stamp: so you could make games like :brbox: ?

Now you can! Introducing WINNERcode, a work-in-progress adaptation of FreeGDK (and FreeBASIC) syntax to a more :stamp: dialect. Here is an example program:

Code: [Select]
#include once "wincode.bi"

scene 640,480

dontquittowindows

greyvoid

cargo "serg.bmp",1

rig as integer pressedspace

startrace
    ultranav 1,640*slots,480*slots,WINNER
    readout "YOU'RE WINNER !",mousex,mousey
    if brake or click>0 then
        if pressedspace=LOSER then honk
        pressedspace=WINNER
    else
        pressedspace=LOSER
    endif
    if esc then timesup
    win
endrace

Save the above as anyname.bas.

And here is wincode.bi (update 1.1):
Code: [Select]
'Copyright (c) 2012 Thunder

'Permission is hereby granted, free of charge, to any person obtaining a copy
'of this software and associated documentation files (the "Software"), to deal
'in the Software without restriction, including without limitation the rights
'to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
'copies of the Software, and to permit persons to whom the Software is
'furnished to do so, subject to the following conditions:

'The above copyright notice and this permission notice shall be included in
'all copies or substantial portions of the Software.

'THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
'IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
'FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
'AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
'LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
'OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
'THE SOFTWARE.

#lang "deprecated"

#define __YOURE_WINNER__

#define startrace do

#define endrace loop

#define exitrace exit do

#define rig dim

#define timesup end

#define WINNER 1

#define LOSER 0

#define quittowindows enableescapekey

#define dontquittowindows disableescapekey

chdir exepath

dim shared as uinteger _mask=rgb(255,0,255)

'You can change this, it's 500000
dim shared as integer render3d=500000
redim shared as single world(render3d,3)
redim shared as integer worldcolors(render3d,3)
dim shared as integer r3d1=0
dim shared as double PI=4*atn(1)
dim shared as integer drawdistance
drawdistance=3000
dim shared as integer fogr,fogg,fogb,onfog
dim shared as single camx
dim shared as single camy
dim shared as single camz
dim shared as single camrot
dim shared as single frim
dim shared as integer screenfps

dim shared as string*2 closeTriggerString=chr$(255)+"k"
dim shared as ubyte escapeKeyEnabled=1
dim shared as uinteger bufColor=rgb(0,0,0)
dim shared as uinteger ptr puiPixel,bufPointer,sgfxPointer
dim shared as any ptr imageexist(1 to 65535)
dim shared as integer imagewidth(1 to 65535),imageheight(1 to 65535)
dim shared as integer mousex=320,mousey=240,click,screenwidth,screenheight,realscreenwidth,realscreenheight

declare sub loadsound(byval sound as string,byval num as integer)
declare sub loopsound(byval num as integer)
declare sub playsound(byval num as integer)
declare sub stopsound(byval num as integer)
declare sub deletesound(byval num as integer)
declare function soundexist(byval num as integer) as integer
declare function _transb(byval so as uinteger,byval de as uinteger,byval pa as any ptr) as uinteger
declare function angle(byval x as double,byval y as double) as double
declare sub box(byval x1 as integer,byval y1 as integer,byval x2 as integer,byval y2 as integer,byval c as uinteger=&hFFFFFF)
declare sub prefix(byval textData as string,byval textX as integer,byval textY as integer)
declare sub greyvoid(byval c as uinteger=0)
declare function controlkey() as ubyte
declare sub deleteimage(byval imagenumber as integer)
declare sub deletestaticobjects
declare sub disableescapekey
declare sub dot(byval x as integer,byval y as integer,byval c as uinteger=&hFFFFFF)
declare function downkey() as ubyte
declare sub enableescapekey
declare function esc as ubyte
declare sub fogcolor(byval c as uinteger)
declare sub fogoff
declare sub fogon
declare sub fogdistance(byval dist as integer=drawdistance)
declare sub getimage(byval num as integer,byval x1 as integer,byval y1 as integer,byval x2 as integer,byval y2 as integer)
declare sub hidemouse
declare sub honk
declare function imagecollision(byval i1 as integer,byval x1 as integer,byval y1 as integer,byval i2 as integer,byval x2 as integer,byval y2 as integer) as ubyte
declare function leftkey() as ubyte
declare function lerp(byval a as single,byval b as single,byval f as single) as single
declare sub showcargo(byval filename as string)
declare sub cargo(byval filename as string,byval imagenumber as integer)
declare sub loadstaticobjects(byval filename as string)
declare sub makelandscape(byval i as integer,byval x as integer=0,byval y as integer=0,byval z as integer=0,byval w as integer=0,byval h as integer=0)
declare sub makepoint(byval x as single=0,byval y as single=0,byval z as single=0,byval c as uinteger)
declare sub movecamera(byval a as single=0)
declare sub ultranav(byval imagenumber as integer,byval x as integer,byval y as integer,byval f as integer=0)
declare function returnkey() as ubyte
declare function rgbb(byval c as uinteger) as ubyte
declare function rgbg(byval c as uinteger) as ubyte
declare function rgbr(byval c as uinteger) as ubyte
declare function rightkey() as ubyte
declare sub savebitmap(byval filename as string)
declare sub saveimage(byval filename as string,byval imagenumber as integer)
declare sub savestaticobjects(byval filename as string)
declare sub scene(byval sWidth as integer=0,byval sHeight as integer=0,byval sDepth as integer=0)
declare sub setwindowtitle(byval tit as string)
declare sub showmouse
declare function slots() as double
declare function brake() as ubyte
declare function split(byval st as string,byval char as string,byval ind as integer) as string
declare sub win
declare sub readout(byval textData as string,byval textX as integer,byval textY as integer)
declare function textheight(byval textData as string) as integer
declare function textwidth(byval textData as string) as integer
declare sub triangle(byval x1 as integer,byval y1 as integer,byval x2 as integer,byval y2 as integer,byval x3 as integer,byval y3 as integer,byval col as uinteger)
declare function upkey() as ubyte
declare function wrapvalue(byval a as single) as single

#ifdef __FB_WIN32__
    declare function mciSendStringA alias "mciSendStringA" (byval as zstring ptr,byval as zstring ptr,byval as uinteger,byval as integer ptr) as uinteger

    public sub loadsound(byval sound as string,byval num as integer)
        static as string quote
        quote=chr$(34)
        mciSendStringA("open " & quote & sound & quote & " type mpegvideo alias snd" & num & " wait",0,0,0)
    end sub

    public sub loopsound(byval num as integer)
        'PlaySoundA(sound,0,8 OR 2 OR 1)
        mciSendStringA("play snd" & num & " from 0 REPEAT",0,0,0)
    end sub

    public sub playsound(byval num as integer)
        'PlaySoundA(sound,0,2 OR 1)
        mciSendStringA("play snd" & num & " from 0",0,0,0)
    end sub

    public sub stopsound(byval num as integer)
        'PlaySoundA(0,0,0)
        mciSendStringA("stop snd" & num,0,0,0)
    end sub
   
    public sub deletesound(byval num as integer)
        mciSendStringA("close snd" & num & " wait",0,0,0)
    end sub
   
    public function soundexist(byval num as integer) as integer
        if mciSendStringA("play snd" & num & " test",0,0,0)=0 then
            return 1
        else
            return 0
        end if
    end function
#else
    public sub loadsound(byval sound as string,byval num as integer)
        return
    end sub

    public sub loopsound(byval num as integer)
        return
    end sub

    public sub playsound(byval num as integer)
        return
    end sub

    public sub stopsound(byval num as integer)
        return
    end sub
   
    public sub deletesound(byval num as integer)
        return
    end sub
   
    public function soundexist(byval num as integer) as integer
        return 0
    end function
#endif

function _transb(byval so as uinteger,byval de as uinteger,byval pa as any ptr) as uinteger
    if so=_mask then
        return de
    else
        return so
    end if
end function

public function angle(byval x as double,byval y as double) as double
    if x>0 then
        if y>0 then
            if x>y then
                'wedge 2
                return 2-(y/x)
            else
                'wedge 1
                return x/y
            end if
        elseif y<0 then
            if x+y<0 then
                'wedge 4
                return (x/y)+4
            else
                'wedge 3
                return 2-(y/x)
            end if
        else
            return 2
        end if
    elseif x<0 then
        if y>0 then
            if x+y>0 then
                'wedge 8
                return (x/y)+8
            else
                'wedge 7
                return 6-(y/x)
            end if
        elseif y<0 then
            if x>y then
                'wedge 5
                return (x/y)+4
            else
                'wedge 6
                return 6-(y/x)
            end if
        else
            return 6
        end if
    else
        if y<0 then
            return 4
        else
            return 0
        end if
    end if
end function

public sub box(byval x1 as integer,byval y1 as integer,byval x2 as integer,byval y2 as integer,byval c as uinteger=&hFFFFFF)
    line bufPointer,(x1,y1)-(x2,y2),c,BF
end sub

public sub prefix(byval textData as string,byval textX as integer,byval textY as integer)
    draw string bufPointer,(textX-(len(textData)*4),textY),textData
end sub

public sub greyvoid(byval c as uinteger=0)
    if c>0 then
        bufColor=c
    else
        bufColor=rgb(127,127,127)
    end if
end sub

public function controlkey() as ubyte
    return multikey(&h1D)
end function

public sub deleteimage(byval imagenumber as integer)
    imagedestroy imageexist(imagenumber)
    imageexist(imagenumber)=0
end sub

public sub deletestaticobjects
    dim as integer i
    for i=0 to r3d1-1
        world(i,0)=0
        world(i,1)=0
        world(i,2)=0
        worldcolors(i,0)=0
        worldcolors(i,1)=0
        worldcolors(i,2)=0
    next i
    r3d1=0
end sub

public sub disableescapekey
    escapeKeyEnabled=0
end sub

public sub dot(byval x as integer,byval y as integer,byval c as uinteger=&hFFFFFF)
    puiPixel=screenwidth*y+x+bufPointer
    *puiPixel=c
end sub

public function downkey() as ubyte
    return multikey(&h50)
end function

public sub enableescapekey
    escapeKeyEnabled=1
end sub

public function esc as ubyte
    return multikey(&h01)
end function

public sub fogcolor(byval c as uinteger)
    fogr=rgbr(c)
    fogg=rgbg(c)
    fogb=rgbb(c)
end sub

public sub fogoff
    onfog=0
end sub

public sub fogon
    onfog=1
end sub

public sub fogdistance(byval dist as integer=drawdistance)
    drawdistance=dist
end sub

public sub getimage(byval num as integer,byval x1 as integer,byval y1 as integer,byval x2 as integer,byval y2 as integer)
    static as integer t,iw,ih
    if x1>x2 then
        t=x1
        x1=x2
        x2=t
    end if
    if y1>y2 then
        t=y1
        y1=y2
        y2=t
    end if
    if imageexist(num)>0 then imagedestroy imageexist(num)
    iw=x2+1-x1
    ih=y2+1-y1
    imageexist(num)=ImageCreate(iw,ih)
    imagewidth(num)=iw
    imageheight(num)=ih
    get bufPointer,(x1,y1)-(x2,y2),imageexist(num)
end sub

public sub hidemouse
    setmouse ,,0
end sub

public sub honk
    #ifdef __FB_LINUX__
        shell("echo "+chr$(7))
    #else
        print chr$(7)
    #endif
end sub

public function imagecollision(byval i1 as integer,byval x1 as integer,byval y1 as integer,byval i2 as integer,byval x2 as integer,byval y2 as integer) as ubyte
    if x1+imagewidth(i1)>x2 and y1+imageheight(i1)>y2 and x2+imagewidth(i2)>x1 and y2+imageheight(i2)>y1 then
        return 1
    else
        return 0
    end if
end function

public function leftkey() as ubyte
    return multikey(&h4B)
end function

public function lerp(byval a as single,byval b as single,byval f as single) as single
    return f*(b-a)+a
end function

public sub showcargo(byval filename as string)
    static as integer filenum, bmpwidth, bmpheight
    static as any ptr img

    filenum = FreeFile()
    if Open( filename For Binary Access Read As #filenum ) <> 0 Then return

    Get #filenum, 19, bmpwidth
    Get #filenum, 23, bmpheight

    Close #filenum

    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    if img = 0 then return

    if BLoad( filename, img ) <> 0 Then ImageDestroy( img ):return

    put bufPointer,(0,0),img,pset
   
    imagedestroy img
end sub

public sub cargo(byval filename as string,byval imagenumber as integer)
    static as integer filenum, bmpwidth, bmpheight
    static as any ptr img

    filenum = FreeFile()
    if Open( filename For Binary Access Read As #filenum ) <> 0 Then return

    Get #filenum, 19, bmpwidth
    Get #filenum, 23, bmpheight

    Close #filenum

    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    if img = 0 then return

    if BLoad( filename, img ) <> 0 Then ImageDestroy( img ):return

    imagewidth(imagenumber)=bmpwidth
    imageheight(imagenumber)=bmpheight
   
    if imageexist(imagenumber)>0 then imagedestroy imageexist(imagenumber)

    imageexist(imagenumber)=img
end sub

public sub loadstaticobjects(byval filename as string)
    static as integer filenum
    static as string txt,ts

    filenum = FreeFile()
    if Open(filename For Binary As #filenum) <> 0 Then return

    Do Until EOF(filenum)
        Line Input #filenum,txt
        ts=split(txt,",",1)
        if len(ts)>0 then
            world(r3d1,0)=val(split(txt,",",0))
            world(r3d1,1)=val(ts)
            world(r3d1,2)=val(split(txt,",",2))
            worldcolors(r3d1,0)=valint(split(txt,",",3))
            worldcolors(r3d1,1)=valint(split(txt,",",4))
            worldcolors(r3d1,2)=valint(split(txt,",",5))
            r3d1+=1
        end if
    Loop

    Close #filenum
end sub

public sub makelandscape(byval i as integer,byval x as integer=0,byval y as integer=0,byval z as integer=0,byval w as integer=0,byval h as integer=0)
    static as integer px,py,iw,ih,iwm,ihm,wm,hm,colly
    static as uinteger c,tc
    static as uinteger ptr ie
    if w=0 and h=0 then
        w=imagewidth(i)
        h=imageheight(i)
    end if
    x-=w/2
    z+=h/2
    ie=imageexist(i)
    tc=rgb(255,0,255)
    iw=imagewidth(i)
    ih=imageheight(i)
    iwm=iw-1
    ihm=ih-1
    wm=w-1
    hm=h-1
    for py=0 to hm
        colly=((py+1)/h)*ihm
        for px=0 to wm
            c=point(((px+1)/w)*iwm,colly,ie)
            if c<>tc then makepoint(px+x,y,z-py,c)
        next px
    next py
end sub

public sub makepoint(byval x as single=0,byval y as single=0,byval z as single=0,byval c as uinteger)
    world(r3d1,0)=x
    world(r3d1,1)=y
    world(r3d1,2)=z
    worldcolors(r3d1,0)=rgbr(c)
    worldcolors(r3d1,1)=rgbg(c)
    worldcolors(r3d1,2)=rgbb(c)
    r3d1+=1
end sub

public sub movecamera(byval a as single=0)
    dim as single camr=camrot*PI/180
    camx+=a*sin(camr)
    camz+=a*cos(camr)
end sub

public sub ultranav(byval imagenumber as integer,byval x as integer,byval y as integer,byval f as integer=0)
    if f=1 then
        put bufPointer,(x,y),imageexist(imagenumber),custom,@_transb
    else
        put bufPointer,(x,y),imageexist(imagenumber),pset
    endif
end sub

public function returnkey() as ubyte
    return multikey(&h1C)
end function

public function rgbb(byval c as uinteger) as ubyte
   return c and 255
end function

public function rgbg(byval c as uinteger) as ubyte
   return c shr 8 and 255
end function

public function rgbr(byval c as uinteger) as ubyte
   return c shr 16 and 255
end function

public function rightkey() as ubyte
    return multikey(&h4D)
end function

public sub savebitmap(byval filename as string)
    bsave filename,bufPointer
end sub

public sub saveimage(byval filename as string,byval imagenumber as integer)
    bsave filename,imageexist(imagenumber)
end sub

public sub savestaticobjects(byval filename as string)
    static as integer filenum,i

    kill filename

    filenum = FreeFile()
    if Open(filename For Output As #filenum) <> 0 Then return

    for i=0 to r3d1-1
        print #filenum,world(i,0) & "," & world(i,1) & "," & world(i,2) & "," & worldcolors(i,0) & "," & worldcolors(i,1) & "," & worldcolors(i,2)
    next i

    Close #filenum
end sub

public sub scene(byval sWidth as integer=0,byval sHeight as integer=0,byval sDepth as integer=0)
    screenwidth=sWidth
    screenheight=sHeight
    if sDepth>0 then
        screenres screenwidth,screenheight,sDepth
        realscreenwidth=screenwidth
        realscreenheight=screenheight
    else
        #ifdef __FB_DOS__
            realscreenwidth=320
            realscreenheight=200
            sDepth=16
        #else
            screeninfo realscreenwidth,realscreenheight,sDepth
        #endif
        if sWidth=0 and sHeight=0 then
            screenwidth=realscreenwidth
            screenheight=realscreenheight
            screenres realscreenwidth,realscreenheight,sDepth,,1 or 4 or 80
        else
            screenres screenwidth,screenheight,sDepth
        end if
    end if
    windowtitle Command(0)
    realscreenwidth=screenwidth
    realscreenheight=screenheight
    if bufPointer>0 then imagedestroy bufPointer
    bufPointer=ImageCreate(screenwidth,screenheight,bufColor)
    sgfxPointer=screenptr()
    width realscreenwidth/8,realscreenheight/14
end sub

public sub setwindowtitle(byval tit as string)
    windowtitle tit
end sub

public sub showmouse
    setmouse ,,1
end sub

public function slots as double
    dim as double rndomnumbler
    rndomnumbler=rnd()
    if rndomnumbler>=1 then rndomnumbler=0
    return rndomnumbler
end function

public function brake as ubyte
    return multikey(&h39)
end function

public function split(byval st as string,byval char as string,byval ind as integer) as string
    static as string s,r
    static as integer curind,x,l
    s=""
    r=""
    curind=0
    x=0
    l=len(st)
    do
        x+=1
        s=mid$(st,x,1)
        if s=char then
            curind+=1
            if curind>ind then exit do
        else
            if curind=ind then r=r+s
        end if
        if x>=l then exit do
    loop
    return r
end function

public sub win
        static as integer px,py,w,h,iw,ih,iwm,ihm,wm,hm,colly
        static as uinteger ptr ie,pp
            iw=screenwidth
            ih=screenheight
            iwm=iw-1
            ihm=ih-1
            w=realscreenwidth
            h=realscreenheight
            wm=w-1
            hm=h-1
        ie=bufPointer
    if iw<w or ih<h then
        pp=sgfxPointer
        screenlock
        for py=0 to hm
            colly=py/hm*ihm
            for px=0 to wm
                *pp=point(px/wm*iwm,colly,ie)
                pp+=1
            next px
        next py
        screenunlock
    else
        put (0,0),ie,pset
    end if
    if multikey(&h38) and multikey(&h3E) or inkey$()=closeTriggerString then end
    if escapeKeyEnabled=1 then if multikey(&h01) then end
    line ie,(0,0)-(iwm,ihm),bufColor,BF
   
    if r3d1>0 then
        dim as single camr=camrot*PI/180
        dim as single points(drawdistance+1,r3d1,3)
        dim as integer i
        for i=0 to r3d1-1
            dim as single x1=world(i,0)-camx
            dim as single z1=world(i,2)-camz
            dim as single z2=x1*sin(camr)+z1*cos(camr)
            if z2>0 and z2<=drawdistance then
                dim as integer z3=int(z2)
                points(z3,i,0)=x1*cos(camr)-z1*sin(camr)
                points(z3,i,1)=world(i,1)-camy
                points(z3,i,2)=z2
            end if
        next i

        dim as integer z
        dim as integer hsw=0.5*screenwidth
        dim as integer hsh=0.5*screenheight
        dim as integer ssw=0.71*screenwidth
        if onfog=1 then
            dim as single pr,pg,pb
            for z=drawdistance to 0 step -1
                for i=0 to r3d1-1
                    dim as single z1=points(z,i,2)
                    if z1>0 then
                        dim as single z2=0-z1
                        dim as integer s=ssw/z1
                        dim as single h=s*-0.5
                        dim as integer x1=points(z,i,0)/z1*hsw+h+hsw
                        dim as integer y1=points(z,i,1)/z2*hsw+h+hsh
                        dim as integer x2=x1+s
                        dim as integer y2=y1+s
                        if x2>0 and y2>0 and x1<screenwidth and y1<screenheight then
                            'Possible fog formulas:
                            'r=(fogr-points(z,i,3))/drawdistance*z1+points(z,i,3)
                            'r=(z1*fogr-(z1*points(z,i,3)))/drawdistance+points(z,i,3)
                            'r=z1/drawdistance*(points(z,i,3)-fogr)+fogr
                            'dim as single f=1/exp(drawdistance/z1)
                            dim as single f=z1/(drawdistance+1)
                            line bufPointer,(x1,y1)-(x2,y2),rgb(lerp(worldcolors(i,0),fogr,f),lerp(worldcolors(i,1),fogg,f),lerp(worldcolors(i,2),fogb,f)),BF
                        end if
                    end if
                next i
            next z
        else
            for z=drawdistance to 0 step -1
                for i=0 to r3d1-1
                    dim as single z1=points(z,i,2)
                    if z1>0 then
                        dim as single z2=0-z1
                        dim as integer s=ssw/z1
                        dim as single h=s*-0.5
                        dim as integer x1=points(z,i,0)/z1*hsw+h+hsw
                        dim as integer y1=points(z,i,1)/z2*hsw+h+hsh
                        dim as integer x2=x1+s
                        dim as integer y2=y1+s
                        if x2>0 and y2>0 and x1<screenwidth and y1<screenheight then line bufPointer,(x1,y1)-(x2,y2),rgb(worldcolors(i,0),worldcolors(i,1),worldcolors(i,2)),BF
                    end if
                next i
            next z
        end if
    end if
    sleep 1
   
    static as double oldtime,time1
    oldtime=time1
    time1=timer()
    frim=(time1-oldtime)
    if frim<0 then frim=0
    if frim>0.5 then frim=0.5
   
    getmouse(mousex,mousey,,click)
    mousex=int(screenwidth/realscreenwidth*mousex)
    mousey=int(screenheight/realscreenheight*mousey)
end sub

public sub readout(byval textData as string,byval textX as integer,byval textY as integer)
    draw string bufPointer,(textX,textY),textData
end sub

public function textheight(byval textData as string) as integer
    return 14
end function

public function textwidth(byval textData as string) as integer
    return len(textData)*8
end function

public sub triangle(byval x1 as integer,byval y1 as integer,byval x2 as integer,byval y2 as integer,byval x3 as integer,byval y3 as integer,byval col as uinteger)

    static as integer dx1,dy1, dx2,dy2, dx3,dy3, delta1,delta2,delta3, Lx,Rx, y, Lxo,Rxo
   
    IF y2 < y1 THEN
        SWAP y1, y2
        SWAP x1, x2
    END IF
    IF y3 < y1 THEN
        SWAP y3, y1
        SWAP x3, x1
    END IF
   
    IF y3 < y2 THEN
        SWAP y3, y2
        SWAP x3, x2
    END IF
   
    dx1 = x2 - x1
    dy1 = y2 - y1
    IF dy1 <> 0 THEN
        delta1 = (dx1 shl 16) / dy1
    ELSE
        delta1 = 0
    END IF
   
    dx2 = x3 - x2
    dy2 = y3 - y2
    IF dy2 <> 0 THEN
        delta2 = (dx2 shl 16) / dy2
    ELSE
        delta2 = 0
    END IF


    dx3 = x1 - x3
    dy3 = y1 - y3
    IF dy3 <> 0 THEN
        delta3 = (dx3 shl 16) / dy3
    ELSE
        delta3 = 0
    END IF
   
   
    'Flat bottom
    'Top part of triangle

    Lx = x1 shl 16
    Rx = Lx
   
    FOR y = y1 TO y2 - 1
        Lxo = Lx shr 16
        Rxo = Rx shr 16
        line bufPointer,(Lxo,y)-(Rxo,y),col
        Lx += delta1
        Rx += delta3
    NEXT y

    'Flat top
    'Lower part of triangle

    Lx = x2 shl 16
    FOR y = y2 TO y3
        Lxo = Lx shr 16
        Rxo = Rx shr 16
        line bufPointer,(Lxo,y)-(Rxo,y),col
        Lx += delta2
        Rx += delta3
    NEXT y

end sub

public function upkey() as ubyte
    return multikey(&h48)
end function

public function wrapvalue(byval a as single) as single
    static as single a360
    a360=a/360
    if a>=360 then
        a=(a360-int(a360))*360
    elseif a<0 then
        a=(a360-int(a360))*360
    end if
    return a
end function

To compile the program, you must download FreeBASIC and type "fbc anyname.bas".

 :roddy: :belair:


yourethunder
Thunder
#2 16-05-2012, 22:09:42 PM


And here is serg.bmp.


yourethunder
ZMannZilla
#3 16-05-2012, 23:16:01 PM
  • "There ain't no stopping us now, we celebrate on the floor"
  • *****
    *****
    ****
  • Posts: 6506
  • Rigcoins: 3877803.30
  • Send Money to ZMannZilla
    Trophy
  • Kind heartGreat fatherBob Cobra was here+
  • "YOU LOOK STU-PID *CLAP CLAP CLAPCLAPCLAP*"
Do you use FreeBASIC?

Nope.

Do you use FreeGDK?

Nope again.

Do you ever wish FreeGDK could be more :stamp: so you could make games like :brbox: ?

Thought never crossed my mi-

Now you can!

Wait, actually I'm not that intere-

Introducing WINNERcode, a work-in-progress adaptation of FreeGDK (and FreeBASIC) syntax to a more :stamp: dialect.

I don't think you heard me, I really couldn't give a rat's a-

Here is an example program:

Is there a non-Vulcan version of that garble?

To compile the program, you must download FreeBASIC and type "fbc anyname.bas".

IKEA virus.


big rigs is great and i want to suck his cock


"Yeah, let’s bring back the Attitude Era…so we can see Shawn Michael’s anus while they shill toys." -RD Reynolds
Z. Mann Zilla
bjorno the hedgehog
#4 17-05-2012, 01:03:23 AM
serg.bmp is awesome (Y)



 cheers m8
bjorno780 http://img444.imageshack.us/img444/2969/freesorfzl1.gif
Thunder
#5 18-05-2012, 13:44:42 PM
I could make a quick game with WINNERcode to demonstrate the possibilities.


yourethunder
JAVIKS
#6 18-05-2012, 13:51:18 PM
  • Global Moderator
  • *****
    *****
    *****
    *****
    *****
    *
  • Posts: 7052
  • Rigcoins: 366765.97
  • Send Money to JAVIKS
    Thumb Up
  • TAG TEAM CHAMPDadCoors Light Fan+
  • "cats are like potato chips"
do it and i might maybe possibly probably play it


JAVIKS
Thunder
#7 18-05-2012, 14:04:07 PM
do it and i might maybe possibly probably play it

Alright, see you in an hour.


yourethunder
Thunder
#8 18-05-2012, 15:01:18 PM
Production delay! See you in a half hour.


yourethunder
JAVIKS
#9 18-05-2012, 15:06:29 PM
  • Global Moderator
  • *****
    *****
    *****
    *****
    *****
    *
  • Posts: 7052
  • Rigcoins: 366765.97
  • Send Money to JAVIKS
    Thumb Up
  • TAG TEAM CHAMPDadCoors Light Fan+
  • "cats are like potato chips"
i will be unavailable and will get to it when i can


JAVIKS
Thunder
#10 18-05-2012, 15:39:26 PM
i will be unavailable and will get to it when i can

Well, I'm uploading the file right now.


yourethunder
Thunder
#11 18-05-2012, 15:54:04 PM
- Last Edit: 18-05-2012, 17:31:15 PM
WINNERcoder

Save and open with 7-zip

Alternately, here is the zip file (~1 MB)

EDIT: Works with Windows and Linux!


yourethunder
DZ
#12 18-05-2012, 23:11:18 PM
  • grrrraaaaaaagggh
  • Administrator
  • *****
    *****
    ***
  • Posts: 7764
  • Rigcoins: 298.60
  • Send Money to DZ
    Thumb Up
  • Active memberszaps dicksNot Active Enough+
  • "i am a trailer park hooker"
virus


Classic Meepington
#13 18-05-2012, 23:38:48 PM
program me love




(\_/) Hi! I'm Bunny ^.^
(^.^) Copy and paste us to your siggy so we can
(")(") achieve WORLD DOMINATION!
Dissident YOU'RE WINNER!
JAVIKS
#14 19-05-2012, 01:05:30 AM
  • Global Moderator
  • *****
    *****
    *****
    *****
    *****
    *
  • Posts: 7052
  • Rigcoins: 366765.97
  • Send Money to JAVIKS
    Thumb Up
  • TAG TEAM CHAMPDadCoors Light Fan+
  • "cats are like potato chips"
first tell me what the game is about, and then i will maybe possibly download it


JAVIKS
Thunder
#15 19-05-2012, 22:09:29 PM
first tell me what the game is about, and then i will maybe possibly download it

OK, WINNERcoder is a game about chasing Sergey Titov.

You start up the game, and there is a title screen. The music playing in the background is Bach's 1812 Overture. You press Enter, then you get to the game.

The game consists of sound, a background, two sprites, and some text. You play as the white sprite at the bottom of the screen. The caucasian sprite in the center of the screen is Sergey Titov. You must use the arrow keys to chase Sergey into a corner and collide with him. When you do, a point gets added and you get rewarded with Microsoft SAPI saying "You're WINNER".

When you get 10 points, you must get one more point to return to the title screen, at which point you once again hear dramatic music.

:roddy:

The Linux version unfortunately has reduced sound capablities. That combined with the fact that Microsoft SAPI is only on Windows makes it so that all you hear is beeps (when you run the program from the terminal, that is). When you do not run the program from the terminal, there is *usually* no sound, and I say that because I have not tested it on other Linux machines.

If you want this and other similar games to run on Mac OSX, download Darwine. That will allow you to run the Windows version of the game(s). However, Wine does not have Microsoft SAPI, so you will only hear the music (and that depends on your Wine installation and the format of the music).

In contrast, if you are running Windows and want to hear no sound, and you do not wish to mute your computer, you can recompile the game if you have a copy of FreeBASIC. You will have to remark out or remove the lines of code that play sound, which are indicated by the commands "speak_async" and "playsound".

----

If you are having any further trouble with the game, here is a FAQ that applies to the current build of WINNERcoder:

Q: How do I get the game?
A: Click on one of the two links above and save the file indicated on the page, be it either an image that says "WINNER coder" on it, or a zip file. If you downloaded the image version, you need a program called 7-zip to open the file. If you downloaded the zip version and you're running Windows XP or later, simply locate the zip file and unzip it to a location of your choice. If you are running a version of Windows earlier than XP, you need either Zipper or 7-zip.

Q: How do I run the game?
A: If you are running Windows (or a Mac with Wine installed), open the folder that you saved the game to and click on "wincoder.exe". It is not a good idea to push Alt-Enter after you have done this (at least if you are running on Windows) because that will make the game go fullscreen, and unfortunately FreeBASIC's way of dynamically switching between fullscreen and windowed mode seems rather incompatible with Windows. If you are running Linux, open the terminal and navigate to the folder where you saved the game to and type in "./wincoder". Alternatively, open the folder that you saved the game to and click on "wincoder".

Q: The game is not working/how do I play the game?
A: This is the tricky part. The first thing you should see when you run the game is a window that has a title screen in it that says "WINNER coder". The next thing you should do is push Enter or Return. If nothing happens, try clicking on the window, then pushing Enter or Return. If still nothing happens, press Alt-Enter, click on the window or screen where it says "WINNER coder" and press Enter or Return again. If yet still nothing happens, do your best to close the game. You could investigate recompiling it on your computer. If when you first open the game, you just see a black screen/window or nothing happens, you should do your best to close the game and abandon all hope, secluding yourself to a life without WINNERcoder, or get another computer. If you are indeed able to run the game and get ingame, it is a simple matter of using the arrow keys on your keyboard to move the white sprite and try to hit the sprite that looks like a guy's face. If you do not have arrow keys or you cannot get it to work, post in this thread and let me know.

Q: I have another question.
A: Post in this thread.

----

Is that enough of a description, Javiks?


yourethunder
0 Members and 1 Guest are viewing this topic.