Gury's Atari 8-bit Forever Portal - Site dedicated to Atari 8-bit home computers by Bostjan Gorisek (Gury)

Entry name:
Zhang-Suen Thinning Algorithm
Category:
Graphics
Publisher/Developer:
Rosetta Code
Year:
2021
Code:
amarok
Programming language:
Action!

Entry name:
Zhang-Suen Thinning Algorithm
Category:
Graphics
Publisher/Developer:
Rosetta Code
Year:
2021

Listing 1

PROC DrawImage(BYTE ARRAY image BYTE x,y,width,height)
  BYTE i,j
  BYTE POINTER ptr

  Color=2
  FOR j=0 TO height-1
  DO
    Plot(x,j+y) DrawTo(x+width-1,j+y)
  OD
  Color=1
  ptr=image
  FOR j=0 TO height-1
  DO
    FOR i=0 TO width-1
    DO
      IF ptr^ THEN
        Plot(i+x,j+y)
      FI
      ptr==+1
    OD
  OD
RETURN

PROC Thinning(BYTE ARRAY image BYTE width,height)
  DEFINE PTR="CARD"
  DEFINE MAX="200"
  PTR ARRAY change(MAX)
  BYTE POINTER p1,p2,p3,p4,p5,p6,p7,p8,p9,p68,p24
  INT count,i
  BYTE x,y,sum,step1

  step1=1
  DO
    count=0
    p1=image p8=p1-1 p4=p1+1
    p2=p1-width p6=p1+width
    p9=p2-1 p3=p2+1
    p7=p6-1 p5=p6+1

    FOR y=0 TO height-1
    DO
      FOR x=0 TO width-1
      DO
        IF p1^=1 AND x>0 AND y>0 AND x<width-1 AND y<height-1 THEN
          sum=p2^+p3^+p4^+p5^+p6^+p7^+p8^+p9^
          IF sum>=2 AND sum<=6 THEN
            sum=0
            IF p3^>p2^ THEN sum==+1 FI
            IF p4^>p3^ THEN sum==+1 FI
            IF p5^>p4^ THEN sum==+1 FI
            IF p6^>p5^ THEN sum==+1 FI
            IF p7^>p6^ THEN sum==+1 FI
            IF p8^>p7^ THEN sum==+1 FI
            IF p9^>p8^ THEN sum==+1 FI
            IF p2^>p9^ THEN sum==+1 FI
            IF sum=1 THEN
              IF step1 THEN
                p24=p4 p68=p6
              ELSE
                p24=p2 p68=p8
              FI
              IF p2^+p4^+p68^<3 AND p24^+p6^+p8^<3 THEN
                change(count)=p1 count==+1
              FI  
            FI
          FI
        FI
        p1==+1 p2==+1 p3==+1 p4==+1 p5==+1
        p6==+1 p7==+1 p8==+1 p9==+1
      OD
    OD
    step1=1-step1
    FOR i=0 TO count-1
    DO
      p1=change(i) p1^=0
    OD
  UNTIL count=0
  OD
RETURN

PROC Main()
  BYTE ARRAY image1=[
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0
    0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0
    0 1 1 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 0 0 0 0 0 0
    0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 1 1 1 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 0 0 0 0 0 0
    0 1 1 1 0 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0
    0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
  BYTE ARRAY image2=[
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0
    0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0
    0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0
    0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0
    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
  BYTE width1=[32],height1=[10],width2=[59],height2=[18]
  BYTE CH=$02FC

  Graphics(7+16)
  Color=1
  SetColor(0,0,$00)
  SetColor(4,0,$04)
  SetColor(1,0,$0C)

  DrawImage(image1,0,0,width1,height1)
  Thinning(image1,width1,height1)
  DrawImage(image1,width1+10,0,width1,height1)

  DrawImage(image2,0,height1+10,width2,height2)
  Thinning(image2,width2,height2)
  DrawImage(image2,width2+10,height1+10,width2,height2)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN

References

https://gitlab.com/amarok8bit/action-rosetta-code/-/blob/master/source/Zhang-Suen_thinning_algorithm.act

https://www.rosettacode.org/wiki/Rosetta_Code

https://atariage.com/forums/topic/326941-action-on-rosetta-code/

https://gitlab.com/amarok8bit/action-rosetta-code/-/tree/master

Listing downloads

Download link 1

This is non-commercial site, its content is based on Atari 8-bit home computer contents and references.
If you feel your rights are violated by showing/using any part of contents of your product represented on this page, please contact me immediatelly so I can remove it!

Atari 8-bit Source code