/* TASK: Bioritmo, Rosetta Code */ #include 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