Run Mainwin Code in a Graphics Window with Color Plus...

[B+]

Yes we can do LOCATE, PRINT, CLS, Plus INPUT!!!  with some modification and limits along with COLOR, INKEY$ modifications...



'Mainscreen Commands for Graphics Window.txt for JB B+ 2019-10-12

' PLUS Color!!! Plus the print is a little bigger for us older folks.

'  Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr

'Then you can use these command substitutes for the graphics window:
'  locate = call locateG characterColumn, characterRow
'   print = call printG text$ '(strings only)
'   input = call inputG prompt$, variable$ '(string variable only)
'   color = call colorG fore$, back$ 'takes only string arguments
'           for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15
'     cls = call clsG 'clears to last colorG fore$, back$ used
' PLUS inkee$ is a global variable you have access to use like QB inkey$

' finish your code section with a wait command

call setup "Testing 1, 2, 3... Main Window Commands for Graphic Windows", 1200, 720 '100 x 30? characters check
for y = 1 to 30
   rc$ = rndColor$()
   while rc$ = "black"
       rc$ = rndColor$()
   wend
   call colorG rc$, "black"
   for x = 1 to 100
       call locateG x, y: call printG str$(x mod 10)
   next
next
call pause 5000
call colorG "white", "black"
call clsG
call colorG "DarkBlue", "Yellow"
call printG "Hello World"
call colorG "Yellow", "DarkBlue"
call printG "How are you?"
call pause 2500
call colorG "lightgray", "Black"
call clsG
for i = 1 to 30
   cnt = cnt + 2
   call locateG cnt, i
   call printG str$(i)
next
call printG "Let's do a little code translation."
call pause 5000

while 1
   scan
   call colorG QBcolr$(14), QBcolr$(4)
   call clsG
   rn = int(rnd(0) * 100) + 1
   do
       call colorG QBcolr$(14), QBcolr$(4)
       call inputG "(q to quit) Guess my number from 1 to 100 ", guess$
       if guess$ = "q" then call quit h$
       g = val(guess$)
       if g > 0 and g < 101 then
           if g < rn then
               call colorG QBcolr$(13), QBcolr$(4)
               call printG " That guess was too low."
           end if
           if g > rn then
               call colorG QBcolr$(9), QBcolr$(4)
               call printG " That guess was too high."
           end if
       end if
   loop until g = rn
   call colorG QBcolr$(15), QBcolr$(4)
   call printG " That guess was just right!"
   call printG " "
   call printG " Press y for yes if you want to play again... any other to quit"
   inkee$ = "" : k$ = ""  'clear old values
   do
       scan
       k$ = inkee$
   loop until len(k$)
   if k$ <> "y" then call quit h$
wend

wait ' end code input section ==========================

' Copy Paste these Procedures so you can do a graphics setup

'  Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr
'Then use you can use these command substitutes for the graphics window:
'  locate = call locateG characterColumn, characterRow
'   print = call printG text$ '(strings only)
'   input = call inputG prompt$, variable$ '(string variable only)
'   color = call colorG fore$, back$ 'takes only string arguments
'           for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15
'     cls = call clsG 'clears to last colorG fore$, back$ used
' PLUS inkee$ is a global variable you have access to use like QB inkey$

' finish your code section with a wait command

'setup graphics window with specified title$, width and height with handle #gr, AKA h$
sub setup title$, wWidth, wHeight
   global xmax, ymax  'screen width and height
   xmax = wWidth : ymax = wHeight  '<<<<<< set this as you need or from plug-in notes

   global cellW, cellH
   'do not mess with cellW and cellH globals for printing
   cellW = 12 'pixels wide for characters
   cellH = 24 'pixels high for characters

   global maxRow, maxCol
   'and then these are calculated from above globals
   maxCol = int(xmax / cellW)  'these control printing characters
   maxRow = int(ymax / cellH)

   global lastC, lastR 'for LocateG (locate), printG (print a line), lp (locate and print)
   lastC = 1 : lastR = 1

   'key events update globals with latest info
   global inkee$, h$

   h$ = "#gr"

   global wFG$, wBG$
   wFG$ = "white" : wBG$ = "black"

   nomainwin

   WindowWidth = xmax + 8
   WindowHeight = ymax + 32
   UpperLeftX = (DisplayWidth-WindowWidth) / 2
   UpperLeftY = (DisplayHeight-WindowHeight) / 2

   open title$ for graphics_nsb_nf as #gr
   #gr "trapclose quit"

   'fonts that don't work arial, tahoma, verdana
   '#gr "font arial ";cellW;" ";cellH
   '#gr "font dejavu_sans_mono ";cellW;" ";cellH

   'fonts that work
   '#gr "font courier_new ";cellW;" ";cellH
   #gr "font consolas ";cellW;" ";cellH

   '#gr "home"                  '< check drawing area
   '#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
   'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

   #gr "setfocus"
   #gr "when characterInput charIn"
   #gr "down"
   call colorG "white", "black"
   call clsG
end sub

sub printG mess$ 'print (with "line feed") for graphics window
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub clsG  'cls for graphics window
   #gr "fill ";wBG$
   lastC = 1 : lastR = 1
end sub

sub colorG fore$, back$ 'set color fore and back to color string names, see QBcolr$ function
   wFG$ = fore$ : wBG$ = back$
   #gr "color ";wFG$
   #gr "backcolor ";wBG$
end sub

sub locateG x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub inputG prmpt$, byref var$   'input for a graphics screen
   'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

function QBcolr$(colrNum)
   select case colrNum
   case 0   : QBcolr$ = "black"
   case 1   : QBcolr$ = "darkblue"
   case 2   : QBcolr$ = "brown"
   case 3   : QBcolr$ = "darkcyan"
   case 4   : QBcolr$ = "darkred"
   case 5   : QBcolr$ = "darkpink"
   case 6   : QBcolr$ = "darkgreen"
   case 7   : QBcolr$ = "lightgray"
   case 8   : QBcolr$ = "darkgray"
   case 9   : QBcolr$ = "blue"
   case 10  : QBcolr$ = "green"
   case 11  : QBcolr$ = "cyan"
   case 12  : QBcolr$ = "red"
   case 13  : QBcolr$ = "pink"
   case 14  : QBcolr$ = "yellow"
   case 15  : QBcolr$ = "white"
   end select
end function

function rndColor$()
   rndColor$ = QBcolr$( int( rnd(0) * 16) )
end function

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol - len(cpText$))/2 + 1.5), y, cpText$
   lastC = 1 : lastR = y + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

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

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub



[tsh73]

Really nice.
InputG is really cool
*saved for future use*

[B+]

tsh for you a bonus! Flipping Bits translated from QB to demo the Mainwin procedures PLUS color! 

' Flipping Bits.txt for JB v2.0 B+ 2019-10-12
' try direct translation from QB64 code

Global cellsPerSide, legalMoves$, startB$, currentB$, targetB$, moveCount, backc$
Global maxCol  '<< for some reason this is not visible to the restart sub without being declared again here

call setup "Rosetta Code - Flipping Bits", 900, 600
backc$ = "black"
call restart
DO
   call clsG 'display current board and target
   call colorG "blue", backc$
   call showBoard 2, 2, currentB$, "Current:"
   call colorG "red", backc$
   call showBoard 2, 2 + 2 * cellsPerSide + 6, targetB$, "Target:"
   call colorG QBcolr$(13), backc$
   call locateG 1, cellsPerSide + 4
   call printG " Number of moves taken so far is " + str$(moveCount)
   call colorG "yellow", backc$
   IF currentB$ = targetB$ THEN
       call printG " Congratulations, done in " + str$(moveCount) + " moves."
       call printG " "
       call inputG " Enter y for yes, if you want to start over ", yes$
       IF yes$ = "y" THEN call restart ELSE nomore = -1
   ELSE 'get next move
       m$ = " ": call printG " "
       WHILE INSTR(legalMoves$, m$) = 0 OR m$ = "0" OR m$ = "q"
           call inputG " Enter a lettered column or a numbered row to flip (0 or q, quits) ", m$
           IF m$ = "0" OR m$ = "q" THEN call quit h$
           IF m$ = "" THEN m$ = " "
       WEND
       'handle move results
       IF m$ <> "0" AND m$ <> "q" THEN moveCount = moveCount + 1: call makeMove m$
   END IF
LOOP UNTIL nomore
call quit h$
wait ' end code input section ==========================

SUB restart

   'debug try this commenting out Global maxCol at start of code
   'notice "maxCol = "+str$(maxCol)  '<<<<<<<<< maxCol was made Global in the setup SUB
                                    '>>>>>>>>> it can be read from main code and other subs
                                    '>>>>>>>>> but not here, unless I make it Global in main.

   cellsPerSide = 0: legalMoves$ = "": moveCount = 0
   call colorG "white", backc$
   call clsG
   call colorG QBcolr$(9), backc$
   call cp 3, "Flipping Bits Game:"
   call colorG QBcolr$(5), backc$
   call cp 5, "You will presented with a square board marked Current and"
   call cp 6, "another marked Target. The object of the game is to match"
   call cp 7, "the Current board to Target in the least amount of moves."
   call cp 9, "To make a move, enter a letter for a column to flip or"
   call cp 10, "a digit for a row to flip. In a flip, all 1's are"
   call cp 11, "changed to 0's and all 0's changed to 1's."
   call cp 13, "You may enter 0 or q at any time to quit."
   call cp 15, "I'd say good luck but this is about skill! :)"
   call printG " "
   irow = 16
   call colorG "yellow", backc$
   WHILE cellsPerSide < 2 OR cellsPerSide > 9
       irow = irow + 1
       s$ = "Please enter how many cells you want per side 2 to 9 "
       call locateG (maxCol - len(s$) - 3)/2, irow
       call inputG s$, in$
       IF in$ = "0" OR in$ = "q" THEN call quit h$ ELSE cellsPerSide = VAL(in$)
   WEND
   FOR i = 1 TO cellsPerSide: legalMoves$ = legalMoves$ + CHR$(96 + i): NEXT
   FOR i = 1 TO cellsPerSide: legalMoves$ = legalMoves$ + STR$(i): NEXT
   startB$ = startBoard$(): currentB$ = startB$: targetB$ = makeTarget$(): currentB$ = startB$
END SUB

FUNCTION startBoard$()
   FOR i = 1 TO cellsPerSide ^ 2: r$ = r$ + str$(INT(RND(0) * 2)): NEXT
   startBoard$ = r$
END FUNCTION

SUB showBoard row, col, board$, title$
   call lp col, row - 1, title$
   FOR i = 1 TO cellsPerSide
       call lp col + 2 * (i - 1) + 3, row, MID$(legalMoves$, i, 1)
   NEXT
   FOR i = 1 TO cellsPerSide
       call lp col - 1, row + i, STR$(i)
       FOR j = 1 TO cellsPerSide
           call lp col + 2 * j, row + i, " " + MID$(board$, (i - 1) * cellsPerSide + j, 1)
       NEXT
   NEXT
END SUB

SUB makeMove move$
   ac = ASC(move$)
   IF ac > 96 THEN 'letter
       col = ac - 96
       FOR i = 1 TO cellsPerSide
           bit$ = MID$(currentB$, (i - 1) * cellsPerSide + col, 1)
           IF bit$ = "0" THEN
               'MID$(currentB$, (i - 1) * cellsPerSide + col, 1) = "1"
               call mid currentB$, (i - 1) * cellsPerSide + col, 1, "1"
           ELSE
               'MID$(currentB$, (i - 1) * cellsPerSide + col, 1) = "0"
               call mid currentB$, (i - 1) * cellsPerSide + col, 1, "0"
           END IF
       NEXT
   ELSE 'number
       row = ac - 48
       FOR i = 1 TO cellsPerSide
           bit$ = MID$(currentB$, (row - 1) * cellsPerSide + i, 1)
           IF bit$ = "0" THEN
               'MID$(currentB$, (row - 1) * cellsPerSide + i, 1) = "1"
               call mid currentB$, (row - 1) * cellsPerSide + i, 1, "1"
           ELSE
               'MID$(currentB$, (row - 1) * cellsPerSide + i, 1) = "0"
               call mid currentB$, (row - 1) * cellsPerSide + i, 1, "0"
           END IF
       NEXT
   END IF
END SUB

FUNCTION makeTarget$()
   WHILE currentB$ = startB$
       FOR i = 1 TO cellsPerSide * cellsPerSide
           m$ = MID$(legalMoves$, INT(RND(0) * LEN(legalMoves$)) + 1, 1)
           call makeMove m$
       NEXT
   WEND
   makeTarget$ = currentB$
END FUNCTION

sub mid byref s$, position, length, new$
   s$ = mid$(s$, 1, position -1) + mid$(new$, 1, length) + mid$(s$, position + length)
end sub

'=================================================================== (195 lines)

' Copy Paste these Procedures so you can do a graphics setup

'  Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr
'Then use you can use these command substitutes for the graphics window:
'  locate = call locateG characterColumn, characterRow
'   print = call printG text$ '(strings only)
'   input = call inputG prompt$, variable$ '(string variable only)
'   color = call colorG fore$, back$ 'takes only string arguments
'           for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15
'     cls = call clsG 'clears to last colorG fore$, back$ used
' PLUS inkee$ is a global variable you have access to use like QB inkey$

' finish your code section with a wait command

'setup graphics window with specified title$, width and height with handle #gr, AKA h$
sub setup title$, wWidth, wHeight
   global xmax, ymax  'screen width and height
   xmax = wWidth : ymax = wHeight  '<<<<<< set this as you need or from plug-in notes

   global cellW, cellH
   'do not mess with cellW and cellH globals for printing
   cellW = 12 'pixels wide for characters
   cellH = 24 'pixels high for characters

   global maxRow, maxCol
   'and then these are calculated from above globals
   maxCol = int(xmax / cellW)  'these control printing characters
   maxRow = int(ymax / cellH)

   global lastC, lastR 'for LocateG (locate), printG (print a line), lp (locate and print)
   lastC = 1 : lastR = 1

   'key events update globals with latest info
   global inkee$, h$

   h$ = "#gr"

   global wFG$, wBG$
   wFG$ = "white" : wBG$ = "black"

   nomainwin

   WindowWidth = xmax + 8
   WindowHeight = ymax + 32
   UpperLeftX = (DisplayWidth-WindowWidth) / 2
   UpperLeftY = (DisplayHeight-WindowHeight) / 2

   open title$ for graphics_nsb_nf as #gr
   #gr "trapclose quit"

   'fonts that don't work arial, tahoma, verdana
   '#gr "font arial ";cellW;" ";cellH
   '#gr "font dejavu_sans_mono ";cellW;" ";cellH

   'fonts that work
   '#gr "font courier_new ";cellW;" ";cellH
   #gr "font consolas ";cellW;" ";cellH

   '#gr "home"                  '< check drawing area
   '#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
   'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

   #gr "setfocus"
   #gr "when characterInput charIn"
   #gr "down"
   call colorG "white", "black"
   call clsG
end sub

sub printG mess$ 'print (with "line feed") for graphics window
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub clsG  'cls for graphics window
   #gr "fill ";wBG$
   lastC = 1 : lastR = 1
end sub

sub colorG fore$, back$ 'set color fore and back to color string names, see QBcolr$ function
   wFG$ = fore$ : wBG$ = back$
   #gr "color ";wFG$
   #gr "backcolor ";wBG$
end sub

sub locateG x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub inputG prmpt$, byref var$   'input for a graphics screen
   'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

function QBcolr$(colrNum)
   select case colrNum
   case 0   : QBcolr$ = "black"
   case 1   : QBcolr$ = "darkblue"
   case 2   : QBcolr$ = "brown"
   case 3   : QBcolr$ = "darkcyan"
   case 4   : QBcolr$ = "darkred"
   case 5   : QBcolr$ = "darkpink"
   case 6   : QBcolr$ = "darkgreen"
   case 7   : QBcolr$ = "lightgray"
   case 8   : QBcolr$ = "darkgray"
   case 9   : QBcolr$ = "blue"
   case 10  : QBcolr$ = "green"
   case 11  : QBcolr$ = "cyan"
   case 12  : QBcolr$ = "red"
   case 13  : QBcolr$ = "pink"
   case 14  : QBcolr$ = "yellow"
   case 15  : QBcolr$ = "white"
   end select
end function

function rndColor$()
   rndColor$ = QBcolr$( int( rnd(0) * 16) )
end function

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y, cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol - len(cpText$))/2 + 1.5), y, cpText$
   lastC = 1 : lastR = y + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

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

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub  'dang 331 lines!



Attachments:

[tsh73]

Hello B+
Thanks for the game. It illustrate your library nicely, though in this case GUI would apparently be better
I added a but to your library, here:


'Mainscreen Commands for Graphics Window.txt for JB B+ 2019-10-12
'working on library by tsh73
' +scroll
' +print without line feed (printGm)
' +Ctrl-V in inputG

'issue: if inputG gets too righth of screen, it doesnt't wrap
' - won't fix

Global maxCol  '<< for some reason this is not visible to the restart sub without being declared again here
Global inkee$  'same issue apparently

call setup "Some new functionality", 900, 600

call printG "0. Changed code for window size"

call printG "   to 'call ajustWindow xmax, ymax'"
call printG "   'ymax + 32' just won't cut then interface set to 125%"
call printG " "

call inputG "1. printG scrolls if out of lines (press  Enter)", dummy$

for i = 1 to 30
call printG i;"1234567890qwertyu"
next

call printG "(1)"
call printG " "

call printG "2. Added printGm that is printG without LineFeed"
call inputG "   and it scrolls too (press  Enter)", dummy$

call printGm "It's a "
for i = 1 to 20
call printGm "long long long "
next
call printGm "line!"

call printG "(2)"
call printG " "

call inputG  "3. Now after inputG scrolls too (press  Enter)", dummy$

call inputG "Input something", var$
call printG " Got >" + var$ + "<."

call printG "(3)"
call printG " "

call printG "4. and inputG supports Ctrl-V"
call inputG "   (CR LF converted to space) (press  Enter)", dummy$

call inputG "Prerss Ctrl-V to paste", var$
call printG " Got >" + var$ + "<."

call printG "(4)"
call printG " "

call printG "*demo is over*"

wait
'=================================================================== (195 lines)

' Copy Paste these Procedures so you can do a graphics setup

'  Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr
'Then use you can use these command substitutes for the graphics window:
'  locate = call locateG characterColumn, characterRow
'   print = call printG text$ '(strings only)
'   input = call inputG prompt$, variable$ '(string variable only)
'   color = call colorG fore$, back$ 'takes only string arguments
'           for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15
'     cls = call clsG 'clears to last colorG fore$, back$ used
' PLUS inkee$ is a global variable you have access to use like QB inkey$

' finish your code section with a wait command

'setup graphics window with specified title$, width and height with handle #gr, AKA h$
sub setup title$, wWidth, wHeight
   global xmax, ymax  'screen width and height
   xmax = wWidth : ymax = wHeight  '<<<<<< set this as you need or from plug-in notes

   global cellW, cellH
   'do not mess with cellW and cellH globals for printing
   cellW = 12 'pixels wide for characters
   cellH = 24 'pixels high for characters

   global maxRow, maxCol
   'and then these are calculated from above globals
   maxCol = int(xmax / cellW)  'these control printing characters
   maxRow = int(ymax / cellH)

   global lastC, lastR 'for LocateG (locate), printG (print a line), lp (locate and print)
   lastC = 1 : lastR = 1

   'key events update globals with latest info
   global inkee$, h$

   h$ = "#gr"

   global wFG$, wBG$
   wFG$ = "white" : wBG$ = "black"

   nomainwin

   'WindowWidth = xmax + 8
   'WindowHeight = ymax + 32
   call ajustWindow xmax, ymax
   UpperLeftX = (DisplayWidth-WindowWidth) / 2
   UpperLeftY = (DisplayHeight-WindowHeight) / 2

   open title$ for graphics_nsb_nf as #gr
   #gr "trapclose quit"

   'fonts that don't work arial, tahoma, verdana
   '#gr "font arial ";cellW;" ";cellH
   '#gr "font dejavu_sans_mono ";cellW;" ";cellH

   'fonts that work
   '#gr "font courier_new ";cellW;" ";cellH
   #gr "font consolas ";cellW;" ";cellH

   '#gr "home"                  '< check drawing area
   '#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
   'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

   #gr "setfocus"
   #gr "when characterInput charIn"
   #gr "down"
   call colorG "white", "black"
   call clsG
end sub

sub printG mess$ 'print (with "line feed") for graphics window
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       'if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then
       CALL scroll
       lastR = maxRow 'yuck!
   end if
end sub

sub printGm mess$ 'printG minus "line feed"
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       'if lastR <> startR then exit for
   next
'    lastC = 1
'    lastR = startR + 1
   if lastR > maxRow then
       CALL scroll
       lastR = maxRow 'yuck!
   end if
end sub

sub clsG  'cls for graphics window
   #gr "fill ";wBG$
   lastC = 1 : lastR = 1
end sub

sub colorG fore$, back$ 'set color fore and back to color string names, see QBcolr$ function
   wFG$ = fore$ : wBG$ = back$
   #gr "color ";wFG$
   #gr "backcolor ";wBG$
end sub

sub locateG x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub inputG prmpt$, byref var$   'input for a graphics screen
   'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   OK$ = OK$+ chr$(22)    'Ctrl-V
   do
       scan
       if instr(OK$, inkee$) then
           select case inkee$
           case Chr$(8)
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           case Chr$(13)
               exit do
           case Chr$(27)
               'new D5, I was expecting nothing in return for my esc
               if inkee$ = chr$(27) then t$ = ""
               exit do
           case Chr$(22)  'Ctrl-V
               open "aux clip window" for text as #clipText
                   #clipText "!paste"
                   #clipText "!contents? value$"
               close #clipText
print "1>";showCtrlChars$(value$);"<"
if right$(value$,2)=chr$(13)+chr$(10) then value$=left$(value$,len(value$)-2)
               call replaceAll value$, chr$(10), ""
               call replaceAll value$, chr$(13), " "
               t$=t$;value$
           case else
               t$=t$;inkee$
           end select
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
   if lastR > maxRow then
       CALL scroll
       lastR = maxRow
   end if
end sub

function QBcolr$(colrNum)
   select case colrNum
   case 0   : QBcolr$ = "black"
   case 1   : QBcolr$ = "darkblue"
   case 2   : QBcolr$ = "brown"
   case 3   : QBcolr$ = "darkcyan"
   case 4   : QBcolr$ = "darkred"
   case 5   : QBcolr$ = "darkpink"
   case 6   : QBcolr$ = "darkgreen"
   case 7   : QBcolr$ = "lightgray"
   case 8   : QBcolr$ = "darkgray"
   case 9   : QBcolr$ = "blue"
   case 10  : QBcolr$ = "green"
   case 11  : QBcolr$ = "cyan"
   case 12  : QBcolr$ = "red"
   case 13  : QBcolr$ = "pink"
   case 14  : QBcolr$ = "yellow"
   case 15  : QBcolr$ = "white"
   end select
end function

function rndColor$()
   rndColor$ = QBcolr$( int( rnd(0) * 16) )
end function

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
'        if lastR > maxRow then lastR = maxRow 'yuck!
       if lastR > maxRow then
           CALL scroll
           lastR = maxRow 'yuck!
       end if
   end if
end sub

sub cp y, cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol - len(cpText$))/2 + 1.5), y, cpText$
   lastC = 1 : lastR = y + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

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

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub  

'---------------------------
sub scroll
   #gr "getbmp bmp 0 ";cellH;" ";xmax;" ";maxRow *cellH
#gr "discard"
   #gr "drawbmp bmp 0 0"
   #gr "place ";0;" ";(maxRow-1) *cellH

   #gr "color ";wBG$    'backcolor
   #gr "boxfilled ";xmax;" "; ymax
   #gr "color ";wFG$    'reset to fore color
end sub

'-------------------------------------------------
sub ajustWindow desiredWidth, desiredHeight
   UpperLeftX = 20
   UpperLeftY = 20
   WindowWidth = 200   '100 seems to be too much - works different
   WindowHeight = 100
   MENU #gr, "dummy"
   open "Ajusting..." for graphics_nsb_nf as #gr
'   graphics
'   graphics_nsb
'   graphics_nsb_nf

   #gr, "home ; down ; posxy x y"
   'x, y give us width, height
   width = 2*x : height = 2*y
   close #gr

   slackX = 200-width
   slackY = 100-height

   WindowWidth = desiredWidth + slackX
   WindowHeight = desiredHeight + slackY
end sub

sub replaceAll byRef workSring$, ChangeFrom$, ChangeTo$
   p = 1
   p =  instr(workSring$, ChangeFrom$, p)
   while p <> 0
       workSring$ = left$( workSring$, p-1 ) + ChangeTo$ +  mid$( workSring$, p+len(ChangeFrom$) )
       p = p+len(ChangeTo$)
       if p>len(workSring$) then exit while
       p =  instr(workSring$, ChangeFrom$, p)
   wend
end sub

function showCtrlChars$(a$)
res$=""
for i = 1 to len(a$)
c$=mid$(a$,i,1)
if asc(c$)<32 then
c$="[";asc(c$);"]"
end if
res$=res$+c$
showCtrlChars$=res$
next
end function



[B+]

Oh look what I found!

Hey tsh73! That scrolling is great! and Ctrl+V means I can paste into inputG that should be handy. Also printGm, what does m stand for? Well a print without line feed was surely needed.

Really love the scrolling!

[tsh73]

Also printGm, what does m stand for?

I was just out of ideas. So something like "Modified"

[B+]

Uh-oh! I am having 2nd thoughts on scrolling.

The whole point of these commands is to have control over what gets printed where in the window, as soon as screen scrolls all that locating is lost.

Try this in modified code:

call setup "Testing 1, 2, 3... Main Window Commands for Graphic Windows", 1200, 720 '100 x 30? characters check
for y = 1 to 30
   rc$ = rndColor$()
   while rc$ = "black"
       rc$ = rndColor$()
   wend
   call colorG rc$, "black"
   for x = 1 to 100
       call locateG x, y: call printGm str$(x mod 10)
   next
next
call pause 5000
wait




It should fill the screen exactly with 100 x 30 digits 0123456789... repeat
Why does it scroll if PrintGm has no line feed?

Uh-oh! Hey, the lp sub (locate and print) might need a no line feed mod too! It prints one character at a time to insure all characters are located in designated screen cells. The printG command works through that sub and also the inputG.

Maybe F and NF initials could be used for Feed and No Feed for print and lp subs. If the print text runs off screen in NF fine! that can be fixed by better planning of screen layout.

Also lastR and lastC are misnamed, should be nextR and nextC.

It just plain depends on the application whether scrolling is beneficial or a hassle. So maybe a scroll on-off toggle to keep our options open.

[tsh73]

The whole point of these commands is to have control over what gets printed where in the window, as soon as screen scrolls all that locating is lost.

Really, no.

I would say "it depends".
And one man "whole point" could be quite different.
(In Russia we say "in taster and color, all crayons are different", which is a corruption of "tastes differ", but it sounds funny and everybody understands the point)

sub lp as of now has ability to line wrap, and so scrolling code just for line to wrap.

Maybe F and NF initials could be used for Feed and No Feed for print and lp subs.

on some languages, there is Write and WriteLine - without linefeed and with one.
But again, in BASIC "print" normally do line wrap.
(and on one other language "printf" just mean "print function" - or so I've been told )

It just plain depends on the application whether scrolling is beneficial or a hassle. So maybe a scroll on-off toggle to keep our options open.

as they say
+100500
EDIT I'm afraid that might be Russian mem as well. Meaning "Over 9000" "VOTING WITH BOTH HANDS" or something