Add Forth solution to challenge 101

2 files changed, 158 insertions, 0 deletions

diff --git a/challenge-101/paulo-custodio/forth/ch-1.fs b/challenge-101/paulo-custodio/forth/ch-1.fs
new file mode 100644
index 0000000000..61cade62fa
--- /dev/null
+++ b/challenge-101/paulo-custodio/forth/ch-1.fs
@@ -0,0 +1,114 @@
+#! /usr/bin/env gforth
+
+\ Challenge 101
+\
+\ TASK #1 › Pack a Spiral
+\ Submitted by: Stuart Little
+\
+\ You are given an array @A of items (integers say, but they can be anything).
+\
+\ Your task is to pack that array into an MxN matrix spirally counterclockwise,
+\ as tightly as possible.
+\
+\ ‘Tightly’ means the absolute value |M-N| of the difference has to be as small
+\ as possible.
+
+VARIABLE #nums  0 #nums !           \ number of items
+VARIABLE width  1 width !           \ max width of items
+
+\ collect argumens, append them to dictionary
+: collect-args      ( -- )
+    BEGIN NEXT-ARG ?DUP WHILE
+        DUP  width @  MAX  width !  \ get maximum width
+        S>NUMBER? 0= THROW DROP     \ convert to number
+        ,                           \ add to dictionary
+        1 #nums +!                  \ count it
+    REPEAT DROP ;
+
+CREATE nums  collect-args
+
+\ compute rows and cols
+: smallest_rect { n -- rows cols }
+    1 1 n { i low high }
+    BEGIN low high < WHILE
+        n i MOD 0= IF
+            i       TO low
+            n i /   TO high
+        THEN
+        i 1+ TO i
+    REPEAT
+    high low ;
+
+VARIABLE #ROWS
+VARIABLE #cols
+
+#nums @  smallest_rect  #cols !  #ROWS !
+
+\ create rectangle for spiral
+CREATE rect  #nums @  CELLS  ALLOT
+
+\ index into nums and rect
+: nums[]        ( i -- addr )
+    CELLS nums + ;
+: rect[]        ( row col -- addr )
+    SWAP  #cols @ *  +  CELLS  rect + ;
+
+\ fill rect with -1
+: fill_rect     ( -- )
+    #rows @  0  DO
+        #cols @  0  DO
+            -1  J I rect[]  !
+        LOOP
+    LOOP ;
+
+\ fill spiral
+: spiral        ( -- )
+    0  #rows @ 1-  0    { i r c }   \ start at bottom left
+    BEGIN i #nums @ < WHILE         \ while numbers left
+        \ go East
+        BEGIN c #cols @ <  r c rect[] @ 0< AND WHILE
+            i nums[] @  r c rect[] !        \ store number
+            i 1+ TO i
+            c 1+ TO c
+        REPEAT
+        c 1- TO c
+        r 1- TO r
+        \ go North
+        BEGIN r 0>=  r c rect[] @ 0< AND WHILE
+            i nums[] @  r c rect[] !        \ store number
+            i 1+ TO i
+            r 1- TO r
+        REPEAT
+        r 1+ TO r
+        c 1- TO c
+        \ go West
+        BEGIN c 0>=  r c rect[] @ 0< AND WHILE
+            i nums[] @  r c rect[] !        \ store number
+            i 1+ TO i
+            c 1- TO c
+        REPEAT
+        c 1+ TO c
+        r 1+ TO r
+        \ go South
+        BEGIN r #rows @ <  r c rect[] @ 0< AND WHILE
+            i nums[] @  r c rect[] !        \ store number
+            i 1+ TO i
+            r 1+ TO r
+        REPEAT
+        r 1- TO r
+        c 1+ TO c
+    REPEAT
+;
+
+\ print spiral
+: .spiral       ( -- )
+    #rows @  0  DO
+        #cols @  0  DO
+            J I rect[]  @  width @ 1+  U.R
+        LOOP
+        CR
+    LOOP ;
+
+
+fill_rect spiral .spiral
+BYE
diff --git a/challenge-101/paulo-custodio/forth/ch-2.fs b/challenge-101/paulo-custodio/forth/ch-2.fs
new file mode 100644
index 0000000000..c2e109c850
--- /dev/null
+++ b/challenge-101/paulo-custodio/forth/ch-2.fs
@@ -0,0 +1,44 @@
+#! /usr/bin/env gforth
+
+\ Challenge 101
+\
+\ TASK #2 › Origin-containing Triangle
+\ Submitted by: Stuart Little
+\ You are given three points in the plane, as a list of six co-ordinates:
+\ A=(x1,y1), B=(x2,y2) and C=(x3,y3).
+\
+\ Write a script to find out if the triangle formed by the given three
+\ co-ordinates contain origin (0,0).
+\
+\ Print 1 if found otherwise 0.
+
+: sign      { x1 y1 x2 y2 x3 y3 -- s }
+    x1 x3 -  y2 y3 - *
+    x2 x3 -  y1 y3 - *  - ;
+
+: point_in_triangle     { xp yp x1 y1 x2 y2 x3 y3 -- f }
+    0 0 0 { d1 d2 d3 }
+    xp yp  x1 y1  x2 y2  sign TO d1
+    xp yp  x2 y2  x3 y3  sign TO d2
+    xp yp  x3 y3  x1 y1  sign TO d3
+
+    0 0 { has-neg has-pos }
+    d1 0<  d2 0<  d3 0<  OR OR TO has-neg
+    d1 0>  d2 0>  d3 0>  OR OR TO has-pos
+
+    has-neg has-pos AND 0= ;
+
+\ collect coords
+: get-num   ( -- n )
+    NEXT-ARG DUP 0= THROW S>NUMBER? 0= THROW DROP ;
+
+
+get-num VALUE x1
+get-num VALUE y1
+get-num VALUE x2
+get-num VALUE y2
+get-num VALUE x3
+get-num VALUE y3
+
+0 0 x1 y1 x2 y2 x3 y3 point_in_triangle 1 AND . CR
+BYE