Clarion

  PROGRAM

OMIT('***')
 * User: Shur
 * Date: 29.02.2016
 * Time: 23:49
 ***

  MAP
      include('i64.inc')
Factorial PROCEDURE(SHORT,*INT64 a)
ShowINT64  PROCEDURE(*INT64 a),STRING
  END

a                    LIKE(INT64)
b                    LIKE(INT64)
c                    LIKE(INT64)
str1                 CSTRING(32000)
str2                 CSTRING(32000)

   CODE       
      Factorial(20,a)
      message(str1,'Factorial',,,,10b)

Factorial            PROCEDURE(SHORT n,*INT64 a)
b like(INT64)
   CODE
      if n = 1 then
         i64Assign(a,1)
         str1 = '1! = 1'
         RETURN
      .
      i64Assign(b,n)     
      Factorial(n-1,a)
      if a.lo = 0 and a.hi = 0
         RETURN
      .   
      i64Mult(a,b,c)
      if i64Sign(c) = -1 
         i64Assign(a,0)
         RETURN
      .   
      a :=: c
      str1 = str1 & '|' & n & '! = ' & ShowINT64(a)
      
ShowINT64           PROCEDURE(a)
d DECIMAL(30,0)
   CODE
      i64ToDecimal(d,a)
      return(d)

  PROGRAM

OMIT('***')
 * User: Shur
 * Date: 29.02.2016
 * Time: 21:18
 ***

  MAP
      include('i64.inc')
ShowINT64  PROCEDURE(*INT64 a),STRING
  END

a                    LIKE(INT64)
b                    LIKE(INT64)
c                    LIKE(INT64)
str1                 CSTRING(32000)
str2                 CSTRING(32000)

   CODE
      a.lo = 1
      str1 = '1=' & ShowINT64(a)         
      b.lo = 1
      str1 = str1 & '|2=' & ShowINT64(b) 
      str2 ='1, 1'
      loop i# = 3 to 200 
         i64Add(a,b,c)
         if i64Sign(c) = -1
            break
         end   
         a :=: b ! deep assignment uses for structures
         b = c   ! usual assignment can be also used     
         str1 = str1 & '|' & i# & '=' & ShowINT64(c)         
         str2 = str2 & ', ' & ShowINT64(c)         
      end
      message(str2,'Fibonacci',,,,10b)
      message(str1,'Fibonacci',,,,10b)
            
ShowINT64           PROCEDURE(a)
d DECIMAL(30,0)
   CODE
      i64ToDecimal(d,a)
      return(d)

   PROGRAM

OMIT('***')
 * User: Shur
 * Date: 28.02.2016
 * Time: 14:05
 ***
complex          GROUP,TYPE
a                       REAL(0)
b                       REAL(0)
                 END

  MAP
cxSum             PROCEDURE(*complex cxA, *complex cxB, *complex cxRes)
cxMul             PROCEDURE(*complex cxA, *complex cxB, *complex cxRes)
cxDiv             PROCEDURE(*complex cxA, *complex cxB, *complex cxRes)
  END

A REAL
B REAL
C REAL

X                   GROUP,PRE(X),DIM(2)
X                       LIKE(complex)
F                       CSTRING(64)
R                       LIKE(complex)
                     END

root               CSTRING(64)
check_               CSTRING(256)

CX1                   LIKE(complex)
CX2                   LIKE(complex)
CX3                   LIKE(complex)

   CODE
      A=1; B=3; C=3
      !A=1; B=-5; C=3
      !A=1; B=2; C=1
      D$ = B * B - 4 * A * C
      if A = 0
         root = 'Not a quadratic equation.'
      elsif D$ = 0
         X[1].X.a = -B/2/A
         root = 'x = ' & X[1].X.a
      elsif D$ > 0 then
         X[1].X.a = (-B-sqrt(D$))/2/A         
         X[2].X.a = (-B+sqrt(D$))/2/A         
         root = 'x1 = ' & X[1].X.a & '|' & |
                  'x2 = ' & X[2].X.a
      else   
         X[1].X.a = -B/2/A; X[1].X.b = sqrt(-D$)/2/A         
         X[2].X.a = -B/2/A; X[2].X.b = -sqrt(-D$)/2/A         
         root = 'x1 = (' & X[1].X.a & ', ' & X[1].X.b & ')' & '|' & | 
                'x2 = (' & X[2].X.a & ', ' & X[2].X.b & ')'
      end
      loop i# = 1 to 2 
         !loop j# = 1 to 2 
            if X[i#].X.a or X[i#].X.b
               if D$ ~< 0
                  X[i#].F = choose(A=0,'',A&'*'&X[i#].X.a&'^2')&choose(B=0,'',choose(B>0,'+','')&B&'*'&X[i#].X.a)&choose(C=0,'',choose(C>0,'+','')&C)
                  X[i#].R.a = round(EVALUATE(X[i#].F),0.0000000000001)
                  check_ = check_ & choose(check_<>'','|','') & X[i#].F&'=' & X[i#].R.a
               else   
                  CX1.a = X[i#].X.a; CX1.b = X[i#].X.b
                  CX2.a = A; CX2.b = 0
                  cxMul(CX1, CX1, CX3) ! x^2
                  cxMul(CX2, CX3, CX3) ! a*x^2
                  X[i#].R = CX3
                  CX2.a = B; CX2.b = 0
                  cxMul(CX1, CX2, CX3) ! b*x
                  CX2 = X[i#].R
                  cxSum(CX2,CX3,CX1) ! a*x^2 + b*x
                  X[i#].R = CX1
                  CX2.a = C; CX2.b = 0
                  cxSum(CX1,CX2,CX3) ! a*x^2 + b*x + c
                  X[i#].R = CX3
                  check_ = check_ & choose(check_<>'','|','') &'= (' & X[i#].R.a & ', ' & X[i#].R.b & ')'
               end   
            end   
         !end   
      end   
      message(choose(A=0,'','D='&D$&'|----------|')&|
         root&|
         choose(A=0,'',choose(check_>'',|
         '|----------|'&|
         check_,'')),'Quadratic equation')

cxSum            PROCEDURE(cxA, cxB, cxRes)
      CODE
         cxRes.a = cxA.a + cxB.a
         cxRes.b = cxA.b + cxB.b

cxMul            PROCEDURE(cxA, cxB, cxRes)
      CODE
         cxRes.a = cxA.a*cxB.a - cxA.b*cxB.b
         cxRes.b = cxA.a*cxB.b + cxB.a*cxA.b

cxDiv            PROCEDURE(cxA, cxB, cxRes)
      CODE
         cxRes.a = (cxA.a*cxB.a + cxA.b*cxB.b) / (cxB.a^2 + cxB.a^2)
         cxRes.b = (cxB.a*cxA.b - cxB.b*cxA.a) / (cxB.a^2 + cxB.a^2)

   PROGRAM

OMIT('***')
 * User: Shur
 * Date: 28.02.2016
 * Time: 14:05
 ***
  MAP
  END

A REAL
B REAL
C REAL

root               CSTRING(64)

   CODE
      
      A=0; B=2; C=3
      !A=1; B=-5; C=3
      !A=1; B=2; C=1
      
      D$ = B * B - 4 * A * C
      if A = 0
         root = 'Not a quadratic equation.'
      elsif D$ = 0
         root = 'x = ' & -B/2/A
      elsif D$ > 0 then
         root = 'x1 = ' & (-B-sqrt(D$))/2/A & '|' & |
                  'x2 = ' & (-B+sqrt(D$))/2/A
      else   
         root = 'x1 = (' & -B/2/A & ', ' &  sqrt(-D$)/2/A & ')' & '|' & | 
                  'x2 = (' & -B/2/A & ', ' & -sqrt(-D$)/2/A & ')'
      end
      message(choose(A=0,'','D='&D$&'|----------|')&root,'Quadratic equation')

   PROGRAM
     MAP
     END
   CODE
     MESSAGE('Hello World!','Clarion')
     RETURN

  PROGRAM

  MAP
  END

InitStr              STRING('Some string with any symbols')
Str                  CSTRING(100),AUTO
symbol               STRING(1)

   CODE
      j# = 1 ! implicit variable
      loop i# = 1 to len(InitStr) by 1
         symbol = lower(InitStr[i#]) ! string can be considered as array
         case symbol
         of 'a' to 'z'
            Str[j#] = choose(was_letter#,symbol,upper(symbol))
            j# += 1 ! using of add equals operator for increment
            was_letter# = TRUE
         else 
            was_letter# = FALSE
         end   
      end   
      message(Str,'CamelCase')