JB Tile Maker 2
#1
Code:
'Tile Maker 2.txt for JB v 2.0 by B+ 2018-04-14
'Edit #1 2018-04-08 add a prompt to name the current PATTERN$ and
'                   print it out in the main window.
'Edit #2 2018-04-08 remove busy, and as per tsh73: fix typo, start in drawMode,
'                   add refresh? OK, redraw whole tile on each click and a bunch of flush-ing!
'                   Added color z for zero either grey (or transparent in future app?)
'                   Changed digits key-presses to prompt for n so can grid up to 16 x 16 tile.
'Edit #3 2018-04-14 Add e for erase so that drawMode does not clear pattern

global  H$, XMAX, YMAX, N, CX$, DRAWING, PATTERN$
H$ = "gr"
XMAX = 600  '< actual drawing space needed
YMAX = 600  '< actual drawing space needed
N = 15
CX$ = "r" 'red
DRAWING = 0
'Celtic$
PATTERN$ = "wwwkwkwwwkwkwwwwwwwwwwwwwwwwwwwwwkwkrrrkwkwwwkwkwwwrwrwwwkwkwwwwyyryyyywwwwkwkwywrwrwy"
PATTERN$ = PATTERN$ + "wkwkwwbbybbbrbbbbwwwwbwywrwrwywbwwwwbbbbrbbbybbwwkwkwywrwrwywkwkwwwwyyyyryywwwwkw"
PATTERN$ = PATTERN$ + "kwwwrwrwwwkwkwwwkwkrrrkwkwwwwwwwwwwwwwwwwwwwwwkwkwwwkwkwww"


WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 300
UpperLeftY = 40

open "   Tile Maker 2018-04-14 for JB v2 by B+ " for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonDown lBD"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"
call help
call drawMode
wait

'=================================================== window control procedures

sub lBD H$, x, y  'mouse left click
   if DRAWING then  ' in drawing mode, set by pressin d

       'which square does click translate to?
       sq = 600 / N
       col = int(x / sq)
       row = int(y / sq)

       'update our PATTERN$ with new color in letter position
       letterPosition = row * N + col + 1
       PATTERN$ = mid$(PATTERN$, 1, letterPosition - 1);CX$;mid$(PATTERN$, letterPosition + 1)

       'refresh entire screen which comes in handy if window minimised
       call NxNTile 0, 0, PATTERN$, 600

       'redraw our drawing grid
       call hue 255, 255, 255
       for y = 0 to 600 step sq
           for x = 0 to 600 step sq
               call box x, y, x + sq, y + sq
           next
       next
       #gr "flush"
   end if
end sub

sub charIn H$, k$
   if k$ = "h" then call help      'get update of instructions or current N, CX$, PATTERN$
   if k$ = "d" then call drawMode  'setup Tile Maker screen
   if k$ = "e" then call erase
   if k$ = "t" then call tile      'display tiling
   if instr( "rbgoyvcwkz", k$) then CX$ = k$
   if k$ = "n" then
       oldN = N
       [tryAgain]
       prompt "Enter the Number of squares per tile side (2 to 16)."; N
       N = int(N)
       if N = 0 then N = oldN 'in case of Cancel
       if N < 2 or N > 16 then goto [tryAgain]
       call erase
   end if
   if k$ = "s" then
       N = 4 : PATTERN$ = "kkwkwwwkkwwwkwkk" : DRAWING = 0
       call tile
   end if
   if k$ = "p" then
       prompt "Enter PATTERN$ name";patternName$
       if patternName$ <> "" then
           if right$(patternName$, 1) <> "$" then patternName$ = patternName$;"$"
           print patternName$;" = ";chr$(34);PATTERN$;chr$(34)
       end if
   end if
   if k$ = "q" then call quit H$
end sub

sub quit Hdl$
   close #Hdl$
   end
end sub

' =========================================================== Help and 2 Main modes
' Tile Maker Help Dialog explains everything:
' color keys, squares per side ( = N ) keys, main mode keys, sample, help and quit keys
' Also can see: the current color setting, N, and the current PATTERN$ string
sub help
   nl$ = chr$(13)
         ns$ = space$(50) + "Tile Maker 2: Keys Help" + nl$ + nl$
   ns$ = ns$ + space$(15) + "Two Modes:" + nl$
   ns$ = ns$ + "d = Drawing mode" + nl$
   ns$ = ns$ + "t = Tiling display, shows screen tiling at shrinking sizes" + nl$ + nl$
   ns$ = ns$ + space$(15) + "Keys to 10 Colors:" + nl$
   ns$ = ns$ + "r = red"    + nl$
   ns$ = ns$ + "g = green"  + nl$
   ns$ = ns$ + "b = blue"   + nl$
   ns$ = ns$ + "o = orange" + nl$
   ns$ = ns$ + "y = yellow" + nl$
   ns$ = ns$ + "v = violet" + nl$
   ns$ = ns$ + "c = cyan"   + nl$
   ns$ = ns$ + "w = white"  + nl$
   ns$ = ns$ + "k = black"  + nl$
   ns$ = ns$ + "z = grey or transparent depending on application."  + nl$ + nl$
   ns$ = ns$ + space$(15) + "Keys to other functions:" + nl$
   ns$ = ns$ + "n = Number of squares per side (erases also)" + nl$
   ns$ = ns$ + "s = Sample: shows tsh73's B&W 4x4 Tile" + nl$
   ns$ = ns$ + "e = Erase drawing and pattern$ (N remains same)" + nl$
   ns$ = ns$ + "h = Help (this dialog)" + nl$
   ns$ = ns$ + "p = Prompt to name and Print PATTERN$ in mainwin" + nl$
   ns$ = ns$ + "q = Quit" + nl$ + nl$
   ns$ = ns$ + "Current N number of squares per side: " + str$(N) + nl$ + nl$
   ns$ = ns$ + "Current Color Key: " + CX$ + nl$ +nl$
   ns$ = ns$ + "Current Color PATTERN$: " + PATTERN$ + nl$ + nl$
   ns$ = ns$ + "DO NOT PRESS or CLICK SCREEN UNTIL t for Tile MODE or s for Sample STOPS RUNNING!"+ nl$ + nl$ + nl$
   ns$ = ns$ + space$(50) + "OK?"
   notice ns$
end sub

'================================= 2 main modes d for draw or  t for tile

sub tile
   DRAWING = 0
   side = 600
   while side > N * 2
       scan
       for y = 0 to 600 step side
           for x = 0 to 600 step side
               scan
               call NxNTile x, y, PATTERN$, side
           next
       next
       #gr "flush"
       if side = 600 then call pause 1000 else call pause 500
       side = side - 20
   wend
end sub

sub drawMode  'setup
   DRAWING = 1
   #gr "fill black"
   sq = 600 / N
   call NxNTile 0, 0, PATTERN$, 600
   call hue 255, 255, 255
   for y = 0 to 600 step sq
       for x = 0 to 600 step sq
           call box x, y, x + sq, y + sq
       next
   next
   #gr "flush"
end sub

sub erase
   DRAWING = 1
   #gr "fill black"
   PATTERN$ = ""
   for i = 1 to N * N
       PATTERN$ = PATTERN$ + "k"
   next
   sq = 600 / N
   CX$ = "w"
   call hue 255, 255, 255
   for y = 0 to 600 step sq
       for x = 0 to 600 step sq
           call box x, y, x + sq, y + sq
       next
   next
   #gr "flush"
end sub
'====================================== drawing procedures

sub hue r, g, b 'fore and back
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub box x0,y0,x1,y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1
end sub

sub fbox x0,y0,x1,y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1;" ";y1
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

sub NxNTile x, y, pattern$, side
   sq = side / N
   for oy =  0 to N-1
       for ox = 0 to N-1
           colr$ = mid$(pattern$, oy * N + ox + 1, 1)
           if instr("rbgoyvcwkz", colr$) then
               select case colr$
               case "r" : call hue 255, 0, 0
               case "b" : call hue 0, 0, 255
               case "g" : call hue 0, 160, 0
               case "o" : call hue 255, 110, 0
               case "y" : call hue 255, 255, 0
               case "v" : call hue 255, 0, 255
               case "c" : call hue 0, 196, 196
               case "w" : call hue 255, 255, 255
               case "k" : call hue 0, 0, 0
               case "z" : call hue 128, 128, 128  'just for this app for future app transparent
               end select
               call fbox x + ox * sq, y + oy * sq, x + ox * sq + sq, y + oy * sq + sq
           end if
       next
   next
end sub

http://justbasiccom.proboards.com/thread...le-pattern
The challenge was to duplicate a patten of black and white squares.


Here is the string pattern for the B&W tile: PATTERN$ = "kkwkwwwkkwwwkwkk"
k = BlacK and w = White

I ended up creating a tile editor program from which you could create a string pattern of colored squares that you could use like a sprite or for tiling.


Attached Files Thumbnail(s)

B += x
Reply
#2
@Bplus,

What is JB? Is it another programming language that I should make a new category for?
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#3
Hi Walter,

JB is Just Basic 
http://qb64.thejoyfulprogrammer.com/show...1411442165

JB has it's own well established forum but alas, is fading like the rest of BASIC's, which is ironic as Carl Gundel finally got around to releasing 2.0 with improved Help system specially for Windows 10 folks.

I don't think it needs it's own board:
1. because I've not seen anyone take an interest here
2. some say (like Aurel) that JB is just a trainer for Liberty Basic which is NOT free and there is some truth to that.
B += x
Reply