Making a Scratch like IDE

User projects written in or related to FreeBASIC.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Making a Scratch like IDE

Post by BasicCoder2 »

As an exercise in programming I wondered how hard it would be to write a simple version of a Scratch like IDE in FreeBASIC.
https://scratch.mit.edu/projects/editor/?tip_bar=home

The intention was to add the option of generating FreeBASIC source code from a Scratch like program as Flowgorithm can generate source code in different languages.
In this demo you can use the mouse to select and move a script block from the left side to the right side. The blocks on the right side will automatically sort themselves according to their position on the y axis.
You can click a value and change it using the number keys.
The next step is to add more scripts and run the program.

Code: Select all

type TEXTBOX
    as integer x
    as integer y
    as integer w
    as integer h
    as ulong   c1
    as ulong   c2
    as integer id
    as integer a      'active
    as string  t      'text
    as integer cursor 'last position of cursor
end type

sub editText(tb as TEXTBOX)
    dim as string key
    dim as integer ascKey
    key = inkey
    if key<>"" then
        if len(key)>1 then
            ascKey = asc(right(key,1))
            if ascKey = 75 then  'tb.cursor LEFT
                if tb.cursor > 0 then
                    tb.cursor = tb.cursor -1 
                end if
            end if
            if ascKey = 77 then  'tb.cursor RIGHT
                if tb.cursor < len(tb.t) then
                    tb.cursor = tb.cursor + 1
                end if
            end if
            if ascKey = 83 then 'DELETE
                tb.t = left(tb.t,tb.cursor) + right(tb.t,len(tb.t)-tb.cursor-1)
            end if
        else
            ascKey = asc(key)
            if asc(key)=8 then
                if tb.cursor > 0 then  'BACKSPACE
                    tb.t = left(tb.t,tb.cursor-1) + mid(tb.t,tb.cursor+1,len(tb.t)-tb.cursor)
                    tb.cursor = tb.cursor - 1
                end if
            else
                if ascKey<>9 and ascKey<>27 and ascKey<>13 then  'TAB, ESC, ENTER
                    if key>="0" and key<="9" then  'numerical input?
                        tb.t = left(tb.t,tb.cursor) + key + right(tb.t,len(tb.t)-tb.cursor)
                        tb.cursor = tb.cursor + 1
                    end if
                end if
            end if
        end if
    end if  'if key pressed
end sub

'================================================================================================

const BORDER = 350   'between block type buttons and block display
const SCRW = 1280
const SCRH = 600

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls

dim shared as integer mx,my,mb,dx,dy,ox,oy
dim shared as integer blkID,txtID
blkID = -1 'not selected
txtID = -1 'not selected

const NUMBLKS = 7
const NUMTB = 2

type BLOCK
    as integer x
    as integer y
    as integer w
    as integer h
    as string  t    'text 
    as ulong   c1
    as ulong   c2
    as integer id   'type of block
    as integer a    'active
    as TEXTBOX tb(0 to NUMTB)
    as integer totTb          'number of text boxes actually used
end type

dim shared as BLOCK blk(0 to NUMBLKS)  'five block types

dim shared as BLOCK blks(0 to 1000)     '1000 clones
dim shared as integer totBlks

' ========  initialize template blocks to clone from  =============

for i as integer = 0 to NUMBLKS 'four script blocks to clone
    blk(i).x = 20
    blk(i).y = i * 24 + 50  'start at same position as its button
    blk(i).w = 300
    blk(i).h = 20
    blk(i).c1 = rgb(74,108,212)
    blk(i).c2 = rgb(74,108,212)
    blk(i).id = i
    read blk(i).t

    for j as integer = 0 to NUMTB
        blk(i).tb(j).y = 2
        blk(i).tb(j).w = 4*8
        blk(i).tb(j).h = 20
        blk(i).tb(j).c1 = rgb(255,255,255)
        blk(i).tb(j).c2 = rgb(200,200,200)
        blk(i).tb(j).t  = "0" 'DEFAULT VALUE
        blk(i).tb(j).cursor = 1
    next j

next i

'set default values
blk(0).tb(0).t = "1"
blk(1).tb(0).t = "10"
blk(2).tb(0).t = "15"
blk(3).tb(0).t = "15"
blk(4).tb(0).t = "100"
blk(4).tb(1).t = "100"
blk(5).tb(0).t = "100"
blk(5).tb(1).t = "100"
blk(6).tb(0).t = "5"
blk(7).tb(0).t = "5"

'============================================================================


sub drawBlock(blk as BLOCK)
    dim as string  char       'current character
    dim as string  newString  'blk.t with inserted textbox text
    dim as integer posX       'current position in newString
    dim as integer n          'current position in blk.tb(n).t
            
    newString = ""
    posX = 0
    n = 0
            
    'create new string to print
    for p as integer = 1 to len(blk.t)  'scan string to print
                
        char = mid(blk.t,p,1)  'get character
                
        if char = "*" then 'must insert text box string
                    
            blk.tb(n).x = posX*8                   'start position of tb in newString                    
            newString = newString & blk.tb(n).t    'insert text box string

            blk.tb(n).w = len(blk.tb(n).t)*8   'adjust tb width to fit string length
            posX = posX + len(blk.tb(n).t)
            n = n + 1  'next text box
                    
        else
                    
            newString = newString + char
            posX = posX + 1
                    
        end if
                
    next p
            
    if newString = "" then newString = "0"
            
    blk.w = len(newString)*8+8  'adjust block width to fit new string
            
    line (blk.x,blk.y)-(blk.x+blk.w,blk.y+blk.h),blk.c1,bf
            
    line (blk.x,blk.y)-(blk.x+blk.w,blk.y+blk.h),rgb(0,0,0),b                    
            
    'border numbers in blocks
    if n>0 then
        for j as integer = 0 to n-1
            if blk.tb(j).w = 0 then blk.tb(j).w = 8
            line (blk.x + blk.tb(j).x                  , blk.y+2)- _
                (blk.x + blk.tb(j).x + blk.tb(j).w, blk.y+blk.h-2),rgb(180,180,250),bf

        next j
    end if
            
    draw string (blk.x+2,blk.y+6),newString,rgb(255,255,255)
            
    'draw cursor
    if txtID<>-1 and blk.a = 1 then
        line (blk.x+blk.tb(txtID).x+blk.tb(txtID).cursor*8, blk.y+4)- _
                (blk.x+blk.tb(txtID).x+blk.tb(txtID).cursor*8+1, blk.y + blk.h-4),rgb(20,20,10),bf
    end if 
end sub

sub drawTemplates()
    for i as integer = 0 to NUMBLKS
        drawBlock(blk(i))
    next i
end sub

sub drawBlocks()
    if totBlks>0 then
        for i as integer = 0 to totBlks-1  'for each block
            if i=blkID then blks(i).a = 1 else blks(i).a = 0
            drawBlock(blks(i))           
        next i
    end if
end sub

'sorts blocks according to the position on the y axis
sub sortBlocks()
    dim as integer sFlag,py
    py = 50
    if totBlks>1 then
        while sFlag = 0
            sFlag = 1
            for i as integer = 0 to totBlks-2
                if blks(i).y > blks(i+1).y then
                    swap blks(i),blks(i+1)
                    sFlag = 0
                end if
            next i
        wend
    end if
    
    if totBlks>0 then
        'place into position
        for i as integer = 0 to totBlks-1
            blks(i).x = BORDER + 50
            blks(i).y = py
            py = py + 24
        next i
    end if
    
end sub

sub update()
    screenlock
    cls
    line (BORDER,0)-(BORDER,SCRH-1),rgb(0,0,0)
    drawTemplates()
    drawBlocks()
    screenunlock
end sub

dim as string strKey,key
dim as integer ascKey

do
    getmouse mx,my,,mb
    
    if mb = 1 then

        txtID = -1       
        blkID = -1
        
        'is button selected?
        for i as integer = 0 to NUMBLKS
            if  mx>blk(i).x _
            and mx<blk(i).x + blk(i).w _
            and my>blk(i).y _
            and my<blk(i).y + blk(i).h then
                blkID = i       'selected block type
            end if 
        next i
        
        if blkID<>-1 then 'create a block
            
            blks(totBlks)=blk(blkID) ' creat a clone

            totBlks=totBlks+1
            
            'move block
            update()
            ox = mx
            oy = my
            while mb=1
                getmouse mx,my,,mb
                if mx<>ox or my<>oy then 'it has moved
                    dx = mx-ox
                    dy = my-oy
                    blks(totBlks-1).x = blks(totBlks-1).x + dx
                    blks(totBlks-1).y = blks(totBlks-1).y + dy
                    ox = mx
                    oy = my
                end if
                update()
                sleep 2              
            wend
            if blks(totBlks-1).x < BORDER then
                totBlks = totBlks-1  'erase it
            end if
        end if

        if totBlks>0 then
            for i as integer = 0 to totBlks-1  'for each block
             
                if  mx>blks(i).x _
                and mx<blks(i).x + blks(i).w _
                and my>blks(i).y _
                and my<blks(i).y + blks(i).h then
                    blkID = i       'selected block
                end if

                         
                if blkID <> -1 then 'which if any text box
                    for j as integer = 0 to NUMTB  'for each text box
                        if  mx > blks(i).x + blks(i).tb(j).x _
                        and mx < blks(i).x + blks(i).tb(j).x + blks(i).tb(j).w _
                        and my > blks(i).y + blks(i).tb(j).y _
                        and my < blks(i).y + blks(i).tb(j).y + blks(i).tb(j).h then
                            txtID = j       'selected text box
                        end if
                    next j
                end if
            
            next i
        
            if blkID <> -1 then  'it is selected
                update()
                ox = mx
                oy = my
                while mb=1
                    getmouse mx,my,,mb
                    if mx<>ox or my<>oy then 'it has moved
                        dx = mx-ox
                        dy = my-oy
                        blks(blkID).x = blks(blkID).x + dx
                        blks(blkID).y = blks(blkID).y + dy
                        ox = mx
                        oy = my
                    end if
                    update()
                    sleep 2              
                wend
            if blks(blkID).x < BORDER + 50 then
                blks(blkID).x = BORDER + 50
            end if
            end if 'blks(blkID) selected

        end if 'totBlks>0
        sortBlocks()
    end if 'mouse button down
    
    'handle text input
    if txtID<>-1 and blkID <> -1 then
        editText(blks(blkID).tb(txtID))
    end if  'if text box active
    
    update()
    sleep 2
    
loop until multikey(&H01)

data " WAIT  *  SECONDS"
data " MOVE  *  STEPS"
data " TURN RIGHT  *  DEGREES"
data " TURN LEFT   *  DEGREES"
data " GO TO x: *  y: *  "
data " GLIDE TO x: *  y: * "
data " CHANGE x BY  * "
data " CHANGE y BY  * "
Last edited by BasicCoder2 on Sep 04, 2017 20:20, edited 1 time in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Making a Scratch like IDE

Post by D.J.Peters »

Not bad at this early stage.

Joshy
Post Reply