RosettaCodeData/Task/Animate-a-pendulum/Amazing-Hopper/animate-a-pendulum-1.hopper
2023-07-01 13:44:08 -04:00

91 lines
2.2 KiB
Text

#include <flow.h>
#include <flow-term.h>
DEF-MAIN(argv,argc)
SET( Pen, 0 )
LET( Pen := STR-TO-UTF8(CHAR(219)) )
CLR-SCR
HIDE-CURSOR
GOSUB( Animate a Pendulum )
SHOW-CURSOR
END
RUTINES
DEF-FUN( Animate a Pendulum )
MSET( accel, speed, bx, by )
SET( theta, M_PI_2 ) // pi/2 constant --> flow.h
SET( g, 9.81 )
SET( l, 1 )
SET( px, 65 )
SET( py, 7 )
LOOP( Animate All )
LET( bx := ADD( px, MUL( MUL( l, 23 ), SIN(theta) ) ) )
LET( by := SUB( py, MUL( MUL( l, 23 ), COS(theta) ) ) )
CLR-SCR
{px,py,bx,by} GOSUB( LINE )
{bx, by, 3} GOSUB( CIRCLE )
LET( accel := MUL(g, SIN(theta) DIV-INTO(l) DIV-INTO(4) ) )
LET( speed := ADD( speed, DIV(accel, 100) ) )
LET( theta := ADD( theta, speed ) )
LOCATE (1, 62) PRNL("PENDULUM")
LOCATE (2, 55) PRNL("Press any key to quit")
SLEEP( 0.1 )
BACK-IF ( NOT( KEY-PRESSED? ), Animate All )
RET
/* DDA Algorithm */
DEF-FUN(LINE, x1, y1, x2, y2)
MSET( x, y, dx, dy, paso, i, gm )
STOR( SUB(x2, x1) SUB(y2, y1), dx, dy )
LET( paso := IF( GE?( ABS(dx) » (DX), ABS(dy)»(DY) ), DX, DY ) )
// increment:
STOR( DIV(dx, paso) DIV(dy, paso), dx, dy )
// print line:
SET( i, 0 )
WHILE( LE?(i, paso), ++i )
LOCATE( y1, x1 ), PRNL( Pen )
STOR( ADD( x1, dx) ADD( y1, dy ), x1, y1 )
WEND
RET
DEF-FUN( Plot Points, xc, yc ,x1 ,y1 )
LOCATE( ADD(xc,x1), ADD( yc, y1) ), PRN( Pen )
LOCATE( SUB(xc,x1), ADD( yc, y1) ), PRN( Pen )
LOCATE( ADD(xc,x1), SUB( yc, y1) ), PRN( Pen )
LOCATE( SUB(xc,x1), SUB( yc, y1) ), PRN( Pen )
LOCATE( ADD(xc,y1), ADD( yc, x1) ), PRN( Pen )
LOCATE( SUB(xc,y1), ADD( yc, x1) ), PRN( Pen )
LOCATE( ADD(xc,y1), SUB( yc, x1) ), PRN( Pen )
LOCATE( SUB(xc,y1), SUB( yc, x1) ), PRNL( Pen )
RET
DEF-FUN( CIRCLE, xc, yc, ratio )
MSET( x, p )
SET( y, ratio )
LOCATE( yc,xc ), PRNL("O")
{yc, xc, y, x} GOSUB( Plot Points )
LET( p := SUB( 1, ratio ) )
LOOP( Print Circle )
++x
COND( LT?( p, 0 ) )
LET( p := ADD( p, MUL(2,x) ) PLUS(1) )
ELS
--y
LET( p := ADD( p, MUL(2, SUB(x,y))) PLUS(1) )
CEND
{yc, xc, y, x} GOSUB( Plot Points )
BACK-IF-LT( x, y, Print Circle )
RET