Golden Waves

[galil...@gmail.com]

| Golden Waves

| Adaptacion del programa homonimo en BASIC-256. Galileo (2016)

^r4/lib/gui.txt

#x #y #h #d

:conv 6.2832 /. ;

:color | r g b --

  8 << or 8 << or ink ;

:switch | t y1 x1 -- t y1 x1

  pick2

  10.0 >? ( 20.0 <? ( pick2 16 << 4.0 /. + conv sin 60.0 *. 65.0 + 16 >> 'h ! ; ) )

  20.0 >? ( 30.0 <? ( pick2 pick2 swap - 16 << 4.0 /. swap +

    conv sin 60.0 *. 65.0 + 16 >> 'h ! ; ) )

  30.0 >? ( 40.0 <? ( pick2 16 << 2.0 /. over + conv sin 30.0 *.

    pick2 16 << 2.0 /. rot + conv sin 30.0 *. + 65.0 + 16 >> 'h ! ; ) )

  40.0 >? ( 50.0 <? ( pick2 pick2 + 16 << 4.0 /. swap +

    conv sin 60.0 *. 65.0 + 16 >> 'h ! ; ) )

  50.0 >? ( 60.0 <? ( d 0.3 *. swap + conv sin 60.0 *. 65.0 + 16 >> 'h ! ; ) ) 

  over 16 << 4.0 /. swap + conv sin 60.0 *. 65.0 + 16 >> 'h !

;

:calcula | t y1 x1 -- 

  24 over - 12 * pick2 12 * + 'x !

  24 over - -6 * pick2 6 * 300 + + 'y !

  10 over - dup * pick2 10 swap - dup * + 16 << sqrt. 'd !

  switch

  h 100 h + 100 h + color

  sfill x y h - op x 10 + y 5 + h - pline x 20 + y h - pline

    x 10 + y 5 - h - pline x y h - pline poli 

  0 60 60 color

  sfill x y h - op x 10 + y 5 + h - pline x 10 + y pline x y 5 - pline x y h - pline poli

  0 150 150 color

  sfill x 10 + y 5 + h - op x 10 + y pline x 20 + y 5 - pline

    x 20 + y h - pline x 10 + y 5 + h - pline poli

;

:buclex | t y1 --

  0 ( 24 <? )( calcula 1+ ) drop ;

:bucley | t --

  0 ( 24 <? )( buclex 1+ ) drop ;

:gwaves 

  1.0 ( 60.0 <? )( cls bucley 0 update drop redraw 0.1 + ) drop ;

: $800000 paper gwaves show 'exit >esc< ;

[Pablo Hugo Reda]

Es dificil cambiar algo sin replantear todo el enfoque.

Lo primero que se me ocurre es quitar la lista de comprobaciones para cambiar la formula con respecto al tiempo, tratando de convertir las palabras en funciones en un vector de llamadas, creo que podria desaparecer h.

Pero estas traduciendo un programa, esta perfecto.

Los demos que estas haciendo son visualmente muy atractivos, creo que en algun momento tendre que mejorar la pagina del proyecto agregando capturas de pantalla.

Tengo pensado manejo de memoria como el proximo documento a publicar. Avisame si hay algun tema que te interese mas para ayudarte a avanzar

[galil...@gmail.com]

El maestro en reda4 eres tu. Si muestras el mismo programa reescrito de otra forma será muy ilustrativo.

[Pablo Hugo Reda]

Si te ayuda..

:nd  | x y t -- x y t d ; calculo distncia solo cuando lo uso..
 10 pick3 - dup * 10 pick3 - dup * + 16 << sqrt. ;

:f1 | x y t -- x y h
 pick2 16 << 4 / + conv sin 60 * 65.0 + 16 >> ;
:f2 | x y t -- x y h
 pick2 pick2 swap - 16 << 4 / swap + conv sin 60 * 65.0 + 16 >> ;
:f3 | x y t -- x y h
 pick2 16 << 2/ over + conv sin 30 * pick2 16 << 2/ rot + conv sin 30 * + 65.0 + 16 >> ;
:f4 | x y t -- x y h
 pick2 pick2 + 16 << 4 / swap + conv sin 60 * 65.0 + 16 >> ;
:f5 | x y t -- x y h
 nd 0.3 *. swap + conv sin 60 * 65.0 + 16 >> ;
:f6 | x y t -- x y h
 over 16 << 4 / swap + conv sin 60 * 65.0 + 16 >> ;

#fs 'f1 'f2 'f3 'f4 'f5 'f6 0 | lista de funciones, 0 hace que comienze otra vez
#fs> 'fs

:execfs fs> @ exec ;
:nextfs 4 'fs> +! fs> @ 0? ( 'fs 'fs> ! ) drop ;

:2d>iso | y x -- x y
 24 over - 12 * pick2 12 * + | y x ix
 24 pick2 - -6 * pick3 6 * 300 + + | y x ix iy
 ;

:barra | x y h --
 dup 100 over + dup color
 pick2 pick2 pick2 - 2dup op | x y h x y-h
 over 10 + over 5 + pline
 over 20 + over pline
 over 10 + over 5 - pline
 2dup pline poli

 0 60 60 color
 2dup op | x y h x y-h
 over 10 + over 5 + pline
 over 10 + over pick4 + pline
 over over pick4 + 5 - pline pline poli

 0 150 150 color
 pick2 20 + pick2 pick2 - | x y h x+20 y-h
 2dup op
 over 10 - over 5 + pline
 pick2 pick2 10 - pick2 rot + 2dup pline
 swap 10 + swap 5 - pline pline poli
 ;

:calcula | t y1 x1 --

 pick2 execfs
 >r 2d>iso r>
 barra
 3drop

 ;


:buclex | t y1 --
  0 ( 24 <? )( calcula 1+ ) drop ;


:bucley | t --
  0 ( 24 <? )( buclex 1+ ) drop ;

: $800000 paper
 1.0 show cls
 bucley 0.1 +
 'nextfs <f1>
 'exit >esc<
 ;