Support Forum / Форум поддержки

Code: Select all

/*
COLORS used in code
'y': comments
'' :main progamm
'g':find rapidly the line
'b':sub-programms
'c':functions
'r':watch it!!special lines that might cause some trouble 
'm':DATA
''
*/
'{{/Bibliothek/coord_trans}}
'{{/Bibliothek/maths}}
'{{/Bibliothek/utilities}}

OPTION ANGLE RADIANS
OPTION BASE 1
OPTION SPRITE POS CENTRAL
SET TOOLBAR OFF
GET ORIENTATION p
SET ORIENTATION p

DEBUG=0

'colours of waves
blue2$="0,0,1"
blue1$="0.181,0.177,.8"
col$(1)="0.864,0,0" 'hull
col$(2)="0.521,0.369,0.147" 'mast
col$(3)=".8,.8,.8" 'sail

'set cst-coordinates
xmax=5
xmin=-xmax
ymax=xmax*SCREEN_HEIGHT()/SCREEN_WIDTH()
ymin=xmin*SCREEN_HEIGHT()/SCREEN_WIDTH()

pi=3.1416


'r'
'file
filename$="seagulls.wav"
'geometry of wave
num_waves=3 ' number of waves on screen 
sin_r=.2 'magnitude of wave

'sprite: position and movement
y_peak_wave=-2 'upper pos of wave (magnitude_position) when displayed as sprite 
additional_squarelength=3 'number of units lower square ends below bottom of screen 
wave_move_mag=1.5 'magnitude of how waves roll back and forth max:2.5

'boat params
boat_pitch_mag=pi/24
boat_y_mag=.2
y_mid_boat=-2.8 'middle position of sprite (boat)
x_endpos_boat=-7 'x-posistion where boat makes turn(both ends)
x_pos_boat=7 'initial position of boat
delta_x_boat=-.001 'speed of boat
''
GOSUB load_sound

y_peak_pos_wave=y_peak_wave+additional_squarelength
h_square=y_peak_pos_wave-2*sin_r-ymin
y_correction=additional_squarelength

'creating sprites
create_wave_sprite("wave_blue1",blue1$)
create_boat_sprite("boat",col$)
create_wave_sprite("wave_blue2",blue2$)

'results from function
sprite_wave_h=create_wave_sprite.sprite_wave_h

SPRITE "wave_blue1" AT tc_x(0), tc_y(sprite_wave_h/2+ymin-y_correction)
SPRITE "wave_blue1" SHOW

SPRITE "wave_blue2" AT tc_x(0+sprite_cst_w/2), tc_y(sprite_wave_h/2+ymin-y_correction)
SPRITE "wave_blue2" SHOW

SPRITE "boat" AT tc_x(0)+1000,tc_y(y_mid_boat)
SPRITE "boat" SHOW

IF DEBUG THEN
 draw_sys ! draw_ticks(1,1)
ENDIF

GRAPHICS ! GRAPHICS CLEAR 0.781,0.948,1 '0.372,0.695,1
flipboat=0 ! pitch_sense=1
LOOP:
FOR phi=0 TO 2*pi STEP 0.001
 tau=-(ATAN2(ACCEL_Y(),ACCEL_X())-ATAN2(1,0))
 dlt_x=wave_move_mag*SIN(phi) ! dlt_rho=boat_pitch_mag*SIN(phi) ! dlt_y=boat_y_mag*SIN(phi)
 SPRITE "wave_blue1" AT tcr_x(dlt_x,sprite_wave_h/2+ymin-y_correction,tau), tcr_y(dlt_x,sprite_wave_h/2+ymin-y_correction,tau) ANGLE -tau
 SPRITE "wave_blue2" AT tcr_x(-dlt_x,sprite_wave_h/2+ymin-y_correction,tau), tcr_y(-dlt_x,sprite_wave_h/2+ymin-y_correction,tau) ANGLE -tau
 x_pos_boat+=delta_x_boat
 
 IF ABS(x_pos_boat)>ABS(x_endpos_boat) THEN
  delta_x_boat*=-1
  x_endpos_boat*=-1
  flipboat=1-flipboat
  pitch_sense*=-1
 ENDIF
   
 SPRITE "boat" AT tcr_x(x_pos_boat,dlt_y+y_mid_boat,tau),tcr_y(x_pos_boat,dlt_y+y_mid_boat,tau) ANGLE -tau*pitch_sense+dlt_rho FLIP flipboat
 IF TOUCH_X(0)>0 THEN END
NEXT phi
GOTO LOOP
END 'of main


'c'
DEF create_boat_sprite(sprite_name$,col$())
 sprite_height=5
 sprite_width=3
 
 'arrange coordinates
 xmin_old=.xmin ! ymin_old=.ymin ! xmax_old=.xmax ! ymax_old=.ymax 
 .xmin=0 ! .xmax=2*xmax_old
 .ymax=sprite_height ! .ymin=.ymax-(ymax_old-ymin_old)
 xmin=.xmin ! xmax=.xmax ! ymin=.ymin ! ymax=.ymax
 
 SPRITE sprite_name$ BEGIN tc_x(sprite_width), tc_y(0) '0:is the point for sprite height - counts from angle
  IF .DEBUG THEN 
   GRAPHICS ! GRAPHICS CLEAR 1,1,1
  ENDIF
  FOR element=1 TO 3
   FILL COLOR insepstr$(1,col$(element),","),insepstr$(2,col$(element),","),insepstr$(3,col$(element),",")
   counter=0
   DO
    counter+=1
    READ data_x,data_y
    x(counter)=tc_x(data_x/2) ! y(counter)=tc_y(data_y/2)
   UNTIL data_x=999 'stop sign
   FILL POLY x,y COUNT counter-1
  NEXT element
 SPRITE END
 
 'restore coordinate_params
 .xmin=xmin_old ! .xmax=xmax_old ! .ymin=ymin_old ! .ymax=ymax_old 
 DATA 0,7,6,7,3,4,999,999,3,7,3,10,3.2,10,3.2,7,999,999,3.2,8,5,8,3.2,10,999,999 'wanne, mast,segel
END DEF ' of create_boat_sprite
'==============================
DEF create_wave_sprite(sprite_name$,col$) 
 'save old coordinate_params
 xmin_old=.xmin ! ymin_old=.ymin ! xmax_old=.xmax ! ymax_old=.ymax 
 
 'copy geometry of wave
 sin_r=.sin_r
 num_waves=.num_waves
 h_square=.h_square
 
 'adapting user-screen for sprite-creation
 .xmin=0 ! .xmax=2*xmax_old
 .ymax=h_square+2*sin_r ! .ymin=.ymax-(ymax_old-ymin_old)
 xmin=.xmin ! xmax=.xmax ! ymin=.ymin ! ymax=.ymax
 
 sprite_wave_w=(xmax_old-xmin_old)/num_waves*(num_waves+2) ! sprite_wave_h=h_square+2*sin_r
 
 'sprite-creation
 debug_tc_x=tc_x(sprite_wave_w) ! debug_tc_y= tc_y(sprite_wave_h) ! debug_0=tc_y(0)
 DRAW COLOR insepstr$(1,col$,","),insepstr$(2,col$,","),insepstr$(3,col$,",")
 
 SPRITE sprite_name$ BEGIN tc_x(sprite_wave_w), tc_y(0) '0:is the point for sprite height - counts from angle
 
  IF .DEBUG THEN 
   GRAPHICS ! GRAPHICS CLEAR 1,1,1
  ENDIF
  
  FOR k=0 TO num_waves+2 STEP (num_waves)/SCREEN_WIDTH() '1/(sprite_wave_w/get_unit_x) 'unit_x shouldn't have changed with change of .xmin...
   DRAW LINE tc_x(k*sprite_wave_w/(num_waves+2)), tc_y(sin_r*SIN(2*.pi*k)+sin_r+h_square) TO tc_x(k*sprite_wave_w/(num_waves+2)),tc_y(0)
  NEXT k
  GRAPHICS MODE CLEAR
  FOR k=0 TO num_waves+2 STEP (num_waves)/SCREEN_WIDTH() '1/(sprite_wave_w/get_unit_x) 'unit_x shouldn't have changed with change of .xmin...
   DRAW LINE tc_x(k*sprite_wave_w/(num_waves+2)), tc_y(sin_r*SIN(2*.pi*k)+sin_r+h_square) TO tc_x(k*sprite_wave_w/(num_waves+2)),0 '=tc_y(.ymax)
  NEXT k
  
  GRAPHICS MODE NORMAL
 SPRITE END
 
 'restore coordinate_params
 .xmin=xmin_old ! .xmax=xmax_old ! .ymin=ymin_old ! .ymax=ymax_old 
END DEF 'of create_wave_sprite
'==============================LIBS==============================
DEF draw_sys()
 IF .ymin=0 AND .ymax=0 THEN 
  .ymin=.xmin*SCREEN_HEIGHT()/SCREEN_WIDTH() ! .ymax=.xmax*SCREEN_HEIGHT()/SCREEN_WIDTH()
 ENDIF
 IF .xmin=0 AND .xmax=0 THEN 
  .xmin=.ymin*SCREEN_WIDTH()/SCREEN_HEIGHT() ! .xmax=.ymax*SCREEN_WIDTH()/SCREEN_HEIGHT()
 ENDIF
 DRAW LINE tc_x(.xmin),tc_y(0) TO  tc_x(.xmax),tc_y(0)
 DRAW LINE tc_x(0),tc_y(.ymin) TO tc_x(0),tc_y(.ymax)
END DEF 
'================= 
DEF draw_ticks(tick_x,tick_y)
 IF .ymin=0 AND .ymax=0 THEN 
  .ymin=.xmin*SCREEN_HEIGHT()/SCREEN_WIDTH() ! .ymax=.xmax*SCREEN_HEIGHT()/SCREEN_WIDTH()
 ENDIF
 IF .xmin=0 AND .xmax=0 THEN 
  .xmin=.ymin*SCREEN_WIDTH()/SCREEN_HEIGHT() ! .xmax=.ymax*SCREEN_WIDTH()/SCREEN_HEIGHT()
 ENDIF 
 FOR n=tick_x TO .xmax STEP tick_x
  DRAW LINE tc_x(n),tc_y(0)-5 TO tc_x(n), tc_y(0)+5
 NEXT n
 
 FOR n= -tick_x TO .xmin STEP -tick_x
  DRAW LINE tc_x(n),tc_y(0)-5 TO tc_x(n), tc_y(0)+5 
 NEXT n
 
 
 FOR n=tick_y TO .yMAX STEP tick_y 
  DRAW LINE tc_x(0)-5,tc_y(n) TO tc_x(0)+5, tc_y(n)
 NEXT n
 
 FOR n=-tick_y TO .ymin STEP -tick_y
  DRAW LINE tc_x(0)-5,tc_y(n) TO tc_x(0)+5, tc_y(n)
 NEXT n
END DEF
'=================
DEF tcr_x(x,y,tau)
 RETURN tc_x(rot_x(x,y,tau))
END DEF
'=================
DEF tcr_y(x,y,tau)
 RETURN tc_y(rot_y(x,y,tau))
END DEF
'=================
DEF rot_x(x,y,tau)
 phi=ATAN2(y,x)
 r=SQR(x*x+y*y)
 RETURN r*COS(phi+tau)
END DEF
'=================
DEF rot_y(x,y,tau)
 phi=ATAN2(y,x)
 r=SQR(x*x+y*y)
 RETURN r*SIN(phi+tau)
END DEF
'=================
DEF tc_x(x)
 'calculate min& max values when those are left to zero respecting screen-ratio 
 IF .ymin=0 AND .ymax=0 THEN 
  .ymin=.xmin*SCREEN_HEIGHT()/SCREEN_WIDTH() ! .ymax=.xmax*SCREEN_HEIGHT()/SCREEN_WIDTH()
 ENDIF
 IF .xmin=0 AND .xmax=0 THEN 
  .xmin=.ymin*SCREEN_WIDTH()/SCREEN_HEIGHT() ! .xmax=.ymax*SCREEN_WIDTH()/SCREEN_HEIGHT()
 ENDIF 
 
 'calculate gradient, linear transormation function  
 mx=SCREEN_WIDTH() /(.xmax-.xmin)
 x0=(-1)*.xmin*mx
 tc_x=x*mx+x0
END DEF
'=================
DEF tc_y(y)
 IF .ymin=0 AND .ymax=0 THEN 
  .ymin=.xmin*SCREEN_HEIGHT()/SCREEN_WIDTH() ! .ymax=.xmax*SCREEN_HEIGHT()/SCREEN_WIDTH()
 ENDIF
 IF .xmin=0 AND .xmax=0 THEN 
  .xmin=.ymin*SCREEN_WIDTH()/SCREEN_HEIGHT() ! .xmax=.ymax*SCREEN_WIDTH()/SCREEN_HEIGHT()
 ENDIF
 my=SCREEN_HEIGHT() / (.ymin-.ymax)
 y0=(-1)*.ymax*my
 tc_y=y*my+y0
END DEF
'=================
DEF insepstr$(section,s1$,S2$)
 IF MAX(LEN(s1$),LEN(s2$))=LEN(s1$) THEN 's1 the longest?
  separator$=s2$ ! string$=s1$ 'shortest is separator
 ELSE
  string$=s2$ ! separator$=s1$
 ENDIF
  
 IF string$="" THEN RETURN "ERROR" '-1 problematisch bei der auswertung. Stoppzeichen definieren und übergeben?
 'insepstr$(2,",","123,4567,890") -> 4567
 option_base_=OPTION_BASE()
 OPTION BASE 1
 length=LEN(string$)
 IF INSTR(string$,separator$,1)=-1 AND section=1 THEN RETURN string$ '-1 'trennzeichen nicht vorhanden
 pos2=0
 FOR n= 1 TO section
  pos1=pos2+1 
  IF pos1<=LEN(string$) THEN pos2=INSTR(string$,separator$,pos1) ELSE RETURN "ERROR" '-1
  IF pos2 = -1 THEN BREAK 'letztes komma fehlt
 NEXT n
  IF n=section AND pos1<=length THEN pos2=length+1 'letzte komma fehlt
  IF n<section THEN RETURN "ERROR" '-1 'weniger sections als erwartet
  '(n=section und noch zeichen übrig: letztes komma fehlt, sonst zuwenig sections
  
  RETURN MID$(string$,pos1,pos2-pos1)
 OPTION BASE option_base_
END DEF
'b'
load_sound:
IF FILE_EXISTS(filename$) THEN
 MUSIC "seagulls" LOAD filename$ 
 MUSIC "seagulls" LOOP
ELSE
 a$="soundbible.com/grab.php?id=191&type=wav"
 HTTP a$ GETDIM t,n
 FILE filename$ WRITEDIM t,n
 WHILE NOT FILE_EXISTS(filename$) ! END WHILE
 MUSIC "seagulls" LOAD filename$
 MUSIC "seagulls" LOOP
ENDIF
RETURN 'of load_sound