Page 1 of 1

Input box library

Posted: Wed Aug 27, 2014 3:18 am
by sneepy

Code: Select all

'{/lib/taps.txt} uses the taps library, embedded at the end of this file
tp 'init tap
bxtestall


/*
message box, input box, and generic box utilities.
indebted to henko, who wrote message box first.

MSGBOX(text$) makes a text box and an ok button
INBOX$(prompt$) makes an input box, returns the input
INBOXOK() returns 1 if inbox ended with the ok button, 0 for cancel
HIDEINTERFACE() hides all the visible buttons, switches, lists, fields, and sliders so
they don't cover up the boxes
RESTOREINTERFACE() shows them again

BOX(text$, parameters$) takes text and fits it into a box
parameters$ containing as many of the following commands as you wish
MIN HEIGHT H
MAX HEIGHT H
MIN WIDTH W
MAX WIDTH W
BACKGROUND R G B
TEXT R G B
FONT F$
FONT SIZE S
ASPECT A 'suggested w/h ratio, but may be overridden by min/max w and h
XPOS X  (The upper left corner is 1,1)
XPOS LEFT (or CENTER or RIGHT)
YPOS Y
YPOS TOP (or CENTER or BOTTOM)

BOXX, BOXY, BOXW, and BOXH return the location and dimensions of the box
*/


'parse supplied parameters to override defaults. parameters to establish are min and
'max height and width, colors, fonts, aspect ratio, location
'make first estimate of sizes
'parse it and try it
'check for problems: doesn't fit, fits but wrong aspect, fits by breaking words
'if no problem break
'change a parameter: line count, line length, font
'fixes - more lines same aspect, more lines, more width, break into pages
'goto parse it and try it
'
'make the sprite

def box(text$, param$)
bxboxstart:
bx 'setup
bxparse(param$)
bxfit(text$)
bxmakesprite(text$)
end def

def bxtestall
bxtest
bxhidetest
mbtest
ibtest
end
end def

def bxhidetest
option base 1
graphics
graphics clear .9,.6,.2
draw font name "ChalkboardSE-Bold"
draw font size 30
draw text "Background with obscuring controls removed" at 50, 500
button "test" title "big button" at 550, 450 size 260,90
field "ftest" text "FIELD" at 50,480 size 100, 40
switch "stest" state 0 at 250, 580
dim m$(3)
m$(1) = "123"
m$(2) = "456"
m$(3) = "789"
list "ltest" text m$ at 150,550 size 100, 100
pause 2
hideinterface
pause 2
box("Unobscured message box. Will restore controls", "font size 50 xpos 60 ypos 480")
pause 2
restoreinterface
bxcleanup
poll:
  if touch_x(0) = -1 then poll
  bxcleanup
  button "test" delete
  field  "ftest" delete
  switch "stest" delete
  list "ltest" delete
end def

def mbtest
  input t$
  graphics
  graphics clear .8,.2,.2
  msgbox(t$)
end def

def bxtest
graphics
box("Upper right corner.", "xpos right ypos top")
pause 2
bxcleanup
box("Lower left.", "xpos left ypos bottom")
pause 2
aspectbox:
bxcleanup
box("Tall thin box in copperplate 30 point. It would be thinner if it didn't have a long word. Tip the screen. Double click when done.", "font Copperplate-Bold font size 30 aspect 0.2")
poll1:
if bxpoll$ = "redo" then aspectbox
if doubleclick then
  bxcleanup
  goto pagetest
end if
goto poll1
pagetest:
t$ = "This text is too long to fit into this box (which has size limits) so it will have to be divided into pages. Double click to move on."
  box(t$, "font didot font size 24 max height 120 max width 150 xpos center ypos center")
poll2:
if bxpoll$ = "redo" then pagetest
if doubleclick then
  bxcleanup
  return
end if
goto poll2
end def

def ibtest
graphics
t$ = "Type 'bye' to exit"
makebox:
out$ = inbox$(t$)
if inboxok then
  if lowstr$(out$) = "bye" then return
  t$ = "You typed "& out$ & ". Type 'bye' to exit"
  goto makebox
else
  t$ = "Canceled. Type 'bye' to exit"
  go to makebox
end if
end def

def bx
ob = option_base()
option base 1
spc$ = chr$(10) & chr$(11) & chr$(12) & chr$(13) & chr$(32) & chr$(133) & chr$(160) 'white space
lf$ = chr$(13)
maxh = screen_height()
minh = 10
maxw = screen_width()
sw = screen_width()
minw = 10
'couldn't figure out how to get the current font. would set it here for later restore
'save current draw color
draw pixel 1,1
get pixel 1,1 color textr0, textg0, textb0
'default olive text on light blue background
backr = .7
backg = .7
backb = 1
textr = .2
textg = .2
textb = 0
aspect = maxw/maxh
left = -1
center = -2
right = -3
top = -1
bottom = -3
x = center
y = top
originalfontsize = font_size() 
fs = originalfontsize
end def

def bxparse(p$)
/*
commands to parse:
MIN HEIGHT H
MAX HEIGHT H
MIN WIDTH W
MAX WIDTH W
BACKGROUND R G B
TEXT R G B
FONT F$
FONT SIZE S
ASPECT A
XPOS X
XPOS LEFT/CENTER/RIGHT
YPOS Y
YPOS TOP/CENTER/BOTTOM
*/
split p$ to cmd$, ncmd with bx.spc$
for i = 1 to ncmd
  c$ = lowstr$(cmd$(i))
  if c$ = "max" then 
    if i > ncmd - 2 then 
      err$ = cmd$(i) & " should be followed by 2 more terms"
      goto error
    end if
    d$ = lowstr$(cmd$(i + 1))
    if d$ = "height" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxh then
        err$ = "MAX HEIGHT is out of range"
        goto error
      end if
      bx.maxh = e
      i += 2
      continue
    end if 'height
    if d$ = "width" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxw then
        err$ = "MAX WIDTH is out of range"
        goto error
      end if
      bx.maxw = e
      i += 2
      continue
    end if 'width
  end if 'max
  if c$ = "min" then 
    if i  > ncmd - 2 then 
      err$ = cmd$(i) & " should be followed by 2 more terms"
      goto error
    end if
    d$ = lowstr$(cmd$(i + 1))
    if d$ = "height" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxh then
        err$ = "MIN HEIGHT is out of range"
        goto error
      end if
      bx.minh = e
      i += 2
      continue
    end if  'height
    if d$ = "width" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxw then
        err$ = "MIN WIDTH is out of range"
        goto error
      end if
      bx.minw = e
      i += 2
      continue
    end if 'width
  end if 'mIn
  if c$ = "background" then
    if i > ncmd - 3 then
      err$ = cmd$(i) & "should be followed by 3 numbers: r, g, b"
      goto error
    end if
    r = cmd$(i + 1)
    g = cmd$(i + 2)
    b = cmd$(i + 3)
    if r < 0 or r > 1 then 
      err$ = "BACKGROUND R is not a number between 0 and 1"
      goto error
    end if
    if g < 0 or g > 1 then 
      err$ = "BACKGROUND G is not a number between 0 and 1"
      goto error
    end if
    if b < 0 or b > 1 then 
      err$ = "BACKGROUND B is not a number between 0 and 1"
      goto error
    end if
    bx.backr = r
    bx.backg = g
    bx.backb = b
    i += 3
    continue
  end if  'background
  if c$ = "text" then
    if i > ncmd - 3 then
      err$ = cmd$(i) & "should be followed by 3 numbers: r, g, b"
      goto error
    end if
    r = cmd$(i + 1)
    g = cmd$(i + 2)
    b = cmd$(i + 3)
    if r < 0 or r > 1 then 
      err$ = "TEXT R is not a number between 0 and 1"
      goto error
    end if
    if g < 0 or g > 1 then 
      err$ = "TEXT G is not a number between 0 and 1"
      goto error
    end if
    if b < 0 or b > 1 then 
      err$ = "TEXT B is not a number between 0 and 1"
      goto error
    end if
    bx.textr = r
    bx.textg = g
    bx.textb = b
    i += 3
    continue
  end if  'text
  if c$ = "font" then
    if i = ncmd then
      err$ = cmd$(i) & " should be followed by a font name or size"
      goto error
    end if
    d$ = cmd$(i + 1)
    if lowstr$(d$) = "size" then
      if i = ncmd - 1 then
        err$ = cmd$(i) & " " & d$ & " should be followed by a number"
        goto error
      end if
      e = cmd$(i + 2)
      if e <= 0 then
        err$ = e &" is not a valid font size"
        goto error
      end if
      bx.fs = e
      draw font size bx.fs
      i += 2
      continue
    else  '  font not followed by size
      list fonts to font$, nfont
      for j = 1 to nfont
        if lowstr$(d$) = lowstr$(font$(j)) then break
      next j
      if j > nfont then
        err$ = "The font "& d$ & " does not exist"
        goto error
      end if
      draw font name d$
      i += 1
      continue
    end if  'font size vs name
  end if   'font
  if c$ = "aspect" then
    if i = ncmd then 
      err$ = cmd$(i) & " should be followed by a number"
      goto error
    end if
    d = cmd$(i + 1)
    if d <= 0 then
      err$ = cmd$(i + 1) & " is not a valid aspect ratio"
      goto error
    end if
    bx.aspect = d
    i += 1
    continue
  end if   'aspect
  if c$ = "xpos" then
    if i = ncmd then 
      err$ = cmd$(i) & " should be followed by a position"
      goto error
    end if
    d$ = cmd$(i + 1)
    e$ = lowstr$(d$)
    if e$ = "left" then
      bx.x = bx.left
      i += 1
      continue
    end if
    if e$ = "center" then
      bx.x = bx.center
      i += 1
      continue
    end if
    if e$ = "right" then
      bx.x = bx.right
      i += 1
      continue
    end if
    d = d$
    if d < 0 or d > screen_width() then
      err$ = d$ & " is not a valid value for the x position of the window"
      goto error
    end if
    bx.x = d$
    i += 1
    continue
  end if  'xpos
  if c$ = "ypos" then
    if i = ncmd then 
      err$ = cmd$(i) & " should be followed by a position"
      goto error
    end if
    d$ = cmd$(i + 1)
    e$ = lowstr$(d$)
    if e$ = "top" then
      bx.y = bx.top
      i += 1
      continue
    end if
    if e$ = "center" then
      bx.y = bx.center
      i += 1
      continue
    end if
    if e$ = "bottom" then
      bx.y = bx.bottom
      i += 1
      continue
    end if
    d = d$
    if d < 0 or d > screen_height() then
      err$ = d$ & " is not a valid value for the y position of the window"
      goto error
    end if
    bx.y = d$
    i += 1
    continue
  end if  'ypos
  'command fell through unrecognized
  err$ = cmd$(i) & " is not a recognized parameter of box()"
  goto error
next i
return
error:
text
print "Error parsing parameters for box. "; err$
end
end def

def bxfit(txt$)
' messy algorithm to fit the text into a box within the h and  w params, 
'treating the aspect ratio as a suggestion. bx.breaks is the array of starting
'characters in txt$

'check for words so long that the minimum width needs increasing
'guess the number of lines needed
'    if less than the minimum, make it the minimum
'    if more than the maximum, maximize the width, and try it anyway
'guess the width based on the lines
'    if less than the minimum, make it the minimum
'    if greater than the maximum, make it the maximum
'try it - parse it to fit and count the lines
'if lines <= guess, return
'(else lines > guess)
'if lines > max
'    if width = max, paginate
'    else let width = max, try it
'else lines are > guess but <= max
'    if width = max, return
'    else width is < max
'         if lines = guess + 1, return
'         else guess++, guess the width

i = 1
lentxt = len(txt$)
bx.npages = 1

longwordcheck:
for j = i to lentxt
  if instr(bx.spc$, substr$(txt$, j, j)) = - 1 then
    'j is next non-space
    break
  end if
next j
i = j   ' i is either the start of a word or > len txt$
for k = i to lentxt
  if instr(bx.spc$, substr$(txt$, k, k)) <> -1 then break
next k
'k is one past the end of word
if i <= lentxt then
  l = text_width(substr$(txt$, i, k - 1))
  bx.minw = max(l, bx.minw)
  bx.minw = min(bx.minw, bx.maxw)
  i = k
  if i <= lentxt then longwordcheck
end if

lineguess:
bx.textw = text_width(trim$(txt$))
bx.texth = text_height(txt$)
maxlines = floor(bx.maxh/bx.texth)
'this equation, without the ceil, is the solution if lines were floats instead of
'integers, and if we didn't have to break the message into words
guesslines = ceil(sqr(bx.textw /bx.texth/bx.aspect))
guesslines = max(guesslines, floor(bx.minh/bx.texth))
if guesslines > maxlines then
  guesslines = maxlines
  bx.w = bx.maxw
  goto tryit
end if

widthguess:
bx.w = ceil(bx.texth * guesslines * bx.aspect)
bx.w = max(bx.w, bx.minw)
bx.w = min(bx.w, bx.maxw)

tryit:
break$ = ""
i = 1
while i <= lentxt
  'trim white space
  for j = i to lentxt
    if substr$(txt$, j, j) = bx.lf$ then
      i = j
      goto saveline
    end if
    if instr(bx.spc$, substr$(txt$, j, j)) = -1 then
      i = j
      break j
    end if
  next j
  if j = lentxt + 1 then break 'remaining characters are all space
  'i is the start of a line, make j the end
  'j is either the end of the whole text, or the last text character before 
  'the last space character before the start of the next line
  for j = i to lentxt
    if substr$(txt$, j, j) = bx.lf$ then saveline
    if text_width(substr$(txt$, i, j)) > bx.w then break j
  next j
  if j > lentxt then 
    'last line. Trim spaces
    for k = j - 1 to i step -1
      if instr(bx.spc$, substr$(txt$, k, k)) = -1 then break k
    next k
    j = k
    goto saveline
  end if
  'j is now one char beyond what fits. Look left for spaces, then for text
  for k = j to i step -1
    if instr(bx.spc$, substr$(txt$, k, k)) <> -1 then break k
  next k
  if k = i - 1 then
    'single word too long to fit. Break it
    j -=1
    goto saveline
  end if
  for j = k to i step -1
    if instr(bx.spc$, substr$(txt$, j, j)) = -1 then break j
  next j
  
  saveline:
  break$ &= i & " " & j & " "
  i = j + 1
end while
split break$ to bx.index$, bx.lines with " "
bx.lines /=2
bx.h = min(bx.lines * bx.texth, bx.maxh)
bx.h = max(bx.h, bx.minh)
if bx.lines <= guesslines then return
if bx.lines > maxlines then 'it didn't fit
  if bx.w = bx.maxw then 'paginate
    bx.npages = ceil(bx.lines/maxlines)
    bx.displaypage = 1
    return
  end if
  bx.w = bx.maxw
  goto tryit
else ' it did fit
  if bx.w = bx.maxw then return
  if bx.lines = guesslines + 1 then return
  guesslines += 1
  goto widthguess 
end if
end def

def bxmakesprite(txt$)
for p = 1 to bx.npages
  sprite "bx" & p begin bx.w, bx.h
  graphics clear bx.backr, bx.backg, bx.backb
  draw color bx.textr, bx.textg, bx.textb
  j = 1 + (p - 1) * 2 * floor(bx.maxh/bx.texth)
  k = min(2 * bx.lines, p * 2 * floor(bx.maxh/bx.texth))
  l = 1
  for i = j to k step 2
    start = bx.index$(i)
    end = bx.index$(i + 1)
    draw text substr$(txt$, start, end) at 1, l
    l += bx.texth
  next i
  sprite end
  if p > 1 then
    sprite "bx1" add "bx" & p
    sprite "bx" & p delete
  end if
next p

bx.x0 = bx.x
bx.y0 = bx.y
if bx.x = bx.left then bx.x0 = 1
if bx.x = bx.center then bx.x0 = screen_width()/2 - bx.w/2
if bx.x = bx.right then bx.x0 = screen_width() - bx.w
if bx.y = bx.top then bx.y0 = 1
if bx.y = bx.center then bx.y0 = screen_height()/2 - bx.h/2
if bx.y = bx.bottom then bx.y0 = screen_height() - bx.h

sprite "bx1" at bx.x0, bx.y0
sprite "bx1" show
sprite "bx1" frame 1


sprite "bxright" begin bx.w/5, bx.h/2
graphics clear 1, 1, 1
draw color 0,0,0 
draw size bx.w/10
draw line 1,1 to bx.w/5, bx.h/4
draw line bx.w/5, bx.h/4 to 1, bx.h/2
sprite end
sprite "bxright" alpha .1
sprite "bxright" copy "bxleft"
sprite "bxright" at bx.w * .8 + bx.x0, bx.y0 + bx.h * .25
if bx.npages > 1 then sprite "bxright" show
sprite "bxleft" at bx.x0, bx.y0 + bx.h * .25
sprite "bxleft" show
sprite "bxleft" flip 1
sprite "bxleft" hide
end def

def bxpoll$()
if bx.sw <> screen_width() then 
  bxcleanup
  return "redo"
end if
tappoll
if bx.npages = 1 then return ""
if click then
  if bx.displaypage > 1 and sprite_hit("bxleft", tapx, tapy) = 1 then
    bx.displaypage -= 1
    if bx.displaypage = 1 then sprite "bxleft" hide
    if bx.displaypage = bx.npages - 1 then sprite "bxright" show
  end if
  if bx.displaypage < bx.npages and sprite_hit("bxright", tapx, tapy) = 1 then
    bx.displaypage += 1
    if bx.displaypage = 2 then sprite "bxleft" show
    if bx.displaypage = bx.npages  then sprite "bxright" hide
  end if
  sprite "bx1" frame bx.displaypage
end if
return ""
end def

def hideinterface
'when called before box(), hides the visible interface objects so they don't block it
list buttons to b$, nb
dim bv$(max(1, nb))
j = 1
for i = 1 to nb
  if button_visible(b$(i)) then
    button b$(i) hide
    bx.b$(j) = b$(i)
    j += 1
  end if
next i
bx.nb = j - 1
list fields to f$, nf
dim fv$(max(1, nf))
j = 1
for i = 1 to nf
  if field_visible(f$(i)) then
    field f$(i) hide
    bx.f$(j) = f$(i)
    j += 1
  end if
next i
bx.nf = j - 1
list lists to l$, nl
dim lv$(max(1, nl))
j = 1
for i = 1 to nl
  if list_visible(l$(i)) then
    list l$(i) hide
    bx.l$(j) = l$(i)
    j += 1
  end if
next i
bx.nl = j - 1
list switches to sw$, nsw
dim swv$(max(1, nsw))
j = 1
for i = 1 to nsw
  if switch_visible(sw$(i)) then
    switch sw$(i) hide
    bx.sw$(j) = sw$(i)
    j += 1
  end if
next i
bx.nsw = j - 1
list sliders to sl$, nsl
dim slv$(max(1, nsl))
j = 1
for i = 1 to nsl
  if slider_visible(sl$(i)) then
    slider sl$(i) hide
   bx.slv$(j) = sl$(i)
    j += 1
  end if
next i
bx.nsl = j - 1
end def

def restoreinterface
'shows the interface objects hidden by bxclearspace
for i = 1 to bx.nb
  button bx.b$(i) show
next i
for i = 1 to bx.nf
  field bx.f$(i) show
next i
for i = 1 to bx.nl
  list bx.l$(i) show
next i
for i = 1 to bx.nsw
  switch bx.sw$(i) show
next i
for i = 1 to bx.nsl
  slider bx.sl$(i) show
next i
end def

def bxcleanup
  sprite "bx1" delete
  sprite "bxleft" delete
  sprite "bxright" delete
  option base bx.ob
  draw font size bx.originalfontsize
  'would restore font here if I knew how
  draw color textr0, textg0, textb0
end def

def boxh = bx.h
def boxw = bx.w
def boxx =  bx.x0
def boxy = bx.y0

def msgbox(txt$)
graphics
mbmakebox:
lineh = text_height(txt$)
maxh = screen_height() - lineh
box(txt$, "XPOS CENTER YPOS TOP MAX HEIGHT " & maxh)
sprite "mbbutton" begin boxw, lineh
graphics clear bx.backr, bx.backg, bx.backb
sprite end
sprite "mbbutton" show
sprite "mbbutton" at boxx, boxy + boxh
button "mbok" title "OK" at boxx + boxw/4, boxy + boxh + 2 size boxw/2, lineh - 4
poll:
if bxpoll$ = "redo" then
  sprite "mbbutton" delete
  button "mbok" delete
  goto mbmakebox
end if
if button_pressed("mbok") then 
  mbcleanup
  return
end if
goto poll
end def

def mbcleanup
bxcleanup
sprite "mbbutton" delete
button "mbok" delete
end def

def inbox$(prompt$)
graphics
ibmakebox:
lineh = text_height(prompt$)
maxh = screen_height() - lineh * 2.5
box(prompt$, "MIN WIDTH 150 XPOS CENTER YPOS TOP MAX HEIGHT " & maxh)
sprite "ibcontrols" begin boxw, lineh * 2.5
graphics clear bx.backr, bx.backg, bx.backb
sprite end
sprite "ibcontrols" show
sprite "ibcontrols" at boxx, boxy + boxh
field "ibresult" at boxx + 1, boxy + boxh + 1 size boxw - 2, lineh
button "ibcan" title "CANCEL" at boxx + 1, boxy + boxh + lineh + 3 size 70, lineh
button "ibok" title "OK" at boxx + boxw - 71, boxy + boxh + lineh + 3 size 70, lineh
poll:
if bxpoll$ = "redo" then
  ibcleanup
  goto ibmakebox
end if
if button_pressed("ibok") then 
  inbox$ = field_text$("ibresult")
  ibcleanup
  bxcleanup
  ok = 1
  return
end if
if button_pressed("ibcan") then
  inbox$ = ""
  ibcleanup
  bxcleanup
  ok = 0
  return
end if
goto poll
end def

def ibcleanup
  sprite "ibcontrols" delete
  field "ibresult" delete
  button "ibcan" delete
  button "ibok" delete
end def

def inboxok = inbox$.ok

/*
higher order functions than touch(x,y) for touch interface

TAPX() and TAPY() return the coordinates of the click, double click, or start of drag
TOUCHSTART() = 1 while a touch is going on and click has not been decided - first 100ms
CLICK() = 1 if the most recent touch activity was a click, else 0
DOUBLECLICK() = 1 if the most recent touch was a double click, else 0
DRAGGING() = 1 if the ongoing touching of the screen is dragging
DRAGGED() = 1 if the most recent completed touch was dragging
DRAGENDX() and DRAGENDY() are the end of the last drag
DRAGSTARTT() and DRAGT() are the start and ongoing/end times of the drag
TAPPOLL() is the polling routine to detect the touches and follow the time. 
taps.clicktime is the duration in ms of touch after which it is a drag and not a click 
x and y are determined by the first touch. click, double click, and dragged persist until polled or the next touch starts a new event.

*/

/*
'uncomment this section to test taps
tp
graphics
graphics clear 0,0,0
draw color 1,1,.8
poll:
tappoll
if click then draw text "click" at tapx, tapy
if doubleclick then
  draw text "doubleclick" at tapx, tapy
   pause 1
  graphics clear 0,0,0
end if
if dragging then draw circle dragendx, dragendy size 3
if dragged then
  draw circle dragendx, dragendy size 8
  draw circle tapx, tapy size 8
  draw text (dragt - dragstartt)/1000 at 1,1
end if
goto poll
*/


def tp 'setup
clicktime = 100
doubleclicktime = 300
t0 = timer()
touch = 0
click = 0
nclick = 0
doubleclick = 0
dragging = 0
dragged = 0
tclick = 0
tdrag = 0
end def

def tappoll
'returns nothing
'if there is a touch
'  if it is new
'    clear click, double click, and dragged flags (but not dragging)
'    set touch flag
'    log its position and time
'  else continued touch
'    log drag position
'    if not already dragging
'      if click time expired
'        set dragging flag
'    (else nothing. continued touch and not new dragging)
'else no touch
'  if dragging
'    set dragged flag
'    clear dragging flag
'    clear touch
'    log end drag time
'  else not dragging
'    if touch was set
'      clear touch   
'      if click time exceeded
'        set dragged flag
'      else it's a click
'         if no prior click, or prior click but too long ago for a double click
'           click count = 1
'           set click,tclick
'        else it's a double click
'          reset click count,click
'          set doubleclick


get touch 0 as x,y
if x<> -1 and y <> -1 then 'there is a touch
  if tp.touch = 0 then 'new touch
    tp.click = 0
    tp.doubleclick = 0
    tp.dragged = 0
    'tp.dragging already = 0
    tp.touch = 1
    tp.t0 = timer()
    tp.x = x
    tp.y = y
  else 'continued touch
    tp.dragx = x
    tp.dragy = y
    tp.tdrag = timer()
    if tp.dragging = 0 and timer() - tp.t0 > tp.clicktime then tp.dragging = 1
  end if
else 'no touch
  if tp.dragging = 1 then
    tp.dragging = 0
    tp.dragged = 1
    tp.touch = 0
    tp.tdrag = timer()
  else
    if tp.touch = 1 then
      tp.touch = 0
      if timer() - tp.t0 > tp.clicktime then
        tp.dragged = 1
        tp.tdrag = timer()
      else 'it is the end of a click
        if tp.nclick = 0 or timer() - tp.tclick > tp.doubleclicktime then
          tp.nclick = 1
          tp.click = 1
          tp.tclick = tp.t0
        else
          tp.doubleclick =  1
          tp.click = 0
          tp.nclick = 0
        end if
      end if
    end if
  end if
end if
end def

def tapx
  tapx = tp.x
end def

def tapy
  tapy = tp.y
end def

def touchstart
  if tp.touch = 0 then return 0
  if tp.click + tp.doubleclick + tp.dragged + tp.dragging then return 0
  return 1
end def

def click
  click = tp.click
  tp.click = 0
end def

def doubleclick
  doubleclick = tp.doubleclick
  tp.doubleclick = 0
end def

def dragging
  dragging = tp.dragging
end def

def dragged
  dragged  = tp.dragged
  tp.dragged = 0
end def

def dragendx
  dragendx = tp.dragx
end def

def dragendy
  dragendy = tp.dragy
end def

def dragstartt
  dragstartt = tp.t0
end def

def dragt
  dragt = tp.tdrag
end def

Re: Input box library

Posted: Wed Aug 27, 2014 4:38 am
by Mr. Kibernetik
Cool library!
One note: demo fails to run on iPhone.

Re: Input box library

Posted: Thu Aug 28, 2014 2:01 am
by sneepy
Unfortunately, I have no iPhone, and may have to leave that debugging to others.

Re: Input box library

Posted: Tue May 10, 2016 3:43 pm
by rbytes
I thought I would also try out this code, but it quits with errors. SImilar to what happens in the next post from this contributor, I get syntax errors, first with the line click=0 in DEF tp , and then if I comment that out, the error just moves to another line. Any suggestions?

Re: Input box library

Posted: Fri Jun 16, 2017 3:28 pm
by GeorgeMcGinn
Sneepy,

I keep going from one error to the next, and even when commenting out the syntax error, eventually there will be code that has to execute it, meaining I can't leave it commented out.

Also, from what I see, I doubt you even got this to work on an iPad, let alone an iPhone.

If you are looking for others to debug your code, this is not the way to get us to help you, as code that is posted here in BASIC Programs must work. Mr. K should have known that. I know he said this is cool, but how can that be determined if it does not work.

I suspect that you have code that does execute it properly, but you may not have given it to us for some reason.

I've flagged your post as you need to provide a working copy. If you can't get it to work, at least have the courtesy of telling us what issues you are having. Then there are plenty of us who will help you out, including me.

But I am not into debugging an entire program with no idea why you can't get it to work or give us the code that executes these routines properly.

George.

sneepy wrote:
Wed Aug 27, 2014 3:18 am

Code: Select all

'{/lib/taps.txt} uses the taps library, embedded at the end of this file
tp 'init tap
bxtestall


/*
message box, input box, and generic box utilities.
indebted to henko, who wrote message box first.

MSGBOX(text$) makes a text box and an ok button
INBOX$(prompt$) makes an input box, returns the input
INBOXOK() returns 1 if inbox ended with the ok button, 0 for cancel
HIDEINTERFACE() hides all the visible buttons, switches, lists, fields, and sliders so
they don't cover up the boxes
RESTOREINTERFACE() shows them again

BOX(text$, parameters$) takes text and fits it into a box
parameters$ containing as many of the following commands as you wish
MIN HEIGHT H
MAX HEIGHT H
MIN WIDTH W
MAX WIDTH W
BACKGROUND R G B
TEXT R G B
FONT F$
FONT SIZE S
ASPECT A 'suggested w/h ratio, but may be overridden by min/max w and h
XPOS X  (The upper left corner is 1,1)
XPOS LEFT (or CENTER or RIGHT)
YPOS Y
YPOS TOP (or CENTER or BOTTOM)

BOXX, BOXY, BOXW, and BOXH return the location and dimensions of the box
*/


'parse supplied parameters to override defaults. parameters to establish are min and
'max height and width, colors, fonts, aspect ratio, location
'make first estimate of sizes
'parse it and try it
'check for problems: doesn't fit, fits but wrong aspect, fits by breaking words
'if no problem break
'change a parameter: line count, line length, font
'fixes - more lines same aspect, more lines, more width, break into pages
'goto parse it and try it
'
'make the sprite

def box(text$, param$)
bxboxstart:
bx 'setup
bxparse(param$)
bxfit(text$)
bxmakesprite(text$)
end def

def bxtestall
bxtest
bxhidetest
mbtest
ibtest
end
end def

def bxhidetest
option base 1
graphics
graphics clear .9,.6,.2
draw font name "ChalkboardSE-Bold"
draw font size 30
draw text "Background with obscuring controls removed" at 50, 500
button "test" title "big button" at 550, 450 size 260,90
field "ftest" text "FIELD" at 50,480 size 100, 40
switch "stest" state 0 at 250, 580
dim m$(3)
m$(1) = "123"
m$(2) = "456"
m$(3) = "789"
list "ltest" text m$ at 150,550 size 100, 100
pause 2
hideinterface
pause 2
box("Unobscured message box. Will restore controls", "font size 50 xpos 60 ypos 480")
pause 2
restoreinterface
bxcleanup
poll:
  if touch_x(0) = -1 then poll
  bxcleanup
  button "test" delete
  field  "ftest" delete
  switch "stest" delete
  list "ltest" delete
end def

def mbtest
  input t$
  graphics
  graphics clear .8,.2,.2
  msgbox(t$)
end def

def bxtest
graphics
box("Upper right corner.", "xpos right ypos top")
pause 2
bxcleanup
box("Lower left.", "xpos left ypos bottom")
pause 2
aspectbox:
bxcleanup
box("Tall thin box in copperplate 30 point. It would be thinner if it didn't have a long word. Tip the screen. Double click when done.", "font Copperplate-Bold font size 30 aspect 0.2")
poll1:
if bxpoll$ = "redo" then aspectbox
if doubleclick then
  bxcleanup
  goto pagetest
end if
goto poll1
pagetest:
t$ = "This text is too long to fit into this box (which has size limits) so it will have to be divided into pages. Double click to move on."
  box(t$, "font didot font size 24 max height 120 max width 150 xpos center ypos center")
poll2:
if bxpoll$ = "redo" then pagetest
if doubleclick then
  bxcleanup
  return
end if
goto poll2
end def

def ibtest
graphics
t$ = "Type 'bye' to exit"
makebox:
out$ = inbox$(t$)
if inboxok then
  if lowstr$(out$) = "bye" then return
  t$ = "You typed "& out$ & ". Type 'bye' to exit"
  goto makebox
else
  t$ = "Canceled. Type 'bye' to exit"
  go to makebox
end if
end def

def bx
ob = option_base()
option base 1
spc$ = chr$(10) & chr$(11) & chr$(12) & chr$(13) & chr$(32) & chr$(133) & chr$(160) 'white space
lf$ = chr$(13)
maxh = screen_height()
minh = 10
maxw = screen_width()
sw = screen_width()
minw = 10
'couldn't figure out how to get the current font. would set it here for later restore
'save current draw color
draw pixel 1,1
get pixel 1,1 color textr0, textg0, textb0
'default olive text on light blue background
backr = .7
backg = .7
backb = 1
textr = .2
textg = .2
textb = 0
aspect = maxw/maxh
left = -1
center = -2
right = -3
top = -1
bottom = -3
x = center
y = top
originalfontsize = font_size() 
fs = originalfontsize
end def

def bxparse(p$)
/*
commands to parse:
MIN HEIGHT H
MAX HEIGHT H
MIN WIDTH W
MAX WIDTH W
BACKGROUND R G B
TEXT R G B
FONT F$
FONT SIZE S
ASPECT A
XPOS X
XPOS LEFT/CENTER/RIGHT
YPOS Y
YPOS TOP/CENTER/BOTTOM
*/
split p$ to cmd$, ncmd with bx.spc$
for i = 1 to ncmd
  c$ = lowstr$(cmd$(i))
  if c$ = "max" then 
    if i > ncmd - 2 then 
      err$ = cmd$(i) & " should be followed by 2 more terms"
      goto error
    end if
    d$ = lowstr$(cmd$(i + 1))
    if d$ = "height" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxh then
        err$ = "MAX HEIGHT is out of range"
        goto error
      end if
      bx.maxh = e
      i += 2
      continue
    end if 'height
    if d$ = "width" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxw then
        err$ = "MAX WIDTH is out of range"
        goto error
      end if
      bx.maxw = e
      i += 2
      continue
    end if 'width
  end if 'max
  if c$ = "min" then 
    if i  > ncmd - 2 then 
      err$ = cmd$(i) & " should be followed by 2 more terms"
      goto error
    end if
    d$ = lowstr$(cmd$(i + 1))
    if d$ = "height" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxh then
        err$ = "MIN HEIGHT is out of range"
        goto error
      end if
      bx.minh = e
      i += 2
      continue
    end if  'height
    if d$ = "width" then
      e = cmd$(i + 2)
      if e <= 0 or e > bx.maxw then
        err$ = "MIN WIDTH is out of range"
        goto error
      end if
      bx.minw = e
      i += 2
      continue
    end if 'width
  end if 'mIn
  if c$ = "background" then
    if i > ncmd - 3 then
      err$ = cmd$(i) & "should be followed by 3 numbers: r, g, b"
      goto error
    end if
    r = cmd$(i + 1)
    g = cmd$(i + 2)
    b = cmd$(i + 3)
    if r < 0 or r > 1 then 
      err$ = "BACKGROUND R is not a number between 0 and 1"
      goto error
    end if
    if g < 0 or g > 1 then 
      err$ = "BACKGROUND G is not a number between 0 and 1"
      goto error
    end if
    if b < 0 or b > 1 then 
      err$ = "BACKGROUND B is not a number between 0 and 1"
      goto error
    end if
    bx.backr = r
    bx.backg = g
    bx.backb = b
    i += 3
    continue
  end if  'background
  if c$ = "text" then
    if i > ncmd - 3 then
      err$ = cmd$(i) & "should be followed by 3 numbers: r, g, b"
      goto error
    end if
    r = cmd$(i + 1)
    g = cmd$(i + 2)
    b = cmd$(i + 3)
    if r < 0 or r > 1 then 
      err$ = "TEXT R is not a number between 0 and 1"
      goto error
    end if
    if g < 0 or g > 1 then 
      err$ = "TEXT G is not a number between 0 and 1"
      goto error
    end if
    if b < 0 or b > 1 then 
      err$ = "TEXT B is not a number between 0 and 1"
      goto error
    end if
    bx.textr = r
    bx.textg = g
    bx.textb = b
    i += 3
    continue
  end if  'text
  if c$ = "font" then
    if i = ncmd then
      err$ = cmd$(i) & " should be followed by a font name or size"
      goto error
    end if
    d$ = cmd$(i + 1)
    if lowstr$(d$) = "size" then
      if i = ncmd - 1 then
        err$ = cmd$(i) & " " & d$ & " should be followed by a number"
        goto error
      end if
      e = cmd$(i + 2)
      if e <= 0 then
        err$ = e &" is not a valid font size"
        goto error
      end if
      bx.fs = e
      draw font size bx.fs
      i += 2
      continue
    else  '  font not followed by size
      list fonts to font$, nfont
      for j = 1 to nfont
        if lowstr$(d$) = lowstr$(font$(j)) then break
      next j
      if j > nfont then
        err$ = "The font "& d$ & " does not exist"
        goto error
      end if
      draw font name d$
      i += 1
      continue
    end if  'font size vs name
  end if   'font
  if c$ = "aspect" then
    if i = ncmd then 
      err$ = cmd$(i) & " should be followed by a number"
      goto error
    end if
    d = cmd$(i + 1)
    if d <= 0 then
      err$ = cmd$(i + 1) & " is not a valid aspect ratio"
      goto error
    end if
    bx.aspect = d
    i += 1
    continue
  end if   'aspect
  if c$ = "xpos" then
    if i = ncmd then 
      err$ = cmd$(i) & " should be followed by a position"
      goto error
    end if
    d$ = cmd$(i + 1)
    e$ = lowstr$(d$)
    if e$ = "left" then
      bx.x = bx.left
      i += 1
      continue
    end if
    if e$ = "center" then
      bx.x = bx.center
      i += 1
      continue
    end if
    if e$ = "right" then
      bx.x = bx.right
      i += 1
      continue
    end if
    d = d$
    if d < 0 or d > screen_width() then
      err$ = d$ & " is not a valid value for the x position of the window"
      goto error
    end if
    bx.x = d$
    i += 1
    continue
  end if  'xpos
  if c$ = "ypos" then
    if i = ncmd then 
      err$ = cmd$(i) & " should be followed by a position"
      goto error
    end if
    d$ = cmd$(i + 1)
    e$ = lowstr$(d$)
    if e$ = "top" then
      bx.y = bx.top
      i += 1
      continue
    end if
    if e$ = "center" then
      bx.y = bx.center
      i += 1
      continue
    end if
    if e$ = "bottom" then
      bx.y = bx.bottom
      i += 1
      continue
    end if
    d = d$
    if d < 0 or d > screen_height() then
      err$ = d$ & " is not a valid value for the y position of the window"
      goto error
    end if
    bx.y = d$
    i += 1
    continue
  end if  'ypos
  'command fell through unrecognized
  err$ = cmd$(i) & " is not a recognized parameter of box()"
  goto error
next i
return
error:
text
print "Error parsing parameters for box. "; err$
end
end def

def bxfit(txt$)
' messy algorithm to fit the text into a box within the h and  w params, 
'treating the aspect ratio as a suggestion. bx.breaks is the array of starting
'characters in txt$

'check for words so long that the minimum width needs increasing
'guess the number of lines needed
'    if less than the minimum, make it the minimum
'    if more than the maximum, maximize the width, and try it anyway
'guess the width based on the lines
'    if less than the minimum, make it the minimum
'    if greater than the maximum, make it the maximum
'try it - parse it to fit and count the lines
'if lines <= guess, return
'(else lines > guess)
'if lines > max
'    if width = max, paginate
'    else let width = max, try it
'else lines are > guess but <= max
'    if width = max, return
'    else width is < max
'         if lines = guess + 1, return
'         else guess++, guess the width

i = 1
lentxt = len(txt$)
bx.npages = 1

longwordcheck:
for j = i to lentxt
  if instr(bx.spc$, substr$(txt$, j, j)) = - 1 then
    'j is next non-space
    break
  end if
next j
i = j   ' i is either the start of a word or > len txt$
for k = i to lentxt
  if instr(bx.spc$, substr$(txt$, k, k)) <> -1 then break
next k
'k is one past the end of word
if i <= lentxt then
  l = text_width(substr$(txt$, i, k - 1))
  bx.minw = max(l, bx.minw)
  bx.minw = min(bx.minw, bx.maxw)
  i = k
  if i <= lentxt then longwordcheck
end if

lineguess:
bx.textw = text_width(trim$(txt$))
bx.texth = text_height(txt$)
maxlines = floor(bx.maxh/bx.texth)
'this equation, without the ceil, is the solution if lines were floats instead of
'integers, and if we didn't have to break the message into words
guesslines = ceil(sqr(bx.textw /bx.texth/bx.aspect))
guesslines = max(guesslines, floor(bx.minh/bx.texth))
if guesslines > maxlines then
  guesslines = maxlines
  bx.w = bx.maxw
  goto tryit
end if

widthguess:
bx.w = ceil(bx.texth * guesslines * bx.aspect)
bx.w = max(bx.w, bx.minw)
bx.w = min(bx.w, bx.maxw)

tryit:
break$ = ""
i = 1
while i <= lentxt
  'trim white space
  for j = i to lentxt
    if substr$(txt$, j, j) = bx.lf$ then
      i = j
      goto saveline
    end if
    if instr(bx.spc$, substr$(txt$, j, j)) = -1 then
      i = j
      break j
    end if
  next j
  if j = lentxt + 1 then break 'remaining characters are all space
  'i is the start of a line, make j the end
  'j is either the end of the whole text, or the last text character before 
  'the last space character before the start of the next line
  for j = i to lentxt
    if substr$(txt$, j, j) = bx.lf$ then saveline
    if text_width(substr$(txt$, i, j)) > bx.w then break j
  next j
  if j > lentxt then 
    'last line. Trim spaces
    for k = j - 1 to i step -1
      if instr(bx.spc$, substr$(txt$, k, k)) = -1 then break k
    next k
    j = k
    goto saveline
  end if
  'j is now one char beyond what fits. Look left for spaces, then for text
  for k = j to i step -1
    if instr(bx.spc$, substr$(txt$, k, k)) <> -1 then break k
  next k
  if k = i - 1 then
    'single word too long to fit. Break it
    j -=1
    goto saveline
  end if
  for j = k to i step -1
    if instr(bx.spc$, substr$(txt$, j, j)) = -1 then break j
  next j
  
  saveline:
  break$ &= i & " " & j & " "
  i = j + 1
end while
split break$ to bx.index$, bx.lines with " "
bx.lines /=2
bx.h = min(bx.lines * bx.texth, bx.maxh)
bx.h = max(bx.h, bx.minh)
if bx.lines <= guesslines then return
if bx.lines > maxlines then 'it didn't fit
  if bx.w = bx.maxw then 'paginate
    bx.npages = ceil(bx.lines/maxlines)
    bx.displaypage = 1
    return
  end if
  bx.w = bx.maxw
  goto tryit
else ' it did fit
  if bx.w = bx.maxw then return
  if bx.lines = guesslines + 1 then return
  guesslines += 1
  goto widthguess 
end if
end def

def bxmakesprite(txt$)
for p = 1 to bx.npages
  sprite "bx" & p begin bx.w, bx.h
  graphics clear bx.backr, bx.backg, bx.backb
  draw color bx.textr, bx.textg, bx.textb
  j = 1 + (p - 1) * 2 * floor(bx.maxh/bx.texth)
  k = min(2 * bx.lines, p * 2 * floor(bx.maxh/bx.texth))
  l = 1
  for i = j to k step 2
    start = bx.index$(i)
    end = bx.index$(i + 1)
    draw text substr$(txt$, start, end) at 1, l
    l += bx.texth
  next i
  sprite end
  if p > 1 then
    sprite "bx1" add "bx" & p
    sprite "bx" & p delete
  end if
next p

bx.x0 = bx.x
bx.y0 = bx.y
if bx.x = bx.left then bx.x0 = 1
if bx.x = bx.center then bx.x0 = screen_width()/2 - bx.w/2
if bx.x = bx.right then bx.x0 = screen_width() - bx.w
if bx.y = bx.top then bx.y0 = 1
if bx.y = bx.center then bx.y0 = screen_height()/2 - bx.h/2
if bx.y = bx.bottom then bx.y0 = screen_height() - bx.h

sprite "bx1" at bx.x0, bx.y0
sprite "bx1" show
sprite "bx1" frame 1


sprite "bxright" begin bx.w/5, bx.h/2
graphics clear 1, 1, 1
draw color 0,0,0 
draw size bx.w/10
draw line 1,1 to bx.w/5, bx.h/4
draw line bx.w/5, bx.h/4 to 1, bx.h/2
sprite end
sprite "bxright" alpha .1
sprite "bxright" copy "bxleft"
sprite "bxright" at bx.w * .8 + bx.x0, bx.y0 + bx.h * .25
if bx.npages > 1 then sprite "bxright" show
sprite "bxleft" at bx.x0, bx.y0 + bx.h * .25
sprite "bxleft" show
sprite "bxleft" flip 1
sprite "bxleft" hide
end def

def bxpoll$()
if bx.sw <> screen_width() then 
  bxcleanup
  return "redo"
end if
tappoll
if bx.npages = 1 then return ""
if click then
  if bx.displaypage > 1 and sprite_hit("bxleft", tapx, tapy) = 1 then
    bx.displaypage -= 1
    if bx.displaypage = 1 then sprite "bxleft" hide
    if bx.displaypage = bx.npages - 1 then sprite "bxright" show
  end if
  if bx.displaypage < bx.npages and sprite_hit("bxright", tapx, tapy) = 1 then
    bx.displaypage += 1
    if bx.displaypage = 2 then sprite "bxleft" show
    if bx.displaypage = bx.npages  then sprite "bxright" hide
  end if
  sprite "bx1" frame bx.displaypage
end if
return ""
end def

def hideinterface
'when called before box(), hides the visible interface objects so they don't block it
list buttons to b$, nb
dim bv$(max(1, nb))
j = 1
for i = 1 to nb
  if button_visible(b$(i)) then
    button b$(i) hide
    bx.b$(j) = b$(i)
    j += 1
  end if
next i
bx.nb = j - 1
list fields to f$, nf
dim fv$(max(1, nf))
j = 1
for i = 1 to nf
  if field_visible(f$(i)) then
    field f$(i) hide
    bx.f$(j) = f$(i)
    j += 1
  end if
next i
bx.nf = j - 1
list lists to l$, nl
dim lv$(max(1, nl))
j = 1
for i = 1 to nl
  if list_visible(l$(i)) then
    list l$(i) hide
    bx.l$(j) = l$(i)
    j += 1
  end if
next i
bx.nl = j - 1
list switches to sw$, nsw
dim swv$(max(1, nsw))
j = 1
for i = 1 to nsw
  if switch_visible(sw$(i)) then
    switch sw$(i) hide
    bx.sw$(j) = sw$(i)
    j += 1
  end if
next i
bx.nsw = j - 1
list sliders to sl$, nsl
dim slv$(max(1, nsl))
j = 1
for i = 1 to nsl
  if slider_visible(sl$(i)) then
    slider sl$(i) hide
   bx.slv$(j) = sl$(i)
    j += 1
  end if
next i
bx.nsl = j - 1
end def

def restoreinterface
'shows the interface objects hidden by bxclearspace
for i = 1 to bx.nb
  button bx.b$(i) show
next i
for i = 1 to bx.nf
  field bx.f$(i) show
next i
for i = 1 to bx.nl
  list bx.l$(i) show
next i
for i = 1 to bx.nsw
  switch bx.sw$(i) show
next i
for i = 1 to bx.nsl
  slider bx.sl$(i) show
next i
end def

def bxcleanup
  sprite "bx1" delete
  sprite "bxleft" delete
  sprite "bxright" delete
  option base bx.ob
  draw font size bx.originalfontsize
  'would restore font here if I knew how
  draw color textr0, textg0, textb0
end def

def boxh = bx.h
def boxw = bx.w
def boxx =  bx.x0
def boxy = bx.y0

def msgbox(txt$)
graphics
mbmakebox:
lineh = text_height(txt$)
maxh = screen_height() - lineh
box(txt$, "XPOS CENTER YPOS TOP MAX HEIGHT " & maxh)
sprite "mbbutton" begin boxw, lineh
graphics clear bx.backr, bx.backg, bx.backb
sprite end
sprite "mbbutton" show
sprite "mbbutton" at boxx, boxy + boxh
button "mbok" title "OK" at boxx + boxw/4, boxy + boxh + 2 size boxw/2, lineh - 4
poll:
if bxpoll$ = "redo" then
  sprite "mbbutton" delete
  button "mbok" delete
  goto mbmakebox
end if
if button_pressed("mbok") then 
  mbcleanup
  return
end if
goto poll
end def

def mbcleanup
bxcleanup
sprite "mbbutton" delete
button "mbok" delete
end def

def inbox$(prompt$)
graphics
ibmakebox:
lineh = text_height(prompt$)
maxh = screen_height() - lineh * 2.5
box(prompt$, "MIN WIDTH 150 XPOS CENTER YPOS TOP MAX HEIGHT " & maxh)
sprite "ibcontrols" begin boxw, lineh * 2.5
graphics clear bx.backr, bx.backg, bx.backb
sprite end
sprite "ibcontrols" show
sprite "ibcontrols" at boxx, boxy + boxh
field "ibresult" at boxx + 1, boxy + boxh + 1 size boxw - 2, lineh
button "ibcan" title "CANCEL" at boxx + 1, boxy + boxh + lineh + 3 size 70, lineh
button "ibok" title "OK" at boxx + boxw - 71, boxy + boxh + lineh + 3 size 70, lineh
poll:
if bxpoll$ = "redo" then
  ibcleanup
  goto ibmakebox
end if
if button_pressed("ibok") then 
  inbox$ = field_text$("ibresult")
  ibcleanup
  bxcleanup
  ok = 1
  return
end if
if button_pressed("ibcan") then
  inbox$ = ""
  ibcleanup
  bxcleanup
  ok = 0
  return
end if
goto poll
end def

def ibcleanup
  sprite "ibcontrols" delete
  field "ibresult" delete
  button "ibcan" delete
  button "ibok" delete
end def

def inboxok = inbox$.ok

/*
higher order functions than touch(x,y) for touch interface

TAPX() and TAPY() return the coordinates of the click, double click, or start of drag
TOUCHSTART() = 1 while a touch is going on and click has not been decided - first 100ms
CLICK() = 1 if the most recent touch activity was a click, else 0
DOUBLECLICK() = 1 if the most recent touch was a double click, else 0
DRAGGING() = 1 if the ongoing touching of the screen is dragging
DRAGGED() = 1 if the most recent completed touch was dragging
DRAGENDX() and DRAGENDY() are the end of the last drag
DRAGSTARTT() and DRAGT() are the start and ongoing/end times of the drag
TAPPOLL() is the polling routine to detect the touches and follow the time. 
taps.clicktime is the duration in ms of touch after which it is a drag and not a click 
x and y are determined by the first touch. click, double click, and dragged persist until polled or the next touch starts a new event.

*/

/*
'uncomment this section to test taps
tp
graphics
graphics clear 0,0,0
draw color 1,1,.8
poll:
tappoll
if click then draw text "click" at tapx, tapy
if doubleclick then
  draw text "doubleclick" at tapx, tapy
   pause 1
  graphics clear 0,0,0
end if
if dragging then draw circle dragendx, dragendy size 3
if dragged then
  draw circle dragendx, dragendy size 8
  draw circle tapx, tapy size 8
  draw text (dragt - dragstartt)/1000 at 1,1
end if
goto poll
*/


def tp 'setup
clicktime = 100
doubleclicktime = 300
t0 = timer()
touch = 0
click = 0
nclick = 0
doubleclick = 0
dragging = 0
dragged = 0
tclick = 0
tdrag = 0
end def

def tappoll
'returns nothing
'if there is a touch
'  if it is new
'    clear click, double click, and dragged flags (but not dragging)
'    set touch flag
'    log its position and time
'  else continued touch
'    log drag position
'    if not already dragging
'      if click time expired
'        set dragging flag
'    (else nothing. continued touch and not new dragging)
'else no touch
'  if dragging
'    set dragged flag
'    clear dragging flag
'    clear touch
'    log end drag time
'  else not dragging
'    if touch was set
'      clear touch   
'      if click time exceeded
'        set dragged flag
'      else it's a click
'         if no prior click, or prior click but too long ago for a double click
'           click count = 1
'           set click,tclick
'        else it's a double click
'          reset click count,click
'          set doubleclick


get touch 0 as x,y
if x<> -1 and y <> -1 then 'there is a touch
  if tp.touch = 0 then 'new touch
    tp.click = 0
    tp.doubleclick = 0
    tp.dragged = 0
    'tp.dragging already = 0
    tp.touch = 1
    tp.t0 = timer()
    tp.x = x
    tp.y = y
  else 'continued touch
    tp.dragx = x
    tp.dragy = y
    tp.tdrag = timer()
    if tp.dragging = 0 and timer() - tp.t0 > tp.clicktime then tp.dragging = 1
  end if
else 'no touch
  if tp.dragging = 1 then
    tp.dragging = 0
    tp.dragged = 1
    tp.touch = 0
    tp.tdrag = timer()
  else
    if tp.touch = 1 then
      tp.touch = 0
      if timer() - tp.t0 > tp.clicktime then
        tp.dragged = 1
        tp.tdrag = timer()
      else 'it is the end of a click
        if tp.nclick = 0 or timer() - tp.tclick > tp.doubleclicktime then
          tp.nclick = 1
          tp.click = 1
          tp.tclick = tp.t0
        else
          tp.doubleclick =  1
          tp.click = 0
          tp.nclick = 0
        end if
      end if
    end if
  end if
end if
end def

def tapx
  tapx = tp.x
end def

def tapy
  tapy = tp.y
end def

def touchstart
  if tp.touch = 0 then return 0
  if tp.click + tp.doubleclick + tp.dragged + tp.dragging then return 0
  return 1
end def

def click
  click = tp.click
  tp.click = 0
end def

def doubleclick
  doubleclick = tp.doubleclick
  tp.doubleclick = 0
end def

def dragging
  dragging = tp.dragging
end def

def dragged
  dragged  = tp.dragged
  tp.dragged = 0
end def

def dragendx
  dragendx = tp.dragx
end def

def dragendy
  dragendy = tp.dragy
end def

def dragstartt
  dragstartt = tp.t0
end def

def dragt
  dragt = tp.tdrag
end def

Re: Input box library

Posted: Sat Jun 17, 2017 2:06 pm
by rbytes
I think sneepy is long gone. I haven't seen a new post from him in ages. In his remarks at the start of the code, he says that the taps library is "embedded" at the end of the code. Did you find that and save it as a separate file? I did a quick search and did not see anything embedded, so I'm not sure what he meant.

Re: Input box library

Posted: Sun Jun 18, 2017 3:34 pm
by GeorgeMcGinn
He shouldn't be. He just posted this last week.

Yes, I copy the entire post, code and all, and I comment out the posted comments which I keep with the code, just in case I missed something. I even uncommented the section he noted to test it.

Also "def tappoll" is commented and is pseudo-code.

Whatever other library he hasn't supplied, and I did a search before I flagged the message. I believe this post is closed as I got notification that it was. If this posted, then maybe it will be closed soon.

George
rbytes wrote:
Sat Jun 17, 2017 2:06 pm
I think sneepy is long gone. I haven't seen a new post from him in ages. In his remarks at the start of the code, he says that the taps library is "embedded" at the end of the code. Did you find that and save it as a separate file? I did a quick search and did not see anything embedded, so I'm not sure what he meant.

Re: Input box library

Posted: Tue Jun 20, 2017 4:07 pm
by gerry
Too bad, this could have been useful..

Re: Input box library

Posted: Sun Jun 25, 2017 12:05 pm
by basiccode
Are you guys tripping or what?.
Surely you realise even if sneepy's code worked in 2014 it's most likely not going to work after several Smart Basic upgrades. You guys seem to have forgotten that Mr K manages to change smart Basics language behaviour with almost every upgrade.

There has been sixteen smart BASIC upgrades since this topic was created.

Re: Input box library

Posted: Sun Jun 25, 2017 8:31 pm
by Henko
Don't exaggerate please. I remember only one occasion: a mod of the INT () function. You know of other mods that caused programs to behave different?