Liberty BASIC Community Forum
« Object Creation Suite MASKS and BMPs:improved »

Welcome Guest. Please Login or Register.
Jan 22nd, 2018, 6:08pm


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Object Creation Suite MASKS and BMPs:improved  (Read 349 times)
michael
Team Liberty BASIC


member is offline

Avatar




PM


Posts: 111
xx Object Creation Suite MASKS and BMPs:improved
« Thread started on: Mar 1st, 2016, 11:03am »

Anyone is welcome to modify this program to make it work with APIs

Its function is to assist making detailed objects for games and allows you to make BMPs with Masks.

Without the blitter it wont function properly for long.

Code:


 dim info$(10,10)
dim rli(45,45)
dim gli(45,45)
dim bli(45,45)
dim fileline$(45)
global corr
global updown$
global lx
global ly
global mousx
global mousy
global r
global g
global b
global plx
global ply
r=0
g=0
b=0
bmpbutton #h.red, "bmp\redbttn.bmp",redclicked, UR,10,10
 bmpbutton #h.blue, "bmp\bluebttn.bmp",blueclicked , UR, 10,130
 bmpbutton #h.green, "bmp\grnbttn.bmp",greenclicked, UR, 10,70
 bmpbutton #h.mred, "bmp\blank5.bmp",mredclicked, UR, 10,40
 bmpbutton #h.mblue, "bmp\blank4.bmp",mblueclicked, UR, 10,160
 bmpbutton #h.mgreen, "bmp\blank3.bmp",mgreenclicked, UR, 10,100
 bmpbutton #h.all, "bmp\grphbttn.bmp",allclicked, UR, 100,160
 bmpbutton #h.2minusall, "bmp\sqrbttn.bmp",minusallclicked, UR, 130, 160
call screen 800,800' Generic screen with graphics box to fit ( I may redesign)
'*******************************place graphics bellow here use #h.1 for draw device
updown$="down"
mousx=22
mousy=22


[refresh]
lx=mousx*10
ly=mousy*10
plx=lx:ply=ly
 #h.2 "place ";lx;" ";ly;";down;color green;size 1;circle 6"
 #h.2 "place 680 80"
 #h.2 "color white"
 #h.2 "ellipse 115 115"
#h.2 "down;color white;size 1;line 460 0 460 460"
#h.1 "size 20;color ";r;" ";g;" ";b;";set ";130;" ";80
#h.1 "size 1;place 100 10;down;backcolor black;color white;\ location ";mousx;" ";mousy;" RGB ";r;" ";g;" ";b;"                     Press ( w s a d ) to move draw *****"
#h.1 "color green;backcolor black;place 100 30;down;\ pen is ";updown$;"**Press 1-UP  2-DOWN**              ( P-save L-load M-MaskBmp N-SaveBmp)"
#h.1 "color red;backcolor black;place 100 45;down;\ Any color bellow 30 is white part of mask.     Make sure you save your project often"
#h.2 "size 1;color green;place 655 40;\ Mouse"
#h.2 "place 650 60;\ SCRATCH"
#h.2 "place 630 80;\       HERE"
#h.2 "place 630 100;\    Left Button"
#h.2 "place 640 120;\    or Right"
#h.1 "place 140 75;color yellow;\ SaveBmp- A BMP.bmp  (rename your files after you are done immediately so you dont overwrite)"
#h.1 "color pink;place 140 90;\ Mask- A NEW MASK.bmp * Save/Load File- A Basicdatafile.bas"
#h.1 "color blue;line 46 0 46 46;line 0 46 46 46"
#h.1 "when rightButtonMove lesscolor"
#h.1 "when leftButtonMove morecolor"
#h.2 "when rightButtonMove lesscolor"
#h.2 "when leftButtonMove morecolor"
#h.2 "setfocus;place 10 20"
   #h.2 "when characterInput [inp]"
   #h.1 "setfocus;place 10 20"
   #h.1 "when characterInput [inp]"
[back]

'^^^^^^^^^^^^^^^^^^^^^^Put graphics and game stuff above^^^^^^^^^^^^^^^^
wait
[quit]
 close #h
 end
sub redrawscreen
#h.2 "cls"
#h.1 "cls"
poz=0
while bottom< 46
lx=poz*10
ly=bottom*10
nr=rli(poz,bottom):ng=gli(poz,bottom):nb=bli(poz,bottom)

#h.2 "place ";lx;" ";ly;";";updown$;";color ";nr;" ";ng;" ";nb;";size 10;set ";lx;" ";ly
#h.1 "";updown$;";size 1;color ";nr;" ";ng;" ";nb;";set ";poz;" ";bottom
 poz=poz+1
if poz> 45 then poz= 0:bottom=bottom+1
wend
end sub
sub allclicked bttnHandle$
 r=r+5
 g=g+5
 b=b+5
 if r>255 then r=0
 if g>255 then g=0
 if b>255 then b=0
 call mixedcolor
 end sub
 sub minusallclicked bttnHandle$
 r=r-5
 g=g-5
 b=b-5
 if r < 0 then r=255
 if g < 0 then g=255
 if b < 0 then b=255
 call mixedcolor
 end sub
 sub redclicked bttnHandle$
 r=r+5
 if r > 255 then r=0
 call mixedcolor
 end sub
 sub blueclicked bttnHandle$
 b=b+5
 if b > 255 then b=0
 call mixedcolor
 end sub
 sub greenclicked bttnHandle$
 g=g+5
 if g >255 then g=0
 call mixedcolor
 end sub
 sub mgreenclicked bttnHandle$
 g=g-5
 if g<0 then g=255
 call mixedcolor
 end sub
 sub mblueclicked bttnHandle$
 b=b-5
 if b<0 then b=255
 call mixedcolor
 end sub
 sub mredclicked bttnHandle$
 r=r-5
 if r<0 then r=255
 call mixedcolor
 end sub
sub mixedcolor
 #h.2 "flush"
 #h.2 "place 680 80"
 #h.2 "down"
 rgb$= str$(r)+" "+str$(g)+" "+str$(b)
 #h.2 "color ";r;" ";g;" ";b
 #h.2 "backcolor "; rgb$
 #h.2 "ellipsefilled 100 100"
 #h.2 "place 470 10;color white;backcolor black;\The colors are ";r;" ";g;" ";b;"***"
 if corr=0 and updown$="down" then rli(mousx,mousy)=r:gli(mousx,mousy)=g:bli(mousx,mousy)=b
 #h.2 "flush"
end sub
[savebmp]
  print #h.1, "flush"
   print #h.1, "getbmp ABMP 0 0 45 45"
   bmpsave "ABMP", "A Bmp.bmp"
goto [back]
[mask]
#h.2 "backcolor black;fill black;cls"
bottom=0
poz=0'
while bottom< 46
r=rli(poz,bottom)
g=gli(poz,bottom)
b=bli(poz,bottom)
nr=rli(poz,bottom)
ng=gli(poz,bottom)
nb=bli(poz,bottom)
if r<20 and g<20 and b<20 then #h.2 "color white;set ";poz;" ";bottom
if r>19 or g>19 or b>19 then #h.2 "color black;set ";poz;" ";bottom
#h.2 "color ";nr;" ";ng;" ";nb;";set ";poz;" ";bottom+46
poz=poz+1
if poz> 45 then poz= 0:bottom=bottom+1
wend
 print #h.1, "getbmp ABMP 0 0 45 45"
 print #h.2, "drawbmp ABMP 0 46"
   print #h.2, "flush"
   print #h.2, "getbmp ABMP 0 0 45 90"
   bmpsave "ABMP", "A NEW MASK.bmp"
goto [refresh]
[loadit]
#h.1 "backcolor black;fill black;cls"
#h.2 "backcolor black;fill black;cls"
gfile$="A Notbasic.bas"
bottom=0
poz=0'temporary variable for increment for array
if fileExists(DefaultDir$, "A Notbasic.bas") then
open gfile$ for input as #fil
'while eof(#fil) > -1'refrence in case need
while bottom< 46
input #fil, thestring
 rli(poz,bottom)=thestring
 nr=thestring
input #fil, thestring
gli(pos,bottom)=thestring
ng=thestring
input #fil, thestring
bli(pos,bottom)=thestring
nb=thestring
lx=poz*10
ly=bottom*10
#h.2 "place ";lx;" ";ly;";";updown$;";color ";nr;" ";ng;" ";nb;";size 10;set ";lx;" ";ly
#h.1 "";updown$;";size 1;color ";nr;" ";ng;" ";nb;";set ";poz;" ";bottom
 poz=poz+1
if poz> 45 then poz= 0:bottom=bottom+1
wend
close #fil
else
fexists$=""
end if
goto [refresh]
end
function fileExists(path$, filename$)
   'dimension the array info$( at the beginning of your program
   files path$, filename$, info$()
   fileExists = val(info$(0, 0)) 'non zero is true
 end function
[saveit]
gfile$="A Notbasic.bas"
bottom=0
poz=0'  temporary variable for increment for array
open gfile$ for output as #fil
while bottom< 46
thestring= rli(poz,bottom)
print #fil, thestring
thestring= gli(poz,bottom)
print #fil, thestring
thestring= bli(poz,bottom)
print #fil, thestring
poz=poz+1
if poz> 45 then poz= 0:bottom=bottom+1
wend
close #fil
goto [back]
end

 ' Generic screen
sub screen x,y
nomainwin
WindowWidth=x
WindowHeight=y
UpperLeftX=1
UpperLeftY=1
graphicbox #h.1, 0,460,800,800
graphicbox #h.2, 0,0,860,470
open "SUPER SHADE...THE DEPTH PROJECT" for window_nf as #h
print #h, "trapclose [quit]"
#h.1 "backcolor black;fill black;cls"
#h.1 "color white"' default color if no color has been chosen
#h.2 "backcolor black;fill black;cls"
#h.2 "color white"'
end sub
sub lesscolor handle$, x,y
if x>630 and x<730 and y>30 and y<130 then
r=r-1
g=g-1
b=b-1
if r<0 then r=0
if g<0 then g=0
if b<0 then b=0
#h.1 "size 20;color ";r;" ";g;" ";b;";set ";130;" ";80
#h.1 "place 100 10;down;backcolor black;color white;\ location ";mousx;" ";mousy;" RGB ";r;" ";g;" ";b;"****":call mixedcolor
#h.2 "place ";lx;" ";ly;";";updown$;";color ";r;" ";g;" ";b;";size 10;set ";lx;" ";ly
if corr=0 and updown$="down" then rli(mousx,mousy)=r:gli(mousx,mousy)=g:bli(mousx,mousy)=b
end if
end sub
sub morecolor handle$, x,y
if x>630 and x<730 and y>30 and y<130 then
r=r+1
g=g+1
b=b+1
if r>254 then r=254
if g>254 then g=254
if b>254 then b=254
#h.1 "down;size 20;color ";r;" ";g;" ";b;";set ";130;" ";80
#h.1 "place 100 10;down;backcolor black;color white;\ location ";mousx;" ";mousy;" RGB ";r;" ";g;" ";b;"****":call mixedcolor
#h.2 "place ";lx;" ";ly;";";updown$;";color ";r;" ";g;" ";b;";size 10;set ";lx;" ";ly
if corr=0 and updown$="down" then rli(mousx,mousy)=r:gli(mousx,mousy)=g:bli(mousx,mousy)=b
end if
if x>-1 and x<460 and y>-1 and y<460 then
lx=int(x/10)*10
ly=int(y/10)*10
mousx=int(x/10)
mousy=int(y/10)
if mousx>45 then mousx=45
if mousy>45 then mousy=45
#h.2 "place ";lx;" ";ly;";";updown$;";color ";r;" ";g;" ";b;";size 10;set ";lx;" ";ly
#h.2 "place ";plx;" ";ply;";down;color black;size 1;circle 6"
#h.2 "place ";lx;" ";ly;";down;color green;size 1;circle 6":plx=lx:ply=ly
if updown$="down" then #h.1 "";updown$;";size 1;color ";r;" ";g;" ";b;";set ";mousx;" ";mousy
#h.1 "size 1;place 100 10;down;backcolor black;color white;\ location ";mousx;" ";mousy;" RGB ";r;" ";g;" ";b;"****":call mixedcolor
#h.1 "color white;backcolor black;place 100 30;down;\ pen is ";updown$;"**Press 1-UP  2-DOWN****"
if corr=0 and updown$="down" then rli(mousx,mousy)=r:gli(mousx,mousy)=g:bli(mousx,mousy)=b
corr=0
end if
end sub
[inp]
 ch$ = Inkey$
 if ch$="w" then mousy=mousy-1
 if ch$="s" then mousy=mousy+1
 if ch$="d" then mousx=mousx+1
 if ch$="a" then mousx=mousx-1
 if ch$="1" then updown$="up"
 if ch$="2" then updown$="down"
 if ch$="p" then [saveit]
 if ch$="l" then [loadit]
 if ch$="n" then [savebmp]
 if ch$="m" then [mask]
if mousx<0 then mousx=0:corr=1
if mousy<0 then mousy=0:corr=1
if mousx>45 then mousx=45:corr=1
if mousy>45 then mousy=45:corr=1
lx=mousx*10
ly=mousy*10
#h.2 "place ";lx;" ";ly;";";updown$;";color ";r;" ";g;" ";b;";size 10;set ";lx;" ";ly
#h.2 "place ";plx;" ";ply;";down;color black;size 1;circle 6"
#h.2 "place ";lx;" ";ly;";down;color green;size 1;circle 6":plx=lx:ply=ly

if updown$="down" then #h.1 "";updown$;";size 1;color ";r;" ";g;" ";b;";set ";mousx;" ";mousy
#h.1 "size 1;place 100 10;down;backcolor black;color white;\ location ";mousx;" ";mousy;" RGB ";r;" ";g;" ";b;"****":call mixedcolor
#h.1 "color white;backcolor black;place 100 30;down;\ pen is ";updown$;"**Press 1-UP  2-DOWN****"
if corr=0 and updown$="down" then rli(mousx,mousy)=r:gli(mousx,mousy)=g:bli(mousx,mousy)=b
corr=0
countdown=countdown+1
if countdown> 30 then countdown=0:call redrawscreen
goto [refresh]




 
« Last Edit: Mar 3rd, 2016, 11:01pm by michael » User IP Logged

I like making program generators and reinventing the wheel.. I never make mistakes.. Not ever.. (lie)
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls