Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

omafrac v0.1

Uploader:Mitgliedcroco97
Datum/Zeit:31.10.2009 08:27:28
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Omafrac, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

'---------------------------------------------------
' Omafract 0.1
' ------------
'
' Program to draw several kinds of fratcals
' Calculations are easy to understand and to modify
' Up to 10000 x 10000 pixel fractals
' 4-part-color palettes
'
' Requires GTK+ 2.16 or higher
'
' This program is a GTK+ teaching example for the programming tutorial
' "Programmieren für Oma"
' http://www.o-bizz.de/qbtuts/omastut/index.htm
' http://www.askos.de/tutorial
'
' by Christof Schatz, Munich 2009
'
' License: LGPL. See COPYING
'---------------------------------------------------

'---------------------------------------------
'Debugging list:
'- No zoom and switch of the bitmap size at the same time.
'- No run execution on ENTER strikes in the text fields ==> More a feature
'- No picture save dialog
'- Save config with picture
'- Somtimes the saved picture has a border which is not intended.
'- Radio Button group warnings at runtime.
'- Show area coordinates in fractal parameter window
'- Show formula in fractal parameter window
'---------------------------------------------

' Merke: Guenstig waere, die Schliessfunktion der Tochterfenster zu deaktivieren, so dass nur noch der Close-Button
' zum Schliessen fuehrt ==> Widgets werden nicht zerstoert. set deletable=false wird aber erst ab GTK 2.18 angeboten.


#include "gtk/gtk.bi"
#include "gtk/libglade/glade-xml.bi"
#define  WIN 1
'#define OS LINUX 1

#ifndef NULL
#define NULL 0
#endif

const loglevel=0

const Cgladefile="fract3.glade"
const Ccolormapsize=4
const Cnmodels=4
const Ccolorrgbmapsize=10000

const Cselect_mode=0
const Cmove_mode=1
const Cbitmapwidth_default=200
const Cbitmapheight_default=200
const Ctestdraw=0
const Cconfig_fname="omafrac.ini"
const Csizewidgetstore=10


dim shared as GtkWidget ptr toplevel
dim shared xml as GladeXML ptr 'xml-Handle fuer das Hauptfenster
dim shared xmlparam as GladeXML ptr 'xml-Handle fuer den Paramterfensterzweig
dim shared xmlcolor as GladeXML ptr 'xml-Handle fuer den Colorselect-Fensterzweig
dim shared systemstart as gboolean = TRUE
dim shared as _GdkColor ptr black0,white0,blue0

' ------------------------------------------------------------------------------------------------------------


Sub brkmess(s as string)

  ? s
  sleep
  end

end sub


#include "omalist.bas"

' ------------------------------------------------------------------------------------------------------------

sub omagtk_msgbox(s as string)

      DIM AS GtkWidget PTR dialog
      dim as zstring ptr signaltype

      dialog = gtk_message_dialog_new (0, _
                                      GTK_DIALOG_DESTROY_WITH_PARENT, _
                                      GTK_MESSAGE_WARNING, _
                                      GTK_BUTTONS_OK, _
                                      s,0)
      gtk_dialog_run(GTK_DIALOG(dialog))
      gtk_widget_destroy( GTK_WIDGET(dialog))

end sub

' ------------------------------------------------------------------------------------------------------------

function min(x1 as integer, x2 as integer) as integer
  min=x1
  if (x2<x1) then min=x2
end function

function max(x1 as integer, x2 as integer) as integer
  max=x1
  if (x2>x1) then max=x2
end function

' ------------------------------------------------------------------------------------------------------------

'%%5
type tomafrac
  width as integer
  height as integer
  xpos as integer
  ypos as integer
  iter as integer
  a1 as double
  a2 as double
  b1 as double
  b2 as double
  z01lo as double
  z01up as double
  z02lo as double
  z02up as double
  iterlim as integer
  colorstep as integer
  drawingarea as GtkWidget ptr
  currentfrac as string
  configfname as string

  declare sub init
  declare sub draw
  declare sub draw_custom1
  declare sub draw_apple
  declare sub draw_julia
  declare sub draw_biomorph
  declare sub testdraw
  declare sub bplot(x as integer, y as integer, col as integer)
  declare sub loadiniconfig(fracname as string, fname as string)
  declare sub loadconfig
  declare sub saveconfig
  declare sub printconfig(fname as string)
  declare function configread(s as string, name1 as string) as double
  declare function configread2(s as string, name1 as string) as string

end type

dim shared as tomafrac ptr omafrac

' ------------------------------------------------------------------------------------------------------------

type tframe
  dim as double x1,x2,y1,y2
end type

' ------------------------------------------------------------------------------------------------------------

type tomagtkmap

  map as GdkPixmap ptr
  map_nx as integer
  map_ny as integer
  map_x as integer
  map_y as integer
  init0 as gboolean
  init_done as gboolean
  init1_done as gboolean
  map_ncolor as integer
  prop1 as gboolean

  context as GdkGC ptr
  fgcolor as _gdkcolor ptr
  bgcolor as _gdkcolor ptr


  declare constructor()
  declare sub init(nwidth as integer, nheight as integer, ncolorbit as integer)
  declare Sub init1()
  declare sub init2(nwidth as integer, nheight as integer, ncolorbit as integer)
  declare sub close()
  declare sub setcolor(fg_red as integer,fg_green as integer, fg_blue as integer, bg_red as integer, bg_green as integer, bg_blue as integer)
  declare sub rectangle(filled as gboolean, x as integer, y as integer, wwidth as integer, wheight as integer)
  declare sub save(fname as string)
  declare sub load(fname as string)

end type



'--------------------------------------------------------------------------------------------------

'%%5


' mainwindow:
'-------------

declare sub on_drawingarea1_expose_event           cdecl alias "on_drawingarea1_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_button1_clicked                        cdecl alias "on_button1_clicked" (byval object as GtkObject  ptr, byval user_data as gpointer)

declare function on_drawingarea1_button_press_event cdecl alias "on_drawingarea1_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_drawingarea1_motion_notify_event cdecl alias "on_drawingarea1_motion_notify_event" (byval object as GtkWidget ptr,  byval button as GdkEventMotion ptr, byval user_data as gpointer) as gboolean

declare function on_drawingarea1_button_release_event cdecl alias "on_drawingarea1_button_release_event" (byval object as  GtkWidget ptr,  byval button as GdkEventMotion ptr, byval user_data as gpointer) as gboolean

declare sub on_select_frame_clicked cdecl alias "on_select_frame_clicked" (byval widget as GtkToggleButton ptr, byval user_data as gpointer)
declare sub  on_move_map_clicked cdecl alias "on_move_map_clicked" (byval widget as GtkToggleButton ptr, byval user_data as gpointer)

'declare sub  on_select_frame_group_changed cdecl alias "on_select_frame_group_changed" (byval widget as GtkWidget  ptr, byval user_data as gpointer)
'declare sub  on_move_map_group_changed cdecl alias "on_move_map_group_changed" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare function on_entry_bitmwidth_key_press_event CDECL alias "on_entry_bitmwidth_key_press_event" (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean

declare function on_entry_bitmheight_key_press_event CDECL alias "on_entry_bitmheight_key_press_event" (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean


declare SUB on_mainwindow_destroy CDECL alias "on_mainwindow_destroy" (BYVAL menuitem AS GtkMenuItem  PTR, BYVAL user_data AS gpointer)

declare sub on_color1_clicked cdecl alias "on_color1_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub openparam_butt_clicked cdecl alias "openparam_butt_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

DECLARE SUB on_window1_destroy CDECL alias "on_window1_destroy" (BYVAL menuitem AS GtkMenuItem  PTR, BYVAL user_data AS gpointer)

declare sub on_button_run_clicked cdecl alias "on_button_run_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub on_button_help_clicked cdecl alias "on_button_help_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub on_stop_clicked cdecl alias "on_stop_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub on_unzoom_button_clicked cdecl alias "on_unzoom_button_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub prop1check_toggled cdecl alias "prop1check_toggled" (byval object as GtkToggleButton ptr,  byval user_data as gpointer)



' paramwindow:
'-------------

declare sub paramwin_closebutton_clicked cdecl alias "paramwin_closebutton_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub save_config_butt_clicked cdecl alias "save_config_butt_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub load_config_butt_clicked cdecl alias "load_config_butt_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub  on_model1_clicked cdecl alias "on_model1_clicked" (byval widget as GtkToggleButton ptr, byval user_data as gpointer)
declare sub  on_model2_clicked cdecl alias "on_model2_clicked" (byval widget as GtkToggleButton ptr, byval user_data as gpointer)
declare sub  on_model3_clicked cdecl alias "on_model3_clicked" (byval widget as GtkToggleButton ptr, byval user_data as gpointer)
declare sub  on_model4_clicked cdecl alias "on_model4_clicked" (byval widget as GtkToggleButton ptr, byval user_data as gpointer)

declare sub set_modelbuttons


' colorwindow:
'-------------
declare function on_color1box1_button_press_event cdecl alias "on_color1box1_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color1box2_button_press_event cdecl alias "on_color1box2_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color2box1_button_press_event cdecl alias "on_color2box1_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color2box2_button_press_event cdecl alias "on_color2box2_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color3box1_button_press_event cdecl alias "on_color3box1_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color3box2_button_press_event cdecl alias "on_color3box2_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color4box1_button_press_event cdecl alias "on_color4box1_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean

declare function on_color4box2_button_press_event cdecl alias "on_color4box2_button_press_event" (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean


declare sub on_colorselectwin_closebutton_clicked cdecl alias "on_colorselectwin_closebutton_clicked" (byval object as GtkWidget ptr,  byval user_data as gpointer)

declare sub on_color1box1_expose_event           cdecl alias "on_color1box1_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color1box2_expose_event           cdecl alias "on_color1box2_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color2box1_expose_event           cdecl alias "on_color2box1_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color2box2_expose_event           cdecl alias "on_color2box2_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color3box1_expose_event           cdecl alias "on_color3box1_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color3box2_expose_event           cdecl alias "on_color3box2_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color4box1_expose_event           cdecl alias "on_color4box1_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare sub on_color4box2_expose_event           cdecl alias "on_color4box2_expose_event" (byval widget as GtkWidget  ptr, byval user_data as gpointer)

declare function on_color1_nentry_key_press_event CDECL alias "on_color1_nentry_key_press_event" (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean

declare function on_color2_nentry_key_press_event CDECL alias "on_color2_nentry_key_press_event" (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean




'--------------------------------------------------------------------------------------------------


constructor tomagtkmap()
  init0=false
  init_done=false
  init1_done=false
  prop1=false
end constructor

'--------------------------------------------------------------------------------------------------


Sub tomagtkmap.init(nwidth as integer, nheight as integer, ncolorbit as integer)

  map_nx=nwidth
  map_ny=nheight
  map_ncolor=ncolorbit
  prop1=false

  map=gdk_pixmap_new(NULL,map_nx,map_ny,24)
  if (map=NULL) then omagtk_msgbox("omagtkmap_init():  gdk_pixmap_new() failed")

  fgcolor=allocate(Len(_GdkColor))
  bgcolor=allocate(Len(_GdkColor))
  init_done=true

End Sub

'--------------------------------------------------------------------------------------------------


Sub tomagtkmap.init2(nwidth as integer, nheight as integer, ncolorbit as integer)

  'Init, but no allocation of fgcolor/bgcolor

  map_nx=nwidth
  map_ny=nheight
  map_ncolor=ncolorbit

  map=gdk_pixmap_new(NULL,map_nx,map_ny,24)
  if (map=NULL) then omagtk_msgbox("omagtkmap_init():  gdk_pixmap_new() failed")

  init_done=true

End Sub



Sub tomagtkmap.init1()

  context=gdk_gc_new(toplevel->window)
  'setcolor(0,255,0,0,0,0)
  'rectangle(TRUE,0,0,100,100)
  'setcolor(255,0,0,0,0,0)
  'rectangle(FALSE,100,100,170,170)
  'setcolor(127,0,127,0,0,0)
  'rectangle(FALSE,200,200,300,400)
  map_x=0
  map_y=0
  omafrac->init
  omafrac->width=map_nx
  omafrac->height=map_ny
  load("omastart.png")
  'omafrac.draw

  init1_done=true


end sub




'--------------------------------------------------------------------------------------------------

Sub tomagtkmap.close()

  deallocate fgcolor
  deallocate bgcolor
  init1_done=false
  init_done=false

End Sub

'--------------------------------------------------------------------------------------------------

sub tomagtkmap.rectangle(filled as gboolean, x as integer, y as integer, wwidth as integer, wheight as integer)

  dim as GtkWidget ptr w
  'setcolor(255,0,0,255,0,0)
  w = glade_xml_get_widget( xml, "drawingarea1" )
  if (w=NULL) then omagtk_msgbox("tomagtkmap.rectangle() Error widget not found")

  'context=gdk_gc_new(w)
  gdk_gc_set_foreground(context,fgcolor)
  gdk_gc_set_background(context,bgcolor)

  gdk_draw_rectangle(map,context,filled,x,y,wwidth,wheight)

end sub

'--------------------------------------------------------------------------------------------------

sub storecolor(fg_red as integer,fg_green as integer, fg_blue as integer, color1 as _GdkColor ptr)

  color1->pixel=fg_red*&h10000+fg_green*&h100+fg_blue
  color1->red=fg_red
  color1->green=fg_green
  color1->blue=fg_blue

end sub


'--------------------------------------------------------------------------------------------------

sub tomagtkmap.setcolor(fg_red as integer,fg_green as integer, fg_blue as integer, bg_red as integer, bg_green as integer, bg_blue as integer)

  fgcolor->pixel=fg_red*&h10000+fg_green*&h100+fg_blue
  fgcolor->red=fg_red
  fgcolor->green=fg_green
  fgcolor->blue=fg_blue

  bgcolor->pixel=bg_red*&h10000+bg_green*&h100+bg_blue
  bgcolor->red=bg_red
  bgcolor->green=bg_green
  bgcolor->blue=bg_blue

  gdk_gc_set_foreground(context,fgcolor)

end sub

'--------------------------------------------------------------------------------------------------

sub tomagtkmap.save(fname as string)

  'dim as GtkWidget ptr w
  'w = glade_xml_get_widget( xml, "drawingarea1" )
  'if (w=NULL) then brkmess("tomagtkmap.rectangle() Error widget not found")
  dim as GdkPixbuf ptr tempbuf
  dim as GError ptr ptr err1


  'Um abzuspeichern, muss die omagtkmap-pixmap in eine pixbuf transferiert werden.
  tempbuf=gdk_pixbuf_new(GDK_COLORSPACE_RGB,FALSE,8,map_nx,map_ny)
  if (tempbuf=NULL) then omagtk_msgbox("tomagtkmap.save():  gdk_pixbuf_new() failed")

  gdk_pixbuf_get_from_drawable(tempbuf,map,gdk_drawable_get_colormap(map),1,1,0,0,map_nx-1,map_ny-1)
  gdk_pixbuf_save(tempbuf,fname,"png",err1,NULL)

  'Sag der Garbage Collection, dass sie den Speicher wieder freigeben kann
  gdk_pixbuf_unref(tempbuf)




  'gtk_widget_get_colormap(w)

  'gdk_gc_get_colormap(context)

end sub


'--------------------------------------------------------------------------------------------------

sub tomagtkmap.load(fname as string)

  'dim as GtkWidget ptr w
  'w = glade_xml_get_widget( xml, "drawingarea1" )
  'if (w=NULL) then brkmess("tomagtkmap.rectangle() Error widget not found")
  dim as GdkPixbuf ptr tempbuf
  dim as GError ptr ptr err1


  'Um zu laden, muss das Bild zunaechst in einer pixbuf zwischengespeichert werden.
  tempbuf=gdk_pixbuf_new_from_file(fname,err1)
  if (tempbuf=NULL) then omagtk_msgbox("tomagtkmap.load(): File not found")

  gdk_pixbuf_render_to_drawable(tempbuf,map,context,0,0,0,0,map_nx,map_ny,GDK_RGB_DITHER_NONE,0,0)


  'dim as GtkWidget ptr w
  'w = glade_xml_get_widget( xml, "drawingarea1" )
  'on_drawingarea1_expose_event(w,NULL)

end sub


'--------------------------------------------------------------------------------------------------

dim shared area1 as tomagtkmap

'--------------------------------------------------------------------------------------------------


'%%6
type tgtk_data
  old_x as integer
  old_y as integer
  old_mapx as integer
  old_mapy as integer
  window_width as integer
  window_height as integer
  window_prop as double

  mouse_mode as integer
  dragframeset as gboolean
  stopflag as gboolean
  all_param_entrys(Csizewidgetstore) as GtkWidget ptr
  all_modelwidgets(Cnmodels) as GtkWidget ptr
  nall_param_entrys as integer

  frame_x1 as integer
  frame_x2 as integer
  frame_y1 as integer
  frame_y2 as integer

  zoomlist as tomalist
  h1 as integer

  declare constructor
  declare sub add_entryhandle(widgetname as string)
  declare sub insert_entryhandle(i as integer, widgetname as string, xml2 as GladeXML ptr)
  declare function feed1(w as GtkWidget ptr) as integer
  declare function feed2(w as GtkWidget ptr) as double
  declare function feed3(w as GtkWidget ptr) as string

  declare sub load
  declare sub loadonly
  declare sub load_newparam(xml2 as GladeXML ptr)
  declare sub feed2gui_param
  declare sub feed2gui(mode as string)

end type

'--------------------------------------------------------------------------------------------------

constructor tgtk_data
  mouse_mode=Cmove_mode
  dragframeset=FALSE
  stopflag=false
  nall_param_entrys=0
  omalist_init(zoomlist,"tframe")

  frame_x1=-1
  frame_y1=-1
  frame_x2=-1
  frame_y2=-1

  h1=0

end constructor

'--------------------------------------------------------------------------------------------------


sub tgtk_data.add_entryhandle(widgetname as string)
  dim as GtkWidget ptr w
  w = glade_xml_get_widget( xml, widgetname)
  if (w=NULL) then omagtk_msgbox("tgtk_data.add_entryhandle() Error widget not found")
  if (nall_param_entrys=10) then omagtk_msgbox("tgtk_data: nall_param_entrys overflow")
  all_param_entrys(nall_param_entrys)=w
  nall_param_entrys=nall_param_entrys+1
end sub

'--------------------------------------------------------------------------------------------------


sub tgtk_data.insert_entryhandle(i as integer, widgetname as string, xml2 as GladeXML ptr)
  dim as GtkWidget ptr w
  w = glade_xml_get_widget( xml2, widgetname)
  if (w=NULL) then omagtk_msgbox("tgtk_data.insert_entryhandle() Error widget not found")
  if (i<0 or i>Csizewidgetstore-1) then omagtk_msgbox("tgtk_data.insert_entryhandle(): index out of range")
  all_param_entrys(i)=w
end sub



'--------------------------------------------------------------------------------------------------

sub tgtk_data.loadonly

  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(2)),ltrim(str(omafrac->iter)))
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(3)),ltrim(str(omafrac->iterlim)))
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(4)),ltrim(str(omafrac->a1)))
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(5)),ltrim(str(omafrac->b1)))
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(6)),ltrim(str(omafrac->a2)))
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(7)),ltrim(str(omafrac->b2)))
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(8)),ltrim(str(omafrac->configfname)))

  if (loglevel=2) then
    ? "tgtk_data.loadonly"
    ? "------------------"
    ? "iter:",omafrac->iter
    ? "iterlim:",omafrac->iterlim
    ? "a1:",omafrac->a1
    ? "a2:",omafrac->a2
  end if

end sub


'--------------------------------------------------------------------------------------------------

sub tgtk_data.load_newparam(xml2 as GladeXML ptr)

  dim as GtkWidget ptr w

  insert_entryhandle(2,"entry_param1",xml2)
  insert_entryhandle(3,"entry_param2",xml2)
  insert_entryhandle(4,"entry_param3",xml2)
  insert_entryhandle(5,"entry_param4",xml2)
  insert_entryhandle(6,"entry_param3a",xml2)
  insert_entryhandle(7,"entry_param4a",xml2)
  insert_entryhandle(8,"paramwin_fname_entry",xml2)

  w = glade_xml_get_widget( xml2, "model1_butt")
  all_modelwidgets(0)=w
  w = glade_xml_get_widget( xml2, "model2_butt")
  all_modelwidgets(1)=w
  w = glade_xml_get_widget( xml2, "model3_butt")
  all_modelwidgets(2)=w
  w = glade_xml_get_widget( xml2, "model4_butt")
  all_modelwidgets(3)=w


end sub



'--------------------------------------------------------------------------------------------------

sub tgtk_data.load

  'Stores widget handles in a global array and loads initial values to text wigdets.

  add_entryhandle("entry_bitmwidth") '0
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(0)),ltrim(str(Cbitmapwidth_default)))
  add_entryhandle("entry_bitmheight") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(1)),ltrim(str(Cbitmapheight_default)))
  add_entryhandle("entry_param1") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(2)),ltrim(str(omafrac->iter)))
  add_entryhandle("entry_param2") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(3)),ltrim(str(omafrac->iterlim)))
  add_entryhandle("entry_param3") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(4)),ltrim(str(omafrac->a1)))
  add_entryhandle("entry_param4") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(5)),ltrim(str(omafrac->b1)))
  add_entryhandle("entry_param3a") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(6)),ltrim(str(omafrac->a2)))
  add_entryhandle("entry_param4a") '1
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(7)),ltrim(str(omafrac->b2)))
  add_entryhandle("paramwin_fname_entry")
  gtk_entry_set_text(GTK_ENTRY(all_param_entrys(8)),ltrim(str(omafrac->configfname)))


  dim as GtkWidget ptr w
  w = glade_xml_get_widget( xml, "zoomsize_entry")
  if (w=NULL) then omagtk_msgbox("tgtk_data.load() Error widget not found")
  gtk_entry_set_text(GTK_ENTRY(w),"0")

  w = glade_xml_get_widget( xml, "prop1check")
  gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(w),area1.prop1)

  w = glade_xml_get_widget( xml, "model1_butt")
  all_modelwidgets(0)=w
  w = glade_xml_get_widget( xml, "model2_butt")
  all_modelwidgets(1)=w
  w = glade_xml_get_widget( xml, "model3_butt")
  all_modelwidgets(2)=w
  w = glade_xml_get_widget( xml, "model4_butt")
  all_modelwidgets(3)=w


end sub

'--------------------------------------------------------------------------------------------------


function tgtk_data.feed1(w as GtkWidget ptr) as integer

    dim as zstring ptr estring
    dim as integer retval

    estring=gtk_entry_get_text(GTK_ENTRY(w))
    retval=val(*estring)

    return retval

end function


'--------------------------------------------------------------------------------------------------

function tgtk_data.feed2(w as GtkWidget ptr) as double

    dim as zstring ptr estring
    dim as double retval

    estring=gtk_entry_get_text(GTK_ENTRY(w))
    retval=val(*estring)

    return retval

end function


'--------------------------------------------------------------------------------------------------

function tgtk_data.feed3(w as GtkWidget ptr) as string

    dim as zstring ptr estring
    dim as string retval

    estring=gtk_entry_get_text(GTK_ENTRY(w))
    retval=*estring

    return retval

end function



'--------------------------------------------------------------------------------------------------



sub tgtk_data.feed2gui_param

  'Übertrage alle Textentry-Werte des param-Fensters in die entsprechenden Klassen

    omafrac->iter=feed1(all_param_entrys(2))
    omafrac->iterlim=feed1(all_param_entrys(3))
    omafrac->a1=feed2(all_param_entrys(4))
    omafrac->a2=feed2(all_param_entrys(6))
    omafrac->b1=feed2(all_param_entrys(5))
    omafrac->b2=feed2(all_param_entrys(7))
    omafrac->configfname=feed3(all_param_entrys(8))

    if (loglevel=2) then
      ? "tgtk_data.feed2gui - current config:"
      omafrac->printconfig("")
    end if

end sub


'--------------------------------------------------------------------------------------------------

sub tgtk_data.feed2gui(mode as string)

  'Übertrage alle Textentry-Werte in die entsprechenden Klassen
  'mode "onlymain": Nur die Felder des Hauptfensters übertragen.
  'mode "all": Auch Paramfenster-Felder


    dim as integer width1, height1
    width1=feed1(all_param_entrys(0))
    height1=feed1(all_param_entrys(1))


    if (width1<=10 or width1>20000) then
      omagtk_msgbox("Bitmap-Konfig: Breitenangabe bitte korrigieren/ergaenzen")
    else
      if (height1<=10 or height1>20000) then
       omagtk_msgbox("Bitmap-Konfig: Höhenangabe bitte korrigieren/ergaenzen")
      else
        area1.init2(width1,height1,32)
      end if
    end if

    if (mode="all") then feed2gui_param

end sub

dim shared as tgtk_data gtk_data


' ------------------------------------------------------------------------------------------------------------

type tcolormapentry
  n as integer
  col as _GdkColor ptr
  w as GtkWidget ptr

  declare constructor
  declare destructor
  declare sub fill(red as integer, green as integer, blue as integer)
  declare sub copy(col2 as _GdkColor ptr)

end type

constructor tcolormapentry
  col=allocate(Len(_GdkColor))
  if (col=NULL) then omagtk_msgbox("tcolormapentry allocation failed")
end constructor

destructor tcolormapentry

  deallocate col

end destructor

sub tcolormapentry.fill(red as integer, green as integer, blue as integer)

  col->pixel=red*&h10000+green*&h100+blue
  col->red=red
  col->green=green
  col->blue=blue

end sub

sub tcolormapentry.copy(col2 as _GdkColor ptr)
  col->red=col2->red
  col->green=col2->green
  col->blue=col2->blue
  col->pixel=col2->pixel
end sub

type tcolormap
  dim as tcolormapentry map(2,Ccolormapsize)
  dim as gint ncol(Ccolormapsize)
  dim as GtkWidget ptr nentry(Ccolormapsize)
  dim as integer colorstep0
  dim as integer rgbmap(Ccolorrgbmapsize,3)
  dim as integer nrgbmap

  declare function colorstep(iter as integer) as integer
  declare sub rgbmap_fill
  declare constructor
  declare sub nentrywidget_save
  declare sub log1

end type

constructor tcolormap
  map(0,0).fill(127,0,0)
  map(1,0).fill(255,0,0)
  map(0,1).fill(0,127,0)
  map(1,1).fill(0,255,0)
  ncol(0)=2
  ncol(1)=2
  colorstep0=-1
end constructor

sub tcolormap.nentrywidget_save
  nentry(0)=glade_xml_get_widget( xmlcolor, "color1_nentry" )
  nentry(1)=glade_xml_get_widget( xmlcolor, "color2_nentry" )
  nentry(2)=glade_xml_get_widget( xmlcolor, "color3_nentry" )
  nentry(3)=glade_xml_get_widget( xmlcolor, "color4_nentry" )
end sub


'--------------------------------------------------------------------------------------------------

sub tcolormap.log1

  dim as integer i,j

  'open "clog.txt" for output as #1

  ? "tcolormap content of map()"
  ? "--------------------------"
  ? "colormap - log"

  for i=0 to Ccolormapsize-1
    for j=0 to 1
      with map(j,i)
      ? i,j,.col->red,.col->green,.col->blue
      end with
    next j
  next i


  'close #1
end sub


'--------------------------------------------------------------------------------------------------

function tcolormap.colorstep(iter as integer) as integer

  'Returns the number of fractaal computation iterations until the colorindex switches.

  dim as integer ncolor,i

  ncolor=0
  for i=0 to Ccolormapsize-1
    ncolor+=ncol(i)
  next i

  if (ncolor<=0) then
    omagtk_msgbox("Error in tcolormap.colorstep(): ncolor<=0 function abort")
    colorstep=1
    exit function
  end if

  colorstep0=int(iter/ncolor)
  if colorstep0<1 then colorstep0=1
  colorstep=colorstep0

end function




'--------------------------------------------------------------------------------------------------

sub tcolormap.rgbmap_fill

  dim as integer i,ind1,k,j
  dim as double rstep,gstep,bstep,r0,g0,b0
  dim as gboolean stopfound
  dim as  double x1,x2

  if (loglevel=2) then ?  "tcolormap.rgbmap_fill start"

  ind1=0
  k=0
  for i=0 to Ccolormapsize-1
    x2=map(1,i).col->red
    x1=map(0,i).col->red
    if (ncol(i)>=1) then rstep=(x2-x1)/ncol(i) else rstep=0
    '? "Red: ";x1,x2,rstep
    x2=map(1,i).col->green
    x1=map(0,i).col->green
    if (ncol(i)>=1) then gstep=(x2-x1)/ncol(i) else gstep=0
    '? "Green: ";x1,x2,gstep
    x2=map(1,i).col->blue
    x1=map(0,i).col->blue
    if (ncol(i)>=1) then bstep=(x2-x1)/ncol(i) else bstep=0
    '? "Blue: ";x1,x2,bstep

    r0=map(0,i).col->red
    g0=map(0,i).col->green
    b0=map(0,i).col->blue
    for j=0 to ncol(i)-1
      if (k>Ccolorrgbmapsize-1) then
        omagtk_msgbox("Error in tcolormap.rgbmap_fill(): rgbmap overflow. Abort function")
        exit sub
      end if

      rgbmap(k,0)=int(r0)
      rgbmap(k,1)=int(g0)
      rgbmap(k,2)=int(b0)
      '? "rgbmap: ";i,k,r0,g0,b0,rstep;"_";gstep;"_";bstep
      r0+=rstep
      g0+=gstep
      b0+=bstep
      k+=1
    next j

  next i
  nrgbmap=k
  'sleep

end sub


'--------------------------------------------------------------------------------------------------

dim shared as tcolormap colormap


'--------------------------------------------------------------------------------------------------

'%%4

SUB cadd(x1 as double,x2 as double,y1 as double,y2 as  double, byref z1 as double, byref z2 as  double)
  z1 =x1+y1
  z2 =x2+y2
end sub

SUB cmult(x1 as double,x2 as double,y1 as double,y2 as double, byref z1 as double , byref z2 as  double)
  z1 =x1*y1-x2*y2
  z2 =x1*y2+x2*y1
  '? "z1:",z1,"z2:",z2
end sub

SUB csqr(x1 as double,x2 as double, byref z1 as double ,byref z2 as double)
  cmult(x1,x2,x1,x2,z1,z2)
  '? "z1:",z1,"z2:",z2
  'z1=-99
  'z2=-99
end sub

SUB cdiv(x1 as double,x2 as double,y1 as double,y2 as double, byref z1 as double , byref z2 as  double)

  dim nen as double

  nen =x2^2+y2^2
  z1 =(x1*y1+x2*y2)/nen
  z2 =(y1*x2-y2*x1)/nen
end sub

SUB conj(x1 as double,x2 as double,y1 as double,y2 as double, byref z1 as double , byref z2 as  double)
  z1 =x1
  z2 =-x2
end sub


' ------------------------------------------------------------------------------------------------------

sub tomafrac.init()
  width=200
  height=200
  xpos=0
  ypos=0
  currentfrac="biomorph"
  loadiniconfig(currentfrac,Cconfig_fname)
end sub

'--------------------------------------------------------------------------------------------------

function tomafrac.configread(s as string, name1 as string) as double

  dim as integer pos1
  pos1=instr(s,"=")+1
  if (pos1=0) then omagtk_msgbox("tomafrac.configread() Error: parameter in config file not found: "+name1):gtk_main_quit()
  '? "mid(s,pos1,len(s)-pos1+1)",mid(s,pos1,len(s)-pos1+1),val(mid(s,pos1,len(s)-pos1+1))
  configread=val(mid(s,pos1,len(s)-pos1+1))
end function

'--------------------------------------------------------------------------------------------------

function tomafrac.configread2(s as string, name1 as string) as string

  dim as integer pos1
  pos1=instr(s,"=")+1
  if (pos1=0) then omagtk_msgbox("tomafrac.configread() Error: parameter in config file not found: "+name1):gtk_main_quit()
  '? "mid(s,pos1,len(s)-pos1+1)",mid(s,pos1,len(s)-pos1+1),val(mid(s,pos1,len(s)-pos1+1))
  configread2=mid(s,pos1,len(s)-pos1+1)
end function

'--------------------------------------------------------------------------------------------------


sub tomafrac.printconfig(fname as string)


  ?"fname: ",fname
  ?"iter:",iter
  ?"iterlim:",iterlim
  ?"a1:",a1
  ?"a2:",a2
  ?"b1:",b1
  ?"b2:",b2
  ?"z01lo:",z01lo
  ?"z01up:",z01up
  ?"z02lo:",z01lo
  ?"z02up:",z01up
  ?"configfname:",configfname
  ? "colormap 1:",colormap.ncol(0)
  ? "colormap 2:",colormap.ncol(1)
  ? "colormap 3:",colormap.ncol(2)
  ? "colormap 4:",colormap.ncol(3)


end sub


'--------------------------------------------------------------------------------------------------

sub tomafrac.loadiniconfig(fracname as string, fname as string)

  dim as integer found,colormapsize,i
  dim as string s

  found=open(fname for input as #1)
  close #1
  if (found=2) then
    omagtk_msgbox "file "+fname+" not found"
    exit sub
  end if

  open fname for input as #1
  found=0
  if (loglevel=2) then
    ? fracname
    ? fname
  end if
  while not eof(1) and found=0
    line input #1,s
     if instr(s,fracname)>0 then found=1
  wend
  if (found=0 and eof(1)) then omagtk_msgbox("tomafrac.loadconfig() Error: Fractal configuration not found: "+fracname)
  found=0
  line input #1,s
  iter=configread(s,"iter")
  line input #1,s
  iterlim=configread(s,"iterlim")
  line input #1,s
  a1=configread(s,"a1")
  line input #1,s
  a2=configread(s,"a2")
  line input #1,s
  b1=configread(s,"b1")
  line input #1,s
  b2=configread(s,"b2")
  line input #1,s
  z01lo=configread(s,"z01lo")
  line input #1,s
  z01up=configread(s,"z01up")
  line input #1,s
  z02lo=configread(s,"z02lo")
  line input #1,s
  z02up=configread(s,"z02up")
  line input #1,s
  configfname=ltrim(configread2(s,"configfname"))
  line input #1,s
  colormapsize=configread(s,"colormapsize")

  '%%co

  if (colormapsize<>Ccolormapsize) then
    omagtk_msgbox("loadconfig error: colormapsize of inifile does not fit the colormapsize expected. Abort")
    exit sub
  end if
  with colormap
  for i=0 to Ccolormapsize-1
    dim as integer r,g,b
    input #1,r,g,b
    storecolor(r,g,b,.map(0,i).col)
    input #1,r,g,b
    storecolor(r,g,b,.map(1,i).col)
    input #1,.ncol(i)
    if (loglevel=2) then
      ? "colormap read: ",i
      ? .map(0,i).col->red;" ";.map(0,i).col->green;" ";.map(0,i).col->blue;" "
      ? .map(1,i).col->red;" ";.map(0,i).col->green;" ";.map(0,i).col->blue;" "
      ? .ncol(i)
    end if
  next i
  end with

  if (loglevel=2) then printconfig(fname)
  'sleep
  close #1

end sub

'--------------------------------------------------------------------------------------------------

sub tomafrac.loadconfig

  loadiniconfig(currentfrac,configfname)

end sub


'--------------------------------------------------------------------------------------------------

sub tomafrac.saveconfig

  dim as integer i

  open configfname for output as #1

  ? #1,"*";currentfrac
  ? #1,"iter = ";iter
  ? #1,"iterlim = ";iterlim
  ? #1,"a1 = ";a1
  ? #1,"a2 = ";a2
  ? #1,"b1 = ";b1
  ? #1,"b2 = ";b2
  ? #1,"z01lo = ";z01lo
  ? #1,"z01up = ";z01up
  ? #1,"z02lo = ";z02lo
  ? #1,"z02up = ";z02up
  ? #1,"configfname = ";configfname
  ? #1,"colormapsize = ";Ccolormapsize
  with colormap
  for i=0 to Ccolormapsize-1
    ? #1,.map(0,i).col->red;" ";.map(0,i).col->green;" ";.map(0,i).col->blue;" ";
    ? #1,.map(1,i).col->red;" ";.map(1,i).col->green;" ";.map(1,i).col->blue;" ";
    ? #1,.ncol(i)
  next i
  end with

  close #1

end sub


'--------------------------------------------------------------------------------------------------

sub tomafrac.bplot(x as integer, y as integer, iter1 as integer)


  'if (col<=10) then area1.setcolor(255,0,0,0,0,0)
  'if (col>10 and col<=30) then area1.setcolor(0,255,0,0,0,0)
  'if (col>30) then area1.setcolor(0,0,255,0,0,0)

  dim as integer r,g,b,k

  k=int(iter1/colorstep)
  if k>colormap.nrgbmap-1 then k=colormap.nrgbmap-1
  r=colormap.rgbmap(k,0)
  g=colormap.rgbmap(k,1)
  b=colormap.rgbmap(k,2)
  area1.setcolor(r,g,b,0,0,0)

  area1.rectangle(FALSE,x,y,1,1)

end sub


'--------------------------------------------------------------------------------------------------

SUB tomafrac.testdraw

   dim as double dz1,dz2,z01,z02,z1,z2,xh1,xh2,z03lo,z03up,z04lo,z04up, _
        dgx,dgy,h1,h2,h3,h4,h5,h6
   dim as integer i,j,k

    dgx=(z01up-z01lo)/10 :dgy=(z02up-z02lo)/10
    dz1=(z01up-z01lo)/width
    dz2=(z02up-z02lo)/height

    for i=1 to width
      for j=1 to height
        z01=z01lo+(i-1)*dz1
        z02=z02lo+(j-1)*dz2
        '? z01,z02,abs(int(z01+z02)*30)
        'sleep
        bplot(i+xpos,j+ypos,abs(int(z01+z02)*30))
      next j
    next i

    on_drawingarea1_expose_event(drawingarea,NULL)

END SUB

'--------------------------------------------------------------------------------------------------

SUB tomafrac.draw

  if (loglevel=2) then ? "currentfrac: ",currentfrac
  if instr(currentfrac,"custom1")>0 then draw_custom1 _
  else if instr(currentfrac,"Appleman")>0 then draw_apple _
  else if instr(currentfrac,"julia")>0 then draw_julia _
  else if instr(currentfrac,"biomorph")>0 then draw_biomorph

END SUB

'--------------------------------------------------------------------------------------------------

#include "draw_apple.bas"

'--------------------------------------------------------------------------------------------------

#include "draw_julia.bas"

'--------------------------------------------------------------------------------------------------

#include "draw_biomorph.bas"

'--------------------------------------------------------------------------------------------------


#include "draw_custom1.bas"

' ------------------------------------------------------------------------------------------------------------

sub color_init()

  black0=allocate(Len(_GdkColor))
  white0=allocate(Len(_GdkColor))
  blue0=allocate(Len(_GdkColor))

  black0->pixel=&hFF000000
  black0->red=0
  black0->green=0
  black0->blue=0

  white0->pixel=&hFFFFFFFF
  white0->red=&hFF
  white0->green=&hFF
  white0->blue=&hFF

  blue0->pixel=&hFF0000FF
  blue0->red=0
  blue0->green=0
  blue0->blue=&hFF

end sub

sub color_close()

  deallocate black0
  deallocate white0
  deallocate blue0

end sub




' ------------------------------------------------------------------------------------------------------------


sub tomagtk_getwidgetsize(widgetname as string, byref wwidth as integer, byref wheight as integer)

  dim as GtkRequisition ptr g
  dim as GtkWidget ptr w

  w = glade_xml_get_widget( xml,widgetname)

  g=allocate(Len(GtkRequisition))

  gtk_widget_size_request(w,g)

  wwidth=g->width
  wheight=g->height

  deallocate(g)

end sub



' ------------------------------------------------------------------------------------------------------------


sub tomagtk_getwidgetsize2(byval widget as GtkWidget ptr, byref wwidth as integer, byref wheight as integer)

  dim as GtkRequisition ptr g

  g=allocate(Len(GtkRequisition))

  gtk_widget_size_request(widget,g)

  wwidth=g->width
  wheight=g->height

  deallocate(g)

end sub



' ------------------------------------------------------------------------------------------------------------

sub tomagtk_clearmap

    dim as GtkWidget ptr w
    w = glade_xml_get_widget( xml, "drawingarea1" )
    dim as integer wwidth,wheight
    tomagtk_getwidgetsize("drawingarea1",wwidth,wheight)
    area1.setcolor(0,0,0,0,0,0)
    '? "tomagtk_cls:";wwidth,wheight
    area1.setcolor(127,127,127,0,0,0)
    gdk_draw_rectangle(area1.map,area1.context,FALSE,0,0,area1.map_nx-1,area1.map_ny-1)
    area1.setcolor(0,0,0,0,0,0)
    gdk_draw_rectangle(w->window,area1.context,TRUE,0,0,wwidth-1,wheight-1)

    on_drawingarea1_expose_event(w,NULL)


end sub



' ------------------------------------------------------------------------------------------------------------

sub tomagtk_refresh

    dim as GtkWidget ptr w
    w = glade_xml_get_widget( xml, "drawingarea1" )
    on_drawingarea1_expose_event(w,NULL)

end sub


' ------------------------------------------------------------------------------------------------------------

SUB on_window1_destroy CDECL (BYVAL menuitem AS GtkMenuItem  PTR, BYVAL user_data AS gpointer) EXPORT

  gtk_main_quit()

END SUB

' ------------------------------------------------------------------------------------------------------------


sub on_drawingarea1_expose_event cdecl(byval widget as GtkWidget ptr, byval user_data as gpointer) export

  dim as integer wwidth,wheight
  dim as GdkGC ptr context
  tomagtk_getwidgetsize("drawingarea1",wwidth,wheight)
  dim as byte ptr x1,x2
  dim as integer i


  with area1
    if (.init0) then _
      dim as integer width1,height1

      gtk_data.window_width=wwidth
      gtk_data.window_height=wheight
      gtk_data.window_prop=wwidth*1./wheight

      'Überschreibe drawingarea schwarz
      area1.setcolor(0,0,0,0,0,0)
      gdk_draw_rectangle(widget->window,.context,TRUE,0,0,wwidth-1,wheight-1)

      'context=gdk_gc_new(toplevel->window)
      'gdk_gc_set_foreground(.context,area1.fgcolor)
      'gdk_gc_set_background(.context,area1.bgcolor)

      if (wwidth>area1.map_nx or wheight>area1.map_ny) then _
        wwidth=area1.map_nx:wheight=area1.map_ny

      gdk_draw_drawable(widget->window,.context,.map,.map_x,.map_y,0,0,.map_nx,.map_ny)

  end with

end sub


' ------------------------------------------------------------------------------------------------------------


sub on_button1_clicked  cdecl (byval object as GtkObject  ptr, byval user_data as gpointer) export

  'dim as GtkWidget ptr w
  'w = glade_xml_get_widget( xml, "drawingarea1" )

  'area1.map_x=area1.map_x+20
  area1.save("omagdk.png")
  omafrac->saveconfig
  omagtk_msgbox("Gespeichert in omagdk.png")

  'on_drawingarea1_expose_event(w,NULL)

end sub


' ------------------------------------------------------------------------------------------------------------

sub thread_wrapper(input1 as gpointer)

  'Umhuellt ("wrappt") den Aufruf von omafrac->draw() als gthreadfunc(), damit es
  'von g_thread_create() aufgerufen werden kann.
  'Funktioniert aber nicht mit FBC20b (g_thread ist nicht richtig angebunden) und ist auch hier nicht noetig.

  dim as tomafrac ptr x
  x=cast(tomafrac ptr,input1)
  x->draw


end sub

' ------------------------------------------------------------------------------------------------------------

sub run_frac

  if Ctestdraw=0 then
    'thread_wrapper(cast(gpointer,omafrac))
    omafrac->draw
  else
    omafrac->testdraw
  end if

  with gtk_data
    .frame_x1=-1
    .frame_y1=-1
    .frame_x2=-1
    .frame_y2=-1
  end with

end sub


' ------------------------------------------------------------------------------------------------------------

sub test_zoomlist
  dim as tframe ptr f
  dim as integer endlist
  omalist_setstart(gtk_data.zoomlist)

  f=omalist_getnext(gtk_data.zoomlist,endlist)
  ? "test_zoomlist:"
  ? f->x1
  ? f->x2
  ? f->y1
  ? f->y2
  sleep
end sub


' ------------------------------------------------------------------------------------------------------------

sub zoomsize_set(i as integer)

  dim as GtkWidget ptr w
  w = glade_xml_get_widget( xml, "zoomsize_entry" )
  gtk_entry_set_text(GTK_ENTRY(w),ltrim(str(i)))

end sub



' ------------------------------------------------------------------------------------------------------------


sub on_button_run_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  dim as GtkWidget ptr w
  w = glade_xml_get_widget( xml, "drawingarea1" )

  '%%5

  gtk_data.feed2gui("onlymain")

  tomagtk_clearmap
  gtk_data.stopflag=false
  omafrac->width=area1.map_nx
  omafrac->height=area1.map_ny
  omafrac->drawingarea=w
  dim as double px=area1.map_nx/area1.map_ny

  if (gtk_data.frame_x1>=0) then

    dim as tframe ptr f
    f=new tframe
    if (f=NULL) then omagtk_msgbox("on_button_run_clicked error: frame allocation failed")
    f->x1=omafrac->z01lo
    f->x2=omafrac->z01up
    f->y1=omafrac->z02lo
    f->y2=omafrac->z02up
    omalist_push(gtk_data.zoomlist,cast(any ptr,f),"tframe")
    zoomsize_set(gtk_data.zoomlist.size)
    'test_zoomlist

    dim as double d1=omafrac->z01up-omafrac->z01lo
    dim as double d2=omafrac->z02up-omafrac->z02lo
    dim as double z01lo1=omafrac->z01lo
    dim as double z02lo1=omafrac->z02lo
    dim as double z01up1=omafrac->z01up
    dim as double z02up1=omafrac->z02up



    'px=1

    '? d1,d2
    '? gtk_data.frame_x1/area1.map_nx,gtk_data.frame_x2/area1.map_nx
    omafrac->z01lo = z01lo1+d1*gtk_data.frame_x1/area1.map_nx
    omafrac->z01up = z01lo1+d1*gtk_data.frame_x2/area1.map_nx
    omafrac->z02lo = z02lo1+d2*gtk_data.frame_y1/area1.map_ny
    omafrac->z02up = z02lo1+d2*(gtk_data.frame_y1+(gtk_data.frame_x2-gtk_data.frame_x1)*px)/area1.map_ny
    'dim as double zoomf
    'zoomf=(omafrac->z01up-omafrac->z01lo)/(z01up1-z01lo1)
    'omafrac->z02lo = z02lo1+d2*gtk_data.frame_y1/area1.map_ny
    'omafrac->z02up = omafrac->z02lo+zoomf*(z02up1-z02lo1)

    dim as integer printlog=0

    if printlog=1 then
      ? " z01lo1:",z01lo1
      ? " z02lo1:",z02lo1
      ? " d1:",d1
      ? " d2:",d2
      ? " px:",px
      ? " gtk_data.frame_x1: ";gtk_data.frame_x1
      ? " gtk_data.frame_x2: ";gtk_data.frame_x2
      ? " gtk_data.frame_y1: ";gtk_data.frame_y1
      ? " gtk_data.frame_y2: ";gtk_data.frame_y2
      ? " area1.map_nx: ";area1.map_nx
      ? " area1.map_ny: ";area1.map_ny
      ? " d1*gtk_data.frame_x1/area1.map_nx: ";d1*gtk_data.frame_x1/area1.map_nx
      ? " d1*gtk_data.frame_x2/area1.map_nx: ";d1*gtk_data.frame_x2/area1.map_nx
      ? " d2*gtk_data.frame_y1/area1.map_ny: ";d2*gtk_data.frame_y1/area1.map_ny
      ? " d2*(gtk_data.frame_y1+(gtk_data.frame_x2-gtk_data.frame_x1)*px)/area1.map_ny: ";d2*(gtk_data.frame_y1+(gtk_data.frame_x2-gtk_data.frame_x1)*px)/area1.map_ny
      ? " gtk_data.frame_y1:",gtk_data.frame_y1
      ? "zoom:"
      ? " omafrac->z01lo:",omafrac->z01lo
      ? " omafrac->z01up:",omafrac->z01up
      ? " omafrac->z02lo:",omafrac->z02lo
      ? " omafrac->z02up:",omafrac->z02up
    end if
    'sleep

  end if

  if (area1.prop1) then omafrac->z02up=omafrac->z02lo+(omafrac->z01up-omafrac->z01lo)/px

  run_frac
  'omafrac.draw
  'on_drawingarea1_expose_event(w,NULL)

end sub

' ------------------------------------------------------------------------------------------------------------


sub on_button_help_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  #ifdef WIN
    shell("start cmd /c help.htm")
  #else
    shell("sh help.htm")
  #endif

end sub

' ------------------------------------------------------------------------------------------------------------

sub prop1check_toggled cdecl (byval object as GtkToggleButton ptr,  byval user_data as gpointer) export

  area1.prop1=gtk_toggle_button_get_active(object)

end sub

' ------------------------------------------------------------------------------------------------------------

sub on_stop_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  '? "Stop clicked"
  'sleep
  if not gtk_data.stopflag then gtk_data.stopflag=true else gtk_data.stopflag=false
  'area1.save("deb.png")


end sub

' ------------------------------------------------------------------------------------------------------------

sub on_unzoom_button_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  omagtk_msgbox("Druecke die rechte Maustaste")

end sub


' ------------------------------------------------------------------------------------------------------------


sub on_unzoom

  dim as tframe ptr x

  with gtk_data
  dim as integer endlist
  if (.zoomlist.size>0) then
    x=omalist_pullback(.zoomlist,endlist)
    omafrac->z01lo=x->x1
    omafrac->z01up=x->x2
    omafrac->z02lo=x->y1
    omafrac->z02up=x->y2

    delete x

    if (loglevel=2) then
      ? "omafrac->z01lo: ",omafrac->z01lo
      ? "omafrac->z01up: ",omafrac->z01up
      ? "omafrac->z02lo: ",omafrac->z02lo
      ? "omafrac->z02up: ",omafrac->z02up
    end if
    zoomsize_set(gtk_data.zoomlist.size)
  else
    dim as double z01lo,z01up,z02lo,z02up
    z01lo=omafrac->z01lo
    z01up=omafrac->z01up
    z02lo=omafrac->z02lo
    z02up=omafrac->z02up
    omafrac->z01lo=z01lo-abs(z01up-z01lo)/2
    omafrac->z01up=z01up+abs(z01up-z01lo)/2
    omafrac->z02lo=z02lo-abs(z02up-z02lo)/2
    omafrac->z02up=z02up+abs(z02up-z02lo)/2
    if (loglevel=2) then
      ? "omafrac->z01lo: ",omafrac->z01lo
      ? "omafrac->z01up: ",omafrac->z01up
      ? "omafrac->z02lo: ",omafrac->z02lo
      ? "omafrac->z02up: ",omafrac->z02up
    end if
  end if

  run_frac

  end with

end sub

' ------------------------------------------------------------------------------------------------------------

SUB on_mainwindow_destroy CDECL (BYVAL menuitem AS GtkMenuItem  PTR, BYVAL user_data AS gpointer) EXPORT

  gtk_main_quit()

END SUB

' ------------------------------------------------------------------------------------------------------------

function on_drawingarea1_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export

  gtk_data.old_mapx=area1.map_x
  gtk_data.old_mapy=area1.map_y
  gtk_data.old_x=button->x
  gtk_data.old_y=button->y

  if (gtk_data.dragframeset) then
    dim as GtkWidget ptr w
    w = glade_xml_get_widget( xml, "drawingarea1" )
    on_drawingarea1_expose_event(w,NULL)
    gtk_data.dragframeset=FALSE
  end if

  if (button->button=3) then
    '? "re Maustaste pressed"
    on_unzoom
  end if


  on_drawingarea1_button_press_event=false


end function


' ------------------------------------------------------------------------------------------------------------


sub area1_move(x as integer, y as integer)

    dim as GtkWidget ptr w
    w = glade_xml_get_widget( xml, "drawingarea1" )
    dim as integer x_old, y_old
    x_old=area1.map_x
    y_old=area1.map_y

    area1.map_x=x
    if area1.map_x<0 then area1.map_x=0
    if area1.map_x>area1.map_nx-500 then
      if (area1.map_nx-500>=0) then area1.map_x=area1.map_nx-500 else area1.map_x=x_old
    end if

    area1.map_y=y
    if area1.map_y<0 then area1.map_y=0
    if area1.map_y>area1.map_ny-500 then
      if (area1.map_ny-500>=0) then area1.map_y=area1.map_ny-500 else area1.map_y=y_old
    end if

    on_drawingarea1_expose_event(w,NULL)


end sub



' ------------------------------------------------------------------------------------------------------------


function on_drawingarea1_motion_notify_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventMotion ptr, byval user_data as gpointer) as gboolean export

  dim as GdkModifierType state

  state=button->state

  if (state and GDK_BUTTON1_MASK) then
    if (gtk_data.mouse_mode=Cselect_mode) then

      dim as integer wwidth,wheight
      tomagtk_getwidgetsize("drawingarea1",wwidth,wheight)

      gdk_draw_drawable(object->window,area1.context,area1.map,area1.map_x,area1.map_y,0,0,wwidth,wheight)
      area1.setcolor(255,255,255,0,0,0)
      gdk_gc_set_foreground(area1.context,area1.fgcolor)
      gdk_draw_rectangle(object->window,area1.context,FALSE,gtk_data.old_x,gtk_data.old_y,_
                         button->x-gtk_data.old_x,button->y-gtk_data.old_y)
      gtk_data.dragframeset=TRUE
    else
      area1_move(gtk_data.old_mapx-button->x+gtk_data.old_x,gtk_data.old_mapy-button->y+gtk_data.old_y)
    end if

  end if

  on_drawingarea1_motion_notify_event=false

end function

' ------------------------------------------------------------------------------------------------------------

function on_drawingarea1_button_release_event cdecl (byval object as  GtkWidget ptr,  byval button as GdkEventMotion ptr, byval user_data as gpointer) as gboolean export


  with gtk_data
    .frame_x1=.old_x+area1.map_x
    .frame_y1=.old_y+area1.map_y
    .frame_x2=button->x+area1.map_x
    .frame_y2=button->y+area1.map_y

    '? "release .frame_x1:",.frame_x1
    '? ".frame_y1:",.frame_y1
    '? ".frame_x2:",.frame_x2
    '? ".frame_y2:",.frame_y2

  end with
  on_drawingarea1_button_release_event=false

end function


' ------------------------------------------------------------------------------------------------------------

sub on_select_frame_clicked cdecl (byval widget as GtkToggleButton  ptr, byval user_data as gpointer) export

 if gtk_toggle_button_get_active (widget) then gtk_data.mouse_mode=Cselect_mode

end sub

' ------------------------------------------------------------------------------------------------------------

sub  on_move_map_clicked cdecl(byval widget as GtkToggleButton ptr, byval user_data as gpointer) export

  if gtk_toggle_button_get_active (widget) then gtk_data.mouse_mode=Cmove_mode

end sub




' ------------------------------------------------------------------------------------------------------------

function on_entry_bitmwidth_key_press_event CDECL (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean export

  'UTF-8-coded, take 2nd byte:
  IF event->keyval MOD &h100 = 13 THEN

    dim as GtkWidget ptr w
    dim as zstring ptr estring
    dim as integer evalue_width, evalue_height, goodvalues
    w = glade_xml_get_widget( xml, "entry_bitmheight" )
    if (w=NULL) then omagtk_msgbox("on_entry_bitmwidth_key_press_event() Error widget not found")

    goodvalues=0
    estring=gtk_entry_get_text(GTK_ENTRY(widget))
    '? "estring: ";*estring;" *** ";estring2
    evalue_width=val(*estring)
    'evalue_width=val("1000")
    if (evalue_width<=10 or evalue_width>20000) then
      omagtk_msgbox("Bitmap-Konfig: Breitenangabe bitte korrigieren/ergaenzen")
    else
      goodvalues=1
    end if

    'evalue_width: brkmess("on_entry_bitmwidth_key_press_event() error: width out of range")
    '? "Hallo", evalue_width, estring2, len(estring2)
    'sleep

    estring=gtk_entry_get_text(GTK_ENTRY(w))
    evalue_height=val(*estring)
    if (evalue_height<=10 or evalue_height>20000) then
      omagtk_msgbox("Bitmap-Konfig: Hoehenangabe bitte korrigieren/ergaenzen")
      goodvalues=0
    else
      goodvalues=1
    end if

    if (goodvalues=1) then
      '? "Value received: ",evalue_width,evalue_height

      area1.init2(evalue_width,evalue_height,32)
      tomagtk_clearmap

    end if
  end if

  RETURN false

END FUNCTION


' ------------------------------------------------------------------------------------------------------------

function on_entry_bitmheight_key_press_event CDECL (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean export

  'UTF-8-coded, take 2nd byte:
  IF event->keyval MOD &h100 = 13 THEN

    dim as GtkWidget ptr w
    dim as zstring ptr estring
    dim as integer evalue_width, evalue_height, goodvalues
    w = glade_xml_get_widget( xml, "entry_bitmwidth" )
    if (w=NULL) then omagtk_msgbox("on_entry_bitmheight_key_press_event() Error widget not found")

    goodvalues=0
    estring=gtk_entry_get_text(GTK_ENTRY(widget))
    evalue_height=val(*estring)
    if (evalue_height<=10 or evalue_height>20000) then
      omagtk_msgbox("Bitmap-Konfig: Höhenangabe bitte korrigieren/ergänzen")
    else
      goodvalues=1
    end if

    estring=gtk_entry_get_text(GTK_ENTRY(w))
    evalue_width=val(*estring)
    if (evalue_width<=10 or evalue_width>20000) then
      omagtk_msgbox("Bitmap-Konfig: Breitenangabe bitte korrigieren/ergänzen")
      goodvalues=0
    else
      goodvalues=1
    end if

    '? "Value received: ",evalue_width,evalue_height

    if (goodvalues=1) then
      area1.init2(evalue_width,evalue_height,32)
      tomagtk_clearmap
    end if

  end if

  RETURN false

END FUNCTION


' ------------------------------------------------------------------------------------------------------------

sub on_color1_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  DIM AS GtkWidget PTR newwin, _
  color1_nentry, _
  color2_nentry, _
  color3_nentry, _
  color4_nentry _

  '%%1
  'colormap.log1

  'Erzeugt alle Widgets des Parameterfensters neu
  xmlcolor = glade_xml_new( Cgladefile,"colorselectwin" , NULL )
  'Schliesse alle Signale an die neuen Widgets an
  glade_xml_signal_autoconnect( xmlcolor )
  'Hole den Zeiger auf das neue Fenster
  newwin = glade_xml_get_widget( xmlcolor, "colorselectwin" )
  color1_nentry= glade_xml_get_widget( xmlcolor, "color1_nentry")
  color2_nentry= glade_xml_get_widget( xmlcolor, "color2_nentry")
  color3_nentry= glade_xml_get_widget( xmlcolor, "color3_nentry")
  color4_nentry= glade_xml_get_widget( xmlcolor, "color4_nentry")

  colormap.nentrywidget_save

  'Initialisiere die Farbstufenzahlen
  gtk_entry_set_text(GTK_ENTRY(color1_nentry),ltrim(str(colormap.ncol(0))))
  gtk_entry_set_text(GTK_ENTRY(color2_nentry),ltrim(str(colormap.ncol(1))))
  gtk_entry_set_text(GTK_ENTRY(color3_nentry),ltrim(str(colormap.ncol(2))))
  gtk_entry_set_text(GTK_ENTRY(color4_nentry),ltrim(str(colormap.ncol(3))))

  gtk_widget_show(newwin)

end sub

' ------------------------------------------------------------------------------------------------------------

sub openparam_butt_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  DIM AS GtkWidget PTR newwin

  'Erzeugt alle Widgets des Parameterfensters neu
  xmlparam = glade_xml_new( Cgladefile,"paramwin" , NULL )
  'Schliesse alle Signale an die neuen Widgets an
  glade_xml_signal_autoconnect( xmlparam )
  'Hole den Zeiger auf das neue Fenster
  newwin = glade_xml_get_widget( xmlparam, "paramwin" )
  'Belade gtk_data mit den neuen Widgets
  gtk_data.load_newparam(xmlparam)
  'Stosse Beladung der Widgets mit den aktuellen Parametern an - sonst waeren die Textfelder leer.
  gtk_data.loadonly

  set_modelbuttons
  gtk_widget_show(newwin)

end sub



' ------------------------------------------------------------------------------------------------------------


'---------------------
' parameter window:
'---------------------



' ------------------------------------------------------------------------------------------------------------

sub paramwin_closebutton_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  if (loglevel=2) then ? "paramwin_close clicked"

  DIM AS GtkWidget PTR newwin

  gtk_data.feed2gui_param
  newwin = glade_xml_get_widget( xmlparam, "paramwin" )
  gtk_widget_destroy(newwin)
  'gtk_data.h1=1
  'tomagtk_refresh

end sub

' ------------------------------------------------------------------------------------------------------------

sub save_config_butt_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  if (loglevel=2) then ? "savee_config clicked"

  gtk_data.feed2gui_param

  omafrac->saveconfig

end sub

' ------------------------------------------------------------------------------------------------------------

sub load_config_butt_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export

  if (loglevel=2) then ? "load_config clicked"

  gtk_data.feed2gui_param
  omafrac->loadconfig
  gtk_data.loadonly

end sub


' ------------------------------------------------------------------------------------------------------------

sub set_modelbuttons

  if (loglevel=2) then ? "set modelbuttons"

  dim as integer i

  'for i=0 to 3:gtk_toggle_button_set_active(gtk_toggle_button(gtk_data.all_modelwidgets(i)),false):next i

  if instr(omafrac->currentfrac,"custom1")>0 then gtk_toggle_button_set_active(gtk_toggle_button(gtk_data.all_modelwidgets(2)),true) _
  else if instr(omafrac->currentfrac,"Appleman")>0 then gtk_toggle_button_set_active(gtk_toggle_button(gtk_data.all_modelwidgets(0)),true) _
  else if instr(omafrac->currentfrac,"julia")>0 then gtk_toggle_button_set_active(gtk_toggle_button(gtk_data.all_modelwidgets(1)),true) _
  else if instr(omafrac->currentfrac,"biomorph")>0 then gtk_toggle_button_set_active(gtk_toggle_button(gtk_data.all_modelwidgets(3)),true)

end sub



' ------------------------------------------------------------------------------------------------------------

sub  on_model1_clicked cdecl (byval widget as GtkToggleButton ptr, byval user_data as gpointer) export

  if gtk_toggle_button_get_active(gtk_toggle_button(gtk_data.all_modelwidgets(0))) then

    omafrac->currentfrac="Appleman"
    if (loglevel=2) then
      ? "************************************************************"
      ? "currentfrac:",omafrac->currentfrac
      ? "************************************************************"
    end if
    omafrac->loadiniconfig(omafrac->currentfrac,Cconfig_fname)
    gtk_data.loadonly
    'colormap.log1
  end if

end sub

' ------------------------------------------------------------------------------------------------------------

sub  on_model2_clicked cdecl (byval widget as GtkToggleButton ptr, byval user_data as gpointer) export

      omafrac->currentfrac="julia"
      if (loglevel=2) then
        ? "************************************************************"
        ? "currentfrac:",omafrac->currentfrac
        ? "************************************************************"
      end if
      omafrac->loadiniconfig(omafrac->currentfrac,Cconfig_fname)
      gtk_data.loadonly
      'colormap.log1

end sub



' ------------------------------------------------------------------------------------------------------------

sub  on_model3_clicked cdecl (byval widget as GtkToggleButton ptr, byval user_data as gpointer) export

   if (omafrac->currentfrac<>"custom1") then

      omafrac->currentfrac="custom1"
      if (loglevel=2) then
        ? "************************************************************"
        ? "currentfrac:",omafrac->currentfrac
        ? "************************************************************"
      end if
      omafrac->loadiniconfig(omafrac->currentfrac,Cconfig_fname)
      gtk_data.loadonly
      'colormap.log1
   end if

end sub

' ------------------------------------------------------------------------------------------------------------

sub  on_model4_clicked cdecl (byval widget as GtkToggleButton ptr, byval user_data as gpointer) export

   if (omafrac->currentfrac<>"biomorph") then
      omafrac->currentfrac="biomorph"
      if (loglevel=2) then
        ? "************************************************************"
        ? "currentfrac:",omafrac->currentfrac
        ? "************************************************************"
      end if
      omafrac->loadiniconfig(omafrac->currentfrac,Cconfig_fname)
      gtk_data.loadonly
      'colormap.log1
    end if

end sub



'-------------
' colorwindow:
'-------------

sub colorbox_set_color(ientry as integer, istart as integer)

  dim xml2 as GladeXML ptr
  dim as _GdkColor ptr col1
  dim as GtkWidget ptr colorsel

  DIM AS GtkWidget PTR fcdialog
  dim as gint resp

  ' enum GtkResponseType
  '   GTK_RESPONSE_NONE = -1
  '   GTK_RESPONSE_REJECT = -2
  '   GTK_RESPONSE_ACCEPT = -3
  '   GTK_RESPONSE_DELETE_EVENT = -4
  '   GTK_RESPONSE_OK = -5
  '   GTK_RESPONSE_CANCEL = -6
  '   GTK_RESPONSE_CLOSE = -7
  '   GTK_RESPONSE_YES = -8
  '   GTK_RESPONSE_NO = -9
  '   GTK_RESPONSE_APPLY = -10
  '   GTK_RESPONSE_HELP = -11
  ' end enum

  'Erzeuge einen neuen colorselectdialog
  xml2 = glade_xml_new( Cgladefile,"colorselectiondialog1" , NULL )
  'Hole den Zeiger auf den neuen  Dialog
  fcdialog = glade_xml_get_widget( xml2, "colorselectiondialog1" )

  'Initialisiere die Farben
  col1=allocate(Len(_GdkColor)): if (col1=NULL) then omagtk_msgbox("colorbox_set_color() allocation problem")
  colorsel = glade_xml_get_widget( xml2, "colorsel-color_selection1" )
  col1->red=256*colormap.map(istart,ientry).col->red
  col1->green=256*colormap.map(istart,ientry).col->green
  col1->blue=256*colormap.map(istart,ientry).col->blue
  gtk_color_selection_set_current_color(GTK_COLOR_SELECTION(colorsel),col1)


  'Starte den Dialog uud nimm die Antwort entgegen
  resp=gtk_dialog_run(GTK_DIALOG(fcdialog))
  if (loglevel=2) then ? "resp:",resp

  if (resp=GTK_RESPONSE_OK) then
    'Hier ins xml-File schauen: Wie heisst das erste Unter-widget des ColorSelection-Dialogs?
    'Achtung Falle: Benutze den lokalen xml-Nodes, nur er zeigt auf die gerade neu erstellten Widgets
    colorsel = glade_xml_get_widget( xml2, "colorsel-color_selection1" )
    gtk_color_selection_get_current_color(GTK_COLOR_SELECTION(colorsel),col1)
    col1->red=int(col1->red/256)
    col1->green=int(col1->green/256)
    col1->blue=int(col1->blue/256)
    if (loglevel=2) then ? "col1: ",col1->red,col1->green,col1->blue
    if (istart<0 or istart>1) then omagtk_msgbox("colorbox_set_color() istart out of range")
    colormap.map(istart,ientry).fill(col1->red,col1->green,col1->blue)
    'firstcolorselectdiag=FALSE
    deallocate col1
    gtk_widget_destroy(fcdialog)
  else
    if (resp=GTK_RESPONSE_CANCEL) then
      gtk_widget_destroy(fcdialog)
    end if
  end if

  if (loglevel=2) then colormap.log1


  'Refresh der Anzeige:
  'Notwendig, da immer nur genau die Teile der Farbflächen refresht werden, die
  'die vom colorselect-Fenster überdeckt werden ==> Halbes Kästchen hat die neue Farbe
  'und halbes Kästchen die alte.
  on_color1box1_expose_event(colormap.map(0,0).w,NULL)
  on_color1box2_expose_event(colormap.map(1,0).w,NULL)
  on_color2box1_expose_event(colormap.map(0,1).w,NULL)
  on_color2box2_expose_event(colormap.map(1,1).w,NULL)
  on_color3box1_expose_event(colormap.map(0,2).w,NULL)
  on_color3box2_expose_event(colormap.map(1,2).w,NULL)
  on_color4box1_expose_event(colormap.map(0,3).w,NULL)
  on_color4box2_expose_event(colormap.map(1,3).w,NULL)

  'void        gtk_color_selection_get_current_color
  '                                          (GtkColorSelection *colorsel,
  '                                           GdkColor *color);
end sub


' ------------------------------------------------------------------------------------------------------------

function color_entry_getvalue(widget as GtkWidget ptr, ientry as integer) as gboolean

    dim as zstring ptr estring
    dim as integer evalue, goodvalues

    goodvalues=0
    estring=gtk_entry_get_text(GTK_ENTRY(widget))

    evalue=val(*estring)
    if (evalue<0 or evalue>1000 or *estring="" or asc(*estring)<48 or asc(*estring)>57) then
      omagtk_msgbox("Farbstufenanzahl: Bitte korrigieren/ergaenzen")
    else
      goodvalues=1
    end if

    '? "Value received: ",evalue,evalue_height

    if (goodvalues=1) then
      colormap.ncol(ientry)=evalue
    end if

    color_entry_getvalue=(goodvalues=1)

end function

' ------------------------------------------------------------------------------------------------------------

function on_color1_nentry_key_press_event CDECL (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean export

  'UTF-8-coded, take 2nd byte:
  IF event->keyval MOD &h100 = 13 THEN
    color_entry_getvalue(widget,0)
  end if


  return false
end function



' ------------------------------------------------------------------------------------------------------------

function on_color2_nentry_key_press_event CDECL (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean export

  'UTF-8-coded, take 2nd byte:
  IF event->keyval MOD &h100 = 13 THEN
    color_entry_getvalue(widget,1)
  end if


  return false
end function

' ------------------------------------------------------------------------------------------------------------

function on_color3_nentry_key_press_event CDECL (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean export

  'UTF-8-coded, take 2nd byte:
  IF event->keyval MOD &h100 = 13 THEN
    color_entry_getvalue(widget,2)
  end if


  return false
end function

' ------------------------------------------------------------------------------------------------------------

function on_color4_nentry_key_press_event CDECL (BYVAL widget AS GtkWidget PTR, BYVAL event AS GdkEventKey PTR, BYVAL user_data AS gpointer) AS gboolean export

  'UTF-8-coded, take 2nd byte:
  IF event->keyval MOD &h100 = 13 THEN
    color_entry_getvalue(widget,3)
  end if


  return false
end function


' ------------------------------------------------------------------------------------------------------------

'sub colorbox_drawframe (byval object as GtkWidget ptr, colormap as tcolormap, colormapindex as integer)
sub colorbox_drawframe (byval widget as GtkWidget ptr, byval color1 as _GdkColor ptr)
'%%2

  dim as integer wwidth, wheight

  tomagtk_getwidgetsize2(widget,wwidth,wheight)
  gdk_gc_set_foreground(area1.context,color1)
  gdk_draw_rectangle(widget->window,area1.context,TRUE,0,0,wwidth-1,wheight-1)
  area1.setcolor(127,127,127,0,0,0)
  gdk_draw_rectangle(widget->window,area1.context,FALSE,0,0,wwidth-1,wheight-1)
  area1.setcolor(140,140,140,0,0,0)
  gdk_draw_rectangle(widget->window,area1.context,FALSE,1,1,wwidth-3,wheight-3)

end sub



function on_color1box1_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color1box1_button_press_event"
  colorbox_set_color(0,0)
  return false
end function

' ------------------------------------------------------------------------------------------------------------

function on_color1box2_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color1box2_button_press_event"
  colorbox_set_color(0,1)
  return false
end function

' ------------------------------------------------------------------------------------------------------------

function on_color2box1_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color2box1_button_press_event"
  colorbox_set_color(1,0)
  return false
end function

' ------------------------------------------------------------------------------------------------------------


function on_color2box2_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color2box2_button_press_event"
  colorbox_set_color(1,1)
  return false
end function




function on_color3box1_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color3box1_button_press_event"
  colorbox_set_color(2,0)
  return false
end function

' ------------------------------------------------------------------------------------------------------------

function on_color3box2_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color3box2_button_press_event"
  colorbox_set_color(2,1)
  return false
end function

' ------------------------------------------------------------------------------------------------------------

function on_color4box1_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color4box1_button_press_event"
  colorbox_set_color(3,0)
  return false
end function

' ------------------------------------------------------------------------------------------------------------


function on_color4box2_button_press_event cdecl (byval object as GtkWidget ptr,  byval button as GdkEventButton ptr, byval user_data as gpointer) as gboolean export
  if (loglevel=2) then ? "on_color4box2_button_press_event"
  colorbox_set_color(3,1)
  return false
end function


' ------------------------------------------------------------------------------------------------------------

sub on_colorselectwin_closebutton_clicked cdecl (byval object as GtkWidget ptr,  byval user_data as gpointer) export
  if (loglevel=2) then ? "on_colorselectwin_closebutton_clicked"

  '%%close

  DIM AS GtkWidget PTR newwin
  dim as integer i
  dim as integer errorfound

  newwin = glade_xml_get_widget( xmlcolor, "colorselectwin" )
  'Sorge dafuer, dass die Werte fuer die Farbstufenanzahlen uebernommen werden.
  errorfound=0
  for i=0 to Ccolormapsize-1
    if not color_entry_getvalue(colormap.nentry(i),i) then errorfound=1
  next i

  if (errorfound=0) then gtk_widget_destroy(newwin)

end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color1box1_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(0,0).col)
  colormap.map(0,0).w=widget
  if (loglevel=2) then ? "on_color1box1_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color1box2_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(1,0).col)
  colormap.map(1,0).w=widget
  if (loglevel=2) then ? "on_color1box2_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color2box1_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(0,1).col)
  colormap.map(0,1).w=widget
  if (loglevel=2) then ? "on_color2box1_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color2box2_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(1,1).col)
  colormap.map(1,1).w=widget
  if (loglevel=2) then ? "on_color2box2_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color3box1_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(0,2).col)
  colormap.map(0,2).w=widget
  if (loglevel=2) then ? "on_color3box1_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color3box2_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(1,2).col)
  colormap.map(1,2).w=widget
  if (loglevel=2) then ? "on_color3box2_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color4box1_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(0,3).col)
  colormap.map(0,3).w=widget
  if (loglevel=2) then ? "on_color4box1_expose_event"
end sub

' ------------------------------------------------------------------------------------------------------------

sub on_color4box2_expose_event           cdecl (byval widget as GtkWidget  ptr, byval user_data as gpointer) export
  colorbox_drawframe(widget,colormap.map(1,3).col)
  colormap.map(1,3).w=widget
  if (loglevel=2) then ? "on_color4box2_expose_event"
end sub



' ------------------------------------------------------------------------------------------------------------


gtk_init( NULL, NULL )
area1.init(1000,700,32)
color_init
omafrac = new tomafrac
if (omafrac=NULL) then omagtk_msgbox("main(): omafrac allocation failed")
xml = glade_xml_new( Cgladefile, NULL, NULL )
toplevel = glade_xml_get_widget( xml, "window1" )
gtk_widget_show_all( toplevel )
glade_xml_signal_autoconnect( xml )
area1.init1()
gtk_data.load()
'colormap.nentrywidget_save
gtk_main( )


g_object_unref( xml )
area1.close
delete omafrac
color_close
end


-----------------------------------------------------------------
draw_julia.bas
-----------------------------------------------------------------


SUB tomafrac.draw_julia

   dim as double dz1,dz2,z01,z02,z1,z2,xh1,xh2,z03lo,z03up,z04lo,z04up, _
        dgx,dgy,h1,h2,h3,h4,h5,h6
   dim as integer i,j,k


    dgx=(z01up-z01lo)/10 :dgy=(z02up-z02lo)/10
    dz1=(z01up-z01lo)/width
    dz2=(z02up-z02lo)/height

    colorstep=colormap.colorstep(iter)
    colormap.rgbmap_fill

    for i=1 to width
      for j=1 to height
        z01=z01lo+(i-1)*dz1
        z02=z02lo+(j-1)*dz2

        z1=z01: z2=z02

        k=1: xh1=0: xh2=0
        while (((xh1+xh2)<iterlim) and (k<=iter))
          csqr(z1,z2,h1,h2)
          cadd(a1,a2,h1,h2,z1,z2)
          xh1=z1^2 :xh2=z2^2
          k=k+1
        wend
        if ((xh1+xh2) <= iterlim) then
          bplot(i+xpos,j+ypos,0)'int(xh1+xh2)
        else
          bplot(i+xpos,j+ypos,k-1)
        end if
      next j
      on_drawingarea1_expose_event(drawingarea,NULL)
      while (gtk_events_pending):gtk_main_iteration:wend
      if gtk_data.stopflag then
        exit for
      end if
    next i

   'for i=0 to 10: bplot(300+i,180+i,14):next i
end sub

-----------------------------------------------------------------
draw_custom1.bas
-----------------------------------------------------------------


SUB tomafrac.draw_custom1

   dim as double dz1,dz2,z01,z02,z1,z2,xh1,xh2,z03lo,z03up,z04lo,z04up, _
        dgx,dgy,h1,h2,h3,h4,h5,h6
   dim as integer i,j,k


    dgx=(z01up-z01lo)/10 :dgy=(z02up-z02lo)/10
    dz1=(z01up-z01lo)/width
    dz2=(z02up-z02lo)/height

    colorstep=colormap.colorstep(iter)
    colormap.rgbmap_fill

    for i=1 to width
      for j=1 to height
        z01=z01lo+(i-1)*dz1
        z02=z02lo+(j-1)*dz2

        z1=z01: z2=z02

        k=1: xh1=0: xh2=0
        while (((xh1+xh2)<iterlim) and (k<=iter))
          csqr(z1,z2,h1,h2)
          cdiv(a1,a2,h1,h2,h3,h4)
          cadd(z01,z02,h3,h4,z1,z2)
          xh1=z1^2 :xh2=z2^2
          k=k+1
        wend
        if ((xh1+xh2) <= iterlim) then
          bplot(i+xpos,j+ypos,0)'int(xh1+xh2)
        else
          bplot(i+xpos,j+ypos,k-1)
        end if
      next j
      on_drawingarea1_expose_event(drawingarea,NULL)
      while (gtk_events_pending):gtk_main_iteration:wend
      if gtk_data.stopflag then
        exit for
      end if
    next i

   'for i=0 to 10: bplot(300+i,180+i,14):next i
end sub


-----------------------------------------------------------------
Draw biomorph
-----------------------------------------------------------------


SUB tomafrac.draw_biomorph

   dim as double dz1,dz2,z01,z02,z1,z2,xh1,xh2,z03lo,z03up,z04lo,z04up, _
        dgx,dgy,h1,h2,h3,h4,h5,h6
   dim as integer i,j,k

    dgx=(z01up-z01lo)/10 :dgy=(z02up-z02lo)/10
    dz1=(z01up-z01lo)/width
    dz2=(z02up-z02lo)/height

    colorstep=colormap.colorstep(iter)
    colormap.rgbmap_fill

    for i=1 to width
      for j=1 to height
        z01=z01lo+(i-1)*dz1
        z02=z02lo+(j-1)*dz2

        z1=z01: z2=z02

        k=1: xh1=0: xh2=0
        while (((xh1+xh2)<iterlim or abs(z1)<sqr(iterlim) or abs(z2)<sqr(iterlim)) and k<=iter)
          csqr(z1,z2,h1,h2)
          cmult(h1,h2,z1,z2,h3,h4)
          cadd(a1,a2,h3,h4,z1,z2)
          xh1=z1^2 :xh2=z2^2
          k=k+1
        wend
        if ((abs(z1)<sqr(iterlim) or abs(z2)<sqr(iterlim))) then
          bplot(i+xpos,j+ypos,0)'int(xh1+xh2)
        else
          bplot(i+xpos,j+ypos,k-1)
        end if
      next j
      on_drawingarea1_expose_event(drawingarea,NULL)
      while (gtk_events_pending):gtk_main_iteration:wend
      if gtk_data.stopflag then
        exit for
      end if
    next i

   'for i=0 to 10: bplot(300+i,180+i,14):next i
end sub


-----------------------------------------------------------------
draw_apple.bas
-----------------------------------------------------------------


SUB tomafrac.draw_apple

   dim as double dz1,dz2,z01,z02,z1,z2,xh1,xh2,z03lo,z03up,z04lo,z04up, _
        dgx,dgy,h1,h2,h3,h4,h5,h6
   dim as integer i,j,k


    dgx=(z01up-z01lo)/10 :dgy=(z02up-z02lo)/10
    dz1=(z01up-z01lo)/width
    dz2=(z02up-z02lo)/height

    colorstep=colormap.colorstep(iter)
    colormap.rgbmap_fill

    for i=1 to width
      for j=1 to height
        z01=z01lo+(i-1)*dz1
        z02=z02lo+(j-1)*dz2

        z1=z01: z2=z02

        k=1: xh1=0: xh2=0
        while (((xh1+xh2)<iterlim) and (k<=iter))
          csqr(z1,z2,h1,h2)
          cadd(z01,z02,h1,h2,z1,z2)
          xh1=z1^2 :xh2=z2^2
          k=k+1
        wend
        if ((xh1+xh2) <= iterlim) then
          bplot(i+xpos,j+ypos,0)'int(xh1+xh2)
        else
          bplot(i+xpos,j+ypos,k-1)
        end if
      next j
      on_drawingarea1_expose_event(drawingarea,NULL)
      while (gtk_events_pending):gtk_main_iteration:wend
      if gtk_data.stopflag then
        exit for
      end if
    next i

   'for i=0 to 10: bplot(300+i,180+i,14):next i
end sub


-----------------------------------------------------------------
omalist.bas
-----------------------------------------------------------------

' Library for double linked container lists
' Belongs to kap39.htm of the Oma's Programmer Tutorial (www.askos.de/tutorial)
' July 2006 by
' C. Schatz
' ASKOS


const OMALIST_START=0
const OMALIST_END=1
const OMALIST_FWD=2
const OMALIST_BWD=3
const OMA_BEHIND=1
const OMA_BEFORE=-1


TYPE tomalist_element

  prev as tomalist_element ptr
  nex as tomalist_element ptr
  cont as any ptr
  keyword as zstring ptr

END TYPE

TYPE tomalist

  start as tomalist_element ptr
  last as tomalist_element ptr
  current as tomalist_element ptr
  size as integer
  typename as string

END TYPE


' ------------------------------------------------------------

SUB omalist_init(byref list as tomalist, typename as string)

  list.start=NULL
  list.last=NULL
  list.current=NULL
  list.size=0
  list.typename=typename

END SUB

' ------------------------------------------------------------

SUB omalist_close(byref list as tomalist, typename as string)

  DIM as integer endoflist
  DIM as tomalist_element ptr curr

  endoflist=FALSE

  curr=list.start
  while(not endoflist)
    'Gib zunaechst den durch cont reservierten Platz frei
    deallocate(curr->cont)
    '...und auch den Keyword-Speicherplatz
    deallocate(curr->keyword)
    'Schaue, ob es das letzte Element war
    endoflist=(curr->nex=NULL)
    if (not endoflist) then
      'Nein? Dann gehe mit curr eins weiter, damit das jetzige
      'Element selbst freigegeben werden kann.
      curr=curr->nex
      deallocate(curr->prev)
    else
      'Ja: Gib curr frei, Zeiger weg von curr werden ja nicht mehr benoetigt.
      deallocate(curr)
    end if
  wend

END SUB


' ------------------------------------------------------------

SUB omalist_push(byref list as tomalist, px as any ptr, typename as string, keyword as string="")

  'Haengt ein neues Element hinten an die Liste dran

  with list
    if .typename<>typename then brkmess("tomalist, push(): typename error")
    if px=NULL then brkmess("tomalist, push(): content is NULL")

    if (.start=NULL) then
      'Noch nichts in der Liste drin
      'Erstmal ein Listenelement generieren. Das ist gleich das Startelement
      .start=allocate(len(tomalist_element))
      if (.start=NULL) then brkmess("tomalist, push(): Error - allocation failed")
      'Die Verweise vom Startelement weg muessen alle auf NULL sein, da ja noch
      'kein anderes Element drin ist.
      .start->nex=NULL
      .start->prev=NULL
      'Das letzte Element ist das erste
      .last=.start
      'Das aktuelle Element ist auch das erste
      .current=.start
    else
      'Fall: Schon was in der Liste gespeichert

      'Erstmal ein Listenelement generieren, das ist gleich das aktuelle:
      .current=allocate(len(tomalist_element))
      'Verlinke das ehemals letzte Element mit dem jetzt aktuellen:
      .current->prev=.last
      .last->nex=.current
      'Nach hinten hin gibts nichts zu verlinken, aktuelles ist ja das letzte Element:
      .current->nex=NULL
      'Und nun den Zeiger auf das letzte Element neu setzen:
      .last=.current
      'Das vorletzte Element erreichen wir weiterhin entweder ueber .start oder ueber
      '.current->prev
    end if

    'Und nun den Inhalt nicht vergessen:
    .current->cont=px
    .current->keyword=allocate(len(keyword)+1)
    *.current->keyword=keyword

    .size+=1

  end with

END SUB


' ------------------------------------------------------------

SUB omalist_insert(byref list as tomalist, position as tomalist_element ptr, px as any ptr, typename as string, mode as integer = OMA_BEHIND, keyword as string = "")

  'Fuegt ein neues Element bei position in die Liste ein
  'mode=-1: Vor position
  'mode=1: Nach position

  if (mode<>OMA_BEFORE and mode<>OMA_BEHIND) then brkmess("tomalist, insert(): mode out of range")

  with list
    if .typename<>typename then brkmess("tomalist, insert(): typename error")
    if px=NULL then brkmess("tomalist, insert(): content is NULL")
    if (position=NULL) then brkmess("tomalist, insert(): position is NULL")

    if (.start=NULL) then
      'Noch nichts in der Liste drin
      'Funktioniert wie bei push()
      'position wird nicht abgefragt.
      .start=allocate(len(tomalist_element))
      if (.start=NULL) then brkmess("tomalist, insert(): Error - allocation failed")
      .start->nex=NULL
      .start->prev=NULL
      .last=.start
      .current=.start
    else
      'Fall: Schon was in der Liste gespeichert

      'Erstmal ein Listenelement generieren, das ist gleich das aktuelle:
      .current=allocate(len(tomalist_element))

      if (mode=OMA_BEFORE) then
        'Fuege .current zwischen position->prev und position ein:
        .current->nex=position           'Rechts von .current kommt position
        .current->prev=position->prev   'Links von .current kommt position->prev
        if (position->prev<>NULL) then  'position koennte ja .start sein...
          position->prev->nex=.current  'Wenn nicht: Rechts von position->prev kommt .current
        else
          .start=.current                 'Wenn doch: Jetzt ist .current .start!
        end if
        position->prev=.current         'Links von position kommt .current
      else
        'Fuege .current zwischen position und position->nex ein:
        .current->prev=position       'Links von .current kommt position
        .current->nex=position->nex  'Rechts von .current kommt position->nex
        if (position->nex<>NULL) then 'position koennte ja .last sein...
          position->nex->prev=.current 'Wenn nicht: Links von position->nex kommt current
        else
          .last=.current                'Wenn doch: Jetzt ist .current .last!
        end if
        position->nex=.current        'Rechts von position kommt current
      end if

     end if

    'Und nun den Inhalt nicht vergessen:
    .current->cont=px
    .current->keyword=allocate(len(keyword)+1)
    *.current->keyword=keyword

    .size+=1

  end with

END SUB

' ------------------------------------------------------------

SUB omalist_log(byref list as tomalist)

  dim as integer i
  dim as tomalist_element ptr curr0

  open "log_list.txt" for output as #9

  with list

  curr0=.start
  while (curr0<>NULL)
    ? #9,.start,.size,.current,.current->nex
  wend

  end with

  close(1)

END SUB

' ------------------------------------------------------------

SUB omalist_setstart(byref list as tomalist)

  list.current=list.start

END SUB

' ------------------------------------------------------------

SUB omalist_setlast(byref list as tomalist)

  list.current=list.last

END SUB

' ------------------------------------------------------------

FUNCTION omalist_get(byref list as tomalist) as any ptr

  'Gibt den Inhalt von .current zurueck

  omalist_get=list.current->cont

END FUNCTION

' ------------------------------------------------------------

FUNCTION omalist_stepfwd(byref list as tomalist) as integer

  'Setze die aktuelle Position eins weiter

  DIM as integer retval

  retval=TRUE

  'Aufgepasst! Wir koennen uns nicht drauf verlassen, dass
  'der Nutzer das Ende der Liste abgepasst hat. .current kann NULL sein!
  if (list.current<>NULL) then list.current=list.current->nex
  omalist_stepfwd=(list.current<>NULL)
END FUNCTION

' ------------------------------------------------------------

FUNCTION omalist_stepbwd(byref list as tomalist) as integer

  'Setze die aktuelle Position eins zurueck

  DIM as integer retval

  retval=TRUE

  list.current=list.current->prev
  omalist_stepbwd=(list.current<>NULL)
END FUNCTION


' ------------------------------------------------------------

FUNCTION omalist_getnext(byref list as tomalist, byref endoflist as integer) as any ptr

  'Gibt den Inhalt von .current zurueck und setzt .current eins weiter

  omalist_getnext=list.current->cont

  endoflist=FALSE
  with list
    if .current->nex<>NULL then .current=.current->nex else endoflist=TRUE
  end with

END FUNCTION


' ------------------------------------------------------------

FUNCTION omalist_getprev(byref list as tomalist, byref endoflist as integer) as any ptr

  'Gibt den Inhalt von .current zurueck und setzt .current eins vor

  omalist_getprev=list.current->prev

  endoflist=FALSE
  with list
    if .current->prev<>NULL then .current=.current->prev else endoflist=TRUE
  end with

END FUNCTION


' ------------------------------------------------------------

FUNCTION omalist_pullback(byref list as tomalist, byref endoflist as integer) as any ptr

  'Gibt den Inhalt von .last zurueck, loescht .last und setzt .current auf .last-1

  list.current=list.last
  omalist_pullback=list.current->cont

  endoflist=FALSE
  with list
    if .current->prev<>NULL then .current=.current->prev else endoflist=TRUE
    deallocate(.current->nex)
    .current->nex=NULL
    .size=.size-1
    .last=.current
  end with


END FUNCTION




' ------------------------------------------------------------

FUNCTION omalist_find(byref list as tomalist, keyword as string, mode as integer=0) as any ptr

  'Sucht Element mit keyword

  'mode=OMALIST_START: Sucht von Anfang an vorwaerts
  'mode=OMALIST_END: Sucht vom Ende weg rueckwaerts
  'mode=OMALIST_FWD: Sucht von current position weg vorwaerts
  'mode=OMALIST_BWD: Sucht von current position weg rueckwarts

  dim retval as tomalist_element ptr
  dim as integer found,endoflist,direction,listOK
  dim as any ptr result

  found=FALSE
  listOK=TRUE
  result=NULL

  if mode=OMALIST_START then omalist_setstart(list)
  if mode=OMALIST_END then omalist_setlast(list)
  direction=1
  if (mode=OMALIST_END or mode=OMALIST_BWD) then direction=-1

  while (NOT found and listOK)
    if (direction=1) then
      result=omalist_get(list)
    else
      result=omalist_get(list)
    end if
    scope
      dim as string s1=*list.current->keyword
      found=(s1=keyword)
    end scope
    if (direction=1) then listOK=omalist_stepfwd(list) else listOK=omalist_stepbwd(list)
  wend

  if (not found) then result=NULL

  omalist_find=result

END FUNCTION

' ------------------------------------------------------------

SUB testomalist_push(byref list as tomalist, s as string, i as integer)

  dim as zstring ptr ps
  dim as integer slen

  slen=len(s)
  ps=allocate(len(s)+1)
  *ps=s

  '? "xxx ";str(i)
  'sleep
  omalist_push(list,ps,"string",str(i))

END SUB


' ------------------------------------------------------------

FUNCTION testomalist_get(byref list as tomalist) as string

  dim as zstring ptr ps
  dim as integer endoflist

  if (list.size=0) then
    testomalist_get=""
    exit function
  end if

  ps=omalist_get(list)
  testomalist_get=*ps

END FUNCTION