NEW:diverse projects, keys,inside polygon [2023,may 09]
Dec 18, 2019 18:49:43 GMT -5
matthew likes this
Post by hedgehog7777 on Dec 18, 2019 18:49:43 GMT -5
'last edit: 2023,may09: [ find :28c:circle_27c10.fin ]
'
' for questions and answers , Email to :chuck.summer@mail.com
' press ctrl and - for smaller texts.
'
Basic_news:check this for a different Basic:
'-------------------------------------------------
libertybasiccom.proboards.com/board/14/liberty-basic-v4-5-1
rcbasic.freeforums.net/
www.jose.it-berater.org/smfforum/index.php?topic=979.0
www.jdoodle.com/execute-freebasic-online/
rosettacode.org/wiki/Category:FreeBASIC
www.freebasic.net/forum
www.purebasic.fr/english/
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
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 a:circle_21
28 b:circle_22
28 c:circle_27c10.fin
29 a: convert text into font
29 b: font.03.txt
30:Hedgehogs Star_field
update: .k_teach & starfield and texture_PB_06.fin:one texture for 2 triangles
31:minesweeper.0.01
'
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
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 :chuck.summer@mail.com
'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: find_all_files and content_30b '4/29/2022
manual:
'-------------------------------------------------------------------------------------------------------------------
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 :chuck.summer@mail.com
'-------------------------------------------------------------------------------------------------------------------
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 )
'
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 ' loop until f01 (not for fullscreen)
' dim i0,f01:do: f01= keydown("N") :loop until f01:color(0,255,0):printr "end"
'*********************************************************************************************************
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.gb: (blend function with texture)
' in one folder :01.pb.jpg and blend_02c.fin.gb
' find 01.pb.jpg: basic4gl.proboards.com/thread/3662/convert-photo-2022-byte-hec
' --------------------------------------------------------------------------------------------------------------------------------------------
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:Telecollege 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 this file ready: 01.pb.jpg
2) find this file : basic4gl.proboards.com/thread/3662/convert-photo-2022-byte-hec
3) in one folder: 01.pb.jpg and gl_color and texture.gb
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
'-----------------------------------------------------------------------------------------------------
28a: 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
'****************************************************************************************************************************
28c: circle_27c10.fin
'circle_27c10.fin.gb 'Line 1
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#)
'
rad=10 :hmf=36 :compute_basic_circle(0,rad,10,hmf*10) '360/10=36 steps
rad=100 :hmf=720:compute_basic_circle(1,rad,10,hmf*10)
'
declare function vL(va() as single,vb() as single) as single
declare sub mouse(x,y) :declare sub circle(co,nr,v() as single)
'
dim lr as single,ll as single,l3#
dim v0(1) as single :v0=vec2(10,10)
dim v1(1) as single,v2(1) as single,v3(1) as single,cc '(2) 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,iL2 as single,iR1 as single,iL1 as single
'
declare sub lines():declare sub txt():declare sub points() :declare sub window(x,y)
function y0(m#,x,t) as single:dim y1#:y1#=m#*x+t:return y1#:end function
'
dim i1db,i2,i2b
dim f06
'2023,4
dim u(99),pc0,iL as single,iR as single,ileft as single,iright as single,iR2 as single,iL3 as single,iR3 as single
dim f2b 'bool
sub pct(i0):u(i0)=PerformanceCounter():end sub
'
dim a,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
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a,2)):end sub
dim s1 as string:for i=0 to 3:s1=s1+chr$(32):next
'**********************************************************************************************************************************************
window(1900,900)
iR=-250:iL=-250
iL3=.2:iR3=.2
iL2=iL3:iR2=iR3
i2=0
'
glTranslatef (0, 0, -200)
resizetext (100,50)
v3=vec2(0,0)
'
do
glClear (c)
'---------------------------------------
mouse(300,250)
circle(900,0,m ) :circle(990,1,v3)
txt()
lines()
points()
'
iR=iR+iR2 :iL=iL+iL2
'
if iL>285 then iL=-280:endif
if iR>285 then iR=-280:endif
'
ileft=iL-iL1-18
v2 = vec2(ileft ,y0(-.47,ileft ,00)) :circle(90,0,v2) 'left
'
iright=iR+iR1
v1 = vec2(iright ,y0(-.47,iright,00)) :circle(90,0,v1) 'right
'
ll = Length(v2-m) 'left
lr = Length(v1-m) 'right
l3# = length(v1-v2) 'length between marbles
'-----------------------------------------------------------------------------------------------------------------------------
'left marble
if ll<20 then f02=true :iL2=0 :endif
if f02 and ll>20 then f02=0 :iL2=iL3:endif
if f02=0 and l3#>=19.889 then iL2=iL3 else f05=f05+1:iL2=0:endif
'right marblw
if lr<=20.1 then f01=true :iR2=0 :endif
if f01 and lr>20 then f01=0 :iR2=iR3:endif
'
if ll<20 then iL2=iL2-.1:endif
if l3#<20 then il2=il2-.1:endif
if f01 and f02=0 and lr<20 then ir2=ir2-.1:endif
if f01 and f02 then ir2=ir2+.1:endif
'
if keydown("N") then do:loop:endif
'big circle-----------------------------------------------------------------------------------------------------------------------------
i2b=i2b+1:if i2b=8 then f06=true:i2b=0:endif
'
circle(99,0,b#(1,i2))
'
if f06 then i2=i2+1:if i2=a31(1)+1 then i2=0:endif:f06=0:endif
'
if f02 and pc0=0 then pct(0):pc0=true:f2b=true:endif
if pc0 then pct(1):if f02=0 then if u(1)>u(0)+700 then f2b=0:pc0=0:endif:endif:endif
'-----------------------------------------------------------------------------------------------------------------------------
drawtext():SwapBuffers ()
loop
'**********************************************************************************************************************************************
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
'
'for angle# = 0 to 2 * m_pi step 2 * m_pi / 360 :glVertex2f (sin (angle#), cos (angle#))
sub circle(co,nr,v() as single): glc(co):glBegin(GL_LINE_LOOP):for i=0 to a31(nr):glVertex2fv (v+b#(nr,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
mx#=mx#*2
m=vec2(mx#,-my#)
while SyncTimer (10) :a1=a1+1:wend
end sub
'
sub lines():glc(990):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=-300 to 300 step 2:v1 = vec2(i,y0(-.47,i,00)):glVertex2fv( v1):next:glend():end sub
'----------------------------------------------------------------------------------------------------------------------------
sub txt()
locate 0,35:
printr "lr:" ;lr;s1
printr "ll:" ;ll;s1
printr "L3#:" ;L3#;s1
printr "i1:";i1;s1
printr "iR2:";iR2;s1
printr "f01:";f01;s1
printr "f02:";f02;s1
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
'----------------------------------------------------------------------------------------------------------------------------
sub window(x,y):setWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow():end sub
'****************************************************************************************************************************
'29a:convert text into font:
'
'converter:
'
m5:
data "font.03.txt"
data "font.03.png" 'destination :13099 bytes
'use this data (above) to convert text into font (png)
'----------------------------------------------------------
'use this data (below) to convert a different text into jpg
'data "pb_01.txt" 'text to convert (source)
'data "03.pb.jpg" 'destination (converted)
'
dim sf$,df$:reset m5:read sf$,df$
'**********************************************************************************************
dim a$(99),c$(99),d$(9999),da$(9999),d1$,e$,d2$(99999),rp$(9999)
dim i1,rb(100000),e,i0,wf,f,i2
'-----------------------------------------------------------------------------------------------------------------
declare function hex$(a,s) :declare function dec(h$) :declare function r0(a)
dim ba(4),s0,s1,s2,s3,s4,s5,s6,i,a,c,i001,i002,i003,i004,dc, s=5'amount: 1(1 byte),3(2 bytes),5(3 bytes)
dim h$,s$(s),s1$(15),b$,i$
reset m1:for i=0 to 15:read s1$(i):next
reset m2:for i=1 to 4:read ba(i):next 'ba=byte.amount
'convert_photo_uc08f - convert_photo_PB_12:2022,6.21 -------------------------------------------------
declare sub file_error()
dim l1,l2,ia,file,i4,i3
dim p1$,p(99999),p1
'-----------------------------------------------------------------------------------------------------------------
resizetext(100,40)
'-----------------------------------------------------------------------------------------------------------------
file = openfileread(sf$):file_error()
i1=-1:do :i1=i1+1 :da$(i1)=readline(file) :loop until da$(i1)="":ia=i1-1
'
l2=len(da$(ia-1)) :l1=len(da$(ia)) :printr:printr da$(0):printr l2;"/";l1
'
i2=-1
for i=0 to ia
for i1=1 to len(da$(i)) step 2
p1$=mid$(da$(i),i1,2) :p1=dec(p1$)
if i=ia then print p1$;"=";p1;"/"; :endif
i2=i2+1:p(i2)=p1
next
next
'
printr:printr p(i2) 'last byte:217,d9
'
file = OpenFileWrite (df$):file_error() :for i=0 to i2:writeByte(file,p(i)):next :CloseFile (file)
color (0,255,0):printr:print "End":end
'-----------------------------------------------------------------------------------------------------------------
function r0(a):dim x2:a=a+1:x2=(rnd()%a):return x2:end function ' 0-10
sub file_error():if FileError () <> "" then print FileError ():end:endif:end sub
function hex$(a,s):dim s0,s1,s2,s3,s4,s5,s6 as integer
s=ba(s):s0=s-1:s1=a:s2=a:h$="":for s6=0 to s:s$(s6)=0:next
do:s3=-1:do:s3=s3+1:s1=s1/16:loop until s1<16
s4=s0-s3:s$(s4)=s1$(s1):s5=pow(16,s3+1)*s1:s2=s2-s5:s1=s2
loop until s1<16
s$(s)=s1$(s1):for s6=0 to s:if s$(s6)="" then s$(s6)="0":endif:h$=h$+s$(s6):next:return h$:end function
'
function dec(h$):i001=len(h$)
i003=-1:dc=0
for i002=i001 to 1 step -1:i003=i003+1
i$=mid$(h$,i002,1):i004=asc(i$)
if i004>47 and i004<58 then i004=i004-48:endif:if i004>96 and i004<103 then i004=i004-87:endif
dc=dc+i004*pow(16,i003)
next
return dc
end function
'
m1:data 0,1,2,3,4,5,6,7,8,9,a ,b ,c ,d ,e ,f
m2:data 1,3,5,7 'hex$(a,b):b=1:1 byte,b=3:2 bytes,b=5:3 bytes
'****************************************************************************************************************************
29b: font.03.txt: '[ text for conversion: 1st byte 89 ... last byte 82 (size: 26460 bytes) ]
'
' use converter above in the same folder:
' copy this text into Notepad, save it with the name : "font.03.txt" :
'
89504e470d0a1a0a0000000d49484452000001000000010008060000005c72a866000000017352474200aece1ce90000000467414d410000b18f0bfc6105000000097048597300000b1300000b1301009a9c18000032c049444154785eed9dcdb9f4b071
a5f53902a5e0c9c00e41218c42f06430b39ca597dacece5b2d67eb9d1582958115829d817c4ef11405b241b20aec665f76d7fb3cbc24c03a04887f8260dfdf1445f1bdfcd2fe23f92be0fe17308f24efd6bf038ff31677ba97e298bfd3be288a2fa44600
3bbc5bff0e3cce5bdcfd5ea2f15f6bdf79df6d5c22f158c7dde9696b04507c2c2cf044ce305e812437fd56a57a150ccf91d74ba806e04351d99991770a95ffb7f57ccf60f4de7f0a23e9dfd36c5da71a800fa457e8b315a12d305b85e753f1fb659a91d6
ef6a3cfc57f1d29bea45fe282147345bfc94f033fa5ef82d916b6d5d23a35ddb6ef9ff64cec6f99df7bc0e3b1317b75dd3d3bef4c63291ee7156ff6ede157f0f774d241e5b71def2ffc98cc6d9756baebcf775dcd7ee23dcded9d2d523c007d2cbecad02
b0455b80d685e90e9c8933d38ac8f9e0fe24aa01f850546667e49d829588c8791b3cce7edf77bc87966cfc7bf65bd7a806a0287e185b95f5155403507c1ceb9edfdd7785f177e4b58b4c1fd0e9052f4d98b31970f70cbc63fc3dce5bdc352f8a3e350228
8aa2288aa2288ac2e1f32091f37214fcdbc23f8ba2ffb5e9a7e06f9b7fdfc06573002a0be1c2d0da66740e35647d1c4592053af535e8b6bfeebebf894b1a806c21ead967af71862bc3faa9b46950e9f1b9bcbc0118293c7cd544e47c7017afa5976723f9
58fc7c5eda0054a1b9276a6fab01fe025ed60054e52f9e01cb11913385a4550e777868d58f122cd213ec5d23d393f875321aa7d566afe3f66b22fa2dad73748d57e88f345bf8b5ceea5b46ae35128f11cd37b29b386712d1b56b32d77a46f8d48e5cc735
2d19fd33188977cb5df5aeeb11b9d659fd37f1b24780bb27741594f7c1b46f9177384fd69a167917e2a59380ef4c70cb6db03e2eee85f7e6d9fc73fbbdd14071c16bc06cc611661a91f3c15d7c0f2c3f44ce149256c3bfc3cb1b0092cd849e7df61a6a33
acd1d061352045b1e2920680b00213390f696d33baa2289e843aceea39df84927f38fd257f5bfe29f82a3f455114455114455114c58fa79e5f8b4fe7a56f016c0608c8194632d3e970a82242f69f3a5c1c1f01dbffedf6d8ff07dd7622006cff091bf927
79d1ef5fb0fd4ece4360fbf7d8fe0d9bc3e3bfd7e93093f45c2306f9efb0fd879c29a8a35ece21a0af46f80448bedf321fe4bc16661e91338c64a71a0048fe01dbbfad8f8f809d57e035a1460076ff898d89de363ea90ca03d36c286801b4967a274671b
00c6e55fe44c411df572a6808e8ddeffa71edb3ff358a7c24063c8f995e0f6599eff59ce6bb1d4077286818495c87be0f9380334ecc5edc6dbe323181636c24683b00724a1824cc3d59e19101e4110d8b771f00660240d86d2ce81d6d3e07fca2b057593
fcafff20af14d0f92828d478af91f6db1b00a6e150fa9f0601b3f51ee9b91869efbde7e328b0efa2d3bbc0cc7b5f2bfcf20e03092bdd3c02c09ed7fbad9d0c027baf385681a7c37c2584269d762dd0b20727a315d81b90f408021af6fe0c9fd7a811c020
b8fde10ee03408fc54013c03c29d1b9ef6f808d8b2c7f74a4758f8c21518b6f31c003616de9182bb8ec35b5a7084fbef0c5cce21a807ff2ee7cb51789bc8ec2bc0edb223197a7c7b0a08fc2d0d00c29c273edae328d278453ed303dbe41fb6b951d0a94d
60d3f6fe3e1ab14cc49e8f32a9d1c4192c6420e710bac465154fc16d22b34b509033f2be0c04c9f237f4f8f61410380b6ceaf9f71920cc2e3a1dc6352606e69900126f8458991713835bc89670f4601a73a93706978d0614dea982ab4b5c5ef889827e4b
d844c1cfc8fb3210e4fb86ffef04373e373ced7104d87aafeb937f439370b09f27ff286ef77bd086c849b78f08c8a519aa304f155c5de2f2c24f14f45bc27e37b86d76206f79fc9eb1d407725e0682e4a387f594ed7104d8b2c1e8911a4ac17e9efcc33e
3302e09c03b1f0b89f9c06af73e5088069f78c06e05df340869c69247f5b03a2e087c2878ce5e8f091f3a558ec819c978120e78ad61e4781868d800fbd5909528b7060bf98fcc371780e80c08ee1fb4884300ebc061f032e9bd44158de180d353ad44df2
37bd873e89e27ed70620fdf6a958319af89f026edf1f7f862692a89be4f9558c3f01c61b5b6a02f96e5cf6832077e4db7f8804b7ff17ecb8fda379e4a1eecfbace1de168ebf7d361517c21e801398c1fea05a9a35ecea2288aa2288aa2288ae20782e736
cedefa6b28ee476781f941477a261d122ec2f1f0f93a2ef5ea0bf6ed6bb4b4de816e5e8927af10b4efa1d387c094b3cff60e5e845fa3c9be8b4c0e81299790fa6bd0d1f4773d5f5d9efa4d802207d35be9eec4f30086feee764d6631cda200cb3b04cc7d
05de9a502184ddd6429ef4621468e64494d72130dd4abfd03560c6b4f3cad312fd9c798b68faf917806ba27a5f3bb0e6b693818c3bb64b1633319c3369056dbb706ccd71470e23ebb5816538f79333fe559becd39587c0dc1b0e5f463b3708667000cc5c
6f2d1ef67385348320305f2cc691f72130f5453f43df4040e7e9ede9eff11f2a80d0596f2ce72116d2841542ee276738fd1d7bf78fbdeb2fff9c57f233fa744726d32e32d945a684e18efc0a94771eed2f52791e1c97031ad1524e836e90294456582759
2e03606e092ea74137187d15952e80b0754daaf013987a056e1f41d2df22c8790a5c868f3064e45b887503104a7fd992b57e6445a621671ac9d37a48986eed4888c7a15e7932ef23935d60c6f45a877d6a451ff43e2a3ece43192e222baf918434e41c02
724f8cf43c04345e98538d07edb1f9af09197622004ce71e6345a812ca968d86df378f8796d24267d7903304cc6df51b750d74877a23d86d3d029c2a07578168b6e9ce8af396e5b40c171bd3d23a64107a045b039d8fc4b93fcec3c9769959f24a67a064
c3190fa967c6d0709a40eb8f10a11100ec18e6fc0316a604721e02533600cc34ef01fd9120db83ae493702d0301ea9a137ecd90379a173e6fb8900db45c1c566c73afda3517c09e3cce3540360ca0d641202e6a71b0068bc338a6b61fc905974834b8770
9079e4535f34c1de2aa09c865d05c8b98b4cbbc8248de4d1f03dc3d743e854f830f7c9a06cfa9d7a04e871567f3588eb473c024cf264b985fde9494047ba74c581c4872d23c3fe75fcbd22841a30d97691c92e30f30ae493901e7e7404e0f1f70ac821b9
61064160beb84e1469c8500304336fb85defe5676808fb4e106736047e3fe9723c8282220cf7fac70f04baf51a2e55908874d982dbb67e0b64b20bcce602bb627456de90f310986ebd860cbd8785dd56fc538f00b0b78648ce30906ca57fa802c3ae3707
c051cdc88cb621671ac987f50e2ec13cb9c56bc0165cc790330e34cf5a0864c81902e63e047e402687c0948d581bffe11f46982e91be077bf566c229fcd44218da63f35110af936ebc26e958e1878cf1f7f463f8d9c6a76d44381249577e32c9c7ee8148
3eacbf3bbafdafbdffe2cb41d9b7371a721645f14da0f23f6d385d1445511445511445511445f151fc755afcc0e5abf30208c1d7527cc71b5e9c60aa89cc87445b6497b4f25594bf8a63dca3efe17ba45e654d923e32d945a65d64b20bccdad778247dff
72cec83bf54a4992d3afa1749954dac969c0c932cdb2c0ed301f6163c819463267f1ea9ceec97b42de0fe83459eb0d397781595bf6b98f2dc282a1bfff67455fcc9ec2cd572af4e7f9c37501b0592f283a53019dd0620cd8f93bf4358771905d0f2664a8
f19bccfbc86417997691c92630d9ba7712be7f3967e41d8abf23494ad3439749a59d9c069c4c9350e527d41339c348e62c3a2cba27ef09793fa0d364f1fa527e877182c956feefff835618b0f253ccd6929b47d82afc7468f09889b9fb7a05e77d31888f
24a22bc90c390d38c3cb6161e22bf1ec5ee437df8b19ed20bb391c1cb6cb4187ef2183e4693d249ee673fe60cff87ba148dfbf23ef549c24194e074797095d47a6b32d0e53959f504fe40c2319b1f2226fc37c9b51b5bc1fd069675e0026f76e9c70ba2d
fb76bfdccb4dfa0bca70c287485e615ce0f09ca1f36c047687e438ef1a5e9ba4d6e2cb69c0e9cb630f4700b0f1b8cf198e63afc487ef842924721a70fa3d44d7f31b72a6913cad87c487fdebd1dba9fb27f24ec54992e174707499d075646ab6d8795908
8d3e1d69d2f1968c7887692365ee27e7df3a521374d069c2bc6ceba461461be0f456fe7bfde9975f9c60cf61ad03f7b4043664c0be5d9b3e57403a74f8004e2d3ec1e57e72c60b600716e0c321f8649acf3c47f207bdbc43d795691799ec22d307747a13
990ddf3bd12536915908494ec587e832d9b46b3bb1d48748d2a4e32d99e974b828ff8dffe6b5759aaceb9061461bc8a46ba3537d3dfcd972f890a1d7833af39a703a74f800ed781eac5bc0c335e5b2db22ac97338de40f7a7987ae2bd32e32d945a60fe8
f426325bd8c96b46de9bc86c1399859024a5e9a1cb84ae235362c37e6cde2b86e66f88ecd3f196cc74d879a7e7a3c75045d669bf863f32cc9db0196d2093ae8d4ef5f5ed09b30272d2dd8e00bc42db73851974c0394ff43543cfa070861280c0c4c3fee6
478079c82bf78cbc3791d9839dbc537192e4b4465ea1ebc894ac3b9ff02840f6a97813c94c879d87eb95d8e363f0b8874efb35bcdccda31933da00a71ff29fd03d796f3f02cc1736b309ab2cd8b743291f25f0a6bacf55b4a1e10e73c5ec219bc58dc299
69007cf4c1789f9e042470fae4daed2601098fcd17c86b13993dd8c93b152749b21a2fc4f60527f65e78cfcc21f9350f3b0022db54bc8964b34e4e435e87d7d6e9d6decbb321ef2e38dd4e027afd65de7b1dde9c049c2b34f65e881e68ce6f56049cf308
2f3ec1a57bf2de1fc6cb668b68059c272d571c4e06c9aec73c2173c464de4726bbc83464bb06b2b6c16e61fc0f3f8b9e4c1fc396772a4e9264355be52ff449b26c1761c2e98d48f435f22632e92293d90687def1cc13e6726f5e47a7d7f19fcbb3bc3681
c956fe6fbf06c4490e57da093e1fb670cf731e81cd9edfc1f9872138a17bf2deef8565d3233b91d3162426ca61e52793f903ccc8dd914bcb24e923935d641ab2ed0169bb108879777af82bef549c2449df0724cc3b2f73bc8ff0ef214c926efcbd4c871f
037bc8a48b4c661b1cfa63800dff89dc9bd7d1e9c57938bdf3dc0ddf81599b7eb1fc87112b49b487e58dcdad5a51141f002a355b49b6b86c71162d25dc9c90b09102b6aafc45f189b0e263e31062fd2c6123046ca18994a2288aa2288aa2288aa2287e3e
f6c4ff4878e20fb6f9d710629274494d3cc27e1d87d47be42d64b689cc1eece41dd1fbdccbd66bd4eefb5cf8fb6bbf79ad028ee7fb9717fd765735c2df170d2dc2a17bf2de9e03c2b9cd38d26f3a155b08b685cc42483223ef1030677a86970fafb1001b
e49d0232c621fc5b1a4fc362dce7b012c2663d79e86c2f446890ed16a1460076acfc3dce7e8b10a9c0869c33f28ee8bb0ba6e89ebcfb8b79e0ef8b4e7c41d77a45a6553cec171f99f4c0394f3f5f8de7713a6cc861f3104f1e4f5ea7d33fdc91106966e4
1d02e6bc8fc385535b58800df20e0389af2120f33a824b50a073a471185a4a8ad3bda5882c88de281c2ee890dd221c38e7c22caf5d644ad6853ed59a4a93ca3c491e34f23ebc164cba3d34dd9377bf5782bfa7bd5532ece7c523c22bb357d0ddbcc0798e
1eb8313e76ac5387acedb3fa16e8ba239208d2a5f2cf818ce186560eee61110072868184f9cd7ac3ed7009fb534180869c9e1886bcbae0b417d2f51a827026ca6e110e9cae0f2504ec58e0c8700b4e748d54e649f2a09177e85a30f306d31bd1c3f4c339
b7b1428bbd8f08bc61b01e1ffbd08a389cef36201160ebbd1747123e9a18eac5a0b3c6035b7825a6c340899c69203d3dfc9e62902e439e97cc03cf87d04ad6a7a0007bec0ec164d3bd599d3a4c08996d115a120abbde2340680ea045ba6ce61972cec83b
742d98cd1548ee5025928d85819d35828dbf15661d47e3e10dd148efeb0d0d19ea49a1f3466cb4f130e44c0329d3fdd4f0db2200e40c01734f3b8ebe7c44787a34124601ae893cff19722ed0a9c38490d91a8e2c5219017b0e757d44e2a41a0169b29967
c83923eff0b564ee9576aecc7bc0c42bac37203e1a707f7f148acec79c6900da398891dedb7bbed4737f8bf4a9fc6b8194e9381c3eb1080039ef81e29c8e34248b4700ecd982b7c398c32195ec2c6cec58887c389feec10974bc86879fba27499ea29177
f85a30f5decf7bffc804acdb7a3ef87c803ff77bcf1269cce73413e9c729e952e94720f1c623ddf0b4e81ae9f05b203ff51830c5e05c1c2e47711ec9382f68ec393874696732497a148143efb5486814003b6f341e66c4cd208824598df79af3bdf278f2
8abdc520b05da7dde1bdd366329df1fb6fd3901c5666d8300db9a527011d680c39c340c2068c61a6470e2d0c9bc83904e46c3477e74bf6b0080039ef81e23c1469c8bcf2adb1c224b34d26d365d8707a6f182a84b0f389af35a9e19c34a97480f956d824
3591037b4fcbe87db7c3ee751ab6ec562c9cf706cbdf1c0c0dc7a5c9a69f87dd456621244969d640ce7b1f1a7d128b0090f31e28cec391869499e885973d222b055bf5c396940222a701a7f74224ba168061ce15085baaf092499a4f07485868daf9071e
87bf6977a0f1ca108e3b6ce774979701f71c1f7975c1e9ee1b07ba27ef786f28fb54fa49b289cc424892cebf16c859f6865fc35904809cdf0bd280c3d3f010b828ce62350fc8f91614851fdb00fcd2be283e8e75c5fb0574f872de1976866a008a8fe51b
1b8075b86bae4c83a2288aa2287e2a351cf8e1b443ba1abe15cfe6efb47f00e5ce5f410d2f821845e1ee3ecb5c8da274699c101c17fffcd7e4facd9fb57f39d39d9ebf575d66f83a92a7f592bd3dfeb707f7ce46e0ba8f1084a53a90f347a0285d1a2705
79793a28d8db167c45ff74fc7599dba6c3db409a71455afb351817918497754e12836b07b8b0855b6a2d7aa325238b80b898c7c39e97d8eaf42130a5c617df709f5d05f8804e8580b9c79f61a79642cb9450e7f7c0fc4c2dcd9d64e31548f2b45eb25987
43963fa6c54be32f73e28bd03ced7d89bcb965bec9646a7009b7a77fb60eb55aee2ffd9cd8578db5845753c9be47f45b80f5da7792f9ef3273855f23935d60d60b9fa457d1b5e8d421305d87cfc268c864179992592752a34169c2f15e23795a2f99e9b0
4baf6074a4cba47b8f755d38ac07b2eb11fd8a73abfc5dd708380834d5fb109993f5d76cd10498331d9b879f69805cbf0e3f740f305b143aee27676e25a4342315601dff797dbd191c2053622327ece7026506412449c7df917ce4fe9d4b7f4f40e684a3
2fff8e9fd01dae073223fe39772afd61e6f9eff9e7f97feaebca14088c859e15c723339290f6f110f793339c00869c692427a7c2ef90faa24e9af47d48469e967ef24ac5459274fc1dc9cfdcbf3334912d6d387c99cff6726ebab79019993f9e933b1417
992e6ce5f5a0df7c0b700684c316d75b9bdf6b9fe6d7af5f3e03fe165e10fee1d790c553f98bf67fd0fe563cabfca13e5e5bee10a03f3b72d8931e3eca9cd8733bf6a38f000cdb875ee1de17b65b43a8680becfa53af50758d70ba399078f8a71e01e434
e4958a8b24e9f83b928fdcbfa1639f8cbe6c0e40ce43f716325bd8c92b1417986d95df6b1e011090cf3e3ad620e8f421a6e8139ac4a0dd64be20fc2600b63dbd21935d60b6a5bf64120d92f56f12ccf921935d64bab095572a2e92a4e3ef483e72ff868e
7dfe25fd3a5bba70f8329fede5dc746f21b3859dbc427181d956f93bd521854140ec75bdd0d9eba3e9305609654b16afe2743a04eda523e1caef40e37a6e8c87a1d387c0941a4f035e63240e869c2920f3b4631cc2135044a6c305d0916428fe44f2b45e
b25987c3a1518034e1f065de866bc819be9ecc1676f2cac4858d80973feeaf7f0350bc8729cf0d7b6f8cbdf708e99ff57a17886b6ae2b2280a813ad32ec26a498f42de01e33945d718fe359ea2f85a5071fc1d38197a04791788ab4f6271e87acd736b51
14455114c5d750df9717c587c167271d3eb0fe4d8997ac04fc14989044cee26620ebf8fa739e0b917798118d63014ea4bfa27c16acec8ebc8a0c53fe5503705790753e9968c83bcc88c6b100ffc6751fe10085b988bbbc62f7235b726621ce428bcdd0e9
43644ed88af31a99aff9a869333fd50a4f924774fa10990f65004cfc9dfde2cb41ba27effe820ef8fba20f7ff7ef8b977c39b5bf57df4d479cf74543f3ca391e4f5ec769081b8fc7fa43a44cfe3da053292425436be129d4e1100c97d720f2ba04053954
fe0cd9f638b314d790c921326fc9fc5f3d2f842de15658f60fe8f421321fce009859fce534e8069b0b7970cebf97f07fe7e50d86a51bf6de201cfe9b2bda4ca6968fde7867ff35bb7518dc4fcef86b48d92fd0a914920e69c919ad631100721e0253ff31
116e4c4b6fd00ff3cd81ad21a721af583c644b2cd3b89f9ce98f715c9ffa9e9ec89cf835c2adf824334e7d05a56ba40b8164c31900b375653eacbc38b7e8b9b1f746d01a0decbd41088d846047bd6f99c6d32bbc373c1e6efa9b7c68bc23195ac3206d3a
ff9c335ac72200e43c44e65d647288cc17f6f28a5d43b6643d8c0b5d40a664484f644ed295189ab9c1016c8cd2ff978f4cf2789c1dc9863300669e5e56f1b89f9cfb6981f35ee95def4377776786e1ed282ebc1807b61e96373cecc9d26948a41d7a7e86
6ee847585a28d6e1300c9fd701a134845dfbc8d68e06c23f89075b434e435eb1fb912d39d500c899d6139987edd740cac46305f04af1f2afc11cc9163a7965eedf2baff7a8871501363e52f3bd5782d95fa687c0d6471d24fb7b8cde6085e3be061ade3f
0b7e78eea6858102e67dba037178011d0ec3f0158fd3d78ac2b0889c86bc6271902df1619cf7a8a18ca4dd643e0fdfbd15cc540043ce53e852e96b4936ac03366782bd57c0ccfd7be5710e87d0b0697b6def81bd0124e12fc260eb3d8f6df20e017b2f2f
1e76f8f995c0de3f674e3f3638d0de7204f00c14de22eef28add8f6c7b442701d78577462687c87c280320f306a8656404c0c2ef840b126c7be11b320901730f3f5c01693b491e9ec133d7f0068bf9e82381cce8613d091c6e7888340b742a85a4435a72
46eb5804809c97a0201761ca2b160fd9121600ef05b2af01dbe797b941d0e943643e94709071d8358f3a008793e9a124342cc85ea1c20d086cdbd790ec05d3f74f603e3274f7fbf66749afc0a1060c76de73cea33d1e4f5ea9b980197985916c814ea590
74484bce681d8b0090f31214641799ec23dba7465a97bc34218af781acf6466378087e16854f86e60128d4e1100c97d720f2fa71d452e0e2d5fc51fb77e0ff4ecd46713abe0485e78f5d97fd5bb7a7c0c813399f822ef9635bc2e27928ab59e986dedf3f
0b84cf47b1f404b433a2712cc009863ff426a328be1a541cceddd8eb5c797d15df7effc5978382ef1392a9b7089f02eefbabefbf288a77815667f1fc0452c3106966e47d3908ba5d9370aba194e27cfa3954ce3490fa2cf6e1332c6cfc75e3bc6a10c72c
3f43bd17747c05eaaf60b94f2d26ca82ebf395af2f5c5abcbaed21d926329b91f72132df446687c87c46de3160cfcaef89efa42674a4192e7ccf42d1706ef503938af3701a4a7e461f7e06850dcb0b1b0c5f81684b60ed6412e8e695932b5ed208e0bafe
215518493791593aed25db22b31ec490330774def3a7d680b7483f5cf89e0182f71569431f94bc1bc53d9586926c22b3a7e3d76ef66c384e7d84056ce481bde7636a4972145cd71b9c79cd028f27afb13493f4747ae3120f0bb32248930f5fba35e9d739
d29d4e805114fc029dfaf128ba0fe8f42e32dd44664f07975e8f00388c1e5d80e3a3cfe10e2803c2f1a1ff1c5f1e4f5e636926e9e9f4c6259816dc52af121936913387b4a722af4bbcacc01da1e017e8d48f47d17d40a7c34876c97d2398790e001b7bec
e11580d0f61e018686ffd0d9b3bd9c5decea40ce19797791c926323b95f690fb2864e4b7140c39e348b7e6762300a228bc350e6750f487e32ff9e5f78f206df20fdb626290fbc979dcb3c3865f147acfeca41b0168d87bee965fbb32907346de5d64b289
cccee49da755baee1169c7c287ee61489445facb0b9f83a07d62e796cfff44f13f53880c392f01c1cd937fd8af1f0b16ee08b0653e7a6548dd0bcc433d28ce7b799f87d93c9ebcc6d24fd251ede9b22bfd61f85bdf02fc3fedff846b582380fd25cf634f
c45f3fddb601b8292c275e7e7efbebd7afffe27e723eb8bba0acb1a120bf83fd5fe0f5a7e9cccbf0ebff417bd21e5f0ddfba309d7e6fae7780c47ff8a65da7424832d4023abac4682bfa94e7271d1ec641660b3b791dfa6d21d390ad23c926327b190862
9efcc37e680480f37c83d063e45194611e3d02304e2924dd4466e9f48664eb15a821b343647e2ebfa16f23939ad4916646de29241dd50e3fc64867e1eaf0300e325bd8c9ebd06f0b99866c1d493691d94bc0e517937f383e3307c046c047028795780be8
0e270189ecbabfe1d043b24d643623ef4364be89cc0e91f98cbcef05e2cd67a1d1c52424fcacd902dd1c6e7b7c3508d790338de4f7ccfca240d9e54ab4d4ea3ddab3d08ba15751d0cde1b6c75783700d39d3485e0d40f13da0bcb3c2120e1beb3beca228
8aa2288ae28be03058878be3a2b80528b3e1af113f8db7df3b025e20ef149071426ef8062c6020671848e670dbe328b037d6c7df046ed95f01dbf25b1ed8890e66b5a2f15fbc4181db5eedc9b90bcc7c42f776bf88a378cfc83b0c2443f70efbcd5584f4
9b4e05e6c66478aae043cef7a9c31371160120671848e670dbe328b037d6c7df846e9b0b64fcbffc1caec3a7910e0d534de96f8bb1b897fbe3d393f748e4bc1404eb7936afb7e0f1e415fc9e42c6a76e409718be06a443efe02d50b03e8e02f31fb10ee0
6e209d16e94c3760c1f3b464e5b78268061be034d3bc5d89cae1f0256f74108e2d1c62a08071605cd870f9a2a4500592ed50d99774814e858184f19dd7c1acdd87c0d89073085d62f81a900ebd83b740c1fa380acce770dbe30cd078a1e1965e8e7c4770
9f8b747637f780e938bbb9df02a7bd02b6bcfc9b0e84c1cabfc6f3b0e5f0874e64972a778ea40b742a0c24be92918f72fe38172f87120cdd4061e9d7169aa11589778337aa43c3ddd87901b4e5bc3ce07e0bb39c482fe36e819e0d49f8191ab63eeaf07f
abd67e93c091003772382294dda9fa03b93748a3cba0add115b9b93889aa0118044937d400c87e13992dd0a934923f8df535dd8d9d571c9f97d90d1ba7fd1996b0528efeb4181b9e74dacb69c8eb019dde446687767b40ce3274e693604f77927b8492e8
d40d7c3348baa14700d8ee22b3053a9546f21f09a267afc0b0f9e340fa6d12343e0c0e2d0997ed225de4954e2bc986d31852de3bcbcea9b90fc681c81947ba1f5d488aef404571a412661b007f04f0af17db47004e5efaabb9c35185ec86ea0f641eeee9
b9235da71a80e23ea0d8b56f009c911140f611606b1270cd8f9f0474241f6f001c7917c5cb4171e3fa83f967b90187c3e9a13034a94940427be948fb1ad0fd52af011d79879064814ea591bcea6f511445511445511445517c39bfb42f8ae203389af0fb
0574581445f1c34183c6d730e9e590d0b4af9186d6528f80b07cfdf5fc01118f27affcef12e83005644c337f6dc5fdd06a328a75988a0b4cf92a6db10e1d5bf6759cafa424b14f583f04dcefe9f4fb1870e35ccc71f83bf22d4ab035e146a0671bd5c3ce
ffc9c45cd9793c79e53e6ea140872920f3caef71b9ec736684c5fce2fbf3b9c0f2587e993cb0860b9bdd83bc3f1edcea53d2ef4780081b728681a45d7841b2bd87c302c48d847a5fd83103b6883602fe310b7b7eeffdd3bd18453a4c61a14d9c5a479e05
e15941d5b18f42d88b5bfef19c1f1f013bfb1d016cd678cafbe530ac2d64f23210449b7e2dfe697a38fd7e0416752067089833117a846f1cb6730f28af14d2ce959dc7f4903304cc59f05978b90d7d0e0cdd6803e08f3f8cc365bf4580b078af5ed91907
5f3fef3f08c2bc8d36c484bdbf35e0f27e390c6b0b99bc0c04d1a69f85871defdfca0fcf614b2f89be15b841b672841f447024603d00080d6365fb804e87e8d947af41bb3d6416226b4f20f106d4d3915c327464403adc8cfb96ff1a98f13ed890db26ef
10ae95f3c19d055a43ce97d186e1c7d8d948ca3c81fbdf02c4959538f52d376f90e898bd486ac863e20e3a1da2679fbd06a186c89966440b898d7e74ec5fc391974fa431101d6ec67dcbff9920088e7ce6fb5dbbb3406bc81946b219796fd2da9860627e
8422f4d0e1cf077165051efaa7a23a1e1a3a93e92a638925e9d02300edf690d9cb5030c49effb1f739882bc26e87b0768c6de81160145cdf1f7ffcb979e11e41fa74fa493623ef4d60d27b04e07c92cf0bbc3cfd9e0a239b8d306f161b61a5e3c69b26e1
211c6cc3bf64bb069ad393808e342faf782d08ce1f99d873700476d99b0084c1bc7aca24e028b8be57780f73e1fec9308ed8e64940ede73910ec6e370938d20078855f137a15083bcff01ed159fc07bba8b6c5420472a619d542b64e03169c4bde08201c
36a08b82ca63f9a5d3700484f3d447802b611a617b6bfa3d0d44d890330c24edb32b7b91f03a00d832b12cb3b167efc7046501e0965a4f70168467c899e6a4b65d4873e9b011e1310f7c2442e6a1ed15302c6cedc4d9c2fdd3517cdf967e4f638afb5003
c061cfd0bff6fe2446d26e0daf41e42c8a057fa7fd4f833df5bf4e874506d4757b0b00d888fab0ff2fda17c5754ce5706804c0427cea37e13f81c1b4b3d113b582c3c74b5704164551144551145fcb3402ad09a8a2f8a96c4e02a2defa6b246e97ff73cb
267c92fed750d09c8e3f74be8aeed2f7af08af7d0534a3d3b7015166fa9d59cdc9d7619e872f7d0d86eb6fc615fe5c58b65b060ff4bc8fddb75a38bf595ee1e6ebec6b5f632a223693cc6379a780ce9033056416be8e4726c36cf10bb6e1efc9216345bc
baf22f16f1c8ef76959f20dad690c99906524e06330fe7e5c4af02d7efc65561dbeabc3db6f404de87716718d8bae5154e9689e1a5cc4320c0a10600b6bbc82c0c244cd8e11188057ae19a0285b7ce4043ce5d643ae37e76f2869c897bab3d739d28bd30
e0c58a197a23b5a14f555e5e03cce515c76c80861672d995809c39a01b1a42c37617991d0253363c4cfca1960f3aef3d86470023302c22a721af501c643ae37e76f2869c893ba4978d0008c258e71b87fe9955a86b3d7f0f21b4041976ddf28ac37003b4
86d721725e8fc21f8a00644c9019798781a46dc02e5b028cb00c390d7985ee01668b8f91e4379a86869c6fe14cf8900ecd01c09665a75d4bbf706f019b39ae384cf7bc2b3d2b73580fdb87f22abf5b7cc3d0059137e4fc0a74cb8b7b9657381d60eadf2f
98c6f759a823727e0db865f6dcf363ebda1d01f68b9e17c76c10327968cff43af6ca4dc213dab09d473d384e854f684fe4bc1e85ff550550b7bcb86779a5d3c13523da6f06c9c59103b16769ec17ee2360f730f4879b153a940f305bfc100e8e59f95313
dad4639be380e370f804a6bc0772eddb836f47894eac00703f39f395d83523da6f06c965bd25f00660e1de03360f437fb83922b346445e9bc0e441efd01fdbe17c1a6c16affd701c0e9fc0cc2b3f1b9ecbdf1eec22b38f45b7d94526615c33a2fd66905c
c38f00b07b9874837b81bcbbe0744fcff90056e2e8db84c59b031c2f9077179cf60ec72615e57d1d53d8dbc8ec63d16d12cf881a015c0c926b7412900dc5a61dce1d553e56f2871e1e7e0c7f46de5d707a6f0471580e60e2730d436f0e8a9328f19f5261
fd3acfba5e16046bcf9de0be33d15f06f2ca1b8076fe80af2349cd07bc1a25f4473400044173f8fab6f08b1cc82abe71d86278415d1144097dfb0680610a0e5fabe0dc08e417270c7df446787cf808b400023ecf90e159446aa74b0cfda0a6ad8802e989
0c683ceefedb80efa840edc28e5b5620c4fbb665e02c08f3adf74ea07bdbfd1b089889905a0dd5422daf21670a693981960e1f1ac2c4f3d721e967588a74b8388e02092b3e87cfdc528b507e1288fb2dcb0081ee6c1ebeedde89f4c375408743f75e9c04
69fe110d40f1a5a0d03a4385575af2ed7a127e0480ad0f1b7791f9263061efe533c2a967c049d24726bbc8b48b4c7691691799ec22d32e320921494ad322f9fdf4d0f8d24927358140fb493653fa20b0e5b08fec360432ef82d3ed04504b281eb2ed2293
5d64da4526bbc8b48b4c7691691799849024a56991fc7e7a687c02c40b63ea3986f693acf4da87f4b0f34a6fcf7c3ace165a5f78c446c0168360ef3f32127a0f2cdbef2bf82b7499ef4b07687ce8e8b390a96130ed2759e9b50fe961e70d86cd3ceb3895
8130f7de7f9e39c631e3c16b8766b4292672a691fcb67a4797f9ae7480bd0f5ffd430aef3da285a7f413293dcf4f667f9bf195bb8b4c1ed0e9e1424374892e32d945a65d64b28b4cbbc8641799769149084986d352f21fadeffd28a83f27fe71b5ffbdf6
47947e22abff83f6ff47fba2b81e34188b0f171aa2cf8fa5efb3a9c7b9e109bf3530f7f0eb11e024baccf7a4036c6dddf70ebb2b92787e32dba4f41de0efcffe5d641602e6bef8a926014fa2cb7c743aac1f01fc0ba2fff5ab81eec97b3ebf45e927c27a
e40f7b653e36fc49e6336600a66c5ca2530f40f67fb1fb2f6cbcae4d4662efeb103c1e212ca0153a154292053a154292053a154292053a55f440fa3c0c1f09dd93f77e0fc2f39359e9e565d03d793feae1b798f96f917f17996c02137f15496a21909049
0849529a16c96fab2f6e0cf2dd5f07d6b7fc45f18da0f2dbc843cea228be01567ac14792fa96bfb81e143c7f061dfa261fe6ae0fbdba5a43dd24cf2de375a0f3557c8be7f908d09cbaf74f00b77c2aff08b5d325aecfc36781b04fddc36dd14d3303ce7c
93cf4234fa2d3827d786135dfadbfe1ec14f00d11ece3f422daf21671ae9dffa3d3dc3c6f65d95bff84c5090877bf3e226b0b5ebc08524a161d4646e2c9e3de5176a4961c69ec33fa8e13ed582d25e3af275fab3303c6cfe4a9330fffd2bc3dd3905d93c
e4b3bc0ff35f6677d6fb2bdf877f294ebfe9d47e5d92cd61585b40ca387858b979a049d38505f1f0b7c6275363f1ce5b7e9104f488af39fc1fed847693f9035fa13f0bc39982eb621f38ed21bb3315c8907346de3f5e4f60e68f7ef3c22f1e4f5ec78f83
b20b85d503525ff9e9c4bf6695600e1c877c96f54271d813c9ce69ff3f9a2167179c6ebf65b756927bb9c9ee3f56e4f9c9ec3bf50436ccaf453ec11d7a06e6f5b11186e7cb88fdeb46520d401098b2c39c2bdedabd07ec7a84e731644f7c1274bc012070
b21092dd9570447684438f79d4603ec08c36c0691f762e9e35e99ebcc32bf1be524f60c3bc62ba5b25d69e6e6b50f680cd227cecfd5aee7f589064375c8164765bbd0353ff7d7e3e4e7123a1a1b86c7b1c36c044b6c4471d871d8721e3053a154e009991
f577f186196d2093ae8d4e953e00ccbce29250e52793f9dfc2c0a135243a36ecc40e327bb093f7c7eb5b60ce37004eba0797936eef8043e1cb945819907797c5c740ed07283c2672a681f44fd871634bb8e8d18a9f0ff2cc2a3ef2f11fcda318a1fdf82a
f521d693f0ce373e7fc41683c869c0e9cf129121a8a163d7f933ec6e6b84d33ed45c7cb842f7e41d1e427fa59ec0c67b7f6eed3f27893c02588f01188f59837de611c4907346debbf94f64765bfd1ac9523a497a84de06c9d6c2c4ce1f3f626b5164bc88
309c3eab189e0494936e9f1135e4dd05a7db49287f0e65e1f306243389f6757a021b3600acc0ed24e2ecde0336ed90d566b0b1f779041209df6de7b2c2e3c92b3489786bfd1ae99ed1001cd63d47f66d1d34e4dc47b63dd823845f03ca69c0e93dcb6124
60e219b0e692d768b49bcc1fb885fe0c0863fdfaa8251a7f6fc47a2c46363d60736bfd1ae9861a0039d3484eda7f147a387a3364bc26bd10484e034e9f8d0cdd14ccd8e27aa3c17db8f523b4978e7c9d7e0484e1858523b67624c0d1436a2933ec99dffe
3843787c387a70607b6b7dcb247f5b03d03e0eda88b22836a9425214455114455114c36038ddbe82ab1fe5288a6f42159f9330361123efa2f851f4fe33908142cb9968323c3144ed7489b1596ce87c2151e80d440b341e7f9bc1e6819d28c220c94e9501
ea26f9f5f97f168479ebf2ff14103013e1b6bfe802988043bfca43810e17c75120f9884700c47db80c5047bd9c69a41fca7f02ddd93cbc75f9d7e1d0bd1745f1ada0c1e0732b5b1f87abd3c2c310da622bfddf08eb61e7434fc26b7018e98b52c20b5260
e7231092ee85a0a1be0d37b50a0ef6b7d693493ade7b4a7e3f3d342cb06b624b09016c4bffc8a11e368bef2676d86d0470de3f1e6ac9ac84ebe949e8791876b7d63bd27c5f03d0023d7b33435e29202bbd90d72630618f6d3d15f6b30eb89f4f2aed3626
38ef0d10edfd3a230d985518ee2767ec6318d8dd5aef483394ef44f27beaa163a2b147f2c44c5d08e6a51fd0c38cbdd742d743e65d64928a6f8be43dcefca415b985de91e6743aca9946f297eabbaf01a1e1acb57ffdf57bedc3947e4c0f1d3fc1e58c2f
0beafccc6abfccb242a7aee6f06bd003eeaeff0e50107df288c3c7f9794aa70f8169e927527a987475c026f1b0e7c416f1c6a50bcf4f66760d5e8b847b3fd8ba3ef5ccec40776bbda36b84f37d8de4f7d343e3b3a78e154c9d3e04a6a55f12d2c3a4abeb
b05bb071be6d3c9cf09b00d8f6f424f43e1a76b7d63bd284f37d8de4f7d343c35ec30b235f45792f122a44b02bfd801ee7396fe03afe06031732d1cf7b349ee3e3c521b4c3e60d4828de2dd0b4dfc4f33aa96bc0fed67a3249bfb001283e03e4bd371ca9
559045517c08a8fc36fa90b3288a6f80955e841f1b8aa2288aa2288ae2041876fa472dc3dfe343e2d7187d1fcc1974929e0126d0d5ef119c00b77cdbfc7b0608f754fcdf0e22ce5964be42e137c9f3bf3a8e007b32fc3dbe031d0b51eafdad431df572a6
91fe2dbf474028d2e1e2f84e20dab7cc3f02dda9f467b8d8d2f1675844ce215afdf0b5a0e3bb54925a435dfc0c9477a70a9283cb9c5a5557c49972ed39f976c4de4f8231c3b976fa7f60e32820dc8a5aec27b822cb1763703491f9a6bed5729ffd1efcab
f56761780a97f02b3ae65f74119221a721af50a196e92df530f134b3ef0eb89f9cf1af311d687c3117b768da3f277c08387462c0c41794a40a4087dd35ec0eec58f87a842a01ed26f307be427f16863305b720f32d8121a721af97574022d3b7e861e2f3
1e5657b89f9cf14701d9f738cc7fd89c0e9f2256fe1ed1efb11d1b35603f172833380066dee058a4b99f9ce9ffaff7757ad96d22b35d60c66757c247402f4024fa6b44869c86bca2e11b721af2faf17a98787a595de17e72c63a4f227be213c899fc3f1d
3e453e8cf056c4e702520908e6cf2fe57e790610997ea55e669bc86c17999a2d761c057a010c8d02643b147f22d35bea61e2436e4b2beee9b09341682fd2f50726a7c3ef0626afd08564fa343d0efda64a7f010a8ab0e27b4132cce000992e6ce5f52d7a
1fc1796f1c1af939d25c12fed624e05ff807c2f939827bf067ed5f8d8583706d080cfea07d34fc6fd71bd01b7266f070f8ea97a33f7f059c0ddf9e59b1f7fb487163fdbf6aeff9e6ee1408d71eb99af0a3e97f2e7c04380ff9571c4e4210d99e69c1b626
c142afa260f7d57a479a740300c9d61c5034ffbd077a4026bbc0eceefa75fe85d2cd91a64734fd4f856f40c446c0e702b84f4f62c869c82b948004a6bc8936fc6c227eb5fe0c08ab9df8230c3f93fffc02d12b9169a7c37005bab59ec8dc905718c908c3
e5333cb770fa138a1d7915451c949bd468a35882f4f30624f54bc444ba531517f250f89b0b818aefe6d7af5fa9e7fd62933f6aff2ede1d7e517c17ea79edf5a9bc524cf2f11180e481f07ff39bff0667c2fc61a4da48200000000049454e44ae426082
'----------------------------------------------------------
' 29c: use the font:
'
font(loadtex("font.03.png"))
printr "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
printr "abcdefghijklmnopqrstuvwxyz"
'****************************************************************************************************************************
30: Hedgehogs Star_field: (update 2023,april3: .k_teach & starfield and texture_PB_06.fin)
'
'
' have 3 files in the same folder:
' 1) .k_teach & starfield and texture_PB_06.fin '(code below)
' 2) 01.pb.jpg: basic4gl.proboards.com/thread/3662/convert-photo-2022-byte-hec
05:pb_01.txt ' [ to convert into: 01.pb.jpg ]
' 3) font.03.png '(from 29a)
'
' read through all text in starfield (to comprehend everything)
'
'here the code 1 :.k_teach & starfield and texture_PB_06.fin :
'{
'.k_teach & starfield and texture_PB_06.fin
'
'Update: 190/one texture over 2 triangles
'
const l1=16000,l3=1000
'
dim a$,arr(255),a100(100,1),a101(127),ba,b95,ca(999,2),cr(10),cb(1,255),d1(250),da,fa0,fb,fc,f30,f0(3,255)
dim g,g1,i,i1,i2,i3,i4,i0,is3=50,in$,in,in5,max ,na,xa5,shift,tx,ty
dim c3(255),in8,ga2,ga3,f26c
'
dim a1$(12),a2$(100),a14#,a15#,a#(3,2)
dim a16,a,a5=43,a3(a5),a4,a6=a5,a25,a26
dim a1,a01,a02,a03
dim bb,b#(195,2),b$
dim c,cx,cy,cz
dim camX#,camy#,camz#
dim f1,f3,f01,f02(100),f07,f75(a6),f80(a6),f97,f(10),fa(255),f99
dim ga
dim l4,l5
dim ma
dim mx#,my#
dim nr
dim sp1=2,sp2,st,ste,sp0 :reset m5:read sp0:dim sp#(sp0):
dim t3(100),tl3,t1(300),t4(300)
dim xa=30,xy,xb,x2,x3,x4,x5,x6
dim ya=8,yb,y2,y3,y4
dim z2,z3,z4,z5,z6
'
f0(3,112)=sp1
dim s0 as string:for i=0 to 3:s0=s0+chr$(32):next
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
declare sub draw(i) :declare sub w(i) :declare sub txt() :declare sub mouse(i) :declare sub box(wb,x1,y1,z1,xw,yw,zw)
declare sub keys(i) :declare sub l(x,y,a$) :declare sub l2(x,y) :declare sub inscan3() :declare sub line2(co2,x1,y1,z1,x2,y2,z2)
declare sub text() :declare sub xyz2() :declare sub combo() :declare sub cam() :declare sub texture(nr,size#,ptr)
declare sub glbt(i0) :declare sub line1(co2,x,y,z) :declare sub draw_xyz_line(l4) :declare sub line_lr(xb,yb,zb,l5)
declare sub vec_key() :declare sub a16_() :declare sub camZ() :declare sub line_ud(xb,yb,zb,l5)
declare sub inv(i0,i1) :declare sub glbC(i0) :declare sub camX() :declare sub camY() :declare sub grid(xb,yb,zb,co,ste,l5)
declare sub k1_(isik,nr,k0):declare sub f_(nr) :declare sub txt1(nr,x,y):declare sub bug()
declare sub wait(i2) :declare function mb_(a):declare sub sl(i0)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function mm(i0,max):i0=i0+1:if i0>=max then i0=0:endif:return i0:end function
function m_(i):na=mouse_button(i):return na:end function
function s$(i): a$=str$(i):a$=left$(a$,len(a$)-1):return a$:end function
function inkey(g10) :return -(g>0)*(g=g10):end function
function inscan(i3):arr(i3)=ScanKeyDown(i3):return arr(i3):end function
function inkey2():in$=inkey$():if in$<>"" then g=asc(in$):endif :b95=a101(g):f30=keydown(chr$(b95)):g=(g*-f30):return g:end function
function mi$(i0):a$="":for i=0 to i0:a$=a$+"-":next:return a$:end function
function skd(i0):i1=ScanKeyDown(i0):return i1:end function
function t(i0#) :a03=i0#/10 :Return a03 :end Function
'
sub inv(i0,i1):f0(i0,i1)=not f0(i0,i1):f0(i0+2,i1)=mm(f0(i0+2,i1),cb(i0,i1)):end sub 'f0(i0:0-1,i1:g or b)
sub cam():cx=camx#:cy=camy#:cz=camz#:end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
for a=0 to 9:cr(a)=a*28:next: for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:ca(i,0)=cr(i1):ca(i,1)=cr(i3):ca(i,2)=cr(i4):next
'
reset m3:for i=0 to 17:read a100(i,0),a100(i,1):a101(a100(i,0))=a100(i,1):next
i2=17:i1=97:do:i2=i2+1:a100(i2,0)=i1:a100(i2,1)=i1-32:a101(i1)=a100(i2,1):i1=i1+1:loop until i1=126
for i=0 to 127:if a101(i)=0 then a101(i)=i:endif:next
'
for i=0 to 255:cb(0,i)=10:next :for i=0 to 255:cb(1,i)=10:next :cb(1,112)=13 'inkey cb(0,i) , inscan cb(1,i) , press f1 (0-4)
'new
a=-1:reset m6:for a=0 to sp0:read sp#(a):next
reset ma:for i=1 to 12:read a1$(i):next
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
reset m39:i=0 :read b$ : t3(i)=LoadTexture("01.pb.jpg")
'
st=1:xy=400 :a01=st*xy:a02=a01*2 :f1=112
declare sub line_3d(x1,z1 ,x2,z2)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'smallest_keys_08.14
dim g2,in6,in2,in2$,c1(255),a2,b1,hmk,is(255),is1,is2,in7,ik(255),ik7 ,k(1,255),k4(1)
for i=0 to 255:c3(i)=i:next:reset m11:for i=0 to 46:read a2,b1:c3(a2)=b1:next:hmk=i-1
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
dim i5,k1,f24(255),sp3(10) 'skd:plus or minus
dim ls(10,1),ls1
declare sub sp_lim(nr,i0) : ::declare sub keys1() :
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
reset m2:read ls1:for i1=1 to ls1:for i=0 to 1:read ls(i1,i):next:next
ls(0,0)=0:ls(0,1)=sp0 :for i=0 to ls1: sp3(i) = -(ls(i,0)>0) * ls(i,0) - (ls(i,0)<0) * ls(i,0) :next
'
m2:data 4, 0,99 , -5,199 ,2,10 ,-10,-5 '1,2,3,4 '0=speed F1/F2
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
sub keys1():dim in6b
in2 = InScanKey ():if in2<>0 then in6=in2:in7=in2:k4(0)=in2 :endif:
if in6>0 and in8=0 then in8=true :k(0,in6) = not (k(0,in6)) :ga2=ga2+1 :endif 'ga2 for test
if in8 and skd(in6)=0 then in8=0 :k4(0)=0 :in6=0:clearkeys() :endif
'
in2$= inkey$():if in2$<>"" then g=asc(in2$):ik7=g:k4(1)=g:endif
if ga=0 and g>0 then ga=true:k(1,g) = not (k(1,g)) :ga3=ga3+1 :endif'ga3 for test
if ga and keydown(chr$(c3(g)))=0 then ga=0 :k4(1)=0 :g=0 :clearkeys() :endif
end sub
sub k_(nr,isik,lower,upper):k1_(isik,nr,lower):k1_(isik,nr,upper):end sub 'data m7
sub k1_(isik,nr,k0):dim i0:i0=sgn(k0):k1=abs(k0):if f24(nr)=0 and k4(isik)=k1 then sp3(nr)=sp3(nr)+i0:sp_lim(nr,i0):f24(nr)=true:f_(nr):endif
:if f24(nr) and k4(isik)=0 then f24(nr)=0 :endif :end sub
sub sp_lim(nr,i0):if i0=1 and sp3(nr)>=ls(nr,1)+1 then sp3(nr)=ls(nr,0):endif :if i0=-1 and sp3(nr)=ls(nr,0)-1 then sp3(nr)=ls(nr,1):endif:end sub
sub f_(nr):if nr=0 then f26c=0: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,34,39,60,44,62,46,63,47,97,65,98,66,99,67,100,68
data 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
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
reset m40:
for i=0 to 95:read b#(i,0),b#(i,1),b#(i,2)
if i<32 then b#(96+i,0)=b#(i,0) :b#(96+i,1)=b#(i,1) :b#(96+i,2)=b#(i,2)+1 :endif
if i>31 and i<64 then b#(96+i,0)=b#(i,0) :b#(96+i,1)=b#(i,1)+1:b#(96+i,2)=b#(i,2) :endif
if i>63 then b#(96+i,0)=b#(i,0)+1:b#(96+i,1)=b#(i,1) :b#(96+i,2)=b#(i,2) :endif
next
reset m41:for i=0 to 3:read a#(i,0),a#(i,1) :next 'a#(0-3) text_ordinate
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'new texture
dim v0#(2)
dim mxd#
mxd# = Mouse_XD ()* 50
'new_inkeys_ba_18.03
declare sub m(b):declare sub mb(m1):declare sub tutorial()
function r0(a as integer) as integer :dim x2 as integer:a=a+1:x2=(rnd()%a):return x2:end function
dim mbt(2) ,f06(2),f05(2)
dim f6b
'2022,6.18
dim v1(100000)(2) as single
dim cl(100000)
dim f2,rx,ry,rz,rm,rm1
dim rxa,rxb,rya,ryb,rza,rzb,rxc,ryc,rzc
'
rm = 32767 'RND_max
rm1 = rm/2
'
function mb_(a)::ma=mouse_button(a):return ma:end function
sub wait(i2):dim i1:do:i1=mb_(i2):loop until i1:end sub'color (255,0,0):print i1:color (100,100,100)
sub sl(i0):dim i,i2:for i=0 to i0:i2=i*123.123:next:end sub
'
dim l2#,vl#(2)
'---------------------------------------------------------------------------------------------------------
'2022,11.4
declare sub side(cnr,v0() as single):declare sub cube(v0() as single)
dim vc(5,2) as single
dim sd(5,3,2) as single'6sides,4 corners
reset m7:for i=0 to 5:read vc(i,0),vc(i,1),vc(i,2):next
reset m8:for i=0 to 5:for i1=0 to 3:read sd(i,i1,0),sd(i,i1,1),sd(i,i1,2):next:next
dim v0(2) as single
v0=vec3(10,10,10)
dim a10
'2023,jan.18
dim tc(5)
for i=0 to 5:tc(i)=r0(254):next
declare sub box_(nr,sz)
'---------------------------------------------------------------------------------------------------------------------------------
'2023.march27
dim cr1(10) as single,gc(999,2) as single,cb#
for a=0 to 9:cb#=a:cr1(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)=cr1(i1):gc(i,1)=cr1(i3):gc(i,2)=cr1(i4):next'1000 gl_colors
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a, 2)):end sub
'---------------------------------------------------------------------------------------------------------------------------------
sub enable():glenable (GL_TEXTURE_2D):glEnable ( GL_BLEND):glColor4f(1, 1, 1, 1):end sub
'2023,apr3
dim v(3,2) as single
reset m10:for i=0 to 3:read v(i,0),v(i,1),v(i,2):next
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
glViewport(0, 0, WindowWidth(), WindowHeight())
glMatrixMode(GL_PROJECTION) : glLoadIdentity()
gluPerspective(60, (1*WindowWidth()) / WindowHeight(), .0001, 100000000)'100 mega
glMatrixMode(GL_MODELVIEW) :
glEnable(GL_TEXTURE_2D)
'------------------------------------------------------
font(loadtex("font.03.png"))
tx=70:ty=50:resizetext(tx,ty)::textmode(texT_OVERLAID):
'
camz#=20
'
'
do
glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)
glLoadIdentity ()
glRotatef (my#, 1, 0, 0):glRotatef (mx#, 0, 1, 0)
glscalef(1,1.2,1)
glTranslatef (-camX#, -camY#, -camZ#)
'--------------------------------------------
mouse(2) :'keys(1):
keys(2)
vec_key()
txt()
'
keys1():k_(0,0,-112,113):k_(1,0,-114,115):k_(2,0,-116,117) :k_(3,1,-97,115):k_(4,0,-118,119):bug()'[sp3(0),0:inscan,(-F1,F2)]
'
inscan3():combo()
'------------------------------------------------------------
draw(1):draw(2):draw(3)
'--------------------------
m(0):m(1):m(2):
tutorial()
'------------------------------------------------------------
' one texture over 2 triangles
glBindTexture(GL_TEXTURE_2D, t3(0))
glBegin(GL_triangles):
glTexCoord2f(1,0):glVertex3fv(v(0))
glTexCoord2f(1,1):glVertex3fv(v(1))
glTexCoord2f(0,0):glVertex3fv(v(3))
glEnd()
glBegin(GL_triangles):
glTexCoord2f(1,1):glVertex3fv(v(1))
glTexCoord2f(0,1):glVertex3fv(v(2))
glTexCoord2f(0,0):glVertex3fv(v(3))
glEnd()
'------------------------------------------------------------
draw(0)
loop
' v0 ,v1 ,v2 ,v3
m10:Data 0,-100,0,0,0,100,100,-4,100,100,-34,0 '0
'[data :4 vec3:0,1,2,3:
' v1# v2#
' v0# v3# ]
'
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ grid(xb,yb,zb,co,ste,l5)
sub draw(i) :
if i=0 then drawtext():SwapBuffers ():endif
if i=1 then
gldisable (GL_TEXTURE_2D)
glColor4f(1, 0.5, 0.5, 0.5)
'
if l2#< 75000000 then
draw_xyz_line(1000) :
grid(0,-4000,0 ,909,1000,5000)'grid(xb,yb,zb,co,ste,l5)
grid(1000000,1500000,2000000 ,90,1000,l1):
box(1, 0,0,0 ,8,8,8)
box(2 , 1000000,1500000,2000000 ,32000,32000,32000):
box(50, 100000,100000,100000 ,10000,10000,10000)
endif
'
if f6b=5 then
if f2=0 then
for i=0 to 100000:
rxa=r0(rm)-rm1:rya=r0(rm)-rm1:rza=r0(rm)-rm1
rxb=r0(rm)-rm1:ryb=r0(rm)-rm1:rzb=r0(rm)-rm1
rxc=r0(rm)-rm1:ryc=r0(rm)-rm1:rzc=r0(rm)-rm1
rx=rxa*rxb*rxc:ry=rya*ryb*ryc:rz=rza*rzb*ryc
v1(i)=vec3(rx,ry,rz)
cl(i)=r0(999)
next
f2=true
endif
'
for i=0 to 20000
glC(cl(i))'texture before gl_points
glbegin(gl_points):glVertex3fv(v1(i)):glend()
next
'
vl# = vec3 (camX#, camY#, camZ# )
l2# = length ( vl# )
endif
'
glc (777)
glBegin(gl_lines):
line_3d(-1,-1 , 1,-1)
line_3d(-1,-1 , 2, 0)
line_3d( 2, 0 , 0, 2)
line_3d( 0, 2 ,-2, 0)
line_3d(-2, 0 ,-1,-1)
glend()
endif
if i=2 then text() :endif
if i=3 then enable() :box_(0,1):endif 'v0:move
end sub
'
sub box_(nr,sz)
v0#=vec3(0, 0, 0) 'move
texture(nr,sz, 4) :texture(nr,sz, 96) '1:raven
texture(nr,sz,32) :texture(nr,sz,128)
texture(nr,sz,64) :texture(nr,sz,160) 'texture(nr,size#,ptr)
end sub
'
sub line_3d(x1,z1 ,x2,z2):glVertex3f(x1,0,z1):glVertex3f(x2,0,z2) :end sub
'z+ to z-
sub box(wb,x1,y1,z1,xw,yw,zw) : x1=x1-xw/2:y1=y1-yw/2:z1=z1-zw/2 : x2=x1+xw:y2=y1+yw:z2=z1+zw
glC(990):glbegin (Gl_line_LOOP):glvertex3f(x1,y1,z1):glvertex3f(x2,y1,z1):glvertex3f(x2,y2,z1):glvertex3f(x1,y2,z1):glend()
'
glC(999)
glBegin (GL_LINES)
glvertex3f(x1,y1,z1):glvertex3f(x1,y1,z2):glvertex3f(x2,y1,z1):glvertex3f(x2,y1,z2)
glvertex3f(x2,y2,z1):glvertex3f(x2,y2,z2):glvertex3f(x1,y2,z1):glvertex3f(x1,y2,z2)
glend()
'
glC(990):glbegin (Gl_line_LOOP):glvertex3f(x1,y1,z2):glvertex3f(x2,y1,z2):glvertex3f(x2,y2,z2):glvertex3f(x1,y2,z2):glend()
'
f02(wb) = (cx>=x1 and cy>=y1 and cz>=z1 and cx<=x2 and cy<=y2 and cz<=z2)
end sub
'
sub w(i) :color(ca(i,0),ca(i,1),ca(i,2)):end sub'1000 colors
sub mouse(i) : if i=1 then xa5=mouse_x()*260:if xa5<0 then xa5=0:endif:if xa5>255 then xa5=255:endif:endif
if i=2 then mx#=mouse_x()*721-360:my#=mouse_y()*361-180:endif
end sub
'
sub l(x,y,a$):locate x,y:print a$:end sub:sub l2(x,y):locate x,y:end sub
sub xyz2():x4=t(cx):y4=t(cy):z4=t(cz):end sub
'
sub keys(i)
if i=2 then :cam()
if g=87 or g=119 then
a10=a10+1
camZ#=camZ#+sp#(sp3(0)):
endif'ws
'
if g=83 or g=115 then camZ#=camZ#-sp#(sp3(0)):endif
if g=65 or g=97 then camY#=camY#-sp#(sp3(0)):endif 'qa
if g=113 or g=81 then camY#=camY#+sp#(sp3(0)):endif
if g=90 or g=122 then camX#=camX#-sp#(sp3(0)):endif 'xz
if g=88 or g=120 then camX#=camX#+sp#(sp3(0)):endif
xyz2()
endif
end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub txt():
if f(1)=0 then f(2)=0: if f(3)=0 then clearregion(0,0,tx,ty):f(3)=true:endif
w(909): l(00,00,"1)InScanKey ()+inkey$()"):w(990):print":hedgehog.PCN2 :2022 (3.31)":w(900):print " new_inkeys_ba_18.01"
is1=is(in7)
'
locate 0,42 :w(900):print mi$(69)
W(337): printr "key.combiation: ctrl+shift+(A-Z)+(0-9)"
W(090): printr ".press combo:shift+ctrl+F12 to leave keys"
W(099): printr "da:";da;": " 'l2(00,26)
locate 0,ty-3 :w(900):print mi$(69):
w(909): printr"9/19-3/20,5/21 :hedgehog.PCN2"
'
clearregion (0,46,tx,46)
W(047): l2(1,46) :
if d1(0) or d1(1) then :for i=0 to is3:if d1(i) then print"d1(";i;"):":endif:next:print " ":endif
endif'if f(1)=0 then
'
if f(1) then f(3)=0 :w(737)
W(900): locate 0,ty-4:printr "(F1-/F2+)_speed:";sp3(0);"/";sp0;":"; sp#(sp3(0));s0
W(094): printr "A:";cx;"/";cy;"/";cz;s0
print "B:";x4;"/";y4;"/";z4;s0
W(099): l2(58,0):print "f02(50):";f02(50);s0
l2(58,1):print "f02(1) :";f02(1) ;s0
l2(58,2):print "f02(2) :";f02(2) ;s0
endif
'
end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub grid(xb,yb,zb,co,ste,l5):gllinewidth(2):glC(co)'floor left_right,up_down
glBegin (GL_LINES):
z5=-l5-ste:do:z5=z5+ste:line_lr(xb,yb,zb,l5):loop until z5=l5
x5=-l5-ste:do:x5=x5+ste:line_ud(xb,yb,zb,l5):loop until x5=l5
glend()
end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub line_lr(xb,yb,zb,l5):glVertex3f( xb-l5,yb ,zb+z5) :glVertex3f( xb+l5 ,yb ,zb+z5) :end sub'left_right
sub line_ud(xb,yb,zb,l5):glVertex3f( xb+x5,yb ,zb-l5) :glVertex3f( xb+x5 ,yb ,zb+l5) :end sub'up_down
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub texture(nr,size#,ptr): glbt(nr): glbegin (Gl_quads):
for i=0 to 3:glTexCoord2fv(b#(i)):glvertex3fv ( b#(i+ptr)*size# +v0# ):next: glend ():end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub glbt(i0):glBindTexture(GL_TEXTURE_2D, t3(i0)):end sub :
sub glbC(i0):glBindTexture(GL_TEXTURE_2D, t1(i0)):end sub '..............
sub draw_xyz_line(l4):line1(9,-l4,0,0):line1(900,l4,0,0):line1(9,0,-l4,0):line1(900,0,l4,0):line1(9,0,0,-l4):line1(900,0,0,l4):end sub
sub line1(co2,x,y,z):glC(co2):gllinewidth(2):glbegin(gl_lines):glVertex3f ( x,y,z):glVertex3f ( 0,0,0 ) :glend():end sub
sub line2(co2,x1,y1,z1,x2,y2,z2):glC(co2):gllinewidth(2):glbegin(gl_lines):glVertex3f (x1,y1,z1):glVertex3f (x2,y2,z2) :glend():end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub vec_key():c=ScanKeyDown(40)-ScanKeyDown(38):if (c or c=1) then cam():a16_():xyz2():camX():camY():camZ():endif:end sub
sub a16_():a14#=cosd(my#)/1.01:a16=int(a14#)*2+1:end sub:sub camX():camX# = camX# + c*sp#(sp3(0))*sind (mx#) *a16:end sub
sub camY():camY# = camY# - c*sp#(sp3(0))*sind (my#):end sub:sub camZ():camZ# = camZ# - c*sp#(sp3(0))*cosd (mx#) *cosd(my#):end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ma:data F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12 'c=inscan(40)-inscan(38)=inscan(37)-inscan(39)'c=d-u___d=l-r:'d=inscan(37)-inscan(39)
m39:data "Raven Bird_01.jpg","Seattle White Doves.jpg","macaw_01.jpg",
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 15'sp#:0-11
m6:data .001,.01,.1,1,10,25,50,100,200,1000,10000,20000,100000,500000,1000000,10000000
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub combo():f01= ( d1(0) and d1(1) and d1(49) )'ctrl+shift+F12:switch to new program:f(1)=true
if f97=0 and (f01) then f97=true:f(1)=not(f(1)) :endif: if f97 and not (f01) then f97=0:f80(0)=0:endif
end sub
sub text():if f(1)= true and f(2)=0 then clearregion(0,0,tx,ty):f(2)=true:endif:end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
m40:'ez_keys,vec_letter,plane,texture_12.final b#()
data 0,0,0 ,0,1,0 ,1,1,0 ,1,0,0 ' 0 96 'up --->x and y
data 0,1,0 ,1,1,0 ,1,0,0 ,0,0,0 ' 4 100 'turn right 1*
data 1,1,0 ,1,0,0 ,0,0,0 ,0,1,0 ' 8 104 'turn right 2*
data 1,0,0 ,0,0,0 ,0,1,0 ,1,1,0 '12 108 'turn right 3*
data 1,0,0 ,1,1,0 ,0,1,0 ,0,0,0 '16 112 'rotated 180 deg
data 0,0,0 ,1,0,0 ,1,1,0 ,0,1,0 '20 116 'rotated 180 deg,turn right 1*
data 0,1,0 ,0,0,0 ,1,0,0 ,1,1,0 '24 120 'rotated 180 deg,turn right 2*
data 1,1,0 ,0,1,0 ,0,0,0 ,1,0,0 '28 124 'rotated 180 deg,turn right 3*
'
data 0,0,0 ,0,0,1 ,1,0,1 ,1,0,0 '32 128 'up ---> x and z
data 0,0,1 ,1,0,1 ,1,0,0 ,0,0,0 '36 132 'turn left 1*
data 1,0,1 ,1,0,0 ,0,0,0 ,0,0,1 '40 136 'turn left 2*
data 1,0,0 ,0,0,0 ,0,0,1 ,1,0,1 '44 140 'turn left 3*
data 1,0,0 ,1,0,1 ,0,0,1 ,0,0,0 '48 144 'rotated 180 deg
data 0,0,0 ,1,0,0 ,1,0,1 ,0,0,1 '52 148 'rotated 180 deg,turn left 1*
data 0,0,1 ,0,0,0 ,1,0,0 ,1,0,1 '56 152 'rotated 180 deg,turn left 2*
data 1,0,1 ,0,0,1 ,0,0,0 ,1,0,0 '60 156 'rotated 180 deg,turn left 3*
'
data 0,0,0 ,0,1,0 ,0,1,1 ,0,0,1 '64 160 'up ---> y and z
data 0,1,0 ,0,1,1 ,0,0,1 ,0,0,0 '68 164 'turn right 1*
data 0,1,1 ,0,0,1 ,0,0,0 ,0,1,0 '72 168 'turn right 2*
data 0,0,1 ,0,0,0 ,0,1,0 ,0,1,1 '76 172 'turn right 3*
data 0,0,1 ,0,1,1 ,0,1,0 ,0,0,0 '80 176 'rotated 180 deg
data 0,0,0 ,0,0,1 ,0,1,1 ,0,1,0 '84 180 'rotated 180 deg,turn right 1*
data 0,1,0 ,0,0,0 ,0,0,1 ,0,1,1 '88 184 'rotated 180 deg,turn right 2*
data 0,1,1 ,0,1,0 ,0,0,0 ,0,0,1 '92 188-191 'rotated 180 deg,turn right 3*
'
m41 :data 0,0 ,0,1 ,1,1 ,1,0 '0-3 'txt-coordinates a#()
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub bug():w(099):locate 0,11:print "12) ":w(888)
txt1(0,4,11):txt1(1,17,11):txt1(2,31,11):txt1(3,48,11):txt1(4,0,12)
locate 0,3:
printr "4)g:" ;g ;" / in6:" ;in6 ;s0
printr "k(0,";in7;"):";k(0,in7);" ": printr "k(1,";ik7;"):";k(1,ik7);s0
for i=0 to 1
printr i*2+7;")m(";i;"):";mbt(i);s0
printr "a10:";a10;s0
next
end sub
'
sub txt1(nr,x,y):locate x,y:print nr;":";: :print sp3(nr);"/[";ls(nr,0);"/";ls(nr,1);"] ":end sub
sub m(b):mbt(b)=mouse_button(b):mb(0):mb(1):mb(2):end sub
sub mb(m1)
if f06(m1)=0 and (mbt(m1)) then
f06(m1)=true:f05(m1)=not(f05(m1))
if mbt(2) then f6b=f6b+1:endif
endif
if f06(m1) and not (mbt(m1)) then f06(m1)=0 :endif
end sub
sub window(x,y):SetWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow():end sub
'
sub tutorial()
if f6b=0 then
w(990):locate 0,15:printr "This is how we start a program:"
w(900):printr "001:":w(r0(999))
printr "press left_mouse_button (=LMB)"
printr "LMB affects the variables mbt(0) and f05(0) . (look 7th line:m(0)"
printr "mbt(0) becomes -1 as long as LMB is pressed"
printr "f05(0) turns from 0 to -1 and from -1 to 0 (short press LMB)"
printr "press right_mouse_button (=RMB). RMB affects the variables mbt(1) and f05(1) (like it is with LMB)."
printr
w(900):printr "002:":w(r0(999))
printr "press alphabet A-Z , 0-9 , ! to + (with shift) "
printr "press: []\;',./ (no shift)"
printr "press: {}|:<>? (with shift)"
printr "these keys point to the variable g (look 4th_line:g:) and k(1,x) (look 6th_line - x depending what key pressed)"
printr
w(900):printr "003:":w(r0(999))
printr "press :shift,Ctrl,Enter,F1-F12,insert,delete,home,end,PgUp,PgDn,"
printr "Backspace,Tab,CapsLock"
printr "This keys point to the variable in6 (in Line 4) and k(0,x) "
printr "(look 5th_line - x depending what key pressed)."
'
printr
w(900):print "004":printr": press middle_mouse_button (=MMB) for next page"
'
endif
'
if f6b=1 then locate 0,15
w(900):printr "004:":w(r0(999))
printr "Now explain Line_12 and Line_13:"
printr "k_(0,0,-112,113):k_(1,0,-114,115):k_(2,0,-116,117) :k_(3,1,-97,115):"
printr "k_(4,0,-118,119)"
printr "here we have 5 subs which increments and decrements "
printr "this variable:sp3(nr) (nr is 0-4 , 5 variables.)"
printr "the variable increments to a maximal and returns to zero"
printr "the variable decrements to zero and returns to maximal"
printr "explain only: k_(0,0,-112,113) in detail:"
printr "the 1st:0 is to change sp3(0)"
printr "the 2nd:0 is for :scankeydown(003:F1-F12) [1 is for keydown(A-Z,0-9)]"
printr "the 3rd:-112 is for F1 and decrement"
printr "the 4th: 113 is for F2 and increment"
printr
printr "ls(0,0)=0:minimal in range 0 __ ls(0,1)=sp0:maximal in range 0"
printr "- sp0=12 - (13 speeds(0-12) for flying"
printr "m2:data 4,....(store here ranges 1-4)"
printr "Use the 2 keys F1 (decrement) and F2 (increment) to change: sp3(0)"
printr "look into line_12 and watch the range 0[0/12]: how sp3(0) changes"
printr
printr "the other 4 subs use other keys and ranges."
printr "range1 uses F3- and f4+ ...abreviate(=abr) decrement:dec or -"
printr "range2 uses F5- and F6+ ...abr increment:inc or +"
printr "range3 uses 'a-' and 's+' (without shift)"
printr "range4 uses F7- and f8+ "
w(900):printr "005: press middle_mouse_button (=MMB) for next page"
endif
if f6b=2 then locate 0,15
w(900):print "005:":w(r0(999)):printr"Explain key_combiations: press 3 to 8 keys"
printr "press 1st shift or control ...or:"
printr "press 1st shift and control"
printr "control : d1(0)=true(-1) (true=-1 false=0)"
printr "shift : d1(1)=true "
printr "press and add any more keys for key combinations"
printr "many d1(x) become:true (the keys are pressed)"
printr "look into 3rd line from below when pressing key_combination"
printr "da:x .variable(abr:var) da stores :how many keys are pressed."
printr
printr "Example:press key-combination :shift+ctrl+F12 (for a change)"
printr "This key-combo switches to :TEXT2 (important)"
printr
w(900):printr "006: press middle_mouse_button (=MMB) for next page"
endif
if f6b=3 then locate 0,15
w(900):print "006a:":w(r0(999)):printr"Flying in space:"
printr "use: mouse_x and mouse_y to look into the direction to fly forward"
printr "use: Arrow_key_UP :fly forward"
printr "use:Arrow_key_Down :fly backward"
printr
printr " *** switch to text2 *** :"
printr "adjust flying-speed:use [F1-] and [F2+] and"
printr "watch 2nd line from below how flying speed changes"
printr "Change to speed_2:0.1"
printr
printr "what can we in this 3D room recognize?"
printr "Look with mouse around, search and find:"
printr "X,Y and Z Axis.in the center is: 0x/0y/0z "
printr "see my location: A:0/0/20 (at start)"
printr
printr "look to the blue grid:It is located:0x,-4000y,0z"
printr
printr "look around and find: 3 boxes"
printr "Go inside the near box: f02(1) becomes:true(-1)"
printr "My location is outside box(1): f02(1) = 0"
printr "text2 displays (in the Up-right-corner) 3 variables:"
printr "f02(1),f02(2),f02(50) "
printr
printr "Enter into box(50):(its location: 100Kx,100Ky,100Kz)(k=1000):"
printr "Change to flying-speed.7:100"
w(900):printr "continue 006: press middle_mouse_button (=MMB) for next page"
endif
if f6b=4 then locate 0,15
w(900):print "006b:":w(r0(999)):printr"Flying in space:"
printr "Fly into Box(50):f02(50)=true"
printr "outside of Box(50):f02(50)=0"
printr "Adjust flying-speed [9:1000] and fly into Box(2)"
printr "Its location: 1000Kx,1500Ky,2000Kz"
printr "Inside of Box(2) is f02(2)=true"
endif
'
if f6b=5 then
locate 0,ty-1:print " distance:";l2#;" "
locate 0,15
w(900):
print "007:":w(r0(999)):printr"Star_field:"
if l2#< 4000000 then
f3=0
printr "1) use combo :Ctrl+shift+F12"
printr "2) use speed:11 (=20000) (F1-,F2+)"
printr "3) fly to box(50) (highest object in sky)"
printr "4) look back to the starter_grid"
printr "5) use speed:15 to leave Galaxy"
printr "6) Fly backward (arrow_key_down) and leave galaxy"
printr "7) go back into galaxy and find your starter_grid"
else
if f3=0 then clearregion(0,15,80,49) :f3=true:endif
endif
endif
'
if mbt(2) then clearregion(0,13,tx,40):if f6b=6 then f6b=0:endif:endif:end sub
'
'm7 was m2
m7:'gl color v0=vec3():v1=vec3():v2=vec3():v3=vec3():v4=vec3():v5=vec3()
data 0.0,1.0,0.0 '0
data 1.0,0.5,0.0
data 1.0,0.0,0.0
data 1.0,1.0,0.0
data 0.0,0.0,1.0
data 1.0,0.0,1.0 '5
'm8 was m3
m8:'side_data
data 1, 1,-1,-1, 1,-1,-1, 1, 1, 1, 1, 1'0...12 data:0-11
data 1,-1, 1,-1,-1, 1,-1,-1,-1, 1,-1,-1
data 1, 1, 1,-1, 1, 1,-1,-1, 1, 1,-1, 1
data 1,-1,-1,-1,-1,-1,-1, 1,-1, 1, 1,-1
data -1, 1, 1,-1, 1,-1,-1,-1,-1,-1,-1, 1
data 1, 1,-1, 1, 1, 1, 1,-1, 1, 1,-1,-1'5
'
m9:
data 1,1,1,1,0,1,1,1,1'cube_top
data 1,0,1,0,0,0,1,0,1'_middle
data 1,1,1,1,0,1,1,1,1'_bottom
'
sub side(cnr,v0() as single): 'glbt(1):'glbC(36)'glColor3fv( vc(cnr) )
glVertex3fv(sd(cnr,0)):glVertex3fv(sd(cnr,1))
glVertex3fv(sd(cnr,2)):glVertex3fv(sd(cnr,3))
end sub
'
sub cube(v0() as single):dim i:glBegin(GL_QUADS):for i=0 to 4:side(i,v0):next:glEnd():end sub
'
'}
'****************************************************************************************************************************
31:minesweeper.0.01
'
'minesweeper.0.01_____2:13 PM 1/28/2019
dim a,i
dim f0
dim mb0,mb1,mx,my,mx1,my1
dim x,x0,x1
dim y,y0,y1,y2
dim Box 'sprite
'-------------------------------------------------------------------------------------------------
function r0(a):dim x2:a=a+1:x2=(rnd()%a):return x2:end function
sub rtxt(x,y):resizetext(x,y):end sub
declare sub set_sprite():declare sub level_print():declare sub mb():declare sub bug()
declare sub mouse(x):declare sub pnr()
dim mbf,m00,mb0k 'boolean
dim mx0,my0,rx=60,ry=50
x0=600 :y0=330
x1=(x0-1)/10 :y1=(y0-1)/10
dim ms(x1,y1),ms2(x1,y1)
dim f01,m1,m2,m3,m4,m5 'debug
dim s1 as string:for i=0 to 3:s1=s1+chr$(32):next:'s1=s1+".":a=len(s1)
'---------------------------------------------------------------------------------------
sub sprite():SprSetPos (mx1,my1):sprsetangle(sprangle() + 0.2):end sub
'-------------------------------------------
x1=30:y1=20 'field_lenght
dim fx=1,fy=4 'field_position
dim bomb_amount=100
'-------------------------------------------
'set_sprite()
rtxt(rx,ry)
mbf=true
'*********************************************************************************************************************
do
level_print()
mouse(0):mouse(1)
bug()
mb()
'sprite() :sprite not ready
f01 = (mx0<=x1 and mx0>-1 and my0<=y1 and my0>-1)
loop
'*********************************************************************************************************************
sub pnr()
if ms2(x,y2)>0 then:
if ms2(x,y2)>5 then color(0,255,0):endif
locate fx+x,fy+y2:print ms2(x,y2)
if ms2(x,y2)>5 then color(255,0,0):endif
endif
end sub
'-------------------------------------------------------------------------------------------------
sub level_print():dim y2p,y2m,xp,xm
if mbf then
mbf=0
clearregion (0,0,60,50)
color (255,0,255)
locate 0,0:print "minesweeper 0.01: 2:13 PM 1/28/2019"
'
color (255,0,0)
for a=0 to bomb_amount
do
x=r0(x1):y=r0(y1)
if ms(x,y)=0 then ms(x,y)=true:f0=true else:f0=false:endif
loop until f0
next
'
for y=0 to y1
for x=0 to x1
if ms(x,y) then locate fx+x,fy+y:print"*":endif
next
next
'
'left,middle and right case
x=0 'case_1:pnr()
for y2=0 to y1 :y2p=y2+1:y2m=y2-1:xp=1
if ms(0,y2)=0 then
if y2=0 then ms2(0,y2)=-ms(xp,y2)-ms(xp,y2p)-ms(0,y2p) :endif
if y2>0 and y2<y1 then ms2(0,y2)=-ms(0,y2m)-ms(0,y2p)-ms(xp,y2m)-ms(xp,y2)-ms(xp,y2p) :endif
if y2=y1 then ms2(0,y2)=-ms(0,y2m)-ms(xp,y2m)-ms(xp,y2) :endif
pnr()
endif
next
'
for x=1 to x1-1 'case_2: [x>0 and x<x1-1]
for y2=0 to y1 :y2p=y2+1:y2m=y2-1:xp=x+1:xm=x-1
if ms(x,y2)=0 then
if y2=0 then ms2(x,y2)=-ms(xm,y2) -ms(xm,y2p)-ms(x ,y2p) -ms(xp,y2p)-ms(xp,y2) :endif
if y2>0 and y2<y1 then ms2(x,y2)=-ms(xm,y2m) -ms(xm,y2) -ms(xm,y2p) -ms(x ,y2m)-ms(x ,y2p)-ms(xp,y2m)-ms(xp,y2)-ms(xp,y2p):endif
if y2=y1 then ms2(x,y2)=-ms(xm,y2) -ms(xm,y2m)-ms(x ,y2m) -ms(xp,y2) -ms(xp,y2m) :endif
pnr()
endif
next
next
'
x=x1 'case_3
for y2=0 to y1
if ms(x,y2)=0 then y2p=y2+1:y2m=y2-1:xm=x-1
if y2=0 then ms2(x,y2)=-ms(xm,y2) -ms(xm,y2p)-ms(x,y2p) :endif
if y2>0 and y2<y1 then ms2(x,y2)=-ms(x ,y2m)-ms(xm,y2m)-ms(xm,y2) -ms(xm,y2p)-ms(x,y2p) :endif
if y2=y1 then ms2(x,y2)=-ms(x ,y2m)-ms(xm,y2m)-ms(xm,y2) :endif
pnr()
endif
next
'
for y=0 to y1:for x=0 to x1:ms(x,y)=0:ms2(x,y)=0:next:next
endif
end sub
'-------------------------------------------------------------------------------------------------
sub bug()
color (255,0,0):locate 0,43
print "------------------------------------------------------------"
printr "x1:";x1;s1
printr "y1:";y1;s1
printr "mx0:";mx0;s1
printr "my0:";my0;s1
printr "in field:";f01;s1
'
color (255,0,255)
locate 20,50:print "press N or left mouse_button"
end sub
'-------------------------------------------------------------------------------------------------
sub mouse(x)
if x=0 then mx =INT(mouse_x()*rx) :my =INT(mouse_y()*ry) :mx0=mx-fx:my0=my-fy:endif
if x=1 then mx1=INT(mouse_x()*641):my1=INT(mouse_y()*481):endif
end sub
'-------------------------------------------------------------------------------------------------
sub mb()
mb0=mouse_button(0) :mb1=mouse_button(1)
'
mb0k = (mb0 or keydown("N"))
if m00=0 and mb0k then mbf=true:m00=true:endif
if m00 and mb0k=0 then mbf=0 :m00=0 :endif
end sub
'-------------------------------------------------------------------------------------------------
end
sub set_sprite()
ResizeSpriteArea(640,480)
Box = NewSprite(LoadTexture("Textures/DesertMagic_01_a_000-100.jpg"))
SprSetSize (400,20) '
SprSetPos (320,230) '
sprsetscale(.2)
BindSprite (Box)
end sub
'-------------------------------------------------------------------------------------------------
'****************************************************************************************************************************
'****************************************************************************************************************************
' end of folder
'
'PCN and Hedgehog 2023
'
' for questions and answers , Email to :chuck.summer@mail.com
' press ctrl and - for smaller texts.
'
Basic_news:check this for a different Basic:
'-------------------------------------------------
libertybasiccom.proboards.com/board/14/liberty-basic-v4-5-1
rcbasic.freeforums.net/
www.jose.it-berater.org/smfforum/index.php?topic=979.0
www.jdoodle.com/execute-freebasic-online/
rosettacode.org/wiki/Category:FreeBASIC
www.freebasic.net/forum
www.purebasic.fr/english/
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
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 a:circle_21
28 b:circle_22
28 c:circle_27c10.fin
29 a: convert text into font
29 b: font.03.txt
30:Hedgehogs Star_field
update: .k_teach & starfield and texture_PB_06.fin:one texture for 2 triangles
31:minesweeper.0.01
'
'-----------------------------------------------------------------------------------------------------------------------------------------------------------
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 :chuck.summer@mail.com
'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: find_all_files and content_30b '4/29/2022
manual:
'-------------------------------------------------------------------------------------------------------------------
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 :chuck.summer@mail.com
'-------------------------------------------------------------------------------------------------------------------
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 )
'
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 ' loop until f01 (not for fullscreen)
' dim i0,f01:do: f01= keydown("N") :loop until f01:color(0,255,0):printr "end"
'*********************************************************************************************************
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.gb: (blend function with texture)
' in one folder :01.pb.jpg and blend_02c.fin.gb
' find 01.pb.jpg: basic4gl.proboards.com/thread/3662/convert-photo-2022-byte-hec
' --------------------------------------------------------------------------------------------------------------------------------------------
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:Telecollege 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 this file ready: 01.pb.jpg
2) find this file : basic4gl.proboards.com/thread/3662/convert-photo-2022-byte-hec
3) in one folder: 01.pb.jpg and gl_color and texture.gb
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
'-----------------------------------------------------------------------------------------------------
28a: 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
'****************************************************************************************************************************
28c: circle_27c10.fin
'circle_27c10.fin.gb 'Line 1
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#)
'
rad=10 :hmf=36 :compute_basic_circle(0,rad,10,hmf*10) '360/10=36 steps
rad=100 :hmf=720:compute_basic_circle(1,rad,10,hmf*10)
'
declare function vL(va() as single,vb() as single) as single
declare sub mouse(x,y) :declare sub circle(co,nr,v() as single)
'
dim lr as single,ll as single,l3#
dim v0(1) as single :v0=vec2(10,10)
dim v1(1) as single,v2(1) as single,v3(1) as single,cc '(2) 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,iL2 as single,iR1 as single,iL1 as single
'
declare sub lines():declare sub txt():declare sub points() :declare sub window(x,y)
function y0(m#,x,t) as single:dim y1#:y1#=m#*x+t:return y1#:end function
'
dim i1db,i2,i2b
dim f06
'2023,4
dim u(99),pc0,iL as single,iR as single,ileft as single,iright as single,iR2 as single,iL3 as single,iR3 as single
dim f2b 'bool
sub pct(i0):u(i0)=PerformanceCounter():end sub
'
dim a,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
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a,2)):end sub
dim s1 as string:for i=0 to 3:s1=s1+chr$(32):next
'**********************************************************************************************************************************************
window(1900,900)
iR=-250:iL=-250
iL3=.2:iR3=.2
iL2=iL3:iR2=iR3
i2=0
'
glTranslatef (0, 0, -200)
resizetext (100,50)
v3=vec2(0,0)
'
do
glClear (c)
'---------------------------------------
mouse(300,250)
circle(900,0,m ) :circle(990,1,v3)
txt()
lines()
points()
'
iR=iR+iR2 :iL=iL+iL2
'
if iL>285 then iL=-280:endif
if iR>285 then iR=-280:endif
'
ileft=iL-iL1-18
v2 = vec2(ileft ,y0(-.47,ileft ,00)) :circle(90,0,v2) 'left
'
iright=iR+iR1
v1 = vec2(iright ,y0(-.47,iright,00)) :circle(90,0,v1) 'right
'
ll = Length(v2-m) 'left
lr = Length(v1-m) 'right
l3# = length(v1-v2) 'length between marbles
'-----------------------------------------------------------------------------------------------------------------------------
'left marble
if ll<20 then f02=true :iL2=0 :endif
if f02 and ll>20 then f02=0 :iL2=iL3:endif
if f02=0 and l3#>=19.889 then iL2=iL3 else f05=f05+1:iL2=0:endif
'right marblw
if lr<=20.1 then f01=true :iR2=0 :endif
if f01 and lr>20 then f01=0 :iR2=iR3:endif
'
if ll<20 then iL2=iL2-.1:endif
if l3#<20 then il2=il2-.1:endif
if f01 and f02=0 and lr<20 then ir2=ir2-.1:endif
if f01 and f02 then ir2=ir2+.1:endif
'
if keydown("N") then do:loop:endif
'big circle-----------------------------------------------------------------------------------------------------------------------------
i2b=i2b+1:if i2b=8 then f06=true:i2b=0:endif
'
circle(99,0,b#(1,i2))
'
if f06 then i2=i2+1:if i2=a31(1)+1 then i2=0:endif:f06=0:endif
'
if f02 and pc0=0 then pct(0):pc0=true:f2b=true:endif
if pc0 then pct(1):if f02=0 then if u(1)>u(0)+700 then f2b=0:pc0=0:endif:endif:endif
'-----------------------------------------------------------------------------------------------------------------------------
drawtext():SwapBuffers ()
loop
'**********************************************************************************************************************************************
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
'
'for angle# = 0 to 2 * m_pi step 2 * m_pi / 360 :glVertex2f (sin (angle#), cos (angle#))
sub circle(co,nr,v() as single): glc(co):glBegin(GL_LINE_LOOP):for i=0 to a31(nr):glVertex2fv (v+b#(nr,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
mx#=mx#*2
m=vec2(mx#,-my#)
while SyncTimer (10) :a1=a1+1:wend
end sub
'
sub lines():glc(990):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=-300 to 300 step 2:v1 = vec2(i,y0(-.47,i,00)):glVertex2fv( v1):next:glend():end sub
'----------------------------------------------------------------------------------------------------------------------------
sub txt()
locate 0,35:
printr "lr:" ;lr;s1
printr "ll:" ;ll;s1
printr "L3#:" ;L3#;s1
printr "i1:";i1;s1
printr "iR2:";iR2;s1
printr "f01:";f01;s1
printr "f02:";f02;s1
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
'----------------------------------------------------------------------------------------------------------------------------
sub window(x,y):setWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow():end sub
'****************************************************************************************************************************
'29a:convert text into font:
'
'converter:
'
m5:
data "font.03.txt"
data "font.03.png" 'destination :13099 bytes
'use this data (above) to convert text into font (png)
'----------------------------------------------------------
'use this data (below) to convert a different text into jpg
'data "pb_01.txt" 'text to convert (source)
'data "03.pb.jpg" 'destination (converted)
'
dim sf$,df$:reset m5:read sf$,df$
'**********************************************************************************************
dim a$(99),c$(99),d$(9999),da$(9999),d1$,e$,d2$(99999),rp$(9999)
dim i1,rb(100000),e,i0,wf,f,i2
'-----------------------------------------------------------------------------------------------------------------
declare function hex$(a,s) :declare function dec(h$) :declare function r0(a)
dim ba(4),s0,s1,s2,s3,s4,s5,s6,i,a,c,i001,i002,i003,i004,dc, s=5'amount: 1(1 byte),3(2 bytes),5(3 bytes)
dim h$,s$(s),s1$(15),b$,i$
reset m1:for i=0 to 15:read s1$(i):next
reset m2:for i=1 to 4:read ba(i):next 'ba=byte.amount
'convert_photo_uc08f - convert_photo_PB_12:2022,6.21 -------------------------------------------------
declare sub file_error()
dim l1,l2,ia,file,i4,i3
dim p1$,p(99999),p1
'-----------------------------------------------------------------------------------------------------------------
resizetext(100,40)
'-----------------------------------------------------------------------------------------------------------------
file = openfileread(sf$):file_error()
i1=-1:do :i1=i1+1 :da$(i1)=readline(file) :loop until da$(i1)="":ia=i1-1
'
l2=len(da$(ia-1)) :l1=len(da$(ia)) :printr:printr da$(0):printr l2;"/";l1
'
i2=-1
for i=0 to ia
for i1=1 to len(da$(i)) step 2
p1$=mid$(da$(i),i1,2) :p1=dec(p1$)
if i=ia then print p1$;"=";p1;"/"; :endif
i2=i2+1:p(i2)=p1
next
next
'
printr:printr p(i2) 'last byte:217,d9
'
file = OpenFileWrite (df$):file_error() :for i=0 to i2:writeByte(file,p(i)):next :CloseFile (file)
color (0,255,0):printr:print "End":end
'-----------------------------------------------------------------------------------------------------------------
function r0(a):dim x2:a=a+1:x2=(rnd()%a):return x2:end function ' 0-10
sub file_error():if FileError () <> "" then print FileError ():end:endif:end sub
function hex$(a,s):dim s0,s1,s2,s3,s4,s5,s6 as integer
s=ba(s):s0=s-1:s1=a:s2=a:h$="":for s6=0 to s:s$(s6)=0:next
do:s3=-1:do:s3=s3+1:s1=s1/16:loop until s1<16
s4=s0-s3:s$(s4)=s1$(s1):s5=pow(16,s3+1)*s1:s2=s2-s5:s1=s2
loop until s1<16
s$(s)=s1$(s1):for s6=0 to s:if s$(s6)="" then s$(s6)="0":endif:h$=h$+s$(s6):next:return h$:end function
'
function dec(h$):i001=len(h$)
i003=-1:dc=0
for i002=i001 to 1 step -1:i003=i003+1
i$=mid$(h$,i002,1):i004=asc(i$)
if i004>47 and i004<58 then i004=i004-48:endif:if i004>96 and i004<103 then i004=i004-87:endif
dc=dc+i004*pow(16,i003)
next
return dc
end function
'
m1:data 0,1,2,3,4,5,6,7,8,9,a ,b ,c ,d ,e ,f
m2:data 1,3,5,7 'hex$(a,b):b=1:1 byte,b=3:2 bytes,b=5:3 bytes
'****************************************************************************************************************************
29b: font.03.txt: '[ text for conversion: 1st byte 89 ... last byte 82 (size: 26460 bytes) ]
'
' use converter above in the same folder:
' copy this text into Notepad, save it with the name : "font.03.txt" :
'
89504e470d0a1a0a0000000d49484452000001000000010008060000005c72a866000000017352474200aece1ce90000000467414d410000b18f0bfc6105000000097048597300000b1300000b1301009a9c18000032c049444154785eed9dcdb9f4b071
a5f53902a5e0c9c00e41218c42f06430b39ca597dacece5b2d67eb9d1582958115829d817c4ef11405b241b20aec665f76d7fb3cbc24c03a04887f8260dfdf1445f1bdfcd2fe23f92be0fe17308f24efd6bf038ff31677ba97e298bfd3be288a2fa44600
3bbc5bff0e3cce5bdcfd5ea2f15f6bdf79df6d5c22f158c7dde9696b04507c2c2cf044ce305e812437fd56a57a150ccf91d74ba806e04351d99991770a95ffb7f57ccf60f4de7f0a23e9dfd36c5da71a800fa457e8b315a12d305b85e753f1fb659a91d6
ef6a3cfc57f1d29bea45fe282147345bfc94f033fa5ef82d916b6d5d23a35ddb6ef9ff64cec6f99df7bc0e3b1317b75dd3d3bef4c63291ee7156ff6ede157f0f774d241e5b71def2ffc98cc6d9756baebcf775dcd7ee23dcded9d2d523c007d2cbecad02
b0455b80d685e90e9c8933d38ac8f9e0fe24aa01f850546667e49d829588c8791b3cce7edf77bc87966cfc7bf65bd7a806a0287e185b95f5155403507c1ceb9edfdd7785f177e4b58b4c1fd0e9052f4d98b31970f70cbc63fc3dce5bdc352f8a3e350228
8aa2288aa2288ac2e1f32091f37214fcdbc23f8ba2ffb5e9a7e06f9b7fdfc06573002a0be1c2d0da66740e35647d1c4592053af535e8b6bfeebebf894b1a806c21ead967af71862bc3faa9b46950e9f1b9bcbc0118293c7cd544e47c7017afa5976723f9
58fc7c5eda0054a1b9276a6fab01fe025ed60054e52f9e01cb11913385a4550e777868d58f122cd213ec5d23d393f875321aa7d566afe3f66b22fa2dad73748d57e88f345bf8b5ceea5b46ae35128f11cd37b29b386712d1b56b32d77a46f8d48e5cc735
2d19fd33188977cb5df5aeeb11b9d659fd37f1b24780bb27741594f7c1b46f9177384fd69a167917e2a59380ef4c70cb6db03e2eee85f7e6d9fc73fbbdd14071c16bc06cc611661a91f3c15d7c0f2c3f44ce149256c3bfc3cb1b0092cd849e7df61a6a33
acd1d061352045b1e2920680b00213390f696d33baa2289e843aceea39df84927f38fd257f5bfe29f82a3f455114455114455114c58fa79e5f8b4fe7a56f016c0608c8194632d3e970a82242f69f3a5c1c1f01dbffedf6d8ff07dd7622006cff091bf927
79d1ef5fb0fd4ece4360fbf7d8fe0d9bc3e3bfd7e93093f45c2306f9efb0fd879c29a8a35ece21a0af46f80448bedf321fe4bc16661e91338c64a71a0048fe01dbbfad8f8f809d57e035a1460076ff898d89de363ea90ca03d36c286801b4967a274671b
00c6e55fe44c411df572a6808e8ddeffa71edb3ff358a7c24063c8f995e0f6599eff59ce6bb1d4077286818495c87be0f9380334ecc5edc6dbe323181636c24683b00724a1824cc3d59e19101e4110d8b771f00660240d86d2ce81d6d3e07fca2b057593
fcafff20af14d0f92828d478af91f6db1b00a6e150fa9f0601b3f51ee9b91869efbde7e328b0efa2d3bbc0cc7b5f2bfcf20e03092bdd3c02c09ed7fbad9d0c027baf385681a7c37c2584269d762dd0b20727a315d81b90f408021af6fe0c9fd7a811c020
b8fde10ee03408fc54013c03c29d1b9ef6f808d8b2c7f74a4758f8c21518b6f31c003616de9182bb8ec35b5a7084fbef0c5cce21a807ff2ee7cb51789bc8ec2bc0edb223197a7c7b0a08fc2d0d00c29c273edae328d278453ed303dbe41fb6b951d0a94d
60d3f6fe3e1ab14cc49e8f32a9d1c4192c6420e710bac465154fc16d22b34b509033f2be0c04c9f237f4f8f61410380b6ceaf9f71920cc2e3a1dc6352606e69900126f8458991713835bc89670f4601a73a93706978d0614dea982ab4b5c5ef889827e4b
d844c1cfc8fb3210e4fb86ffef04373e373ced7104d87aafeb937f439370b09f27ff286ef77bd086c849b78f08c8a519aa304f155c5de2f2c24f14f45bc27e37b86d76206f79fc9eb1d407725e0682e4a387f594ed7104d8b2c1e8911a4ac17e9efcc33e
3302e09c03b1f0b89f9c06af73e5088069f78c06e05df340869c69247f5b03a2e087c2878ce5e8f091f3a558ec819c978120e78ad61e4781868d800fbd5909528b7060bf98fcc371780e80c08ee1fb4884300ebc061f032e9bd44158de180d353ad44df2
37bd873e89e27ed70620fdf6a958319af89f026edf1f7f862692a89be4f9558c3f01c61b5b6a02f96e5cf6832077e4db7f8804b7ff17ecb8fda379e4a1eecfbace1de168ebf7d361517c21e801398c1fea05a9a35ecea2288aa2288aa2288ae20782e736
cedefa6b28ee476781f941477a261d122ec2f1f0f93a2ef5ea0bf6ed6bb4b4de816e5e8927af10b4efa1d387c094b3cff60e5e845fa3c9be8b4c0e81299790fa6bd0d1f4773d5f5d9efa4d802207d35be9eec4f30086feee764d6631cda200cb3b04cc7d
05de9a502184ddd6429ef4621468e64494d72130dd4abfd03560c6b4f3cad312fd9c798b68faf917806ba27a5f3bb0e6b693818c3bb64b1633319c3369056dbb706ccd71470e23ebb5816538f79333fe559becd39587c0dc1b0e5f463b3708667000cc5c
6f2d1ef67385348320305f2cc691f72130f5453f43df4040e7e9ede9eff11f2a80d0596f2ce72116d2841542ee276738fd1d7bf78fbdeb2fff9c57f233fa744726d32e32d945a684e18efc0a94771eed2f52791e1c97031ad1524e836e90294456582759
2e03606e092ea74137187d15952e80b0754daaf013987a056e1f41d2df22c8790a5c868f3064e45b887503104a7fd992b57e6445a621671ac9d37a48986eed4888c7a15e7932ef23935d60c6f45a877d6a451ff43e2a3ece43192e222baf918434e41c02
724f8cf43c04345e98538d07edb1f9af09197622004ce71e6345a812ca968d86df378f8796d24267d7903304cc6df51b750d74877a23d86d3d029c2a07578168b6e9ce8af396e5b40c171bd3d23a64107a045b039d8fc4b93fcec3c9769959f24a67a064
c3190fa967c6d0709a40eb8f10a11100ec18e6fc0316a604721e02533600cc34ef01fd9120db83ae493702d0301ea9a137ecd90379a173e6fb8900db45c1c566c73afda3517c09e3cce3540360ca0d641202e6a71b0068bc338a6b61fc905974834b8770
9079e4535f34c1de2aa09c865d05c8b98b4cbbc8248de4d1f03dc3d743e854f830f7c9a06cfa9d7a04e871567f3588eb473c024cf264b985fde9494047ba74c581c4872d23c3fe75fcbd22841a30d97691c92e30f30ae493901e7e7404e0f1f70ac821b9
61064160beb84e1469c8500304336fb85defe5676808fb4e106736047e3fe9723c8282220cf7fac70f04baf51a2e55908874d982dbb67e0b64b20bcce602bb627456de90f310986ebd860cbd8785dd56fc538f00b0b78648ce30906ca57fa802c3ae3707
c051cdc88cb621671ac987f50e2ec13cb9c56bc0165cc790330e34cf5a0864c81902e63e047e402687c0948d581bffe11f46982e91be077bf566c229fcd44218da63f35110af936ebc26e958e1878cf1f7f463f8d9c6a76d44381249577e32c9c7ee8148
3eacbf3bbafdafbdffe2cb41d9b7371a721645f14da0f23f6d385d1445511445511445511445f151fc755afcc0e5abf30208c1d7527cc71b5e9c60aa89cc87445b6497b4f25594bf8a63dca3efe17ba45e654d923e32d945a65d64b20bccdad778247dff
72cec83bf54a4992d3afa1749954dac969c0c932cdb2c0ed301f6163c819463267f1ea9ceec97b42de0fe83459eb0d397781595bf6b98f2dc282a1bfff67455fcc9ec2cd572af4e7f9c37501b0592f283a53019dd0620cd8f93bf4358771905d0f2664a8
f19bccfbc86417997691c92630d9ba7712be7f3967e41d8abf23494ad3439749a59d9c069c4c9350e527d41339c348e62c3a2cba27ef09793fa0d364f1fa527e877182c956feefff835618b0f253ccd6929b47d82afc7468f09889b9fb7a05e77d31888f
24a22bc90c390d38c3cb6161e22bf1ec5ee437df8b19ed20bb391c1cb6cb4187ef2183e4693d249ee673fe60cff87ba148dfbf23ef549c24194e074797095d47a6b32d0e53959f504fe40c2319b1f2226fc37c9b51b5bc1fd069675e0026f76e9c70ba2d
fb76bfdccb4dfa0bca70c287485e615ce0f09ca1f36c047687e438ef1a5e9ba4d6e2cb69c0e9cb630f4700b0f1b8cf198e63afc487ef842924721a70fa3d44d7f31b72a6913cad87c487fdebd1dba9fb27f24ec54992e174707499d075646ab6d8795908
8d3e1d69d2f1968c7887692365ee27e7df3a521374d069c2bc6ceba461461be0f456fe7bfde9975f9c60cf61ad03f7b4043664c0be5d9b3e57403a74f8004e2d3ec1e57e72c60b600716e0c321f8649acf3c47f207bdbc43d795691799ec22d307747a13
990ddf3bd12536915908494ec587e832d9b46b3bb1d48748d2a4e32d99e974b828ff8dffe6b5759aaceb9061461bc8a46ba3537d3dfcd972f890a1d7833af39a703a74f800ed781eac5bc0c335e5b2db22ac97338de40f7a7987ae2bd32e32d945a60fe8
f426325bd8c96b46de9bc86c1399859024a5e9a1cb84ae235362c37e6cde2b86e66f88ecd3f196cc74d879a7e7a3c75045d669bf863f32cc9db0196d2093ae8d4ef5f5ed09b30272d2dd8e00bc42db73851974c0394ff43543cfa070861280c0c4c3fee6
478079c82bf78cbc3791d9839dbc537192e4b4465ea1ebc894ac3b9ff02840f6a97813c94c879d87eb95d8e363f0b8874efb35bcdccda31933da00a71ff29fd03d796f3f02cc1736b309ab2cd8b743291f25f0a6bacf55b4a1e10e73c5ec219bc58dc299
69007cf4c1789f9e042470fae4daed2601098fcd17c86b13993dd8c93b152749b21a2fc4f60527f65e78cfcc21f9350f3b0022db54bc8964b34e4e435e87d7d6e9d6decbb321ef2e38dd4e027afd65de7b1dde9c049c2b34f65e881e68ce6f56049cf308
2f3ec1a57bf2de1fc6cb668b68059c272d571c4e06c9aec73c2173c464de4726bbc83464bb06b2b6c16e61fc0f3f8b9e4c1fc396772a4e9264355be52ff449b26c1761c2e98d48f435f22632e92293d90687def1cc13e6726f5e47a7d7f19fcbb3bc3681
c956fe6fbf06c4490e57da093e1fb670cf731e81cd9edfc1f9872138a17bf2deef8565d3233b91d3162426ca61e52793f903ccc8dd914bcb24e923935d641ab2ed0169bb108879777af82bef549c2449df0724cc3b2f73bc8ff0ef214c926efcbd4c871f
037bc8a48b4c661b1cfa63800dff89dc9bd7d1e9c57938bdf3dc0ddf81599b7eb1fc87112b49b487e58dcdad5a51141f002a355b49b6b86c71162d25dc9c90b09102b6aafc45f189b0e263e31062fd2c6123046ca18994a2288aa2288aa2288aa2287e3e
f6c4ff4878e20fb6f9d710629274494d3cc27e1d87d47be42d64b689cc1eece41dd1fbdccbd66bd4eefb5cf8fb6bbf79ad028ee7fb9717fd765735c2df170d2dc2a17bf2de9e03c2b9cd38d26f3a155b08b685cc42483223ef1030677a86970fafb1001b
e49d0232c621fc5b1a4fc362dce7b012c2663d79e86c2f446890ed16a1460076acfc3dce7e8b10a9c0869c33f28ee8bb0ba6e89ebcfb8b79e0ef8b4e7c41d77a45a6553cec171f99f4c0394f3f5f8de7713a6cc861f3104f1e4f5ea7d33fdc91106966e4
1d02e6bc8fc385535b58800df20e0389af2120f33a824b50a073a471185a4a8ad3bda5882c88de281c2ee890dd221c38e7c22caf5d644ad6853ed59a4a93ca3c491e34f23ebc164cba3d34dd9377bf5782bfa7bd5532ece7c523c22bb357d0ddbcc0798e
1eb8313e76ac5387acedb3fa16e8ba239208d2a5f2cf818ce186560eee61110072868184f9cd7ac3ed7009fb534180869c9e1886bcbae0b417d2f51a827026ca6e110e9cae0f2504ec58e0c8700b4e748d54e649f2a09177e85a30f306d31bd1c3f4c339
b7b1428bbd8f08bc61b01e1ffbd08a389cef36201160ebbd1747123e9a18eac5a0b3c6035b7825a6c340899c69203d3dfc9e62902e439e97cc03cf87d04ad6a7a0007bec0ec164d3bd599d3a4c08996d115a120abbde2340680ea045ba6ce61972cec83b
742d98cd1548ee5025928d85819d35828dbf15661d47e3e10dd148efeb0d0d19ea49a1f3466cb4f130e44c0329d3fdd4f0db2200e40c01734f3b8ebe7c44787a34124601ae893cff19722ed0a9c38490d91a8e2c5219017b0e757d44e2a41a0169b29967
c83923eff0b564ee9576aecc7bc0c42bac37203e1a707f7f148acec79c6900da398891dedb7bbed4737f8bf4a9fc6b8194e9381c3eb1080039ef81e29c8e34248b4700ecd982b7c398c32195ec2c6cec58887c389feec10974bc86879fba27499ea29177
f85a30f5decf7bffc804acdb7a3ef87c803ff77bcf1269cce73413e9c729e952e94720f1c623ddf0b4e81ae9f05b203ff51830c5e05c1c2e47711ec9382f68ec393874696732497a148143efb5486814003b6f341e66c4cd208824598df79af3bdf278f2
8abdc520b05da7dde1bdd366329df1fb6fd3901c5666d8300db9a527011d680c39c340c2068c61a6470e2d0c9bc83904e46c3477e74bf6b0080039ef81e23c1469c8bcf2adb1c224b34d26d365d8707a6f182a84b0f389af35a9e19c34a97480f956d824
3591037b4fcbe87db7c3ee751ab6ec562c9cf706cbdf1c0c0dc7a5c9a69f87dd456621244969d640ce7b1f1a7d128b0090f31e28cec391869499e885973d222b055bf5c396940222a701a7f74224ba168061ce15085baaf092499a4f07485868daf9071e
87bf6977a0f1ca108e3b6ce774979701f71c1f7975c1e9ee1b07ba27ef786f28fb54fa49b289cc424892cebf16c859f6865fc35904809cdf0bd280c3d3f010b828ce62350fc8f91614851fdb00fcd2be283e8e75c5fb0574f872de1976866a008a8fe51b
1b8075b86bae4c83a2288aa2287e2a351cf8e1b443ba1abe15cfe6efb47f00e5ce5f410d2f821845e1ee3ecb5c8da274699c101c17fffcd7e4facd9fb57f39d39d9ebf575d66f83a92a7f592bd3dfeb707f7ce46e0ba8f1084a53a90f347a0285d1a2705
79793a28d8db167c45ff74fc7599dba6c3db409a71455afb351817918497754e12836b07b8b0855b6a2d7aa325238b80b898c7c39e97d8eaf42130a5c617df709f5d05f8804e8580b9c79f61a79642cb9450e7f7c0fc4c2dcd9d64e31548f2b45eb25987
43963fa6c54be32f73e28bd03ced7d89bcb965bec9646a7009b7a77fb60eb55aee2ffd9cd8578db5845753c9be47f45b80f5da7792f9ef3273855f23935d60d60b9fa457d1b5e8d421305d87cfc268c864179992592752a34169c2f15e23795a2f99e9b0
4baf6074a4cba47b8f755d38ac07b2eb11fd8a73abfc5dd708380834d5fb109993f5d76cd10498331d9b879f69805cbf0e3f740f305b143aee27676e25a4342315601dff797dbd191c2053622327ece7026506412449c7df917ce4fe9d4b7f4f40e684a3
2fff8e9fd01dae073223fe39772afd61e6f9eff9e7f97feaebca14088c859e15c723339290f6f110f793339c00869c692427a7c2ef90faa24e9af47d48469e967ef24ac5459274fc1dc9cfdcbf3334912d6d387c99cff6726ebab79019993f9e933b1417
992e6ce5f5a0df7c0b700684c316d75b9bdf6b9fe6d7af5f3e03fe165e10fee1d790c553f98bf67fd0fe563cabfca13e5e5bee10a03f3b72d8931e3eca9cd8733bf6a38f000cdb875ee1de17b65b43a8680becfa53af50758d70ba399078f8a71e01e434
e4958a8b24e9f83b928fdcbfa1639f8cbe6c0e40ce43f716325bd8c92b1417986d95df6b1e011090cf3e3ad620e8f421a6e8139ac4a0dd64be20fc2600b63dbd21935d60b6a5bf64120d92f56f12ccf921935d64bab095572a2e92a4e3ef483e72ff868e
7dfe25fd3a5bba70f8329fede5dc746f21b3859dbc427181d956f93bd521854140ec75bdd0d9eba3e9305609654b16afe2743a04eda523e1caef40e37a6e8c87a1d387c0941a4f035e63240e869c2920f3b4631cc2135044a6c305d0916428fe44f2b45e
b25987c3a1518034e1f065de866bc819be9ecc1676f2cac4858d80973feeaf7f0350bc8729cf0d7b6f8cbdf708e99ff57a17886b6ae2b2280a813ad32ec26a498f42de01e33945d718fe359ea2f85a5071fc1d38197a04791788ab4f6271e87acd736b51
14455114c5d750df9717c587c167271d3eb0fe4d8997ac04fc14989044cee26620ebf8fa739e0b917798118d63014ea4bfa27c16acec8ebc8a0c53fe5503705790753e9968c83bcc88c6b100ffc6751fe10085b988bbbc62f7235b726621ce428bcdd0e9
43644ed88af31a99aff9a869333fd50a4f924774fa10990f65004cfc9dfde2cb41ba27effe820ef8fba20f7ff7ef8b977c39b5bf57df4d479cf74543f3ca391e4f5ec769081b8fc7fa43a44cfe3da053292425436be129d4e1100c97d720f2ba04053954
fe0cd9f638b314d790c921326fc9fc5f3d2f842de15658f60fe8f421321fce009859fce534e8069b0b7970cebf97f07fe7e50d86a51bf6de201cfe9b2bda4ca6968fde7867ff35bb7518dc4fcef86b48d92fd0a914920e69c919ad631100721e0253ff31
116e4c4b6fd00ff3cd81ad21a721af583c644b2cd3b89f9ce98f715c9ffa9e9ec89cf835c2adf824334e7d05a56ba40b8164c31900b375653eacbc38b7e8b9b1f746d01a0decbd41088d846047bd6f99c6d32bbc373c1e6efa9b7c68bc23195ac3206d3a
ff9c335ac72200e43c44e65d647288cc17f6f28a5d43b6643d8c0b5d40a664484f644ed295189ab9c1016c8cd2ff978f4cf2789c1dc9863300669e5e56f1b89f9cfb6981f35ee95def4377776786e1ed282ebc1807b61e96373cecc9d26948a41d7a7e86
6ee847585a28d6e1300c9fd701a134845dfbc8d68e06c23f89075b434e435eb1fb912d39d500c899d6139987edd740cac46305f04af1f2afc11cc9163a7965eedf2baff7a8871501363e52f3bd5782d95fa687c0d6471d24fb7b8cde6085e3be061ade3f
0b7e78eea6858102e67dba037178011d0ec3f0158fd3d78ac2b0889c86bc6271902df1619cf7a8a18ca4dd643e0fdfbd15cc540043ce53e852e96b4936ac03366782bd57c0ccfd7be5710e87d0b0697b6def81bd0124e12fc260eb3d8f6df20e017b2f2f
1e76f8f995c0de3f674e3f3638d0de7204f00c14de22eef28add8f6c7b442701d78577462687c87c280320f306a8656404c0c2ef840b126c7be11b320901730f3f5c01693b491e9ec133d7f0068bf9e82381cce8613d091c6e7888340b742a85a4435a72
46eb5804809c97a0201761ca2b160fd9121600ef05b2af01dbe797b941d0e943643e94709071d8358f3a008793e9a124342cc85ea1c20d086cdbd790ec05d3f74f603e3274f7fbf66749afc0a1060c76de73cea33d1e4f5ea9b980197985916c814ea590
74484bce681d8b0090f31214641799ec23dba7465a97bc34218af781acf6466378087e16854f86e60128d4e1100c97d720f2fa71d452e0e2d5fc51fb77e0ff4ecd46713abe0485e78f5d97fd5bb7a7c0c813399f822ef9635bc2e27928ab59e986dedf3f
0b84cf47b1f404b433a2712cc009863ff426a328be1a541cceddd8eb5c797d15df7effc5978382ef1392a9b7089f02eefbabefbf288a77815667f1fc0452c3106966e47d3908ba5d9370aba194e27cfa3954ce3490fa2cf6e1332c6cfc75e3bc6a10c72c
3f43bd17747c05eaaf60b94f2d26ca82ebf395af2f5c5abcbaed21d926329b91f72132df446687c87c46de3160cfcaef89efa42674a4192e7ccf42d1706ef503938af3701a4a7e461f7e06850dcb0b1b0c5f81684b60ed6412e8e695932b5ed208e0bafe
215518493791593aed25db22b31ec490330774def3a7d680b7483f5cf89e0182f71569431f94bc1bc53d9586926c22b3a7e3d76ef66c384e7d84056ce481bde7636a4972145cd71b9c79cd028f27afb13493f4747ae3120f0bb32248930f5fba35e9d739
d29d4e805114fc029dfaf128ba0fe8f42e32dd44664f07975e8f00388c1e5d80e3a3cfe10e2803c2f1a1ff1c5f1e4f5e636926e9e9f4c6259816dc52af121936913387b4a722af4bbcacc01da1e017e8d48f47d17d40a7c34876c97d2398790e001b7bec
e11580d0f61e018686ffd0d9b3bd9c5decea40ce19797791c926323b95f690fb2864e4b7140c39e348b7e6762300a228bc350e6750f487e32ff9e5f78f206df20fdb626290fbc979dcb3c3865f147acfeca41b0168d87bee965fbb32907346de5d64b289
cccee49da755baee1169c7c287ee61489445facb0b9f83a07d62e796cfff44f13f53880c392f01c1cd937fd8af1f0b16ee08b0653e7a6548dd0bcc433d28ce7b799f87d93c9ebcc6d24fd251ede9b22bfd61f85bdf02fc3fedff846b582380fd25cf634f
c45f3fddb601b8292c275e7e7efbebd7afffe27e723eb8bba0acb1a120bf83fd5fe0f5a7e9cccbf0ebff417bd21e5f0ddfba309d7e6fae7780c47ff8a65da7424832d4023abac4682bfa94e7271d1ec641660b3b791dfa6d21d390ad23c926327b190862
9efcc37e680480f37c83d063e45194611e3d02304e2924dd4466e9f48664eb15a821b343647e2ebfa16f23939ad4916646de29241dd50e3fc64867e1eaf0300e325bd8c9ebd06f0b99866c1d493691d94bc0e517937f383e3307c046c047028795780be8
0e270189ecbabfe1d043b24d643623ef4364be89cc0e91f98cbcef05e2cd67a1d1c52424fcacd902dd1c6e7b7c3508d790338de4f7ccfca240d9e54ab4d4ea3ddab3d08ba15751d0cde1b6c75783700d39d3485e0d40f13da0bcb3c2120e1beb3beca228
8aa2288ae28be03058878be3a2b80528b3e1af113f8db7df3b025e20ef149071426ef8062c6020671848e670dbe328b037d6c7df046ed95f01dbf25b1ed8890e66b5a2f15fbc4181db5eedc9b90bcc7c42f776bf88a378cfc83b0c2443f70efbcd5584f4
9b4e05e6c66478aae043cef7a9c31371160120671848e670dbe328b037d6c7df846e9b0b64fcbffc1caec3a7910e0d534de96f8bb1b897fbe3d393f748e4bc1404eb7936afb7e0f1e415fc9e42c6a76e409718be06a443efe02d50b03e8e02f31fb10ee0
6e209d16e94c3760c1f3b464e5b78268061be034d3bc5d89cae1f0256f74108e2d1c62a08071605cd870f9a2a4500592ed50d99774814e858184f19dd7c1acdd87c0d89073085d62f81a900ebd83b740c1fa380acce770dbe30cd078a1e1965e8e7c4770
9f8b747637f780e938bbb9df02a7bd02b6bcfc9b0e84c1cabfc6f3b0e5f0874e64972a778ea40b742a0c24be92918f72fe38172f87120cdd4061e9d7169aa11589778337aa43c3ddd87901b4e5bc3ce07e0bb39c482fe36e819e0d49f8191ab63eeaf07f
abd67e93c091003772382294dda9fa03b93748a3cba0add115b9b93889aa0118044937d400c87e13992dd0a934923f8df535dd8d9d571c9f97d90d1ba7fd1996b0528efeb4181b9e74dacb69c8eb019dde446687767b40ce3274e693604f77927b8492e8
d40d7c3348baa14700d8ee22b3053a9546f21f09a267afc0b0f9e340fa6d12343e0c0e2d0997ed225de4954e2bc986d31852de3bcbcea9b90fc681c81947ba1f5d488aef404571a412661b007f04f0af17db47004e5efaabb9c35185ec86ea0f641eeee9
b9235da71a80e23ea0d8b56f009c911140f611606b1270cd8f9f0474241f6f001c7917c5cb4171e3fa83f967b90187c3e9a13034a94940427be948fb1ad0fd52af011d79879064814ea591bcea6f511445511445511445517c39bfb42f8ae203389af0fb
0574581445f1c34183c6d730e9e590d0b4af9186d6528f80b07cfdf5fc01118f27affcef12e83005644c337f6dc5fdd06a328a75988a0b4cf92a6db10e1d5bf6759cafa424b14f583f04dcefe9f4fb1870e35ccc71f83bf22d4ab035e146a0671bd5c3ce
ffc9c45cd9793c79e53e6ea140872920f3caef71b9ec736684c5fce2fbf3b9c0f2587e993cb0860b9bdd83bc3f1edcea53d2ef4780081b728681a45d7841b2bd87c302c48d847a5fd83103b6883602fe310b7b7eeffdd3bd18453a4c61a14d9c5a479e05
e15941d5b18f42d88b5bfef19c1f1f013bfb1d016cd678cafbe530ac2d64f23210449b7e2dfe697a38fd7e0416752067089833117a846f1cb6730f28af14d2ce959dc7f4903304cc59f05978b90d7d0e0cdd6803e08f3f8cc365bf4580b078af5ed91907
5f3fef3f08c2bc8d36c484bdbf35e0f27e390c6b0b99bc0c04d1a69f85871defdfca0fcf614b2f89be15b841b672841f447024603d00080d6365fb804e87e8d947af41bb3d6416226b4f20f106d4d3915c327464403adc8cfb96ff1a98f13ed890db26ef
10ae95f3c19d055a43ce97d186e1c7d8d948ca3c81fbdf02c4959538f52d376f90e898bd486ac863e20e3a1da2679fbd06a186c89966440b898d7e74ec5fc391974fa431101d6ec67dcbff9920088e7ce6fb5dbbb3406bc81946b219796fd2da9860627e
8422f4d0e1cf077165051efaa7a23a1e1a3a93e92a638925e9d02300edf690d9cb5030c49effb1f739882bc26e87b0768c6de81160145cdf1f7ffcb979e11e41fa74fa493623ef4d60d27b04e07c92cf0bbc3cfd9e0a239b8d306f161b61a5e3c69b26e1
211c6cc3bf64bb069ad393808e342faf782d08ce1f99d873700476d99b0084c1bc7aca24e028b8be57780f73e1fec9308ed8e64940ede73910ec6e370938d20078855f137a15083bcff01ed159fc07bba8b6c5420472a619d542b64e03169c4bde08201c
36a08b82ca63f9a5d3700484f3d447802b611a617b6bfa3d0d44d890330c24edb32b7b91f03a00d832b12cb3b167efc7046501e0965a4f70168467c899e6a4b65d4873e9b011e1310f7c2442e6a1ed15302c6cedc4d9c2fdd3517cdf967e4f638afb5003
c061cfd0bff6fe2446d26e0daf41e42c8a057fa7fd4f833df5bf4e874506d4757b0b00d888fab0ff2fda17c5754ce5706804c0427cea37e13f81c1b4b3d113b582c3c74b5704164551144551145fcb3402ad09a8a2f8a96c4e02a2defa6b246e97ff73cb
267c92fed750d09c8e3f74be8aeed2f7af08af7d0534a3d3b7015166fa9d59cdc9d7619e872f7d0d86eb6fc615fe5c58b65b060ff4bc8fddb75a38bf595ee1e6ebec6b5f632a223693cc6379a780ce9033056416be8e4726c36cf10bb6e1efc9216345bc
baf22f16f1c8ef76959f20dad690c99906524e06330fe7e5c4af02d7efc65561dbeabc3db6f404de87716718d8bae5154e9689e1a5cc4320c0a10600b6bbc82c0c244cd8e11188057ae19a0285b7ce4043ce5d643ae37e76f2869c897bab3d739d28bd30
e0c58a197a23b5a14f555e5e03cce515c76c80861672d995809c39a01b1a42c37617991d0253363c4cfca1960f3aef3d86470023302c22a721af501c643ae37e76f2869c893ba4978d0008c258e71b87fe9955a86b3d7f0f21b4041976ddf28ac37003b4
86d721725e8fc21f8a00644c9019798781a46dc02e5b028cb00c390d7985ee01668b8f91e4379a86869c6fe14cf8900ecd01c09665a75d4bbf706f019b39ae384cf7bc2b3d2b73580fdb87f22abf5b7cc3d0059137e4fc0a74cb8b7b9657381d60eadf2f
98c6f759a823727e0db865f6dcf363ebda1d01f68b9e17c76c10327968cff43af6ca4dc213dab09d473d384e854f684fe4bc1e85ff550550b7bcb86779a5d3c13523da6f06c9c59103b16769ec17ee2360f730f4879b153a940f305bfc100e8e59f95313
dad4639be380e370f804a6bc0772eddb836f47894eac00703f39f395d83523da6f06c965bd25f00660e1de03360f437fb83922b346445e9bc0e441efd01fdbe17c1a6c16affd701c0e9fc0cc2b3f1b9ecbdf1eec22b38f45b7d94526615c33a2fd66905c
c38f00b07b9874837b81bcbbe0744fcff90056e2e8db84c59b031c2f9077179cf60ec72615e57d1d53d8dbc8ec63d16d12cf881a015c0c926b7412900dc5a61dce1d553e56f2871e1e7e0c7f46de5d707a6f0471580e60e2730d436f0e8a9328f19f5261
fd3acfba5e16046bcf9de0be33d15f06f2ca1b8076fe80af2349cd07bc1a25f4473400044173f8fab6f08b1cc82abe71d86278415d1144097dfb0680610a0e5fabe0dc08e417270c7df446787cf808b400023ecf90e159446aa74b0cfda0a6ad8802e989
0c683ceefedb80efa840edc28e5b5620c4fbb665e02c08f3adf74ea07bdbfd1b089889905a0dd5422daf21670a693981960e1f1ac2c4f3d721e967588a74b8388e02092b3e87cfdc528b507e1288fb2dcb0081ee6c1ebeedde89f4c375408743f75e9c04
69fe110d40f1a5a0d03a4385575af2ed7a127e0480ad0f1b7791f9263061efe533c2a967c049d24726bbc8b48b4c7691691799ec22d32e320921494ad322f9fdf4d0f8d24927358140fb493653fa20b0e5b08fec360432ef82d3ed04504b281eb2ed2293
5d64da4526bbc8b48b4c7691691799849024a56991fc7e7a687c02c40b63ea3986f693acf4da87f4b0f34a6fcf7c3ace165a5f78c446c0168360ef3f32127a0f2cdbef2bf82b7499ef4b07687ce8e8b390a96130ed2759e9b50fe961e70d86cd3ceb3895
8130f7de7f9e39c631e3c16b8766b4292672a691fcb67a4797f9ae7480bd0f5ffd430aef3da285a7f413293dcf4f667f9bf195bb8b4c1ed0e9e1424374892e32d945a65d64b28b4cbbc8641799769149084986d352f21fadeffd28a83f27fe71b5ffbdf6
47947e22abff83f6ff47fba2b81e34188b0f171aa2cf8fa5efb3a9c7b9e109bf3530f7f0eb11e024baccf7a4036c6dddf70ebb2b92787e32dba4f41de0efcffe5d641602e6bef8a926014fa2cb7c743aac1f01fc0ba2fff5ab81eec97b3ebf45e927c27a
e40f7b653e36fc49e6336600a66c5ca2530f40f67fb1fb2f6cbcae4d4662efeb103c1e212ca0153a154292053a154292053a154292053a55f440fa3c0c1f09dd93f77e0fc2f39359e9e565d03d793feae1b798f96f917f17996c02137f15496a21909049
0849529a16c96fab2f6e0cf2dd5f07d6b7fc45f18da0f2dbc843cea228be01567ac14792fa96bfb81e143c7f061dfa261fe6ae0fbdba5a43dd24cf2de375a0f3557c8be7f908d09cbaf74f00b77c2aff08b5d325aecfc36781b04fddc36dd14d3303ce7c
93cf4234fa2d3827d786135dfadbfe1ec14f00d11ece3f422daf21671ae9dffa3d3dc3c6f65d95bff84c5090877bf3e226b0b5ebc08524a161d4646e2c9e3de5176a4961c69ec33fa8e13ed582d25e3af275fab3303c6cfe4a9330fffd2bc3dd3905d93c
e4b3bc0ff35f6677d6fb2bdf877f294ebfe9d47e5d92cd61585b40ca387858b979a049d38505f1f0b7c6275363f1ce5b7e9104f488af39fc1fed847693f9035fa13f0bc39982eb621f38ed21bb3315c8907346de3f5e4f60e68f7ef3c22f1e4f5ec78f83
b20b85d503525ff9e9c4bf6695600e1c877c96f54271d813c9ce69ff3f9a2167179c6ebf65b756927bb9c9ee3f56e4f9c9ec3bf50436ccaf453ec11d7a06e6f5b11186e7cb88fdeb46520d401098b2c39c2bdedabd07ec7a84e731644f7c1274bc012070
b21092dd9570447684438f79d4603ec08c36c0691f762e9e35e99ebcc32bf1be524f60c3bc62ba5b25d69e6e6b50f680cd227cecfd5aee7f589064375c8164765bbd0353ff7d7e3e4e7123a1a1b86c7b1c36c044b6c4471d871d8721e3053a154e009991
f577f186196d2093ae8d4e953e00ccbce29250e52793f9dfc2c0a135243a36ecc40e327bb093f7c7eb5b60ce37004eba0797936eef8043e1cb945819907797c5c740ed07283c2672a681f44fd871634bb8e8d18a9f0ff2cc2a3ef2f11fcda318a1fdf82a
f521d693f0ce373e7fc41683c869c0e9cf129121a8a163d7f933ec6e6b84d33ed45c7cb842f7e41d1e427fa59ec0c67b7f6eed3f27893c02588f01188f59837de611c4907346debbf94f64765bfd1ac9523a497a84de06c9d6c2c4ce1f3f626b5164bc88
309c3eab189e0494936e9f1135e4dd05a7db49287f0e65e1f306243389f6757a021b3600acc0ed24e2ecde0336ed90d566b0b1f779041209df6de7b2c2e3c92b3489786bfd1ae99ed1001cd63d47f66d1d34e4dc47b63dd823845f03ca69c0e93dcb6124
60e219b0e692d768b49bcc1fb885fe0c0863fdfaa8251a7f6fc47a2c46363d60736bfd1ae9861a0039d3484eda7f147a387a3364bc26bd10484e034e9f8d0cdd14ccd8e27aa3c17db8f523b4978e7c9d7e0484e1858523b67624c0d1436a2933ec99dffe
3843787c387a70607b6b7dcb247f5b03d03e0eda88b22836a9425214455114455114c36038ddbe82ab1fe5288a6f42159f9330361123efa2f851f4fe33908142cb9968323c3144ed7489b1596ce87c2151e80d440b341e7f9bc1e6819d28c220c94e9501
ea26f9f5f97f168479ebf2ff14103013e1b6bfe802988043bfca43810e17c75120f9884700c47db80c5047bd9c69a41fca7f02ddd93cbc75f9d7e1d0bd1745f1ada0c1e0732b5b1f87abd3c2c310da622bfddf08eb61e7434fc26b7018e98b52c20b5260
e7231092ee85a0a1be0d37b50a0ef6b7d693493ade7b4a7e3f3d342cb06b624b09016c4bffc8a11e368bef2676d86d0470de3f1e6ac9ac84ebe949e8791876b7d63bd27c5f03d0023d7b33435e29202bbd90d72630618f6d3d15f6b30eb89f4f2aed3626
38ef0d10edfd3a230d985518ee2767ec6318d8dd5aef483394ef44f27beaa163a2b147f2c44c5d08e6a51fd0c38cbdd742d743e65d64928a6f8be43dcefca415b985de91e6743aca9946f297eabbaf01a1e1acb57ffdf57bedc3947e4c0f1d3fc1e58c2f
0beafccc6abfccb242a7aee6f06bd003eeaeff0e50107df288c3c7f9794aa70f8169e927527a987475c026f1b0e7c416f1c6a50bcf4f66760d5e8b847b3fd8ba3ef5ccec40776bbda36b84f37d8de4f7d343e3b3a78e154c9d3e04a6a55f12d2c3a4abeb
b05bb071be6d3c9cf09b00d8f6f424f43e1a76b7d63bd284f37d8de4f7d343c35ec30b235f45792f122a44b02bfd801ee7396fe03afe06031732d1cf7b349ee3e3c521b4c3e60d4828de2dd0b4dfc4f33aa96bc0fed67a3249bfb001283e03e4bd371ca9
559045517c08a8fc36fa90b3288a6f80955e841f1b8aa2288aa2288ae2041876fa472dc3dfe343e2d7187d1fcc1974929e0126d0d5ef119c00b77cdbfc7b0608f754fcdf0e22ce5964be42e137c9f3bf3a8e007b32fc3dbe031d0b51eafdad431df572a6
91fe2dbf474028d2e1e2f84e20dab7cc3f02dda9f467b8d8d2f1675844ce215afdf0b5a0e3bb54925a435dfc0c9477a70a9283cb9c5a5557c49972ed39f976c4de4f8231c3b976fa7f60e32820dc8a5aec27b822cb1763703491f9a6bed5729ffd1efcab
f56761780a97f02b3ae65f74119221a721af50a196e92df530f134b3ef0eb89f9cf1af311d687c3117b768da3f277c08387462c0c41794a40a4087dd35ec0eec58f87a842a01ed26f307be427f16863305b720f32d8121a721af97574022d3b7e861e2f3
1e5657b89f9cf14701d9f738cc7fd89c0e9f2256fe1ed1efb11d1b35603f172833380066dee058a4b99f9ce9ffaff7757ad96d22b35d60c66757c247402f4024fa6b44869c86bca2e11b721af2faf17a98787a595de17e72c63a4f227be213c899fc3f1d
3e453e8cf056c4e702520908e6cf2fe57e790610997ea55e669bc86c17999a2d761c057a010c8d02643b147f22d35bea61e2436e4b2beee9b09341682fd2f50726a7c3ef0626afd08564fa343d0efda64a7f010a8ab0e27b4132cce000992e6ce5f52d7a
1fc1796f1c1af939d25c12fed624e05ff807c2f939827bf067ed5f8d8583706d080cfea07d34fc6fd71bd01b7266f070f8ea97a33f7f059c0ddf9e59b1f7fb487163fdbf6aeff9e6ee1408d71eb99af0a3e97f2e7c04380ff9571c4e4210d99e69c1b626
c142afa260f7d57a479a740300c9d61c5034ffbd077a4026bbc0eceefa75fe85d2cd91a64734fd4f856f40c446c0e702b84f4f62c869c82b948004a6bc8936fc6c227eb5fe0c08ab9df8230c3f93fffc02d12b9169a7c37005bab59ec8dc905718c908c3
e5333cb770fa138a1d7915451c949bd468a35882f4f30624f54bc444ba531517f250f89b0b818aefe6d7af5fa9e7fd62933f6aff2ede1d7e517c17ea79edf5a9bc524cf2f11180e481f07ff39bff0667c2fc61a4da48200000000049454e44ae426082
'----------------------------------------------------------
' 29c: use the font:
'
font(loadtex("font.03.png"))
printr "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
printr "abcdefghijklmnopqrstuvwxyz"
'****************************************************************************************************************************
30: Hedgehogs Star_field: (update 2023,april3: .k_teach & starfield and texture_PB_06.fin)
'
'
' have 3 files in the same folder:
' 1) .k_teach & starfield and texture_PB_06.fin '(code below)
' 2) 01.pb.jpg: basic4gl.proboards.com/thread/3662/convert-photo-2022-byte-hec
05:pb_01.txt ' [ to convert into: 01.pb.jpg ]
' 3) font.03.png '(from 29a)
'
' read through all text in starfield (to comprehend everything)
'
'here the code 1 :.k_teach & starfield and texture_PB_06.fin :
'{
'.k_teach & starfield and texture_PB_06.fin
'
'Update: 190/one texture over 2 triangles
'
const l1=16000,l3=1000
'
dim a$,arr(255),a100(100,1),a101(127),ba,b95,ca(999,2),cr(10),cb(1,255),d1(250),da,fa0,fb,fc,f30,f0(3,255)
dim g,g1,i,i1,i2,i3,i4,i0,is3=50,in$,in,in5,max ,na,xa5,shift,tx,ty
dim c3(255),in8,ga2,ga3,f26c
'
dim a1$(12),a2$(100),a14#,a15#,a#(3,2)
dim a16,a,a5=43,a3(a5),a4,a6=a5,a25,a26
dim a1,a01,a02,a03
dim bb,b#(195,2),b$
dim c,cx,cy,cz
dim camX#,camy#,camz#
dim f1,f3,f01,f02(100),f07,f75(a6),f80(a6),f97,f(10),fa(255),f99
dim ga
dim l4,l5
dim ma
dim mx#,my#
dim nr
dim sp1=2,sp2,st,ste,sp0 :reset m5:read sp0:dim sp#(sp0):
dim t3(100),tl3,t1(300),t4(300)
dim xa=30,xy,xb,x2,x3,x4,x5,x6
dim ya=8,yb,y2,y3,y4
dim z2,z3,z4,z5,z6
'
f0(3,112)=sp1
dim s0 as string:for i=0 to 3:s0=s0+chr$(32):next
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
declare sub draw(i) :declare sub w(i) :declare sub txt() :declare sub mouse(i) :declare sub box(wb,x1,y1,z1,xw,yw,zw)
declare sub keys(i) :declare sub l(x,y,a$) :declare sub l2(x,y) :declare sub inscan3() :declare sub line2(co2,x1,y1,z1,x2,y2,z2)
declare sub text() :declare sub xyz2() :declare sub combo() :declare sub cam() :declare sub texture(nr,size#,ptr)
declare sub glbt(i0) :declare sub line1(co2,x,y,z) :declare sub draw_xyz_line(l4) :declare sub line_lr(xb,yb,zb,l5)
declare sub vec_key() :declare sub a16_() :declare sub camZ() :declare sub line_ud(xb,yb,zb,l5)
declare sub inv(i0,i1) :declare sub glbC(i0) :declare sub camX() :declare sub camY() :declare sub grid(xb,yb,zb,co,ste,l5)
declare sub k1_(isik,nr,k0):declare sub f_(nr) :declare sub txt1(nr,x,y):declare sub bug()
declare sub wait(i2) :declare function mb_(a):declare sub sl(i0)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function mm(i0,max):i0=i0+1:if i0>=max then i0=0:endif:return i0:end function
function m_(i):na=mouse_button(i):return na:end function
function s$(i): a$=str$(i):a$=left$(a$,len(a$)-1):return a$:end function
function inkey(g10) :return -(g>0)*(g=g10):end function
function inscan(i3):arr(i3)=ScanKeyDown(i3):return arr(i3):end function
function inkey2():in$=inkey$():if in$<>"" then g=asc(in$):endif :b95=a101(g):f30=keydown(chr$(b95)):g=(g*-f30):return g:end function
function mi$(i0):a$="":for i=0 to i0:a$=a$+"-":next:return a$:end function
function skd(i0):i1=ScanKeyDown(i0):return i1:end function
function t(i0#) :a03=i0#/10 :Return a03 :end Function
'
sub inv(i0,i1):f0(i0,i1)=not f0(i0,i1):f0(i0+2,i1)=mm(f0(i0+2,i1),cb(i0,i1)):end sub 'f0(i0:0-1,i1:g or b)
sub cam():cx=camx#:cy=camy#:cz=camz#:end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
for a=0 to 9:cr(a)=a*28:next: for i=0 to 999:i1=i/100:i2=i1*100:i3=(i-i2)/10:i4=i-i2-i3*10:ca(i,0)=cr(i1):ca(i,1)=cr(i3):ca(i,2)=cr(i4):next
'
reset m3:for i=0 to 17:read a100(i,0),a100(i,1):a101(a100(i,0))=a100(i,1):next
i2=17:i1=97:do:i2=i2+1:a100(i2,0)=i1:a100(i2,1)=i1-32:a101(i1)=a100(i2,1):i1=i1+1:loop until i1=126
for i=0 to 127:if a101(i)=0 then a101(i)=i:endif:next
'
for i=0 to 255:cb(0,i)=10:next :for i=0 to 255:cb(1,i)=10:next :cb(1,112)=13 'inkey cb(0,i) , inscan cb(1,i) , press f1 (0-4)
'new
a=-1:reset m6:for a=0 to sp0:read sp#(a):next
reset ma:for i=1 to 12:read a1$(i):next
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
reset m39:i=0 :read b$ : t3(i)=LoadTexture("01.pb.jpg")
'
st=1:xy=400 :a01=st*xy:a02=a01*2 :f1=112
declare sub line_3d(x1,z1 ,x2,z2)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'smallest_keys_08.14
dim g2,in6,in2,in2$,c1(255),a2,b1,hmk,is(255),is1,is2,in7,ik(255),ik7 ,k(1,255),k4(1)
for i=0 to 255:c3(i)=i:next:reset m11:for i=0 to 46:read a2,b1:c3(a2)=b1:next:hmk=i-1
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
dim i5,k1,f24(255),sp3(10) 'skd:plus or minus
dim ls(10,1),ls1
declare sub sp_lim(nr,i0) : ::declare sub keys1() :
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
reset m2:read ls1:for i1=1 to ls1:for i=0 to 1:read ls(i1,i):next:next
ls(0,0)=0:ls(0,1)=sp0 :for i=0 to ls1: sp3(i) = -(ls(i,0)>0) * ls(i,0) - (ls(i,0)<0) * ls(i,0) :next
'
m2:data 4, 0,99 , -5,199 ,2,10 ,-10,-5 '1,2,3,4 '0=speed F1/F2
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
sub keys1():dim in6b
in2 = InScanKey ():if in2<>0 then in6=in2:in7=in2:k4(0)=in2 :endif:
if in6>0 and in8=0 then in8=true :k(0,in6) = not (k(0,in6)) :ga2=ga2+1 :endif 'ga2 for test
if in8 and skd(in6)=0 then in8=0 :k4(0)=0 :in6=0:clearkeys() :endif
'
in2$= inkey$():if in2$<>"" then g=asc(in2$):ik7=g:k4(1)=g:endif
if ga=0 and g>0 then ga=true:k(1,g) = not (k(1,g)) :ga3=ga3+1 :endif'ga3 for test
if ga and keydown(chr$(c3(g)))=0 then ga=0 :k4(1)=0 :g=0 :clearkeys() :endif
end sub
sub k_(nr,isik,lower,upper):k1_(isik,nr,lower):k1_(isik,nr,upper):end sub 'data m7
sub k1_(isik,nr,k0):dim i0:i0=sgn(k0):k1=abs(k0):if f24(nr)=0 and k4(isik)=k1 then sp3(nr)=sp3(nr)+i0:sp_lim(nr,i0):f24(nr)=true:f_(nr):endif
:if f24(nr) and k4(isik)=0 then f24(nr)=0 :endif :end sub
sub sp_lim(nr,i0):if i0=1 and sp3(nr)>=ls(nr,1)+1 then sp3(nr)=ls(nr,0):endif :if i0=-1 and sp3(nr)=ls(nr,0)-1 then sp3(nr)=ls(nr,1):endif:end sub
sub f_(nr):if nr=0 then f26c=0: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,34,39,60,44,62,46,63,47,97,65,98,66,99,67,100,68
data 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
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
reset m40:
for i=0 to 95:read b#(i,0),b#(i,1),b#(i,2)
if i<32 then b#(96+i,0)=b#(i,0) :b#(96+i,1)=b#(i,1) :b#(96+i,2)=b#(i,2)+1 :endif
if i>31 and i<64 then b#(96+i,0)=b#(i,0) :b#(96+i,1)=b#(i,1)+1:b#(96+i,2)=b#(i,2) :endif
if i>63 then b#(96+i,0)=b#(i,0)+1:b#(96+i,1)=b#(i,1) :b#(96+i,2)=b#(i,2) :endif
next
reset m41:for i=0 to 3:read a#(i,0),a#(i,1) :next 'a#(0-3) text_ordinate
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'new texture
dim v0#(2)
dim mxd#
mxd# = Mouse_XD ()* 50
'new_inkeys_ba_18.03
declare sub m(b):declare sub mb(m1):declare sub tutorial()
function r0(a as integer) as integer :dim x2 as integer:a=a+1:x2=(rnd()%a):return x2:end function
dim mbt(2) ,f06(2),f05(2)
dim f6b
'2022,6.18
dim v1(100000)(2) as single
dim cl(100000)
dim f2,rx,ry,rz,rm,rm1
dim rxa,rxb,rya,ryb,rza,rzb,rxc,ryc,rzc
'
rm = 32767 'RND_max
rm1 = rm/2
'
function mb_(a)::ma=mouse_button(a):return ma:end function
sub wait(i2):dim i1:do:i1=mb_(i2):loop until i1:end sub'color (255,0,0):print i1:color (100,100,100)
sub sl(i0):dim i,i2:for i=0 to i0:i2=i*123.123:next:end sub
'
dim l2#,vl#(2)
'---------------------------------------------------------------------------------------------------------
'2022,11.4
declare sub side(cnr,v0() as single):declare sub cube(v0() as single)
dim vc(5,2) as single
dim sd(5,3,2) as single'6sides,4 corners
reset m7:for i=0 to 5:read vc(i,0),vc(i,1),vc(i,2):next
reset m8:for i=0 to 5:for i1=0 to 3:read sd(i,i1,0),sd(i,i1,1),sd(i,i1,2):next:next
dim v0(2) as single
v0=vec3(10,10,10)
dim a10
'2023,jan.18
dim tc(5)
for i=0 to 5:tc(i)=r0(254):next
declare sub box_(nr,sz)
'---------------------------------------------------------------------------------------------------------------------------------
'2023.march27
dim cr1(10) as single,gc(999,2) as single,cb#
for a=0 to 9:cb#=a:cr1(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)=cr1(i1):gc(i,1)=cr1(i3):gc(i,2)=cr1(i4):next'1000 gl_colors
sub glC(a as integer):glColor3f(gc(a,0),gc(a,1),gc(a, 2)):end sub
'---------------------------------------------------------------------------------------------------------------------------------
sub enable():glenable (GL_TEXTURE_2D):glEnable ( GL_BLEND):glColor4f(1, 1, 1, 1):end sub
'2023,apr3
dim v(3,2) as single
reset m10:for i=0 to 3:read v(i,0),v(i,1),v(i,2):next
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
glViewport(0, 0, WindowWidth(), WindowHeight())
glMatrixMode(GL_PROJECTION) : glLoadIdentity()
gluPerspective(60, (1*WindowWidth()) / WindowHeight(), .0001, 100000000)'100 mega
glMatrixMode(GL_MODELVIEW) :
glEnable(GL_TEXTURE_2D)
'------------------------------------------------------
font(loadtex("font.03.png"))
tx=70:ty=50:resizetext(tx,ty)::textmode(texT_OVERLAID):
'
camz#=20
'
'
do
glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT)
glLoadIdentity ()
glRotatef (my#, 1, 0, 0):glRotatef (mx#, 0, 1, 0)
glscalef(1,1.2,1)
glTranslatef (-camX#, -camY#, -camZ#)
'--------------------------------------------
mouse(2) :'keys(1):
keys(2)
vec_key()
txt()
'
keys1():k_(0,0,-112,113):k_(1,0,-114,115):k_(2,0,-116,117) :k_(3,1,-97,115):k_(4,0,-118,119):bug()'[sp3(0),0:inscan,(-F1,F2)]
'
inscan3():combo()
'------------------------------------------------------------
draw(1):draw(2):draw(3)
'--------------------------
m(0):m(1):m(2):
tutorial()
'------------------------------------------------------------
' one texture over 2 triangles
glBindTexture(GL_TEXTURE_2D, t3(0))
glBegin(GL_triangles):
glTexCoord2f(1,0):glVertex3fv(v(0))
glTexCoord2f(1,1):glVertex3fv(v(1))
glTexCoord2f(0,0):glVertex3fv(v(3))
glEnd()
glBegin(GL_triangles):
glTexCoord2f(1,1):glVertex3fv(v(1))
glTexCoord2f(0,1):glVertex3fv(v(2))
glTexCoord2f(0,0):glVertex3fv(v(3))
glEnd()
'------------------------------------------------------------
draw(0)
loop
' v0 ,v1 ,v2 ,v3
m10:Data 0,-100,0,0,0,100,100,-4,100,100,-34,0 '0
'[data :4 vec3:0,1,2,3:
' v1# v2#
' v0# v3# ]
'
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ grid(xb,yb,zb,co,ste,l5)
sub draw(i) :
if i=0 then drawtext():SwapBuffers ():endif
if i=1 then
gldisable (GL_TEXTURE_2D)
glColor4f(1, 0.5, 0.5, 0.5)
'
if l2#< 75000000 then
draw_xyz_line(1000) :
grid(0,-4000,0 ,909,1000,5000)'grid(xb,yb,zb,co,ste,l5)
grid(1000000,1500000,2000000 ,90,1000,l1):
box(1, 0,0,0 ,8,8,8)
box(2 , 1000000,1500000,2000000 ,32000,32000,32000):
box(50, 100000,100000,100000 ,10000,10000,10000)
endif
'
if f6b=5 then
if f2=0 then
for i=0 to 100000:
rxa=r0(rm)-rm1:rya=r0(rm)-rm1:rza=r0(rm)-rm1
rxb=r0(rm)-rm1:ryb=r0(rm)-rm1:rzb=r0(rm)-rm1
rxc=r0(rm)-rm1:ryc=r0(rm)-rm1:rzc=r0(rm)-rm1
rx=rxa*rxb*rxc:ry=rya*ryb*ryc:rz=rza*rzb*ryc
v1(i)=vec3(rx,ry,rz)
cl(i)=r0(999)
next
f2=true
endif
'
for i=0 to 20000
glC(cl(i))'texture before gl_points
glbegin(gl_points):glVertex3fv(v1(i)):glend()
next
'
vl# = vec3 (camX#, camY#, camZ# )
l2# = length ( vl# )
endif
'
glc (777)
glBegin(gl_lines):
line_3d(-1,-1 , 1,-1)
line_3d(-1,-1 , 2, 0)
line_3d( 2, 0 , 0, 2)
line_3d( 0, 2 ,-2, 0)
line_3d(-2, 0 ,-1,-1)
glend()
endif
if i=2 then text() :endif
if i=3 then enable() :box_(0,1):endif 'v0:move
end sub
'
sub box_(nr,sz)
v0#=vec3(0, 0, 0) 'move
texture(nr,sz, 4) :texture(nr,sz, 96) '1:raven
texture(nr,sz,32) :texture(nr,sz,128)
texture(nr,sz,64) :texture(nr,sz,160) 'texture(nr,size#,ptr)
end sub
'
sub line_3d(x1,z1 ,x2,z2):glVertex3f(x1,0,z1):glVertex3f(x2,0,z2) :end sub
'z+ to z-
sub box(wb,x1,y1,z1,xw,yw,zw) : x1=x1-xw/2:y1=y1-yw/2:z1=z1-zw/2 : x2=x1+xw:y2=y1+yw:z2=z1+zw
glC(990):glbegin (Gl_line_LOOP):glvertex3f(x1,y1,z1):glvertex3f(x2,y1,z1):glvertex3f(x2,y2,z1):glvertex3f(x1,y2,z1):glend()
'
glC(999)
glBegin (GL_LINES)
glvertex3f(x1,y1,z1):glvertex3f(x1,y1,z2):glvertex3f(x2,y1,z1):glvertex3f(x2,y1,z2)
glvertex3f(x2,y2,z1):glvertex3f(x2,y2,z2):glvertex3f(x1,y2,z1):glvertex3f(x1,y2,z2)
glend()
'
glC(990):glbegin (Gl_line_LOOP):glvertex3f(x1,y1,z2):glvertex3f(x2,y1,z2):glvertex3f(x2,y2,z2):glvertex3f(x1,y2,z2):glend()
'
f02(wb) = (cx>=x1 and cy>=y1 and cz>=z1 and cx<=x2 and cy<=y2 and cz<=z2)
end sub
'
sub w(i) :color(ca(i,0),ca(i,1),ca(i,2)):end sub'1000 colors
sub mouse(i) : if i=1 then xa5=mouse_x()*260:if xa5<0 then xa5=0:endif:if xa5>255 then xa5=255:endif:endif
if i=2 then mx#=mouse_x()*721-360:my#=mouse_y()*361-180:endif
end sub
'
sub l(x,y,a$):locate x,y:print a$:end sub:sub l2(x,y):locate x,y:end sub
sub xyz2():x4=t(cx):y4=t(cy):z4=t(cz):end sub
'
sub keys(i)
if i=2 then :cam()
if g=87 or g=119 then
a10=a10+1
camZ#=camZ#+sp#(sp3(0)):
endif'ws
'
if g=83 or g=115 then camZ#=camZ#-sp#(sp3(0)):endif
if g=65 or g=97 then camY#=camY#-sp#(sp3(0)):endif 'qa
if g=113 or g=81 then camY#=camY#+sp#(sp3(0)):endif
if g=90 or g=122 then camX#=camX#-sp#(sp3(0)):endif 'xz
if g=88 or g=120 then camX#=camX#+sp#(sp3(0)):endif
xyz2()
endif
end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub txt():
if f(1)=0 then f(2)=0: if f(3)=0 then clearregion(0,0,tx,ty):f(3)=true:endif
w(909): l(00,00,"1)InScanKey ()+inkey$()"):w(990):print":hedgehog.PCN2 :2022 (3.31)":w(900):print " new_inkeys_ba_18.01"
is1=is(in7)
'
locate 0,42 :w(900):print mi$(69)
W(337): printr "key.combiation: ctrl+shift+(A-Z)+(0-9)"
W(090): printr ".press combo:shift+ctrl+F12 to leave keys"
W(099): printr "da:";da;": " 'l2(00,26)
locate 0,ty-3 :w(900):print mi$(69):
w(909): printr"9/19-3/20,5/21 :hedgehog.PCN2"
'
clearregion (0,46,tx,46)
W(047): l2(1,46) :
if d1(0) or d1(1) then :for i=0 to is3:if d1(i) then print"d1(";i;"):":endif:next:print " ":endif
endif'if f(1)=0 then
'
if f(1) then f(3)=0 :w(737)
W(900): locate 0,ty-4:printr "(F1-/F2+)_speed:";sp3(0);"/";sp0;":"; sp#(sp3(0));s0
W(094): printr "A:";cx;"/";cy;"/";cz;s0
print "B:";x4;"/";y4;"/";z4;s0
W(099): l2(58,0):print "f02(50):";f02(50);s0
l2(58,1):print "f02(1) :";f02(1) ;s0
l2(58,2):print "f02(2) :";f02(2) ;s0
endif
'
end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub grid(xb,yb,zb,co,ste,l5):gllinewidth(2):glC(co)'floor left_right,up_down
glBegin (GL_LINES):
z5=-l5-ste:do:z5=z5+ste:line_lr(xb,yb,zb,l5):loop until z5=l5
x5=-l5-ste:do:x5=x5+ste:line_ud(xb,yb,zb,l5):loop until x5=l5
glend()
end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub line_lr(xb,yb,zb,l5):glVertex3f( xb-l5,yb ,zb+z5) :glVertex3f( xb+l5 ,yb ,zb+z5) :end sub'left_right
sub line_ud(xb,yb,zb,l5):glVertex3f( xb+x5,yb ,zb-l5) :glVertex3f( xb+x5 ,yb ,zb+l5) :end sub'up_down
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub texture(nr,size#,ptr): glbt(nr): glbegin (Gl_quads):
for i=0 to 3:glTexCoord2fv(b#(i)):glvertex3fv ( b#(i+ptr)*size# +v0# ):next: glend ():end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub glbt(i0):glBindTexture(GL_TEXTURE_2D, t3(i0)):end sub :
sub glbC(i0):glBindTexture(GL_TEXTURE_2D, t1(i0)):end sub '..............
sub draw_xyz_line(l4):line1(9,-l4,0,0):line1(900,l4,0,0):line1(9,0,-l4,0):line1(900,0,l4,0):line1(9,0,0,-l4):line1(900,0,0,l4):end sub
sub line1(co2,x,y,z):glC(co2):gllinewidth(2):glbegin(gl_lines):glVertex3f ( x,y,z):glVertex3f ( 0,0,0 ) :glend():end sub
sub line2(co2,x1,y1,z1,x2,y2,z2):glC(co2):gllinewidth(2):glbegin(gl_lines):glVertex3f (x1,y1,z1):glVertex3f (x2,y2,z2) :glend():end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub vec_key():c=ScanKeyDown(40)-ScanKeyDown(38):if (c or c=1) then cam():a16_():xyz2():camX():camY():camZ():endif:end sub
sub a16_():a14#=cosd(my#)/1.01:a16=int(a14#)*2+1:end sub:sub camX():camX# = camX# + c*sp#(sp3(0))*sind (mx#) *a16:end sub
sub camY():camY# = camY# - c*sp#(sp3(0))*sind (my#):end sub:sub camZ():camZ# = camZ# - c*sp#(sp3(0))*cosd (mx#) *cosd(my#):end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ma:data F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12 'c=inscan(40)-inscan(38)=inscan(37)-inscan(39)'c=d-u___d=l-r:'d=inscan(37)-inscan(39)
m39:data "Raven Bird_01.jpg","Seattle White Doves.jpg","macaw_01.jpg",
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 15'sp#:0-11
m6:data .001,.01,.1,1,10,25,50,100,200,1000,10000,20000,100000,500000,1000000,10000000
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub combo():f01= ( d1(0) and d1(1) and d1(49) )'ctrl+shift+F12:switch to new program:f(1)=true
if f97=0 and (f01) then f97=true:f(1)=not(f(1)) :endif: if f97 and not (f01) then f97=0:f80(0)=0:endif
end sub
sub text():if f(1)= true and f(2)=0 then clearregion(0,0,tx,ty):f(2)=true:endif:end sub
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
m40:'ez_keys,vec_letter,plane,texture_12.final b#()
data 0,0,0 ,0,1,0 ,1,1,0 ,1,0,0 ' 0 96 'up --->x and y
data 0,1,0 ,1,1,0 ,1,0,0 ,0,0,0 ' 4 100 'turn right 1*
data 1,1,0 ,1,0,0 ,0,0,0 ,0,1,0 ' 8 104 'turn right 2*
data 1,0,0 ,0,0,0 ,0,1,0 ,1,1,0 '12 108 'turn right 3*
data 1,0,0 ,1,1,0 ,0,1,0 ,0,0,0 '16 112 'rotated 180 deg
data 0,0,0 ,1,0,0 ,1,1,0 ,0,1,0 '20 116 'rotated 180 deg,turn right 1*
data 0,1,0 ,0,0,0 ,1,0,0 ,1,1,0 '24 120 'rotated 180 deg,turn right 2*
data 1,1,0 ,0,1,0 ,0,0,0 ,1,0,0 '28 124 'rotated 180 deg,turn right 3*
'
data 0,0,0 ,0,0,1 ,1,0,1 ,1,0,0 '32 128 'up ---> x and z
data 0,0,1 ,1,0,1 ,1,0,0 ,0,0,0 '36 132 'turn left 1*
data 1,0,1 ,1,0,0 ,0,0,0 ,0,0,1 '40 136 'turn left 2*
data 1,0,0 ,0,0,0 ,0,0,1 ,1,0,1 '44 140 'turn left 3*
data 1,0,0 ,1,0,1 ,0,0,1 ,0,0,0 '48 144 'rotated 180 deg
data 0,0,0 ,1,0,0 ,1,0,1 ,0,0,1 '52 148 'rotated 180 deg,turn left 1*
data 0,0,1 ,0,0,0 ,1,0,0 ,1,0,1 '56 152 'rotated 180 deg,turn left 2*
data 1,0,1 ,0,0,1 ,0,0,0 ,1,0,0 '60 156 'rotated 180 deg,turn left 3*
'
data 0,0,0 ,0,1,0 ,0,1,1 ,0,0,1 '64 160 'up ---> y and z
data 0,1,0 ,0,1,1 ,0,0,1 ,0,0,0 '68 164 'turn right 1*
data 0,1,1 ,0,0,1 ,0,0,0 ,0,1,0 '72 168 'turn right 2*
data 0,0,1 ,0,0,0 ,0,1,0 ,0,1,1 '76 172 'turn right 3*
data 0,0,1 ,0,1,1 ,0,1,0 ,0,0,0 '80 176 'rotated 180 deg
data 0,0,0 ,0,0,1 ,0,1,1 ,0,1,0 '84 180 'rotated 180 deg,turn right 1*
data 0,1,0 ,0,0,0 ,0,0,1 ,0,1,1 '88 184 'rotated 180 deg,turn right 2*
data 0,1,1 ,0,1,0 ,0,0,0 ,0,0,1 '92 188-191 'rotated 180 deg,turn right 3*
'
m41 :data 0,0 ,0,1 ,1,1 ,1,0 '0-3 'txt-coordinates a#()
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub bug():w(099):locate 0,11:print "12) ":w(888)
txt1(0,4,11):txt1(1,17,11):txt1(2,31,11):txt1(3,48,11):txt1(4,0,12)
locate 0,3:
printr "4)g:" ;g ;" / in6:" ;in6 ;s0
printr "k(0,";in7;"):";k(0,in7);" ": printr "k(1,";ik7;"):";k(1,ik7);s0
for i=0 to 1
printr i*2+7;")m(";i;"):";mbt(i);s0
printr "a10:";a10;s0
next
end sub
'
sub txt1(nr,x,y):locate x,y:print nr;":";: :print sp3(nr);"/[";ls(nr,0);"/";ls(nr,1);"] ":end sub
sub m(b):mbt(b)=mouse_button(b):mb(0):mb(1):mb(2):end sub
sub mb(m1)
if f06(m1)=0 and (mbt(m1)) then
f06(m1)=true:f05(m1)=not(f05(m1))
if mbt(2) then f6b=f6b+1:endif
endif
if f06(m1) and not (mbt(m1)) then f06(m1)=0 :endif
end sub
sub window(x,y):SetWindowWidth(x):SetWindowHeight(y):SetWindowBorder(true):UpdateWindow():end sub
'
sub tutorial()
if f6b=0 then
w(990):locate 0,15:printr "This is how we start a program:"
w(900):printr "001:":w(r0(999))
printr "press left_mouse_button (=LMB)"
printr "LMB affects the variables mbt(0) and f05(0) . (look 7th line:m(0)"
printr "mbt(0) becomes -1 as long as LMB is pressed"
printr "f05(0) turns from 0 to -1 and from -1 to 0 (short press LMB)"
printr "press right_mouse_button (=RMB). RMB affects the variables mbt(1) and f05(1) (like it is with LMB)."
printr
w(900):printr "002:":w(r0(999))
printr "press alphabet A-Z , 0-9 , ! to + (with shift) "
printr "press: []\;',./ (no shift)"
printr "press: {}|:<>? (with shift)"
printr "these keys point to the variable g (look 4th_line:g:) and k(1,x) (look 6th_line - x depending what key pressed)"
printr
w(900):printr "003:":w(r0(999))
printr "press :shift,Ctrl,Enter,F1-F12,insert,delete,home,end,PgUp,PgDn,"
printr "Backspace,Tab,CapsLock"
printr "This keys point to the variable in6 (in Line 4) and k(0,x) "
printr "(look 5th_line - x depending what key pressed)."
'
printr
w(900):print "004":printr": press middle_mouse_button (=MMB) for next page"
'
endif
'
if f6b=1 then locate 0,15
w(900):printr "004:":w(r0(999))
printr "Now explain Line_12 and Line_13:"
printr "k_(0,0,-112,113):k_(1,0,-114,115):k_(2,0,-116,117) :k_(3,1,-97,115):"
printr "k_(4,0,-118,119)"
printr "here we have 5 subs which increments and decrements "
printr "this variable:sp3(nr) (nr is 0-4 , 5 variables.)"
printr "the variable increments to a maximal and returns to zero"
printr "the variable decrements to zero and returns to maximal"
printr "explain only: k_(0,0,-112,113) in detail:"
printr "the 1st:0 is to change sp3(0)"
printr "the 2nd:0 is for :scankeydown(003:F1-F12) [1 is for keydown(A-Z,0-9)]"
printr "the 3rd:-112 is for F1 and decrement"
printr "the 4th: 113 is for F2 and increment"
printr
printr "ls(0,0)=0:minimal in range 0 __ ls(0,1)=sp0:maximal in range 0"
printr "- sp0=12 - (13 speeds(0-12) for flying"
printr "m2:data 4,....(store here ranges 1-4)"
printr "Use the 2 keys F1 (decrement) and F2 (increment) to change: sp3(0)"
printr "look into line_12 and watch the range 0[0/12]: how sp3(0) changes"
printr
printr "the other 4 subs use other keys and ranges."
printr "range1 uses F3- and f4+ ...abreviate(=abr) decrement:dec or -"
printr "range2 uses F5- and F6+ ...abr increment:inc or +"
printr "range3 uses 'a-' and 's+' (without shift)"
printr "range4 uses F7- and f8+ "
w(900):printr "005: press middle_mouse_button (=MMB) for next page"
endif
if f6b=2 then locate 0,15
w(900):print "005:":w(r0(999)):printr"Explain key_combiations: press 3 to 8 keys"
printr "press 1st shift or control ...or:"
printr "press 1st shift and control"
printr "control : d1(0)=true(-1) (true=-1 false=0)"
printr "shift : d1(1)=true "
printr "press and add any more keys for key combinations"
printr "many d1(x) become:true (the keys are pressed)"
printr "look into 3rd line from below when pressing key_combination"
printr "da:x .variable(abr:var) da stores :how many keys are pressed."
printr
printr "Example:press key-combination :shift+ctrl+F12 (for a change)"
printr "This key-combo switches to :TEXT2 (important)"
printr
w(900):printr "006: press middle_mouse_button (=MMB) for next page"
endif
if f6b=3 then locate 0,15
w(900):print "006a:":w(r0(999)):printr"Flying in space:"
printr "use: mouse_x and mouse_y to look into the direction to fly forward"
printr "use: Arrow_key_UP :fly forward"
printr "use:Arrow_key_Down :fly backward"
printr
printr " *** switch to text2 *** :"
printr "adjust flying-speed:use [F1-] and [F2+] and"
printr "watch 2nd line from below how flying speed changes"
printr "Change to speed_2:0.1"
printr
printr "what can we in this 3D room recognize?"
printr "Look with mouse around, search and find:"
printr "X,Y and Z Axis.in the center is: 0x/0y/0z "
printr "see my location: A:0/0/20 (at start)"
printr
printr "look to the blue grid:It is located:0x,-4000y,0z"
printr
printr "look around and find: 3 boxes"
printr "Go inside the near box: f02(1) becomes:true(-1)"
printr "My location is outside box(1): f02(1) = 0"
printr "text2 displays (in the Up-right-corner) 3 variables:"
printr "f02(1),f02(2),f02(50) "
printr
printr "Enter into box(50):(its location: 100Kx,100Ky,100Kz)(k=1000):"
printr "Change to flying-speed.7:100"
w(900):printr "continue 006: press middle_mouse_button (=MMB) for next page"
endif
if f6b=4 then locate 0,15
w(900):print "006b:":w(r0(999)):printr"Flying in space:"
printr "Fly into Box(50):f02(50)=true"
printr "outside of Box(50):f02(50)=0"
printr "Adjust flying-speed [9:1000] and fly into Box(2)"
printr "Its location: 1000Kx,1500Ky,2000Kz"
printr "Inside of Box(2) is f02(2)=true"
endif
'
if f6b=5 then
locate 0,ty-1:print " distance:";l2#;" "
locate 0,15
w(900):
print "007:":w(r0(999)):printr"Star_field:"
if l2#< 4000000 then
f3=0
printr "1) use combo :Ctrl+shift+F12"
printr "2) use speed:11 (=20000) (F1-,F2+)"
printr "3) fly to box(50) (highest object in sky)"
printr "4) look back to the starter_grid"
printr "5) use speed:15 to leave Galaxy"
printr "6) Fly backward (arrow_key_down) and leave galaxy"
printr "7) go back into galaxy and find your starter_grid"
else
if f3=0 then clearregion(0,15,80,49) :f3=true:endif
endif
endif
'
if mbt(2) then clearregion(0,13,tx,40):if f6b=6 then f6b=0:endif:endif:end sub
'
'm7 was m2
m7:'gl color v0=vec3():v1=vec3():v2=vec3():v3=vec3():v4=vec3():v5=vec3()
data 0.0,1.0,0.0 '0
data 1.0,0.5,0.0
data 1.0,0.0,0.0
data 1.0,1.0,0.0
data 0.0,0.0,1.0
data 1.0,0.0,1.0 '5
'm8 was m3
m8:'side_data
data 1, 1,-1,-1, 1,-1,-1, 1, 1, 1, 1, 1'0...12 data:0-11
data 1,-1, 1,-1,-1, 1,-1,-1,-1, 1,-1,-1
data 1, 1, 1,-1, 1, 1,-1,-1, 1, 1,-1, 1
data 1,-1,-1,-1,-1,-1,-1, 1,-1, 1, 1,-1
data -1, 1, 1,-1, 1,-1,-1,-1,-1,-1,-1, 1
data 1, 1,-1, 1, 1, 1, 1,-1, 1, 1,-1,-1'5
'
m9:
data 1,1,1,1,0,1,1,1,1'cube_top
data 1,0,1,0,0,0,1,0,1'_middle
data 1,1,1,1,0,1,1,1,1'_bottom
'
sub side(cnr,v0() as single): 'glbt(1):'glbC(36)'glColor3fv( vc(cnr) )
glVertex3fv(sd(cnr,0)):glVertex3fv(sd(cnr,1))
glVertex3fv(sd(cnr,2)):glVertex3fv(sd(cnr,3))
end sub
'
sub cube(v0() as single):dim i:glBegin(GL_QUADS):for i=0 to 4:side(i,v0):next:glEnd():end sub
'
'}
'****************************************************************************************************************************
31:minesweeper.0.01
'
'minesweeper.0.01_____2:13 PM 1/28/2019
dim a,i
dim f0
dim mb0,mb1,mx,my,mx1,my1
dim x,x0,x1
dim y,y0,y1,y2
dim Box 'sprite
'-------------------------------------------------------------------------------------------------
function r0(a):dim x2:a=a+1:x2=(rnd()%a):return x2:end function
sub rtxt(x,y):resizetext(x,y):end sub
declare sub set_sprite():declare sub level_print():declare sub mb():declare sub bug()
declare sub mouse(x):declare sub pnr()
dim mbf,m00,mb0k 'boolean
dim mx0,my0,rx=60,ry=50
x0=600 :y0=330
x1=(x0-1)/10 :y1=(y0-1)/10
dim ms(x1,y1),ms2(x1,y1)
dim f01,m1,m2,m3,m4,m5 'debug
dim s1 as string:for i=0 to 3:s1=s1+chr$(32):next:'s1=s1+".":a=len(s1)
'---------------------------------------------------------------------------------------
sub sprite():SprSetPos (mx1,my1):sprsetangle(sprangle() + 0.2):end sub
'-------------------------------------------
x1=30:y1=20 'field_lenght
dim fx=1,fy=4 'field_position
dim bomb_amount=100
'-------------------------------------------
'set_sprite()
rtxt(rx,ry)
mbf=true
'*********************************************************************************************************************
do
level_print()
mouse(0):mouse(1)
bug()
mb()
'sprite() :sprite not ready
f01 = (mx0<=x1 and mx0>-1 and my0<=y1 and my0>-1)
loop
'*********************************************************************************************************************
sub pnr()
if ms2(x,y2)>0 then:
if ms2(x,y2)>5 then color(0,255,0):endif
locate fx+x,fy+y2:print ms2(x,y2)
if ms2(x,y2)>5 then color(255,0,0):endif
endif
end sub
'-------------------------------------------------------------------------------------------------
sub level_print():dim y2p,y2m,xp,xm
if mbf then
mbf=0
clearregion (0,0,60,50)
color (255,0,255)
locate 0,0:print "minesweeper 0.01: 2:13 PM 1/28/2019"
'
color (255,0,0)
for a=0 to bomb_amount
do
x=r0(x1):y=r0(y1)
if ms(x,y)=0 then ms(x,y)=true:f0=true else:f0=false:endif
loop until f0
next
'
for y=0 to y1
for x=0 to x1
if ms(x,y) then locate fx+x,fy+y:print"*":endif
next
next
'
'left,middle and right case
x=0 'case_1:pnr()
for y2=0 to y1 :y2p=y2+1:y2m=y2-1:xp=1
if ms(0,y2)=0 then
if y2=0 then ms2(0,y2)=-ms(xp,y2)-ms(xp,y2p)-ms(0,y2p) :endif
if y2>0 and y2<y1 then ms2(0,y2)=-ms(0,y2m)-ms(0,y2p)-ms(xp,y2m)-ms(xp,y2)-ms(xp,y2p) :endif
if y2=y1 then ms2(0,y2)=-ms(0,y2m)-ms(xp,y2m)-ms(xp,y2) :endif
pnr()
endif
next
'
for x=1 to x1-1 'case_2: [x>0 and x<x1-1]
for y2=0 to y1 :y2p=y2+1:y2m=y2-1:xp=x+1:xm=x-1
if ms(x,y2)=0 then
if y2=0 then ms2(x,y2)=-ms(xm,y2) -ms(xm,y2p)-ms(x ,y2p) -ms(xp,y2p)-ms(xp,y2) :endif
if y2>0 and y2<y1 then ms2(x,y2)=-ms(xm,y2m) -ms(xm,y2) -ms(xm,y2p) -ms(x ,y2m)-ms(x ,y2p)-ms(xp,y2m)-ms(xp,y2)-ms(xp,y2p):endif
if y2=y1 then ms2(x,y2)=-ms(xm,y2) -ms(xm,y2m)-ms(x ,y2m) -ms(xp,y2) -ms(xp,y2m) :endif
pnr()
endif
next
next
'
x=x1 'case_3
for y2=0 to y1
if ms(x,y2)=0 then y2p=y2+1:y2m=y2-1:xm=x-1
if y2=0 then ms2(x,y2)=-ms(xm,y2) -ms(xm,y2p)-ms(x,y2p) :endif
if y2>0 and y2<y1 then ms2(x,y2)=-ms(x ,y2m)-ms(xm,y2m)-ms(xm,y2) -ms(xm,y2p)-ms(x,y2p) :endif
if y2=y1 then ms2(x,y2)=-ms(x ,y2m)-ms(xm,y2m)-ms(xm,y2) :endif
pnr()
endif
next
'
for y=0 to y1:for x=0 to x1:ms(x,y)=0:ms2(x,y)=0:next:next
endif
end sub
'-------------------------------------------------------------------------------------------------
sub bug()
color (255,0,0):locate 0,43
print "------------------------------------------------------------"
printr "x1:";x1;s1
printr "y1:";y1;s1
printr "mx0:";mx0;s1
printr "my0:";my0;s1
printr "in field:";f01;s1
'
color (255,0,255)
locate 20,50:print "press N or left mouse_button"
end sub
'-------------------------------------------------------------------------------------------------
sub mouse(x)
if x=0 then mx =INT(mouse_x()*rx) :my =INT(mouse_y()*ry) :mx0=mx-fx:my0=my-fy:endif
if x=1 then mx1=INT(mouse_x()*641):my1=INT(mouse_y()*481):endif
end sub
'-------------------------------------------------------------------------------------------------
sub mb()
mb0=mouse_button(0) :mb1=mouse_button(1)
'
mb0k = (mb0 or keydown("N"))
if m00=0 and mb0k then mbf=true:m00=true:endif
if m00 and mb0k=0 then mbf=0 :m00=0 :endif
end sub
'-------------------------------------------------------------------------------------------------
end
sub set_sprite()
ResizeSpriteArea(640,480)
Box = NewSprite(LoadTexture("Textures/DesertMagic_01_a_000-100.jpg"))
SprSetSize (400,20) '
SprSetPos (320,230) '
sprsetscale(.2)
BindSprite (Box)
end sub
'-------------------------------------------------------------------------------------------------
'****************************************************************************************************************************
'****************************************************************************************************************************
' end of folder
'
'PCN and Hedgehog 2023