Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
omafrac v0.1
| Uploader: |  croco97 |
| 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