RosettaCodeData/Task/Biorhythms/Amazing-Hopper/biorhythms.hopper

/* TASK: Bioritmo, Rosetta Code */

#include <jambo.h>

Main
   Set break
   Set stack 15

   Get total args
   If ( Is equal to '7' )
       /* argumentos del programa*/

       nombre="", año=0, mes=0, día=0, año a examinar=0, mes a examinar=0

       Set ' Arg str(2), Arg num(3) Arg num(4), Arg num(5) ', Move to 'nombre, año, mes, día'
       Set ' Arg num(6), Arg num(7) ',                        Move to 'mes a examinar, año a examinar'

       /* arrays de valores constantes */
       Void ' Etiquetas, Meses, Factores '

       /* otras variables utilitarias */
       b=año, g=año a examinar, l=g, r=0

       /* programa */
       Gosub 'Configuración del programa'
       Gosub 'Construcción del bioritmo'
       Locate (22, 1), Prnl
   Else
       Printnl ("Modo de uso: hopper bioritmo.jambo NOMBRE DD MM AA MME AAE")
       Printnl (Utf8("donde DD,MM,AA fecha de nacimiento, MME, AAE mes y año a examinar"))
   End If

End

Subrutines

Define 'Construcción del bioritmo'
   ak=0, b1=0, y=0

   Loop

      Gosub 'Análisis de año bisiesto'

      Let ( ak := #( Factores[mes]+28.5-día ) )
      ++mes
      x=12
      When ( #( mes < 13 ) ){ Set 'ak,x', Let( ak := Gosub 'Cálculo' ) }

      Let ( b1 := #( g-b-1 ) )

      Set decimal '0'
      Let ( ak := #( (b1*365+((g-1)/4)-((g-1)/100)+((g-1)/400)-((b/4)-(b/100)+(b/400))+ak) ) )
      Unset decimal

      y = ak
      Let (b := g)

      Gosub 'Análisis de año bisiesto'

      Let ( x := #( mesaexaminar - 1 ) )
      Let ( mes := 1 )
      If ( #( x <> 0 ) )
         Set 'ak, x', Let( ak := Gosub 'Cálculo' )
         y = ak
      End If

      Cls
      Set 'ak, y', Gosub 'Desplegar la malla'
      Pause
      ++mes a examinar
   Until ( #( mesaexaminar == 13 ) )
Return

Define 'Desplegar la malla, ak, y'
   i=4, j=0, i1=1, fi=3

   Loop
      Set 'i, i1, fi', Gosub 'Genera la malla'
      Set 'i, fi, i1', Gosub 'Escribe la identificación'
      Set 'ak, i, fi', Gosub 'Despliega el bioritmo'
      i += 34
      Let ( ak := y )
      ++i1
      ++j
   Until ( #( j == 3 ) )

Return

Define 'Genera la malla, i, i1, fi'
   j1=4, j2=0, ti=i, i2=0

   Let ( r := Get if( Equals( i1,1 ), 23, Get if( Equals( i1,2 ), 28, 33) ) )

   Loop
      Let ( j2 := Add( 4, i ) )

      Loop if ( #( j2 < ( (27+Factores[mesaexaminar])+i) ) )
         Locate ( #(j1+fi), j2 ), Printnl (" |")
         j2 += 5
      Back

      Locate ( #(j1+fi), #( 28+(Factores[mesaexaminar])+i) ), Printnl ("| ")
      ++j1
   Until ( #( j1 > 13 ) )

   Let ( i := ti )
   i2 = ti
   j2 = 1

   Loop if ( #( j2 < ((27 + Factores[mesaexaminar] )+1) ) )
      Locate ( #(8+fi), #(i2+1) ), Printnl ("-")
      ++i2, ++j2
   Back

   Locate ( #(8+fi), #(5+i) ), Printnl ( "+" )
   Loccol ( #(10+i) ),         Printnl ( "+" )
   Loccol ( #(15+i) ),         Printnl ( "+" )
   Loccol ( #(20+i) ),         Printnl ( "+" )
   Loccol ( #(25+i) ),         Printnl ( "+" )

   Locate ( #(14+fi), #(1+i) ), Printnl ( "1...5...10...15...20...25..." )

   If ( #( (28+Factores[mesaexaminar]) == 29 ) )
      Locate ( #(14+fi), #(29+i) ), Printnl ( "." )
   Else If ( #( (28+ Factores[mesaexaminar]) == 30 ) )
      Locate ( #(14+fi), #(29+i) ), Printnl ( "30" )
      Locate ( #(8+fi), #(30+i) ),  Printnl ( "+" )
   Else If ( #( (28+Factores[mesaexaminar]) == 31 ) )
      Locate ( #(14+fi), #(29+i) ), Printnl ( "30." )
      Locate ( #(8+fi), #(30+i) ),  Printnl ( "+" )
   End If

Return

Define 'Escribe la identificación, i, fi, i1'
   Locate ( #(16+fi), #(1+i) ), Printnl ( #( Meses[mesaexaminar] ), " ", Int(l), " D. de C." )
   Locrow ( #(17+fi) ),         Printnl ( "Bioritmo para ", nombre )
   Locrow ( #(18+fi) ),         Printnl ( "Estado: ", #( Etiquetas[i1] ) )
Return

Define 'Despliega el bioritmo, ak, i, fi'
   n=0, j=0
   PI = M_PI

   Loop if( #( j < ( (28 + Factores[mesaexaminar]) * 2 ) ) )
      Let ( ak := #( ak + 0.5 ) )
      Let ( n := #( (10 * ( -(sin( ( 2 * PI * ak ) / r ) ) ) ) + 17 ) )

      If ( #( (int( int( j / 2 )-(( int( j / 2) / 5) * 5))) == 5 ) )
          Locate ( #( int( n / 2 ) + fi ), #( int( j / 2 ) + ( i + 1 )) )
      Else
          Locate ( #( (n / 2 ) + fi ), #( ( j / 2 ) + ( i + 1 ) ) )
      End If
      Printnl ("*")
      ++j
   Back

Return

Define 'Análisis de año bisiesto'
   x1=0, x2=0, x3=0
   /* "b" es variable global */
   Let ( x1 := Get if ( #( b - ( int( b / 4 ) * 4 ) == 0 ), 1, 0 ))
   Let ( x2 := Get if ( #( b - ( int( b / 100 ) * 100 ) == 0 ), 1, 0 ))
   Let ( x3 := Get if ( #( b - ( int( b / 400 ) * 400 ) == 0 ), 1, 0 ))
   [2] #( x1 - x2 + x3 ), Put 'Factores'
Return

Define 'Cálculo, ak,x'
   i = mes
   Loop if( #(i <= x) )
      Let ( ak := #( 28 + Factores[i] + ak ) )
      ++i
   Back
Return 'ak'

/* CONFIGURACION DEL PROGRAMA */

Define ' Configuración del programa '
   Set ' Utf8("Físico"), "Emocional", "Intelectual" '                      Apnd list 'Etiquetas'
   Set ' "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", \
         "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre" '     Apnd list 'Meses'
   Set ' 3, 0, 3, 2, 3, 2, 3, 3, 2, 3, 2, 3 '                              Apnd list 'Factores'
Return