# Reference:
# https://stackoverflow.com/questions/2049582/how-to-determine-if-a-point-is-in-a-2d-triangle
# https://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/

sub if-overlap ($triangle-pair) {
   my (\A,\B) = $triangle-pair;
   my Bool $result = False;

   sub sign (\T) {
      return (T[0;0] - T[2;0]) × (T[1;1] - T[2;1]) -
             (T[1;0] - T[2;0]) × (T[0;1] - T[2;1]);
   }

   sub point-in-triangle (\pt, \Y --> Bool) {
      my $d1 = sign (pt, Y[0], Y[1]);
      my $d2 = sign (pt, Y[1], Y[2]);
      my $d3 = sign (pt, Y[2], Y[0]);

      my $has_neg = [or] $d1 < 0, $d2 < 0, $d3 < 0;
      my $has_pos = [or] $d1 > 0, $d2 > 0, $d3 > 0;

      return not ($has_neg and $has_pos);
   }

   sub orientation(\P, \Q, \R --> Int) {
      my \val = (Q[1] - P[1]) × (R[0] - Q[0]) -
                (Q[0] - P[0]) × (R[1] - Q[1]);

      return 0 if val == 0;     # colinear
      return val > 0 ?? 1 !! 2; # clock or counterclock wise
   }

   sub onSegment(\P, \Q, \R --> Bool) {
      Q[0] ≤ max(P[0], R[0]) and Q[0] ≥ min(P[0], R[0]) and
      Q[1] ≤ max(P[1], R[1]) and Q[1] ≥ min(P[0], R[1])
         ?? True !! False
   }

   sub intersect(\A,\B,\C,\D --> Bool) {
      my \o1 = orientation A, C, D;
      my \o2 = orientation B, C, D;
      my \o3 = orientation A, B, C;
      my \o4 = orientation A, B, D;

         o1 != o2 and o3 != o4
      or o1 ==  0 and onSegment A, C, D
      or o2 ==  0 and onSegment B, C, D
      or o3 ==  0 and onSegment A, B, C
      or o4 ==  0 and onSegment A, B, D
         ?? True !! False
   }

   for ^3 {
      { $result = True; last } if
          point-in-triangle A.[$^i], B or
          point-in-triangle B.[$^i], A ;
   }

   unless $result {
      $result = True if
          intersect A.[0], A.[1], B.[0], B.[1] or
          intersect A.[0], A.[1], B.[0], B.[2]
   }

   say "{A.gist} and {B.gist} do{' NOT' unless $result} overlap.";
}

my \DATA = [
   [ [(0,0),(5,0),(0,5)]   ,  [(0,0),(5,0),(0,6)]     ],
   [ [(0,0),(0,5),(5,0)]   ,  [(0,0),(0,5),(5,0)]     ],
   [ [(0,0),(5,0),(0,5)]   ,  [(-10,0),(-5,0),(-1,6)] ],
   [ [(0,0),(5,0),(2.5,5)] ,  [ (0,4),(2.5,-1),(5,4)] ],
   [ [(0,0),(1,1),(0,2)]   ,  [(2,1),(3,0),(3,2)]     ],
   [ [(0,0),(1,1),(0,2)]   ,  [(2,1),(3,-2),(3,4)]    ],
   [ [(0,0),(1,0),(0,1)]   ,  [(1,0),(2,0),(1,1)]     ]
];

if-overlap $_ for DATA ;


/* REXX */
Signal On Halt
Signal On Novalue
Signal On Syntax

fid='trio.in'
oid='trio.txt'; 'erase' oid

Call trio_test '0 0   5 0   0 5   0 0   5  0   0 6'
Call trio_test '0 0   0 5   5 0   0 0   0  5   5 0'
Call trio_test '0 0   5 0   0 5 -10 0  -5  0  -1 6'
Call trio_test '0 0   5 0 2.5 5   0 4 2.5 -1   5 4'
Call trio_test '0 0   1 1   0 2   2 1   3  0   3 2'
Call trio_test '0 0   1 1   0 2   2 1   3 -2   3 4'
Call trio_test '0 0   1 0   0 1   1 0   2  0   1 1'

Call trio_test '1 0   3 0   2 2   1 3   3  3   2 5'
Call trio_test '1 0   3 0   2 2   1 3   3  3   2 2'
Call trio_test '0 0   2 0   2 2   3 3   5  3   5 5'
Call trio_test '2 0   2 6   1 8   0 1   0  5   8 3'
Call trio_test '0 0   4 0   0 4   0 2   2  0   2 2'
Call trio_test '0 0   4 0   0 4   1 1   2  1   1 2'
Exit

trio_test:
parse Arg tlist
tlist=space(tlist)
Parse Arg ax ay bx by cx cy dx dy ex ey fx fy

Say 'ABC:' show_p(ax ay) show_p(bx by) show_p(cx cy)
Say 'DEF:' show_p(dx dy) show_p(ex ey) show_p(fx fy)

bordl=bord(tlist)  /* corners that are on the other triangle's edges */
If bordl<>'' Then
  Say 'Corners on the other triangle''s edges:' bordl
wb=words(bordl)                     /* how many of them?             */
Select
  When wb=3 Then Do                 /* all three match               */
    If ident(ax ay,bx by,cx cy,dx dy,ex ey,fx fy) Then
      Say 'Triangles are identical'
    Else
      Say 'Triangles overlap'
    Say ''
    Return
    End
  When wb=2 Then Do                 /* two of them match             */
    Say 'Triangles overlap'
    Say '  they have a common edge 'bordl
    Say ''
    Return
    End
  When wb=1 Then Do                 /* one of them match             */
    Say 'Triangles touch on' bordl  /* other parts may overlap       */
    Say '  we analyze further'
    End
  Otherwise                         /* we know nothing yet           */
    Nop
  End

trio_result=trio(tlist)             /* any other overlap?            */

Select
  When trio_result=0 Then Do        /* none whatsoever               */
    If wb=1 Then
      Say 'Triangles touch (border case) at' show_p(bordl)
    Else
      Say 'Triangles don''t overlap'
    End
  When trio_result>0 Then           /* plain overlapping case        */
    Say 'Triangles overlap'
  End
Say ''
Return

trio:
/*---------------------------------------------------------------------
* Determine if two triangles overlap
*--------------------------------------------------------------------*/
parse Arg tlist
Parse Arg pax pay pbx pby pcx pcy pdx pdy pex pey pfx pfy

abc=subword(tlist,1,6)
def=subword(tlist,7,6)

Do i=1 To 3
  s.i=subword(abc abc,i*2-1,4)
  t.i=subword(def def,i*2-1,4)
  End

abc_=''
def_=''

Do i=1 To 3
  abc.i=subword(abc,i*2-1,2)   /* corners of ABC */
  def.i=subword(def,i*2-1,2)   /* corners of DEF */
  Parse Var abc.i x y; abc_=abc_ '('||x','y')'
  Parse Var def.i x y; def_=def_ '('||x','y')'
  End
Call o 'abc_='abc_
Call o 'def_='def_

over=0
  Do i=1 To 3 Until over
    Do j=1 To 3 Until over
      If ssx(s.i t.j) Then Do       /* intersection of two edges     */
        over=1
        Leave
        End
      End
    End

If over=0 Then Do                   /* no edge intersection found    */
  Do ii=1 To 3 Until over           /* look for first possibility    */
    Call o '    '  'abc.'ii'='abc.ii 'def='def
    Call o 'ii='ii 'def.'ii'='def.ii 'abc='abc
    If in_tri(abc.ii,def) Then Do   /* a corner of ABC is in DEF     */
      Say abc.ii 'is within' def
      over=1
      End
    Else If in_tri(def.ii,abc) Then Do  /* a corner of DEF is in ABC */
      Say def.ii 'is within' abc
      over=1
      End
    End
  End

If over=0 Then rw='don''t '
Else rw=''

Call o 'Triangles' show_p(pax pay) show_p(pbx pby) show_p(pcx pcy),
             'and' show_p(pdx pdy) show_p(pex pey) show_p(pfx pfy),
                                                            rw'overlap'
Call o ''
Return over

ssx: Procedure Expose oid bordl
/*---------------------------------------------------------------------
* Intersection of 2 line segments A-B and C-D
*--------------------------------------------------------------------*/
Parse Arg xa ya xb yb xc yc xd yd

d=ggx(xa ya xb yb xc yc xd yd)

Call o 'ssx:' arg(1) d
res=0
Select
  When d='-' Then res=0
  When d='I' Then Do
    If xa<>xb Then Do
      xab_min=min(xa,xb)
      xcd_min=min(xc,xd)
      xab_max=max(xa,xb)
      xcd_max=max(xc,xd)
      If xab_min>xcd_max |,
         xcd_min>xab_max Then
        res=0
      Else Do
        res=1
        Select
          When xa=xc & isb(xc,xb,xd)=0 Then Do; x=xa; y=ya; End
          When xb=xc & isb(xc,xa,xd)=0 Then Do; x=xb; y=yb; End
          When xa=xd & isb(xc,xb,xd)=0 Then Do; x=xa; y=ya; End
          When xb=xd & isb(xc,xa,xd)=0 Then Do; x=xb; y=yb; End
          Otherwise Do
            x='*'
            y=ya
            End
          End
        Call o  'ssx:' x y
        End
      End
    Else Do
      yab_min=min(ya,yb)
      ycd_min=min(yc,yd)
      yab_max=max(ya,yb)
      ycd_max=max(yc,yd)
      If yab_min>ycd_max |,
         ycd_min>yab_max Then
        res=0
      Else Do
        res=1
        x=xa
        y='*'
        Parse Var bordl x_bord '/' y_bord
        If x=x_bord Then Do
          Call o  xa'/* IGNORED'
          res=0
          End
        End
      End
    End
  Otherwise Do
    Parse Var d x y
    If is_between(xa,x,xb) &,
       is_between(xc,x,xd) &,
       is_between(ya,y,yb) &,
       is_between(yc,y,yd) Then Do
      If x'/'y<>bordl Then
        res=1
      End
    End
  End
  If res=1 Then Do
    Say 'Intersection of line segments: ('||x'/'y')'
    Parse Var bordl x_bord '/' y_bord
    If x=x_bord Then Do
      res=0
      Call o x'/'y 'IGNORED'
      End
    End
  Else Call o  'ssx: -'
Return res

ggx: Procedure Expose oid bordl
/*---------------------------------------------------------------------
* Intersection of 2 (straight) lines
*--------------------------------------------------------------------*/
Parse Arg xa ya xb yb xc yc xd yd
res=''
If xa=xb Then Do
  k1='*'
  x1=xa
  If ya=yb Then Do
    res='Points A and B are identical'
    rs='*'
    End
  End
Else Do
  k1=(yb-ya)/(xb-xa)
  d1=ya-k1*xa
  End
If xc=xd Then Do
  k2='*'
  x2=xc
  If yc=yd Then Do
    res='Points C and D are identical'
    rs='*'
    End
  End
Else Do
  k2=(yd-yc)/(xd-xc)
  d2=yc-k2*xc
  End

If res='' Then Do
  If k1='*' Then Do
    If k2='*' Then Do
      If x1=x2 Then Do
        res='Lines AB and CD are identical'
        rs='I'
        End
      Else Do
        res='Lines AB and CD are parallel'
        rs='-'
        End
      End
    Else Do
      x=x1
      y=k2*x+d2
      End
    End
  Else Do
    If k2='*' Then Do
      x=x2
      y=k1*x+d1
      End
    Else Do
      If k1=k2 Then Do
        If d1=d2 Then Do
          res='Lines AB and CD are identical'
          rs='I'
          End
        Else Do
          res='Lines AB and CD are parallel'
          rs='-'
          End
        End
      Else Do
        x=(d2-d1)/(k1-k2)
        y=k1*x+d1
        End
      End
    End
  End
  If res='' Then Do
    res='Intersection is ('||x'/'y')'
    rs=x y
    Call o 'line intersection' x y
    End
  Call o 'A=('xa'/'ya') B=('||xb'/'yb') C=('||xc'/'yc') D=('||xd'/'yd')' '-->' res
  Return rs

isb: Procedure
  Parse Arg a,b,c
  Return sign(b-a)<>sign(b-c)

is_between: Procedure Expose oid
  Parse Arg a,b,c
  Return diff_sign(b-a,b-c)

diff_sign: Procedure
  Parse Arg diff1,diff2
  Return (sign(diff1)<>sign(diff2))|(sign(diff1)=0)

o:
/*y 'sigl='sigl */
Return lineout(oid,arg(1))

in_tri: Procedure Expose oid bordl
/*---------------------------------------------------------------------
* Determine if the point (px/py) is within the given triangle
*--------------------------------------------------------------------*/
Parse Arg px py,ax ay bx by cx cy
abc=ax ay bx by cx cy
res=0
maxx=max(ax,bx,cx)
minx=min(ax,bx,cx)
maxy=max(ay,by,cy)
miny=min(ay,by,cy)

If px>maxx|px<minx|py>maxy|py<miny Then
  Return 0

Parse Value mk_g(ax ay,bx by) With k.1 d.1 x.1
Parse Value mk_g(bx by,cx cy) With k.2 d.2 x.2
Parse Value mk_g(cx cy,ax ay) With k.3 d.3 x.3
/*
say 'g1:' show_g(k.1,d.1,x.1)
say 'g2:' show_g(k.2,d.2,x.2)
say 'g3:' show_g(k.3,d.3,x.3)
Say px py '-' ax ay bx by cx cy
*/
Do i=1 To 3
  Select
    When k.i='*' Then
      Call o 'g.'i':' 'x='||x.i
    When k.i=0 Then
      Call o 'g.'i':' 'y='d.i
    Otherwise
      Call o 'g.'i':' 'y=' k.i'*x'dd(d.i)
    End
  End

If k.1='*' Then Do
  y2=k.2*px+d.2
  y3=k.3*px+d.3
  If is_between(y2,py,y3) Then
    res=1
  End
Else Do
  kp1=k.1
  dp1=py-kp1*px
  If k.2='*' Then
    x12=x.2
  Else
    x12=(d.2-dp1)/(kp1-k.2)
  If k.3='*' Then
    x13=x.3
  Else
    x13=(d.3-dp1)/(kp1-k.3)
  If is_between(x12,px,x13) Then
    res=1
  End

If res=1 Then rr=' '
         Else rr=' not '
If pos(px'/'py,bordl)>0 Then Do
  ignored=' but is IGNORED'
  res=0
  End
Else
  ignored=''
Say 'P ('px','py') is'rr'in' abc  ignored
Return res

bord:
/*---------------------------------------------------------------------
* Look for corners of triangles that are situated
* on the edges of the other triangle
*--------------------------------------------------------------------*/
parse Arg tlist
Parse Arg pax pay pbx pby pcx pcy pdx pdy pex pey pfx pfy
bordl=''
abc=subword(tlist,1,6)
def=subword(tlist,7,6)

Do i=1 To 3
  s.i=subword(abc abc,i*2-1,4)
  t.i=subword(def def,i*2-1,4)
  End

abc_=''
def_=''
Do i=1 To 3
  abc.i=subword(abc,i*2-1,2)
  def.i=subword(def,i*2-1,2)
  Parse Var abc.i x y; abc_=abc_ '('||x','y')'
  Parse Var def.i x y; def_=def_ '('||x','y')'
  End

Do i=1 To 3
  i1=i+1
  If i1=4 Then i1=1
  Parse Value mk_g(abc.i,abc.i1) With k.1.i d.1.i x.1.i
  Parse Value mk_g(def.i,def.i1) With k.2.i d.2.i x.2.i
  End
Do i=1 To 3
  Call o  show_g(k.1.i,d.1.i,x.1.i)
  End
Do i=1 To 3
  Call o  show_g(k.2.i,d.2.i,x.2.i)
  End

pl=''
Do i=1 To 3
  p=def.i
  Do j=1 To 3
    j1=j+1
    If j1=4 Then j1=1
    g='1.'j
    If in_segment(p,abc.j,abc.j1) Then Do
      pp=Translate(p,'/',' ')
      If wordpos(pp,bordl)=0 Then
        bordl=bordl pp
      End
    Call o  show_p(p) show_g(k.g,d.g,x.g) '->' bordl
    End
  End
Call o  'Points on abc:' pl

pl=''
Do i=1 To 3
  p=abc.i
  Do j=1 To 3
    j1=j+1
    If j1=4 Then j1=1
    g='2.'j
    If in_segment(p,def.j,def.j1)Then Do
      pp=Translate(p,'/',' ')
      If wordpos(pp,bordl)=0 Then
        bordl=bordl pp
      End
    Call o  show_p(p) show_g(k.g,d.g,x.g) '->' bordl
    End
  End
Call o  'Points on def:' pl

Return bordl

in_segment: Procedure Expose g. sigl
/*---------------------------------------------------------------------
* Determine if point x/y is on the line segment ax/ay bx/by
*--------------------------------------------------------------------*/
Parse Arg x y,ax ay,bx by
Call show_p(x y) show_p(ax ay) show_p(bx by)
Parse Value mk_g(ax ay,bx by) With gk gd gx
Select
  When gx<>'' Then
    res=(x=gx & is_between(ay,y,by))
  When gk='*' Then
    res=(y=gd & is_between(ax,x,bx))
  Otherwise Do
    yy=gk*x+gd
    res=(y=yy & is_between(ax,x,bx))
    End
  End
Return res

mk_g: Procedure Expose g.
/*---------------------------------------------------------------------
* given two points (a and b)
* compute y=k*x+d or, if a vertical line, k='*'; x=c
*--------------------------------------------------------------------*/
Parse Arg a,b                       /* 2 points                      */
Parse Var a ax ay
Parse Var b bx by
If ax=bx Then Do                    /* vertical line                 */
  gk='*'                            /* special slope                 */
  gx=ax                             /* x=ax is  the equation         */
  gd='*'                            /* not required                  */
  End
Else Do
  gk=(by-ay)/(bx-ax)                /* compute slope                 */
  gd=ay-gk*ax                       /* compute y-distance            */
  gx=''                             /* not required                  */
  End
Return gk gd gx

is_between: Procedure
  Parse Arg a,b,c
  Return diff_sign(b-a,b-c)

diff_sign: Procedure
  Parse Arg diff1,diff2
  Return (sign(diff1)<>sign(diff2))|(sign(diff1)=0)

show_p: Procedure
  Call trace 'O'
  Parse Arg x y
  If pos('/',x)>0 Then
    Parse Var x x '/' y
  Return space('('||x'/'y')',0)

isb: Procedure Expose oid
  Parse Arg a,b,c
  Return sign(b-a)<>sign(b-c)

o: Call o  arg(1)
   Return

show_g: Procedure
/*---------------------------------------------------------------------
* given slope, y-distance, and (special) x-value
* compute y=k*x+d or, if a vertical line, k='*'; x=c
*--------------------------------------------------------------------*/
Parse Arg k,d,x
Select
  When k='*' Then res='x='||x       /* vertical line                 */
  When k=0   Then res='y='d         /* horizontal line               */
  Otherwise Do                      /* ordinary line                 */
    Select
      When k=1  Then res='y=x'dd(d)
      When k=-1 Then res='y=-x'dd(d)
      Otherwise      res='y='k'*x'dd(d)
      End
    End
  End
Return res

dd: Procedure
/*---------------------------------------------------------------------
* prepare y-distance for display
*--------------------------------------------------------------------*/
  Parse Arg dd
  Select
    When dd=0 Then dd=''            /* omit dd if it's zero          */
    When dd<0 Then dd=dd            /* use dd as is (-value)         */
    Otherwise      dd='+'dd         /* prepend '+' to positive dd    */
    End
  Return dd

ident: Procedure
/*---------------------------------------------------------------------
* Determine if the corners ABC match those of DEF (in any order)
*--------------------------------------------------------------------*/
  cnt.=0
  Do i=1 To 6
    Parse Value Arg(i) With x y
    cnt.x.y=cnt.x.y+1
    End
  Do i=1 To 3
    Parse Value Arg(i) With x y
    If cnt.x.y<>2 Then
      Return 0
    End
  Return 1

Novalue:
  Say  'Novalue raised in line' sigl
  Say  sourceline(sigl)
  Say  'Variable' condition('D')
  Signal lookaround

Syntax:
  Say  'Syntax raised in line' sigl
  Say  sourceline(sigl)
  Say  'rc='rc '('errortext(rc)')'

halt:
lookaround:
  If fore() Then Do
    Say  'You can look around now.'
    Trace ?R
    Nop
    End
  Exit 12


require "matrix"

def det2D(p1, p2, p3)
    return p1[0] * (p2[1] - p3[1]) + p2[0] * (p3[1] - p1[1]) + p3[0] * (p1[1] - p2[1])
end

def checkTriWinding(p1, p2, p3, allowReversed)
    detTri = det2D(p1, p2, p3)
    if detTri < 0.0 then
        if allowReversed then
            p2[0], p3[0] = p3[0], p2[0]
            p2[1], p3[1] = p3[1], p2[1]
        else
            raise "Triangle has incorrect winding"
        end
    end
end

def boundaryCollideChk(p1, p2, p3, eps)
    return det2D(p1, p2, p3) < eps
end

def boundaryDoesntCollideChk(p1, p2, p3, eps)
    return det2D(p1, p2, p3) <= eps
end

def triTri2D(t1, t2, eps, allowReversed, onBoundary)
    # Triangles must be expressed anti-clockwise
    checkTriWinding(t1[0], t1[1], t1[2], allowReversed)
    checkTriWinding(t2[0], t2[1], t2[2], allowReversed)

    if onBoundary then
        # Points on the boundary are considered as colliding
        chkEdge = -> (p1, p2, p3, eps) { boundaryCollideChk(p1, p2, p3, eps) }
    else
        # Points on the boundary are not considered as colliding
        chkEdge = -> (p1, p2, p3, eps) { boundaryDoesntCollideChk(p1, p2, p3, eps) }
    end

    # For edge E of triangle 1
    for i in 0..2 do
        j = (i + 1) % 3

        # Check all points of trangle 2 lay on the external side of the edge E. If
        # they do, the triangles do not collide.
        if chkEdge.(t1[i], t1[j], t2[0], eps) and chkEdge.(t1[i], t1[j], t2[1], eps) and chkEdge.(t1[i], t1[j], t2[2], eps) then
            return false
        end
    end

    # For edge E of triangle 2
    for i in 0..2 do
        j = (i + 1) % 3

        # Check all points of trangle 1 lay on the external side of the edge E. If
        # they do, the triangles do not collide.
        if chkEdge.(t2[i], t2[j], t1[0], eps) and chkEdge.(t2[i], t2[j], t1[1], eps) and chkEdge.(t2[i], t2[j], t1[2], eps) then
            return false
        end
    end

    # The triangles collide
    return true
end

def main
    t1 = [Vector[0,0], Vector[5,0], Vector[0,5]]
    t2 = [Vector[0,0], Vector[5,0], Vector[0,6]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, true)]

    t1 = [Vector[0,0], Vector[0,5], Vector[5,0]]
    t2 = [Vector[0,0], Vector[0,5], Vector[5,0]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, true, true)]

    t1 = [Vector[  0,0], Vector[ 5,0], Vector[ 0,5]]
    t2 = [Vector[-10,0], Vector[-5,0], Vector[-1,6]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, true)]

    t1 = [Vector[0,0], Vector[  5, 0], Vector[2.5,5]]
    t2 = [Vector[0,4], Vector[2.5,-1], Vector[  5,4]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, true)]

    t1 = [Vector[0,0], Vector[1,1], Vector[0,2]]
    t2 = [Vector[2,1], Vector[3,0], Vector[3,2]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, true)]

    t1 = [Vector[0,0], Vector[1, 1], Vector[0,2]]
    t2 = [Vector[2,1], Vector[3,-2], Vector[3,4]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, true)]

    # Barely touching
    t1 = [Vector[0,0], Vector[1,0], Vector[0,1]]
    t2 = [Vector[1,0], Vector[2,0], Vector[1,1]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, true)]

    # Barely touching
    t1 = [Vector[0,0], Vector[1,0], Vector[0,1]]
    t2 = [Vector[1,0], Vector[2,0], Vector[1,1]]
    print "Triangle: ", t1, "\n"
    print "Triangle: ", t2, "\n"
    print "overlap: %s\n\n" % [triTri2D(t1, t2, 0.0, false, false)]
end

main()


object Overlap {
  type Point = (Double, Double)

  class Triangle(var p1: Point, var p2: Point, var p3: Point) {
    override def toString: String = s"Triangle: $p1, $p2, $p3"
  }

  def det2D(t: Triangle): Double = {
    val (p1, p2, p3) = (t.p1, t.p2, t.p3)
    p1._1 * (p2._2 - p3._2) +
      p2._1 * (p3._2 - p1._2) +
      p3._1 * (p1._2 - p2._2)
  }

  def checkTriWinding(t: Triangle, allowReversed: Boolean): Unit = {
    val detTri = det2D(t)
    if (detTri < 0.0) {
      if (allowReversed) {
        val a = t.p3
        t.p3 = t.p2
        t.p2 = a
      } else throw new RuntimeException("Triangle has wrong winding direction")
    }
  }

  def boundaryCollideChk(t: Triangle, eps: Double): Boolean = det2D(t) < eps

  def boundaryDoesntCollideChk(t: Triangle, eps: Double): Boolean = det2D(t) <= eps

  def triTri2D(t1: Triangle, t2: Triangle, eps: Double = 0.0, allowReversed: Boolean = false, onBoundary: Boolean = true): Boolean = {
    //triangles must be expressed anti-clockwise
    checkTriWinding(t1, allowReversed)
    checkTriWinding(t2, allowReversed)
    // 'onBoundary' determines whether points on boundary are considered as colliding or not
    val chkEdge = if (onBoundary) Overlap.boundaryCollideChk _ else Overlap.boundaryDoesntCollideChk _
    val lp1 = Array(t1.p1, t1.p2, t1.p3)
    val lp2 = Array(t2.p1, t2.p2, t2.p3)

    // for each edge E of t1
    for (i <- 0 until 3) {
      val j = (i + 1) % 3
      // Check all points of t2 lay on the external side of edge E.
      // If they do, the triangles do not overlap.
      if (chkEdge(new Triangle(lp1(i), lp1(j), lp2(0)), eps)
        && chkEdge(new Triangle(lp1(i), lp1(j), lp2(1)), eps)
        && chkEdge(new Triangle(lp1(i), lp1(j), lp2(2)), eps)) return false
    }

    // for each edge E of t2
    for (i <- 0 until 3) {
      val j = (i + 1) % 3
      // Check all points of t1 lay on the external side of edge E.
      // If they do, the triangles do not overlap.
      if (chkEdge(new Triangle(lp2(i), lp2(j), lp1(0)), eps)
        && chkEdge(new Triangle(lp2(i), lp2(j), lp1(1)), eps)
        && chkEdge(new Triangle(lp2(i), lp2(j), lp1(2)), eps)) return false
    }

    // The triangles overlap
    true
  }

  def main(args: Array[String]): Unit = {
    var t1 = new Triangle((0.0, 0.0), (5.0, 0.0), (0.0, 5.0))
    var t2 = new Triangle((0.0, 0.0), (5.0, 0.0), (0.0, 6.0))
    println(s"$t1 and\n$t2")
    println(if (triTri2D(t1, t2)) "overlap" else "do not overlap")

    // need to allow reversed for this pair to avoid exception
    t1 = new Triangle((0.0, 0.0), (0.0, 5.0), (5.0, 0.0))
    t2 = t1
    println(s"\n$t1 and\n$t2")
    println(if (triTri2D(t1, t2, 0.0, allowReversed = true)) "overlap (reversed)" else "do not overlap")

    t1 = new Triangle((0.0, 0.0), (5.0, 0.0), (0.0, 5.0))
    t2 = new Triangle((-10.0, 0.0), (-5.0, 0.0), (-1.0, 6.0))
    println(s"\n$t1 and\n$t2")
    println(if (triTri2D(t1, t2)) "overlap" else "do not overlap")

    t1.p3 = (2.5, 5.0)
    t2 = new Triangle((0.0, 4.0), (2.5, -1.0), (5.0, 4.0))
    println(s"\n$t1 and\n$t2")
    println(if (triTri2D(t1, t2)) "overlap" else "do not overlap")

    t1 = new Triangle((0.0, 0.0), (1.0, 1.0), (0.0, 2.0))
    t2 = new Triangle((2.0, 1.0), (3.0, 0.0), (3.0, 2.0))
    println(s"\n$t1 and\n$t2")
    println(if (triTri2D(t1, t2)) "overlap" else "do not overlap")

    t2 = new Triangle((2.0, 1.0), (3.0, -2.0), (3.0, 4.0))
    println(s"\n$t1 and\n$t2")
    println(if (triTri2D(t1, t2)) "overlap" else "do not overlap")

    t1 = new Triangle((0.0, 0.0), (1.0, 0.0), (0.0, 1.0))
    t2 = new Triangle((1.0, 0.0), (2.0, 0.0), (1.0, 1.1))
    println(s"\n$t1 and\n$t2")
    println("which have only a single corner in contact, if boundary points collide")
    println(if (triTri2D(t1, t2)) "overlap" else "do not overlap")

    println(s"\n$t1 and\n$t2")
    println("which have only a single corner in contact, if boundary points do not collide")
    println(if (triTri2D(t1, t2, onBoundary = false)) "overlap" else "do not overlap")
  }
}


Module Module1

    Class Triangle
        Property P1 As Tuple(Of Double, Double)
        Property P2 As Tuple(Of Double, Double)
        Property P3 As Tuple(Of Double, Double)

        Sub New(p1 As Tuple(Of Double, Double), p2 As Tuple(Of Double, Double), p3 As Tuple(Of Double, Double))
            Me.P1 = p1
            Me.P2 = p2
            Me.P3 = p3
        End Sub

        Function Det2D() As Double
            Return P1.Item1 * (P2.Item2 - P3.Item2) +
                   P2.Item1 * (P3.Item2 - P1.Item2) +
                   P3.Item1 * (P1.Item2 - P2.Item2)
        End Function

        Sub CheckTriWinding(allowReversed As Boolean)
            Dim detTri = Det2D()
            If detTri < 0.0 Then
                If allowReversed Then
                    Dim a = P3
                    P3 = P2
                    P2 = a
                Else
                    Throw New Exception("Triangle has wrong winding direction")
                End If
            End If
        End Sub

        Function BoundaryCollideChk(eps As Double) As Boolean
            Return Det2D() < eps
        End Function

        Function BoundaryDoesntCollideChk(eps As Double) As Boolean
            Return Det2D() <= eps
        End Function

        Public Overrides Function ToString() As String
            Return String.Format("Triangle: {0}, {1}, {2}", P1, P2, P3)
        End Function
    End Class

    Function TriTri2D(t1 As Triangle, t2 As Triangle, Optional eps As Double = 0.0, Optional alloweReversed As Boolean = False, Optional onBoundary As Boolean = True) As Boolean
        'Triangles must be expressed anti-clockwise
        t1.CheckTriWinding(alloweReversed)
        t2.CheckTriWinding(alloweReversed)

        '"onboundary" determines whether points on boundary are considered as colliding or not
        Dim chkEdge = If(onBoundary, Function(t As Triangle) t.BoundaryCollideChk(eps), Function(t As Triangle) t.BoundaryDoesntCollideChk(eps))
        Dim lp1 As New List(Of Tuple(Of Double, Double)) From {t1.P1, t1.P2, t1.P3}
        Dim lp2 As New List(Of Tuple(Of Double, Double)) From {t2.P1, t2.P2, t2.P3}

        'for each edge E of t1
        For i = 0 To 2
            Dim j = (i + 1) Mod 3
            'Check all points of t2 lay on the external side of edge E.
            'If they do, the triangles do not overlap.
            If chkEdge(New Triangle(lp1(i), lp1(j), lp2(0))) AndAlso
               chkEdge(New Triangle(lp1(i), lp1(j), lp2(1))) AndAlso
               chkEdge(New Triangle(lp1(i), lp1(j), lp2(2))) Then
                Return False
            End If
        Next

        'for each edge E of t2
        For i = 0 To 2
            Dim j = (i + 1) Mod 3
            'Check all points of t1 lay on the external side of edge E.
            'If they do, the triangles do not overlap.
            If chkEdge(New Triangle(lp2(i), lp2(j), lp1(0))) AndAlso
               chkEdge(New Triangle(lp2(i), lp2(j), lp1(1))) AndAlso
               chkEdge(New Triangle(lp2(i), lp2(j), lp1(2))) Then
                Return False
            End If
        Next

        'The triangles overlap
        Return True
    End Function

    Sub Overlap(t1 As Triangle, t2 As Triangle, Optional eps As Double = 0.0, Optional allowReversed As Boolean = False, Optional onBoundary As Boolean = True)
        If TriTri2D(t1, t2, eps, allowReversed, onBoundary) Then
            Console.WriteLine("overlap")
        Else
            Console.WriteLine("do not overlap")
        End If
    End Sub

    Sub Main()
        Dim t1 = New Triangle(Tuple.Create(0.0, 0.0), Tuple.Create(5.0, 0.0), Tuple.Create(0.0, 5.0))
        Dim t2 = New Triangle(Tuple.Create(0.0, 0.0), Tuple.Create(5.0, 0.0), Tuple.Create(0.0, 6.0))
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Overlap(t1, t2)
        Console.WriteLine()

        ' need to allow reversed for this pair to avoid exception
        t1 = New Triangle(Tuple.Create(0.0, 0.0), Tuple.Create(0.0, 5.0), Tuple.Create(5.0, 0.0))
        t2 = t1
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Overlap(t1, t2, 0.0, True)
        Console.WriteLine()

        t1 = New Triangle(Tuple.Create(0.0, 0.0), Tuple.Create(5.0, 0.0), Tuple.Create(0.0, 5.0))
        t2 = New Triangle(Tuple.Create(-10.0, 0.0), Tuple.Create(-5.0, 0.0), Tuple.Create(-1.0, 6.0))
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Overlap(t1, t2)
        Console.WriteLine()

        t1.P3 = Tuple.Create(2.5, 5.0)
        t2 = New Triangle(Tuple.Create(0.0, 4.0), Tuple.Create(2.5, -1.0), Tuple.Create(5.0, 4.0))
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Overlap(t1, t2)
        Console.WriteLine()

        t1 = New Triangle(Tuple.Create(0.0, 0.0), Tuple.Create(1.0, 1.0), Tuple.Create(0.0, 2.0))
        t2 = New Triangle(Tuple.Create(2.0, 1.0), Tuple.Create(3.0, 0.0), Tuple.Create(3.0, 2.0))
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Overlap(t1, t2)
        Console.WriteLine()

        t2 = New Triangle(Tuple.Create(2.0, 1.0), Tuple.Create(3.0, -2.0), Tuple.Create(3.0, 4.0))
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Overlap(t1, t2)
        Console.WriteLine()

        t1 = New Triangle(Tuple.Create(0.0, 0.0), Tuple.Create(1.0, 0.0), Tuple.Create(0.0, 1.0))
        t2 = New Triangle(Tuple.Create(1.0, 0.0), Tuple.Create(2.0, 0.0), Tuple.Create(1.0, 1.1))
        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Console.WriteLine("which have only a single corner in contact, if boundary points collide")
        Overlap(t1, t2)
        Console.WriteLine()

        Console.WriteLine("{0} and", t1)
        Console.WriteLine("{0}", t2)
        Console.WriteLine("which have only a single corner in contact, if boundary points do not collide")
        Overlap(t1, t2, 0.0, False, False)
    End Sub

End Module


struct Point {
    x f64
	y f64
}

fn (p Point) str() string {
    return "(${p.x:.1f}, ${p.y:.1f})"
}

struct Triangle {
mut:
    p1 Point
	p2 Point
	p3 Point
}

fn (t Triangle) str() string {
    return "Triangle $t.p1, $t.p2, $t.p3"
}

fn (t Triangle) det_2d() f64 {
    return t.p1.x * (t.p2.y - t.p3.y) +
           t.p2.x * (t.p3.y - t.p1.y) +
           t.p3.x * (t.p1.y - t.p2.y)
}

fn (mut t Triangle) check_tri_winding(allow_reversed bool) {
    det_tri := t.det_2d()
    if det_tri < 0.0 {
        if allow_reversed {
            a := t.p3
            t.p3 = t.p2
            t.p2 = a
        } else {
            panic("Triangle has wrong winding direction.")
        }
    }
}

fn boundary_collide_chk(t Triangle, eps f64, does bool) bool {
	if does {
    	return t.det_2d() < eps
	}
	return t.det_2d() <= eps
}

fn tri_tri_2d(mut t1 Triangle, mut t2 Triangle, eps f64, allow_reversed bool, on_boundary bool) bool {
    // Triangles must be expressed anti-clockwise.
    t1.check_tri_winding(allow_reversed)
    t2.check_tri_winding(allow_reversed)

    lp1 := [t1.p1, t1.p2, t1.p3]
    lp2 := [t2.p1, t2.p2, t2.p3]

    // for each edge E of t1
    for i in 0..3 {
        j := (i + 1) % 3
        // Check all Points of t2 lay on the external side of edge E.
        // If they do, the Triangles do not overlap.
        tri1 := Triangle{lp1[i], lp1[j], lp2[0]}
        tri2 := Triangle{lp1[i], lp1[j], lp2[1]}
        tri3 := Triangle{lp1[i], lp1[j], lp2[2]}
        if boundary_collide_chk(tri1, eps,on_boundary) && boundary_collide_chk(tri2, eps,on_boundary) && boundary_collide_chk(tri3, eps,on_boundary) {
            return false
        }
    }

    // for each edge E of t2
    for i in 0..3 {
        j := (i + 1) % 3
        // Check all Points of t1 lay on the external side of edge E.
        // If they do, the Triangles do not overlap.
        tri1 := Triangle{lp2[i], lp2[j], lp1[0]}
        tri2 := Triangle{lp2[i], lp2[j], lp1[1]}
        tri3 := Triangle{lp2[i], lp2[j], lp1[2]}
        if boundary_collide_chk(tri1, eps,on_boundary) && boundary_collide_chk(tri2, eps,on_boundary) && boundary_collide_chk(tri3, eps,on_boundary) {
            return false
        }
    }

    // The Triangles overlap.
    return true
}

fn iff(cond bool, s1 string, s2 string) string {
    if cond {
        return s1
    }
    return s2
}

fn main() {
    mut t1 := Triangle{Point{0.0, 0.0}, Point{5.0, 0.0}, Point{0.0, 5.0}}
    mut t2 := Triangle{Point{0.0, 0.0}, Point{5.0, 0.0}, Point{0.0, 6.0}}
    println("\n$t1 and\n$t2")
    mut overlapping := tri_tri_2d(mut t1, mut t2, 0.0, false, true)
    println(iff(overlapping, "overlap", "do not overlap"))

    // Need to allow reversed for this pair to avoid panic.
    t1 = Triangle{Point{0.0, 0.0}, Point{0.0, 5.0}, Point{5.0, 0.0}}
    t2 = t1
    println("\n$t1 and\n$t2")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, true, true)
    println(iff(overlapping, "overlap (reversed)", "do not overlap"))

    t1 = Triangle{Point{0.0, 0.0}, Point{5.0, 0.0}, Point{0.0, 5.0}}
    t2 = Triangle{Point{-10.0, 0.0}, Point{-5.0, 0.0}, Point{-1.0, 6.0}}
    println("\n$t1 and\n$t2")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, false, true)
    println(iff(overlapping, "overlap", "do not overlap"))

    t1.p3 = Point{2.5, 5.0}
    t2 = Triangle{Point{0.0, 4.0}, Point{2.5, -1.0}, Point{5.0, 4.0}}
    println("\n$t1 and\n$t2")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, false, true)
    println(iff(overlapping, "overlap", "do not overlap"))

    t1 = Triangle{Point{0.0, 0.0}, Point{1.0, 1.0}, Point{0.0, 2.0}}
    t2 = Triangle{Point{2.0, 1.0}, Point{3.0, 0.0}, Point{3.0, 2.0}}
    println("\n$t1 and\n$t2")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, false, true)
    println(iff(overlapping, "overlap", "do not overlap"))

    t2 = Triangle{Point{2.0, 1.0}, Point{3.0, -2.0}, Point{3.0, 4.0}}
    println("\n$t1 and\n$t2")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, false, true)
    println(iff(overlapping, "overlap", "do not overlap"))

    t1 = Triangle{Point{0.0, 0.0}, Point{1.0, 0.0}, Point{0.0, 1.0}}
    t2 = Triangle{Point{1.0, 0.0}, Point{2.0, 0.0}, Point{1.0, 1.1}}
    println("\n$t1 and\n$t2")
    println("which have only a single corner in contact, if boundary Points collide")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, false, true)
    println(iff(overlapping, "overlap", "do not overlap"))

    println("\n$t1 and\n$t2")
    println("which have only a single corner in contact, if boundary Points do not collide")
    overlapping = tri_tri_2d(mut t1, mut t2, 0.0, false, false)
    println(iff(overlapping, "overlap", "do not overlap"))
}


import "/dynamic" for Tuple, Struct

var Point = Tuple.create("Point", ["x", "y"])

var Triangle = Struct.create("Triangle", ["p1", "p2", "p3"])

var det2D = Fn.new { |t|
    return t.p1.x * (t.p2.y - t.p3.y) +
           t.p2.x * (t.p3.y - t.p1.y) +
           t.p3.x * (t.p1.y - t.p2.y)
}

var checkTriWinding = Fn.new { |t, allowReversed|
    var detTri = det2D.call(t)
    if (detTri < 0) {
        if (allowReversed) {
           var a = t.p3
	       t.p3  = t.p2
	       t.p2 =  a
        } else Fiber.abort("Triangle has wrong winding direction")
    }
}

var boundaryCollideChk = Fn.new { |t, eps| det2D.call(t) < eps }

var boundaryDoesntCollideChk = Fn.new { |t, eps| det2D.call(t) <= eps }

var triTri2D = Fn.new { |t1, t2, eps, allowReversed, onBoundary|
    // Triangles must be expressed anti-clockwise
    checkTriWinding.call(t1, allowReversed)
    checkTriWinding.call(t2, allowReversed)
    // 'onBoundary' determines whether points on boundary are considered as colliding or not
    var chkEdge = onBoundary ? boundaryCollideChk : boundaryDoesntCollideChk
    var lp1 = [t1.p1, t1.p2, t1.p3]
    var lp2 = [t2.p1, t2.p2, t2.p3]

    // for each edge E of t1
    for (i in 0..2) {
        var j = (i + 1) % 3
        // Check all points of t2 lay on the external side of edge E.
        // If they do, the triangles do not overlap.
	    if (chkEdge.call(Triangle.new(lp1[i], lp1[j], lp2[0]), eps) &&
            chkEdge.call(Triangle.new(lp1[i], lp1[j], lp2[1]), eps) &&
            chkEdge.call(Triangle.new(lp1[i], lp1[j], lp2[2]), eps)) return false
    }

    // for each edge E of t2
    for (i in 0..2) {
        var j = (i + 1) % 3
        // Check all points of t1 lay on the external side of edge E.
        // If they do, the triangles do not overlap.
        if (chkEdge.call(Triangle.new(lp2[i], lp2[j], lp1[0]), eps) &&
            chkEdge.call(Triangle.new(lp2[i], lp2[j], lp1[1]), eps) &&
            chkEdge.call(Triangle.new(lp2[i], lp2[j], lp1[2]), eps)) return false
    }

    // The triangles overlap
    return true
}

var tr = "Triangle: "
var printTris = Fn.new { |t1, t2, nl| System.print("%(nl)%(tr)%(t1) and\n%(tr)%(t2)") }

var t1 = Triangle.new(Point.new(0, 0), Point.new(5, 0), Point.new(0, 5))
var t2 = Triangle.new(Point.new(0, 0), Point.new(5, 0), Point.new(0, 6))
printTris.call(t1, t2, "")
System.print(triTri2D.call(t1, t2, 0, false, true) ? "overlap" : "do not overlap")

// need to allow reversed for this pair to avoid exception
t1 = Triangle.new(Point.new(0, 0), Point.new(0, 5), Point.new(5, 0))
t2 = t1
printTris.call(t1, t2, "\n")
System.print(triTri2D.call(t1, t2, 0, true, true) ? "overlap (reversed)" : "do not overlap")

t1 = Triangle.new(Point.new(0, 0), Point.new(5, 0), Point.new(0, 5))
t2 = Triangle.new(Point.new(-10, 0), Point.new(-5, 0), Point.new(-1, 6))
printTris.call(t1, t2, "\n")
System.print(triTri2D.call(t1, t2, 0, false, true) ? "overlap" : "do not overlap")

t1.p3 = Point.new(2.5, 5)
t2 = Triangle.new(Point.new(0, 4), Point.new(2.5, -1), Point.new(5, 4))
printTris.call(t1, t2, "\n")
System.print(triTri2D.call(t1, t2, 0, false, true) ? "overlap" : "do not overlap")

t1 = Triangle.new(Point.new(0, 0), Point.new(1, 1), Point.new(0, 2))
t2 = Triangle.new(Point.new(2, 1), Point.new(3, 0), Point.new(3, 2))
printTris.call(t1, t2, "\n")
System.print(triTri2D.call(t1, t2, 0, false, true) ? "overlap" : "do not overlap")

t2 = Triangle.new(Point.new(2, 1), Point.new(3, -2), Point.new(3, 4))
printTris.call(t1, t2, "\n")
System.print(triTri2D.call(t1, t2, 0, false, true) ? "overlap" : "do not overlap")

t1 = Triangle.new(Point.new(0, 0), Point.new(1, 0), Point.new(0, 1))
t2 = Triangle.new(Point.new(1, 0), Point.new(2, 0), Point.new(1, 1.1))
printTris.call(t1, t2, "\n")
System.print("which have only a single corner in contact, if boundary points collide")
System.print(triTri2D.call(t1, t2, 0, false, true) ? "overlap" : "do not overlap")

printTris.call(t1, t2, "\n")
System.print("which have only a single corner in contact, if boundary points do not collide")
System.print(triTri2D.call(t1, t2, 0, false, false) ? "overlap" : "do not overlap")


// A triangle is three pairs of points: ( (x,y), (x,y), (x,y) )

fcn det2D(triangle){
   p1,p2,p3 := triangle;
   p1[0]*(p2[1] - p3[1]) + p2[0]*(p3[1] - p1[1]) + p3[0]*(p1[1] - p2[1]);
}
fcn checkTriWinding(triangle,allowReversed){ //-->triangle, maybe new
   detTri:=det2D(triangle);
   if(detTri<0.0){
      if(allowReversed){ p1,p2,p3 := triangle; return(p1,p3,p2); }  // reverse
      else throw(Exception.AssertionError(
		  "triangle has wrong winding direction"));
   }
   triangle	// no change
}
fcn triTri2D(triangle1,triangle2, eps=0.0, allowReversed=False, onBoundary=True){
   // Trangles must be expressed anti-clockwise
   triangle1=checkTriWinding(triangle1, allowReversed);
   triangle2=checkTriWinding(triangle2, allowReversed);

   chkEdge:=
      if(onBoundary) // Points on the boundary are considered as colliding
	 fcn(triangle,eps){ det2D(triangle)<eps }
      else           // Points on the boundary are not considered as colliding
	 fcn(triangle,eps){ det2D(triangle)<=eps };; // first ; terminates if

   t1,t2 := triangle1,triangle2;	// change names to protect the typist
   do(2){				// check triangle1 and then triangle2
      foreach i in (3){	//For edge E of trangle 1,
	 j:=(i+1)%3;	// 1,2,0
	 // Check all points of trangle 2 lay on the external side
	 // of the edge E. If they do, the triangles do not collide.
	 if(chkEdge(T(t1[i],t1[j],t2[0]), eps) and
	    chkEdge(T(t1[i],t1[j],t2[1]), eps) and
	    chkEdge(T(t1[i],t1[j],t2[2]), eps)) return(False);  // no collision
      }
      t2,t1 = triangle1,triangle2; // flip and re-test
   }
   True   // The triangles collide
}


F analyze(s)
   print(‘Examining [’s‘] which has a length of ’s.len‘:’)
   I s.len > 1
      V b = s[0]
      L(c) s
         V i = L.index
         I c != b
            print(‘    Not all characters in the string are the same.’)
            print(‘    '’c‘' (0x’hex(c.code)‘) is different at position ’i)
            R

   print(‘    All characters in the string are the same.’)

V strs = [‘’, ‘   ’, ‘2’, ‘333’, ‘.55’, ‘tttTTT’, ‘4444 444k’]
L(s) strs
   analyze(s)


PROC PrintBH(BYTE a)
  BYTE ARRAY hex=['0 '1 '2 '3 '4 '5 '6 '7 '8 '9 'A 'B 'C 'D 'E 'F]

  Put(hex(a RSH 4))
  Put(hex(a&$0F))
RETURN

PROC Test(CHAR ARRAY s)
  BYTE i,pos

  pos=0
  FOR i=2 TO s(0)
  DO
    IF s(i)#s(1) THEN
      pos=i
      EXIT
    FI
  OD

  PrintF("""%S"" (len=%B) -> ",s,s(0))
  IF pos=0 THEN
    PrintE("all characters are the same.")
  ELSE
    PrintF("""%C"" (hex=$",s(pos))
    PrintBH(s(pos))
    PrintF(") is the first difference at pos. %B.%E",pos)
  FI
  PutE()
RETURN

PROC Main()
  Test("")
  Test("   ")
  Test("2")
  Test("333")
  Test(".55")
  Test("tttTTT")
  Test("4444 444k")
RETURN


with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_All_Chars_Are_Same is
   procedure All_Chars_Are_Same (S : in String) is
      First_Diff : Natural := 0;
   begin
      Put_Line ("Input = """ & S & """, length =" & S'Length'Image);
      for I in S'First + 1 .. S'Last loop
         if S(I) /= S(S'First) then
            First_Diff := I;
            exit;
         end if;
      end loop;
      if First_Diff = 0 then
         Put_Line (" All characters are the same.");
      else
         Put (" First difference at position" & First_Diff'Image &
              ", character = '" & S(First_Diff) &
              "', hex = ");
         Put (Character'Pos (S(First_Diff)), Width => 0, Base => 16);
         New_Line;
      end if;
   end All_Chars_Are_Same;
begin
   All_Chars_Are_Same ("");
   All_Chars_Are_Same ("   ");
   All_Chars_Are_Same ("2");
   All_Chars_Are_Same ("333");
   All_Chars_Are_Same (".55");
   All_Chars_Are_Same ("tttTTT");
   All_Chars_Are_Same ("4444 444k");
end Test_All_Chars_Are_Same;


BEGIN
    # return the position of the first different character in s           #
    #     or UPB s + 1 if all the characters are the same                 #
    OP  FIRSTDIFF = ( STRING s )INT:
        IF UPB s <= LWB s
        THEN
            # 0 or 1 character                                            #
            UPB s + 1
        ELSE
            # two or more characters                                      #
            INT  result := LWB s + 1;
            CHAR c1      = s[ LWB s ];
            FOR s pos FROM LWB s + 1 TO UPB s WHILE s[ s pos ] = c1 DO result +:= 1 OD;
            result
        FI # FIRSTDIFF # ;
    # convert a character to a hex string                                 #
    PROC hex = ( CHAR c )STRING:
        BEGIN
            STRING result := "";
            INT    n      := ABS c;
            IF n = 0
            THEN
                result := "0"
            ELSE
                WHILE n > 0 DO
                    INT d = n MOD 16;
                    n OVERAB 16;
                    IF d < 10
                    THEN REPR ( d + ABS "0" )
                    ELSE REPR ( ( d - 10 ) + ABS "a" )
                    FI +=: result
                OD
            FI;
            result
        END # hex # ;
    # show whether s contains all the same character of the first diff    #
    PROC show first diff = ( STRING s )VOID:
        IF  print( ( """", s, """ (length ", whole( ( UPB s + 1 ) - LWB s, 0 ), "): " ) );
            INT diff pos = FIRSTDIFF s;
            diff pos > UPB s
        THEN
            # all characters the same                                     #
            print( ( "all characters are the same", newline ) )
        ELSE
            # not all characters are the same                             #
            print( ( "first different character """
                   , s[ diff pos ]
                   , """(0x", hex( s[ diff pos ] )
                   , ") at position: "
                   , whole( diff pos, 0 )
                   , newline
                   )
                 )
        FI # show first diff # ;
    # task test cases                                                     #
    show first diff( ""          );
    show first diff( "   "       );
    show first diff( "2"         );
    show first diff( "333"       );
    show first diff( ".55"       );
    show first diff( "tttTTT"    );
    show first diff( "4444 444k" );
    show first diff( "4444|444k" )
END


strings: [
    "", "   ", "2", "333", ".55", "tttTTT",
    "4444   444k", "pépé", "🐶🐶🐺🐶", "🎄🎄🎄🎄"
]

allSameChars?: function [str][
    if empty? str -> return ø
    current: first str
    loop.with:'i str 'ch [
        if ch <> current -> return i
    ]
    return ø
]

loop strings 's [
    prints ["\"" ++ s ++ "\"" ~"(size |size s|):"]
    firstNotSame: allSameChars? s
    if? null? firstNotSame -> print "all the same."
    else -> print ~"first different char `|get s firstNotSame|` at position |firstNotSame|."
]


testCases := ["", "   ", "2", "333", ".55", "tttTTT", "4444 4444k"]
for key, str in testCases {
	MsgBox % "Examining `'" str "`' which has a length of " StrLen(str) ":`n"
	if (StrLen(str) == 0) or (StrLen(str) == 1) {
		MsgBox % "  All characters in the string are the same.`n"
		continue
	}
	firstChar := SubStr(str, 1, 1)
	Loop, Parse, str
	{
		if (firstChar != A_LoopField) {
			hex := Format("0x{:x}", Ord(A_LoopField))
			MsgBox % "  Not all characters in the string are the same.`n  Character `'" A_LoopField "`' (" hex ") is different at position " A_Index ".`n", *
			break
		}
		if (A_Index = StrLen(str))
			MsgBox % "  All characters in the string are the same.`n", *
	}
}


# syntax: GAWK -f DETERMINE_IF_A_STRING_HAS_ALL_THE_SAME_CHARACTERS.AWK
BEGIN {
    for (i=0; i<=255; i++) { ord_arr[sprintf("%c",i)] = i } # build array[character]=ordinal_value
    n = split(",   ,2,333,.55,tttTTT,4444 444k",arr,",")
    for (i in arr) {
      width = max(width,length(arr[i]))
    }
    width += 2
    fmt = "| %-*s | %-6s | %-8s | %-8s | %-3s | %-8s |\n"
    head1 = head2 = sprintf(fmt,width,"string","length","all same","1st diff","hex","position")
    gsub(/[^|\n]/,"-",head1)
    printf(head1 head2 head1) # column headings
    for (i=1; i<=n; i++) {
      main(arr[i])
    }
    printf(head1) # column footing
    exit(0)
}
function main(str,  c,first_diff,hex,i,leng,msg,position) {
    msg = "yes"
    leng = length(str)
    for (i=1; i<leng; i++) {
      c = substr(str,i+1,1)
      if (substr(str,i,1) != c) {
        msg = "no"
        first_diff = "'" c "'"
        hex = sprintf("%2X",ord_arr[c])
        position = i + 1
        break
      }
    }
    printf(fmt,width,"'" str "'",leng,msg,first_diff,hex,position)
}
function max(x,y) { return((x > y) ? x : y) }


10 'SAVE"SAMECHAR", A
20 DEFINT A-Z
30 DATA "","   ","2","333",".55","tttTTT","4444 444k", "FIN"
40 ' Main program cycle
50 CLS
60 PRINT "Program SameChar"
70 PRINT "Determines if a string has the same character or not."
80 PRINT
90 WHILE S$<>"FIN"
100   READ S$
110   IF S$="FIN" THEN 150
120   GOSUB 190  ' Revision subroutine
130   PRINT "'";S$;"' of length";LEN(S$);
140   IF I<2 THEN PRINT "contains all the same character." ELSE PRINT "is different at possition";STR$(I);": '";DC$; "' (0x"; HEX$(ASC(DC$)); ")"
150 WEND
160 PRINT
170 PRINT "End of program run."
180 END
190 ' DifChar subroutine
200   C$ = LEFT$(S$,1)
210   I = 1
220   DC$=""
230   WHILE I<LEN(S$) AND DC$=""
240     IF MID$(S$,I,1)<>C$ THEN DC$=MID$(S$,I,1) ELSE I=I+1
250   WEND
260   IF DC$="" THEN I=1
270 RETURN


get "libhdr"

let diffchar(s) = valof
$(  for i=2 to s%0
        unless s%i = s%1 resultis i
    resultis 0
$)

let show(s) be
$(  let i = diffchar(s)
    writef("*"%S*" (length %N): ", s, s%0)
    test i=0
        do writes("all the same.*N")
        or writef("'%C' at index %N.*N", s%i, i)
$)

let start() be
$(  show("")
    show("   ")
    show("2")
    show("333")
    show(".55")
    show("tttTTT")
    show("4444 444k")
$)


#include<string.h>
#include<stdio.h>

int main(int argc,char** argv)
{
    int i,len;
    char reference;

    if(argc>2){
        printf("Usage : %s <Test String>\n",argv[0]);
        return 0;
    }

    if(argc==1||strlen(argv[1])==1){
        printf("Input string : \"%s\"\nLength : %d\nAll characters are identical.\n",argc==1?"":argv[1],argc==1?0:(int)strlen(argv[1]));
        return 0;
    }

    reference = argv[1][0];
    len = strlen(argv[1]);

    for(i=1;i<len;i++){
        if(argv[1][i]!=reference){
            printf("Input string : \"%s\"\nLength : %d\nFirst different character : \"%c\"(0x%x) at position : %d\n",argv[1],len,argv[1][i],argv[1][i],i+1);
            return 0;
        }
    }

    printf("Input string : \"%s\"\nLength : %d\nAll characters are identical.\n",argv[1],len);

    return 0;

}


using System;

namespace AllSame {
    class Program {
        static void Analyze(string s) {
            Console.WriteLine("Examining [{0}] which has a length of {1}:", s, s.Length);
            if (s.Length > 1) {
                var b = s[0];
                for (int i = 1; i < s.Length; i++) {
                    var c = s[i];
                    if (c != b) {
                        Console.WriteLine("    Not all characters in the string are the same.");
                        Console.WriteLine("    '{0}' (0x{1:X02}) is different at position {2}", c, (int)c, i);
                        return;
                    }
                }

            }
            Console.WriteLine("    All characters in the string are the same.");
        }

        static void Main() {
            var strs = new string[] { "", "   ", "2", "333", ".55", "tttTTT", "4444 444k" };
            foreach (var str in strs) {
                Analyze(str);
            }
        }
    }
}


#include <iostream>
#include <string>

void all_characters_are_the_same(const std::string& str) {
    size_t len = str.length();
    std::cout << "input: \"" << str << "\", length: " << len << '\n';
    if (len > 0) {
        char ch = str[0];
        for (size_t i = 1; i < len; ++i) {
            if (str[i] != ch) {
                std::cout << "Not all characters are the same.\n";
                std::cout << "Character '" << str[i]
                    << "' (hex " << std::hex << static_cast<unsigned int>(str[i])
                    << ") at position " << std::dec << i + 1
                    << " is not the same as '" << ch << "'.\n\n";
                return;
            }
        }
    }
    std::cout << "All characters are the same.\n\n";
}

int main() {
    all_characters_are_the_same("");
    all_characters_are_the_same("   ");
    all_characters_are_the_same("2");
    all_characters_are_the_same("333");
    all_characters_are_the_same(".55");
    all_characters_are_the_same("tttTTT");
    all_characters_are_the_same("4444 444k");
    return 0;
}


(defn check-all-chars-same [s]
  (println (format "String (%s) of len: %d" s (count s)))
  (let [num-same (-> (take-while #(= (first s) %) s)
                     count)]
    (if (= num-same (count s))
      (println "...all characters the same")
      (println (format "...character %d differs - it is 0x%x"
                       num-same
                       (byte (nth s num-same)))))))

  (map check-all-chars-same
         [""
          "   "
          "2"
          "333"
          ".55"
          "tttTTT"
          "4444 444k"])


(defun strequ (&rest str)
    (if (not str) (setf str (list "" "   " "2" "333" ".55" "tttTTT" "4444 444k")))
    (dolist (s str)
        (do ((i 0 (1+ i)))
            ((cond
                ((= i (length s))
                    (format t "\"~a\" [~d] : All characters are identical.~%" s (length s)) t)
                ((char/= (char s i) (char s 0))
                    (format t "\"~a\" [~d] : '~c' (0x~0x) at index ~d is different.~%" s (length s) (char s i) (char-int (char s i)) i) t))))))


import std.stdio;

void analyze(string s) {
    writefln("Examining [%s] which has a length of %d:", s, s.length);
    if (s.length > 1) {
        auto b = s[0];
        foreach (i, c; s[1..$]) {
            if (c != b) {
                writeln("    Not all characters in the string are the same.");
                writefln("    '%c' (0x%x) is different at position %d", c, c, i);
                return;
            }
        }
    }
    writeln("    All characters in the string are the same.");
}

void main() {
    auto strs = ["", "   ", "2", "333", ".55", "tttTTT", "4444 444k"];
    foreach (str; strs) {
        analyze(str);
    }
}


program Determine_if_a_string_has_all_the_same_characters;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

procedure Analyze(s: string);
var
  b, c: char;
  i: Integer;
begin
  writeln(format('Examining [%s] which has a length of %d:', [s, s.Length]));
  if s.Length > 1 then
  begin
    b := s[1];
    for i := 2 to s.Length - 1 do
    begin
      c := s[i];
      if c <> b then
      begin
        writeln('    Not all characters in the string are the same.');
        writeln(format('    "%s" 0x%x is different at position %d', [c, Ord(c), i]));
        Exit;
      end;
    end;
  end;
  writeln('    All characters in the string are the same.');
end;

var
  TestCases: array of string = ['', '   ', '2', '333', '.55', 'tttTTT', '4444 444k'];
  w: string;

begin
  for w in TestCases do
    Analyze(w);
  Readln;
end.


-module(string_examples).
-export([examine_all_same/1, all_same_examples/0]).

all_same_characters([], _Offset) ->
    all_same;
all_same_characters([_], _Offset) ->
    all_same;
all_same_characters([X, X | Rest], Offset) ->
    all_same_characters([X | Rest], Offset + 1);
all_same_characters([X, Y | _Rest], Offset) when X =/= Y ->
    {not_all_same, Y, Offset + 1}.

examine_all_same(String) ->
    io:format("String \"~ts\" of length ~p:~n", [String, length(String)]),
    case all_same_characters(String, 0) of
        all_same ->
            io:format("  All characters are the same.~n~n");
        {not_all_same, OffendingChar, Offset} ->
            io:format("  Not all characters are the same.~n"),
            io:format("  Char '~tc' (0x~.16b) at offset ~p differs.~n~n",
                      [OffendingChar, OffendingChar, Offset])
    end.

all_same_examples() ->
    Strings = ["",
               "   ",
               "2",
               "333",
               ".55",
               "tttTTT",
               "4444 444k",
               "pépé",
               "🐶🐶🐺🐶",
               "🎄🎄🎄🎄"],
    lists:foreach(fun examine_all_same/1, Strings).


// Determine if a string has all the same characters. Nigel Galloway: June 9th., 2020
let fN n=if String.length n=0 then None else n.ToCharArray()|>Array.tryFindIndex(fun g->g<>n.[0])

let allSame n=match fN n with
               Some g->printfn "First different character in <<<%s>>> (length %d) is hex %x at position %d" n n.Length (int n.[g]) g
              |_->printfn "All Characters are the same in <<<%s>>> (length %d)" n n.Length

allSame ""
allSame "   "
allSame "2"
allSame "333"
allSame ".55"
allSame "tttTTT"
allSame "4444 444k"


USING: formatting io kernel math.parser sequences ;

: find-diff ( str -- i elt ) dup ?first [ = not ] curry find ;
: len. ( str -- ) dup length "%u — length %d — " printf ;
: same. ( -- ) "contains all the same character." print ;
: diff. ( -- ) "contains a different character at " write ;

: not-same. ( i elt -- )
    dup >hex diff. "index %d: '%c' (0x%s)\n" printf ;

: sameness-report. ( str -- )
    dup len. find-diff dup [ not-same. ] [ 2drop same. ] if ;

{
    ""
    "   "
    "2"
    "333"
    ".55"
    "tttTTT"
    "4444 444k"
} [ sameness-report. ] each


program demo_verify
implicit none
    call homogeneous('')
    call homogeneous('2')
    call homogeneous('333')
    call homogeneous('.55')
    call homogeneous('tttTTT')
    call homogeneous('4444  444k')
contains

subroutine homogeneous(str)
character(len=*),intent(in)  :: str
character(len=:),allocatable :: ch
character(len=*),parameter   :: g='(*(g0))'
integer :: where
   if(len(str)>0)then;ch=str(1:1);else;ch='';endif
   where=verify(str,ch)
   if(where.eq.0)then
     write(*,g)'STR: "',str,'" LEN: ',len(str),'. All chars are a ','"'//ch//'"'
   else
     write(*,g)'STR: "',str,'" LEN: ',len(str), &
     & '. Multiple chars found. First difference at position ',where, &
     & ' where a ','"'//str(where:where)//'"(hex:',hex(str(where:where)),') was found.'
     write(*,g)repeat(' ',where+5),'^'
   endif
end subroutine homogeneous

function hex(ch) result(hexstr)
character(len=1),intent(in) :: ch
character(len=:),allocatable :: hexstr
   hexstr=repeat(' ',100)
   write(hexstr,'(Z0)')ch
   hexstr=trim(hexstr)
end function hex

end program demo_verify


dim as string s, nxt

input "Enter string:  ", s

if len(s)<2 then   'A string with one or zero characters passes by default
    print "All characters are the same."
    end
end if

dim as ubyte i

for i = 1 to len(s)-1
    nxt = mid(s, i+1, 1)
    if mid(s, i, 1)<>nxt then   'if any character differs from the previous one
        print "First non-matching char is "+nxt
        print "It occurs at position "+str(i+1)
        print "Its hex value is "+hex(asc(nxt))
        end
    end if
next i

'otherwise, success!
print "All characters are the same."


package main

import "fmt"

func analyze(s string) {
    chars := []rune(s)
    le := len(chars)
    fmt.Printf("Analyzing %q which has a length of %d:\n", s, le)
    if le > 1 {
        for i := 1; i < le; i++ {
            if chars[i] != chars[i-1] {
                fmt.Println("  Not all characters in the string are the same.")
                fmt.Printf("  %q (%#[1]x) is different at position %d.\n\n", chars[i], i+1)
                return
            }
        }
    }
    fmt.Println("  All characters in the string are the same.\n")
}

func main() {
    strings := []string{
        "",
        "   ",
        "2",
        "333",
        ".55",
        "tttTTT",
        "4444 444k",
        "pépé",
        "🐶🐶🐺🐶",
        "🎄🎄🎄🎄",
    }
    for _, s := range strings {
        analyze(s)
    }
}


class Main {
    static void main(String[] args) {
        String[] tests = ["", "   ", "2", "333", ".55", "tttTTT", "4444 444k"]
        for (String s : tests) {
            analyze(s)
        }
    }

    static void analyze(String s) {
        println("Examining [$s] which has a length of ${s.length()}")
        if (s.length() > 1) {
            char firstChar = s.charAt(0)
            int lastIndex = s.lastIndexOf(firstChar as String)
            if (lastIndex != 0) {
                println("\tNot all characters in the string are the same.")
                println("\t'$firstChar' (0x${Integer.toHexString(firstChar as Integer)}) is different at position $lastIndex")
                return
            }
        }
        println("\tAll characters in the string are the same.")
    }
}


import Numeric (showHex)
import Data.List (span)
import Data.Char (ord)

inconsistentChar :: Eq a => [a] -> Maybe (Int, a)
inconsistentChar [] = Nothing
inconsistentChar xs@(x:_) =
  let (pre, post) = span (x ==) xs
  in if null post
       then Nothing
       else Just (length pre, head post)

---------------------------TEST----------------------------
samples :: [String]
samples = ["   ", "2", "333", ".55", "tttTTT", "4444 444"]

main :: IO ()
main = do
  let w = succ . maximum $ length <$> samples
      justifyRight n c = (drop . length) <*> (replicate n c ++)
      f = (++ "' -> ") . justifyRight w ' ' . ('\'' :)
  (putStrLn . unlines) $
    (\s ->
        maybe
          (f s ++ "consistent")
          (\(n, c) ->
              f s ++
              "inconsistent '" ++
              c : "' (0x" ++ showHex (ord c) ")" ++ " at char " ++ show (succ n))
          (inconsistentChar s)) <$>
    samples


Doc=: 2 : 'u :: (n"_)'

task=: monad define
 common=. (; #) y  NB. the string and its length
 if. same y do.
  common , <'same'
 else.
  i =. differ y
  c =. i { y
  common , <((, (' (' , ') ' ,~ hex))c),'differs at index ',":i
 end.
)

hex=: ((Num_j_,26}.Alpha_j_) {~ 16 16 #: a.&i.)&> Doc 'convert ASCII literals to hex representation'
assert '61' -: hex 'a'


public class Main{
	public static void main(String[] args){
		String[] tests = {"", "   ", "2", "333", ".55", "tttTTT", "4444 444k"};
		for(String s:tests)
			analyze(s);
	}

	public static void analyze(String s){
		System.out.printf("Examining [%s] which has a length of %d:\n", s, s.length());
		if(s.length() > 1){
			char firstChar = s.charAt(0);
			int lastIndex = s.lastIndexOf(firstChar);
			if(lastIndex != 0){
				System.out.println("\tNot all characters in the string are the same.");
				System.out.printf("\t'%c' (0x%x) is different at position %d\n", firstChar, (int) firstChar, lastIndex);
				return;
			}
		}
		System.out.println("\tAll characters in the string are the same.");
	}
}


const check = s => {
  const arr = [...s];
  const at = arr.findIndex(
      (v, i) => i === 0 ? false : v !== arr[i - 1]
  )
  const l = arr.length;
  const ok = at === -1;
  const p = ok ? "" : at + 1;
  const v = ok ? "" : arr[at];
  const vs = v === "" ? v : `"${v}"`
  const h = ok ? "" : `0x${v.codePointAt(0).toString(16)}`;
  console.log(`"${s}" => Length:${l}\tSame:${ok}\tPos:${p}\tChar:${vs}\tHex:${h}`)
}

['', '   ', '2', '333', '.55', 'tttTTT', '4444 444k', '🐶🐶🐺🐶', '🎄🎄🎄🎄'].forEach(check)


jq -rn '

  def firstdifferent:
    label $out
    | foreach explode[] as $i ({index:-1};
        .prev = .i | .i = $i | .index +=1;
        if .prev and $i != .prev then .index, break $out else empty end)
      // null ;

  def lpad($n): " "*($n-length) + "\"\(.)\"" ;

  [" "*10, "length", "same", "index", "char"],
  (inputs
   | firstdifferent as $d
   | [lpad(10), length, ($d == null)] + (if $d then [$d, .[$d:$d+1]] else null end) )
  | @tsv
'


firstdifferent(s) = isempty(s) ? nothing : findfirst(x -> x != s[1], s)

function testfunction(strings)
   println("String                  | Length | All Same | First Different(Hex) | Position\n" *
           "-----------------------------------------------------------------------------")
    for s in strings
        n = firstdifferent(s)
        println(rpad(s, 27), rpad(length(s), 9), n == nothing ? "yes" :
            rpad("no               $(s[n])   ($(string(Int(s[n]), base=16)))", 36) * string(n))
    end
end

testfunction([
	"",
	"   ",
	"2",
	"333",
    ".55",
    "tttTTT",
    "4444 444k",
    "pépé",
    "🐶🐶🐺🐶",
    "🎄🎄🎄🎄",
])


fun analyze(s: String) {
    println("Examining [$s] which has a length of ${s.length}:")
    if (s.length > 1) {
        val b = s[0]
        for ((i, c) in s.withIndex()) {
            if (c != b) {
                println("    Not all characters in the string are the same.")
                println("    '$c' (0x${Integer.toHexString(c.toInt())}) is different at position $i")
                return
            }
        }
    }
    println("    All characters in the string are the same.")
}

fun main() {
    val strs = listOf("", "   ", "2", "333", ".55", "tttTTT", "4444 444k")
    for (str in strs) {
        analyze(str)
    }
}


{def firstDifferingChar
 {def firstDifferingChar.r
  {lambda {:w :i :n}
   {if {or {> :i :n} {= {+ :i 1} {W.length :w}}}
   then all characters are the same
   else {if {not {W.equal? {W.get :i :w} {W.get {+ :i 1} :w}}}
   then at position {+ :i 1} {W.get :i :w} becomes {W.get {+ :i 1} :w}
   else {firstDifferingChar.r :w {+ :i 1} :n}}}}}
 {lambda {:w}
  {if {= {W.length :w} 1}
   then :w is a single character
   else {firstDifferingChar.r :w 0 {W.length :w}}}}}
-> firstDifferingChar

{firstDifferingChar 2}
-> 2 is a single character
{firstDifferingChar 333}
-> all characters are the same
{firstDifferingChar .55}
-> at position 1 . becomes 5
{firstDifferingChar tttTTT}
-> at position 3 t becomes T


function analyze(s)
    print(string.format("Examining [%s] which has a length of %d:", s, string.len(s)))
    if string.len(s) > 1 then
        local last = string.byte(string.sub(s,1,1))
        for i=1,string.len(s) do
            local c = string.byte(string.sub(s,i,i))
            if last ~= c then
                print("    Not all characters in the string are the same.")
                print(string.format("    '%s' (0x%x) is different at position %d", string.sub(s,i,i), c, i - 1))
                return
            end
        end
    end
    print("    All characters in the string are the same.")
end

function main()
    analyze("")
    analyze("   ")
    analyze("2")
    analyze("333")
    analyze(".55")
    analyze("tttTTT")
    analyze("4444 444k")
end

main()


CheckSame:=proc(s)
	local i, index;
	printf("input: \"%s\", length: %a\n", s, StringTools:-Length(s));
	for i from 2 to StringTools:-Length(s) do
		if (s[i - 1] <> s[i]) then
			printf("The given string has different characters.\n");
			printf("The first different character is %a (0x%x) which appears at index %a.\n\n",
			 	  s[i], convert(s[i], 'bytes')[1], i);
			return;
		end if;
	end do;
	# if no difference found
	printf("The given string has all same characters.\n\n");
end proc:

# Test
CheckSame("");
CheckSame("   ");
CheckSame("2");
CheckSame("333");
CheckSame(".55");
CheckSame("tttTTT");
CheckSame("4444 444k");


ClearAll[AllSameCharacters]
AllSameCharacters[s_String] := Module[{c = Characters[s], i = 0, tf},
  If[Length[c] > 1,
    tf = AllTrue[Rest[c], (i++; # == First[c]) &];
    If[tf,
     Print["input = \"", s, "\", Length = ", StringLength[s],
      ", All the same!"]
     ,
     Print["input = \"", s, "\", Length = ", StringLength[s],
      ", Character " <> ToString[i + 1] <>
       " is different from character " <> ToString[i], ", hex = ",
      IntegerString[[email protected][c[[i + 1]]], 16]]
     ]
    ,
    Print["input = \"", s, "\", Length = ", StringLength[s],
     ", All the same!"]
    ];
  ]
AllSameCharacters[""]
AllSameCharacters["   "]
AllSameCharacters["2"]
AllSameCharacters["333"]
AllSameCharacters[".55"]
AllSameCharacters["tttTTT"]
AllSameCharacters["4444 444k"]


F processString(input)
   [Char = Int] charMap
   V dup = Char("\0")
   V index = 0
   V pos1 = -1
   V pos2 = -1
   L(key) input
      index++
      I key C charMap
         dup = key
         pos1 = charMap[key]
         pos2 = index
         L.break
      charMap[key] = index
   V unique = I dup == Char("\0") {‘yes’} E ‘no’
   V diff = I dup == Char("\0") {‘’} E ‘'’dup‘'’
   V hexs = I dup == Char("\0") {‘’} E hex(dup.code)
   V position = I dup == Char("\0") {‘’} E pos1‘ ’pos2
   print(‘#<40  #<6  #<10  #<8  #<3  #<5’.format(input, input.len, unique, diff, hexs, position))

print(‘#<40  #2  #10  #8  #.  #.’.format(‘String’, ‘Length’, ‘All Unique’, ‘1st Diff’, ‘Hex’, ‘Positions’))
print(‘#<40  #2  #10  #8  #.  #.’.format(‘------------------------’, ‘------’, ‘----------’, ‘--------’, ‘---’, ‘---------’))
L(s) [‘’, ‘.’, ‘abcABC’, ‘XYZ ZYX’, ‘1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ’]
   processString(s)


def analyze(s)
    s = str(s)
    println "Examining [" + s + "] which has a length of " + str(len(s)) + ":"

    if len(s) < 2
        println "\tAll characters in the string are the same."
        return
    end

    for i in range(0, len(s) - 2)
        if s[i] != s[i + 1]
            println "\tNot all characters in the string are the same."
            println "\t'" + s[i + 1] + "' " + format("(0x%x)", ord(s[i + 1])) +\
                    " is different at position " + str(i + 2)
            return
        end
    end

    println "\tAll characters in the string are the same."
end

tests = {"", "   ", "2", "333", ".55", "tttTTT", "444 444k"}
for s in tests
   analyze(s)
end


import strformat

proc analyze(str: string) =
    if str.len() > 1:
        var first = str[0]
        for i, c in str:
            if c != first:
                echo "'", str, "': [len: ", str.len(), "] not all characters are the same. starts to differ at index ",
                    i, ": '", first, "' != '", c, "' [", fmt"{ord(c):#x}", "]"
                return
    echo "'", str, "': [len: ", str.len(), "] all characters are the same"

var strings = @["", "   ", "2", "333", ".55", "tttTTT", "4444 444k"]
for str in strings:
    analyze(str)


(*  Task: Determine if a string has all the same characters *)

(*  Create a function that determines whether all characters in a string are identical,
    or returns the index of first different character.

    Using the option type here to combine the functionality.
*)
let str_first_diff_char (s : string) : int option =
    let len = String.length s in
    if len = 0
    then None
    else
    let first = s.[0] in
    let rec helper idx =
        if idx >= len
        then None
        else if s.[idx] = first
        then helper (idx + 1)
        else Some idx
    in
    helper 1
;;

(*  Task display: using format of Ada
    Example:

Input = "333", length = 3
 All characters are the same.
Input = ".55", length = 3
 First difference at position 2, character = '5', hex = 16#35#
*)

let format_answer s =
    let first_line = "Input = \"" ^ s ^ "\", length = " ^ (s |> String.length |> string_of_int) in
    let second_line = match str_first_diff_char s with
        | None -> " All characters are the same."
        | Some idx -> Printf.sprintf " First difference at position %d, character = %C, hex = %#x" (idx+1) s.[idx] (Char.code s.[idx])
    in
    print_endline first_line; print_endline second_line
;;

let _ =
    [""; "   "; "2"; "333"; ".55"; "tttTTT"; "4444 444k"]
    |> List.iter format_answer
;;


PROC PrintBH(BYTE a)
  BYTE ARRAY hex=['0 '1 '2 '3 '4 '5 '6 '7 '8 '9 'A 'B 'C 'D 'E 'F]

  Put(hex(a RSH 4))
  Put(hex(a&$0F))
RETURN

PROC Test(CHAR ARRAY s)
  BYTE i,j,n,pos1,pos2

  pos1=0 pos2=0
  n=s(0)-1
  IF n=255 THEN n=0 FI
  FOR i=1 TO n
  DO
    FOR j=i+1 TO s(0)
    DO
      IF s(j)=s(i) THEN
        pos1=i
        pos2=j
        EXIT
      FI
    OD
    IF pos1#0 THEN
      EXIT
    FI
  OD

  PrintF("""%S"" (len=%B) -> ",s,s(0))
  IF pos1=0 THEN
    PrintE("all characters are unique.")
  ELSE
    PrintF("""%C"" (hex=$",s(pos1))
    PrintBH(s(pos1))
    PrintF(") is duplicated at pos. %B and %B.%E",pos1,pos2)
  FI
  PutE()
RETURN

PROC Main()
  Test("")
  Test(".")
  Test("abcABC")
  Test("XYZ ZYX")
  Test("1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ")
RETURN


with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_All_Chars_Unique is
   procedure All_Chars_Unique (S : in String) is
   begin
      Put_Line ("Input = """ & S & """, length =" & S'Length'Image);
      for I in S'First .. S'Last - 1 loop
         for J in I + 1 .. S'Last loop
            if S(I) = S(J) then
               Put (" First duplicate at positions" & I'Image &
                    " and" & J'Image & ", character = '" & S(I) &
                    "', hex = ");
               Put (Character'Pos (S(I)), Width => 0, Base => 16);
               New_Line;
               return;
            end if;
         end loop;
      end loop;
      Put_Line (" All characters are unique.");
   end All_Chars_Unique;
begin
   All_Chars_Unique ("");
   All_Chars_Unique (".");
   All_Chars_Unique ("abcABC");
   All_Chars_Unique ("XYZ ZYX");
   All_Chars_Unique ("1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ");
end Test_All_Chars_Unique;


BEGIN
    # mode to hold the positions of duplicate characters in a string      #
    MODE DUPLICATE = STRUCT( INT original, first duplicate );
    # finds the first non-unique character in s and returns its position  #
    # and the position of the original character in a DUPLICATE           #
    # if all characters in s are uniue, returns LWB s - 1, UPB s + 1      #
    PROC first duplicate position = ( STRING s )DUPLICATE:
    BEGIN
        BOOL all unique := TRUE;
        INT  o pos      := LWB s - 1;
        INT  d pos      := UPB s + 1;
        FOR i FROM LWB s TO UPB s WHILE all unique DO
            FOR j FROM i + 1 TO UPB s WHILE all unique DO
                IF NOT ( all unique := s[ i ] /= s[ j ] ) THEN
                    o pos := i;
                    d pos := j
                FI
            OD
        OD;
        DUPLICATE( o pos, d pos )
    END # first duplicate position # ;
    # task test cases                                                     #
    []STRING tests = ( "", ".", "abcABC", "XYZ ZYX", "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ" );
    FOR t pos FROM LWB tests TO UPB tests DO
        IF  STRING s    = tests[ t pos ];
            DUPLICATE d = first duplicate position( s );
            print( ( "<<<", s, ">>> (length ", whole( ( UPB s + 1 ) - LWB s, 0 ), "): " ) );
            original OF d < LWB s
        THEN
            print( ( " all characters are unique", newline ) )
        ELSE
            # have at least one duplicate #
            print( ( " first duplicate character: """, s[ original OF d ], """"
                   , " at: ", whole( original OF d, 0 ), " and ", whole( first duplicate OF d, 0 )
                   , newline
                   )
                 )
        FI
    OD
END


program SameNessOfChar;
{$IFDEF FPC}
   {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=16}{$ALIGN 16}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils;//Format
const
  TestData : array[0..6] of String =
     ('','   ','2','333','.55','tttTTT','4444 444k');
function PosOfDifferentChar(const s: String):NativeInt;
var
  i: Nativeint;
  ch:char;
Begin
  result := length(s);
  IF result < 2 then
    EXIT;
  ch := s[1];
  i := 2;
  while (i< result) AND (S[i] =ch) do
    inc(i);
  result := i;
end;

procedure OutIsAllSame(const s: String);
var
  l,len: NativeInt;
Begin
  l := PosOfDifferentChar(s);
  len := Length(s);
  write('"',s,'" of length ',len);
  IF l = len then
    writeln(' contains all the same character')
  else
    writeln(Format(' is different at position %d "%s" (0x%X)',[l,s[l],Ord(s[l])]));
end;

var
  i : NativeInt;
begin
  For i := Low(TestData) to HIgh(TestData) do
    OutIsAllSame(TestData[i]);
end.


use strict;
use warnings;
use feature 'say';
use utf8;
binmode(STDOUT, ':utf8');
use List::AllUtils qw(uniq);
use Unicode::UCD 'charinfo';
use Unicode::Normalize qw(NFC);

for my $str (
    '',
    '   ',
    '2',
    '333',
    '.55',
    'tttTTT',
    '4444 444k',
    'Δ👍👨',
    '🇬🇧🇬🇧🇬🇧🇬🇧',
    "\N{LATIN CAPITAL LETTER A}\N{COMBINING DIAERESIS}\N{COMBINING MACRON}" .
    "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}\N{COMBINING MACRON}" .
    "\N{LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON}"
) {
    my @S;
    push @S, NFC $1 while $str =~ /(\X)/g;
    printf qq{\n"$str" (length: %d) has }, scalar @S;
    my @U = uniq @S;
    if (1 != @U and @U > 0) {
        say 'different characters:';
        for my $l (@U) {
            printf "'%s' %s (0x%x) in positions: %s\n",
                $l, charinfo(ord $l)->{'name'}, ord($l), join ', ', map { 1+$_ } grep { $l eq $S[$_] } 0..$#S;
        }
    } else {
        say 'the same character in all positions.'
    }
}


use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

on run
    script showSource
        on |λ|(s)
            quoted("'", s) & " (" & length of s & ")"
        end |λ|
    end script

    script showDuplicate
        on |λ|(mb)
            script go
                on |λ|(tpl)
                    set {c, ixs} to tpl
                    quoted("'", c) & " at " & intercalate(", ", ixs)
                end |λ|
            end script
            maybe("None", go, mb)
        end |λ|
    end script

    fTable("Indices (1-based) of any duplicated characters:\n", ¬
        showSource, showDuplicate, ¬
        duplicatedCharIndices, ¬
        {"", ".", "abcABC", "XYZ ZYX", "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ"})
end run

------------------CHARACTER DUPLICATIONS-------------------

-- duplicatedCharIndices :: String -> Maybe (Char, [Int])
on duplicatedCharIndices(s)
    script positionRecord
        on |λ|(dct, c, i)
            set k to (id of c) as string
            script additional
                on |λ|(xs)
                    insertDict(k, xs & i, dct)
                end |λ|
            end script
            maybe(insertDict(k, {i}, dct), additional, lookupDict(k, dct))
        end |λ|
    end script

    script firstDuplication
        on |λ|(sofar, idxs)
            set {iCode, xs} to idxs
            if 1 < length of xs then
                script earliest
                    on |λ|(kxs)
                        if item 1 of xs < (item 1 of (item 2 of kxs)) then
                            Just({chr(iCode), xs})
                        else
                            sofar
                        end if
                    end |λ|
                end script
                maybe(Just({chr(iCode), xs}), earliest, sofar)
            else
                sofar
            end if
        end |λ|
    end script

    foldl(firstDuplication, Nothing(), ¬
        assocs(foldl(positionRecord, {name:""}, chars(s))))
end duplicatedCharIndices

--------------------------GENERIC--------------------------

-- Just :: a -> Maybe a
on Just(x)
    -- Constructor for an inhabited Maybe (option type) value.
    -- Wrapper containing the result of a computation.
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- Nothing :: Maybe a
on Nothing()
    -- Constructor for an empty Maybe (option type) value.
    -- Empty wrapper returned where a computation is not possible.
    {type:"Maybe", Nothing:true}
end Nothing

-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
    -- Constructor for a pair of values, possibly of two different types.
    {type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple

-- assocs :: Map k a -> [(k, a)]
on assocs(m)
    script go
        on |λ|(k)
            set mb to lookupDict(k, m)
            if true = |Nothing| of mb then
                {}
            else
                {{k, |Just| of mb}}
            end if
        end |λ|
    end script
    concatMap(go, keys(m))
end assocs

-- keys :: Dict -> [String]
on keys(rec)
    (current application's ¬
        NSDictionary's dictionaryWithDictionary:rec)'s allKeys() as list
end keys

-- chr :: Int -> Char
on chr(n)
    character id n
end chr

-- chars :: String -> [Char]
on chars(s)
    characters of s
end chars

-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
    script
        property mf : mReturn(f)
        property mg : mReturn(g)
        on |λ|(x)
            mf's |λ|(mg's |λ|(x))
        end |λ|
    end script
end compose

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    set acc to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & (|λ|(item i of xs, i, xs))
        end repeat
    end tell
    return acc
end concatMap

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        lst
    else
        {}
    end if
end enumFromTo

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- fst :: (a, b) -> a
on fst(tpl)
    if class of tpl is record then
        |1| of tpl
    else
        item 1 of tpl
    end if
end fst

-- fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
on fTable(s, xShow, fxShow, f, xs)
    set ys to map(xShow, xs)
    set w to maximum(map(my |length|, ys))
    script arrowed
        on |λ|(a, b)
            justifyRight(w, space, a) & " -> " & b
        end |λ|
    end script
    s & linefeed & unlines(zipWith(arrowed, ¬
        ys, map(compose(fxShow, f), xs)))
end fTable

-- insertDict :: String -> a -> Dict -> Dict
on insertDict(k, v, rec)
    tell current application
        tell dictionaryWithDictionary_(rec) of its NSMutableDictionary
            its setValue:v forKey:(k as string)
            it as record
        end tell
    end tell
end insertDict

-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, delim}
    set str to xs as text
    set my text item delimiters to dlm
    str
end intercalate

-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller, strText)
    if n > length of strText then
        text -n thru -1 of ((replicate(n, cFiller) as text) & strText)
    else
        strText
    end if
end justifyRight

-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|

-- lookupDict :: a -> Dict -> Maybe b
on lookupDict(k, dct)
    -- Just the value of k in the dictionary,
    -- or Nothing if k is not found.
    set ca to current application
    set v to (ca's NSDictionary's dictionaryWithDictionary:dct)'s objectForKey:k
    if missing value ≠ v then
        Just(item 1 of ((ca's NSArray's arrayWithObject:v) as list))
    else
        Nothing()
    end if
end lookupDict

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- maximum :: Ord a => [a] -> a
on maximum(xs)
    script
        on |λ|(a, b)
            if a is missing value or b > a then
                b
            else
                a
            end if
        end |λ|
    end script

    foldl(result, missing value, xs)
end maximum

-- maybe :: b -> (a -> b) -> Maybe a -> b
on maybe(v, f, mb)
    -- The 'maybe' function takes a default value, a function, and a 'Maybe'
    -- value.  If the 'Maybe' value is 'Nothing', the function returns the
    -- default value.  Otherwise, it applies the function to the value inside
    -- the 'Just' and returns the result.
    if Nothing of mb then
        v
    else
        tell mReturn(f) to |λ|(Just of mb)
    end if
end maybe

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- quoted :: Char -> String -> String
on quoted(c, s)
    -- string flanked on both sides
    -- by a specified quote character.
    c & s & c
end quoted

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if 1 > n then return out
    set dbl to {a}

    repeat while (1 < n)
        if 0 < (n mod 2) then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines

-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
    zipWith(Tuple, xs, ys)
end zip

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(|length|(xs), |length|(ys))
    if 1 > lng then return {}
    set xs_ to take(lng, xs) -- Allow for non-finite
    set ys_ to take(lng, ys) -- generators like cycle etc
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs_, item i of ys_)
        end repeat
        return lst
    end tell
end zipWith


with javascript_semantics
procedure samechar(sequence s)
    string msg = "all characters are the same"
    integer l = length(s)
    if l>=2 then
        integer ch = s[1]
        for i=2 to l do
            integer si = s[i]
            if si!=ch then
                string su = utf32_to_utf8({si})
                msg = sprintf(`first different character "%s"(#%02x) at position %d`,{su,si,i})
                exit
            end if
        end for
    end if
    printf(1,"\"%s\" (length %d): %s\n",{utf32_to_utf8(s),l,msg})
end procedure

constant tests = {"","   ","2","333",".55","tttTTT","4444 444k",
                  utf8_to_utf32("🐶🐶🐺🐶"),utf8_to_utf32("🎄🎄🎄🎄")}
for i=1 to length(tests) do samechar(tests[i]) end for


(de equal? (Str)
   (let (Lst (chop Str)  C (car Lst)  P 2  F)
      (prin Str ": ")
      (for A (cdr Lst)
         (NIL (= A C) (on F) (prin "First different character " A))
         (inc 'P) )
      (if F (prinl " at position: " P) (prinl "all characters are the same")) ) )
(equal?)
(equal? "   ")
(equal? "333")
(equal? ".55")
(equal? "tttTTT")


strings: [
    "", ".", "abcABC", "XYZ ZYX",
    "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ",
    "01234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ0X",
    "hétérogénéité",
    "🎆🎃🎇🎈", "😍😀🙌💃😍🙌", "🐠🐟🐡🦈🐬🐳🐋🐡"
]

loop strings 'str [
    chars: split str
    prints ["\"" ++ str ++ "\"" ~"(size |size str|):"]

    if? chars = unique chars ->
        print "has no duplicates."
    else [
        seen: #[]
        done: false

        i: 0
        while [and? i<size chars
                    not? done][
            ch: chars\[i]
            if? not? key? seen ch [
                seen\[ch]: i
            ]
            else [
                print ~"has duplicate char `|ch|` on |get seen ch| and |i|"
                done: true
            ]
            i: i+1
        ]
    ]
]


unique_characters(str){
	arr := [], res := ""
	for i, v in StrSplit(str)
		arr[v] := arr[v] ? arr[v] "," i : i
	for i, v in Arr
		if InStr(v, ",")
			res .= v "|" i " @ " v "`tHex = " format("{1:X}", Asc(i)) "`n"
	Sort, res, N
	res := RegExReplace(res, "`am)^[\d,]+\|")
	res := StrSplit(res, "`n").1
	return """" str """`tlength = " StrLen(str) "`n" (res ? "Duplicates Found:`n" res : "Unique Characters")
}


To run:
Start up.
Show the uniformity of "".
Show the uniformity of "   ".
Show the uniformity of "2".
Show the uniformity of "333".
Show the uniformity of ".55".
Show the uniformity of "tttTTT".
Show the uniformity of "4444 444k".
Wait for the escape key.
Shut down.

To find the first different character in a string giving a byte and a count:
If the string is blank, put -1 into the count; exit.
Put the string's first's target into a first letter.
Slap a substring on the string.
Loop.
If a counter is past the string's length, put -1 into the count; exit.
Put the substring's first's target into a letter.
If the letter is not the first letter, put the letter into the byte; put the counter minus 1 into the count; exit.
Add 1 to the substring's first.
Repeat.

To show the uniformity of a string:
Write """" then the string then """ (length " then the string's length then ") " on the console without advancing.
Find the first different character in the string giving a byte and a count.
If the count is -1, write "contains all the same character." on the console; exit.
Convert the byte to a nibble string.
Write "contains a different character at index " then the count then ": '" then the byte then "' (0x" then the nibble string then ")." on the console.


:- system:set_prolog_flag(double_quotes,chars) .

main
:-
same_or_different("") ,
same_or_different("   ") ,
same_or_different("2") ,
same_or_different("333") ,
same_or_different(".55") ,
same_or_different("tttTTT") ,
same_or_different("4444 444k")
.

%!  same_or_different(INPUTz0)

same_or_different(INPUTz0)
:-
system:format('input string is "~s" .~n',[INPUTz0]) ,
examine(INPUTz0)
.

%!  examine(INPUTz0)

examine([])
:-
! ,
system:format('all the same characters .~n',[])
.

examine([COMPARE0|INPUTz0])
:-
examine(INPUTz0,COMPARE0,2,_INDEX_)
.

%!  examine(INPUTz0,COMPARE0,INDEX0,INDEX)

examine([],_COMPARE0_,INDEX0,INDEX0)
:-
! ,
system:format('all the same characters .~n',[])
.

examine([COMPARE0|INPUTz0],COMPARE0,INDEX0,INDEX)
:-
! ,
INDEX1 is INDEX0 + 1 ,
examine(INPUTz0,COMPARE0,INDEX1,INDEX)
.

examine([DIFFERENT0|_INPUTz0_],COMPARE0,INDEX0,INDEX0)
:-
prolog:char_code(DIFFERENT0,DIFFERENT_CODE) ,
system:format('character "~s" (hex ~16r) different than "~s" at 1-based index ~10r .~n',[[DIFFERENT0],DIFFERENT_CODE,[COMPARE0],INDEX0])
.


# syntax: GAWK -f DETERMINE_IF_A_STRING_HAS_ALL_UNIQUE_CHARACTERS.AWK
BEGIN {
    for (i=0; i<=255; i++) { ord_arr[sprintf("%c",i)] = i } # build array[character]=ordinal_value
    n = split(",.,abcABC,XYZ ZYX,1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ",arr,",")
    for (i in arr) {
      width = max(width,length(arr[i]))
    }
    width += 2
    fmt = "| %-*s | %-6s | %-10s | %-8s | %-3s | %-9s |\n"
    head1 = head2 = sprintf(fmt,width,"string","length","all unique","1st diff","hex","positions")
    gsub(/[^|\n]/,"-",head1)
    printf(head1 head2 head1) # column headings
    for (i=1; i<=n; i++) {
      main(arr[i])
    }
    printf(head1) # column footing
    exit(0)
}
function main(str,  c,hex,i,leng,msg,position1,position2,tmp_arr) {
    msg = "yes"
    leng = length(str)
    for (i=1; i<=leng; i++) {
      c = substr(str,i,1)
      if (c in tmp_arr) {
        msg = "no"
        first_diff = "'" c "'"
        hex = sprintf("%2X",ord_arr[c])
        position1 = index(str,c)
        position2 = i
        break
      }
      tmp_arr[c] = ""
    }
    printf(fmt,width,"'" str "'",leng,msg,first_diff,hex,position1 " " position2)
}
function max(x,y) { return((x > y) ? x : y) }


#include<stdbool.h>
#include<string.h>
#include<stdlib.h>
#include<stdio.h>

typedef struct positionList{
    int position;
    struct positionList *next;
}positionList;

typedef struct letterList{
    char letter;
    int repititions;
    positionList* positions;
    struct letterList *next;
}letterList;

letterList* letterSet;
bool duplicatesFound = false;

void checkAndUpdateLetterList(char c,int pos){
    bool letterOccurs = false;
    letterList *letterIterator,*newLetter;
    positionList *positionIterator,*newPosition;

    if(letterSet==NULL){
        letterSet = (letterList*)malloc(sizeof(letterList));
        letterSet->letter = c;
        letterSet->repititions = 0;

        letterSet->positions = (positionList*)malloc(sizeof(positionList));
        letterSet->positions->position = pos;
        letterSet->positions->next = NULL;

        letterSet->next = NULL;
    }

    else{
        letterIterator = letterSet;

        while(letterIterator!=NULL){
            if(letterIterator->letter==c){
                letterOccurs = true;
                duplicatesFound = true;

                letterIterator->repititions++;
                positionIterator = letterIterator->positions;

                while(positionIterator->next!=NULL)
                    positionIterator = positionIterator->next;

                newPosition = (positionList*)malloc(sizeof(positionList));
                newPosition->position = pos;
                newPosition->next = NULL;

                positionIterator->next = newPosition;
            }
            if(letterOccurs==false && letterIterator->next==NULL)
                break;
            else
                letterIterator = letterIterator->next;
        }

        if(letterOccurs==false){
            newLetter = (letterList*)malloc(sizeof(letterList));
            newLetter->letter = c;

            newLetter->repititions = 0;

            newLetter->positions = (positionList*)malloc(sizeof(positionList));
            newLetter->positions->position = pos;
            newLetter->positions->next = NULL;

            newLetter->next = NULL;

            letterIterator->next = newLetter;
        }
    }
}

void printLetterList(){
    positionList* positionIterator;
    letterList* letterIterator = letterSet;

    while(letterIterator!=NULL){
        if(letterIterator->repititions>0){
            printf("\n'%c' (0x%x) at positions :",letterIterator->letter,letterIterator->letter);

            positionIterator = letterIterator->positions;

            while(positionIterator!=NULL){
                printf("%3d",positionIterator->position + 1);
                positionIterator = positionIterator->next;
            }
        }

        letterIterator = letterIterator->next;
    }
    printf("\n");
}

int main(int argc,char** argv)
{
    int i,len;

    if(argc>2){
        printf("Usage : %s <Test string>\n",argv[0]);
        return 0;
    }

    if(argc==1||strlen(argv[1])==1){
        printf("\"%s\" - Length %d - Contains only unique characters.\n",argc==1?"":argv[1],argc==1?0:1);
        return 0;
    }

    len = strlen(argv[1]);

    for(i=0;i<len;i++){
        checkAndUpdateLetterList(argv[1][i],i);
    }

    printf("\"%s\" - Length %d - %s",argv[1],len,duplicatesFound==false?"Contains only unique characters.\n":"Contains the following duplicate characters :");

    if(duplicatesFound==true)
        printLetterList();

    return 0;
}


'''Determine if a string has all the same characters'''

from itertools import groupby

# firstDifferingCharLR :: String -> Either String Dict
def firstDifferingCharLR(s):
    '''Either a message reporting that no character changes were
       seen, or a dictionary with details of the  first character
       (if any) that differs from that at the head of the string.
    '''
    def details(xs):
        c = xs[1][0]
        return {
            'char': repr(c),
            'hex': hex(ord(c)),
            'index': s.index(c),
            'total': len(s)
        }
    xs = list(groupby(s))
    return Right(details(xs)) if 1 < len(xs) else (
        Left('Total length ' + str(len(s)) + ' - No character changes.')
    )

# TEST ----------------------------------------------------
# main :: IO ()
def main():
    '''Test of 7 strings'''

    print(fTable('First, if any, points of difference:\n')(repr)(
        either(identity)(
            lambda dct: dct['char'] + ' (' + dct['hex'] +
            ') at character ' + str(1 + dct['index']) +
            ' of ' + str(dct['total']) + '.'
        )
    )(firstDifferingCharLR)([
        '',
        '   ',
        '2',
        '333',
        '.55',
        'tttTTT',
        '4444 444'
    ]))

# GENERIC -------------------------------------------------

# either :: (a -> c) -> (b -> c) -> Either a b -> c
def either(fl):
    '''The application of fl to e if e is a Left value,
       or the application of fr to e if e is a Right value.
    '''
    return lambda fr: lambda e: fl(e['Left']) if (
        None is e['Right']
    ) else fr(e['Right'])

# identity :: a -> a
def identity(x):
    '''The identity function.'''
    return x

# fTable :: String -> (a -> String) ->
# (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
    '''Heading -> x display function -> fx display function ->
       f -> xs -> tabular string.
    '''
    def go(xShow, fxShow, f, xs):
        ys = [xShow(x) for x in xs]
        w = max(map(len, ys))
        return s + '\n' + '\n'.join(map(
            lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)),
            xs, ys
        ))
    return lambda xShow: lambda fxShow: lambda f: lambda xs: go(
        xShow, fxShow, f, xs
    )

# Left :: a -> Either a b
def Left(x):
    '''Constructor for an empty Either (option type) value
       with an associated string.
    '''
    return {'type': 'Either', 'Right': None, 'Left': x}

# Right :: b -> Either a b
def Right(x):
    '''Constructor for a populated Either (option type) value'''
    return {'type': 'Either', 'Left': None, 'Right': x}

# MAIN ---
if __name__ == '__main__':
    main()


using System;
using System.Linq;

public class Program
{
    static void Main
    {
        string[] input = {"", ".", "abcABC", "XYZ ZYX", "1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ"};
        foreach (string s in input) {
            Console.WriteLine($"\"{s}\" (Length {s.Length}) " +
                string.Join(", ",
                    s.Select((c, i) => (c, i))
                    .GroupBy(t => t.c).Where(g => g.Count() > 1)
                    .Select(g => $"'{g.Key}' (0X{(int)g.Key:X})[{string.Join(", ", g.Select(t => t.i))}]")
                    .DefaultIfEmpty("All characters are unique.")
                )
            );
        }
    }
}


#include <iostream>
#include <string>

void string_has_repeated_character(const std::string& str) {
    size_t len = str.length();
    std::cout << "input: \"" << str << "\", length: " << len << '\n';
    for (size_t i = 0; i < len; ++i) {
        for (size_t j = i + 1; j < len; ++j) {
            if (str[i] == str[j]) {
                std::cout << "String contains a repeated character.\n";
                std::cout << "Character '" << str[i]
                    << "' (hex " << std::hex << static_cast<unsigned int>(str[i])
                    << ") occurs at positions " << std::dec << i + 1
                    << " and " << j + 1 << ".\n\n";
                return;
            }
        }
    }
    std::cout << "String contains no repeated characters.\n\n";
}

int main() {
    string_has_repeated_character("");
    string_has_repeated_character(".");
    string_has_repeated_character("abcABC");
    string_has_repeated_character("XYZ ZYX");
    string_has_repeated_character("1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ");
    return 0;
}