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

Posted: **Thu Jan 05, 2017 5:29 pm**

Hi y'all,
can't help it...german people do love libreries, so I'm gonna add some stuff here again...

This time it's about building up chains, like you can do with pointers or so.

The chain can be used to crawl through datas, that are aligned in a closed chain. You can pick elements from the chain and thus remove them or to insert them behind an other element. you can use the chain for example to make sure, that you use a content of the chain only once.

Again I left the testing-snippets, so you can play around with the functions ...Of course they can be deleted thereafter

Have fun with it.

Joel.

Code: Select all

/*
COLORS used in code
'y': comments
'' :main progamm
'b':testroutines
'c':functions
''
*/
/*

'auskommentieren - ANFANG
sw=SCREEN_WIDTH() ! sh=SCREEN_HEIGHT()
INPUT "testnumber: e.g.6:":test
ON test GOSUB test1,test2,test3,test4,test5,test6
END

'b'
test1:
 
RETURN 'of test1
'==========
test2:
 INPUT "OPTION BASE (0 / 1)":array_base
 OPTION BASE array_base
 DIM array$(4,10)
 chain_build(array$,10)
 PRINT "predecessor","element","successor","content"
 PRINT "_____________________________________________"
 FOR n=array_base TO 10-1+array_base
  READ a$
  array$(array_base+3,n)=a$
  
  PRINT array$(array_base,n),array$(array_base+1,n), array$(array_base+2,n),array$(array_base+3,n)
  
 NEXT n
DATA "a","b","c","d","e","f","g","h","i","j"  
RETURN 'of test2
'===========
test3:
 GOSUB test2
 t3_loop:
 PRINT
 INPUT element_to_pick
 start_element=array$(array_base+2,element_to_pick)
 chain_pick(array$,element_to_pick)
 element=start_element 'start DO-UNTIL with this element
 PRINT "predecessor","element","successor","content"
 PRINT "_____________________________________________"
 DO
   PRINT chain_cont$(array$,array_base,element),chain_cont$(array$,array_base+1,element),chain_cont$(array$,array_base+2,element),chain_cont$(array$,array_base+3,element)
   'PRINT array$(array_base,element),array$(array_base+1,element),array$(array_base+2,element),array$(array_base+3,element)  
   next_element=array$(array_base+2,element) 'index of next element
   element=next_element
   IF element=start_element THEN LOOP=LOOP+1 'stop when chain has been run through 
  UNTIL LOOP=2
 'GOTO t3_loop 
RETURN 'of test3
'===========
test4:
 GOSUB test3
 LOOP=0
 PRINT
 INPUT insert_after
 start_element=array$(array_base+2,insert_after)
 PRINT chain_ins(array$,10,insert_after)
 element=start_element 'start DO-UNTIL with this element
 PRINT "predecessor","element","successor","content"
 PRINT "_____________________________________________"
 DO
   PRINT array$(array_base,element),array$(array_base+1,element),array$(array_base+2,element),array$(array_base+3,element) 
   next_element=array$(array_base+2,element) 'index of next element
   element=next_element
   IF element=start_element THEN LOOP=LOOP+1 'stop when chain has been run through 
  UNTIL LOOP=2
RETURN 'of test4
'===========
test5:
 GOSUB test4
 LOOP=0
 INPUT insert_after
 start_element=array$(array_base+2,insert_after)
 PRINT chain_ins(array$,10,insert_after)
 element=start_element 'start DO-UNTIL with this element
 PRINT "predecessor","element","successor","content"
 PRINT "_____________________________________________"
 DO
  PRINT array$(array_base,element),array$(array_base+1,element),array$(array_base+2,element),array$(array_base+3,element) 
  next_element=array$(array_base+2,element) 'index of next element
  element=next_element
  IF element=start_element THEN LOOP=LOOP+1 'stop when chain has been run through 
 UNTIL LOOP=2
RETURN 'of test5
'==========
test6:'chain()
 GOSUB test4
 PRINT
 'create buttons
 FOR n=0 TO 7
  READ button_name$
  BUTTON button_name$ TEXT button_name$ AT sw*.8,sh*.2+sh*n/10 SIZE sw*.2,sh*.1
  BUTTON button_name$ SHOW
 NEXT n
 
 'check buttons pressed
 test6_loop:
 SLOWDOWN
 RESTORE TO button_names
 FOR n=1 TO 8
  READ button_name$
  IF BUTTON_PRESSED(button_name$) THEN BREAK
 NEXT n 
 IF n=9 THEN GOTO test6_loop
 ON n GOSUB t6_prev,t6_current,t6_next,t6_pick,t6_list,t6_first,t6_curr_cont,t6_size
 GOTO test6_loop
 
 t6_prev:
  PRINT chain(array$,-1)
 RETURN 'of t6_prev
 
 t6_current:
  PRINT chain(array$,0)
 RETURN 'of t6_current
 
 t6_next:
  PRINT chain(array$,1)
 RETURN 'of t6_next
 
 t6_pick:
  chain_pick(array$,chain(array$,0))
 RETURN 'of t6_pick
 
 t6_list:
  PRINT
  array_base=OPTION_BASE()
  index_start=chain(array$,0)
  element=index_start
  PRINT "predecessor","element","successor","content"
 PRINT "_____________________________________________"
  DO
   PRINT array$(array_base,element),array$(array_base+1,element),array$(array_base+2,element),array$(array_base+3,element)
   element=chain(array$,1)
  UNTIL element=index_start
 RETURN 'of t6_list
 
 t6_first:
  PRINT chain_first(array$)
 RETURN 'of t6_first
 
 t6_curr_cont:
  PRINT chain_cont1$(array$,array_base+3)
 RETURN 'of t7_current
 
 t6_size:
  PRINT chain_size(array$)
 RETURN 'of t6_size
 
 button_names:
 DATA "prev","current","next","pick","list","first","curr_cont_4","size"
RETURN 'of test6


'auskommentieren - ENDE
*/
'c'

''
'c'
'builds up a chain off arrays where 1st index = "pointer" (dimension=3) and 2nd index is integer with "dimension" 
'1st index 0..2 or 1..3 dependent on option base.
'OPTION BASE 0: 1:= index of this, 0:= index of previous element, 2:= index of next element 
'==========
DEF chain_build(array$(,),dimension)
  chain.dimension=dimension
  array_base=OPTION_BASE() 'index of 1st element
  array_highest=dimension-1+array_base 'index of last element
  
  FOR n= array_base+1 TO array_highest-1 'first and last element are treated separately
   array$(array_base+1,n)=n 'index of "this"
   array$(array_base+2,n)=n+1 'next
   array$(array_base,n)=n-1 'previous
  NEXT n
  
  'treatment of 1st...
  array$(array_base+1,array_base)=array_base 'this of 1st element
  array$(array_base+2,array_base)=array_base+1 'next of 1st element
  array$(array_base,array_base)=array_highest 'previous of 1st element
  '... and last element
  array$(array_base+1,array_highest)=array_highest 'this of last element
  array$(array_base+2,array_highest)=array_base 'next of last element
  array$(array_base,array_highest)=array_highest-1 'previous of last element
  chain(array$,0)'initiate chain.first_element, chain.current_element, 
END DEF
''
'c'

'picks an element and "repairs" the chain. index=-1 picks the current element (of chain())

DEF chain_pick(array$(,),index)   
 array_base=OPTION_BASE()
 IF index=chain.current_element THEN chain.current_element=array$(array_base+2,index)'falls current=index
 IF index=chain.first_element THEN chain.first_element=array$(array_base+2,index)'falls first=index
 'look up previous and next element of current element 
 prev_element=array$(array_base,index)
 next_element=array$(array_base+2,index)
 IF prev_element>-1 AND next_element>-1 THEN 'element is in chain 
  'setting prev and next to '-1'
  array$(array_base,index)=-1
  array$(array_base+2,index)=-1
  'array$(array_base+1,index)=-1 '??
 
  array$(array_base+2,prev_element)=next_element 'previous element points to next element
  array$(array_base,next_element)=prev_element 'next element points to previous
  chain_pick=index
  chain.dimension=chain.dimension-1
 ELSE
  chain_pick=-1
 ENDIF
 called=1
END DEF
''
'c'

'inserts element behind current index and returns 1 if sucessful otherwise -1 and doesn't change anything
DEF chain_ins(array$(,),dimension,index)'dimension:wg.nächstes freies element
 array_base=OPTION_BASE()
 array_highest=dimension-1+array_base
 next_element=array$(array_base+2,index)
 FOR n=array_base TO array_highest
  IF array$(array_base,n)=array$(array_base+2,n) THEN BREAK 'sucht nächstes freies element
 NEXT n
 IF n>array_highest THEN
  chain_ins=-1
 ELSE
  chain_ins=1
  free_index=n
  'array$(array_base+1,free_index)=free_index 'this
  array$(array_base,free_index)=index 'new element points to current element
  array$(array_base+2,index)=free_index 'current element points to new element 
  
  array$(array_base+2,free_index)=next_element 'new element points to next element
  array$(array_base,next_element)=free_index 'next element points to new element
  chain.dimension=chain.dimension+1
 ENDIF
END DEF
''
'c'

'current_element
'works with chain_pick
DEF chain(array$(,),control)  
 array_base=OPTION_BASE()
 
 IF NOT called THEN
  first_element=array_base
  current_element=first_element
 ENDIF
 'ON control+2 GOSUB go_back,get_current_element,go_forward
 
 IF control=0 THEN 
  GOSUB get_current_element
 ELSE
  FOR n=1 TO ABS(control)
   current_element=array$(array_base+SGN(control)+1,current_element)
  NEXT n 
 ENDIF 
 
 GOTO chain_end
'b'
 get_current_element:
  'implizit
 RETURN 'of current element
 /*
 go_back:
  current_element=array$(array_base,current_element)
 RETURN 'of go_back
 
 go_forward:
  current_element=array$(array_base+2,current_element)
 RETURN 'of go_forward
 */
''
'c'
 chain_end:
 chain=current_element
 called =1
END DEF 
''
'c'
DEF chain_first(array$(,))
 chain_first=chain.first_element
END DEF
'==========
DEF chain_current(array$(,))
 chain_current=chain.current_element
END DEF
'==========
DEF chain_cont$(array$(,),index_a,index_b)
 IF index_a>-1 AND index_b >-1 THEN
 chain_cont$=array$(index_a,index_b)
 ENDIF 
END DEF
'==========
DEF chain_cont1$(array$(,),index_a)
 index_b=chain.current_element
 chain_cont1$=array$(index_a,index_b)
END DEF
'==========
DEF chain_size(array$(,))
 chain_size=chain.dimension
END DEF
'==========
DEF wait_touch
 'press button
 DO
  SLOWDOWN
  GET TOUCH 0 AS .t_x,.t_y
 UNTIL .t_x>-1
 'release button
 DO 
  SLOWDOWN
  GET TOUCH 0 AS t_x,t_y
 UNTIL t_x=-1
END DEF
'==========
DEF wait_touch_key
 'press button or key
 DO
  SLOWDOWN
  GET TOUCH 0 AS .t_x,.t_y
  key$=INKEY$()
 UNTIL .t_x>-1 OR key$<>""
 'release button or key
 DO 
  SLOWDOWN
  GET TOUCH 0 AS t_x,t_y
  key$=INKEY$()
 UNTIL t_x=-1 OR key$=""
END DEF

Posted: **Fri Jan 20, 2017 4:26 pm**

You probably know that issue: You are writing a function that is not supposed to change any of the settings like FILL COLOR ecc. Now you are unable to save these settings, since there aren't any built-in-check-functions. But you need to change them anyway
So I wrote a few lines in order to check the following settings:
- draw color
- draw alpha
- fill color
- fill alpha
- draw size d_s
- (font size): there is a function. realized it too late
- option text pos normal text_pos_normal

May be the one or the other can make use of it...Bye, Joel

P.S. oops, made a last-minute-change after having posted it here:
GRAPHICS SAVE 0,0, 100,100 TO "save_graphic_params" changed as follows:
GRAPHICS SAVE 0,0, 150,150 TO "save_graphic_params"

Code: Select all

DEF save_graphic_params
 IF NOT called THEN called=1
 GRAPHICS SAVE 0,0, 150,150 TO "save_graphic_params" 'need a small corner to check something out...so save that corner
 'function checks and saves the folowing settings:
 'draw color d_r,d_g,d_b,d_a
 'fill color f_r,f_g,f_b,f_a
 'draw size d_s
 'font size f_s
 'option text pos normal text_pos_normal
 
 scr=SCREEN_SCALE() 'Retina:2
 
 'check draw color
 DRAW LINE 0,0 TO 1,1
 GET PIXEL 0,0 COLOR d_r,d_g,d_b, d_A
 
 'check fill color
 FILL RECT 0,0 TO 1,1
 GET PIXEL 0,0 COLOR f_r,f_g,f_b,f_a
 
 'check draw size
 FILL COLOR 1,1,1 'white for background
 FILL RECT 0,0 TO 50,50
 
 DRAW COLOR 0,0,0 'black for drawing
 DRAW LINE 0,0 TO 0,1
 
 FOR d_s=0 TO 50
  GET PIXEL x,0 COLOR c_r,c_g,c_b,c_a
  IF c_r=1 THEN BREAK
 NEXT d_s
 
 f_s = FONT_SIZE()
 
 'check text_pos
 DRAW FONT SIZE 15 'will be restored at the end of this function
 FILL RECT 0,0 TO 120,120
 teststr$=CHR$(124)&"                  "
 DRAW TEXT teststr$ AT 0,0
 FOR y_pos=0 TO TEXT_HEIGHT("T")*scr
  FOR x_pos=0 TO 50*scr
   GET PIXEL x_pos,y_pos COLOR r,g,b,a
   IF r=0 THEN BREAK  
  NEXT x_pos
   IF r=0 THEN BREAK
 NEXT y_pos
 
 IF x_pos=50*scr+1 AND y_pos=TEXT_HEIGHT("T")*scr+1 THEN text_pos_normal=0 ELSE text_pos_normal=1
 
 'restore changed settings:draw color / fill color / font size
 DRAW FONT SIZE f_s
 DRAW COLOR d_r,d_g,d_b ! DRAW ALPHA d_a
 FILL COLOR f_r,f_g,f_b ! FILL ALPHA f_a
 DRAW IMAGE "save_graphic_params" AT 0,0 'restoring the corner
END DEF
'==========
DEF restore_graphic_params
 'restores the settings saved by save_graphic_params:
 'draw color d_r,d_g,d_b,d_a
 'fill color f_r,f_g,f_b,f_a
 'draw size d_s
 'font size f_s
 'option text pos normal text_pos_normal
 IF save_graphic_params.called THEN 'change only if there are evaluable settings saved
  DRAW COLOR save_graphic_params.d_r, save_graphic_params.d_g, save_graphic_params.d_b
  DRAW ALPHA save_graphic_params.d_a
  FILL COLOR save_graphic_params.f_r, save_graphic_params.f_g, save_graphic_params.f_b
  FILL ALPHA save_graphic_params.f_a
  DRAW SIZE save_graphic_params.d_s
  DRAW FONT SIZE save_graphic_params.f_s
  IF save_graphic_params.text_pos_normal=1 THEN 
   OPTION TEXT POS NORMAL
  ELSE
   OPTION TEXT POS CENTRAL
  ENDIF
 ENDIF  
END DEF

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

utilities

utilities

Re: utilities