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 * "