Commit 6180eac2 by kollo

version 1.09-3

parent 91d1bf8e
' Utility to convert ATARI ST RSC Files to GUI Files
' (c) Markus Hoffmann 2003 (letzte Bearbeitung: 10.07.2003)
'
'
i=1
outputfilename$="b.gui"
while len(param$(i))
if left$(param$(i))="-"
if param$(i)="--help" or param$(i)="-h"
@intro
@using
else if param$(i)="--version"
@intro
quit
else if param$(i)="-o"
inc i
if len(param$(i))
outputfilename$=param$(i)
endif
endif
else
inputfile$=param$(i)
if not exist(inputfile$)
print "rsc2gui: "+inputfile$+": file or path not found"
clr inputfile$
endif
endif
inc i
wend
if len(inputfile$)
rumpf$=inputfile$
while len(rumpf$)
wort_sep rumpf$,"/",1,a$,rumpf$
wend
f$=a$
rumpf$=a$
wort_sep a$,".",1,rumpf$,typ$
if typ$="rsc"
if exist(outputfilename$)
print "rsc2gui: Outputfilename already exists: ";outputfilename$
else
@convert
endif
else
print f$+": file not recognized: File format not recognized"
endif
else
print "rsc2gui: No input files"
endif
quit
procedure intro
print "GEM RSC to GUI Converter V.1.08 (c) Markus Hoffmann 2003"
version
return
procedure using
print "Usage: bas2x11basic [options] file..."
print "Options:"
print " -h, --help Display this information"
print " -o <file> Place the output into <file>"
return
procedure convert
open "I",#1,inputfile$
rsc$=input$(#1,lof(#1))
close #1
open "O",#2,outputfilename$
print #2,"' rsc2gui V.1.08 ("+f$+")"
print #2,"' (c) Markus Hoffmann "+date$+" "+time$
spaces=0
@header(varptr(rsc$))
if ntree>0
for i=0 to ntree-1
print #2,"TREE_"+str$(i)+": TREE {"
inc spaces
@dotree(varptr(rsc$)+@lswap(lpeek(varptr(rsc$)+treeadr+4*i)))
dec spaces
print #2,"}"
next i
endif
if nfrstr>0
for i=0 to nfrstr-1
text$=@getchar$(varptr(rsc$)+@lswap(lpeek(varptr(rsc$)+frstradr+4*i)))
print #2,"FREESTR_"+str$(i)+": STRING="+chr$(34)+text$+chr$(34)
next i
endif
print #2,"' ----- End of INPUT -----"
close #2
return
procedure header(a)
rscver=@dswap(dpeek(a))
print #2,"RSC {"
print #2," Version=";rscver
if rscver=0
objadr=@dswap(dpeek(a+2))
tedinfoadr=@dswap(dpeek(a+4))
iconblkadr=@dswap(dpeek(a+6))
bitblkadr=@dswap(dpeek(a+6))
frstradr=@dswap(dpeek(a+10))
stringadr=@dswap(dpeek(a+12))
imdataadr=@dswap(dpeek(a+14))
frimgadr=@dswap(dpeek(a+16))
treeadr=@dswap(dpeek(a+18))
nobj=@dswap(dpeek(a+20))
ntree=@dswap(dpeek(a+22))
ntedinfo=@dswap(dpeek(a+24))
nib=@dswap(dpeek(a+26))
nbb=@dswap(dpeek(a+28))
nfrstr=@dswap(dpeek(a+30))
nimage=@dswap(dpeek(a+32))
size=@dswap(dpeek(a+34))
else if rscver=3
objadr=@lswap(lpeek(a+2))
tedinfoadr=@lswap(lpeek(a+6))
iconblkadr=@lswap(lpeek(a+10))
bitblkadr=@lswap(lpeek(a+14))
frstradr=@lswap(lpeek(a+18))
stringadr=@lswap(lpeek(a+22))
imdataadr=@lswap(lpeek(a+26))
frimgadr=@lswap(lpeek(a+30))
treeadr=@lswap(lpeek(a+34))
nobj=@dswap(dpeek(a+38))
ntree=@dswap(dpeek(a+40))
ntedinfo=@dswap(dpeek(a+42))
nib=@dswap(dpeek(a+44))
nbb=@dswap(dpeek(a+46))
nfrstr=@dswap(dpeek(a+48))
nimage=@dswap(dpeek(a+50))
size=@lswap(lpeek(a+52))
else
print "ERROR: Unknown RSC Version ";rscver
endif
print #2," Objadr =$";hex$(objadr,8,8,1);" # Adresse Object-Array"
print #2," Tedinfoadr=$";hex$(tedinfoadr,8,8,1);" # Adresse TEDINFO-Array"
print #2," Iconblkadr=$";hex$(iconblkadr,8,8,1);" # Adresse ICONBLK-Array"
print #2," Bitblkadr =$";hex$(bitblkadr,8,8,1);" # Adresse BITBLK-Array"
print #2," Frstradr =$";hex$(frstradr,8,8,1);" # Adresse FreeString-Table"
print #2," Imdataadr =$";hex$(imdataadr,8,8,1);" # Adresse Imagedata"
print #2," Frimgadr =$";hex$(frimgadr,8,8,1);" # Adresse Freeimage-Table"
print #2," Treeadr =$";hex$(treeadr,8,8,1);" # Adresse Tree-Table"
print #2," nObj =";nobj
print #2," nTree =";ntree
print #2," nTed =";ntedinfo
print #2," niconblk =";nib
print #2," nbitblk =";nbb
print #2," nFreestring=";nfrstr
print #2," nImage =";nimage
print #2," RSCsize =";size
print #2,"}"
flush #2
return
procedure dotree(a)
treestart=a
@doobj(0,65535)
flush #2
return
procedure doobj(idx,parent)
local obnext,obhead,obtail
print "OB >",idx
while idx<>parent
obnext=@dswap(dpeek(treestart+idx*24+0))
obhead=@dswap(dpeek(treestart+idx*24+2))
obtail=@dswap(dpeek(treestart+idx*24+4))
obtype=@dswap(dpeek(treestart+idx*24+6))
obx=@dswap(dpeek(treestart+idx*24+16))
oby=@dswap(dpeek(treestart+idx*24+18))
obw=@dswap(dpeek(treestart+idx*24+20))
obh=@dswap(dpeek(treestart+idx*24+22))
obspec=@lswap(lpeek(treestart+idx*24+12))
obflags=@dswap(dpeek(treestart+idx*24+8))
obstate=@dswap(dpeek(treestart+idx*24+10))
print #2,space$(spaces*2);"OB_"+str$(idx)+": ";
if obtype=20
typ$="BOX"
else if obtype=21
typ$="TEXT"
else if obtype=22
typ$="BOXTEXT"
else if obtype=23
typ$="IMAGE"
else if obtype=24
typ$="USERDEF"
else if obtype=25
typ$="IBOX"
else if obtype=26
typ$="BUTTON"
else if obtype=27
typ$="BOXCHAR"
else if obtype=28
typ$="STRING"
else if obtype=29
typ$="FTEXT"
else if obtype=30
typ$="FBOXTEXT"
else if obtype=31
typ$="ICON"
else if obtype=32
typ$="TITLE"
else if obtype=42
typ$="ALERTTYP"
else
typ$="UNKNOWN"
endif
print #2,typ$;"(";
print #2,"X=";obx;",Y=";oby;",W=";obw;",H=";obh;
' print #2,obtype,obnext,obhead,obtail;
if obtype=28 or obtype=32 or obtype=26
text$=@getchar$(varptr(rsc$)+obspec)
print #2,", TEXT="+chr$(34)+text$+chr$(34);
else if obtype=21 or obtype=22 or obtype=29 or obtype=30
tedinfo=varptr(rsc$)+obspec
text$=@getchar$(varptr(rsc$)+@lswap(lpeek(tedinfo)))
ptmp$=@getchar$(varptr(rsc$)+@lswap(lpeek(tedinfo+4)))
pvalid$=@getchar$(varptr(rsc$)+@lswap(lpeek(tedinfo+8)))
font=@dswap(dpeek(tedinfo+12))
just=@dswap(dpeek(tedinfo+16))
color=@dswap(dpeek(tedinfo+18))
border=@dswap(dpeek(tedinfo+22))
print #2,", TEXT="+chr$(34)+text$+chr$(34);
if len(ptmp$)
print #2,", PTMP="+chr$(34)+ptmp$+chr$(34);
endif
if len(pvalid$)
print #2,", PVALID="+chr$(34)+pvalid$+chr$(34);
endif
print #2,", FONT=";font;
print #2,", JUST=";just;
print #2,", COLOR=";color;
print #2,", BORDER=";border;
else
char=asc(right$(mkl$(obspec)))
framesize=asc(mid$(mkl$(obspec),3,1))
color=asc(mid$(mkl$(obspec),2,1))
rest=asc(mid$(mkl$(obspec),1,1))
framecol=color and (255 xor 15)/16
textcol=color and 15
pattern=rest and (255 xor 15)/16
textmode=(pattern and 8)/8
pattern=pattern and 7
bgcol=rest and 15
if char<>0 or obtype=27
print #2,", CHAR='";chr$(char);"'";
endif
print #2,", FRAME=";framesize;
print #2,", FRAMECOL=";framecol;
print #2,", TEXTCOL=";textcol;
print #2,", BGCOL=";bgcol;
print #2,", PATTERN=";pattern;
print #2,", TEXTMODE=";textmode;
endif
if obflags<>0
print #2,", FLAGS=";
if obflags and 1
print #2,"SELECTABLE+";
endif
if (obflags and 2)<>0
print #2,"DEFAULT+";
endif
if obflags and 4
print #2,"EXIT+";
endif
if obflags and 8
print #2,"EDITABLE+";
endif
if obflags and 16
print #2,"RADIOBUTTON+";
endif
if obflags and 32
print #2,"LASTOB+";
endif
if obflags and 64
print #2,"TOUCHEXIT+";
endif
if obflags and 128
print #2,"HIDETREE+";
endif
if obflags and 256
print #2,"INDIRECT+";
endif
if obflags and (65535 xor 255 xor 256)
print #2,"MOREFLAGS(%";bin$(obflags,16,16,1);")";
endif
endif
if obstate<>0
print #2,", STATE=";
if obstate and 1
print #2,"SELECTED+";
endif
if obstate and 2
print #2,"CROSSED+";
endif
if obstate and 4
print #2,"CHECKED+";
endif
if obstate and 8
print #2,"DISABLED+";
endif
if obstate and 16
print #2,"OUTLINED+";
endif
if obstate and 32
print #2,"SHADOWED+";
endif
if obstate and 64
print #2,"WHITEBACK+";
endif
if obstate and 128
print #2,"DRAW3D+";
endif
if obstate and (65535 xor 255)
print #2,"MORESTATE(%";bin$(obstate,16,16,1);")";
endif
endif
print #2,")";
if obhead<>65535
print #2," {"
inc spaces
sss=idx
@doobj(obhead,sss)
dec spaces
print #2,space$(spaces*2);"}"
else
print #2
endif
flush #2
idx=obnext
wend
return
function getchar$(a)
local t$,s
t$=""
do
s=peek(a)
exit if s=0
t$=t$+chr$(s)
inc a
loop
return t$
endfunc
function dswap(v)
return (v and 255)*256+(v and (65535 xor 255))/256
endfunc
function lswap(v)
local a$
a$=mkl$(v)
return cvl(right$(a$)+mid$(a$,3,1)+mid$(a$,2,1)+left$(a$))
endfunc
......@@ -7,7 +7,7 @@ dim a(18000),b(18000)
arrayfill a(),0
arrayfill b(),0
gprint "shows ATARI ST monochrome pictures (32000 Bytes)"
fileselect "Datei auswaehlen:","./*.pic","f1.pic",f$
fileselect "Datei auswaehlen:","pictures/*.pic","f1.pic",f$
if exist(f$)
open "I",#1,f$
clr x,y,count
......
Summary: Example basic program sourcefiles for X11-Basic
Vendor: Markus Hoffmann
Name: X11Basic-examples
Version: 1.07
Release: 10
Version: 1.09
Release: 2
Copyright: GPL
Group: Development/Languages
URL: http://x11-basic.sourceforge.net/examples/
Packager: Markus Hoffmann <m.hoffmann@uni-bonn.de>
Packager: Markus Hoffmann <kollo@users.sourceforge.net>
%description
......@@ -35,10 +35,12 @@ Markus Hoffmann
Authors:
--------
Markus Hoffmann <m.hoffmann@uni-bonn.de>
Markus Hoffmann <kollo@users.sourceforge.net>
%changelog
* Tue Jun 26 2003 Markus Hoffmann <kollo@users.sourceforge.net>
changed email-address
* Tue Mar 07 2002 Markus Hoffmann <m.hoffmann@uni-bonn.de>
included manual
* Tue Jan 01 2002 Markus Hoffmann <m.hoffmann@uni-bonn.de>
......
'
' ANALOGUHR V.1.08 console-Version
' Demoprogramm. Es soll nur die Funktionalitaet von X11-BASIC
' demonstrieren. Hier kann man zur Syntax etc. lernen
' Letzte Bearbeitung 09.03.2003 Markus Hoffmann
'
bw=40
bh=20
bx=0
by=0
cls
print chr$(27)+"["+str$(0)+";"+str$(30+1)+";"+str$(40+7)+"m";
print "Analoguhr mit X-BASIC"
print " von Markus Hoffmann"
x=bx+bw/2
y=by+bh/2
xr=30
print chr$(27)+"[m";
'
' ***** Radien fr Zeiger usw. berechnen.
'
r=xr-x
bs=r/50
bm=r/20
t=r/12
r1=r
r2=r*0.914
r3=r*0.857
r4=r*0.84
r5=r*0.8
r6=r*0.571
'
' ***** Aktuelle Zeit in Ti$ bernehmen.
'
@u_hr_zeichnen_1
CLR ti$
al$="Systemzeit oder Neueingabe|der Uhrzeit?"
' ALERT 2,al$,1,"System|Eingabe",v
v=1
IF v=1
ti$=LEFT$(TIME$,2)
ti$=ti$+MID$(TIME$,4,2)
ti$=ti$+RIGHT$(TIME$,2)
ELSE
CLS
PRINT AT(10,10);"Bitte geben Sie die ";
PRINT "aktuelle Uhrzeit ein (HHMMSS): ";
INPUT ti$
ENDIF
'
'
' ***** Werte aus Ti$ an Uhrvariablen bergeben.
'
s=VAL(MID$(ti$,5,2))
w1=s-15
m=VAL(MID$(ti$,3,2))
w2=m-15
st=VAL(MID$(ti$,1,2))
IF st>12
st=st-12
ENDIF
st=st*5+INT(m/12)
w3=st-15
@u_hr_zeichnen_2
'
ti=STIMER
'
' ***** Warten, bis eine Sekunde vergangen ist.
'
do
IF STIMER>ti
ti=STIMER
print chr$(27)+"["+str$(0)+";"+str$(30+7)+";"+str$(40+7)+"m";
' pbox 120,250,280,300
@s_ekunde
print chr$(27)+"["+str$(0)+";"+str$(30+5)+";"+str$(40+7)+"m";
print at(10,7);time$
print at(150/16,5);date$
flush
pause 1-timer+stimer-0.05
ENDIF
loop
'
'
PROCEDURE s_ekunde
INC s
print chr$(27)+"["+str$(0)+";"+str$(30+7)+";"+str$(40+7)+"m";
@gLINE(x,y,x1,y1)
print chr$(27)+"["+str$(0)+";"+str$(30+4)+";"+str$(40+7)+"m";
INC w1
x1=x+INT(COS(w1*6*PI/180)*r5)
y1=y+INT(SIN(w1*6*PI/180)*r5)
@gLINE(x,y,x1,y1)
IF s=60
CLR s
@m_inute
ENDIF
print chr$(27)+"["+str$(0)+";"+str$(30+3)+";"+str$(40+7)+"m";
@gLINE(x,y,x2,y2)
@gLINE(x,y,x3,y3)
RETURN
PROCEDURE m_inute
INC m
print chr$(27)+"["+str$(0)+";"+str$(30+7)+";"+str$(40+7)+"m";
@gLINE(x,y,x2,y2)
print chr$(27)+"["+str$(0)+";"+str$(30+2)+";"+str$(40+7)+"m";
INC w2
x2=x+INT(COS(w2*6*PI/180)*r5)
y2=y+INT(SIN(w2*6*PI/180)*r5)
@gLINE(x,y,x2,y2)
IF m/12=INT(m/12)
@s_tunde
ENDIF
RETURN
PROCEDURE s_tunde
INC st
print chr$(27)+"["+str$(0)+";"+str$(30+7)+";"+str$(40+7)+"m";
@gLINE(x,y,x3,y3)
print chr$(27)+"["+str$(0)+";"+str$(30+2)+";"+str$(40+7)+"m";
INC w3
x3=x+INT(COS(w3*6*PI/180)*r6)
y3=y+INT(SIN(w3*6*PI/180)*r6)
@gLINE(x,y,x3,y3)
IF st=60
CLR st
ENDIF
RETURN
PROCEDURE u_hr_zeichnen_1
w=-15
REPEAT
INC w
x4=x+INT(COS(w*6*PI/180)*r3)
y4=y+INT(SIN(w*6*PI/180)*r3)
x5=x+INT(COS(w*6*PI/180)*r2)
y5=y+INT(SIN(w*6*PI/180)*r2)
x5a=x+INT(COS(w*6*PI/180)*r4)
y5a=y+INT(SIN(w*6*PI/180)*r4)
x6=x+INT(COS(w*6*PI/180)*r1)
y6=y+INT(SIN(w*6*PI/180)*r1)
@gLINE(x4,y4,x5,y5)
IF w/5=INT(w/5)
print at(x6-bh/2,(y6+bw/4)*2);STR$((-w+5)/5)
@gLINE(x5a,y5a,x5,y5)
ENDIF
UNTIL w=45
RETURN
PROCEDURE u_hr_zeichnen_2
x1=x+INT(COS(w1*6*PI/180)*r5)
y1=y+INT(SIN(w1*6*PI/180)*r5)
@gLINE(x,y,x1,y1)
x2=x+INT(COS(w2*6*PI/180)*r5)
y2=y+INT(SIN(w2*6*PI/180)*r5)
@gLINE(x,y,x2,y2)
x3=x+INT(COS(w3*6*PI/180)*r6)
y3=y+INT(SIN(w3*6*PI/180)*r6)
@gLINE(x,y,x3,y3)
RETURN
procedure plot(x,y)
print at(y,x*2);"##";
return
procedure circle(cx,cy,cr)
local i
for i=0 to 360 step 10
@gline(cx+cr*cos(i/180*pi),cy+cr*sin(i/180*pi),cx+cr*cos((i+10)/180*pi),cy+cr*sin((i+10)/180*pi))
next i
return
procedure gline(x1,y1,x2,y2)
local dx,dy,row,col,final
dX=x2-x1
dY=y2-y1
pos_slope=abs(dX>0)
if dY<0
pos_slope=1-pos_slope
endif
if ABS(dX)>ABS(dY)
if dX>0
col=x1
row=y1
final=x2
else
col=x2
row=y2
final=x1
endif
inc1=2*ABS(dY)
G=inc1-ABS(dX)
inc2=2*(ABS(dY)-ABS(dX))
if pos_slope
while col<=final
@plot(col,row)
inc col
if G>=0
inc row
add G,inc2
else
add G,inc1
endif
wend
else
while col<=final
@plot(col,row)
inc col
if G>0
dec row
add G,inc2
else
add G,inc1
endif
wend
endif
else
if dY>0)
col=x1
row=y1
final=y2
else
col=x2
row=y2
final=y1
endif
inc1=2*ABS(dX)
G=inc1-ABS(dY)
inc2=2*(ABS(dX)-ABS(dY))
if pos_slope
while row<=final
@plot(col,row)
inc row
if G>=0
inc col
add G,inc2
else
add G,inc1
endif
wend
else
while row<=final
@plot(col,row)
inc row
if G>0
dec col
add G,inc2
else
add G,inc1
endif
wend
endif
endif
return
'
' Bresenham's algorithm for drawing line
'
' Ported to X11-Basic (c) Markus Hoffmann 2003
'
phi=0
do
cls
print at(10,9);"Bresenham X11-Basic (c) Markus Hoffmann 2003"
xx=2*(11+10*cos(phi1/180*pi))
xxx=2*(20-19*cos(phi2/180*pi))
yy=11+10*sin(phi1/180*pi)
yyy=11-10*sin(phi2/180*pi)
@gline(xx,yy,xxx,yyy)
flush
pause 0.03
add phi1,10
add phi2,13
loop
print
end
procedure plot(x,y)
print at(y,x);"#";
return
procedure gline(x1,y1,x2,y2)
dX=x2-x1
dY=y2-y1
pos_slope=abs(dX>0)
if dY<0
pos_slope=1-pos_slope
endif
if ABS(dX)>ABS(dY)
if dX>0
col=x1
row=y1
final=x2
else
col=x2
row=y2
final=x1
endif
inc1=2*ABS(dY)
G=inc1-ABS(dX)
inc2=2*(ABS(dY)-ABS(dX))
if pos_slope
while col<=final
@plot(col,row)
inc col
if G>=0
inc row
add G,inc2
else
add G,inc1
endif
wend
else
while col<=final
@plot(col,row)
inc col
if G>0
dec row
add G,inc2
else
add G,inc1
endif
wend
endif
else
if dY>0)
col=x1
row=y1
final=y2
else
col=x2
row=y2
final=y1
endif
inc1=2*ABS(dX)
G=inc1-ABS(dY)
inc2=2*(ABS(dX)-ABS(dY))
if pos_slope
while row<=final
@plot(col,row)
inc row
if G>=0
inc col
add G,inc2
else
add G,inc1
endif
wend
else
while row<=final
@plot(col,row)
inc row
if G>0
dec col
add G,inc2
else
add G,inc1
endif
wend
endif
endif
return