Community snippets

Moderators: LCMark, LCfraser

Community snippets

Postby [-hh] » Mon Oct 31, 2016 11:54 pm

Probably it will be hard in an experimental phase to build 'optimized' libraries. So I start here a collection of snippets that may be used, improved -- or simply not used ;-)

The reason to open a separate thread for this is an answer I got from peter-b in the LiveCode QCC (#18734) . This answer is a jewel of a snippet (at least for me). So it _must_ have number 42. Reorganizing my other snippets from the "Community widgets" thread will be deleted there and follow up here. Probably some of the snippets will/could get now an upgrade using #42.
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Tue Nov 01, 2016 12:21 am

[#42] LCB snippet: Apply a (fixed) handler to each element of a list

Originally I used the math term 'map' for that. To avoid such general terms, I name the handler now 'applyToList' instead of 'mapToList'.

The snippet of peter-b is then as follows.

Code: Select all
handler type ApplyHandler(in pValue as optional any) returns optional any

handler applyToList(in pHandler as ApplyHandler, in pValues as List) returns List
   variable tResult as List
   variable tValue as optional any
   repeat for each element tValue in pValues
      push pHandler(tValue) onto tResult
   end repeat
   return tResult
end handler

So what? A few lines will show the elegance of this handler.
In LCB there is a statement "ParseListOfStringAsListOfNumber"
but not vice versa "ParseListOfNumberAsListOfString".

We use the above elegance to build it named as 'numListToStringList'.

Code: Select all
handler numListToStringList(in pNumList as List) returns List
    return applyToList(formatToString,pNumList)
end handler

handler formatToString(in pEach as optional any) returns optional any
    return pEach formatted as string
end handler

More examples for the return value of formatToString*.
  • Financial rounding and adding a currency symbol to a list of numbers
    Code: Select all
    return "$ " & hhNumberToString(pEach,1,2)
  • Financial rounding, add a currency symbol and multiply by the variable mExchangeRateDollarPound to a list of numbers
    Code: Select all
    return "£ " & hhNumberToString(mExchangeRate*pEach,1,2)
  • Apply a text operation on each element of a list of strings
    Code: Select all
    replace "teh " with "the " in pEach -- Simon will smile here
    return pEach

A 2D example: Apply a handler to a list of points:
Scale (=multiply) the coordinates by variables mXFactor and mYFactor
Code: Select all
private variable mXFactor as Number
private variable mYFactor as Number

handler scaleListOfPointsBy(in pNumList as List, in pXFactor as Number, in pYFactor as Number) returns List
    set mXFactor to pXFactor
    set mYFactor to pYFactor
    return applyToList(ScaleBy,pNumList)
end handler

handler ScaleBy(in pEach as optional any) returns optional any
    return point [mXFactor*the x of pEach, mYFactor*the y of pEach]
end handler


What a powerful handler 'applyToList' is! Thank you very much, Peter (and the team)!
___
* hhNumberToString is snippet #43.

[Edit 1. Removed the parens from "(pEach formatted as string)", had 'ambiguous results'.][Edit 2. 'Finished' the 2D example]
Last edited by [-hh] on Tue Nov 01, 2016 7:35 am, edited 2 times in total.
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Tue Nov 01, 2016 12:27 am

[#43] LCB snippet: Convert number to 'number-formatted' string.

Currently, in LCB, "put tNumber formatted as string into tString" yields unwanted results.
Bernd has written work-arounds for formatting strings in his published variant of the chart widgets.
Here is variant that yields the same results as setting the numberformat in LCS with zeros, for example:

Code: Select all
set numberformat to "000.00"
put 92.8 into myString -- myString is "092.80"

that is at least three leading digits, then exactly two rounded decimals, has in LCB the same result with

Code: Select all
put hhNumberToString(92.8,3,2) into myString

using the following handler.

Code: Select all
-- pLeadNum the at least leading digits of the integer part
-- pDecNum the exact number of decimals, last one rounded, filled up with zeros
private handler hhNumberToString(in pNum as Number,in pLeadNum as Number, in pDecNum as Number) returns String
   variable tS as String
   variable tN as Number
   variable tC as Number
   put the empty string into tS
   if pNum < 0 then
     put "-" into tS
     multiply pNum by -1
   else
     put "" into tS
   end if
   put the rounded of ((the rounded of 10^(pDecNum+1)*pNum)/10) into tN
   if tN = 0 then
     repeat pLeadNum+pDecNum times
       put "0" after tS
     end repeat
   else
     repeat with tC from \
         the maximum of pLeadNum+pDecNum-1 and (the trunc of the log of tN) down to 0
       put the trunc of (tN/10^tC) formatted as string after tS
       put tN mod 10^tC into tN
     end repeat
   end if
   if pDecNum > 0 then -- fractional part
     put "." before char -pDecNum of tS
   end if
   return tS
end handler

Usage example in LCB:

Code: Select all
log hhNumberToString(the universal time,0,6)
-- Compare that with the unwanted result of
-- log (the universal time formatted as string) -- yields something like "1.47554e+09"
-- [while "log the universal time" formats like hhNumberToString(the universal time,0,6)!]


______
* Simplified and removed a possible rounding error.
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Tue Nov 01, 2016 12:31 am

[#44] LCB snippet: Create a matrix of rectangles of constant size.

This is a simple utility handler, the LCB counterpart of the LCS version.

Code: Select all
-- Creates a list of rectangles (for placing objects)
-- of constant width and constant height
-- arranged as a 'matrix' (in rows and columns):
-- pR = number of rows of objects
-- pC = number of columns of objects
-- pW = the width of each object
-- pH = the height of each object
-- pL = the left of the first object
-- pT = the top of the first object
-- pD = distance between objects
private handler createRectList(in pR as Number, in pC as Number, in pW as Number, in pH as Number, in pD as Number, in pL as Number, in pT as Number) returns List
   variable iZ as Number
   variable jZ as Number
   variable dV as Number
   variable dH as Number
   variable tI as Number
   variable tJ as Number
   variable tList as List
   put [] into tList
   repeat with tI from 1 up to pR
      put pT+(tI-1)*pH into iZ
      put (tI-1)*pD into dV
      repeat with tJ from 1 up to pC
           put pL+(tJ-1)*pW into jZ
           put (tJ-1)*pD into dH
           push rectangle [jZ+dH, iZ+dV, jZ+dH+pW, iZ+dV+pH] onto tList
      end repeat
     end repeat
     return tList
end handler

LCB doesn't like missing parameters, so here a short version.

Code: Select all
-- short version. The "4" is a reminder to the number of parameters.
private handler createRectList4(in pR as Number, in pC as Number, in pW as Number, in pH as Number)
   return createRectList(pR,pC,pW,pH,0,0,0)
end handler

Usage example.

Code: Select all
--- for example in handler OnPaint()
constant kDummy is "Infinite LC"
variable tRect as Rectangle
set the font of this canvas to font "Monaco" at size 9
set tRect to the image bounds of text kDummy on this canvas
put createRectList4(6, 5, 1.2*the width of tRect, 2*the height of tRect) into tRectList
variable tC as Number
repeat with tC from 1 up to (6*5)
    fill text kDummy at left of (element tC of tRectList) on this canvas
end repeat


Connected to that, here a handler, that returns the cell of the matrix that was clicked as [row, column].

Code: Select all
-- needs thes variables (or add them as params)
private variable mLeft as Number
private variable mTop as Number
private variable mWidth as Number
private variable mHeight as Number
private variable mDist as Number
-- returns [row clicked, column clicked]
private handler cellClicked(in pPoint as Point) returns List
   variable tW as Number
   variable tH as Number
   variable tWidth1 as Number
     variable tHeight1 as Number
   set tW to the trunc of ((-mLeft+the x of pPoint)/(mWidth +mDist))
     set tH to the trunc of ((-mTop +the y of pPoint)/(mHeight+mDist))
      set tWidth1 to mLeft+tW*(mWidth+mDist)
   set tHeight1 to mTop+tH*(mHeight+mDist)
     if pPoint is within rectangle [tWidth1,tHeight1,tWidth1+mWidth,tHeight1+mHeight] then
        return [1+tH,1+tW]
   else
      return [0,0]
   end if
end handler
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Tue Nov 01, 2016 12:38 am

[#45] LCB snippet: Create a list of a range of numbers (as string).

[For the LC Script version see here]

Handlers for creating
  • a list of a range of numbers
    Examples: [-41, -40, -39, ..., 41, 42] or [1.114, 1.214, ... , 1.414]
  • a list of a range of numbers formatted as string
    Examples: ["-41","-40","-39",...,"41","42"] or ["1.114","1.214",...,"1.414"]
  • in the string variant each element may be prefixed and/or suffixed by constant strings (e.g. "0x" as prefix or ".png" as suffix).
  • in both variants the numbers may be formatted by hhNumberToString (see the _updated_ LCB snippet #43).
I use this often for selecting or highliting blocks of objects or objects in a systematic way (e.g. every line of a listField with an even line number, or its lines 2 to 42 step 4).

Code: Select all
-- snippet #45: returns a list of
-- numbers from pStart (up|down) to pEnd by step pStep
-- formatted as string, with prefix pPrefix and suffix pSuffix
-- the numberFormat as given in pNumberFormat
-- param pNumberFormat has the form [pLeadNum,pDecNum] as List
--   where parameters pLeadNum,pDecNum are as in handler
--   hhNumberToString (see snippet #45 below)
private handler uRange(in pStart as Number, in pEnd as Number, in pStep as Number, in pNumberFormat as List, in pPrefix as String, in pSuffix as String) returns List
   variable tC as Number
   variable tList as List
   variable tString as String
   put the empty list into tList
   if 0 < (pStart-pEnd)*pStep then
      return ""
   end if
   if pNumberFormat is not the empty list then
      variable dC1 as Number
      variable dC2 as Number
       put element 1 of pNumberFormat into dC1
       put element 2 of pNumberFormat into dC2
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push pPrefix & hhNumberToString(tC,dC1,dC2) & pSuffix onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push pPrefix & hhNumberToString(tC,dC1,dC2) & pSuffix onto tList
         end repeat
      end if
   else
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push pPrefix & (tC formatted as string) & pSuffix onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push pPrefix & (tC formatted as string) & pSuffix onto tList
         end repeat
      end if
   end if
   return tList
end handler

[The same handler is in LCS 10 lines (using numberformat as an option).]
Usage example.

Code: Select all
-- combine the list of strings to a string of numbers (needed in LC)
variable tStringList as List
variable tString as String
set tList to uRange(1/7,11,1/7,[2,2],"","")
combine tList with delimiter "," into tString
-- yields "00.14,00.29,00.43,...,10.86,11.00"

And here the numbers variant (NOT formatted as string if pNumberFormat is [] ).
This is simplest of simple (it is essentially xtalk's 'iota'), but very useful for me.

Code: Select all
-- snippet #45N: returns a list of
-- numbers from pStart (up|down) to pEnd by step pStep
-- formatted as string, with prefix pPrefix and suffix pSuffix
-- *** if pNumberFormat is [] then each out-element is a number
-- *** else each out-element is a string formatted as follows.
-- the numberFormat as given in pNumberFormat
-- param pNumberFormat has the form [pLeadNum,pDecNum] as List
--   where parameters pLeadNum,pDecNum are as in handler
--   hhNumberToString (see snippet #45 below)
private handler listRange(in pStart as Number, in pEnd as Number, in pStep as Number, in pNumberFormat as List) returns List
   variable tC as Number
   variable tList as List
   put the empty list into tList
   if 0 < (pStart-pEnd)*pStep then
      return tList
   end if
   if pNumberFormat is not the empty list then
      variable dC1 as Number
      variable dC2 as Number
       set dC1 to pNumberFormat[1]
       set dC2 to pNumberFormat[2]
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push hhNumberToString(tC,dC1,dC2) onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push hhNumberToString(tC,dC1,dC2) onto tList
         end repeat
      end if
   else
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push tC onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push tC onto tList
         end repeat
      end if
   end if
   return tList
end handler

Example usage.

Code: Select all
--[1] returns the list of strings of
--    [1,1]-formatted numbers ["1.0","1.1","1.2",...,"41.9","42.0"]
return listRange(1,42,0.1,[1,1])

--[2] returns the "hello world" of lists
-- returns numbers because format is []:
return listRange(1,100,1,[])


Finally a full 'test-widget' example, using snippets #43,#44,#45.
[Just copy, save as the only .lcb file in some folder, load it (by the topRight folder icon) in the Extension builder and hit "Test".]

Code: Select all
widget community.livecode.hermann.test01

use com.livecode.math
use com.livecode.canvas
use com.livecode.widget
use com.livecode.engine

metadata title         is "test01"
metadata author      is "hh"
metadata version      is "0.0.0"
metadata preferredSize   is "320,275"

private variable mE as ScriptObject
private variable mDown as Boolean
private variable mClickPosition as Point

private variable mLeft as Number
private variable mTop as Number
private variable mWidth as Number
private variable mHeight as Number
private variable mDist as Number

public handler OnCreate()
   put my script object into mE
   set property "width" of mE to 300
   set property "height" of mE to 245
   set property "top" of mE to 10
   set property "left" of mE to 10
   post "set width of this stack to 320; " & \
      "set height of this stack to 265; " & \
      "choose browse tool"
end handler

public handler OnMouseDown()
   put true into mDown
   put the click position into mClickPosition
   redraw all
end handler

public handler OnMouseUp()
   put false into mDown
   redraw all
end handler

public handler OnMouseRelease()
   put false into mDown
   redraw all
end handler

public handler OnPaint()
   variable tStringList as List
   variable tRectList as List
   put uRange(1/7,11,1/7,[2,2],"","") into tStringList
   log listRange(1/7,11,1/7,[2,2])
   set the font of this canvas to font "Monaco" at size 12
   variable tRect as Rectangle
   set tRect to the image bounds of text (element 1 of tStringList) on this canvas
   put the width of tRect into mWidth
   put 1.5*the height of tRect into mHeight
   put 0.5*mHeight into mDist
   put mDist into mLeft
   put mDist into mTop
   put createRectList(11,7,mWidth,mHeight,mDist,mLeft,mTop) into tRectList
   variable tC as Number
   set the dashes of this canvas to [1,2,6,2]
   repeat with tC from 1 up to 77
      set the paint of this canvas to solid paint with color [0.2,0.2,1.0]
      stroke rectangle path of (element tC of tRectList) on this canvas
      set the paint of this canvas to solid paint with color [0,0,0]
        fill text (element tC of tStringList) \
         at left of (element tC of tRectList) on this canvas
   end repeat
   if mDown then
      variable tList as List
      variable tString as String
      variable tRect as Rectangle
      set tList to cellClicked(mClickPosition)
      if tList is not [0,0] then
         set tString to hhNumberToString(tList[1],1,0) &"_"& \
                     hhNumberToString(tList[2],1,0)
         set tRect to the image bounds of text tString on this canvas
         set the width  of tRect to 4 + the width  of tRect
         set the height of tRect to 4 + the height of tRect
         set the left of tRect to -2 + the x of mClickPosition + the left of tRect
         set the top  of tRect to -2 + the y of mClickPosition + the top  of tRect
         set the paint of this canvas to solid paint with color [0.8,1.0,1.0]
         fill rectangle path of tRect on this canvas
         set the paint of this canvas to solid paint with color [0,0,0]
         fill text tString at mClickPosition on this canvas
      end if
   end if
end handler

-- returns [row clicked, column clicked]
private handler cellClicked(in pPoint as Point) returns List
   variable tW as Number
   variable tH as Number
   variable tWidth1 as Number
     variable tHeight1 as Number
   set tW to the trunc of ((-mLeft+the x of pPoint)/(mWidth +mDist))
     set tH to the trunc of ((-mTop +the y of pPoint)/(mHeight+mDist))
      set tWidth1 to mLeft+tW*(mWidth+mDist)
   set tHeight1 to mTop+tH*(mHeight+mDist)
     if pPoint is within rectangle [tWidth1,tHeight1,tWidth1+mWidth,tHeight1+mHeight] then
        return [1+tH,1+tW]
   else
      return [0,0]
   end if
end handler

-- snippet #44: Creates a list of rectangles
-- (for objects) of constant width and constant height
-- arranged as a 'matrix' (rows and columns):
-- pR = number of rows of the objects
-- pC = number of columns of the objects
-- pW = the width of each object
-- pH = the height of each object
-- pL = the left of the first object
-- pT = the top of the first object
-- pD = distance between objects
private handler createRectList(in pR as Number, in pC as Number, in pW as Number, in pH as Number, in pD as Number, in pL as Number, in pT as Number) returns List
   variable iZ as Number
   variable jZ as Number
   variable dV as Number
   variable dH as Number
   variable tI as Number
   variable tJ as Number
   variable tList as List
   put [] into tList
   repeat with tI from 1 up to pR
      put pT+(tI-1)*pH into iZ
      put (tI-1)*pD into dV
      repeat with tJ from 1 up to pC
           put pL+(tJ-1)*pW into jZ
           put (tJ-1)*pD into dH
           push rectangle [jZ+dH, iZ+dV, jZ+dH+pW, iZ+dV+pH] onto tList
      end repeat
     end repeat
     return tList
end handler

-- shortened version. The "4" is a reminder to the number of parameters.
private handler createRectList4(in pR as Number, in pC as Number, in pW as Number, in pH as Number)
   return createRectList(pR,pC,pW,pH,0,0,0)
end handler

-- snippet #45: returns a list of
-- numbers from pStart (up|down) to pEnd by step pStep
-- formatted as string, with prefix pPrefix and suffix pSuffix
-- the numberFormat as given in pNumberFormat
-- param pNumberFormat has the form [pLeadNum,pDecNum] as List
--   where parameters pLeadNum,pDecNum are as in handler
--   hhNumberToString (see snippet #45 below)
private handler uRange(in pStart as Number, in pEnd as Number, in pStep as Number, in pNumberFormat as List, in pPrefix as String, in pSuffix as String) returns List
   variable tC as Number
   variable tList as List
   variable tString as String
   put the empty list into tList
   if 0 < (pStart-pEnd)*pStep then
      return ""
   end if
   if pNumberFormat is not the empty list then
      variable dC1 as Number
      variable dC2 as Number
       put element 1 of pNumberFormat into dC1
       put element 2 of pNumberFormat into dC2
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push pPrefix & hhNumberToString(tC,dC1,dC2) & pSuffix onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push pPrefix & hhNumberToString(tC,dC1,dC2) & pSuffix onto tList
         end repeat
      end if
   else
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push pPrefix & (tC formatted as string) & pSuffix onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push pPrefix & (tC formatted as string) & pSuffix onto tList
         end repeat
      end if
   end if
   return tList
end handler

-- snippet #45N: returns a list of
-- numbers from pStart (up|down) to pEnd by step pStep
-- *** if pNumberFormat is [] then each out-element is a number
-- *** else each out-element is a string formatted as follows.
-- formatted as string, the numberFormat as given in pNumberFormat
-- param pNumberFormat has the form [pLeadNum,pDecNum] as List
--   where parameters pLeadNum,pDecNum are as in handler
--   hhNumberToString (see snippet #45 below)
private handler listRange(in pStart as Number, in pEnd as Number, in pStep as Number, in pNumberFormat as List) returns List
   variable tC as Number
   variable tList as List
   put the empty list into tList
   if 0 < (pStart-pEnd)*pStep then
      return tList
   end if
   if pNumberFormat is not the empty list then
      variable dC1 as Number
      variable dC2 as Number
       set dC1 to pNumberFormat[1]
       set dC2 to pNumberFormat[2]
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push hhNumberToString(tC,dC1,dC2) onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push hhNumberToString(tC,dC1,dC2) onto tList
         end repeat
      end if
   else
      if pStart <= pEnd then
         repeat with tC from pStart up to pEnd by pStep
            push tC onto tList
         end repeat
      else
         repeat with tC from pStart down to pEnd by pStep
            push tC onto tList
         end repeat
      end if
   end if
   return tList
end handler

-- snippet #43:
-- pLeadNum the at least leading digits of the integer part
-- pDecNum the exact number of decimals, last one rounded, filled up with zeros
private handler hhNumberToString(in pNum as Number,in pLeadNum as Number, in pDecNum as Number) returns String
   variable tS as String
   variable tN as Number
   variable tC as Number
   put the empty string into tS
   if pNum < 0 then
     put "-" into tS
     multiply pNum by -1
   else
     put "" into tS
   end if
   put the rounded of ((the rounded of 10^(pDecNum+1)*pNum)/10) into tN
   if tN = 0 then
     repeat pLeadNum+pDecNum times
       put "0" after tS
     end repeat
   else
     repeat with tC from \
         the maximum of pLeadNum+pDecNum-1 and (the trunc of the log of tN) down to 0
       put the trunc of (tN/10^tC) formatted as string after tS
       put tN mod 10^tC into tN
     end repeat
   end if
   if pDecNum > 0 then -- fractional part
     put "." before char -pDecNum of tS
   end if
   return tS
end handler

end widget
Attachments
snippet#43-44-45.png
This is the output. Clicking on a dashed rectangle displays
(clicked row_clicked column).
snippet#43-44-45.png (42.04 KiB) Viewed 4535 times
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Thu Nov 03, 2016 9:05 pm

[#46] LCB snippet: Is Point in transformed rectangle?

The pointInShape-handler below actually works for any polygon/polyline path that is from a list of points. This handler returns true if and only if the a point is within the polygon using fill rule "even odd".

A typical situation is as follows, for rectangles,you will mostly use it for the bounds of an object that will be transformed: The 'applying' handler is specialised for the case of transformed rectangles.
The red rectangle is the original one, that is then rotated by -60 degrees to the cyan rectangle.

situation.jpg
situation.jpg (22.22 KiB) Viewed 4387 times

You wish now to hilite the rotated rectangle but if and only if the click position is within the rotated rectangle (and _not_ also if it is outside of it but still within the rect of that rotated rectangle).

inside.jpg
inside.jpg (25.07 KiB) Viewed 4387 times
outside.jpg
outside.jpg (25.76 KiB) Viewed 4387 times

This is achieved with the help of the following handlers.

Code: Select all
-- pString is the instructions of a transformed rectangle path
private handler hhPointIsInTransformedRect(in pPoint as Point, in pString as String) returns Boolean
   return pointInShape(pPoint, hhInstructionsToPoints(pString))
end handler

-- pString is the instructions of a transformed rectangle path
private handler hhInstructionsToPoints(in pString as String) returns List
   variable tS as String
   variable tL as List
   variable tL1 as List
   variable tOff as Number
   variable tN as Number
   replace "-" with " -" in pString
   replace "L -" with "L-" in pString
   replace "M -" with "M-" in pString
   put the first offset of "L" in pString into tOff
   put char 2 to (tOff-1) of pString into tS
   put " " & char (tOff+1) to -2 of pString after tS
   split tS by " " into tL
   put the empty list into tL1
   put the number of elements in tL into tN
   if tN > 1 then
      push point [element 1 of tL parsed as number, \
      element 2 of tL parsed as number] onto tL1
   end if
   if tN > 3 then
      push point [element 3 of tL parsed as number, \
      element 4 of tL parsed as number] onto tL1
   end if
   if tN > 5 then
      push point [element 5 of tL parsed as number, \
      element 6 of tL parsed as number] onto tL1
   end if
   if tN > 7 then
      push point [element 7 of tL parsed as number, \
      element 8 of tL parsed as number] onto tL1
   end if
   if tN > 1 then
      push point [element 1 of tL parsed as number, \
      element 2 of tL parsed as number] onto tL1
   end if
      return tL1
end handler

-- ACKNOWLEDGEMENT.
-- This is essentially the subdivison algorithm by MShimrat (Aug 1962).
handler pointInShape(in pPoint as Point, in pList as List) returns Boolean
   variable tX0 as Number
   variable tY0 as Number
   put the x of pPoint into tX0
   put the y of pPoint into tY0
   variable tCheck as Boolean
   put false into tCheck
   variable tC as Number
   variable tX1 as Number
   variable tX2 as Number
   variable tY1 as Number
   variable tY2 as Number
   variable nJ as Number
   put the number of elements in pList into nJ
   repeat with tC from 1 up to nJ
      put the x of pList[tC] into tX1
      put the y of pList[tC] into tY1
      put the x of pList[nJ] into tX2
      put the y of pList[nJ] into tY2
         if ( ((tY1 > tY0) is not (tY2 > tY0)) and \
         ( tX0 < tX1 + (tX2-tX1)*(tY0-tY1)/(tY2-tY1) ) ) then
         put not tCheck into tCheck
      end if
      put tC into nJ
   end repeat
   return tCheck
end handler

Usage of these handlers in a "click handler" may be seen in the closing full 'test-widget' example of the next snippet (#47).
Last edited by [-hh] on Fri Nov 04, 2016 2:26 am, edited 1 time in total.
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Fri Nov 04, 2016 12:59 am

[#47] LCB snippet: Transforming a list of points.

One of the statements for creating a path is to use
        set <path> to (polygon | polyline) path with points <list of points>

After that you can transform the created path but this doesn't include the corresponding transform of the source. You have to get it from the instructions of the path or to do it yourself. The last option is easily done with the following handlers.

This following an application of peter-b's snippet (#42) and will us enable to act on a list of non-empty points, similar to available statements for paths
  • affine transform the points by setting a transform matrix
  • scale the points by giving scale-factors
  • skew the points by giving skew-factors and center locations
  • rotate the points by giving positive (=cw) or negative angles (=ccw)
  • translate the points by giving translate-shifts
and, not available for paths,
  • perspective transform the points by setting a distortion list
This is the core.

Code: Select all
--mark snippet #42 @peter-b
handler type ApplyHandler(in pValue as optional any) returns optional any

handler applyToList(in pHandler as ApplyHandler, in pValues as List) returns List
   variable tResult as List
   variable tValue as optional any
   repeat for each element tValue in pValues
      push pHandler(tValue) onto tResult
   end repeat
   return tResult
end handler

handler transformPointsBy(in pNumList as List, in pAction as String) returns List
   if pAction is "affine" then
          return applyToList(affinePoints,pNumList)
   else if pAction is "rotate" then
        return applyToList(rotatePoints,pNumList)
   else if pAction is "scale" then
           return applyToList(scalePoints,pNumList)
   else if pAction is "skew" then
            return applyToList(skewPoints,pNumList)
   else if pAction is "translate" then
           return applyToList(translatePoints,pNumList)
   else if pAction is "perspective" then
           return applyToList(perspectivePoints,pNumList)
   else
          return applyToList(identityPoints,pNumList)
   end if   
end handler

Then we use (the variables to be defined as in the full 'widget-test' example below) the following handlers.

Code: Select all
handler scalePoints(in pEach as optional any) returns optional any
    return point [mXFactor*the x of pEach, mYFactor*the y of pEach]
end handler

-- skewX is in x-direction (first coord)
-- skewY is in y-direction (second coord)
handler skewPoints(in pEach as optional any) returns optional any
    return point [the x of pEach+mXSkew*(the y of pEach-mYCenter), \
       the y of pEach-mYSkew*(the x of pEach-mXCenter)]
end handler

handler rotatePoints(in pEach as optional any) returns optional any
    return point \
       [mXCenter + mCos*(the x of pEach-mXCenter)-mSin*(the y of pEach-mYCenter), \
       mYCenter + mCos*(the y of pEach-mYCenter)+mSin*(the x of pEach-mXCenter)]
end handler

handler translatePoints(in pEach as optional any) returns optional any
    return point [mXShift + the x of pEach, mYShift + the y of pEach]
end handler

handler affinePoints(in pEach as optional any) returns optional any
    return point [mAffine[1]*(the x of pEach)+mAffine[2]*(the y of pEach)+mAffine[5], \
              mAffine[3]*(the x of pEach)+mAffine[4]*(the y of pEach)+mAffine[6]]
end handler

-- first 6 elements of mPerspective are affine
-- last two elements are scaling the "distortion"
-- if tM[7] and tm[8] are zero we have an affine transform!
handler perspectivePoints(in pEach as optional any) returns optional any
   variable tX
   variable tY
   variable tD
   variable tM
   set tM to mPerspective
   set tX to the x of pEach
   set tY to the y of pEach
   set tD to (tM[7]*tX + tM[8]*tY + 100)/100 --> changed <--
   return point [(tM[1]*tX + tM[2]*tY + tM[5])/tD, (tM[3]*tX + tM[4]*tY + tM[6])/tD]
end handler

handler identityPoints(in pEach as optional any) returns optional any
    return pEach
end handler

Once again is here a full 'widget-test' example, using snippets #42,#43,#46 (and #47).
[Just copy, save as the only .lcb file in some folder, load it (by the topRight folder icon) in the Extension builder and hit "Test".]
This includes also utilites multiplyTransform and inverseAffine for 'affine matrices' (lists of 6 elements).

Code: Select all
widget community.livecode.hermann.test02

use com.livecode.math
use com.livecode.canvas
use com.livecode.widget
use com.livecode.engine

metadata title    is "test02"
metadata author   is "hh"
metadata version  is "0.0.1"
metadata preferredSize is "320,275"

private variable mE as ScriptObject
private variable mDown as Boolean
private variable mClickPosition as Point

private variable mList as List
private variable mXFactor as Number
private variable mYFactor as Number
private variable mXShift as Number
private variable mYShift as Number
private variable mXSkew as Number
private variable mYSkew as Number
private variable mCos as Number
private variable mSin as Number
private variable mXCenter as Number
private variable mYCenter as Number
private variable mXDistort as Number
private variable mYDistort as Number
private variable mAffine as List
private variable mPerspective as List
private variable mTest as List
private variable mDo as String

property "perspectiveList"         get getPerspective set setPerspective
metadata perspectiveList.editor    is "com.livecode.pi.string"
metadata perspectiveList.default   is "1,0,0,1,0,0,0,0"

--mark snippet #42 @peter-b
handler type ApplyHandler(in pValue as optional any) returns optional any

handler applyToList(in pHandler as ApplyHandler, in pValues as List) returns List
   variable tResult as List
   variable tValue as optional any
   repeat for each element tValue in pValues
      push pHandler(tValue) onto tResult
   end repeat
   return tResult
end handler

handler transformPointsBy(in pNumList as List, in pAction as String) returns List
    if pAction is "affine" then
       return applyToList(affinePoints,pNumList)
   else if pAction is "rotate" then
        return applyToList(rotatePoints,pNumList)
   else if pAction is "scale" then
        return applyToList(scalePoints,pNumList)
   else if pAction is "skew" then
         return applyToList(skewPoints,pNumList)
   else if pAction is "translate" then
        return applyToList(translatePoints,pNumList)
      else if pAction is "perspective" then
        return applyToList(perspectivePoints,pNumList)
      else if pAction is "ztest" then
        return applyToList(ztestPoints,pNumList)
    else
       return applyToList(identityPoints,pNumList)
   end if   
end handler

handler translatePoints(in pEach as optional any) returns optional any
    return point [mXShift + the x of pEach, mYShift + the y of pEach]
end handler

-- skewX is in x-direction (first coord)
-- skewY is in y-direction (second coord)
handler skewPoints(in pEach as optional any) returns optional any
    return point [the x of pEach+mXSkew*(the y of pEach-mYCenter), \
              the y of pEach-mYSkew*(the x of pEach-mXCenter)]
end handler

handler scalePoints(in pEach as optional any) returns optional any
    return point [mXFactor*the x of pEach, mYFactor*the y of pEach]
end handler

handler rotatePoints(in pEach as optional any) returns optional any
    return point \
       [mXCenter + mCos*(the x of pEach-mXCenter)-mSin*(the y of pEach-mYCenter), \
       mYCenter + mCos*(the y of pEach-mYCenter)+mSin*(the x of pEach-mXCenter)]
end handler

handler affinePoints(in pEach as optional any) returns optional any
    return point [mAffine[1]*(the x of pEach)+mAffine[2]*(the y of pEach)+mAffine[5], \
              mAffine[3]*(the x of pEach)+mAffine[4]*(the y of pEach)+mAffine[6]]
end handler

-- first 6 elements of mPerspective are affine
-- last two elements are scaling the "distortion"
handler perspectivePoints(in pEach as optional any) returns optional any
   variable tX
   variable tY
   variable tD
   variable tM
   set tM to mPerspective -- sx, ry, rx, sy, tx, ty, px, py
   set tX to the x of pEach
   set tY to the y of pEach
   set tD to (tM[7]*tX + tM[8]*tY + 100)/100 --> changed <--
   return point [(tM[1]*tX + tM[2]*tY + tM[5])/tD, (tM[3]*tX + tM[4]*tY + tM[6])/tD]
end handler

handler identityPoints(in pEach as optional any) returns optional any
    return pEach
end handler

-- use for testRuns
handler ztestPoints(in pEach as optional any) returns optional any
    --return (pEach formatted as string) & "_"
    --put hhNumberToString(4*pEach,2,2) into pEach
    --replace "." with ":" in pEach
   variable tX
   variable tY
   set tX to the x of pEach
   set tY to the y of pEach
    return point [tX,tX^mTest[1]*tY^mTest[2]]
end handler

public handler OnCreate()
   put my script object into mE
   set property "width" of mE to 300
   set property "height" of mE to 245
   set property "top" of mE to 10
   set property "left" of mE to 10
   put rectPoints([40,70,160,170]) into mList
   put "perspective" into mDo
   set mPerspective to [2,0,0,1,0,0,0.3,0.01]
   -- inverseAffine Test:
   -- log multiplyTransform([1,-0.5,0.25,1,50,20],inverseAffine([1,-0.5,0.25,1,50,20]))
   post "set width of this stack to 320; set height of this stack to 265;" & \
       "choose browse tool"
end handler

public handler OnMouseDown()
   if the click button is 3 then
      put false into mDown
      popup menu "affine\nrotate\nscale\nskew\ntranslate\nperspective\nztest" at the click position
      if the result is not nothing then
         put the result into mDo
      end if
   else
      put true into mDown
      put the click position into mClickPosition
   end if   
   redraw all
end handler

public handler OnMouseUp()
   put false into mDown
   redraw all
end handler

public handler OnMouseRelease()
   put false into mDown
   redraw all
end handler

public handler OnPaint()
   variable tList as List
   variable tString as String
   variable tPath as Path
   variable tP as List
   variable tPath0 as Path
   set tPath0 to polyline path with points mList
   set the paint of this canvas to solid paint with color [1.0,0.0,0.0]
   stroke tPath0 on this canvas
   -- set private variables here to see better what they will do
   if mDo is "affine" then
      set tP to [1,-0.5,0.25,1,80,-20]
         set mAffine to tP
   else if mDo is "rotate" then
      set tP to [-60,100,120]
      set mCos to cos(tP[1]*pi/180)
         set mSin to sin(tP[1]*pi/180)
       set mXCenter to tP[2]
       set mYCenter to tP[3]
   else if mDo is "scale" then
      set tP to [0.4,1.2]
       set mXFactor to tP[1]
       set mYFactor to tP[2]
   else if mDo is "skew" then
      set tP to [25,0,100,120]
         set mXSkew to sin(-tP[1]*pi/180)
       set mYSkew to sin(-tP[2]*pi/180)
       set mXCenter to tP[3]
       set mYCenter to tP[4]
   else if mDo is "translate" then
      set tP to [100,10]
         set mXShift to tP[1]
       set mYShift to tP[2]
   else if mDo is "perspective" then
      --set tP to [2,0,0,1,0,0,0.3,0.01]
      --set mPerspective to tP
      set tP to mPerspective
      set mXDistort to tP[7]
      set mYDistort to tP[8]
   else if mDo is "ztest" then
      set tP to [0.3,0.7]
      set mTest to tP
   end if
   set tPath to polyline path with points transformPointsBy(mList,mDo)
   -- set the font of this canvas to font "Monaco" at size 12
   set the size of the font of this canvas to 13
   set the paint of this canvas to solid paint with color [0.2,0.2,0.2]
   fill text "RightClick to switch transform." at point [10,10] on this canvas
   set tList to numListToStringList(tP)
   combine tList with "," into tString
   replace "," with ", " in tString
   fill text "<\q"&mDo&"\q, " & tString & ">" at point [10,28] on this canvas
   set the dashes of this canvas to [1,2,6,2]
   set the paint of this canvas to solid paint with color [0.8,1.0,1.0]
   fill tPath on this canvas
   set the paint of this canvas to solid paint with color [0.0,0.0,1.0]
   set the join style of this canvas to "miter"
   set the stroke width of this canvas to 1
   stroke tPath on this canvas
   if mDown then
      variable tRect as Rectangle
      if hhPointIsInTransformedRect(mClickPosition,the instructions of tPath) then
         set tString to "INSIDE"
         set the paint of this canvas to solid paint with color [1.0,1.0,0.5]
         fill tPath on this canvas
         set the dashes of this canvas to []
         set the paint of this canvas to solid paint with color [1.0,0.5,0.0]
         stroke tPath on this canvas
      else
         set tString to "OUTSIDE"
      end if
      --mark ClickLabel
      set tRect to the image bounds of text tString on this canvas
      set the width  of tRect to 4 + the width  of tRect
      set the height of tRect to 4 + the height of tRect
      set the left of tRect to -2 + the x of mClickPosition + the left of tRect
      set the top  of tRect to -2 + the y of mClickPosition + the top  of tRect
      set the paint of this canvas to solid paint with color [0.8,1.0,1.0]
      fill rectangle path of tRect on this canvas
      set the paint of this canvas to solid paint with color [0,0,0]
      fill text tString at mClickPosition on this canvas
   end if
end handler

handler getPerspective() returns String
   variable tList as any
   variable tString as any
   put numListToStringList(mPerspective) into tList
   combine tList with "," into tString
   return tString
end handler

handler setPerspective(in pList as String) returns nothing
   variable tList as List
   split pList by "," into tList
   set mDo to "perspective"
   set mPerspective to tList parsed as list of number
   redraw all
end handler

-- utility handler
handler multiplyTransform(in pL as List, in pR as List)
   return [pL[1]*pR[1]+pL[2]*pR[3], pL[1]*pR[2]+pL[2]*pR[4], \
         pL[1]*pR[5]+pL[2]*pR[6]+pL[5], \
         pL[3]*pR[1]+pL[4]*pR[3], pL[3]*pR[2]+pL[4]*pR[4],\
         pL[3]*pR[5]+pL[4]*pR[6]+pL[6], 0, 0, 1]   
end handler

-- pM is a list of 6 Numbers (affine transformation matrix)
handler inverseAffine(in pM as List) returns List
   variable tD as Number
   set tD to pM[1]*pM[4] - pM[2]*pM[3] -- determinant
   if tD = 0 then
      return [0,0,0,0,0,0] --> into doc
   else
      return [pM[4]/tD, -pM[2]/tD, - pM[3]/tD, pM[1]/tD, \
         (pM[2]*pM[6] - pM[5]*pM[4])/tD, (pM[3]*pM[5] - pM[1]*pM[6])/tD]
   end if
end handler

handler numListToStringList(in pNumList as List) returns List
   return applyToList(formatToString,pNumList)
end handler

handler formatToString(in pEach as optional any) returns optional any
   return pEach formatted as string
end handler
handler rectPoints(in pN as List) returns List
   return [point [pN[1],pN[2]],point [pN[3],pN[2]], \
         point [pN[3],pN[4]],point [pN[1],pN[4]], point [pN[1],pN[2]]]
end handler
-- end utility handler

--mark snippet #43:
-- pLeadNum the at least leading digits of the integer part
-- pDecNum the exact number of decimals, last one rounded, filled up with zeros
private handler hhNumberToString(in pNum as Number,in pLeadNum as Number, in pDecNum as Number) returns String
   variable tS as String
   variable tN as Number
   variable tC as Number
   put the empty string into tS
   if pNum < 0 then
     put "-" into tS
     multiply pNum by -1
   else
     put "" into tS
   end if
   put the rounded of ((the rounded of 10^(pDecNum+1)*pNum)/10) into tN
   if tN = 0 then
     repeat pLeadNum+pDecNum times
       put "0" after tS
     end repeat
   else
     repeat with tC from \
         the maximum of pLeadNum+pDecNum-1 and (the trunc of the log of tN) down to 0
       put the trunc of (tN/10^tC) formatted as string after tS
       put tN mod 10^tC into tN
     end repeat
   end if
   if pDecNum > 0 then -- fractional part
     put "." before char -pDecNum of tS
   end if
   return tS
end handler

--mark snippet #46:
-- pString is the instructions of a transformed rectangle path
private handler hhPointIsInTransformedRect(in pPoint as Point, in pString as String) returns Boolean
   return pointInShape(pPoint, hhInstructionsToPoints(pString))
end handler

-- pString is the instructions of a transformed rectangle path
private handler hhInstructionsToPoints(in pString as String) returns List
   variable tS as String
   variable tL as List
   variable tL1 as List
   variable tOff as Number
   variable tN as Number
   replace "-" with " -" in pString
   replace "L -" with "L-" in pString
   replace "M -" with "M-" in pString
   put the first offset of "L" in pString into tOff
   put char 2 to (tOff-1) of pString into tS
   put " " & char (tOff+1) to -2 of pString after tS
   split tS by " " into tL
   put the empty list into tL1
   put the number of elements in tL into tN
   if tN > 1 then
      push point [element 1 of tL parsed as number, \
      element 2 of tL parsed as number] onto tL1
   end if
   if tN > 3 then
      push point [element 3 of tL parsed as number, \
      element 4 of tL parsed as number] onto tL1
   end if
   if tN > 5 then
      push point [element 5 of tL parsed as number, \
      element 6 of tL parsed as number] onto tL1
   end if
   if tN > 7 then
      push point [element 7 of tL parsed as number, \
      element 8 of tL parsed as number] onto tL1
   end if
   if tN > 1 then
      push point [element 1 of tL parsed as number, \
      element 2 of tL parsed as number] onto tL1
   end if
      return tL1
end handler

-- ACKNOWLEDGEMENT.
-- This is essentially the subdivison algorithm by MShimrat (Aug 1962).
handler pointInShape(in pPoint as Point, in pList as List) returns Boolean
   variable tX0 as Number
   variable tY0 as Number
   put the x of pPoint into tX0
   put the y of pPoint into tY0
   variable tCheck as Boolean
   put false into tCheck
   variable tC as Number
   variable tX1 as Number
   variable tX2 as Number
   variable tY1 as Number
   variable tY2 as Number
   variable nJ as Number
   put the number of elements in pList into nJ
   repeat with tC from 1 up to nJ
      put the x of pList[tC] into tX1
      put the y of pList[tC] into tY1
      put the x of pList[nJ] into tX2
      put the y of pList[nJ] into tY2
         if ( ((tY1 > tY0) is not (tY2 > tY0)) and \
         ( tX0 < tX1 + (tX2-tX1)*(tY0-tY1)/(tY2-tY1) ) ) then
         put not tCheck into tCheck
      end if
      put tC into nJ
   end repeat
   return tCheck
end handler

end widget

In the property editor you can edit the perspective transform:
property 'perspectiveList' is given by a list of 8 elements. The first 6 elements are as usual defining the matrix of an affine transform, the last two are x- and y-distortion factors. I f these are zero, then we have an ordinary affine transform.

From script you can do (for example)

Code: Select all
get property "perspectiveList" of widget <widget name>
set property "perspectiveList" of widget to <list of 8 elements>

Example to test 'isolated' the distortion parameters:

Code: Select all
-- (The first six  "1,0,0,1,0,0" are the identity affine transform)
set property "perspectiveList" of widget to "1,0,0,1,0,0,0.3,0.01"
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby peter-b » Fri Nov 04, 2016 10:24 am

Thank you for these very interesting examples of functional programming in LiveCode Builder!
LiveCode Open Source Team — @PeterTBBrett — peter.brett@livecode.com
peter-b
 
Posts: 182
Joined: Thu Nov 20, 2014 2:14 pm
Location: LiveCode Ltd.

Re: Community snippets

Postby [-hh] » Sun Nov 06, 2016 9:12 am

[#48] LCB snippet: Lexicographic order of a list of points

Points (x,y) of numbers x and y are in lexicographic order if they are sorted
ascending numeric in cartesian coordinates:
   = primary by the first coordinate and
   = secondary by the second coordinate
LC uses not cartesian coordinates but is "flipped" in the second coordinate (top-down instead of bottom-up). We have to handle this.

In LC Script we write

Code: Select all
-- pList is a string of lines of points of numbers
-- each line is "item1,item2" or (item1,item2)
function lexicographicSort pList
   sort pList descending numeric by item 2 of each -- we are flipped!
   sort pList numeric by item 1 of each
   return pList
end lexicographicSort

In LC Builder we can use the powerful tool of a comparing sort function which has to return
  • a negative number if pLeft is to sort 'before' pRight
  • zero if pLeft is to sort 'equal' to pRight (no reorder)
  • a positive number if pLeft is to sort 'after' pRight
Here is one.

Code: Select all
-- pList is a list of points
private handler lexicographicSort(in pList as List) returns List
   sort pList using handler LexicographicOrder
   return pList
end handler

private handler LexicographicOrder(in pLeft as Point, in pRight as Point) returns Number
   if the x of pLeft = the x of pRight then
      return the y of pRight - the y of pLeft -- we are flipped!
   else
      return the x of pLeft - the x of pRight
   end if
end handler
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Sun Nov 06, 2016 10:02 am

[#49] LCB snippet: Convex hull of a set of points

The Convex hull of a set of points is the smallest convex set containing the set (non-math: A rubber band around all points, as tight as possible). For a finite set of points the hull is a polygon using a subset of the points.

The computation of such a polygon is non-trivial. There are several algorithms, see for a good overview
https://en.wikipedia.org/wiki/Convex_hull_algorithms .

This here is an implementation of Andrew's monotone chain algorithm, see link in the script of "ConvexHull".

The LC-Script version is even for 1000 lines of points fast enough for a RaspberryPi.
This is now the LCB version (uses the sort function described in snippet #48):

Code: Select all
-- Andrew's monotone chain algorithm, see
-- https://en.wikibooks.org/wiki/
--       Algorithm_Implementation/Geometry/Convex_hull/Monotone_chain
-- This version: [-hh fecit, Nov 2016]
-- pPoints is a valid list of points
-- returns the conves hull as list of points in ccw order
private handler convexHull(in pPoints as List) returns List
   variable tPts1 as Array
   variable tPts2 as List
   variable tPts as List
   variable tHull as List
   variable tP as Point
   variable tC as Number
   variable tK as Number
   variable tK0 as Number
   variable tN as Number
   variable tE as String
   variable tTmp as List   
   -- remove empty or duplicate elements
   repeat for each element tP in pPoints
      if tP is not empty then
         put true into tPts1[ \
            (the x of tP formatted as string) &","& \
            (the y of tP formatted as string)]
      end if
   end repeat
   put the keys of tPts1 into tPts2
   -- recreate list of points
   repeat for each element tE in tPts2
       split tE by "," into tTmp
      push point [ \
         element 1 of tTmp parsed as number, \
         element 2 of tTmp parsed as number] onto tPts
   end repeat
   put the number of elements in tPts into tN
   -- lexicographical sort
   sort tPts using handler LexicographicOrder -->  explanation: LCB snippet #48
   -- select upper part of hull
   put 0 into tK
   put 1 into tK0
   put tPts & tPts into tHull -- initialize tHull
   repeat with tC from 1 up to tN
      repeat  while \
            (tK > tK0 and crossProduct(tHull[tK-1],tHull[tK],tPts[tC]) <= 0)
         subtract 1 from tK
      end repeat
      add 1 to tK
         put tPts[tC] into tHull[tK]
   end repeat
   -- select lower part of hull
   put tK into tK0
   repeat with tC from tN-1 down to 1
      repeat while (tK > tK0 and crossProduct(tHull[tK-1],tHull[tK],tPts[tC]) <= 0)
            subtract 1 from tK
      end repeat
      add 1 to tK
         put tPts[tC] into tHull[tK]
   end repeat
   return element 1 to tK of tHull
end handler
-- ccw if > 0, cw if < 0, collinear if = 0
private handler crossProduct(in pPt1 as Point,in pPt2 as Point,in pPt3 as Point)
  return  (the x of pPt2 - the x of pPt1)*(the y of pPt3  - the y of pPt1) \
        - (the y of pPt2 - the y of pPt1)*(the x of pPt3  - the x of pPt1)
end handler

-- negative if pLeft < pRight, 0 if pLeft = pRight, positive if pLeft > pRight
private handler LexicographicOrder(in pLeft as Point, in pRight as Point) returns Number
    if the x of pLeft = the x of pRight then
      return the y of pRight - the y of pLeft -- we are flipped!
    else
      return the x of pLeft - the x of pRight
   end if
end handler

[It needs some time to make the list elements 'unique' (these are the lines before the comment mark "lexicographical sort"). If somebody who reads this has a faster/simpler solution (not using LCS) then tell us please.]

A full widget example using the above is LCB widget #48.
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Thu Nov 10, 2016 4:13 am

[#50] LCB snippet: Helpers for lists of numbers

These are some very simple handlers I need often.
Parameter <numList> is a list of 1 to N numbers.
  • numListToStringList(numList)
    -- returns numList's elements as strings
  • numListToString(numList)
    -- returns string of numList's elements as items
  • maxL(numList)
    -- returns the maximum of numList's elements
  • minL(numList)
    -- returns the minimum of numList's elements
  • absL(numList)
    -- returns list of the abs of numList's elements
  • floorL(numList)
    -- returns list of the floor of numList's elements
  • ceilL(numList)
    -- returns list of the ceiling of numList's elements
  • roundL(numList)
    -- returns list of the rounded of numList's elements
  • cutL(numList, lowerCut, upperCut)
    -- returns the minimum of upperCut and (the maximum of lowerCut and numList's elements), i.e. the elements are cut such that lowerCut <= element <= upperCut.
Usage examples.

Code: Select all
variable numList as List
set numList to [-1.5,0,1.5]

log numListToStringList(numList) --> the list  ["-1.5","0","1.5"]
log numListToString(numList)     --> the string "-1.5,0,1.5"
log maxL(numList) --> the number 1.5
log minL(numList) --> the number -1.5
log absL(numList)   --> the list [1.5,0,1.5]
log floorL(numList) --> the list [-1,0,1]
log ceilL(numList)  --> the list [-2,0,2]
log roundL(numList) --> the list [-1,0,2]
log cutL(numList, 0, 1) --> the list [0,0,1]

The handlers.

Code: Select all
handler numListToStringList(in pNumList as List) returns List
    return applyToList(formatToString,pNumList)
end handler
handler numListToString(in pNumList as List) returns String
   variable tList as List
   variable tString as String
   set tList to applyToList(formatToString,pNumList)
    combine tList with "," into tString
    return tString
end handler
private handler maxL(in pList as List)
   return the maximum value of pList
end handler
private handler minL(in pList as List)
   return the minimum value of pList
end handler
private handler absL(in pList as List)
   return applyToList(abs0,pList)
end handler
private handler floorL(in pList as List)
   return applyToList(floor0,pList)
end handler
private handler ceilL(in pList as List)
   return applyToList(ceil0,pList)
end handler
private handler roundL(in pList as List)
   return applyToList(round0,pList)
end handler
--cut Numbers at lowerCut and upperCut ;-)
private variable lowerCut as Number
private variable upperCut as Number
private handler cutL(in pList as List, in pMin as Number, in pMax as Number)
    set lowerCut to pMin
    set upperCut to pMax
   return applyToList(cut0,pList)
end handler
--helper (ApplyHandler for each list element)
handler formatToString(in pEach as optional any) returns optional any
    return pEach formatted as string
end handler
private handler abs0(in pEach as Number) returns Number
   return the abs of pEach
end handler
private handler floor0(in pEach as Number) returns Number
   return the floor of pEach
end handler
private handler ceil0(in pEach as Number) returns Number
   return the ceiling of pEach
end handler
private handler round0(in pEach as Number) returns Number
   return the rounded of pEach
end handler
private handler cut0(in pEach as Number) returns Number
   return the minimum of upperCut and (the maximum of lowerCut and pEach)
end handler
--peter b's jewel snippet, needed above
handler type ApplyHandler(in pValue as optional any) returns optional any
handler applyToList(in pHandler as ApplyHandler, in pValues as List) returns List
   variable tResult as List
   variable tValue as optional any
   repeat for each element tValue in pValues
      push pHandler(tValue) onto tResult
   end repeat
   return tResult
end handler
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Sat Nov 12, 2016 1:17 pm

[#51] LCB snippet: Basic template

This is the basic template I currently use.
[It is a working widget, simply load it (as the _only_ lcb file in a folder) with the Extension Builder and hit button "Test".]

It defines some basic variables and properties, includes some utility handlers and implements the basic handlers. It simply draws a rounded rectangle and shows, if switched on, a blinking dot at the widget's center -- just to see an action.

  • Public handler:
    OnPaint, OnCreate, OnLoad, OnSave, OnMouseDown (with popup menu) and several other mouse actions.
  • Timer handling:
    OnTimer, OnOpen, OnClose.
  • Basic properties:
    Color etc. , incl. using the property editor and dictionary entries.
  • Utility handler.
    hhStringToColor, hhColorToString, postRect, numListToStringList, numListToString, outsetRect.
Attachments
hhTemplate.lcb.zip
Unzip and put as the _only_ lcb-file in a (new) folder.
(4.1 KiB) Downloaded 95 times
basicTemplate.png
basicTemplate.png (5.33 KiB) Viewed 3972 times
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Wed Aug 23, 2017 12:53 pm

[#52] LCB snippet: HighContrastColors
Edit. Reposted after correcting a copy/paste typo ("maximum" to "minimum") and adding a missing helper handler.

This is the LC version of an algorithm that I originally wrote in LC Script, see (and use for more info or as demo stack for the algorithm) RaspberryPi Stacks collection #81.
I'll need that for one of my next community widgets to generate colorful two-color sample icons. May also be useful for some of you, at least as a base for manual 'fine tuning'.

Code: Select all
-- Colors are here in the form [r,g,b] where each element r,g,b is an integer
-- in range 0-255
-- pMinContrast is usually a number between 4.0 and 7.0, I use mostly 5.5
-- pBaseColor is usually used as backColor, pClr is a "startColor"
-- The result is again in the form [r,g,b], usable as "color [r/255, g/255, b/255]"
-- (or convert it to a string for use in LC Script)
-- The result is here a grayLevel (r=g=b), usually not too bad in contrast.
-- Of course you may change the algorithm to get a mor colorful result.

private handler adjustContrastRatio(in pMinContrast as Number,in pBaseClr as List,in pClr as List) returns List
  variable goDown as Boolean
  put false into goDown
  variable pClr1 as List
  put pClr into pClr1
  variable tCnt as Number
  put 0 into tCnt
  repeat forever
    add 1 to tCnt
    if contrastRatio(relativeLuminance(pClr),relativeLuminance(pBaseClr)) > pMinContrast or tCnt > 999 then
       exit repeat
    end if
    if pClr is [255,255,255] then -- or other criterium
      put true into goDown
      put pClr1 into pClr
    end if
    variable tC as Number
      if goDown then
       repeat with tC from 1 up to 3
        put the maximum of 0 and (-1 + pClr[tC]) into pClr[tC]
      end repeat
    else
      repeat with tC from 1 up to 3
        put the minimum of 255 and (1 + pClr[tC]) into pClr[tC]
      end repeat
    end if
    if pClr is [0,0,0] then
       exit repeat
    end if
  end repeat
  return pClr
end handler

-- pRGB is of the form [r,g,b] where each
-- element r,g,b is an integer in range 0-255
private handler relativeLuminance(in pRGB as List) returns Number
  variable tLuminance as Number
  put 0 into tLuminance
  variable tWeights as List
   put [0.2126,0.7152,0.0722] into tWeights
   variable tC as Number
  repeat with tC from 1 up to 3
    variable tCC
    variable tRi
    put pRGB[tC]/255 into tCC
    if tCC <= 0.03928 then
      put tCC/12.92 into tRi
    else
      put ((tCC+0.055)/1.055)^2.4 into tRi
    end if
    add (tWeights[tC]*tRi) to tLuminance
  end repeat
  return tLuminance
end handler

-- computes ratio of lighter against darker
private handler contrastRatio (in pL1 as Number, in pL2 as Number) returns Number
  if pL1 > pL2 then -- pL2 is darker
    return (pL1 + 0.05) / (pL2 + 0.05)
  else
     return (pL2 + 0.05) / (pL1 + 0.05)
  end if
end handler


If you wish to test this "quick-and-dirty" then use the code below.
  • Paste it, together with the code above inserted at the indicated line, in a textfile "contrastColors.lcb" (which should be the only lcb file in its folder)
  • Open the file from Tools > Extension Builder (click folder icon at top right for a fialog)
  • Hit Test to compile
Then rightClick the widget repeatedly to draw 16 randomly selected backColors with there "contrast-forecolors". I get here mostly always acceptable results.

Code: Select all
widget community.livecode.hermann.highcontrastcolors

use com.livecode.math
use com.livecode.canvas
use com.livecode.widget
use com.livecode.engine

metadata title is "highcontrastcolors_test"
metadata author is "Hermann"
metadata version is "0.0.0"

variable mFontSize as Number

public handler OnCreate()
   put 21 into mFontSize
   post "set width of this stack to 400; set height of this stack to 400; set rect of me to 5,5,395,395"
end handler

public handler OnMouseDown()
   if the click button is 3 then
      redraw all
   end if
end handler

public handler OnPaint()
   stroke rectangle path of my bounds on this canvas
   variable tText as String
   variable tL as List
   variable tL1 as List
   variable tL2 as List
   variable tC as Number
   variable tH as Number
   variable tBounds as Rectangle
  put highContrastColors(16) into tL
  set the font of this canvas to font "DroidSans" at size mFontSize
  put 0 into tH
   repeat with tC from 1 up to 16
     split tL[tC] by "," into tL2
      put (tL2 parsed as list of number) into tL1
     put (tC formatted as string) & ": " & tL[tC] into tText
     set the paint of this canvas to solid paint with color [tL1[1]/255, tL1[2]/255, tL1[3]/255]
     put the bounds of text "["&tText on this canvas into tBounds
     fill rectangle path of rectangle [0, tH, my width, tH + the height of tBounds] on this canvas
     set the paint of this canvas to solid paint with color [tL1[4]/255, tL1[5]/255, tL1[6]/255]
    fill text tText at point[8,tH+0.8*the height of tBounds] on this canvas
    add the height of tBounds to tH
   end repeat
end handler

private handler highContrastColors(in pNum as Number) returns List
   variable tC as Number
   variable tB as List
   variable tF as List
   variable tS as List
   variable tBF as List
   variable tS0 as String
   put [] into tBF
   repeat pNum times
     put [255*(any number), 255*(any number), 255*(any number)] into tB
     put adjustContrastRatio(5.5,tB,tB) into tF
     put "" into tS0
       repeat with tC from 1 up to 3
       put (the trunc of tB[tC] formatted as string) & "," after tS0
     end repeat
      repeat with tC from 1 up to 3
       put (the trunc of tF[tC] formatted as string) & "," after tS0
     end repeat
      push char 1 to -2 of tS0 onto tBF
   end repeat
   return tBF
end handler

--------> insert the code from the snippet above here <---------

end widget

Attachments
contrastColor.png
contrastColor.png (15.7 KiB) Viewed 299 times
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Postby [-hh] » Tue Sep 19, 2017 3:48 am

[#53] LCB snippet: Basic random handlers

[This snippet shall also show how close LC Script and LC Builder are already connected for our usage. If you didn't try LCB until know then you may read the following easy functions and jump into it with the attached lcb file (how to start from lcb files is described in #52).]

LCB gives us (pseudo) random generated real numbers that are uniformly distributed in range 0.0 to 1.0.

Code: Select all
variable tU as Number
put any number into tU

We may use this as follows.

1. Generate random integers in range N1 to N2.

In LCS we have for that:
Code: Select all
-- returns a random integer in range pN1 to pN2
function integerRandom N1,N2
  return N1-1 + random(N2-N1+1)
end integerRandom

In LCB we have accordingly:
Code: Select all
-- returns a random integer in range pN1 to pN2
handler integerRandom(in pN1 as Number, in pN2 as Number) returns Number
   return the trunc of (pN1 + (pN2-pN1) * any number)
end handler

2. Generate a random sort of the integers in range N1 to N2

In LCS we have for that:
Code: Select all
-- returns a randomly ordered List of the integers pN1 up to pN2
function randomOrderList pN1,pN2
   repeat with tI = pN1 to pN2
      put comma & tI after tL1
   end repeat
   put char 2 to -1 of tL1 into tL2
   sort items of tL2 by random(2^16)
   return tL2
end randomOrderList

In LCB we have accordingly:
Code: Select all
-- returns a randomly ordered List of the integers pN1 up to pN2
handler randomOrderList(in pN1 as Number, in pN2 as Number) returns List
   variable tL as List
   variable tI as Number
   put [] into tL
   repeat with tI from pN1 up to pN2
      push tI onto tL
   end repeat
   sort tL using handler randomCompare
   return tL
end handler

-- returns a random integer in range 1- 2^15 to 2^15-1 = 2^16-1 numbers
handler randomCompare(in pLeft as any, in pRight as any) returns Number
   return the trunc of ( 1 - 2^15 + (2^16-2) * any number)
end handler


3. Random reordering of a finite number of objects
The random sort of the element numbers/indices from (2) may be used for that.

In LCS we could do that as follows for a string myString:
Code: Select all
-- returns the string pStr with its chars randomly reordered
function randomOrderString pStr
  put the length of pStr into tN
  put randomOrderList(1,tN) into tL
  repeat for each item tI in tL
    put char (item tI of tL) of pStr after tS
  end repeat
  return tS
end randomOrderString

In LCB we have accordingly:
Code: Select all
-- returns the string pStr with its chars randomly reordered
handler randomOrderString(in pStr as String) returns String
   variable tI as Number
   variable tL as List
   variable tS as String
   put randomOrderList(1,the number of chars in pStr) into tL
   repeat for each element tI in tL
      put char tL[tI] of pStr after tS
   end repeat
   return tS
end handler


Finally you may try the following full-widget-code, that generates a 10-digit number and a random order of the string "LiveCode_thistles_at_Edinburgh_Scotland."

For the display the randomised string is split into four parts. Click the widget or use the scroll wheel (or resize the stack window) to have a new random generation.
Also find attached to have, for comparison, all the same as LC Script in a stack.

 
Attachments
test53.lcb.zip
snippet #53 -- the LC Builder handlers as working widget
(1.7 KiB) Downloaded 14 times
test53.livecode.zip
snippet #53 -- the LC Script functions as working stack
(1.82 KiB) Downloaded 5 times
snippet#53.png
A result of the "Basic Random" test
snippet#53.png (23.79 KiB) Viewed 28 times
shiftLock happens
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Livecode Membership
 
Posts: 1485
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE


Return to LiveCode Builder

Who is online

Users browsing this forum: No registered users and 0 guests