commit b04d90ff0db1bd0ecf55619d328d78cd22ef08fc Author: Greg Gauthier Date: Sun Jul 9 12:18:33 2023 +0100 initial commit diff --git a/bin/addsub b/bin/addsub new file mode 100755 index 0000000..78e2f84 Binary files /dev/null and b/bin/addsub differ diff --git a/bin/answer b/bin/answer new file mode 100755 index 0000000..365c2b0 Binary files /dev/null and b/bin/answer differ diff --git a/bin/clooper b/bin/clooper new file mode 100755 index 0000000..bb43cb3 Binary files /dev/null and b/bin/clooper differ diff --git a/bin/colors b/bin/colors new file mode 100755 index 0000000..27ff080 Binary files /dev/null and b/bin/colors differ diff --git a/bin/conv b/bin/conv new file mode 100755 index 0000000..3ce28d6 Binary files /dev/null and b/bin/conv differ diff --git a/bin/drawtest b/bin/drawtest new file mode 100755 index 0000000..e5ecfa7 Binary files /dev/null and b/bin/drawtest differ diff --git a/bin/fbpaint b/bin/fbpaint new file mode 100755 index 0000000..076690a Binary files /dev/null and b/bin/fbpaint differ diff --git a/bin/fbpanel b/bin/fbpanel new file mode 100755 index 0000000..d5d9467 Binary files /dev/null and b/bin/fbpanel differ diff --git a/bin/hello b/bin/hello new file mode 100755 index 0000000..64e70a0 Binary files /dev/null and b/bin/hello differ diff --git a/bin/inkey b/bin/inkey new file mode 100755 index 0000000..7527cbd Binary files /dev/null and b/bin/inkey differ diff --git a/bin/makdword b/bin/makdword new file mode 100755 index 0000000..d86e4e0 Binary files /dev/null and b/bin/makdword differ diff --git a/bin/repeats b/bin/repeats new file mode 100755 index 0000000..b462e2f Binary files /dev/null and b/bin/repeats differ diff --git a/bin/screenres b/bin/screenres new file mode 100755 index 0000000..b3041d3 Binary files /dev/null and b/bin/screenres differ diff --git a/bin/simplebox b/bin/simplebox new file mode 100755 index 0000000..9d92fa0 Binary files /dev/null and b/bin/simplebox differ diff --git a/bin/statics b/bin/statics new file mode 100755 index 0000000..05fdaea Binary files /dev/null and b/bin/statics differ diff --git a/bin/tui b/bin/tui new file mode 100755 index 0000000..f98102d Binary files /dev/null and b/bin/tui differ diff --git a/bin/tuibox b/bin/tuibox new file mode 100755 index 0000000..2538628 Binary files /dev/null and b/bin/tuibox differ diff --git a/bin/tutorial b/bin/tutorial new file mode 100755 index 0000000..46902dd Binary files /dev/null and b/bin/tutorial differ diff --git a/bin/weights b/bin/weights new file mode 100755 index 0000000..869fd19 Binary files /dev/null and b/bin/weights differ diff --git a/bin/width b/bin/width new file mode 100755 index 0000000..5fcf305 Binary files /dev/null and b/bin/width differ diff --git a/src/addsub.fb.bas b/src/addsub.fb.bas new file mode 100644 index 0000000..22a547d --- /dev/null +++ b/src/addsub.fb.bas @@ -0,0 +1,35 @@ +#lang "fblite" +dim as integer max,a,b,n,i + +print +input "Maximum absolute value of the numbers [default: 100]: ";max +if max<2 then + max=100 +end if +print +input "How many examples [default: 25] ";n +if n<=0 then + n=25 +end if +Print ' output on the printer +Print +Print +Print " ";n;" arithmetical exercises with integral numbers from ";-max;" to";max +Print +Print + +randomize 'initialize the rnd random-number generator +for i=1 to n + a=int(rnd*(2*max+1))-max + b=int(rnd*(2*max+1))-max + Print using " ###) ";i; + Print a; + if b<=0 then + Print " -";abs(b) + else + Print " +";b + end if + 'Print + 'Print +next i +Print Chr(12) ' for output on computer screen use the command "sleep" \ No newline at end of file diff --git a/src/answer.fb.bas b/src/answer.fb.bas new file mode 100644 index 0000000..6fdf8d2 --- /dev/null +++ b/src/answer.fb.bas @@ -0,0 +1,3 @@ +Dim answer As String +Input "Type something, you idiot! ", answer +Print "You typed: '";answer;"'" diff --git a/src/clooper.fb.bas b/src/clooper.fb.bas new file mode 100644 index 0000000..b029764 --- /dev/null +++ b/src/clooper.fb.bas @@ -0,0 +1,32 @@ +Cls +Print "Standard Sixteen Color Test" +Sleep 2000 +For b As Integer = 0 to 15 + For f As Integer = 0 to 15 + Cls + Locate 10,15 + Color f,b:Print "Foreground: "; f; " Background: "; b;" ";:Color 7,0:Print + Sleep 125 + Next f +Next b +Color 7,0 +Print "Press Any Key...":Sleep + +Cls +Print "RGB Color Test: 256 Random RGB Values..." +Sleep 2000 +Randomize 2, 1 +For i As Integer = 1 to 256 + dim as Integer last,first + last = 254:first = 0 + dim as Integer r,g,b + r = cast(integer, fix(rnd*(last-first))+first) + g = cast(integer, fix(rnd*(last-first))+first) + b = cast(integer, fix(rnd*(last-first))+first) + + Cls + Locate 10,15 + Color RGB(r,g,b), RGB(b,r,g):Print "Color Count: ";i;" Foreground: (";r;",";g;",";b;")";" Background: (";b;",";g;",";r;")";:Color 7,0:Print + Sleep 125 +Next i +Print "Press any key...":Sleep:Cls \ No newline at end of file diff --git a/src/colors.fb.bas b/src/colors.fb.bas new file mode 100644 index 0000000..3a4c007 --- /dev/null +++ b/src/colors.fb.bas @@ -0,0 +1,13 @@ +Dim As Integer clr, ccode +Color 15,0 +clr = Color +Print "Current color setting:" +Print "Foreground: ";Loword(clr) +Print "Background: ";Hiword(clr) +Print +ccode = Screen(0, 0) +Print "Character code at 1,1 is";ccode;" which is ";Chr(ccode);"." +clr = Screen(1, 1, 1) +Print "Foreground color at 1,1:";clr And 15 +Print "Background color at 1,1:";clr Shr 4 +End \ No newline at end of file diff --git a/src/conv.fb.bas b/src/conv.fb.bas new file mode 100644 index 0000000..179f41d --- /dev/null +++ b/src/conv.fb.bas @@ -0,0 +1,7 @@ +Dim As Double myDbl +Dim As Integer myInt +myDbl = 5.56 +myInt = myDbl +print "myInt = "; myInt +Sleep +End \ No newline at end of file diff --git a/src/drawtest.fb.bas b/src/drawtest.fb.bas new file mode 100644 index 0000000..b2ae49a --- /dev/null +++ b/src/drawtest.fb.bas @@ -0,0 +1,18 @@ +Cls +Locate 1, 10 +'Color 15, 1 +'Print space( 50 ); +'Locate 12, 12 +'print "Hello World"; + +'Print Point(1,10) + +Sub DrawTextBox(ByVal x as Integer, ByVal y as Integer, _ + ByVal TextWidth as Integer, ByVal FieldLen as Integer, _ + ByVal TabAble as Integer = 0, ByVal Label as String) + + Color 15,1:Locate y,x:Print Label;:Locate y,x+TextWidth:Print "["; + Locate y,x+TextWidth+FieldLen-1:Print "]"; +End Sub + +DrawTextBox 25,5,10,33,1, "Name:" diff --git a/src/fbfonts/fb_fonts.zip b/src/fbfonts/fb_fonts.zip new file mode 100644 index 0000000..f3fef59 Binary files /dev/null and b/src/fbfonts/fb_fonts.zip differ diff --git a/src/fbfonts/upload/demo b/src/fbfonts/upload/demo new file mode 100755 index 0000000..72158c0 Binary files /dev/null and b/src/fbfonts/upload/demo differ diff --git a/src/fbfonts/upload/demo.bas b/src/fbfonts/upload/demo.bas new file mode 100644 index 0000000..3be187a --- /dev/null +++ b/src/fbfonts/upload/demo.bas @@ -0,0 +1,47 @@ +Const depth=8 + +#Include Once "gfx.bi" +#Include Once "font.bi" + +ScreenRes 640,480,depth + +Dim As TFont SerifRed,SansBlue,MonoGreen,Serif,Sans,Mono,Sans18,Sans30 +SerifRed.Load("serif.fnt",&hd83f3f) +MonoGreen.Load("mono.fnt",&h13c86b) +SansBlue.Load("sans.fnt",&h729fcf) +Sans.Load("sans.fnt") +Serif.Load("serif.fnt") +Mono.Load("mono.fnt") +Sans18.Load("sans.fnt"):Sans18.ChangeSize(18) +Sans30.Load("sans.fnt"):Sans30.ChangeSize(30) + +Line (0,0)-(640,480),GetColor(&h2e3436),BF +Serif.DrawString(,"ÄÖÜäöüß éÈáÀóÒúÙíÌć ĄĘñ âêô ¿ €",10,10) +SerifRed.DrawString(,"Freeserif",10,30) +Serif.DrawString(,"Freeserif Bold",100,30,True) +Serif.DrawString(,"Freeserif Italic",220,30,,,True) +Serif.DrawString(,"Freeserif Underlined",340,30,,True) + +SansBlue.DrawString(,"Freesans",10,80) +Sans.DrawString(,"Freesans Bold",100,80,True) +Sans.DrawString(,"Freesans Italic",220,80,,,True) +Sans.DrawString(,"Freesans Underlined",340,80,,True) + +MonoGreen.DrawString(,"Freemono",10,130) +Mono.DrawString(,"Freemono Bold",100,130,True) +Mono.DrawString(,"Freemono Italic",220,130,,,True) +Mono.DrawString(,"Freemono Underlined",340,130,,True) + +Serif.DrawString(,"Basic Latin: Good evening FreeBasic - Community and others",10,180) +Serif.DrawString(,"German: Hallöchen! Stinkefüße und Äpfel kosten 1000 €uros",10,200) +Serif.DrawString(,"Portuguese/Spanish: Olá amigos ¿Cómo estás? Eñe Freebasic é ótimo",10,220) +Serif.DrawString(,"Polish: Się granicą filmów Ęsiąząt",10,240) + +Sans.DrawString(,"Freesans 11",10,300) +Sans18.DrawString(,"Freesans 18",10,320) +Sans30.DrawString(,"Freesans 30",10,350) + + +Sans.DrawString(,"Bold, Italic and Unterlined!",10,450,True,True,True) +Sleep +End diff --git a/src/fbfonts/upload/font.bi b/src/fbfonts/upload/font.bi new file mode 100644 index 0000000..1c598fe --- /dev/null +++ b/src/fbfonts/upload/font.bi @@ -0,0 +1,495 @@ +Type TFont + As Any Ptr Char(103),CharItalic(103) + As UByte wide(103) + As UByte size,origsize + As Integer clr + Declare Sub Load(file As String, clrc As Integer=&hffffff) + Declare Sub DrawString(buffer As Any Ptr=0,text As String,x As Integer,y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False) + Declare Sub Render(buffer As Any Ptr=0,charid As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False) + Declare Sub CombinedRender(buffer As Any Ptr=0,charid As UByte,charid2 As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False,down As Boolean=False,plusx As Integer=0,plusy As Integer=0) + 'Declare Sub ChangeColor(clr As Integer) + Declare Sub ChangeSize(newsize As UByte) + Declare Function Length(text As WString) As Integer +End Type + +Sub TFont.Load(file As String, clrc As Integer=&hffffff) + clr=GetColor(clrc) + Dim As UByte in + Dim As Integer wholewide,start + Dim As Any Ptr fntimg + Var ff=FreeFile + Open file For Binary As #ff + Get #ff,0,size + origsize=size + For i As Integer=1 To 101 + + If wide(1)=&hFF Then + wide(i)=7 + Else + Get #ff,,wide(i) + End If + + Char(i)=ImageCreate(wide(i),size-1) + CharItalic(i)=ImageCreate(wide(i)+2,size-1) + wholewide+=wide(i) + Next + Char(102)=ImageCreate(Wide(64),size-1) + CharItalic(102)=ImageCreate(Wide(64)+2,size-1) + Char(103)=ImageCreate(Wide(31),size-1) + CharItalic(103)=ImageCreate(Wide(31)+2,size-1) + Wide(103)=Wide(31) + If wide(1)=&hFF Then wide(1)=7:start=1 + fntimg=ImageCreate(wholewide,size) + For x As Integer=start To wholewide Step 8 + For y As Integer=0 To size-1 + Get #ff,,in + For i As Integer=1 To 8 + If Bit(in,8-i)=True Then + Pset fntimg,(x+(i-1),y),clr + End If + Next + Next + Next + Close #ff + wholewide=0 + + For i As Integer=1 To 101 + Get fntimg,(wholewide,0)-(wholewide+wide(i)-1,size-1),Char(i) + wholewide+=wide(i) + For x As UByte=0 To Wide(i)-1 + For y As UByte=0 To size-1 + If depth<=8 Then + If Point(x,y,Char(i))=clr Then + If y<(size-1)/3 Then + Pset CharItalic(i),(x+2,y),clr + ElseIf y>((size-2)/3)*2 Then + Pset CharItalic(i),(x,y),clr + Else + Pset CharItalic(i),(x+1,y),clr + End If + End If + ElseIf depth=16 Then + If Point(x,y,Char(i))<>&hff00ff Then + If y<(size-1)/3 Then + Pset CharItalic(i),(x+2,y),clr + ElseIf y>((size-2)/3)*2 Then + Pset CharItalic(i),(x,y),clr + Else + Pset CharItalic(i),(x+1,y),clr + End If + End If + Else + If Point(x,y,Char(i))<>&hffff00ff Then + 'If y<(size-1)/2 Then + 'Pset CharItalic(i),(x+2,y),clr + 'ElseIf y>((size-2)/3)*2 Then + Pset CharItalic(i),(x,y),clr + 'Else + ' Pset CharItalic(i),(x+1,y),clr + 'End If + End If + End If + Next + Next + Next + + Char(102)=MirrorImage(Char(64),2,clr) + CharItalic(102)=MirrorImage(CharItalic(64),2,clr) + Char(103)=MirrorImage2(Char(31),-1,clr,-3) + CharItalic(103)=MirrorImage2(CharItalic(31),1,clr,-3) + + ImageDestroy fntimg +End Sub + +Sub TFont.Render(buffer As Any Ptr=0,charid As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False) + If italic=True Then + Put buffer,(x,y),CharItalic(charid),trans + If bold=True Then Put buffer,(x+1,y),CharItalic(charid),trans + Else + Put buffer,(x,y),Char(charid),trans + If bold=True Then Put buffer,(x+1,y),Char(charid),trans + End If +End Sub + +Sub TFont.CombinedRender(buffer As Any Ptr=0,charid As UByte,charid2 As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False,down As Boolean=False,plusx As Integer=0,plusy As Integer=0) + If italic=True Then + Put buffer,(x,y),CharItalic(charid),trans + If down=True Then + Put buffer,(x+plusx,y+size-3-plusy),CharItalic(charid2),trans + Else + Put buffer,(x+plusx,y-plusy),CharItalic(charid2),trans + End If + If bold=True Then + Put buffer,(x+1,y),CharItalic(charid),Trans + If down=True Then + Put buffer,(x+1+plusx,y+size-3-plusy),CharItalic(charid2),trans + Else + Put buffer,(x+1+plusx,y-plusy),CharItalic(charid2),trans + End If + End If + Else + Put buffer,(x,y),Char(charid),trans + If down=True Then + Put buffer,(x+plusx,y+size-3-plusy),Char(charid2),trans + Else + Put buffer,(x+plusx,y-plusy),Char(charid2),trans + End If + If bold=True Then + Put buffer,(x+1,y),Char(charid),Trans + If down=True Then + Put buffer,(x+1+plusx,y+size-3-plusy),Char(charid2),trans + Else + Put buffer,(x+1+plusx,y-plusy),Char(charid2),trans + End If + End If + End If +End Sub + +Sub TFont.DrawString(buffer As Any Ptr=0,text As String,x As Integer,y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False) + Dim As UByte charid,charid2 + Dim As Byte plusx,plusy + Dim As Boolean down + Dim As UShort textlength + For i As Integer=0 To Len(text) + charid=text[i]-32 + charid2=0 + down=False + plusx=0 + plusy=0 + If text[i]<33 Then + textlength+=3 + charid=0 + ElseIf charid=162 Then + charid=text[i+1]-32 + i+=1 + If charid=159 Then + charid=103 + textlength+=wide(103) + End If + ElseIf charid=194 Then + charid=text[i+1]-32 + i+=1 + If charid=98 Then + charid=text[i+1]-32 + i+=1 + If charid=140 Then + charid=101 + textlength+=wide(101) + End If + End If + Elseif charid=164 Then + charid=text[i+1]-32 + i+=1 + If charid=100 Then 'Ą + charid=33 + charid2=64 + textlength+=wide(33) + down=True + plusx=6 + Elseif charid=101 Then 'ą + charid=65 + charid2=64 + textlength+=wide(65) + down=True + plusx=3 + ElseIf charid=102 Then + charid=35 + charid2=102 + textlength+=wide(35) + plusy=2 + plusx=3 + ElseIf charid=103 Then + charid=67 + charid2=102 + textlength+=wide(67) + ElseIf charid=120 Then 'Ę + charid=37 + charid2=102 + textlength+=wide(37) + plusy=2 + plusx=2 + Elseif charid=121 Then + charid=69 + charid2=64 + textlength+=wide(69) + down=True + plusx=3 + End If + ElseIf charid=163 Then + charid=text[i+1]+32 + i+=1 + Select Case charid + Case 220 'ü + charid=99 + textlength+=wide(99) + Case 196 'ä + charid=97 + textlength+=wide(97) + Case 164 'Ä + charid=94 + textlength+=wide(94) + Case 214 'ö + charid=98 + textlength+=wide(98) + Case 182 'Ö + charid=95 + textlength+=wide(95) + Case 188 'Ü + charid=96 + textlength+=wide(96) + Case 191 'ß + charid=100 + textlength+=wide(100) + 'Case 140 '€ + 'charid=101 + 'textlength+=wide(101) + + Case 162 'â + charid=33 + charid2=62 + textlength+=wide(33) + plusy=3 + Case 170 'ê + charid=37 + charid2=62 + textlength+=wide(37) + plusy=4 + Case 180 'Ô + charid=47 + charid2=62 + textlength+=wide(47) + plusy=4 + + Case 194 'â + charid=65 + charid2=62 + textlength+=wide(65) + plusy=2 + plusx=-1 + Case 202 'ê + charid=69 + charid2=62 + textlength+=wide(69) + plusy=2 + plusx=-1 + Case 212 'ô + charid=79 + charid2=62 + textlength+=wide(79) + plusy=2 + plusx=-1 + + Case 166 'Æ + charid=33 + charid2=37 + textlength+=wide(33)+6 + plusx=6 + Case 198 'Æ + charid=65 + charid2=69 + textlength+=wide(65)+5 + plusx=5 + + Case 209 'ñ + charid=78 + charid2=63 + textlength+=wide(78) + plusy=size-2 + + Case 160 'À + charid=33 + charid2=64 + textlength+=wide(33) + plusy=2 + plusx=2 + Case 161 'À + charid=33 + charid2=102 + textlength+=wide(33) + plusy=2 + plusx=2 + Case 168 'É + charid=37 + charid2=64 + textlength+=wide(37) + plusy=2 + plusx=2 + Case 169 'É + charid=37 + charid2=102 + textlength+=wide(37) + plusy=2 + plusx=2 + Case 172 'Ì + charid=41 + charid2=64 + textlength+=wide(41) + plusy=2 + Case 173 'Ì + charid=41 + charid2=102 + textlength+=wide(41) + plusy=2 + Case 178 'Ò + charid=47 + charid2=64 + textlength+=wide(47) + plusy=2 + plusx=2 + Case 179 'Ò + charid=47 + charid2=102 + textlength+=wide(47) + plusy=2 + plusx=2 + Case 185 'Ù + charid=53 + charid2=64 + textlength+=wide(53) + plusy=2 + plusx=2 + Case 186 'Ù + charid=53 + charid2=102 + textlength+=wide(53) + plusy=2 + plusx=2 + Case 230 'Ć + charid=35 + charid2=102 + textlength+=wide(35) + plusy=2 + plusx=3 + + Case 192 'à + charid=65 + charid2=64 + textlength+=wide(65) + Case 193 'á + charid=65 + charid2=102 + textlength+=wide(65) + Case 200 'é + charid=69 + charid2=64 + textlength+=wide(69) + Case 201 'é + charid=69 + charid2=102 + textlength+=wide(69) + Case 204 'í + charid=73 + charid2=64 + textlength+=wide(74) + Case 205 'í + charid=73 + charid2=102 + textlength+=wide(74) + Case 210 'ó + charid=79 + charid2=64 + textlength+=wide(79) + Case 211 'ó + charid=79 + charid2=102 + textlength+=wide(79) + Case 217 'ú + charid=85 + charid2=64 + textlength+=wide(85) + Case 218 'ú + charid=85 + charid2=102 + textlength+=wide(85) + Case 228 'Ą + charid=33 + charid2=64 + textlength+=wide(33) + down=True + plusx=6 + Case 229 'ą + charid=65 + charid2=64 + textlength+=wide(65) + down=True + plusx=3 + Case 231 'ć + charid=67 + charid2=102 + textlength+=wide(67) + Case 248 'Ę + charid=37 + charid2=64 + textlength+=wide(37) + down=True + plusx=4 + Case 249 'ę + charid=69 + charid2=64 + textlength+=wide(69) + down=True + plusx=3 + Case Else + textlength+=3 + End Select + Else + textlength+=wide(charid) + End If + + If charid<>0 Then + If charid2<>0 Then + CombinedRender(buffer,charid,charid2,x+textlength-wide(charid),y,bold,,italic,down,plusx,plusy) + Else + Render(buffer,charid,x+textlength-wide(charid),y,bold,,italic) + End If + End If + + 'Draw String (10,40+i*20),Str(charid)+"|"+Str(Len(text)) + If bold=True Then textlength+=1 + If underline=True Then + Line (x,y+size+1)-(x+textlength,y+size+1),clr + End If + Next +End Sub + +'Sub TFont.ChangeColor(clrc As Integer) + 'Var clr2=GetColor(clrc) + 'For i As Integer=1 To 102 + 'For y As Integer=0 To size-1 + 'For x As Integer=0 To wide(i)+2 + 'If Point(x,y,char(i))=clr Then + 'Pset char(i),(x,y),clr2 + 'End If + 'If Point(x,y,charitalic(i))=clr Then + 'Pset charitalic(i),(x,y),clr2 + 'End If + 'Next + 'Next + 'Next + 'clr=clr2 +'End Sub + +Sub TFont.ChangeSize(newsize As UByte) + size=newsize + Dim As Integer oldwide + For i As Integer=1 To 102 + oldwide=Wide(i) + Wide(i)=Wide(i)+(size-origsize) + Char(i)=Resize(Char(i),Wide(i)/oldwide,size/origsize) + Next + +End Sub + +Function TFont.Length(text As WString) As Integer + Dim As Integer textlength + Dim As UByte charid + For i As Integer=0 To Len(text) + charid=text[i]-32 + If charid<33 Then + textlength+=3 + Else + textlength+=wide(charid) + End If + Next + Return textlength +End Function diff --git a/src/fbfonts/upload/gfx.bi b/src/fbfonts/upload/gfx.bi new file mode 100644 index 0000000..59a3607 --- /dev/null +++ b/src/fbfonts/upload/gfx.bi @@ -0,0 +1,121 @@ +#define RGBA_R(c) (CUInt(c) Shr 16 And 255) +#define RGBA_G(c) (CUInt(c) Shr 8 And 255) +#define RGBA_B(c) (CUInt(c) And 255) +'#define RGBA_A(c) (CUInt(c) Shr 24 ) + +Function GetDistanceBetweenColours(a As Integer, b As Integer) As Integer + Var ra=RGBA_R(a) + Var ga=RGBA_G(a) + Var ba=RGBA_B(a) + + Var rb=RGBA_R(b) + Var gb=RGBA_G(b) + Var bb=RGBA_B(b) + + dim as integer dR = ra - rb + dim as integer dG = ga - gb + dim as integer dB = ba - bb + return dR * dR + dG * dG + dB * dB +End Function + +Function GetColor(clr As Integer)As Integer + Dim As Integer plt4(15)={&h000000, &h000080, &h008000, &h241200, &h800000, &h800080, &h808000, &hc0c0c0, &h808080, &h0000FF, &h00FF00, &h00FFFF, &hFF0000, &hFF00FF, &hFFFF00, &hFFFFFF} + Dim As Integer plt8(255)={&h000080, &h008000, &h241200, &h800000, &h800080, &h808000, &hc0c0c0, &h808080, &h0000FF, &h00FF00, &h00FFFF, &hFF0000, &hFF00FF, &hFFFF00, &hFFFFFF, &h000000, &h141414, &h202020, &h2C2C2C, &h383838, &h444444, &h505050, &h616161, &h717171, &h818181, &h919191, &hA1A1A1, &hB6B6B6, &hCACACA, &hE2E2E2, &hFFFFFF, &h0000FF, &h4000FF, &h7D00FF, &hBE00FF, &h000000, &hFF00BE, &hFF007D, &hFF0040, &hFF0000, &hFF4000, &hFF7D00, &hFFBE00, &hFFFF00, &hBEFF00, &h7DFF00, &h40FF00, &h00FF00, &h00FF40, &h00FF7D, &h00FFBE, &h00FFFF, &h00BEFF, &h007DFF, &h0040FF, &h7D7DFF, &h9D7DFF, &hBE7DFF, &hDE7DFF, &hFF7DFF, &hFF7DDE, &hFF7DBE, &hFF7D9D, &hFF7D7D, &hFF9D7D, &hFFBE7D, &hFFDE7D, &hFFFF7D, &hDEFF7D, &hBEFF7D, &h9DFF7D, &h7DFF7D, &h7DFF9D, &h7DFFBE, &h7DFFDE, &h7DFFFF, &h7DDEFF, &h7DBEFF, &h7D9DFF, &hB6B6FF, &hC6B6FF, &hDAB6FF, &hEAB6FF, &hFFB6FF, &hFFB6EA, &hFFB6DA, &hFFB6C6, &hFFB6B6, &hFFC6B6, &hFFDAB6, &hFFEAB6, &hFFFFB6, &hEAFFB6, &hDAFFB6, &hC6FFB6, &hB6FFB6, &hB6FFC6, &hB6FFDA, &hB6FFEA, &hB6FFFF, &hB6EAFF, &hB6DAFF, &hB6C6FF, &h000071, &h1C0071, &h380071, &h550071, &h710071, &h710055, &h710038, &h71001C, &h710000, &h711C00, &h713800, &h715500, &h717100, &h557100, &h387100, &h1C7100, &h007100, &h00711C, &h007138, &h007155, &h007171, &h005571, &h003871, &h001C71, &h383871, &h443871, &h553871, &h613871, &h713871, &h713861, &h713855, &h713844, &h713838, &h714438, &h715538, &h716138, &h717138, &h617138, &h557138, &h447138, &h387138, &h387144, &h387155, &h387161, &h387171, &h386171, &h385571, &h384471, &h505071, &h595071, &h615071, &h695071, &h715071, &h715069, &h715061, &h715059, &h715050, &h715950, &h716150, &h716950, &h717150, &h697150, &h617150, &h597150, &h507150, &h507159, &h507161, &h507169, &h507171, &h506971, &h506171, &h505971, &h000040, &h100040, &h200040, &h300040, &h400040, &h400030, &h400020, &h400010, &h400000, &h401000, &h402000, &h403000, &h404000, &h304000, &h204000, &h104000, &h004000, &h004010, &h004020, &h004030, &h004040, &h003040, &h002040, &h001040, &h202040, &h282040, &h302040, &h382040, &h402040, &h402038, &h402030, &h402028, &h402020, &h402820, &h403020, &h403820, &h404020, &h384020, &h304020, &h284020, &h204020, &h204028, &h204030, &h204038, &h204040, &h203840, &h203040, &h202840, &h2C2C40, &h302C40, &h342C40, &h3C2C40, &h402C40, &h402C3C, &h402C34, &h402C30, &h402C2C, &h40302C, &h40342C, &h403C2C, &h40402C, &h3C402C, &h34402C, &h30402C, &h2C402C, &h2C4030, &h2C4034, &h2C403C, &h2C4040, &h2C3C40, &h2C3440, &h2C3040, &h000000, &h000000, &h000000, &h000000, &h000000, &h000000, &h000000, &h000000, &hFFFFFF} + + Dim As Integer ret,r,g,b + r=RGBA_R(clr) + g=RGBA_G(clr) + b=RGBA_B(clr) + If depth=4 Then + Dim As Integer d, c + d=&h000000 + c=&hFFFFFF + For i As Integer=0 To 15 + d=GetDistanceBetweenColours(clr,plt4(i)) + If d0 Then Pset ret,(x*xScale,y*yScale),clr + Next + Next + + For y As Integer=0 To sourceheight + For x As Integer=0 To sourcewidth + clr=Point(x,y,source) + clr2=Point(x+1,y,source) + clr3=Point(x,y+1,source) + clr4=Point(x+1,y+1,source) + clr5=Point(x-1,y,source) + clr6=Point(x,y-1,source) + clr7=Point(x+1,y-1,source) + For yi As Integer=0 To yScale + For xi As Integer=0 To xScale + 'If clr+clr2+clr3<>0 Then + + Pset ret,(x*xScale+xi,y*yScale+yi),clr + 'End If + Next + Next + Next + Next + + Return ret +End Function + +Function MirrorImage(source As Any Ptr,plusx As Integer=0,clr2 As Integer)As Any Ptr + Dim As Integer sourcewidth, sourceheight,clr + ImageInfo(source,sourcewidth,sourceheight) + Var ret=ImageCreate(sourcewidth+plusx,sourceheight) + For y As Integer=0 To sourceheight + For x As Integer=0 To sourcewidth-1 + clr=Point(x,y,source) + If clr=clr2 Then + Pset ret,(sourcewidth-x+plusx,y),GetColor(&hFFFFFF) + End If + Next + Next + Return ret +End Function + +Function MirrorImage2(source As Any Ptr,plusx As Integer=0,clr2 As Integer,plusy As Integer=0)As Any Ptr + Dim As Integer sourcewidth, sourceheight,clr + ImageInfo(source,sourcewidth,sourceheight) + Var ret=ImageCreate(sourcewidth+plusx,sourceheight+plusy) + For y As Integer=0 To sourceheight + For x As Integer=0 To sourcewidth-1 + clr=Point(x,y,source) + If clr=clr2 Then + Pset ret,(sourcewidth-x+plusx,sourceheight-y+plusy),GetColor(&hFFFFFF) + End If + Next + Next + Return ret +End Function + diff --git a/src/fbfonts/upload/mono.fnt b/src/fbfonts/upload/mono.fnt new file mode 100644 index 0000000..174d7d6 Binary files /dev/null and b/src/fbfonts/upload/mono.fnt differ diff --git a/src/fbfonts/upload/sans.fnt b/src/fbfonts/upload/sans.fnt new file mode 100644 index 0000000..ea66d1e Binary files /dev/null and b/src/fbfonts/upload/sans.fnt differ diff --git a/src/fbfonts/upload/serif.fnt b/src/fbfonts/upload/serif.fnt new file mode 100644 index 0000000..6f52cdc Binary files /dev/null and b/src/fbfonts/upload/serif.fnt differ diff --git a/src/fbgfxbox.fb.bas b/src/fbgfxbox.fb.bas new file mode 100644 index 0000000..9f0cedf --- /dev/null +++ b/src/fbgfxbox.fb.bas @@ -0,0 +1,296 @@ +'' +'' FreeBASIC Text Input Box using fbgfx only! +'' +'' Alex Barry +'' http://www.mrbarry.com/ +'' +'' June 24, 2011 +'' + + +#define DEBUG 1 + +Type InputBox +public: + Declare Constructor( byref strId as string ) + Declare Destructor() + + Declare Sub reset( ) + + Declare Function getStringId( ) As String + + Declare Sub display( focus as integer ) + Declare Function getInput( ) As Integer + + Declare Sub setCaret( pos as integer ) + + Declare Sub setCaretBlinkRate( nTimesPerSecond as double = 1.0 ) + + As Integer x, y + As Integer columns + As String * 1 passwordChar + As Integer isPassword + As String text + + As Integer redraw + + As Integer paddingX, paddingY + + As Uinteger background, foreground, border, caretCol +private: + Declare Sub moveCaretLeft() + Declare Sub moveCaretRight() + As Integer caret + As Integer caretDraw + As Integer textStartAt + As Double caretInterval + As Double caretNextBlink + As String stringId +End Type + +ScreenRes 800, 600, 16 +Dim Shared As Integer fontWidth, fontHeight +'' Get the default width and height of the font +var w = Width() +fontWidth = 800 / LoWord( w ) +fontHeight = 600 / HiWord( w ) + +Dim clickLock as Integer = 0 + +Dim txt(0 To 1) As InputBox Ptr = { new InputBox( "Left" ), new InputBox( "Right" ) } +txt(0)->x = 20 +txt(0)->y = 20 +txt(0)->columns = 50 +txt(0)->paddingY = 5 +txt(0)->setCaretBlinkRate( 2.5 ) + +txt(1)->x = 500 +txt(1)->y = 20 +txt(1)->columns = 30 +txt(1)->paddingY = 5 +txt(1)->setCaretBlinkRate( 2.5 ) +txt(1)->isPassword = 1 + +locate 10, 1 +Print "** Press Esc to quit **" +Print "Font Size: " & fontWidth & "x" & fontHeight +Print +Do + + Dim As Integer mx, my, mb + GetMouse( mx, my, , mb ) + If ( mb And 1 ) And ( Not clickLock ) Then + For obj As Integer = Lbound( txt ) To Ubound( txt ) + Dim ibox As InputBox Ptr = txt(obj) + If ( mx >= ibox->x ) And ( mx <= ibox->x+(fontWidth*ibox->columns)+(ibox->paddingX*2) ) And ( my >= ibox->y ) And ( my <= ibox->y+(fontHeight)+(ibox->paddingY*2) ) Then + If obj > 0 Then + Print "Changing focus to " & ibox->getStringId() + For r As Integer = obj-1 To Lbound( txt ) Step -1 + swap txt(r+1), txt(r) + Next r + End If + ibox->redraw = 1 + If mx < (ibox->x+ibox->paddingX) Then + ibox->setCaret(0) + Else + var caretPos = fix( (mx-(ibox->x+ibox->paddingX))/fontWidth ) + ibox->setCaret( caretPos ) + End If + End if + Next Obj + clickLock = 1 + ElseIf ( ( mb And 1 ) = 0 ) And clickLock Then + clickLock = 0 + End if + + if txt(0)->getInput( ) then + print "Input (" & txt(0)->getStringId() & ") : `" & txt(0)->text & "`" + txt(0)->reset() + end if + + ScreenLock() + txt(0)->display(1) + For u As Integer = 1 To Ubound( txt ) + txt(u)->display(0) + Next u + ScreenUnLock() + sleep 1, 1 +Loop Until Multikey( &h1 ) + +For d As Integer = Lbound( txt ) To Ubound( txt ) + Delete txt(d) +Next d + +Constructor InputBox( byref strId as string ) + this.isPassword = 0 + this.passwordChar = "*" + this.paddingX = 2 + this.paddingY = 2 + this.caretInterval = 1.0 + this.background = rgb(255,255,255) + this.foreground = rgb(0,0,0) + this.border = rgb( 100,100,100 ) + this.caretCol = rgb( 10,10,10 ) + this.stringId = strId + this.reset() +End Constructor + +Destructor InputBox() + this.text = "" + this.passwordChar = "" +End Destructor + +Sub InputBox.reset() + this.text = "" + this.caret = 0 + this.caretDraw = 0 + this.textStartAt = 1 + this.redraw = 1 +End Sub + +Function InputBox.getStringId( ) As String + return this.stringId +End Function + +Sub InputBox.display( focus as integer ) + + If focus Then + If (Timer >= this.caretNextBlink) Then + this.caretDraw = Not this.caretDraw + this.caretNextBlink = Timer + this.caretInterval + this.redraw = 1 + End If + Else + this.caretDraw = 0 + End If + + If this.redraw Then + Line (this.x, this.y)-step((this.columns*fontWidth)+(this.paddingX*2), fontHeight+(this.paddingY*2)), this.background, bf + Line (this.x, this.y)-step((this.columns*fontWidth)+(this.paddingX*2), fontHeight+(this.paddingY*2)), this.border, b + + Dim showChars as string + showChars = Mid( this.text, this.textStartAt ) + If len( showChars ) > this.columns Then showChars = Mid( showChars, 1, this.columns ) + If this.isPassword = 1 Then + showChars = String( len( showChars ), this.passwordChar ) + End If + Draw String ( this.x+this.paddingX, this.y+this.paddingY ), showChars, this.foreground + + If this.caretDraw Then + Line ( this.x+this.paddingX + (this.caret*8) - 1, this.y+(this.paddingY/2) )-( this.x+this.paddingX + (this.caret*8), this.y+fontHeight+(this.paddingY) ), this.caretCol, bf + Else + Line ( this.x+this.paddingX + (this.caret*8) - 1, this.y+(this.paddingY/2) )-( this.x+this.paddingX + (this.caret*8), this.y+fontHeight+(this.paddingY) ), this.background, bf + End If + + this.redraw = 0 + End If + +End Sub + +Function InputBox.getInput( ) As Integer + '' Parse text input + Dim a As Integer + Dim i As String + Dim As String splitA, splitB + i = Inkey() + a = Asc( i ) + this.redraw = 1 + If ( a >= 32 ) And ( a <= 126 ) Then + splitA = Mid( this.text, 1, this.textStartAt+this.caret-1 ) + splitB = Mid( this.text, this.textStartAt+this.caret ) + this.text = splitA & i & splitB + moveCaretRight( ) + ElseIf ( a = 13 ) Then + this.redraw = 0 + Return 1 + ElseIf ( a = 8 ) Then + If ( len( this.text ) > 0 ) And ( this.textStartAt >= 1 ) Then + splitA = Mid( this.text, 1, this.textStartAt+this.caret-2 ) + splitB = Mid( this.text, this.textStartAt+this.caret + 1 ) + this.text = splitA & splitB + moveCaretLeft( ) + End If + ElseIf ( i = (chr(255)+chr(75)) ) Then '' Left + this.moveCaretLeft( ) + ElseIf ( i = (chr(255)+chr(77)) ) Then '' Right + this.moveCaretRight( ) + ElseIf ( i = (chr(255)+chr(83)) ) Then '' Delete + If ( len( this.text ) > 0 ) Then + splitA = Mid( this.text, 1, this.textStartAt+this.caret-1 ) + splitB = Mid( this.text, this.textStartAt+this.caret + 1 ) + this.text = splitA & splitB + End If + ElseIf ( i = (chr(255)+chr(71)) ) Then '' Home + this.textStartAt = 1 + this.caret = 0 + ElseIf ( i = (chr(255)+chr(79)) ) Then '' End + Dim max As Integer + max = len( this.text ) - this.columns + If max < 1 Then + this.textStartAt = 1 + this.setCaret( len( this.text ) ) + Else + this.textStartAt = max + this.setCaret( this.columns ) + End If + Else + If a > 0 Then +#if DEBUG + Print "Unhandled key: "; + For p As Integer = 1 To Len( i ) + print asc( Mid( i, p, 1 ) ) & "+"; + Next + Print "" +#endif + End If + this.redraw = 0 + End If + + Return 0 +End Function + +Sub InputBox.setCaret( p as integer ) + If (p < 0) Then + this.caret = 0 + ElseIf pos >= 1 Then + If p > this.columns Then p = this.columns + Dim maxd As Integer + maxd = len( mid( this.text, this.textStartAt, this.columns ) ) + If p > maxd Then + this.caret = maxd + Else + this.caret = p + End If + End If + this.caretDraw = 0 + this.caretNextBlink = Timer +End Sub + +Sub InputBox.setCaretBlinkRate( nTimesPerSecond as double ) + this.caretInterval = 1.0/nTimesPerSecond + this.caretNextBlink = Timer +End Sub + +Sub InputBox.moveCaretLeft() + If this.caret = 0 Then + this.textStartAt -= 1 + If this.textStartAt < 1 Then this.textStartAt = 1 + Else + this.caret -= 1 + End If +End Sub + +Sub InputBox.moveCaretRight() + If this.caret = this.columns Then + this.textStartAt += 1 + Dim max As Integer + max = len( this.text ) - this.columns + If max < 1 Then + this.textStartAt = 1 + Else + this.textStartAt = max + End If + Else + this.caret += 1 + End If +End sub \ No newline at end of file diff --git a/src/fbpaint.fb.bas b/src/fbpaint.fb.bas new file mode 100644 index 0000000..a241897 --- /dev/null +++ b/src/fbpaint.fb.bas @@ -0,0 +1,564 @@ + + +#INCLUDE "fbgfx.bi" +Using FB +Windowtitle "Simple Paint Program" +Screenres 640,480,32 + +Dim Shared As Integer cmd +cmd = 0 'draw mode default +Dim Shared As Integer btnID 'id of button pressed +Dim Shared As Integer penSize +penSize = 3 'pen size default +Dim Shared As Integer mirror +mirror = 0 'default to no mirror + +'fill in pallete with colors +Dim As Ubyte r,g,b +Dim Shared As Uinteger colors(48) +For i As Integer = 0 To 47 + Read r,g,b + colors(i) = Rgb(r,g,b) +Next i + +Dim Shared As Any Ptr canvas1,canvas2 'displayed image +canvas1 = Imagecreate(640,480,Rgb(255,255,254)) 'save image while screen is being worked on +canvas2 = Imagecreate(640,480,Rgb(255,255,254)) 'saves saved image for UNDO + +Dim Shared As Integer mx,my,ox,oy,sx,sy,dx,dy,mb 'mouse variables +Setmouse(0,0,1,1) + +Dim Shared As Integer sColor 'id of selected color in palette +sColor = 0 'black pen default palette#0 + +Dim Shared As Integer mode1, mode2 'fill rectangle, fill circle + + +Sub update() + Screenlock() + '============= + 'draw buttons + '============= + For x As Integer = 0 To 15 + If cmd=x Or (mirror = 1 And x = 7) Then + Line (x*40,0)-(x*40+39,20),Rgb(100,100,255),bf + Else + Line (x*40,0)-(x*40+39,20),Rgb(10,10,255),bf + End If + Next x + Draw String (4,8),"DRAW RECT CIRC LINE FILL RUB CLS HMIR UNDO SAVE LOAD PEN .... .... .... QUIT",Rgb(255,255,254) + For i As Integer = 0 To 15 + Line (i*40,0)-(i*40+39,20),Rgb(200,200,200),b + Next i + + + '================== + ' draw palette + '================== + For x As Integer = 0 To 39 + Line (x*16,464)-(x*16+15,479),colors(x),bf + If x = sColor Or (mirror = 1 And x = 7) Then + Line (x*16,464)-(x*16+15,479) ,Rgb(255,255,254),b + Line (x*16+1,464+1)-(x*16+15-1,479-1) ,Rgb(0,0,0),b + Else + Line (x*16,464)-(x*16+15,479) ,Rgb(0,0,0),b + End If + Next x + Screenunlock() + Sleep 2 +End Sub + +Sub thickLine(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,size As Integer,c As Uinteger) + Dim As Integer x,y + If x1 = x2 And y1 = y2 Then + Circle (x1, y1), size, c, , , , f + Elseif Abs(x2 - x1) >= Abs(y2 - y1) Then + Dim K As Single = (y2 - y1) / (x2 - x1) + For I As Integer = x1 To x2 Step Sgn(x2 - x1) + x = I + y = K * (I - x1) + y1 + Circle (x,y), size, c, , , , f + If mirror = 1 Then + Circle (640-x,y),size,c,,,,f 'for horizontal mirror + End If + Next I + Else + Dim L As Single = (x2 - x1) / (y2 - y1) + For J As Integer = y1 To y2 Step Sgn(y2 - y1) + x = L * (J - y1) + x1 + y = J + Circle (x,y), size,c,,,,f + If mirror = 1 Then + Circle (640-x,y),size,c,,,,f 'for horizontal mirror + End If + Next J + End If +End Sub + +Sub FloodFill (x As Integer, y As Integer, oldcolour As Integer, newcolour As Integer) + Dim As Integer Ptr p = New Integer[16*1024 * 1024] + Dim As Integer n = 0 + Dim As Integer x0, y0 + + If oldcolour = newcolour Then Exit Sub + p[n] = x + p[n+1] = y + n = n + 2 + While n > 0 + y0 = p[n-1] + x0 = p[n-2] + n = n - 2 + If Point(x0, y0) = oldcolour Then + Pset (x0, y0), newcolour + p[n] = x0 + p[n+1] = y0-1 + p[n+2] = x0 + p[n+3] = y0+1 + p[n+4] = x0-1 + p[n+5] = y0 + p[n+6] = x0+1 + p[n+7] = y0 + n = n + 8 + End If + Wend + Delete p +End Sub + +Sub Fill() + FloodFill (mx,my,Point(mx,my),colors(sColor)) + update() + 'wait for select button release + While mb=1 + Getmouse mx,my,,mb + Wend + Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1 + Get (0,0)-(639,479),canvas1 'canvas1 = screen +End Sub + +Sub drawRectangle() + Dim As Integer r + Dim As String s + While mb=1 + Getmouse mx,my,,mb + If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new + Screenlock() + Put (0,0),canvas1,Trans 'restore screen + + 'fill rectangle mode? + If mode1 = 1 Then + For i As Integer = oy To my + Line (ox,i)-(mx,i),colors(sColor) + Next i + End If + + thickLine(ox,oy,mx,oy,penSize,colors(sColor)) + thickLine(mx,oy,mx,my,penSize,colors(sColor)) + thickLine(mx,my,ox,my,penSize,colors(sColor)) + thickLine(ox,my,ox,oy,penSize,colors(sColor)) + Screenunlock() + update() + Sleep 1 + End If + Wend + Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1 + Get (0,0)-(639,479),canvas1 'canvas1 = screen +End Sub + +Sub drawLine() + Dim As Integer sx,sy + sx = mx + sy = my + While mb=1 + Getmouse mx,my,,mb + If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new + Put (0,0),canvas1,Trans 'restore screen + thickLine(sx,sy,mx,my,penSize,colors(sColor)) 'draw line + ox = mx + oy = my + update() + End If + Wend + Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1 + Get (0,0)-(639,479),canvas1 'canvas1 = screen +End Sub + +Sub drawPen() + While mb=1 + Getmouse mx,my,,mb + If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new + thickLine(ox,oy,mx,my,penSize,colors(sColor)) 'drawline onto screenBuffer + ox = mx + oy = my + update() + End If + Sleep 1 + Wend + Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1 + Get (0,0)-(639,479),canvas1 'canvas1 = screen + +End Sub + +Sub Ellipse(x0 As Integer, Y0 As Integer, X1 As Integer, y1 As Integer, c As Uinteger) + 'bresenham circle + 'void bresenham_ellipse( x0 As Integer,y0 As Integer, x1 As integer, y1 As integer ) + If x0>x1 Then Swap x0,x1 + If y0>y1 Then Swap y0,y1 + Dim As Integer x,y,a2,b2, S, T,xb,yb,b + b=(y1-y0)/2 + b2=b*b + a2=(x1-x0)^2/4 + xb=(x0+x1)/2 + yb=(y0+y1)/2 + + x = 0 + y = b + S = a2*(1-2*b) + 2*b2 + T = b2 - 2*a2*(2*b-1) + If mode2 = 1 Then 'fill ellipse + Line ((xb-x),(yb+y))-((xb-x),(yb-y)),c + Line ((xb+x),(yb+y))-((xb+x),(yb-y)),c + End If + Circle ((xb+x),(yb+y)),3,c,,,,f + Circle ((xb+x),(yb-y)),3,c,,,,f + Circle ((xb-x),(yb+y)),3,c,,,,f + Circle ((xb-x),(yb-y)),3,c,,,,f + + Do + If S<0 Then + + S += 2*b2*(2*x+3) + T += 4*b2*(x+1) + x+=1 + Elseif T<0 Then + S += 2*b2*(2*x+3) - 4*a2*(y-1) + T += 4*b2*(x+1) - 2*a2*(2*y-3) + x+=1 + y-=1 + Else + S -= 4*a2*(y-1) + T -= 2*a2*(2*y-3) + y-=1 + End If + If mode2 = 1 Then 'fill ellipse + Line ((xb-x),(yb+y))-((xb-x),(yb-y)),c + Line ((xb+x),(yb+y))-((xb+x),(yb-y)),c + End If + Circle ((xb+x),(yb+y)),3,c,,,,f + Circle ((xb+x),(yb-y)),3,c,,,,f + Circle ((xb-x),(yb+y)),3,c,,,,f + Circle ((xb-x),(yb-y)),3,c,,,,f + Loop While y>0 + +End Sub + +Sub drawCircle() + Dim As Double r + Dim As Integer x,y,cx,cy + While mb=1 + Getmouse mx,my,,mb + If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new + Screenlock() + Put (0,0),canvas1,Trans 'restore screen + Ellipse(ox,oy,mx,my,colors(sColor)) 'draw onto screen + If mirror = 1 Then + Ellipse(640-ox,oy,640-mx,my,colors(sColor)) + End If + Screenunlock() + update() + End If + Wend + Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1 + Get (0,0)-(639,479),canvas1 'canvas1 = screen +End Sub + +Sub Rubber() + Dim As Double r + Dim As Integer x,y,cx,cy + While mb=1 + Getmouse mx,my,,mb + If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new + Line(ox,oy)-(ox+20,oy+20),Rgb(255,255,254),bf 'erase box outline + Line(mx,my)-(mx+20,my+20),Rgb(255,255,254),bf + Line(mx,my)-(mx+20,my+20),Rgb(0,0,0),b 'draw box outline + ox = mx + oy = my + update() + End If + Wend + Line(ox,oy)-(ox+20,oy+20),Rgb(255,255,254),bf 'erase box outline + Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1 + Get (0,0)-(639,479),canvas1 'canvas1 = screen +End Sub + +Sub save() + Dim fileName As String + Locate 20,10 + Get (0,0)-(639,479),canvas1 'save into canvas1 + Line (60,140)-(560,172),Rgb(255,255,254),bf + Line (60,140)-(560,172),Rgb(1,1,1),b + Line Input "Enter picture name:", fileName + Locate 26,10 + Print " ... SAVING" + Bsave filename + ".bmp",canvas1 + Put (0,0),canvas1,Pset 'copy to screen + update() +End Sub + +Sub load() + Dim fileName As String + Locate 20,10 + Line (60,140)-(560,172),Rgb(255,255,254),bf + Line (60,140)-(560,172),Rgb(1,1,1),b + Line Input "Enter picture name:",fileName + Bload filename + ".bmp",canvas1 + Put (0,0),canvas1,Pset 'copy to screen + update() +End Sub + +Color Rgb(0,0,0),Rgb(255,255,254) 'black ink, white paper +Cls 'executes the color change + +update() + +Dim As String key +Do + + Getmouse mx,my,,mb + ox = mx + oy = my + + + If mb = 1 Then + + 'is it over drawing area? + If my>20 And my<480-20 Then + If cmd = 0 Then + drawPen() + End If + If cmd = 1 Then + drawRectangle() + End If + If cmd = 2 Then + drawCircle() + End If + If cmd = 3 Then + drawLine() + End If + If cmd = 4 Then + Fill() + End If + If cmd = 5 Then + Rubber() + End If + End If + 'is it over buttons + If my<20 Then + + btnID = mx\40 + + If btnID=1 Then 'set rectangle mode + + Get (0,0)-(639,479),canvas1 'save screen into canvas1 to restore + Locate 18,2 + Print "Release mouse button over fill or not fill icon to select mode" + update() + 'drop down rectangle examples + For j As Integer = 0 To 1 + Line (44,j*32+23)-(44+31,j*32+31+23),Rgb(255,255,254),bf + Line (44,j*32+23)-(44+31,j*32+31+23),Rgb(1,1,1),b + Line (52,31)-(52+16,31+16),Rgb(1,1,1),b + Line (52,63)-(52+16,63+16),Rgb(1,1,1),bf + Next j + While mb=1 + Getmouse mx,my,,mb + Wend + 'was it released over shape fill mode? + If mx>44 And mx<75 And my>25 And my<87 Then + mode1 = (Int(my-23)\32) + End If + Put (0,0),canvas1,Pset 'restore screen + update() + End If + + If btnID=2 Then 'set rectangle mode + + Get (0,0)-(639,479),canvas1 'save screen into canvas1 to restore + Locate 18,2 + Print "Release mouse button over fill or not fill icon to select mode" + update() + 'drop down ellipse examples + For j As Integer = 0 To 1 + Line (84,j*32+25)-(84+31,j*32+31+25),Rgb(255,255,254),bf + Line (84,j*32+25)-(84+31,j*32+31+25),Rgb(1,1,1),b + Circle (99,40),10,Rgb(1,1,1) + Circle (99,73),10,Rgb(1,1,1),,,,f + Next j + While mb=1 + Getmouse mx,my,,mb + Wend + 'was it released over shape fill mode? + If mx>84 And mx<115 And my>25 And my<87 Then + mode2 = (Int(my-23)\32) + End If + Put (0,0),canvas1,Pset 'restore screen + update() + End If + + If btnID<6 Then + cmd = btnID + End If + + If btnID=6 Then + Color Rgb(1,1,1),Rgb(255,255,254) 'black ink, white paper + Line canvas1,(0,0)-(639,479),Rgb(255,255,254),bf 'clear canvas1 + Cls + End If + + If btnID=7 Then + mirror = mirror+1 + If mirror=2 Then mirror = 0 + End If + + If btnID=8 Then + Put canvas1,(0,0),canvas2,Pset 'get previous + Put (0,0),canvas1,Pset 'copy to screen + update() + End If + + If btnID = 9 Then + save() + update() + 'btnID = mode 'reset button ID + End If + + If btnID = 10 Then + load() + update() + 'btnID = mode 'reset button ID + End If + + If btnID = 11 Then 'pen size + Get (0,0)-(639,479),canvas1 'save screen into canvas1 to restore + Locate 8,2 + Print "Release mouse button over desired pen size" + update() + 'drop down pen examples + For j As Integer = 0 To 3 + Line (449,j*23+23)-(449+22,j*23+22+23),Rgb(255,255,254),bf + Line (449,j*23+23)-(449+22,j*23+22+23),Rgb(1,1,1),b + Circle (449+11,j*23+11+23),j*2+1,Rgb(1,1,1),,,,f + Next j + While mb=1 + Getmouse mx,my,,mb + Wend + 'was it released over pen size? + If mx>454 And mx<476 And my>23 And my<114 Then + penSize = (Int(my-23)\23)*2+1 + End If + Put (0,0),canvas1,Pset 'restore screen + update() + + End If + + + 'wait for button release + While mb = 1 + Getmouse mx,my,,mb + Wend + + update() + + End If + 'is it over pallete? + If my>464 Then + sColor = mx\16 + While mb = 1 + Getmouse mx,my,,mb + Wend + End If + update() + End If + +Loop Until btnID = 15 + +Imagedestroy(canvas1) +Imagedestroy(canvas2) + +'Custom colors +ColorData: + +' === microsoft PAINT standard colors === +Data 0 ,0 , 0 'BLACK +Data 127,127,127 'dark gray +Data 195,195,195 'light gray +Data 255,255,254 'WHITE +Data 136, 0, 21 'red brown +Data 185,122, 87 'brown +Data 237, 28, 36 'red +Data 255,174,201 'pink +Data 255,127, 39 'orange +Data 255,201, 14 'deep yellow gold +Data 255,242, 0 'yellow +Data 239,228,176 'light yellow +Data 34,177, 76 'green +Data 181,230, 29 'lime +Data 0,162,232 'turquoise medium blue +Data 153,217,234 'light blue +Data 63, 72,204 'indigo dark blue +Data 112,146,190 'blue gray +Data 163, 73,164 'purple +Data 200,191,231 'lavenda +'===================================== +Data 255,128,128 +Data 255, 0, 0 +Data 128, 64, 64 +Data 128, 0, 0 + +Data 255,255,128 'yellow +Data 255,255, 0 +Data 255,128, 64 'orange +Data 255,128, 0 +Data 128, 64, 0 'brown +Data 128,128, 0 + +Data 128,255,128 'green +Data 128,255, 0 +Data 0,255, 0 +Data 0,128, 0 +Data 0, 64, 0 +Data 128,128, 64 + +Data 0,255,128 +Data 0,255, 64 +Data 0,128,128 +Data 0,128, 64 +Data 0, 64, 64 +Data 128,128,128 'gray + +Data 128,255,255 'blue +Data 0,255,255 +Data 0, 64,128 +Data 0, 0,255 +Data 0, 0,128 +Data 64,128,128 + +Data 0,128,255 +Data 0,128,192 +Data 128,128,255 +Data 0, 0,160 +Data 0, 0, 64 +Data 192,192,192 'gray + +Data 255,128,192 'red +Data 128,128,192 +Data 128, 0, 64 +Data 128, 0,128 'purple +Data 64, 0, 64 +Data 64, 0,128 'black + +Data 255,128,255 +Data 255, 0,255 +Data 255, 0,128 +Data 128, 0,255 +Data 64, 0,128 +Data 255,255,254 'white \ No newline at end of file diff --git a/src/fbpanel.fb.bas b/src/fbpanel.fb.bas new file mode 100644 index 0000000..3295df7 --- /dev/null +++ b/src/fbpanel.fb.bas @@ -0,0 +1,41 @@ +locate ,,0 +dim as integer oldcolor = color +dim as integer oldwidth = width + +width 80, 25 +view print 1 to 8 +color 0, 7 +cls +sleep 2000 + +view print 17 to 25 +color , 7 +cls +sleep 2000 + +locate 25,57 +print "press any key to exit..."; +sleep 2000 + +view print 9 to 16 +color 7, 1 +cls +sleep 2000 + +locate 13, 40 - (len( "Welcome to FreeBASIC!" ) \ 2) +sleep 2000 + +print "Welcome to "; +color 15 +print "FreeBASIC"; +color 7 +print "!" + +sleep +dim as string clearkey = inkey + +width oldwidth and &HFFFF, oldwidth shr 16 +color oldcolor and &HFFFF, oldcolor shr 16 +view print 1 to oldwidth shr 16 +cls +locate ,,1 \ No newline at end of file diff --git a/src/fontish.fb.bas b/src/fontish.fb.bas new file mode 100644 index 0000000..98e59b1 --- /dev/null +++ b/src/fontish.fb.bas @@ -0,0 +1,224 @@ +'============= START FONT BUSINESS ========================== +Function Blur(Byref tim As Uinteger Pointer,rad As Single=2) As Uinteger Pointer + Type p2 + As Integer x,y + As Uinteger col + End Type + #macro ppoint(_x,_y,colour) + pixel=row+pitch*(_y)+4*(_x) + (colour)=*pixel + #endmacro + #macro ppset(_x,_y,colour) + pixel=row+pitch*(_y)+4*(_x) + *pixel=(colour) + #endmacro + #macro average() + ar=0:ag=0:ab=0:inc=0 + xmin=x:If xmin>rad Then xmin=rad + xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x + ymin=y:If ymin>rad Then ymin=rad + ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y + For y1 As Integer=-ymin To ymax + For x1 As Integer=-xmin To xmax + inc=inc+1 + ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255) + ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255) + ab=ab+(NewPoints(x+x1,y+y1).col And 255) + Next x1 + Next y1 + averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc)) + #endmacro + Dim As Integer _x,_y + Imageinfo tim,_x,_y + Dim As Uinteger Pointer im=Imagecreate(_x,_y) + Dim As Integer pitch + Dim As Any Pointer row + Dim As Uinteger Pointer pixel + Dim As Uinteger col + Imageinfo tim,,,,pitch,row + Dim As p2 NewPoints(_x,_y) + For y As Integer=0 To (_y)-1 + For x As Integer=0 To (_x)-1 + ppoint(x,y,col) + NewPoints(x,y)=type(x,y,col) + Next x + Next y + Dim As Uinteger averagecolour + Dim As Integer ar,ag,ab + Dim As Integer xmin,xmax,ymin,ymax,inc + For y As Integer=0 To _y-1 + For x As Integer=0 To _x-1 + average() + NewPoints(x,y).col=averagecolour + Next x + Next y + Imageinfo im,,,,pitch,row + For y As Integer=0 To _y + For x As Integer=0 To _x + ppset((NewPoints(x,y).x),(NewPoints(x,y).y),NewPoints(x,y).col) + Next x + Next y + ImageDestroy tim: tim = 0 + Function= im +End Function +Sub drawstring(xpos As Integer,ypos As Integer,text As String,colour As Uinteger,size As Single,im As Any Pointer=0) + Type D2 + As Double x,y + As Uinteger col + End Type + Static As d2 cpt(),XY() + Static As Integer runflag + If runflag=0 Then + Redim XY(64,127) + Redim cpt(1 To 64) + Screenres 10,10 + dim as uinteger pointer img + Dim count As Integer + For ch As Integer=1 To 127 + img=imagecreate(10,10) + Draw String img,(1,1),Chr(ch) + For x As Integer=1 To 8 + For y As Integer=1 To 8 + If Point(x,y,img)<>0 Then + count=count+1 + XY(count,ch)=Type(x,y) + End If + Next y + Next x + count=0 + imagedestroy img + Next ch + runflag=1 + End If + If size=0 Then Exit Sub + Dim As D2 np,t + #macro Scale(p1,p2,d) + np.col=p2.col + np.x=d*(p2.x-p1.x)+p1.x + np.y=d*(p2.y-p1.y)+p1.y + #endmacro + + Dim As D2 c=Type(xpos,ypos) + Dim As Integer dx=xpos,dy=ypos + For z6 As Integer=1 To Len(text) + Var asci=text[z6-1] + For _x1 As Integer=1 To 64 + t=Type(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour) + Scale(c,t,size) + cpt(_x1)=np + + If XY(_x1,asci).x<>0 Then + If Abs(size)>1 Then + Line im,(cpt(_x1).x-size/2,cpt(_x1).y-size/2)-(cpt(_x1).x+size/2,cpt(_x1).y+size/2),cpt(_x1).col,bf + Else + Pset im,(cpt(_x1).x,cpt(_x1).y),cpt(_x1).col + End If + End If + Next _x1 + dx=dx+8 + Next z6 +End Sub +Sub init Constructor 'automatic loader + drawstring(0,0,"",0,0) + Screen 0 +End Sub + +function Colour(im as uinteger pointer,newcol as uinteger,grade as integer) as uinteger pointer + #macro ppset2(_x,_y,colour) + pixel2=row2+pitch2*(_y)+4*(_x) + *pixel2=(colour) + #endmacro + #macro ppoint(_x,_y,colour) + pixel=row+pitch*(_y)+4*(_x) + (colour)=*pixel + #endmacro + dim as integer w,h + Dim As Integer pitch,pitch2 + Dim As Any Pointer row,row2 + Dim As Uinteger Pointer pixel,pixel2 + Dim As Uinteger col + Imageinfo im,w,h,,pitch,row + dim as uinteger pointer temp + temp=imagecreate(w,h) + Imageinfo temp,,,,pitch2,row2 + for y as integer=0 to h-1 + for x as integer=0 to w-1 + ppoint(x,y,col) + Var v=.299*((col Shr 16)And 255)+.587*((col Shr 8)And 255)+.114*(col And 255) + if v>grade then + ppset2(x,y,newcol) + else + ppset2(x,y,rgb(255,0,255)) + end if + next x + next y + return temp + end function + +sub FONT(byref myfont as uinteger pointer,fontsize as integer,col as uinteger,grade as integer=190) +Const FIRSTCHAR = 32, LASTCHAR = 127 +Const NUMCHARS = (LASTCHAR - FIRSTCHAR) + 1 +Dim As ubyte Ptr p +dim as uinteger pointer temp +Dim As Integer i +temp = ImageCreate(NUMCHARS * 8*FontSize, 9*FontSize,rgb(255,0,255)) +myfont=ImageCreate(NUMCHARS * 8*FontSize, 9*FontSize,rgb(255,0,255)) + +For i = FIRSTCHAR To LASTCHAR + drawstring ((i - FIRSTCHAR) * 8*FontSize, 1,chr(i),rgb(255,255,255),FontSize,temp) +Next i +for n as integer=1 to fontsize-1 + temp=blur(temp,1) +next n +temp=Colour(temp,col,grade) +put myfont,(0,0),temp,trans +ImageInfo( myfont,,,,, p ) +p[0] = 0 +p[1] = FIRSTCHAR +p[2] = LASTCHAR +For i = FIRSTCHAR To LASTCHAR + p[3 + i - FIRSTCHAR] = 8*FontSize +next i +imagedestroy(temp) +end sub +'=================== END FONTS ======================================== + + +'=========== USAGE ======================== +screen 19,32 + +dim as uinteger pointer customfont +dim as uinteger pointer customfont2 +dim as uinteger pointer customfont3 + +'font choice,size,colour + +font customfont,3,rgb(0,200,0) + + +'You can tweak the last parameter a bit. +'The default is 190 +font customfont2,1,rgb(200,200,200),205 + + +font customfont3,4,rgb(0,0,255),210 + + +draw string(50,50),"Custom font",,customfont +draw string(50,200),"Custom font2",,customfont2 +draw string(50,300),"Custom font3",,customfont3 +draw string(50,400),"Press a key",,customfont + +sleep +do + screenlock + cls + draw string(10,200),"Once the fonts are created then",,customfont + draw string(10,300),"they display by Draw string.",,customfont + draw string(10,400)," to end",,customfont3 + screenunlock + sleep 1,1 + loop until inkey=chr(27) + + + \ No newline at end of file diff --git a/src/fonts.fb.bas b/src/fonts.fb.bas new file mode 100644 index 0000000..08c9c73 --- /dev/null +++ b/src/fonts.fb.bas @@ -0,0 +1,23 @@ +#include once "windows.bi" +' +dim as integer p,res +' +dim progpath as zstring * 512 +res=GetModuleFileName(NULL,progpath,512) +' +p=instr(progpath,"\") +while p>0 + mid(progpath,p,1)="_" + p=instr(progpath,"\") +wend +' +print "REGEDIT4" '"Windows Registry Editor Version 5.00" +print +print "[HKEY_CURRENT_USER\Console\";progpath;"]" +print !"\"FontSize\"=dword:000e0000" '14 pt +print !"\"FontFamily\"=dword:00000036" +print !"\"FontWeight\"=dword:000002bc" 'bold +print !"\"FaceName\"=\"Lucida Console\"" +'print !"\"QuickEdit\"=dword:00000001" +' +sleep \ No newline at end of file diff --git a/src/fonts/demo.bas b/src/fonts/demo.bas new file mode 100644 index 0000000..33bf2a2 --- /dev/null +++ b/src/fonts/demo.bas @@ -0,0 +1,18 @@ +Const Xmax=640 +Const Ymax=480 + +ScreenRes Xmax,Ymax,32 + +#Include Once "fontlib.bi" + +ScreenLock +Line (0,0)-(Xmax,Ymax),RGB(30,30,30),BF +ColorRGB(86,156,214,3) +ColorRGB(86,156,214,4) +DrawString("Hello World! :-) VGA-16",30,10,VGA16) +DrawString("Hello World! :-) VGA-14",30,30,VGA14) +DrawString("Hello World! :-) VGA-8",30,50,VGA8) +DrawString("Hello World! :-) PX Sans Nouveaux",30,70,SANS) +DrawString("Hello World! :-) Monospace",30,90,MONO) +ScreenUnlock +Sleep diff --git a/src/fonts/font1.bmp b/src/fonts/font1.bmp new file mode 100644 index 0000000..a9bfc1a Binary files /dev/null and b/src/fonts/font1.bmp differ diff --git a/src/fonts/font1.fon b/src/fonts/font1.fon new file mode 100644 index 0000000..494bb5c --- /dev/null +++ b/src/fonts/font1.fon @@ -0,0 +1,3 @@ +font1.bmp +all=8 +8 diff --git a/src/fonts/font2.bmp b/src/fonts/font2.bmp new file mode 100644 index 0000000..e367e76 Binary files /dev/null and b/src/fonts/font2.bmp differ diff --git a/src/fonts/font2.fon b/src/fonts/font2.fon new file mode 100644 index 0000000..862d216 --- /dev/null +++ b/src/fonts/font2.fon @@ -0,0 +1,3 @@ +font2.bmp +all=8 +8 diff --git a/src/fonts/font3.bmp b/src/fonts/font3.bmp new file mode 100644 index 0000000..6dcb842 Binary files /dev/null and b/src/fonts/font3.bmp differ diff --git a/src/fonts/font3.fon b/src/fonts/font3.fon new file mode 100644 index 0000000..ab8a020 --- /dev/null +++ b/src/fonts/font3.fon @@ -0,0 +1,3 @@ +font3.bmp +all=8 +8 diff --git a/src/fonts/fontlib.bi b/src/fonts/fontlib.bi new file mode 100644 index 0000000..69acaed --- /dev/null +++ b/src/fonts/fontlib.bi @@ -0,0 +1,97 @@ +Type TFont + As String nam,imgpath + As Integer height,charlength(93) + As Any Ptr img,char(93) +End Type + +Dim Shared As TFont Font(4) +Dim Shared As UByte num_fonts + +Sub LoadFont(nam As String, height As UByte, path As String) + Dim As String length + Dim As Integer count,fontlength + + With Font(num_fonts) + .nam=nam + .height=height + .img=ImageCreate(93*8,height) + Var ff=FreeFile + Open path For Input As #ff + Line Input #ff,.imgpath + Line Input #ff,length + For i As Integer=1 To 93 + .charlength(i)=Val(Mid(length,5)) + Next + Do + Line Input #ff,Length + count+=1 + .charlength(count)=Val(Length) + Loop Until Eof(ff) + Close #ff + Bload .imgpath,.img + For i As Integer=1 To 93 + .char(i)=ImageCreate(.charlength(i),height) + Get .img,(fontlength,0)-(fontlength+.charlength(i)-1,height-1),.char(i) + fontlength+=.charlength(i) + Next + ImageDestroy .img + End With + num_fonts+=1 +End Sub + +Const VGA14=0 +Const VGA16=1 +Const VGA8=2 +Const SANS=3 +Const MONO=4 + +LoadFont("VGA_14",14,"font1.fon") +LoadFont("VGA_16",16,"font2.fon") +LoadFont("VGA_8",8,"font3.fon") +LoadFont("Sans Serif 11",11,"sans11.fon") +LoadFont("Monospace 14",15,"mono14.fon") + +function replace(byval src as uinteger, byval dest as uinteger, byval p as any ptr) as uinteger + dim c as uinteger = *cptr(uinteger ptr, p) + if src = RGB(255,255,255) then + return c + elseif src = 0 then + return dest + else + return src + end if +end function + +Sub ColorRGB(R As UByte, G As UByte, B As Ubyte, fontid As UByte=0) + Dim As ULong C + C=RGB(R,G,B) + For i As Integer=1 To 93 + Put Font(fontid).char(i),(0,0),Font(fontid).char(i),Custom,@replace,@c + Next +End Sub + +Sub DrawString(text As String, x As Short, y As Short, fontid As UByte=0) + Dim As Integer fontlength + For i As Integer=1 To Len(text) + 'Put (x+(i-2)*8+(8-Font(fontid).Charlength(Asc(Mid(text,i,1))-32)),y),Font(fontid).Char(Asc(Mid(text,i,1))-32),Trans + If Mid(text,i,1)<>" " Then + Put (x+fontlength,y),Font(fontid).Char(Asc(Mid(text,i,1))-32),Trans + fontlength+=Font(fontid).Charlength(Asc(Mid(text,i,1))-32) + Else + fontlength+=6 + End If + Next +End Sub + +Function FontWidth(text As String, fontid As UByte=0)As Integer + Dim As Integer fontlength + For i As Integer=1 To Len(text) + If Mid(text,i,1)<>" " Then + fontlength+=Font(fontid).Charlength(Asc(Mid(text,i,1))-32) + Else + fontlength+=6 + End If + Next + Return fontlength +End Function + diff --git a/src/fonts/fonts.zip b/src/fonts/fonts.zip new file mode 100644 index 0000000..e98b779 Binary files /dev/null and b/src/fonts/fonts.zip differ diff --git a/src/fonts/mono14.bmp b/src/fonts/mono14.bmp new file mode 100644 index 0000000..e1f36ec Binary files /dev/null and b/src/fonts/mono14.bmp differ diff --git a/src/fonts/mono14.fon b/src/fonts/mono14.fon new file mode 100644 index 0000000..5f006a8 --- /dev/null +++ b/src/fonts/mono14.fon @@ -0,0 +1,3 @@ +mono14.bmp +all=8 +8 diff --git a/src/fonts/sans11.bmp b/src/fonts/sans11.bmp new file mode 100644 index 0000000..923957d Binary files /dev/null and b/src/fonts/sans11.bmp differ diff --git a/src/fonts/sans11.fon b/src/fonts/sans11.fon new file mode 100644 index 0000000..8983e54 --- /dev/null +++ b/src/fonts/sans11.fon @@ -0,0 +1,95 @@ +sans11.bmp +all=8 +2 +4 +9 +6 +11 +7 +2 +4 +4 +6 +6 +3 +4 +2 +5 +6 +4 +6 +6 +6 +6 +6 +6 +6 +6 +2 +3 +4 +6 +4 +6 +10 +8 +7 +7 +7 +7 +7 +8 +7 +2 +6 +7 +7 +8 +7 +8 +7 +8 +7 +7 +8 +8 +8 +10 +8 +8 +7 +3 +5 +3 +6 +7 +3 +6 +6 +6 +6 +6 +5 +6 +6 +2 +3 +5 +2 +8 +6 +6 +6 +6 +5 +6 +5 +6 +6 +10 +6 +6 +6 +4 +2 +4 diff --git a/src/hello.fb.bas b/src/hello.fb.bas new file mode 100644 index 0000000..49e6cb6 --- /dev/null +++ b/src/hello.fb.bas @@ -0,0 +1,5 @@ +Cls +Print "Hello, World!" + + + diff --git a/src/inkey.fb b/src/inkey.fb new file mode 100755 index 0000000..7527cbd Binary files /dev/null and b/src/inkey.fb differ diff --git a/src/inkey.fb.bas b/src/inkey.fb.bas new file mode 100755 index 0000000..ae44806 --- /dev/null +++ b/src/inkey.fb.bas @@ -0,0 +1,21 @@ +Dim As String key, char +Dim As Integer i +Do + 'Check keyboard buffer + key = Inkey + 'If key has been pressed + If Len(key) > 0 Then + 'Clear the last message + Locate 1, 1 + Print Space(79); + 'Reposition cursor + locate 1,1 + 'Print current key codes + For i = 1 To Len(key) + char = Mid(key, i, 1) + Print "Character: ";char; " Code: ";Asc(char); " "; + Next + End If + Sleep 10 +Loop Until key = Chr(27) +End \ No newline at end of file diff --git a/src/makdword.fb.bas b/src/makdword.fb.bas new file mode 100644 index 0000000..235c070 --- /dev/null +++ b/src/makdword.fb.bas @@ -0,0 +1,28 @@ +#define MAKDWORD(x,y) (cint(x) shl 16 or cint(y)) + +Dim myInt As Uinteger +Dim As Integer i, cnt +myInt = MAKDWORD(5,5) + +Width 80,25 +cnt = 1 +For i = 1 to 80 + If cnt = 10 Then + cnt = 0 + End If + Locate 1, i + Print Str(cnt) + cnt += 1 +Next +cnt = 2 +For i = 2 To 25 + If cnt = 10 then + cnt = 0 + End If + Locate i,1 + Print Str(cnt); + cnt += 1 +Next +Locate Hiword(myInt), Loword(myInt) +Print "We stored the screen location in a single uinteger" +End \ No newline at end of file diff --git a/src/passwdbox.fb.bas b/src/passwdbox.fb.bas new file mode 100644 index 0000000..0478fda --- /dev/null +++ b/src/passwdbox.fb.bas @@ -0,0 +1,48 @@ +cls +i = 20 +maxchar = 20 +screen 12 + +Do + color 7, 0 + cls + locate 2, 1 + print "Password:" + color 4,15 + + ' if passed the maximum character limit, then take one + ' letter out of the password to make it not pass the limit + if len(pass$) > maxchar then pass$ = mid$(pass$, 1, len(pass$) - 1) + + for s = 1 to maxchar + locate 3,s + print " "; + next s + + if len(pass$) > 0 then + for s = 1 to len(pass$) + locate 3, s + print "*"; + next s + end if + + do + a$ = inkey$ + loop until a$ <> "" + if a$ = chr$(13) then + cls + color 4, 0 + print "You typed "; pass$ + sleep + end + end if + + if a$ = chr$(8) then + pass$ = left(pass$, len(pass$) - 1) + i=i+1 + else + pass$ = pass$ + a$ + i=i-1 + end if + loop +End \ No newline at end of file diff --git a/src/repeats.fb.bas b/src/repeats.fb.bas new file mode 100644 index 0000000..ea1c3ab --- /dev/null +++ b/src/repeats.fb.bas @@ -0,0 +1,24 @@ +Dim As Single total, count, number +Dim As String text + +Print "This program will calculate the sum and average for a" +Print "list of numbers. Enter an empty value to see the results." +Print + +Do + Input "Enter a number: ", text + If text = "" Then Exit Do + count += 1 + total += Val(text) +Loop + +Print +Print "You entered: "; count; " number(s)" +Print "The sum is: "; total + +If count > 0 Then Print "The average is: "; total / count + +Print +Print "Any keypress ends program."; + +Sleep \ No newline at end of file diff --git a/src/screenres.fb.bas b/src/screenres.fb.bas new file mode 100644 index 0000000..c6aa10a --- /dev/null +++ b/src/screenres.fb.bas @@ -0,0 +1,568 @@ +/' ######################### ABSTRACT ############################## + + File: ScreenRes_Width.bas Updated: 2015 Jan 03 + +Language: FreeBASIC 1.00.0 ( 32bit Windows ) By: Dean Saurdine + + Purpose: Demonstrate font sizes in console and GfxLib gui screens + +Skillset: beginning Beginner + + Notes: 1) No copyright. Public domain. No warranty. Your risk. + 2) Coded Courier New 10pt on 72 columns. + 3) Ensure -s gui compiler switch is NOT set. + 4) The three main program segments can be three different + program files and three different executables, if desired. + 5) Appendix follows main program and can be read first, if + desired. Written for the beginning Beginner. + +##################################################################### '/ +REM####################### MAIN PROGRAM ############################ + +/' ******************************** + ***** FreeBASIC console screen ***** + ******************************** +'/ + +REM setup FreeBASIC console screen +Screen , Rem default FreeBASIC screen +Width 43,28 Rem columns,rows +Color 0,15 Rem black foreground,white background +Cls + +REM print box grid at font size +Color ,7 Rem light gray background + +For false_loop As Integer = 0 To 0 + + Dim As Integer row = 0 + Dim As Integer column = 0 + + Rem odd numbered rows + For row = 1 To 27 Step 2 + For column = 1 To 43 Step 2 + Locate row,column : Print Space(1) ; + Next column + Next row + + Rem even numbered rows + For row = 2 To 28 Step 2 + For column = 2 To 42 Step 2 + Locate row,column : Print Space(1) ; + Next column + Next row + +Next false_loop + +'Print row Rem try compiling with this line uncommented + +/' +Note: the variables false_loop, row and column are visible only while +the false loop runs, which is exactly one time. false_loop, row and +column are created once. This coding technique is efficient for +loop-in-loop with large counters and small steps, a common occurence +when creating "graphic" elements. The expense is the creation of +false_loop, which is a do-nothing variable. Alternatives to a false +loop? Will they obfuscate the code? + +Counting "variable creations" can be considered as a first step in +managing the computer's memory space. Programs with well managed memory +space run faster and smoother, and the concept becomes increasingly +important as programs become larger and more complex. More advanced +memory space management methods are beyond this program's purpose. +'/ + +REM print text +Color ,15 Rem back to white background +'Color ,7 Rem try this for different visual effect + +Locate 2,2 : Print "FreeBASIC console font size 8x12 pixels" ; +Locate 5,2 : Print "console 'Print' is opaque background" ; + +Locate 10,9 : Print "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ; +Locate 12,9 : Print "abcdefghijklmnopqrstuvwxyz" ; +Locate 14,9 : Print "0 1 2 3 4 5 6 7 8 9 ~_+`-=" ; +Locate 16,9 : Print "!@(#)$[%]^{&}*;':""|,\." ; + +Locate 21,9 : Print "press a key to continue..." ; : Sleep +Locate 21,9 : Print " " ; + +/' ************************* + ***** GfxLib gui screen ***** + ************************* +'/ + +REM sub definitions +Sub model( ByVal columns As Integer , _ Rem console layer + ByVal rows As Integer , _ Rem console layer + ByVal w As Integer , _ Rem font width in pixels + ByVal h As Integer _ Rem font height in pixels + ) + + REM set and display the different GfxLib gui screen font sizes + + REM finish setup GfxLib gui screen. + 'ScreenRes 336,336 Rem graphic layer x,y pixels + Width columns,rows Rem console layer for font size w x h + Color 0,15 Rem black foreground,white background + Cls + +/' +Note: window, screen, and layer are different concepts. For now, we can +say "layers on a screen, screen in an operating system window." We can +also say "everything that can be done on the console screen is now done +on the GfxLib gui screen's console layer". + +The first mnemomic will eventually become "viewport in a layer, layer on +a page, page on a screen, screen in an operating system window." +Viewports and pages are beyond this program's purpose. + +Executing ScreenRes more than once may result in the GfxLib gui screen's +operating system window returning to its original position, if it has +been moved while the executable is running. Try it by uncommenting +ScreenRes in this code block. +'/ + + REM print text on console layer + Locate 2,2 : Print "GfxLib gui font size 8x" + Str(h) + Space(1) + _ + "pixels" ; + + REM draw text on graphic layer + Color 32 Rem bright blue foreground + Draw String ( (2-1)*w,(2-1)*h ), "GfxLib gui" + +/' +Note: the GfxLib gui screen, as it is set in this program, has an +adjustable 256 color palette, with color index numbers from 0 to 255. +For now, we can say Color 0 and Color 15 are identical to the console +screens. Color 1 through Color 14 may look different. Adjusting the +GfxLib gui screen's color palette is beyond this program's purpose. + +The Draw String should precisely overlay the first part of the Print. + +The "math" inside the Draw String's outer braces converts a column,row +position to an x,y position, using the following general equations: + + x = ( pseudo column - 1 ) * w + y = ( pseudo row - 1 ) * h + +Pseudo because real columns and real rows are on the console layer. + +The 1 is because the layers have different origin coordinate numbers: + The console layer's origin coordinate numbers are column,row = 1,1. + The graphic layer's origin coordinate numbers are x,y = 0,0. +The two origins are at the same place, which is the GfxLib gui screen's +upper left corner. + +The w is because one console layer column is w pixels wide, and the h is +because one console layer row is h pixels high. + +Pseudo column and pseudo row do not need to be integers in these +equations. The calculation results will be reduced to the next lower +integer when used for the x and y positions in a drawing command. Try +pseudo column = 2.6, pseudo row = 3.3, or some other fractions. +'/ + + REM draw box grid at font size on graphic layer + Color 7 Rem light gray foreground + + Scope + + Dim As Integer y = 0 + Dim As Integer x = 0 + + For y = 0 To (rows-1)*h Step h + For x = 0 To (columns-1)*w Step w + Line (x-1,y-1)-(x+w-1,y+h-1),,B Rem B = hollow Box + Next x + Next y + + End Scope + + 'Print y Rem try compiling with this line uncommented + +/' +Note: the Scope...End Scope code block works the same way as a false +loop, and has the advantage of not creating a do-nothing variable. +Alternatives to Scope, without obfuscating the code? + +Placement of the grid, for visual effect, depends on the font size +and the physical pixel size and shape. Different "screen" manufacturers +and/or models may have different physical pixel sizes and shapes. + + code correct... Line (x,y)-(x+w,y+h),,B + move box one pixel left... Line (x-1,y)-(x+w-1,y+h),,B + then one pixel up... Line (x-1,y-1)-(x+w-1,y+h-1),,B + +Remember: "good visual effect" may not always be "code correct". +'/ + + REM mixed printing and drawing on their respective layers + Color 0 Rem back to black foreground + 'Color 0,7 Rem try this for different visual effect + + Locate ( 5,2 ) : Print _ + "console ""Print"" is opaque background" ; + + Draw String ( (2-1)*w,(7-1)*h ), _ + "graphic ""Draw"" is transparent background" + + Draw String ( (9-1)*w,(10-1)*h ), _ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + + Draw String ( (9-1)*w,(12-1)*h ), _ + "abcdefghijklmnopqrstuvwxyz" + + Draw String ( (9-1)*w,(14-1)*h ), _ + "0 1 2 3 4 5 6 7 8 9 ~_+`-=" + + Draw String ( (9-1)*w,(16-1)*h ), _ + "!@(#)$[%]^{&}*;':""|,\." + + Locate ( 21,9 ) : Print _ + "press a key to continue..." ; + Sleep + +/' +Note: this coding style shows the coding similarities and differences +between printing text on the console layer and drawing text on the +graphic layer. What are they? Does printing and drawing order matter? + +Recall the "math" inside Draw String's outer braces converts column,row +position to x,y position. Can you create general equations to convert +x,y position to column,row position? Where would they be used? +'/ + +End Sub +REM end of sub definitions + +REM main program +REM start setup GfxLib gui screen +ScreenRes 336,336 Rem graphic layer x,y pixels +'Width columns,rows Rem in the sub definition +'Color foreground,background Rem in the sub definition +'Cls Rem in the sub definition + +REM set and display the different GfxLib gui screen font sizes +model( 42,42 , 8,8 ) Rem console layer columns,rows for font size w,h +model( 42,24 , 8,14 ) Rem ditto +model( 42,21 , 8,16 ) Rem ditto + +'model( 42,28 , 8,12 ) Rem try this illegal font size, with and + Rem without the other models. + +REM end of main program + +/' ***************************** + ***** GfxLib console screen ***** + ***************************** +'/ + +REM setup GfxLib console screen Rem closes GfxLib gui screen, if open +Screen 0 Rem GfxLib console screen +Width 80,25 Rem default columns,rows +Color 7,0 Rem default foreground,background +Cls + +REM print text +Locate 2,2 : Print "GfxLib console font size 8x12 pixels" ; +Locate 21,2 : Print "press a key to end this executable..." ; : Sleep + +REM end of main program +REM##################################################################### +REM######################## APPENDIX ############################### + +/' + +---------- + +"Graphic screen text is too small" usually means a lack of understanding +of how the GfxLib gui screen works. There is a lot to learn and this is, +fortunately, one of a very few times that interrelated concepts have to +be learned simultaneously. + +This program belongs to the category of "study and play with this, then +see me if you have questions". It is written in the FreeBASIC (fb) +dialect of the BASIC coding language. + +This appendix and main program's /'Note...'/ are meant to supplement the +existing wiki pages, and have evolved with "can you explain..." and "can +I see your 3-ring binder...". /'Note...'/ can be considered as footnotes +to specific code blocks. My questions and "try this" are meant to +stimulate thinking and creativity. + +---------- + +Prerequisites, or keywords/keyboard keys "you are supposed to know". +Some do not have proper wiki pages as of this appendix's writing. + +colon (statement termination = : = CR) +Enter key (statement and line termination = Enter key = CRLF) +underscore (statement continuation = _ = suppress CR in CRLF) +Rem (human readable comment, in the FreeBASIC variations) + +Screen , (FreeBASIC console screen) +Width (screen size) +Color (screen Colors) +Cls (Clear the screen) + +Locate (position screen cursor) +Print (Print something on screen) + +Dim (variable definition) +Integer (variable or expression type) +String (variable or expression type) + +Str (create String from number) +Space (flexible, human readable version of " ") +plus (String concatination = +) + +Scope...End Scope (code block, localized new variable visibility) +For...Next (code block, looping with built-in counter) +Sub...End Sub (code block, branching) + +Sleep (suspend program execution) + + +New keywords to learn: + +ScreenRes x,y (GfxLib gui screen) +Screen 0 (GfxLib console screen) + +Draw String (Draw text as String on graphic layer) +Line (draw Line or box on graphic layer) + +---------- + +To be consistent with the corresponding compiler switches, which are +-s gui and -s console, the word "gui" is used to identify what other +coders may call "graphic" screens. + +---------- + +"Terminal 8x12" is the intended font style and size for the console +screen segments of this program. + +See my Console_Defaults.bas program for discussion of console screen +default settings (Windows operating system). + +---------- + +Font size can be verified with this program's running executable. There +should be, for font size 8x12, four lines for every three lines of font +size 8x16. Eight lines for every six lines, sixteen for twelve... + +"Four for three" is calculated from the Least Common Multiple (LCM) of +12 and 16. LCM is a concept from mathematics. + +LCM( 12,16 ) = 48. 48 is the smallest common screen height, in pixels. + +Then calculate the corresponding number of available screen rows from: + + available rows = LCM / font height + +8x12 font size: available rows = 48 / 12 = 4 +8x16 font size: available rows = 48 / 16 = 3 + +---------- + +GfxLib is one of FreeBASIC's built-in libraries. GfxLib contains the +FreeBASIC gui screens and another FreeBASIC console screen. In this +appendix, the screens accessed via GfxLib are called GfxLib gui screen +and GfxLib console screen, and the default FreeBASIC console screen is +called the FreeBASIC console screen. + +The GfxLib console screen can be considered as having the same default +screen settings as the FreeBASIC console screen, and these defaults are +set in the same way (via cmd.exe). + +Use the FreeBASIC console screen if your program has no gui elements, as +GfxLib will bloat the executable. Use the GfxLib console screen if, for +any reason, you want to switch from a GfxLib gui screen to a console +screen. + +---------- + +Initiating a GfxLib gui screen with the "Screen mode" statement is from +old BASIC dialects, and should only be used for initial translation of +old BASIC programs. The FreeBASIC way to initiate a GfxLib gui screen is +through the use of the ScreenRes keyword. ScreenRes can be used in a +simple way, as in this program, or ScreenRes can be more capable than +the various gui screens created from "Screen mode". + +---------- + +The GfxLib gui screen can be considered as having one built-in unnamed +fixed-width font, whose style resembles Courier. Most text editors and +word processors set font size in points. GfxLib gui screen's font size +is set in pixels. This font size is represented by a box w pixels wide +and h pixels high. Characters, in the font set, fit into the box. + +GfxLib gui screen's available font sizes are 8x8, 8x14 and 8x16. In +words, the available font width is w = 8 pixels and the available font +heights are h = 8, 14 and 16 pixels. The default height is h = 8 pixels. + +The size of the GfxLib gui screen's built-in font can be adjusted by the +coder through the use of the "ScreenRes x,y" and "Width columns,rows" +statement pair. Adjusting the size of GfxLib gui screen's built-in font +is a purpose of this program. + +The coder can, through advanced use of the ScreenRes keyword, introduce +and use other fonts. The coder can also use other libraries to introduce +and use other fonts (and screens). Other fonts and screens are beyond +this program's purpose. + +---------- + +The following LCM table can be used to "rapid prototype" the GfxLib gui +screen, with built-in font size options to try for a common screen size. +LCM = Least Common Multiple, a concept from mathematics. + + +--------------------------------+ + LCM | rows ( for gui font 8 x h ) | ++-----------+--------------------------------| +| ScreenRes | | | | +| y | h = 8 | h = 14 | h = 16 | +| pixels | | | | +|============================================| +| 112 | 14 | 8 | 7 | +| 224 | 28 | 16 | 14 | +| 336 | 42 | 24 | 21 | +| 448 | 56 | 32 | 28 | +| 560 | 70 | 40 | 35 | +| 672 | 84 | 48 | 42 | +| 784 | 98 | 56 | 49 | +| 896 | 112 | 64 | 56 | +| 1008 | 126 | 72 | 63 | +| 1120 | 140 | 80 | 70 | +| 1232 | 154 | 88 | 77 | +| 1344 | 168 | 96 | 84 | +|======================+---------------------+ +| x | columns | ++----------------------+ + +Read up for x and columns, for font width w = 8 pixels. +Read down for y and rows, for font height h = 8 or 14 or 16 pixels. + +Code as: ScreenRes x,y + Width columns,rows + + +Example: setup GfxLib gui screen smaller than x,y = 800,600 and at font +size 8x14, using the LCM table. + + code as: ScreenRes 784,560 + Width 98,40 + +---------- + +x,y and columns,rows are calculated from the following equations, which +can also be used "fine tune" the GfxLib gui screen after deciding on a +particular font size: + + either: columns = x / 8 and rows = y / h + + or: x = columns * 8 and y = rows * h + + where: h = 8 or 14 or 16 + +Code as: ScreenRes x,y + Width columns,rows + +All equation elements need to be exactly integers (no fractions), or the +GfxLib gui screen font size may revert to the default 8x8. The available +columns,rows will then become the next lower integers, based on the +GfxLib gui screen's default 8x8 font size and the coder's x,y. + + +Example: setup GfxLib gui screen smaller than x,y = 800,600 and at font +size 8x14, using the equations. + + columns = x / 8 = 800 / 8 = 100 ...all are exactly integers + + rows = y / h = 600 / 14 = 42.86 ...fractions! Use rows = 42 + + then... y = rows * h = 42 * 14 = 588 ...all are exactly integers + + code as: ScreenRes 800,588 + Width 100,42 + +---------- + +Summary of FreeBASIC screen features ( for now... ) + + +-----------------------------------------------+ + FreeBASIC Screens | console | GfxLib gui | + | ( Windows ) | | ++---------------------+===============================================| +| screen initiation | Screen , (FreeBASIC) | ScreenRes x,y | +| | Screen 0 (GfxLib) | | +|---------------------+-------------------------+---------------------| +| screen size | columns,rows | x,y | +|---------------------+-------------------------+---------------------| +| default screen size | set via cmd.exe | not defined | +|---------------------+-------------------------+---------------------| +| font style | set via cmd.exe | similar to Courier | +|---------------------+-------------------------+---------------------| +| font size | set via cmd.exe | adjustable 8x8 | +| | | 8x14 | +| | | 8x16 | +|---------------------+-------------------------+---------------------| +| default font size | set via cmd.exe | 8x8 | +|---------------------+-------------------------+---------------------| +| screen colors | fixed 0 to 15 (cmd.exe) | adjustable 0 to 255 | +|---------------------+-------------------------+---------------------| +| default Color | 7,0 if Color is used. | 15,0 | +| | Set via cmd.exe if | | +| | Color is not used. | | +|---------------------+-------------------------+---------------------| +| layer types | "console" | console | +| | | graphic | ++---------------------------------------------------------------------+ + +Whether or not "console" exists depends on the point of view you are +comfortable with. "Console" as shown here is consistent with the "layers +on a screen, screen in an operating system window" mnemonic. It is +equally correct to say "FreeBASIC console screens do not have layers". + +See my Console_Defaults.bas program for discussion of cmd.exe settings. + +---------- + +The following "code" is copy/paste from my template file, named +template_FreeBASIC.bas and saved as a "read only" file. The file helps +me code in a consistent style, and the file evolves as I learn. + + +REM setup FreeBASIC console screen +Screen , Rem default FreeBASIC screen +Width 80,25 Rem default columns,rows +Color 7,0 Rem default foreground,background +Cls + +REM setup GfxLib gui screen +ScreenRes x,y Rem graphic layer pixels +Width columns,rows Rem console layer for font size w x h +Color 15,0 Rem default foreground,background +Cls + +REM setup GfxLib console screen Rem closes GfxLib gui screen, if open +Screen 0 Rem GfxLib console screen +Width 80,25 Rem default columns,rows +Color 7,0 Rem default foreground,background +Cls + + +Comments are free! In my coding style, comments "to the left" describe +code blocks, while comments "to the right" are like sticky notes. +FreeBASIC code is letter-case insensitive, so I use REM "to the left" to +describe a code block and Rem "to the left" to describe a code block +within a code block. + +---------- + +'/ + +REM end of appendix +REM##################################################################### +REM end of file diff --git a/src/simplebox.fb.bas b/src/simplebox.fb.bas new file mode 100644 index 0000000..f7a6b4f --- /dev/null +++ b/src/simplebox.fb.bas @@ -0,0 +1,18 @@ +Screen 13 + +'Move to (50,50) without drawing +Draw "BM 50,50" + +'Set drawing color to 2 (green) +Draw "C2" + +'Draw a box +Draw "R50 D30 L50 U30" + +'Move inside the box +Draw "BM +1,1" + +'Flood fill with color 1 (blue) up to border color 2 +Draw "P 1,2" + +Sleep \ No newline at end of file diff --git a/src/statics.fb.bas b/src/statics.fb.bas new file mode 100644 index 0000000..a2de788 --- /dev/null +++ b/src/statics.fb.bas @@ -0,0 +1,27 @@ +Sub StaticSub() + Static cnt As Integer + cnt += 1 + Print "In StaticSub "; cnt; " time(s)." + If (cnt = 10) Then + Print "That's the end!" + End If +End Sub + +' *** Versus VB5 *** +'Private Sub StaticSub() +' Set cnt As Integer +' cnt = cnt + 1 +' Print "In StaticSub" & cnt & " times(s)." +' If cnt = 10 Then +' Print "That's the end!" +' End If +'End Sub + +Dim i As Integer +For i = 1 to 10 + 'Call StaticSub until the loop completes + StaticSub +Next + +Sleep +End diff --git a/src/termfont.fb.bas b/src/termfont.fb.bas new file mode 100644 index 0000000..33a8774 --- /dev/null +++ b/src/termfont.fb.bas @@ -0,0 +1,55 @@ +'*** ONLY WORKS ON WINDOWS *** +#include "windows.bi" + +Dim As HKEY hKey1, hKey2 +Dim As DWORD dwDisposition +Dim As Integer fontheight,fontwidth +Dim As DWORD fontFamily = 54 +Dim As DWORD fontSize + +'valid font heights for Lucida console are +'5, 6, 7, 8, 10, 12, 14, 16, 18, 20, 24, 28, 36, and 72 + +fontheight = 72 'change this value for a different font size +fontwidth = 0 +fontsize=(fontheight*2^16)+fontwidth + +Dim As DWORD fontWeight = 700 + +Dim As String key2 +key2 = Command(0) +For x As Integer = 1 To Len(key2) + If Mid$(key2,x,1) = "\" Then + Mid$(key2,x,1)="_" + End If +Next x + +Dim As String faceName = "Lucida Console" + + +RegOpenKeyEx( HKEY_CURRENT_USER, "Console", 0, KEY_ALL_ACCESS, @hKey1 ) + + +RegCreateKeyEx( hKey1, Strptr(key2), 0, null, 0, KEY_ALL_ACCESS, _ +null, @hKey2, @dwDisposition ) + + +RegSetValueEx( hKey2, "FaceName", 0, REG_SZ, _ +Strptr(faceName), Sizeof(faceName)+2 ) + +RegSetValueEx( hKey2, "FontFamily", 0, REG_DWORD, _ +cast(LPSTR,@fontFamily), Sizeof(DWORD) ) + +RegSetValueEx( hKey2, "FontSize", 0, REG_DWORD, _ +cast(LPSTR,@fontSize), Sizeof(DWORD) ) + +Print RegSetValueEx( hKey2, "FontWeight", 0, REG_DWORD, _ +cast(LPSTR,@fontWeight), Sizeof(DWORD) ) + + +freeconsole() +allocconsole() +color 12,0 +width 20,1 +Print " Big Red Letters!"; +Sleep \ No newline at end of file diff --git a/src/tui.fb.bas b/src/tui.fb.bas new file mode 100644 index 0000000..1b20dce --- /dev/null +++ b/src/tui.fb.bas @@ -0,0 +1,139 @@ +'' Text user interface example + +namespace tui + +type window + declare constructor _ + ( _ + new_x as integer = 1, new_y as integer = 1, _ + new_w as integer = 20, new_h as integer = 5, _ + new_title as string = "" _ + ) + declare destructor( ) + declare sub show( ) + + '' Title property + declare property title as string + declare property title( new_title as string ) + + '' Position properties + declare property x as integer + declare property x( new_x as integer ) + declare property y as integer + declare property y( new_y as integer ) + +private: + declare sub redraw( ) + declare sub remove( ) + declare sub drawtitle( ) + + dim as string mytitle + dim as integer posx, posy, sizew, sizeh +end type + +constructor window _ + ( _ + new_x as integer, new_y as integer, _ + new_w as integer, new_h as integer, _ + new_title as string _ + ) + + this.posx = new_x + this.posy = new_y + this.sizew = new_w + this.sizeh = new_h + this.mytitle = new_title + + if( len( this.mytitle ) = 0 ) then + this.mytitle = "untitled" + end if + +end constructor + +destructor window( ) + color 7, 0 + cls +end destructor + +property window.title( ) as string + return this.mytitle +end property + +property window.title( new_title as string ) + this.mytitle = new_title + this.drawtitle( ) +end property + +property window.x( ) as integer + return this.posx +end property + +property window.x( new_x as integer ) + this.remove( ) + this.posx = new_x + this.redraw( ) +end property + +property window.y( ) as integer + return this.posy +end property + +property window.y( new_y as integer ) + this.remove( ) + this.posy = new_y + this.redraw( ) +end property + +sub window.show( ) + this.redraw( ) +end sub + +sub window.drawtitle( ) + locate this.posy, this.posx + color 15, 1 + print space( this.sizew ); + locate this.posy, this.posx + (this.sizew \ 2) - (len( this.mytitle ) \ 2) + print this.mytitle; +end sub + +sub window.remove( ) + color 0, 0 + var spaces = space( this.sizew ) + for i as integer = this.posy to this.posy + this.sizeh - 1 + locate i, this.posx + print spaces; + next +end sub + +sub window.redraw( ) + this.drawtitle( ) + color 8, 7 + var spaces = space( this.sizew ) + for i as integer = this.posy + 1 to this.posy + this.sizeh - 1 + locate i, this.posx + print spaces; + next +end sub + +end namespace + + dim win as tui.window = tui.window( 3, 5, 50, 15 ) + + win.show( ) + sleep 2000 + + win.title = "Window 1" + sleep 2000 + win.x = win.x + 10 + sleep 2000 + + win.title = "Window 2" + sleep 2000 + win.y = win.y - 2 + sleep 2000 + + locate 25, 1 + color 7, 0 + print "Press any key..."; + + sleep diff --git a/src/tuibox.fb.bas b/src/tuibox.fb.bas new file mode 100644 index 0000000..1614218 --- /dev/null +++ b/src/tuibox.fb.bas @@ -0,0 +1,123 @@ + +namespace tui + +type window + declare constructor _ + ( _ + new_x as integer = 1, new_y as integer = 1, _ + new_w as integer = 20, new_h as integer = 5, _ + new_title as string = "" _ + ) + declare destructor( ) + declare sub show( ) + + '' Title property + declare property title as string + declare property title( new_title as string ) + + '' Position properties + declare property x as integer + declare property x( new_x as integer ) + declare property y as integer + declare property y( new_y as integer ) + +private: + declare sub redraw( ) + declare sub remove( ) + declare sub drawtitle( ) + + dim as string mytitle + dim as integer posx, posy, sizew, sizeh +end type + +constructor window _ + ( _ + new_x as integer, new_y as integer, _ + new_w as integer, new_h as integer, _ + new_title as string _ + ) + + this.posx = new_x + this.posy = new_y + this.sizew = new_w + this.sizeh = new_h + this.mytitle = new_title + + if( len( this.mytitle ) = 0 ) then + this.mytitle = "untitled" + end if + +end constructor + +destructor window( ) + color 7, 0 + cls +end destructor + +property window.title( ) as string + return this.mytitle +end property + +property window.title( new_title as string ) + this.mytitle = new_title + this.drawtitle( ) +end property + +property window.x( ) as integer + return this.posx +end property + +property window.x( new_x as integer ) + this.remove( ) + this.posx = new_x + this.redraw( ) +end property + +property window.y( ) as integer + return this.posy +end property + +property window.y( new_y as integer ) + this.remove( ) + this.posy = new_y + this.redraw( ) +end property + +sub window.show( ) + this.redraw( ) +end sub + +sub window.drawtitle( ) + locate this.posy, this.posx + color 15, 1 + print space( this.sizew ); + locate this.posy, this.posx + (this.sizew \ 2) - (len( this.mytitle ) \ 2) + print this.mytitle; +end sub + +sub window.remove( ) + color 0, 0 + var spaces = space( this.sizew ) + for i as integer = this.posy to this.posy + this.sizeh - 1 + locate i, this.posx + print spaces; + next +end sub + +sub window.redraw( ) + this.drawtitle( ) + color 8, 7 + var spaces = space( this.sizew ) + for i as integer = this.posy + 1 to this.posy + this.sizeh - 1 + locate i, this.posx + print spaces; + next +end sub + +end namespace + +dim win1 as tui.window = tui.window( 3, 5, 50, 15, "Flashcards" ) +Cls +'win1.title = "Window 1" +win1.show( ) +sleep diff --git a/src/tutorial1.fb.bas b/src/tutorial1.fb.bas new file mode 100644 index 0000000..1f3d3f8 --- /dev/null +++ b/src/tutorial1.fb.bas @@ -0,0 +1,76 @@ +'From the FreeBASIC.Net tutorial site. +#include "fbgfx.bi" +Using FB + +'Put all the vars into a custom type +Type ObjectType + x As Single + y As Single + r As Single + l As Single + u As Single + d As Single + speed As Single +End Type + +Dim Shared CircleM As ObjectType + +Screen 13,8,2,0 'A 320x200 graphical window +SetMouse 0,0,0 'Hide the mouse cursor + +CircleM.x = 150 'Put the circle in the middle +CircleM.y = 90 'Of the window. +CircleM.l = 0 +CircleM.r = 0 +CircleM.u = 0 +CircleM.d = 0 +CircleM.speed = 1 + +Do + Cls 'Refreshes the window, so the circle doesn't "paint" + Circle (CircleM.x,CircleM.y), 10, 15 'Sets new location and shape + If CircleM.speed = 0 Then CircleM.speed = 1 + + If MultiKey(SC_LEFT) Then CircleM.l = 1:CircleM.r = 0:CircleM.u = 0:CircleM.d = 0 + If MultiKey(SC_RIGHT) Then CircleM.r = 1:CircleM.l = 0:CircleM.u = 0:CircleM.d = 0 + If MultiKey(SC_UP) Then CircleM.u = 1:CircleM.d = 0:CircleM.l = 0:CircleM.r = 0 + If MultiKey(SC_DOWN) Then CircleM.d = 1:CircleM.u = 0:CircleM.l = 0:CircleM.r = 0 + + If MultiKey(SC_UP) And MultiKey(SC_LEFT) Then CircleM.u = 1:CircleM.l = 1:CircleM.d = 0:CircleM.r = 0 + If MultiKey(SC_UP) And MultiKey(SC_RIGHT) Then CircleM.u = 1:CircleM.r = 1:CircleM.d = 0:CircleM.l = 0 + If MultiKey(SC_DOWN) And MultiKey(SC_LEFT) Then CircleM.d = 1:CircleM.l = 1:CircleM.u = 0:CircleM.r = 0 + If MultiKey(SC_DOWN) And MultiKey(SC_RIGHT) Then CircleM.d = 1:CircleM.r = 1:CircleM.u = 0:CircleM.l = 0 + + 'Listens for activity on named keys, and updates the circle + 'Position accordingly. + If CircleM.l = 1 Then + CircleM.x = CircleM.x - CircleM.speed + If CircleM.x < 0 Then CircleM.x = 320 + End If + + If CircleM.r = 1 Then + CircleM.x = CircleM.x + CircleM.speed + If CircleM.x > 320 Then CircleM.x = 0 + End If + + If CircleM.u = 1 Then + CircleM.y = CircleM.y - CircleM.speed + If CircleM.y < 0 Then CircleM.y = 200 + End If + + If CircleM.d = 1 Then + CircleM.y = CircleM.y + CircleM.speed + If CircleM.y > 200 Then CircleM.y = 0 + End If + + If MultiKey(SC_TAB) Then CircleM.speed = CircleM.speed + 1 + If MultiKey(SC_SPACE) Then + CircleM.speed = 0 + CircleM.l = 0 + CircleM.r = 0 + CircleM.u = 0 + CircleM.d = 0 + End If + + Sleep 10, 1 'No delay makes the movement invisible +Loop Until MultiKey(SC_Q) Or MultiKey(SC_ESCAPE) 'Escape or Q to exit diff --git a/src/weights.fb.bas b/src/weights.fb.bas new file mode 100644 index 0000000..f5b2e8a --- /dev/null +++ b/src/weights.fb.bas @@ -0,0 +1,4 @@ +Dim As Single lb, kg +Input "Enter a weight in pounds:", lb +kg = lb * 0.454 +Print lb; " lb. is equal to ";kg; " kg" \ No newline at end of file diff --git a/src/width.fb.bas b/src/width.fb.bas new file mode 100644 index 0000000..52aa5ed --- /dev/null +++ b/src/width.fb.bas @@ -0,0 +1,23 @@ + +Dim As Integer consize, rows, cols +'Get the current console size +consize = Width +rows = Hiword(consize) +cols = Loword(consize) +Print "Current Rows =";rows +Print "Current Columns =";cols +Print "Press any key..." +Sleep +Cls +'Resize console if necessary +If rows > 25 Then + Width 80, 25 +End If +'Get the new console size +consize = Width +rows = Hiword(consize) +cols = Loword(consize) +Print "New Rows =";rows +Print "New Columns =";cols +Sleep +End \ No newline at end of file