NEW:diverse projects, keys,inside polygon [2023,march.11]

[hedgehog7777]

'last edit: 2023,    march.10:find DL for guests [in:02]
                               march.11:start marbles with circles (in 28)
'
Basic_news:check this for a different Basic:
libertybasiccom.proboards.com/board/14/liberty-basic-v4-5-1

'-----------------------------------------------------------------------------------------------------------------------------------------------------------
... find the following programms in this page:
01:change 4 vector_points with mouse and F5-F8
02:.join diverse projects _ write email with new code_08.txt
03:find_all_files and content_30b
04:find 3d-plane_04
05:best and short cam with ground collision()
06:[keys_ez_19c.final]_(v1.5)
07:smallest keys:10/7/2021 PCN'hedgehog
08:two different and excellent flying-abilities
09:Camera demo (Camera_02)
10:doppel-click and mousebutton (v1.2).gb
11:hedgehogs inside polygon v1.6 (8.07_2021)
12:gosub when mouse is moving (v1.0)
13:PB03 , Starfield0
14:Star field demo 1
15:Star field demo 2
16:Star field demo 3
17:Fly different_03
18:matrix_02.final
19:matrix_03.final
20:matrix_05
21:rotate and vectortext .PB.02
22:blend_01.gb
23:blend_02c.fin    'blend function with texture
24:blend_02c.8.zip (704.92 KB)     'advanced blend
25:mouse mxa()_01
26:use Gl_color and texture
27:.mouse_angle and _speed_02
28:circle_21 and circle_22
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
' 01:
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
'smallest_keys.02.03b.(15b).gb : F5-F8 :change 4 vector_points with mx and my
'
dim g1,in5,in,in$,i,c(255),a1,b1,hmk
for i=0 to 255:c(i)=i:next:reset m11:i=0:do:read a1,b1:if a1<>-1 then c(a1)=b1:i=i+1:endif:loop until a1=-1 :hmk=i-1
'smallest_keys.02 :2022,8.16
declare sub keys():declare sub text():declare sub skd_not(i0)
'
dim a15,a8(255),a9(255),a,e
'
dim d2,mx2,mx2b,mx2c,mx2d
dim d3,mx3,mx3b,mx3c,mx3d
'mx1c = mx(1,3) 'mx1b = mx(1,2) 'mx1 = mx(1,0) 'mx1d = mx(1,4)
'
dim i1,i2,i3,i4,cr(10),c4(999,2),co(9,2)'1000 colors
for a=0 to 9:cr(a)=a*28:next'1000 text_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:c4(i,0)=cr(i1):c4(i,1)=cr(i3):c4(i,2)=cr(i4):next'1000 text_colors
sub w(i):color(c4(i,0),c4(i,1),c4(i,2)):end sub'1000 colors wo comma
function r0(a):dim x2:a=a+1:x2=(rnd()%a):return x2:end function ' 0-10
'2022,12.7
'declare sub limx(i0):declare sub limy(i0):
declare sub all0(i0):declare sub mx_(i0):declare sub my_(i0) 'declare sub spc(nr)
'2022,12.8
dim s$="      ",mx5(4),my5(4),mx1(4,4),my1(4,4),dx(4),dy(4),a789,mx6(4),my6(4),mx7(4),my7(4),Vm(4,1) as single,a10
dim vG(1) as single,vH(1) as single,vx3L as single,lambda1#,vI(1) as single,vJ(1) as single
declare sub lim_(i0)
vG=vec2(-10,0):vH=vec2(30,40):vI=vec2(50,50):vJ=vec2(80,20)
mx6(1) =vG(0) :my6(1) =vG(1) :mx6(2) =vH(0) :my6(2) =vH(1) :mx6(3) =vI(0) :my6(3) =vI(1) :mx6(4) =vJ(0) :my6(4) =vJ(1)
mx7(1) =mx6(1):my7(1) =my6(1):mx7(2) =mx6(2):my7(2) =my6(2):mx7(3) =mx6(3):my7(3) =my6(3):mx7(4) =mx6(4):my7(4) =my6(4)
Vm(1,0)=mx6(1):Vm(1,1)=my6(1):Vm(2,0)=mx6(2):Vm(2,1)=my6(2):Vm(3,0)=mx6(3):Vm(3,1)=my6(3):Vm(4,0)=mx6(4):Vm(4,1)=my6(4)
'-------------------------------------------------------------------------------------------------------------------------------------
resizetext(80,40)
do
 keys() :text()
 lim_(1) :lim_(2) :lim_(3):lim_(4)
loop
'
sub lim_(i0)
if a9(115+i0) then
 mx1(i0,3)=true
 if mx1(i0,2) then mx_(i0):Dx(i0) = mx1(i0,0) - mx5(i0) :mx1(i0,2)=0 :endif
 if mx1(i0,2)=0 then mx_(i0)
   if mx1(i0,4)=0 then Dx(i0)=-mx5(i0):mx1(i0,4)=true:endif
   mx5(i0)=mx5(i0)+Dx(i0)
   mx7(i0)=mx5(i0)+mx6(i0) :a10=true
   if mx7(i0)>360 then mx7(i0)=360:endif :if mx7(i0)<-360 then mx7(i0)=-360:endif
 endif
else
 if mx1(i0,3) then if mx1(i0,2)=0 then mx1(i0,0)=mx5(i0):mx1(i0,2)=true:endif :endif
endif
'--------------------------------------------------------------------------------------------------
if a9(115+i0) then
  my1(i0,3)=true
  if my1(i0,2) then my_(i0):Dy(i0) = my1(i0,0) - my5(i0) :my1(i0,2)=0 :endif
  if my1(i0,2)=0 then my_(i0)
    if my1(i0,4)=0 then Dy(i0)=-my5(i0):my1(i0,4)=true:endif
    my5(i0)=my5(i0)+Dy(i0)
    my7(i0)=my5(i0)+my6(i0) :a10=true
    if my7(i0)>360 then my7(i0)=360:endif :if my7(i0)<-360 then my7(i0)=-360:endif
  endif
else
  if my1(i0,3) then if my1(i0,2)=0 then my1(i0,0)=my5(i0):my1(i0,2)=true:endif :endif
endif
if a10 then Vm(i0)=vec2( mx7(i0), my7(i0) ):a10=0:endif
end sub
'-------------------------------------------------------------------------------------------------------------------------------------
sub mx_(i0) :mx5(i0)=mouse_x()*600:end sub
sub my_(i0) :my5(i0)=mouse_y()*600:end sub
'
sub keys(): skd_not(116):skd_not(117):skd_not(118):skd_not(119)
  in = InScanKey () :if in<>0 then in5=in :endif
  in$= inkey$() :if in$<>"" then g1=asc(in$) :endif
  if in5>0 then if ScanKeyDown (in5) =0 then in5=0 :endif:endif
  if g1>0 then if keydown(chr$(c(g1)))=0 then g1=0 :endif:endif
end sub
'
sub text(): locate 0,0:
w(090): print "g1:" ;g1 ;" / in5:" ;in5;s$:printr: ':spc(4)
w(900): print "g1 = inkey$() in5 = inscankey() "
'
locate 0,6
w(356): printr "new version:2022,12.8:"
w(990): printr "change 4 different vector_points with:F5,F6,F7,F8"
Locate 0,10
'
if a9(116)=0 then w(777) else w(900):endif:print "F5:vM(1):";vM(1,0);"/";vM(1,1);s$:printr
if a9(117)=0 then w(777) else w(900):endif:print "F6:vM(2):";vM(2,0);"/";vM(2,1);s$:printr
if a9(118)=0 then w(777) else w(900):endif:print "F7:vM(3):";vM(3,0);"/";vM(3,1);s$:printr
if a9(119)=0 then w(777) else w(900):endif:print "F8:vM(4):";vM(4,0);"/";vM(4,1);s$:printr
'
printr
w(759): printr "[vM(1-4)] limits: -360 and 360"
printr:printr:printr:printr
w(r0(999)): printr "use mouse(x) and F5,F6,F7,F8 to change vM(1)-vM(4)"
end sub
'
sub skd_not(i0):if a8(i0)=0 then:if (ScanKeyDown (i0)) then all0(i0):a8(i0)=true:a9(i0)=not(a9(i0)):endif:endif
  if a8(i0) then:if not (ScanKeyDown (i0)) then a8(i0)=0 :endif:endif:end sub
sub all0(i0):if i0>115 and i0<120 then for i=116 to 119:if i<>i0 then a9(i)=0:endif:next:endif:end sub
'-------------------------------------------------------------------------------------------------------------------------------------
m11:
data 126,96,33,49,64,50,35,51,36,52,37,53,94,54,38,55,42,56,40,57,41,48,95,45,43,61,123,91,125,93,124,92,58,59
data 34,39,60,44,62,46,63,47,97,65,98,66,99,67,100,68,101,69,102,70,103,71,104,72,105,73,106,74,107,75,108,76
data 109,77,110,78,111,79,112,80,113,81,114,82,115,83,116,84,117,85,118,86,119,87,120,88,121,89,122,90,-1,-1
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
'for questions or answers write email to :[e-mail]
'PCN4 & Hedgehog :2023
**************************************************************************************************************************************
' 02:
.join diverse projects _ write email with new code_08.txt:
.join diverse projects _ write email with n....txt (5.75 KB)
'
'for guests:
www.mediafire.com/file/hself9wyoca01h5/.Marble_training_08.zip/file
' 2:18 PM 9/10/2022:
www.mediafire.com/file/y0y4f2lms6lajn9/Battle_loderunner_start_09e.zip/file
**************************************************************************************************************************************
  '03:
manual: 
find_all_files and content_30b             '4/29/2022
'-------------------------------------------------------------------------------------------------------------------
a program to find all files and folders in this
particular folder ( where you copy this program :find_all_files and content_30b)
'-------------------------------------------------------------------------------------------------------------------
after starting this program it displays all files in the
particular folder and a end-line :"-------------------------------------"
to indicate that the folder-content is above this line.
'-------------------------------------------------------------------------------------------------------------------
green_lines indicate that this is a folder_file with a file_content,
grey_lines indicate that this is not a folder_file.
'-------------------------------------------------------------------------------------------------------------------
press 'enter' to continue
now in display :how many files for sortation so far found.
'
press again 'enter' to start :sortation (with all files and folders found)
'
this can take many minutes (10000-50000 files)
the new version is 3 times faster in sortation
(to sortate 50000 files took 60min, now only 20min)
'
the program is slow in Basic4Gl and should be written in Assembler.
the PRG is to show the principles and basics about sortation and find_all_files+folders.
'
to find File_size would be a great improvement or accomplishment.
'-------------------------------------------------------------------------------------------------------------------
'5 variables for change (PRG):
dim na$ ="find_all_files and content_30"               'newsest file_name
dim na2$=".test.txt"                                            'destination_file_name (sorted_files)
'
const am =999999                                               'max amount of file
const hmf1=30000                                               'files_max (for every letter(A-Z,0-9,....)
dim folders_and_files=true                                    'find: folders_and_files(=true)...... (or only folders=0)
'-------------------------------------------------------------------------------------------------------------------
when the PRG is finished, a Text can be found in this particular folder (where this PRG is): Test.txt        '(=na2$)
'-------------------------------------------------------------------------------------------------------------------
I encourage to write a different folder-program
and send a copy to :[e-mail]
'-------------------------------------------------------------------------------------------------------------------
PCN_Hedgehog:4.29.2022
'**************************************************************************************************************************************
'**************************************************************************************************************************************
declare sub find_all_files(g$) :declare sub window(x,y) :declare sub m003() :declare sub file_error() :declare sub wait_(a$)
declare function mb(a) :declare sub wait() :declare sub write_file(a$,l) :declare function sa$(i#) :declare sub sortate_strings_to_s5()
declare sub sortate() :declare sub lcase() :declare sub sortate_string_s3():declare function smallest_string$():declare sub sortate_string_s4()
'---------------------------------------------------------------5 variables for change-----------
dim na$ ="find_all_files and content_30b" 'newsest file_name
dim na2$=".test.txt" 'destination_file
'
const am   =999999                'max amount of file
const hmf1=30000                  'files_max (for every letter(A-Z,0-9,....)
dim folders_and_files=true       'find: folders_and_files(=true)...... (or only folders=0)
'-------------------------------------------------------------------------------------------------
dim a1 as integer
dim a1$,a2b$(am),a3$(am)
dim c$(am)
dim e(am),e$(am)
dim e1(am) as integer
dim f$(am)
dim file as integer
dim hmf as integer
dim h$(am)
dim i,ia as integer
dim mf as integer
dim n,n1,n2 as integer
dim wf as integer
:mf=999999:dim s2$(mf),s5$(mf),s3$(mf),ba$
'----------------sub sortate_string_s4()----------------
dim a$,b$,s7$(255,hmf1),s4$(hmf1)
dim s1,s1a,s2,s2a,s8,s7(255),i5,i7,ib
'----------------------------------------------------------
dim i9 ,i9b as integer
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
dim a,i1,i2,i3,i4,cr(10),c4(999,2) '1000 colors
for a=0 to 9:cr(a)=a*28:next'1000 text_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:c4(i,0)=cr(i1):c4(i,1)=cr(i3):c4(i,2)=cr(i4):next'1000 text_colors
sub c(i):color(c4(i,0),c4(i,1),c4(i,2)):end sub'1000 colors wo comma
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
start:window(1900,800) :resizetext(120,60)
'
a1$=""
find_all_files(a1$)
'
a=0:n=0
for i=0 to hmf
    if e(i)>-1 then c(090)
        a2b$(a)=c$(i):
        e1(a)=e(i):
        h$(n)=a2b$(a)+" : "+sa$(e(i)+1):n=n+1 :a=a+1
    else ::if folders_and_files then c(777):h$(n)=c$(i):n=n+1:endif
    endif
    printr a;":";c$(i);" ";e(i)+1
next
'
c(990):printr "-------------------------------------------------------------"
printr "press enter":input a$
'
if a>0 then a1=0
    for ia=0 to a 'inc a
        find_all_files(a2b$(ia)+"/"):
        for i3=0 to hmf:
            f$(i3)=c$(i3):
            if e(i3)>-1 then a=a+1 :c(777):printr n
                e1(a)=e(ia):a2b$(a)=a2b$(ia)+"/"+f$(i3):
                a3$(a)=a2b$(ia)+"/"+f$(i3):
                h$(n)=a2b$(ia)+"/"+f$(i3)+" : "+sa$(e(i3)+1) :n=n+1:n1=n1+1 :'c(900) :printr a2b$(ia)+"/";f$(i3);" : ";sa$(e(i3)+1)
            else ::if folders_and_files then h$(n)=a2b$(ia)+"/"+f$(i3) :n=n+1:n1=n1+1 :endif 'c(777) :printr a2b$(ia)+"/";f$(i3):
            endif :
        next
    next
endif
'
n=n-1
'
for i=0 to n:c$(i)=h$(i):next:hmf=n
c(090):printr"sortate:";n
printr "press enter":input a$
'
sortate()
'
c(900):printr"finished.find '";na2$;"' in this folder"
'
m003()
'
end
'------------------------------------------------------------------------------------------------------------------------------------------------------
sub find_all_files(g$): dim d,a$,a,e$,c1$
    a$=findfirstfile(g$+"*.*"):a=-1:do:a=a+1:d=a+(a>0):c$(d)=findnextfile():loop until c$(d)="":hmf=a-2
'
    for i=0 to hmf:c1$=c$(i)                          'how many files in folder
        a$=findfirstfile(g$+c1$+"/*.*"):a=-1:do:a=a+1:e$=findnextfile():loop until e$="":e(i)=a-2
    next
end sub
'
sub window(x,y) :wf=WindowFullscreen():SetWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true)
:SetWindowTitle("Hedgehogs pink tree : "+na$):SetWindowResizable(true):UpdateWindow():end sub
'
function mb(a):dim m:m=mouse_button(a):return m:end function
'
sub wait():dim i1,i3,w,w1=0:do:i1=mb(0):i3=mb(1):loop until i1 or i3:if i1 then for w=0 to 10000:w1=w1+w:next:endif:end sub
'
sub write_file(a$,l):dim l3,l2,file3,i0:l2=0'write b(0)
    file3 = OpenFileWrite (a$):file_error()
    for i0=1 to l:WriteLine ( file3, h$(n) ) :l2=l2+1:if l2=1000 then l3=l3+1:l2=0:endif :next
    CloseFile (file3)
end sub
'
sub file_error():if FileError () <> "" then :Locate 1,23:print FileError ():endif:end sub
'
sub m003():dim r1
    file = OpenFileWrite (na2$):if FileError () <> "" then print FileError (): end endif
'
    for r1=0 to n : WriteLine (file, sa$(r1)+":"+s5$(r1)) :next 'h$
    WriteLine (file, "-------------------------------------------------------------------")
    WriteLine (file, na$+" :PCN+Hedgehog :April(25) 2022")
    CloseFile (file)
end sub
'
function sa$(i#):dim an$,aa,de$,ac$:an$=str$(i#):aa=len(an$):de$=right$(an$,1)
    if de$ = "." then ac$=left$(an$,aa-1) else ac$=an$:endif: :return ac$:
end function
'*****************************************************************************************************************************************
sub sortate()
    for i=0 to hmf:s2$(i)=c$(i):next     'c$()() to s2$
    lcase()                                          's2$() to s3$()
    sortate_string_s4()                        's3$() to s7$(x,y) to s4$() to s5()
end sub
'
sub sortate_string_s4() : dim a1$,s1$,s2$ 's3$() to s7$(x,y) to s4$() to s5()
    dim ia2 as integer
    for i3=0 to hmf :
        a$=left$(s3$(i3),2):s1=asc(left$(a$,1)):s2=asc(right$(a$,1)):'s1$=(left$(a$,1)):s2$=(right$(a$,1)):a1$=left$(s3$(i3),10):'printr a$;":";a1$;":";s1$;s2$
        s8=s7(s1):
        s7$(s1,s8)=s3$(i3):
        s7(s1)=s7(s1)+1
    next
'
    i2=0
    for s1a=0 to 255
        if s7(s1a)<>0 then
            hmf=s7(s1a)-1
            for ia=0 to hmf :i5=i5+1:ia2=ia2+1:   'if ia=10 then end:endif
                if ia2=100 then ia2=0
                    color(255,0,0):print i5;":";s1a;"/";s7(s1a);"/";ia;":":color (90,90,90):printr s7$(s1a,ia)
                endif
                s4$(ia)=s7$(s1a,ia)
            next
            sortate_strings_to_s5()'s4$() to s5$()
        endif
    next
    i7=i7-1
    color (0,255,0):printr "**********************************************"
end sub
'
sub sortate_strings_to_s5()
    i9=0:i9b=0:c(990)
    for i3=0 to hmf
        b$ = smallest_string$()
        s5$(i7)=b$:i7=i7+1:i9=i9+1:if i9=100 then i9=0:i9b=i9b+1:printr i9b;"00" :endif
    next
end sub
'
sub lcase():for i=0 to hmf:s3$(i)=lcase$(s2$(i)):next:end sub
'
sub sortate_string_s3():dim i3b,i3c as integer
    for i3=0 to hmf:i3b=i3b+1:if i3b=100 then i3b=0:i3c=i3c+1:printr i3c;"00/";n:endif
        ba$ = smallest_string$()
        s5$(i3)=ba$
    next
end sub
'
function smallest_string$():i1=0:dim s9$
    i4=-1:do:i4=i4+1:loop until s4$(i4)<>"zzzz":s9$=s4$(i4)
    i2=0 :for i=0 to hmf :if s4$(i)<s9$ then s9$=s4$(i):i2=i:endif:next
    if i2=0 then s9$=s4$(i4):s4$(i4)="zzzz" else s4$(i2)="zzzz":endif
return s9$
end function
'
sub wait_(a$):do:loop until keydown(a$):end sub
'*****************************************************************************************************************************************
' end of file (4.29.2022)
'
  '04:
'----------------------------------------------------------------------------------------------------------------------
'find 3d-plane_04 hedgehog PCN 8.18.2021, April 2022
'
dim wf
declare sub window(x,y)
window(1000,800)
'
dim a$(10),b$,aa,ac$,a#,c$,b#,c#,a0#,y01#
dim d#,de$
dim p#(2),q#(2),r#(2)
dim txt
dim vPQ#(2),vPR#(2),vE#(2)
dim v01#,v02#,v03#,v04#,v05#,v06#
dim v4$,v5$,v6$
dim x
dim y1#,x1#,z1#,d1#,y#,z
declare sub plus(i,i#) :declare sub ABCD()
'
function sa$(i#):a0#=i#:b$=str$(a0#):aa=len(b$):de$=right$(b$,1)
if de$ = "." then ac$=left$(b$,aa-1) else ac$=b$:endif: :return ac$:
end function
'
function yb#(A#,B#,C#,D#,x,z):v04#=x:v05#=z
v01#=A#*-1 :v02#=C#*-1 :v03#=D#*-1
x1#=x*(v01#/B#) :z1#=z*(v02#/B#) :d1#=v03#/B#
y1#=x1#+z1#+d1#
'
return y1#
end
end function
'-------------------------------------------------------------------------
P#=vec3(1,-2,0):Q#=vec3(3,1,4):R#=vec3(0,-1,2):
ABCD()'a#,b#,c#,d#
'-------------------------------------------------------------------------
resizetext (60,40)
color(200,200,200)
printr "find 3D_plane through any 3 3D_points:"
printr "example: P#(";p#(0);",";p#(1);",";p#(2);") Q#(";q#(0);",";q#(1);",";q#(2);") R#(";r#(0);",";r#(1);",";r#(2);")"
printr "--------------------------------------------------"
printr
plus(2,b#):plus(3,c#):plus(4,d#) :c$= "----->"+sa$(A#)+"x"+a$(2)+sa$(B#)+"y"+a$(3)+sa$(C#)+"z"+a$(4)+sa$(D#)+"=0 "
printr c$
'
x=2:z=5
y#=yb#(A#,b#,c#,d#,x,z)
printr
printr "--------------------------------------------------"
printr "function yb#(A#,B#,C#,D#,x,z):return y1#"
printr
printr "example:x=";x;" z=";z;" "
printr "y#=yb#(";A#;",";b#;",";c#;",";d#;",";x;",";z;")=";y#
printr "point P(";x;"/";y#;"/";z;") is part of plane."
printr "--------------------------------------------------"
printr "my 3D Layout:"
printr "Y"
printr "I"
printr "I"
printr "I"
printr "I"
printr "Z------------>X"
do:loop
'-------------------------------------------------------------------------
sub ABCD() :vPQ#=Q#-P# :vPR#=R#-P# 'vPQ*vPR=v(a1,a2,a3)*v(b1,b2,b3)
A#=vPQ#(1)*vPR#(2)-vPQ#(2)*vPR#(1)'A# ' =(a2b3-a3b2,a3b1-a1b3,a1b2-a2b1)
B#=vPQ#(2)*vPR#(0)-vPQ#(0)*vPR#(2)'B# ' =(A# ,B# ,C# )
C#=vPQ#(0)*vPR#(1)-vPQ#(1)*vPR#(0)'C#
D#=-( A#*P#(0)+B#*P#(1)+C#*P#(2) ) 'D# results from a#,b#,c#
end sub
'
sub plus(i,i#):if i#>0 then a$(i)="+" :endif:end sub
'-------------------------------------------------------------------------
'p(1,-2,0),q(3,1,4),r(0,-1,2) ---->2x-8y+5z-18
'
'vPQ=(3-1,1+2,4-0) vPR=(0-1,-1+2,2-0)
'vPQ=( 2 ,3 ,4) vPR=( -1, 1,2 )
' a1 ,a2 ,a3 b1, b2,b3
'va*vb=(a2b3-a3b2,a3b1-a1b3,a1b2-a2b1)
'va*vb=(6-4 ,-4-4 ,2-3*-1)
'va*vb=(2 ,-8 ,5 ) 'obvious A#,B#,C# (2x-8y+5z-18)
' A# ,B# ,C#
' 2x -8y +5z = 18
'-------------------------------------------------------------------------
sub window(x,y): wf=WindowFullscreen():'x=1920:y=1080'if wf then:x=1920:y=1080:else x=1600:y=1000 :endif
SetWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow()
end sub
'
'find 3d-plane_03 hedgehog PCN 8.18.2021
'----------------------------------------------------------------------------------------------------------------------
 '05:
' best and short cam with ground collision() (v1.1,11.2021)
'
dim a,a$
dim vPQ#(2),vPR#(2),a#,b#,c#,d#,y2#,v01#,v02#,v03#,x1#,z1#,d1#,y1#,dis_y#
dim Q1#(2),P1#(2),R1#(2)
'
dim cam#(2),offset#(2),camYAng#,camXAng#
dim c0,c1,c2,cx,cy as integer
declare sub window(x,y):declare sub cam_int() :declare sub ABCD() :declare function yb#(A#,B#,C#,D#,x#,z#)
window(1800,800)
'
declare sub Move_camera() :declare sub scankey(a1,b1,c1)
P1#=vec3(-30,-50,-10):Q1#=vec3(0,100,40):R1#=vec3(40,0,-10) :abcd() '3D-plane with 3 points
'-------------------------------------------------------------------------------------------------------
resizetext(100,40)
' 'point on plane(camX/Y_plane/camZ)"
'cam():(camX/camY/camZ) 'dis_y#=y2#-cam#(1)
color(255,0,0):locate 0,5:print "use arrow UP,down,left,right and mouse":color(200,200,200):
do
  Move_camera() :cam_int()
  locate 0,1:print "cam#     :";c0;"/";c1;"   ":locate 24,1:print "/";c2;"   "
  y2#=yb#(A#,B#,C#,D#,cam#(0),cam#(2)) 'point on plane (cam above or below plane)
  dis_y#=y2#-cam#(1)
  locate 0,2:print "Y_plane  :";c0;"/";y2#;"  ":locate 24,2:print "/";c2;"  "
  locate 0,3:print "dis_y      :";dis_y#;"  "
  locate 0,7:print "cam_ang_X/Y :";cx;"/";cy;"   "
  a = sgn(dis_y#)
  if a=-1 then a$="below" else a$="above":endif
  locate 0,9:print "camera_point is ";a$;" the plane"
loop
'-------------------------------------------------------------------------------------------------------
sub Move_camera()
  while SyncTimer (10)
    camYAng# =-mouse_x()*720 :camXAng#=-mouse_y()*720 :offset# = vec3(0, 0, 0)
    scankey(VK_LEFT,0,1):scankey(VK_RIGHT,0,-1):scankey(VK_UP,2,1):scankey(VK_DOWN,2,-1)
    cam# = cam# - MatrixRotateY(camYAng#) * MatrixRotateX(camXAng#) * offset# *5
  wend
end sub
'
sub scankey(a1,b1,c1):if ScanKeyDown (a1) then offset#(b1) = offset#(b1) + c1 :endif :end sub
sub window(x,y):SetWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow():end sub
sub cam_int():c0=int(cam#(0)):c1=int(cam#(1)):c2=int(cam#(2)):cx=int(camXAng#):cy=int(camYAng#):end sub
'
sub ABCD() :vPQ#=Q1#-P1# :vPR#=R1#-P1# 'vPQ*vPR=v(a1,a2,a3)*v(b1,b2,b3)
 A#=vPQ#(1)*vPR#(2)-vPQ#(2)*vPR#(1)'A# ' =(a2b3-a3b2,a3b1-a1b3,a1b2-a2b1)
 B#=vPQ#(2)*vPR#(0)-vPQ#(0)*vPR#(2)'B# =(A# ,B# ,C# )
 C#=vPQ#(0)*vPR#(1)-vPQ#(1)*vPR#(0)'C#
 D#=-( A#*P1#(0)+B#*P1#(1)+C#*P1#(2) )'D# results from a#,b#,c#
end sub
'
function yb#(A#,B#,C#,D#,x#,z#):'v04#=x:v05#=z ''ax+by+cz+d=0 ------> y=-ax/b-cz/b-d/b
 v01#=A#*-1 :v02#=C#*-1 :v03#=D#*-1
 x1#=x#*(v01#/B#) :z1#=z#*(v02#/B#) :d1#=v03#/B#
 y1#=x1#+z1#+d1#
 return y1#
end function
'----------------------------------------------------------------------------------------------------------------------
  '06:
'[keys_ez_19c.final]_(v1.5)...hedgehog'PCN___[9/2021]    :setwindowfullscreen(true or false) with key_F9
dim a1,b1,c(255),da,d1(250),fc,fb,fg,g(1),hmk,i,i0,i1,in,is3=50,in5,wf,a09 as integer :dim in$,s$,s2$
dim f0(1,255),f1(1,255),f2(1,255),li(1,255),sp1,a11(99),f99,f01,f97,f(9),f87,f88,f89 as integer :a11(9)=5
declare sub text() :declare sub is_ik(i1,i0,i3,i4) :declare sub txt_f0_f1(y1,a1):declare sub inscan3():declare sub combo() :declare sub inc_dec_a11(i1,i0,i3,i4)
declare sub s2(x):declare sub spc(x):declare sub window(x,y):declare sub wait():declare sub keys()
resizetext(60,30):for i0=0 to 1:for i=0 to 255:li(i0,i)=11:next:next'limit
for i=0 to 255:c(i)=i:next:reset m1:i=0:do:read a1,b1:if a1<>-1 then c(a1)=b1:i=i+1:endif:loop until a1=-1 :hmk=i-1
function skd(i0):i1=ScanKeyDown(i0):return i1:end function :spc(3):s2(27) :window(1800,800)
'----------------------------------------------------------------------------------------------------------------------
do: text():keys():inscan3() :combo()
  is_ik(0,112, 9, 0):is_ik(0,113, 9,12):sp1=a11(9) :is_ik(1,97,11,-20) :is_ik(1,65,11,20)
  is_ik(0,114,10,-30):is_ik(0,115,10,30)'F3,F4
  is_ik(0,120,11,-30):is_ik(0,121,11,30)
'
  if f2(0,120) then wait():f2(0,120)=0:a09=not a09:SetWindowFullscreen(a09):UpdateWindow():endif
loop
'
sub wait():do:keys():loop until g(0)=0 and g(1)=0 :end sub
sub keys(): in = InScanKey ():if in<>0 then g(0)=in:endif :if ScanKeyDown (g(0)) =0 then g(0)=0:endif
      in$= inkey$():if in$<>"" then g(1)=asc(in$):endif :if keydown(chr$(c(g(1))))=0 then g(1)=0:endif: :end sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub is_ik(i1,i0,i3,i4): if f0(i1,i0)=0 then if g(i1)=i0 then f99=i3:f0(i1,i0)=true:f2(i1,i0)=not(f2(i1,i0)):inc_dec_a11(i1,i0,i3,i4):endif:endif:
      if f0(i1,i0) then :if g(i1)=0 then f0(i1,i0)=0:endif:endif:end sub
sub inc_dec_a11(i1,i0,i3,i4):if i4<2 and a11(i3)>i4 then a11(i3)=a11(i3)-1:endif:if i4>0 and a11(i3)<i4 then a11(i3)=a11(i3)+1:endif:end sub
'i1:0 or 1___i0=key_nr__________i3:inc_dec a11(i3)_____i4:limit
sub inscan3():d1(0)=skd(17):d1(1)=skd(16):if (d1(0) or d1(1)) then fc=0:da=-d1(0)-d1(1):for i=2 to is3:fb=-(i<38)*KEYDOWN(chr$(-63*(i<28)-20*(i>27)+i))
      d1(i)=fb-(i>37)*skd(74+i)-(i=50)*skd(9):da=da-d1(i):next:else:if fc=0 then :for i= 2 to is3:d1(i)=0:next:fc=true:da=0:endif:endif:end sub
sub combo():f01= ( d1(0) and d1(1) and d1(49) )'ctrl+shift+F12:switch to new program:f(1)=true
      if f97=0 then :if f01 then :f(1)=not(f(1)):f97=true:endif:endif:if f97 and f01=0 then f97=0:endif :end sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub text()
color (255,0,0) :locate 0,00 :print "keys_ez_19a.fin_(v1.42)...hedgehog'PCN"
color (0,255,255) :locate 0,02 :print "g(0):";g(0);s$
color (255,0,255) :locate 46,02 :print "a11(";f99;"):";a11(f99);s$
locate 0,04 :print "g(1):";g(1);s$
locate 0,06 :print "skd17:";skd(17) ;" skd16:";skd(16);s$
locate 0,07 :print "------------------------------------------------------------"
color (0,255,0) :locate 0,08 :print "sub:is_ik(0,112, 9, 0):"
locate 0,10 :print "0 or 1 :0=inscankey F1-F12 , 1=keydown A-Z,0-9"
color (255,0,0) :locate 0,11 :print "112 :Key_number"
locate 0,12 :print "9 :a11(9) or a11(x)"
locate 0,13 :print "0 :decrease 0 and <2"
locate 0,14 :print "------------------------------------------------------------"
color (0,255,0) :locate 0,29 :print"press F1,F2,F3,F4,A,shift+A,shift+ctrl+Z+X+C"
txt_f0_f1(02,0) :txt_f0_f1(04,1)
'
if da<>0 then:fg=0:locate 0,20 :print "da:";da;":";:locate 10,20: if d1(0) or d1(1) then for i=0 to is3:if d1(i) then print"d1(";i;"):":
endif:next:print s2$:endif:else if fg=0 then clearregion(0,20,60,21):fg=true :endif:endif
'
end sub
'----------------------------------------------------------------------------------------------------------------------
sub txt_f0_f1(y1,a1):color (255,255,0) :locate 15,y1 :print "f0(";a1;",";g(a1);"):";f0(a1,g(a1)) ;s$
      locate 30,y1 :print "f2(";a1;",";g(a1);"):";f2(a1,g(a1)) ;s$:end sub
sub spc(x):for i=1 to x:s$=s$+" ":next:end sub :sub s2(x):for i=1 to x:s2$=s2$+".":next:end sub
sub window(x,y): wf=WindowFullscreen():'x=1920:y=1080'if wf then:x=1920:y=1080:else x=1600:y=1000 :endif
      SetWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow()
end sub
m1:
data 126,96,33,49,64,50,35,51,36,52,37,53,94,54,38,55,42,56,40,57,41,48,95,45,43,61,123,91,125,93,124,92,58,59,34,39,60,44,62,46,63,47,97,65,98,66,99,67,100
data 68,101,69,102,70,103,71,104,72,105,73,106,74,107,75,108,76,109,77,110,78,111,79,112,80,113,81,114,82,115,83,116,84,117,85,118,86,119,87,120,88,121,89,122,90,-1,-1
'----------------------------------------------------------------------------------------------------------------------
'[keys_ez_19c.final]_(v1.5)...hedgehog'PCN___[9/2021]
 '07:
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'smallest keys:10/7/2021 PCN'hedgehog
'
dim g1,in5,in,in$,i,c(255),a1,b1,hmk
for i=0 to 255:c(i)=i:next:reset m11:i=0:do:read a1,b1:if a1<>-1 then c(a1)=b1:i=i+1:endif:loop until a1=-1 :hmk=i-1
'
do
  locate 0,49:print "g1:" ;g1 ;" / in5:" ;in5 ;"       "
  in = InScanKey () :if in<>0 then in5=in :endif
  in$= inkey$() :if in$<>"" then g1=asc(in$) :endif
  if in5>0 then if ScanKeyDown (in5) =0 then in5=0 :endif:endif
  if g1>0 then if keydown(chr$(c(g1)))=0 then g1=0 :endif:endif
loop
'
m11:
data 126,96,33,49,64,50,35,51,36,52,37,53,94,54,38,55,42,56,40,57,41,48,95,45,43,61,123,91,125,93,124,92,58,59
data 34,39,60,44,62,46,63,47,97,65,98,66,99,67,100,68,101,69,102,70,103,71,104,72,105,73,106,74,107,75,108,76
data 109,77,110,78,111,79,112,80,113,81,114,82,115,83,116,84,117,85,118,86,119,87,120,88,121,89,122,90,-1,-1
'*********************************************************************************************************************************************
😉😊  '08:
' july 2021 :found two different and excellent flying-abilities. November 2021:city of pyramids_and kd().10
'
dim cam#(2), camYAng#, camXAng#, offset#(2) :const d=20
dim c0,c1,c2,cx,cy as integer
dim x,y,z,c as integer
dim x#
dim mx1
'
cam#(0) = 135 :cam#(2) = 50 :c=GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT
'
declare sub city_of_pyramids(z1,x1,y1,h1) :declare sub Move_camera():declare sub scankey(a1,b1,c1)
declare sub cam_int():declare sub text()
'
const s1=5
dim a,b ,dl,dr ,f01,b1 ,f02,f03 ,c10,ca,iz as integer
dim a#(2)
declare sub scankey3(s1#,a1$,a2$,b1$,b2$,c1$,c2$)
declare function kd(a$):declare sub spc(i0)
'**********************************************************************************************************
glViewport(0, 0, WindowWidth(), WindowHeight())
'
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
gluPerspective(60, (1*WindowWidth()) / WindowHeight(), .1, 10000000)
'
glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
'
glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
'
textmode(texT_OVERLAID):resizetext(80,40)
'
do: Move_camera() :cam_int()
  glClear (c)
  glLoadIdentity ()
'--------------------------------------------------------------
  glRotatef (-camXAng#, 1, 0, 0) : glRotatef (-camYAng#, 0, 1, 0)
  glTranslatef (-cam#(0), -cam#(1), -cam#(2))
'--------------------------------------------------------------
  city_of_pyramids(20,20,5,1000)
  text()
  drawtext():SwapBuffers ()
'--------------------------------------------------------------
loop
'**********************************************************************************************************
sub spc(i0):for iz=0 to i0:print" ":next:printr:end sub
sub text() :locate 0,0:print "cam#:";c0;"/";c1;"/";c2;" *** cam_ang_X/Y:";cx;"/";cy:spc(3):end sub
'
sub Move_camera()
while SyncTimer (10)
  camYAng# =-mouse_x()*720 :camXAng#=-mouse_y()*720 :offset# = vec3(0, 0, 0)
  scankey(VK_LEFT,0,1):scankey(VK_RIGHT,0,-1):scankey(VK_UP,2,1):scankey(VK_DOWN,2,-1)
  scankey3(5,"Z","X","A","Q","W","S")'5=speed
  cam# = cam# - MatrixRotateY(camYAng#) * MatrixRotateX(camXAng#) * offset# *5
wend
end sub
'
sub city_of_pyramids(z1,x1,y1,h1)
for y = 1 to y1
  for z = 1 to z1
    glPushMatrix ()
    for x = 1 to x1
      glBegin (GL_TRIANGLE_FAN)
       glColor3f (0,.5, 1): glVertex3f ( 0, d, 0)
       glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
       glColor3f (1, 1, 1): glVertex3f ( d,-d, d)
       glColor3f (0, 0, 1): glVertex3f ( d,-d,-d)
       glColor3f (0, 1, 0): glVertex3f (-d,-d,-d)
       glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
      glEnd ()
      glTranslatef (50, 0, 0)
    next
    glPopMatrix ()
    glTranslatef (0, 0, -50)
  next
  glTranslatef (0, h1, 50*z1)
next
end sub
'
function kd(a$):a=asc(a$):ca=keydown(chr$(a)):return ca:end function
'
sub scankey3(s1#,a1$,a2$,b1$,b2$,c1$,c2$):
  f01= ( kd(a1$) or kd(a2$) ) - ( kd(b1$) or kd(b2$) ) - ( kd(c1$) or kd(c2$) ):
  if f01<>0 then a#=vec3(s1#*(kd(a1$)-kd(a2$)),s1#*(kd(b1$)-kd(b2$)),s1#*(kd(c1$)-kd(c2$))):cam#=cam#+a#:else a#=vec3(0,0,0):endif
end sub
'
sub scankey(a1,b1,c1):if ScanKeyDown (a1) then offset#(b1) = offset#(b1) + c1 :endif :end sub
sub cam_int():c0=int(cam#(0)):c1=int(cam#(1)):c2=int(cam#(2)):cx=int(camXAng#):cy=int(camYAng#):end sub
'*********************************************************************************************************************************************
😊  '09:
' Camera demo (Camera_02)
'
' Demonstrates:
' Storing a camera position and direction in a matrix
' Moving the camera around (using a basic aeroplane like mechanism)
' Camera variables
dim camera#(3)(3) ' Camera position and direction
dim speed# ' Camera speed
' Working variables
dim x, y, temp#(3), xaxis#, yaxis#
dim i,f01,d(9) as integer
declare sub pct(i0)
'
' Setup camera
camera# = MatrixTranslate (0, 5, 0)
speed# = 0.05
'
TextMode (TEXT_OVERLAID)
color (200, 200, 255)
print "Use arrow keys to fly camera"
'
' Main loop
pct(0)
while true
  if f01=0 then pct(1):if d(1)>d(0)+5000 then clearregion(0,0,30,0):f01=true:endif:endif
  ' Render frame
  glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)
  '
  ' Render from the camera's viewpoint
  ' Notes:
  ' * The camera stores the position and direction of the
  ' CAMERA relative to the WORLD.
  ' * We want to render the WORLD relative to the CAMERA,
  ' therefore we need to invert the matrix.
  ' * The camera is built from rotations and translations
  ' therefore we can use RTInvert to correctly invert
  ' it.
  glLoadMatrixf (RTInvert (camera#))
'
'  Draw some quads

  for i=0 to 30 step 30
    for x = -20 to 20 step 2
      for y = -20 to 20 step 2
        glPushMatrix ()
        glTranslatef (x * 3, i, y * 3)
        glBegin (GL_QUADS)
          glColor3f ( 1, 0, 0): glVertex2f ( 1, 3)
          glColor3f ( 0, 1, 0): glVertex2f (-1, 3)
          glColor3f ( 0, 0, 1): glVertex2f (-1, 0)
          glColor3f ( 1, 1, 1): glVertex2f ( 1, 0)
       glEnd ()
       glPopMatrix ()
      next
    next
  next
'
  DrawText ()
  SwapBuffers ()
'
' Update the camera position
  while SyncTimer (10)
' Move the camera forward.
' We can do this by noticing that camera# is a rotation and translation matrix.
' Therefore if we split the matrix into columns, we know that the first three
' compose the basis axes of the rotation component.
' To put it in simpler terms:
' camera#(0) = The camera's LEFT vector
' camera#(1) = The camera's UP vector
' camera#(2) = The camera's BACKWARD vector
' We also know that the right hand column vector camera#(3) contains the
' camera's POSITION.
'
' Therefore to move the camera forward, we just need to add the camera's
' FORWARD vector (scaled by the current speed) to the camera's POSITION vector.
' (Note: We can get the camera's FORWARD vector by negating it's BACKWARD vector
' i.e by calculating -camera# (2))
'
    camera# (3) = camera# (3) + -camera# (2) * speed#
'
' Turn the camera
' We do this by multiplying the camera matrix by a rotation matrix.
' The rotation matrix is multiplied on the RIGHT HAND SIDE of the camera matrix.
' Therefore the rotation happens in CAMERA SPACE (i.e relative to the camera).
'
' If we rotate around the Z axis (points out of the screen) the camera will bank
' If we rotate around the X axis (points left) the camera will pitch.
'
    xaxis# = -Mouse_XD () * 30
    yaxis# = Mouse_YD () * 30
    if ScanKeyDown (VK_LEFT) then xaxis# = 1: endif
    if ScanKeyDown (VK_RIGHT) then xaxis# = -1: endif
    if ScanKeyDown (VK_UP) then yaxis# = -1: endif
    if ScanKeyDown (VK_DOWN) then yaxis# = 1: endif
'
    camera# = camera# * MatrixRotateZ (xaxis#) * MatrixRotateX (yaxis#)
'
' Turn the camera
    temp# = camera#(3)
    camera#(3) = vec4 (0, 0, 0, 1)
    camera# = MatrixRotateY (camera# (0)(1)) * camera#
    camera#(3) = temp#
'
' Orthonormalize the camera matrix.
'
' Everytime we multiply the matrix by a rotation, we introduce rounding error.
' This rounding error is insignificant for a reasonable number of transformations.
' However, as we are updating the camera 100 times per second the camera matrix
' will quickly become the result of 1000s of transformations, and eventually the
' rounding error can build up to the point where the matrix collapses or explodes.
'
' Orthonormalize performs a sequence of cross-products and vector normalizations
' to ensure the rotation component of the matrix is orthonormal, and minimize any
' accumulated rounding error.
'
    camera# = Orthonormalize (camera#)
  wend
wend
'
sub pct(i0)(i0)=performancecounter():end sub
'
'Camera_02___7.27.21___PCN
'*********************************************************************************************************************************************
😊   '10:
' doppel-click and mousebutton (v1.2).gb:
'
dim a,cr(10),c4(999,2),d(9,1),d6,f1,i,i0,i1,i2,i3,i4,mb0,mb1,mb2,mb(1),n,f05(1),f06(1),f07(1)
'---------------------------------------------------------------------------------------------------------------------------------------------------
declare sub m(b): declare sub wait(b): declare sub pct(i,i0): declare sub mousebutton() :declare sub c(i) :declare sub text(i1)
'
for a=0 to 9:cr(a)=a*28:next'1000 text_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:c4(i,0)=cr(i1):c4(i,1)=cr(i3):c4(i,2)=cr(i4):next'1000 text_colors
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
start:resizetext(80,40)
do
if f1=0 then locate 0,0:c(990)
  printr "wait(0) :wait for left mouse_button":wait(0)
  printr "wait(1) :wait for right mouse_button":wait(1)
  clearregion (0,0,60,1):f1=true
endif
'------------------------------------------------------------------------------------------
mousebutton()
'------------------------------------------------------------------------------------------
locate 0,2:c(900):
printr "f05(0)/f05(1):";f05(0);"/";f05(1);" "
printr "mb(0)/mb(1):";mb(0);"/";mb(1);" "
'------------------------------------------------------------------------------------------
locate 0, 8:c(909):print "doppel-click mouse_button training: (left or right)"
locate 0,11:c(990):print "msec: (1000 msec=1 sec)"
'------------------------------------------------------------------------------------------
locate 0,30:c(959):print "keep all 3 values less than 100 milli-seconds."
loop
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
sub mousebutton():'m(0):m(1)
for i0=0 to 1 :m(i0)
  if f07(i0)=0 then
  if f06(i0)=0 then: if (mb(i0)) then pct(1,i0):f06(i0)=true:f05(i0)=not(f05(i0)) :endif:endif
  if f06(i0) then:pct(2,i0): if not (mb(i0)) then pct(3,i0):f06(i0)=0 :f07(i0)=true: :endif:endif
else
  if f06(i0)=0 then:pct(6,i0) :if (mb(i0)) then pct(4,i0):f06(i0)=true:f05(i0)=not(f05(i0)) :endif:endif
  if f06(i0) then:pct(5,i0) :if not (mb(i0)) then :f06(i0)=0 :f07(i0)=0 : :endif:endif
endif
'
text(i0*5)
next
end sub
'
sub text(i1):locate 10,12+i1
 c(327):printr "mouse_button(";i0;") "
 c(550):printr d(2,i0)-d(1,i0);" 1st click lenght "
 printr d(6,i0)-d(3,i0);" pause between 2 clicks "
 printr d(5,i0)-d(4,i0);" 2nd click lenght "
end sub
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
sub m(b):mb(b)=mouse_button(b):end sub
sub wait(b):do:m(b):loop until mb(b) :do:m(b):loop until not mb(b):end sub
sub pct(i,i0)(i,i0)=performancecounter():end sub
sub c(i):color(c4(i,0),c4(i,1),c4(i,2)):end sub'1000 colors wo comma
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'hedgehog_PCN_11:50 AM 3/3/2020 :mousebutton_02.04.final
'****************************************************************************************************************************************************
' 😉  '11:
'--------------------------hedgehogs inside polygon v1.6 (8.07_2021)-----------------------------------------------------------------------
dim a#(2,2),a1#,b#(100),c#(3),m#(2),mx#,my#,v#(4,1),smx#,smy#,cb#,v1#(50),cv#(19,2),mxb#
dim f(22),c,f01,f02,f03,f04,f05,f06,f07 ,f08 as integer
dim i,m1,nr,in,in5,in$,g,g2,a(100),b(100),a1,b1,hmk,y as integer
dim f7,f8,f9,mx1,mx2,mx3 as integer
'
declare sub ms() :declare sub move(i0#,i1#,i2#) :declare sub l(x0#,y0#,x1#,y1# ,nr) :declare sub text()
declare sub mouse() :declare sub draw() :declare sub rn() :declare sub keys()
'
function d#(ix#,iy#,x0#,y0#,x1#,y1#):a1#=(iy#-y0#)*(x1#-x0#)-(ix#-x0#)*(y1#-y0#):return a1#:end function
function ran#():cb#=rnd()%21:cb#=cb#/10:cb#=cb#-1:return cb#:end function'-1 to 1
function r#():cb#=rnd()%50:cb#=cb#/100:cb#=cb#+.5:return cb#:end function'.5-1
reset m1:i=0:do:read a1,b1:if a1<>-1 then a(i)=a1:b(i)=b1:i=i+1:endif:loop until a1=-1 :hmk=i-1
for i=0 to 19:v1#(i)=ran#():cv#(i)=vec3(r#(),r#(),r#()):next
'
textmode(texT_OVERLAID):resizetext(80,30) :rn():glClearColor( c#(0),c#(1),c#(2),c#(3) )
v#(0)=vec2(-1,-1):v#(1)=vec2( 1,-1):v#(2)=vec2( 2, 0):v#(3)=vec2( 0, 2):v#(4)=vec2(-2, 0):
smx#=3.5 :smy#=2.5 :c = GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT :y=25:f03=-1
'
resizetext(60,40)
color (255,255,200):printr "move mouse:all 5 corners of polygon.press f1 for next corner."
printr "new structure must look like polygon."
printr "press f1 until: f03=cross."
printr "check if f01=-1 (cross inside polygon)"
'
locate 20,39:print"ground collision"
'
do : keys() : mouse() : glClear (c)
  move(mx#, my#, -10) :glBegin (GL_lines):l(0, -.5 ,0, .5 ,0):l(-.5, 0 ,.5, 0 ,0):glEnd ()
  move(0, 0, -10)
  glBegin (GL_lines): 'polygon
    l(v#(0,0),v#(0,1),v#(1,0),v#(1,1),2) : l(v#(1,0),v#(1,1),v#(2,0),v#(2,1),3)
    l(v#(2,0),v#(2,1),v#(3,0),v#(3,1),4) : l(v#(3,0),v#(3,1),v#(4,0),v#(4,1),5) :l(v#(4,0),v#(4,1),v#(0,0),v#(0,1),6)
  glEnd ()
'
  f01 = (b#(2)>=0) and (b#(3)>=0) and (b#(4)>=0) and (b#(5)>=0) and (b#(6)>=0)
  if f03>-1 then v#(f03)=vec2(mx#,my#) :endif
'
  if f02=0 then :if in5=112 then f02=true:f03=f03+1:if f03=5 then f03=-1:endif :endif:endif
  if f02 then :if in5=0 then f02=0 :endif:endif
'
  glBegin (GL_lines):for i=0 to 15:glcolor3fv(cv#(i)):l(-8+i,-4+v1#(i),-7+i,-4+v1#(i+1),i+7):next:glEnd ()
'
  if mx2<0 then mx2=0:endif:if mx2>15 then mx2=15:endif
  color (255,255,200)
  locate 0,y-1:print "f(";mx2;"):";f(mx2);"     "
  locate 0,y+3:print "f01:";f01;"     "
  locate 0,y+4:print "f02:";f02;"     "
  locate 0,y+5:print "f03=";:if f03=-1 then print "cross" else print f03;"     ":endif
'
  for i=0 to 15:f(i) = (b#(i+7)<=0) :next
  draw()
loop
'
sub keys():text()
  in = InScanKey () :if in<>0 then in5=in :endif :in$= inkey$() :if in$<>"" then g=asc(in$) :endif
  g2=g : for i=0 to hmk:if g=a(i) then g2=b(i):endif:next
  if in5>0 then if ScanKeyDown (in5)=0 then in5=0 :endif:endif:if g>0 then if keydown(chr$(g2))=0 then g=0:endif:endif
end sub
'----------------------------------------------------------------------------------------------------------------------
sub text() :color(255,50,50): locate 0,y :print "in5:";in5 ;"     "
 locate 0,y+1:print "g:" ;g ;"     " :
 locate 0,y+2:print "g2:" ;g2 ;"     "
end sub
'
m1:data 126,96,33,49,64,50,35,51,36,52,37,53,94,54,38,55,42,56,40,57,41,48,95,45,43,61,123,91,125,93,124,92,58,59
data 34,39,60,44,62,46,63,47,97,65,98,66,99,67,100,68,101,69,102,70,103,71,104,72,105,73,106,74,107,75,108,76
data 109,77,110,78,111,79,112,80,113,81,114,82,115,83,116,84,117,85,118,86,119,87,120,88,121,89,122,90,-1,-1
'
sub l(x0#,y0#,x1#,y1# ,nr):
 a#(2)= vec3(m#(0),m#(1),m#(2)):a#(0)= vec3(x0#,y0#,0)+a#(2):a#(1)=vec3(x1#,y1#,0)+a#(2)
 glVertex3fv (a#(0)):glVertex3fv (a#(1)):
 b#(nr) = d#(mx#,my#,x0#,y0#,x1#,y1#)
end sub
'
sub draw():drawtext():SwapBuffers ():end sub
sub move(i0#,i1#,i2#):m#(0)=i0#:m#(1)=i1#:m#(2)=i2#:end sub
sub ms():do:m1=mouse_button(0):loop until m1:do:loop until mouse_button(0)=0:end sub
sub mouse(): mx#=(mouse_x()*11-5)*smx# :my#=-(mouse_y()*11-5)*smy# :mx2=int(mx#)+8:end sub
sub rn():for i=0 to 3:c#(i)=rnd()%40/100.0:next:end sub
'---------------------------------------------------------------------------------------------------------------------------------------
'hedgehogs inside polygon v1.6 (8.07_2021)
'*********************************************************************************************************
😊  '12:
'gosub when mouse is moving (v1.0)    .Hedgehog        .7.26.2021
'
const max=1000
dim c,d(10),l,n(max) as integer
dim mx0#,my0#,mx1#,my1#
dim f01,l1,l2,i as integer
'-------------------------------------------------------------------------------
declare sub mouse() :declare sub pct(i0) :declare sub text()
'--------------------------------------------------------------------------------------------------------------------------------------------------
c = GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT
textmode(texT_OVERLAID):resizetext(40,50)
locate 10,5:print "some subs and gosubs only"
locate 10,6:print "when mouse moves"
locate 10,20:print "move mouse in any direction"
locate 10,21:print "watch variables l,l1,l2"
'--------------------------------------------------------------------------------------------------------------------------------------------------
do: glClear (c)
 mouse()
'
 pct(0) :if f01=0 then :f01=true:pct(1):endif
 pct(2)
 if d(2)>d(1)+100 then f01=0
  l1=l1+1:if l1>max then l1=0:endif
  n(l1)=l :l=0
 endif
'
 text()
'
 if l1<30 then locate 0,7:print l1;"/29 ":endif
 if l1>29 then
  for i=30 to 0 step -1
   locate 0,7+i:print "n(";l1-i;"):";n(l1-i);" "
  next
 endif
'--------------------------------------------------------
 drawtext():SwapBuffers ()
loop
'*********************************************************************************************************
sub mouse():mx1#=mouse_x()*11-5 :my1#=mouse_y()*11-5
 if mx1#>mx0# or mx1#<mx0# or my1#>my0# or my1#<my0# then l=l+1:l2=l2+1endif
 mx0#=mouse_x()*11-5 :my0#=mouse_y()*11-5 :
end sub 'my,my
sub pct(i0)(i0)=performancecounter():end sub
sub text():locate 0,0:
 printr "mx/my:";mx0#;"/";my0#;"   "
 printr "pct(0):";d(0);"   "
 printr "l:";l;"   "
 printr "l1:";l1;"   "
 printr "l2:";l2;"   "
end sub
'*********************************************************************************************************
'😊 '13:
' PB03 , Starfield0
' Written by Scott Brosious
'
const Width = 320, Height = 200
const pixels = 1000 ' Number of pixels
const maxlenght = 20
'
dim X3D(pixels)(2)
dim Y3D(pixels)(2)
dim Z3D#(pixels)(2)
dim X2D#(pixels)(2)
dim Y2D#(pixels)(2)
dim X,Y,Z
dim i,j
dim lenght
dim intensity#
'
' Initialize
for i = 0 to pixels
 X = int(rnd() % (width + 1) - (width /2))
 Y = int(rnd() % (height + 1) - (height /2))
 Z = int(rnd() % 200)
 lenght = int(rnd() % maxlenght) + 1
 X3D(i)(0) = X
 Y3D(i)(0) = Y
 Z3D#(i)(0) = Z + lenght
 X3D(i)(1) = X
 Y3D(i)(1) = Y
 Z3D#(i)(1) = Z
next
'
' Set 2D mode
glMatrixMode (GL_PROJECTION)
glLoadIdentity ()
glOrtho (0, Width, 0, Height, -1, 1)
glMatrixMode (GL_MODELVIEW)
glDisable (GL_DEPTH_TEST)
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
glEnable (GL_BLEND)
glEnable (GL_LINE_SMOOTH)
glLineWidth(2)
'
while true
'
glClear (GL_COLOR_BUFFER_BIT) ' Clear screen
'
' Plot some pixels
glBegin (GL_LINES)
 for i = 0 to pixels
  X2D#(i)(0) = ((X3D(i)(0) * 256) / (256 - Z3D#(i)(0))) + (Width / 2)
  Y2D#(i)(0) = (((Height / 2)- Y3D(i)(0) * 256) / (256 - Z3D#(i)(0))) + (Height / 2)
  X2D#(i)(1) = ((X3D(i)(1) * 256) / (256 - Z3D#(i)(1))) + (Width / 2)
  Y2D#(i)(1) = (((Height / 2)- Y3D(i)(1) * 256) / (256 - Z3D#(i)(1))) + (Height / 2)
  intensity# = Z3D#(i)(0) / 240
  glColor4f (1, 1, 1 , intensity# )
  glVertex2f (X2D#(i)(0), Y2D#(i)(0))
  glColor4f (1, 1, 1 , .1)
  glVertex2f (X2D#(i)(1), Y2D#(i)(1))
 next
glEnd ()
'
SwapBuffers () ' Display output
'
for i = 0 to pixels
 Z3D#(i)(0) = Z3D#(i)(0) + 1
 Z3D#(i)(1) = Z3D#(i)(1) + 1
'
 if Z3D#(i)(1) > 254 - maxlenght then gosub Refresh endif
 if Z3D#(i)(1) > 254 - maxlenght then X3D(i)(1) = X3D(i)(0): Y3D(i)(1) = Y3D(i)(0) endif
 if Z3D#(i)(1) > 254 - maxlenght then Z3D#(i)(1) = 0: endif
next
'
wend
'
Refresh:
X = int(rnd() % (width + 1) - (width /2))
Y = int(rnd() % (height + 1) - (height /2))
X3D(i)(0) = X
Y3D(i)(0) = Y
lenght = int(rnd() % maxlenght) + 1
Z3D#(i)(0) = lenght
return
'*********************************************************************************************************
  '14:     
' Star field demo 1     (Written by Scott Brosious)
' This is also a bit of a tutorial on OpenGL and how Basic4GL does things.
'
const maxStars = 200
dim stars#(maxStars)(2)
'
' Note: An array of maxStars 3D vectors.
' The # after it means floating point. Otherwise it would store integers (the default in Basic4GL)
'
dim i   ' ALL variables must be declared before use, with DIM
'
' Populate star field:
for i = 1 to maxStars
 stars#(i) = vec3 (rnd () % 201 - 100, rnd () % 201 - 100, -i)
 ' Vec3 creates a 3D vector. Parameters are X, Y and Z
 ' Rnd() returns a number between 0 and MAXINT (MAXINT = about 2 billion),
 ' So we use the % (mod) operator to convert it to a number between 0 and 200.
 '
 ' We have to setup our vectors with respect to the coordinate system.
 ' In OpenGL, the coordinate system says that:
 ' X = How many units to the RIGHT.
 ' Y = How many units UP.
 ' Z = How many units OUT OF THE SCREEN.
 '
 ' So because we want our stars to appear INTO the screen, we have to use a
 ' NEGATIVE Z value.
next
'
glDisable (GL_DEPTH_TEST)
'
' This disables the Z buffer.
' (The Z buffer automatically determines which pixels are infront of the other ones.
' We don't need it for a star field though.)
'
' Main loop:
while true
glClear (GL_COLOR_BUFFER_BIT) ' This clears the screen.
' The "colour buffer" refers to the actual image that we are going to draw.
' There are other buffers (like the Z buffer) that we could clear also if we
' were using them. But we're not
'
for i = 1 to maxStars
 ' Move the star forward, by adding 1 to Z
 stars#(i) = stars#(i) + vec3 (0, 0, 1)
 ' If the Z goes positive (infront of the screen), move it to the back again.
 if stars#(i)(2) >= 0 then stars#(i)(2) = -maxStars endif
 ' Note: All "if" statements must have an "endif", even if they are
 ' only on 1 line.
 ' Draw the star.
 ' In OpenGL you don't actually access the pixels directly.
 ' Instead you pass 3D data into OpenGL. It will do the 3D maths for you
 ' and draw the appropriate image on the screen.
 ' You place the 3D data between a glBegin() and a glEnd().
 ' We want it to plot points (each point is a star), so we pass GL_POINTS
 ' to glBegin ()
 glBegin (GL_POINTS)
  glVertex3fv (stars#(i))
  ' This is a form of the glVertex command.
  ' The last 3 characters give us information about this particular
  ' version.
  ' 3 = Takes a 3D vector
  ' F = Floating point values
  ' V = Vector is passed in as an array
  glEnd ()
next
'
SwapBuffers ()
'
' Basic4GL uses "double buffered" mode.
' All drawing happens in the off-screen buffer.
' When we're finished, we "swap" it to the onscreen buffer by calling SwapBuffers()
'
WaitTimer (20)
' Wait timer slows us down. Parameter is the interval.
' Note: Frames per second (FPS) = 1000 / Interval
'
' So 1000 / 20 = 50 frames per second
wend
'
'*********************************************************************************************************
   '15:  
' Star field demo 2           (Written by Scott Brosious)
'
' Varying star's brightness by explicitly setting the colour
'
' This demo is based on the source code from the previous one.
' I've removed most of the explanation comments from the previous demo,
' and just commented the new pieces.
' * I've upped the number of stars, and doubled the movement speed also
'
const maxStars = 1000
'
dim stars#(maxStars)(2)
dim i, intensity#
'
' Populate star field
for i = 1 to maxStars
    stars#(i) = vec3 (rnd () % 401 - 200, rnd () % 401 - 200, -i)
next
'
glDisable (GL_DEPTH_TEST)
'
' Main loop
while true
glClear (GL_COLOR_BUFFER_BIT)
for i = 1 to maxStars
 ' Move the star forward, by adding 1 to Z
 stars#(i) = stars#(i) + vec3 (0, 0, 2)
 ' If the Z goes positive (behind the screen), move it to the back again.
 if stars#(i)(2) >= 0 then stars#(i)(2) = -maxStars endif
 ' Calculate the star's intensity.
 ' We want this to come out as a value between 0 and 1.
 ' So the furthest away stars have intensity 0, and the closest have 1.
 intensity# = (stars#(i)(2) + maxStars) / maxStars
 glBegin (GL_POINTS)
  glColor3f (intensity#, intensity#, intensity#)   ' Set the star's colour
  ' This is a form of the glColor command.
  ' The last 2 characters tell us:
  ' 3 = Takes a 3D vector
  ' F = Floating point values
  ' 3 parameters are: Red component, Blue component, Green component
  glVertex3fv (stars#(i))
 glEnd ()
next
'
SwapBuffers ()
WaitTimer (20)
wend
'*********************************************************************************************************
   '16:
' Star field demo 3:        (Written by Scott Brosious)
' Varying star's brightness using OpenGL fog
'
const maxStars = 1000
dim stars#(maxStars)(2)
dim i
'
for i = 1 to maxStars     ' Populate star field
      stars#(i) = vec3 (rnd () % 401 - 200, rnd () % 401 - 200, -i)
next
'
glDisable (GL_DEPTH_TEST)
'
' Setup OpenGL fog.
' This instructs OpenGL to fog out objects that are in the distance, by
' gradually changing their colour to the fog colour. We will use black.
' Once fog is setup it is all automatic. We don't need to worry about setting
' the star's colours.
'
glEnable (GL_FOG)
glFogi (GL_FOG_MODE, GL_LINEAR) ' Objects fade out linearly
glFogf (GL_FOG_END, maxStars) ' Objects past this distance are totally faded
glFogf (GL_FOG_START, 0) ' Objects before this distance are totally un-faded
glFogfv (GL_FOG_COLOR, vec3 (0, 0, 0)) ' Fog colour = black
'
' Note:
' These are all versions of the glFog command.
' glFogi takes an integer parameter (i = integer)
' glFogf takes a floating point parameter (f = float)
' glFogfv takes a floating point array parameter (f = float, v = array)
'
' Main loop
while true
glClear (GL_COLOR_BUFFER_BIT)
for i = 1 to maxStars
 ' Move the star forward, by adding 1 to Z
 stars#(i) = stars#(i) + vec3 (0, 0, 2)
 ' If the Z goes positive (behind the screen), move it to the back again.
 if stars#(i)(2) >= 0 then stars#(i)(2) = -maxStars endif
 glBegin (GL_POINTS)
  glVertex3fv (stars#(i))
 glEnd ()
next
SwapBuffers ()
WaitTimer (20)
wend
'*********************************************************************************************************
   '17:
' Fly different_03:
'
const gridxsize = 20, gridysize = 20
const spacing# = 20
const turnSpeed# = 1, accell# = 0.02
'
' Data types
struc SPlayer
  dim pos#(3)(3) ' Current position and direction
  dim speed# ' Speee
endstruc
'
dim h#(gridxsize)(gridysize)   ' Terrain heightmap
dim SPlayer player    ' Player position
'
dim light#(3): light# = Normalize (vec4 (0, 20, 0, 1))  ' Other info
dim x, y, turnx#, turny#, temp#(4)(3), normal#(3), i#, t#(3)   ' Working variables
'
' Make a terrain
'
for y = 0 to gridysize
 for x = 0 to gridxsize
  h#(x)(y) = rnd() % 10 - 5
 next
next
'
' Setup player
player.pos# = MatrixRotateX (-45)
player.pos# (3) = vec4 (gridXSize * spacing# / 2, 200, gridYSize * spacing# / 2, 1)
'
' Setup OpenGL
glEnable(GL_LIGHT1) ' Enable Light One
' Main loop
while true
 gosub Render
 updatejoystick()
 while SyncTimer (10): gosub Update: wend
wend
'
end
'
Render:
glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)   ' Clear screen
glLoadMatrixf (RTInvert (player.pos#))   ' Setup camera position
'
for y = 0 to gridYSize - 1    ' Draw terrain map
 for x = 0 to gridXSize - 1
  temp#(1) = vec4 (x * spacing#, h#(x)(y), y * spacing#, 1)
  temp#(2) = vec4 (x * spacing# + spacing#, h#(x + 1)(y), y * spacing#, 1)
  temp#(3) = vec4 (x * spacing# + spacing#, h#(x + 1)(y + 1), y * spacing# + spacing#, 1)
  temp#(4) = vec4 (x * spacing#, h#(x)(y + 1), y * spacing# + spacing#, 1)
  normal# = -Normalize (CrossProduct (temp#(2) - temp#(1), temp#(4) - temp#(1)))
  i# = light# * normal#
  i# = i# * i# * i# * i#
  if i# < .2 then i# = .2 endif
  glColor3f (i#, i#, i#)
  glBegin (GL_TRIANGLE_FAN)
   glVertex3fv (temp#(1)): glVertex3fv (temp#(2)): glVertex3fv (temp#(3)): glVertex3fv (temp#(4))
  glEnd ()
 next
next
'
SwapBuffers ()
return
'
Update:
turnx# = joy_x()*0.00003: turny# = joy_y()*0.00003
if ScanKeyDown (VK_LEFT)    then turnx# = turnx# - turnSpeed# :endif
if ScanKeyDown (VK_RIGHT) then turnx# = turnx# + turnSpeed# :endif
if ScanKeyDown (VK_UP)       then turny# = turny# - turnSpeed#  :endif
if ScanKeyDown (VK_DOWN) then turny# = turny# + turnSpeed# :endif
'
if KEYDOWN ("A") then player.speed# = player.speed# + accell# :endif
if KEYDOWN ("Z") then player.speed# = player.speed# - accell#  :endif
'
player.pos# = player.pos# * MatrixRotateX (turny#) * MatrixRotateZ (-turnx#)
t# = player.pos# (3)
player.pos# = MatrixRotateY (player.pos# (0)(1) * .5) * player.pos#
player.pos# (3) = t#
player.pos# (3) = player.pos# (3) - player.pos#(2) * player.speed#
return
'*********************************************************************************************************
   '18:
'matrix_02.final:09.27.21, hedgehog'PCN
'
const d=1:dim a#, b# :declare sub quads():declare sub fan() :dim x, y,c as integer
c = 256 or 16384 'glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)
'
while true
glClear (c)
glLoadIdentity ()
glTranslatef (0, 0, -16)
glRotatef (a#, 0, 0, 1)
for y= -5 to 5:
 for x =-5 to 5
  glPushMatrix ()
  glTranslatef (x * 3, y * 3, 0)
  glRotatef ((x + y) * 60 + b#, 1, 0, 0)
  fan()
  glPopMatrix ()
 Next
Next
'
SwapBuffers ()
while SyncTimer (10) :a# = a# + 0.9: b#=b# + 3.6 :wend
wend
'
sub quads()
 glBegin (GL_QUADS)
  glColor3f (1, 0, 0): glVertex2f ( 1, 1)
  glColor3f (0, 1, 0): glVertex2f (-1, 1)
  glColor3f (0, 0, 1): glVertex2f (-1,-1)
  glColor3f (1, 1, 1): glVertex2f ( 1,-1)
 glEnd ()
end sub
'
sub fan()
glBegin (GL_TRIANGLE_FAN)
 glColor3f (0,.5, 1): glVertex3f ( 0, d, 0)
 glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
 glColor3f (1, 1, 1): glVertex3f ( d,-d, d)
 glColor3f (0, 0, 1): glVertex3f ( d,-d,-d)
 glColor3f (0, 1, 0): glVertex3f (-d,-d,-d)
 glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
glEnd ()
end sub
'******************************************************************************************************************************************
   '19:
'matrix_03.final:09.27.21, hedgehog_PCN
'
const d=1:dim a#, b# :declare sub fan() :dim x, y,c as integer
dim camY#,camX#
'
c = 256 or 16384 'glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)
'
while true
camx# =-mouse_x()*720 :camY#=-mouse_y()*720
glClear (c)
glLoadIdentity ()
glTranslatef (0, 0, -16)
'
for y= -5 to 5:
 for x =-5 to 5
  glPushMatrix ()
  glTranslatef (x * 3, y * 3, 0)
  glRotatef ((camX#), 0, 1, 0)
  glRotatef ((camy#), 0, 0, 1)
  fan()
 glPopMatrix ()
 Next
Next
'
SwapBuffers ()
while SyncTimer (10) :a# = a# + 0.9: b#=b# + 3.6 :wend
wend
'
sub fan()
glBegin (GL_TRIANGLE_FAN)
 glColor3f (0,.5, 1): glVertex3f ( 0, d, 0)
 glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
 glColor3f (1, 1, 1): glVertex3f ( d,-d, d)
 glColor3f (0, 0, 1): glVertex3f ( d,-d,-d)
 glColor3f (0, 1, 0): glVertex3f (-d,-d,-d)
 glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
glEnd ()
end sub
'******************************************************************************************************************************************
   '20:
'matrix_05:09.27.21, hedgehog'PCN
'
const d=1:dim a#, b# :dim x, y,c as integer :dim mY#,mX#,rtri#,rquad#
declare sub draw(i0,x1,y1) :declare sub fan1() :declare sub quads1() :declare sub triangles()
c=GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
'
do
 glClear(c)
 glLoadIdentity()
 glTranslatef(0,0.0,-6.0)
 glRotatef(rtri#,0.0,1.0,0.0)
 triangles()
'--------------------------------------------------------------------------------------------------------------------
 glLoadIdentity()
 glTranslatef(1.5,0.0,-6.0)
 glRotatef(rquad#,1.0,1.0,0.0)
 quads1()
'--------------------------------------------------------------------------------------------------------------------
 rtri# = rtri# + 0.2 :rquad# = rquad# - 0.15
 draw(0,-3,1) '0=quads
 draw(1,-3,-2) '1=fan
'--------------------------------------------------------------------------------------------------------------------
 SwapBuffers ()
loop
'
sub draw(i0,x1,y1)
 mx# =-mouse_x()*720 :my#=-mouse_y()*720
 glLoadIdentity ()
 glTranslatef (0, 0, -16)
 for y= y1 to y1+1:
  for x =x1 to x1+1
   glPushMatrix ()
   glTranslatef (x * 3, y * 3, 0)
   glRotatef ((mX#), 0, 1, 0)
   glRotatef ((my#), 0, 0, 1)
   if i0=0 then quads1() :endif
   if i0=1 then fan1() :endif
   glPopMatrix ()
  next
 next
end sub
'
sub fan1()
glBegin (GL_TRIANGLE_FAN)
 glColor3f (0,.5, 1): glVertex3f ( 0, d, 0)
 glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
 glColor3f (1, 1, 1): glVertex3f ( d,-d, d)
 glColor3f (0, 0, 1): glVertex3f ( d,-d,-d)
 glColor3f (0, 1, 0): glVertex3f (-d,-d,-d)
 glColor3f (1, 0, 0): glVertex3f (-d,-d, d)
 glEnd ()
end sub
'
sub quads1()
glBegin(GL_QUADS)
 glColor3f(0.0,1.0,0.0) :
 glVertex3f( 1.0, 1.0,-1.0)
 glVertex3f(-1.0, 1.0,-1.0)
 glVertex3f(-1.0, 1.0, 1.0)
 glVertex3f( 1.0, 1.0, 1.0)
'
 glColor3f(1.0,0.5,0.0)
 glVertex3f( 1.0,-1.0, 1.0)
 glVertex3f(-1.0,-1.0, 1.0)
 glVertex3f(-1.0,-1.0,-1.0)
 glVertex3f( 1.0,-1.0,-1.0)
'
 glColor3f(1.0,0.0,0.0)
 glVertex3f( 1.0, 1.0, 1.0)
 glVertex3f(-1.0, 1.0, 1.0)
 glVertex3f(-1.0,-1.0, 1.0)
 glVertex3f( 1.0,-1.0, 1.0)
'
 glColor3f(1.0,1.0,0.0)
 glVertex3f( 1.0,-1.0,-1.0)
 glVertex3f(-1.0,-1.0,-1.0)
 glVertex3f(-1.0, 1.0,-1.0)
 glVertex3f( 1.0, 1.0,-1.0)
'
 glColor3f(0.0,0.0,1.0)
 glVertex3f(-1.0, 1.0, 1.0)
 glVertex3f(-1.0, 1.0,-1.0)
 glVertex3f(-1.0,-1.0,-1.0)
 glVertex3f(-1.0,-1.0, 1.0)
'
 glColor3f(1.0,0.0,1.0)
 glVertex3f( 1.0, 1.0,-1.0)
 glVertex3f( 1.0, 1.0, 1.0)
 glVertex3f( 1.0,-1.0, 1.0)
 glVertex3f( 1.0,-1.0,-1.0)
glEnd()
end sub
'
sub triangles()
glBegin(GL_TRIANGLES)
 glColor3f(1.0,0.0,0.0) :glVertex3f( 0.0, 1.0, 0.0)
 glColor3f(0.0,1.0,0.0) :glVertex3f(-1.0,-1.0, 1.0)
 glColor3f(0.0,0.0,1.0) :glVertex3f( 1.0,-1.0, 1.0)
 glColor3f(1.0,0.0,0.0) :glVertex3f( 0.0, 1.0, 0.0)
 glColor3f(0.0,0.0,1.0) :glVertex3f( 1.0,-1.0, 1.0)
 glColor3f(0.0,1.0,0.0) :glVertex3f( 1.0,-1.0, -1.0)
 glColor3f(1.0,0.0,0.0) :glVertex3f( 0.0, 1.0, 0.0)
'
 glColor3f(0.0,1.0,0.0) :glVertex3f( 1.0,-1.0, -1.0)
 glColor3f(0.0,0.0,1.0) :glVertex3f(-1.0,-1.0, -1.0)
 glColor3f(1.0,0.0,0.0) :glVertex3f( 0.0, 1.0, 0.0)
 glColor3f(0.0,0.0,1.0) :glVertex3f(-1.0,-1.0,-1.0)
 glColor3f(0.0,1.0,0.0) :glVertex3f(-1.0,-1.0, 1.0)
glEnd()
end sub
'******************************************************************************************************************************************
'    '21:
'rotate and vectortext .PB.02   'Proboards_version :last correcture:     4.12pm , 6.2.22
manual:01) press F3 for Text-menue
            02) look at all 10 boxes from a distance and freeze camera (F6)
            03) choose which box to rotate:press 0-9 (above Alphabet)
            04) rotate :press 1-3  (right of Alphabet and arrows: 1X ,  2Y  ,  3Z ) 
                             use mouse_x to rotate chosen box
'----------------------------------------------------------
'pre-dim...******************************************************************************************************************
dim sp0:reset m5:read sp0:dim sp#(sp0)
dim v3=57'vertex-amount
dim v2=45'letter_amount
dim s_amount=20
dim object=9'points
'******************************************************************************************************************
'a
dim a,a1,a2,a5=43,a3(a5),a4,a6=a5,a7(127),aa(s_amount,1000),ab(v2,10)
dim a00,a01,a02,a03,a04,a05,a06,a08,a09,a11(200),a12(200),a14,a15,a16,a17#,a18#,a20#(object,2),a22(1000,20),a23,a24,a25#
dim a26#,a27#,a28,a29,a30,a31,a33
dim a#(19,2),a1#,a14#,a15#
dim a$(100),a1$,a2$(1000)
dim alph#,alpha1#,alpha2#,alpha3#
'b
dim b,b1,b2,b3,b4,b5,b21,b22(255),b23
dim beta#,beta1#,beta2#,beta3#,bet#
dim b$,b1$(1000),b2$,b4$,b5$,b6$,b7$,b8$,b9$,ba$,bb$,b10$
'c
dim c,c1,c2,c3,c4(999,2)
dim c01#
dim camX#,camY#,camZ#,cr(10),co(v2),ci(95),cs(43)
dim c$
'd
dim d,d3,d4,d9,d10,d11,d12,d13,d14,d15
dim d#
dim dg1,dg2,dg3,db,db2
dim d9$,d10$
'e
dim e0
'f
dim file,f1,fb,fd,file2
dim f00,f01,f02,f03,f04,f05,f06,f07,f08,f09,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19,f20,f21,f22,f23,f24,f25
dim f26,f27,f28,f29,f30,f31,f32,f33,f34,f35,f36,f37,f38,f39,f40,f41,f42,f43,f45(10),f46(10),f47,f48,f49,f50
dim f51,f52,f55,f56,f60,f70,f71,f72
dim f75(50),f80(50),f81,f90(200),f91,f92(127),f93
dim f100,f101
'
dim g
dim hy#,hy1#,hy2#,hy3#
'i
dim i,i0,i1,i2,i3,i4,i5,i8,i9,ia,ib,i10,i11,i22
dim i#,i0#,i7#(5),i10#
dim in3$(20),in,in0,in4,in5,in6
dim in1$,i$,in$,i1$,i2$,i3$(100,10,2),i4$(100,10),i5$(100),i6$,i7$,i8$
'k
dim k2,k3
'l
dim l3=2000,l0(v2,v3),ln
'm
dim m,m0,m1,m2,m3
dim mouse,mx#,my#,mb0,mb1,mx1,my1
'p
dim p1,p2,pa=9
'q
dim q0,q1(100)
'r
dim rtx,rty
's
dim sp1,st,stp4=36,stp=1,size,sc#
dim st$
't
dim texture1,texture2
dim t1(100),t2,t7,t3(50),t4
'v
dim v1,vd
dim vertex#(12)(2),ver1#(2),ver2#(2),ver11#(2),ver21#(2),ver3#(2),ver4#(2),v#(10,3),ver5#(2)
dim ver#(v3+1,1,2),ver6#(2),ver7#(2),ver8#(3,2)
'w
dim wl(s_amount)
'x
dim x0,x1,x2,x3,x4,x5,x40#,x60#,x41#(2),x61#(2)
dim x#,x0#,x1#,x6#,x7#,x8#,x9#,x10#,x11#
dim xy,xa1 'xa#(stp4),xb#(stp4),
dim x2#,x3#,x4#
dim xy$
'y
dim y0,y1,y2,y3,y4,y5,y40#,y60#,y41#(2),y61#(2)
dim y#,y0#,y1#,y2#,y3#,y6#,y7#,y8#,y9#,y10#,y11#
'z
dim z0,z2,z3,z4,z5,z60#,z40#,z61#(2),z41#(2)
dim z#,z0#,z1#,z2#,z3#,z4#,z6#,z7#,z8#,z9#,z10#,z11#
dim za#(stp4),zb#(stp4)
'
'n
dim n0=25,n$(30),ct,t6(n0,n0,n0),tl0,tl1,tl2,tl3,tl4,x,y,z
dim a10(100,1),a45,b10,a21(127),f64,g1'inkey$
dim f44,f74,g2
dim xc#,yc#,zc#,a0,b0
dim x50(10,11000),y50(10,11000),z50(10,11000)
'
dim x30#(100),y30#(100),z30#(100)
dim ctrl,shift,tab
dim a000,a001,a002,a003,a004,a005,a006,a100
dim d1(50)
'******************************************************************************************************************
Function mb(m):mb0=mouse_button(m):return mb0:End Function
'
Function r1(min,max):Return rnd()% (max - min + 1) + min:End Function
Function t(i0#,i1,i2):a=(i0#+i1)/i2:Return a:End Function
declare sub col(i0,i1,i2)
declare sub co3(i)
declare sub vec_draw3(sen,lsize#,lcol,distx#,width,x,y,z)
declare sub draw_box(i,x#,y#,z#)
'
reset m12:for a=0 to a5 :read a3(a):a7(a3(a))=a :next
declare sub inkey2():declare sub ink()
declare sub inscan2():declare sub ins()
declare sub inscan3()
declare sub j(i)
declare sub m100(i9)
declare sub file_error()
'
e0=-1:for i= 97 to 122:j(i):next:for i= 48 to 64:j(i):next:for i= 65 to 96:j(i):next:for i=123 to 126:j(i):next:for i= 32 to 47:j(i):next:j(13)
sub j(i):e0=e0+1:a11(e0)=i:a12(i)=e0:end sub
'
declare sub draw_box4(tn,size,x2,y2,z2)
declare sub vec_quad(nr,d#):declare sub vec_quad2(nr,d#) :declare sub vec_quad3(nr,d#)
declare sub compute_point(pc,x3#,y3#,z3#,x0#,y0#,z0#)
declare sub draw_basic_circle3(r)
declare sub draw_line30()
declare sub draw_basic_circle4(r)
declare sub c0(i0)
declare sub line1(co,x,y,z)
declare sub draw_point2(pc,x1#,y1#,z1#,x0#,y0#,z0#)
declare sub draw_point3(pc,hy2#,alpha2#,alpha1#,x0#,y0#,z0#)
'
declare sub draw_box5(c,i0,wb)
declare sub rotate_x(alpha4#,x0#,y0#,z0#)
declare sub rotate_y(alpha5#,x0#,y0#,z0#)
declare sub rotate_z(alpha6#,x0#,y0#,z0#,vo() as single)
declare sub draw_rotate_z(co,vo() as single)
'draw_rotate_z(co,vo() as single)
'************************************************************************
'declare sub g75()
function m_x() :if a15=0 then m0=mouse_x()*358+1 else m0=mouse_x()*361 :endif:return m0:end function
function m_x1():m1=mouse_x()*09000-4500 :return m1:end function
function m_x2():m2=mouse_x()*10000-5000 :return m2:end function
function m_x3():m3=mouse_x()*11000-5500 :return m3:end function
' (x - x1 )*(z2 - z1 )/(x2 - x1 ) + z1
' (z - z1 )*(y2 - y1 )/(z2 - z1 ) + y1
function lz(x#,x40#,z40#,x60#,z60#):z#=(x# - x40#)*(z60# - z40#)/(x60# - x40#) + z40#:return z#:end function
function ly(z#,y40#,z40#,y60#,z60#):y#=(z# - z40#)*(y60# - y40#)/(z60# - z40#) + y40#:return y#:end function
function lx(y#,x40#,y40#,x60#,y60#):x#=(y# - y40#)*(x60# - x40#)/(y60# - y40#) + x40#:return x#:end function
'
function inkey(g10) :return -(g>0)*(g=g10):end function
function inscan(g11):return -(b21>0)*(b21=g11):end function
'
declare sub draw1(ln,co,x40#,y40#,z40#,x60#,y60#,z60#)
declare sub draw2(ln,co,x40#,y40#,z40#,x60#,y60#,z60#)
declare sub draw3(x40#,y40#,z40#,x60#,y60#,z60#)
declare sub draw4(ln,co,x40#,y40#,z40#,x60#,y60#,z60#)
'
declare sub debug_2(ia)
declare sub point()
'
x41#(0)=-1000 :y41#(0)= 1000 :z41#(0)= -1000'P1
x61#(0)=-1000 :y61#(0)= 2000 :z61#(0)= 2000'Q1
'
'-1000,-1000,-1000,2000,2000,3000
x41#(1)=-1000 :y41#(1)= -1000 :z41#(1)= 2000'P2
x61#(1)=-2000 :y61#(1)= 1000 :z61#(1)= 2000'Q2
'******************************************************************************************************************
rtx=80:rty=40
y0=450:x0=1000:y1=(y0)/10 :x1=(x0)/10
st=1:xy=400
a01=st*xy:a02=a01*2
m=0:mouse=1
camX# = 0:camZ# = a01
sp1=7:f75(32)=sp1'
a14=0'locate text_x
dg1=360:dg2=dg1/stp:dg3=dg2-1:p1=dg1/stp4-1
'
sc#=1
'******************************************************************************************************************
for a=0 to 9:cr(a)=a*28:next'1000 text_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:c4(i,0)=cr(i1):c4(i,1)=cr(i3):c4(i,2)=cr(i4):next
'******************************************************************************************************************
a=-1:reset m6:for a=0 to sp0:read sp#(a):next
i1=-1:for i=0 to 250 step 10:i1=i1+1:gosub string1:next:ct=i1
'------------------------------------------------------------------------------------------------------------------
reset m21:for i1=0 to v2:read i2:ab(i1,0)=i2:for i3=0 to i2-1:read i4:ab(i1,i3+1)=i4:l0(i1,i4)=1:next:next
'
reset m30:for i=0 to v3:
for i1=0 to 5:read i7#(i1):i7#(i1)=i7#(i1)/20:next
ver#(i,0)=vec3 (i7#(0),i7#(1),i7#(2)):ver# (i,1)=vec3(i7#(3),i7#(4),i7#(5)):
next
'
reset m3:for i=0 to 17:read a10(i,0),a10(i,1):a21(a10(i,0))=a10(i,1):next
i2=17:i1=97:do:i2=i2+1:a10(i2,0)=i1:a10(i2,1)=i1-32:a21(i1)=a10(i2,1):i1=i1+1:loop until i1=126
for i=0 to 127:if a21(i)=0 then a21(i)=i:endif:next
'
reset m4:
for i8=0 to s_amount
read a1$:i3=len(a1$)-1:
for i1=0 to i3:a2$(i1)=mid$(a1$,i1+1,1):a2=asc(a2$(i1)):
if a2>47 and a2<58 then:aa(i8,i1)=a2-48:endif'0-9
if a2>64 and a2<91 then:aa(i8,i1)=a2-55:endif'A-Z
if a2=46 then:aa(i8,i1)=36:endif'.
if a2=44 then:aa(i8,i1)=37:endif',
if a2=32 then:aa(i8,i1)=38:endif'space
if a2=58 then:aa(i8,i1)=39:endif':
if a2=47 then:aa(i8,i1)=40:endif'/
if a2=45 then:aa(i8,i1)=41:endif'-
if a2=43 then:aa(i8,i1)=42:endif'+
if a2=95 then:aa(i8,i1)=43:endif'_
if a2=40 then:aa(i8,i1)=44:endif'(
if a2=41 then:aa(i8,i1)=45:endif')
next:wl(i8)=i3'0:-48,A:-65
next
'
m4:
'data "ABC:DEF,GHI,JKL,MNO PQR STU: VWX: YZ0" '0
data "PRESS 0-9 (ABOVE QWERTYUIOP) TO TURN BOX(0-9)" '0
data "PRESS 1-3 (NUMBERS ON THE RIGHT_KEYBOARD_SIDE)" '1
data "ROTATE: 1_X 2_Y 3_Z" '2
data "F1:SPEED" '3
data "F6:FREEZE.CAMERA" '4
data "F3:TEXT_MENUE" '5
data "F4:CAM.ROTATE.1 AT POSITION" '6
data "ON:USE LEFT.MOUSE_BUTTON:ZOOM -" '7
data " USE RIGHT.MOUSE_BUTTON:ZOOM +" '8
data " PRESS SPACE TO ZOOM SLOW" '09
data "POSITION YOURSELF INTO CAMERA.ROTATION.CENTER "'10
data "F5:SUPPORT_LINES ON/OFF" '11
data "X" '12
data "Y" '13
data "Z" '14
data "F6:FREEZE.CAMERA AND ROTATE.2:OBJECT:" '15
data "KEYS_2:1 /2 /3 +MOUSE_X" '16
data " PRESS CTRL TO ZOOM FAST" '17
data "SHORT-PRESS:1-9(ON/OFF) TO ROTATE" '18
data "1-9:NUM-LOCK(ON):RIGHT.NUMBER-BLOCK" '19
data "F7+/F8-:FLYING ALONG THE LINE" '20
'
for i=0 to v2:co(i)=r1(0,10):next'letter_color
'
vec_quad(0,10):vec_quad(4,1):vec_quad2(12,1) :vec_quad3(16,1)
'
f36=true
'
for i=0 to 95:ci(i)=10:next'inkey
for i=0 to 43:cs(i)=10:next'inscan
cs(32)=sp0+1'cs_inscan_f1_--->f75(32)=0-7
'
reset m14:read pa:for i0=0 to object:for i1=0 to 2:read a20#(i0,i1):next:next
reset m15:read q0:for i0=0 to q0:read a22(i0,0):for i1=1 to a22(i0,0):read a22(i0,i1):next:next
'
reset m2:for i=0 to 16:read a10(i,0),a10(i,1):a21(a10(i,0))=a10(i,1):next
i2=16:i1=97:do:i2=i2+1:a10(i2,0)=i1:a10(i2,1)=i1-32:a21(i1)=a10(i2,1):i1=i1+1:loop until i1=126
for i=0 to 127:if a21(i)=0 then a21(i)=i:endif:next
'
dim bc$,be$
bc$="photo_texture.sphere_136.125/"
b8$=bc$+"files/text/vector_data/"
b7$=b8$+"vector_list_01.txt"
b9$=bc$+"files/fonts/"
ba$=bc$+"files/textures/birds/"
bb$=bc$+"files/text/time/time.txt"
be$=bc$+"files/textures/99_new_color/"
'------------------------------------------------------------------------------------------------------------------
'reset m1:tl3=-1:do:tl3=tl3+1 :read a$(tl3):if a$(tl3) <>"end" then t1(tl3)=LoadTexture(be$+a$(tl3)):endif:loop until a$(tl3)="end"
'reset m39:tl4=-1:do:tl4=tl4+1 :read b$ :if b$ <>"end2" then t3(tl4)=LoadTexture(ba$+b$):endif:loop until b$="end2":p2=tl4-1
'*************************************************************************************************************************************************
declare function sa$(i#)
dim ca#(10,2):
dim ca0#,v0(99,2) as single,v4(2) as single,v5(2) as single,v6(2) as single
dim va,ig,f48b
'
'june 2022
declare sub rotate_object(wb,vo() as single)
dim vcb(2) as single,vcb2(2) as single
vcb2 = vec3(1000,0,0) :v5 = vcb2
'
dim hmb=9,wb 'wb=which_box
dim xa(hmb)(10) as single,ya(hmb)(10) as single,za(hmb)(10) as single
dim g3,wba
dim angle1(hmb),angle2(hmb),angle3(hmb)
dim v8(2) as single,vl(2) as single,n1 as single
'
'june 2022 :photo_texture.sphere_137.001 proboards_v
declare sub glC(a as integer)
dim cl(10) as single,gc(999,2) as single,n2 as single
for a=0 to 9:n2=a:cl(a)=n2/9:next'1000 gl_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:gc(i,0)=cr(i1):gc(i,1)=cr(i3):gc(i,2)=cr(i4):next'1000 gl_colors
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a,2)):end sub
i=0:i1=0:i2=0:i3=0:i4=0
'
dim c8(6)
reset mc :for i1=1 to 6:read c8(i1):next
mc:data 900,090,909,333,099,009
'*************************************************************************************************************************************************
'font(loadtex(b9$+"font.png"))
glViewport(0, 0, WindowWidth(), WindowHeight())
'
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
gluPerspective(60, (1*WindowWidth()) / WindowHeight(), .1, 10000000)
'
glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
'
glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
'
textmode(texT_OVERLAID):resizetext(rtx,rty)
glEnable(GL_TEXTURE_2D)
a15=windowfullscreen()
'
gosub time_read
gosub read_vector_list
'
do
'----------------------------------------------------------------------------------------------------------
glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)
gosub rotate_translate
'----------------------------------------------------------------------------------------------------------
gosub draw_box1'photos
gosub draw_box2'grid
draw1(0,17,x41#(0),y41#(0),z41#(0),x61#(0),y61#(0),z61#(0))
draw1(1,30,x41#(1),y41#(1),z41#(1),x61#(1),y61#(1),z61#(1))
gosub draw5
'------------------------------------------------------
if f80(33)=0 and f80(35)=0 then x10#=camX#:y10#=camY#:z10#=camZ#:endif 'f2=0 and f4=0
if f80(33)=0 then compute_point(10,1200,400,300,x10#,y10#,z10#):endif 'f2=0
'------------------------------------------------------
rotate_object(0,vcb2)
rotate_object(1,v8)
rotate_object(2,v8)
rotate_object(3,v8)
rotate_object(4,v8)
rotate_object(5,v8)
rotate_object(6,v8)
rotate_object(7,v8)
rotate_object(8,v8)
rotate_object(9,v8)
'
gosub read_vec_list:
'------------------------------------------------------
inscan2() : gosub keys3
inscan3()
gosub counter:gosub counter2
'------------------------------------------------------
if f80(33)=0 then 'f2=0
gosub draw_xyz_line
inkey2()
gosub draw_vector_text
gosub mouse1:gosub mousebutton:
if f80(35)=0 then gosub keys1: gosub keys2:endif'f4=0
endif
'----------------------------------------------------------------------------------------------------------
gosub time:debug_2(x60#):gosub debug_3
'----------------------------------------------------------------------------------------------------------
drawtext():SwapBuffers ()
loop
'*****************************************************************************************************************************
sub draw1(ln,co,x40#,y40#,z40#,x60#,y60#,z60#)
f45(ln)=f80(26) or f80(27) or f80(28) or f80(29) or f80(30) or f80(31)
if f45(ln) then f80(37)=true :endif
'
if f46(ln)=0 then draw2(ln,co,x40#,y40#,z40#,x60#,y60#,z60#):f46(ln)=true:endif
if f45(ln)=0 then draw4(ln,co,x40#,y40#,z40#,x60#,y60#,z60#):endif
'
if f45(ln) then draw2(ln,co,x40#,y40#,z40#,x60#,y60#,z60#):endif
end sub
'*****************************************************************************************************************************
sub draw2(ln,co,x40#,y40#,z40#,x60#,y60#,z60#):
a28=0
glPointSize(5):'drawings with condition that P<>Q (only one line)
if x40#<>x60# then:'glBindTexture(GL_TEXTURE_2D, t1(co)):
glc(900)
glbegin(gl_points)
for x#=-5000 to 5000 step 10
z#=lz(x#,x40#,z40#,x60#,z60#):
y#=ly(z#,y40#,z40#,y60#,z60#):
glVertex3f(x#,y#,z#)
x50(ln,x#+5000)=x#:y50(ln,x#+5000)=y#:z50(ln,x#+5000)=z#'..............
next
glend()
else x#=x40#
if z40#<>z60# then :'glBindTexture(GL_TEXTURE_2D, t1(1)):
glbegin(gl_points)
for z#=-5000 to 5000 step 10
y#=ly(z#,y40#,z40#,y60#,z60#):
point()
x50(ln,z#+5000)=x#:y50(ln,z#+5000)=y#:z50(ln,z#+5000)=z#'..............
next
glend()
else z#=z40#:'glBindTexture(GL_TEXTURE_2D, t1(32)):
glbegin(gl_points):'f41=true
for y#=-5000 to 5000 step 10 :
point()
x50(ln,y#+5000)=x#:y50(ln,y#+5000)=y#:z50(ln,y#+5000)=z#'..............
next
glend()
endif'if z40#<>z60#
endif'if x40#<>x60#
if z40#=z60# then z#=z40#'and f41=0
if y40#<>y60# then ':glBindTexture(GL_TEXTURE_2D, t1(30)):
glbegin(gl_points)
for y#=-5000 to 5000 step 10 :
x#=lx(y#,x40#,y40#,x60#,y60#)
point()
x50(ln,y#+5000)=x#:y50(ln,y#+5000)=y#:z50(ln,y#+5000)=z#'..............
next
glend()
else y#=y40#:'glBindTexture(GL_TEXTURE_2D, t1(29)):
glbegin(gl_points)
for x#=-5000 to 5000 step 10 : point(): next
x50(ln,x#+5000)=x#:y50(ln,x#+5000)=y#:z50(ln,x#+5000)=z#'..............
glend()
endif'if y40#<>y60#
endif
'glBindTexture(GL_TEXTURE_2D, t1(2)):
glc(90)
draw3(x40#,y40#,z40#,x60#,y60#,z60#)
end sub
sub point():glVertex3f(x#,y#,z#):ia=x#:end sub
'*****************************************************************************************************************************
sub draw3(x40#,y40#,z40#,x60#,y60#,z60#):glPointSize(10):glbegin(gl_points):glVertex3f(x40#,y40#,z40#):glVertex3f(x60#,y60#,z60#):glend():end sub
'*****************************************************************************************************************************
sub draw4(ln,co,x40#,y40#,z40#,x60#,y60#,z60#): glPointSize(5):'glBindTexture(GL_TEXTURE_2D, t1(co)):
glc(90)
glbegin(gl_points)
for a29=0 to 10000 step 10 :glVertex3f( x50(ln,a29),y50(ln,a29),z50(ln,a29) ):next:a28=a28+1:
glend()
'glBindTexture(GL_TEXTURE_2D, t1(32)):
glc(900)
draw3(x40#,y40#,z40#,x60#,y60#,z60#)
end sub
'*****************************************************************************************************************************
draw5:'
if b21=118 and a24<9990 then a24=a24+10 :endif'f7
if b21=119 and a24>0 then a24=a24-10 :endif'f8
if b21=118 then f42=true: else f42=0 :endif
if b21=119 then f43=true: else f43=0 :endif
'
if f42 or f43 then gosub txt01 else gosub txt02:endif
if f42 or f43 then 'gosub mouse1:
f80(37)=0'f6
glLoadIdentity ()
glRotatef (my#, 1, 0, 0)
glRotatef (mx#, 0, 1, 0)
glscalef(1,1.2,1)
glTranslatef (-x50(1,a24),-y50(1,a24),-z50(1,a24))
endif
return
'
txt01: LOCATE 0,30:print "a24 :";a24 ;" "
LOCATE 0,31:print "f42,f43:";f42;"/";f43;" "
LOCATE 0,32:print "mx# :";mx#;" "
LOCATE 0,33:print "a28 :";a28;" " 'f4
return
txt02:clearregion(0,30,15,33):return
'*****************************************************************************************************************************
sub rotate_object(wb,vo() as single):vcb = vo
if f80(33)=0 then 'f2=0
if f80(2)=999 and f80(0) then f48=true:f48b=f48b+1:endif 'insert+ctrl disabled
if f48 then vd=vd+1:gosub open_vec_write:gosub vec_write0:endif
if f48 and f52=0 then b4=performancecounter() :f52=true:endif
if f52 then b5=performancecounter():if b5>b4+2000 then f52=0:endif:endif
'
ig=0:glPointSize(10):
for i0=0 to q0 'quad or polygon amount_amount
for i1=1 to a22(i0,0) 'how many points per quad or polygon
ig=ig+1
if f80(23) or f80(24) or f80(25) or f47=0 then
rotate_x(angle1(wb), a20#(a22(i0,i1),0), a20#(a22(i0,i1),1), a20#(a22(i0,i1),2) )
rotate_y(angle2(wb),xc#,yc#,zc#)
rotate_z(angle3(wb),x2#,y2#,z2#,vo)
xa(wb)(i1)=x3#:ya(wb)(i1)=y3#:za(wb)(i1)=z3#
endif
next
draw_box5(i0,a22(i0,0),wb)
next
if f48 then gosub vec_write4:gosub close_vec_write:f48=0:f80(2)=0:f80(0)=0:gosub open_vec_list:endif
endif
end sub
'*****************************************************************************************************************************
sub rotate_x(alpha4#,x0#,y0#,z0#):'zy'rotate x-axis:
alpha1#=atand(y0#/z0#):hy1#=y0#/sind(alpha1#): ':txt1(x0#,y0#,z0#)
beta# = alpha1#+alpha4#
zc#=cosd(beta#) *(hy1#) :yc#=sind(beta#) *(hy1#):xc#=x0# ':txt2(xc#,yc#,zc#)
'draw_rotate_x(5)
end sub
sub draw_rotate_x(co):c0(co):glPointSize(5):glbegin(gl_points):glVertex3f(xc#,yc#,zc#):glend():end sub'xy
'*****************************************************************************************************************************
sub rotate_y(alpha5#,x0#,y0#,z0#):'xz'rotate y-axis:
alpha2#=atand(x0#/z0#):hy3#=x0#/sind(alpha2#)
beta1# = alpha2#+alpha5#
z2#=cosd(beta1#) *(hy3#) :x2#=sind(beta1#) *(hy3#) :y2#=y0# ':txt3(x2#,y2#,z2#)
'draw_rotate_y(2)
end sub
sub draw_rotate_y(co):c0(co):glPointSize(5):glbegin(gl_points):glVertex3f(x2#,y2#,z2#):glend():end sub'xz
'*****************************************************************************************************************************
sub rotate_z(alpha6#,x0#,y0#,z0#,vo() as single):'xy'rotate z-axis
alpha3#=atand(y0#/x0#):hy2#=y0#/sind(alpha3#)
beta# = alpha3#+alpha6#
x3#=cosd(beta#) *(hy2#) :y3#=sind(beta#) *(hy2#) :z3#=z0# ':txt4(x3#,y3#,z3#)
draw_rotate_z(20,vo)
end sub
sub draw_rotate_z(co,vo() as single):
if ig=1 then c0(2): v4 = vec3(x3#,y3#,z3#) :v6 = vo - v4 :vcb = v6 :else ':endif
if ig=8 then c0(5): v8 = vec3(x3#,y3#,z3#)+vcb
else c0(co)
endif:endif
'
v0(i2)= vec3(x3#,y3#,z3#)+vcb
if ig<9 then glbegin(gl_points):glVertex3fv(v0(i2)):glend() :endif
end sub'xy
'*****************************************************************************************************************************
sub draw_box5(c,i0,wb):'xa(wb)(i1)=x3#:ya(wb)(i1)=y3#:za(wb)(i1)=z3#
if i0=4 then 'glBindTexture(GL_TEXTURE_2D,t3(co+6)):
glc(c8(c+1))
glbegin (Gl_quads):
for i=1 to i0:if (c=5 or c=4) then glTexCoord3fv(a#(11+i)) else glTexCoord3fv(a#(15+i)):endif
ca#(1)=vec3(xa(wb)(i),ya(wb)(i),za(wb)(i))+vcb : glvertex3fv( ca#(1) ):
next:glend ()
'
else: glBindTexture(GL_TEXTURE_2D,t1(c+6))
glbegin (Gl_polygon):for i=1 to i0:glvertex3f( xa(wb)(i),ya(wb)(i),za(wb)(i) ):next: glend ():endif
if f48 then : for i=1 to i0:gosub vec_write2:next endif
end sub
'*****************************************************************************************************************************
read_vec_list:
if f80(6) = 999 then 'page_up f80(6)=true disabled
file = openfileread(b7$):file_error()
b=endoffile(file):if not b then i$ = ReadLine(file):endif
CloseFile (file)
'
file = openfileread(b8$+i$)
i$ =ReadLine(file)'object_name
i$=ReadLine(file):b4$=left$(i$,3):i$=ReadLine(file):b5$=left$(i$,3):i$=ReadLine(file):b6$=left$(i$,3)
'
if f80(40) then angle1(wba)=val(b4$):angle2(wba)=val(b5$):angle3(wba)=val(b6$):endif
if f80(40)=0 then angle1(wba)=0:angle2(wba)=0:angle3(wba)=0:endif
'
i$=ReadLine(file):i$=ReadLine(file)'++++++++++++++++++++++++++
'
i$ =ReadLine(file) '9. :point_amount (pa) :0-9.
i1$=left$(i$,5):pa=val(i1$):'max 99999 points
'
for i=0 to pa
i$ =ReadLine(file)
for i3=0 to 2:i1=0:i2$=""
do:i1=i1+1:i1$=mid$(i$,i1,1):if i1$<>"," then i2$=i2$+i1$:endif:loop until i1$=","
a20#(i,i3)=val(i2$):i$ = right$( i$,len(i$)-i1 )
next
next
'
i$=ReadLine(file):i$=ReadLine(file)'++++++++++++++++++++++++++
'
i$ =ReadLine(file)'6. :polygon_amount (q0) :0-6.
i$=left$(i$,4)'max.9999
q0=val(i$)
'
for i=0 to q0:
i$ =ReadLine(file)
i1=0:i2$=""
do:i1=i1+1:i1$=mid$(i$,i1,1):if i1$<>"," then i2$=i2$+i1$:endif:loop until i1$=","
i2=val(i2$):a22(i,0)=i2
for i3=1 to i2 :i2$=""
do:i1=i1+1:i1$=mid$(i$,i1,1):if i1$<>"," then i2$=i2$+i1$:endif:loop until i1$=","
a22(i,i3)=val(i2$)
next
next
CloseFile (file)
'
f80(6)=0:'page_up
'
endif
return
stop :CloseFile (file):end:return
'*****************************************************************************************************************************
sub file_error():if FileError () <> "" then :Locate 1,23:print FileError ():endif:end sub
'*****************************************************************************************************************************
open_vec_list:
file2 = openfileread(b7$):file_error()
b3=0:while not (endoffile(file2)):b3=b3+1:b1$(b3)=ReadLine(file2):wend:b3=b3-1
b1$(0)=i7$
CloseFile (file2)
'
file2 = OpenFileWrite (b7$):
for i=0 to b3:writeLine(file2,b1$(i)):next
CloseFile (file2)
return
'
open_vec_write:i1$=str$(vd):i2$=left$(i1$,len(i1$)-1):
if len(i2$)=1 then i2$="00"+i2$:endif'max.999 files
if len(i2$)=2 then i2$="0"+i2$:endif
'
i7$="vector_data_("+i2$+").txt"
file = OpenFileWrite (b8$+i7$)
return
'
vec_write0: i$="object_name:house_01":writeLine(file,i$):
i$ = sa$( angle1(wba) ):writeLine( file,i$+" :rotation x:angle1" )
i$ = sa$( angle2(wba) ):writeLine( file,i$+" : y:angle2" )
i$ = sa$( angle3(wba) ):writeLine( file,i$+" : z:angle3" )
return
'
vec_write2: i4$(i0,i)=str$(a22(i0,i))
if f80(40)=0 then 'f9=0
i3$(i0,i,0)=str$(xa(wb)(i)):
i3$(i0,i,1)=str$(ya(wb)(i)):
i3$(i0,i,2)=str$(za(wb)(i)):
endif
'
if f80(40) then 'f9
i3$(i0,i,0)=str$( a20#(a22(i0,i),0) ):
i3$(i0,i,1)=str$( a20#(a22(i0,i),1) ):
i3$(i0,i,2)=str$( a20#(a22(i0,i),2) ):
endif
return
'
vec_write4:
gosub write_plus
for i0=0 to pa:m100(i0):next
'
writeLine( file,sa$(pa)+" :point_amount (pa) :0-"+str$(pa) )
'
b10$=" "
for i=0 to pa :
i$=sa$( x30#(i))+","+sa$(y30#(i))+","+sa$(z30#(i))+","
i1=len(i$)
b2$=right$(b10$,len(b10$)-i1)
writeLine( file,i$+b2$+":"+sa$(i) ) :
next
'
gosub write_plus
'
writeLine( file,sa$(q0)+" :polygon_amount (q0) :0-"+sa$(q0) )
for i22=0 to q0:b$=""
for i=0 to a22(i22,0):b$=b$+sa$( a22(i22,i))+",":next
writeLine(file,b$+" :"+sa$(i22) )
next
'
gosub write_plus
return
'
write_plus: writeLine(file,"+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++")
writeLine(file,"+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++")
return
'
sub m100(i9):f49=0:i=-1:
do:i=i+1:i1=0: do :i1=i1+1:ib=val(i4$(i,i1) )
if ib=i9 then x30#(i9)=val( i3$(i,i1,0) ):y30#(i9)=val( i3$(i,i1,1) ) :z30#(i9)=val( i3$(i,i1,2) ):f49=true:endif
loop until i1=a22(i,0) or f49 :loop until i=q0 or f49
end sub
'
close_vec_write:CloseFile (file):return
'*****************************************************************************************************************************
read_vector_list:
file = openfileread(b7$):file_error()
b=endoffile(file):i$ =ReadLine(file):i1$=mid$(i$,14,3)''max.999 files
vd=val(i1$)
CloseFile (file)
return
'*****************************************************************************************************************************
sub c0(i0):'glBindTexture(GL_TEXTURE_2D, t1(i0)):
end sub
'*****************************************************************************************************************************
sub line1(co,x,y,z):glc(co):gllinewidth(2):glbegin(gl_lines):glVertex3f ( x,y,z):glVertex3f ( 0,0,0 ) :glend():end sub
'*****************************************************************************************************************************
draw_xyz_line:line1(99,-1000,0,0):line1(900,1000,0,0):line1(99,0,-1000,0):line1(900,0,1000,0):line1(99,0,0,-1000):line1(900,0,0,1000):return
'************************************************************************************************************************************************************************************************************
rotate_translate:
if f42=0 and f43=0 then
glLoadIdentity ()
'
if f80(33) then glRotatef ( 0, 1, 0, 0):glRotatef ( 0, 0, 1, 0) 'f2.ON
glRotatef ( a45, 0, 0, 1):glscalef(1,1,1)
camX# = 0:camy# = 0:camZ# = 2.5
glTranslatef (-camX#, -camY#, -camZ#)
f80(34)=0'f3.OFF
endif
'
if f80(33)=0 then: 'f2.OFF
if f80(35)=0 then 'f4.OFF
glRotatef (my#, 1, 0, 0)
glRotatef (mx#, 0, 1, 0)
glscalef(1,1.2,1)
glTranslatef (-camX#, -camY#, -camZ#) :endif
if f80(35) then 'f4.ON
glRotatef (i# , 1, 0, 0)
glRotatef (i10#-90, 0, 1, 0)
glTranslatef ( -x11#, -y11#, -z11# ) :endif
'
endif'if f80(33)=0
else:gosub draw5
'
endif
return
'*********************************************************************************************************************************************************
counter:if f80(33) then :if f60=0 then:a30=PerformanceCounter():f60=true:endif:a31=PerformanceCounter():if a31>a30+10 then a45=a45+2:f60=0:endif:endif:return
'************************************************************************************************************************************************************************************************************
draw_box1:if f80(33)=0 then draw_box4(1,2,0,0,-1):draw_box4(0,2,0,0, 1):endif:return
'******************************************************************************************************************
sub draw_box4(tn,size,x2,y2,z2):
glBindTexture(GL_TEXTURE_2D,t3(tn))
glBegin(Gl_quads)
glTexCoord3fv(a#(4)): glVertex3fv(a#(04)*size+ vec3(x2,y2,z2) )
glTexCoord3fv(a#(5)): glVertex3fv(a#(05)*size+ vec3(x2,y2,z2) )
glTexCoord3fv(a#(6)): glVertex3fv(a#(06)*size+ vec3(x2,y2,z2) )
glTexCoord3fv(a#(7)): glVertex3fv(a#(07)*size+ vec3(x2,y2,z2) )
glend()
end sub
'*****************************************************************************************************************************
sub draw_basic_circle3(r):'xz...horizontal
for beta1# = 0 to 360 step 10
x8#=cosd(beta1#) *(r) :z8#=sind(beta1#) *(r)
a#(8)=a#(3) + vec3(x8#,0,z8#)
if f80(36)=0 then:c0(2):draw_line30():endif
next
end sub
sub draw_line30():glPointSize(1):glbegin(gl_points):glVertex3fv ( a#(8) ):glend():end sub'xz
'*****************************************************************************************************************************
sub draw_basic_circle4(r):'xy...height
r=r*sc#
for beta# = -90 to 90 step 5
x6#=cosd(beta#) *(r) :y6#=sind(beta#) *(r)
a#(3)=a#(0)+vec3(0,y6#,0)
draw_basic_circle3(x6#)
next
end sub
'************************************************************************************************************************************************************************************************************
sub draw_point3(pc,hy2#,alpha2#,alpha1#,x0#,y0#,z0#)
x1#=cosd(alpha2#) *(hy2#) :y1#=sind(alpha2#) *(hy2#)'height
a17#=cosd(alpha1#):a18#=sind(alpha1#) 'xz_circle
x4#=a17# *(x1#) :z4#=a18# *(x1#)
draw_point2(pc,x4#,y1#,z4#,x0#,y0#,z0#)
end sub
'
sub draw_point2(pc,x1#,y1#,z1#,x0#,y0#,z0#):a#(2)=a#(0)+vec3(x1#,y1#,z1#)*sc#:x11#=a#(2,0):y11#=a#(2,1):z11#=a#(2,2)
'glBindTexture(GL_TEXTURE_2D, t1(pc)):glPointSize(10):glbegin(gl_points):glVertex3fv( a#(2) ):glend():
end sub
'
yellow_line:c0(6):glbegin(gl_lines):glVertex3fv ( a#(0) ):glVertex3fv ( a#(1) ) :glend():return
'************************************************************************************************************************************************************************************************************
sub compute_point(pc,x3#,y3#,z3#,x0#,y0#,z0#)
if mb(1) and b21=0 then sc#=sc#+.01 :endif:if mb(0) and b21=0 then sc#=sc#-.01 :endif
if mb(1) and b21=32 then sc#=sc#+.001:endif:if mb(0) and b21=32 then sc#=sc#-.001:endif
if mb(1) and b21=17 then sc#=sc#+.1 :endif:if mb(0) and b21=17 then sc#=sc#-.1 :endif'faster: ctrl
'
a#(0)=vec3(x0#,y0#,z0#) : a#(1)= a#(0)+(vec3(x3#,y3#,z3#)*sc#)
if f80(36)=0 then:gosub yellow_line:draw_point2(2,x3#,y3#,z3#,x0#,y0#,z0#):endif
'
hy#=pow(pow(x3#,2)+pow(z3#,2),0.5)
alpha1#=atand(z3#/x3#)
hy2#=pow(pow(hy#,2)+pow(y3#,2),0.5)
alpha2#=atand(y3#/hy#)
draw_basic_circle4(hy2#)
'---------------------------------------------------------------------------
i#=mouse_y()*-720+360 : i10#=mouse_x()*720:i10=i#:i11=i10#
draw_point3(pc,hy2#,i#,i10#,x0#,y0#,z0#):
'---------------------------------------------------------------------------
end sub
'************************************************************************************************************************************************************************************************************
draw_basic_circle:
for beta# = 0 to 360 step 10
x6#=cosd(beta#) *(1000) :z6#=sind(beta#) *(1000)
x7#=cosd(beta#+10)*(1000) :z7#=sind(beta#+10)*(1000)
gosub draw_line2
next
return
draw_line2:gllinewidth(2):glbegin(gl_lines):glVertex3f(x0+x6#,0,z0+z6#):glVertex3f(x0+x7#,0,z0+z7#):glend():return
'*****************************************************************************************************************************'vec_quad(4,1)
sub vec_quad(nr,d#) :a#(nr)=vec3( 0, 0, 0) :a#(nr+1)=vec3( d#, 0, 0):a#(nr+2)=vec3( d#, d#, 0):a#(nr+3)=vec3( 0, d#, 0):end sub
sub vec_quad2(nr,d#):a#(nr)=vec3( d#, 0, 0):a#(nr+1)=vec3( d#, d#, 0):a#(nr+2)=vec3( 0, d#, 0):a#(nr+3)=vec3( 0, 0, 0) :end sub
sub vec_quad3(nr,d#):a#(nr)=vec3( 0, d#, 0):a#(nr+1)=vec3( 0, 0, 0) :a#(nr+2)=vec3( d#, 0, 0):a#(nr+3)=vec3( d#, d#, 0):end sub
'************************************************************************************************************************************************************************************************************
sub inkey2():in$=inkey$():if in$<>"" then g=asc(in$):endif:b10=a21(g):f55=keydown(chr$(b10)):if f55=0 then g=0:endif:gosub keys5:end sub
keys5:if f04=0 and g then: if f64=0 then g1=g:f64=true:endif:f04=true:ink():endif:if f04 and g<>g1 then f04=0:f64=0:endif:return'PCN
sub ink():k2=a12(g):f90(k2)=not f90(k2):f92(k2)=f92(k2)+1:if f92(k2)=ci(k2) then f92(k2)=0:endif :end sub'inkey
'************************************************************************************************************************************************************************************************************
sub inscan2():in=InScanKey ():if in<>0 then in5=in:b21=in5:endif:f30=ScanKeyDown(in5):if f30=0 then b21=0:endif:gosub keys6:end sub'inscan
keys6:if f44=0 and b21 then: if f74=0 then g2=b21:f74=true:endif:f44=true:ins():endif:if f44 and b21<>g2 then f44=0:f74=0:endif:return'PCN
sub ins():k3=a7(b21):f80(k3)=not f80(k3):f75(k3)=f75(k3)+1:if f75(k3)=cs(k3) then f75(k3)=0:endif:end sub
'************************************************************************************************************************************************************************************************************
sub inscan3():d1(0)=ScanKeyDown(17):d1(1)=ScanKeyDown(16):if (d1(0) or d1(1)) then f100=0:for i= 2 to 27:d1(i)=KEYDOWN(chr$(63+i)):next:
for i=28 to 37:d1(i)=KEYDOWN(chr$(20+i)):next else if f100=0 then for i= 2 to 27:d1(i)=0:next:for i=28 to 37:d1(i)=0:next:f100=true:endif:endif:end sub
'************************************************************************************************************************************************************************************************************
counter2:if f36 then:if f10=0 then:a09=PerformanceCounter():f10=true:endif: a00=PerformanceCounter()
if a00>a09+500 then a03=a03+1:f10=0:endif:if a03=20 then f36=0:endif:endif: return
'*****************************************************************************************************************************************
sub draw_box(i,x#,y#,z#):glBindTexture(GL_TEXTURE_2D, i):
glbegin (gl_quads): for i=0 to 3:ver8#(i)=a#(i)+vec3(x#,y#,z#) :glvertex3fv (ver8#(i)) :next: glend ():end sub
'*****************************************************************************************************************************************
sub co3(i):color(c4(i,0),c4(i,1),c4(i,2)):end sub'1000 colors wo comma
'*****************************************************************************************************************************************
draw_vector_text:
vl=vec3(5000,0,0):
vec_draw3( 3,160,900,120,10,20, 00,-200)
vec_draw3( 4,160,222,120, 1,20, 200,-200)
vec_draw3( 5,160, 90,120, 5,20, 400,-200)
'
vec_draw3( 0,160,909,120, 1,20, 600,-200)
vec_draw3( 1,160,099,120, 5,20, 800,-200)
vec_draw3( 2,160,777,120, 1,20,1000,-200)
vec_draw3( 0,160, 90,120, 5,20,1200,-200)
vec_draw3( 6,160,900,120, 2,20,1400,-200)
vec_draw3( 7,160,990,120, 2,20,1600,-200)
vec_draw3( 8,160,999,120, 2,20,1800,-200)
vec_draw3( 9,160,777,120, 2,20,2000,-200)
vec_draw3(17,160,444,120, 2,20,2200,-200)
vec_draw3(10,160,099,120, 2,20,2400,-200)
vec_draw3(11,160,909,120, 2,20,2600,-200)
vec_draw3(15,160,900,120, 2,20,2800,-200)
vec_draw3(16,160,397,120, 2,20,3000,-200)
vec_draw3(18,160,951,120, 5,20,3200,-200)
vec_draw3(19,160,287,120, 5,20,3400,-200)
vec_draw3(20,160,750,120, 2,20,3600,-200)
'
Vl = vec3(0,0,0)
vec_draw3(12,160,900,120, 2,09, 80, 0)'x
vec_draw3(13,160,900,120, 2,-1,-1000, 0)'y
vec_draw3(14,160,900,120, 2,-1, 10,1000)'z
return
'*****************************************************************************************************************************************
sub vec_draw3(sen,lsize#,lcol,distx#,width,x,y,z):
 glc(lcol)
 gllinewidth(width): 'glBindTexture(GL_TEXTURE_2D, t1(lcol)):
 glBegin (GL_lineS)
    for i=0 to wl(sen):b1=aa(sen,i):'which letter___wl(sen):sentence_lenght
       for i1=1 to ab(b1,0)'vertex-amount
          v1=ab(b1,i1)
          ver4#=vec3(x*distx#+i*distx#,-y,z)
          ver6#=ver#(v1,0)*lsize#:ver7#=ver#(v1,1)*lsize#
          ver2#=ver6#+ver4#+vl
          ver3#=ver7#+ver4#+vl
          glVertex3fv (ver2#):glVertex3fv (ver3#)
       next
    next
    glend()
end sub
'*********************************************************************************************************************************************************
time:d3=PerformanceCounter():d4=d3/1000:d11=d9-d10+d4:d12=d11/60:d13=d12/60:d14=d13*60:d15=d12-d14:return
'******************************************************************************************************************
keys1: c=ScanKeyDown (VK_DOWN)-ScanKeyDown (VK_UP):'d=ScanKeyDown (VK_left)-ScanKeyDown (VK_right)
if (c or c=1) then
a14#=cosd(my#)/1.01: a15#=int(a14#)*2+1:a16=a15#
camX# = camX# + c*sp#(sp1)*sind (mx#) *a16
camY# = camY# - c*sp#(sp1)*sind (my#)
camZ# = camZ# - c*sp#(sp1)*cosd (mx#) *cosd(my#)
x4=t(camx#,a01,a02):y4=t(camy#,a01,a02):z4=t(camz#,a01,a02)
x5=camX#:y5=camY#:z5=camZ#
endif
return
'******************************************************************************************************************
keys2:
if inkey(119) then camZ#=camZ#-sp#(sp1):z4=int((camz#+a01)/a02):endif'w
if inkey(115) then camZ#=camZ#+sp#(sp1):z4=int((camz#+a01)/a02):endif's
'
if inkey(113) then camY#=camY#+sp#(sp1):y4=int((camy#+a01)/a02):endif'q
if inkey(097) then camY#=camY#-sp#(sp1):y4=int((camy#+a01)/a02):endif'a
'
if inkey(120) then camX#=camX#+sp#(sp1):x4=int((camx#+a01)/a02):endif'x
if inkey(122) then camX#=camX#-sp#(sp1):x4=int((camx#+a01)/a02):endif'z
'73,75
if inkey(105) then: if angle1(wba)<359 then angle1(wba)=angle1(wba)+2:endif:endif'rotate_x___I
if inkey(107) then: if angle1(wba)>1 then angle1(wba)=angle1(wba)-2:endif:endif'K
'74,76
if inkey(106) then: if angle2(wba)<359 then angle2(wba)=angle2(wba)+2:endif:endif'rotate_y__J
if inkey(108) then: if angle2(wba)>1 then angle2(wba)=angle2(wba)-2:endif:endif'L
'89,72
if inkey(121) then: if angle3(wba)<359 then angle3(wba)=angle3(wba)+2:endif:endif'rotate_z__Y
if inkey(104) then: if angle3(wba)>1 then angle3(wba)=angle3(wba)-2:endif:endif'H
'
if f80(23) then angle1(wba)=m_x():endif'1
if f80(24) then angle2(wba)=m_x():endif
if f80(25) then angle3(wba)=m_x():endif'3
'
if f80(26) then x41#(0)=m_x1():endif'4
if f80(27) then y41#(0)=m_x2():endif
if f80(28) then z41#(0)=m_x3():endif'6
'
if f80(29) then x61#(0)=m_x2():endif'7
if f80(30) then y61#(0)=m_x3():endif
if f80(31) then z61#(0)=m_x1():endif'9
'
if g>47 and g<58 then g3=g-48:wba=g3:endif
'
if inscan(112) then sp1=f75(32):endif 'cs_inscan_f1_0-7'
return
'******************************************************************************************************************
keys3: if f80(33)=999 then gosub screensaver:endif:return 'screensaver disabled
screensaver:draw_box4(a08,4,-2,-2,0):gosub counter:if a45>359 then a45=0:a08=a08+1:if a08=p2+1 then a08=0:endif:endif:return
'******************************************************************************************************************
mouse1:if f80(37)=0 then:mx#=mouse_x()*721-360:my#=mouse_y()*361-180:endif:mx1=mx#:my1=my#:return'f6:37
'******************************************************************************************************************
mousebutton:mb0=mouse_button(0):mb1=mouse_button(1):return
'******************************************************************************************************************
mouse3:c01#=mouse_x()*256:return
'******************************************************************************************************************
draw_box2:
gllinewidth(2): y3=-4000
'
'glBindTexture(GL_TEXTURE_2D,t1(0))
glc(990)

glBegin (GL_LINES)
x3=10:for z3=-10 to 10:gosub line_lr:next:gosub line_lr'left_right
z3=10:for x3=-10 to 10:gosub line_ud:next:gosub line_ud'up_down
glend()
' next:y3=0
return
line_lr:glVertex3f( -a01-x3*a02,-a01+a1+y3,-a01+z3*a02):glVertex3f( a01+x3*a02,-a01+a1+y3,-a01+z3*a02):return'left_right
line_ud:glVertex3f( -a01+x3*a02,-a01+a1+y3,-a01-z3*a02):glVertex3f( -a01+x3*a02,-a01+a1+y3, a01+z3*a02):return'up_down
'******************************************************************************************************************
sub debug_2(ia):dim normal_version
if f80(34) then f29=0:f37=0
co3(990): LOCATE 0,00:
printr x5;"/";y5;"/";z5;"              "
co3(999): printr "---------------------------"
co3(090): printr "F1:speed:";sp0;sp1;": "; sp#(sp1);"         "
printr "F3:debug"
printr "F5:line_support.ON/OFF"
'
'printr "wb:";wb;" "
printr "g3:";g3;" "

if f80(35) then co3(090):LOCATE 0,07
co3(900):print "Zoom:":co3(090):printr"lmb-,rmb+,spc,ctrl"
co3(900):print "zoom:":co3(090):print sc#;" ": co3(990):print i10;"/";i11;" "
else clearregion (0,7,25,8):
endif
co3(999): LOCATE 0,09:print "---------------------------"
co3(099): LOCATE 0,10:print "F6:freeze.camera"
co3(900): LOCATE 0,11:print "rotate2: / / "
co3(990): LOCATE 8,11:print angle1(wba):LOCATE 12,11:print angle2(wba):LOCATE 16,11:print angle3(wba);" "
LOCATE 0,12:print "rotate2:X /Y /Z "
LOCATE 0,13:print "keys1 :IK-/JL-/YH-"
LOCATE 0,14:print "keys2 :"
'
co3(555):
if f80(23) then co3(900):endif:print "1"
co3(555): print " /"
if f80(24) then co3(900):endif:print "2"
co3(555): print " /"
if f80(25) then co3(900):endif:print "3"
co3(555): print " +mx"
'
co3(999): LOCATE 0,15:print "---------------------------"
LOCATE 0,16:print "rotate3:line":co3(099):print " F6:freeze"
co3(990): LOCATE 0,17:print "Q :";ia;"/";y60#;"/";z60#;" "
LOCATE 0,18:print "keys.b :"
'
if f80(29) then co3(900) else co3(555):endif:print "7"
co3(555): print " /"
if f80(30) then co3(900):endif:print "8"
co3(555): print " /"
if f80(31) then co3(900):endif:print "9"
co3(555): print " +mx"
'
co3(555): LOCATE 0,19:print "P :";x40#;"/";y40#;"/";z40#;" "
LOCATE 0,20:print "keys.a :"
if f80(26) then co3(900):endif:print "4"
co3(555): print " /"
if f80(27) then co3(900):endif:print "5"
co3(555): print " /"
if f80(28) then co3(900):endif:print "6"
co3(555): print " +mx"
'
co3(999): LOCATE 0,21 :print "---------------------------"
'
if normal_version then
co3(900): LOCATE 0,22 :
if f80(40)=0 then print "f9:data without angle ":endif
if f80(40) then print "f9:data with angle ":endif
co3(900): LOCATE 0,23 :print "pg_up :load_data"
if f52 then co3(990) else co3(900):endif: LOCATE 0,24 :print "ctrl+insert:save_data"
endif
'
co3(999): LOCATE 0,25 :print "---------------------------"
'
gosub txt10
'
co3(900): LOCATE 20,39 :print "Inkey() :";g ;" $:" ;chr$(g);"__k2:";k2;" "
LOCATE 50,39 :print "Scankey.b21:";b21;"__k3:";k3;" "
co3(090) : LOCATE 0,rty-2:print "Time:" ;d13;".":if d15<10 then print"0":endif:print d15;" "
LOCATE 0,rty-1:print "Field:" ;x4 ;"/";y4;"/";z4;" *"
endif
end sub
'******************************************************************************************************************
txt10:co3(900):
LOCATE 0,26 :for i=0 to 1:print -d1(i):next
LOCATE 0,27 :for i=2 to 27:print -d1(i):next
LOCATE 0,28:for i=28 to 37:print -d1(i):next
return
'******************************************************************************************************************
debug_3:
if f80(34)=0 then
if f29=0 then:clearregion(0,0,80,40):f29=true:endif
if f36 then:co3(900):LOCATE 0,0:print "F3:bug_menue:";a03;" ":endif
if f36=0 and f37=0 then clearregion(0,0,80,40):f37=true:endif
endif
return
'******************************************************************************************************************
time_read:
file = openfileread(bb$)
if FileError () <> "" then :Locate 1,23:print FileError ():endif
b=endoffile(file):
if not(b) then
d9$ =ReadLine(file)
d10$=ReadLine(file)
i$ =ReadLine(file)'"+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
endif
d9=val(d9$):d10=val(d10$)
CloseFile (file)
return
'*****************************************************************************************************************************
sub col(i0,i1,i2):color(cr(i0),cr(i1),cr(i2)):end sub
'******************************************************************************************************************
m3: data 126,96,33,49,34,39,35,51,36,52,37,53,38,55,40,57,41,48,42,56,43,61,58,59,60,44,62,46,63,47,64,50,94,54,95,45,-1
m5:data 9'sp#:0-6
m6:data 0.5,4,8,15,32,64,100,200,400,800
m1:
data "255.000.255.bmp"'0.
data "218.181.230.bmp"'1.
data "255.000.000.bmp"'2.'"137.035.000.bmp"'12___
data "218.123.117.bmp"'3
data "146.147.210.bmp"'4
data "207.215.161.bmp"'5
data "207.215.034.bmp"'6
data "194.193.099.bmp"'7
data "194.193.005.bmp"'8
data "194.103.099.bmp"'9
'20-29...\
data "137.064.000.bmp"'10
data "137.035.098.bmp"'11
data "137.035.000.bmp"'12
data "120.181.230.bmp"'13
data "137.035.000.bmp"'14
data "120.181.230.bmp"'15
data "120.181.005.bmp"'16
data "114.089.098.bmp"'17
data "113.181.005.bmp"'18
data "113.094.005.bmp"'19
data "102.066.102.bmp"'20
'\
data "102.066.000.bmp"'21
data "080.103.155.bmp"'22
data "080.103.099.bmp"'23
data "080.103.075.bmp"'24
data "069.077.000.bmp"'25
data "051.099.237.bmp"'26
data "051.099.067.bmp"'27
data "048.169.102.bmp"'28
data "048.000.255.bmp"'29
'\
data "000.255.116.bmp"'30
data "000.066.000.bmp"'31
data "255.255.000.Yellow.bmp"'32
data "000.127.000.bmp"'33
'data "255.000.000.bmp"'34
'
data "end"
m2: data 33,49,34,39,35,51,36,52,37,53,38,55,40,57,41,48,42,56,43,61,58,59,60,44,62,46,63,47,64,50,94,54,95,45,-1
'
m39:
data"macaw_01.jpg"'0
data"Geese Park Bird_01.jpg"
data"Colorful Bird Rainbow_01.jpg"
data"00005.jpg"
data"Raven Bird_01.jpg"
data"sparrow_01.jpg"'5
data"red_finch_bird_01.jpg"
data"00004.jpg"
data"00006.jpg"
data"red dove_02.jpg"
data"red dove_03.jpg"'10
data"Seattle White Doves.jpg"
data"00001.jpg"
data"00002.jpg"
data"00003.jpg"
data"red.dove.jpg"'
data"Pinterest_02.png"
data "end2"
'******************************************************************************************************************
m21:
data 7,0,1,2,3,4,5,34 '0
data 1,9 '1
data 5,1,2,4,5,6 '2
data 5,2,3,4,5,6 '3
data 4,0,2,3,6 '4
data 5,0,3,4,5,6 '5
data 6,0,1,3,4,5,6 '6
data 3,2,3,4 '7
data 7,0,1,2,3,4,5,6 '8
data 6,0,2,3,4,5,6 '9
data 6,0,1,2,3,4,6 'A...10
data 9,0,1,4,5,16,17,18,19,20 'B...11
data 4,0,1,4,5 'C...12
data 7,0,1,38,39,40,41,42 'D...13
data 5,0,1,4,5,6 'E...14
data 4,0,1,4,6 'F...15
data 6,0,1,3,4,5,21 'G...16
data 5,0,1,2,3,6 'H...17
data 1,9 'I...18
data 4,2,3,5,22 'J...19
data 4,0,1,23,24 'K...20
data 3,0,1,5 'L...21
data 6,0,1,2,3,25,26 'M...22
data 5,0,1,2,3,27 'N...23
data 6,0,1,2,3,4,5 'O...24
data 5,0,1,2,4,6 'P...25
data 7,0,1,2,3,4,5,28 'Q...26
data 6,0,1,2,4,6,29 'R...27
data 5,0,3,4,5,6 'S...28
data 2,4,9 'T...29
data 5,0,1,2,3,5 'U...30
data 2,30,31 'V...31
data 6,0,1,2,3,32,33 'W...32
data 2,27,34 'X...33
data 3,35,36,37 'Y...34
data 3,4,5,34 'Z...35
data 1,43 '. 36
data 1,44 ', 37
data 1,45 'spc.38
data 2,46,47 ': 39
data 1,48 '/ 40
data 1,49 '- 41
data 2,49,50 '+ 42
data 1,51 '_ 43
data 3,52,53,54 '( 44
data 3,55,56,57 ') 45
'*****************************************************************************************************************************************
m30:' ver#( 0,0)_____ver#( 0,1)
data 0,10,0 , 0,20,0 '00
data 0, 0,0 , 0,10,0
data 10,10,0 , 10,20,0
data 10, 0,0 , 10,10,0
data 0,20,0 , 10,20,0
data 0, 0,0 , 10, 0,0
data 0,10,0 , 10,10,0
data 10,10,0 , 5, 5,0'07
data 5, 5,0 , 5, 1,0
data 5, 0,0 , 5,20,0
data 0,10,0 , 5,20,0'10
data 10,10,0 , 5,20,0
data 0,10,0 , 5, 0,0
data 10,10,0 , 5, 0,0
data 4.5,10,0 , 5.5,10,0
data 4.5, 0,0 , 5.5, 0,0'15
data 10,20,0 , 10,12,0'16...B
data 0,10,0 , 08,10,0'17...B
data 10,00,0 , 10,08,0'18...B
data 08,10,0 , 10,08,0'19...B
data 08,10,0 , 10,12,0'20...B
data 10,10,0 , 04,10,0'21...G
data 05,20,0 , 10,20,0'22...J
data 00,10,0 , 10,20,0'23...K
data 00,10,0 , 10,00,0'24...K
data 00,20,0 , 05,10,0'25...M
data 10,20,0 , 05,10,0'26...M
data 00,20,0 , 10,00,0'27...N
data 08,02,0 , 11,-1,0'28...Q
data 00,10,0 , 10,00,0'29...R
data 00,20,0 , 05,00,0'30...V
data 10,20,0 , 05,00,0'31...V
data 00,00,0 , 05,09,0'32...W
data 10,00,0 , 05,09,0'33...W
data 00,00,0 , 10,20,0'34...X
data 00,20,0 , 05,12,0'35...y
data 10,20,0 , 05,12,0'36...y
data 05,00,0 , 05,12,0'37...y
data 00,20,0 , 07,20,0'38...D
data 00,00,0 , 07,00,0'39...D
data 10,03,0 , 10,17,0'40...D
data 10,03,0 , 07,00,0'41...D
data 07,20,0 , 10,17,0'42...D
data 4.8,0,0 , 5.2,0,0'43 .
data 5,1,0 , 4.5,-3,0'44 ,
data 0,0,0 , 0,0,0 '45 spc
data 4.5,12,0 , 5.5,12,0'46 :
data 4.5,08,0 , 5.5,08,0'47 :
data 1,00,0 , 9,19,0'48 /
data 1,10,0 , 9,10,0'49 -
data 5,15,0 , 5,05,0'50 +
data 0, 0,0 , 10,00,0'51 _
data 8,0,0 , 5,03,0'52 (
data 5,3,0 , 5,17,0'53 (
data 5,17,0 , 8,20,0'54 (
data 2, 0,0 , 5,03,0'55 )
data 5, 3,0 , 5,17,0'56 )
data 5,17,0 , 2,20,0'57 )
'---------------------------------------------------------------------------------------
string1:
n$(i1)=str$(i):n$(i1)=left$(n$(i1),len(n$(i1))-1)
if len(n$(i1))=1 then n$(i1)="00"+n$(i1):endif
if len(n$(i1))=2 then n$(i1)="0" +n$(i1):endif
return
'---------------------------------------------------------------------------------------
m12: data 17,13,45,46,36,35,33,34,08,32,09,20,38,40,37,39,16,110,111,106,109,107,96,97,98,99
data 100,101,102,103,104,105,112,113,114,115,116,117,118,119,120,121,122,123
'---------------------------------------------------------------------------------------
m14:data 7'point_amount:pa
'data 200 ,300, 400'0:a20#(0)
'data 800, 300, 400'1
'data 800,-300, 400'2
'data 200,-300, 400'3
'
'data 200, 300,-400'4
'data 800, 300,-400'5
'data 800,-300,-400'6
'data 200,-300,-400'7:a20#(7)
'data 500, 600, 400'8
'data 500, 600,-400'9
'
data -300,-500,-300'0
data -300,-500, 300
data 300,-500, 300
data 400,-500,-300'3
'
data -300, 500,-300'4
data -300, 500, 300
data 300, 500, 300
data 400, 500,-300'7
'
m15:
data 5 'polygon_amount:q0.0-6
'data 5,0,8,1,2,3 ' 400:a22(100.q0,10)
'data 5,4,9,5,6,7 '-400
'data 4,0,3,7,4 ' 200
'data 4,1,2,6,5 ' 600
'data 4,0,8,9,4
'data 4,1,8,9,5
'data 4,2,3,7,6 '-300
'----------------------------
'data 4,0,1,2,3'0
'data 4,4,5,6,7'1
'----------------------------
data 4,0,1,5,4 ':0
data 4,2,3,7,6 ':1
data 4,0,3,7,4 ':2
data 4,1,2,6,5 ':3
data 4,0,1,2,3 ':4
data 4,4,5,6,7 ':5 '...comma after 7
'---------------------------------------------------------------------------------------
function sa$(i#):dim an$,aa,de$,ac$:an$=str$(i#):aa=len(an$):de$=right$(an$,1)
if de$ = "." then ac$=left$(an$,aa-1) else ac$=an$:endif: :return ac$:
end function
'*********************************************************************************************************
'*********************************************************************************************************
   '22:
'blend_01.gb:     'blend function for beginners
'---------------------------------------------------------------
declare sub find_all_files()
declare sub draw_cubes(x1,y1) :declare sub cube()
'
const d=1:
dim a
dim a#
dim a$
'
dim b#
'
dim c as integer
dim c$(1000)
'
dim g$="Textures/"
'
dim hmf
'
dim mY#,mX#
'
dim rtri#,rquad#
dim x as integer
dim y
'*********************************************************************************************************************************************
declare sub quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
find_all_files()
'---------------------------------------------------------------------------------------------------------------------------------
declare sub glC(a as integer)
dim i,i1,i2,i3,i4 'all integer
dim cr(10) as single,gc(999,2) as single
for a#=0 to 9:cr(a#)=a#/9:next'1000 gl_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:gc(i,0)=cr(i1):gc(i,1)=cr(i3):gc(i,2)=cr(i4):next'1000 gl_colors
'---------------------------------------------------------------------------------------------------------------------------------
c = GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
'
do
    glClear(c)
'--------------------------------------------------------------------------------------------------------------------
    glLoadIdentity()
    glTranslatef(0.0,0.0,-6.0)
    glRotatef(rquad#,1,1,1)
    cube()
    rquad# = rquad# - 0.15
    'draw_cubes(-3,1)
'--------------------------------------------------------------------------------------------------------------------
    'glLoadIdentity()
    glEnable ( GL_BLEND)
    glBlendFunc (GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glColor4f(1, 0.5, 0.5, 0.5)
    glBegin (GL_quads)
        glVertex3f(-2,-2,3)
        glVertex3f( 2,-2,3)
        glVertex3f( 2, 2,3)
        glVertex3f(-2, 2,3)
    glEnd()
'--------------------------------------------------------------------------------------------------------------------
    SwapBuffers ()
loop
'
sub find_all_files():a$=findfirstfile(g$+"*.*"):a=-1:do:a=a+1:c$(a)=findnextfile():loop until c$(a)="":hmf=a-1:end sub
'
sub draw_cubes(x1,y1):
mx# =-mouse_x()*720 :my#=-mouse_y()*720
glLoadIdentity ()
glTranslatef (0, 0, -16)
for y= y1 to y1+1:
for x =x1 to x1+1
glPushMatrix ()
glTranslatef (x * 3, y * 3, 0)
glRotatef ((mX#), 0, 1, 0)
glRotatef ((my#), 0, 0, 1)
cube()
glPopMatrix ()
next
next
end sub
'
'glColor3f(0.0,1.0,0.0) '___0.0=0__1.0=9,RGB
' quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
sub cube()
glBegin(GL_QUADS)
quad(090, 2, 2, 0, 0, 2, 0, 0, 2, 2, 2, 2, 2)
quad(940, 2, 0, 2, 0, 0, 2, 0, 0, 0, 2, 0, 0)
quad(900, 2, 2, 2, 0, 2, 2, 0, 0, 2, 2, 0, 2)
quad(990, 2, 0, 0, 0, 0, 0, 0, 2, 0, 2, 2, 0)
quad(009, 0, 2, 2, 0, 2, 0, 0, 0, 0, 0, 0, 2)
quad(909, 2, 2, 0, 2, 2, 2, 2, 0, 2, 2, 0, 0)
glEnd()
end sub
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a,2)):end sub
sub quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4):glC(col):glVertex3f( x1, y1,z1):glVertex3f(x2,y2,z2):glVertex3f(x3,y3,z3):glVertex3f( x4,y4,z4):end sub
'------------------------------------------------------------------------------------------------------------------------------------
'sub w(i):color(c4(i,0),c4(i,1),c4(i,2)):end sub'1000 colors wo comma
'
'*********************************************************************************************************
'    '23:
' blend_02c.fin:   (blend function with texture)
' have this photo:01.pb.jpg (=texture) in the same folder .
' build this texture :https://basic4gl.proboards.com/thread/3662/convert-photo-2022-multiplication-june
' --------------------------------------------------------------------------------------------------------------------------------------------
declare sub find_all_files()
declare sub draw_cubes(x1,y1) :declare sub cube()
const d=1:
dim a
dim a#
dim a$
'
dim b#
'
dim c as integer
dim c$(1000)
'
dim g$="Textures/"
'
dim hmf
'
dim mY#,mX#
'
dim rtri#,rquad#
dim x as integer
dim y
'*********************************************************************************************************************************************
declare sub quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
find_all_files()
'---------------------------------------------------------------------------------------------------------------------------------
declare sub glC(a as integer)
dim i,i1,i2,i3,i4 'all integer
dim cr(10) as single,gc(999,2) as single
for a#=0 to 9:cr(a#)=a#/9:next'1000 gl_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:gc(i,0)=cr(i1):gc(i,1)=cr(i3):gc(i,2)=cr(i4):next'1000 gl_colors
'---------------------------------------------------------------------------------------------------------------------------------
dim t0(100)
'a=-1:reset m1:for a=0 to 5:read a$:t0(a)=LoadTexture("files\"+a$):next
a=-1:reset m2:for a=0 to 0:read a$:t0(a)=LoadTexture(a$):next
'---------------------------------------------------------------------------------------------------------------------------------
dim rx,ry :rx=80:ry=50
glViewport(0, 0, WindowWidth(), WindowHeight())
'
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
gluPerspective(60, (1*WindowWidth()) / WindowHeight(), .1, 10000000)
glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
'
glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
glEnable(GL_TEXTURE_2D)
'
textmode(texT_OVERLAID):resizetext(rx,ry)
c = GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT    
'
do
 glClear(c)
'--------------------------------------------------------------------------------------------------------------------
 glLoadIdentity()
 glTranslatef(-1.0,-1,-6.0)
 glRotatef(rquad#,1,1,1)
 :cube()
 rquad# = rquad# + 0.05
 'draw_cubes(-3,1)
'--------------------------------------------------------------------------------------------------------------------
 'glLoadIdentity()
 glEnable ( GL_BLEND)
 glBlendFunc (GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
'
'glColor4f(1, 0.5, 0.5, 0.5)
 glColor4f(1, 1, 1, .5)
'
 glBindTexture(GL_TEXTURE_2D, t0(0))
 glBegin (GL_quads)
 glTexCoord2f(0,0):glVertex3f(-2,-2,3)
 glTexCoord2f(1,0):glVertex3f( 2,-2,3)
 glTexCoord2f(1,1):glVertex3f( 2, 2,3)
 glTexCoord2f(0,1):glVertex3f(-2, 2,3)
 glEnd()
 gldisable( GL_BLEND)
 'glEnable ( GL_BLEND)
'--------------------------------------------------------------------------------------------------------------------
 SwapBuffers ()
loop
'
sub find_all_files():a$=findfirstfile(g$+"*.*"):a=-1:do:a=a+1:c$(a)=findnextfile():loop until c$(a)="":hmf=a-1:end sub
'
sub draw_cubes(x1,y1):
 mx# =-mouse_x()*720 :my#=-mouse_y()*720
 glLoadIdentity ()
 glTranslatef (0, 0, -16)
 for y= y1 to y1+1:
 for x =x1 to x1+1
 glPushMatrix ()
 glTranslatef (x * 3, y * 3, 0)
 glRotatef ((mX#), 0, 1, 0)
 glRotatef ((my#), 0, 0, 1)
 cube()
 glPopMatrix ()
 next
 next
end sub
'
 'glColor3f(0.0,1.0,0.0) '___0.0=0__1.0=9,RGB
 ' quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
sub cube()
 glBindTexture(GL_TEXTURE_2D, t0(0))
 glBegin(GL_QUADS)
 quad(090, 1, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1)
 quad(940, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0)
 quad(900, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1)
 quad(990, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0)
 quad(009, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1)
 quad(909, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0)
 glEnd()
end sub
'
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a,2)):end sub
sub quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4):'glC(col):
 glTexCoord2f(0,0):glVertex3f( x1, y1,z1):
 glTexCoord2f(1,0):glVertex3f(x2,y2,z2):
 glTexCoord2f(1,1):glVertex3f(x3,y3,z3):
 glTexCoord2f(0,1):glVertex3f( x4,y4,z4):
end sub
'------------------------------------------------------------------------------------------------------------------------------------
'Table 4.3 Source and Destination Blending Factors:OpenGL(8th).2013.pdf
'Constant                                            RGB Blend Factor                Alpha Blend Factor
'--------------------------------------------------------------------------------------
'GL_ZERO________________________(0, 0, 0)                             0
'GL_ONE_________________________(1, 1, 1)                             1
'GL_SRC_COLOR___________________(Rs,Gs, Bs)                        As
'GL_ONE_MINUS_SRC_COLOR________(1, 1, 1) - (Rs,Gs, Bs)         1 - As
'GL_DST_COLOR___________________(Rd,Gd, Bd)                       Ad
'GL_ONE_MINUS_DST_COLOR________(1, 1, 1) - (Rd,Gd, Bd)        1 - Ad
'GL_SRC_ALPHA___________________(As, As, As)                        As
'GL_ONE_MINUS_SRC_ALPHA________(1, 1, 1) - (As,As,As)           1 - As
'GL_DST_ALPHA___________________(Ad,Ad, Ad)                        Ad
'GL_ONE_MINUS_DST_ALPHA________(1, 1, 1) - (Ad, Ad,Ad)         1 - Ad
'GL_CONSTANT_COLOR_____________(Rc,Gc, Bc)                         Ac
'GL_ONE_MINUS_CONSTANT_COLOR__ (1, 1, 1) - (Rc,Gc, Bc)         1 - Ac
'GL_CONSTANT_ALPHA______________(Ac, Ac,Ac)                        Ac
'GL_ONE_MINUS_CONSTANT_ALPHA___(1, 1, 1) - (Ac,Ac, Ac)          1 - Ac
'GL_SRC_ALPHA_SATURATE__________(f , f , f ),f =min(As, 1-Ad)   1
'GL_SRC1_COLOR__________________(Rs1,Gs1, Bs1)                   As1
'GL_ONE_MINUS_SRC1_COLOR_______(1, 1, 1) - (Rs1,Gs1, Bs1)    1 - As1
'GL_SRC1_ALPHA__________________(As1, As1, As1)                   As1
'GL_ONE_MINUS_SRC1_ALPHA________(1, 1, 1) - (As1, As1, As1)  1 - As1
'--------------------------------------------------------------------------------------
'
m1:data 00001.jpg,00002.jpg,00003.jpg,00004.jpg,00005.jpg,00006.jpg
m2:data 01.pb.jpg
'have :blend_02c.fin.gb and 01.pb.jpg in the same folder
'in folder :https://basic4gl.proboards.com/thread/3662/convert-photo-2022-multiplication-june
':observe convert_photo_PB_12.gb and build a texture:01.pb.jpg
'*********************************************************************************************************
'     '24:
'advanced blend: blend_02c.8.zip (704.92 KB)       or: 
www.mediafire.com/file/cv4hjr1e4umpywk/blend_02c.8.zip/file
'*********************************************************************************************************
' 25:Telekolleg 2 (french)
'2023,jan.18:PCN+Hedgehog:mxa()_02.gb
dim mxa,mxb,mxc,mxd
sub mxa_():mxA=int(mouse_x()*179-89):end sub '-90 to 90
sub mxB_():mxB=int(mouse_x()*357-178):end sub '-180 to 180
sub mxC_():mxC=int(mouse_x()*357-178):mxc=90*(mxc<-90)-90*(mxc>90)-mxc*(mxc>-91 and mxc<91):end sub 'small -90 to 90
'sub mxC_() and sub mxD_() are the same:
sub mxD_():mxD=int(mouse_x()*357-178):if mxd<-90 then mxd=-90:endif:if mxd>90 then mxd=90 :endif:end sub
'
do:mxa_():mxb_():mxc_():mxd_()
 locate 0,0
 printr "mxa:";mxa;" "
 printr "mxb:";mxb;" "
 printr "mxc:";mxc;" "
 printr "mxd:";mxd;" "
loop
'*********************************************************************************************************
'  26:gl_color and texture
'
1) have in the same folder:
 convert_photo_PB_12.gb and pb_01.txt    :produce:------->01.pb.jpg
'
2) find this file in a different Proboards_folder: convert_photo_PB (2022 ,6) / 8_byte_hec to dec [2022 ,11] /
'
3) have gl_color and texture.gb and 01.pb.jpg in the same folder
'
4)copy this code below into basic4Gl and the name is :gl_color and texture.gb
'---------------------------------------------------------------------------------------------------------------------
declare sub find_all_files():declare sub cube():declare sub quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)

'------------------------------------
const d=1:
dim a,a#,a$
dim b#
dim c,c$(1000)
dim g$="Textures/"
dim hmf
dim mY#,mX#
dim rtri#,rq as single
dim x
dim y
'*********************************************************************************************************************************************
find_all_files()
'---------------------------------------------------------------------------------------------------------------------------------
declare sub glC(a as integer)
dim i,i1,i2,i3,i4
dim cr(10) as single,gc(999,2) as single,cb#
for a=0 to 9:cb#=a:cr(a)=cb#/9:next'1000 gl_colors
for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:gc(i,0)=cr(i1):gc(i,1)=cr(i3):gc(i,2)=cr(i4):next'1000 gl_colors
'---------------------------------------------------------------------------------------------------------------------------------
declare sub enable()
c = GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
'
'dim t1=LoadTexture("textures/00001.jpg")
dim t1=LoadTexture("01.pb.jpg")
dim v(99,3,2) as single
'
v(0,0)=vec3(-20,0,0)
v(0,1)=vec3(-10,-10,0)
v(4,0)=vec3(0,0,0) :v(4,1)=vec3(0,1,0) :v(4,2)=vec3(1,1,0):v(4,3)=vec3(1,0,0) 'tx_coord
v(1,0)=vec3(-2,-2,0):v(1,1)=vec3(-2,2,0):v(1,2)=vec3(2,2,0):v(1,3)=vec3(2, -2,0)
'
for i=0 to 3:v(3,i)=v(1,i)+v(0,1):v(5,i)=v(1,i)+vec3(0,0,3):next
'
glBlendFunc (GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
'*******************************************************************************************************************************************
do
glClear(c)
'--------------------------------------------------------------------------------------------------------------------
glLoadIdentity()
glTranslatef(0,0,-20)
rq= rq - 0.15 :glRotatef(rq,1,1,1)
'--------------------------------------------------------------------------------------------------------------------
gldisable (GL_TEXTURE_2D)
cube()
glColor4f(1, 0.5, 0.5, 0.5) 'glColor4f(1, 1, 0, 1)
glBegin (GL_quads):glVertex3fv(v(5,0)):glVertex3fv(v(5,1)):glVertex3fv(v(5,2)):glVertex3fv(v(5,3)):glEnd()
enable()
'--------------------------------------------------------------------------------------------------------------------
glTranslatef (0, 0, -10)
'
glLoadIdentity ()
glTranslatef(0,0,-30)
'
glBindTexture(GL_TEXTURE_2D, t1)
glBegin (GL_quads):
glTexCoord3fv(v(4,0)):glVertex3fv(v(3,0)):
glTexCoord3fv(v(4,1)):glVertex3fv(v(3,1)):
glTexCoord3fv(v(4,2)):glVertex3fv(v(3,2)):
glTexCoord3fv(v(4,3)):glVertex3fv(v(3,3)):
glEnd()
'--------------------------------------------------------------------------------------------------------------------
SwapBuffers ()
loop
'*******************************************************************************************************************************************
sub enable():glenable (GL_TEXTURE_2D):glEnable ( GL_BLEND):glColor4f(1, 1, 1, 1):end sub
sub find_all_files():a$=findfirstfile(g$+"*.*"):a=-1:do:a=a+1:c$(a)=findnextfile():loop until c$(a)="":hmf=a-1:end sub
'
sub cube()
glBegin(GL_QUADS)
quad(090, 2, 2, 0, 0, 2, 0, 0, 2, 2, 2, 2, 2)
quad(940, 2, 0, 2, 0, 0, 2, 0, 0, 0, 2, 0, 0)
quad(900, 2, 2, 2, 0, 2, 2, 0, 0, 2, 2, 0, 2)
quad(990, 2, 0, 0, 0, 0, 0, 0, 2, 0, 2, 2, 0)
quad(009, 0, 2, 2, 0, 2, 0, 0, 0, 0, 0, 0, 2)
quad(909, 2, 2, 0, 2, 2, 2, 2, 0, 2, 2, 0, 0)
glEnd()
end sub
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a,2)):end sub
sub quad(col,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4):glC(col):glVertex3f( x1, y1,z1):glVertex3f(x2,y2,z2):glVertex3f(x3,y3,z3):glVertex3f( x4,y4,z4):end sub
'
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'
'27:.mouse_angle and _speed_02:
'
'2023,march.9
declare sub mouse_angle()
dim mx0 as single,my0 as single,angle0 as single
dim mx1#,my1#,mx2#,my2#,mx3#,my3#
dim mb0,f02g,f01g,f54,f01g2,a9(255),a9_115 'bool
'
dim au,iu,i1u,i2u,i3u,i4u
dim cru(10),c4u(999,2)
for au=0 to 9:cru(au)=au*28:next'1000 text_colors
for iu=0 to 999:i1u=iu/100:i2u=i1u*100:i3u=(iu-i2u)/10:i4u=iu-i2u-i3u*10:c4u(iu,0)=cru(i1u):c4u(iu,1)=cru(i3u):c4u(iu,2)=cru(i4u):next
sub w(i):color(c4u(i,0),c4u(i,1),c4u(i,2)):end sub'1000 colors wo comma
'
declare sub mouse_speed():declare sub mx3_():declare sub my3_()
dim mx2 as single,my2 as single
dim stp,c1,l1,u(99),l4,l3,l5,l6,rl1,rl2,rl3
dim f95,pc0,pc1,pc2,pc3,pc4 'bool
sub pct(i0 as integer):u(i0)=performancecounter():end sub
'****************************************************************************************************
resizetext(80,50)
w(90): print "mouse_angle " :w(900):printr "press left_mb"
w(777)
do
mouse_angle() :mouse_speed()
locate 0,3
printr "angle0:";angle0;"           "
printr
printr "mx0/my0:";mx0;"/";my0;"                      "
printr "mx2#/my2#:";mx2#;"/";my2#;"                                  "
w(990)
printr "f01g:";f01g;"            "
printr "f01g2:";f01g2;"           "
printr "--------------------------------------"
w(90)
printr "mouse_speed L6"
printr
w(c1)
printr "l3:";l3;"           "
printr "l5:";l5;"           "
printr "l6:";l6;"           "
w(999)
printr "rl1:";rl1;"         "
printr "rl2:";rl2;"         "
printr "rl3:";rl3;"         "
printr "--------------------------------------"
loop
'*****************************************************************************************************
sub mouse_angle():' mx#,my#,mb0---------->my1#,my2,mx1#,mx2
mx0=mouse_x()*721-360 :my0=mouse_y()*721-360:mb0=mouse_button(0)
'
if mb0 and f02g=0 then f01g=true:endif
if f54=0 and f01g then f01g2=not f01g2:f54=true:endif
if f54 and f01g=0 then f54=0:endif
if a9(120)=0 then
if f01g2 and f01g=0 then a9(115)=true:a9_115=0:f01g2=0:endif
else
if f01g then a9(120)=0:a9(116)=true:f01g=0:f01g2=0:endif
endif
'
if f01g and f02g=0 then
mx1#=mx0:my1#=my0:f02g=true
endif
'
if mb0 and f02g then
mx2#=mx0-mx1#:my2#=my0-my1# :
if mx2#=0 then mx2#=.001:endif
angle0=90-atand(my2#/mx2#):'mxa=angle0:mxa=angle0
endif
'
if mb0=0 then f02g=0 :f01g=0 :endif
end sub
'-----------------------------------------------------------------------------------------------------
sub mx3_():mx3#=mouse_x()*322:if mx3#<0 then mx3#=0:endif :if mx3#>1280 then mx3#=1280:endif:end sub
sub my3_():my3#=mouse_y()*244:if my3#<0 then my3#=0:endif :if my3#> 480 then my3#=480 :endif:end sub
sub mouse_speed()
dim fx,fy
mx3_():my3_()
fx= (mx3#<>mx2) :fy= (my3#<>my2)
'
if fx or fy then
c1=900
l1=l1+1
mx2=mx3# :my2=my3#
if pc1=0 then pct(1):pc1=true:rl2=0:endif
endif
'
if l1>0 then
if f95=0 then l4=l3:f95=true:endif
l3=l3+1:l1=0:pct(2):pc2=true:
if f95 then
if pc4=0 then pct(4):pc4=true:endif
l5=l3-l4
pct(5) :if u(5)>u(4)+100 then l6=l5:pc4=0:l4=l3:endif
endif
'
if pc1 then
if u(2)>u(1)+100 then rl2=rl2+1:rl3=rl3+1:pct(1):endif
endif 'if pc1
endif
'
if pc2 then
if l6>9 then stp=50 else stp=300:endif
pct(3)
if u(3)>u(2)+stp then
pc3=true:pc2=0:pc0=0:c1=999
rl1=rl1+1:rl3= 0:f95=0:pc1=0:pc4=0:l6=0
endif
endif
end sub
'-----------------------------------------------------------------------------------------------------
'    28:circle_21b:
dim angle#
dim a31(99),i,beta1#,beta3#,beta4#,beta5#,b#(10,1000,2),hmf,i11,rad,x8#,z8#
'
declare sub compute_basic_circle(i00,r0,st,beta2#) :declare sub debug()
rad=10 :hmf=36:compute_basic_circle(0,rad,10,hmf*10) '360/10=36 steps
'
debug()
'
declare function vL(va() as single,vb() as single) as single
dim l1#,l2#
declare sub mouse(x,y)
declare sub circle(v() as single)
dim v0(1) as single :v0=vec2(10,10)
dim v1(1) as single,v2(1) as single
dim mx#,my#,m(1) as single
textmode(texT_OVERLAID):resizetext(80,30)
dim c = GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT
dim f01,f02,f03,f04,f05
dim i1 as single,i1b as single,i1c as single,i1d as single
declare sub lines():declare sub txt():declare sub points()
function y0(m#,x,t) as single:dim y1#:y1#=m#*x+t:return y1#:end function
'****************************************************************************************************************************
i1=-100 :i1b=.1
glTranslatef (0, 0, -200)
'
do
  glClear (c)
  mouse(300,250)
  v1=m : circle( v1 )
'
  txt()
'--------------------------------
   lines()
  points()
'
  i1=i1+i1b
  if i1>250 then i1=-100:endif
  v2 = vec2(i1-i1d-18 ,y0(-.66,i1-i1d-18 ,90)) :circle( v2 ) 'left
  v1 = vec2(i1+i1c ,y0(-.66,i1+i1c ,90)) :circle( v1 )
'
  l1# = Length(v1-m)
  l2# = Length(v2-m) 'left
'
  if l1#<20 then f01=true :i1b=0 :endif
  if f01 and l1#>20 then f01=0 :i1b=.1:endif
  if l2#<20 then f02=true :i1b=0 :endif 'left
  if f02 and l2#>20 then f02=0 :i1b=.1:f05=f05+1:endif
'
  if f01 and f02 then:: i1c=i1c+.05 else if i1c>0 then i1c=i1c-.1 :f03=f03+1: :endif ::endif
  if f02 then:: i1d=i1d+.05 else if i1d>0 then i1d=i1d-.1 :f04=f04+1: :endif ::endif
'
  if f01 and f02=0 then:: if l1#<19.5 then i1b=-.1:endif ::endif
'--------------------------------
  drawtext():SwapBuffers ()
loop
'****************************************************************************************************************************
end
sub compute_basic_circle(i00,r0,st,beta2#):'xz...horizontal
 i11=-1:beta1#=0:beta3#=360/beta2#:beta4#=st*beta3#:beta5#=360+beta4#
 do: i11=i11+1:
  x8#=cosd(beta1#) *(r0) :z8#=sind(beta1#) *(r0)
  b#(i00,i11)=vec3(x8#,z8#,0)
  beta1#=beta1#+beta4#
 loop until beta1#>=beta5#
 a31(i00)=i11
end sub
'
sub debug():textmode(texT_OVERLAID):resizetext(80,40)
  print "test":for i=0 to 100:print b#(0,i,0);" * ";:next
end sub
'
'for angle# = 0 to 2 * m_pi step 2 * m_pi / 360 :glVertex2f (sin (angle#), cos (angle#))
sub circle(v() as single):glColor3f(0.5, 0.5, 0.5)
glBegin (GL_LINE_LOOP)
 for i=0 to a31(0) :glVertex2fv (v+b#(0,i)) :next
glEnd ()
end sub
sub mouse(x,y):dim x1,y1,a1
 x1=x/2 :y1=y/2
 mx#=mouse_x()*x-x1 :my#=mouse_y()*y-y1
 m=vec2(mx#,-my#)
 while SyncTimer (10) :a1=a1+1:wend
end sub
'
sub lines():glColor3f(1, 1, 0)
glBegin (GL_lines)
 glVertex2f (-50,0):glVertex2f (50,0):
 glVertex2f (0,-50):glVertex2f (0,50):
glEnd ()
end sub
'
sub points()
glPointSize(2)
glbegin(gl_points)
 for i=-100 to 200 step 2
  v1 = vec2(i,y0(-.66,i,90))
  glVertex2fv( v1)
 next
glend()
end sub
'------------------------------------------------------------------------
sub txt()
locate 0,3:
printr "m(0):";mx#;" "
printr "m(1):";my#;" "
printr "L1#:" ;L1#;" "
printr "f05:";f05;" "
printr "i1b:";i1b;" "
end sub
'------------------------------------------------------------------------
function vL(va() as single,vb() as single) as single:dim a#
  a# = pow ( pow(vb(0)-va(0),2 ) + pow(vb(1)-va(1),2 ) + pow(vb(2)-va(2),2 ),0.5 )
  return a#
end function
'****************************************************************************************************************************
'
' 28b:circle_22b:
'
'
dim angle#
dim a31(99),i,beta1#,beta3#,beta4#,beta5#,b#(10,1000,2),hmf,i11,rad,x8#,z8#
declare sub compute_basic_circle(i00,r0,st,beta2#) :declare sub debug()
rad=10 :hmf=36:compute_basic_circle(0,rad,10,hmf*10) '360/10=36 steps
debug()
declare function vL(va() as single,vb() as single) as single
dim l1#,l2#
declare sub mouse(x,y)
declare sub circle(v() as single)
dim v0(1) as single :v0=vec2(10,10)
dim v1(1) as single,v2(1) as single
dim mx#,my#,m(1) as single
textmode(texT_OVERLAID):resizetext(80,30)
dim c = GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT
dim f01,f02,f03,f04,f05
dim i1 as single,i1b as single,i1c as single,i1d as single
declare sub lines():declare sub txt():declare sub points()
function y0(m#,x,t) as single:dim y1#:y1#=m#*x+t:return y1#:end function
'****************************************************************************************************************************
i1=-100 :i1b=.1
glTranslatef (0, 0, -200)
do
  glClear (c)
  mouse(300,250)
  v1=m : circle( v1 )
'
  txt()
'--------------------------------
  lines()
  points()
'
  i1=i1+i1b
  if i1>250 then i1=-100:endif
  v2 = vec2(i1-i1d-17 ,y0(-.66,i1-i1d-17 ,90)) :circle( v2 ) 'left
  v1 = vec2(i1+i1c ,y0(-.66,i1+i1c ,90)) :circle( v1 )
'
  l1# = Length(v1-m)
  l2# = Length(v2-m) 'left
'
  if l1#<20 then f01=true :i1b=0 :endif
  if f01 and l1#>20 then f01=0 :i1b=.1:endif
  if l2#<20 then f02=true :i1b=0 :endif 'left
  if f02 and l2#>20 then f02=0 :i1b=.1:f05=f05+1:endif
'
  if f01 and f02 then:: i1c=i1c+.05 else if i1c>0 then i1c=i1c-.1 :f03=f03+1: :endif ::endif
  if f02 then:: i1d=i1d+.05 else if i1d>0 then i1d=i1d-.1 :f04=f04+1: :endif ::endif
'
  if f01 and f02=0 then :: if l1#<19.5 then i1b=-.1 :endif ::endif
  if f02 and f01=0 then :: if i1d>0 then i1d=i1d-.05:endif ::endif
'--------------------------------
  drawtext():SwapBuffers ()
loop
'****************************************************************************************************************************
end
sub compute_basic_circle(i00,r0,st,beta2#):'xz...horizontal
i11=-1:beta1#=0:beta3#=360/beta2#:beta4#=st*beta3#:beta5#=360+beta4#
do: i11=i11+1:
x8#=cosd(beta1#) *(r0) :z8#=sind(beta1#) *(r0)
b#(i00,i11)=vec3(x8#,z8#,0)
beta1#=beta1#+beta4#
loop until beta1#>=beta5#
a31(i00)=i11
end sub
'
sub debug():textmode(texT_OVERLAID):resizetext(80,40)
print "test":for i=0 to 100:print b#(0,i,0);" * ";:next
end sub
'
sub circle(v() as single):glColor3f(0.5, 0.5, 0.5)
glBegin (GL_LINE_LOOP) 'for angle# = 0 to 2 * m_pi step 2 * m_pi / 360 :glVertex2f (sin (angle#), cos (angle#))
for i=0 to a31(0) :glVertex2fv (v+b#(0,i)) :next
glEnd ()
end sub
'
sub mouse(x,y):dim x1,y1,a1
x1=x/2 :y1=y/2
mx#=mouse_x()*x-x1 :my#=mouse_y()*y-y1
m=vec2(mx#,-my#)
while SyncTimer (10) :a1=a1+1:wend
end sub
'
sub lines():glColor3f(1, 1, 0)
glBegin (GL_lines)
glVertex2f (-50,0):glVertex2f (50,0):
glVertex2f (0,-50):glVertex2f (0,50):
glEnd ()
end sub
'----------------------------------------------------------------------------
sub points()
glPointSize(2)
glbegin(gl_points)
for i=-100 to 200 step 2
v1 = vec2(i,y0(-.66,i,90))
glVertex2fv( v1)
next
glend()
end sub
'----------------------------------------------------------------------------
sub txt()
locate 0,3:
printr "m(0):";mx#;"     "
printr "m(1):";my#;"          "
printr "L1#:" ;L1#;"     "
printr "f03:";f03;"        "
printr "f04:";f04;"         "
printr "f02:";f02;"         "
end sub
'----------------------------------------------------------------------------
function vL(va() as single,vb() as single) as single:dim a#
a# = pow ( pow(vb(0)-va(0),2 ) + pow(vb(1)-va(1),2 ) + pow(vb(2)-va(2),2 ),0.5 )
return a#
end function
'****************************************************************************************************************************
'

Attachments:

new_inkeys_ah.solar.zip (204.43 KB)

[matthew]

Nice keyboard checking utility.