Community snippets

Moderators: LCMark, LCfraser

Post Reply
[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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 5405 times
shiftLock happens

[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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 5257 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 5257 times
outside.jpg
outside.jpg (25.76 KiB) Viewed 5257 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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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

peter-b
Posts: 182
Joined: Thu Nov 20, 2014 2:14 pm
Location: LiveCode Ltd.

Re: Community snippets

Post by 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

[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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 113 times
basicTemplate.png
basicTemplate.png (5.33 KiB) Viewed 4842 times
shiftLock happens

[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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 1169 times
shiftLock happens

[-hh]
VIP Livecode Opensource Backer
VIP Livecode Opensource Backer
Posts: 1550
Joined: Thu Feb 28, 2013 11:52 pm
Location: Göttingen, DE

Re: Community snippets

Post by [-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 27 times
test53.livecode.zip
snippet #53 -- the LC Script functions as working stack
(1.82 KiB) Downloaded 17 times
snippet#53.png
A result of the "Basic Random" test
snippet#53.png (23.79 KiB) Viewed 898 times
shiftLock happens

Post Reply

Return to “LiveCode Builder”