LB Booster
Programming >> BASIC code examples >> draw it : sprites
http://lbb.conforums.com/index.cgi?board=code&action=display&num=1440409217
draw it : sprites
Post by bluatigro on Aug 24th, 2015, 09:40am

i rebuild draw it so you can draw your sprites yourself

WARNING :
- ONLY DRAW IN THE BLACK ARREA

ideas on inprovement and/or expansion are welkome
Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
global mode , pixel , lijn , ellipse , box
global ellipsefill , boxfill , ox , oy , nx , ny
global file$ , size , winx , winy , color$ , backolor$
global sprx , spry
winx = WindowWidth
winy = WindowHeight
menu #m , "file" _
        , "new" , [new] _
        , "open" , [open] _
        , "save" , [save] _
        , "save as" , [saveAs] _
        ,|, "exit" , [quit]
menu #m , "tools" _
        , "pixel" , [pixel] _
        , "line" , [line] _
        , "ellipse" , [ellipse] _
        , "ellipse fill" , [ellipsefill] _
        , "box" , [box] _
        , "box fill" , [boxfill] _
        ,|, "size" , [size] _
        ,|, "color" , [color] _
        , "backcolor" , [backcolor]
size = 1
pixel = 1
lijn = 2
ellipse = 3
ellipsefill = 4
box = 5
boxfill = 6
color$ = "black"
backcolor$ = "yellow"
mode = pixel
open "draw it 1.0" for graphics as #m
  #m "trapclose [quit]"
  #m "when mouseMove [move]"
  #m "when leftButtonDown [leftdown]"
  #m "when leftButtonMove [leftmove]"
  #m "when leftButtonUp [leftup]"
  #m "setfocus"
wait
[move]
  nx = MouseX
  ny = MouseY
wait
[leftmove]
  nx = MouseX
  ny = MouseY
  #m "rule " ; _R2_NOTXORPEN
  #m "color white"
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case else
      #m "rule " ; _R2_COPYPEN
      #m "color " ; color$ 
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
  end select
wait
sub Pause ms
  t = time$( "milliseconds" )
  while time$( "milliseconds" ) < t + ms
  wend
end sub
[leftdown]
  ox = MouseX
  oy = MouseY
wait
[leftup]
  #m "rule " ; _R2_COPYPEN
  #m "size " ; size
  select case mode
    case lijn
      #m "color black" 
      #m "down"
      #m "line " ; ox ; " " ; oy - spry _
      ; " " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "color black" 
      #m "goto " ; ( ox + nx ) / 2 _
      ; " " ; ( oy + ny ) / 2 - spry
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "color black"
      #m "backcolor black"
      #m "goto " ; ( ox + nx ) / 2 _
      ; " " ; ( oy + ny ) / 2 - spry
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "color black" 
      #m "goto " ; ox ; " " ; oy - spry
      #m "down"
      #m "box " ; nx ; " " ; ny - spry
      #m "up"      
      #m "color " ; color$
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "color black" 
      #m "backcolor black"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"      
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"
    case else
  end select
wait
[pixel]
  mode = pixel
wait
[line]
  mode = lijn
wait
[ellipse]
  mode = ellipse
wait
[ellipsefill]
  mode = ellipsefill
wait
[box]
  mode = box
wait
[boxfill]
  mode = boxfill
wait
[size]
  s$ = str$( size )
  prompt "size = " ; s$
  size = val( s$ )
wait
[color]
  colordialog color$ ; color$
wait
[backcolor]
  colordialog backcolor$ ; backcolor$
wait
[new]
  file$ = DefaultDir$ + "\unnamed.bmp"
  #m "fill white"
[x]
  prompt "X size ?" ; x$
  sprx = val( x$ )
  if sprx > winx then goto [x]
[y]
  prompt "Y size ?" ; y$
  spry = val( y$ )
  if spry > winy / 2 then goto [y]
  #m "goto " ; 0 ; " " ; spry + 1
  #m "color black"
  #m "backcolor black"
  #m "down"
  #m "boxfilled " ; spry ; " " ; spry * 2
  #m "up"
wait
[open]
  filedialog "open bmp" , "*.bmp" , file$
  loadbmp "drawing" , file$
  #m "background drawing"
wait
[saveAs]
  filedialog "save bmp" , "*.bmp" , file$
[save]
  #m "getbmp drawing 0 0 " ; sprx ; " " ; spry * 2
  bmpsave "drawing" , file$ + ".bmp"
wait
[quit]
  close #m
end
Re: draw it : sprites
Post by bluatigro on Aug 24th, 2015, 12:22pm

update :
- remove added
Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
global mode , pixel , lijn , ellipse , box , remove
global ellipsefill , boxfill , ox , oy , nx , ny
global file$ , size , winx , winy , color$ , backolor$
global sprx , spry
winx = WindowWidth
winy = WindowHeight
sprx = 64
spry = 64
menu #m , "file" _
        , "new" , [new] _
        , "open" , [open] _
        , "save" , [save] _
        , "save as" , [saveAs] _
        ,|, "exit" , [quit]
menu #m , "tools" _
        , "pixel" , [pixel] _
        , "line" , [line] _
        , "ellipse" , [ellipse] _
        , "ellipse fill" , [ellipsefill] _
        , "box" , [box] _
        , "box fill" , [boxfill] _
        , "remove" , [remove] _
        ,|, "size" , [size] _
        ,|, "color" , [color] _
        , "backcolor" , [backcolor]
size = 1
pixel = 1
lijn = 2
ellipse = 3
ellipsefill = 4
box = 5
boxfill = 6
remove = 7
color$ = "black"
backcolor$ = "yellow"
mode = pixel
open "draw it sprite" for graphics as #m
  #m "trapclose [quit]"
  #m "when mouseMove [move]"
  #m "when leftButtonDown [leftdown]"
  #m "when leftButtonMove [leftmove]"
  #m "when leftButtonUp [leftup]"
  #m "setfocus"
wait
[move]
  nx = MouseX
  ny = MouseY
wait
[leftmove]
  nx = MouseX
  ny = MouseY
  #m "rule " ; _R2_NOTXORPEN
  #m "color white"
  #m "size 1"
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case pixel
      #m "rule " ; _R2_COPYPEN
      #m "color black"
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny - spry
      #m "down"
      #m "set " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$ 
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
     case else ''remove
      #m "rule " ; _R2_COPYPEN
      #m "color white"
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny - spry
      #m "down"
      #m "set " ; nx ; " " ; ny - spry
      #m "up"
      #m "color black"
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
  end select
wait
sub Pause ms
  t = time$( "milliseconds" )
  while time$( "milliseconds" ) < t + ms
  wend
end sub
[leftdown]
  ox = MouseX
  oy = MouseY
wait
[leftup]
  #m "rule " ; _R2_COPYPEN
  #m "size " ; size
  select case mode
    case lijn
      #m "color black" 
      #m "down"
      #m "line " ; ox ; " " ; oy - spry _
      ; " " ; nx ; " " ; ny - spry
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "color black" 
      #m "goto " ; ( ox + nx ) / 2 _
      ; " " ; ( oy + ny ) / 2 - spry
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "color black"
      #m "backcolor black"
      #m "goto " ; ( ox + nx ) / 2 _
      ; " " ; ( oy + ny ) / 2 - spry
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "color black" 
      #m "goto " ; ox ; " " ; oy - spry
      #m "down"
      #m "box " ; nx ; " " ; ny - spry
      #m "up"      
      #m "color " ; color$
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "color black" 
      #m "backcolor black"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"      
      #m "color " ; color$
      #m "backcolor " ; backcolor$
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"
    case else
  end select
wait
[pixel]
  mode = pixel
wait
[line]
  mode = lijn
wait
[ellipse]
  mode = ellipse
wait
[ellipsefill]
  mode = ellipsefill
wait
[box]
  mode = box
wait
[boxfill]
  mode = boxfill
wait
[remove]
  mode = remove
wait
[size]
  s$ = str$( size )
  prompt "size = " ; s$
  size = val( s$ )
wait
[color]
  colordialog color$ , color$
wait
[backcolor]
  colordialog backcolor$ , backcolor$
wait
[new]
  file$ = DefaultDir$ + "\unnamed.bmp"
  #m "fill white"
[x]
  x$ = str$( sprx )
  prompt "X size ?" ; x$
  sprx = val( x$ )
  if sprx > winx then goto [x]
[y]
  y$ = str$( spry )
  prompt "Y size ?" ; y$
  spry = val( y$ )
  if spry > winy / 2 then goto [y]
  #m "goto " ; 0 ; " " ; spry + 1
  #m "color black"
  #m "backcolor black"
  #m "down"
  #m "boxfilled " ; spry ; " " ; spry * 2
  #m "up"
wait
[open]
  filedialog "open bmp" , "*.bmp" , file$
  loadbmp "drawing" , file$
  #m "background drawing"
wait
[saveAs]
  filedialog "save bmp" , "*.bmp" , file$
[save]
  #m "getbmp drawing 0 0 " ; sprx ; " " ; spry * 2
  bmpsave "drawing" , file$ + ".bmp"
wait
[quit]
  close #m
end