On the other hand there might be some stuff which is usable, for instance the draw_text() function which can write text in any direction.
The description is not optimal, sometimes even missing (interpret the parameters)
The code is not very readable, because I am a lousy programmer
Code: Select all
option base 1
randomize
maxx=screen_width()
maxy=screen_height()
text ! print "hello" ! print cur_date$() ! pause 5
graphics
draw color 0,0,0
fill color 0.8,0.8,0.8
fill rect 0,0 to maxx,maxy
end
' def stat(n,a)
' def nsort(n,a())
' def asort(n,a$)
' def tablesort (r,c,in$(,),out$(,),onc())
' def array_reverse(n,a())
' def getn(xpos,ypos,default)
' def n2a$(num,lang,dec)
' def pre_pad$(w,a$)
' def str_cmp(a$,b$)
' def file_select$(xtop,ytop)
' def crypt$(in$,key$,mode)
' def file_crypt$(file_in$,key$,file_out$,mode)
' def xy_grid (xtop,ytop,xbot,ybot,alfa,beta,xpix,ypix)
' def page_window(name$,titel$,xs,ys,ww,hh,R,G,B,alpha)
' def message (t$,x,y)
' def numpad(xtop,ytop,bs,minval,maxval)
' def b_p(n$) = button_pressed(n$)
' def c_list(id$,title$,cont$(),size,xt,yt,xb,yb)
' def telwerk(def$,xt,yt)
' def rmeter(tit$,col$,xc,yc,rad,minval,maxval,val,mode)
' def set_col(col$)
' def t_color(t)
' def fill_segment (xc,yc,ri,ru,alfo,alfe)
' def w_open (title$,xtop,ytop,xbot,ybot)
' def font_size = (text_width("0123456789")-1)/6
' def cur_date$() gives current date as dd-mm-yyyy
' def stack(size) stack functions with error check
' def stack(size) stack functions without error check
' def draw_text(txt$,col$,siz,alph,x,y,angl,tok(,,))
' def set_color(col$)
' def tokens(tok(,,))
' segment_sub:
' def seg_number(k,x,y,sc)
' def segment_on (nr,x,y,sc)
def stat (n,a())
min=a(1) ! max=a(1) ! som=a(1)
for i=2 to n
if min>a(i) then min=a(i)
if max<a(i) then max=a(i)
som=som+a(i)
next i
a(n+1)=min ! a(n+2)=max ! a(n+3)=som ! a(n+4)=som/n
end def
def nsort(n,a())
for i=2 to n
if a(i)>a(i-1) then loop2
res=a(i)
for j=i-1 to 1 step -1
if a(j)<res then loop1
a(j+1)=a(j)
next j
loop1:
a(j+1)=res
loop2:
next i
end def
' string sort (method: insertion sort)
'
def asort(n,a$())
for i=2 to n
if str_cmp(a$(i),a$(i-1))=1 then loopa2
res$=a$(i)
for j=i-1 to 1 step -1
if str_cmp(a$(j),res$)=2 then loopa1
a$(j+1)=a$(j)
next j
loopa1:
a$(j+1)=res$
loopa2:
next i
end def
' table sorting function (option base 1 assumed)
' r = number of rows
' c = number of columns
' in$(,) = table to be sorted
' out$(,) = sorted table
' onc() = columns to be used for sorting, terminate with 0
'
def tablesort (r,c,in$(,),out$(,),onc())
dim sortcol$(r),index(r)
for i=1 to r
sortcol$(i)="" ! k=1
while onc(k)>0 and k<=c
sortcol$(i)&=in$(i,onc(k))! k+=1
end while
'y'
sortcol$(i)&=str$(i) ' workaround for bug in SORT M AS N
''
next i
sort sortcol$ as index
for i=1 to r ! for j=1 to c ! out$(i,j)=in$(index(i),j) ! next j ! next i
return
end def
def array_reverse(n,a())
base=option_base()
for i=base to floor((n-base+1)/2)
r=n-i+base
temp=a(i) ! a(i)=a(r) ! a(r)=temp ! next i
end def
def getn(xpos,ypos,default)
field "data" text n2a$(default,8,0) at xpos,ypos size 100,30
get1:
if field_changed("data")=0 then goto get1
hulp=field_text$("data")
field "data" delete
draw text n2a$(hulp,8,0) at xpos,ypos
getn=hulp
end def
' format a number for PRINT or DRAW TEXT statement
' num = the number to be formatted
' len = the field length to be used for the formatted number,
' inclusive decimals, sign, dots, and comma
' len=0 will automatically use the shortest field needed
' dec = the number of decimal positions
' to print a table right-aligned, give len a value of at least the
' longest number in the table. Giving even more than that, will
' have a TAB effect for the whole table
'
def n2a$(num,len,dec)
dec=max(dec,0)! fh$="###" ! f$="" ! th$="," ! dec$="."
if num<0 then ! s=1 ! num=-num ! else ! s=0 ! end if
pre=max(floor(log10(num)+1),1) ! noc=floor((pre-1)/3)
le=pre+noc+s ! if dec then le+=dec+1
if len and len>le then spaces=len-le else spaces=0
while spaces ! f$&=" " ! spaces-=1 ! end while
if s then f$&="-" ! f$&=left$(fh$,pre-3*noc)
while noc ! f$&=th$&fh$ ! noc-=1 ! end while
if dec then ! f$&=dec$ ! while dec ! f$&="#" ! dec-=1 ! end while ! end if
return str$(num,f$)
end def
def pre_pad$(w,a$)
sp$=" "
tot=w-len(a$)
if tot>0 then pre_pad$=substr$(sp$,1,tot) & a$ else pre_pad$=a$
end def
def str_cmp (a$,b$)
c$=" !'-./0123456789?@abcdefghijklmnopqrstuvwxyz"
la=len(a$) ! lb=len(b$)
if a$=b$ and la=lb then
str_cmp=0 ! return
end if
min=la ! if lb<min then min=lb
for i=1 to min
as$=substr$(a$,i,i) ! bs$=substr$(b$,i,i)
if as$=bs$ then goto volg
for k=1 to 44
if as$=substr$(c$,k,k) then
str_cmp=2 ! return
end if
if bs$=substr$(c$,k,k) then
str_cmp=1 ! return
end if
next k
volg:
next i
if min=la then str_cmp=2 else str_cmp=1
end def
' file browser/selector for use in Smart Basic programs
' returns selected file with path
' touch a folder to descend in the file structure
' touch "back ^" button to go back one level (parent directory)
' use filter to restrict the number of files shown
' folders are prefixed in the list with "D_"
' position the fileselector with the x,y coordinates
' the original background is restored after quitting the function
'
def file_select$(xtop,ytop)
maxdim=100 ! set lists custom
dim directs$(maxdim),files$(maxdim), combi$(2*maxdim)
graphics ! fill color .8,.8,.8 ! draw color 0,0,0
graphics clear .8,.8,.8
s_w=screen_width() ! s_h=screen_height()
wid=220 ! hgt=420
if xtop+wid>s_w-10 then xtop=s_w-wid-10 ! xbot=xtop+wid
if ytop+hgt>s_h-10 then ytop=s_h-hgt-10 ! ybot=ytop+hgt
sprite "fbrow" scan xtop-2,ytop-2,wid+4,hgt+4
draw size 3 ! draw rect xtop,ytop to xbot,ybot
draw line xtop,ytop+24 to xbot,ytop+24
draw color 0,0,1 ! draw text "file select" at xtop+45,ytop+4
draw color 0,0,0
button "back" title "back ^" at xtop+150,ytop+340 size 60,30
field "filter" text "filter" at xtop+10,ytop+340 size 120,30
button "cancel" title "cancel" at xtop+10,ytop+380 size 90,30
button "ok" title "OK" at xtop+120,ytop+380 size 90,30
filter$="" ! fil$=""
fil_lab1: path$="" ! dir$=""
fil_lab2: if dir$>"" then path$=path$ & "/" & dir$
fil_lab21:
dir path$ list dirs directs$,n1
dir path$ list files files$,n2
fil_lab3:
if n1 then
for i=1 to n1 ! combi$(i)="D_" & directs$(i) ! next i
end if
fil_lab4:
ntot=n1
if n2 then
for i=1 to n2
if filter$="" or filter$="filter" or instr(files$(i),filter$)>=0 then
ntot+=1 ! combi$(ntot)=files$(i)
end if
next i
end if
if ntot=0 then ! ntot=1 ! combi$(1)="" ! end if
dim temp$(ntot)
for i=1 to ntot ! temp$(i)=combi$(i) ! next i
list "fsel" text temp$ at xtop+2,ytop+26 size xbot-xtop-4,300
draw size 3 ! draw line xtop,ytop+330 to xbot,ytop+330
fil_lab5:
if button_pressed("cancel") then
ret$="" ! goto fil_lab6
end if
if button_pressed("ok") then
if fil$>"" then
if path$="" then ret$=path$ & "/" & fil$
goto fil_lab6
end if
end if
if field_changed("filter") then
filter$=field_text$("filter") ! goto fil_lab4
end if
if button_pressed("back") then
for k=len(path$) to 1 step -1
if mid$(path$,k,1)="/" then break
next k
if k then ! path$=left$(path$,k-1) ! goto fil_lab21 ! end if
end if
sel=list_selected("fsel")
if sel>0 then
if sel>n1 then
fil$=combi$(sel) ! goto fil_lab5
else
dir$=directs$(sel) ! goto fil_lab2
end if
end if
goto fil_lab5
fil_lab6:
field "filter" delete ! button "back" delete
button "cancel" delete ! button "ok" delete
list "fsel" delete
sprite "fbrow" at xtop-2,ytop-2 ! sprite "fbrow" stamp
sprite "fbrow" delete
return ret$
end def
def crypt$(in$,key$,mode)
dim key(15)
lk=len(key$) ! lt=len(in$)
for i=1 to lk ! key(i)=asc(substr$(key$,i,i)) ! next i
for i=1 to lt
out$=out$ & chr$(asc(substr$(in$,i,i))+mode*key(1+mod(i,lk)))
next i
crypt$=out$
end def
' This function will encrypt a text-file which must be present
' in the map where the program is started.
' Encryption is done with mode=1, the result is written to the
' output-file and is given back by the function as a string.
' Decryption to readable tekst must be done with mode=-1, and
' of course with the same key. When trying to decrypt with a
' different key, the program may crash, which might be a desirable
' feature in this special case.
' The key may consist of any caracters, but normally it is a easy
' to remember word. Maximum length is 15 letters (change the dim-
' statement if you want more). Preferable lengths are prime numbers
' such as 7 or 13.
' The encrypted text cannot easily be deciphered without the key,
' as any specific letter in the text is replaced by different
' tokens in the encrypted text.
' The input-file must be enclosed in double quotes to ensure that
' the entire file is regarded as one (1) string.
' the function works for either option base 0 or 1
'
def file_crypt$(file_in$,key$,file_out$,mode)
base=substr$("10",1,1) ' base=option base x
dim key(15)
file file_in$ input in$
lk=len(key$) ! lt=len(in$) ! out$=""
for i=base to lk-1+base ! key(i)=asc(substr$(key$,i,i)) ! next i
for i=base to lt-1+base
out$=out$ & chr$(asc(substr$(in$,i,i))+mode*key(base+mod(i,lk)))
next i
file file_out$ delete ! file file_out$ print """" & out$ & """"
return out$
end def
def mod(a,m)
d=a/m ! mod=m*(d-floor(d))
end def
def xy_grid (xtop,ytop,xbot,ybot,alfa,beta,xpix,ypix)
if xpix=0 or ypix=0 then
fill rect xtop-6,ytop-6 to xbot+6,ybot+6
return
end if
xc=xtop+alfa*(xbot-xtop) ! yc=ytop+beta*(ybot-ytop)
graphics lock
draw color 0,0,1 ! draw size 2
draw line xtop,yc to xbot,yc ! draw line xc,ytop to xc,ybot
draw color 0,0,0 ! draw size 3
draw rect xtop-4,ytop-4 to xbot+4,ybot+4
draw size 1 ! draw alpha 0.3
for x=xc+xpix to xbot step xpix ! draw line x,ytop to x,ybot ! next x
for x=xc-xpix to xtop step -xpix ! draw line x,ytop to x,ybot ! next x
for y=yc+ypix to ybot step ypix ! draw line xtop,y to xbot,y ! next y
for y=yc-ypix to ytop step -ypix ! draw line xtop,y to xbot,y ! next y
draw alpha 1
graphics unlock
end def
' page window
' open and close with command page show and page hide
' other page commands in manual
'
def page_window(name$,titel$,xs,ys,ww,hh,R,G,B,alpha)
page name$ set
page name$ frame xs,ys,ww,hh
page name$ color R,G,B,alpha
button "close" title "❎" at ww-30,5 size 22,22
button "bottom" title "" at -6,hh-3 size ww+12,3
button "left" title "" at 0,-6 size 3,hh+12
button "right" title "" at ww-3,-6 size 3,hh+12
button "upper1" title "" at -6,0 size ww+12,3
button "upper2" title "" at -6,30 size ww+12,3
button "title" title titel$ at 60,3 size 180,27
'
' other UI objects
'
page name$ hide ! page "" set
end def
def message (t$,x,y)
z=12*len(t$)+10 ! if z<300 then z=300
xb=x+z ! yb=y+50
w_open ("",x,y,xb,yb)
draw text t$ at x+5,y+2
button "oki" title "ok" at (x+xb-60)/2,y+24 size 60,20
loki:
if button_pressed("oki") then
fill rect x-2,y-2 to xb+2,yb+2
button "oki" delete
else
goto loki
end if
end def
' numerical keypad object
'
' produce a simpel keypad to quickly enter a number in an app
' upon entry, the keypad disappears
' left upper corner is placed at "xtop,ytop"
' "bs" is the button size (keypad becomes 4.3 times larger)
' size of number is accepted between "minval" and "maxval"
' if both "minval" and "maxval" are zero, then no restrictions
' max number of tokens in the number is 10 (minus and dot included)
'
def numpad(xtop,ytop,bs,minval,maxval)
sp=3 ! th=bs-16 ! pflag=0 ! sflag=0
if bs<20 then bs=20
draw font size .9*bs-18
ww=4*bs+5*sp ! hh=th+4*bs+6*sp
xbot=xtop+ww ! ybot=ytop+hh
sprite "bg" scan xtop-2,ytop-2,ww+4,hh+4
r=10 ! graphics lock
draw color 0,0,0 ! draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
draw line xtop,ytop+th to xbot,ytop+th
graphics unlock
button "0" title "0" at xtop+sp,ytop+th+3*bs+5*sp size bs,bs
button "1" title "1" at xtop+sp,ytop+th+2*bs+4*sp size bs,bs
button "2" title "2" at xtop+2*sp+bs,ytop+th+2*bs+4*sp size bs,bs
button "3" title "3" at xtop+3*sp+2*bs,ytop+th+2*bs+4*sp size bs,bs
button "4" title "4" at xtop+sp,ytop+th+bs+3*sp size bs,bs
button "5" title "5" at xtop+2*sp+bs,ytop+th+bs+3*sp size bs,bs
button "6" title "6" at xtop+3*sp+2*bs,ytop+th+bs+3*sp size bs,bs
button "7" title "7" at xtop+sp,ytop+th+2*sp size bs,bs
button "8" title "8" at xtop+2*sp+bs,ytop+th+2*sp size bs,bs
button "9" title "9" at xtop+3*sp+2*bs,ytop+th+2*sp size bs,bs
button "-" title "-" at xtop+2*sp+bs,ytop+th+3*bs+5*sp size bs,bs
button "." title "." at xtop+3*sp+2*bs,ytop+th+3*bs+5*sp size bs,bs
button "Cl" title "C" at xtop+4*sp+3*bs,ytop+th+2*sp size bs,bs
button "del" title "<-" at xtop+4*sp+3*bs,ytop+th+bs+3*sp size bs,bs
button "ok" title "ok" at xtop+4*sp+3*bs,ytop+th+2*bs+4*sp size bs,2*bs+sp
a$=""
nump1:
if b_s("ok") then
number=val(a$)
if minval<>0 or maxval<>0 then
if number<minval or number>maxval then
fill rect xtop+8,ytop+2 to xbot-10,ytop+th-2
draw color .6,0,0 ! draw text "range err" at xtop+8,ytop+2
pflag=0 ! a$="" ! pause 1
fill rect xtop+8,ytop+2 to xbot-10,ytop+th-2
goto nump1
end if
end if
button "-" delete ! button "." delete ! button "Cl" delete
button "del" delete ! button "ok" delete
for i=0 to 9 ! button i delete ! next i
sprite "bg" at xtop-2,ytop-2 ! sprite "bg" stamp
draw font size 24 ! draw size 1
numpad=number ! return
end if
if b_s("Cl") then
a$ = "" ! pflag=0 ! sflag=0 ! goto nump3
end if
if b_s("del") and len(a$) then
ll=len(a$) ! if substr$(a$,ll,ll)="." then pflag=0
a$ = left$(a$,ll-1) ! sflag=0 ! goto nump3
end if
if b_s("-") then
a$ = "-" ! pflag=0 ! sflag=0 ! goto nump3
end if
if b_s(".") and not pflag and not sflag then
a$ &= "." ! pflag=1 ! goto nump3
end if
for k=0 to 9
t$=k
if b_s(t$) and not sflag then
a$ &= t$ ! goto nump3
end if
next k
goto nump1
nump3:
if len(a$)>10 then ! sflag=1 ! goto nump1 ! end if
fill rect xtop+8,ytop+2 to xbot-6,ytop+th-2
draw color 0,0,1 ! draw text a$ at xtop+8,ytop+2 ! draw color 0,0,0
goto nump1
end def
def b_p(n$) = button_pressed(n$)
' id$ = object name
' cont$ = array met elementen
' size = aantal elementen in de list
'
def c_list(id$,title$,cont$(),size,xt,yt,xb,yb)
dim temp$(size)
for i=1 to size ! temp$(i)=cont$(i) ! next i
list id$ text temp$ at xt+2,yt+32 size xb-xt-4,yb-yt-34
draw size 3
draw rect xt,yt to xb,yb ! draw line xt,yt+30 to xb,yt+30
draw color 0,0,1 ! draw text title$ at xt+5,yt+5
end def
' number input wheel
' def$ is the default value and defines the number of positions
' decimal point is allowed
' xt and yt are the coordinates of the left upper corner
' the function returns the dialed number
'
def telwerk(def$,xt,yt)
dim num(10) ! n=len(def$) ! if n>10 then n=10
draw font size 30 ! draw size 4
for i=1 to n
c$=substr$(def$,i,i)
if c$="." then num(i)=-1 else num(i)=c$
next i
br=50+40*n ! xb=xt+br ! yb=yt+60
fill rect xt,yt to xb,yb ! draw rect xt,yt to xb,yb
for i=1 to n
xs=xt+40*i
if num(i)=-1 then
draw text "." at xs-30,yt+12
else
draw text num(i) at xs-30,yt+12
end if
draw line xs,yt to xs,yb
next i
yc=(yt+yb)/2
draw text "ok" at xb-42,yt+12
lab1:
xx=touch_x(0) ! yy=touch_y(0) ! if xx<0 then lab1
pause .2
if xx<xt or xx>xb or yy<yt-30 or yy>yb+30 then lab1
if xx>xb-50 and xx<xb then lab2
i=1+floor((xx-xt)/40)
if i<1 then i=1 ! if i>n then i=n
if num(i)=-1 then lab1
if yy<yc then
num(i)=num(i)-1 ! if num(i)<0 then num(i)=9
else
num(i)=num(i)+1 ! if num(i)>9 then num(i)=0
end if
fill rect xt-38+40*i,yt+2 to xt-2+40*i,yb-2
draw text num(i) at xt+10+40*(i-1),yt+12
goto lab1
lab2: c$=""
for i=1 to n
if num(i)=-1 then c$=c$ & "." else c$=c$ & num(i)
next i
telwerk=c$
end def
' rmeter function, where:
' tit$ = text, printed on the meter
' col$ = color of meter, "r", "g" , "b" for red, green and blue
' xc and yc = centre of meter on the screen
' rad = size (radius) of the meter
' minval and maxval = lowest and highest value on the scale
' val = the value to be displayed by the meter
' mode=1 : creation of one meter
' mode=0 : use meter to display value
' mode=-1: delete meter from screen
'
def rmeter(tit$,col$,xc,yc,rad,minval,maxval,val,mode)
if mode=-1 then
fill circle xc,yc size rad+2
return
end if
graphics lock
if mode=0 then mode_0
set_col("n")
draw size 3 ! draw circle xc,yc size rad
draw size 4 ! draw circle xc,yc size rad-6
set_col(col$)
draw size 3 ! draw circle xc,yc size rad-3
set_col("n")
draw arc xc,yc,rad-50,130,410
draw size 3
for a=130 to 410 step 28
xs=xc+(rad-50)*cos(a) ! ys=yc+(rad-50)*sin(a)
xe=xc+(rad-42)*cos(a) ! ye=yc+(rad-42)*sin(a)
draw line xs,ys to xe,ye
next a
draw size 1
for a=130 to 410 step 7
xs=xc+(rad-50)*cos(a) ! ys=yc+(rad-50)*sin(a)
xe=xc+(rad-44)*cos(a) ! ye=yc+(rad-44)*sin(a)
draw line xs,ys to xe,ye
next a
delta=(maxval-minval)/10 ! sval=minval
draw font size 15
for a=130 to 410 step 28
xs=xc+(rad-30)*cos(a)-18 ! ys=yc+(rad-30)*sin(a)-10
draw text n2a$(sval,3,0) at xs,ys
sval=sval+delta
next a
draw font size 20
mode_0:
fill circle xc,yc size rad-52
xs=xc+(rad-80)*cos(112) ! ys=yc+(rad-80)*sin(112)
set_col(col$)
fill circle xc,yc size 10 ! draw text tit$ at xs,ys
set_col("n")
if val<minval then val=minval
if val>maxval then val=maxval
beta=130+280*(val-minval)/(maxval-minval)
xs=xc-30*cos(beta) ! ys=yc-30*sin(beta)
xe=xc+(rad-54)*cos(beta) ! ye=yc+(rad-54)*sin(beta)
draw size 6 ! draw line xs,ys to xe,ye
graphics unlock
end def
def set_col(col$)
if col$="r" or col$="R" then
draw color 1,0,0 ! fill color 1,0,0
end if
if col$="g" or col$="G" then
draw color 0,.6,0 ! fill color 0,.6,0
end if
if col$="b" or col$="B" then
draw color 0,0,1 ! fill color 0,0,1
end if
if col$="n" or col$="N" then
draw color 0,0,0 ! fill color .8,.8,.8
end if
enddef
' temperature grade scale
' temperature goes from white to yellow,to red, to blue to black
' t=0 -> lowest temperature (black)
' t=1 -> highest temperature (white)
' the function sets the fill color
'
def t_color(t)
if t<0 then t=0 ! if t>1 then t=1
if t<0.2 then
r=0 ! g=0 ! b=5*t
else
if t<0.7 then
r=2*(t-0.2) ! g=0 ! b=2*(0.7-t)
else
if t<0.9 then
r=1 ! g=5*(t-0.7) ! b=0
else
r=1 ! g=1 ! b=10*(t-0.9)
end if
end if
end if
fill color r,g,b
end def
' xc,yc is centre of the circle
' ri,ru are radii of inner and outer circle arcs
' alfo,alfe start and ending angle for segment
'
def fill_segment (xc,yc,ri,ru,alfo,alfe)
dim xx(14),yy(14)
xx(1)=xc+ru*cos(alfe) ! yy(1)=yc-ru*sin(alfe)
xx(2)=xc+ri*cos(alfe) ! yy(2)=yc-ri*sin(alfe)
xx(3)=xc+ri*cos(alfo) ! yy(3)=yc-ri*sin(alfo)
i=4
for alf=alfo to alfe step (alfe-alfo)/3
xx(i)=xc+ru*cos(alf) ! yy(i)=yc-ru*sin(alf) ! i+=1
next alf
fill poly xx,yy count 6
end def
def w_open (title$,xtop,ytop,xbot,ybot)
r=10 ! draw color 0,0,0 ! draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
l=(xbot-xtop-12*len(title$))/2
draw line xtop,ytop+24 to xbot,ytop+24
draw color 0,0,1
draw text title$ at xtop+l,ytop-2
draw color 0,0,0
end if
end def
def cur_date$() ' gives current date as dd-mm-yyyy
yy=current_year()
mm=current_month() ! if mm<10 then m$="0"&mm else m$=mm
dd=current_date() ! if dd<10 then d$="0"&dd else d$=dd
return d$ & "-" & m$ & "-" & yy
end def
' Stack functions:stack(init), push, and pop
' with error checking (check on
' works with option base 0 and 1
'
def stack(size) ! dim st(size+1) ! sp=0 ! end def
def push(number)
if stack.sp=stack.size then ! .stack_error=1 ! return ! end if
stack.sp+=1 ! stack.st(stack.sp)=number
end def
def pop()
if stack.sp=0 then ! .stack_error=1 ! return ! end if
stack.sp-=1 ! return stack.st(stack.sp+1)
end def
' same stack functions without error checking
/*
def stack(size) ! dim st(size+1) ! sp=0 ! end def
def push(num) ! stack.sp+=1 ! stack.st(stack.sp)=num ! end def
def pop ! stack.sp-=1 ! return stack.st(stack.sp+1) ! end def
*/
' Draw text in any angle, size and color
'
def draw_text(txt$,col$,siz,alph,x,y,angl,tok(,,))
set_col(col$)
draw alpha alph ! lt=len(txt$) ! fac=siz/4
ca=cos(-angl) ! sa=sin(-angl) ! draw size 1+floor(siz/10)
for i=1 to lt
t$=substr$(txt$,i,i) ! t=asc(t$)
if t>96 then ! k=t-82 ! goto dt_loop1 ! end if
if t>47 and t<58 then ! k=t-44 ! goto dt_loop1 ! end if
if t=32 then k=1 ! if t=44 then k=2
if t=46 then k=3 ! if t=63 then k=14
dt_loop1:
r=siz*(i-1) ! xd=x+r*ca ! yd=y+r*sa
for j=1 to 10
xl=fac*tok(k,j,1) ! yl=fac*tok(k,j,2)
if xl<0 then dt_loop2
xp=xd+xl*ca-yl*sa ! yp=yd+xl*sa+yl*ca
if j=1 then draw to xp,yp else draw line to xp,yp
next j
dt_loop2:
next i
end def
def set_color(col$)
if col$="z" then draw color 0,0,0
if col$="r" then draw color 1,0,0
if col$="g" then draw color 0,.6,0
if col$="b" then draw color 0,0,1
if col$="w" then draw color 1,1,1
end def
def tokens(tok(,,)) ' dim tok(40,10,2) needed
for i=1 to 40 ! for j=1 to 10 ! for k=1 to 2
read tok(i,j,k)
next k ! next j ! next i
data -1,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 '
data 1.5,3, 2,3, 2,3.5, 1,4, 1.5,3.5, 1.5,3, -1,0,0,0,0,0,0,0 ',
data 1,3.5, 1.5,3.5, 1.5,4, 1,4, -1,0,0,0,0,0,0,0,0,0,0,0 '.
data 0,1, 0,3, 1,4, 2,4, 3,3, 3,1, 2,0, 1,0, 0,1, -1,0 '0
data 1,1, 2,0, 2,4, 1,4, 3,4, -1,0, 0,0, 0,0, 0,0, 0,0 '1
data 0,1, 1,0, 2,0, 3,1, 0,4, 3,4, -1,0, 0,0, 0,0, 0,0 '2
data 0,0, 3,0, 2,1, 3,2, 3,3, 2,4, 1,4, 0,3, -1,0, 0,0 '3
data 3,3, 0,3, 2,0, 2,4, 2,3, 3,3, -1,0, 0,0, 0,0, 0,0 '4
data 3,0, 1,0, 0,2, 2,2, 3,3, 2,4, 0,4, -1,0, 0,0, 0,0 '5
data 2,0, 0,2, 0,3, 1,4, 2,4, 3,3, 2,2, 0,2, -1,0, 0,0 '6
data 0,0, 3,0, 0,4, 1.5,2, 1,2, 2,2, -1,0, 0,0, 0,0, 0,0 '7
data 0,2, 0,0, 3,0, 3,2, 0,2, 0,4, 3,4, 3,2, -1,0, 0,0 '8
data 2.3,2, 1,2, 0,1, 1,0, 2,0, 3,1, 1,4, -1,0, 0,0, 0,0 '9
data 0,1, 1.5,0, 3,1, 1,2.5, 1,3.5, .5,4, 1.5,4, 1,3.5, -1,0, 0,0 '?
data 0,4, 1.5,0, 3,4, 2.6,3, 0.4,3, -1,0, 0,0, 0,0, 0,0, 0,0 'a
data 2,2, 0,2, 0,0, 2,0, 3,1, 2,2, 3,3, 2,4, 0,4, 0,2 'b
data 3,1, 2,0, 1,0, 0,1, 0,3, 1,4, 2,4, 3,3, -1,0, 0,0 'c
data 0,0, 0,4, 2,4, 3,3, 3,1, 2,0, 0,0, -1,0, 0,0, 0,0 'd
data 3,0, 0,0, 0,2, 2,2, 0,2, 0,4, 3,4, -1,0, 0,0, 0,0 'e
data 3,0, 0,0, 0,2, 2,2, 0,2, 0,4, -1,0, 0,0, 0,0, 0,0 'f
data 3,1, 2,0, 1,0, 0,1, 0,3, 1,4, 2,4, 3,3, 3,2, 1,2 'g
data 0,0, 0,4, 0,2, 3,2, 3,0, 3,4, -1,0, 0,0, 0,0, 0,0 'h
data 1,0, 3,0, 2,0, 2,4, 3,4, 1,4, -1,0, 0,0, 0,0, 0,0 'i
data 1,0, 3,0, 3,3, 2,4, 1,4, 0,3, -1,0, 0,0, 0,0, 0,0 'j
data 0,0, 0,4, 0,3, 3,0, 1.5,1.5, 3,4, -1,0, 0,0, 0,0, 0,0 'k
data 0,0, 0,4, 3,4, -1,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 'l
data 0,4, 0,0, 1.5,2, 3,0, 3,4, -1,0, 0,0, 0,0, 0,0, 0,0 'm
data 0,4, 0,0, 3,4, 3,0, -1,0, 0,0, 0,0, 0,0, 0,0, 0,0 'n
data 0,1, 0,3, 1,4, 2,4, 3,3, 3,1, 2,0, 1,0, 0,1, -1,0 'o
data 0,4, 0,0, 2,0, 3,1, 2,2, 0,2, -1,0, 0,0, 0,0, 0,0 'p
data 2,4, 1,4, 0,3, 0,1, 1,0, 2,0, 3,1, 3,3, 2,3, 3,4 'q
data 0,4, 0,0, 2,0, 3,1, 2,2, 0,2, 1,2, 3,4, -1,0, 0,0 'r
data 3,0, 1,0, 0,1, 1,2, 2,2, 3,3, 2,4, 0,4, -1,0, 0,0 's
data 0,0, 3,0, 1.5,0, 1.5,4, -1,0, 0,0, 0,0, 0,0, 0,0, 0,0 't
data 0,0, 0,3, 1,4, 2,4, 3,3, 3,4, 3,0, -1,0, 0,0, 0,0 'u
data 0,0, 1.5,4, 3,0, -1,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 'v
data 0,0, 0,4, 1.5,2, 3,4, 3,0, -1,0, 0,0, 0,0, 0,0, 0,0 'w
data 0,0, 3,4, 1.5,2, 0,4, 3,0, -1,0, 0,0, 0,0, 0,0, 0,0 'x
data 0,0, 1.5,2, 0,4, 3,0, -1,0, 0,0, 0,0, 0,0, 0,0, 0,0 'y
data 0,0, 3,0, 0,4, 3,4, -1,0, 0,0, 0,0, 0,0, 0,0, 0,0 'z
end def
' init subroutine for 7-segment number display
'
segment_sub:
dim sx(7,6),sy(7,6),num(10,7)
for k=1 to 6 ! for i=1 to 4 ! read sx(k,i),sy(k,i) ! next i ! next k
for i=1 to 6 ! read sx(7,i),sy(7,i) ! next i
for k=1 to 10 ! for j=1 to 7 ! read num(k,j) ! next j ! next k
data 5,0, 75,0, 65,10, 15,10, 0,5, 10,15, 10,69, 0,74
data 80,5, 70,15, 70,69, 80,74, 0,86, 10,91, 10,147, 0,157
data 80,86, 70,91, 70,147, 80,157, 5,160, 75,160, 65,150, 15,150
data 0,80, 10,75, 70,75, 80,80, 70,85, 10,85
data 1,2,3,4,5,6,-1, 3,5,-1,0,0,0,0, 1,3,7,4,6,-1,0
data 1,3,5,6,7,-1,0, 2,7,3,5,-1,0,0, 1,2,7,5,6,-1,0
data 1,2,4,6,5,7,-1, 1,3,5,-1,0,0,0, 1,2,3,4,5,6,7, 1,2,3,7,5,6,-1
return
' 7-segment number k, left upper corner at x-4,y-4 screenposition
' sc = scale, scale 1 gives 88x168 size on screen
'
def seg_number(k,x,y,sc)
fill color 0,0,0 ! fill alpha .7
fill rect x-4,y-4 to 80*sc+x+4,160*sc+y+4
fill color 0,.7,0 ! fill alpha 1
for j=1 to 7
snum=.num(k+1,j) ! if snum=-1 then break
segment_on(snum,x,y,sc)
next j
end def
def segment_on (nr,x,y,sc)
dim xseg(6), yseg(6)
if nr>6 then k=6 else k=4
for i=1 to k ! xseg(i)=sc*.sx(nr,i)+x ! yseg(i)=sc*.sy(nr,i)+y ! next i
fill poly xseg,yseg count k
end def